utilities.pas

企业进销存管理系统

              try
                PStream := Query1.CreateBlobStream(Query1.fields[iFindKey[i]],bmread);
                ((xdatasource.DataSet as TDataSet).FieldByName(sreturn[i]) as TBlobfield).loadfromstream(pstream);
              finally
                PStream.Free;
              end;
          end
          else
            (xdatasource.DataSet as TDataSet)[sreturn[i]] := Query1.fields[iFindKey[i]].value;
        end;
      end;
    end;
  finally
    Select_Form.Free;
  end;
end;


//取回资料丢回资料库指定栏位
function SelSingle_Data(xDataSource:TDataSource; asFdLabel:Array of string; sSQL,sTbNm,sKey,sLookKey,sLocFdNm:string;
         lShowKeyFd:Boolean=False;iAutoNoType:Integer=1): Boolean;
var
  i : Integer;
begin
  Result := False;
  SelSinleData_Form := TSelSinleData_Form.Create(Application);
  try
    with SelSinleData_Form,SelSinleData_Form.Query1 do
    begin

      Qry1.DatabaseName := TDBDataSet(xDataSource.DataSet).DataBaseName;
      DatabaseName := TDBDataSet(xDataSource.DataSet).DataBaseName;

      sTableName := sTbNm;
      sKeyFieldName := sLookKey;
      sLocFieldName := sLocFdNm;
      lShowKeyField := lShowKeyFd;
      iAutoKeyType := iAutoNoType;
      SetLength(asFieldLabel, High(asFdLabel)+1);
      for i := 0 to High(asFdLabel) do asFieldLabel[i] := asFdLabel[i];
      SQl.Clear;
      SQL.Add(sSQL);
      Open;

      if ShowModal = mrok then
      begin
        Result := True;
        if not (xDataSource.DataSet.State in [dsInsert, dsEdit]) then
          xDatasource.DataSet.Edit;
        (xdatasource.DataSet as TDataSet)[sKey] := Query1.FieldByName(sLookKey).Value;
      end;
    end;
  finally
    SelSinleData_Form.Free;
  end;
end;


//--------------  Procedure ----------------------------------------------------
//取float的小数四舍五入到?位数
//------------------------------------------------------------------------------
function DealFractional(Number : double; Digit : Integer):double;
Var
  X : real;
begin
  if NOT Odd(Trunc(Number*Exp(Digit*Ln(10)))) then 
    begin
      X:=Number*Exp(Digit*Ln(10))+1;
      Result:=(Round(X)-1)/Exp(Digit*Ln(10));
    end
  else
    Result:=Round(Number*Exp(Digit*Ln(10)))/Exp(Digit*Ln(10));
end;

//files operator
//1.GetFileName
function rGetFileName(sin: string): string;
var
  sPath: string;
  sFileExt: string;
begin
  spath := ExtractFilePath(sin);
  sFileExt := ExtractFileExt(sin);
  Result := Copy(sin,Length(spath)+1,Length(sin)-Length(sPath)-Length(sFileExt));
end;


//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);
var
  sCap: string;
begin
  Case IconType  of
    MB_ICONINFORMATION : sCap := '信息';
    MB_ICONWARNING : sCap := '警告';
    MB_ICONERROR :  sCap := '错误';
  end;

  if sFormat = '' then
    MessageBoxEx(Application.Handle,PChar(sMes[0].vstring),pChar(sCap),MB_OK+IconType,SUBLANG_CHINESE_TRADITIONAL)
  else
    MessageBoxEx(Application.Handle,PChar(Format(sFormat,sMes)),pChar(sCap),MB_OK+IconType,SUBLANG_CHINESE_TRADITIONAL);

end;


//function 2: YES & NO buttons
function R_YesNoMessage(sMes: array of const;sFormat: string ='';  const xcaption: string='请确认'):Boolean;
var
  sAns: Integer;
begin
  if sFormat = '' then
    sAns := MessageBoxEx(Application.Handle,PChar(sMes[0].vstring),PChar(xcaption),MB_YESNO+MB_ICONQuestion,SUBLANG_CHINESE_TRADITIONAL)
  else
    sAns := MessageBoxEx(Application.Handle,PChar(Format(sFormat,sMes)),PChar(xcaption),MB_YESNO+MB_ICONQuestion,SUBLANG_CHINESE_TRADITIONAL);

  if sAns= idYes then
    Result := True
  else
    Result := False;
end;


