globallibunit.pas

工商收费系统,主要是管理非税收收入的费用的管理

              Temp:=StrToInt(Copy(OldCountDate,5,2));
              Temp:=Temp+1;
              if Temp<10 then
                 oldCountDate:=Copy(OldCountDate,1,4)+'0'+IntToStr(Temp)
              else
                 oldCountDate:=Copy(OldCountDate,1,4)+IntToStr(Temp);
         end;
     Result:=OldCountDate;
end;

////////////////////////////////////////////////
//设置编辑框的颜色，SetFoucsColor为进入编辑框时的颜色，SetrExitCOlor为离开编辑框时的颜色
//输入变量：
//Sender：需要设置的编辑框或列表框名称
//编制人：全永兵
//编制日期：2001-05-07
////////////////////////////////////////////////
procedure SetFocusColor(Sender: TDBEdit);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TMaskEdit);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TEdit);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TDBLookupComboBox);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TDateTimePicker);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TDBComboBox);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TDBMemo);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetFocusColor(Sender: TComboBox);overload;
begin
   Sender.color:=clAqua;
end;
procedure SetExitColor(Sender: TComboBox);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TMaskEdit);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TDBComboBox);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TDateTimePicker);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TDBEdit);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TEdit);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TDBLookupComboBox);overload;
begin
   Sender.color:=clWindow;
end;
procedure SetExitColor(Sender: TDBMemo);overload;
begin
   Sender.color:=clWindow;
end;

///////////////////////////////////////////////////////////////////
//下面三个函数从List框中去掉一条并将其加到另一List框中
//输入变量：
//
//
//
//编制人：全永兵
//编制日期：2001-05-17
///////////////////////////////////////////////////////////////////
procedure MoveSelected(List: TCustomListBox; Items: TStrings);
var
  I: Integer;
begin
  for I := List.Items.Count - 1 downto 0 do
    if List.Selected[I] then
    begin
      Items.AddObject(List.Items[I], List.Items.Objects[I]);
      List.Items.Delete(I);
    end;
end;
Function GetFirstSelection(List: TCustomListBox): Integer;
begin
  for Result := 0 to List.Items.Count - 1 do
    if List.Selected[Result] then Exit;
  Result := LB_ERR;
end;

procedure SetItem(List: TCustomListBox; Index: Integer);
var
  MaxIndex: Integer;
begin
  with List do
  begin
    SetFocus;
    MaxIndex := List.Items.Count - 1;
    if Index = LB_ERR then Index := 0
    else if Index > MaxIndex then Index := MaxIndex;
   Selected[Index] := True;
  end;
end;
procedure SetButtons(List1: TCustomListBox;List2: TCustomListBox;btn1:TSpeedButton;btn2:TSpeedButton;btn3:TSpeedButton;btn4:TSpeedButton);
var
  SrcEmpty, DstEmpty: Boolean;
begin
  SrcEmpty := List1.Items.Count = 0;
  DstEmpty := List2.Items.Count = 0;
  btn1.Enabled := not SrcEmpty;
  btn2.Enabled := not SrcEmpty;
  btn3.Enabled := not DstEmpty;
  btn4.Enabled := not DstEmpty;
end;

//将SQL语句中的单引号变为双引号
//例：'''field1'',''field2'''-->'"field1","field2"'
Function singleQuoteToDoubleQuote(s:string):string;
var
   i:integer;
begin
   result:='';
   for i:=1 to length(s)  do
   begin
      if copy(s,i,1)='''' then
         result:=result + '"'
      else
         result:=result + copy(s,i,1);
   end;
end;
//将SQL语句中的双引号变为单引号
//例：'"field1","field2"'-->'''field1'',''field2'''
Function DoubleQuoteTosingleQuote(s:string):string;
var
   i:integer;
begin
   result:='';
   for i:=1 to length(s)  do
   begin
      if copy(s,i,1)='"' then
         result:=result + ''''
      else
         result:=result + copy(s,i,1);
   end;
end;
///////////////////////////////////////////////////////////////////
//函数功能：给定数值，将其转换为字符串
//输入变量：nNum,要转换的数值,nLength:转换后字符串的长度
//输出变量：返回转换后的字符串
//
//编制人：全永兵
//编制日期：2001-06-08
///////////////////////////////////////////////////////////////////
Function IntToString(nNum,nLength:integer):string;
var
   i:integer;
begin
   result:=IntToStr(nNum);
   if length(result)>nLength then
   begin
      result:='';
      Exit;
   end
   else if length(result)=nLength then
      Exit
   else
      for i:=1 to nLength-length(result) do
         result:='0'+result;
end;

////////////////////////////////////////////////////////////////
//函数名称：InitEdtCtlIme                                     //
//函数功能；将指定控件容器的所有输入法模式为指定的值的        //
//            TEdit与TDBEdit控件的输入法名称设置为相应的的值  //
//输入参数：winCtl:TWinControl  指定容器                      //
//          meMode:TImeMode     指定输入法模式                //
//          strIme:String       要设置的值                    //
//输出参数：无                                                //
//例子：InitEdtCtlIme(self,imChinese,'智能ABC输入法');        //
//编写人：陈宇                                                //
//编写时间：2001年10月23日                                    //
////////////////////////////////////////////////////////////////

procedure InitEdtCtlIme(winCtl:TWinControl;ImeMode:TImeMode;strIme:String);
var
   currCtl:TWinControl;
   i:Integer;
begin
   currCtl:=nil;
   for i:=0 to winCtl.ControlCount-1 do
   begin
   //    currCtl:=(currForm as TWinControl).FindNextControl(currCtl,TRUE,FALSE,FALSE);
       currCtl:=TWinControl(winCtl.Controls[i]);
       if currCtl=nil then break;

       if (currCtl is TEdit) then
          if (currCtl as TEdit).imeMode=ImeMode then
             (currCtl as TEdit).imeName:=strIme;

       if (currCtl is TDBEdit) then
          if (currCtl as TDBEdit).imeMode=ImeMode then
             (currCtl as TDBEdit).imeName:=strIme;

       if (currCtl is TDBMemo) then
          if (currCtl as TDBMemo).imeMode=ImeMode then
             (currCtl as TDBMemo).imeName:=strIme;
   end
end;
////////////////////////////////////////////////////////////////
///  将字符转化为数字的钱数///
Function StrtoMoney(strMon:string; account:integer):string;
var
    strMontmp :string;
    i         :Integer;
    intTmp    :integer;
begin
   strMontmp:=strMon;
   intTmp:=Pos('.',pChar(strMon));
   Delete(strMontmp,intTmp,1); //去掉小数点
   if intTmp=0 then
      strMontmp:=strMontmp+'00'
   else if (strlen(pChar(strMon))-intTmp)=1 then
      strMontmp:=strMontmp+'0'
   else if (strlen(pChar(strMon))-intTmp)=0 then
      strMontmp:=strMontmp+'00';
   if Length(strMontmp)>account then
      begin
         Application.MessageBox('价钱或数量输入错误！请重新输入',
                '提示',MB_OK+MB_DefButton1+MB_IconInformation+MB_ApplModal);
         //countDBEdt.SetFocus;
         exit;
      end;
   {去掉多余的零}
   intTmp:=Pos('0',pChar(strMontmp));
   while (intTmp=1) and (intTmp<>strlen(pChar(strMontmp))) do
   begin
      Delete(strMontmp,intTmp,1);
      intTmp:=Pos('0',pChar(strMontmp));
   end;
   result:=strMontmp;
end;

//////////为数字钱数增加小数点后的零////////
function Zero(s:string):string;
var
    intTmp    :integer;
begin
   intTmp:=Pos('.',pChar(s));
   if strlen(Pchar(s))=0 then
      result:='0.00'
   else if intTmp=0 then
      result:=s+'.00'
   else if (strlen(pChar(s))-intTmp)=1 then
      result:=s+'0'
   else if (strlen(pChar(s))-intTmp)=0 then
      result:=s+'00'
   else result:=s  ;
   //result:='￥'+result;
end;

//////////如果控件的TEXT为零打印空格////////////
function CheckMoney(s:string):string;
//var curTmp:currency;
begin
    // curTmp:=strTocurr(s);
     if (s='0')or (s='0.00')or (s='.00') or (s='0.0') or (s='.0') then result:=''
     else result:=s;
end;

function CheckstrTocurr(s:string):currency;
begin
   if s='' then result:=0
   else result:=strToCurr(s);
end;
//过程名：editfont
//功能：根据输入字符数改变字体大小，以适应票据单元格的宽度。
//参数：共两个，qrrichtext 为tqrrichtext 型变量，str 为string 型变量
//制作时间：2002.4.25
//制作人：周德东
//修改说明：由于出现了 AR970 打印机打印折行时不完全的情况，所以做了修改
//修改人：郝志远
//修改时间：2002-6-4
procedure editfont(var qrrichtext:tqrrichtext;str:string);

// 以下为原程序
{
var
  i:integer;
begin
  if qrrichtext.Tag=0 then
     qrrichtext.Tag:=qrrichtext.Top; //初始化保存top变量
  if qrrichtext.Tag<>qrrichtext.Top then
     qrrichtext.Top:=qrrichtext.Tag;
  if qrrichtext.Height<=25 then
     begin
          qrrichtext.Font.Size:=10;
          qrrichtext.Lines.Clear;
          qrrichtext.Lines.Append(str);
          if qrrichtext.Lines.Count>1 then
            qrrichtext.Font.Size:=8;
     end;
  if qrrichtext.Height>25 then
    begin
      qrrichtext.Font.Size:=12;
      qrrichtext.Lines.Clear;
      qrrichtext.Lines.Append(str);