home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / ChipCD_1.03.iso / zkuste / delphi / kompon / d23456 / COOLTRAY.ZIP / demos / CoolTrayTest / CtMain.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-21  |  9KB  |  328 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.   Application.Minimize;      // Will hide dialogs and popup windows as well (this demo has none)
  112.   TrayIcon1.HideMainForm;
  113. end;
  114.  
  115.  
  116. procedure TMainForm.Exit1Click(Sender: TObject);
  117. begin
  118.   Close;
  119. end;
  120.  
  121.  
  122. procedure TMainForm.Button1Click(Sender: TObject);
  123. begin
  124.   HideWindow1Click(Self);
  125. end;
  126.  
  127.  
  128. procedure TMainForm.Button2Click(Sender: TObject);
  129. begin
  130.   TrayIcon1.IconVisible := not TrayIcon1.IconVisible;
  131. end;
  132.  
  133.  
  134. procedure TMainForm.Button6Click(Sender: TObject);
  135. begin
  136.   if IsWindowVisible(Application.Handle) then
  137.     TrayIcon1.HideTaskbarIcon
  138.   else
  139.     TrayIcon1.ShowTaskbarIcon;
  140. end;
  141.  
  142.  
  143. procedure TMainForm.Button4Click(Sender: TObject);
  144. begin
  145.   TrayIcon1.ShowBalloonHint('Balloon hint',
  146.         'Use the balloon hint to display important information.' + #13 +
  147.         'The text can be max. 255 chars. and the title max. 64 chars.',
  148.         bitInfo, 10);
  149. end;
  150.  
  151.  
  152. procedure TMainForm.Button5Click(Sender: TObject);
  153. begin
  154.   TrayIcon1.HideBalloonHint;
  155. end;
  156.  
  157.  
  158. procedure TMainForm.Edit1Change(Sender: TObject);
  159. begin
  160.   TrayIcon1.Hint := Edit1.Text;
  161. end;
  162.  
  163.  
  164. procedure TMainForm.CheckBox1Click(Sender: TObject);
  165. begin
  166.   TrayIcon1.ShowHint := CheckBox1.Checked;
  167. end;
  168.  
  169.  
  170. procedure TMainForm.CheckBox2Click(Sender: TObject);
  171. begin
  172.   if Assigned(PopupMenu1) then
  173.     PopupMenu1.AutoPopup := CheckBox2.Checked;
  174. end;
  175.  
  176.  
  177. procedure TMainForm.CheckBox3Click(Sender: TObject);
  178. begin
  179.   TrayIcon1.LeftPopup := CheckBox3.Checked;
  180. end;
  181.  
  182.  
  183. procedure TMainForm.CheckBox4Click(Sender: TObject);
  184. begin
  185.   TrayIcon1.Enabled := CheckBox4.Checked;
  186. end;
  187.  
  188.  
  189. procedure TMainForm.CheckBox5Click(Sender: TObject);
  190. begin
  191.   TrayIcon1.MinimizeToTray := CheckBox5.Checked;
  192. end;
  193.  
  194.  
  195. procedure TMainForm.ComboBox1Change(Sender: TObject);
  196. begin
  197.   TrayIcon1.Behavior := TBehavior(ComboBox1.ItemIndex);
  198. end;
  199.  
  200.  
  201. procedure TMainForm.TrayIcon1MouseDown(Sender: TObject;
  202.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  203. begin
  204.   if Assigned(PopupMenu1) then
  205.     if not PopupMenu1.AutoPopup then
  206.     begin
  207.       SetForegroundWindow(Application.Handle);  // Move focus from tray icon to this form
  208.       MessageDlg('The popup menu is disabled.', mtInformation, [mbOk], 0);
  209.     end;
  210. end;
  211.  
  212.  
  213. procedure TMainForm.TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
  214.   X, Y: Integer);
  215. var
  216.   Pt: TPoint;
  217. begin
  218.   Label1.Caption := 'Mouse pos.: ' + IntToStr(X) + ',' + IntToStr(Y);
  219.   Label2.Caption := 'Key status: ';
  220.   if ssCtrl in Shift then
  221.     Label2.Caption := Label2.Caption + ' Ctrl ';
  222.   if ssAlt in Shift then
  223.     Label2.Caption := Label2.Caption + ' Alt ';
  224.   if ssShift in Shift then
  225.     Label2.Caption := Label2.Caption + ' Shift ';
  226.   // Get client coords.
  227.   Pt := TrayIcon1.GetClientIconPos(X, Y);
  228.   Label6.Caption := 'Client pos.: ' + IntToStr(Pt.X) + ',' + IntToStr(Pt.Y);
  229. end;
  230.  
  231.  
  232. procedure TMainForm.rdoCycleClick(Sender: TObject);
  233. begin
  234.   case rdoCycle.ItemIndex of
  235.     0: begin
  236.       TrayIcon1.CycleIcons := False;
  237.       TrayIcon1.IconList := nil;
  238.       ImageList1.GetIcon(0, TrayIcon1.Icon);
  239.       Edit2.Text := IntToStr(TrayIcon1.IconIndex);
  240.     end;
  241.     1: begin
  242.       TrayIcon1.IconList := ImageList1;
  243.       TrayIcon1.CycleInterval := 400;
  244.       TrayIcon1.CycleIcons := True;
  245.     end;
  246.     2: begin
  247.       TrayIcon1.IconList := ImageList2;
  248.       TrayIcon1.CycleInterval := 400;
  249.       TrayIcon1.CycleIcons := True;
  250.     end;
  251.     3: begin
  252.       TrayIcon1.IconList := ImageList3;
  253.       TrayIcon1.CycleInterval := 300;
  254.       TrayIcon1.CycleIcons := True;
  255.     end;
  256.     4: begin
  257.       TrayIcon1.IconList := ImageList4;
  258.       TrayIcon1.CycleInterval := 100;
  259.       TrayIcon1.CycleIcons := True;
  260.     end;
  261.     5: begin
  262.       TrayIcon1.IconList := ImageList5;
  263.       TrayIcon1.CycleInterval := 400;
  264.       TrayIcon1.CycleIcons := True;
  265.     end;
  266.     6: begin
  267.       TrayIcon1.IconList := ImageList6;
  268.       TrayIcon1.CycleInterval := 100;
  269.       TrayIcon1.CycleIcons := True;
  270.     end;
  271.   end;
  272. end;
  273.  
  274.  
  275. procedure TMainForm.TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
  276. begin
  277.   Edit2.Text := IntToStr(TrayIcon1.IconIndex);
  278. end;
  279.  
  280.  
  281. procedure TMainForm.WMQueryEndSession(var Message: TMessage);
  282. { This method is a hack. It intercepts the WM_QUERYENDSESSION message.
  283.   This way we can decide if we want to ignore the "Close to tray" option.
  284.   Otherwise, when selected, the option makes Windows unable to shut down. }
  285. begin
  286.   SessionEnding := True;
  287.   Message.Result := 1;
  288. end;
  289.  
  290.  
  291. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  292. begin
  293.   CanClose := ((not CheckBox6.Checked) or SessionEnding);
  294.   if not CanClose then
  295.   begin
  296.     TrayIcon1.HideMainForm;
  297.     TrayIcon1.IconVisible := True;
  298.   end;
  299. end;
  300.  
  301.  
  302. procedure TMainForm.TrayIcon1MouseEnter(Sender: TObject);
  303. begin
  304.   Label5.Caption := 'ENTER';
  305. end;
  306.  
  307.  
  308. procedure TMainForm.TrayIcon1MouseExit(Sender: TObject);
  309. begin
  310.   Label5.Caption := 'EXIT';
  311. end;
  312.  
  313.  
  314. procedure TMainForm.TrayIcon1Startup(Sender: TObject; var ShowMainForm: Boolean);
  315. begin
  316. //  ShowMainForm := False;
  317. end;
  318.  
  319.  
  320. procedure TMainForm.TrayIcon1BalloonHintClick(Sender: TObject);
  321. begin
  322.   SetForegroundWindow(Application.Handle);  // Move focus from tray icon to this form
  323.   ShowMessage('POP!');
  324. end;
  325.  
  326. end.
  327.  
  328.