⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cgf1.pas

📁 非常丰富的delphi小程序,相信会对你有帮助
💻 PAS
字号:
                                                           unit cgf1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, Excel2000, OleServer, DB, DBTables,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    Table1: TTable;
    Ea1: TExcelApplication;
    Es1: TExcelWorksheet;
    Ew1: TExcelWorkbook;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    Animate1: TAnimate;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  private
    { Private declarations }
  public
  Function Legit1(const s:string):boolean;  { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 If opendialog1.Execute then
  begin
   Edit1.Text:=opendialog1.FileName;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,count1,Flag:integer;str1,str2:string;
begin
If Legit1(Edit1.Text) then
 begin //0
  Try
  EA1.Connect ;
  Except
  showmessage('是否正确安装了Excel,或者Excel已经运行!');
  Abort;
  end;
  Button1.Visible :=false;
  Ea1.Visible[0]:=false;
  Ea1.Caption:='从Excel文件中读取内容';
  Ea1.Workbooks.Open(Edit1.Text,null,null,null,null,null,null,null,null,null,null,null,null,0);
  Ew1.ConnectTo(Ea1.Workbooks[1]);
  Es1.ConnectTo(Ew1.Worksheets[1] as _worksheet);
  count1:=es1.Cells.CurrentRegion.rows.Count;
  Table1.Active:=true;
  Animate1.Visible:=true;
  Animate1.Active:=true;
  For i:=2 to count1 do
   begin //1
     Flag:=0;
     str1:=Es1.Cells.Item[i,1];
     Table1.First;
     while not table1.Eof do
     begin //2
     str2:=Table1.Fields[0].AsString ;
     If (str1=str2) then
       begin//3
       Animate1.Active:=false;
       If Messagedlg('学号为'+str2+'姓名为'+table1.Fields[1].asstring+'的记录已经存在,是否覆盖?',mtwarning,[mbyes,mbno],0)=mryes  then
         begin//4
          Animate1.Active:=true;
          Table1.Edit;
          Table1.Fields[0].AsString :=Es1.Cells.Item[i,1];
          Table1.Fields[1].asstring:=Es1.Cells.Item[i,2];
          Table1.Fields[2].asstring:=Es1.Cells.Item[i,3];
          Table1.Fields[3].asstring:=Es1.Cells.Item[i,4];
          Table1.Post;
          Flag:=1;
          break;
         end  //4
        Else
         begin//4
         Flag:=2;
         Break;
         end; //4

       end  //3
      else
       begin//3
       Animate1.Active :=true;
       Flag:=0;
       Table1.Next;
       end; //3
     end;  //2
     If Flag=0 then begin
     Table1.Append;
     Table1.Fields[0].AsString :=Es1.Cells.Item[i,1];
     Table1.Fields[1].asstring:=Es1.Cells.Item[i,2];
     Table1.Fields[2].asstring:=Es1.Cells.Item[i,3];
     Table1.Fields[3].asstring:=Es1.Cells.Item[i,4];
     Table1.Post;   end;
   end;  //1
  Table1.Active:=false;
  Animate1.Active:=false;
  Animate1.Visible :=false;
  Ea1.Quit;
  Ea1.Disconnect ;
  Button1.Visible :=true;
  end//0
 else
  showmessage('文件选择有错误,请检查修改后重新导入!');

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Self.Close;
end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
Resize:=false;
end;

function TForm1.Legit1(const s: string): boolean;
var count1:integer; str:string;
begin
count1:=Length(s);
If Count1<8 then Result:=false
 else
  begin
   Str:=copy(s,count1-3,4);
   if (Str='.xls')or(str='.XLS')or(str='.Xls')or(str='.xLs')or(str='.xlS')
       or(str='.XLs')or(str='.xLS')or(str='.XLs') then  result:=true
     Else result:=false;

  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -