delphi基础开发技巧.txt

一些重要并且经典的编程实例

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; 

◇[DELPHI]MEMO的自动翻页 
Procedure ScrollMemo(Memo : TMemo; Direction : char); 
begin 
case direction of 
'd': begin 
SendMessage(Memo.Handle, { HWND of the Memo Control } 
WM_VSCROLL, { Windows Message } 
SB_PAGEDOWN, { Scroll Command } 
0) { Not Used } 
end; 
'u' : begin 
SendMessage(Memo.Handle, { HWND of the Memo Control } 
WM_VSCROLL, { Windows Message } 
SB_PAGEUP, { Scroll Command } 
0); { Not Used } 
end; 
end; 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
ScrollMemo(Memo1,'d'); //上翻页 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
ScrollMemo(Memo1,'u'); //下翻页 
end; 

◇[DELPHI]DBGrid中回车到下个位置(Tab键) 
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char); 
begin 
if Key = #13 then 
if DBGrid1.Columns.Grid.SelectedIndex < DBGrid1.Columns.Count - 1 then 
DBGrid1.Columns[DBGrid1.Columns.grid.SelectedIndex + 1].Field.FocusControl 
else 
begin 
Table1.next; 
DBGrid1.Columns[0].field.FocusControl; 
end; 
end; 

◇[DELPHI]如何安装控件 
安装方法: 
1.对于单个控件,Component-->install component..-->PAS或DCU文件-->install 
2.对于带*.dpk文件的控件包,File-->open(下拉列表框中选*.dpk)-->install即可. 
3.对于带*.dpl文件的控件包,Install Packages-->Add-->dpl文件名即可。 
4.如果以上Install按钮为失效的话,试试Compile按钮。 
5.是run time lib则在option下的packages下的runtimepackes加之. 
如果编译时提示文件找不到的话,一般是控件的安装目录不在delphi的Lib目录中,有两种方法可以解决: 
1.把安装的原文件拷入到delphi的Lib目录下。 
2.或者Tools-->Environment Options中把控件原代码路径加入到Delphi的Lib目录中即可。 

