utilities.pas

企业进销存管理系统

unit utilities;

//本公用程式单元共计有下列单元,您可以使用下列的的字串为关键字,来做搜寻
{字串处理函数}
{档案的函数}
{讯息的函数}
{系统函数}
{日期时间处理函数}
{数字处理函数}
{资料表的函数}
{其他函数}
interface

uses Wintypes,SysUtils,WinProcs,Classes,Forms,DB,DBTables,Registry, math,
     RXDBCtrl, ToolEdit,Dialogs,Controls,menus,buttons,ExtCtrls, DBCtrls,
     IMM, Variants;
type
  Auto_Item_Formate = (cYYMMDD_xxxS, cYYMM_xxxxS, YYMM_xxxxS, YYMMDDxxxxS ,
                       cYYYMMxxxx, cYYMMDDxxx, cYYYMM_xxx, YYYMMDDxxx, YYMMDDxxxx ,
                       YYMMDDxxxS, YYMMxxxxxS, YYMMDDxxx, YYMMxxxxx);
                   // 自动编号的格式 : 前四个表示西元年 , 后五个表示台历方式
  TSQLAggFunc = (xSum,xAvg,xMin,xMax);
const
  SQL_str_For_Agg: array [TSQLAggFunc] of string = (
                    'select sum(%s) from %s  %s',
                    'select avg(%s) from %s  %s',
                    'select min(%s) from %s  %s',
                    'select max(%s) from %s  %s'); //提供做栏位运算使用

var
  GlobalUser : string;         //全域使用者
  UserRight : string;          //使用者权限
  Globaluser_Level : string;   // 使用者权限 , 因很多专案用此名称, 所以加入

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

{字串处理函数}

// 返回 Substr 在 s 中共有几个
function SubStrCnt(substr: string; S: string): Integer;

// 将S以split 分隔开,放入 sArr 中
procedure GetStrArray(var sArr: array of string; sSplit: string; S: string);

function RollBackString(sint: string):string;  //反转字串

function convstring(ins: string):string;  //将单字串中单一个'/'改为'//',C语言适用
function Replace(str,SourStr,DestStr:string;casesensitive:Boolean):string; //casesensitive:False不区分大小写
//将一字串中的阿拉伯数字转为大写，单独传出
function MyIntToChinese(myint: string):string;

{档案的函数}
//1.GetFileName, you can uses extractfileName, but it can't explain '-' word, so we must get some specially
function rGetFileName(sin: string): string;

{讯息的函数}
//  1.The Dialog has 'Ok' Button
//  2.The Dialog has 'Ok & Cancel' Buttons
//  3.The Dialog has 'Yes, NO and Cancel' three buttons
//First function that has a 'OK' Button, and must send a string that you want to show
Procedure R_OkMessage(sMes: array of const; sFormat: string =''; const IconType: Integer=MB_ICONWARNING);
function R_YesNoMessage(sMes: array of const; sFormat: string ='';const xcaption: string='请确认'):Boolean;



{系统函数}
//系统忙录时,可使用这个function改变指标的状态
Procedure SystemBusy(var Sender: TForm;xStatus: Boolean);
Function ReadWriteReg(Key,Value:string;IfWrite:Boolean):string; //写入注册档

procedure ShowWorkForm(aFC: array of TFormClass; Sender: TObject);

Procedure OpenForm(Sender:TObject; FormClass:TFormClass; Var Fm;Aowner:TComponent; sCap:string = '');
//取得磁碟机的序号
function Get_disk_serial_number(lw: Char): LongInt;

{日期时间处理函数}
Function GetYYMM : string;    //Get year,month  write by JEFF
Function GetYYMMNoForm(x : TDate) : string;    //Get year,month  write by JEFF


  //将西元年转为中华民国年,并且以字串二位数的表示方式,分别传回年,月,日
Procedure DateTransChines(EditDate:tDate;var yy:string; var mm:string; var dd:string);
function GetYear(xDate: TDate;IsChinese: Boolean=True):Word; //传回年份
function GetMonth(xDate: TDate):Word;   //传回月份
function GetDays(xDate: TDate):Word;    //传回日份
Procedure AssignDBDate(Sender: TObject; tDataSour : TDataSource=nil; tField : string=''); //选取日期
Function ConvertDate(Date:TDatetime):string;    //日期转换成字串
PROCEDURE CreateAtPos(Sender:TCustomForm);
function GetFirstDay(xDate: TDate): TDate;      // 取得该月的第一天
function GetLastDay(xDate: TDate): TDate;       // 取得该月的最后一天


{数字处理函数}
//Num2BCNum  将阿拉伯数字转成中文(大写)数字字串
//Num2BCNum(10002.34) ==> 壹万零贰点叁肆        89/02/16 robot
function Num2BCNum(dblArabic: double): string;

function TransMulitByte(sInt: string):string;  //将数字转变为全型的数字

function DealFractional(Number : double; Digit : Integer):double;//四舍五入

//将数字转为一定长度的字串,如不足指定的位数则填入0,如1变为001
function IntToString(scr, count: Integer; cFill:Char='0'): string;


{资料表的函数}

// 使用传入的 Qry 执行 sSQL 语句
procedure QryExec(var Qry: TQuery; sSql: string; lOpen: Boolean=True; sErr: string='操作失败!');
procedure DataSetPost(xDataSet: TDataSet);
procedure QryRefresh(var xQry: TQuery; asFdNm: Array of string);

//========================================================================
//资料重整
//若程式没有dm单元 , 请在project | options | directories/conditionals |
//conditionals defines 里加上 nodatabase
//重整比对资料库放在 DataBasePath\clone
//========================================================================
procedure ReBuildTable(DatabaseName: string);

function AutoSingleIntNo(var xQry: TQuery; sTbNm, sKeyFdNm: string): Integer;


//------------------------------------------------------------------------------
//procedure Auto_Item_Number6 说明
//叁数:
//      DataSet     : 要作业的资料表,可以是TTable或是TQuery
//      Item_Field  : 要自动编号的栏位
//      Item_Format : 要自动编号的格式,请叁考
//                     type
//                          Auto_Item_Formate =
//                              (cYYYMMxxxx,cYYMMDDxxx,cYYYMM_xxx,YYYMMDDxxx);//自动编号的格式
//      FirstWord   : 自动编号的前导字元,例如:'A088010001',这个'A'就是前导字元,如果不产生前导字元,请传入NULL字元
//      IsInsert    : 指定产生的编号是否可以使用插入的功能,例如:当使用者从中间删
//                    除一笔资料,当新增一笔资料时,会产生的删除的那一笔的编号;这个
//                    叁数的预设值为:True,你可以不输入这个叁数,其为插入的功能.
//------------------------------------------------------------------------------
procedure Auto_Item_Number(DataSet: TDBDataSet;Item_Field: string;
              Item_Format: Auto_Item_Formate;FirstWord: Char='X';IsInsert: Boolean=True;ODay: TDate=0);
//修改後的Auto_Item_Number1：可以以前置码+年，年月，年月日+任何隔离码如'_'+任意数位流水码
//叁数:
//      ifchina ：台历还是西历，true为西历
//      ifYMD：选择是用年，年月，年月日，进行编码注：只可以传'Y','YM','YMD'
//      item:流水位数
//      NumYY：年的位数选择，台历只可是2,3;西历只可是2,4
//      ifLine :隔离符号如'_'                 -------------- write by jeff on 2003/02/12-----------
procedure Auto_Item_Number1(DataSet: TDBDataSet;Item_Field: string; FirstWord: string='X';
              IsInsert: Boolean=True;ODay: TDate=0;
              ifChina: Boolean=True;ifYMD: string='YM';item :integer=4;NumYY :integer=2;
              ifLine :string='');


Procedure AssignAddr(tDataSour : TDataSource; tField : string;tZipField:string=''); //选取地址
Function AutoItem(ItemField,TableName:string; sDatabaseName :string='Laser'):Integer;  //自动编号

function MakeAutoNumberWithSingle(tDataSet:TDataSet;sFieldName:string;
         KeyWord : Char;xdatabaseName: string):string;//产生有前导符号的自动编号

//------------------------------------------------------------------------------
//function Select_Data 说明
//叁数:
//      xDataSource  :  要取回资料的datasource
//      xCaption     :  选择FORM的caption
//      sSQL         :  要查询资料的SQL 语法
//
//      sDataBaseName:  要作业的资料库名称
//      sReturn      :  要接受资料的栏位名称
//      iFindKey     :  相对於要接受资料栏位在SQL语法中的序位,这个个数应与sReturn同
//回传值:如有选择资料,则回传True,else False
//------------------------------------------------------------------------------

function SelSingle_Data(xDataSource:TDataSource; asFdLabel:Array of string;
         sSQL,sTbNm,sKey,sLookKey,sLocFdNm:string; lShowKeyFd:Boolean=False;iAutoNoType:Integer=1): Boolean;

function Select_Data(xDataSource: TDataSource;xCaption: string; sSQL: string;
         sDataBaseName: string;sreturn:array of string;iFindKey, iColWidth: array of Integer): Boolean;

function select_text(xCaption: string;sSQL: string;xDataBaseName: string;
         iFindKey, iColWidth: array of Integer):TStringList;   //取回资料丢回TStringlist ,适合於非db栏位


//------------------------------------------------------------------------------
//function Search function 说明
//叁数:
//      DataSet : 所要查询的资料表名称
//      SearchFieldNo : 所要查询的Fields 名称
//      iReturnFieldNo : 所要回传的栏位序号
//------------------------------------------------------------------------------

function SearchData(DataSet: TTable;  SearchFieldNO: array of Integer):TstringList;


//------------------------------------------------------------------------------
//(新版)资料查询的功能
//叁数:
//    DataSet   : 传入要搜寻的资料表,可以是TTable或是TQuery
//    iKeyField : 前面?个栏位是主键(KEY),此为要取回资料用,例如在要搜寻的资料表中,
//                T_Cust(假设其主键为CustNO,FieldIndex=0),共有三个栏位,在传入搜寻
//                的时候,这个主键(CustNo)也必须为搜寻的必要条件,而且这个值必须摆在
//                sField 叁数的第一位,此时,iKeyField=1;
//    sField    : 指定要搜寻的栏位在DataSet,index 的阵列.
//
//              Ex.
//                xSearch_Data(tableCust,1,[0,1,3,6,8]);
//------------------------------------------------------------------------------
procedure xSearch_Data(const DataSet: TDBDataSet;iKeyField:Integer;sField: array of Integer);

procedure Search_MasterDetailEx(const MDataSet: TDBDataSet;sMField: array of Integer;const DDataSet: TDBDataSet;sDField,iMDisField_List,iDDisField_List: array of Integer;LookUpData,LookUpPurposeFields,LookUpVisibleFields,LookUpVisibleName,LookUpSourceFields :array of string;sOtherWhere: string='');
 // Search_MasterDetailNoLook 只关系主档，明细档资料表
procedure Search_MasterDetailNoLook(const MDataSet: TDBDataSet;sMField: array of Integer;const DDataSet: TDBDataSet;sDField,iMDisField_List,iDDisField_List: array of Integer;sOtherWhere: string='');

//procedure Search_MasterDetail(const MDataSet: TDBDataSet;sMField: array of Integer;const DDataSet: TDBDataSet;sDField: array of Integer;sOtherWhere: string='');

//------------------------------------------------------------------------------
//求栏位值的总和 function 说明
//叁数:
//      T     : 传入要运算的资料表,本函数只适用於 Ttable
//      Field : 要运算的栏位
//      xWhere: 算式运算的条件值,
//              例如:要对出货的金额做加总(单笔出货单),需使用下列函数
//              SumField(T_Bill,'B_Qty * B_Price','Where B_Code="出货单号"');
//------------------------------------------------------------------------------

function SumField(T: TTable; Field: string;xWhere: string=''): Extended;

//求栏位值的平均值,请叁考SumField的说明
function AgvField(T: TTable; Field: string;xWhere: string=''): Extended;

//求栏位的最大值,请叁考SumField的说明
function MaxField(T: TTable; Field: string;xWhere: string=''): Extended;

