syspublic.pas

蓝图财务进销存一体化,delphi源码,使用ACCESS数据库

                   Num2Str := 'Thirty'
                 else
                   Num2Str := 'Thirty-' + Num2Str(Num mod 10);
              2: if Num = 20 then
                   Num2Str := 'Twenty'
                 else
                   Num2Str := 'Twenty-' + Num2Str(Num mod 10);
            0,1: case Num of
                    0: Num2Str := 'Zero';
                    1: Num2Str := 'One';
                    2: Num2Str := 'Two';
                    3: Num2Str := 'Three';
                    4: Num2Str := 'Four';
                    5: Num2Str := 'Five';
                    6: Num2Str := 'Six';
                    7: Num2Str := 'Seven';
                    8: Num2Str := 'Eight';
                    9: Num2Str := 'Nine';
                   10: Num2Str := 'Ten';
                   11: Num2Str := 'Eleven';
                   12: Num2Str := 'Twelve';
                   13: Num2Str := 'Thirteen';
                   14: Num2Str := 'Fourteen';
                   15: Num2Str := 'Fifteen';
                   16: Num2Str := 'Sixteen';
                   17: Num2Str := 'Seventeen';
                   18: Num2Str := 'Eightteen';
                   19: Num2Str := 'Nineteen'
                 end
          end
 end {Num2Str};

begin
 Num:= Trunc(Amount);
 Fracture:= Round(1000*Frac(Amount));
 if Num > 0 then
   Result := Num2Str(Num) + ' and ';
 if Fracture > 0 then
   Result := Result + IntToStr(Fracture) + '/1000'
 else
   Result := Result +  '000/1000';
end;

function StringGridRowSwap(mStringGrid: TStringGrid;
  mFromRow, mToRow: Integer): Boolean;
var
  S: string;
begin
  Result := False;
  if (mToRow = mFromRow) then Exit;
  if not Assigned(mStringGrid) then Exit;
  if (mFromRow < 0) or (mFromRow >= mStringGrid.RowCount) then Exit;
  if (mToRow < 0) or (mToRow >= mStringGrid.RowCount) then Exit;
  try
    S := mStringGrid.Rows[mFromRow].Text;
    mStringGrid.Rows[mFromRow].Text := mStringGrid.Rows[mToRow].Text;
    mStringGrid.Rows[mToRow].Text := S;
  except
    Exit;
  end;
  Result := True;
end; { StringGridRowSwap }
 
function StringGridRowSort(mStringGrid: TStringGrid;
  mColIndex: Integer; mDesc: Boolean = False): Boolean;
var
  I, J: Integer;
begin
  Result := False;
  if not Assigned(mStringGrid) then Exit;
  if (mColIndex < 0) or (mColIndex >= mStringGrid.ColCount) then Exit;
  for I := mStringGrid.FixedRows to mStringGrid.RowCount - 2 do
    for J := I + 1 to mStringGrid.RowCount - 1 do
      if mDesc then
        if mStringGrid.Cells[mColIndex, I] < mStringGrid.Cells[mColIndex, J] then
          StringGridRowSwap(mStringGrid, I, J)
        else
      else if mStringGrid.Cells[mColIndex, I] > mStringGrid.Cells[mColIndex, J] then
        StringGridRowSwap(mStringGrid, I, J);
  Result := True;
end; { StringGridRowSort }
///////End Source

function StrLeft(const mStr: string; mDelimiter: string): string;
begin
  Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }
 
function ListValue(mList: string; mIndex: Integer; mDelimiter: string = ','): string;
var
  I, L, K: Integer;
begin
  L := Length(mList);
  I := Pos(mDelimiter, mList);
  K := 0;
  Result := '';
  while (I > 0) and (K <> mIndex) do begin
    mList := Copy(mList, I + Length(mDelimiter), L);
    I := Pos(mDelimiter, mList);
    Inc(K);
  end;
  if K = mIndex then Result := StrLeft(mList + mDelimiter, mDelimiter);
end; { ListValue }
 
function StringGridToText(mStringGrid: TStringGrid;
  mStrings: TStrings): Boolean;
var
  I, J: Integer;
  T: string;
begin
  Result := False;
  if (not Assigned(mStringGrid)) or (not Assigned(mStrings)) then Exit;
  with mStringGrid do try
    mStrings.Clear;
    for J := 0 to RowCount - 1 do begin
      T := '';
      for I := 0 to ColCount - 1 do
        T := T + #9 + Cells[I, J];
      Delete(T, 1, 1);
      mStrings.Add(T);
    end;
  except
    Exit;
  end;
  Result := True;
end; { StringGridToText }
 
function TextToStringGrid(mStrings: TStrings;
  mStringGrid: TStringGrid): Boolean;
var
  I, J: Integer;
  T: string;
begin
  Result := False;
  if (not Assigned(mStringGrid)) or (not Assigned(mStrings)) then Exit;
  with mStrings, mStringGrid do try
    for I := 0 to ColCount - 1 do begin
      T := '';
      for J := 0 to Min(RowCount - 1, Count - 1) do
        Cells[I, J] := ListValue(Strings[J], I, #9);
    end;
  except
    Exit;
  end;
  Result := True;
end; { TextToStringGrid }
///////End Source

function repl_substr(sub_old, sub_new, s: string): string;
var
  i: integer;
begin
  repeat
    i := pos(sub_old, s);
    if i > 0 then
    begin
      delete(s, i, Length(sub_old));
      insert(sub_new, s, i);
    end;
  until i < 1;
  Result := s;
end;

function BackupSQLDataBase(connstr_sql,DatabaseName,Backup_FileName:string):Boolean;
var
//备份SQL数据库SQL数据数据库备份，connstr_sql是ADO控件的connectionstring,DatabaseName是数据库名称，
//Backup_FileName要备份到的目标文件
  ADOQuery:TADOQuery;
begin
  try
    ADOQuery:=TADOQuery.Create(nil);
    ADOQuery.Close;
    ADOQuery.ConnectionString:=connstr_sql;
    ADOQuery.SQL.Clear;
    ADOQuery.SQL.Add('backup database '+DatabaseName+' to disk = ' + '''' + Backup_FileName + ''' with format');
    Try
      Screen.Cursor := crHourGlass;
      ADOQuery.ExecSQL;
      Result:=true;
    Except
      Screen.Cursor := crDefault;
      Result:=false;
      exit;
    end;
  finally
    ADOQuery.Free;
  end;
end;

function RestoreSQLDataBase(connstr_sql,DatabaseName,Restore_FileName:string):Boolean;
var//数据库恢复函数，estore_FileName以前备份的数据库文件
  ADOQuery:TADOQuery;
begin
  try
    ADOQuery:=TADOQuery.Create(nil);
    ADOQuery.Close;//恢复数据库不能打开数据库，要打开系统数据库master，把连接字符串如adoconnetion的connectionstring中的数据库名称换成"master"数据库
    ADOQuery.ConnectionString:=repl_substr(DatabaseName,'master',connstr_sql);
    ADOQuery.SQL.Clear;
    ADOQuery.SQL.Add('RESTORE DATABASE '+DatabaseName+' from disk = ' + '''' + Restore_FileName + '''');
    Try
      Screen.Cursor := crHourGlass;
      ADOQuery.ExecSQL;
      Result:=true;
    Except
      Screen.Cursor := crDefault;
      Result:=false;
      exit;
    end;
  finally
    ADOQuery.Free;
  end;
end;

//看了mantousoft提供的代码,想起了几年前与人打赌时写的人民币金额大小写转换程序,于是就翻了出来.

//作者 ZLB（[e-mail]）
//对不起,代码有点乱.

function F2C(r: real): string;
var
tmp1,rr :string;  
l,i,j,k:integer;
const n1:array[0..9] of string=('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
const n2:array[0..3] of string=('','拾','佰','仟');
const n3:array[0..2] of string=('元','万','亿');
begin
  tmp1:=FormatFloat('#.00',r);
  l:=length(tmp1);
  rr:='';
  if strtoint(tmp1[l])<>0 then
  begin
    rr:='分';
    rr:=n1[strtoint(tmp1[l])]+rr;
  end;
  
  if strtoint(tmp1[l-1])<>0 then
  begin
    rr:='角'+rr;
    rr:=n1[strtoint(tmp1[l-1])]+rr;
  end;

  i:=l-3;
  j:=0;k:=0;
  while i>0 do
  begin
    if j mod 4=0 then
    begin
      rr:=n3[k]+rr;
      inc(k);if k>2 then k:=1;
      j:=0;
    end;
    if strtoint(tmp1[i])<>0 then
      rr:=n2[j]+rr;
    rr:=n1[strtoint(tmp1[i])]+rr;
    inc(j);
    dec(i);
  end;
  while pos('零零',rr)>0 do
    rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
  rr:=stringreplace(rr,'零亿','亿零',[rfReplaceAll]);
  while pos('零零',rr)>0 do
    rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
  rr:=stringreplace(rr,'零万','万零',[rfReplaceAll]);
  while pos('零零',rr)>0 do
    rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
  rr:=stringreplace(rr,'零元','元零',[rfReplaceAll]);
  while pos('零零',rr)>0 do
    rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
  rr:=stringreplace(rr,'亿万','亿',[rfReplaceAll]);
  if copy(rr,length(rr)-1,2)='零' then
    rr:=copy(rr,1,length(rr)-2);
  result:=rr;
end;

Procedure CompentAutoSize(FormeSize:TForm;var Form_width,Form_Height:integer);
var i:integer;
    f_Width,f_Height:double;
    comtemp:TComponent;
begin
  f_Width:=FormeSize.Width/Form_Width;
  f_Height:=FormeSize.Height/Form_Height;
//  FormeSize.Font.Size:=Trunc(FormeSize.Font.Size*f_Font);
  for i:=0 to FormeSize.ComponentCount-1 do
    begin
      comtemp:=FormeSize.Components[i];
      if comtemp is TGraphicControl then
        begin
          TGraphicControl(comtemp).Left:=Trunc(TGraphicControl(comtemp).Left*f_Width);
          TGraphicControl(comtemp).Width:=Trunc(TGraphicControl(comtemp).Width*f_Width);
          TGraphicControl(comtemp).Top:=Trunc(TGraphicControl(comtemp).Top*f_Height);
          TGraphicControl(comtemp).Height:=Trunc(TGraphicControl(comtemp).Height*f_Height);
        end
      else if comtemp is TWinControl then
        begin
          TWinControl(comtemp).Left:=Trunc(TWinControl(comtemp).Left*f_Width);
          TWinControl(comtemp).Width:=Trunc(TWinControl(comtemp).Width*f_Width);
          TWinControl(comtemp).Top:=Trunc(TWinControl(comtemp).Top*f_Height);
          TWinControl(comtemp).Height:=Trunc(TWinControl(comtemp).Height*f_Height);
        end
      else if comtemp is TControl then
        begin
          TControl(comtemp).Left:=Trunc(TControl(comtemp).Left*f_Width);
          TControl(comtemp).Width:=Trunc(TControl(comtemp).Width*f_Width);
          TControl(comtemp).Top:=Trunc(TControl(comtemp).Top*f_Height);
          TControl(comtemp).Height:=Trunc(TControl(comtemp).Height*f_Height);
        end;
    end;
  Form_Width:=FormeSize.Width;
  Form_Height:=FormeSize.Height;
end;

function GetConn(ADOQry: TADOQuery): Boolean;
begin
  result := true;
  try
    if ADOQry.Active = true then
      ADOQry.Close;
    ADOQry.Connection := DataMForm.ADOConnet;
  except
    result := false;
  end;
end;

function GetIniValue(ADOConnet: TADOConnection; sName: string): string;
var
  ADOSetTmp: TADOQuery;
  sSql: string;
begin
  Result := '';
  if sName = '' then
    exit;

  ADOSetTmp := TADOQuery.Create(nil);
  ADOSetTmp.LockType := ltReadOnly;
  sSql := ' SELECT * FROM SystemIni where sName=''' + sName + '''';
  OpenDataSetEx(ADOConnet, ADOSetTmp, sSql);
  if ADOSetTmp.IsEmpty then
    Result := ''
  else
    Result := ADOSetTmp.FieldByName('sValue').AsString;
  ADOSetTmp.Close;
  ADOSetTmp.Free;
end;

function OpenDataSetEx(ADOConnet: TADOConnection; DataSet: TADOQuery; szSql:
  string): Boolean;
begin
  result := true;
  try
    if DataSet.Active = true then
      DataSet.Close;
    DataSet.Close;
    DataSet.SQL.Clear;
    DataSet.SQL.Add(szSql);
    DataSet.Connection := ADOConnet;
    DataSet.Open;
  except
    result := false;
  end;
end;

function MakeComputerCode: string;
begin
  Result := Trim(GetIDESerial) + Trim(GetDiskSerial('C:'));
  Result := GetStandardStr(Result);
end;

function GetIDESerial: string;
begin
  Result := GetIdeDiskSerialNumber;
end;

function GetDiskSerial(sDisk: string): string;
var
  dwNum, dwTmp: dword;
begin
  Result := '';
  if GetVolumeInformation(PChar(sDisk + '\'), nil, 0, Addr(dwNum), dwTmp, dwTmp,
    nil, 0) then
    Result := IntToStr(dwNum);
end;

function GetStandardStr(sStr: string): string;
var
  i: Integer;
  s1: string;
begin
  Result := '';
  s1 := '';
  if Trim(sStr) = '' then   Exit;
  for i := 1 to Length(sStr) do
    begin
      s1 := Copy(sStr, i, 1);
      if ((s1 >= '0') and (s1 <= '9')) or ((s1 >= 'a') and (s1 <= 'z')) or ((s1 >=
        'A') and (s1 <= 'Z')) then
        Result := Result + s1;
    end;
  Result := Trim(Result);
end;

function GetPCName: string;
var
  CNameBuffer: PChar;
  fl_loaded: Boolean;
  CLen: ^DWord;
begin
  GetMem(CNameBuffer, 255);
  New(CLen);
  CLen^ := 255;
  fl_loaded := GetComputerName(CNameBuffer, CLen^);
  if fl_loaded then
    Result := StrPas(CNameBuffer)
  else
    Result := '';
  FreeMem(CNameBuffer, 255);
  Dispose(CLen);
  Result := Trim(Result);
end;

function MakeRegisterCode(sName, sPcCode: string): string;
var
  s1, s2: string;
  i: Integer;
begin
  s2 := '';
  s1 := StringEncrypt(Trim(sPcCode) + Trim(sName), #1#7#0#5);
  s1 := GetStandardStr(s1);
  for i := 1 to Length(s1) do
    begin
      s2 := s2 + Copy(s1, i, 1);
      if i mod 4 = 0 then   s2 := s2 + '-';
    end;
  if Copy(s2, Length(s2), 1) = '-' then    s2 := Copy(s2, 1, Length(s2) - 1);
  Result := s2;
end;

function StringEncrypt(mStr: string; mKey: string): string;
var
  I, J: Integer;
begin
  J := 1;
  Result := '';
  for I := 1 to Length(mStr) do
  begin
    Result := Result + Char(Ord(mStr[I]) xor Ord(mKey[J]));
    if J + 1 <= Length(mKey) then
      Inc(J)
    else
      J := 1;
  end;
  { 自己加步骤 }
  Result := StringToDisplay(Result);
end; { StringEncrypt }

function StringToDisplay(mString: string): string;