【分享】Delphi编程技巧集锦(二)

阿杰发表于 2009-7-26 14:52:14

◇截获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;
◇得到硬盘序列号 var SerialNum : pdword; a, b : dword; Buffer : array of char; begin if GetVolumeInformation('c:\', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^); end;
◇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;
◇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.Field.FocusControl else begin Table1.next; DBGrid1.Columns.field.FocusControl; end; end;
◇如何安装控件 安装方法: 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目录中即可。
◇目录完全删除(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;
◇取得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);//行长
◇读硬盘序列号 function GetDiskSerial(DiskChar: Char): string; var SerialNum : pdword; a, b : dword; Buffer : array of char; begin result := ""; if GetVolumeInformation(PChar(diskchar+":\"), Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then 　Result := IntToStr(SerialNum^); end;
◇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: ; 字体大小:font-size: 文本修饰:text-decoration:[ underline || overline || line-through || blink ] 文本转换:text-transform: 背景颜色:background-color:[<颜色> | transparent] 背景图象:background-image:[ | none] 行高:line-height: 边框样式:border-style: [ none | dotted | dashed | solid | double | groove | ridge | inset | outset ] 漂浮:float: 8。长度单位 相对单位: em (em,元素的字体的高度) ex (x-height,字母 "x" 的高度) px (像素,相对于屏幕的分辨率) 绝对长度: in (英寸,1英寸=2.54厘米) cm (厘米,1厘米=10毫米) mm (米) pt (点,1点=1/72英寸) pc (帕,1帕=12点)
◇VCL制作简要步骤 1.创建部件属性方法事件 (建立库单元,继承为新的类型,添加属性、方法、事件,注册部件,建立包文件) 2.消息处理 3.异常处理 4.部件可视
◇动态连接库的装载 静态装载:procedure name;external 'lib.dll'; 动态装载:var handle:Thandle; handle:=loadlibrary('lib.dll'); if handle<>0 then begin {dosomething} freelibrary(handle); end;
◇指针变量和地址 var x,y:integer;p:^integer;//指向INTEGER变量的指针 x:=10;//变量赋值 p:=@x;//变量x的地址 y:=p^;//为Y赋值指针P @@procedure//返回过程变量的内存地址
◇判断字符是汉字的一个字符 ByteType('你好haha吗',1) = mbLeadByte//是第一个字符 ByteType('你好haha吗',2) = mbTrailByte//是第二个字符 ByteType('你好haha吗',5) = mbSingleByte//不是中文字符
◇memo的定位操作 memo1.lines.delete(0)//删除第1行 memo1.selstart:=10//定位10字节处
◇获得双字节字符内码 function getit(s: string): integer; begin Result := byte(s) * 0 + byte(s); end; 使用:getit('计')//$bcc6 即十进制 48326
◇调用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")
◇将文件存到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;
◇把文件全部复制到剪贴板 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;
◇列举当前系统运行进程 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;
◇根据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;
◇最菜理解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}
◇动态读取程序自身大小 function GesSelfSize: integer; var f: file of byte; begin filemode := 0; assignfile(f, application.exename); reset(f); Result := filesize(f);//单位是字节 closefile(f); end;
◇读取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;
◇动态建立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;
◇播放背景音乐 uses mmsystem //播放音乐 MCISendString('OPEN e:.MID TYPE SEQUENCER ALIAS NN', '', 0, 0); MCISendString('PLAY NN FROM 0', '', 0, 0); MCISendString('CLOSE ANIMATION', '', 0, 0); end; //停止播放 MCISendString('OPEN e:.MID TYPE SEQUENCER ALIAS NN', '', 0, 0); MCISendString('STOP NN', '', 0, 0); MCISendString('CLOSE ANIMATION', '', 0, 0);
◇接口和类的一个范例代码 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;
◇任务条就看不当程序 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.
◇ALT+CTRL+DEL看不到程序 在implementation后添加声明: function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL'; RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏 RegisterServiceProcess(GetCurrentProcessID, 0);//显示
◇检测光驱符号 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;
◇检测声卡 if auxGetNumDevs()<=0 then showmessage('No soundcard found!') else showmessage('Any soundcard found!');
◇在字符串网格中画图 StringGrid.OnDrawCell事件 with StringGrid1.Canvas do Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
◇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的字符即为%
◇SQL显示多数据库/表 SELECT DISTINCT A.bianhao,a.xingming, b.gongzi FROM "jianjie.dbf" a, "gongzi.DBF" b WHERE A.bianhao=b.bianhao
◇RFC(Request For Comment)相关 IETF(Internet Engineering Task Force)维护RFC文档<a href="http://www.ietf.cnri.reston.va.us/">http://www.ietf.cnri.reston.va.us</a> RFC882:报文头标结构 RFC1521:MIME第一部分,传输报文方法 RFC1945:多媒体文档传输文档
◇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;
◇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; 检测是否安装IE插件Shockwave&Quicktime var myPlugin = navigator.plugins["Shockwave"]; if (myPlugin) document.writeln("你已经安装了 Shockwave!") else document.writeln("你尚未安装 Shockwave!")
var myPlugin = navigator.plugins["Quicktime"]; if (myPlugin) document.writeln("你已经安装了Quicktime!") else document.writeln("你尚未安装 Quicktime!")

eye0eye 发表于 2009-7-29 14:03:06

好东西。学习中！

upring 发表于 2015-6-6 13:10:45

支持阿杰整理分享

页: [1]

紫水晶编程技术论坛 - 努力打造成全国最好的编程论坛's Archiver

【分享】Delphi编程技巧集锦(二)