utilities.pas

企业进销存管理系统

      Reg.CloseKey;
    end;
  Reg.Free;
end;

function Replace(str,SourStr,DestStr:string;casesensitive:Boolean):string;
var
  i:Integer;
  s,t:string;
begin
  s:='';
  t:=str;
    repeat
      if casesensitive then i:=pos(SourStr,t) else i:=pos(lowercase(SourStr),lowercase(t));
      if i>0 then
        begin
          s:=s+Copy(t,1,i-1)+DestStr;
          t:=Copy(t,i+Length(SourStr),MaxInt);
        end
      else s:=s+t;
    until i<=0;
  Result:=s;
end;


procedure ShowWorkForm(aFC: array of TFormClass; Sender: TObject);
var
  xFM: TForm;
  iFmIdx: Integer;
  cFmKind: Char;
begin
  iFmIdx := StrToInt(Copy(TWinControl(Sender).Name, 2, 2));
  cFmKind := TWinControl(Sender).Name[5];
  if (cFmKind = 'C') or (cFmKind = 'c') then
    OpenForm(Sender, aFC[iFmIdx-1], xFM, Application)
  else
    if (cFmKind = 'M') or (cFmKind = 'm') then
    begin
      xFM := aFC[iFmIdx-1].Create(Application);
      if (Sender is TMenuItem) then
        xFM.Caption := (Sender as TMenuItem).Caption
      else
        xFM.Caption := (Sender as TSpeedButton).Caption;
      xFM.ShowModal;
    end;                                    
end;

Procedure OpenForm(Sender:TObject;FormClass:TFormClass;Var Fm;Aowner:TComponent; sCap:string = '');
Var
  i: Integer;
  Child: TForm;
begin
  for i := 0 to Screen.FormCount-1 do
    if Screen.Forms[i].ClassType = FormClass then
    begin
      Child := Screen.Forms[i];
      if Child.WindowState = wsMinimized then ShowWindow(Child.Handle,SW_SHOWNORMAL);
      if (NOT Child.Visible) then Child.Visible:=True;
      Child.BringToFront;
      Child.SetFocus;
      TForm(fm):=Child;
      Exit;
    end;
  Child := TForm(FormClass.NewInstance);
  TForm(Fm):=Child;
  Child.Create(Aowner);
  child.Show;    //jeff add code : Can open form*************2002/04/22
  if Sender=nil then Exit;

  if (sCap <>'') then
    child.Caption := sCap
  else
  begin
    if (Sender is TMenuItem) then child.Caption := (Sender as TMenuItem).Caption
      else if (Sender is TMenuItem) then Child.Caption := (Sender as TSpeedButton).Caption;
  end;

end;

PROCEDURE CreateAtPos(Sender:TCustomForm);
Var
  CursorPos:TPoint;
begin
  GetCursorPos(CursorPos);//得到光标位置
  if (CursorPos.x - Sender.Width)<0 then Sender.Left:=CursorPos.x
    else Sender.Left:=CursorPos.x- Sender.Width;

  if (CursorPos.y + Sender.Height)>SCREEN.Height then Sender.Top:=CursorPos.y - Sender.Height
    else Sender.Top:=CursorPos.y;
end;


function GetFirstDay(xDate: TDate): TDate;
var
  yy, mm, dd : Word;
begin
  DecodeDate(xDate, yy, mm, dd);
  Result := EncodeDate(yy, mm, 1);
end;


function GetLastDay(xDate: TDate): TDate;
var
  yy, mm, dd : Word;
begin
  DecodeDate(xDate, yy, mm, dd);  
  Result := EncodeDate(yy, mm, MonthDays[isLeapYear(yy), mm]);
end;



Procedure AssignDBDate(Sender: TObject; tDataSour : TDataSource=nil; tField : string='');
var
  TmpCalendar : TCalendarDlg;
begin
  TmpCalendar := TCalendarDlg.Create(Application);
  CreateAtPos(TmpCalendar);
  if TmpCalendar.ShowModal = 1 then
  if (tDataSour=Nil)and(tField='') then
  begin
    if Sender is TComboEdit then
      TComboEdit(Sender).Text := FormatDateTime(ShortDateFormat,TmpCalendar.Calendar1.CalendarDate);
  end
  else
  begin
    with TTable(tDataSour.DataSet) do
    begin
      if not (state in [dsInsert, dsEdit]) then Edit;
      FieldByName(tField).AsString := FormatDateTime(ShortDateFormat,TmpCalendar.Calendar1.CalendarDate);
    end;
  end;
  TmpCalendar.Free;
end;

Function AutoItem(ItemField,TableName:string; sDatabaseName :string='Laser'):Integer;
var
  Qry:TQuery;
  i,j:Integer;
begin
  Qry:=TQuery.Create(Nil);
  Qry.DatabaseName := sDatabaseName;
  With Qry do
    begin
      Close;
      SQL.Clear;
      SQL.Add('SELECT '+ItemField+' FROM '+TableName+'');
      Open;
    end;
  Qry.Last;
  if Qry.Fields[0].AsString = '' then j := 0
  else j := Qry.Fields[0].AsInteger;
  if j <> Qry.RecordCount then
     begin
       Qry.First;
       for i := 1 to Qry.RecordCount do
         if Qry.Fields[0].AsInteger = i then Qry.Next
         else Break;
       Result := i;
     end
  else
    Result := Qry.RecordCount+1;
  Qry.Free;
end;

Procedure AssignAddr(tDataSour : TDataSource; tField : string; tZipField:string='');
var
  TmpAddr:TAddress;
