一生delphi编程经验

本人今天把自已以前的一些delphi编程经验进行个小总结，总结完后突有一个  
  这样的想法：如果我把这些总结发给网上的delphi朋友，而他们如果也有些自已  
  的delphi编程小结，也发给我(如果愿意的话),这样大家的进步肯定是很快的。      
    本人email：yesterday97@hotmail.com  
   
   
  (1).按下ctrl和其它键之后发生一事件。  
          procedure   TForm1.FormKeyDown(Sender:   TObject;   var   Key:   Word;  
              Shift:   TShiftState);  
          begin  
              if   (ssCtrl   in   Shift)   and   (key   =67)   then  
                    showmessage('keydown   Ctrl+C');  
          end;  
  (2).Dbgrid中用Enter键代替Tab键.  
        procedure   TForm1.DBGrid1KeyPress(Sender:   TObject;   var   Key:   Char);  
        begin  
            if   Key   =   #13   then  
            if   ActiveControl   =   DBGrid1   then  
            begin  
                  TDBGrid(ActiveControl).SelectedIndex   :=   TDBGrid(ActiveControl).SelectedIndex   +   1;  
                  Key   :=   #0;  
            end;  
        end;  
  (3).Dbgrid中选择多行发生一事件。  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          var  
          i:integer;  
          bookmarklist:Tbookmarklist;  
          bookmark:tbookmarkstr;  
          begin  
              bookmark:=adoquery1.Bookmark;  
              bookmarklist:=dbgrid1.SelectedRows;  
              try  
              begin  
                  for   i:=0   to   bookmarklist.Count-1   do  
                  begin  
                      adoquery1.Bookmark:=bookmarklist[i];  
                      with   adoquery1   do  
                      begin  
                          edit;  
                          fieldbyname('mdg').AsString:=edit2.Text;  
                          post;  
                      end;  
                  end;  
              end;  
              finally  
              adoquery1.Bookmark:=bookmark;  
              end;  
          end;  
  (4).Form的一个出现效果。    
          procedure   TForm1.Button1Click(Sender:   TObject);  
          var  
          r:thandle;  
          i:integer;  
          begin  
              for   i:=1   to   trunc(width/1.414)   do  
              begin  
                  r:=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);  
          begin  
              if   key=#13   then  
                  begin  
                      if   not   (Activecontrol   is   Tmemo)   then  
                      begin  
                          key:=#0;  
                          keybd_event(vk_tab,mapvirtualkey(vk_tab,0),0,0);  
                      end;  
                  end;  
          end;  
  (6).Progressbar加上色彩。  
          const  
          {$EXTERNALSYM   PBS_MARQUEE}  
          PBS_MARQUEE   =   08;  
          var  
              Form1:   TForm1;  
          implementation  
          {$R   *.dfm}  
          uses  
          CommCtrl;  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          begin  
              //   Set   the   Background   color   to   teal  
              Progressbar1.Brush.Color   :=   clTeal;  
              //   Set   bar   color   to   yellow  
              SendMessage(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);  
          begin  
              if   OpenDialog1.Execute   then  
              begin  
                  try  
                      adoconnection1.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   do  
                      begin  
                          Close;  
                          SQL.Clear;  
                          SQL.Add('Backup   DataBase   sfa   to   disk   ='''+opendialog1.FileName+'''');  
                          ExecSQL;  
                      end;  
                  except  
                      ShowMessage('±?·Y꧰ü');  
                  Exit;  
                  end;  
              end;  
              Application.MessageBox('1§?2?ú￡?êy?Y±?·Y3é1|','ìáê?',MB_OK   +   MB_ICONINFORMATION);  
          end;  
          procedure   TForm1.Button2Click(Sender:   TObject);  
          begin  
              if   OpenDialog1.Execute   then  
              begin  
                  try  
                      adoconnection1.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   do  
                      begin  
                          Close;  
                          SQL.Clear;  
                          SQL.Add('Restore   DataBase   sfa   from   disk   ='''+opendialog1.FileName+'''');  
                          ExecSQL;  
                    end;  
                except  
                    ShowMessage('???′꧰ü');  
                    Exit;  
                end;  
            end;  
            Application.MessageBox('1§?2?ú￡?êy?Y???′3é1|','ìáê?',MB_OK   +   MB_ICONINFORMATION);  
          end;  
(9).查找局域网上的sqlserver报务器。  
          uses   Comobj;  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          var  
          SQLServer:Variant;  
          ServerList:Variant;  
          i,nServers:integer;  
          sRetValue:String;  
          begin  
              SQLServer   :=   CreateOleObject('SQLDMO.Application');  
              ServerList:=   SQLServer.ListAvailableSQLServers;  
              nServers:=ServerList.Count;  
              for   i   :=   1   to   nservers   do  
              ListBox1.Items.Add(ServerList.Item(i));  
              SQLServer:=NULL;  
              serverList:=NULL;  
          end;  
  (10).窗体打开时的淡入效果。  
          procedure   TForm1.FormCreate(Sender:   TObject);  
          begin  
              AnimateWindow   (Handle,   400,   AW_CENTER);  
          end;  
  (11).动态创建窗体。  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          begin  
              try  
                  form2:=Tform2.Create(self);  
                  form2.ShowModal;  
              finally  
                  form2.Free;  
              end;  
          end;  
          procedure   TForm1.FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
          begin  
              action:=cafree;  
          end;  
          procedure   TForm1.FormDestroy(Sender:   TObject);  
          begin  
              form1:=nil;  
          end;  
  (12).复制文件。  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          begin  
              try  
              copyfileA(pchar('C:/AAA.txt'),pchar('D:/AAA.txt'),false);  
              except  
              showmessage('sfdsdf');  
              end;  
          end;  
  (13).复制文件夹。  
          uses   shellAPI;  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          var  
                lpFileOp:   TSHFileOpStruct;  
          begin  
              with   lpFileOp   do  
              begin  
                  Wnd:=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   then  
            ShowMessage('删除失败');  
          end;  
  (14).改变Dbgrid的选定色。  
          procedure   TForm1.DBGrid1DrawDataCell(Sender:   TObject;   const   Rect:   TRect;  
          Field:   TField;   State:   TGridDrawState);    
          begin  
              if   gdSelected   in   state   then  
              SetBkColor(dbgrid1.canvas.handle,clgreen)  
              else  
              setbkcolor(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;  
          var  
          r:TRegistry;  
          s:string;  
          begin  
              r   :=   TRegistry.create;  
              try  
              with   r   do  
              begin  
                  RootKey   :=   HKEY_CLASSES_ROOT;  
                  OpenKey(   '/ADODB.Connection/CurVer',   false   );  
                  s   :=   ReadString('');  
                  if   s   <>   ''   then   Result   :=   True  
                  else   Result   :=   False;  
                  CloseKey;  
              end;  
              finally  
                r.free;  
              end;  
          end;  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          begin  
            if   ADOInstalled   then   showmessage('this   computer   has   installed   ADO');  
          end;  
  (16).取利主机的ip地址。  
          uses   winsock;  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          var  
          IP:string;  
          IPstr:String;  
          buffer:array[1..32]   of   char;  
          i:integer;  
          WSData:TWSAdata;  
          Host:PHostEnt;  
          begin  
              if   WSAstartup(2,WSData)<>0   then  
              begin  
                  showmessage('WS2_32.DLL3?ê??ˉ꧰ü.');  
                  exit;  
              end;  
              try  
                  if   GetHostname(@buffer[1],32)<>0   then  
                  begin  
                      showmessage('??óDμ?μ??÷?ú??.');  
                  exit;  
              end;  
              except  
                  showmessage('??óD3é1|·μ???÷?ú??');  
                  exit;  
              end;  
              Host:=GetHostbyname(@buffer[1]);  
              if   Host=nil   then  
              begin  
                  showmessage('IPμ??·?a??.');  
                  exit;  
              end  
              else  
              begin  
                  edit2.Text:=Host.h_name;  
                  edit3.Text:=chr(host.h_addrtype+64);  
                  for   i:=1   to   4   do  
                  begin  
                    IP:=inttostr(ord(host.h_addr^[i-1]));  
                    if   i<4   then  
                    ipstr:=ipstr+IP+'.'  
                  else  
                    edit1.Text:=ipstr+ip;  
                  end;  
                end;  
                WSACleanup;  
          end;  
  (17).取得计算机名。  
          function   tform1.get_name:string;  
          var     ComputerName:   PChar;     size:   DWord;  
          begin  
                  GetMem(ComputerName,255);  
                  size:=255;  
                  if   GetComputerName(ComputerName,size)=False   then  
                        result:=''  
                  else  
                        result:=ComputerName;  
                  FreeMem(ComputerName);  
          end;  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          begin  
              label1.Caption:=get_name;  
          end;  
(18).取得硬盘序列号。  
          function   tform1.GetHDSerialNumber:   LongInt;          
          {$IFDEF   WIN32}  
          var    
              pdw   :   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);  
          begin  
              edit1.Text:=inttostr(gethdserialnumber);  
          end;  
  (19).限定光标移动范围。  
          procedure   TForm1.Button1Click(Sender:   TObject);  
          var  
          rect1:trect;  
          begin  
              rect1:=button2.BoundsRect;  
              mapwindowpoints(handle,0,rect1,2);  
              clipcursor(@rect1);  
          end;  
          procedure   TForm1.Button2Click(Sender:   TObject);  
          var  
          screenrect:trect;  
          begin  
              screenrect:=rect(0,0,screen.Width,screen.Height);  
              clipcursor(@screenrect);  
          end;  
  (20).限制edit框只能输入数字。  
          procedure   TForm1.Edit1KeyPress(Sender:   TObject;   var   Key:   Char);  
          begin  
              if   not   (key   in   ['0'..'9','.',#8])   then  
              begin  
                  key:=#0;  
                  Messagebeep(0);  
              end;  
          end;  
  (21).dbgrid中根据任一条件某一格变色。  
          procedure   TForm_main.DBGridEh1DrawColumnCell(Sender:   TObject;  
          const   Rect:   TRect;   DataCol:   Integer;   Column:   TColumnEh;  
          State:   TGridDrawState);  
          begin  
              if   (trim(DataModule1.ADOQuery1.FieldByName('dczt').AsString)='OK')   then  
              begin  
                  if   datacol=6   then  
                  begin  
                      DbGrideh1.Canvas.Brush.Color:=clGradientActiveCaption;  
                      DbGrideh1.DefaultDrawColumnCell(Rect,datacol,column,state);  
                  end;  
              end;  
          end;  
  (22).打开word文件。  
          procedure   TfjfsglForm.SpeedButton4Click(Sender:   TObject);  
          var  
          MSWord:   Variant;  
          str:string;    
          begin  
              if   trim(DataModule1.adoquery27.fieldbyname('fjmc').asstring)<>''   then  
              begin  
                  str:=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;  
              end  
              else  
              showmessage('');  
          end;  
  (23).word文件传入和传出数据库。  
          uses   IdGlobal;  
          procedure   TdjhyForm.SpeedButton2Click(Sender:   TObject);  
          var  
          sfilename:string;  
          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;  
                  DataModule1.ADOQuery14.Edit;  
                  DataModule1.ADOQuery14.FieldByName('word').AsString:=blobcontenttostring(sfilename);  
                  DataModule1.ADOQuery14.Post;  
              end;  
          end;  
          procedure   TdjhyForm.SpeedButton1Click(Sender:   TObject);  
          var  
          sfilename:string;  
          bs:Tadoblobstream;  
          begin  
              bs:=Tadoblobstream.Create(TBLOBfield(DataModule1.ADOQuery14.FieldByName('word')),bmread);  
              try  
                  sfilename:=extractfilepath(application.ExeName)+trim(DataModule1.adoquery14.fieldbyname('hybh').AsString);  
                  sfilename:=sfilename+'.'+'doc';  
                  bs.SaveToFile(sfilename);  
                  try  
                      djhyopenform:=Tdjhyopenform.Create(self);  
                      djhyopenform.olecontainer1.CreateObjectFromFile(sfilename,false);  
                      djhyopenform.OleContainer1.Iconic:=true;  
                      djhyopenform.ShowModal;  
                  finally  
                      djhyopenform.Free;  
                  end;  
              finally  
                  bs.free;  
              end;  
          end;  
  (24).中文标题的提示框。  
          procedure   TdjhyForm.SpeedButton5Click(Sender:   TObject);  
          begin  
              if   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);