home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d5 / sStyleFree.exe / sTranspControl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-11-24  |  3.6 KB  |  140 lines
  1. unit sTranspControl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, udcUtil;
  8.  
  9. type
  10.   TsTranspControl = class(TGraphicControl)
  11.   private
  12.     { Private declarations }
  13.     FTransparency : integer;
  14.     tb : TTransparentBitmap;
  15.     FOptimize : boolean;
  16.     procedure SetTransparency(const Value: integer);
  17.     procedure SetOptimize(const Value: boolean);
  18.   protected
  19.     { Protected declarations }
  20.   public
  21.     { Public declarations }
  22.     FStoredBmp : TBitmap;
  23.     constructor Create(AOwner:TComponent); override;
  24.     destructor Destroy; override;
  25.     procedure Paint; override;
  26.   published
  27.     { Published declarations }
  28.     property Transparency: integer read FTransparency write SetTransparency;
  29.     property Optimize : boolean read FOptimize write SetOptimize;
  30.     property Align;
  31.     property Anchors;
  32.     property AutoSize;
  33.     property BiDiMode;
  34.     property Caption;
  35.     property Color;
  36.     property Constraints;
  37.     property DragCursor;
  38.     property DragKind;
  39.     property DragMode;
  40.     property Enabled;
  41.     property Font;
  42.     property ParentBiDiMode;
  43.     property ParentColor;
  44.     property ParentFont;
  45.     property ParentShowHint;
  46.     property PopupMenu;
  47.     property ShowHint;
  48.     property Visible;
  49.     property OnClick;
  50.     property OnContextPopup;
  51.     property OnDblClick;
  52.     property OnDragDrop;
  53.     property OnDragOver;
  54.     property OnEndDock;
  55.     property OnEndDrag;
  56.     property OnMouseDown;
  57.     property OnMouseMove;
  58.     property OnMouseUp;
  59.     property OnStartDock;
  60.     property OnStartDrag;
  61.   end;
  62.  
  63. implementation
  64.  
  65. uses
  66.   sPanel;
  67.  
  68. { TsTranspControl }
  69.  
  70. constructor TsTranspControl.Create(AOwner: TComponent);
  71. begin
  72.   inherited Create(AOwner);
  73.   ControlStyle := ControlStyle + [csOpaque];
  74.   tb := TTransparentBitmap.Create;
  75.   FStoredBmp := TBitMap.Create;
  76.   FOptimize := True;
  77.   ParentFont := True;
  78.   AutoSize := True;
  79. end;
  80.  
  81. destructor TsTranspControl.Destroy;
  82. begin
  83.   inherited;
  84.   tb.Free;
  85. end;
  86.  
  87. procedure TsTranspControl.Paint;
  88. var
  89.   R: TRect;
  90.   DC: HDC;
  91.   P: TPoint;
  92. begin
  93.   R := ClientRect;
  94.   FStoredBmp.Height := R.Bottom - R.Top;
  95.   FStoredBmp.Width := R.Right - R.Left;
  96.   if FTransparency = 0 then begin
  97.     FStoredBmp.Canvas.Brush.Color := Color;
  98.     FStoredBmp.Canvas.FillRect(R);
  99.   end
  100.   else begin
  101.     DC := GetWindowDC(Canvas.Handle);
  102.     tb.NewBitmap;
  103.     tb.Bitmap.Height := R.Bottom - R.Top;
  104.     tb.Bitmap.Width := R.Right - R.Left;
  105.     if (Parent is TsPanel) and Assigned(TsPanel(Parent).FStoredBmp) and Optimize then begin
  106.       bitBlt(tb.Bitmap.Canvas.Handle, 0, 0, tb.Bitmap.Width, tb.Bitmap.Height, TsPanel(Parent).FStoredBmp.Canvas.Handle, Left, Top, SrcCopy);
  107.     end
  108.     else begin
  109.       P.x := 0; P.y := 0;
  110.       P := ClientToScreen(P);
  111.       OffsetRect(R, P.x , P.y);
  112.  
  113.       tb.GetScreenBitmap(R);
  114.     end;
  115.     tb.ApplyTransparency(Rect(0, 0, R.Right - R.Left, R.Bottom - R.Top), Color, Transparency);
  116.     BitBlt(FStoredBmp.Canvas.Handle, 0, 0, TB.TransBitmap.Width, TB.TransBitmap.Height, TB.TransBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  117.     ReleaseDC(Canvas.Handle, DC);
  118.   end;
  119.   Self.
  120.   Canvas.CopyRect(ClientRect, FStoredBmp.Canvas, ClientRect);
  121. end;
  122.  
  123. procedure TsTranspControl.SetOptimize(const Value: boolean);
  124. begin
  125.   FOptimize := Value;
  126.   Invalidate;
  127. end;
  128.  
  129. procedure TsTranspControl.SetTransparency(const Value: integer);
  130. begin
  131.   if FTransparency <> Value then begin
  132.     if Value < 0 then FTransparency := 0
  133.     else if Value > 100 then FTransparency := 100
  134.     else FTransparency := Value;
  135.     Invalidate;
  136.   end;
  137. end;
  138.  
  139. end.
  140.