common.pas

财务报表系统,包括系统登陆

unit Common;

interface

uses Classes, SysUtils, DB, Variants, ExcelXP;

type
  cdsEventsRecord = record
    ne: TDataSetNotifyEvent;
    ee: TDataSetErrorEvent;
    fe: TFilterRecordEvent;
  end;
  cdsEventsArray = array[1..20] of cdsEventsRecord;

//****************************************************************************//
//                       DataSet 函数                                         //
//****************************************************************************//
//保存DataSet的事件
function  SaveCDSEvents(ds: TDataSet): cdsEventsArray;
//恢复DataSet的事件
procedure RestoreCDSEvents(ds: TDataSet; e: cdsEventsArray);
// 将 TDataSet 的某个字段，形成 StringList
procedure AssignDsStrings(ds: TDataSet; s: string; sl: TStrings);
//============================================================================//

//****************************************************************************//
//                         Excel 函数                                         //
//****************************************************************************//
// 数字转换成Excel的格式
function IntToExcelStr(n: Integer): string;
// 为单元格加边框
procedure RangeBorder(sheet: Variant; y, x: Integer);
// 复制 Sheet1.Range 到 Sheet2
procedure CopyRange(src: Variant; x1, y1, x2, y2: Integer; dest: Variant; x,y: Integer);
// 填充单元格内容  align=1 left, 2 right 3 center
procedure FillValue(sheet:Variant; y, x:Integer; value:Variant ; align:Integer = 0; border: Boolean = True);
// 合并单元格
procedure MergeCells(sheet: Variant; x1, y1, x2, y2: Integer);
//============================================================================//

implementation

//保存CLIENTDATASET的事件
function SaveCDSEvents(ds: TDataSet): cdsEventsArray;
begin
  Result[ 1].ne := ds.AfterCancel;
  Result[ 2].ne := ds.AfterClose;
  Result[ 3].ne := ds.AfterDelete;
  Result[ 4].ne := ds.AfterEdit;
  Result[ 5].ne := ds.AfterInsert;
  Result[ 6].ne := ds.AfterOpen;
  Result[ 7].ne := ds.AfterPost;
  Result[ 8].ne := ds.AfterRefresh;
  Result[ 9].ne := ds.AfterScroll;
  Result[10].ne := ds.BeforeCancel;
  Result[11].ne := ds.BeforeClose;
  Result[12].ne := ds.BeforeDelete;
  Result[13].ne := ds.BeforeEdit;
  Result[14].ne := ds.BeforeInsert;
  Result[15].ne := ds.BeforeOpen;
  Result[16].ne := ds.BeforePost;
  Result[17].ne := ds.BeforeRefresh;
  Result[18].ne := ds.BeforeScroll;
  Result[19].ne := ds.OnCalcFields;
  Result[20].ne := ds.OnNewRecord;
  Result[ 1].ee := ds.OnDeleteError;
  Result[ 2].ee := ds.OnEditError;
  Result[ 3].ee := ds.OnPostError;
  Result[ 1].fe := ds.OnFilterRecord;
end;

//恢复CLIENTDATASET的事件
procedure RestoreCDSEvents(ds: TDataSet; e: cdsEventsArray);
begin
  ds.AfterCancel   := e[ 1].ne;
  ds.AfterClose    := e[ 2].ne;
  ds.AfterDelete   := e[ 3].ne;
  ds.AfterEdit     := e[ 4].ne;
  ds.AfterInsert   := e[ 5].ne;
  ds.AfterOpen     := e[ 6].ne;
  ds.AfterPost     := e[ 7].ne;
  ds.AfterRefresh  := e[ 8].ne;
  ds.AfterScroll   := e[ 9].ne;
  ds.BeforeCancel  := e[10].ne;
  ds.BeforeClose   := e[11].ne;
  ds.BeforeDelete  := e[12].ne;
  ds.BeforeEdit    := e[13].ne;
  ds.BeforeInsert  := e[14].ne;
  ds.BeforeOpen    := e[15].ne;
  ds.BeforePost    := e[16].ne;
  ds.BeforeRefresh := e[17].ne;
  ds.BeforeScroll  := e[18].ne;
  ds.OnCalcFields  := e[19].ne;
  ds.OnNewRecord   := e[20].ne;
  ds.OnDeleteError := e[ 1].ee;
  ds.OnEditError   := e[ 2].ee;
  ds.OnPostError   := e[ 3].ee;
  ds.OnFilterRecord := e[ 1].fe;
