誰有代碼：把程式縮成圖標放在右下角，給50分，不會少了。

Question

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ShellAPI,
  StdCtrls, Menus;const
  WM_TRAYNOTIFY = WM_USER+100;type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure TrayNotifyMessage(var Sender: TMessage); message WM_TRAYNOTIFY;
    procedure MarkTaskBarIcon(Sender: TObject);
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  tnd : TNOTIFYICONDATA;
implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
begin
   Application.OnMinimize := MarkTaskBarIcon;
end;procedure TForm1.MarkTaskBarIcon(Sender: TObject);
begin
   Form1.Visible := False;
   tnd.cbSize := sizeof(tnd);
   tnd.Wnd := Handle;
   tnd.uID := 128;
   tnd.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
   tnd.uCallbackMessage := WM_TRAYNOTIFY;
   tnd.hIcon := Application.Icon.Handle;
   StrPCopy(tnd.szTip,Application.Title);
   Shell_NotifyIcon(NIM_ADD,@tnd);
end;procedure TForm1.TrayNotifyMessage(var Sender: TMessage);
begin
   if Sender.LParam = WM_LBUTTONDBLCLK then
  begin
    Shell_NotifyIcon(NIM_DELETE,@tnd);
    Form1.Visible := True;
    Application.Restore;
    Application.BringToFront;
  end;
     if  wm_size=1 then
     
end;end.

Answer 1

unit Unit1; interface { 记住在uses部分中包括 ShellAPI} 
uses 
Windows, Messages, SysUtils, Classes, 
Graphics, Controls, Forms, Dialogs, 
ShellAPI, StdCtrls; {自定义消息，当小图标捕捉到鼠标事件时Windows向回调函数发送此消息} 
{自定义消息，当小图标捕捉到鼠标事件时Windows向回调函数发送此消息} 
const MY_MESSAGE = WM_USER + 100; type 
TForm1 = class(TForm) 
procedure FormCreate(Sender: TObject); 
procedure FormClose(Sender: TObject; var Action: TCloseAction); 
procedure FormPaint(Sender: TObject); 
private 
procedure OnIconNotify(var Message: TMessage); 
message MY_MESSAGE; 
public 
{ Public declarations } 
end; var 
Form1: TForm1; implementation {$R *.DFM} 
{当小图标捕捉到鼠标事件时进入此过程} 
{当小图标捕捉到鼠标事件时进入此过程} 
procedure TForm1.OnIconNotify(var Message: TMessage); 
const 
Busy: Boolean = false; 
begin 
if not Busy then begin 
Busy := true; 
if Message.LParam=WM_LBUTTONDOWN then 
if Application.MessageBox('Are you sure', 
'Exit', MB_YESNO)=IDYES then Close; 
Busy := false; 
end; 
end; {当主Form建立时通知Windows加入小图标} 
procedure TForm1.FormCreate(Sender: TObject); 
var 
nid: TNotifyIconData; 
begin 
nid.cbSize := sizeof(nid); // nid变量的字节数 
nid.Wnd := Handle; // 主窗口句柄 
nid.uID := -1; // 内部标识，可设为任意数 
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指?
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指?nid.szTip := 'This is a test application'; // 提示字符串 
nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息 
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有?if not Shell_NotifyIcon(NIM_ADD, @nid) then begin 
ShowMessage('Failed!'); 
Application.Terminate; 
end; 
{将程序的窗口样式设为TOOL窗口，可避免在任务条上出现} 
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); 
end; {程序被关闭时通知Windows去掉小图标} 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
var 
nid: TNotifyIconData; 
begin 
nid.cbSize := sizeof(nid); // nid变量的字节数 
nid.cbSize := sizeof(nid); // nid变量的字节数 
nid.uID := -1; //内部标识，与加入小图标时的数一致 
nid.Wnd := Handle; //主窗口句柄 
Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标 
Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标 
end; {主窗口初始化完毕并显示时将激活Paint重画事件，此时将主窗口隐藏} 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
Hide; 
end; end. 
在implementation前声明以下函数： function RegisterServiceProcess(dwProcessID, dwType: Integer):
  Integer; stdcall; external 'KERNEL32.DLL'; 在button1的OnClick 事件中：
  RegisterServiceProcess( GetCurrentProcessID, 1 ); 在button2的OnClick 事件中：
  RegisterServiceProcess( GetCurrentProcessID, 0 );SetWindowLong(application.Handle,GWL_ExStyle,WS_EX_ToolWindow);建立快捷方式：
