程序图标的问题(50分)

飞沙 · 2003-11-29

怎么样使程序运行时，程序图标只出现在右下角，或者是不出现，更或者进程里也看不到， 最好开机就自动运行

mystudy · 2003-11-29

第三控件cooltrayicon 自动运行写注册表中的run

飞沙 · 2003-11-29

我要代码

wab · 2003-11-29

unit TrayIcon; interface uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,   StdCtrls, ExtCtrls; type   ENotifyIconError = class(Exception);   TTrayNotifyIcon = class(TComponent)   private     FDefaultIcon: THandle;     FIcon: TIcon;     FHideTask: Boolean;     FHint: string;     FIconVisible: Boolean;     FPopupMenu: TPopupMenu;     FOnClick: TNotifyEvent;     FOnDblClick: TNotifyEvent;     FNoShowClick: Boolean;     FTimer: TTimer;     Tnd: TNotifyIconData;     procedure SetIcon(Value: TIcon);     procedure SetHideTask(Value: Boolean);     procedure SetHint(Value: string);     procedure SetIconVisible(Value: Boolean);     procedure SetPopupMenu(Value: TPopupMenu);     procedure SendTrayMessage(Msg: DWORD; Flags: UINT);     function ActiveIconHandle: THandle;     procedure OnButtonTimer(Sender: TObject);   protected     procedure Loaded; override;     procedure LoadDefaultIcon; virtual;     procedure Notification(AComponent: TComponent;       Operation: TOperation); override;   public     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;   published     property Icon: TIcon read FIcon write SetIcon;     property HideTask: Boolean read FHideTask write SetHideTask default False;     property Hint: String read FHint write SetHint;     property IconVisible: Boolean read FIconVisible write SetIconVisible default False;     property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;     property OnClick: TNotifyEvent read FOnClick write FOnClick;     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;   end; procedure Register; implementation { TIconManager } { 处理"托盘消息" } type   TIconManager = class   private     FHWindow: HWnd;     procedure TrayWndProc(var Message: TMessage);   public     constructor Create;     destructor Destroy; override;     property HWindow: HWnd read FHWindow write FHWindow;   end; var   IconMgr: TIconManager;   DDGM_TRAYICON: Cardinal; constructor TIconManager.Create; begin   FHWindow := Classes.AllocateHWnd(TrayWndProc); end; destructor TIconManager.Destroy; begin   if FHWindow <> 0 then Classes.DeallocateHWnd(FHWindow);   inherited Destroy; end; procedure TIconManager.TrayWndProc(var Message: TMessage); { 用户自定义消息,用来处理托盘图标与组件之间的消息. } var   Pt: TPoint;   TheIcon: TTrayNotifyIcon; begin   with Message do   begin     if (Msg = DDGM_TRAYICON) then     begin       TheIcon := TTrayNotifyIcon(WParam);       case lParam of         WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;         WM_LBUTTONDBLCLK:           begin             TheIcon.FNoShowClick := True;             if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);           end;         WM_RBUTTONDOWN:           begin             if Assigned(TheIcon.FPopupMenu) then             begin               SetForegroundWindow(IconMgr.HWindow);               GetCursorPos(Pt);               TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);               //TheIcon.FPopupMenu.Popup(LParamLo,LParamHi);               PostMessage(IconMgr.HWindow, WM_USER, 0, 0);             end;           end;       end;     end     else       Result := DefWindowProc(FHWindow, Msg, wParam, lParam);   end; end; { TTrayNotifyIcon } constructor TTrayNotifyIcon.Create(AOwner: TComponent); begin   inherited Create(AOwner);   FIcon := TIcon.Create;   FTimer := TTimer.Create(Self);   with FTimer do   begin     Enabled := False;     Interval := GetDoubleClickTime;     OnTimer := OnButtonTimer;   end;   LoadDefaultIcon; end; destructor TTrayNotifyIcon.Destroy; begin   if FIconVisible then SetIconVisible(False);   FIcon.Free;   FTimer.Free;   inherited Destroy; end; function TTrayNotifyIcon.ActiveIconHandle: THandle; begin   if (FIcon.Handle <> 0) then     Result := FIcon.Handle   else     Result := FDefaultIcon; end; procedure TTrayNotifyIcon.LoadDefaultIcon; begin   FDefaultIcon := LoadIcon(0, IDI_WINLOGO); end; procedure TTrayNotifyIcon.Loaded; begin   inherited Loaded;   if FIconVisible then     SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP); end; procedure TTrayNotifyIcon.Notification(AComponent: TComponent;   Operation: TOperation); begin   inherited Notification(AComponent, Operation);   if (Operation = opRemove) and (AComponent = PopupMenu) then     PopupMenu := nil; end; procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject); begin   FTimer.Enabled := False;   if (not FNoShowClick) and Assigned(FOnClick) then     FOnClick(Self);   FNoShowClick := False; end; procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT); begin   with Tnd do   begin     cbSize := SizeOf(Tnd);     StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));     uFlags := Flags;     uID := UINT(Self);     Wnd := IconMgr.HWindow;     uCallbackMessage := DDGM_TRAYICON;     hIcon  := ActiveIconHandle;   end;   Shell_NotifyIcon(Msg, @Tnd); end; procedure TTrayNotifyIcon.SetHideTask(Value: Boolean); const   ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide); begin   if FHideTask <> Value then   begin     FHideTask := Value;     if not (csDesigning in ComponentState) then       ShowWindow(Application.Handle, ShowArray[FHideTask]);   end; end; procedure TTrayNotifyIcon.SetHint(Value: string); begin   if FHint <> Value then   begin     FHint := Value;     if FIconVisible then       SendTrayMessage(NIM_MODIFY, NIF_TIP);   end; end; procedure TTrayNotifyIcon.SetIcon(Value: TIcon); begin   FIcon.Assign(Value);   if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON); end; procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean); const   MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD); begin   if FIconVisible <> Value then   begin     FIconVisible := Value;     SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);   end; end; procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu); begin   FPopupMenu := Value;   if Value <> nil then Value.FreeNotification(Self); end; procedure Register; begin   RegisterComponents('Extend', [TTrayNotifyIcon]); end; const   TrayMsgStr = 'DDG.TrayNotifyIconMsg'; initialization   DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);   IconMgr := TIconManager.Create; finalization   IconMgr.Free; end.

indexhome · 2003-11-29

你可以先定义一个TNotifyIconData的类型ServerStart1，不过先要USES SHELLAPI单元， 再用下面的填充结构：   serverStart1.cbSize:=Sizeof(TNotifyIconData);   serverStart1.Wnd:=self.Handle;   serverStart1.uID:=0;   ServerStart1.uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;   ServerStart1.uCallbackMessage:=Station_message;//这里是自定义消息   ServerStart1.hIcon:=icon1.Handle;//  这是你要显示图标的句柄   ServerStart1.szTip:='服务正在运行; 再调用Shell_NotifyIcon(NIM_Add,@ServerStart1);来显示在右下角 程序结束时用Shell_NotifyIcon(NIM_Delete,@ServerStart1);来删除 不想程序运行时出现在任务栏里可以用下面的API函数 ShowWindow(Application.Handle,SW_Hide);就可以了，

hongxing_dl · 2003-11-29

procedure TForm1.Button1Click(Sender: TObject); begin      if Edit1.Text='' then        begin         MessageBox(Handle,'应用程序名称不可以为空。','错误',MB_OK+MB_ICONERROR);         Exit;      end;      with TRegistry.Create;      try         RootKey:=HKEY_LOCAL_MACHINE;         if OpenKey('Software/Microsoft/Windows/CurrentVersion/Run',False) then            WriteString('StartUp1', Edit1.Text);   //如果是自己的程序，Edit1.Text改为ParamStr(0)就可以了         else            MessageBox(Handle,'打开注册表失败。','错误',MB_OK+MB_ICONERROR);      finally         CloseKey;         Free;      end; end; 详细请看： http://www.delphibbs.com/delphibbs/dispq.asp?lid=1158387

飞沙 · 2003-12-03

to hongxing_dl 写一个路径到注册表里有用吗，我试了，好像没什么作用哦 to indexhome   ShowWindow(Application.Handle,SW_Hide); 这句用了也不能在任务条中隐藏 ServerStart1.uCallbackMessage:=Station_message;//这里是自定义消息 上面一句的Station_message应该传什么值才能双击打右下角图标就打开程序啊，谢谢

shaga · 2003-12-03

怎么不用wab的？它的可以啊

f-h-s · 2003-12-03

不需要写什么注册表的 indexhome说的方法简单可行，只不过是没有说清楚 建议查一下：Shell_NotifyIcon 的在线帮助，很简单的

无头骑士 · 2003-12-03

自动运行，那就是写注册表了。 右下角的图标，当然是写代码或用第三方控件。 不出现在任务栏中要用到一个API函数。 代码发给你： 、//创建图标过程。 procedure TmainForm.modifytrayicon(action: dword); var NIData:TNotifyIconData; begin    with NIData do    begin    cbSize:=SIZEOF(TNotifyIconData);    uid:=0;    uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;    wnd:=Handle;    uCallbackMessage:=wm_trayicon;    hIcon:=Application.Icon.Handle;    StrPCopy(szTip,Application.Title);    end;    Shell_NotifyIcon(Action,@nidata); end; //调用创建图标过程 procedure TmainForm.FormCreate(Sender: TObject); begin modifytrayicon(NIM_ADD); Image1.Left:=0; Image1.Top:=0; Image1.Stretch:=True; StatusBar1.Panels[0].Text:=pass.dd; end; //取消图标 procedure TmainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin if MessageDlg('确认要退出系统吗？',mtConfirmation,[mbOK,mbcancel],1)=mrok then begin modifytrayicon(NIM_DELETE); Action:=caFree; end else Action:=caNone; end

飞沙 · 2003-12-06

多人接受答案了。

程序图标的问题(50分)

飞沙

Unregistered / Unconfirmed

mystudy

Unregistered / Unconfirmed

飞沙

Unregistered / Unconfirmed

wab

Unregistered / Unconfirmed

indexhome

Unregistered / Unconfirmed

hongxing_dl

Unregistered / Unconfirmed

飞沙

Unregistered / Unconfirmed

shaga

Unregistered / Unconfirmed

f-h-s

Unregistered / Unconfirmed

无头骑士

Unregistered / Unconfirmed

飞沙

Unregistered / Unconfirmed

Similar threads