aceprev.pas

suite component ace report

unit AcePrev;

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

interface
{$I ace.inc}
uses
  {$IFDEF WIN32}
    windows,
  {$ELSE}
    winprocs,wintypes,
  {$ENDIF}
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, AceFile, extctrls, AceSetup;

type
  TAceZoom = (az200,az150,az100,az75,az50,az25,az10,azWidth,azHeight,azPage);

  TAcePreview = class(TScrollBox)
  private
    FAcePrinterSetup: TAcePrinterSetup;
    FFiler: TAceFiler;
    FPaintBox: TPaintBox;
    FPaintBox2: TPaintBox; {dummy needed for screen refresh}
    FAceDC: TAceDeviceContext;
    FPage: LongInt;
    FZoom: Integer;
    FAceZoom: TAceZoom;
    FOnVertScroll: TNotifyEvent;
    FOnHorzScroll: TNotifyEvent;
    FLoadPercent: Single;
    FIgnorePrinterSettings: Boolean;
    FPrinting: Boolean;
    FAcePrinter: TAcePrinter;
    FPrintStatus: TNotifyEvent;
    FPainting: Boolean;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure SetPage( pg: LongInt); virtual;
    procedure ClickedMe(Sender: TObject); virtual;
    function GetPageCount: Integer;
    procedure SetZoom(z: Integer);
    procedure SetAcePrinterSetup(ps: TAcePrinterSetup);
    function GetAcePrinterSetup: TAcePrinterSetup;
    procedure SetAceZoom(az: TAceZoom);
    procedure LoadCurrentAPS;
    procedure SizePage;
    procedure PaintPage(Sender: TObject); virtual;
    function GetLoadPercent: Single;

    function GetDescription: String;
    procedure SetDescription(Desc: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property AcePrinterSetup: TAcePrinterSetup read GetAcePrinterSetup write SetAcePrinterSetup;

    procedure LoadFromStream(Stream: TStream);
    procedure LoadFromFile(FileName: String);
    procedure SaveToFile(FileName: String);
    procedure SaveToStream( Stream: TStream);

    procedure LoadFromAceFile(AF: TAceFile);

    procedure SendPageToPrinter;
    procedure SendPagesToPrinter(StartPage, EndPage: LongInt);

    property Filer: TAceFiler read FFiler write FFiler;
    property AceDC: TAceDeviceContext read FAceDC write FAceDC;
    property PaintBox: TPaintBox read FPaintbox write FPaintBox;
    property Page: LongInt read FPage write SetPage;
    property PageCount: Integer read GetPageCount;
    property Zoom: Integer read FZoom write SetZoom;
    property AceZoom: TAceZoom read FAceZoom write SetAceZoom;

    procedure NextPage;
    procedure PriorPage;
    procedure LastPage;
    procedure FirstPage;

    procedure ZoomWidth;
    procedure ZoomHeight;
    procedure ZoomPage;

    property LoadPercent: Single read GetLoadPercent;
    property Description: String read GetDescription write SetDescription;
    property IgnorePrinterSettings: Boolean read FIgnorePrinterSettings write FIgnorePrinterSettings;

    property AcePrinter: TAcePrinter read FAcePrinter write FAcePrinter;
    property PrintStatus: TNotifyEvent read FPrintStatus write FPrintStatus;

  published
    property OnVertScroll: TNotifyEvent read FOnVertScroll write FOnVertScroll;
    property OnHorzScroll: TNotifyEvent read FOnHorzScroll write FOnHorzScroll;
  end;



implementation

uses aceutil, acetypes ;

constructor TAcePreview.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPaintBox := TPaintBox.Create(nil);
  FPaintBox.Parent := self;
  FPaintBox.Height := 0;
  FPaintBox.width := 0;
  FPaintBox.Align := alNone;
  FPaintBox.Top := 0;
  FPaintBox.Left := 0;
  FPaintBox.OnClick := ClickedMe;
  FFiler := TAceFiler.Create;

  FPaintBox2 := TPaintBox.Create(nil);
  FPaintBox2.Parent := self;
  FPaintBox2.Height := 0;
  FPaintBox2.width := 0;
  FPaintBox2.Top := 0;
  FPaintBox2.Left := 0;
  if csDesigning in ComponentState 
     then FPaintBox2.Align := alNone
     else FPaintBox2.Align := alClient;

  FAceDC := TAceDeviceContext.Create;
  FPage := 1;
  FZoom := 100;
  FAceZoom := az100;
  FAcePrinterSetup := TAcePrinterSetup.Create;
  FLoadPercent := 0;
  FIgnorePrinterSettings := False;

  FPrinting := False;
  FPrintStatus := nil;
end;

destructor TAcePreview.destroy;
begin
  if FPaintBox <> nil then
  begin
    FPaintBox.Parent := nil;
    FPaintBox.Free;
  end;

  if FPaintBox2 <> nil then
  begin
    FPaintBox2.Parent := nil;
    FPaintBox2.Free;
  end;

  if FFiler <> nil then FFiler.FRee;
  if FAceDC <> nil Then FAceDC.Free;
  if FAcePrinterSetup <> nil then FAcePrinterSetup.free;

  inherited Destroy;
end;

procedure TAcePreview.SetAcePrinterSetup(ps: TAcePrinterSetup);
begin
  FAcePrinterSetup.Assign(ps);
end;

function TAcePreview.GetAcePrinterSetup: TAcePrinterSetup;
begin
{  if Filer.AceFile <> nil then
  begin
    TAceAceFile(Filer.AceFile).GetPagePrinterInfo(FAcePrinterSetup, FPage);
  end;}
  result := FAcePrinterSetup;
end;

function TAcePreview.GetLoadPercent: Single;
begin
  if Filer.AceFile <> nil then result := TAceAceFile(Filer.AceFile).PercentDone
  else result := 0;
end;

function TAcePreview.GetDescription: String;
var
  af: TAceAceFile;
begin
  af := TAceAceFile(Filer.AceFile);
  if af <> nil then
  begin
    result := af.Description;
  end else result := '';
end;
procedure TAcePreview.SetDescription(Desc: String);
var
  af: TAceAceFile;
begin
  af := TAceAceFile(Filer.AceFile);
  if af <> nil then af.Description := Desc;
end;

procedure TAcePreview.LoadCurrentAPS;
begin
  if TAceAceFile(Filer.AceFile).GetPagePrinterInfo(AcePrinterSetup, FPage) then
  begin
    AcePrinterSetup.SetData;
  end;
end;

procedure TAcePreview.SizePage;
var
  h,w: Double;
  af: TAceAceFile;
begin
  if Not FPrinting then
  begin
    af := TAceAceFile(Filer.AceFile);
    if af <> nil then
    begin
      { Set data only if something changed }
      h := AcePrinterSetup.length * Zoom / 100;
      h := h * Screen.PixelsPerInch;
      w  := AcePrinterSetup.width * Zoom / 100;
      w := w * Screen.PixelsPerInch;

      if (PaintBox.Height <> Round(h)) Or (PaintBox.Width <> Round(w)) then
      begin
        PaintBox.Height := Round(h);
        PaintBox.Width  := Round(w);
      end else Invalidate;
    end;
  end;
end;


procedure TAcePreview.PaintPage(Sender: TObject);
var
  af: TAceAceFile;
  vBar, hBar: Integer;

  DC, MemDC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
begin
  if Not FPainting then
  begin
    FPainting := True;
    if Not FPrinting then
    begin
      af := TAceAceFile(Filer.AceFile);

      DC := GetDC(Handle);
      if af <> nil then
      begin
        { Scroll bar position must be scaled to the reports original
          resolution.  If not when report is created in one resolution
          and viewed in another then scrolling gets all garbled up. }
        hBar := MulDiv(HorzScrollBar.Position,Screen.PixelsPerInch, GetDeviceCaps(DC,LOGPIXELSX));
        vBar := MulDiv(VertScrollBar.Position,Screen.PixelsPerInch, GetDeviceCaps(DC,LOGPIXELSY));

        af.HorzScale := Zoom;
        af.VertScale := Zoom;


        MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
        MemDC := CreateCompatibleDC(0);
        OldBitmap := SelectObject(MemDC, MemBitmap);
        try
          Perform(WM_ERASEBKGND, MemDC, MemDC);
          AceDC.DC := MemDC;
          AceSetOrigin(MemDC, Screen.PixelsPerInch,  Screen.PixelsPerInch, -hBar, -vBar);

          if af.Pages.Count > 0 then  Filer.SendPage( AceDC, Page );
          BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, hBar,vBar, SRCCOPY);
        finally
          SelectObject(MemDC, OldBitmap);
          DeleteDC(MemDC);
          DeleteObject(MemBitmap);
        end;

      end;


      ReleaseDC(Handle, DC);
    end;
    FPainting := False;

  end;

