Delphi笔记

      2020-05-23 08:54      HTML5

本人今天把自已以前的一些delphi编程经验进行个小总结,总结完后突有一个这样的想法:如果我把这些总结发给网上的delphi朋友,而他们如果也有些自已的delphi编程小结,也发给我(如果愿意的话),这样大家的进步肯定是很快的。本人email:[email protected](1).按下ctrl和其它键之后发生一事件。procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);beginif (ssCtrl in Shift) and (key =67) thenshowmessage('keydown Ctrl+C');end;(2).Dbgrid中用Enter键代替Tab键.procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);beginif Key = #13 thenif ActiveControl = DBGrid1 thenbeginTDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1;Key := #0;end;end;(3).Dbgrid中选择多行发生一事件。procedure TForm1.Button1Click(Sender: TObject);vari:integer;bookmarklist:Tbookmarklist;bookmark:tbookmarkstr;beginbookmark:=adoquery1.Bookmark;bookmarklist:=dbgrid1.SelectedRows;trybeginfor i:=0 to bookmarklist.Count-1 dobeginadoquery1.Bookmark:=bookmarklist[i];with adoquery1 dobeginedit;fieldbyname('mdg').AsString:=edit2.Text;post;end;end;end;finallyadoquery1.Bookmark:=bookmark;end;end;(4).Form的一个出现效果。procedure TForm1.Button1Click(Sender: TObject);varr:thandle;i:integer;beginfor i:=1 to trunc(width/1.414) dobeginr:=CreateEllipticRgn(trunc(width/2)-i,trunc(height/2)-i,trunc(width/2)+i,trunc(height/2)+i);SetWindowRgn(handle,r,true);Application.ProcessMessages;sleep(1);end;end;(5).用Enter代替Tab在编辑框中移动隹点。procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);beginif key=#13 thenbeginif not (Activecontrol is Tmemo) thenbeginkey:=#0;keybd_event(vk_tab,mapvirtualkey(vk_tab,0),0,0);end;end;end;(6).Progressbar加上色彩。const{$EXTERNALSYM PBS_MARQUEE}PBS_MARQUEE = 08;varForm1: TForm1;implementation{$R *.dfm}usesCommCtrl;procedure TForm1.Button1Click(Sender: TObject);begin// Set the Background color to tealProgressbar1.Brush.Color := clTeal;// Set bar color to yellowSendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clYellow);end;(7).住点移动时编辑框色彩不同。procedure TForm1.Edit1Enter(Sender: TObject);begin(sender as tedit).Color:=clred;end;procedure TForm1.Edit1Exit(Sender: TObject);begin(sender as tedit).Color:=clwhite;end;(8).备份和恢复procedure TForm1.Button1Click(Sender: TObject);beginif OpenDialog1.Execute thenbegintryadoconnection1.Connected:=False;adoconnection1.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=FRIEND-YOFZKSCO;'+'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=FRIEND-YOFZKSCO;Use Encryption for Data=False;Tag with column collation when possible=False';adoconnection1.Connected:=True;with adoQuery1 dobeginClose;SQL.Clear;SQL.Add('Backup DataBase sfa to disk ='''+opendialog1.FileName+'''');ExecSQL;end;exceptShowMessage('±?·Y꧰ü');Exit;end;end;Application.MessageBox('1§?2?ú£?êy?Y±?·Y3é1|','ìáê?',MB_OK + MB_ICONINFORMATION);end;procedure TForm1.Button2Click(Sender: TObject);beginif OpenDialog1.Execute thenbegintryadoconnection1.Connected:=false;adoconnection1.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=FRIEND-YOFZKSCO;'+'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=FRIEND-YOFZKSCO;Use Encryption for Data=False;Tag with column collation when possible=False';adoconnection1.Connected:=true;with adoQuery1 dobeginClose;SQL.Clear;SQL.Add('Restore DataBase sfa from disk ='''+opendialog1.FileName+'''');ExecSQL;end;exceptShowMessage('???′꧰ü');Exit;end;end;Application.MessageBox('1§?2?ú£?êy?Y???′3é1|','ìáê?',MB_OK + MB_ICONINFORMATION);end;回复人: delphiyesterday(郑康益) ( ) 信誉:31 2003-6-5 14:39:33 得分:0(9).查找局域网上的sqlserver报务器。uses Comobj;procedure TForm1.Button1Click(Sender: TObject);varSQLServer:Variant;ServerList:Variant;i,nServers:integer;sRetValue:String;beginSQLServer := CreateOleObject('SQLDMO.Application');ServerList:= SQLServer.ListAvailableSQLServers;nServers:=ServerList.Count;for i := 1 to nservers doListBox1.Items.Add(ServerList.Item(i));SQLServer:=NULL;serverList:=NULL;end;(10).窗体打开时的淡入效果。procedure TForm1.FormCreate(Sender: TObject);beginAnimateWindow (Handle, 400, AW_CENTER);end;(11).动态创建窗体。procedure TForm1.Button1Click(Sender: TObject);begintryform2:=Tform2.Create(self);form2.ShowModal;finallyform2.Free;end;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);beginaction:=cafree;end;procedure TForm1.FormDestroy(Sender: TObject);beginform1:=nil;end;(12).复制文件。procedure TForm1.Button1Click(Sender: TObject);begintrycopyfileA(pchar('C:\AAA.txt'),pchar('D:\AAA.txt'),false);exceptshowmessage('sfdsdf');end;end;(13).复制文件夹。uses shellAPI;procedure TForm1.Button1Click(Sender: TObject);varlpFileOp: TSHFileOpStruct;beginwith lpFileOp dobeginWnd:=Self.Handle;wfunc:=FO_COPY;pFrom:=pchar('C:\AAA');pTo:=pchar('D:\AAA');fFlags:=FOF_ALLOWUNDO;hNameMappings:=nil;lpszProgressTitle:=nil;fAnyOperationsAborted:=True;end;if SHFileOperation(lpFileOp)<>0 thenShowMessage('删除失败');end;(14).改变Dbgrid的选定色。procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;Field: TField; State: TGridDrawState);beginif gdSelected in state thenSetBkColor(dbgrid1.canvas.handle,clgreen)elsesetbkcolor(dbgrid1.canvas.handle,clwhite);dbgrid1.Canvas.TextRect(rect,0,0,field.AsString);dbgrid1.Canvas.Textout(rect.Left,rect.Top,field.AsString);end;(15).检测系统是否已安装了ADO。uses registry;function Tform1.ADOInstalled:Boolean;varr:TRegistry;s:string;beginr := TRegistry.create;trywith r dobeginRootKey := HKEY_CLASSES_ROOT;OpenKey( '\ADODB.Connection\CurVer', false );s := ReadString('');if s <> '' then Result := Trueelse Result := False;CloseKey;end;finallyr.free;end;end;procedure TForm1.Button1Click(Sender: TObject);beginif ADOInstalled then showmessage('this computer has installed ADO');end;(16).取利主机的ip地址。uses winsock;procedure TForm1.Button1Click(Sender: TObject);varIP:string;IPstr:String;buffer:array[1..32] of char;i:integer;WSData:TWSAdata;Host:PHostEnt;beginif WSAstartup(2,WSData)<>0 thenbeginshowmessage('WS2_32.DLL3?ê??ˉ꧰ü.');exit;end;tryif GetHostname(@buffer[1],32)<>0 thenbeginshowmessage('??óDμ?μ??÷?ú??.');exit;end;exceptshowmessage('??óD3é1|·μ???÷?ú??');exit;end;Host:=GetHostbyname(@buffer[1]);if Host=nil thenbeginshowmessage('IPμ??·?a??.');exit;endelsebeginedit2.Text:=Host.h_name;edit3.Text:=chr(host.h_addrtype+64);for i:=1 to 4 dobeginIP:=inttostr(ord(host.h_addr^[i-1]));if i<4 thenipstr:=ipstr+IP+'.'elseedit1.Text:=ipstr+ip;end;end;WSACleanup;end;(17).取得计算机名。function tform1.get_name:string;var ComputerName: PChar; size: DWord;beginGetMem(ComputerName,255);size:=255;if GetComputerName(ComputerName,size)=False thenresult:=''elseresult:=ComputerName;FreeMem(ComputerName);end;procedure TForm1.Button1Click(Sender: TObject);beginlabel1.Caption:=get_name;end;Top回复人: delphiyesterday(郑康益) ( ) 信誉:31 2003-6-5 14:40:54 得分:0(18).取得硬盘序列号。function tform1.GetHDSerialNumber: LongInt;{$IFDEF WIN32}varpdw : pDWord;mc, fl : dword;{$ENDIF}begin{$IfDef WIN32}New(pdw);GetVolumeInformation('c:\',nil,0,pdw,mc,fl,nil,0);Result := pdw^;dispose(pdw);{$ELSE}Result := GetWinFlags;{$ENDIF}end;procedure TForm1.Button1Click(Sender: TObject);beginedit1.Text:=inttostr(gethdserialnumber);end;(19).限定光标移动范围。procedure TForm1.Button1Click(Sender: TObject);varrect1:trect;beginrect1:=button2.BoundsRect;mapwindowpoints(handle,0,rect1,2);clipcursor(@rect1);end;procedure TForm1.Button2Click(Sender: TObject);varscreenrect:trect;beginscreenrect:=rect(0,0,screen.Width,screen.Height);clipcursor(@screenrect);end;(20).限制edit框只能输入数字。procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);beginif not (key in ['0'..'9','.',#8]) thenbeginkey:=#0;Messagebeep(0);end;end;(21).dbgrid中根据任一条件某一格变色。procedure TForm_main.DBGridEh1DrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumnEh;State: TGridDrawState);beginif (trim(DataModule1.ADOQuery1.FieldByName('dczt').AsString)='OK') thenbeginif datacol=6 thenbeginDbGrideh1.Canvas.Brush.Color:=clGradientActiveCaption;DbGrideh1.DefaultDrawColumnCell(Rect,datacol,column,state);end;end;end;(22).打开word文件。procedure TfjfsglForm.SpeedButton4Click(Sender: TObject);varMSWord: Variant;str:string;beginif trim(DataModule1.adoquery27.fieldbyname('fjmc').asstring)<>'' thenbeginstr:=trim(DataModule1.ADOQuery27.fieldbyname('fjmc').AsString);MSWord:= CreateOLEObject('Word.Application');//MSWord.Documents.Open('d:\Program Files\Common Files\Sfa\'+str, True);//MSWord.Visible:=1;//str:='';MSWord.ActiveDocument.Range(0, 0);//MSWord.ActiveDocument.Range.InsertAfter(str);//?úWord?D???ó×?·?'Title'MSWord.ActiveDocument.Range.InsertParagraphAfter;endelseshowmessage('');end;(23).word文件传入和传出数据库。uses IdGlobal;procedure TdjhyForm.SpeedButton2Click(Sender: TObject);varsfilename:string;function BlobContentTostring(const Filename:string):string;beginwith Tfilestream.Create(filename,fmopenread) dotrysetlength(result,size);read(pointer(result)^,size);finallyfree;end;end;beginif opendialog1.Execute thenbeginsfilename:=opendialog1.FileName;DataModule1.ADOQuery14.Edit;DataModule1.ADOQuery14.FieldByName('word').AsString:=blobcontenttostring(sfilename);DataModule1.ADOQuery14.Post;end;end;procedure TdjhyForm.SpeedButton1Click(Sender: TObject);varsfilename:string;bs:Tadoblobstream;beginbs:=Tadoblobstream.Create(TBLOBfield(DataModule1.ADOQuery14.FieldByName('word')),bmread);trysfilename:=extractfilepath(application.ExeName)+trim(DataModule1.adoquery14.fieldbyname('hybh').AsString);sfilename:=sfilename+'.'+'doc';bs.SaveToFile(sfilename);trydjhyopenform:=Tdjhyopenform.Create(self);djhyopenform.olecontainer1.CreateObjectFromFile(sfilename,false);djhyopenform.OleContainer1.Iconic:=true;djhyopenform.ShowModal;finallydjhyopenform.Free;end;finallybs.free;end;end;(24).中文标题的提示框。procedure TdjhyForm.SpeedButton5Click(Sender: TObject);beginif Application.MessageBox('', Mb_YesNo + Mb_IconWarning) =Id_yes then DataModule1.ADOQuery14.Delete;end;(25).运行一应用程序文件。WinExec('HH.EXE D:\Program files\common files\MyshipperCRM e-sales help\MyshipperCRM e-sales help.chm',SW_NORMAL);