dataproc.pas

集成酒店桑拿食管管理的完整程序

unit dataproc;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    Db, DBTables,grids,dbgrids,stdctrls,REGISTRY;


type
  Tfm = class(TDataModule)
    Database1: TDatabase;
    Database2: TDatabase;
    Query1: TQuery;
    Query2: TQuery;
    newcode: TStoredProc;
    Database3: TDatabase;
    Query3: TQuery;
    Database4: TDatabase;
    Query4: TQuery;
    Query5: TQuery;
    Query6: TQuery;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type pertype=record
     name:string;
     code:string;
     curbc:string;
     dept:string;
     Headship:string;
     sydw:string;
     workpath:string;
     workjsj:string;
     sysdir:string;
     offduty:string;
    end;
var
  fm: Tfm;
  curper :pertype;
  lc:string;
  xt:integer;
  Procedure  GetValue(var valuearr:array of string;qutj :string);
  Procedure  ChineseGrid(gridname:TDbGrid);
  procedure  comadd(combo:TComboBox;listfieldnum:integer;sqltj:string);
  procedure  addlogo(code:string;dt:string;de:string);
  function  passzh(kl:string):string;
  function xdh(db,lsdb,name:string;l:integer):string;
  function xbh(db,lsdb,name:string;l1,l2:integer):string;
  function  passname(kl:string):string;
  function  unpassname(kl:string):string;
  Procedure qkgrid(gg:TStringGrid);
  Procedure  degrid(grid:tstringgrid);
  procedure Help(index:integer);
  procedure oldtonew(old,new:TStringGrid;k:integer);
  Procedure rytobox(box1,box2:TComboBox;lx:string);
  function  ICKcz(je,sjje:real;kh,jsr,cz,xf:string):integer;
 // function  ICKcz(je:real;kh,jsr,cz,xf:string):integer;
//  function  ICKxf(je:real;kh,jsr,djcode,cz,xf:string):integer;
  function  ICKxf(je:real;kh,jsr,xfdz,djcode,cz,xf:string):integer;
  function rmb(je:real):string;
  function xtod(xx:integer):string;
  procedure  allunlock(wd:string);
  function  getnewcode(code:string):string;
  function pyjc(hz:string):string;
  procedure  cleargrid(gridname:TStringGrid;starcol:integer);
  Function  roommoney(rmno:string;isbj,iszd:integer):integer;
  function cwpz(pzrq:tdatetime;pzlx,zy:string;kmdm:array of string;jje,dje:array of Currency;bmdm,djh:string;jsfs:integer;dqh,dwdm,jsr,fphm:string;fprq:tdatetime;ywbh:string;sl,dj,wb,hl:array of Currency;ts:integer):integer;
  function yysrpz(pzrq,pzlx,zy:string;kmdm,bmdm:array of string;jje,dje:array of Currency;ts:integer):integer;
  Procedure  addoldcom(combo:TComboBox;nr,db:string);
  procedure  comadd1(combo,combo2:TComboBox;listfieldnum:integer;sqltj:string);
  procedure servertime(Sender: TObject);
  function  ICKjd(kh,cz,xf:string):integer;


implementation
uses icdate;
{$R *.DFM}
Procedure rytobox(box1,box2:TComboBox;lx:string);
begin
   fm.query1.RequestLive:=false;
   fm.query1.Active :=false;
   fm.query1.sql.clear;
 //  fm.query1.sql.add('select stuff.code,stuff.name from stuff,rytype where rytype.deptcode=stuff.deptcode and stuff.Headship=rytype.code and rytype.typename='''+lx+'''');
   fm.query1.sql.add('select stuff.code,stuff.name from stuff,rytype where rytype.deptcode=stuff.deptcode and stuff.Headship=rytype.code and stuff.isfwy='+lx+'');
   fm.query1.Open;
   box1.Items.Clear;
   box2.Items.Clear;
   while not fm.query1.eof do
   begin
     box1.Items.Add(fm.query1.fields[0].asstring);
     box2.Items.Add(fm.query1.fields[1].asstring);
     fm.query1.next;
   end;
   fm.query1.sql.clear;
   fm.Query1.UnPrepare;
   fm.query1.RequestLive:=false;
