📄 apppub.pas
字号:
if not sysutils.FileExists(fileName) then //nofile
exit;
Assignfile(logfile,fileName);
reset(logFile);
i:=0;
while i<index do
begin
readln(logfile,tmpresult);
if tmpresult[1]<>'//' then
i:=i+1;
end;
result:=tmpresult;
end;
function ckfreespace():int64;
var a,b,c,d:cardinal;
e:int64;
begin
a:=0;b:=0;c:=0;d:=0;result:=-1;
if windows.GetDiskFreeSpace(pchar(ExtractFileDrive(application.ExeName)+'\'),a,b,c,d) then
begin
if b<=0 then exit;
if c=d then exit;
e:=(a * b) div 1024;
e:=e*c div 1024;
result:=e;
// if e<minfreespace then
// Messagebox(0,pchar('磁盘空间小于'+inttostr(minfreespace)+',请删除部分不用文件,以释放磁盘空间.'),'',MB_OK);
end
else
result:=-1;
end;
///////////////////////////////////////////////////////////////////////////////////////////////
procedure stringgridAddLine(const srcstrs:Tstrings;var strgrig:TStringGrid);
var i:integer;
begin
if not logined then exit;
if strgrig.ColCount<>srcstrs.count then
strgrig.ColCount:=srcstrs.count;
if (strgrig.Rowcount>=2) then
if (strgrig.Cells[0,1]<>'') and (strgrig.Cells[0,1]<>' ') then
strgrig.Rowcount:=strgrig.Rowcount+1;
for i:=0 to srcstrs.count-1 do
strgrig.Cells[i,strgrig.Rowcount-1]:=srcstrs.Strings[i];
end;
procedure importregfile(regfilename:string);
var logfile:text;
tstr:string;
tmpstr:string;
begin
if (not fileexists(regfilename)) or (extractfileext(regfilename)<>'.reg') then exit;
Assignfile(logfile,regfilename);
reset(logfile);
while not eof(logfile) do
begin
readln(logfile,tmpstr);
tstr:=tstr+tmpstr+#$d#$a;
end;
closefile(logfile);
rewrite(logfile);
tmpstr:=stringreplace(apppath,'\','\\',[rfreplaceall]);
tstr:=stringreplace(tstr,'~',tmpstr,[rfreplaceall]);
write(logfile,tstr);
closefile(logfile);
ShellExecute(application.Handle,'open','regedit.exe',pchar(regfilename),nil,1);
//sysutils.DeleteFile(regfilename);
end;
function savestrings(const filename:string;strs:Tstrings):boolean;
var logfile:text;
I:INTEGER;
begin
result:=false;
if filename='' then exit;
Assignfile(logfile,filename);
rewrite(logfile);
try
for i:=0 to strs.Count-1 do
writeln(logfile,strs.strings[i]);
result:=true;
except
end;
closefile(logfile);
end;
function readstrings(const filename:string;var strs:Tstrings):boolean;
var logfile:text;
tstr:string;
begin
result:=false;
strs.Clear;
if not fileexists(filename) then exit;
Assignfile(logfile,filename);
reset(logfile);
try
while not eof(logfile) do
begin
tstr:='';
readln(logfile,tstr);
strs.Add(tstr);
end;
result:=true;
except
end;
closefile(logfile);
end;
function savetbtohtml(dset:Tdataset;filename,title:string):boolean;
var tstr,fext:string;
txtfile:text;
i,j:integer;
tstr4:string;
begin
try
if not dset.Active then dset.Active:=true;
assignfile(txtfile,filename);
rewrite(txtfile);
writeln(txtfile,'<html><head><title>'+title+'</title></head><body>');
writeln(txtfile,'<center>'+title+'</center><hr><table border=1 align=center width=%100 cellpadding="0" cellspacing="0" bordercolorlight="#CCCCCC" bordercolordark="#FFFFFF">');
tstr:='';
for i:=0 to dset.FieldCount-1 do
begin
tstr:=tstr+'<td>'+dset.Fields[i].FieldName+'</td>';
end;
writeln(txtfile,'<tr>'+tstr+'</tr>');
if not dset.Eof then
begin
dset.First;
for i:=0 to dset.RecordCount-1 do
begin
tstr:='';
for j:=0 to dset.FieldCount-1 do
begin
if dset.Fields[j].AsString='' then
tstr:=tstr+'<td> </td>'
else
tstr:=tstr+'<td>'+dset.Fields[j].AsString+'</td>';
end;
writeln(txtfile,'<tr>'+tstr+'</tr>');
dset.Next;
end;
end;
writeln(txtfile,'</table></body></html>');
closefile(txtfile);
result:=true;
except
result:=false;
end;
dset.active:=false;
end;
function savetbtohtml(dset:Tstringgrid;filename,title:string):boolean;
var tstr,fext:string;
txtfile:text;
i,j:integer;
tstr4:string;
begin
try
assignfile(txtfile,filename);
rewrite(txtfile);
writeln(txtfile,'<html><head><title>无标题</title></head><body>');
writeln(txtfile,'<center>'+title+'</center><table border=1 align=center width=%100 cellpadding="0" cellspacing="0" bordercolorlight="#CCCCCC" bordercolordark="#FFFFFF">');
tstr:='';
for i:=0 to dset.RowCount-1 do
begin
tstr:='';
for j:=0 to dset.colCount-1 do
begin
if dset.Cells[j,i]='' then
tstr:=tstr+'<td> </td>'
else
tstr:=tstr+'<td>'+dset.Cells[j,i]+'</td>';
end;
writeln(txtfile,'<tr>'+tstr+'</tr>');
end;
writeln(txtfile,'</table></body></html>');
closefile(txtfile);
result:=true;
except
result:=false;
end;
end;
function decodestr(const S:string;encodebyte:integer=15):string;
var i:integer;
tret:string;
begin
if length(S) mod 2<>0 then exit;
tret:='';
for i:=1 to length(S) div 2 do
tret:=tret+chr(byte(strtoint('$'+S[i*2-1]+S[i*2])-encodebyte));
result:=tret;
end;
function encodestr(const S:string;encodebyte:integer=15):string;
var i:integer;
tret:string;
begin
tret:='';
for i:=1 to length(S) do
tret:=tret+inttohex(byte(ord(S[i])+encodebyte),2);
result:=tret;
end;
PROCEDURE SETAPPPSTYLE;
VAR I,J:INTEGER;
TSTR:STRING;
fcolor:CARDINAL;
SYSV:cardinal;
pa:array of byte;
BEGIN
SYSV:=WINDOWS.GetVersion;
sysv:=(LOBYTE(LOWORD(SYSV)));
IF sysv>4 THEN EXIT;
tstr:=appconfig.Datas['appbk','appcolor'];
if tstr='' then exit;
Bitmap := TBitmap.create;
if tstr[1]<>'B' then
begin
fcolor:=strtoint(tstr);
SYSV:=0;
end
else
begin
tstr:=copy(tstr,2,length(tstr));
tstr:=stringreplace(tstr,'..\',apppath,[rfreplaceall]);
if not fileexists(tstr) then exit;
Bitmap.LoadFromFile(tstr);
end;
fcolor:=bitmap.Canvas.Pixels[0,0];
for I:=0 to application.ComponentCount-1 do
if application.Components[I] is tform then
begin
if SYSV=0 then
Tcustomform(application.Components[I]).Color:=fcolor
else
begin
Tcustomform(application.Components[I]).Color:=fcolor;
Tcustomform(application.Components[I]).Brush.Bitmap:=Bitmap;
for j:=0 to Tcustomform(application.Components[I]).ComponentCount-1 do
if Tcustomform(application.Components[I]).Components[j] is twincontrol then
BEGIN
twincontrol(Tcustomform(application.Components[I]).Components[j]).Brush.Bitmap:=bitmap;
END;
end;
end;
END;
function savegridtohtml(dset:Tstringgrid;filename,title:string):boolean;
var tstr,fext:string;
i,j:integer;
tstr4:string;
tstrs:tstrings;
begin
tstrs:=tstringlist.Create ;
try
tstrs.add('<html><head><title>'+title+'</title></head><body>');
tstrs.add('<center>'+title+'</center><table border=1 align=center width=%100 cellpadding="0" cellspacing="0" bordercolorlight="#CCCCCC" bordercolordark="#FFFFFF">');
tstr:='';
for i:=0 to dset.RowCount-1 do
begin
tstr:='';
for j:=0 to dset.ColCount-1 do
begin
if dset.Cells[j,i]='' then
tstr:=tstr+'<td> </td>'
else
tstr:=tstr+'<td>'+dset.Cells[j,i]+'</td>';
end;
tstrs.add('<tr>'+tstr+'</tr>');
end;
tstrs.add('</table></body></html>');
tstrs.SaveToFile(filename);
result:=true;
except
result:=false;
end;
tstrs.Free;
end;
procedure Tcasefile.LoadFromFile(const FileName: string);
var i:integer;
begin
inherited LoadFromFile(filename);
for i:=0 to count-1 do
if (i<count) and (copy(strings[i],1,2)='//') then
self.Delete(i);
end;
function Tcasefile.maptogrid(gridctrl:Tstringgrid):boolean;
var i:integer;
begin
gridctrl.RowCount:=self.Count+1;
for i:=1 to count do
gridctrl.Rows[i].Text :=stringreplace(strings[i-1],',',#$D#$A,[rfreplaceall]);
result:=true;
end;
function Tcasefile.loadfromgrid(gridctrl:Tstringgrid):boolean;
var i:integer;
begin
text:='';
for i:=1 to gridctrl.RowCount-1 do
Add(stringreplace(gridctrl.Rows[i].Text,#$D#$A,',',[rfreplaceall]));
result:=true;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -