fxstj.pas

进销存开发系统

unit Fxstj;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Fbase, DB, ADODB, Grids, DBGrids, ExtCtrls, Buttons, ToolWin,
  ComCtrls, RpCon, RpConDS, RpDefine, RpRave, Word2000, OleServer,
  Excel2000;

type
  TF_xstj = class(TF_base)
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    Panel1: TPanel;
    SpeedButton2: TSpeedButton;
    DBGrid1: TDBGrid;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    StatusBar1: TStatusBar;
    WordApplication1: TWordApplication;
    WordDocument1: TWordDocument;
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelWorksheet1: TExcelWorksheet;
    Panel2: TPanel;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_xstj: TF_xstj;

implementation
  uses Fzct,Fzyxx;
{$R *.dfm}

procedure TF_xstj.FormShow(Sender: TObject);
begin
  inherited;
  F_zct.jt:=2;
end;

procedure TF_xstj.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  inherited;
  if Application.MessageBox('是否退出？','提示',mb_yesno)=Id_no then
    Canclose:=False;
  F_zct.jt:=0;
end;

procedure TF_xstj.SpeedButton1Click(Sender: TObject);
begin
  inherited;
  Application.CreateForm(TF_zyxx, F_zyxx);
  F_zyxx.ShowModal;
  F_zyxx.Free;
end;

procedure TF_xstj.SpeedButton2Click(Sender: TObject);
begin
  inherited;
  close;
end;

procedure TF_xstj.SpeedButton3Click(Sender: TObject);
var
  oledoc,oletemplate,oleindex:olevariant;
  cols,rows:integer;
begin
  inherited;
  if (ADOQuery1.Active=False) then Exit;
  try
    oletemplate:=true;
    oleindex:=1;
    try
      wordapplication1.connect;
    except
      Application.MessageBox('没安装Word','提示',mb_ok);
      Abort;
    end;
    WordApplication1.visible:=True;
    WordApplication1.caption:='导出数据到Word进行打印';
    oledoc:=WordApplication1.Documents;
    oledoc.add(newtemplate:=true);
    WordDocument1.ConnectTo(wordapplication1.Documents.Item(oleindex));
    WordDocument1.Range.InsertBefore(' '+#13);
    ADOQuery1.First;
    for cols:=0 to 3 do
      WordDocument1.Range.InsertAfter(dbgrid1.Columns[cols].Title.Caption+'   ');
    WordDocument1.Range.InsertAfter(#13);
    for rows:=1 to ADOQuery1.RecordCount do
    begin
      for cols:=0 to 3 do
      begin
        if cols<=1 then
          WordDocument1.Range.InsertAfter(adoquery1.Fields[cols].Value+'   ');
        if cols>1 then
          WordDocument1.Range.InsertAfter(floattostr(ADOQuery1.Fields[cols].Value)+'   ');
      end;
      WordDocument1.Range.InsertAfter(' '+#13);
      Adoquery1.Next;
    end;
    WordApplication1.Disconnect;
  except
    Application.MessageBox('无法导入','提示',MB_ok);
  end;
end;
procedure TF_xstj.SpeedButton4Click(Sender: TObject);
var
  cols,rows:integer;
begin
  inherited;
  if (ADOQuery1.Active=False) then Exit;
  with self.ExcelApplication1 do
  begin
    Excelapplication1.Connect;
    Excelapplication1.Visible[0]:=True;
    Excelapplication1.SheetsInNewWorkbook[0]:=1;
    Excelapplication1.Workbooks.Add(emptyparam,0);
    Excelworkbook1.ConnectTo(Workbooks[1] as _workbook);
  end;
  Excelworksheet1.connectto(Excelworkbook1.sheets[1] as _worksheet);
  Excelworksheet1.name:='数据导入Word中';
  Excelworksheet1.visible[0];
  ADOQuery1.First;
    for cols:=1 to 4 do
      Excelworksheet1.Cells.Item[1,cols]:=DBGrid1.Columns[cols-1].Title.caption;
    for rows:=1 to adoquery1.RecordCount do
    begin
      for cols:=1 to 4 do
      begin
        if cols<=2 then
          Excelworksheet1.Cells.Item[rows+1,cols]:=Adoquery1.Fields[cols-1].Value;
        if cols>2 then
          Excelworksheet1.Cells.Item[rows+1,cols]:=adoquery1.Fields[cols-1].Value;
      end;
      Adoquery1.Next;
    end;
    Excelapplication1.Disconnect;
end;

end.