//求栏位的最小值,请叁考SumField的说明
function MinField(T: TTable; Field: string;xWhere: string=''): Extended;

//在执行的状态,将资料表的结构存至文字档
procedure print_table_structure(xtable: TdbDataSet);


{其他函数}
function GetShortName(sLongName:string) : string;
//切换到中文输入法模式
//ToChinese(hWindows,True); 切换到中文
//ToChinese(hWindows,False);切换到英文
procedure ToChinese(hWindows: THandle; bChinese: Boolean);

//将传入的字符串是否是正确的整型,若不是正确的整型,则反回 def
function ValidInt(sVal: string; def:integer=0): integer;



implementation

uses uReBuild_Index,uBusy,uSelect_Form,uSelSinleData_Form,uCalendar,uAddress, uForm_Search,uForm_SearchData,uMasterDetailSearch,uMasterDetailSearchNoLook,uForm_YYMM;
//untCash
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
Function GetYYMM : string;    //得到年月  有form
begin
  result :='';
  Form_YYMM :=TForm_YYMM.Create(application);
  CreateAtPos(Form_YYMM);
  try
    with Form_YYMM do begin
      if ShowModal = mrOk then
         result := copy(inttostr(SpinEdit1.value),3,2) + ComboBox1.text
      else
         result :=''
    end;
  finally
    Form_YYMM.Free;
  end;
end;
Function GetYYMMNoForm(x : TDate) : string;  //得到年月  无form
var
  yy,mm,dd: Word;
begin
  DecodeDate(x,yy,mm,dd);
  if Pos('e',ShortDateFormat)>0 then
     result := inttostr(yy-1911)+copy(inttostr(mm+100),2,2)
  else
     result := copy(inttostr(yy),3,2)+inttostr(mm);

end;

function MyIntToChinese(myint: string):string;
var
  RecI : Integer;
  ss : string;
begin
  ss := '';
  for recI:=1 to Length(myint) do
      case myint[recI] of
        '0': ss:=ss+'        零';
        '1': ss:=ss+'        壹';
        '2': ss:=ss+'        贰';
        '3': ss:=ss+'        叁';
        '4': ss:=ss+'        肆';
        '5': ss:=ss+'        伍';
        '6': ss:=ss+'        陆';
        '7': ss:=ss+'        柒';
        '8': ss:=ss+'        捌';
        '9': ss:=ss+'        玖';
      end;
  Result := ss;
end;

procedure ToChinese(hWindows: THandle; bChinese: Boolean);
begin
  if ImmIsIME(GetKeyboardLayOut(0)) <> bChinese then
    ImmSimulateHotKey(hWindows, IME_THotKey_IME_NonIME_Toggle);
end;


function GetShortName(sLongName:string) : string;
var
  sShortName    : string;
  nShortNameLen : Integer;
begin
  SetLength(sShortName,MAX_PATH);
  nShortNameLen := GetShortPathName(PChar(sLongName),PChar(sShortName),MAX_PATH-1);
  if( 0 = nShortNameLen )then
    begin
      // handle errors...

    end;
  SetLength( sShortName,nShortNameLen );
  Result := sShortName;
end;


function ValidInt(sVal: string; def:integer=0): integer;
begin
  Try
    Result := StrToInt(sVal);
  except
    Result := def;
  end;
end;


// 使用传入的 Qry 执行 sSQL 语句
procedure QryExec(var Qry:TQuery; sSql:string; lOpen:Boolean=True; sErr:string='操作失败!');
begin
  With Qry do
  begin
    Close;
    SQL.Clear;
    SQL.Add(sSql);
    if lOpen then
      try
        Open
      except
        R_OkMessage([sErr],'',MB_ICONERROR);
        Raise;
      End
    else
      Try
        ExecSQL;
      except
        R_OkMessage([sErr],'',MB_ICONERROR);
        Raise;
      End;
  end;
end;

procedure DataSetPost(xDataSet: TDataSet);
begin
  if xDataSet.State in [dsInsert,dsEdit] then
    Try
      xDataSet.Post;
    except
      Raise;
    End;
end;