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

📄 unit1.~pas

📁 稿件名称:用Delphi制作“资源管理器”结构的数据查询窗口
💻 ~PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, ComCtrls, Excel2000, OleServer, DB,
  ADODB;

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    DataSource1: TDataSource;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    ExcelWorkbook1: TExcelWorkbook;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure ADOTable1FilterRecord(DataSet: TDataSet;
      var Accept: Boolean);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    Procedure Excel_App(DBGrid:TDBgrid);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
 var
   Node1:TTreeNode;
   NodeText1:string;
   NodeText2:string;
begin
  WITH TreeView1.Items DO
  BEGIN
    Clear;
    WITH ADOQuery1 DO
    BEGIN
      Active :=TRUE;
      FIRST;
      WHILE NOT EOF DO
      BEGIN
        NodeText1:=FieldValues['投保单位'];
        Node1:=Add(nil,NodeText1);
        WITH ADOQuery2 DO
        BEGIN
          ACTIVE:=FALSE;
          Parameters.ParamByName('TBDW').Value:=NodeText1;
          ACTIVE:=TRUE;
          FIRST;
          WHILE NOT EOF DO
          BEGIN
            NodeText2:=FieldValues['车架号'];
            AddChild(Node1,NodeText2);
            NEXT;
          END;
        END;
        NEXT;
      END;
    END
  END;
  ADOQuery1.Close ;
  ADOQuery2.Close ;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
  IF NOT ADOTABLE1.Active THEN ADOTABLE1.Active :=TRUE;
  ADOTABLE1.Filtered :=FALSE;
  ADOTABLE1.Filtered :=TRUE;
end;

procedure TForm1.ADOTable1FilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
   CASE TREEVIEW1.Selected.Level OF
    0:Accept:=(ADOTABLE1.Fields [1].AsString=TREEVIEW1.Selected.Text);
    1:Accept:=(ADOTABLE1.Fields[4].AsString=TREEVIEW1.Selected.Text);
  END
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
   TREEVIEW1.FullExpand ;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 TREEVIEW1.FullCollapse ; 
end;

Procedure TForm1.Excel_App(DBGrid:TDBgrid);
var
 //定义数据转出时的行列变量
 i,row,column:integer;
 Query:TDataSet;
Begin
 //连接EXCEL
 //---未安装Excel,结束程序
 Try
  ExcelApplication1.Connect;
 Except
  MessageDlg('是否正确安装了Excel?',mtError,[Mbok],0);
 Abort;
 End;
 //------
//**完成工作表连接
 ExcelApplication1.Visible[0]:=True;
 ExcelApplication1.Caption:='财保数据转出';
 ExcelApplication1.Workbooks.Add(Null,0);
 ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
 ExcelWorksheet1.ConnectTo (ExcelWorkbook1.Worksheets[1] as _Worksheet);
//****Excel连接完成//

//----开始完成数据导出----//
//设置第一行表头
 for i:=1 to DBGrid.FieldCount do
 begin
   ExcelWorksheet1.Cells.Item[1,i]:=DBGrid.Fields[i-1].Fieldname;
 end;
//开始导出内容
 Query:=DBGrid.DataSource.DataSet;
 row:=2;
 with Query do
 begin
  first;
  While not eof do
  begin
   column:=1;
   for i:=1 to fieldcount do
   begin
    ExcelWorksheet1.Cells.Item[row,column]:=fields[i-1].value;
    column:=column+1;
   end;
   next;
   row:=row+1;
  end;
 end;
 //内容导出完成
 ExcelApplication1.Disconnect;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 Excel_App(DBGrid1);
end;

end.

⌨️ 快捷键说明

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