home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / D34567 / SMDBG / SMDBGRID.ZIP / RXUtils.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-08-01  |  6.6 KB  |  202 lines
  1. unit RXUtils; //Some functions from RX's VCLUtils.Pas;
  2.  
  3. {$IFNDEF VER80}     {-- Delphi 1.0     }
  4.  {$IFNDEF VER90}    {-- Delphi 2.0     }
  5.   {$IFNDEF VER93}   {-- C++Builder 1.0 }
  6.     {$DEFINE RX_D3} { Delphi 3.0 or higher }
  7.   {$ENDIF}
  8.  {$ENDIF}
  9. {$ENDIF}
  10.  
  11. {$P+,W-,R-,V-}
  12.  
  13. interface
  14.  
  15. {$IFDEF WIN32}
  16. uses Windows, Classes, Graphics;
  17. {$ELSE}
  18. uses WinTypes, WinProcs, Classes, Graphics;
  19. {$ENDIF}
  20.  
  21. { Windows resources (bitmaps and icons) VCL-oriented routines }
  22. procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer;
  23.   Bitmap: TBitmap; TransparentColor: TColor);
  24.  
  25. { Service routines }
  26. function Max(X, Y: Integer): Integer;
  27. function Min(X, Y: Integer): Integer;
  28.  
  29. { Standard Windows colors that are not defined by Delphi }
  30. const
  31. {$IFNDEF WIN32}
  32.   clInfoBk = TColor($02E1FFFF);
  33.   clNone = TColor($02FFFFFF);
  34. {$ENDIF}
  35.   clCream = TColor($A6CAF0);
  36.   clMoneyGreen = TColor($C0DCC0);
  37.   clSkyBlue = TColor($FFFBF0);
  38.  
  39. implementation
  40.  
  41. { Service routines }
  42. function Max(X, Y: Integer): Integer;
  43. begin
  44.   if X > Y then
  45.     Result := X
  46.   else
  47.     Result := Y;
  48. end;
  49.  
  50. function Min(X, Y: Integer): Integer;
  51. begin
  52.   if X < Y then
  53.     Result := X
  54.   else
  55.     Result := Y;
  56. end;
  57.  
  58. function PaletteColor(Color: TColor): Longint;
  59. const
  60. { TBitmap.GetTransparentColor from GRAPHICS.PAS use this value }
  61.   PaletteMask = $02000000;
  62. begin
  63.   Result := ColorToRGB(Color) or PaletteMask;
  64. end;
  65.  
  66.  
  67. { Transparent bitmap }
  68. procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
  69.   SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; Palette: HPalette;
  70.   TransparentColor: TColorRef);
  71. var
  72.   Color: TColorRef;
  73.   bmAndBack, bmAndObject, bmAndMem, bmSave: HBitmap;
  74.   bmBackOld, bmObjectOld, bmMemOld, bmSaveOld: HBitmap;
  75.   MemDC, BackDC, ObjectDC, SaveDC: HDC;
  76.   palDst, palMem, palSave, palObj: HPalette;
  77. begin
  78.   { Create some DCs to hold temporary data }
  79.   BackDC := CreateCompatibleDC(DstDC);
  80.   ObjectDC := CreateCompatibleDC(DstDC);
  81.   MemDC := CreateCompatibleDC(DstDC);
  82.   SaveDC := CreateCompatibleDC(DstDC);
  83.   { Create a bitmap for each DC }
  84.   bmAndObject := CreateBitmap(SrcW, SrcH, 1, 1, nil);
  85.   bmAndBack := CreateBitmap(SrcW, SrcH, 1, 1, nil);
  86.   bmAndMem := CreateCompatibleBitmap(DstDC, DstW, DstH);
  87.   bmSave := CreateCompatibleBitmap(DstDC, SrcW, SrcH);
  88.   { Each DC must select a bitmap object to store pixel data }
  89.   bmBackOld := SelectObject(BackDC, bmAndBack);
  90.   bmObjectOld := SelectObject(ObjectDC, bmAndObject);
  91.   bmMemOld := SelectObject(MemDC, bmAndMem);
  92.   bmSaveOld := SelectObject(SaveDC, bmSave);
  93.   { Select palette }
  94.   palDst := 0; palMem := 0; palSave := 0; palObj := 0;
  95.   if Palette <> 0 then begin
  96.     palDst := SelectPalette(DstDC, Palette, True);
  97.     RealizePalette(DstDC);
  98.     palSave := SelectPalette(SaveDC, Palette, False);
  99.     RealizePalette(SaveDC);
  100.     palObj := SelectPalette(ObjectDC, Palette, False);
  101.     RealizePalette(ObjectDC);
  102.     palMem := SelectPalette(MemDC, Palette, True);
  103.     RealizePalette(MemDC);
  104.   end;
  105.   { Set proper mapping mode }
  106.   SetMapMode(SrcDC, GetMapMode(DstDC));
  107.   SetMapMode(SaveDC, GetMapMode(DstDC));
  108.   { Save the bitmap sent here }
  109.   BitBlt(SaveDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SRCCOPY);
  110.   { Set the background color of the source DC to the color,         }
  111.   { contained in the parts of the bitmap that should be transparent }
  112.   Color := SetBkColor(SaveDC, PaletteColor(TransparentColor));
  113.   { Create the object mask for the bitmap by performing a BitBlt()  }
  114.   { from the source bitmap to a monochrome bitmap                   }
  115.   BitBlt(ObjectDC, 0, 0, SrcW, SrcH, SaveDC, 0, 0, SRCCOPY);
  116.   { Set the background color of the source DC back to the original  }
  117.   SetBkColor(SaveDC, Color);
  118.   { Create the inverse of the object mask }
  119.   BitBlt(BackDC, 0, 0, SrcW, SrcH, ObjectDC, 0, 0, NOTSRCCOPY);
  120.   { Copy the background of the main DC to the destination }
  121.   BitBlt(MemDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, SRCCOPY);
  122.   { Mask out the places where the bitmap will be placed }
  123.   StretchBlt(MemDC, 0, 0, DstW, DstH, ObjectDC, 0, 0, SrcW, SrcH, SRCAND);
  124.   { Mask out the transparent colored pixels on the bitmap }
  125.   BitBlt(SaveDC, 0, 0, SrcW, SrcH, BackDC, 0, 0, SRCAND);
  126.   { XOR the bitmap with the background on the destination DC }
  127.   StretchBlt(MemDC, 0, 0, DstW, DstH, SaveDC, 0, 0, SrcW, SrcH, SRCPAINT);
  128.   { Copy the destination to the screen }
  129.   BitBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0,
  130.     SRCCOPY);
  131.   { Restore palette }
  132.   if Palette <> 0 then begin
  133.     SelectPalette(MemDC, palMem, False);
  134.     SelectPalette(ObjectDC, palObj, False);
  135.     SelectPalette(SaveDC, palSave, False);
  136.     SelectPalette(DstDC, palDst, True);
  137.   end;
  138.   { Delete the memory bitmaps }
  139.   DeleteObject(SelectObject(BackDC, bmBackOld));
  140.   DeleteObject(SelectObject(ObjectDC, bmObjectOld));
  141.   DeleteObject(SelectObject(MemDC, bmMemOld));
  142.   DeleteObject(SelectObject(SaveDC, bmSaveOld));
  143.   { Delete the memory DCs }
  144.   DeleteDC(MemDC);
  145.   DeleteDC(BackDC);
  146.   DeleteDC(ObjectDC);
  147.   DeleteDC(SaveDC);
  148. end;
  149.  
  150. procedure StretchBitmapTransparent(Dest: TCanvas; Bitmap: TBitmap;
  151.   TransparentColor: TColor; DstX, DstY, DstW, DstH, SrcX, SrcY,
  152.   SrcW, SrcH: Integer);
  153. var
  154.   CanvasChanging: TNotifyEvent;
  155.   Temp: TBitmap;
  156. begin
  157.   if DstW <= 0 then DstW := Bitmap.Width;
  158.   if DstH <= 0 then DstH := Bitmap.Height;
  159.   if (SrcW <= 0) or (SrcH <= 0) then begin
  160.     SrcX := 0; SrcY := 0;
  161.     SrcW := Bitmap.Width;
  162.     SrcH := Bitmap.Height;
  163.   end;
  164.   if not Bitmap.Monochrome then
  165.     SetStretchBltMode(Dest.Handle, STRETCH_DELETESCANS);
  166.   CanvasChanging := Bitmap.Canvas.OnChanging;
  167.   try
  168.     Bitmap.Canvas.OnChanging := nil;
  169.     Temp := Bitmap;
  170.     try
  171.       if TransparentColor = clNone then begin
  172.         StretchBlt(Dest.Handle, DstX, DstY, DstW, DstH, Temp.Canvas.Handle,
  173.           SrcX, SrcY, SrcW, SrcH, Dest.CopyMode);
  174.       end
  175.       else
  176.       begin
  177. {$IFDEF RX_D3}
  178.         if TransparentColor = clDefault then
  179.           TransparentColor := Temp.Canvas.Pixels[0, Temp.Height - 1];
  180. {$ENDIF}
  181.         if Temp.Monochrome then TransparentColor := clWhite
  182.         else TransparentColor := ColorToRGB(TransparentColor);
  183.         StretchBltTransparent(Dest.Handle, DstX, DstY, DstW, DstH,
  184.           Temp.Canvas.Handle, SrcX, SrcY, SrcW, SrcH, Temp.Palette,
  185.           TransparentColor);
  186.       end;
  187.     finally
  188.     end;
  189.   finally
  190.     Bitmap.Canvas.OnChanging := CanvasChanging;
  191.   end;
  192. end;
  193.  
  194. procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer;
  195.   Bitmap: TBitmap; TransparentColor: TColor);
  196. begin
  197.   StretchBitmapTransparent(Dest, Bitmap, TransparentColor, DstX, DstY,
  198.     Bitmap.Width, Bitmap.Height, 0, 0, Bitmap.Width, Bitmap.Height);
  199. end;
  200.  
  201. end.
  202.