aceimg.pas

suite component ace report

unit AceImg;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses wintypes, winprocs, sysutils, classes, graphics;

type
  TAceImage = class(TObject)
  end;

  TAceBitmapType = (abtNone, abtWindows, abtPresMan);

  TAceBitmap = class(TAceImage)
  private
    FPalette: HBITMAP;
    FDIBBits: Pointer;
    FMonochrome: Boolean;
    FBitmapType: TAceBitmapType;

    FBitmapFileHeader: TBitmapFileHeader;

    FBitmapStream: TMemoryStream;
    FCoreHeader: TBitmapCoreHeader;
    FInfoHeader: TBitmapInfoHeader;
    FColorSize: Word;
    FBitsSize: LongInt;
    FBitmapInfo: PBitmapInfo;
    FBitmapCoreInfo: PBitmapCoreInfo;
    FDC: THandle;

    FWidth, FHeight: LongInt;
    FPixelsPerInch: Integer;

    procedure InitBitmap;
    procedure MakePalette;
    procedure CreateWinPalette;
    procedure CreatePMPalette;
    procedure CreateBitmapInfo;
  protected
    function GetHeight(Handle: THandle): Integer;
    function GetWidth(Handle: THandle): Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Clear;
    procedure LoadFromStream(Stream: TStream);
    procedure StretchDraw(hnd: THandle; Rect: TRect);
    procedure Draw(hnd: THandle; x,y: Integer);

    property Width: LongInt read FWidth write FWidth;
    property Height: LongInt read FHeight write FHeight;
    property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
  end;

  function AceGetGraphic(Stream: TStream): TGraphic;
  function AceIsBlob(Stream: TStream): Boolean;
  function AceIsIcon(Stream: TStream): Boolean;
  function AceIsBitmap(Stream: TStream): Boolean;
  function AceIsEMF(Stream: TStream): Boolean;
  function AceIsPlaceWMF(Stream: TStream): Boolean;

implementation

uses acetypes, forms
{$ifdef AceJpeg}
,jpeg
{$endif}
;

function IsJPegVersion: Boolean;
begin
  {$ifdef AceJpeg}
      Result := True;
   {$else}
      Result := False;
  {$endif}
end;
function AceGetGraphic(Stream: TStream): TGraphic;
var
  Spot: Integer;
  Graphic: TGraphic;

  procedure LoadImage;
  begin
    if Graphic <> nil then
    begin
      try
        Graphic.LoadFromStream(Stream);
      except
        Stream.Position := Spot;
        Graphic.Free;
        Graphic := nil;
      end;
    end;
  end;
begin
  Graphic := nil;

  { Stip out any blob header info }
  AceIsBlob(Stream);
  { Save position }
  Spot := Stream.Position;

  if AceIsBitmap(Stream) then
  begin
    Graphic := TBitMap.Create;
    LoadImage;
  end;

  if Graphic = nil then
  begin
    if (AceIsEMF(Stream) or AceIsPlaceWMF(Stream)) then
    begin
      Graphic := TMetaFile.Create;
      LoadImage;
    end;
  end;

  if Graphic = nil then
  begin
    if AceIsIcon(Stream) then
    begin
      Graphic := TIcon.Create;
      LoadImage;
    end;
  end;

  if Graphic = nil then
  begin
    if IsJpegVersion then
    begin
      {$ifdef AceJpeg}
      Graphic := TJPegImage.Create;
      LoadImage;
      {$endif}
    end;
  end;

  Result := Graphic;
end;

function AceIsBlob(Stream: TStream): Boolean;
type
  TGraphicHeader = record
    Count: Word;                { Fixed at 1 }
    HType: Word;                { Fixed at $0100 }
    Size: Longint;              { Size not including header }
  end;
var
  Size: LongInt;
  Header: TGraphicHeader;
