u_tools_leo.pas

来自「一个仓库管理中的子系统－－采购子系统」· PAS 代码 · 共 1,257 行 · 第 1/3 页

/////////////////////////////////////////////////////////////////////////////////
function replace_qrlabel_all(form:tform;Rep:TQuickRep):boolean;
var
  count1:integer;
  control:tcomponent;
begin
try
for count1:=0 to form.ComponentCount-1 do
  begin
  if (form.components[count1] is tedit) or (form.components[count1] is tlabel) then
    if  (tcontrol(form.components[count1]).visible=true) and (tcontrol(form.components[count1]).hint<>'') then
      begin
      control:=FindChildControl(rep,tcontrol(form.components[count1]).hint);
      if control<>nil then
        replace_qrlabel(tcontrol(form.components[count1]),twincontrol(control));
      end;

  end;
except
application.MessageBox('显示数据到报表时发生错误.','系统提示',mb_ok+mb_iconinformation);
end;
end;
/////////////////////////////////////////////////////////////////////////////////
function replace_qrlabel(control:tcontrol;Band:twincontrol):boolean;
var
  QRLabel:tqrlabel;
  edit:tedit;
  l:tlabel;
begin
if control is tedit then
  begin
  edit:=tedit(control);
  qrlabel:=tqrlabel.Create(band);
  qrlabel.parent:=band;
  qrlabel.AutoSize:=true;
  qrlabel.Caption:=edit.text;
  qrlabel.Font:=edit.font;
  qrlabel.font.color:=clblack;
  qrlabel.Left:=round(edit.Left/twincontrol(edit.parent).width*band.Width);
  qrlabel.top:=round((band.Height-qrlabel.height)/2);
  qrlabel.visible:=true;
  end;
if control is tlabel then
  begin
  l:=tlabel(control);
  qrlabel:=tqrlabel.Create(band);
  qrlabel.parent:=band;
  qrlabel.AutoSize:=true;
  qrlabel.Caption:=l.caption;
  qrlabel.Font:=l.font;
  qrlabel.font.color:=clblack;
  qrlabel.Left:=round(l.Left/twincontrol(l.parent).width*band.Width);
  qrlabel.top:=round((band.Height-qrlabel.height)/2);
  qrlabel.visible:=true;
  end;
end;

//////////////////////////////////////////////////////////////////////////
function isnextmonth(year1,month1,year2,month2:integer):integer;
begin
if (year1=year2) and (month1=month2) then
  begin
  result:=0;
  exit;
  end;
if (year1=year2) and (abs(month1-month2)=1) then
  begin
  result:=1;
  exit;
  end;
if (year1-year2=1) and (month1=1) and (month2=12) then
  begin
  result:=1;
  exit;
  end;
if (year2-year1=1) and (month2=1) and (month1=12) then
  begin
  result:=1;
  exit;
  end;
result:=2;  
end;
function changelength_back(str:string;fillchar:char;strlength:integer):string;
var
  count1:integer;
  buf:string;
begin
if length(str)>=strlength then
  begin
  result:=copy(str,1,strlength);
  end
else begin
     for count1:=1 to strlength-length(str) do
       buf:=buf+fillchar;
     result:=str+buf;
     end;

end;
//////////////////////////////////////////////////////////////////////////
function getsql_cal_ware(warename:string;wareidnames:array of string;wareslname,xbname,xbzbidname:string;xbxbidnames:array of string;xbslname,zbid,caltype:string):string;
var
  buf:string;
  count1:integer;
  xbxbiditems:string;//构造插入到ware表中的id码
  xbxbidname,wareidname,tempwareidname:string;//需要做比较的两个参数
  tempwarename:string;
begin
for count1:=0 to high(xbxbidnames) do
  begin
  xbxbiditems:=xbxbiditems+xbxbidnames[count1]+',';
  xbxbidname:=xbxbidname+xbname+'.'+xbxbidnames[count1]+'+';
  end;
xbxbiditems:=copy(xbxbiditems,1,length(xbxbiditems)-1);
xbxbidname:=copy(xbxbidname,1,length(xbxbidname)-1);

for count1:=0 to high(wareidnames) do
  begin
  wareidname:=wareidname+warename+'.'+wareidnames[count1]+'+';
  end;
wareidname:=copy(wareidname,1,length(wareidname)-1);
tempwarename:='tempware_leo';
for count1:=0 to high(wareidnames) do
  begin
  tempwareidname:=tempwareidname+tempwarename+'.'+wareidnames[count1]+'+';
  end;
