temp.pas

多媒体播放后台管理系统适用于各种字幕播放软件的后台管理,包括播放内容、时间、等级等的管理。

unit temp;

interface

uses DBTables, Forms, ADODB, DB, SysUtils, Windows, Messages, Variants, Classes, Graphics, Controls, 
  Dialogs, StdCtrls, OleServer, ExcelXP;

function GetNextNo(Query: TADOQuery; TableName, FieldName: string; var No: string; Len: Integer): Boolean;
function GetSysDateTime(Query: TADOQuery): TDateTime;

procedure ExportToExcel(Sender: TForm; cdsLoading: TDataSet; Prompt: Boolean);

implementation

function GetSysDateTime(Query: TADOQuery): TDateTime;
var
  objQuery: TADOQuery;
begin
  objQuery := TADOQuery.Create(Query.Owner);
  objQuery.Connection := Query.Connection;

  objQuery.Close;
  objQuery.SQL.Clear;
  objQuery.SQL.Add('select now() as DT');
  objQuery.Open;
  if objQuery.RecordCount > 0 then
    Result := objQuery.FieldByName('DT').AsDateTime
  else
    Result := Now();

  objQuery.Free;
end;

function GetNextNo(Query: TADOQuery; TableName, FieldName: string; var No: string; Len: Integer): Boolean;
var
  objQuery: TADOQuery;
  strTemp: string;
begin
  Result := false;
  No := '';

  if (Len <= 0) then
    Len := 8;

  objQuery := TADOQuery.Create(Query.Owner);
  objQuery.Connection := Query.Connection;

  strTemp := '';
  objQuery.Close;
  objQuery.SQL.Clear;
  objQuery.SQL.Add('select max(' + FieldName + ') as No from ' + TableName);
  objQuery.Open;
  if objQuery.RecordCount > 0 then
    strTemp := objQuery.FieldByName('No').AsString;

  if (strTemp = '') then
    strTemp :=  StringOfChar('0', Len - 1) + '1'
  else begin
    strTemp := FloatToStr(trunc(StrToFloat(strTemp) + 1));
    strTemp := StringOfChar('0', Len - Length(strTemp)) + strTemp;
  end;

  objQuery.Free;

  No := strTemp;
  Result := true;
end;

procedure ExportToExcel(Sender: TForm; cdsLoading: TDataSet; Prompt: Boolean);
var
  boolExcelVisible: Boolean;
  strFileName: string;
  row, column, i: Integer;
  eapMain: TExcelApplication;
  ewsMain: TExcelWorkSheet;
  ewbMain: TExcelWorkBook;
  dlgSave: TSaveDialog;
begin
  if (not cdsLoading.Active) or ((cdsLoading.Active) and (cdsLoading.RecordCount < 1)) then
  begin
    if Prompt then
      ShowMessage('没有数据，请先查询！');
    Exit;
  end;

  dlgSave := TSaveDialog.Create(nil);
  if Prompt then
  begin
    if Application.MessageBox('启动Excel界面吗?', '请回答', MB_YESNO + MB_DEFBUTTON1) <> IDNO then
    begin
      boolExcelVisible := True
    end
    else begin
      boolExcelVisible := False;

      dlgSave.FileName := Sender.Caption;
      if dlgSave.Execute then
      begin
        strFileName := dlgSave.FileName;
        if Pos('.', strFileName) = 0 then
          strFileName := strFileName + '.xls';
        if (FileExists(strFileName)) then
          if MessageBox(0, '当前位置已存在该文件名的文件，是否替换？', '系统询问', mb_yesno or mb_iconquestion) = id_yes then
            DeleteFile(PChar(strFileName))
          else begin
            dlgSave.Free;
            Exit;
          end;
      end
      else begin
        dlgSave.Free;
        Exit;
      end;
    end;
  end
  else begin
    boolExcelVisible := True
  end;

  eapMain := TExcelApplication.Create(nil);
  try
    eapMain.Connect;
  except
    ShowMessage('EXCEL可能未安装，或其文件损坏');
    eapMain.Free;
    Exit;
  end;

  ewsMain := TExcelWorkSheet.Create(nil);
  ewbMain := TExcelWorkBook.Create(nil);
  ewbMain.ConnectTo(eapMain.Workbooks.Add(null, 0));
  ewsMain.ConnectTo(ewbMain.Worksheets[1] as _worksheet);
  with cdsLoading do
  begin
    row := 1;
    column := 1;
    for i := 1 to FieldCount do
    begin
      if (Fields[i - 1].Visible) then
      begin
        ewsMain.Cells.Item[row, column] := Fields[i - 1].DisplayName;
        column := column + 1;
      end;
    end;
    First; //数据集置于开始位置
    row := 2;//column :=1;
    while not eof do
    begin
      column := 1;
      for i := 1 to FieldCount do
      begin
        if (Fields[i - 1].Visible) then
        begin
          ewsMain.Cells.Item[row, column] := Fields[i - 1].AsString;
          column := column + 1;
        end;
      end;
      Next;
      row := row + 1;
    end;
  end;

  if boolExcelVisible then
    eapMain.Visible[0] := True//显示EXCEL程序
  else begin
    try
      ewsmain.SaveAs(strFileName);    //保存文件
      ShowMessage('保存完毕！');
    except
      ShowMessage('已取消保存！');
    end;
  end;//替换或保存文件

  ewbMain.Free;
  ewsMain.Free;
  eapMain.Free;
  dlgSave.Free;
end;

end.