📄 u_math.pas
字号:
unit U_math;
interface
uses windows,excel2000, Sysutils, stdctrls, classes, DataBase, ComCtrls, DBTables,
Controls, DBGrids, Variable, Messages, db, Forms, global, DBGridEh, Series, //DbChart,
Registry, FR_Class, FR_PTabl, Printers,FileCtrl,DBGridEhImpExp, Graphics; //QForms,
type
rTreedata=Record
Code:string;
Name:string;
DeleteFlag:Boolean;
EndFlag:Boolean;
SCode:string;
end;
pTreedata=^rTreedata;
procedure Check_EditInteger(Sender:tobject;len:integer;var key:char);
procedure Check_EditFloat(Sender:tobject;len:integer;var key:char);
procedure Check_EditChar(Sender:tobject;len:integer;var key:char);
function ISNULLEdit(Sender:tobject):Real;
procedure GetMemuInfo(PrgCode:string);//获取菜单信息
procedure CreateTree(tvTree:TTreeView;arrangecode:string;FirstNodeTxt:string;qurTree:Tquery;QStr:String);// arrange 排列编码 tNodes 结点
function GetTreeLevel(sFormat,sCode:String):integer; // 返回一个代码级数
procedure AddTreeNode(tvTree:TTreeView;pTD:pTreedata);//新增结点
procedure EditTreeNode(tvTree:TTreeView;pTD:pTreedata);//修改结点
function InttoStrl(value,len:dword):string; //格式化数值为0000000
procedure DestoryTree(tvTree:TTreeView);//摧毁树
function DeleteTreeItem(tNode:TTreeNode):Boolean; //删除树结点
procedure GetNewTreeCode(tvTree:TTreeView;var s :string;Rule:string;var success:integer);//取得新树结点
function GetPyBm(Str:String):String;//取得拼音简码
function GetMonthDayNum(ADate:TDateTime):Integer;//得到任意月天数
function GetDecodeDate(ADate:TDateTime):string;
function CheckDate(sDate:string):Boolean;
procedure AdjustDropDownForm(AControl : TControl; HostControl: TControl); //坐标
function EditMask(s:string;Len:integer):string;
function PartitionSize(Size:string):string;
procedure GetCurrPath;
procedure CreateBomTree(tvTree:TTreeView;arrangecode:string;FirstNodeTxt:string;qurTree:Tquery);// // Bom 树 arrange 排列编码 tNodes 结点
procedure createBomchild(tvTree:TTreeView;Fatherid:integer); //
function GetSerialNo(Typestr: string;var value:string):boolean; //业务流水号
function GetSANo (Typestr: string;var value:string):boolean; //业务流水号typestr ='SAOR'
function CheckBomNewNode( AFatherID :integer; ANewNodeID :integer;var Flag:integer):boolean;//检查新增BomNode
function MessageBoxLg(Handle:integer;Text,Caption:String;flag:integer):integer;
function MainLog(Maker: string; BillNo: string; Flag: integer; FormName, DeptCode: string; Des: string; var PResult: integer): boolean;
function BomCostWork(AgnateID:integer;var PResult:real):real;
function createBusyWork(bookno: string; Maker: string; var PResult: integer): boolean;
//function checkbtn(modcode:string):boolean;
procedure NctDecrypt(Src: pchar; DeStr: pchar); stdcall;
procedure NctEncrypt(Src: pchar; EnStr: pchar); stdcall;
{* 显示提示窗口}
procedure InfoDlg(Mess: string; Caption: string = SCnInformation; Flags: Integer
= MB_OK + MB_ICONINFORMATION);
{* 显示提示确认窗口}
function InfoOk(Mess: string; Caption: string = SCnInformation): Boolean;
{* 显示错误窗口}
procedure ErrorDlg(Mess: string; Caption: string = SCnError);
{* 显示警示窗口}
procedure WarningDlg(Mess: string; Caption: string = SCnWarning);
{* 显示查询是否窗口}
function QueryDlg(Mess: string; DefaultNo: Boolean = False;
Caption: string = SCnInformation): Boolean;
{* 显示是否取消窗口}
function MsgDlg(Mess: string; DefaultNo: Boolean = False;
Caption: string = SCnInformation): Integer;
//权限显示
Function ShowEnable(OldButton, DataButton: Boolean): Boolean;
function WriteReg(Str: String): Integer;
function ReadReg: string;
function Decrypt(S: string): string;
function Encrypt(const S: string): string;
function HexToStr(AStr: string): string;
function StrToHex(AStr: string): string;
function TransChar(AChar: Char): Integer;
function GetIdeSerialNumber: pchar;
//判断时间是否有效
function IsDateTime(const DateString: String): Boolean;
//读取服务器上最新当前时间
function GetNow(Flag: Integer=1): TDateTime;
////////////////////////////////////////////////////////////////////////////////
//判断物料库存情况 // Result -->1:信息提示框 2:提示用户是否继续 3:不需要提示
function CheckStoreSafety(Flag,ShowNum:Integer;var List:TList):Integer;
// function CheckStoreSafety(Flag:Integer;var List:TList):Integer;
////////////////////////////////////////////////////////////////////////////////
//编辑窗体中的下拉框体『函数系列--插入下拉数据』
procedure SetCBList(Index: Integer; Code, Name: String;var List: TList);
//编辑窗体中的下拉框体『函数系列--取出下拉数据对应的编码值』
function GetCBCode(Index: Integer;var List: TList): String;
////////////////////////////////////////////////////////////////////////////////
// added by JiangMin 2005-09-16
// 物料出入库保存前的物料ID号及出入库数量
procedure SetCBGidNum(GID:Integer;Num:Integer;var List:TList);
////////////////////////////////////////////////////////////////////////////////
//增强版网格转换到普通网格中
procedure AssignPrintGrid(SenderGrid: TDBGrid; SourceGrid: TDBGridEh);
//打印增强版网格数据
procedure PrintGridEh(QFormName: String; Flag: Integer; SourceGrid: TDBGridEh;
PInt: Integer=1; BeginDate: TDateTime=-700000; EndDate: TDateTime=-700000;
Maker: String='');
//网格数据导出 SourceGrid:数据源网格 --add by xueqf
procedure ExPortEh(SourceGrid: TDBGridEh);
//将打印模板加载
function LoadPrintModal(MODID: String; PrintRep: TfrReport): Boolean;
//图表画点函数『纵横坐标』
Procedure AddPoint(Const x,y:Double; ZSeries: TLineSeries; Qstr: String; AColor:TColor);
implementation
uses Main, Dialogs ,StrUtils;
procedure NctDecrypt; stdcall; external 'NctMos.dll';
procedure NctEncrypt; stdcall; external 'NctMos.dll';
function MessageBoxLg(Handle:integer;Text,Caption:String;flag:integer):integer;
var
Msg:TMsgBoxParams;
begin
Msg.cbSize:=Sizeof(Msg);
Msg.hwndOwner:=Handle;
Msg.hInstance:=hinstance;
Msg.lpszText:=PChar(Text);
Msg.lpszCaption:=PChar(Caption);
Msg.dwStyle:=flag+MB_USERICON;
Msg.lpszIcon:='MAINICON';
Msg.dwContextHelpId:=1;
Msg.lpfnMsgBoxCallback:=nil;
Msg.dwLanguageId:=LANG_NEUTRAL;
Result:=integer(MessageBoxIndirect(Msg));
end;
function BomCostWork(AgnateID:integer;var PResult:real):real;
var
BomCostProc: TStoredProc;
TPAgnateID,TPResult: TPARAM;
begin
BomCostProc:=TStoredProc.Create(nil);
try
BomCostProc.DatabaseName:='dbmain';
BomCostProc.StoredProcName:='sp_BomCost';
TPAgnateID := tparam.Create(BomCostProc.Params,ptInput);
TPResult := tparam.Create(BomCostProc.Params,ptOutput);
try
try
TPAgnateID.Name := '@AgnateID';
TPAgnateID.DataType := ftInteger;
TPAgnateID.ParamType := ptInput;
TPResult.Name := '@Result';
TPResult.DataType := ftfloat;
TPResult.ParamType := ptoutput;
BomCostProc.ParamByName('@AgnateID').AsInteger := AgnateID;
BomCostProc.ParamByName('@Result').AsFloat := PResult;
BomCostProc.ExecProc;
PResult := BomCostProc.ParamByName('@Result').value;
Result := PResult;
except
Result := 0;
end
finally
TPAgnateID.free;
TPResult.Free;
end;
finally
BomCostProc.Active:=false;
BomCostProc.Free;
end;
end;
function createBusyWork(bookno: string; Maker: string; var PResult: integer): boolean;
var
createBusyWorkProc: TStoredProc;
TPbookno,TPMaker,TPResult: TPARAM;
begin
createBusyWorkProc:=TStoredProc.Create(nil);
try
createBusyWorkProc.DatabaseName:='dbmain';
createBusyWorkProc.StoredProcName:='sp_createBusyWork';
TPbookno := tparam.Create(createBusyWorkProc.Params,ptInput);
TPMaker := tparam.Create(createBusyWorkProc.Params,ptInput);
TPResult := tparam.Create(createBusyWorkProc.Params,ptOutput);
try
try
TPbookno.Name := '@bookno';
TPbookno.DataType := ftstring;
TPbookno.ParamType := ptInput;
TPMaker.Name := '@Maker';
TPMaker.DataType := ftstring;
TPMaker.ParamType := ptInput;
TPResult.Name := '@Result';
TPResult.DataType := ftInteger;
TPResult.ParamType := ptoutput;
createBusyWorkProc.ParamByName('@bookno').AsString := bookno;
createBusyWorkProc.ParamByName('@Maker').AsString := Maker;
createBusyWorkProc.ParamByName('@Result').AsInteger := PResult;
createBusyWorkProc.ExecProc;
PResult := createBusyWorkProc.ParamByName('@Result').value;
if PResult=0 then
Result := false
else
Result := true;
except
Result := false;
end
finally
TPbookno.free;
TPMaker.free;
TPResult.Free;
end;
finally
createBusyWorkProc.Active:=false;
createBusyWorkProc.Free;
end;
end;
//*******************************************
//输入： Maker操作员； BillNo单据流水号； FormName窗体类名； DeptCode部门号； Des描述信息
// Flag --单据更新状态 0制单 1审核 2反审核 3记帐 4下达 5挂起 6取消
// --7是从挂起中恢复 8修改计划 9任务返修下达 10改单 11删除 12改单审核
// --13改单下达 14改单挂起 15改单挂起恢复 16改单取消 17产品另行挂起
// --18出库 19出库修正 20已作废 21已反作废 22已滚回 23已签字
// --24已反签字 25已红冲 26已登帐 27已结帐 28已结转损益 29已期末调汇
// --30日记帐已凭证引入 31日记帐已凭证反引入
//处理： 对编辑框体进行可修改 不可修改处理
//输出： PResult成功标记 True成功 False失败
//*******************************************
function MainLog(Maker: string; BillNo: string; Flag: integer;
FormName, DeptCode: string; Des: string; var PResult: integer): boolean;
var
MainLogProc: TStoredProc;
TPMaker,TPBillNo,TPFlag,TPFormName,TPDeptCode,TPDes,TPResult: TPARAM;
begin
MainLogProc:=TStoredProc.Create(nil);
try
MainLogProc.DatabaseName:='dbmain';
MainLogProc.StoredProcName:='sp_MainLog';
TPMaker := tparam.Create(MainLogProc.Params,ptInput);
TPBillNo := tparam.Create(MainLogProc.Params,ptInput);
TPFlag := tparam.Create(MainLogProc.Params,ptInput);
TPFormName:= tparam.Create(MainLogProc.Params,ptInput);
TPDeptCode:= tparam.Create(MainLogProc.Params,ptInput);
TPDes := tparam.Create(MainLogProc.Params,ptInput);
TPResult := tparam.Create(MainLogProc.Params,ptOutput);
try
try
TPMaker.Name := '@Maker';
TPMaker.DataType := ftstring;
TPMaker.ParamType := ptInput;
TPBillNo.Name := '@BillNo';
TPBillNo.DataType := ftstring;
TPBillNo.ParamType := ptInput;
TPFlag.Name := '@Flag';
TPFlag.DataType := ftInteger;
TPFlag.ParamType := ptInput;
TPFormName.Name := '@FormName';
TPFormName.DataType := ftstring;
TPFormName.ParamType := ptInput;
TPDeptCode.Name := '@DeptCode';
TPDeptCode.DataType := ftstring;
TPDeptCode.ParamType := ptInput;
TPDes.Name := '@Des';
TPDes.DataType := ftstring;
TPDes.ParamType := ptInput;
TPResult.Name := '@Result';
TPResult.DataType := ftInteger;
TPResult.ParamType := ptoutput;
MainLogProc.ParamByName('@Maker').AsString := Maker;
MainLogProc.ParamByName('@BillNo').AsString := BillNo;
MainLogProc.ParamByName('@Flag').AsInteger := Flag;
MainLogProc.ParamByName('@FormName').AsString := FormName;
MainLogProc.ParamByName('@DeptCode').AsString := DeptCode;
MainLogProc.ParamByName('@Des').AsString := Des;
MainLogProc.ParamByName('@Result').AsInteger := PResult;
MainLogProc.ExecProc;
PResult := MainLogProc.ParamByName('@Result').value;
if PResult=0 then
Result := false
else
Result := true;
except
Result := false;
end
finally
TPMaker.free;
TPBillNo.free;
TPFlag.Free;
TPDes.Free;
TPFormName.Free;
TPDeptCode.Free;
TPResult.Free;
end;
finally
MainLogProc.Active:=false;
MainLogProc.Free;
end;
end;
procedure Check_EditInteger(Sender:tobject;len:integer;var key:char);
begin
If Not (key in['0'..'9',chr(VK_BACK),#13]) Then key:=#0 ;
// if TEdit(sender).seltext<>'' then exit;
if (Len>0) and (Length(TEdit(Sender).text)>=len) and (key<>chr(VK_BACK)) then key:=#0;
end;
procedure Check_EditFloat(Sender:tobject;len:integer;var key:char);
begin
if (Pos('.',TEdit(Sender).Text)>1)and (key='.') then key:=#0;
If Not (key in['0'..'9','.',chr(VK_BACK),#13]) Then key:=#0 ;
//if TEdit(Sender).seltext<>'' then exit;
if (Len>0) and (Length(TEdit(Sender).text)>=len) and (key<>chr(VK_BACK)) then key:=#0;
end;
function ISNULLEdit(Sender:tobject):Real;
begin
if TEdit(Sender).Text='' then Result:=0
else Result:=strtofloat(Trim(TEdit(Sender).Text));
end;
procedure GetMemuInfo(PrgCode:string);//获取菜单信息
var
mn_col,mn_row : integer ; //列号和行号
i,ii : integer ; //循环变量
ss : string ; //
str_menu_col,str_menu_row : string;
begin
with DataMod.qurpublic do
begin
try
close;
sql.Clear;
sql.Add('delete from SYS_Module where prgcode='+'"'+PrgCode+'"') ;
ExecSQL ;
except
exit;
end;
end;
PrgCode:='00';
mn_col := frmMain.MainMenu1.Items.Count; //获得菜单列数
//把菜单列记录到Module表中
for i := 1 to mn_col do
begin
ss := frmMain.MainMenu1.Items[i-1].Caption; //获得列名称
if i < 10 then
str_menu_col := '0' + inttostr(i)
else
str_menu_col := inttostr(i); //两位列号
// if i=1 then continue
// else
if ((i mod 4)=1) then prgcode:='0'+inttostr(strtoint(prgcode)+1);
// if ((i mod 4)=0) and (i>10) then prgcode:=inttostr(strtoint(prgcode)+1);
str_menu_row := '00'; //行号为零
with DataMod.qurpublic do
begin
Close;
SQL.Clear ;
SQL.Add (' Insert into SYS_Module ') ;
SQL.Add (' (ModCode , ModName, PrgCode, MenuCol, MenuRow)') ;
SQL.Add (' values (:mod_code , :mod_name, :prg_code,:menu_col,:menu_row) ') ;
ParamByName('mod_code').AsString := PrgCode + str_menu_col + str_menu_row ; //PrgCode为菜单所在应用程序代码，已在外部定义值
ParamByName('mod_name').AsString := ss;
ParamByName('prg_code').AsString := PrgCode;
ParamByName('menu_col').AsString := str_menu_col;
ParamByName('menu_row').AsString := str_menu_row;
try
ExecSQL;
except
exit;
end;
end;
mn_row := frmMain.MainMenu1.Items[i-1].Count;
for ii := 1 to mn_row do
begin
ss := frmMain.MainMenu1.Items[i-1].Items[ii-1].Caption;
ss := trim(ss);
if i < 10 then
str_menu_col := '0' + inttostr(i)
else
str_menu_col := inttostr(i);
if ii < 10 then
str_menu_row := '0' + inttostr(ii)
else
str_menu_row := inttostr(ii);
// Insert Module
with DataMod.qurpublic do
begin
Close;
SQL.Clear ;
SQL.Add (' Insert into SYS_Module ') ;
SQL.Add (' (ModCode , ModName, PrgCode, MenuCol, MenuRow) ') ;
SQL.Add (' values (:mod_code,:mod_name, :prg_code,:menu_col,:menu_row) ') ;
ParamByName('mod_code').AsString:=PrgCode + str_menu_col + str_menu_row ;
ParamByName('mod_name').AsString := ss;
ParamByName('prg_code').AsString := PrgCode;
ParamByName('menu_col').AsString := str_menu_col;
ParamByName('menu_row').AsString := str_menu_row;
try
ExecSQL ;
except
exit;
end;
end; //ii
end; //i
end; //with
End;
procedure CreateTree(tvTree:TTreeView;arrangecode:string;FirstNodeTxt:string;qurTree:Tquery;QStr:String);// arrange 排列编码 tNodes 结点
var
currLevel:integer;
pTD:pTreedata;
Node:array[0..6] of TTreeNode;
i:integer;
begin
currlevel:=0;
tvtree.Items.Clear;
tvtree.ShowRoot:=False;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -