fcGraphics.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:3k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit fcGraphics;
  2. interface
  3. uses Windows, Graphics;
  4. function PaletteFromDIBColorTable(DIBHandle: THandle; ColorTable: Pointer;
  5.   ColorCount: Integer): HPalette;
  6. procedure ByteSwapColors(var Colors; Count: Integer);
  7. implementation
  8. procedure ByteSwapColors(var Colors; Count: Integer);
  9. var   // convert RGB to BGR and vice-versa.  TRGBQuad <-> TPaletteEntry
  10.   SysInfo: TSystemInfo;
  11. begin
  12.   GetSystemInfo(SysInfo);
  13.   asm
  14.         MOV   EDX, Colors
  15.         MOV   ECX, Count
  16.         DEC   ECX
  17.         JS    @@END
  18.         LEA   EAX, SysInfo
  19.         CMP   [EAX].TSystemInfo.wProcessorLevel, 3
  20.         JE    @@386
  21.   @@1:  MOV   EAX, [EDX+ECX*4]
  22.         BSWAP EAX
  23.         SHR   EAX,8
  24.         MOV   [EDX+ECX*4],EAX
  25.         DEC   ECX
  26.         JNS   @@1
  27.         JMP   @@END
  28.   @@386:
  29.         PUSH  EBX
  30.   @@2:  XOR   EBX,EBX
  31.         MOV   EAX, [EDX+ECX*4]
  32.         MOV   BH, AL
  33.         MOV   BL, AH
  34.         SHR   EAX,16
  35.         SHL   EBX,8
  36.         MOV   BL, AL
  37.         MOV   [EDX+ECX*4],EBX
  38.         DEC   ECX
  39.         JNS   @@2
  40.         POP   EBX
  41.     @@END:
  42.   end;
  43. end;
  44. function SystemPaletteOverride(var Pal: TMaxLogPalette): Boolean;
  45. var
  46.   DC: HDC;
  47.   SysPalSize: Integer;
  48. begin
  49.   Result := False;
  50.   if SystemPalette16 <> 0 then
  51.   begin
  52.     DC := GetDC(0);
  53.     try
  54.       SysPalSize := GetDeviceCaps(DC, SIZEPALETTE);
  55.       if SysPalSize >= 16 then
  56.       begin
  57.         { Ignore the disk image of the palette for 16 color bitmaps.
  58.           Replace with the first and last 8 colors of the system palette }
  59.         GetPaletteEntries(SystemPalette16, 0, 8, Pal.palPalEntry);
  60.         GetPaletteEntries(SystemPalette16, 8, 8, Pal.palPalEntry[Pal.palNumEntries - 8]);
  61.         Result := True;
  62.       end
  63.     finally
  64.       ReleaseDC(0,DC);
  65.     end;
  66.   end;
  67. end;
  68. function PaletteFromDIBColorTable(DIBHandle: THandle; ColorTable: Pointer;
  69.   ColorCount: Integer): HPalette;
  70. var
  71.   DC: HDC;
  72.   Save: THandle;
  73.   Pal: TMaxLogPalette;
  74. begin
  75.   Result := 0;
  76.   Pal.palVersion := $300;
  77.   if DIBHandle <> 0 then
  78.   begin
  79.     DC := CreateCompatibleDC(0);
  80.     Save := SelectObject(DC, DIBHandle);
  81.     Pal.palNumEntries := GetDIBColorTable(DC, 0, 256, Pal.palPalEntry);
  82.     SelectObject(DC, Save);
  83.     DeleteDC(DC);
  84.   end
  85.   else
  86.   begin
  87.     Pal.palNumEntries := ColorCount;
  88.     Move(ColorTable^, Pal.palPalEntry, ColorCount * 4);
  89.   end;
  90.   if Pal.palNumEntries = 0 then Exit;
  91.   if (Pal.palNumEntries <> 16) or not SystemPaletteOverride(Pal) then
  92.     ByteSwapColors(Pal.palPalEntry, Pal.palNumEntries);
  93.   Result := CreatePalette(PLogPalette(@Pal)^);
  94. end;
  95. end.