home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / kompon / d234567 / COOLTRAY.ZIP / CustomHint1 / Main.pas < prev   
Pascal/Delphi Source File  |  2002-04-07  |  3KB  |  108 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, ImgList, CoolTrayIcon, Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     CoolTrayIcon1: TCoolTrayIcon;
  12.     PopupMenu1: TPopupMenu;
  13.     Exit1: TMenuItem;
  14.     Label1: TLabel;
  15.     Button1: TButton;
  16.     Label2: TLabel;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormDestroy(Sender: TObject);
  19.     procedure Loaded; override;
  20.     procedure CoolTrayIcon1MouseEnter(Sender: TObject);
  21.     procedure CoolTrayIcon1MouseExit(Sender: TObject);
  22.     procedure Exit1Click(Sender: TObject);
  23.     procedure Button1Click(Sender: TObject);
  24.   private
  25.     HTooltip: HWND;
  26.     CustomFont: TFont;
  27.     BackColor, TextColor: COLORREF;
  28.   end;
  29.  
  30. const
  31.   // Tooltip constants
  32.   TTM_SETMAXTIPWIDTH = (WM_USER + 24);
  33.   TTM_SETTIPBKCOLOR = (WM_USER + 19);
  34.   TTM_SETTIPTEXTCOLOR = (WM_USER + 20);
  35.   TTM_SETTITLEA = (WM_USER + 32);
  36.  
  37. var
  38.   Form1: TForm1;
  39.  
  40. implementation
  41.  
  42. {$R *.DFM}
  43.  
  44. procedure TForm1.FormCreate(Sender: TObject);
  45. begin
  46.   CustomFont := TFont.Create;
  47.   CustomFont.Size := 14;
  48.   CustomFont.Name := 'Verdana';
  49.   BackColor := RGB(0, 0, 255);
  50.   TextColor := RGB(255, 255, 0);
  51. end;
  52.  
  53.  
  54. procedure TForm1.FormDestroy(Sender: TObject);
  55. begin
  56.   CustomFont.Free;
  57. end;
  58.  
  59.  
  60. procedure TForm1.Loaded;
  61. begin
  62.   inherited;
  63.   HTooltip := CoolTrayIcon1.GetTooltipHandle;
  64. end;
  65.  
  66.  
  67. procedure TForm1.CoolTrayIcon1MouseEnter(Sender: TObject);
  68. begin
  69.   if HTooltip = 0 then
  70.     Exit;
  71.   // Set colors
  72.   SendMessage(HTooltip, TTM_SETTIPBKCOLOR, BackColor, 0);
  73.   SendMessage(HTooltip, TTM_SETTIPTEXTCOLOR, TextColor, 0);
  74.   // Set max width
  75. //  SendMessage(HTooltip, TTM_SETMAXTIPWIDTH, 0, 999);       //???
  76.   // Set font
  77.   SendMessage(HTooltip, WM_SETFONT, CustomFont.Handle, 0);
  78. end;
  79.  
  80.  
  81. procedure TForm1.CoolTrayIcon1MouseExit(Sender: TObject);
  82. begin
  83.   if HTooltip = 0 then
  84.     Exit;
  85.   // Close tooltip immediately (by moving it off-screen)
  86.   SetWindowPos(HTooltip, 0, -500, -500, 0, 0, SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOSIZE);
  87.   // Reset tooltip properties to defaults
  88.   SendMessage(HTooltip, TTM_SETMAXTIPWIDTH, 0, -1);
  89.   SendMessage(HTooltip, WM_SETFONT, 0, 0);
  90.   SendMessage(HTooltip, TTM_SETTIPBKCOLOR, GetSysColor(COLOR_INFOBK), 0);
  91.   SendMessage(HTooltip, TTM_SETTIPTEXTCOLOR, GetSysColor(COLOR_INFOTEXT), 0);
  92. end;
  93.  
  94.  
  95. procedure TForm1.Exit1Click(Sender: TObject);
  96. begin
  97.   Close;
  98. end;
  99.  
  100.  
  101. procedure TForm1.Button1Click(Sender: TObject);
  102. begin
  103.   Exit1Click(Self);
  104. end;
  105.  
  106. end.
  107.  
  108.