unit DataUnit;

// 1入库表;2品名表;3出库表;4库存表;5人员表;6人员表（部门班组）;7库存提示;8发放提示；
interface

uses
  System.SysUtils, System.Classes,
  FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf,
  FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async,
  FireDAC.Phys, FireDAC.VCLUI.Wait,
  Data.DB, FireDAC.Comp.Client, FireDAC.Stan.ExprFuncs,
  FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.Phys.SQLiteDef, FireDAC.Phys.SQLite,
  FireDAC.Comp.UI, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf,
  FireDAC.DApt, FireDAC.Comp.DataSet, Vcl.DBGrids, ComObj,
  Winapi.Windows, System.Variants, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TDM1 = class(TDataModule)
    FDConnection1: TFDConnection;
    FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink;
    FDGUIxWaitCursor1: TFDGUIxWaitCursor;
    FDQuery1: TFDQuery;
    DataSource1: TDataSource;
    FDQuery2: TFDQuery;
    DataSource2: TDataSource;
    FDQuery3: TFDQuery;
    DataSource3: TDataSource;
    FDQuery5: TFDQuery;
    DataSource5: TDataSource;
    FDQuery6: TFDQuery;
    DataSource6: TDataSource;
    FDQuery4: TFDQuery;
    DataSource4: TDataSource;
    FDQuery7: TFDQuery;
    DataSource7: TDataSource;
    FDQuery8: TFDQuery;
    DataSource8: TDataSource;
    SaveDialog1: TSaveDialog;
    procedure DataModuleCreate(Sender: TObject);
    procedure DBGridSort(Column: TColumn);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DM1: TDM1;
  arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  arXlsEnd: array[0..1] of Word = ($0A, 00);
  arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
  {
  以上为导出EXCEL文件格式所需数组
  }
  function ExportDBGrid(Args: array of const; SheetName: string): boolean;
  function ExportDBGrid1(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet): boolean;

const
  dbPath = 'E:\WZGL\';
  dbName = 'E:\WZGL\WZGLK.db';

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}

procedure TDM1.DataModuleCreate(Sender: TObject);
begin
  { 数据库连接类型 }
  DM1.FDConnection1.DriverName := 'SQLite';
  DM1.FDConnection1.Params.Add('DriverID=SQLite');

  { 当数据库文件不存在时，创建这个文件 }
  if not FileExists(dbName) then
  begin
    if not DirectoryExists(dbPath) then // 判断目录是否存在
      try
        begin
          CreateDir(dbPath);
          // ForceDirectories(Edit1.Text);   创建目录
        end;
      except
        raise Exception.Create('无法创建 ' + dbPath);
      end;
    DM1.FDConnection1.Params.Add('Database=' + dbName);
    DM1.FDConnection1.Connected := True;
    DM1.FDConnection1.ExecSQL
      ('CREATE TABLE 入库表(序号 int PRIMARY KEY, 品名 string(20), 数量 int, 规格 string(10),入库日期 date,保管人 string(8),使用周期（天） int,保质期（天） int)');
    { 执行SQL语句 }
    DM1.FDConnection1.ExecSQL
      ('CREATE TABLE 品名表(序号 int PRIMARY KEY, 品名代号 string(10),品名 string(20), 规格 string(10),使用周期（天） int,保质期（天） int)');
    { 执行SQL语句 }
    DM1.FDConnection1.ExecSQL
      ('CREATE TABLE 出库表(序号 int PRIMARY KEY, 品名 string(20), 数量 int, 规格 string(10),出库日期 date,领取人 string(8),所在部门（班组） string(12),使用周期（天） int,发放理由 string)');
    { 执行SQL语句 }
    DM1.FDConnection1.ExecSQL
      ('CREATE TABLE 库存表(序号 int PRIMARY KEY, 品名 string(20), 数量 int, 规格 string(10),入库日期 date,保管人 string(8),使用周期（天） int,保质期（天） int)');
    { 执行SQL语句 }
    DM1.FDConnection1.ExecSQL
      ('CREATE TABLE 人员表(序号 int PRIMARY KEY, 所在部门（班组） string(12),姓名 string(8),职名 string(12))');
    { 执行SQL语句 }
  end
  { 当数据库文件存在时，直接进行连接 }
  else
  begin
    DM1.FDConnection1.Params.Add('Database=' + dbName);
    DM1.FDConnection1.Connected := True;
  end;