end;
function xtod(xx:integer):string;
begin
  case xx of
  0:xtod:='零';
  1:xtod:='壹';
  2:xtod:='贰';
  3:xtod:='叁';
  4:xtod:='肆';
  5:xtod:='伍';
  6:xtod:='陆';
  7:xtod:='柒';
  8:xtod:='捌';
  9:xtod:='玖';
  end;
end;


function rmb(je:real):string;
var ls:string;
    je0,je1:real;
    i,k,bz:integer;
    dw:array[1..7] of string;
begin
   je1:=int(abs(je));
   je0:=int((abs(je)-je1)*100+100.5);
   ls:='整';
   dw[5]:='';
   dw[4]:='仟';
   dw[3]:='佰';
   dw[2]:='拾';
   dw[1]:='';
   dw[6]:='角';
   dw[7]:='分';
   for i:=0 to 1 do
   begin
     if xtod(strtoint(floattostr(abs(je0))[3-i]))<>'零' then
         ls:=xtod(strtoint(floattostr(abs(je0))[3-i]))+dw[7-i]+ls
     else
     begin
       if i=1 then
         ls:=xtod(strtoint(floattostr(abs(je0))[3-i]))+ls;
     end;
   end;
   k:=1;
   bz:=1;
   ls:='元'+ls;

   for i:=0 to length(floattostr(je1))-1 do
   begin
     if k>5 then k:=2;
     if i=4 then ls:='万'+ls;
     if i=9 then ls:='亿'+ls;
//     if i=11 then ls:='兆'+ls;
     if bz=1 then
     begin
       if xtod(strtoint(floattostr(je1)[length(floattostr(je1))-i]))='零' then bz:=1
       else
       begin
         ls:=xtod(strtoint(floattostr(je1)[length(floattostr(je1))-i]))+dw[k]+ls;
         bz:=0;
       end;
     end
     else
     begin
       if xtod(strtoint(floattostr(je1)[length(floattostr(je1))-i]))='零' then
       begin
           bz:=1;
          ls:=xtod(strtoint(floattostr(je1)[length(floattostr(je1))-i]))+ls;
       end
       else
         ls:=xtod(strtoint(floattostr(je1)[length(floattostr(je1))-i]))+dw[k]+ls;
     end;
     k:=k+1;
   end;
   rmb:=ls;
end;


Procedure qkgrid(gg:TStringGrid);
var i,j:integer;
begin
  for i:=0 to gg.ColCount-1 do
  for j:=0 to gg.RowCount-1 do
     gg.Cells[i,j]:='';
end;

function xdh(db,lsdb,name:string;l:integer):string;
var i,bz:integer;
    ls,lsxbh:string;
begin
      for i:=1 to l-1 do
        ls:=ls+'0';
      fm.query2.sql.clear;
      fm.Query2.active:=false;
      fm.query2.sql.text:='delete xbhtemp';
      fm.query2.sql.Add('insert into xbhtemp select distinct '+name+' from '+db);
      if trim(lsdb)<>'' then
         fm.query2.sql.Add('insert into xbhtemp select distinct '+name+' from '+lsdb);
//      fm.query2.Prepare;
      fm.query2.ExecSQL;
      fm.query2.sql.clear;
      fm.Query2.active:=false;
      fm.query2.sql.text:='select max(bh) from xbhtemp';
