|
d;
Shift: TShiftState);
begin
lastKey := Key;
end;
◇[DELPHI]如何清空一个目录
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + ''''*.*'''', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> ''''.'''') and (SearchRec.Name <> ''''..'''') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;
◇[DELPHI]安装程序如何添加到Uninstall列表
操作注册表，如下：
1.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall键下建立一个主键，名称任意。
例HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUninstall
2.在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\MyUnistall下键两个串值，
这两个串值的名称是特定的：DisplayName和UninstallString。
3.给串DisplayName赋值为显示在“删除应用程序列表”中的名称，如''''Aiming Uninstall one'''';
给串UninstallString赋值为执行的删除命令，如 C:\WIN97\uninst.exe -f"C:\TestPro\aimTest.isu"
◇[DELPHI]截获WM_QUERYENDSESSION关机消息
type
Tform1 = class(Tform)
procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND;
private
{ Private declarations }
public
{ Public declarations }
end;
procedure Tform1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
Showmessage(''''computer is about to shut down'''');
end;
◇[DELPHI]获取网上邻居
procedure getnethood();//NT做服务器，WIN98上调试通过。
var
a,i:integer;
errcode:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries:dword;
buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
alldomain:tstrings;
begin //listcomputer is a listview to list all computers;controlcenter is a form.
alldomain:=tstringlist.Create ;
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_DOMAIN;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=nil;
lpcomment :=nil;
lpprovider :=nil;
end; // 获取所有的域
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then begin
enumentries:=1024;
buffersize:=sizeof(netres);
errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],buffersize);
end;
a:=0;
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'''''''') and (errcode=NO_ERROR) do
begin
alldomain.Add (netres[a].lpremotename);
a:=a+1;
end;
wnetcloseenum(enumhandle);
// 获取所有的计算机
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
for i:=0 to alldomain.Count-1 do
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SERVER;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(alldomain[i]);
lpcomment :=nil;
lpprovider :=nil;
end;
ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],EnumHandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
a:=0;
while (string(netres[a].lpprovider)<>'''''''') and (errcode=NO_ERROR) do
begin
mylistitem :=mylistitems.Add ;
mylistitem.ImageIndex :=0;
mylistitem.Caption :=uppercase(stringreplace(string(NetRes[a].lpremotename),''''\\'''','''''''',[rfReplaceAll]));
a:=a+1;
end;
wnetcloseenum(enumhandle);
end;
end;
◇[DELPHI]获取某一计算机上的共享目录
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_DISK;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(computername);
lpcomment :=nil;
lpprovider :=nil;
end; // 获取根结点
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
wnetcloseenum(enumhandle);
a:=0;
mylistitems:=controlcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'''''''') and (errcode=NO_ERROR) do
begin
with mylistitems do
begin
mylistitem:=add;
mylistitem.ImageIndex :=4;
mylistitem.Caption :=extractfilename(netres[a].lpremotename);
end;
a:=a+1;
end;
end;
◇[DELPHI]得到硬盘序列号
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;
begin
if GetVolumeInformation(''''c:\'''', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^);
end;
1.关于MDI主窗体背景新解
在Form中添加Image控件
设BMP图象
name为 IMG_BK
在Foem的Create事件中写入
Self.brush.bitmap:=img_bk.picture.bitmap;
2.在标题栏处画VCL控件(一行解决问题!!!)
在 form 的onpaint 事件中
控件.pointto(getdc(0),left,top);
3 Edit 中只输入数字
SetWindowLong(Edit1.Handle, GWL_STYLE,
GetWindowLong(Edit1.Handle, GWL_STYLE) or
ES_NUMBER);
4.类似MDI方式新解
在要设置child的oncreate方式下写入:
self.parent:=''''要设置为mainform的Form'''';
5. 屏幕的Refresh(只需一行!)
RedrawWindow(0,nil,0,RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
| |
--- ----
handle RGN(可刷新局部屏幕)
6.类似DOS下的CLS指令的WINDOWS指令!
paintdesktop(getdc(0));
7.扩展控件新功能
在编程中 ,我们经常要控制控件的动作,但该控件又没有提供该方法
这时 ,可通过发消息给该控件 ,以达到我们的目的!
如:
button1.perform(wm_keydown,13,0);
listbox1.perform(wm_vscroll,sb_linedown,0);
等等 可少去 重载之苦!!!!!
8.闪烁标题如打印机超时(一行)
form 放一timer 控件
time 事件 中 写入 ;
flashwindow(application.handle,true);
9.在桌面上加个VCL控件!(不是画的,不可refresh)
windows.setparent(控件.handle,0);
注: 想放哪都行 (如''''开始处状态栏'''')
10.关于 ''''类似MDI方式新解(一行就行!!!!)''''的修正
windows.setparent(self.handle,''''要设置为mainform的Form'''');
11 普通Form象MDI中mainform始终在最底层
SetActiveWindow(0);
或 SetwindowPos(...);
12 执行下列语句开始Windows屏幕保护程序
SendMessage(HWND_BROADCAST,WM_SYSCOMMAND,SC_SCREENSAVE,0);
13 button 的 caption 多行显示：
SetWindowLong(Button1.handle, GWL_STYLE,
GetWindowlong(Button1.Handle, GWL_STYLE) or
BS_MULTILINE);
必要时加上 Button1.Invalidate;
14.整死windows98 :)
asm int $19 end
Q: 怎么来改变ListBox的字体呢？就修改其中的一行。
A: 先把ListBox1.Style 设成lbOwnerDrawFixed
然后在 OnDrawItem 事件下写下如下代码
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Offset: Integer;
begin
Offset := 2;
with (Control as TListBox).Canvas do begin
FillRect(Rect);
if Index = 2 then begin
Font.Name := ''''Fixedsys'''';
Font.Color := clRed;
Font.Size := 12;
end else begin
Font.Name := ''''Arial'''';
Font.Color := clBlack;
&nbs 上一页 [1] [2] [3] [4] [5] [6] [7] 下一页
[Delphi程序]先人的DELPHI基础开发技巧
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