end;

procedure TDM1.DBGridSort(Column: TColumn);  //DBgrid点击标题栏排序
var
  SqlStr,myFieldName,TempStr: string;
  OrderPos: integer;
  SavedParams: TParams;
begin
  if not (Column.Field.FieldKind in [fkData,fkLookup]) then exit;
  //如果字段类型不属于物理字段或查询字段则退出
  if Column.Field.FieldKind =fkData then
    myFieldName := UpperCase(Column.Field.FieldName)  //如为物理字段，字段名大写
  else
    myFieldName := UpperCase(Column.Field.KeyFields);   //如为查询字段，主键名大写

  while Pos(myFieldName,';')<>0 do   //如果名称中包含分号
    myFieldName := copy(myFieldName,1,Pos(myFieldName,';')-1)
                  + ',' + copy(myFieldName,Pos(myFieldName,';')+1,100);  //把分号变逗号
  with TFDQuery(TDBGrid(Column.Grid).DataSource.DataSet) do
  begin
    close;
    SqlStr := UpperCase(Sql.Text);   //SQL语句字符串大写
//  if pos(myFieldName,SqlStr)=0 then exit;   //如果SQL语句中不存在所选字段名，则退出
    if ParamCount>0 then   //如果运行过程时包含参数
    begin
      SavedParams := TParams.Create;   //创建保存参数变量
      SavedParams.Assign(Params);   //连接参数
    end;
    OrderPos := pos('ORDER',SqlStr);   //获取'ORDER'串在SQL语句中的起始位置
    if (OrderPos=0) or
      (pos(myFieldName,copy(SqlStr,OrderPos,100))=0) then   //如不存在ORDER或ORDER子句中不包含所选字段
      TempStr := ' Order By ' + myFieldName + ' Asc'   //生成按照所选字段升序排列的ORDER子句
    else if pos('ASC',SqlStr)=0 then   //如果ORDER子句中有所选字段但不包含升序标志
      TempStr := ' Order By ' + myFieldName + ' Asc'   //生成按所选字段升序排列的ORDER子句
    else   //如果ORDER子句中有所选字段且包含升序标志
      TempStr := ' Order By ' + myFieldName + ' Desc';   //生成按所选字段降序排列的ORDER子句
    if OrderPos<>0 then SqlStr := Copy(SqlStr,1,OrderPos-1);   //如果存在ORDER子句，提取ORDER子句之前的SQL语句内容
    SqlStr := SqlStr + TempStr;   //将其与新生成的ORDER子句连接
    Active := False;   //锁定QUERY状态
    Sql.Clear;   //清除SQL内容
    Sql.Text := SqlStr;   //更新SQL内容
    if ParamCount>0 then   //如果运行过程时包含参数
    begin
      Params.Assign(SavedParams);   //提取保存的参数变量
      SavedParams.Free;   //释放参数变量
    end;
    Prepare;   //将带参数的SQL语句传给数据库引擎
    Open;   //打开查询
    Fields[0].DisplayWidth := 4;
    Fields[1].DisplayWidth := 20;
    Fields[2].DisplayWidth := 6;
    Fields[3].DisplayWidth := 10;
  end;
end;


function ExportDBGrid(Args: array of const; SheetName: string): boolean;
// 循环读取记录方式导出EXCEL

var
  c, r, i, j, k: integer;
  app: Olevariant;
  Sheet: Variant;
  TempFileName, ResultFileName: string;