//      fm.query2.Prepare;
      fm.query2.open;
      if (fm.query2.Fields[0].IsNull) or (trim(fm.query2.Fields[0].asstring)='') then
        lsxbh:=ls+'1'
      else
      begin
         bz:=0;
         lsxbh:=trim(fm.query2.Fields[0].asstring);
         while bz=0 do
         begin
           lsxbh:=copy(ls+inttostr(strtoint64(lsxbh)+1),length(inttostr(strtoint64(lsxbh)+1)),l);
           fm.query2.sql.clear;
           fm.Query2.active:=false;
           fm.query2.sql.text:='select bh from xbhtemp where bh='''+lsxbh+'''';
           fm.query2.Prepare;
           fm.query2.open;
           if not fm.Query2.Eof then bz:=0
           else bz:=1;
         end;
      end;
      fm.query2.close;
      fm.query2.sql.clear;
      fm.Query2.UnPrepare;
      fm.query2.RequestLive:=false;
      fm.Query2.active:=false;
      fm.query2.sql.clear;
      fm.query2.sql.text:='delete xbhtemp';
      fm.query2.Prepare;
      fm.query2.ExecSQL;
      fm.query2.sql.clear;
      fm.Query2.UnPrepare;
//      fm.Query2.active:=true;
      fm.query2.RequestLive:=false;
      xdh:=lsxbh;

end;

function xbh(db,lsdb,name:string;l1,l2:integer):string;
var i,bz:integer;
    ls,lsxbh,ls1:string;
begin
      for i:=1 to l2-1 do
        ls:=ls+'0';
      fm.query2.sql.clear;
      fm.Query2.active:=false;
      fm.query2.sql.text:='delete from xbhtemp';
      fm.query2.sql.Add('insert into xbhtemp select distinct '+name+' from '+db);
      if trim(lsdb)<>'' then
         fm.query2.sql.Add('insert into xbhtemp select distinct '+name+' from '+lsdb);
      fm.query2.Prepare;
      fm.query2.ExecSQL;
      fm.query2.sql.clear;
      fm.Query2.active:=false;
      fm.query2.sql.text:='select max(bh) from xbhtemp';
      fm.query2.Prepare;
      fm.query2.open;
      if (fm.query2.Fields[0].IsNull) or (trim(fm.query2.Fields[0].asstring)='') then
        lsxbh:=ls+'1'
      else
      begin
         bz:=0;
         lsxbh:=copy(fm.query2.Fields[0].asstring,l1,l2);
         ls1:=copy(fm.query2.Fields[0].asstring,1,l1-1);
         while bz=0 do
         begin
           lsxbh:=copy(ls+inttostr(strtoint64(lsxbh)+1),length(inttostr(strtoint64(lsxbh)+1)),l2);
           fm.query2.sql.clear;
           fm.Query2.active:=false;
           fm.query2.sql.text:='select bh from xbhtemp where bh='''+ls1+lsxbh+'''';
           fm.query2.Prepare;
           fm.query2.open;
           if not fm.Query2.Eof then bz:=0
           else bz:=1;
         end;
      end;
      fm.query2.close;
      fm.query2.sql.clear;
      fm.Query2.UnPrepare;
      fm.query2.RequestLive:=false;
      fm.Query2.active:=false;
      fm.query2.sql.clear;
      fm.query2.sql.text:='delete from xbhtemp';
      fm.query2.Prepare;
      fm.query2.ExecSQL;
      fm.query2.sql.clear;
      fm.Query2.UnPrepare;
//      fm.Query2.active:=true;
      fm.query2.RequestLive:=false;
      xbh:=ls1+lsxbh;

end;




function  passzh(kl:string):string;
var i:integer;
   ls:string;
begin
  ls:='';
  for i:=1 to length(kl) do
     ls:=ls+chr(ord(kl[i])*3);
  passzh:=ls;
end;

function  unpassname(kl:string):string;
var i:integer;
   ls:string;
begin
  ls:='';
  for i:=1 to length(kl) do
     ls:=ls+chr(ord(kl[i])-8);
  unpassname:=ls;
end;

function  passname(kl:string):string;
var i:integer;
   ls:string;
begin
  ls:='';
  for i:=1 to length(kl) do
     ls:=ls+chr(ord(kl[i])+8);
  passname:=ls;
end;

procedure Help(index:integer);
begin
   if xt=0 then
     winhelp(0,Pchar('前台帮助.hlp'),HELP_CONTEXT,index);
   if xt=1 then
     winhelp(0,Pchar('查询帮助.hlp'),HELP_CONTEXT,index);
end;


Procedure  degrid(grid:tstringgrid);
var i,j:integer;
begin
   i:=grid.Row;
   while trim(grid.Cells[0,i])<>'' do
   begin
      for j:=0 to grid.ColCount-1 do
        grid.Cells[j,i]:=grid.Cells[j,i+1];
      i:=i+1;
   end;
end;

procedure oldtonew(old,new:TStringGrid;k:integer);
var i,j:integer;
begin
  if (old.row>0) and (trim(old.Cells[0,old.Row])<>'') then
  begin
     i:=1;
     while trim(new.Cells[0,i])<>'' do i:=i+1;
     for j:=0 to k do
       new.Cells[j,i]:=old.Cells[j,old.Row];
     new.row:=i;
     for i:=old.Row to old.RowCount-1 do
       for j:=0 to k do
        old.Cells[j,i]:=old.Cells[j,i+1];
  end;
end;


Procedure  getvalue(var valuearr:array of string;qutj :string);
var i:integer; 
begin
   fm.Query6.active:=false;
   fm.Query6.sql.clear;
   fm.Query6.sql.text:=qutj;
   fm.Query6.open;
   if (not (fm.Query6.isempty)) then
      for i:=0 to fm.Query6.fieldcount-1 do
          valuearr[i]:=fm.Query6.fields[i].asstring;
   fm.Query6.close;
   fm.Query6.sql.clear;
   fm.Query6.UnPrepare;
   fm.Query6.RequestLive:=false;
end ;

Procedure  ChineseGrid(gridname:TDBGrid);
var
   i:integer;
begin
   fm.query1.close;
   fm.query1.sql.clear;
   fm.query1.sql.add('Select * from chinesename');
   fm.query1.open;
   for i:=0 to gridname.fieldcount-1 do
     begin
     if gridname.Fields[i].datatype=(ftboolean) then
        if gridname.Fields[i].displaylabel='sex' then
           tbooleanfield(gridname.Fields[i]).displayvalues:='男;女'
        else
           tbooleanfield(gridname.Fields[i]).displayvalues:='是;否';
     if fm.query1.locate('name',gridname.fields[i].fieldname,[loCaseInsensitive]) then
        gridname.fields[i].displaylabel:=fm.query1.fieldByname('chinesename').asstring;
     end;
   fm.query1.close;
   fm.Query1.UnPrepare;
   fm.query1.RequestLive:=false;
end ;

procedure  comadd(combo:TComboBox;listfieldnum:integer;sqltj:string);
var
  comlist,lsstr,ze: string;
  i,j :integer;
begin
  fm.query1.close;
  fm.query1.sql.clear;
  fm.query1.sql.add (sqltj);
  fm.query1.prepare;
  fm.query1.Open;
  combo.items.clear;
  if not fm.query1.isempty then
    begin
      while not fm.query1.eof do
        begin
          comlist:='';
          for i:=0 to listfieldnum-1 do
             begin
               ze:='';
               for j:=0 to  fm.query1.fields[i].datasize do
                    ze:=ze+' ';
               lsstr:=fm.query1.fields[i].asstring;
               lsstr:= copy(lsstr+ze,1,fm.query1.fields[i].datasize)+'  ';
               comlist:=comlist+lsstr;
             end;
          combo.items.add(comlist);
          fm.query1.Next;
        end;
      combo.itemindex:=0;
    end;
    fm.Query1.active:=false;
    fm.query1.RequestLive:=false;
end;
procedure  comadd1(combo,combo2:TComboBox;listfieldnum:integer;sqltj:string);
var
  comlist,lsstr,ze: string;
  i,j :integer;
begin
  fm.Query1.Active :=false;
  fm.Query1.sql.clear;
  fm.Query1.sql.add(sqltj);
  fm.Query1.prepare;
  fm.Query1.Open;
//  combo.items.clear;
//  combo2.items.clear;
  if not fm.Query1.isempty then
  begin
    while not fm.Query1.eof do
    begin
      if combo2=nil then
      begin
         comlist:='';
         for i:=0 to listfieldnum-1 do
         begin
           ze:='';
            for j:=0 to  fm.Query1.fields[i].datasize do
              ze:=ze+' ';
            lsstr:=trim(fm.Query1.fields[i].asstring);
            lsstr:=copy(lsstr+ze,1,fm.Query1.fields[i].datasize)+'  ';
            comlist:=comlist+lsstr;
         end;
         combo.items.add(trim(comlist));
       end
       else
       begin
         comlist:='';
         for i:=1 to listfieldnum-1 do
         begin
           ze:='';
            for j:=0 to  fm.Query1.fields[i].datasize do
              ze:=ze+' ';
            lsstr:=trim(fm.Query1.fields[i].asstring);
            lsstr:=copy(lsstr+ze,1,fm.Query1.fields[i].datasize);
            comlist:=comlist+'   '+lsstr;
         end;
         combo2.items.add(trim(comlist));
         combo.items.add(trim(fm.Query1.fields[0].asstring));
       end;
      fm.Query1.Next;
    end;
    combo.itemindex:=0;
  end;
  fm.Query1.active:=false;
  fm.Query1.UnPrepare ;
end;


function cwpz(pzrq:tdatetime;pzlx,zy:string;kmdm:array of string;jje,dje:array of Currency;bmdm,djh:string;jsfs:integer;dqh,dwdm,jsr,fphm:string;fprq:tdatetime;ywbh:string;sl,dj,wb,hl:array of Currency;ts:integer):integer;
var i,id:integer; jf,df:Currency;
begin
   jf:=0;df:=0;
   for i:=0 to ts do
   begin
     jf:=jf+jje[i];df:=df+dje[i];
   end;
   if jf<>df then
   begin
     cwpz:=1;
     exit;
   end;
   cwpz:=2;
   fm.Query4.Active:=false;
   fm.Query4.SQL.Clear;
   fm.Query4.SQL.Add('select max(id) from pazgs');
   fm.Query4.Open;
   id:=fm.Query4.Fields[0].AsInteger+1;
   for i:=0 to ts do
   begin
     if trim(kmdm[i])<>'' then
     begin
       fm.Query4.Active:=false;
       fm.Query4.SQL.Clear;
       fm.Query4.SQL.Add('insert into pazgs (bz,pzrq,pzlx,pzh,zy,kmdm,j,d,bmdm,djh,jsfs,dqh,dwdm,jsr,fphm,fprq,ywbh,sl,dj,wb,hl,czy,id)');
       fm.Query4.SQL.Add(' values(0,:ppzrq,:ppzlx,:ppzh,:pzy,:pkmdm,:pjje,:pdje,:pbmdm,:pdjh,:pjsfs,:pdqh,:pdwdm,:pjsr,:pfphm,:pfprq,:pywbh,:psl,:pdj,:pwb,:phl,:pczy,:pid)');
       fm.Query4.ParamByName('ppzrq').asdatetime:=pzrq;
       fm.Query4.ParamByName('ppzh').asstring:=inttostr(id);
       fm.Query4.ParamByName('ppzlx').asstring:=pzlx;
       fm.Query4.ParamByName('pzy').asstring:=zy;
       fm.Query4.ParamByName('pkmdm').asstring:=kmdm[i];
       fm.Query4.ParamByName('pjje').asCurrency:=jje[i];
       fm.Query4.ParamByName('pdje').asCurrency:=dje[i];