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

📄 a4.pas

📁 一个delphi开发的库存管理系统源代码
💻 PAS
字号:
unit a4;

interface

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

type
  Tfa4 = class(TForm)
    dg_view: TDBGridEh;
    sd: TSaveDialog;
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    PrintDBGridEh1: TPrintDBGridEh;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure dg_viewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    procedure savedata(flag : boolean);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fa4: Tfa4;

implementation
uses dm,vks,main;

{$R *.dfm}
//导出到excle中去
procedure Tfa4.savedata(flag : 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:J1'].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;   //是否有下划线
  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=5 then total := total + DataSet.FieldByName(FieldName).AsFloat;
        if J=8 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, 4) := floattostr(total);
  ExcelApp.Cells(Row, 7) := floattostr(total1);
  if flag=false then ExcelApp.Visible := True
  else if sd.execute then
  begin
    WorkBook.SaveAs(sd.FileName);
    WorkBook.Close;
    vks.info(1104);
  end;
end;

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

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

procedure Tfa4.dg_viewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //打印
  if key=vk_f11 then N1Click(Sender);
  //导出
  if key=vk_f12 then N2Click(Sender);
  //刷新
  if key=vk_f5 then
  begin
    fdm.qkc.Close;
    fdm.qkc.Open;
  end;
  //删除
  if key=vk_delete then N3Click(Sender);
end;

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

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

procedure Tfa4.N3Click(Sender: TObject);
begin
  if (dg_view.Fields[5].AsString<>'') and (dg_view.Fields[5].asinteger=0) and (vks.box('确定要删除本库存数据吗?'#13#10'如果删除,将不能恢复,请不要删除本窗口数据.','库存数据删除窗口')) then
  begin
    with fdm.q do
    begin
      close;
      sql.Text := 'delete from [kc] where gid='+dg_view.Fields[12].AsString;
      try
        execsql;
        close;
        fdm.qkc.Close;
        fdm.qkc.Open;
      except
        close;
        vks.info(1008);
      end;
    end;
  end;
end;

end.

⌨️ 快捷键说明

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