📄 global.pas
字号:
unit global;
interface
uses
Windows, Messages,db, SysUtils, Classes, Graphics, Controls, Forms,stdctrls,
Dialogs,math,Printers;
const
MaxPapers=150; //一张申报单最多可生成税票数目。
type
setRecord=record
server:string[60];
dbname:string[60];
user:string[30];
Passwd:string[30];
end;
settype = file of setrecord;
SpHmRecord=record
spHm:integer;
NowUse:integer;
end;
SphmFile = file of Sphmrecord;
HzjksRecord=record
spHm:integer;
end;
HzjksFile = file of Hzjksrecord;
var
ch:string;//启动用
ConnSuccess:boolean; //是否成功连上服务器
LoginSuccess:boolean; //登录是否成功
//---以下是功能权限设置的各项值：--------------------
//---以下是功能权限设置的各项值：--------------------
ft2:boolean;
// ft2:设计
//-----------------------------------------------
OpratorName:string; //操作员姓名
OpratorCode:string; //操作员代码
OpratorGroupcode:string; //操作员所属组代码
OpratorPassWord:string; //操作员口令
superPassWord:string; //操作员口令
servername,DBname:string;
jstj,bbmc,bbdw,bbrq:string; //bbbz 固定报表(1)/自定义报表(0) bbbz,
sfncslr:string; //是否年初数录入 '是'，'否'
//---以下是基本系统设置----------------------------------
//--------------------------------
function To_Date(ss:string;var DD:Tdatetime):boolean;
Procedure OnlyInteger(var ch:char);
Procedure OnlyReal(var ch:char);
function IsNum(Str :string):boolean;
Function dx(hj:currency):string;
function SmallTOBig(xx:currency):string;
Function GetXsd:string;
procedure WriteXsd(XSdstr:string);
function ComputerName : String;
function AddKey(Str:string):string;
function UnAddKey(Str:string):string;
procedure showcombobox(var combotxt:Tcombobox;str:string);
procedure SendTabKey;
procedure SendAltDown;
procedure SendDown;
procedure SendCTLEND;
procedure SendCTLHOME;
Function showform(FormClass: TFormClass; IsModalForm:Boolean):Tform;
implementation
Function showform(FormClass: TFormClass; IsModalForm:Boolean): TForm; //通用form显示,不能在此窗口上在调另外一个窗口.
var I:Integer;
begin
Result:=nil;
for I := 0 to Screen.FormCount - 1 do
begin
if Screen.Forms[I] is FormClass then
begin
Result := Screen.Forms[I];
Break;
end;
end;
if IsModalForm then
begin
Application.CreateForm(FormClass,result);
try
result.ShowModal ;
finally
result.Free;
result:=nil;
end;
end else
begin
if not assigned(result) then
Application.CreateForm(FormClass, result)
else begin
result.WindowState:=wsNormal;
result.Show;
end;
end;
end;
function To_Date(ss:string;var DD:Tdatetime):boolean;
var str:string;
begin //用于判断ss是否是一有效的日期字串，并转成日期型。
if (length(ss)<>8) then begin result:=false; exit; end;
str:=copy(ss,1,4)+'-'+copy(ss,5,2)+'-'+copy(ss,7,2);
try
dd:=strtodatetime(str);
result:=true;
except
result:=false;
end;
end;
//KeyPress事件中执行，加此限后必为整数
Procedure OnlyInteger(var ch:char);
begin
if ord(ch)=8 then exit;
if not (ch in ['0','1','2','3','4','5','6','7','8','9']) then
ch:=#0;
end;
//加此限后，不一定为实数
Procedure OnlyReal(var ch:char);
begin
if ord(ch)=8 then exit;
if not (ch in ['0','1','2','3','4','5','6','7','8','9','.']) then
ch:=#0;
end;
//检测一个字串是否可换转成数值型:
function IsNum(Str :string):boolean;
var ss:string;
i,j:integer;
begin
ss:=trim(str);
if ss='' then
begin
Isnum:=false;
exit;
end;
j:=0;
for i:=1 to length(ss) do
begin
if not (ss[i] in ['-','0','1','2','3','4','5','6','7','8','9','.']) then
begin
isnum:=false;
exit;
end else
begin
if ss[i]='.' then j:=j+1;
if (ss[i]='-') and (i<>1) then
begin
isnum:=false;
exit;
end;
end;
end;
if j>1 then
isnum:=false
else
isNum:=true;
end;
//将数字转成人民币大写
Function dx(hj:currency):string;
var
tmp,dxstring:string;
je,i:integer;
begin
je:=floor(hj*100);
tmp:=inttostr(je);
while length(tmp)<8 do
tmp:='x'+tmp;
i:=1;
dxstring:='';
while i<=8 do
begin
case tmp[i] of
'x':dxstring:=dxstring+'⊕';
'0': dxstring:=dxstring+'零';
'1': dxstring:=dxstring+'壹';
'2': dxstring:=dxstring+'贰';
'3': dxstring:=dxstring+'叁';
'4': dxstring:=dxstring+'肆';
'5': dxstring:=dxstring+'伍';
'6': dxstring:=dxstring+'陆';
'7': dxstring:=dxstring+'柒';
'8': dxstring:=dxstring+'捌';
'9': dxstring:=dxstring+'玖';
end;
i:=i+1;
//下面二行是为了对准金额大写，没有他意
if (i mod 2)=0 then //如果是偶数
dxstring:=dxstring+' '
else dxstring:=dxstring+' ';
end;
result:=dxstring;
end;
//---------------------------------------------------------------
function SmallTOBig(xx:currency):string;
var
v,no,bz,p,k,isneg:integer;
n:double;
a,b,aa,ab,bb,zc:string;
begin
A:='亿仟佰拾万仟佰拾元 角分';
B:='零壹贰叁肆伍陆柒捌玖';
n:=xx;
//保留二位小数
if xx<0 then
begin
xx:=-xx;
isneg:=1;
end else isneg:=0;
aa:=format('%12.2f',[xx]);
bz:=0;
no:=12;
//aa=STR(xx,no,2)
WHILE no>0 DO
begin
bb:=copy(aa,no,1);
IF NOT ((bb='.') OR (bb=' ')) then
begin
v:=strtoint(bb);
IF bb='0' then
begin
CASE no of
5:begin
if copy(aa,6,1)<>'0' then
ab:='万零'
else ab:='万';
end;
9:begin
if copy(aa,11,1)<>'0' then
ab:='元零'
else ab:='元';
end;
12: ab:='整';
else
ab:=copy(B,v*2+1,2);
end;
end
ELSE
ab:=copy(B,v*2+1,2)+copy(A,no*2-1,2);
IF ab<>'零' then
begin
bz:=0;
zc:=ab+zc;
end
ELSE
IF ((bz=0) AND (copy(zc,1,2)<>'元') AND (copy(zc,1,2)<>'万')) then
begin
bz:=1;
zc:=ab+zc;
end;
end;
no:=no-1;
end;
IF N<1 then
zc:=copy(zc,5,30);
IF copy(aa,11,2)='00' then
begin
p:=length(zc);
zc:=copy(zc,1,p-4)+copy(zc,p-1,2);
END;
K:=pos('亿',zc);
IF K<>0 then
begin
IF copy(zc,K+2,2)='万' then
zc:=copy(zc,1,K+1)+copy(zc,K+4,40);
end;
if isneg=1 then zc:='负'+zc;
if zc='整' then zc:='';
result:=zc;
end;
//------------------------------------------------------
Function GetXsd:string;
var f1:text;
filename,xsdstr:string;
begin
//打开文件，
filename:=extractFilepath(application.exename)+'xsd.txt';
// assignfile(f1,filename);
if fileexists(filename)=false then
begin
application.MessageBox('流水帐文本文件丢失！','进销存',mb_iconstop+mb_ok);
exit;
end;
assignfile(f1,filename);
reset(f1);
read(f1,xsdstr);
closefile(f1);
getxsd:=xsdstr;
end;
procedure WriteXsd(XSdstr:string);
var f1:text;
filename:string;
begin
//打开文件，
filename:=extractFilepath(application.exename)+'xsd.txt';
// assignfile(f1,filename);
if fileexists(filename)=false then
begin
application.MessageBox('流水帐文本文件丢失！','进销存',mb_iconstop+mb_ok);
exit;
end;
assignfile(f1,filename);
// reset(f1);
rewrite(f1);
write(f1,xsdstr);
closefile(f1);
end;
function ComputerName : String;
var CNameBuffer : PChar;
fl_loaded : Boolean;
CLen : ^DWord;
begin
GetMem(CNameBuffer,255);
New(CLen);
CLen^:= 255;
fl_loaded := GetComputerName(CNameBuffer,CLen^);
if fl_loaded then
ComputerName := StrPas(CNameBuffer)
else
ComputerName := 'Unkown';
FreeMem(CNameBuffer,255);
Dispose(CLen);
end;
function AddKey(Str:string):string;
var i:integer;
ss:string;
c:char;
begin
ss:=str;
for i:=1 to length(str) do
begin
c:=str[i];
ss[i]:=char(ord(c)+103);
end;
addkey:=ss;
end;
function UnAddKey(Str:string):string;
var i:integer;
ss:string;
c:char;
begin
ss:=str;
for i:=1 to length(str) do
begin
c:=str[i];
ss[i]:=char(ord(c)-103);
end;
unaddkey:=ss;
end;
// showcombobox 用以在combobox 控件的 style 设为 csDropDownList
// 时，来显示一个字段的值！
procedure showcombobox(var combotxt:Tcombobox;str:string);
var i:integer;
begin
for i:=0 to combotxt.Items.Count-1 do
begin
if combotxt.Items.Strings[i]=trim(str) then
begin
combotxt.ItemIndex :=i;
break;
end;
end;
end;
procedure SendTabKey;
begin
keybd_event(VK_TAB,MAPVIRTUALKEY(VK_TAB,0),0,0);
keybd_event(VK_TAB,MAPVIRTUALKEY(VK_TAB,0),KEYEVENTF_KEYUP,0);
end;
procedure SendAltDown;
begin
keybd_event(VK_MENU,MAPVIRTUALKEY(VK_MENU,0),0,0);
keybd_event(VK_DOWN,MAPVIRTUALKEY(VK_DOWN,0),0,0);
keybd_event(VK_DOWN,MAPVIRTUALKEY(VK_DOWN,0),KEYEVENTF_KEYUP,0);
keybd_event(VK_MENU,MAPVIRTUALKEY(VK_MENU,0),KEYEVENTF_KEYUP,0);
end;
procedure SendDown;
begin
keybd_event(VK_DOWN,MAPVIRTUALKEY(VK_DOWN,0),0,0);
keybd_event(VK_DOWN,MAPVIRTUALKEY(VK_DOWN,0),KEYEVENTF_KEYUP,0);
end;
procedure SendCTLEND; //ctrl+End
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(VK_END,MAPVIRTUALKEY(VK_END,0),0,0);
keybd_event(VK_END,MAPVIRTUALKEY(VK_END,0),KEYEVENTF_KEYUP,0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;
procedure SendCTLHOME; //ctrl+Home
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(VK_HOME,MAPVIRTUALKEY(VK_HOME,0),0,0);
keybd_event(VK_HOME,MAPVIRTUALKEY(VK_HOME,0),KEYEVENTF_KEYUP,0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -