rm_class.pas

report machine 2.3 功能强大

          if VarType(v) in [varSingle, varDouble] then
            Result := FormatFloat('0.########', v)
          else
            Result := v;
        end;
      1: //数字型
        begin
          DecimalSeparator := Chr(Format and $FF);
          case f2 of
            0: Result := FormatFloat('##0.' + Dup('#', (Format div $0100) and $FF), v);
            1: Result := FloatToStrF(v, ffFixed, 15, (Format div $0100) and $FF);
            2: Result := FormatFloat('#,##0.' + Dup('#', (Format div $0100) and $FF), v);
            3: Result := FloatToStrF(v, ffNumber, 15, (Format div $0100) and $FF);
            4: Result := FormatFloat(FormatStr, v);
          end;
        end;
      2: //日期型
        begin
          if f2 > High(RMDateFormats) then
            Result := RMFormatDateTime(FormatStr, v)
          else
            Result := RMFormatDateTime(RMDateFormats[f2], v);
        end;
      3: //时间型
        begin
          if f2 = 4 then
            Result := FormatDateTime(FormatStr, v)
          else
            Result := FormatDateTime(RMTimeFormats[f2], v);
        end;
      4: //逻辑型
        begin
          if f2 = 4 then
            s := FormatStr
          else
            s := RMFormatBoolStr[f2];
          if Integer(v) = 0 then
            Result := Copy(s, 1, Pos(';', s) - 1)
          else
            Result := Copy(s, Pos(';', s) + 1, 255);
        end;
    end;
  except
    Result := v;
  end;
  DecimalSeparator := c;
end;

procedure RMGetFormatStr(var ParName, FormatStr: string; var Format: integer);
var
  i, j: Integer;
begin
  if CurView <> nil then
  begin
    Format := CurView.Format;
    FormatStr := CurView.FormatStr;
  end
  else
  begin
    Format := 0;
    FormatStr := '';
  end;

  i := Pos(' #', ParName);
  if i <> 0 then
  begin
    FormatStr := Copy(ParName, i + 2, Length(ParName) - i - 1);
    ParName := Copy(ParName, 1, i - 1);

    if FormatStr[1] in ['0'..'9', 'N', 'n'] then
    begin
      if FormatStr[1] in ['0'..'9'] then
        FormatStr := 'N' + FormatStr;
      Format := $01000000;
      if FormatStr[2] in ['0'..'9'] then
        Format := Format + $00010000;
      i := Length(FormatStr);
      while i > 1 do
      begin
        if FormatStr[i] in ['.', ',', '-'] then
        begin
          Format := Format + Ord(FormatStr[i]);
          FormatStr[i] := '.';
          if FormatStr[2] in ['0'..'9'] then
          begin
            Inc(i);
            j := i;
            while (i <= Length(FormatStr)) and (FormatStr[i] in ['0'..'9']) do
              Inc(i);
            Format := Format + 256 * StrToInt(Copy(FormatStr, j, i - j));
          end;
          break;
        end;
        Dec(i);
      end;

      if not (FormatStr[2] in ['0'..'9']) then
      begin
        FormatStr := Copy(FormatStr, 2, 255);
        Format := Format + $00040000;
      end;
    end
    else if FormatStr[1] in ['D', 'T', 'd', 't'] then
    begin
      Format := $02040000;
      FormatStr := Copy(FormatStr, 2, 255);
    end
    else if FormatStr[1] in ['B', 'b'] then
    begin
      Format := $04040000;
      FormatStr := Copy(FormatStr, 2, 255);
    end;
  end;
end;

function RMProgressForm: TRMProgressForm;
begin
  if FRMProgressForm = nil then
    FRMProgressForm := TRMProgressForm.Create(nil);
  Result := FRMProgressForm;
end;

const
  Clr: array[0..1] of TColor = (clWhite, clSilver);

function SBmp: TBitmap;
var
  i, j: Integer;
begin
  if FBmp = nil then
  begin
    FBmp := TBitmap.Create;
    FBmp.Width := 8;
    FBmp.Height := 8;
    for j := 0 to 7 do
    begin
      for i := 0 to 7 do
        FBmp.Canvas.Pixels[i, j] := Clr[(j + i) mod 2];
    end;
  end;
  Result := FBmp;
