globallibunit.pas

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

unit GlobalLibUnit;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AxCtrls, OleCtrls, vcf1, StdCtrls, DBCtrls, ExtCtrls, Grids,Variants,
  DBGrids, ComCtrls, ToolWin,inifiles,dbTables,buttons,ImgList, Quickrpt, Mask,QRCTRLS;

type TArraystring = array[0..1,0..10] of string;
type TArrayColor = array[0..8] of TColor;

Var   gMoneyUpperCase: array[0..10] of string=('元','拾','佰','仟','万','拾','佰','仟','亿','拾','佰');
Var   gMoneyLowerCase: array[0..1] of string=('分','角');

//////////////////////////////////////
// 全局参数 //////////////////////////
Var
gstrTicketCode:string;//票据编码
gstrTicketName:string;//票据名称
gstrTicketDLL:string;//动态连接库
gstrOperaterCode:string;//操作员编码
gstrOperaterName:string;//操作员姓名
gstrCompanyName:string;//公司名称
gstrExecutePath:string;//系统路径
gstrInputMethod:string;//系统输入法
gintLeft:integer;  //左边距
gintTop:integer;   //上边距
gstrContinuously :string;  //是否连续打印
gstrOperaterquery:integer;//操作员查询标志，1为启动操作员查询，0为不启动
gstrOperater:string;

//////////////////////////////////////

   //以下为陈宇增加的代码
   procedure InitEdtCtlIme(winCtl:TWinControl;ImeMode:TImeMode;strIme:String);
   //以下为全永兵增加的代码
   Function CallException(TestContent:string):String;
   procedure SetFocusColor(Sender: TDBEdit);overload;
   procedure SetFocusColor(Sender: TEdit);overload;
   procedure SetFocusColor(Sender: TDBLookupComboBox);overload;
   procedure SetFocusColor(Sender: TDateTimePicker);overload;
   procedure SetFocusColor(Sender: TDBComboBox);overload;
   procedure SetFocusColor(Sender: TComboBox);overload;
   procedure SetFocusColor(Sender: TMaskEdit);overload;
   procedure SetFocusColor(Sender: TDBMemo);overload;
   procedure SetExitColor(Sender: TDBMemo);overload;
   procedure SetExitColor(Sender: TDateTimePicker);overload;
   procedure SetExitColor(Sender: TDBComboBox);overload;
   procedure SetExitColor(Sender: TComboBox);overload;
   procedure SetExitColor(Sender: TDBEdit);overload;
   procedure SetExitColor(Sender: TEdit);overload;
   procedure SetExitColor(Sender: TMaskEdit);overload;
   procedure SetExitColor(Sender: TDBLookupComboBox);overload;
   procedure SetItem(List: TCustomListBox; Index: Integer);
   procedure SetButtons(List1: TCustomListBox;List2: TCustomListBox;
              btn1:TSpeedButton;btn2:TSpeedButton;btn3:TSpeedButton;
              btn4:TSpeedButton);
   /////////////////////////////////函数////////////////////////////////////
   Function GetFirstSelection(List: TCustomListBox): Integer;
    ////////////宫俊/////////////////////
   Function GetNewData(StrLen:integer;Str:string;NewType:integer):string;//产生新的字符串
   Procedure CallErrorMessage(ErrorMessage:string);
   Function CountDateChange(OldCountDate:string):string;
   Procedure CaptionChange(Sender:TObject;DTPicker:TDateTimePicker);//将SpeedButton.Caption的字符'有'与'无'切换；
    ///////////宫俊/////////////////////
   Function ChangeMoneyLowcaseToUppercase(sNum:string):String;
   Function strToMoney(strMon :string;account:integer):string;
   function Zero(s:string):string;
   function CheckMoney(s:string):string;
   function CheckstrTocurr(s:string):currency;
   procedure editfont(var qrrichtext:tqrrichtext;str:string);
   procedure editNumfont(var qrrichtext:tqrrichtext;str:string);
      //////////王元毅///////////
   procedure editFont1(var qrrichtext:tqrrichtext;str:string);//将字符变成三行打印
      //////////郝志远///////////
   function AddThousandComma(strSource:string):string;
   procedure EditThreeRow(var qrrichtext:tqrrichtext;str:string;CharCountPRow:integer);//将字符变成三行打印