tempwareidname:=copy(tempwareidname,1,length(tempwareidname)-1);
for count1:=0 to high(xbxbidnames) do
if caltype='+' then//如果库中没有这个项目，需要将这个项目加上来，且数量为零。
buf:='insert into '+warename+('(id,rkrq,sl,jldw,dj)')+' select '+xbxbiditems+',0,jldw,dj from '+xbname+' where '+xbxbidname+' not in (select '+wareidname+' from '+warename+') and '+xbzbidname+'='+''''+zbid+'''';
result:=buf+' '+'update '+warename +' set '+wareslname+'=(select '+wareslname +' from '+warename+' '+tempwarename+' where '+tempwareidname+'='+wareidname+')'+caltype+'(select '+xbslname+' from '+xbname+' where '+xbzbidname+'='+''''+zbid+''''+' and '+xbxbidname+'='+wareidname+') where '+wareidname+' in (select '+xbxbidname+' from '+xbname+' where '+xbzbidname+'='+''''+zbid+''''+')';
end;
//////////////////////////////////////////////////////////////////////////
function getsql_cal_ware(warename,wareidname,wareslname,xbname,xbzbidname,xbxbidname,xbslname,zbid,caltype:string):string;
var
  buf:string;
begin
if caltype='+' then//如果库中没有这个项目，需要将这个项目加上来，且数量为零。
buf:='insert into '+warename+' select '+xbxbidname+',0,jldw,dj from '+xbname+' where '+xbxbidname+' not in (select '+wareidname+' from '+warename+') and '+xbzbidname+'='+''''+zbid+'''';
result:=buf+' '+'update '+warename +' set '+wareslname+'=(select '+wareslname +' from '+warename+' zck2 where zck2.'+wareidname+'='+warename+'.'+wareidname+')'+caltype+'(select '+xbslname+' from '+xbname+' where '+xbzbidname+'='+''''+zbid+''''+' and '+xbxbidname+'='+warename+'.'+wareidname+') where '+warename+'.'+wareidname+' in (select '+xbxbidname+' from '+xbname+' where '+xbzbidname+'='+''''+zbid+''''+')';
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.add(stream:tstream):integer;
var
  tempstream:tmemorystream;
begin
tempstream:=tmemorystream.Create;
stream.Position:=0;
tempstream.CopyFrom(stream,0);
flist.Add(tempstream);
result:=flist.count-1;
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.delete(index:integer):boolean;
begin
result:=false;
if (index<0) or (index>=flist.Count) then exit;
tmemorystream(flist[index]).free;
flist.Delete(index);
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.write(stream:tstream;index:integer):boolean;
begin
result:=false;
if (index<0) or (index>=flist.Count) then exit;
stream.Position:=0;
stream.CopyFrom(tmemorystream(flist[index]),0);
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.savetostream(stream:tmemorystream):boolean;
var
  str:tstringlist;
  strstream:tmemorystream;
  count1:integer;
  ssize:tstringstream;
begin
result:=false;
try
  str:=tstringlist.Create;
  strstream:=tmemorystream.Create;
  //记录下每个stream的长度，用于恢复
  //stream的结构：
  //20个字节的长度指示+一个stream用于恢复长度+若干个stream流.
  for count1:=0 to flist.Count-1 do
    str.add(inttostr(tmemorystream(flist[count1]).size));
  str.SaveToStream(strstream);
  ssize:=tstringstream.create(changelength(inttostr(strstream.size),'0',headsizelength));
  stream.clear;
  //存入位置指示
  ssize.position:=0;
  stream.copyfrom(ssize,ssize.size);
  //存入每个流的大小指示
  strstream.position:=0;
  stream.copyfrom(strstream,strstream.size);
  //将每个流都存入stream中
  for count1:=0 to flist.Count-1 do
     begin
     tmemorystream(flist[count1]).position:=0;
     stream.copyfrom(tmemorystream(flist[count1]),tmemorystream(flist[count1]).size);
     end;
finally
  if str<> nil then str.free;
  if strstream<> nil then strstream.free;
end;
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.loadfromstream(stream:tstream):boolean;
var
  ssize:tstringstream;
  size:integer;
  slist:tmemorystream;
  sizelist:tstringlist;
  count1:integer;
  tempstream:tmemorystream;
begin
result:=false;
ssize:=tstringstream.create('');
slist:=tmemorystream.create;
sizelist:=tstringlist.Create;
ssize.position:=0;
stream.position:=0;
try
try
  ssize.copyfrom(stream,headsizelength);
  size:=strtoint(ssize.datastring);
  slist.position:=0;
  stream.position:=headsizelength;
  slist.copyfrom(stream,size);
  slist.Position:=0;
  sizelist.LoadFromStream(slist);
  for count1:=0 to sizelist.Count-1 do
    begin
    tempstream:=tmemorystream.Create;
    tempstream.CopyFrom(stream,strtoint(sizelist[count1]));
    flist.add(tempstream);
    end;