end;

function RMCompressor: TRMCompressor;
begin
  if FRMCompressor = nil then
    FRMCompressor := TRMCompressor.Create;
  Result := FRMCompressor;
end;

function RMConsts: TRMVariables; // some constants like 'clRed'
var
  i: integer;
begin
  if not Assigned(FRMConsts) then
  begin
    FRMConsts := TRMVariables.Create;
    FRMConsts.Sorted := True;
    for i := 0 to 41 do
    begin
      if i <> 16 then
        FRMConsts[RMColorNames[i]] := RMColors[i]
      else
        FRMConsts[RMColorNames[i]] := clNone;
    end;

    FRMConsts['mrNone'] := mrNone; FRMConsts['mrOk'] := mrOk;
    FRMConsts['mrCancel'] := mrCancel;
    FRMConsts['mrYes'] := mrYes; FRMConsts['mrNo'] := mrNo;

    FRMConsts['CRLF'] := #13#10;
    FRMConsts['Null'] := Null;

    FRMConsts['fsBold'] := 2; FRMConsts['fsItalic'] := 1;
    FRMConsts['fsUnderline'] := 4;

    FRMConsts['RMftNone'] := 0; FRMConsts['RMftRight'] := 1;
    FRMConsts['RMftBottom'] := 2; FRMConsts['RMftLeft'] := 4;
    FRMConsts['RMftTop'] := 8;

    FRMConsts['RMtaLeft'] := 0; FRMConsts['RMtaRight'] := 1;
    FRMConsts['RMtaCenter'] := 2; FRMConsts['RMtaVertical'] := 4;
    FRMConsts['RMtaMiddle'] := 8; FRMConsts['RMtaDown'] := 16;

    FRMConsts['baNone'] := 0; FRMConsts['baLeft'] := 1;
    FRMConsts['baRight'] := 2; FRMConsts['baCenter'] := 3;
    FRMConsts['baWidth'] := 4; FRMConsts['baBottom'] := 5;

    FRMConsts['psSolid'] := psSolid; FRMConsts['psDash'] := psDash;
    FRMConsts['psDot'] := psDot; FRMConsts['psDashDot'] := psDashDot;
    FRMConsts['psDashDotDot'] := psDashDotDot; FRMConsts['psDouble'] := psDouble;

    FRMConsts['rbFirst'] := 0;
    FRMConsts['rbCurrent'] := 1;
    FRMConsts['rbDefault'] := 2;
    FRMConsts['reLast'] := 0;
    FRMConsts['reCurrent'] := 1;
    FRMConsts['reCount'] := 2;
    FRMConsts['reDefault'] := 3;

    FRMConsts['mb_Ok'] := mb_Ok;
    FRMConsts['mb_OkCancel'] := mb_OkCancel;
    FRMConsts['mb_YesNo'] := mb_YesNo;
    FRMConsts['mb_YesNoCancel'] := mb_YesNoCancel;
    FRMConsts['mb_IconError'] := mb_IconError;
    FRMConsts['mb_IconQuestion'] := mb_IconQuestion;
    FRMConsts['mb_IconInformation'] := mb_IconInformation;
    FRMConsts['mb_IconWarning'] := mb_IconWarning;

    FRMConsts['psDashDotDot'] := psDashDotDot; FRMConsts['psDouble'] := psDouble;
  end;
  Result := FRMConsts;
end;

function RMLocale: TRMLocale;
begin
  if FLocale = nil then
    FLocale := TRMLocale.Create;
  Result := FLocale;
end;

procedure RMPrintGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic; aIsPrinting: Boolean);
var
  BitmapHeader: pBitmapInfo;
  BitmapImage: Pointer;
  HeaderSize: DWORD; // D3/D4 compatibility
  ImageSize: DWORD;
  Bitmap: TBitmap;