implementation
////////////////////////////////////////////////
//将单个数字小写变成人民币大写
//输入变量：sNum-人民币小写，i-所要选取的位数
//输出变量:大写字符
//编制人：宫俊
//编制日期：2001-09-28
//修改人：陈宇
//修改日期：2001-11-27
////////////////////////////////////////////////
Function UpperNumber(sNum:string;i:integer):String;
begin
     result:='';
     if Copy(sNum,Length(sNum)-i+1,1)<>'0' then
        case strtoint(Copy(sNum,Length(sNum)-i+1,1)) of
            1:result:='壹';
            2:result:='贰';
            3:result:='叁';
            4:result:='肆';
            5:result:='伍';
            6:result:='陆';
            7:result:='柒';
            8:result:='捌';
            9:result:='玖';
         end
     else
         begin
//              if strtoint(Copy(sNum,Length(sNum)-i+1,i))<>0 then
                 result:='零';
         end;
end;


////////////////////////////////////////////////
//将人民币小写转换成大写
//输入变量：sNum-人民币小写
//输出变量:''-表示无，'-1'—表示格式错误，其他表示人民币大写
//编制人：宫俊
//编制日期：2001-09-28
//修改人：陈宇
//修改日期：2001-11-30
//修改人：郝志远
//修改日期：2002-5-9
////////////////////////////////////////////////
Function ChangeMoneyLowcaseToUppercase(sNum:string):String;
var
   i:integer;
   intPosition:integer;//小数点的位置
   TempStr:string;//临时变量
   strTemp:string;//临时变量
   strLeft:string;//小数点左边的变量
   strRight:string;//小数点右边的变量
begin
   if Trim(sNum)='' then
      begin
         Result:='';
         Exit;
      end;
   intPosition:=Pos('.',sNum);
   if intPosition<>0 then
      begin
         strLeft:=Copy(sNum,1,intPosition-1);
         strRight:=Copy(sNum,intPosition+1,Length(sNum)-intPosition);
         if Length(strRight)=1 then
            strRight:=strRight+'0';
      end
   else
      begin
         strLeft:=sNum;
         strRight:='';
      end;
    try
       //i:=StrToInt(strLeft);

       //郝志远
       //2002-01-10
       i:=StrToInt64(strLeft);
       if strRight<>'' then
          i:=StrToInt(strRight);
       if Length(strRight)>2 then
          begin
             Result:='-1';
             Exit;
          end;
    except
       Result:='-1';
       Exit;
    end;
   if  Length(strRight)>3 then
      begin
         Result:='-1';
         Exit;
      end;
   if strLeft<>'' then
    begin
         for i:=1 to length(strLeft) do
           begin
                TempStr:=UpperNumber(strLeft,i);
                if (tempStr<>'') and (tempStr<>'零') then begin
                    if (i=9) and (Copy(Result,1,2)='万') then
                       Delete(Result,1,2);
                    TempStr:=TempStr+gMoneyUpperCase[i-1];
                end;
//                if ( TempStr='零' ) and ( Copy(Result,1,2)<>'零' ) then
                if ( TempStr='零' ) and (Result<>'')
                   and (Copy(Result,1,2)<>'零')
                   and (Copy(Result,1,2)<>'万')
                then
                   Result:='零'+Result;
                if ( TempStr='零' ) and ( i=5 )  then
                   Result:='万'+Result;
                ///////////////////////////
                //修改人：郝志远
                //修改时间：2002-5-9
                if ( TempStr='零' ) and ( i=9 )  then
                   begin
                     if copy(Result,1,2)='万' then
                       delete(Result,1,2);
                     Result:='亿'+Result;
                   end;
                ///////////////////////////
                if ( TempStr<>'零' ) then
                   Result:=TempStr+Result;
           end;
