开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
CtMain.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：9k
源码类别：

Delphi控件源码

开发平台：

Delphi

CtMain.pas：源码内容
  1. unit CtMain;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Menus, ImgList, CoolTrayIcon;
  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.     ImageList7: TImageList;
  52.     procedure FormCreate(Sender: TObject);
  53.     procedure ShowWindow1Click(Sender: TObject);
  54.     procedure HideWindow1Click(Sender: TObject);
  55.     procedure Exit1Click(Sender: TObject);
  56.     procedure Button1Click(Sender: TObject);
  57.     procedure Button2Click(Sender: TObject);
  58.     procedure Edit1Change(Sender: TObject);
  59.     procedure CheckBox1Click(Sender: TObject);
  60.     procedure CheckBox2Click(Sender: TObject);
  61.     procedure TrayIcon1MouseDown(Sender: TObject; Button: TMouseButton;
  62.       Shift: TShiftState; X, Y: Integer);
  63.     procedure TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
  64.       X, Y: Integer);
  65.     procedure CheckBox3Click(Sender: TObject);
  66.     procedure CheckBox4Click(Sender: TObject);
  67.     procedure CheckBox5Click(Sender: TObject);
  68.     procedure ComboBox1Change(Sender: TObject);
  69.     procedure rdoCycleClick(Sender: TObject);
  70.     procedure TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
  71.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  72.     procedure Button4Click(Sender: TObject);
  73.     procedure TrayIcon1MouseExit(Sender: TObject);
  74.     procedure TrayIcon1MouseEnter(Sender: TObject);
  75.     procedure TrayIcon1Startup(Sender: TObject; var ShowMainForm: Boolean);
  76.     procedure TrayIcon1BalloonHintClick(Sender: TObject);
  77.     procedure Button5Click(Sender: TObject);
  78.     procedure Button6Click(Sender: TObject);
  79.   private
  80.     // Some extra stuff necessary for the "Close to tray" option:
  81.     SessionEnding: Boolean;
  82.     procedure WMQueryEndSession(var Message: TMessage); message WM_QUERYENDSESSION;
  83.   end;
  85. var
  86.   MainForm: TMainForm;
  88. implementation
  90. {$R *.DFM}
  92. procedure TMainForm.FormCreate(Sender: TObject);
  93. begin
  94.   Edit1Change(Self);
  95.   CheckBox1Click(Self);
  96.   CheckBox2Click(Self);
  97.   CheckBox3Click(Self);
  98.   CheckBox4Click(Self);
  99.   CheckBox5Click(Self);
  100.   rdoCycleClick(Self);
  101.   ComboBox1.ItemIndex := 0;
  102. end;
  105. procedure TMainForm.ShowWindow1Click(Sender: TObject);
  106. begin
  107.   TrayIcon1.ShowMainForm;    // ALWAYS use this method!!!
  108. end;
  111. procedure TMainForm.HideWindow1Click(Sender: TObject);
  112. begin
  113.   Application.Minimize;      // Will hide dialogs and popup windows as well (this demo has none)
  114.   TrayIcon1.HideMainForm;
  115. end;
  118. procedure TMainForm.Exit1Click(Sender: TObject);
  119. begin
  120.   // We kill the "Close to tray" feature to be able to exit.
  121.   if CheckBox6.Checked then
  122.     CheckBox6.Checked := False;
  123.   Close;
  124. end;
  127. procedure TMainForm.Button1Click(Sender: TObject);
  128. begin
  129.   HideWindow1Click(Self);
  130. end;
  133. procedure TMainForm.Button2Click(Sender: TObject);
  134. begin
  135.   TrayIcon1.IconVisible := not TrayIcon1.IconVisible;
  136. end;
  139. procedure TMainForm.Button6Click(Sender: TObject);
  140. begin
  141.   if IsWindowVisible(Application.Handle) then
  142.     TrayIcon1.HideTaskbarIcon
  143.   else
  144.     TrayIcon1.ShowTaskbarIcon;
  145. end;
  148. procedure TMainForm.Button4Click(Sender: TObject);
  149. begin
  150.   TrayIcon1.ShowBalloonHint('Balloon hint',
  151.         'Use the balloon hint to display important information.' + #13 +
  152.         'The text can be max. 255 chars. and the title max. 64 chars.',
  153.         bitInfo, 10);
  154. end;
  157. procedure TMainForm.Button5Click(Sender: TObject);
  158. begin
  159.   TrayIcon1.HideBalloonHint;
  160. end;
  163. procedure TMainForm.Edit1Change(Sender: TObject);
  164. begin
  165.   TrayIcon1.Hint := Edit1.Text;
  166. end;
  169. procedure TMainForm.CheckBox1Click(Sender: TObject);
  170. begin
  171.   TrayIcon1.ShowHint := CheckBox1.Checked;
  172. end;
  175. procedure TMainForm.CheckBox2Click(Sender: TObject);
  176. begin
  177.   if Assigned(PopupMenu1) then
  178.     PopupMenu1.AutoPopup := CheckBox2.Checked;
  179. end;
  182. procedure TMainForm.CheckBox3Click(Sender: TObject);
  183. begin
  184.   TrayIcon1.LeftPopup := CheckBox3.Checked;
  185. end;
  188. procedure TMainForm.CheckBox4Click(Sender: TObject);
  189. begin
  190.   TrayIcon1.Enabled := CheckBox4.Checked;
  191. end;
  194. procedure TMainForm.CheckBox5Click(Sender: TObject);
  195. begin
  196.   TrayIcon1.MinimizeToTray := CheckBox5.Checked;
  197. end;
  200. procedure TMainForm.ComboBox1Change(Sender: TObject);
  201. begin
  202.   TrayIcon1.Behavior := TBehavior(ComboBox1.ItemIndex);
  203. end;
  206. procedure TMainForm.TrayIcon1MouseDown(Sender: TObject;
  207.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  208. begin
  209.   if Assigned(PopupMenu1) then
  210.     if not PopupMenu1.AutoPopup then
  211.     begin
  212.       SetForegroundWindow(Application.Handle);  // Move focus from tray icon to this form
  213.       MessageDlg('The popup menu is disabled.', mtInformation, [mbOk], 0);
  214.     end;
  215. end;
  218. procedure TMainForm.TrayIcon1MouseMove(Sender: TObject; Shift: TShiftState;
  219.   X, Y: Integer);
  220. var
  221.   Pt: TPoint;
  222. begin
  223.   Label1.Caption := 'Mouse pos.: ' + IntToStr(X) + ',' + IntToStr(Y);
  224.   Label2.Caption := 'Key status: ';
  225.   if ssCtrl in Shift then
  226.     Label2.Caption := Label2.Caption + ' Ctrl ';
  227.   if ssAlt in Shift then
  228.     Label2.Caption := Label2.Caption + ' Alt ';
  229.   if ssShift in Shift then
  230.     Label2.Caption := Label2.Caption + ' Shift ';
  231.   // Get client coords.
  232.   Pt := TrayIcon1.GetClientIconPos(X, Y);
  233.   Label6.Caption := 'Client pos.: ' + IntToStr(Pt.X) + ',' + IntToStr(Pt.Y);
  234. end;
  237. procedure TMainForm.rdoCycleClick(Sender: TObject);
  238. begin
  239.   case rdoCycle.ItemIndex of
  240.     0: begin
  241.       TrayIcon1.CycleIcons := False;
  242.       TrayIcon1.IconList := nil;
  243.       ImageList1.GetIcon(0, TrayIcon1.Icon);
  244.       Edit2.Text := IntToStr(TrayIcon1.IconIndex);
  245.     end;
  246.     1: begin
  247.       TrayIcon1.IconList := ImageList1;
  248.       TrayIcon1.CycleInterval := 400;
  249.       TrayIcon1.CycleIcons := True;
  250.     end;
  251.     2: begin
  252.       TrayIcon1.IconList := ImageList2;
  253.       TrayIcon1.CycleInterval := 400;
  254.       TrayIcon1.CycleIcons := True;
  255.     end;
  256.     3: begin
  257.       TrayIcon1.IconList := ImageList3;
  258.       TrayIcon1.CycleInterval := 300;
  259.       TrayIcon1.CycleIcons := True;
  260.     end;
  261.     4: begin
  262.       TrayIcon1.IconList := ImageList4;
  263.       TrayIcon1.CycleInterval := 100;
  264.       TrayIcon1.CycleIcons := True;
  265.     end;
  266.     5: begin
  267.       TrayIcon1.IconList := ImageList5;
  268.       TrayIcon1.CycleInterval := 400;
  269.       TrayIcon1.CycleIcons := True;
  270.     end;
  271.     6: begin
  272.       TrayIcon1.IconList := ImageList6;
  273.       TrayIcon1.CycleInterval := 100;
  274.       TrayIcon1.CycleIcons := True;
  275.     end;
  276.     7: begin
  277.       TrayIcon1.IconList := ImageList7;
  278.       TrayIcon1.CycleInterval := 150;
  279.       TrayIcon1.CycleIcons := True;
  280.     end;
  281.   end;
  282. end;
  285. procedure TMainForm.TrayIcon1Cycle(Sender: TObject; NextIndex: Integer);
  286. begin
  287.   Edit2.Text := IntToStr(TrayIcon1.IconIndex);
  288. end;
  291. procedure TMainForm.WMQueryEndSession(var Message: TMessage);
  292. { This method is a hack. It intercepts the WM_QUERYENDSESSION message.
  293.   This way we can decide if we want to ignore the "Close to tray" option.
  294.   Otherwise, when selected, the option would make Windows unable to shut down. }
  295. begin
  296.   SessionEnding := True;
  297.   Message.Result := 1;
  298. end;
  301. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  302. begin
  303.   CanClose := ((not CheckBox6.Checked) or SessionEnding);
  304.   if not CanClose then
  305.   begin
  306.     TrayIcon1.HideMainForm;
  307.     TrayIcon1.IconVisible := True;
  308.   end;
  309. end;
  312. procedure TMainForm.TrayIcon1MouseEnter(Sender: TObject);
  313. begin
  314.   Label5.Caption := 'ENTER';
  315. end;
  318. procedure TMainForm.TrayIcon1MouseExit(Sender: TObject);
  319. begin
  320.   Label5.Caption := 'EXIT';
  321. end;
  324. procedure TMainForm.TrayIcon1Startup(Sender: TObject; var ShowMainForm: Boolean);
  325. begin
  326. //  ShowMainForm := False;
  327. end;
  330. procedure TMainForm.TrayIcon1BalloonHintClick(Sender: TObject);
  331. begin
  332.   SetForegroundWindow(Application.Handle);  // Move focus from tray icon to this form
  333.   ShowMessage('POP!');
  334. end;
  336. end.