原码显示如下：

(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;

标签：