begin
  if not aIsPrinting then
  begin
    Canvas.StretchDraw(DestRect, aGraph);
    Exit;
  end;

  if aGraph is TMetaFile then
  begin
    Canvas.StretchDraw(DestRect, aGraph);
    Exit;
  end;

  if aGraph is TBitmap then
  begin
    Bitmap := TBitmap(aGraph);
{$IFNDEF Delphi2}
    Bitmap.PixelFormat := pf24Bit;
{$ENDIF}
  end
  else
  begin
    Bitmap := TBitmap.Create;
    Bitmap.Width := aGraph.Width;
    Bitmap.Height := aGraph.Height;
{$IFNDEF Delphi2}
    Bitmap.PixelFormat := pf24Bit;
{$ENDIF}
    Bitmap.Canvas.Draw(0, 0, aGraph);
  end;

  try
    GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
    GetMem(BitmapHeader, HeaderSize);
    GetMem(BitmapImage, ImageSize);
    try
      SetStretchBltMode(Canvas.Handle, STRETCH_DELETESCANS);
      GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
      StretchDIBits(Canvas.Handle,
        DestRect.Left, DestRect.Top, {Destination Origin}
        DestRect.Right - DestRect.Left, {Destination Width}
        DestRect.Bottom - DestRect.Top, {Destination Height}
        0, 0, {Source Origin}
        Bitmap.Width, Bitmap.Height, {Source Width & Height}
        BitmapImage,
        TBitmapInfo(BitmapHeader^),
        DIB_RGB_COLORS,
        SRCCOPY)
    finally
      FreeMem(BitmapImage);
      FreeMem(BitmapHeader);
    end;
  finally
    if not (aGraph is TBitmap) then
      Bitmap.Free;
  end;
end;

const
  pkNone = 0;
  pkBitmap = 1;
  pkMetafile = 2;
  pkIcon = 3;
  pkJPEG = 4;
  pkGIF = 5;

procedure RMLoadPicture(Stream: TStream; aPic: TPicture; aObject: TRMObject);
var
  b: Byte;
  n: Integer;
  Graphic: TGraphic;
  TempStream: TMemoryStream;
begin
  Stream.Read(b, 1);
  if (aObject is TRMPictureView) and (RMVersion >= 29) then
    Stream.Read(TRMPictureView(aObject).BlobType, 1);
  Stream.Read(n, 4);
  Graphic := nil;
  case b of
    pkBitmap: Graphic := TBitmap.Create;
    pkMetafile: Graphic := TMetafile.Create;
    pkIcon: Graphic := TIcon.Create;
{$IFDEF JPEG}
    pkJPEG: Graphic := TJPEGImage.Create;
{$ENDIF}
{$IFDEF RXGIF}
    pkGIF: Graphic := TGIFImage.Create;
{$ENDIF}
  end;

  aPic.Graphic := Graphic;
  if Graphic <> nil then
  begin
    Graphic.Free;
    TempStream := TMemoryStream.Create;
    TempStream.CopyFrom(Stream, n - Stream.Position);
    TempStream.Position := 0;
    aPic.Graphic.LoadFromStream(TempStream);
    TempStream.Free;
  end;

  Stream.Seek(n, soFromBeginning);
end;

procedure RMWritePicture(Stream: TStream; aPic: TPicture; aObject: TRMObject);
var
  b: Byte;
  n, o: Integer;
begin
  b := pkNone;
  if aPic.Graphic <> nil then
  begin
    if aPic.Graphic is TBitmap then
      b := pkBitmap
    else if aPic.Graphic is TMetafile then
      b := pkMetafile
    else if aPic.Graphic is TIcon then
      b := pkIcon
{$IFDEF JPEG}
    else if aPic.Graphic is TJPEGImage then
      b := pkJPEG
{$ENDIF}
{$IFDEF RXGIF}
    else if aPic.Graphic is TGIFImage then
      b := pkGIF
{$ENDIF};
  end;

  Stream.Write(b, 1);
  if aObject is TRMPictureView then
    Stream.Write(TRMPictureView(aObject).BlobType, 1);
  n := Stream.Position;
  Stream.Write(n, 4);
  if b <> pkNone then
    aPic.Graphic.SaveToStream(Stream);
  o := Stream.Position;
  Stream.Seek(n, soFromBeginning);
  Stream.Write(o, 4);
  Stream.Seek(0, soFromEnd);
end;

{===========================================================================}
//old

function RMCreateObject(Typ: Byte; const ClassName: string): TRMView; //建立RMView
var
  i: Integer;
begi