如何将一个应用程序的表单做一个图标显示在桌面的右下角?(50分)

C

ChenQ

Unregistered / Unconfirmed
GUEST, unregistred user!
有源码
http://antic_ant.delphibbs.com 上的readtoolssource.zip
例如下
unit utexttool;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, FileCtrl, StdCtrls, ComCtrls, Menus, StdActns,registry,
ExtActns, ActnList,shellapi;
const
WM_TRAYICON=WM_USER+100;

type
TForm1 = class(TForm)
Panel1: TPanel;
Splitter1: TSplitter;
Panel2: TPanel;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
RichEdit1: TRichEdit;
Label1: TLabel;
PageControl1: TPageControl;
PopupMenu1: TPopupMenu;
Open1: TMenuItem;
Close1: TMenuItem;
CloseAll1: TMenuItem;
StatusBar1: TStatusBar;
N1: TMenuItem;
Font1: TMenuItem;
Edit1: TMenuItem;
Replace1: TMenuItem;
Find1: TMenuItem;
N3: TMenuItem;
Paste1: TMenuItem;
Copy1: TMenuItem;
Cut1: TMenuItem;
N4: TMenuItem;
Undo1: TMenuItem;
N5: TMenuItem;
Exit1: TMenuItem;
ActionList1: TActionList;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
EditSelectAll1: TEditSelectAll;
EditUndo1: TEditUndo;
EditDelete1: TEditDelete;
RichEditBold1: TRichEditBold;
RichEditItalic1: TRichEditItalic;
RichEditUnderline1: TRichEditUnderline;
RichEditStrikeOut1: TRichEditStrikeOut;
RichEditBullets1: TRichEditBullets;
FileSaveAs1: TFileSaveAs;
FileExit1: TFileExit;
FontEdit1: TFontEdit;
N2: TMenuItem;
Selectall1: TMenuItem;
SearchFind1: TSearchFind;
SearchReplace1: TSearchReplace;
FontDialog1: TFontDialog;
PopupMenu2: TPopupMenu;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
N6: TMenuItem;
FilterComboBox1: TFilterComboBox;
PopupMenu3: TPopupMenu;
new1: TMenuItem;
rename1: TMenuItem;
Edit2: TEdit;
Panel3: TPanel;
SearchFind2: TSearchFind;
SearchFindNext1: TSearchFindNext;
SearchReplace2: TSearchReplace;
SearchFindFirst1: TSearchFindFirst;
FilePrintSetup1: TFilePrintSetup;
Print1: TMenuItem;
Autoscroll1: TMenuItem;
procedure FileListBox1Change(Sender: TObject);
procedure FileListBox1DblClick(Sender: TObject);
procedure Font1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure CloseAll1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure WMTRAYICON(var message:Tmessage);message WM_TRAYICON;
procedure N31Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure rename1Click(Sender: TObject);
procedure new1Click(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Autoscroll1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure opentxt(caption:string);
procedure modifytrayicon(action:dword);
end;
procedure KPress(Sender: TObject; var Key: Char);

var
Form1: TForm1;
i,j:integer;
hid: boolean;
my:integer;
implementation

{$R *.dfm}



procedure TForm1.FileListBox1Change(Sender: TObject);
begin
if length(FileListBox1.FileName)>0 then
begin
//showmessage(FileListBox1.FileName);
richedit1.Clear;
RichEdit1.Lines.LoadFromFile(FileListBox1.FileName);
end;
end;

procedure TForm1.opentxt(caption:string);
var
richedit:Trichedit;
tabsheet:Ttabsheet;
begin
tabsheet:=Ttabsheet.Create(nil);
tabsheet.Name:='tabsheet'+inttostr(i);
tabsheet.PageControl:=PageControl1;
tabsheet.Caption:=extractfilename(caption);
tabsheet.Hint:=caption;
tabsheet.ShowHint:=false;
pageControl1.ShowHint:=false;
richedit:=trichedit.Create(nil);
richedit.Name:='richedit'+inttostr(i);
richedit.Parent:=tabsheet;
richedit.ScrollBars:=ssBoth;
richedit.HideScrollBars :=false;
richedit.Align:=alClient;
richedit.PopupMenu:=PopupMenu1;
richedit.PopupMenu.Items[5].Checked:=false;
richedit.Font.Name:='宋体';
richedit.Font.Size:=12;
richedit.Lines.LoadFromFile(Filelistbox1.FileName);
PageControl1.ActivePage:=tabsheet;
i:=i+1;


end;

procedure TForm1.FileListBox1DblClick(Sender: TObject);
var
m:integer;
find:boolean;
begin
find:=false;
if pageControl1.PageCount>0 then
begin
for m:=0 to pagecontrol1.PageCount-1 do
begin
if pageControl1.Pages[m].Hint <>FileListBox1.FileName then
begin
find:=false;
continue;

end
else
begin

find:=true;
pageControl1.ActivePage:=pageControl1.pages[m];
break;
end;
end;
if not find then opentxt(FileListBox1.FileName);

end
else
opentxt(FileListBox1.FileName);
end;

procedure TForm1.Font1Click(Sender: TObject);
var
rchedt:TrichEdit;
begin
if FontDialog1.Execute then
begin
rchedt:=TrichEdit(PopupMenu1.PopupComponent);
rchedt.Font:=fontdialog1.Font;
end;

end;

procedure TForm1.Close1Click(Sender: TObject);

begin
pageControl1.ActivePage.Destroy;
end;

procedure TForm1.CloseAll1Click(Sender: TObject);
var
m,n:integer;
begin
m:=pageControl1.PageCount-1;
for n:= m downto 0 do
begin
pageControl1.Pages[n].Destroy;
end;
end;

procedure TForm1.Open1Click(Sender: TObject);
var
rchedt:trichedit;
begin
;
rchedt:=TrichEdit(PopupMenu1.PopupComponent);
if rchedt.Modified then
begin
//rchedt.Lines.SaveToFile(self.DirectoryListBox1.Directory+'/'+ pageControl1.ActivePage.Caption);
rchedt.Lines.SaveToFile(pageControl1.ActivePage.Hint);
end
else
begin

exit;
end;
end;

procedure TForm1.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; // with
shell_notifyicon(action,@nidata);
end;

procedure TForm1.FormCreate(Sender: TObject);

var
reg:Tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;//
reg.OpenKey('/SOFTWARE/Microsoft/Windows/CurrentVersion/Run',false);
reg.WriteString('txttools',application.ExeName);
reg.CloseKey;
reg.Free;
modifytrayicon(nim_add);
showwindow(application.Handle,SW_HIDE);
//setwindowlong(application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
hid:=true;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
modifytrayicon(nim_delete);
end;

procedure TForm1.WMTRAYICON(var message: Tmessage);
var
mousepos:Tpoint;
begin
if message.LParam =WM_RBUTTONDOWN then
begin
setactivewindow(handle);
getcursorpos(mousepos);
PopupMenu2.Popup(mousepos.X,mousepos.Y);
end;
if message.LParam =WM_LBUTTONDBLCLK then
begin
show;
showwindow(application.Handle,SW_HIDE);
end;

end;

procedure TForm1.N31Click(Sender: TObject);
begin
hid:=false;
close;
end;

procedure TForm1.N11Click(Sender: TObject);
begin
show;
showwindow(application.Handle,SW_HIDE);
end;

procedure TForm1.N21Click(Sender: TObject);
begin
hide;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if hid then
begin
canclose:=false;
hide;
end
else
canClose:=true;
end;

procedure TForm1.rename1Click(Sender: TObject);
var
finteger:integer;
begin
if not FileExists(DirectoryListBox1.Directory+'/new.txt')then
begin
FileListBox1.Items.Add('new.txt');
finteger:=filecreate(DirectoryListBox1.Directory+'/new.txt');
fileclose(finteger);
//opentxt(FileListBox1.FileName);
end
else
application.MessageBox('file ecists','txttools',MB_OK);
end;
procedure KPress(Sender: TObject; var Key: Char);
begin
if key=#13 then renamefile(form1.FileListBox1.FileName,form1.DirectoryListBox1.Directory+'/'+Tedit(sender).Text);
end;
procedure TForm1.new1Click(Sender: TObject);

var

mousepos:Tpoint;
key:Char;
begin

Edit2.Parent:=self;
getcursorpos(mousepos);
Edit2.Left:=mousepos.X;
Edit2.Top:=mousepos.Y;
Edit2.Text:='';
Edit2.Visible:=true;
//renameedt.OnKeyPress:=kpress(sender,key);
end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
var
pagcount:integer;
begin
if key=#13 then
begin

Edit2.Visible:=false;

for pagcount:=0 to pageControl1.PageCount-1 do//Iterate
begin
if pageControl1.Pages[pagcount].Caption=extractfilename(FileListBox1.FileName) then
begin
pageControl1.Pages[pagcount].Caption:=edit2.text+'.txt';
pageControl1.Pages[pagcount].Hint:=DirectoryListBox1.Directory+'/'+Tedit(sender).Text+'.txt';

end;

end;//for
renamefile(FileListBox1.FileName,DirectoryListBox1.Directory+'/'+Tedit(sender).Text+'.txt');
FilelistBox1.Items[filelistBox1.ItemIndex]:=edit2.text+'.txt';
edit2.Text:='';
end;
end;

procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if y>my then Trichedit(sender).Perform(WM_VSCROLL,makewparam(SB_LINEDOWN,0),0)
else
Trichedit(sender).Perform(WM_VSCROLL,makewparam(SB_LINEUP,0),0);

my:=y;
end;

procedure TForm1.Autoscroll1Click(Sender: TObject);
var
rchedt:Trichedit;
begin
rchedt:=TrichEdit(PopupMenu1.PopupComponent);
if autoscroll1.Checked then
begin
rchedt.OnMouseMove:=form1.RichEdit1.OnMouseMove;
//rchedt.Perform(WM_VSCROLL,makewparam(SB_LINEDOWN,0),0);
end
else
begin
rchedt.OnMouseMove:=nil;
end;


end;

end.

 
在程序员大本营的荟萃版又控件,非常酷
 
一个API解决
SetWindowPos(MyForm->handle,HWND_BOTTOM,0,0,Screen->Width,Screen->Height,SWP_NOACTIVATE);
//象桌面一样平铺,且最后
 
用rx控件库中的rxcyicon控件
 
顶部