home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / kompon / d234567 / COOLTRAY.ZIP / CoolTrayTest / CtMain.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-12  |  8KB  |  327 lines
  1. unit CtMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Menus, ImgList, CoolTrayIcon;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Button1: TButton;
  12.     Button2: TButton;
  13.     Button3: TButton;
  14.     PopupMenu1: TPopupMenu;
  15.     ShowWindow1: TMenuItem;
  16.     HideWindow1: TMenuItem;
  17.     N1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     ImageList1: TImageList;
  20.     rdoCycle: TRadioGroup;
  21.     GroupBox1: TGroupBox;
  22.     Label1: TLabel;
  23.     Label2: TLabel;
  24.     GroupBox2: TGroupBox;
  25.     Label3: TLabel;
  26.     Edit1: TEdit;
  27.     CheckBox1: TCheckBox;
  28.     CheckBox2: TCheckBox;
  29.     CheckBox3: TCheckBox;
  30.     CheckBox4: TCheckBox;
  31.     CheckBox5: TCheckBox;
  32.     CheckBox6: TCheckBox;
  33.     Label7: TLabel;
  34.     ComboBox1: TComboBox;
  35.     TrayIcon1: TCoolTrayIcon;
  36.     Edit2: TEdit;
  37.     Label4: TLabel;
  38.     ImageList2: TImageList;
  39.     ImageList3: TImageList;
  40.     ImageList4: TImageList;
  41.     ImageList5: TImageList;
  42.     ImageList6: TImageList;
  43.     Button4: TButton;
  44.     N2: TMenuItem;
  45.     BalloonHint1: TMenuItem;
  46.     GroupBox3: TGroupBox;
  47.     Label5: TLabel;
  48.     Label6: TLabel;
  49.     Button5: TButton;
  50.     Button6: TButton;
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure ShowWindow1Click(Sender: TObject);
  53.     procedure HideWindow1Click(Sender: TObject);
  54.     procedure Exit1Click(Sender: TObject);
  55.     procedure Button1Click(Sender: TObject);
  56.     procedure Button2Click(Sender: TObject);
  57.     procedure Edit1Change(Sender: TObject);
  58.     procedure CheckBox1Click(Sender: TObject);
  59.     procedure CheckBox2Click(Sender: TObject);
  60.     procedure TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
  61.       Shift: TShiftState; X, Y: Integer);
  62.     procedure TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
  63.       X, Y: Integer);
  64.     procedure CheckBox3Click(Sender: TObject);
  65.     procedure CheckBox4Click(Sender: TObject);
  66.     procedure CheckBox5Click(Sender: TObject);
  67.     procedure ComboBox1Change(Sender: TObject);
  68.     procedure rdoCycleClick(Sender: TObject);
  69.     procedure TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
  70.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  71.     procedure Button4Click(Sender: TObject);
  72.     procedure TrayIcon1MouseExit(Sender: TObject);
  73.     procedure TrayIcon1MouseEnter(Sender: TObject);
  74.     procedure TrayIcon1Startup(Sender: TObject; var ShowMainForm: Boolean);
  75.     procedure TrayIcon1BalloonHintClick(Sender: TObject);
  76.     procedure Button5Click(Sender: TObject);
  77.     procedure Button6Click(Sender: TObject);
  78.   private
  79.     // Some extra stuff necessary for the "Close to tray" option:
  80.     SessionEnding: Boolean;
  81.     procedure WMQueryEndSession(var Message: TMessage); message WM_QUERYENDSESSION;
  82.   end;
  83.  
  84. var
  85.   MainForm: TMainForm;
  86.  
  87. implementation
  88.  
  89. {$R *.DFM}
  90.  
  91. procedure TMainForm.FormCreate(Sender: TObject);
  92. begin
  93.   Edit1Change(Self);
  94.   CheckBox1Click(Self);
  95.   CheckBox2Click(Self);
  96.   CheckBox3Click(Self);
  97.   CheckBox4Click(Self);
  98.   CheckBox5Click(Self);
  99.   rdoCycleClick(Self);
  100. end;
  101.  
  102.  
  103. procedure TMainForm.ShowWindow1Click(Sender: TObject);
  104. begin
  105.   TrayIcon1.ShowMainForm;   // ALWAYS use this method!!!
  106. end;
  107.  
  108.  
  109. procedure TMainForm.HideWindow1Click(Sender: TObject);
  110. begin
  111.   TrayIcon1.HideMainForm;
  112. end;
  113.  
  114.  
  115. procedure TMainForm.Exit1Click(Sender: TObject);
  116. begin
  117.   Close;
  118. end;
  119.  
  120.  
  121. procedure TMainForm.Button1Click(Sender: TObject);
  122. begin
  123.   TrayIcon1.HideMainForm;
  124. end;
  125.  
  126.  
  127. procedure TMainForm.Button2Click(Sender: TObject);
  128. begin
  129.   TrayIcon1.IconVisible := not TrayIcon1.IconVisible;
  130. end;
  131.  
  132.  
  133. procedure TMainForm.Button6Click(Sender: TObject);
  134. begin
  135.   if IsWindowVisible(Application.Handle) then
  136.     TrayIcon1.HideTaskbarIcon
  137.   else
  138.     TrayIcon1.ShowTaskbarIcon;
  139. end;
  140.  
  141.  
  142. procedure TMainForm.Button4Click(Sender: TObject);
  143. begin
  144.   TrayIcon1.ShowBalloonHint('Balloon hint',
  145.         'Use the balloon hint to display important information.' + #13 +
  146.         'The text can be max. 255 chars. and the title max. 64 chars.',
  147.         bitInfo, 10);
  148. end;
  149.  
  150.  
  151. procedure TMainForm.Button5Click(Sender: TObject);
  152. begin
  153.   TrayIcon1.HideBalloonHint;
  154. end;
  155.  
  156.  
  157. procedure TMainForm.Edit1Change(Sender: TObject);
  158. begin
  159.   TrayIcon1.Hint := Edit1.Text;
  160. end;
  161.  
  162.  
  163. procedure TMainForm.CheckBox1Click(Sender: TObject);
  164. begin
  165.   TrayIcon1.ShowHint := CheckBox1.Checked;
  166. end;
  167.  
  168.  
  169. procedure TMainForm.CheckBox2Click(Sender: TObject);
  170. begin
  171.   if Assigned(PopupMenu1) then
  172.     PopupMenu1.AutoPopup := CheckBox2.Checked;
  173. end;
  174.  
  175.  
  176. procedure TMainForm.CheckBox3Click(Sender: TObject);
  177. begin
  178.   TrayIcon1.LeftPopup := CheckBox3.Checked;
  179. end;
  180.  
  181.  
  182. procedure TMainForm.CheckBox4Click(Sender: TObject);
  183. begin
  184.   TrayIcon1.Enabled := CheckBox4.Checked;
  185. end;
  186.  
  187.  
  188. procedure TMainForm.CheckBox5Click(Sender: TObject);
  189. begin
  190.   TrayIcon1.MinimizeToTray := CheckBox5.Checked;
  191. end;
  192.  
  193.  
  194. procedure TMainForm.ComboBox1Change(Sender: TObject);
  195. begin
  196.   TrayIcon1.Behavior := TBehavior(ComboBox1.ItemIndex);
  197. end;
  198.  
  199.  
  200. procedure TMainForm.TrayIcon1MouseDown(Sender: TObject;
  201.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  202. begin
  203.   if Assigned(PopupMenu1) then
  204.     if not PopupMenu1.AutoPopup then
  205.     begin
  206.       SetForegroundWindow(Application.Handle);  // Move focus from tray icon to this form
  207.       MessageDlg('The popup menu is disabled.', mtInformation, [mbOk], 0);
  208.     end;
  209. end;
  210.  
  211.  
  212. procedure TMainForm.TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
  213.   X, Y: Integer);
  214. var
  215.   Pt: TPoint;
  216. begin
  217.   Label1.Caption := 'Mouse pos.: ' + IntToStr(X) + ',' + IntToStr(Y);
  218.   Label2.Caption := 'Key status: ';
  219.   if ssCtrl in Shift then
  220.     Label2.Caption := Label2.Caption + ' Ctrl ';
  221.   if ssAlt in Shift then
  222.     Label2.Caption := Label2.Caption + ' Alt ';
  223.   if ssShift in Shift then
  224.     Label2.Caption := Label2.Caption + ' Shift ';
  225.   // Get client coords.
  226.   Pt := TrayIcon1.GetClientIconPos(X, Y);
  227.   Label6.Caption := 'Client pos.: ' + IntToStr(Pt.X) + ',' + IntToStr(Pt.Y);
  228. end;
  229.  
  230.  
  231. procedure TMainForm.rdoCycleClick(Sender: TObject);
  232. begin
  233.   case rdoCycle.ItemIndex of
  234.     0: begin
  235.       TrayIcon1.CycleIcons := False;
  236.       TrayIcon1.IconList := nil;
  237.       ImageList1.GetIcon(0, TrayIcon1.Icon);
  238.       Edit2.Text := IntToStr(TrayIcon1.IconIndex);
  239.     end;
  240.     1: begin
  241.       TrayIcon1.IconList := ImageList1;
  242.       TrayIcon1.CycleInterval := 400;
  243.       TrayIcon1.CycleIcons := True;
  244.     end;
  245.     2: begin
  246.       TrayIcon1.IconList := ImageList2;
  247.       TrayIcon1.CycleInterval := 400;
  248.       TrayIcon1.CycleIcons := True;
  249.     end;
  250.     3: begin
  251.       TrayIcon1.IconList := ImageList3;
  252.       TrayIcon1.CycleInterval := 300;
  253.       TrayIcon1.CycleIcons := True;
  254.     end;
  255.     4: begin
  256.       TrayIcon1.IconList := ImageList4;
  257.       TrayIcon1.CycleInterval := 100;
  258.       TrayIcon1.CycleIcons := True;
  259.     end;
  260.     5: begin
  261.       TrayIcon1.IconList := ImageList5;
  262.       TrayIcon1.CycleInterval := 400;
  263.       TrayIcon1.CycleIcons := True;
  264.     end;
  265.     6: begin
  266.       TrayIcon1.IconList := ImageList6;
  267.       TrayIcon1.CycleInterval := 100;
  268.       TrayIcon1.CycleIcons := True;
  269.     end;
  270.   end;
  271. end;
  272.  
  273.  
  274. procedure TMainForm.TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
  275. begin
  276.   Edit2.Text := IntToStr(TrayIcon1.IconIndex);
  277. end;
  278.  
  279.  
  280. procedure TMainForm.WMQueryEndSession(var Message: TMessage);
  281. { This method is a hack. It intercepts the WM_QUERYENDSESSION message.
  282.   This way we can decide if we want to ignore the "Close to tray" option.
  283.   Otherwise, when selected, the option makes Windows unable to shut down. }
  284. begin
  285.   SessionEnding := True;
  286.   Message.Result := 1;
  287. end;
  288.  
  289.  
  290. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  291. begin
  292.   CanClose := ((not CheckBox6.Checked) or SessionEnding);
  293.   if not CanClose then
  294.   begin
  295.     TrayIcon1.HideMainForm;
  296.     TrayIcon1.IconVisible := True;
  297.   end;
  298. end;
  299.  
  300.  
  301. procedure TMainForm.TrayIcon1MouseEnter(Sender: TObject);
  302. begin
  303.   Label5.Caption := 'ENTER';
  304. end;
  305.  
  306.  
  307. procedure TMainForm.TrayIcon1MouseExit(Sender: TObject);
  308. begin
  309.   Label5.Caption := 'EXIT';
  310. end;
  311.  
  312.  
  313. procedure TMainForm.TrayIcon1Startup(Sender: TObject; var ShowMainForm: Boolean);
  314. begin
  315. //  ShowMainForm := False;
  316. end;
  317.  
  318.  
  319. procedure TMainForm.TrayIcon1BalloonHintClick(Sender: TObject);
  320. begin
  321.   SetForegroundWindow(Application.Handle);  // Move focus from tray icon to this form
  322.   ShowMessage('POP!');
  323. end;
  324.  
  325. end.
  326.  
  327.