begin
  try
    result := True;
    app := CreateOLEObject('Excel.application'); // 创建EXCEL表对象
    // app.WorkBooks.Add(xlWBatWorkSheet);
  except
    Application.MessageBox('Excel没有正确安装！', '警告', MB_OK);
    result := False;
    exit;
  end;
  DM1.SaveDialog1.DefaultExt := 'xls'; // 默认文件名后缀为xls
  DM1.SaveDialog1.FileName := SheetName; // 读取EXCEL工作簿名称参数
  if DM1.SaveDialog1.Execute then // 调用保存文件对话框
    TempFileName := DM1.SaveDialog1.FileName // 设定保存文件名
  else
    exit;
  app.Workbooks.Add; // 添加工作表

  app.SheetsInNewWorkbook := High(Args) + 1; // 取最大工作表数

  for k := Low(Args) to High(Args) do // 逐个工作表循环

  begin
    app.Workbooks[1].WorkSheets[k + 1].Name := '表' + inttostr(k + 1); // 设工作表名
    Sheet := app.Workbooks[1].WorkSheets['表' + inttostr(k + 1)]; // 设定工作表对象
    app.Visible := False; // 设为不可见
    Screen.Cursor := crHourGlass; // 光标显示正在运行中
    TDBGrid(Args[k].VObject).DataSource.DataSet.First; // 回到首记录
    c := TDBGrid(Args[k].VObject).DataSource.DataSet.FieldCount; // 取字段总数
    r := TDBGrid(Args[k].VObject).DataSource.DataSet.RecordCount; // 取记录总数
    Application.ProcessMessages; // 使程序在循环时能够响应外界事件

    for i := 0 to c - 1 do // 按列读取数据
      Sheet.cells(1, 1 + i) := TDBGrid(Args[k].VObject)
        .DataSource.DataSet.Fields[i].DisplayLabel; // 读取各列字段名

    for j := 1 to r do // 按行读取数据
    begin
      for i := 0 to c - 1 do // 当前行按列读取
        Sheet.cells(j + 1, 1 + i) := TDBGrid(Args[k].VObject)
          .DataSource.DataSet.Fields[i].AsString; // 以文本方式读取各列数据
      TDBGrid(Args[k].VObject).DataSource.DataSet.Next; // 到下一记录
    end;
  end;

  ResultFileName := TempFileName; // 确定文件名
  if ResultFileName = '' then // 如为空则默认名称为“数据导出”
    ResultFileName := '数据导出';
  if FileExists(TempFileName) then // 判断文件是否存在
    DeleteFile(PWideChar(WideString(TempFileName))); // 如同名文件已存在，则先删除
  app.Activeworkbook.saveas(TempFileName); // 保存文件
  app.Activeworkbook.close(False); // 关闭文件
  app.quit; // 退出excel表对象
  app := unassigned; // 文件注销
end;

function ExportDBGrid1(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet): boolean;
// 文件流写入方式导出EXCEL

