rm_utils.pas

report machine 2.3 功能强大

    if fl2 then
    begin
      if s[j] = '''' then fl1 := not fl1;
    end;  
  until (c = 0) or (j >= Length(s));

  if RM_Class.Flag_TableEmpty then
    Result := ''
  else
    Result := Copy(s, i + 1, j - i - 1);
end;

(* -------------------------------------------------- *)
(* RMCurrToBIGNum  将阿拉伯数字转成中文数字字串
(* 使用示例:
(*   RMCurrToBIGNum(10002.34) ==> 一万零二圆三角四分
(* -------------------------------------------------- *)
const
  _ChineseNumeric: array[0..9] of string = (
    '零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖');

function RMCurrToBIGNum(Value: Currency): string;
var
  sArabic, sIntArabic: string;
  sSectionArabic, sSection: string;
  i, iDigit, iSection, iPosOfDecimalPoint: integer;
  bInZero, bMinus: boolean;

  function ConvertStr(const str: string): string; //将字串反向, 例如: 传入 '1234', 传回 '4321'
  var
    i: integer;
  begin
    Result := '';
    for i := Length(str) downto 1 do
      Result := Result + str[i];
  end;

begin
  Result := ''; bInZero := True;
  sArabic := FloatToStr(Value); //将数字转成阿拉伯数字字串
  if sArabic[1] = '-' then
  begin
    bMinus := True;
    sArabic := Copy(sArabic, 2, 9999);
  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 := '';
    for i := 1 to Length(sSectionArabic) do //以下的 i 控制: 个十百千位四个位数
    begin
      iDigit := Ord(sSectionArabic[i]) - 48;
      if iDigit = 0 then
      begin
        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 := _ChineseNumeric[iDigit] + 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 Length(Result) > 0 then
    Result := Result + '圆';
  if iPosOfDecimalPoint > 0 then //处理小数部分
  begin
    for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
    begin
      iDigit := Ord(sArabic[i]) - 48;
      Result := Result + _ChineseNumeric[iDigit];
      case i - (iPosOfDecimalPoint + 1) of
        0: Result := Result + '角';
        1: Result := Result + '分';
        2: Result := Result + '厘';
      end;
    end;
  end;

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

  if bMinus then
    Result := '负' + Result;
  if ((Round(Value * 100)) div 1) mod 10 = 0 then
    Result := Result + '整';
end;

function RMChineseNumber(const jnum: string): string;
var
  hjnum: real;
  Vstr, zzz, cc, cc1, Presult: string;
  xxbb: array[1..12] of string;
  uppna: array[0..9] of string;
  iCount, iZero {,vpoint}: integer;
//   vPoint,vdtlno:integer;
begin
  hjnum := strtofloat(jnum);
  //*设置大写中文数字*//
  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 := '';
  result := '';
  presult := '';
  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;
                //  if iZero>=1 then
                //     zzz:=xxbb[9]
                //  else
          zzz := '';
                //  vPoint:=1;
        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;

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;

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;

end.