//         if Copy(sNum,Length(sNum),1)='0' then
           if (Result<>'') and (Copy(strLeft,Length(strLeft),1)='0') then
             Result:=Result+'元';
    end;
   if (strRight<>'') and (strRight<>'00') then
    begin
         strTemp:='';
         for i:=1 to length(strRight) do
           begin
                TempStr:=UpperNumber(strRight,i);
                if (TempStr<>'') and (TempStr<>'零') then
                    TempStr:=TempStr+gMoneyLowerCase[i-1];
                if not ((TempStr='零') and (strTemp='')) then
                   strTemp:=TempStr+strTemp;
           end;
         if(strLeft<>'0')and(Copy(strLeft,Length(strLeft),1)='0')and(TempStr<>'零') then
            strTemp:='零'+strTemp;

    end;
    Result:=Result+strTemp;
    if  (Result<>'') and (Copy(Result,Length(Result)-1,2)<>'分') then
         Result:=Result+'整';

    if Result='' then Result:='零元整';
end;


Function CallException(TestContent:string):String;
begin
     Try
       if Trim(TestContent)='' then
          begin
               Result:='0';
               Exit;
          end;
       Result:='0';
     except
     on E:Exception do
       begin
          if Pos('is not a valid floating point value',E.Message)<>0 then
             begin
              Application.MessageBox('输入类型应该是数值型,请重新输入!','错误框',MB_ICONStop);
              Result:='-1';
             end;
        end;
     end;
end;

Function GetNewData(StrLen:integer;Str:string;NewType:integer):string;
var
TempInt,i:longint;
TempStr:string;
begin
     TempStr:=Copy(Str,1,6);
     Delete(Str,1,6);
     if NewType=0  then
        Str:=IntToStr(StrToInt(Str)+1)
     else
         Str:=IntToStr(StrToInt(Str)-1);
     TempInt:=StrLen-Length(Str);
     For i:=1 to  TempInt do
         Str:='0'+Str;
     Result:=TempStr+Str;
end;

Procedure CallErrorMessage(ErrorMessage:string);
begin
     if Pos('Master record missing',ErrorMessage)<>0 then
        Application.MessageBox('该代码已应用不能删除','错误框',mb_iconstop);
     if Pos('perform the edit because another user changed the record',ErrorMessage)<>0 then
        Application.MessageBox('该记录已经被别人改变','错误框',mb_iconstop);
     if Pos('must have a value',ErrorMessage)<>0 then
        Application.MessageBox('字段不能为空','错误框',mb_iconstop);
     if Pos('Key violation',ErrorMessage)<>0 then
        Application.MessageBox('主键重复','错误框',mb_iconstop);
     if Pos('Dataset not in edit or insert mode',ErrorMessage)<>0 then
        Application.MessageBox('数据不在修改状态或增加状态','错误框',mb_iconstop);
end;

Function ChangeStr(InputType:integer;QueryField,InputStr:string):string;
begin//将输入查询语句变成规范的SQL语句
     case InputType of
     1:  begin//普通查询
               Result:=QueryField+' like '+'"%'+InputStr+'%"';
               if InputStr='null'  then
                  Result:=QueryField+'=null';
               if InputStr='' then
                  Result:='( '+QueryField+' like "%"'+' or '+ QueryField+'="" )';
         end;
     2:  begin//日期查询
               Result:=QueryField+' like '+'"%'+InputStr+'"';
               if InputStr='%'  then
                  Result:=QueryField+' like '+'"'+InputStr+'"';
               if InputStr='null'  then
                  Result:=QueryField+'=null';
               if InputStr='' then
                  Result:='( '+QueryField+' like "%"'+' or '+ QueryField+'=null )';
         end;
     end;
end;

Procedure CaptionChange(Sender:TObject;DTPicker:TDateTimePicker);
begin
     if Sender is TSpeedButton then
       if TSpeedButton(Sender).caption='有' then
          begin
               TSpeedButton(Sender).caption:='无';
               DTPicker.Visible:=False;
          end
       else
          begin
               TSpeedButton(Sender).caption:='有';
               DTPicker.Visible:=True;
          end;
end;

Function CountDateChange(OldCountDate:string):string;
var
temp:integer;
begin
     if Copy(OldCountDate,5,2)='12' then
        OldCountDate:=IntToStr(StrToInt(Copy(OldCountDate,1,4))+1)+'01'
     else
         begin