◇[DELPHI]目录完全删除(deltree) 
procedure TForm1.DeleteDirectory(strDir:String); 
var 
sr: TSearchRec; 
FileAttrs: Integer; 
strfilename:string; 
strPth:string; 
begin 
strpth:=Getcurrentdir(); 
FileAttrs := faAnyFile; 
if FindFirst(strpth+'\'+strdir+'\*.*', FileAttrs, sr) = 0 then 
begin 
if (sr.Attr and FileAttrs) = sr.Attr then 
begin 
strfilename:=sr.Name; 
if fileexists(strpth+'\'+strdir+'\'+strfilename) then 
deletefile(strpth+'\'+strdir+'\'+strfilename); 
end; 
while FindNext(sr) = 0 do 
begin 
if (sr.Attr and FileAttrs) = sr.Attr then 
begin 
strfilename:=sr.name; 
if fileexists(strpth+'\'+strdir+'\'+strfilename) then 
deletefile(strpth+'\'+strdir+'\'+strfilename); 
end; 
end; 
FindClose(sr); 
removedir(strpth+'\'+strdir); 
end; 
end; 

◇[DELPHI]取得TMemo 控件当前光标的行和列信息到Tpoint中 
1.function ReadCursorPos(SourceMemo: TMemo): TPoint; 
var Point: TPoint; 
begin 
　point.y := SendMessage(SourceMemo.Handle,EM_LINEFROMCHAR,SourceMemo.SelStart,0); 
　point.x := SourceMemo.SelStart-SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0); 
　Result := Point; 
end; 
2.LineLength:=SendMessage(memol．handle,EM-LINELENGTH,Cpos,0);//行长 

◇[DELPHI]读硬盘序列号 
function GetDiskSerial(DiskChar: Char): string; 
var 
SerialNum : pdword; 
a, b : dword; 
Buffer : array [0..255] of char; 
begin 
result := ""; 
if GetVolumeInformation(PChar(diskchar+":\"), Buffer, SizeOf(Buffer), SerialNum, 
a, b, nil, 0) then 
　Result := IntToStr(SerialNum^); 
end; 

◇[INTERNET]CSS常用综合技巧 
1。P:first-letter { font-size: 300%; float: left }//首字会比普通字体加大三倍。 
2。//连接一个外部样式表 
3。嵌入一个样式表 
4。 //内联样式 
Arial//SPAN接受STYLE、CLASS和ID属性 

DIV可以包含段落、标题、表格甚至其它部分 

5。CLASS属性 
//定义见3。 
6。ID属性 
//定义见3。 
7。属性列表 
字体风格:font-style: [normal | italic | oblique]; 
字体大小:font-size: [xx-small | x-small | small | medium | large | x-large | xx-large | larger | smaller | <长度> | <百分比>] 
文本修饰:text-decoration:[ underline || overline || line-through || blink ] 
文本转换:text-transform:[none | capitalize | uppercase | lowercase] 
背景颜色:background-color:[<颜色> | transparent] 
背景图象:background-image:[ | none] 
行高:line-height: [normal | <数字> | <长度> | <百分比>] 
边框样式:border-style: [ none | dotted | dashed | solid | double | groove | ridge | inset | outset ] 
漂浮:float: [left | right | none] 
8。长度单位 
相对单位: 
em (em,元素的字体的高度) 
ex (x-height,字母 "x" 的高度) 
px (像素,相对于屏幕的分辨率) 
绝对长度: 
in (英寸,1英寸=2.54厘米) 
cm (厘米,1厘米=10毫米) 
mm (米) 
pt (点,1点=1/72英寸) 
pc (帕,1帕=12点) 

◇[DELPHI]VCL制作简要步骤 
1.创建部件属性方法事件 
(建立库单元,继承为新的类型,添加属性、方法、事件,注册部件,建立包文件) 
2.消息处理 
3.异常处理 
4.部件可视 

◇[DELPHI]动态连接库的装载 
静态装载:procedure name;external 'lib.dll'; 
动态装载:var handle:Thandle; 
handle:=loadlibrary('lib.dll'); 
if handle<>0 then 
begin 
{dosomething} 
freelibrary(handle); 
end; 

◇[DELPHI]指针变量和地址 
var x,y:integer;p:^integer;//指向INTEGER变量的指针 
x:=10;//变量赋值 
p:=@x;//变量x的地址 
y:=p^;//为Y赋值指针P 
@@procedure//返回过程变量的内存地址 

◇[DELPHI]判断字符是汉字的一个字符 
ByteType('你好haha吗',1) = mbLeadByte//是第一个字符 
ByteType('你好haha吗',2) = mbTrailByte//是第二个字符 
ByteType('你好haha吗',5) = mbSingleByte//不是中文字符 

◇[DELPHI]memo的定位操作 
memo1.lines.delete(0)//删除第1行 
memo1.selstart:=10//定位10字节处 

◇[DELPHI]获得双字节字符内码 
function getit(s: string): integer; 
begin 
Result := byte(s[1]) * 0 + byte(s[2]); 
end; 
使用:getit('计')//$bcc6 即十进制 48326 

◇[DELPHI]调用ADD数据存储过程 
存储过程如下: 
create procedure addrecord( 
record1 varchar(10) 
record2 varchar(20) 
) 
as 
begin 
insert into tablename (field1,field2) values(:record1,:record2) 
end 
执行存储过程: 
EXECUTE procedure addrecord("urrecord1","urrecord2") 

◇[DELPHI]将文件存到blob字段中 
function blobcontenttostring(const filename: string):string; 
begin 
with tfilestream.create(filename,fmopenread) do 
try 
setlength(Result,size); 
read(Pointer(Result)^,size); 
finally 
free; 
end; 
end; 
//保存字段 
begin 
if (opendialog1.execute) then 
begin 
sFileName:=OpenDialog1.FileName; 
adotable1.edit; 
adotable1.fieldbyname('visio').asstring:=Blobcontenttostring(FileName); 
adotable1.post; 
end; 

◇[DELPHI]把文件全部复制到剪贴板 
uses shlobj,activex,clipbrd; 
procedure Tform1.copytoclipbrd(var FileName:string); 
var 
FE:TFormatEtc; 
Medium: TStgMedium; 
dropfiles:PDropFiles; 
pFile:PChar; 
begin 
FE.cfFormat := CF_HDROP; 
FE.dwAspect := DVASPECT_CONTENT; 
FE.tymed := TYMED_HGLOBAL; 
Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TDropFiles)+length(FileName)+1); 
if Medium.hGlobal<>0 then begin 
Medium.tymed := TYMED_HGLOBAL; 
dropfiles := GlobalLock(Medium.hGlobal); 
try 
dropfiles^.pfiles := SizeOf(TDropFiles); 
dropfiles^.fwide := False; 
longint(pFile) := longint(dropfiles)+SizeOf(TDropFiles); 
StrPCopy(pFile,FileName); 
Inc(pFile, Length(FileName)+1); 
pFile^ := #0; 
finally 
GlobalUnlock(Medium.hGlobal); 
end; 
Clipboard.SetAsHandle(CF_HDROP,Medium.hGlobal); 
end; 
end; 

◇[DELPHI]列举当前系统运行进程 
uses TLHelp32; 
procedure TForm1.Button1Click(Sender: TObject); 
var lppe: TProcessEntry32; 
found : boolean; 
Hand : THandle; 
begin 
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0); 
found := Process32First(Hand,lppe); 
while found do 
begin 
ListBox1.Items.Add(StrPas(lppe.szExeFile)); 
found := Process32Next(Hand,lppe); 
end; 
end; 

◇[DELPHI]根据BDETable1建立新表Table2 
Table2:=TTable.Create(nil); 
try 
Table2.DatabaseName:=Table1.DatabaseName; 
Table2.FieldDefs.Assign(Table1.FieldDefs); 
Table2.IndexDefs.Assign(Table1.IndexDefs); 
Table2.TableName:='new_table'; 
Table2.CreateTable(); 
finally 
Table2.Free(); 
end; 

◇[DELPHI]最菜理解DLL建立和引用 
//先看DLL source(FILE-->NEW-->DLL) 
library project1; 
uses 
SysUtils, Classes; 
function addit(f:integer;s:integer):integer;export; 
begin 
makeasum:=f+s; 
end; 
exports 
addit; 
end. 
//调用(IN ur PROJECT) 
implementation 
function addit(f:integer;s:integer):integer;far;external 'project1';//申明 
{调用就是addit(2,4);结果显示6} 

◇[DELPHI]动态读取程序自身大小 
function GesSelfSize: integer; 
var 
f: file of byte; 
begin 
filemode := 0; 
assignfile(f, application.exename); 
reset(f); 
Result := filesize(f);//单位是字节 
closefile(f); 
end; 

◇[DELPHI]读取BIOS信息 
with Memo1.Lines do 
begin 
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061)))); 
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091)))); 
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5)))); 
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71)))); 
end; 

◇[DELPHI]动态建立MSSQL别名 
procedure TForm1.Button1Click(Sender: TObject); 
var MyList: TStringList; 
begin 
MyList := TStringList.Create; 
try 
with MyList do 
begin 
Add('SERVER NAME=210.242.86.2'); 
Add('DATABASE NAME=db'); 
Add('USER NAME=sa'); 
end; 
Session1.AddAlias('TESTSQL', 'MSSQL', MyList); //