func.pas

来自「适合行业为眼镜业」· PAS 代码 · 共 980 行 · 第 1/2 页

            '7': ThisWei:='柒'; '8': ThisWei:='捌';
            '9': ThisWei:='玖'; '0': ThisWei:='零';
        end;
        case PosPoint-iWei of              //获得当前人民币单位
            -3:ThisPos:='厘';-2:ThisPos:='分';
            -1:ThisPos:='角';1 :ThisPos:='元';
            2 :ThisPos:='拾';3 :ThisPos:='佰';
            4 :ThisPos:='千';5 :ThisPos:='万';
            6 :ThisPos:='拾';7:ThisPos:='佰';
            8 :ThisPos:='千';9 :ThisPos:='亿';
            10 :ThisPos:='十';11:ThisPos:='佰';
            12:ThisPos:='千';
        end;
    strObjectMoney :=ThisWei+ThisPos+strObjectMoney;//组合成大写金额
    end;
Small2Big:=strObjectMoney;      //
end;
//
Procedure InitFontArray;
begin
  Font_Style[0] :=[fsBold];
  Font_Style[1] :=[fsBold];
  Font_Style[2] :=[fsItalic];
  Font_Style[3] :=[fsUnderline];
  Font_Style[4] :=[fsStrikeOut];
end;
procedure setnull(f_from:TForm);  //清空EDIT里的数据；
var
  i,j:integer;
begin
  for i:=0 to f_from.ComponentCount-1 do
  begin
  if (f_from.Components[i] Is TCustomEdit) then
    (f_from.Components[i] as TCustomEdit).Clear;
  if (f_from.Components[i] Is TStringGrid) then
  begin
    for j:=1 to (f_from.Components[i] as TStringGrid).RowCount-1 do   //清空网格，不能只减去行，避免下次新建时数据重复出现
      (f_from.Components[i] as TStringGrid).Rows[j].Clear;
    (f_from.Components[i] as TStringGrid).RowCount:=2;
  end;  


end;
end;

procedure createinter;  //创建接口
begin
  adisp:=IEasy_Dcom_Serverdisp(Idispatch(frm_data.Socket_Connection.appserver));
  ipubtemp:=IPublicServerDisp(idispatch(dmmain.socketpublic.appserver));
  if MSTorage=nil then
  Mstorage:=tstringlist.Create;
end;
procedure detroy;   //释放接口;
begin
  adisp:=nil;
  ipubtemp:=nil;
  Mstorage.Free;
  Mstorage:=nil;
end;

function setCode(sql:string;maks:string):string; //自增编号！！！
var
  s_NewDate:String;
  sqls,make:wideString;
  s_Date:String;
  s_Code:olevariant;
begin
  s_Date:=FormatDateTime('yymmdd',now());
  if trim(maks)>'' then
  begin
    make:=maks+s_date;
  end;
  sqls:=sql;
  try
  ipubtemp.autoid(sqls,make,s_code); //调用接口方法！！
  except
  application.MessageBox('服务器终止服务！',pchar(application.Title),mb_iconwarning);
  exit;
  end;
  result:=trim(vartostr(s_Code));
end;

function selectpy( values:string):string; //拼音转换;
var
  i,j:integer;
  s1,s2:string;
begin
  s1:=trim(values);
  i:=1;
  j:=length(s1);

  while i<=length(s1) do
  begin
  case WORD(s1[i]) shl 8 + WORD(s1[i+1]) of
    $B0A1..$B0C4 : s2 :=s2+ 'A';
    $B0C5..$B2C0 : s2 :=s2+ 'B';
    $B2C1..$B4ED : s2 :=s2+ 'C';
    $B4EE..$B6E9 : s2 :=s2+ 'D';
    $B6EA..$B7A1 : s2 :=s2+ 'E';
    $B7A2..$B8C0 : s2 :=s2+ 'F';
    $B8C1..$B9FD : s2 :=s2+ 'G';
    $B9FE..$BBF6 : s2 :=s2+ 'H';
    $BBF7..$BFA5 : s2 :=s2+ 'J';
    $BFA6..$C0AB : s2 :=s2+ 'K';
    $C0AC..$C2E7 : s2 :=s2+ 'L';
    $C2E8..$C4C2 : s2 :=s2+ 'M';
    $C4C3..$C5B5 : s2 :=s2+ 'N';
    $C5B6..$C5BD : s2 :=s2+ 'O';
    $C5BE..$C6D9 : s2 :=s2+ 'P';
    $C6DA..$C8BA : s2 :=s2+ 'Q';
    $C8BB..$C8F5 : s2 :=s2+ 'R';
    $C8F6..$CBF9 : s2 :=s2+ 'S';
    $CBFA..$CDD9 : s2 :=s2+ 'T';
    $CDDA..$CEF3 : s2 :=s2+ 'W';
    $CEF4..$D188 : s2 :=s2+ 'X';
    $D1B9..$D4D0 : s2 :=s2+ 'Y';
    $D4D1..$D7F9 : s2 :=s2+ 'Z';
    end;
    i:=i+2;
  end;
  result:=s2;