except
  exit;
end;
finally
  if ssize<>nil then ssize.free;
  if slist<>nil then slist.free;
  if sizelist<>nil then sizelist.free;
end;
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.savetofile(filename:string):boolean;
var
  tempstream:tmemorystream;
begin
result:=false;
try
  tempstream:=tmemorystream.Create;
  savetostream(tempstream);
  tempstream.SaveToFile(filename);
  tempstream.free;
finally
  if  tempstream<>nil then tempstream.free;
end;
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function TStreams.loadfromfile(filename:string):boolean;
var
  tempstream:tmemorystream;
begin
result:=false;
try
  tempstream:=tmemorystream.Create;
  tempstream.loadfromFile(filename);
  loadfromstream(tempstream);
  tempstream.free;
finally
  if  tempstream<>nil then tempstream.free;
end;
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
constructor TStreams.create;
begin
flist:=tlist.Create;
inherited;
end;
//////////////////////////////////////////////////////////////////////////
destructor  TStreams.destroy;
var
  count1:integer;
begin
for count1:=0 to flist.Count-1 do
  tmemorystream(flist[count1]).free;
flist.free;
inherited ;
end;
//////////////////////////////////////////////////////////////////////////
function tstreams.getcount:integer;
begin
result:=flist.count;
end;
//////////////////////////////////////////////////////////////////////////
function tmsgpacket.savetostream(stream:tmemorystream):boolean;
var
  ssize:tstringstream;
  slist:tmemorystream;
begin
result:=false;
if not assigned(stream) then  exit;
ssize:=tstringstream.create(changelength(inttostr(getheadsize),'0',headsizelength));
slist:=tmemorystream.create;
flist.savetostream(slist);
stream.clear;
ssize.position:=0;
stream.copyfrom(ssize,ssize.size);
slist.position:=0;
stream.copyfrom(slist,slist.size);
fmem.position:=0;
stream.copyfrom(fmem,fmem.size);
ssize.free;
slist.free;
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function tmsgpacket.savetofile(filename:string):boolean;
var
  mem:tmemorystream;
begin
result:=false;
mem:=tmemorystream.Create;
try
  if savetostream(mem)=false then exit;
  mem.SaveToFile(filename);
finally
  mem.free;
end;
result:=true;
end;
//////////////////////////////////////////////////////////////////////////
function tmsgpacket.loadfromstream(stream:tstream):boolean;
var
  ssize:tstringstream;
  size:integer;
  slist:tmemorystream;
begin
ssize:=tstringstream.create('');
slist:=tmemorystream.create;
ssize.position:=0;
stream.position:=0;
ssize.copyfrom(stream,headsizelength);
try
try
  size:=strtoint(ssize.datastring);
  slist.position:=0;
  stream.position:=headsizelength;
  slist.copyfrom(stream,size);
  slist.Position:=0;
  flist.loadfromstream(slist);
  fmem.free;
  fmem:=tmemorystream.create;
  fmem.position:=0;
  fmem.copyfrom(stream,stream.size-stream.position);
except
  flist.clear;
  fmem.free;
  fmem:=tmemorystream.create;
  fmem.size:=0;
  result:=false;
  exit;
end;
result:=true;
finally
ssize.free;
slist.free;
end;
end;
//////////////////////////////////////////////////////////////////////////
function tmsgpacket.loadfromfile(filename:string):boolean;
var
  mem:tmemorystream;
begin
mem:=tmemorystream.create;
mem.loadfromfile(filename);
if loadfromstream(mem)=false then
  begin
  result:=false;
  flist.clear;
  fmem.size:=0;
  exit;
  end;
mem.free;
result:=true;
end;
////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////
destructor tmsgpacket.destory;
begin
fmem.free;
inherited;
end;
//////////////////////////////////////////////////////////////////////////
constructor tmsgpacket.create;
begin
inherited;
fmem:=tmemorystream.create;
fmem.size:=0;
flist:=tstringlist.create;
flist.clear;
end;
/////////////////////////////////////////////////////////////////////////////////////
procedure tmsgpacket.setvalue(const name,value:string);
begin
flist.values[name]:=value;
end;
////////////////////////////////////////////////////////////////////////////////////
function tmsgpacket.isempty;
begin
result:=((fmem.size=0) or (flist.count=0));
end;