const
  CCH_MAXNAME=255;
  LNK_RUN_MIN=7;
  LNK_RUN_MAX=3;
  LNK_RUN_NORMAL=1;type LINK_FILE_INFO=record
         FileName:array[0..MAX_PATH] of char;
         WorkDirectory:array[0..MAX_PATH] of char;
         IconLocation:array[0..MAX_PATH] of char;
         IconIndex:integer;
         Arguments:array[0..MAX_PATH] of char;
         Description:array[0..CCH_MAXNAME] of char;
         ItemIDList:PItemIDList;
         RelativePath:array[0..255] of char;
         ShowState:integer;
         HotKey:word;
     end;function CreateLinkFile(const info:LINK_FILE_INFO;const DestFileName:string=''):boolean;
var
 anobj:IUnknown;
 shlink:IShellLink;
 pFile:IPersistFile;
 wFileName:widestring;
begin
 wFileName:=destfilename;
 anobj:=CreateComObject(CLSID_SHELLLINK);
 shlink:=anobj as IShellLink;
 pFile:=anobj as IPersistFile;
 shlink.SetPath(info.FileName);
 shlink.SetWorkingDirectory(info.WorkDirectory);
 shlink.SetDescription(info.Description);
 shlink.SetArguments(info.Arguments);
 shlink.SetIconLocation(info.IconLocation,info.IconIndex);
// shlink.SetIDList(info.ItemIDList);
 shlink.SetHotkey(info.HotKey);
 shlink.SetShowCmd(info.ShowState);
 shlink.SetRelativePath(info.RelativePath,0);
 if DestFileName='' then
  wFileName:=ChangeFileExt(info.FileName,'lnk');
 result:=succeeded(pFile.Save(pwchar(wFileName),false));
end;
以下是程序里的一段，可以实现无限层导入：
procedure TForm8.LoadTreeView;
var
  strsql,tid:string;
begin
  try    DataModule3.ADOTable3.open;
    DataModule3.ADOTable3.Locate('DTname',RzComboBox1.Text,[lopartialkey]);
    tid:=inttostr(DataModule3.ADOTable3.FieldByName('id').value);
    strsql:='select * from T where TypeID='+tid;
    DQ.Active :=false;
    DQ.SQL.Clear ;
    DQ.SQL.Add(strsql);
    DQ.Active :=true;
    DQ.Filtered :=true;
    DQ.Filter := 'Parent=0';
    U_DiGui(0,seltv.TopItem );//从当前0层开始递归建树
  except
    showmessage('字典里没有数据！');
  end;
end;
procedure TForm8.U_DiGui(parentID:Cardinal;ParentNode:TTreeNode);
var
  tmpTBData:array of TableData;
  i,j:integer;
  tmpNode:TTreeNode;begin
  j:=DQ.RecordCount;
  setlength(tmpTBData,j);//保存递规上一层结点值
  for i:=0 to j-1 do begin
    tmpTBData[i].ID := Cardinal(DQ.fieldbyname('ID').value);
    tmpTBData[i].Name  := DQ.fieldbyname('Name').value;
    tmpTBData[i].ParentID  := Cardinal(DQ.fieldbyname('Parent').value);
    DQ.Next;
  end;
  for i:=0 to j-1 do begin //递规调用建立所有结点
    tmpNode:=seltv.Items.AddChild(ParentNode,tmpTBData[i].Name);
 //   tmpNode.ImageIndex:=2;
    new(pData);
    pData^.ID:=tmpTBData[i].ID;
    tmpNode.Data:=pData;
    DQ.Filter := 'Parent=' + IntToStr(Integer(tmpTBData[i].ID));
    if DQ.RecordCount >0 then begin
      U_DiGui(tmpTBData[i].ID,tmpNode );
    end;
  end;
end;

Answer 2

以前的帖子就有很多
建议你使用cooltrayicon控件
源码delphi5开发人员指南上有
网上可以当到

Answer 3

一控件unit SysTray;interfaceuses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  ShellApi, ExtCtrls, Menus, StdCtrls;const
  WM_SYSTRAY = WM_USER + 1;
  IDI_TRAYICON = 0;type
  TPopupMode = set of(pmLeftClick, pmRightClick, pmLeftDblClick, pmRightDblClick);
  TMouseEvent= procedure(Sender: TObject;
                         Button: TMouseButton;
                         X, Y: Integer) of object;  TSysTray = class(TComponent)
  private
    { Private declarations }
    FIcon: TIcon;
    FIconData: TNotifyIconData;
    FParentWindow: HWnd;
    FWindowHandle: HWnd;
    FHint: string;
    FPopupMenu: TPopupMenu;
    FPopupAlign: TPopupAlignment;
    FPopupMode: TPopupMode;
    FActive: boolean;
    FShowDesigning: boolean;    FOnIconMouseDown: TMouseEvent;
    FOnIconDoubleClick: TMouseEvent;    function AddIcon: boolean;
    function DeleteIcon: boolean;
    function ModifyIcon: boolean;    procedure SetIcon(Icon: TIcon);
    procedure SetHint(Hint: string);
    procedure SetActive(Value: boolean);
    procedure SetShowDesigning(Value: boolean);
    procedure FillDataStructure;    procedure WndProc(var Msg: TMessage); message WM_SYSTRAY;  protected
    { Protected declarations }  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;  published
    { Published declarations }
    property Active: boolean read FActive write SetActive;
    property ShowDesigning: boolean read FShowDesigning write SetShowDesigning;
    property Icon: TIcon Read FIcon write SetIcon;
    property Hint: string read FHint write SetHint;
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    property PopupMode: TPopupMode read FPopupMode write FPopupMode;
    property PopupAlign: TPopupAlignment read FPopupAlign write FPopupAlign;    property OnIconDoubleClick:TMouseEvent
             read FOnIconDoubleClick write FOnIconDoubleClick;
    property OnIconMouseDown:TMouseEvent
             read FOnIconMouseDown write FOnIconMouseDown ;
  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('DayDream', [TSysTray]);
end;constructor TSysTray.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIcon := TIcon.Create;
  FHint := 'SysTray Component.';
  FPopupMode := [pmRightClick];
  FPopupAlign := paRight;
  FActive := false;
  FShowDesigning := false;  if (AOwner <> nil) and (AOwner is TForm) then
    FParentWindow := TForm(AOwner).Handle
  else
    FParentWindow := 0;  FWindowHandle := AllocateHWnd(WndProc);  FillDataStructure;
end;destructor TSysTray.Destroy;
begin
  try
    if (not (csDesigning in ComponentState) and FActive)
       or ((csDesigning in ComponentState) and FShowDesigning) then
          DeleteIcon;
  finally
    FIcon.Free;
    DeallocateHWnd(FWindowHandle);
  end;
  inherited Destroy;
end;function TSysTray.AddIcon: boolean;
begin
  FillDataStructure;
  Result := Shell_NotifyIcon(NIM_ADD, @FIconData);
end;function TSysTray.DeleteIcon: boolean;
begin
  Result := Shell_NotifyIcon(NIM_DELETE, @FIconData);
end;function TSysTray.ModifyIcon: boolean;
begin
  FillDataStructure;
  if FActive then
    Result := Shell_NotifyIcon(NIM_MODIFY, @FIconData)
  else
    Result := true;
end;procedure TSysTray.SetIcon(Icon: TIcon);
begin
  FIcon.Assign(Icon);
  ModifyIcon;
end;procedure TSysTray.SetHint(Hint: string);
begin
  if Length(Hint) >= 64 then Hint := Copy(Hint, 1, 63);
  FHint := Hint;
  ModifyIcon;
end;procedure TSysTray.SetActive(Value: boolean);
begin
  if Value <> FActive then
  begin
    FActive := Value;
    if not (csDesigning in ComponentState) then
    begin
      case Value of
        true:    AddIcon;
        false:   DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.SetShowDesigning(Value: boolean);
begin
  if (csDesigning in ComponentState) then
  begin
    if Value <> FShowDesigning then
    begin
      FShowDesigning := Value;
      case Value of
        true:    AddIcon;
        false:   DeleteIcon;
      end;
    end;
  end;
end;procedure TSysTray.FillDataStructure;
begin
  With FIconData do
  begin
    uCallbackMessage:=WM_SYSTRAY;
    cbSize := SizeOf(FIconData);
    uID := IDI_TRAYICON;
    wnd := FWindowHandle;
    hIcon := FIcon.Handle;
    StrCopy(FIconData.szTip, PChar(FHint));
    uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  end;
end;procedure TSysTray.WndProc(var Msg: TMessage);
var
  P: TPoint;
begin
  if (Msg.WParam <> IDI_TRAYICON) then exit;
  if Assigned(FPopupMenu) then
    FPopupMenu.Alignment := FPopupAlign;  GetCursorPos(p);
  case Msg.LParam of
    WM_LBUTTONDOWN:
      begin
        if (pmLeftClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconMouseDown) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconMouseDown(Self, mbLeft, p.x, p.y);
        end;
      end;    WM_RBUTTONDOWN:
      begin
        if (pmRightClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconMouseDown) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconMouseDown(Self, mbRight, p.x, p.y);
        end;
      end;    WM_LBUTTONDBLCLK:
      begin
        if (pmLeftDblClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconDoubleClick) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconDoubleClick(Self, mbLeft, p.x, p.y);
        end;
      end;    WM_RBUTTONDBLCLk:
      begin
        if (pmRightDblClick in FPopupMode) and Assigned(FPopupMenu) then
        begin
          SetForegroundWindow(FParentWindow);
          FPopupMenu.Popup(p.x,p.y);
        end;
        if Assigned(FOnIconDoubleClick) then
        begin
          SetForegroundWindow(FParentWindow);
          FOnIconDoubleClick(Self, mbRight, p.x, p.y);
        end;
      end;    else
      Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
  end;
end;end.

Answer 4

在csdn的搜索里，用“托盘”做关键字，看看找到的东西~~~~

Answer 5

对不起，刚帖的时候多帖了些东西
unit Unit1; interface { 记住在uses部分中包括 ShellAPI} 
uses 
Windows, Messages, SysUtils, Classes, 
Graphics, Controls, Forms, Dialogs, 
ShellAPI, StdCtrls; {自定义消息，当小图标捕捉到鼠标事件时Windows向回调函数发送此消息} 
{自定义消息，当小图标捕捉到鼠标事件时Windows向回调函数发送此消息} 
const MY_MESSAGE = WM_USER + 100; type 
TForm1 = class(TForm) 
procedure FormCreate(Sender: TObject); 
procedure FormClose(Sender: TObject; var Action: TCloseAction); 
procedure FormPaint(Sender: TObject); 
private 
procedure OnIconNotify(var Message: TMessage); 
message MY_MESSAGE; 
public 
{ Public declarations } 
end; var 
Form1: TForm1; implementation {$R *.DFM} 
{当小图标捕捉到鼠标事件时进入此过程} 
{当小图标捕捉到鼠标事件时进入此过程} 
procedure TForm1.OnIconNotify(var Message: TMessage); 
const 
Busy: Boolean = false; 
begin 
if not Busy then begin 
Busy := true; 
if Message.LParam=WM_LBUTTONDOWN then 
if Application.MessageBox('Are you sure', 
'Exit', MB_YESNO)=IDYES then Close; 
Busy := false; 
end; 
end; {当主Form建立时通知Windows加入小图标} 
procedure TForm1.FormCreate(Sender: TObject); 
var 
nid: TNotifyIconData; 
begin 
nid.cbSize := sizeof(nid); // nid变量的字节数 
nid.Wnd := Handle; // 主窗口句柄 
nid.uID := -1; // 内部标识，可设为任意数 
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指?
nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指?nid.szTip := 'This is a test application'; // 提示字符串 
nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息 
nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有?if not Shell_NotifyIcon(NIM_ADD, @nid) then begin 
ShowMessage('Failed!'); 
Application.Terminate; 
end; 
{将程序的窗口样式设为TOOL窗口，可避免在任务条上出现} 
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); 
end; {程序被关闭时通知Windows去掉小图标} 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
var 
nid: TNotifyIconData; 
begin 
nid.cbSize := sizeof(nid); // nid变量的字节数 
nid.cbSize := sizeof(nid); // nid变量的字节数 
nid.uID := -1; //内部标识，与加入小图标时的数一致 
nid.Wnd := Handle; //主窗口句柄 
Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标 
Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标 
end; {主窗口初始化完毕并显示时将激活Paint重画事件，此时将主窗口隐藏} 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
Hide; 
end; end.

Answer 6

不会吧~~~ :(http://CoolSlob.8u8.com/Download/Cleaner.src.zip这是一个实例~~~

Answer 7

procedure Twin_popup.FormCreate(Sender: TObject);
var 
tnd1,tnd2 : TNOTIFYICONDATA;
hs:array[0..1]of LongWord;
begin
  inherited;
    hs[0]:=LoadIcon(hInstance, 'popup.ico');
    tnd1.cbSize := sizeof(@tnd1);//(NotifyIconData);
    tnd1.Wnd := handle;
    tnd1.uID :=128;
    tnd1.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    tnd1.uCallbackMessage :=WM_TRAYNOTIFY;
    tnd1.hIcon := hs[0];
    StrPCopy(tnd1.szTip,Application.Title);
    Shell_NotifyIcon(NIM_ADD, @tnd1);
end;這樣做，為什麼在狀態條裡不出現小圖標呢？

Answer 8

unit Unit1;interface{ 记住在uses部分中包括 ShellAPI}usesWindows, Messages, SysUtils, Classes,Graphics, Controls, Forms, Dialogs,ShellAPI, StdCtrls;{自定义消息，当小图标捕捉到鼠标事件时Windows向回调函数发送此消息}const MY_MESSAGE = WM_USER + 100;typeTForm1 = class(TForm)procedure FormCreate(Sender: TObject);procedure FormClose(Sender: TObject; var Action: TCloseAction);procedure FormPaint(Sender: TObject);privateprocedure OnIconNotify(var Message: TMessage);message MY_MESSAGE;public{ Public declarations }end;varForm1: TForm1;implementation{$R *.DFM}{当小图标捕捉到鼠标事件时进入此过程}procedure TForm1.OnIconNotify(var Message: TMessage);constBusy: Boolean = false;beginif not Busy then beginBusy := true;if Message.LParam=WM_LBUTTONDOWN thenif Application.MessageBox('Are you sure','Exit', MB_YESNO)=IDYES then Close;Busy := false;end;end;{当主Form建立时通知Windows加入小图标}procedure TForm1.FormCreate(Sender: TObject);varnid: TNotifyIconData;beginnid.cbSize := sizeof(nid); // nid变量的字节数nid.Wnd := Handle; // 主窗口句柄nid.uID := -1; // 内部标识，可设为任意数nid.hIcon := Application.Icon.Handle; // 要加入的图标句柄，可任意指定nid.szTip := 'This is a test application'; // 提示字符串nid.uCallbackMessage := MY_MESSAGE; // 回调函数消息nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE; // 指明哪些字段有效if not Shell_NotifyIcon(NIM_ADD, @nid) then beginShowMessage('Failed!');Application.Terminate;end;{将程序的窗口样式设为TOOL窗口，可避免在任务条上出现}SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);end;{程序被关闭时通知Windows去掉小图标}procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);varnid: TNotifyIconData;beginnid.cbSize := sizeof(nid); // nid变量的字节数nid.uID := -1; //内部标识，与加入小图标时的数一致nid.Wnd := Handle; //主窗口句柄Shell_NotifyIcon(NIM_DELETE, @nid); //去掉小图标end;{主窗口初始化完毕并显示时将激活Paint重画事件，此时将主窗口隐藏}procedure TForm1.FormPaint(Sender: TObject);beginHide;end;end.

Answer 9

CSDN效率全被这些人破坏掉了
越来越慢的CSDN不知还能活多久不能自己先找一找!!!!!!!!!
shit