rm_utils.pas

中小企业管理系统------ ERP系统原代码

  result := '';
  presult := '';
  if hjnum < 0 then
  begin
    hjnum := -hjnum;
    Result := '负';
  end;

  xxbb[1] := '亿';
  xxbb[2] := '千';
  xxbb[3] := '百';
  xxbb[4] := '十';
  xxbb[5] := '万';
  xxbb[6] := '千';
  xxbb[7] := '百';
  xxbb[8] := '十';
  xxbb[9] := '一';
  xxbb[10] := '.';
  xxbb[11] := '';
  xxbb[12] := '';

  uppna[0] := '零';
  uppna[1] := '一';
  uppna[2] := '二';
  uppna[3] := '三';
  uppna[4] := '四';
  uppna[5] := '五';
  uppna[6] := '六';
  uppna[7] := '七';
  uppna[8] := '八';
  uppna[9] := '九';

  Str(hjnum: 12: 2, Vstr);
  cc := '';
  cc1 := '';
  zzz := '';

  iZero := 0;
//  vPoint:=0;
  for iCount := 1 to 10 do
  begin
    cc := Vstr[iCount];
    if cc <> ' ' then
    begin
      zzz := xxbb[iCount];
      if cc = '0' then
      begin
        if iZero < 1 then //*对“零”进行判断*//
          cc := '零'
        else
          cc := '';
        if iCount = 5 then //*对万位“零”的处理*//
          if copy(result, length(result) - 1, 2) = '零' then
            result := copy(result, 1, length(result) - 2) + xxbb[iCount] + '零'
          else
            result := result + xxbb[iCount];
        cc1 := cc;
        zzz := '';
        iZero := iZero + 1;
      end
      else
      begin
        if cc = '.' then
        begin
          cc := '';
          if (cc1 = '') or (cc1 = '零') then
          begin
            Presult := copy(result, 1, Length(result) - 2);
            result := Presult;
            iZero := 15;
          end;
          zzz := '';
        end
        else
        begin
          iZero := 0;
          cc := uppna[StrToInt(cc)];
        end
      end;
      result := result + (cc + zzz)
    end;
  end;

  if Vstr[11] = '0' then //*对小数点后两位进行处理*//
  begin
    if Vstr[12] <> '0' then
    begin
      cc := '点';
      result := result + cc;
      cc := uppna[StrToInt(Vstr[12])];
      result := result + (uppna[0] + cc + xxbb[12]);
    end
  end
  else
  begin
    if iZero = 15 then
    begin
      cc := '点';
      result := result + cc;
    end;
    cc := uppna[StrToInt(Vstr[11])];
    Result := Result + (cc + xxbb[11]);
    if Vstr[12] <> '0' then
    begin
      cc := uppna[StrToInt(Vstr[12])];
      Result := Result + (cc + xxbb[12]);
    end;
  end;

  if Copy(Result, 1, 4) = '一十' then
    Delete(Result, 1, 2);
end;

function RMSmallToBig(curs: string): string;
var
  Small, Big: string;
  wei: string[2];
  i: integer;
begin
  small := trim(curs);
  Big := '';
  for i := 1 to length(Small) do
  begin
    case strtoint(small[i]) of {位置上的数转换成大写}
      1: wei := '壹'; 2: wei := '贰';
      3: wei := '叁'; 4: wei := '肆';
      5: wei := '伍'; 6: wei := '陆';
      7: wei := '柒'; 8: wei := '捌';
      9: wei := '玖';
      0: wei := '零';
    end;

    Big := Big + wei; {组合成大写}
  end;

  Result := Big;
end;

procedure RMSetFontSize(aComboBox: TComboBox; aFontSize: integer);
var
  i: integer;
begin
  for i := Low(RMDefaultFontSize) to High(RMDefaultFontSize) do
  begin
    if RMDefaultFontSize[i] = aFontSize then
    begin
      if RMIsChineseGB then
        aComboBox.Text := RMDefaultFontSizeStr[i]
      else
        aComboBox.Text := RMDefaultFontSizeStr[i + 13];
      Exit;
    end;
  end;
  aComboBox.Text := IntToStr(aFontSize);
end;