end;

procedure TAcePreview.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  MyDC: THandle;
begin
  if (csDesigning in ComponentState) then
  begin
    inherited;
{    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    FillRect(Message.DC, Bounds(0,0,Width, Height), Brush.Handle);}
  end else
  begin
    if Filer.AceFile = nil then inherited
    else
    begin
      if FPainting then
      begin
        MyDC := SaveDC(Message.DC);
        Brush.Style := bsSolid;
        Brush.Color := clWhite;
        FillRect(Message.DC, Bounds(0,0,PaintBox.Width, PaintBox.Height), Brush.Handle);
        Brush.Color := clBtnFace;
        ExcludeClipRect(Message.DC, 0,0,PaintBox.Width, PaintBox.Height);
        FillRect(Message.DC, ClientRect, Brush.Handle);
        Message.Result := 1;
        RestoreDC(Message.DC, MyDC);
      end;
    end;  
  end;
end;

procedure TAcePreview.SendPageToPrinter;
begin
  SendPagesToPrinter( Page, Page );
end;

procedure TAcePreview.SendPagesToPrinter(StartPage, EndPage: LongInt);
var
  ps,ep: LongInt;
begin
  if Not FPrinting then
  begin
    try
      FPrinting := True;
      if Filer.AceFile <> nil then
      begin
        AcePrinter := TAcePrinter.Create;
        try
          AcePrinter.IgnorePrinterSettings := IgnorePrinterSettings;
          Filer.AceFile.AcePrinterSetup := FAcePrinterSetup;

          ps := StartPage;
          if ps <= 0 then ps := 1;
          ep := EndPage;
          if ep <= 0 then ep := PageCount;

          AcePrinter.OnStatus := FPrintStatus;
          Filer.SendPages( AcePrinter, ps, ep);
        finally
          AcePrinter.Free;
        end;
      end;
    finally
      FPrinting := False;
      Invalidate;
      FPrintStatus := nil;
    end;
  end else raise Exception.Create('Printing in progress.');
