delphi编程经验(zz)

本人今天把自已以前的一些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);