function RMGetFontSize(aComboBox: TComboBox): integer;
begin
  if aComboBox.ItemIndex >= 0 then
  begin
    if aComboBox.ItemIndex <= High(RMDefaultFontSize) then
      Result := RMDefaultFontSize[aComboBox.ItemIndex]
    else
      Result := StrToInt(aComboBox.Text);
  end
  else
  begin
    try
      Result := StrToInt(aComboBox.Text);
    except
      Result := 0;
    end;
  end;
end;

function RMCreateBitmap(const ResName: string): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Handle := LoadBitmap(HInstance, PChar(ResName));
end;

function RMLoadStr(ID: Integer): string;
begin
  Result := RMLocale.LoadStr(ID);
end;

procedure RMSetStrProp(aObject: TObject; const aPropName: string; ID: Integer);
var
  str: string;
  pi: PPropInfo;
begin
  str := RMLoadStr(ID);
  if str <> '' then
  begin
    pi := GetPropInfo(aObject.ClassInfo, aPropName);
    if pi <> nil then
      SetStrProp(aObject, pi, str);
  end;
end;

function RMGetPropValue(const aObjectName, aPropName: string): Variant;
var
  pi: PPropInfo;
  liObject: TObject;
begin
  Result := varEmpty;
  if CurReport <> nil then
    liObject := RMFindComponent(CurReport.Owner, aObjectName)
  else
    liObject := RMFindComponent(nil, aObjectName);

  if liObject <> nil then
  begin
    pi := GetPropInfo(liObject.ClassInfo, aPropName);
    if pi <> nil then
    begin
      case pi.PropType^.Kind of
        tkString, tkLString, tkWString:
          Result := GetStrProp(liObject, pi);
        tkInteger, tkEnumeration:
          Result := GetOrdProp(liObject, pi);
        tkFloat:
          Result := GetFloatProp(liObject, pi);
      end;
    end;
  end;
end;

function RMRound(x: Extended; dicNum: Integer): Extended; //四舍五入
var
  tmp: string;
  i: Integer;
begin
  tmp := '#.';
  for i := 1 to dicNum do
    tmp := tmp + '0';
  Result := StrToFloat(FormatFloat(tmp, x));
end;

function RMMakeFileName(AFileName, AFileExtension: string; ANumber: Integer): string;
var
  FileName: string;
begin
  FileName := ChangeFileExt(ExtractFileName(AFileName), '');
  Result := Format('%s%.4d.%s', [FileName, ANumber, AFileExtension]);
end;

function RMAppendTrailingBackslash(const S: string): string;
begin
  Result := S;
  if not IsPathDelimiter(Result, Length(Result)) then
    Result := Result + '\';
end;

function RMColorBGRToRGB(AColor: TColor): string;
begin
  Result := IntToHex(ColorToRGB(AColor), 6);
  Result := Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;

function RMMakeImgFileName(AFileName, AFileExtension: string; ANumber: Integer): string;
var
  FileName: string;
begin
  FileName := ChangeFileExt(ExtractFileName(AFileName), '');
  Result := Format('%s_I%.4d.%s', [FileName, ANumber, AFileExtension]);
end;

procedure RMSetControlsEnable(AControl: TWinControl; AState: Boolean);
const
  StateColor: array[Boolean] of TColor = (clInactiveBorder, clWindow);
var
  I: Integer;
begin
  with AControl do
    for I := 0 to ControlCount - 1 do
    begin
      if ((Controls[I] is TWinControl) and
        (TWinControl(Controls[I]).ControlCount > 0)) then
        RMSetControlsEnable(TWinControl(Controls[I]), AState);
      if (Controls[I] is TCustomEdit) then
        THackWinControl(Controls[I]).Color := StateColor[AState]
      else if (Controls[I] is TCustomComboBox) then
        THackWinControl(Controls[I]).Color := StateColor[AState];
      Controls[I].Enabled := AState;
    end;
end;

procedure RMSaveFormPosition(f: TForm);
var
  Ini: TRegIniFile;
  Name: string;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  Name := rsForm + f.ClassName;
//  Ini.WriteBool(Name, rsVisible, f.Visible);
  Ini.WriteInteger(Name, rsX, f.Left);
  Ini.WriteInteger(Name, rsY, f.Top);
  Ini.WriteInteger(Name, rsWidth, f.Width);
  Ini.WriteInteger(Name, rsHeight, f.Height);
  Ini.WriteBool(Name, rsMaximized, f.WindowState = wsMaximized);
  Ini.Free;
end;

procedure RMRestoreFormPosition(f: TForm);
var
  Ini: TRegIniFile;
  Name: string;
  Maximized: Boolean;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  Name := rsForm + f.ClassName;
  Maximized := Ini.ReadBool(Name, rsMaximized, True);
  if not Maximized then
    f.WindowState := wsNormal;
  f.SetBounds(Ini.ReadInteger(Name, rsX, f.Left),
    Ini.ReadInteger(Name, rsY, f.Top),
    Ini.ReadInteger(Name, rsWidth, f.Width),
    Ini.ReadInteger(Name, rsHeight, f.Height));
  Ini.Free;
end;

procedure RMGetBitmapPixels(aGraphic: TGraphic; var x, y: Integer);
var
  mem: TMemoryStream;
  FileBMPHeader: TBitMapFileHeader;

  procedure _GetBitmapHeader;
  var
    bmHeadInfo: PBITMAPINFOHEADER;
  begin
    try
      GetMem(bmHeadInfo, Sizeof(TBITMAPINFOHEADER));
      mem.ReadBuffer(bmHeadInfo^, Sizeof(TBITMAPINFOHEADER));
      x := Round(bmHeadInfo.biXPelsPerMeter / 39);
      y := Round(bmHeadInfo.biYPelsPerMeter / 39);
      FreeMem(bmHeadInfo, Sizeof(TBITMAPINFOHEADER));
    finally
      if x < 1 then
        x := 96;
      if y < 1 then
        y := 96;
    end;
  end;

begin
  x := 96; y := 96;
  mem := TMemoryStream.Create;
  try
    aGraphic.SaveToStream(mem);
    mem.Position := 0;

    if (mem.Read(FileBMPHeader, Sizeof(TBITMAPFILEHEADER)) = Sizeof(TBITMAPFILEHEADER)) and
      (FileBMPHeader.bfType = $4D42) then
    begin
      _GetBitmapHeader;
    end;
  finally
    mem.Free;
  end;
end;

function RMGetWindowsVersion: string;
var
  Ver: TOsVersionInfo;
begin
  Ver.dwOSVersionInfoSize := SizeOf(Ver);
  GetVersionEx(Ver);
  with Ver do
  begin
    case dwPlatformId of
      VER_PLATFORM_WIN32s: Result := '32s';
      VER_PLATFORM_WIN32_WINDOWS:
        begin
          dwBuildNumber := dwBuildNumber and $0000FFFF;
          if (dwMajorVersion > 4) or ((dwMajorVersion = 4) and
            (dwMinorVersion >= 10)) then
            Result := '98'
          else
            Result := '95';
        end;
      VER_PLATFORM_WIN32_NT: Result := 'NT';
    end;
  end;
end;

function RMMonth_EnglishShort(aMonth: Integer): string;
begin
  Result := '';
  if (aMonth < 1) or (aMonth > 12) then
    Exit;
  case aMonth of
    1: Result := SShortMonthNameJan;
    2: Result := SShortMonthNameFeb;
    3: Result := SShortMonthNameMar;
    4: Result := SShortMonthNameApr;
    5: Result := SShortMonthNameMay;
    6: Result := SShortMonthNameJun;
    7: Result := SShortMonthNameJul;
    8: Result := SShortMonthNameAug;
    9: Result := SShortMonthNameSep;
    10: Result := SShortMonthNameOct;
    11: Result := SShortMonthNameNov;
    12: Result := SShortMonthNameDec;
  end;
end;

function RMMonth_EnglishLong(aMonth: Integer): string;
begin
  Result := '';
  if (aMonth < 1) or (aMonth > 12) then
    Exit;
  case aMonth of
    1: Result := SLongMonthNameJan;
    2: Result := SLongMonthNameFeb;
    3: Result := SLongMonthNameMar;
    4: Result := SLongMonthNameApr;
    5: Result := SLongMonthNameMay;
    6: Result := SLongMonthNameJun;
    7: Result := SLongMonthNameJul;
    8: Result := SLongMonthNameAug;
    9: Result := SLongMonthNameSep;
    10: Result := SLongMonthNameOct;
    11: Result := SLongMonthNameNov;
    12: Result := SLongMonthNameDec;
  end;
end;

function RMSinglNumToBig(Value: Extended; Digit: Integer): string;
var
  lBigNums, lstr: string;
  lPos: Integer;
begin
  Result := '';
  if Digit = 0 then
    Exit;
  lBigNums := '零壹贰叁肆伍陆柒捌玖';
  lstr := FloatTostr(Value);
  lPos := Pos('.', lstr) - Digit;

  if (lPos > 0) and (lPos < Length(lstr)) then
    Result := copy(lBigNums, StrToInt(lstr[lPos]) * 2 + 1, 2);
end;


{***************************函数头部说明******************************
// 单元名称 : Unit1
// 函数名称 :HexByte
// 函数实现目标：
// 参    数 :b: Byte
// 返回值   :string
// 作    者 :  ＳＩＮＭＡＸ           　　　　　  　　　　　
// 　　　　 "._`-.　　　　 (\-.　          Http://SinMax.yeah.net
// 　　　　　　'-.`;.--.___/ _`>　      　 Email:[e-mail]
// 　　　　　　　 `"( )　　, ) 　      　　　　
// 　　　　　　　　　\\----\-\　       　　　==== 郎  正 ====  　
// 　　　 ~~ ~~~~~~ "" ~~ """ ~~~~~~~~~　　
// 创建日期 :  2002-07-26
// 工作路径 :  C:\Documents and Settings\Administrator\桌面\File2Str\
// 修改记录 :
// 备   注 :
********************************************************************}

function HexByte(b: Byte): string;
const HexDigs: array[0..15] of char = '0123456789ABCDEF';
var bz: Byte;
begin
  bz := b and $F;
  b := b shr 4;
  HexByte := HexDigs[b] + HexDigs[bz];
end;

{***************************函数头部说明******************************
// 单元名称 : Unit1
// 函数名称 :File2TXT
// 函数实现目标：文件转为流
// 参    数 :Filename:String
// 返回值   :AnsiString
// 作    者 :  ＳＩＮＭＡＸ           　　　　　  　　　　　
// 　　　　 "._`-.　　　　 (\-.　          Http://SinMax.yeah.net ;
// 　　　　　　'-.`;.--.___/ _`>　      　 Email:[e-mail]
// 　　　　　　　 `"( )　　, ) 　      　　　　
// 　　　　　　　　　\\----\-\　       　　　==== 郎  正 ====  　
// 　　　 ~~ ~~~~~~ "" ~~ """ ~~~~~~~~~　　
// 创建日期 :  2002-07-26
// 工作路径 :  D:\报表客户端\计算\
// 修改记录 :
// 备   注 :
********************************************************************}
//load

function RMStream2TXT(aStream: TStream): AnsiString;
var
  lStr: AnsiString;
  Arec: char;
  i: integer;
begin
  lStr := '';
  aStream.Position := 0;
  for i := 0 to aStream.Size - 1 do
  begin
    aStream.Read(arec, 1);
    lStr := lStr + HexByte(Ord(Arec));
  end;
  lStr := lStr + '#';
  Result := lStr;
end;

{***************************函数头部说明******************************
// 单元名称 : Unit1
// 函数名称 :TForm1.TXT2File
// 函数实现目标：流转为文件
// 参    数 :inStr:AnsiString;Filename:String
// 返回值   :Boolean
// 作    者 :  ＳＩＮＭＡＸ           　　　　　  　　　　　
// 　　　　 "._`-.　　　　 (\-.　          Http://SinMax.yeah.net ;
// 　　　　　　'-.`;.--.___/ _`>　      　 Email:[e-mail]
// 　　　　　　　 `"( )　　, ) 　      　　　　
// 　　　　　　　　　\\----\-\　       　　　==== 郎  正 ====  　
// 　　　 ~~ ~~~~~~ "" ~~ """ ~~~~~~~~~　　
// 创建日期 :  2002-07-26
// 工作路径 :  D:\报表客户端\计算\
// 修改记录 :
// 备   注 :
********************************************************************}

function RMTXT2Stream(inStr: AnsiString; OutStream: TStream): Boolean;
var
  i, DEC: integer;
  lChar: Char;
begin
  Result := False;
  i := 1;
  try
    while not (inStr[i] = '#') do
    begin
      DEC := StrtoInt(('$' + inStr[i])) * 16 + StrtoInt('$' + inStr[i + 1]);
      lChar := Chr(dec);
      OutStream.Write(lChar, 1);
      i := i + 2;
    end;
    Result := True;
  except
  end
end;

end.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档