end;

procedure TAcePreview.LoadFromStream(Stream: TStream);
begin
  Filer.LoadFromStream(Stream);
  PaintBox.OnPaint := PaintPage;
  FPaintBox2.OnPaint := PaintPage;
  FPage := -1;
  Page := 1;
end;
procedure TAcePreview.LoadFromFile(FileName: String);
begin
  Filer.LoadFromFile(FileName);
  PaintBox.OnPaint := PaintPage;
  FPaintBox2.OnPaint := PaintPage;  
  FPage := -1;
  Page := 1;
end;
procedure TAcePreview.SaveToFile(FileName: String);
begin
  Filer.SaveToFile(FileName);;
end;
procedure TAcePreview.SaveToStream( Stream: TStream);
begin
  Filer.SaveToStream(Stream);
end;

procedure TAcePreview.LoadFromAceFile(AF: TAceFile);
begin
  if AF <> nil then
  begin
    FPage := 1;
    Filer.AceFile := AF;
    PaintBox.OnPaint := PaintPage;
    FPaintBox2.OnPaint := PaintPage;    
    LoadCurrentAPS;
    SizePage;
  end;
end;

procedure TAcePreview.SetPage( pg: LongInt);
begin
  if FPage <> pg then
  begin
    if Filer.AceFile <> nil then
    begin
      if (pg > 0) And (Filer.AceFile.Pages.Count >= pg) then
      begin
        FPage := pg;
        LoadCurrentAPS;
        SizePage;
      end;
    end;
  end;
end;

procedure TAcePreview.ClickedMe(Sender: TObject);
begin
  Click;
end;

function TAcePreview.GetPageCount: Integer;
begin
  if Filer.AceFile = nil then result := 0
  else result := Filer.AceFile.Pages.Count;
end;

procedure TAcePreview.SetZoom(z: Integer);
begin
  if z <> FZoom then
  begin
    FZoom := z;
    if Filer.AceFile <> nil then
    begin
      TAceAceFile(Filer.AceFile).HorzScale := z;
      TAceAceFile(Filer.AceFile).VertScale := z;
    end;
    SizePage;
  end;
end;

procedure TAcePreview.SetAceZoom(az: TAceZoom);
begin
  FAceZoom := az;
  case FAceZoom of
    az200: Zoom := 200;
    az150: Zoom := 150;
    az100: Zoom := 100;
    az75:  Zoom := 75;
    az50:  Zoom := 50;
    az25:  Zoom := 25;
    az10:  Zoom := 10;
    azWidth:  ZoomWidth;
    azHeight: ZoomHeight;
    azPage:   ZoomPage;
  end;
end;

procedure TAcePreview.NextPage;
begin
  Page := Page + 1;
end;
procedure TAcePreview.PriorPage;
begin
  Page := Page - 1;
end;
procedure TAcePreview.LastPage;
begin
  Page := PageCount;
end;
procedure TAcePreview.FirstPage;
begin
  Page := 1;
end;

procedure TAcePreview.ZoomWidth;
var
  zm,w: Double;
begin
  zm := LongInt(width) * 100;
  w := AcePrinterSetup.Width * Screen.PixelsPerInch;
  zm := zm / w;
  Zoom := Round(zm) - 2;
end;
procedure TAcePreview.ZoomHeight;
var
  zm,h: Double;
begin
  zm := LongInt(height) * 100;
  h := AcePrinterSetup.Length * Screen.PixelsPerInch;
  zm := zm / h;
  Zoom := Round(zm) - 2;
end;
procedure TAcePreview.ZoomPage;
begin
  if (height/width*100) > (AcePrinterSetup.Length/AcePrinterSetup.Width*100) then ZoomWidth
  else ZoomHeight;
end;


procedure TAcePreview.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  if Assigned(FOnHorzScroll) then FOnHorzScroll(Self);
end;
procedure TAcePreview.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  if Assigned(FOnVertScroll) then FOnVertScroll(Self);
end;
procedure TAcePreview.WMSize(var Message: TWMSize);
begin
  if FAceZoom in [azWidth, azHeight, azPage] then AceZoom := FAceZoom;
  inherited;
end;



end.