begin
  TmpAddr:=TAddress.Create(Application);
  if TmpAddr.ShowModal = 1 then
    begin
      with TTable(tDataSour.DataSet) do
      begin
        if not (state in [dsInsert, dsEdit]) then
          Edit;
        FieldByName(tField).AsString := TmpAddr.Addr;
        if tZipField<>'' then
          FieldByName(tzipField).AsString := TmpAddr.ZipCode;
      end;
    end;
  TmpAddr.Free;
end;

Function ConvertDate(Date:TDatetime):string;
var
  tmpDateFormat : string;
begin
  tmpDateFormat := ShortDateFormat;
  ShortDateFormat:='MM/DD/YYYY';
  Result := DateTimeToStr(Date);
  ShortDateFormat:=tmpDateFormat;
end;

// 返回 Substr 在 s 中共有几个
function SubStrCnt(substr: string; S: string): Integer;
var
  tmps: string;
  iPos: integer;
begin
  result := 0;
  tmps := S;
  iPos := Pos(substr,tmps);
  While iPos>0 do
  begin
    result := result + 1;
    delete(tmps,1,iPos);
    iPos := Pos(substr,tmps);
  end;
end;

// 将S以split 分隔开,放入 sArr 中
procedure GetStrArray(var sArr: array of string; sSplit: string; S: string);
var
  tmps: string;
  i, iPos: integer;
begin
  if (s='') or (sSplit='') then exit;
  tmps := S;

  for i := 0 to High(sArr) do
  begin
    iPos := Pos(sSplit,tmps);
    if iPos=0 then begin sArr[i]:= tmps; exit; end;
    sArr[i] := Copy(tmps,1,iPos-1);
    delete(tmps,1,iPos);
  end;
end;



//产生一个反转的字串
function RollBackString(sint: string):string;
var
  i: Integer;
begin
  for i := Length(sInt) downto 1 do
    Result := Result + sInt[i];
end;


//将一中文字串中含有数字的半型字转为全形的字
function TransMulitByte(sInt: string):string;
const
  Ans : array [0..9] of string =('０','１','２','３','４','５','６','７','８','９');
var
  sOut: string;
  iCount: Integer;
begin
  icount := 1;
  while (iCount <=Length(sInt)) do begin
    if (sint[iCount] in ['0'..'9']) then
      sOut := sOut + ans[strtoint(sInt[iCount])]
    else
      sOut := sOut + sInt[iCount];
    inc(ICount);
  end;
  Result := sOut;
end;

//Num2BCNum  将阿拉伯数字转成中文(大写)数字字串
//Num2BCNum(10002.34) ==> 壹万零贰点叁肆
function Num2BCNum(dblArabic: double): string;
const
  _ChineseNumeric = '零壹贰叁肆伍陆柒捌玖';
var
  sArabic: string;
  sIntArabic: string;
  iPosOfDecimalPoint: Integer;
  i: Integer;
  iDigit: Integer;
  iSection: Integer;
  sSectionArabic: string;
  sSection: string;
  bInZero: Boolean;
  bMinus: Boolean;

// 将字串反向, 例如: 传入 '1234', 传回 '4321'
 function ConvertStr(const sBeConvert: string): string;
  var
    x: Integer;
  begin
    Result := '';
    for x := Length(sBeConvert) downto 1 do
      AppendStr(Result, sBeConvert[x]);
  end; { of ConvertStr }
begin
  Result := '';
  bInZero := True;
  sArabic := FloatToStr(dblArabic); // 将数字转成阿拉伯数字字串
  if sArabic[1] = '-' then
  begin
    bMinus := True;
    sArabic := Copy(sArabic, 2, 254);
  end
  else
    bMinus := False;
  iPosOfDecimalPoint := Pos('.', sArabic);  // 取得小数点的位置

// 先处理整数的部分
  if iPosOfDecimalPoint = 0 then
    sIntArabic := ConvertStr(sArabic)
  else
    sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));
// 从个位数起以每四位数为一小节
  for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
  begin
    sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
    sSection := '';
    // 以下的 i 控制: 个十百千位四个位数
    for i := 1 to Length(sSectionArabic) do
    begin
      iDigit := Ord(sSectionArabic[i]) - 48;
      if iDigit = 0 then
      begin
        // 1. 避免 '零' 的重覆出现
        // 2. 个位数的 0 不必转成 '零'
        if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
        bInZero := True;
      end
      else
      begin
        case i of
          2: sSection := '拾' + sSection;
          3: sSection := '佰' + sSection;
          4: sSection := '仟' + sSection;
        end;
        sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
          sSection;
        bInZero := False;
      end;
    end;

    // 加上该小节的位数
    if Length(sSection) = 0 then
    begin
      if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
        Result := '零' + Result;
    end
    else
    begin
      case iSection of
        0: Result := sSection;
        1: Result := sSection + '万' + Result;
        2: Result := sSection + '亿' + Result;
        3: Result := sSection + '兆' + Result;
      end;
    end;
  end;

//处理小数点右边的部分
  if iPosOfDecimalPoint > 0 then
  begin
    AppendStr(Result, '点');
    for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
    begin
      iDigit := Ord(sArabic[i]) - 48;
      AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
    end;
  end;

  // 其他例外状况的处理
  if Length(Result) = 0 then Result := '零';
  if Copy(Result, 1, 2) = '点' then Result := '零' + Result;

  // 是否为负数
  if bMinus then Result := '负' + Result;
end;

{Procedure CheckKeyValue(E:EDatebaseError;sms:string);
begin
   if (E is EDatebaseError) then
    if (E is EDatebaseError).Errors[0].ErrorCode = rKeyViol then begin
        R_OKMessage([sms]);
        Abort;
    end;
end;}

end.