home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d56 / DCHINTEX.ZIP / udcHintEx.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-03  |  6KB  |  219 lines
  1. unit udcHintEx;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, udcUtil;
  7.  
  8. type
  9.   TdcInternalHintEx = class(THintWindow)
  10.   private
  11.     FTransBitmap: TTransparentBitmap;
  12.     FActivating: Boolean;
  13.   protected
  14.     procedure Paint; override;
  15.     procedure CreateParams(var Params: TCreateParams); override;
  16.   public
  17.     procedure ActivateHint(Rect: TRect; const AHint: string); override;
  18.     function CalcHintRect(MaxWidth: Integer; const AHint: string;
  19.       AData: Pointer): TRect; override;
  20.     constructor Create(AOwner:TComponent); override;
  21.     destructor Destroy; override;
  22.   end;
  23.  
  24.   TdcHintEx= class(TComponent)
  25.   private
  26.     FFont: TFont;
  27.     FTransparent: Boolean;
  28.     FTransparency: Integer;
  29.     FTranspColor: TColor;
  30.     FShadowColor: TColor;
  31.     FEnabled: Boolean;
  32.     FLeftMargin: Integer;
  33.     FRightMargin: Integer;
  34.     FBottomMargin: Integer;
  35.     FTopMargin: Integer;
  36.     procedure SetEnable(const Value: Boolean);
  37.     procedure SetTransparency(const Value: Integer);
  38.     procedure SetFont(const Value: TFont);
  39.   public
  40.     constructor Create(AOwner: TComponent); override;
  41.     destructor Destroy; override;
  42.   published
  43.     property Transparent: boolean read FTransparent write FTransparent;
  44.     property Transparency: Integer read FTransparency write SetTransparency default 30;
  45.     property TranspColor: TColor read FTranspColor write FTranspColor default clInfoBk;
  46.     property ShadowColor: TColor read FShadowColor write FShadowColor default clWhite;
  47.     property Enabled: Boolean read FEnabled write SetEnable;
  48.     property Font: TFont read FFont write SetFont;
  49.     property LeftMargin: Integer read FLeftMargin write FLeftMargin default 5;
  50.     property TopMargin: Integer read FTopMargin write FTopMargin default 5;
  51.     property RightMargin: Integer read FRightMargin write FRightMargin default 5;
  52.     property BottomMargin: Integer read FBottomMargin write FBottomMargin default 5;
  53.   end;
  54.  
  55. procedure Register;
  56.  
  57.  
  58. implementation
  59.  
  60. { TdcInternalHintEx }
  61.  
  62. {$R *.RES}
  63.  
  64. var dcHintEx: TdcHintEx;
  65.  
  66. procedure TdcInternalHintEx.ActivateHint(Rect: TRect; const AHint: string);
  67. type
  68.   PRGBArray = ^TRGBArray;
  69.   TRGBArray = array[0..1000000] of TRGBTriple;
  70. begin
  71.   FActivating := True;
  72.   try
  73.     ShowWindow(Handle, SW_HIDE);
  74.     Caption := AHint;
  75.     Inc(Rect.Bottom, 2);
  76.     Inc(Rect.Right, 2);
  77.     UpdateBoundsRect(Rect);
  78.     if Rect.Top + Height > Screen.DesktopHeight then
  79.       Rect.Top := Screen.DesktopHeight - Height;
  80.     if Rect.Left + Width > Screen.DesktopWidth then
  81.       Rect.Left := Screen.DesktopWidth - Width;
  82.     if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
  83.     if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
  84.  
  85.     if dcHintEx.Transparent then
  86.       FTransBitmap.CreateBitmap(Rect, dcHintEx.TranspColor, dcHintEx.Transparency);
  87.     SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
  88.       SWP_SHOWWINDOW or SWP_NOACTIVATE);
  89.     Invalidate;
  90.   finally
  91.     FActivating := False;
  92.   end;
  93. end;
  94.  
  95. function TdcInternalHintEx.CalcHintRect(MaxWidth: Integer; const AHint: string;
  96.   AData: Pointer): TRect;
  97. begin
  98.   Result := Rect(0, 0, MaxWidth, 0);
  99.   Canvas.Font := dchintEx.Font;
  100.   DrawText(Canvas.Handle, PChar(AHint), -1, Result, DT_CALCRECT or DT_LEFT or
  101.     DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
  102.   Inc(Result.Right, dchintEx.RightMargin+dcHintEx.LeftMargin);
  103.   Inc(Result.Bottom, dcHintEx.BottomMargin+dcHintEx.TopMargin);
  104. end;
  105.  
  106. constructor TdcInternalHintEx.Create(AOwner: TComponent);
  107. begin
  108.   inherited;
  109.   FTransBitmap := TTransparentBitmap.Create;
  110. end;
  111.  
  112. procedure TdcInternalHintEx.CreateParams(var Params: TCreateParams);
  113. begin
  114.   inherited;
  115.   Params.Style := Params.Style - WS_BORDER;
  116. end;
  117.  
  118. destructor TdcInternalHintEx.Destroy;
  119. begin
  120.   FTransBitmap.Free;
  121.   inherited;
  122. end;
  123.  
  124. procedure TdcInternalHintEx.Paint;
  125. var R: TRect;
  126. begin
  127.   R := ClientRect;
  128.   Canvas.Font := dcHintEx.Font;
  129.   if dcHintEx.Transparent then
  130.     BitBlt(Canvas.Handle, 0, 0, FTransBitmap.TransBitmap.Width, FTransBitmap.TransBitmap.Height,
  131.       FTransBitmap.TransBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  132.  
  133.   Inc(R.Left, dcHintEx.LeftMargin-1);
  134.   Inc(R.Top, dcHintEx.TopMargin-1);
  135.   Dec(R.Right, dcHintEx.RightMargin+1);
  136.   Dec(R.Bottom, dcHintEx.BottomMargin+1);
  137.  
  138.   Canvas.Font.Color := dcHintEx.ShadowColor;
  139.   DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
  140.     DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  141.  
  142.   Inc(R.Left,2);
  143.   Inc(R.Top,2);
  144.   Inc(R.Right,2);
  145.   Inc(R.Bottom,2);
  146.   DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
  147.     DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  148.  
  149.   Dec(R.Left);
  150.   Dec(R.Top);
  151.   Dec(R.Right);
  152.   Dec(R.Left);
  153.   Canvas.Font.Color := dcHintEx.Font.Color;
  154.   DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
  155.     DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  156. end;
  157.  
  158. { TdcHintEx }
  159.  
  160. constructor TdcHintEx.Create(AOwner: TComponent);
  161. begin
  162.   if not (AOwner.InheritsFrom(TCustomForm)) then
  163.     raise Exception.Create('dcHintEx must be dropped on a form.');
  164.   inherited;
  165.   FLeftMargin:= 5;
  166.   FRightMargin:= 5;
  167.   FTopMargin:= 5;
  168.   FBottomMargin:= 5;
  169.   FTransparent := True;
  170.   FTransparency := 30;
  171.   FTranspColor := clInfoBk;
  172.   FShadowColor := clWhite;
  173.   FFont := TFont.Create;
  174.   FFont.Assign(TCustomForm(AOwner).Font);
  175. end;
  176.  
  177. destructor TdcHintEx.Destroy;
  178. begin
  179.   FFont.Free;
  180.   inherited;
  181. end;
  182.  
  183. procedure TdcHintEx.SetEnable(const Value: Boolean);
  184. begin
  185.   if FEnabled <> Value then begin
  186.     FEnabled := Value;
  187.     if not (csDesigning in ComponentState) then
  188.       if FEnabled then begin
  189.         dcHintEx := Self;
  190.         HintWindowClass := TdcInternalHintEx
  191.       end
  192.       else begin
  193.         dcHintEx := nil;
  194.         if HintWindowClass = TdcInternalHintEx then
  195.           HintWindowClass := THintWindow;
  196.       end;
  197.   end;
  198. end;
  199.  
  200. procedure TdcHintEx.SetFont(const Value: TFont);
  201. begin
  202.   FFont.Assign(Value);
  203. end;
  204.  
  205. procedure TdcHintEx.SetTransparency(const Value: Integer);
  206. begin
  207.   if (Value < 0) or (Value > 100) then
  208.     raise Exception.Create('Invalid transparency percentage value.');
  209.   FTransparency := Value;
  210. end;
  211.  
  212. procedure Register;
  213. begin
  214.   RegisterComponents('dc Tools', [TdcHintEx]);
  215. end;
  216.  
  217. end.
  218.  
  219.