{系统忙录时,可使用这个function改变指标的状态}
Procedure SystemBusy(var Sender: TForm;xStatus: Boolean);
begin
  if xStatus then begin
    application.CreateForm(TBusyForm,Sender);
    TBusyForm(Sender).show;
    TBusyForm(Sender).update;
    Screen.Cursor := crHourGlass
  end else begin
    Screen.Cursor := crDefault;
    TBusyForm(Sender).Free;
  end;
end;


{日期时间处理function}

//将西元年转为中华民国年,并且以字串二位数的表示方式,分别传回年,月,日
Procedure DateTransChines(EditDate:tDate;var yy:string; var mm:string; var dd:string);
var
  wYY,wMM,wDD: word;
begin
  DecodeDate(EditDate, wYY, wMM, wDD);
  wYY := wYY-1911;
  yy := IntToStr(wYY);
  if wMM<10 then mm:='0'+IntToStr(wMM) else mm:=IntToStr(wMM);
  if wDD<10 then dd:='0'+IntToStr(wDD) else dd:=IntToStr(wDD);
end;

  //传回年份
function GetYear(xDate: TDate;IsChinese: Boolean=True):Word;
var
  yy,mm,dd: word;
begin
  DecodeDate(xDate,yy,mm,dd);
  if IsChinese then
    Result := yy-1911
  else
    Result := yy;
end;

  //传回月份
function GetMonth(xDate: TDate):Word;
var
  yy,mm,dd: word;
begin
  DecodeDate(xDate,yy,mm,dd);
  Result := mm;
end;

  //传回日份
function GetDays(xDate: TDate):Word;
var
  yy,mm,dd: word;
begin
  DecodeDate(xDate,yy,mm,dd);
  Result := dd;
end;


{ enf of  日期时间处理function}


//在执行的状态,将资料表的结构存至文字档
procedure print_table_structure(xtable: TdbDataSet);
var
   l: tstrings;
   sin1:tstrings;
   i: Integer;
   s: string;
   osave: TSaveDialog;

   function BooltoStr(valin: Boolean): string;
   begin
    if Valin then BooltoStr := '是' else BooltoStr := '';
   end;
begin

  L:= Tstringlist.create;
  osave := TSaveDialog.Create(nil);
  sin1:=tstringlist.create;
  try
     s:='';
     l.add('资料库名称:'+xtable.DatabaseName);
     if xtable is TTable then
       l.add('资料表名称:'+ttable(xtable).TableName)
     else
        l.add('资料表名称:');

     if xtable is ttable then begin
       ttable(xtable).GetIndexNames(sin1);

       for i:= 0 to sin1.Count-1 do
           s:= s+ ','+sin1[i];
       l.add('索引名称:'+s   );
       s:='';
     end
     else
        l.add('索引名称:');
     l.add('栏位名称'+chr(vk_Tab)+'显示名称'+chr(vk_Tab)+'栏位大小'+chr(vk_Tab)+'索引'+chr(vk_Tab)+'栏位型态');
     l.add('===================================================================');
     for i:=0 to xtable.FieldCount-1 do begin
        if Length(xtable.fields[i].FieldName)>=8 then
          s:= xtable.fields[i].FieldName+chr(vk_Tab)
        else
          s := xtable.fields[i].FieldName+chr(vk_Tab)+chr(vk_Tab);
        if Length(xtable.Fields[i].DisplayName)>=8 then
          s := s+ xtable.Fields[i].DisplayName+chr(vk_Tab)
        else
          s:= s+xtable.Fields[i].DisplayName+chr(vk_Tab)+chr(vk_Tab);
        s:= s+IntToStr(xtable.Fields[i].Size)+chr(vk_Tab)+chr(vk_Tab);
        s:= s+BooltoStr(xtable.Fields[i].IsIndexfield)+chr(vk_Tab);

         case xtable.Fields[i].DataType of
              ftUnknown: s:=s+'未知';
              ftString:  s:=s+'string';
              ftSmallint:s:= s+'16-bit Integer';
              ftInteger: s:= s+'32-bit Integer';
              ftWord:    s:= s+'16-bit unsigned Integer';
              ftBoolean: s:= s+'Boolean';
              ftFloat:	s:=s+'Floating-point numeric';
              ftCurrency: s:= s+'Money';
              ftBCD:s:=s+'Binary-Coded Decimal';
              ftDate:s:=s+'Date';
              ftTime:s:=s+'Time';
              ftDateTime:s:=s+'Date and time';
              ftBytes:s:=s+'Fixed number of bytes';
              ftVarBytes:s:=s+'Variable number of bytes (binary storage)';
              ftAutoInc:s:=s+'Auto-incrementing 32-bit Integer counter';
              ftBlob:s:=s+'Binary Large OBject';
              ftMemo:s:=s+'Text memo';
              ftGraphic: s:= s+'Bitmap';
              ftFmtMemo: s:=s+'Formatted text memo';
              ftParadoxOle: s:=s+'Paradox OLE';
              ftDBaseOle:s:=s+'dBASE OLE';
              ftTypedBinary:s:=s+'Typed binary';
              ftCursor: s:=s+'Output cursor from an Oracle stored procedure (TParam only)';
              ftFixedChar: s:=s+'Fixed Character';
              ftWideString:s:=s+'Wide string';
              ftLargeInt:s:=s+'Large Integer';
              ftADT: s:= s+'Abstract Data Type';
              ftArray: s:= s+'Array field';
              ftReference: s:=s+'REF field';
              ftDataSet	: s:=s+'DataSet field';
         end;

         L.ADD(s);
     end;
     osave.DefaultExt := 'txt';

     if osave.Execute then begin
        l.SaveToFile(osave.FileName);
     end;

  finally
    sin1.Free;
    osave.Free;
    l.Free;
  end;
