📄 basecell.pas
字号:
unit BaseCell;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
TB97Ctls, TB97, TB97Tlbr, StdCtrls, ImgList, OleCtrls, CELLLib_TLB,Registry,
Db, DBTables, Grids;
type
TGetDataBase = class
private
FPassword: string;
Query: TQuery;
procedure SetPassword( Value: string );
published
property Password: string read FPassword write SetPassword;
public
SelfCraete:Boolean;
DataBase: TDataBase;
Username: string;
Sql: string;
databaseName: string;
DataGrid: TStringGrid;
GetFlag: Integer; //1：表示带字段名称 0：表示不带字段名称
function GetPassword( Value: string ): string;
procedure Execute;
constructor Create;
destructor Destroy; override;
end;
TBaseCellForm = class(TForm)
ImageList1: TImageList;
Dock971: TDock97;
Label1: TLabel;
Toolbar971: TToolbar97;
ToolbarButton971: TToolbarButton97;
ToolbarButton972: TToolbarButton97;
ToolbarButton974: TToolbarButton97;
ToolbarButton976: TToolbarButton97;
Cell1: TCell;
ToolbarButton973: TToolbarButton97;
Database1: TDatabase;
ToolbarButton977: TToolbarButton97;
ToolbarButton975: TToolbarButton97;
ToolbarButton978: TToolbarButton97;
SaveDialog1: TSaveDialog;
ToolbarButton979: TToolbarButton97;
procedure ToolbarButton971Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ToolbarButton976Click(Sender: TObject);
procedure ToolbarButton974Click(Sender: TObject);
procedure PrintCell(PrintFlag:Boolean;showDia:Boolean);
procedure ToolbarButton972Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ToolbarButton973Click(Sender: TObject);
procedure ClearCell;
procedure SetCellRow0(Cell:TCell;Index:Integer);
procedure SetCellCol0(Cell:TCell;Index:Integer);
function GetCellCol(Cell:TCell;NO:String;ID:Integer):Integer;
function GetCellRow(Cell:TCell;NO:String):Integer;
function GetCellCols(Cell:TCell):Integer;
function IfCellEx(Cell:TCell;Index:Integer):Boolean;
procedure Cell1ExecuteUserFunc(Sender: TObject; const name: WideString;
rettype, paranum: Smallint; var paratype: Integer;
var funcResult: OleVariant);
procedure Cell1SetCellData(Sender: TObject; col, row: Integer;
var data, changed: OleVariant);
procedure ToolbarButton977Click(Sender: TObject);
procedure ToolbarButton975Click(Sender: TObject);
procedure ToolbarButton978Click(Sender: TObject);
procedure ToolbarButton979Click(Sender: TObject);
private
{ Private declarations }
public
aPrintRow,aPrintCol:Integer;
aStartRow,aStartCol:Integer;
STARTROW,STARTCOL:Integer;
sSYB,sCPLX:String;
procedure OpenFile(FileName:String);
{ Public declarations }
end;
var
BaseCellForm: TBaseCellForm;
Pubpath: string;
S_UserName,S_Password:String;
S_FileName_DQ,S_FileName_CP:String;
// S_Position:String;
S_TableName_BM,S_TableName_DQ:String;
S_IsCP:Boolean;
S_GM_Name:String;
S_GM_No:String;
S_CP_Name:String;
S_CP_No:String;
S_CurDate:TDateTime;
S_CurYear:String; //当前财年
S_CurPeriod:String; //当前才月
implementation
uses DefinePrintColRow, GE_PublicFunction;
{$R *.DFM}
constructor TGetDataBase.Create;
begin
inherited Create;
DataGrid := TStringGrid.Create( nil );
end;
destructor TGetDataBase.Destroy;
begin
DataGrid.Free;
inherited Destroy;
end;
function TGetDataBase.GetPassword( Value: string ): string;
//var i: Integer;
begin
Result := Value;
// for i := 1 to Length( Value ) do
// Result[i] := char( integer( Value[i] ) - 10 );
end;
procedure TGetDataBase.SetPassword( Value: string );
//var i: Integer;
begin
FPassword := Value;
// for i := 1 to Length( Value ) do
// FPassword[i] := char( integer( Value[i] ) + 10 );
end;
procedure TGetDataBase.Execute;
var i, j: Integer;
begin
try
SelfCraete:=False;
if DataBase = nil then
begin
DataBase := TDataBase.Create( Application );
DataBase.DatabaseName := DataBaseName;
DataBase.Params.Values['USER NAME'] :=UserName;
DataBase.Params.Values['PASSWORD'] := Self.GetPassword( Self.password );
DataBase.LoginPrompt := False;
SelfCraete:=True;
end;
if Query = nil then
begin
Query := TQuery.Create( Application );
Query.DatabaseName := DataBase.DatabaseName;
end;
if not DataBase.Connected then
DataBase.open;
Query.Sql.Text := '';
Query.Sql.Text := Sql;
try
Query.Open;
except
application.HandleException( Self );
end;
DataGrid.ColCount := Query.Fields.Count;
DataGrid.RowCount := 2;
if GetFlag = 1 then //带字段名称
begin
for i := 0 to Query.Fields.Count - 1 do
DataGrid.Cells[i, 0] := '1'+Query.Fields[i].FieldName;
j := 0;
end
else
j := -1;
while not Query.Eof do
begin
j := j + 1;
if DataGrid.RowCount - 1 < j then
DataGrid.RowCount := j + 1;
for i := 0 to Query.Fields.Count - 1 do
begin
case Query.Fields[i].DataType of //第一位表示是字符还是数字 0：数字 1：字符
ftSmallint,ftInteger,ftWord,ftFloat:
DataGrid.Cells[i, j] := '0'+Query.Fields[i].AsString;
else
DataGrid.Cells[i, j] := '1'+Query.Fields[i].AsString;
end;
end;
Query.Next;
end;
if SelfCraete then
begin
DataBase.Close;
DataBase.Free;
DataBase := nil;
end;
except
if SelfCraete then
begin
DataBase.Close;
DataBase.Free;
DataBase := nil;
end;
end;
end;
type GetCellFromDBGetarray = array[0..5] of smallInt;
QKMHZBGetarray = array[0..9] of smallInt;
QMXZGetarray = array[0..18] of smallInt;
QFZDGetarray = array[0..9] of smallInt;
myarray = array[0..1] of smallInt;
myarray1 = array[0..5] of smallInt;
function FormatStrFor0(S:String;ALength:Integer):String;
var i,l:Integer;
begin
Result:=S;
l:=Length(S);
for i:=0 to ALength- l-1 do
Result:='0'+Result;
end;
function GetWeekofYear( SysDate: TSystemTime; AFromFirstDay: Boolean ): integer;
var
Date, RDate: TDate;
begin
Date := EnCodeDate( SysDate.wYear, SysDate.wMonth, SysDate.wDay );
if AFromFirstDay then
RDate := EnCodeDate( SysDate.wYear, 1, 1 )
else
begin
RDate := EnCodeDate( SysDate.wYear, 1, 1 );
if dayofweek( RDate ) = 1 then
RDate := EnCodeDate( SysDate.wYear, 1, 1 )
else
RDate := EnCodeDate( SysDate.wYear, 1, 7 - dayofweek( RDate ) + 2 );
end;
result := ( round( Date ) - round( RDate ) + dayofweek( RDate ) ) div 7 + 1;
end;
procedure SetUserFunction( Cell: TCell );
var parmType: myarray;
parmType1,parmDefault1: myarray1;
parmDefault: myarray;
S: string;
procedure SetGetOutDataBase;
var QMXZ, MXZDefault: GetCellFromDBGetarray;
S: string;
begin //0, 表示该参数不能缺省1, 表示该参数可以缺省
QMXZ[0] := 3;
QMXZ[1] := 0;
QMXZ[2] := 1;
QMXZ[3] := 1;
QMXZ[4] := 1;
QMXZ[5] := 1;
MXZDefault[0] := 1;
MXZDefault[1] := 0;
MXZDefault[2] := 0;
MXZDefault[3] := 1;
MXZDefault[4] := 0;
MXZDefault[5] := 0;
S := '取外部数据库中数据(pos,flag,UserName,Password,databasename,Sql)' + #13#10 +
'所有参数类型均为字符串' + #13#10 +
'pos:填充区域，如果为空表示取一个值，如果范围首位相同表示自动扩充范围' + #13#10 +
'flag:取数标志，1：表示带字段名称 0：表示不带字段名称' + #13#10 +
'UserName: 所要打开的数据库的用户名' + #13#10 +
'password: 所要打开的数据库的口令，因此字符串已经加密，所以请用导航器生成此函数，不能直接填写口令参数' + #13#10 +
'databaseName: 所要打开的数据库BDE别名' + #13#10 +
'sql:查询语句';
Cell.DoAddUserFunctionEx( '特殊函数', 'QWBSJ', 4, 6, QMXZ[0], MXZDefault[0], S );
end;
procedure SetGetCellData;
var QMXZ, MXZDefault: GetCellFromDBGetarray;
S: string;
begin //0, 表示该参数不能缺省1, 表示该参数可以缺省
QMXZ[0] := 2;
QMXZ[1] := 0;
MXZDefault[0] := 0;
MXZDefault[1] := 0;
S := 'GetCellData(Pos,Page)' + #13#10 +
'取单元点数据' + #13#10 +
'pos:坐标点' + #13#10 +
'Page:页面位置';
Cell.DoAddUserFunctionEx( '表函数', 'GETCELLDATA', 4, 2, QMXZ[0], MXZDefault[0], S );
end;
begin
SetGetOutDataBase;
SetGetCellData; //取其他页数据
parmType[0] := 2;
parmDefault[0] := 0;
// Cell.DoAddUserFunctionEx( '特殊函数', 'SetTempInput', 4, 1, parmType[0], parmDefault[0], '设置当前点为临时输入点，'+#13#10+'参数为设置点的坐标');
Cell.DoAddUserFunctionEx( '特殊函数', 'SetJEDX', 1, 1, parmType[0], parmDefault[0], '将指定点的值以金额大写的方式显示，' + #13#10 + '参数为设置点的坐标' );
parmType[0] := 0;
parmDefault[0] := 1;
S := 'GEDAY' + #13#10 +
'返回报表内当前日期，不是机器的系统日期' + #13#10 +
'语法' + #13#10 +
'GEDay(Flag)' + #13#10 +
'falg=0: 1999年05月01日' + #13#10 +
'falg=1: 1999/05/01/' + #13#10 +
'falg=2: 05/01/1999' + #13#10 +
'falg=-1: 1999年04月30日' + #13#10 +
'falg=-2: 1999/04/30' + #13#10 +
'实例' + #13#10 +
'GEDay(-1) 返回 1999/04/30';
Cell.DoAddUserFunctionEx( '时间函数', 'GEDay', 4, 1, parmType[0], parmDefault[0], S );
Cell.DoAddUserFunctionEx( '时间函数', 'Day', 4, 1, parmType[0], parmDefault[0], S );
S := 'GEMonth' + #13#10 +
'返回报表内当前年月，不是机器的系统日期' + #13#10 +
'语法' + #13#10 +
'GEMonth(Flag)' + #13#10 +
'falg=0: 1999年01月' + #13#10 +
'falg=1: 1999/01/' + #13#10 +
'falg=2: 01/1999' + #13#10 +
'falg=-1: 1998年12月' + #13#10 +
'falg=-2: 1998/12/' + #13#10 +
'falg=-3: 12/1998' + #13#10 +
'实例' + #13#10 +
'GEMonth(-1) 返回 1998年12月';
Cell.DoAddUserFunctionEx( '时间函数', 'GEMonth', 4, 1, parmType[0], parmDefault[0], S );
Cell.DoAddUserFunctionEx( '时间函数', 'Month', 4, 1, parmType[0], parmDefault[0], S );
S := 'GEYEAR' + #13#10 +
'返回报表内当前年，不是机器的系统日期' + #13#10 +
'语法' + #13#10 +
'GEYear(Flag)' + #13#10 +
'falg=0: 1999年' + #13#10 +
'falg=1: 1999' + #13#10 +
'falg=-1: 1998年' + #13#10 +
'falg=-2: 1998' + #13#10 +
'实例' + #13#10 +
'GEYear(-1) 返回 1998年';
Cell.DoAddUserFunctionEx( '时间函数', 'GEYear', 4, 1, parmType[0], parmDefault[0], S );
Cell.DoAddUserFunctionEx( '时间函数', 'Year', 4, 1, parmType[0], parmDefault[0], S );
S := 'GEWEEK' + #13#10 +
'返回当前报表时间对应的周数' + #13#10 +
'语法' + #13#10 +
'GEWeek(Flag)' + #13#10 +
'falg=0: 当前天对应的周数' + #13#10 +
'falg=-1: 当前天对应的周数减1' + #13#10 +
'实例' + #13#10 +
'GEWeek(0) 返回 44';
Cell.DoAddUserFunctionEx( '时间函数', 'GEWeek', 4, 1, parmType[0], parmDefault[0], S );
Cell.DoAddUserFunctionEx( '时间函数', 'Week', 4, 1, parmType[0], parmDefault[0], S );
Cell.DoAddUserFunctionEx( '时间函数', 'Date', 4, 0, parmType[0], parmDefault[0], 'DATE' + #13#10 + '返回当前机器的系统日期' );
Cell.DoAddUserFunctionEx( '时间函数', 'Time', 4, 0, parmType[0], parmDefault[0], 'TIME' + #13#10 + '返回当前机器的系统时间' );
Cell.DoAddUserFunctionEx( '时间函数', 'Unit', 4, 0, parmType[0], parmDefault[0], 'UNIT' + #13#10 + '返回当前系统运行时的单位' );
Cell.DoAddUserFunctionEx( '时间函数', 'Period', 4, 0, parmType[0], parmDefault[0], 'Period' + #13#10 + '返回当前系统运行时的会计期间' );
Cell.DoAddUserFunctionEx( '特殊函数', 'UnitDes', 4, 0, parmType[0], parmDefault[0], 'UnitDes' + #13#10 + '返回当前当前系统运行时单位描述' );
parmType1[0] := 2;
parmType1[1] := 1;
parmType1[2] := 2;
parmType1[3] := 0;
parmType1[4] := 2;
parmDefault1[0] := 0;
parmDefault1[1] := 0;
parmDefault1[2] := 0;
parmDefault1[3] := 0;
parmDefault1[4] := 0;
S := 'TJYS' + #13#10 +
'按照坐标1,2间的条件关系显示颜色' + #13#10 +
'语法' + #13#10 +
'TJYS(Pos1,Con,Pos2,Color,Pos3)' + #13#10 +
'POS1: 坐标1' + #13#10 +
'Con: 条件' + #13#10 +
'POS2: 坐标2' + #13#10 +
'Color:显示颜色(代表颜色的整形数)' + #13#10 +
'Pos3: 设置颜色的坐标';
Cell.DoAddUserFunctionEx( '特殊函数', 'TJYS', 0, 5, parmType1[0], parmDefault1[0],S );
{parmType[0] := 0;
parmDefault[0] := 0;
Cell.DoAddUserFunctionEx( '特殊函数', 'ACol', 1, 1, parmType[0], parmDefault[0], 'ACOL' + #13#10 + '取行位置(系统内部用函数)' + #13#10 +'如: ACOL(1) = 1 ');
parmType[0] := 1;
parmDefault[0] := 0;
Cell.DoAddUserFunctionEx( '特殊函数', 'ARow', 1, 1, parmType[0], parmDefault[0], 'AROW' + #13#10 + '取列位置(系统内部用函数)'+ #13#10 +'如: AROW(A) = 1');
parmType1[0] := 0;
parmType1[1] := 1;
parmType1[2] := 1;
parmDefault[0] := 0;
S := 'CALCOL' + #13#10 + 'calCol(当前行号,起始列号,公式)进行行数据的计算'+ #13#10 +
'如: CALCOL(col(),rows(),acol(1)+"+"+ acol(2)';
Cell.DoAddUserFunctionEx( '特殊函数', 'CALCOL', 4, 2, parmType1[0], parmDefault[0], S);}
end;
procedure TBaseCellForm.ToolbarButton971Click(Sender: TObject);
begin
Close;
end;
procedure TBaseCellForm.OpenFile(FileName:String);
begin
Cell1.DoOpenFile(PubPath+FileName);
end;
procedure TBaseCellForm.FormCreate(Sender: TObject);
//var
// Reg: TRegistry;
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -