📄 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.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -