[转载]先人的DELPHI基础开发技巧(页 1) - Delphi论坛 - 编程论坛

xu2000 发表于 2006-10-12 22:43

[转载]先人的DELPHI基础开发技巧

[DELPHI]网络邻居复制文件 uses shellapi; copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);
◇[DELPHI]产生鼠标拖动效果 通过MouseMove事件、DragOver事件、EndDrag事件实现，例如在PANEL上的LABEL： var xpanel,ypanel,xlabel,ylabel:integer; PANEL的MouseMove事件：xpanel:=x;ypanel:=y; PANEL的DragOver事件：xpanel:=x;ypanel:=y; LABEL的MouseMove事件：xlabel:=x;ylabel:=y; LABEL的EndDrag事件：label.left:=xpanel-xlabel;label.top:=ypanel-ylabel;
◇[DELPHI]取得WINDOWS目录 uses shellapi; var windir:array[0..255] of char; getwindowsdirectory(windir,sizeof(windir)); 或者从注册表中读取，位置： HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion SystemRoot键，取得如：C:\WINDOWS
◇[DELPHI]在form或其他容器上画线 var x,y:array [0..50] of integer; canvas.pen.color:=clred; canvas.pen.style:=psDash; form1.canvas.moveto(trunc(x[i]),trunc(y[i])); form1.canvas.lineto(trunc(x[j]),trunc(y[j]));
◇[DELPHI]字符串列表使用 var tips:tstringlist; tips:=tstringlist.create; tips.loadfromfile('filename.txt'); edit1.text:=tips[0]; tips.add('last line addition string'); tips.insert(1,'insert string at NO 2 line'); tips.savetofile('newfile.txt'); tips.free;
◇[DELPHI]简单的剪贴板操作 richedit1.selectall; richedit1.copytoclipboard; richedit1.cuttoclipboard; edit1.pastefromclipboard;
◇[DELPHI]关于文件、目录操作 Chdir('c:\abcdir');转到目录 Mkdir('dirname');建立目录 Rmdir('dirname');删除目录 GetCurrentDir;//取当前目录名，无'\' Getdir(0,s);//取工作目录名s:='c:\abcdir'; Deletfile('abc.txt');//删除文件 Renamefile('old.txt','new.txt');//文件更名 ExtractFilename(filelistbox1.filename);//取文件名 ExtractFileExt(filelistbox1.filename);//取文件后缀
◇[DELPHI]处理文件属性 attr:=filegetattr(filelistbox1.filename); if (attr and faReadonly)=faReadonly then ... //只读 if (attr and faSysfile)=faSysfile then ... //系统 if (attr and faArchive)=faArchive then ... //存档 if (attr and faHidden)=faHidden then ... //隐藏
◇[DELPHI]执行程序外文件 WINEXEC//调用可执行文件 winexec('command.com /c copy *.* c:\',SW_Normal); winexec('start abc.txt'); ShellExecute或ShellExecuteEx//启动文件关联程序 function executefile(const filename,params,defaultDir:string;showCmd:integer):THandle; ExecuteFile('C:\abc\a.txt','x.abc','c:\abc\',0); ExecuteFile('http://tingweb.yeah.net','','',0); ExecuteFile('mailto:tingweb@wx88.net','','',0);
◇[DELPHI]取得系统运行的进程名 var hCurrentWindow:HWnd;szText:array[0..254] of char; begin hCurrentWindow:=Getwindow(handle,GW_HWndFrist); while hCurrentWindow <> 0 do begin if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext)); hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext); end; end; ◇[DELPHI]关于汇编的嵌入 Asm End; 可以任意修改EAX、ECX、EDX；不能修改ESI、EDI、ESP、EBP、EBX。 ◇[DELPHI]关于类型转换函数 FloatToStr//浮点转字符串 FloatToStrF//带格式的浮点转字符串 IntToHex//整数转16进制 TimeToStr DateToStr DateTimeToStr FmtStr//按指定格式输出字符串 formatDateTime('YYYY-MM-DD,hh-mm-ss',DATE); ◇[DELPHI]字符串的过程和函数 Insert(obj,target,pos);//字符串target插入在pos的位置。如插入结果大于target最大长度，多出字符将被截掉。如Pos在255以外，会产生运行错。例如，st:='Brian'，则Insert（'OK',st,2）会使st变为'BrOKian'。 Delete(st,pos,Num);//从st串中的pos（整型）位置开始删去个数为Num（整型）个字符的子字串。例如，st:='Brian'，则Delete(st,3,2)将变为Brn。 Str(value,st);//将数值value（整型或实型）转换成字符串放在st中。例如，a=2.5E4时，则str(a:10,st)将使st的值为' 25000'。 Val(st,var,code);//把字符串表达式st转换为对应整型或实型数值，存放在var中。St必须是一个表示数值的字符串，并符合数值常数的规则。在转换过程中，如果没有检测出错误，变量code置为0，否则置为第一个出错字符的位置。例如，st:=25.4E3,x是一个实型变量，则val(st,x,code)将使X值为25400，code值为0。 Copy(st.pos.num);//返回st串中一个位置pos（整型）处开始的，含有num（整型）个字符的子串。如果pos大于st字符串的长度，那就会返回一个空串，如果pos在255以外，会引起运行错误。例如，st:='Brian'，则Copy(st,2,2)返回'ri'。 Concat(st1,st2,st3……,stn);//把所有自变量表示出的字符串按所给出的顺序连接起来，并返回连接后的值。如果结果的长度255，将产生运行错误。例如，st1:='Brian',st2:=' ',st3:='Wilfred'，则Concat(st1,st2,st3)返回'Brian Wilfred'。 Length(st);//返回字符串表达式st的长度。例如，st:='Brian'，则Length(st)返回值为5。 Pos(obj,target);//返回字符串obj在目标字符串target的第一次出现的位置，如果target没有匹配的串，Pos函数的返回值为0。例如，target:='Brian Wilfred'，则Pos('Wil',target)的返回值是7，Pos('hurbet',target)的返回值是0。 ◇[DELPHI]关于处理注册表 uses Registry; var reg:Tregistry; reg:=Tregistry.create; reg.rootkey:='HKey_Current_User'; reg.openkey('Control Panel\Desktop',false); reg.WriteString('Title Wallpaper','0'); reg.writeString('Wallpaper',filelistbox1.filename); reg.closereg; reg.free; ◇[DELPHI]关于键盘常量名 VK_BACK/VK_TAB/VK_RETURN/VK_SHIFT/VK_CONTROL/VK_MENU/VK_PAUSE/VK_ESCAPE /VK_SPACE/VK_LEFT/VK_RIGHT/VK_UP/VK_DOWN F1--F12：$70(112)--$7B(123) A-Z：$41(65)--$5A(90) 0-9：$30(48)--$39(57) ◇[DELPHI]初步判断程序母语 DELPHI软件的DOS提示：This Program Must Be Run Under Win32. VC++软件的DOS提示：This Program Cannot Be Run In DOS Mode. ◇[DELPHI]操作Cookie response.cookies("name").domain:='http://www.086net.com'; with response.cookies.add do begin name:='username'; value:='username'; end 
[align=right][color=#000066][此贴子已经被作者于2006-10-12 22:49:44编辑过][/color][/align]

xu2000 发表于 2006-10-12 22:52

◇[DELPHI]增加到文档菜单连接 uses shellapi,shlOBJ; shAddToRecentDocs(shArd_path,pchar(filepath));//增加连接 shAddToRecentDocs(shArd_path,nil);//清空 ◇[杂类]备份智能ABC输入法词库 windows\system\user.rem windows\system\tmmr.rem ◇[DELPHI]判断鼠标按键 if GetAsyncKeyState(VK_LButton)<>0 then ... //左键 if GetAsyncKeyState(VK_MButton)<>0 then ... //中键 if GetAsyncKeyState(VK_RButton)<>0 then ... //右键 ◇[DELPHI]设置窗体的最大显示 onformCreate事件 self.width:=screen.width; self.height:=screen.height; ◇[杂类]隐藏共享文件夹 共享效果：可访问，但不可见（在资源管理、网络邻居中） 取共享名为：direction$ 访问：//computer/dirction/ ◇[Java Script]Java Script网页常用效果 网页60秒定时关闭 <script language="java script"></script> 关闭窗口 <a href="/" onclick="javascript:window.close();return false;">关闭</a> 定时转URL <meta http-equiv="refresh" content="40;url=http://www.086net.com"> 设为首页 <a onclick="this.style.behavior='url(#default#homepage)';this.sethomepage('http://086net.com');"href="#">设为首页</a> 收藏本站 <a href="javascript:window.external.addfavorite('http://086net.com','[未名码头]')">收藏本站</a> 加入频道 <a href="javascript:window.external.addchannel('http://086net.com')">加入频道</a> ◇[DELPHI]文本编辑相关 checkbox1.checked:=not checkbox1.checked; if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsBold] else richedit1.font.style:=richedit1.font.style-[fsBold]//粗体 if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsItalic] else richedit1.font.style:=richedit1.font.style-[fsItalic]//斜体 if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsUnderline] else richedit1.font.style:=richedit1.font.style-[fsUnderline]//下划线 memo1.alignment:=taLeftJustify;//居左 memo1.alignment:=taRightJustify;//居右 memo1.alignment:=taCenter;//居中 ◇[DELPHI]随机产生文本色 randomize;//随机种子 memo1.font.color:=rgb(random(255),random(255),random(255)); ◇[DELPHI]DELPHI5 UPDATE升级补丁序列号 1000003185 90X25fx0 ◇[DELPHI]文件名的非法字符过滤 for i:=1 to length(s) do if s[i] in ['\','/',':','*','?','<','>','|'] then ◇[DELPHI]转换函数的定义及说明 datetimetofiledate (datetime:Tdatetime):longint; 将Tdatetime格式的日期时间值转换成DOS格式的日期时间值 datetimetostr (datetime:Tdatetime):string; 将Tdatatime格式变量转换成字符串，如果datetime参数不包含日期值，返回字符串日期显示成为00/00/00，如果datetime参数中没有时间值，返回字符串中的时间部分显示成为00：00：00 AM datetimetostring (var result string; const format:string; datetime:Tdatetime); 根据给定的格式字符串转换时间和日期值，result为结果字符串，format为转换格式字符串，datetime为日期时间值 datetostr (date:Tdatetime) 使用shortdateformat全局变量定义的格式字符串将date参数转换成对应的字符串 floattodecimal (var result:Tfloatrec;value: extended;precision,decimals: integer); 将浮点数转换成十进制表示 floattostr (value:extended):string 将浮点数value转换成字符串格式，该转换使用普通数字格式，转换的有效位数为15位。 floattotext (buffer:pchar;value:extended; format:Tfloatformat;precision, digits:integer):integer; 用给定的格式、精度和小数将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函数返回值为存储到buffer中的字符位数，buffer是非0结果的字符串缓冲区。 floattotextfmt (buffer:pchar;value:extended; format:pchar):integer 用给定的格式将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函数返回值为存储到buffer中的字符位数。 inttohex (value:longint;digits:integer): string; 将给定的数值value转换成十六进制的字符串。参数digits给出转换结果字符串包含的数字位数。 inttostr (value:longint):string 将整数转换成十进制形式字符串 strtodate (const S:string):Tdatetime 将字符串转换成日期值，S必须包含一个合法的格式日期的字符串。 strtodatetime (const S:string):Tdatetime 将字符串S转换成日期时间格式，S必须具有MM/DD/YY HH：MM：SS[AM|PM]格式，其中日期和时间分隔符与系统时期时间常量设置相关。如果没有指定AM或PM信息，表示使用24小时制。 strtofloat (const S:string):extended; 将给定的字符串转换成浮点数，字符串具有如下格式： [+|-]nnn…[.]nnn…[<+|-><E|e><+|->nnnn] strtoint (const S:string):longint 将数字字符串转换成整数，字符串可以是十进制或十六进制格式，如果字符串不是一个合法的数字字符串，系统发生ECONVERTERROR异常 strtointdef (const S:string;default: longint):longint; 将字符串S转换成数字，如果不能将S转换成数字，strtointdef函数返回参数default的值。 strtotime (const S:string):Tdatetime 将字符串S转换成TDATETIME值，S具有HH：MM：SS[AM|PM]格式，实际的格式与系统的时间相关的全局变量有关。 timetostr (time:Tdatetime):string; 将参数TIME转换成字符串。转换结果字符串的格式与系统的时间相关常量的设置有关。 ◇[DELPHI]程序不出现在ALT+CTRL+DEL 在implementation后添加声明: function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏 RegisterServiceProcess(GetCurrentProcessID, 0);//显示 用ALT+DEL+CTRL看不见 ◇[DELPHI]程序不出现在任务栏 uses windows var Extendedstyle : Integer; begin Application.Initialize; //============================================================== Extendedstyle := GetWindowLong (Application.Handle, GWL_EXstyle); SetWindowLong(Application.Handle, GWL_EXstyle, Extendedstyle OR WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW); //=============================================================== Application.Createform(Tform1, form1); Application.Run; end. ◇[DELPHI]如何判断拨号网络是开还是关 if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then showmessage('在线!') else showmessage('不在线!'); ◇[DELPHI]实现IP到域名的转换 function GetDomainName(Ip:string):string; var pH:PHostent; data:twsadata; ii:dword; begin WSAStartup($101, Data); ii:=inet_addr(pchar(ip)); pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET); if (ph<>nil) then result:=pH.h_name else result:=''; WSACleanup; end; ◇[DELPHI]处理“右键菜单”方法 var reg: TRegistry; begin reg := TRegistry.Create; reg.RootKey:=HKEY_CLASSES_ROOT; reg.OpenKey('*\shell\check\command', true); reg.WriteString('', '"' + application.ExeName + '" "%1"'); reg.CloseKey; reg.OpenKey('*\shell\diary', false); reg.WriteString('', '操作(&C)'); reg.CloseKey; reg.Free; showmessage('DONE!'); end; ◇[DELPHI]发送虚拟键值ctrl V procedure sendpaste; begin keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0); keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), 0, 0); keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), KEYEVENTF_KEYUP, 0); keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0); end; ◇[DELPHI]当前的光驱的盘符 procedure getcdrom(var cd:char); var str:string; drivers:integer; driver:char; i,temp:integer; begin drivers:=getlogicaldrives; temp:=(1 and drivers); for i:=0 to 26 do begin if temp=1 then begin driver:=char(i+integer('a')); str:=driver+':'; if getdrivetype(pchar(str))=drive_cdrom then begin cd:=driver; exit; end; end; drivers:=(drivers shr 1); temp:=(1 and drivers); end; end; ◇[DELPHI]字符的加密与解密 function cryptstr(const s:string; stype: dword):string; var i: integer; fkey: integer; begin result:=''; case stype of 0: setpass; begin randomize; fkey := random($ff); for i:=1 to length(s) do result := result+chr( ord(s[i]) xor i xor fkey); result := result + char(fkey); end; 1: getpass begin fkey := ord(s[length(s)]); for i:=1 to length(s) - 1 do result := result+chr( ord(s[i]) xor i xor fkey); end; end; □◇[DELPHI]向其他应用程序发送模拟键 var h: THandle; begin h := FindWindow(nil, '应用程序标题'); PostMessage(h, WM_KEYDOWN, VK_F9, 0);//发送F9键 end; □◇[DELPHI]DELPHI 支持的DAO数据格式 td.Fields.Append(td.CreateField ('dbBoolean',dbBoolean,0)); td.Fields.Append(td.CreateField ('dbByte',dbByte,0)); td.Fields.Append(td.CreateField ('dbInteger',dbInteger,0)); td.Fields.Append(td.CreateField ('dbLong',dbLong,0)); td.Fields.Append(td.CreateField ('dbCurrency',dbCurrency,0)); td.Fields.Append(td.CreateField ('dbSingle',dbSingle,0)); td.Fields.Append(td.CreateField ('dbDouble',dbDouble,0)); td.Fields.Append(td.CreateField ('dbDate',dbDate,0)); td.Fields.Append(td.CreateField ('dbBinary',dbBinary,0)); td.Fields.Append(td.CreateField ('dbText',dbText,0)); td.Fields.Append(td.CreateField ('dbLongBinary',dbLongBinary,0)); td.Fields.Append(td.CreateField ('dbMemo',dbMemo,0)); td.Fields['ID'].Set_Attributes(dbAutoIncrField);//自增字段

xu2000 发表于 2006-10-12 22:53

□◇[DELPHI]DELPHI配置MS SQL 7和BDE步骤 第一步，配置ODBC： 先在ODBC 中设数据源，安装过SQL Server7.0 后,ODBC中有一项"系统DSN"应该有两项 数据源，一个是MQIS，一个是LocalSever，任选一个选后点击配置按钮，不知你的SQL7.0 是不是安装在本地机器上，如果是的话直接进行下一步，如果不是，在服务器一栏中填上 Server,然后进行下一步，填写登录ID 和密码（登录ID，和密码是在SQL7.0中的用户选项 中设的）。 第二步，配置BDE: 打开Delphi的BDE，然后点击MQIS 或 LocalServer，就会提示用户名和密码，这和 ODBC的用户名和密码是一样的，填上就行了。 第三步，配置程序： 如果用的是TTable，就在TTable的DatabaseName中选择MQIS 或LocalServer,然后在 TableName中选择Sale就行了，然后将Active改为True,Delphi弹出提示对话，填入用户 名和密码。 如果用的是TQuery,在TQuery上点击右键，再击"SQL Builder"，这是以界面方式配置 SQL语句，或者在TQuery的SQL中填入SQL语句。最后，别忘了将Active改为True。 在运行也可能配置TQuery,具体见Delphi帮助。 □◇[DELPHI]得到图像上某一点的RGB值 procedure Tform1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var red,green,blue:byte ; i:integer; begin i:= image1.Canvas.Pixels[x,y]; Blue:= GetBvalue(i); Green:= GetGvalue(i): Red:= GetRvalue(i); Label1.Caption:=inttostr(Red); Label2.Caption:=inttostr(Green); Label3.Caption:=inttostr(Blue); end; □◇[DELPHI]关于日期格式分解转换 var year,month,day:word;now2:Tdatatime; now2:=date(); decodedate(now2,year,month,day); lable1.Text :=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日'; ◇[DELPHI]如何判断当前网络连接方式 判断结果是MODEM、局域网或是代理服务器方式。 uses wininet; Function ConnectionKind :boolean; var flags: dword; begin Result := InternetGetConnectedState(@flags, 0); if Result then begin if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then begin showmessage('Modem'); end; if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then begin showmessage('LAN'); end; if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then begin showmessage('Proxy'); end; if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then begin showmessage('Modem Busy'); end; end; end; ◇[DELPHI]如何判断字符串是否是有效EMAIL地址 function IsEMail(EMail: String): Boolean; var s: String;ETpos: Integer; begin ETpos:= pos('@', EMail); if ETpos > 1 then begin s:= copy(EMail,ETpos+1,Length(EMail)); if (pos('.', s) > 1) and (pos('.', s) < length(s)) then Result:= true else Result:= false; end else Result:= false; end; ◇[DELPHI]判断系统是否连接INTERNET 需要引入URL.DLL中的InetIsOffline函数。 函数申明为： function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL'; 然后就可以调用函数判断系统是否连接到INTERNET if InetIsOffline(0) then ShowMessage('not connected!') else ShowMessage('connected!'); 该函数返回TRUE如果本地系统没有连接到INTERNET。 附： 大多数装有IE或OFFICE97的系统都有此DLL可供调用。 InetIsOffline BOOL InetIsOffline( DWORD dwFlags, ); ◇[DELPHI]简单地播放和暂停WAV文件 uses mmsystem; function PlayWav(const FileName: string): Boolean; begin Result := PlaySound(PChar(FileName), 0, SND_ASYNC); end; procedure StopWav; var buffer: array[0..2] of char; begin buffer[0] := #0; PlaySound(Buffer, 0, SND_PURGE); 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]网络下载文件 uses UrlMon; function DownloadFile(Source, Dest: string): Boolean; begin try Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0; except Result := False; end; end; if DownloadFile('http://www.borland.com/delphi6.zip, 'c:\kylix.zip') then ShowMessage('Download succesful') else ShowMessage('Download unsuccesful') ◇[DELPHI]解析服务器IP地址 uses winsock function IPAddrToName(IPAddr : String): String; var SockAddrIn: TSockAddrIn; HostEnt: PHostEnt; WSAData: TWSAData; begin WSAStartup($101, WSAData); SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr)); HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); if HostEnt<>nil then result:=StrPas(Hostent^.h_name) else result:=''; end; ◇[DELPHI]取得快捷方式中的连接 function ExeFromLink(const linkname: string): string; var FDir, FName, ExeName: PChar; z: integer; begin ExeName:= StrAlloc(MAX_PATH); FName:= StrAlloc(MAX_PATH); FDir:= StrAlloc(MAX_PATH); StrPCopy(FName, ExtractFileName(linkname)); StrPCopy(FDir, ExtractFilePath(linkname)); z:= FindExecutable(FName, FDir, ExeName); if z > 32 then Result:= StrPas(ExeName) else Result:= ''; StrDispose(FDir); StrDispose(FName); StrDispose(ExeName); end; ◇[DELPHI]控制TCombobox的自动完成 {'Sorted' property of the TCombobox to true } var lastKey: Word; //全局变量 //TCombobox的OnChange事件 procedure Tform1.AutoCompleteChange(Sender: TObject); var SearchStr: string; retVal: integer; begin SearchStr := (Sender as TCombobox).Text; if lastKey <> VK_BACK then // backspace: VK_BACK or $08 begin retVal := (Sender as TCombobox).Perform(CB_FINDSTRING, -1, LongInt(PChar(SearchStr))); if retVal > CB_Err then begin (Sender as TCombobox).ItemIndex := retVal; (Sender as TCombobox).SelStart := Length(SearchStr); (Sender as TCombobox).SelLength := (Length((Sender as TCombobox).Text) - Length(SearchStr)); end; // retVal > CB_Err end; // lastKey <> VK_BACK lastKey := 0; // reset lastKey end; //TCombobox的onKeyDown事件 procedure Tform1.AutoCompleteKeyDown(Sender: TObject; var Key: Word; 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]如何计算一个目录的大小 function GetDirectorySize(const ADirectory: string): Integer; var Dir: TSearchRec; Ret: integer; Path: string; begin Result := 0; Path := ExtractFilePath(ADirectory); Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir); if Ret <> NO_ERROR then exit; try while ret=NO_ERROR do begin inc(Result, Dir.Size); if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*')); Ret := Sysutils.FindNext(Dir); end; finally Sysutils.FindClose(Dir); 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; ◇[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;

xu2000 发表于 2006-10-12 22:53

◇[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。<LINK REL=styleSheet HREF="basics.css" TITLE="Contemporary">//连接一个外部样式表 3。嵌入一个样式表 <style TYPE="text/css" MEDIA=screen>  </style> 4。 //内联样式 Arial//SPAN接受style、CLASS和ID属性 <DIV CLASS=note>DIV可以包含段落、标题、表格甚至其它部分</DIV> 5。<H1 CLASS=punk>CLASS属性</H1>//定义见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:[<URLs> | 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]) * $100 + 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); //?ミMSSQL?? Session1.SaveConfigFile; finally MyList.Free; Session1.Active:=True; Database1.DatabaseName:='DB'; Database1.AliasName:='TESTSQL'; Database1.LoginPrompt:=False; Database1.Params.Add('USER NAME=sa'); Database1.Params.Add('PASSWORD='); Database1.Connected:=True; end; end; procedure Tform1.Button2Click(Sender: TObject); begin Database1.Connected:=False; Session1.DeleteAlias('TESTSQL'); ?? end; ◇[DELPHI]播放背景音乐 uses mmsystem //播放音乐 MCISendString('OPEN e:\1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0); MCISendString('PLAY NN FROM 0', '', 0, 0); MCISendString('CLOSE ANIMATION', '', 0, 0); end; //停止播放 MCISendString('OPEN e:\1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0); MCISendString('STOP NN', '', 0, 0); MCISendString('CLOSE ANIMATION', '', 0, 0); ◇[DELPHI]接口和类的一个范例代码 Type{接口和类申明：区别在于不能在接口中申明数据成员、任何非公有的方法、公共方法不使用PUBLIC关键字} Isample=interface//定义Isample接口 function getstring:string; end; Tsample=class(TInterfacedObject,Isample) public function getstring:string; end; //function定义 function Tsample.getstring:string; begin result:='what show is '; end; //调用类对象 var sample:Tsample; begin sample:=Tsample.create; showmessage(sample.getstring+'class object!'); sample.free; end; //调用接口 var sampleinterface:Isample; sample:Tsample; begin sample:=Tsample.create; sampleInterface:=sample;//Interface的实现必须使用class {以上两行也可表达成sampleInterface:=Tsample.create;} showmessage(sampleInterface.getstring+'Interface!'); //sample.free;{和局部类不同，Interface中的类自动释放} sampleInterface:=nil;{释放接口对象} end; ◇[DELPHI]任务条就看不当程序 var Extendedstyle : Integer; begin Application.Initialize; Extendedstyle := GetWindowLong (Application.Handle, GWL_EXstyle); SetWindowLong(Application.Handle, GWL_EXstyle, Extendedstyle OR WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW); Application.Createform(Tform1, form1); Application.Run; end. ◇[DELPHI]ALT+CTRL+DEL看不到程序 在implementation后添加声明: function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏 RegisterServiceProcess(GetCurrentProcessID, 0);//显示 ◇[DELPHI]检测光驱符号 var drive:char; cdromID:integer; begin for drive:='d' to 'z' do begin cdromID:=GetDriveType(pchar(drive+':\')); if cdromID=5 then showmessage('你的光驱为:'+drive+'盘!'); end; end; ◇[DELPHI]检测声卡 if auxGetNumDevs()<=0 then showmessage('No soundcard found!') else showmessage('Any soundcard found!'); ◇[DELPHI]在字符串网格中画图 StringGrid.OnDrawCell事件 with StringGrid1.Canvas do Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic); ◇[SQL SERVER]SQL中代替Like语句的另一种写法 比如查找用户名包含有"c"的所有用户, 可以用 use mydatabase select * from table1 where username like'%c%" 下面是完成上面功能的另一种写法: use mydatabase select * from table1 where charindex('c',username)>0 这种方法理论上比上一种方法多了一个判断语句,即>0, 但这个判断过程是最快的, 我想信80%以上的运算都是花在查找字 符串及其它的运算上, 所以运用charindex函数也没什么大不了. 用这种方法也有好处, 那就是对%,|等在不能直接用like 查找到的字符中可以直接在这charindex中运用, 如下: use mydatabase select * from table1 where charindex('%',username)>0 也可以写成: use mydatabase select * from table1 where charindex(char(37),username)>0 ASCII的字符即为% ◇[DELPHI]SQL显示多数据库/表 SELECT DISTINCT A.bianhao,a.xingming, b.gongzi FROM "jianjie.dbf" a, "gongzi.DBF" b WHERE A.bianhao=b.bianhao ◇[DELPHI]RFC(Request For Comment)相关 IETF(Internet Engineering Task Force)维护RFC文档http://www.ietf.cnri.reston.va.us RFC882：报文头标结构 RFC1521：MIME第一部分，传输报文方法 RFC1945：多媒体文档传输文档 ◇[DELPHI]TNMUUProcessor的使用 var inStream,outStream:TFileStream; begin inStream:=TFileStream.create(infile.txt,fmOpenRead); outStream:=TFileStream(outfile.txt,fmCreate); NMUUE.Method:=uuCode;{UUEncode/Decode} //NMUUE.Method:=uuMIME;{MIME} NMUUE.InputStream:=InStream; NMUUE.OutputStream:=OutStream; NMUUE.Encode;{编码处理} //NMUUE.Decode;{解码处理} inStream.free; outStream.free; end;

xu2000 发表于 2006-10-12 22:55

◇[DELPHI]TFileStream的操作 //从文件流当前位置读count字节到缓冲区BUFFER function read(var buffer;count:longint):longint;override; //将缓冲区BUFFER读到文件流中 function write(const buffer;count:longint):longint;override; //设置文件流当前读写指针为OFFSET function seek(offset:longint;origin:word):longint;override; origin={soFromBeginning,soFromCurrent,soFromEnd} //从另一文件流中当前位置复制COUNT到当前文件流当前位置 function copyfrom(source:TStream;count:longint):longint; //读指定文件到文件流 var myFStream:TFileStream; begin myFStream:=TFileStream.create(OpenDialog1.filename,fmOpenRead); end; [javascript]检测是否安装IE插件Shockwave&Quicktime <script LANGUAGE="javascript"> var myPlugin = navigator.plugins["Shockwave"]; if (myPlugin) document.writeln("你已经安装了 Shockwave!") else document.writeln("你尚未安装 Shockwave!") </script> <script LANGUAGE="javascript"> var myPlugin = navigator.plugins["Quicktime"]; if (myPlugin) document.writeln("你已经安装了Quicktime!") else document.writeln("你尚未安装 Quicktime!") </script> [INTERNET]表格中引用IFRAME效果 <table border="0" cellpadding="0" cellspacing="0" width="100%"> <tr> <td><ILAYER id="ad1" visibility="hidden" height="60"></ILAYER> <NOLAYER> <IFRAME SRC="i:\jinhtml\zj\h21.htm" width="500" height="200" marginwidth="0" marginheight="110" hspace="10" vspace="20" frameborder="0" scrolling="1"></IFRAME> </NOLAYER> </td> </tr> </table> ◇[DELPHI]WebBrowser控件技巧 1。实现打印功能 var vaIn, vaOut: OleVariant; WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); 2。WebBrowser从流中读取页面 function Tform1.LoadFromStream(const AStream: TStream): HRESULT; begin AStream.seek(0, 0); Result := (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(AStream)); end; 3。"about:" protocol will let you Navigate to an HTML string: procedure Tform1.LoadHTMLString(sHTML: String); var Flags, TargetFrameName, PostData, Headers: OleVariant; WebBrowser1.Navigate('about:' + sHTML, Flags, TargetFrameName, PostData, Headers) 4。"res:" protocol will let you Navigate to an HTML file stored as a resource. More informations is available from the Microsoft site: procedure Tform1.LoadHTMLResource; var Flags, TargetFrameName, PostData, Headers: OleVariant; WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml', Flags, TargetFrameName, PostData, Headers) 使用brcc32.exe建立资源文件 (*.rc) MYHTML 23 ".\html\myhtml.htm" MOREHTML 23 ".\html\morehtml.htm" {$R HTML.RES} //html.rc被编译成html.res 5。保存完整的HTML文件 var HTMLDocument: IHTMLDocument2; Persistfile: IPersistFile; begin HTMLDocument := WebBrowser1.Document as IHTMLDocument2; PersistFile := HTMLDocument as IPersistFile; PersistFile.Save(StringToOleStr('test.htm'), True); while HTMLDocument.readyState <> 'complete' do Application.ProcessMessages; end; ◇[DELPHI]安装WebBrowser控件（内嵌IE控件） 你必须先确定系统已安装Internet Explorer4或以后版本，DELPHI菜单--Component- - Import ActiveX Contro，列表中选择Microsoft Internet Controls"并ADD到一个已存在的包文件中，WebBrowser控件将显示在ActiveX控件面板。 ◇[DELPHI]实现windows2000半透明窗体 function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明 procedure Tform1.formCreate(Sender: TObject); var l:longint; begin l:=getWindowLong(Handle, GWL_EXstyle); l := l Or $80000; SetWindowLong (handle, GWL_EXstyle, l); SetLayeredWindowAttributes(handle, 0, 180, 2); end; ◇[DELPHI]程序显示广告WebBrowser加载图片 var Flag, frame, pData, Header: OLEVariant; begin WebBrowser1.Navigate('http://www.chineseall.com/images/logo.jpg', flag, frame,pData, Header) end; ◇[DELPHI]计算一个目录的大小 function GetDirectorySize(const ADirectory: string): Integer; var Dir: TSearchRec; Ret: integer; Path: string; begin Result := 0; Path := ExtractFilePath(ADirectory); Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir); if Ret <> NO_ERROR then exit; try while ret=NO_ERROR do begin inc(Result, Dir.Size); //如果是目录，且不是'.'或'..'则进行递归调用 if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*')); Ret := Sysutils.FindNext(Dir); end; finally Sysutils.FindClose(Dir); end; 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]发布ADO程序之安装ADO 运行一次 MDac_typ.exe ，这个文件在微软的 Windows、IE、Office、Visual Studio 中都有。 安装程序所安装后的目录与程序中设置的目录路径一样，C:\Program Files\Common Files\System\ado文件夹中有没有ADO组件，装ACCESS2000就有ADO2.1，没有则安装MS OFfice2000，编译要去掉project->Option->Packages对话框中的Build With RunTime Library的勾。 ◇[DELPHI]拦截Windows系统消息：WM_CLOSE消息 procedure WMClose(var Msg: TMessage);message WM_CLOSE; procedure TMainform.WMClose(var Msg: TMessage); begin m_bCloseNoQuery := false; inherited; end; 　 来自：Adnil, 时间：2002-3-26 14:54:00, ID：1003492 强！ 大致看了一下，提两个修改意见： ◇[DELPHI]设置窗体的最大显示 onformCreate事件 self.width:=screen.width; self.height:=screen.height; 修改： self.windowstate := wsmaxmized; ◇[DELPHI]文件名的非法字符过滤 for i:=1 to length(s) do if s[i] in ['\','/',':','*','?','<','>','|'] then 修改： try slist := tstringlist.create; slist.savetofile(s); result := true; deletefile(s); except result := false; end; 利用异常机制，这样可以兼容linux的文件命名。 追加部分 ◇[DELPHI]配置ODBC的代码 var reg: TRegistry; Driver: string; begin //建立和更新odbc数据源 //查找ODBCINST.INI键,如果sql server的驱动程序没有安装，则提示退出 //如果存在，则进行配置 reg := TRegistry.Create; try with reg do begin RootKey := HKEY_LOCAL_MACHINE; if OpenKey('Software\ODBC\ODBCINST.INI\SQL Server', False) then begin //如果存在sql server 驱动程序 Driver := ReadString('Driver'); CloseKey; if OpenKey('Software\ODBC\ODBC.INI\ODBC Data Sources', True) then begin //注册一个DSN名称 WriteString(Edit_DataSource.Text, 'SQL Server'); end else begin //创建键值失败 Application.MessageBox(pchar('在创建DSN' + edit_datasource.text + '时发生错误'), '创建ODBC数据源失败', MB_ICONINformATION or MB_OK); exit; end; CloseKey; //end 建立dsn if OpenKey('Software\ODBC\ODBC.INI\' + Edit_DataSource.Text, True) then begin WriteString('Database', Edit_DataSource.Text); WriteString('Driver', Driver); WriteString('LastUser', Edit_LoginUser.Text); WriteString('Server', Edit_Ip.Text); end else begin //创建键值失败 Application.MessageBox(pchar('在创建DSN' + edit_datasource.text + '时发生错误'), '创建ODBC数据源失败', MB_ICONINformATION or MB_OK); exit; end; CloseKey; end else Application.MessageBox('在当前机器上没有安装 SQL Server的ODBC 驱动程序!，请安装相应的驱动程序', '驱动程序出错', MB_ICONINformATION or MB_OK); CloseKey; end; finally reg.Free; end; end; ◇[DELPHI]验证邮件地址有效函数 function IsValidEmail(const value: string): boolean; function CheckAllowed(const s: string): boolean; var i: integer; begin Result:= false; for i:= 1 to Length(s) do begin // illegal char in s -> no valid address if not (s[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then Exit; end; Result:= true; end; var i: integer; namePart, serverPart: string; begin // of IsValidEmail Result:= false; i:= Pos('@', value); if (i = 0) or (pos('..', value) > 0) then Exit; namePart:= Copy(value, 1, i - 1); serverPart:= Copy(value, i + 1, Length(value)); if (Length(namePart) = 0) // @ or name missing or ((Length(serverPart) < 4)) // name or server missing or then Exit; // too short i:= Pos('.', serverPart); // must have dot and at least 3 places from end if (i = 0) or (i >= (Length(serverPart) - 2)) then Exit; Result:= CheckAllowed(namePart) and CheckAllowed(serverPart); end; ◇[DELPHI]设定IE的默认打开主页 procedure SetStartPage(StartPage:string); var Reg:TRegistry; begin Reg:=TRegistry.Create; Reg.RootKey:=HKEY_CURRENT_USER; Reg.OpenKey(StartPagePath,False); Reg.WriteString('Start Page',StartPage); Reg.Free; end; ◇[DELPHI]form边缘特效 procedure Tform1.formCreate(Sender: TObject); var Region1 : array of tPoint; Region1hrgn : hRgn; Begin SetLength(Region1,59); Region1[0].X:=12; Region1[0].Y:=6; Region1[1].X:=484; Region1[1].Y:=6; Region1[2].X:=484; Region1[2].Y:=7; Region1[3].X:=486; Region1[3].Y:=7; Region1[4].X:=486; Region1[4].Y:=8; Region1[5].X:=487; Region1[5].Y:=8; Region1[6].X:=487; Region1[6].Y:=9; Region1[7].X:=488; Region1[7].Y:=9; Region1.X:=488; Region1.Y:=10; Region1[9].X:=489; Region1[9].Y:=10; Region1[10].X:=489; Region1[10].Y:=12; Region1[11].X:=490; Region1[11].Y:=12; Region1[12].X:=490; Region1[12].Y:=285; Region1[13].X:=489; Region1[13].Y:=285; Region1[14].X:=489; Region1[14].Y:=287; Region1[15].X:=488; Region1[15].Y:=287; Region1[16].X:=488; Region1[16].Y:=288; Region1[17].X:=487; Region1[17].Y:=288; Region1[18].X:=487; Region1[18].Y:=289; Region1[19].X:=486; Region1[19].Y:=289; Region1[20].X:=486; Region1[20].Y:=290; Region1[21].X:=484; Region1[21].Y:=290; Region1[22].X:=484; Region1[22].Y:=291; Region1[23].X:=101; Region1[23].Y:=291; Region1[24].X:=100; Region1[24].Y:=290; Region1[25].X:=99; Region1[25].Y:=290; Region1[26].X:=98; Region1[26].Y:=289; Region1[27].X:=97; Region1[27].Y:=288; Region1[28].X:=96; Region1[28].Y:=287; Region1[29].X:=95; Region1[29].Y:=286; Region1[30].X:=95; Region1[30].Y:=284; Region1[31].X:=94; Region1[31].Y:=283; Region1[32].X:=94; Region1[32].Y:=200; Region1[33].X:=93; Region1[33].Y:=199; Region1[34].X:=93; Region1[34].Y:=198; Region1[35].X:=92; Region1[35].Y:=197; Region1[36].X:=91; Region1[36].Y:=196; Region1[37].X:=90; Region1[37].Y:=195; Region1[38].X:=89; Region1[38].Y:=194; Region1[39].X:=88; Region1[39].Y:=194; Region1[40].X:=87; Region1[40].Y:=193; Region1[41].X:=14; Region1[41].Y:=193; Region1[42].X:=13; Region1[42].Y:=192; Region1[43].X:=12; Region1[43].Y:=192; Region1[44].X:=11; Region1[44].Y:=191; Region1[45].X:=10; Region1[45].Y:=190; Region1[46].X:=9; Region1[46].Y:=189; Region1[47].X:=8; Region1[47].Y:=188; Region1[48].X:=8; Region1[48].Y:=187; Region1[49].X:=7; Region1[49].Y:=186; Region1[50].X:=7; Region1[50].Y:=184; Region1[51].X:=6; Region1[51].Y:=183; Region1[52].X:=6; Region1[52].Y:=12; Region1[53].X:=7; Region1[53].Y:=11; Region1[54].X:=7; Region1[54].Y:=10; Region1[55].X:=8; Region1[55].Y:=9; Region1[56].X:=9; Region1[56].Y:=8; Region1[57].X:=10; Region1[57].Y:=7; Region1[58].X:=11; Region1[58].Y:=7; Region1hrgn:=CreatePolygonRgn(Region1[0],59,2); SetWindowRgn(Handle, Region1hrgn, True); end; ◇[DELPHI]LISTVIEW实现隔行背景颜色 procedure Tform1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean); begin if item.Index mod 2 = 1 then begin sender.Canvas.Brush.Color:=clYellow; end else sender.Canvas.Brush.Color:=clwhite; end; ◇[DELPHI]判断机器是否网络状态 uses WinInet; procedure Tform1.Button1Click(Sender: TObject); function GetOnlineStatus : Boolean; var ConTypes : Integer; begin ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; if (InternetGetConnectedState(@ConTypes, 0) = False) then Result := False else Result := True; end; begin if not GetOnlineStatus then ShowMessage('Not Connected'); end; ◇[DELPHI]窗体渐渐出现 AnimateWindow(Handle,1000,AW_CENTER); //在窗体创建事件中 ◇[DELPHI]制作竖式菜单图片的关键代码 ONDrawItem事件 begin acanvas.Draw(0,2,image1.picture.bitmap); anvas.TextOut(arect.left+image1.picture.bitmap.width+2,arect.top,tmenuitem(sender).caption); end; ◇[软件开发]目前几个热门开发工具含义 Borland Enterprise Studio, Java Edition 是一个完整的电子商务开发平台，能够加速 J2EE架构的电子商务应用系统投向市场的周期。 Borland Enterprise Studio提供了完整的应用程序开发周期解决方案， 全面集成业界领先的Java 应用设计、开发和过程管理解决方案。 包含以下技术： Borland JBuilder：市场份额居首位的 Java 开发工具 Borland AppServer：企业级 J2EE 应用服务器 Rational Rose Modeler 2001：世界领先的可视化建模工具 Rational Rose with JBuilder integration：建立在 Rose 模型和 JBuilder 应用程序之间的双向引擎 Rational Unified Process：最先进的软件开发管理思想和工具 ◇[软件开发]Rational的工具集的功能解释 Rational Suite是Rational公司开发的一套为协助软件开发者进行软件开发的协 助工具套件，主要由以下几个软件构成(中文译名按Rational中国代理翻译）： Rational Unified Process Requisite Pro需求管理工具（整个开发过程） Clear Case配置管理工具（整个开发过程，包括版本管理、进程控制） Clear Quest变更请求管理工具（整个开发过程） SoDA自动文档管理工具（整个开发过程） ROSE可视化建模工具（建立软件模型，进行正向、逆向软件工程[engineering]） Robot（软件测试用，通过Script自动模拟输入输出） TestFactory（软件测试用） Pure Coverage（测试时用，能自动检查那些代码没有被测试） Purify（测试时用，检查运行时内存错误） Quantify（性能检测工具，查出系统瓶颈以便改进运行速度） LoadTest Performance Architect 面向不同的用户，Rational把以上的软件打成不同的开发包： Analyst Studio 主要面向系统分析员 Development Studio 主要面向软件开发者 Test Studio 主要面向测试工作者 Performance Studio Enterprise 主要面向企业 ◇[软件开发]除rose以外UML设计工具 国内常见： 1、Visual Modeler——微软的，安装Visual Studio就有,只是功能有点简单； 2、Rational Rose2000——Rational公司的，不用说啦，你嫌贵； 3、Paradigm Plus——CA公司的，太平洋公司代理，和Rose差不多具有强大的功能，只是Rational别的支持系统（如配置管理、测试）就不和他兼容了； 4、PlayCase——中科院沈阳研究所的，免费（强烈推荐试一试,因为它同时支持IDEF，也支持中国的MIS系统的要命的步骤：组织结构图——业务结构)； 5、Viso2000——也是微软的了，价格也不算太贵，不过用来做软件有点麻烦

无名游客 发表于 2006-10-29 07:41

经典啊 谢谢楼主

菜鸟上路 发表于 2006-10-29 19:52

uses shellapi; copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false); 这条语句的targer.txt文件是复制在哪个目录下啊??

ty2 发表于 2006-11-13 13:31

楼主涉猎好广泛呀！
请问能不能发些类的属性及方法方面的资料来看看呀？
谢谢了！

海心浮云 发表于 2007-6-3 19:20

好多，谢谢啦

scutSolo 发表于 2008-2-20 23:57

楼主好人啊

这么好的楼主
不服不行

chb592657370 发表于 2008-5-19 14:01

挺详细啊，Copy下来学习了。谢谢楼主，[em14]

hczsea 发表于 2008-7-1 17:29

强人啊。。。。。。。。

快影发表于 2008-7-2 19:46

精华啊..[tk05]

ninu 发表于 2008-7-2 20:05

太NB了，顶

mp3aaa 发表于 2008-7-5 09:49

好不错

页: [1]

编程论坛's Archiver

[转载]先人的DELPHI基础开发技巧

楼主好人啊