home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kompon / d23456 / COOLTRAY.ZIP / demos / CustomHint2 / BigHint.pas < prev    next >
Pascal/Delphi Source File  |  2002-04-11  |  5KB  |  207 lines
  1. unit BigHint;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, CoolTrayIcon, TextTrayIcon, Menus, ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TTiledHintWindow = class(THintWindow)
  11.   private
  12.     Bmp: TBitmap;
  13.     procedure TileImage(Bitmap: TBitmap; R: TRect);
  14.   protected
  15.     procedure Paint; override;
  16.   public
  17.     constructor Create(AOwner: TComponent); override;
  18.     destructor Destroy; override;
  19.   end;
  20.  
  21.   TForm1 = class(TForm)
  22.     TextTrayIcon1: TTextTrayIcon;
  23.     PopupMenu1: TPopupMenu;
  24.     Regular1: TMenuItem;
  25.     Custom1: TMenuItem;
  26.     N1: TMenuItem;
  27.     Exit1: TMenuItem;
  28.     Timer1: TTimer;
  29.     Timer2: TTimer;
  30.     Label1: TLabel;
  31.     Button1: TButton;
  32.     Label2: TLabel;
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure FormDestroy(Sender: TObject);
  35.     procedure Timer1Timer(Sender: TObject);
  36.     procedure Timer2Timer(Sender: TObject);
  37.     procedure TextTrayIcon1MouseExit(Sender: TObject);
  38.     procedure TextTrayIcon1MouseEnter(Sender: TObject);
  39.     procedure Exit1Click(Sender: TObject);
  40.     procedure Button1Click(Sender: TObject);
  41.     procedure TextTrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
  42.       X, Y: Integer);
  43.     procedure Regular1Click(Sender: TObject);
  44.     procedure Custom1Click(Sender: TObject);
  45.   private
  46.     HintWindow1: THintWindow;
  47.     HintWindow2: TTiledHintWindow;
  48.     CurrentHintWindow: THintWindow;
  49.     LastMouse, LastHint: TPoint;
  50.     Hint: string;
  51.   end;
  52.  
  53. var
  54.   Form1: TForm1;
  55.  
  56. implementation
  57.  
  58. {$R *.dfm}
  59. {$R 'images.res'}
  60.  
  61. {------------------------ TForm1 ----------------------}
  62.  
  63. procedure TForm1.FormCreate(Sender: TObject);
  64. var
  65.   I: Integer;
  66. begin
  67.   HintWindow1 := THintWindow.Create(Self);
  68.   HintWindow1.Color := clAqua;
  69.   HintWindow1.Canvas.Font.Style := [fsBold];
  70.   HintWindow1.Canvas.Font.Size := 10;
  71.  
  72.   HintWindow2 := TTiledHintWindow.Create(Self);
  73.   HintWindow2.Canvas.Font.Color := clWhite;
  74.  
  75.   Timer1.Interval := Application.HintPause;
  76.   Timer2.Interval := Application.HintHidePause;
  77.  
  78.   Hint := Hint + 'This is a BIG hint!'+#13;
  79.   for I := 1 to 30 do
  80.   begin
  81.     Hint := Hint + 'abc - 0123456789 - 0123456789 - 0123456789 - 0123456789 - def';
  82.     if I <> 30 then
  83.       Hint := Hint + #13;
  84.   end;
  85.  
  86.   Regular1Click(Self);
  87. end;
  88.  
  89. procedure TForm1.FormDestroy(Sender: TObject);
  90. begin
  91.   HintWindow1.Free;
  92.   HintWindow2.Free;
  93. end;
  94.  
  95. procedure TForm1.TextTrayIcon1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  96. begin
  97.   LastMouse.X := X;
  98.   LastMouse.Y := Y;
  99. end;
  100.  
  101. procedure TForm1.Timer1Timer(Sender: TObject);
  102. var
  103.   HintRect: TRect;
  104. begin
  105.   Timer1.Enabled := False;
  106.   if (LastHint.X <> LastMouse.X) or (LastHint.Y <> LastMouse.Y) then
  107.   begin
  108.     if not Timer2.Enabled then
  109.     begin
  110.       HintRect := CurrentHintWindow.CalcHintRect(Screen.Width, Hint, nil);
  111.       CurrentHintWindow.ActivateHint(Rect(LastMouse.X - HintRect.Right,
  112.                LastMouse.Y - HintRect.Bottom, LastMouse.X, LastMouse.Y), Hint);
  113.     end;
  114.     LastHint.X := LastMouse.X;
  115.     LastHint.Y := LastMouse.Y;
  116.   end;
  117.   Timer2.Enabled := true;
  118. end;
  119.  
  120. procedure TForm1.Timer2Timer(Sender: TObject);
  121. begin
  122.   CurrentHintWindow.ReleaseHandle;
  123.   Timer2.Enabled := False;
  124. end;
  125.  
  126. procedure TForm1.Regular1Click(Sender: TObject);
  127. begin
  128.   Regular1.Checked := True;
  129.   CurrentHintWindow := HintWindow1;
  130. end;
  131.  
  132. procedure TForm1.Custom1Click(Sender: TObject);
  133. begin
  134.   Custom1.Checked := True;
  135.   CurrentHintWindow := HintWindow2;
  136. end;
  137.  
  138. procedure TForm1.Exit1Click(Sender: TObject);
  139. begin
  140.   Close;
  141. end;
  142.  
  143. procedure TForm1.TextTrayIcon1MouseExit(Sender: TObject);
  144. begin
  145.   CurrentHintWindow.ReleaseHandle;
  146.   Timer1.Enabled := False;
  147.   Timer2.Enabled := False;
  148.   Timer1.Interval := Application.HintPause;
  149.   Timer2.Interval := 5000;        // Seems to be the time a tooltip is open
  150. end;
  151.  
  152. procedure TForm1.TextTrayIcon1MouseEnter(Sender: TObject);
  153. begin
  154.   if not Timer1.Enabled then
  155.     Timer1.Enabled := True;
  156. end;
  157.  
  158. procedure TForm1.Button1Click(Sender: TObject);
  159. begin
  160.   Exit1Click(Self);
  161. end;
  162.  
  163. {------------------ TTiledHintWindow ------------------}
  164.  
  165. constructor TTiledHintWindow.Create(AOwner: TComponent);
  166. var
  167.   H: HBITMAP;
  168. begin
  169.   inherited Create(AOwner);
  170.   Bmp := TBitmap.Create;
  171.   H := LoadBitmap(HINSTANCE, 'BACKGROUND');
  172.   Bmp.Handle := H;
  173. end;
  174.  
  175. destructor TTiledHintWindow.Destroy;
  176. begin
  177.   Bmp.Free;
  178.   inherited Destroy;
  179. end;
  180.  
  181. procedure TTiledHintWindow.Paint;
  182. var
  183.   R: TRect;
  184. begin
  185.   R := ClientRect;
  186.   Inc(R.Left, 2);
  187.   Inc(R.Top, 2);
  188.   TileImage(Bmp, R);
  189.   DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
  190.            DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  191. end;
  192.  
  193. procedure TTiledHintWindow.TileImage(Bitmap: TBitmap; R: TRect);
  194. var
  195.   X, Y: Integer;
  196. begin
  197.   try
  198.     for X := 0 to (R.Right-R.Left) div Bitmap.Width do
  199.       for Y := 0 to (R.Bottom-R.Top) div Bitmap.Height do
  200.         Canvas.Draw(X * Bitmap.Width, Y * Bitmap.Height, Bitmap);
  201.   finally
  202.   end;
  203. end;
  204.  
  205. end.
  206.  
  207.