unit20.~pas

来自「学籍管理系统 基于sql2000 实现插入删除修改 等功能 不错」· ~PAS 代码 · 共 148 行

~PAS
148
字号
unit Unit20;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Grids, DBGrids, DB, ADODB;

type
  TForm5 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    bj: TComboBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    BitBtn3: TBitBtn;
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bjChange(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  //  procedure bjChange(Sender: TObject);
  private
   procedure CopyDbDataToExcel(Args: array of const);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
  sqlstring:string;
implementation

uses Unit1;

{$R *.dfm}

procedure Tform5.CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer; 
XLApp: Variant; 
Sheet: Variant; 
I: Integer; 
begin 
Screen.Cursor := crHourGlass; 
if not VarIsEmpty(XLApp) then 
begin 
XLApp.DisplayAlerts := False; 
XLApp.Quit; 
VarClear(XLApp); 
end; 
try
XLApp := CreateOleObject('Excel.Application');
except 
Screen.Cursor := crDefault; 
Exit; 
end; 

XLApp.WorkBooks.Add; 
XLApp.SheetsInNewWorkbook := High(Args) + 1; 

for I := Low(Args) to High(Args) do 
begin 
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name; 
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name]; 

if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then 
begin 
Screen.Cursor := crDefault; 
Exit; 
end; 

TDBGrid(Args[I].VObject).DataSource.DataSet.first; 
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do 
Sheet.Cells[1, iCount + 1] := 
TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption; 

jCount := 1; 
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do 
begin 
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do 
Sheet.Cells[jCount + 1, iCount + 1] := 
TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString; 

Inc(jCount); 
TDBGrid(Args[I].VObject).DataSource.DataSet.Next; 
end; 
XlApp.Visible := True; 
end; 
Screen.Cursor := crDefault; 
end;
procedure TForm5.BitBtn2Click(Sender: TObject);
begin
close;
end;

procedure TForm5.FormCreate(Sender: TObject);
var
data_path:string;
begin
 data_path:=application.GetNamePath+'user/'+form1.user+'/'+'班级.mdb';
 ADOQuery2.connectionstring:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+data_path+';';
 sqlstring:='select * from 班级表';
  bj.Clear;
  with ADOQuery2 do
    begin
      close;
      sql.Clear;
      sql.Add(sqlstring);
      open;
      while not eof do
         begin
           bj.Items.Add(fieldbyname('名称').asstring);
            next;
         end;
  //end;
end;
end;

procedure TForm5.bjChange(Sender: TObject);
var
data_path1:string;
begin
 data_path1:=application.GetNamePath+'user/'+form1.user+'/'+trim(bj.text)+'.mdb';
 ADOQuery1.connectionstring:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+data_path1+';';
 sqlstring:='select * from 学生信息表';
 // bj.Clear;
  with ADOQuery1 do
    begin
      close;
      sql.Clear;
      sql.Add(sqlstring);
      open;
      end;
end;

procedure TForm5.BitBtn3Click(Sender: TObject);
begin
CopyDbDataToExcel([DBGrid1]);
end;

end.

⌨️ 快捷键说明

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