end;

procedure ckbEdit(ckb:TCheckBox;edt:TEdit);
begin
  if ckb.Checked then
  with edt do
  begin
    ReadOnly:=false;
    Color:=clCream;
    SetFocus;
  end;
  if ckb.Checked=false  then
  with edt do
  begin
    ReadOnly:=true;
    Color:=cl3DLight;
    Text:='';
  end;
end;
procedure ckbEdits(ckb:TCheckBox;edt1,edt2:TEdit);
begin
   if ckb.Checked then
  begin
    edt1.ReadOnly:=false;
    edt1.Color:=clCream;
    edt1.SetFocus;
    edt2.ReadOnly:=false;
    edt2.Color:=clCream;
  end;
  if ckb.Checked=false then
  begin
    edt1.ReadOnly:=true;
    edt1.Color:=cl3DLight;
    edt1.Text:='';
    edt2.ReadOnly:=true;
    edt2.Color:=cl3DLight;
    edt2.Text:='';
  end;
end;
procedure ckbCmb(ckb:TCheckBox;cmb:TComboBox);
begin
  if ckb.Checked then
  with cmb do
  begin
    ItemIndex:=0;
    Color:=clCream;
    SetFocus;
  end;
  if ckb.Checked=false  then
  with cmb do
  begin
    ItemIndex:=-1;
    Color:=cl3DLight;
    Text:='';
  end;
end;
procedure ckbDtps(ckb:TCheckBox;dtp1,dtp2:TDateTimePicker);
begin
  if ckb.Checked then
  begin
    dtp1.Color:=clCream;
    dtp1.SetFocus;
    dtp2.Color:=clCream;
  end;
  if ckb.Checked=false then
  begin
    dtp1.Color:=cl3DLight;
    dtp2.Color:=cl3DLight;
  end;
end;

procedure GetDataToComBoX(cmbman:TcomboBox;tempsql:string;XsFieldName:string);
var
  fh_rs:OleVariant;
  TempTbl:TClientDataset;
begin
  cmbman.Clear;
  ipubtemp.ty_query(tempsql,fh_rs);
  if not  varisnull(fh_rs) then
  begin
    TempTbl := TClientDataset.Create(nil);
    try
    with TempTbl do
    begin
        Data := fh_rs;
        Open;
        first;
        while not  Eof   do
        begin
        cmbMan.AddItem(fieldbyname(XsFieldName).AsString,Nil);
        Next;
        end;
        Close;
    end;
    finally
    TempTbl.Free;
    end;
    cmbMan.ItemIndex := 0;
 end;
end;

function GetKeyFieldValue(sortField:string;clientdb:TClientDataSet): OleVariant;
var
  aCDS : TClientDataSet;
begin
  aCDS:=TClientDataSet.Create(nil);
  try
   try
     if not varisnull(clientdb.Data) then
  begin
  ///如果重新按其他列排序后，此处可能不对了 ！！ydy
  aCDS.Data:=clientdb.Data;  //ClientDataSet1.Data;
  //ydy 2004-2-18 add
      WITH acds do begin
          IndexName := '';
          IndexDefs.Update;
      end;
      with aCDs.IndexDefs.AddIndexDef do
          begin
            Fields := sortField;  //不同表此处不同'sg_id'; //AFields;
            Options := [];
          end;
  aCDs.IndexDefs.Update;
  ///////////

  aCDS.Last;
  //Result:=aCDS.FieldByName('SG_id').Value;
  Result:=aCDS.FieldByName(sortfield).Value;
  end;
  finally // wrap up
  aCDS.Free ;
  end; // try/finally
  except
  on e: Exception do
  raise;
  end; // try/except
end;

procedure getlock(m:string;index,count:integer);
var
  i,j:integer;
begin
  case index of
 1: begin
      if pos('CG',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('CG',m)+2,(Count));
      end;
    end;
  2:begin
      if pos('ST',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('ST',m)+2,(Count));
      end;
  end;
  3:begin
      if pos('PS',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('PS',m)+2,(Count));
      end;
   end;
  4:begin
      if pos('BASE',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('BASE',m)+4,(Count));
      end;
    end;
  5:begin
      if pos('Sys',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('Sys',m)+3,(Count));
      end;
    end;
  6:begin
      if pos('Mon',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('Mon',m)+3,(Count));
      end;
    end;
  7:begin
      if pos('Cw',m)<>0 then
      begin
        qxstr:=qxstr+copy(m,pos('Cw',m)+2,(Count));
      end;
    end;
  end;
  for i:=1 to 250 do
  begin
     if i>length(qxstr) then  loginlock[i-1]:=0
     else
    loginlock[i-1]:=strtoint(copy(qxstr,i,1));
  end;
end;

function SetPass(List_No:string):boolean; //单据只能出现一次；
var
  sqlpub:widestring;
begin
  result:=false;
  try
  sqlpub:='update receipt set check_result=7 where receipt_no='+''''+trim(list_no)+'''';
  ipubtemp.scrapsate(sqlpub);
  result:=true;
  except
  end;
end;
function SetPassed(List_No:string):boolean;
var
  sqlpub:widestring;
begin
  result:=false;
  try
  sqlpub:='update receipt set check_result=8 where receipt_no='+''''+trim(list_no)+'''';
  ipubtemp.scrapsate(sqlpub);
  result:=true;
  except
  end;
end;
procedure SortGrid(filedbynames:string;CdsTable:Tclientdataset;GridBase:tdbgrid;column: TColumn);  //排序
var
  i,j,p:integer;
begin
  if not GridBase.DataSource.DataSet.Active then exit;
  j:=GridBase.Columns.Count-1;
  for i:=0 to j do
  begin
    p:=pos('↑',trim(GridBase.Columns.Items[i].Title.Caption));
    if p>0 then
     GridBase.Columns.Items[i].Title.Caption:=copy(GridBase.Columns.Items[i].Title.Caption,1,p-1);
  end;
   WITH CdsTable do
   begin
    IndexName := '';
    IndexDefs.Update;
   end;
   CdsTable.AddIndex(filedbynames,filedbynames,[],'',filedbynames); //本地排序
   CdsTable.IndexName:=filedbynames;
   CdsTable.IndexDefs.Update;
  column.Title.Caption:=column.Title.Caption+'↑';
  gridbase.Refresh;
end;

procedure GetValuesData(Mcmb:tcombobox);  //获得数据；
var
  i:integer;
begin
  for i:=0 to mstorage.Count-1 do
  begin
    Mcmb.Items.Add(trim(Mstorage.Strings[i]));
  end;
end;
procedure SetValuesData (Mcmb:tcombobox); //取数据;
var
  i:integer;
begin
   for i:=0 to mcmb.Items.Count-1 do
  begin
    Mstorage.Add(trim(mcmb.Items.Strings[i]));
  end;
end;

procedure SetDbgrid( grid:tdbgrid;index:integer); //设置DBGRID的固定列
begin
  tstringgrid(grid).FixedCols:=index;
end;

function clearGrid(var Grid:TStringGrid):boolean;
var i:integer;
begin
   for i:=1 to Grid.RowCount-1 do
      Grid.Rows[i].Clear;
   RefreshOrd(Grid);
   Result:=true;
end;
//删除行
function DelRow(var StrGrid:TStringGrid;Arow:integer):boolean;
var
  i,n,Acol:integer;
begin
  Result := True;
  if Arow=0 then
  begin
    Result := False;
    Exit;
  end;
  Try
    n := Arow;
    Acol := StrGrid.ColCount-1;
    while n<StrGrid.RowCount do
    begin
      for i:=1 to Acol do
        StrGrid.Cells[i,n] := StrGrid.Cells[i,n+1];
      inc(n);
    end;
    if StrGrid.RowCount>2 then StrGrid.RowCount:=StrGrid.RowCount-1;
  Except
    Result := False;
  End;
end;

procedure RefreshOrd(var Grid:TStringGrid);
var i:integer;
begin
  for i:=1 to Grid.RowCount-1 do
    begin
     Grid.Cells[0,i]:=inttostr(i);
    end;
end;


function GetDataPrint(recipient,GETclient:tClientdataset):boolean;
begin
  result:=false;
  recipient.Close;
  recipient.Data:=null;
  recipient.data:=getclient.Data;
  recipient.Open;
  if not varisnull(recipient.Data) then
  begin
    getclient.Close;
    getclient.Data:=null;
  end;
  result:=true;
end;


procedure GetCopyGrid(souce,client:tstringgrid);
var
  i,j,t,b:integer;
  s:string;
begin
  souce.RowCount:=client.RowCount;
  souce.ColCount:=1 ;
  for i:=0 to client.ColCount-1 do
  begin
    if client.ColWidths[i]>0 then
    begin
      souce.ColWidths[souce.ColCount-1]:= client.ColWidths[i];
      souce.ColCount :=souce.ColCount+1 ;
    end;
    for j:=0 to client.RowCount-1 do
    begin
      //souce.Rows[j].Clear;
      if client.ColWidths[i]>0 then
      begin
        souce.cells[souce.ColCount-1,j]:=client.cells[i,j];
      end;
    end;
  end;
  j:=0;
  for i:=0 to souce.ColCount-1 do
  begin
    if trim(souce.Cells[i,0])='' then
    begin
      inc(j);
    end;
  end;
  if j>0 then
  begin
    for i:=0 to souce.ColCount-1 do
    begin
      souce.Cols[i]:=souce.Cols[i+1];
    end;
  end;
  souce.ColCount:=souce.ColCount-j+1;
end;

end.