end;

// 将 TDataSet 的某个字段，形成 StringList
procedure AssignDsStrings(ds: TDataSet; s: string; sl: TStrings);
var
  b: TBookmarkStr;
begin
  b := ds.Bookmark;
  sl.Clear;
  ds.First;
  while not ds.Eof do begin
    if ds.FieldValues[s] <> null then
      sl.Add(ds.FieldByName(s).AsString);
    ds.Next;
  end;
  ds.Bookmark := b;
end;

// 数字转换成Excel的格式
function IntToExcelStr(n: Integer): string;
var
  s: string;
begin
  if n > 26 then
    s := char(integer('A')+((n-1) div 26)-1);
  if n mod 26 = 0 then
    s := s+'Z'
  else
    s := s+char(integer('A')+(n mod 26)-1);
  Result := s;
end;

// 为单元格加边框
procedure RangeBorder(sheet: Variant; y, x: Integer);
var
  R: string;
begin
  R := IntToExcelStr(x)+IntToStr(y)+':'+IntToExcelStr(x)+IntToStr(y);
  sheet.Range[R].Borders[1].Weight := sheet.Range['A4:A4'].Borders[1].Weight;
  sheet.Range[R].Borders[2].Weight := sheet.Range['A4:A4'].Borders[2].Weight;
  sheet.Range[R].Borders[3].Weight := sheet.Range['A4:A4'].Borders[3].Weight;
  sheet.Range[R].Borders[4].Weight := sheet.Range['A4:A4'].Borders[4].Weight;
end;

// 复制 Sheet1.Range 到 Sheet2
procedure CopyRange(src: Variant; x1, y1, x2, y2: Integer; dest: Variant; x,y: Integer);
var
  R: string;
  i: Integer;
begin
  // 内容与格式
  R := IntToExcelStr(x1)+IntToStr(y1)+':'+IntToExcelStr(x2)+IntToStr(y2);
  src.Range[R].Copy;
  R := IntToExcelStr(x)+IntToStr(y);
  dest.Range[R].PasteSpecial;
  dest.Range['A1'].Select;

  // 单元格属性
  for i:= x1 to x2 do
    dest.Columns[x+i-x1].ColumnWidth := src.Columns[i].ColumnWidth;
  for i:= y1 to y2 do
    dest.Rows[y+i-y1].RowHeight := src.Rows[i].RowHeight;
end;

// 填充单元格内容  align=1 left, 2 right 3 center
procedure FillValue(sheet:Variant; y, x:Integer; value:Variant ; align:Integer = 0; border: Boolean = True);
begin
  sheet.Cells[y, x].Value := value;
  case align of
    1:
      sheet.Cells[y, x].HorizontalAlignment := xlLeft;
    2:
      sheet.Cells[y, x].HorizontalAlignment := xlRight;
    3:
      sheet.Cells[y, x].HorizontalAlignment := xlCenter;
  end;
  if (border) then
    RangeBorder(sheet, y, x);
end;

// 合并单元格
procedure MergeCells(sheet: Variant; x1, y1, x2, y2: Integer);
var
  R: string;
begin
  R := IntToExcelStr(x1)+IntToStr(y1)+':'+IntToExcelStr(x2)+IntToStr(y2);
  sheet.Range[R].Merge;
end;

end.