rm_utils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,252 行 · 第 1/4 页

        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; aFontHeight, aFontSize: integer);
var
  i: integer;
begin
  for i := Low(RMDefaultFontSize) to High(RMDefaultFontSize) do
  begin
    if RMDefaultFontSize[i] = aFontHeight then
    begin
      if RMIsChineseGB then
        aComboBox.Text := RMDefaultFontSizeStr[i]
      else
        aComboBox.Text := RMDefaultFontSizeStr[i + 13];

      Exit;
    end;
  end;

  aComboBox.Text := IntToStr(aFontSize);
end;

procedure RMSetFontSize1(aListBox: TListBox; aFontSize: integer);
var
  i: integer;
begin
  for i := Low(RMDefaultFontSize) to High(RMDefaultFontSize) do
  begin
    if RMDefaultFontSize[i] = aFontSize then
    begin
      if RMIsChineseGB then
        aListBox.ItemIndex := i
      else
        aListBox.ItemIndex := i + 13;

      Break;
    end;
  end;
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 RMGetFontSize1(aIndex: Integer; aText: string): integer;
begin
  if aIndex >= 0 then
  begin
    if aIndex <= High(RMDefaultFontSize) then
      Result := RMDefaultFontSize[aIndex]
    else
      Result := StrToInt(aText);
  end
  else
  begin
    try
      Result := StrToInt(aText);
    except
      Result := 0;
    end;
  end;
end;

function RMCreateBitmap(const ResName: string): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Handle := LoadBitmap(HInstance, PChar(ResName));
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(aReport: TRMReport; const aObjectName, aPropName: string): Variant;
var
  pi: PPropInfo;
  lObject: TObject;
begin
  Result := varEmpty;
  if aReport <> nil then
    lObject := RMFindComponent(aReport.Owner, aObjectName)
  else
    lObject := RMFindComponent(nil, aObjectName);

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

function RMRound(x: Extended; dicNum: Integer): Extended; //四舍五入
var
  tmp: string;
  i: Integer;
begin
  if dicNum = 0 then
  begin
    Result := Round(x);
    Exit;
  end;

  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(aParentKey: string; aForm: TForm);
var
  Ini: TRegIniFile;
  Name: string;
begin
  Ini := TRegIniFile.Create(RMRegRootKey + aParentKey);
  Name := rsForm + aForm.ClassName;
  Ini.WriteInteger(Name, rsX, aForm.Left);
  Ini.WriteInteger(Name, rsY, aForm.Top);
  Ini.WriteInteger(Name, rsWidth, aForm.Width);
  Ini.WriteInteger(Name, rsHeight, aForm.Height);
  Ini.WriteBool(Name, rsMaximized, aForm.WindowState = wsMaximized);
  Ini.Free;
end;

procedure RMRestoreFormPosition(aParentKey: string; aForm: TForm);
var
  lIni: TRegIniFile;
  lName: string;
  lMaximized: Boolean;
begin
  lIni := TRegIniFile.Create(RMRegRootKey + aParentKey);
  try
    lName := rsForm + aForm.ClassName;
    lMaximized := lIni.ReadBool(lName, rsMaximized, True);
    if not lMaximized then
      aForm.WindowState := wsNormal;

    aForm.SetBounds(lIni.ReadInteger(lName, rsX, aForm.Left),
      lIni.ReadInteger(lName, rsY, aForm.Top),
      lIni.ReadInteger(lName, rsWidth, aForm.Width),
      lIni.ReadInteger(lName, rsHeight, aForm.Height));
  finally
    lIni.Free;
  end;
end;

{ 获取JPEG的宽度、高度等信息 }
{ Copyright Kingron 2002 }

const
  JPEG_FLAG_BEGIN = $D8FF;
  JPEG_FLAG_END = $D9FF;
  JPEG_FRAME = $C0FF;

type
  TSegHeader = packed record
    Flag: WORD;
    LenHi, LenLo: Byte;
  end;

function GetJPEGSize(FileName: string; var Width, Height: WORD): Boolean;
var
  FS: TFileStream;
  Flag1, Flag2: WORD;
  B: Byte;

  procedure SeekForFrame;
  var
    Seg: TSegHeader;
  begin
    with Seg, FS do
    begin
      repeat
        Read(Seg, SizeOf(Seg));
        if Flag <> JPEG_FRAME then
          Position := Position + MakeWord(LenLo, LenHi) - 2;
      until (Position >= Fs.Size) or (Seg.Flag = JPEG_FRAME);
    end;
  end;

begin
  FS := TFileStream.Create(FileName, fmOpenRead);
  try
    { JPEG 文件开头必须为 FF D8,文件尾必须为 FF D9 }
    FS.Read(Flag1, SizeOf(Flag1));
    FS.Position := FS.Size - 2;
    FS.Read(Flag2, SizeOf(Flag2));
    Result := (Flag1 = JPEG_FLAG_BEGIN) and (Flag2 = JPEG_FLAG_END);
    if not Result then exit; { 不是合法的JPEG文件则退出 }

    FS.Position := 2;
    SeekForFrame; { 寻找JPEG的Frame段，即图像数据区 }
    FS.Read(B, SizeOf(B)); { Frame段段头后第一个Byte为数据精度 }

    FS.Read(B, SizeOf(B)); { 高度高字节 }
    WordRec(Height).Hi := B;
    FS.Read(B, SizeOf(B)); { 高度低字节 }
    WordRec(Height).Lo := B;

    FS.Read(B, SizeOf(B)); { 宽度高字节 }
    WordRec(Width).Hi := B;
    FS.Read(B, SizeOf(B)); { 宽度低字节 }
    WordRec(Width).Lo := B;
  finally
    FS.Free;
  end;
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 RMNumToBig(Value: Integer): string;
var
  i: Integer;
  lBigNums, lstr: string;
begin
  Result := '';
  if Value = 0 then
  begin
    Result := '０';
    Exit
  end;

  lBigNums := '０一二三四五六七八九十';
  lstr := IntTostr(Value);
  for i := 1 to Length(lStr) do
    Result := Result + Copy(lBigNums, StrToInt(lstr[i]) * 2 + 1, 2);
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;