begin
  Result := False;
  Stream.Position := 0;
  Size := Stream.Size;
  if Size >= Sizeof(TGraphicHeader) Then
  begin
    Stream.Read(Header, Sizeof(Header));
    if (Header.Count <> 1) or (Header.HType <> $0100) or
       (Header.Size <> Size - SizeOf(Header)) then Stream.Position := 0
    else Result := True;   
  end;
end;

function AceIsIcon(Stream: TStream): Boolean;
const
  rc3_StockIcon = 0;
  rc3_Icon = 1;
  rc3_Cursor = 2;
type
  TCursorOrIcon = packed record
    Reserved: Word;
    wType: Word;
    Count: Word;
  end;
var
  Header: TCursorOrIcon;
  Spot: LongInt;
begin
  Result := False;
  if Stream <> nil then
  begin
    if Stream.Size > Stream.Position then
    begin
      Spot := Stream.Position;
      { See if valid cursor }
      Stream.Read(Header, Sizeof(Header));
      Result := (Header.wType in [RC3_STOCKICON, RC3_ICON]);
      Stream.Position := Spot;
    end;
  end;
end;

{ AceIsBitmap }
function AceIsBitmap(Stream: TStream): Boolean;
var
  Header: TBitmapFileHeader;
  Spot: LongInt;
begin
  Result := False;
  if Stream <> nil then
  begin
    if Stream.Size > Stream.Position then
    begin
      Spot := Stream.Position;
      { See if valid bitmap header }
      Stream.Read(Header, Sizeof(Header));
      Result := (Header.bfType = $4D42);
      Stream.Position := Spot;
    end;
  end;
end;

{ AceIsEMF }
function AceIsEMF(Stream: TStream): Boolean;
var
  Size, Spot: Longint;
{$ifdef WIN32}
  Header: TEnhMetaHeader;
{$endif}
begin
  Result := False;
{$ifdef WIN32}
  if Stream <> nil then
  begin
    Size := Stream.Size - Stream.Position;
    if Size > Sizeof(Header) then
    begin
      Spot := Stream.Position;
      Stream.Read(Header, Sizeof(Header));
      Stream.Position := Spot;
      Result := (Header.iType = EMR_HEADER)
                 and (Header.dSignature = ENHMETA_SIGNATURE);
    end;
  end;
{$endif}
end;

{ AceIsPlaceWMF }
function AceIsPlaceWMF(Stream: TStream): Boolean;
var
  Size, Spot: Longint;
  Header: TAcePlaceMetaHeader;
  Sum: array[0..9] of Word absolute Header;
  CheckSum: Word;
{  w,h: Integer;}
begin
  Result := False;
  if Stream <> nil then
  begin
    Size := Stream.Size - Stream.Position;
    if Size > Sizeof(Header) then
    begin
      Spot := Stream.Position;
      Stream.Read(Header, Sizeof(Header));
      Stream.Position := Spot;

{    w := MulDiv(Header.BBox.Right - Header.BBox.Left,25400,Header.Inch);
    h := MulDiv(Header.BBox.Bottom - Header.BBox.Top,25400,Header.Inch);
 }
      if (Header.Key = AcePlaceHeadKey) then
      begin
        Spot := 0;
        CheckSum := 0;
        while Spot < 10 do
        begin
          CheckSum := CheckSum xor Sum[Spot];
          Inc(Spot);
        end;
        Result := (CheckSum = Header.CheckSum);
      end;
    end;
  end;
end;


{ TAceBitmap }
constructor TAceBitmap.Create;
begin
  FBitmapStream := TMemoryStream.Create;
  FBitmapInfo := nil;
  FBitmapCoreInfo := nil;
  FPalette := 0;
  FDC := 0;
  FPixelsPerInch := Screen.PixelsPerInch;
end;

destructor TAceBitmap.Destroy;
begin
  Clear;
  if FBitmapStream <> nil then FBitmapStream.Free;
  inherited Destroy;
end;

procedure TAceBitmap.Clear;
begin
  FBitmapStream.Clear;
  if FBitmapInfo <> nil then
  begin
    FreeMem(FBitmapInfo, FColorSize + SizeOf(TBitmapInfoHeader));