var
  i: integer;
  Col, row: word;
  ABookMark: TBookMark;
  aFileStream: TFileStream;
  TempFileName, ResultFileName: string;

  procedure incColRow; //增加行列号
  begin
  if Col = ADataSet.FieldCount - 1 then   //如果到达末列
    begin
      Inc(Row);    //行加1
      Col :=0;     //列为0
    end
  else             //如未到末列
    Inc(Col);      //列加1
  end;

  procedure WriteStringCell(AValue: ansistring);//写字符串数据
  var
    L: Word;
  begin
    L := Length(AValue);     //取参数字符串长度
    arXlsString[1] := 8 + L;     //arXlsString数组元素1：参数串长度+8
    arXlsString[2] := Row;       //arXlsString数组元素2：行数
    arXlsString[3] := Col;       //arXlsString数组元素3：列数
    arXlsString[5] := L;         //arXlsString数组元素5：参数串长度
    aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));  //arXlsString数组写入文件流
    aFileStream.WriteBuffer(Pointer(AValue)^, L);    //参数串写入文件流
    IncColRow;                                       //增加行列号
  end;
  procedure WriteIntegerCell(AValue: integer);//写整数
  var
    V: Integer;
  begin
    arXlsInteger[2] := Row;    //arXlsInteger数组元素2：行数
    arXlsInteger[3] := Col;    //arXlsInteger数组元素3：列数
    aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));   //arXlsInteger数组写入文件流
    V := (AValue shl 2) or 2;       //整型参数左移2位（相当于乘以4）然后与2进行or操作，所得值赋给变量V
    {
    Delphi的按位运算符共有六个: not and or xor shr shl
    not 就是按位(给二进制的每一位)取反;
    and 就是把两个运算数按位对比, 同是1返回1, 反之返回0;
    or 就是把两个运算数按位对比, 只有其中一个是1就返回1，都是0才返回0;
    xor 就是把两个运算数按位对比, 只有两个不一样才返回1，一样(都是0或都是1)则返回0;
    shr 是按位右移, shr 1 是右移一位，相当于除以2（二进制下）;
    shl 是按位左移，shl 1 是左移一位，相当于乘以2（二进制下）;
    }
    aFileStream.WriteBuffer(V, 4);   //变量V写入文件流（长度为4）
    IncColRow;                       //增加行列号
  end;

  procedure WriteFloatCell(AValue: double);//写浮点数
  begin
    arXlsNumber[2] := Row;     //arXlsNumber数组元素2：行数
    arXlsNumber[3] := Col;     //arXlsNumber数组元素3：列数
    aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));  //arXlsNumber数组写入文件流
    aFileStream.WriteBuffer(AValue, 8);   //浮点参数写入文件流，长度为8
    IncColRow;                            //增加行列号
  end;

begin
  DM1.SaveDialog1.DefaultExt := 'xls'; // 默认文件名后缀为xls
  DM1.SaveDialog1.FileName := FileName; // 读取EXCEL工作簿名称参数

  if DM1.SaveDialog1.Execute then // 正常调用保存文件对话框
    TempFileName := DM1.SaveDialog1.FileName // 设定保存文件名
  else           //如果中断或取消
    begin
      result := false;
      exit;
    end;

  ResultFileName := TempFileName; // 确定文件名
  if ResultFileName = '' then     // 如文件名为空则默认名称为“数据导出”
    ResultFileName := '数据导出';

  if FileExists(ResultFileName) then
  DeleteFile(PWideChar(WideString(ResultFileName))); //如文件已存在，先删除
  aFileStream := TFileStream.Create(ResultFileName, fmCreate);   //按照设定文件名创建一个文件流
  result := True;
  Try
    //写文件头
    aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));
    //写列头
    Col := 0; Row := 0;
    if bWriteTitle then    //如果列头参数为真
    begin
      for i := 0 to aDataSet.FieldCount - 1 do        //遍历各列
      WriteStringCell(ansistring(aDataSet.Fields[i].FieldName));  //数据列表字段名写入单元格
    end;
    //写数据集中的数据
    aDataSet.DisableControls;      //断开数据组件（修改过程中）
    ABookMark := aDataSet.GetBookmark;    //取当前定位
    aDataSet.First;                //到首记录
    while not aDataSet.Eof do      //循环遍历所有记录
    begin
      for i := 0 to aDataSet.FieldCount - 1 do     //循环遍历所有字段
      case ADataSet.Fields[i].DataType of
        ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:     //整型数值类型
        WriteIntegerCell(aDataSet.Fields[i].AsInteger);        //调用写整数过程
        ftFloat, ftCurrency, ftBCD:                            //浮点数值类型
        WriteFloatCell(aDataSet.Fields[i].AsFloat)             //调用写浮点数过程
      else
        WriteStringCell(ansistring(aDataSet.Fields[i].AsString));          //调用写字符串过程
      end;
      aDataSet.Next;        //下一记录
    end;
    //写文件尾
    AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));       //arXlsEnd数组写入文件流
    if ADataSet.BookmarkValid(ABookMark) then                  //如果原记录定位有效
    aDataSet.GotoBookmark(ABookMark);                          //回到原记录定位
  finally
    AFileStream.Free;                                          //释放文件流
    ADataSet.EnableControls;                                   //连接数据组件（修改完毕）
  end;
end;

end.