a3.pas

一个delphi开发的库存管理系统源代码

unit a3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGridEh, EhLibADO, Menus, ComObj, ExcelXP, OleServer, DB,
  frxClass, frxDBSet, Printers,PrViewEh, PrnDbgeh;

type
  Tfa3 = class(TForm)
    dg_view: TDBGridEh;
    ExcelApplication1: TExcelApplication;
    sd: TSaveDialog;
    ExcelWorkbook1: TExcelWorkbook;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    PrintDBGridEh1: TPrintDBGridEh;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dg_viewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure frxReport1GetValue(const VarName: String;
      var Value: Variant);
  private
    { Private declarations }
  public
    flag : char;
    procedure ini(sflag:char); 
    procedure savedata(sflag : boolean);
    { Public declarations }
  end;

var
  fa3: Tfa3;

implementation
uses dm,vks,main;

{$R *.dfm}

procedure Tfa3.ini(sflag:char);
begin
  fdm.qdlist.Filter := 'type='''+sflag+'''';
  fdm.qdlist.Filtered := true;
  if fdm.qdlist.Active then fdm.qdlist.Close;
  fdm.qdlist.Active := true;
end;

//导出到excle中去
procedure Tfa3.savedata(sflag : boolean);
var
  ExcelApp,WorkBook: Variant;
  i, j, k: Integer;
  total, total1: real;
  Row, Col: Integer;
  FieldName: string;
  DataSet: TDataSet;
begin
  // 数据发送到 Excel
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    vks.info(1024);
    Exit;
  end;

  Application.ProcessMessages;
  WorkBook := ExcelApp.WorkBooks.Add;
  //加入标题
  ExcelApp.Range['A1:I1'].Merge;   //单元格从A1到J1
  ExcelApp.Rows[1].RowHeight :=25; //行高
  ExcelApp.Rows[1].Borders.LineStyle := 1;   //加边框
  ExcelApp.Rows[1].HorizontalAlignment := xlCenter;   //水平对齐方式
  ExcelApp.Rows[1].VerticalAlignment := xlCenter;   //垂直对齐方式
  ExcelApp.Rows[1].Interior.Color := clSkyBlue;   //颜色
  ExcelApp.Rows[1].Characters.Font.Name := '宋体';   //字体
  ExcelApp.Rows[1].Characters.Font.FontStyle := '加粗';
  ExcelApp.Rows[1].Characters.Font.Size := 16;
  ExcelApp.Rows[1].Characters.Font.OutlineFont := False;   //是否有下划线
  if flag='A' then ExcelApp.Cells(1, 1) := FormatDateTime('yyyymmdd',now())+'进货数据导出'
  else ExcelApp.Cells(1, 1) := FormatDateTime('yyyymmdd',now())+'出货数据导出';
  
  Col := 1;
  Row := 2;
  DataSet := dg_view.DataSource.DataSet;
  if Row=2 then
  begin
    ExcelApp.Rows[Row].Borders.LineStyle := 1;
    ExcelApp.Rows[Row].RowHeight :=15; //行高
    ExcelApp.Rows[Row].Interior.Color := clSilver;   //颜色
    ExcelApp.Rows[Row].Characters.Font.Name := '宋体';   //字体
    ExcelApp.Rows[Row].Characters.Font.FontStyle := '加粗';
    for I := 1 to dg_view.Columns.Count - 2 do
    begin
      if dg_view.Columns[I].Visible and (i<>2) then
      begin
        FieldName := dg_view.Columns[I].Title.Caption;
        ExcelApp.Cells(Row, Col) := FieldName;
        Col := Col + 1;
      end;
    end;
    Row := Row + 1;
    DataSet.First;
  end;

  total  := 0;
  total1 := 0; 

  while not DataSet.Eof do
  begin
    ExcelApp.Rows[Row].Borders.LineStyle := 1;
    Col := 1;
    for J := 1 to dg_view.Columns.Count - 2 do
    begin
      if J<>2 then
      begin
        FieldName := dg_view.Columns[J].FieldName;
        if J=4 then total := total + DataSet.FieldByName(FieldName).AsFloat;
        if J=6 then total1 := total1 + DataSet.FieldByName(FieldName).AsFloat;
        ExcelApp.Cells(Row, Col) := trim(DataSet.FieldByName(FieldName).AsString);
        Col := Col + 1;
      end;
    end;
    Row := Row + 1;
    DataSet.Next;
  end;
  ExcelApp.Rows[Row].Borders.LineStyle := 1;
  ExcelApp.Rows[Row].Borders.Color := clSilver;   //颜色
  ExcelApp.Rows[Row].RowHeight :=15; //行高
  ExcelApp.Rows[Row].Interior.Color := clSilver;   //颜色
  ExcelApp.Rows[Row].Characters.Font.Name := '宋体';   //字体
  ExcelApp.Rows[Row].Characters.Font.FontStyle := '加粗';
  ExcelApp.Cells(Row, 1) := '合计';
  ExcelApp.Cells(Row, 3) := floattostr(total);
  ExcelApp.Cells(Row, 5) := floattostr(total1);
  if sflag=false then ExcelApp.Visible := True
  else if sd.execute then
  begin
    WorkBook.SaveAs(sd.FileName);
    WorkBook.Close;
    vks.info(1104);
  end;
end;

procedure Tfa3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  action := cafree;
end;

procedure Tfa3.dg_viewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=vk_f5 then ini(flag);
  //打印
  if key=vk_f11 then N1Click(Sender);
  if key=vk_f12 then N2Click(Sender);
end;

procedure Tfa3.FormShow(Sender: TObject);
begin
  if not fdm.qslist.Active then fdm.qslist.Active := true;
  if not fdm.qslist1.Active then fdm.qslist1.Active := true;
  if not fdm.qvlist.Active then fdm.qvlist.Active := true;
  if not fdm.qdlist.Active then fdm.qdlist.Open;
end;

procedure Tfa3.N1Click(Sender: TObject);
begin
  PrinterPreview.Orientation := poLandscape;
  PrintDBGridEh1.Preview;
end;

procedure Tfa3.N2Click(Sender: TObject);
begin
  if fmain.str[3]<>'' then savedata(false) else savedata(true);
end;

procedure Tfa3.frxReport1GetValue(const VarName: String;
  var Value: Variant);
begin
  if flag='A' then
  begin
    if VarName='title' then
    begin
      Value := '物品入库历史记录';
    end;
  end;
end;

end.