end;
//------------------------------------------------------------------------------
//产生有前导符号的自动编号
//------------------------------------------------------------------------------
function MakeAutoNumberWithSingle(tDataSet:TDataSet;sFieldName:string;KeyWord : Char;xDataBaseName: string):string;
var
  yy, mm, dd  :string;
  sLastNo     :string;
  tempQuery   :TQuery;
  sCurrentNo  :string;
    //--------------  Function ----------------
    //将自动编号的序号设为三码,-xxx
    //------------------------------------------
  function GetOrderNo(Prio:string):string;
  var
    sreturn:string;
    iCount:Integer;
  begin
    sReturn:=IntToStr(strtoint(Prio)+1);
    iCount:=Length(sReturn);
    if iCount=1 then          //假如只有一位数时在前面加二个0
      Result:='00'+sReturn
    else if iCount=2 then
      Result:='0'+sReturn     //假如有二位数时,在前面加上一个0
    else
      Result:=sReturn;
  end;//end of function
begin//the makeAutoNumber start
  tempQuery := TQuery.Create(Application);
  try
      with tempQuery do begin
    DatabaseName:= xDataBaseName;
    close;
    SQL.Clear;
    SQL.Add('SELECT max('+sFieldName+') as autonumber FROM "'+TTable(tDataSet).tableName +'" '+Copy(TTable(tDataSet).tableName,1,pos(TTable(tDataSet).tableName,'.')-1));
    SQL.Add(' Where '+sFieldName+' like '''+KeyWord+'%''');
    Open;
    DateTransChines(now,yy,mm,dd); //求得现在的日期,以自动编号为 " yymm-xxx "
    if FieldByName('autonumber').AsString='' then //假如无任何记录,从001 开始
      Result:=KeyWord+yy+mm+'-001'
    else begin
      sCurrentNo:=Copy(FieldByName('autonumber').AsString,2,4);//取得目前的 yymm值
      sLastNo:=Copy(FieldByName('autonumber').AsString,7,3);// -xxx 的最後数值
      close;
      if CompareStr(sCurrentNo,(yy+mm))=0 then
        Result:=KeyWord+sCurrentNo+'-'+GetOrderNo(sLastNo)
      else
        Result:=KeyWord+yy+mm+'-001';
    end; //end of recordcount=0
      end; //end of with tempQuery do begin
  finally
    tempQuery.Free;
  end;//end of Try
end;

///////////////////////////////////////////////////////////////////////////////
//函数/过程实现部份

function convstring(ins: string):string;
var
  i: Integer;
begin
  i := 3;
  while (i < system.Length(ins)) do begin
    if ins[i] = '\' then begin
      insert('\',ins,i);
      inc(i);
    end;
    inc(i);
  end;
  if Copy(ins,1,2)='\\' then
    ins := '\\'+ins; //当时万国路径时,增加两个反\线
  Result := ins;
end;

Function ReadWriteReg(Key,Value:string;IfWrite:Boolean):string;
var
  Reg:TRegistry;
begin
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  if Reg.OpenKey('\SOFTWARE\MISSoft\App',False) then
    begin
      if Reg.ValueExists(Key) then
      else
        Reg.WriteString(Key,Value);
      Result := Reg.ReadString(Key);
      if IfWrite then
        Reg.WriteString(Key,Value);
      Reg.CloseKey;
    end
  else
    begin
      Result:=Value;
      Reg.CreateKey('\SOFTWARE\MISSoft\App');
      if IfWrite then
        Reg.WriteString(Key,Value);