rm_utils.pas

这是一个功能强大

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;

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;

{$IFNDEF COMPILER6_UP}

function DirectoryExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ENDIF}

function RMGetTmpFileName: string;
var
  lTempDir: array[0..1024] of char;
  lTempFile: array[0..1024] of char;
begin
  Result := '';
  if GetTempPath(sizeof(lTempDir), lTempDir) = 0 then Exit;

  StrPCopy(lTempDir, StrPas(lTempDir) + 'ReportMachine\');
  if not DirectoryExists(StrPas(lTempDir)) then
    SysUtils.CreateDir(StrPas(lTempDir));

  if GetTempFileName(lTempDir, '_rm_', 0, lTempFile) = 0 then Exit;

  Result := StrPas(lTempFile);
end;

function RMGetTmpFileName(aExt: string): string;
var
  lTempDir: array[0..1024] of char;
  lStr: string;
begin
  Result := '';
  if GetTempPath(sizeof(lTempDir), lTempDir) = 0 then Exit;

  StrPCopy(lTempDir, StrPas(lTempDir) + 'ReportMachine\');
  if not DirectoryExists(StrPas(lTempDir)) then
    SysUtils.CreateDir(StrPas(lTempDir));

  while True do
  begin
    lStr := StrPas(lTempDir) + '_rm_' + IntToStr(GetTickCount) + aExt;
    if not SysUtils.FileExists(lStr) then
    begin
      Result := lStr;
      Break;
    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;
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;
  if inStr = '' then
  begin
    Result := True;
    Exit;
  end;

  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;

function RMLoadStr(aResID: Integer): string;
begin
  Result := RMResourceManager.LoadStr(aResID);
end;

function RMStrToFloat(aStr: string): Double;
begin
  aStr := RMDeleteNoNumberChar(aStr);
  Result := 0;
  try
    Result := StrToFloat(aStr);
  except
  end;
end;

{$HINTS OFF}

function RMIsValidFloat(aStr: string): Boolean;
begin
  Result := True;
  try
    RMStrToFloat(aStr);
  except
    Result := False;
  end;
end;

function RMisNumeric(aStr: string): Boolean;
var
  R: Double;
  E: Integer;
begin
  Val(aStr, R, E);
  Result := (E = 0);
end;
{$HINTS ON}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMDeviceCompatibleCanvas }

constructor TRMDeviceCompatibleCanvas.Create(aReferenceDC: HDC; aWidth, aHeight: Integer; aPalette: HPalette);
begin
  inherited Create;

  FReferenceDC := aReferenceDC;
  FWidth := aWidth;
  FHeight := aHeight;

  FSavePalette := 0;
  FRestorePalette := False;

  FCompatibleDC := CreateCompatibleDC(FReferenceDC);

  FCompatibleBitmap := CreateCompatibleBitmap(FReferenceDC, aWidth, aHeight);
  FOldBitMap := SelectObject(FCompatibleDC, FCompatibleBitmap);

  if aPalette <> 0 then
  begin
    FSavePalette := SelectPalette(FCompatibleDC, aPalette, False);
    RealizePalette(FCompatibleDC);
    FRestorePalette := True;
  end
  else
  begin
    FSavePalette := SelectPalette(FCompatibleDC, SystemPalette16, False);
    RealizePalette(FCompatibleDC);
    FRestorePalette := True;
  end;

  PatBlt(FCompatibleDC, 0, 0, aWidth, aHeight, WHITENESS);
  SetMapMode(FCompatibleDC, MM_TEXT);
end;

destructor TRMDeviceCompatibleCanvas.Destroy;
begin
  if FRestorePalette then
    SelectPalette(FReferenceDC, FSavePalette, False);

  FReferenceDC := 0;
  Handle := 0;
  if FCompatibleDC <> 0 then
  begin
    SelectObject(FCompatibleDC, FOldBitMap);
    DeleteObject(FCompatibleBitmap);
    DeleteDC(FCompatibleDC);
  end;

  inherited Destroy;
end;

procedure TRMDeviceCompatibleCanvas.CreateHandle;
begin
  UpdateFont;
  Handle := FCompatibleDC;
end;

procedure TRMDeviceCompatibleCanvas.Changing;
begin
  inherited Changing;
  UpdateFont;
end;

procedure TRMDeviceCompatibleCanvas.UpdateFont;
var
  lFontSize: Integer;
  liDevicePixelsPerInch: Integer;
begin
  liDevicePixelsPerInch := GetDeviceCaps(FReferenceDC, LOGPIXELSY);
  if (liDevicePixelsPerInch <> Font.PixelsPerInch) then
  begin
    lFontSize := Font.Size;
    Font.PixelsPerInch := liDevicePixelsPerInch;
    Font.Size := lFontSize;
  end;
end;

procedure TRMDeviceCompatibleCanvas.RenderToDevice(aDestRect: TRect; aPalette: HPalette; aCopyMode: TCopyMode);
var
  lSavePalette: HPalette;
  lbRestorePalette: Boolean;
begin
  lSavePalette := 0;
  lbRestorePalette := False;
  if aPalette <> 0 then
  begin
    lSavePalette := SelectPalette(FReferenceDC, aPalette, False);
    RealizePalette(FReferenceDC);
    lbRestorePalette := True;
  end;

  BitBlt(FReferenceDC,
    aDestRect.Left, aDestRect.Top, aDestRect.Right - aDestRect.Left, aDestRect.Bottom - aDestRect.Top,
    FCompatibleDC, 0, 0, aCopyMode);

  if lbRestorePalette then
    SelectPalette(FReferenceDC, lSavePalette, False);
end;

// Draw Bitmap

procedure _DrawDIBitmap(aCanvas: TCanvas; const aDestRect: TRect; aBitmap: TBitmap;
  aCopyMode: TCopyMode);
var
  lBitmapHeader: pBitmapInfo;
  HBitmapHeader: HGLOBAL;
  lBitmapImage: Pointer;
  HBitmapImage: HGLOBAL;
  lHeaderSize: DWORD;
  lImageSize: DWORD;
begin
  GetDIBSizes(aBitmap.Handle, lHeaderSize, lImageSize);

//  GetMem(lBitmapHeader, lHeaderSize);
//  GetMem(lBitmapImage, lImageSize);
  HBitmapHeader := GlobalAlloc(GMEM_MOVEABLE or GMEM_SH