home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmHint.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  4KB  |  154 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmHint
  5. Purpose  : Minor enhancements to the original VCL THintWindow.  Used in other
  6.            unit's of the rmControl library.
  7. Date     : 10-26-2000
  8. Author   : Ryan J. Mills
  9. Version  : 1.80
  10. ================================================================================}
  11.  
  12. unit rmHint;
  13.  
  14. interface
  15.  
  16. {$I CompilerDefines.INC}
  17.  
  18. uses messages, windows, controls, classes, Graphics;
  19.  
  20. type
  21.   TrmHintWindow = class(TCustomControl)
  22.   private
  23.     FActivating: Boolean;
  24.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  25.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  26.   protected
  27.     procedure CreateParams(var Params: TCreateParams); override;
  28.     procedure Paint; override;
  29.   public
  30.     constructor Create(AOwner: TComponent); override;
  31.     procedure ActivateHint(Rect: TRect; const AHint: string); virtual;
  32.     procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); virtual;
  33.     function CalcHintRect(MaxWidth: Integer; const AHint: string;
  34.       AData: Pointer): TRect; virtual;
  35.     function IsHintMsg(var Msg: TMsg): Boolean; virtual;
  36.     procedure ReleaseHandle;
  37.     property BiDiMode;
  38.     property Caption;
  39.     property Color;
  40.     property Canvas;
  41.     property Font;
  42.   end;
  43.  
  44. implementation
  45.  
  46. uses Forms, extctrls;
  47.  
  48. { TrmHintWindow }
  49.  
  50. constructor TrmHintWindow.Create(AOwner: TComponent);
  51. begin
  52.   inherited Create(AOwner);
  53.   Color := clInfoBk;
  54.   {$ifdef D5_OR_HIGHER}
  55.   Canvas.Font := Screen.HintFont;
  56.   {$else}
  57.   Canvas.Font := Font;   
  58.   {$endif}
  59.   Canvas.Brush.Style := bsClear;
  60. end;
  61.  
  62. procedure TrmHintWindow.CreateParams(var Params: TCreateParams);
  63. begin
  64.   inherited CreateParams(Params);
  65.   with Params do
  66.   begin
  67.     Style := WS_POPUP or WS_BORDER;
  68.     WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  69.     if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW;
  70.     AddBiDiModeExStyle(ExStyle);
  71.   end;
  72. end;
  73.  
  74. procedure TrmHintWindow.WMNCHitTest(var Message: TWMNCHitTest);
  75. begin
  76.   Message.Result := HTTRANSPARENT;
  77. end;
  78.  
  79. procedure TrmHintWindow.WMNCPaint(var Message: TMessage);
  80. var
  81.   DC: HDC;
  82.   R: TRect;
  83. begin
  84.   DC := GetWindowDC(Handle);
  85.   try
  86.     R := Rect(0, 0, Width, Height);
  87.     DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
  88.   finally
  89.     ReleaseDC(Handle, DC);
  90.   end;
  91. end;
  92.  
  93. procedure TrmHintWindow.Paint;
  94. var
  95.   R: TRect;
  96. begin
  97.   R := ClientRect;
  98.   inc(R.Left,1);
  99.  
  100.   Canvas.Font.Assign(font);
  101.   Canvas.Font.Color := clInfoText;
  102.   DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
  103.     DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  104. end;
  105.  
  106. function TrmHintWindow.IsHintMsg(var Msg: TMsg): Boolean;
  107. begin
  108.   with Msg do
  109.     Result := ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) or
  110.       ((Message = CM_ACTIVATE) or (Message = CM_DEACTIVATE)) or
  111.       (Message = CM_APPKEYDOWN) or (Message = CM_APPSYSCOMMAND) or
  112.       (Message = WM_COMMAND) or ((Message > WM_MOUSEMOVE) and
  113.       (Message <= WM_MOUSELAST)) or (Message = WM_NCMOUSEMOVE);
  114. end;
  115.  
  116. procedure TrmHintWindow.ActivateHint(Rect: TRect; const AHint: string);
  117. begin
  118.   FActivating := True;
  119.   try
  120.     Caption := AHint;
  121.     UpdateBoundsRect(Rect);
  122.     if Rect.Top + Height > Screen.DesktopHeight then
  123.       Rect.Top := Screen.DesktopHeight - Height;
  124.     if Rect.Left + Width > Screen.DesktopWidth then
  125.       Rect.Left := Screen.DesktopWidth - Width;
  126.     if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
  127.     if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
  128.     SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
  129.       SWP_SHOWWINDOW or SWP_NOACTIVATE);
  130.     Invalidate;
  131.   finally
  132.     FActivating := False;
  133.   end;
  134. end;
  135.  
  136. procedure TrmHintWindow.ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer);
  137. begin
  138.   ActivateHint(Rect, AHint);
  139. end;
  140.  
  141. function TrmHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
  142. begin
  143.   Result := Rect(0, 0, MaxWidth, 0);
  144.   DrawText(Canvas.Handle, PChar(AHint), -1, Result, DT_CALCRECT or DT_LEFT or
  145.     DT_SINGLELINE or DT_TOP OR DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
  146. end;
  147.  
  148. procedure TrmHintWindow.ReleaseHandle;
  149. begin
  150.    DestroyHandle;  
  151. end;
  152.  
  153. end.
  154.