unit AlRep;
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Printers, DrawMeta{v0.64}, Fileu{/v0.64};

type
  {tOrientation = (poPortrait,poLandscape);}
  tPapersize   = (alr_A4, alr_A5, alr_Legal, alr_Letter);

type
  TAlBandType = (
    alr_Title, alr_PageHeader,
    alr_DetailHeader, alr_Detail, alr_DetailFooter,
    alr_PageFooter, alr_ReportFooter, alr_NewPage,
    alr_GroupHeader, alr_GroupFooter
  );

type
  TAlSysDataType = (
    alr_Time, alr_Date, alr_DateTime,
    alr_PageNum, alr_Counter, alr_Count, alr_FormName);

type
  tAlRulerType = (alr_none, alr_cmH, alr_cmHV, alr_cmV);

type
  tClipMode = (cm_Clip, cm_Expand, cm_Overwrite);

type
  TAlControl = class({v0.31 so that it responds to windows messages (designing)}TCustomPanel{/v0.31 tCustomLabel})
  private
    {v0.31}
    FTransparent: boolean;
    FWordWrap: boolean;
    FAutoSize: boolean;
    {/v0.31}
    function BasicName:string;
  protected
    procedure SetParent(AParent:tWinControl); override;
    procedure Print(var aRect:tRect); virtual;
    procedure PrintOut(var aRect:tRect; const s:string); virtual; abstract;
    function Skip: boolean; virtual;
    function GetValue: string; virtual;
    {v0.31}
    procedure WndProc(var Message: TMessage); override;
    procedure SetAutosize(value:boolean);virtual;{controls}
    function Designing: boolean;
    {/v0.31}
  public
    property Value: string read GetValue;
  published
    { veröffentlichen geerbte Properties }
    property Visible;
    {v0.31}
    property Transparent: boolean read FTransparent write FTransparent;
    property WordWrap: boolean read FWordWrap write FWordWrap;
    property AutoSize:boolean read FAutoSize write SetAutoSize;
    property Caption;
    {/v0.31}
  end;

type {recreatewnd}
  TAlLabel = class(TAlControl)
  private
  protected
    Procedure AdjustPrintRect(VAR aRect:tRect);
    Procedure DoPrintText(var Rect:TRect; Flags: Word);
    Procedure PrintOut (var aRect:tRect; const s:string); override;
    procedure Print (var aRect:tRect); override;
  public
    constructor Create (AOwner:tComponent); override;
  published
    { veröffentlichen geerbte Properties }
    {v0.31}{/v0.31
    property Caption;}
    property Alignment;
    property AutoSize default true;
    property Transparent default true;
    property WordWrap default false;
    property Color;
    property Font;
    property ParentFont;
    property Enabled;
  end;

type
  TAlField = class(tAlLabel)
  private
    FValues : TStringList;
    dindex  : integer;
    procedure ResetData; virtual;
    procedure ClearData; virtual;
  protected
    function  GetValue:string; override;
    function  GetNextValue:string;
    function  Skip:boolean; override;
  public
    constructor Create (AOwner:tComponent); override;
    destructor  Destroy; override;
    property    NextValue:string read GetNextValue;
  published
    { veröffentlichen geerbte Properties }
    property Caption;
    property Alignment;
    property AutoSize default true;
    property Transparent default true;
    property WordWrap default false;
    property Color;
    property Font;
    property ParentFont;
    property Enabled;
  end;

type
  TAlSysField = class(tAlLabel)
  private
    dIndex       : integer;
    FSysDataType : TAlSysDataType;
    procedure UpdateCaption;
  protected
    procedure Loaded; override;
    Procedure SetSysDataType (value:TAlSysDataType);
    function  Skip:boolean; override;
    function  GetValue:string; override;
  public
    { Public-Deklarationen }
    constructor Create (AOwner:TComponent); override;
  published
    { veröffentlichen geerbte Properties }
    property Alignment;
    property AutoSize default true;
    property Transparent;
    property WordWrap;
    property Color;
    property Font;
    property ParentFont;
    property Enabled;
    { neue Properties }
    property DataType:TAlSysDataType read FSysDataType write SetSysDataType;
  end;

type
  TAlShape = class(TAlControl)
  private
    FBrush : tBrush;
    FPen   : tPen;
    FShape : tShapeType;
  protected
    procedure SetBrush(value:tBrush);
    procedure SetPen (value:tPen);
    procedure SetShape (value:tShapeType);
    procedure Paint; override;
    procedure PrintOut (var aRect:tRect; const dummy:string); override;
  public
    constructor Create (AOwner:tComponent); override;
    destructor  destroy; override;
  published
    procedure StyleChanged (Sender:tObject);
    { veröffentlichen geerbte Properties }
    property Height default 65;
    property Width  default 65;
    { neue Properties }
    property Brush:tBrush read FBrush write SetBrush;
    property Pen:tPen read FPen write SetPen;
    property Shape:tShapeType read FShape write SetShape;
  end;

type
  tAlImage = class(TAlControl)
  private
    FPicture  : tPicture;
    FStretch  : boolean;
    FCenter   : boolean;
    aPen      : tPen;
  protected
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure Paint; override;
    procedure SetCenter (value:boolean);
    procedure SetStretch (value:boolean);
    procedure SetPicture (value:tPicture);
    procedure SetAutosize (value:boolean); override;
    procedure PrintOut (var aRect:tRect; const dummy:string); override;
  public
    constructor create (AOwner:tComponent); override;
    destructor  destroy; override;
  published
    procedure PicChanged (Sender:tObject);
    property Autosize;
    property Height   default 100;
    property Width    default 100;
    property Center:boolean read FCenter write SetCenter default true;
    property Stretch:boolean read FStretch write SetStretch default true;
    property Picture:tPicture read FPicture write SetPicture;
  end;

type
  TAlBand = class;
// type omitted for forward declaration
  TAlDetailLink = class(tComponent)
  private
    lastVal      : string;
    FGroupHeader : TAlBand;
    FGruppenFuss : TAlBand;
    FDetailBand  : TAlBand;
    FDataSource  : TAlField;
    procedure SetDetailBand (value:TAlBand);
  protected
    Function CheckChanged (check_for:boolean):boolean;
  public
  published
    property GroupHeader:TAlBand read FGroupHeader write FGroupHeader;
    property GroupFooter:TAlBand read FGruppenFuss write FGruppenFuss;
    property GroupBand:TAlBand   read FDetailBand  write SetDetailBand;
    property DataSource:TAlField read FDataSource  write FDataSource;
  end;
// type omitted for forward declaration
  TAlBand = class(tCustomPanel)
  private
    FBandType : TAlBandType;
    FAltColor     : boolean;
    alt           : boolean; // alternate the background color if not white
    FDetailLink   : tAlDetailLink;
    FRuler        : tAlRulerType;
    FClipMode     : tClipMode;
    procedure SetAbschnittTyp (value:TAlBandType);
    procedure SetRulerTyp (value:tAlRulerType);
  protected
    procedure SetParent (AParent:tWinControl); override;
    procedure Paint; override;
  public
    { Public-Deklarationen }
    constructor Create (AOwner:TComponent); override;
  published
    { veröffentlichen geerbte Properties }
    property Align;
    property Color;
    property Font;
    property ParentFont;
    property Enabled;
    { neue Properties }
    property BandType:TAlBandType read FBandType write SetAbschnittTyp;
    property AltColor:boolean read FAltColor write FAltColor default false;
    property Ruler:tAlRulerType read FRuler write SetRulerTyp;
    property ClipMode:tClipMode read FClipMode write FClipMode default cm_clip;
    {v0.31}
    property Caption;
    {/v0.31}
  end;

type
  TPages = class (tList)
     function GetPage(index:integer):tGraphic;
  public
     procedure Clear;override;
     destructor Destroy; override;
     property Page[index:integer]:tGraphic read GetPage;
  end;

type
  TAlReport = class(tComponent)
  private
    { Private-Deklarationen }
    RptHeaders   : tList;
    PgeHeaders   : tList;
    DtlHeaders   : tList;
    Details      : tList;
    DtlFooters   : tList;
    PgeFooters   : tList;
    RptFooters   : tList;
    YPos         : LongInt;
    MaxYPos      : LongInt;
    FirstPage    : boolean;

    { Property Functions }
    FOrientation : TPrinterOrientation;
    FPapersize   : tPapersize;
    FLeftMargin  : integer;
    FRightMargin : integer;
    FReportTitle : string;
    procedure SetOrientation(Value: TPrinterOrientation);
    procedure SetPaperSize(Value: tPapersize);
    procedure SetLeftMargin(Value:integer);
    procedure SetRightMargin (value:integer);
    procedure UpdateScrollBars;
    procedure PrintDtlHeader(nr:integer);
    procedure PrintDtlFooter(nr:integer);
    procedure PrintBand (aBand:TAlBand);
    procedure PrintBandNC (aBand:TAlBand);
    function  SkipBand (aBand:TAlBand):boolean;
    procedure FinishPage;
    procedure NewPage;
    Function  RealHeight(aHeight:LongInt):LongInt;
    Function  RealWidth(aWidth:longInt):LongInt;
    Function  LeftMargPix:LongInt;
    Function  RightMargPix:LongInt;
    procedure DoTheJob;
    procedure SetDebugMode (value:boolean);
    function  GetDebugMode:boolean;
    procedure SetCaptionMode (value:boolean);
    function  GetCaptionMode:boolean;
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    constructor Create (AOwner:TComponent); override;
    destructor  destroy; override;
    procedure Print;
    procedure MakePreviewPages(ListOfPages: TPages);
    {m}{/m procedure Preview(var ListOfPages:TPages);}
    procedure AddNamedValue (const aName,aValue:string);
    procedure ResetData;
    procedure ClearData;
    property  DebugMode:boolean read GetDebugMode write SetDebugMode;
    property  CaptionMode:boolean read GetCaptionMode write SetCaptionMode;
  published
    { Published-Deklarationen }
    property Orientation: TPrinterOrientation read FOrientation write SetOrientation;
    property PaperSize: TPaperSize read FPapersize write SetPapersize;
    property LeftMarginMM: integer     read FLeftMargin  write SetleftMargin;
    property RightMarginMM:integer    read FRightMargin write SetRightMargin;
    property ReportTitle:string       read FReportTitle write FReportTitle;
  end;

type
  TAlPrinter = class // replacement for TPrinter enables previewing
  private
    FPreviewing              : boolean;
    FPages                   : TPages;  // list of metafiles
    FOwnPages: TPages;
    FCurrentMetafile         : TDrawMetaFile;
    FOrientation             : TPrinterOrientation;
    FLeftWaist               : integer; { in Pixel }
    FTopWaist                : integer; { in Pixel }
    FPhyPageWidth            : LongInt; { in Pixel }
    FPhyPageHeight           : LongInt;
    FPixelsPerInchVertical   : integer;
    FPixelsPerInchHorizontal : integer;
    FPaperSize               : TPaperSize;
    FTitle                   : string;
    function  GetCanvas:tCanvas;
    function  GetPageHeight:integer;
    function  GetPageWidth:integer;
    function  GetPageNumber:integer;
    function  GetPageCount:integer;
    procedure SetOrientation(value:TPrinterOrientation);
    procedure SetTitle (const s:string);
  protected
    {m}
    procedure SetPages(APages: TPages);
    function GetHandle: HDC; {printer}
    {/m}
    procedure CalcMeasurements;
  public
    constructor Create; virtual;
    destructor  Destroy; override;
    procedure BeginDoc;
    procedure EndDoc;
    procedure NewPage;
    procedure GetPrinter (ADevice, ADriver, APort: PChar
      ; var ADeviceMode: THandle);
    {m}
    procedure DoAfterPrinterSetupDialog;
    property Handle: HDC read GetHandle;
    property  Pages: TPages read FPages write {m}SetPages {/m FPages};
    {/m}
    property  Canvas:tCanvas read GetCanvas;
    property  PageHeight:integer read GetPageHeight;
    property  PageWidth:integer read GetPageWidth;
    property  PageNumber:integer read GetPageNumber;
    property  Orientation:TPrinterOrientation read FOrientation write SetOrientation;
    property  Papersize:tPaperSize read FPapersize write FPapersize;
    property  Previewing:boolean read FPreviewing write FPreviewing;
    property  PageCount:integer read GetPageCount;
    property  LeftWaist:integer read FLeftWaist; { in Pixel }
    property  TopWaist:integer read FTopWaist; { in Pixel }
    property  PhyPageWidth:LongInt read FPhyPageWidth; { in Pixel }
    property  PhyPageHeight:LongInt read FPhyPageHeight;
    property  PixelsPerInchVertical:integer read FPixelsPerInchVertical;
    property  PixelsPerInchHorizontal:integer read FPixelsPerInchHorizontal;
    property  Title:string read FTitle write SetTitle;
  end;

  function AlPrinter:TAlPrinter;

  function LoadReport (const aFileName:string;
                       VAR aReport:TAlReport; VAR aForm:tForm):boolean;

  var
     NoValue : string;

  procedure Register;

implementation

const
   Inch   = 2.54;  // cm
   InchMM = 25.4;  // mm
const
   sizes : array[tPapersize] of tPoint =
    ((X:210; Y:297),(X:148;Y:210),(X:215;Y:355),(X:215;Y:279));

const
  BandName : array[TAlBandType] of string[16] =
     ('Title','PageHeader',
      'DetailHeader','Detail','DetailFooter',
      'PageFooter','ReportFooter','New Page',
      'GroupHeader','GroupFooter');

const
  check_group_header = false;
  check_group_footer = true;

var
  bDebugMode   : boolean = false;
  bCaptionMode : boolean = false;

type
   TBandList=class(tList)
      procedure SortInsert (aItem:TAlBand);
   end;

{---------------------------------------------------}

procedure TBandList.SortInsert (aItem:TAlBand);
var
  i : integer;
begin
  for i:=0 to Count-1 do
   if TAlBand(Items[i]).Top>aItem.Top then
    begin
      Insert (i,aItem);
      exit;
    end;
  Add (aItem);
end;

{---------------------------------------------------}
VAR
  FAlPrinter : TAlPrinter = NIL;

function AlPrinter:TAlPrinter;
begin
  if NOT Assigned(FAlPrinter) then
     FAlPrinter := TAlPrinter.Create;
  Result := FAlPrinter;
end;

{TAlPrinter}
constructor TAlPrinter.Create;
begin
  inherited Create;
  FPreviewing := true;   // support for design mode
  CalcMeasurements;      // get design mode values
  FPages := TPages.Create;
{m}FOwnPages := FPages;{/m}
end;

{m}
procedure TAlPrinter.SetPages(APages: TPages);
begin
  if APages = nil then begin
    FPages := FOwnPages;
  end else begin
    FPages := APages;
  end;
end;

function TAlPrinter.GetHandle: HDC;
begin
  Result := Printer.Handle;
end;

procedure TAlPrinter.DoAfterPrinterSetupDialog;
begin
  Orientation := Printer.Orientation;
end;

{/m}

destructor TAlPrinter.Destroy;
begin
  if Assigned(FCurrentMetafile) then
     FCurrentMetafile.Close;
  {m}{/m for i:=0 to FOwnPages.Count-1 do
      with TDrawMetaFile(FOwnPages.Items[i]) do Free;}
  {m}FOwnPages.Free;{/m FPages.Free;}
  inherited Destroy;
end;

Procedure TAlPrinter.CalcMeasurements;
var
   FWaist      : tPoint;
   FPhySize    : tPoint;
{   TextMetrics : TTextMetric;}
begin
  if FPreviewing then begin
    FPixelsPerInchVertical := Screen.PixelsPerInch;
    FPixelsPerInchHorizontal := PixelsPerInchVertical;
    if FOrientation = poPortrait then begin
      FPhyPageWidth {pxl} := round (PixelsPerInchHorizontal
                             * sizes[FPapersize].x / InchMM);
      FPhyPageHeight{pxl} := round (PixelsPerInchVertical
                             * sizes[FPapersize].y / InchMM);
    end else begin
      FPhyPageWidth {pxl} := round (PixelsPerInchHorizontal
                             * sizes[FPapersize].y / InchMM);
      FPhyPageHeight{pxl} := round (PixelsPerInchVertical
                             * sizes[FPapersize].x / InchMM);
    end;
    FLeftWaist := 0;
    FTopWaist  := 0;
  end else begin
    // Calculate the number of pixels per inch vertical and horizontal.
   // 'GetDeviceCaps' is a Windows API call.
    FPixelsPerInchVertical   := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
    FPixelsPerInchHorizontal := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    // Get the gutter on the left and top.  'Escape' is a Windows API call.
    Escape(Printer.Handle, GETPRINTINGOFFSET, 0, Nil, @FWaist);
    FLeftWaist := FWaist.X;
    FTopWaist  := FWaist.Y;
    Escape(Printer.Handle, GETPHYSPAGESIZE, 0, Nil, @FPhySize);
    FPhyPageWidth  := FPhySize.X;
    FPhyPageHeight := FPhySize.Y;
  end
end;

procedure TAlPrinter.BeginDoc;
{var
  i : integer;}
begin
  if FPreviewing then begin
    FPages.Clear;
    {m}FCurrentMetafile := NIL;{/m}
  end else begin
     Printer.BeginDoc;
  end;
end;

procedure TAlPrinter.EndDoc;
begin
  if FPreviewing then
   begin
     if Assigned(FCurrentMetafile) then
        FCurrentMetafile.Close;
     FCurrentMetafile := NIL;
   end
  else
     Printer.EndDoc;
end;

procedure TAlPrinter.NewPage;
begin
  if FPreviewing then begin
    if Assigned(FCurrentMetafile) then
      FCurrentMetafile.Close;
    FCurrentMetafile := TDrawMetaFile.Create(PhyPageWidth, PhyPageHeight);
    FPages.Add(FCurrentMetafile);
  end else
    Printer.NewPage;
end;

Function TAlPrinter.GetCanvas:tCanvas;
begin
  if FPreviewing then begin
    if NOT Assigned(FCurrentMetafile) then
      NewPage;
    if Assigned(FCurrentMetafile) then
      Result := FCurrentMetafile.Canvas
    else
      raise Exception.Create ('AlPrinter could not assign the Canvas');
  end else
    Result := Printer.Canvas;
end;

Function TAlPrinter.GetPageHeight:integer;
begin
  if FPreviewing then
    Result := PhyPageHeight
  else
    Result := Printer.PageHeight;
end;

function TAlPrinter.GetPageWidth:integer;
begin
  if FPreviewing then
    Result := PhyPageWidth
  else
    Result := Printer.PageWidth;
end;

Function TAlPrinter.GetPageNumber:integer;
begin
  if FPreviewing then
    Result := FPages.Count
  else
    Result := Printer.PageNumber;
end;

function TAlPrinter.GetPageCount:integer;
begin
  if FPreviewing then
    Result := FPages.Count
  else
    Result := 0;
end;

procedure TAlPrinter.SetOrientation(value:TPrinterOrientation);
begin
  FOrientation := value;
  {m}{/m if NOT FPreviewing then}
     Printer.Orientation := FOrientation;
  CalcMeasurements;
end;

procedure TAlPrinter.SetTitle(const s:string);
begin
  FTitle := s;
  if NOT FPreviewing then
     Printer.Title := FTitle;
end;

procedure TAlPrinter.GetPrinter (ADevice, ADriver, APort: PChar
      ; var ADeviceMode: THandle);
begin
  Printer.GetPrinter(ADevice, ADriver, APort, ADeviceMode);
end;

{/TAlPrinter}
///////////////////////////////////////////////////////////////////////////////

function TPages.GetPage(index:integer):TGraphic;
begin
  if (index>=0) and (index<Count) then
     Result := TDrawMetaFile(Items[index])
  else
     Result := NIL;
end;

procedure TPages.Clear;
var
  i : integer;
begin
  for i:=0 to Count-1 do
     with TDrawMetaFile(Items[i]) do Free;
  inherited Clear;
end;

destructor TPages.Destroy;
begin
  Clear;
  inherited;
end;

///////////////////////////////////////////////////////////////////////////////

procedure TAlDetailLink.SetDetailBand (value:TAlBand);
begin
  if {v0.31} true {/v0.31 csDesigning in ComponentState} then
     if Assigned(FDetailBand) then
        FDetailBand.FDetailLink := NIL;
     if Assigned(value) then
      begin
        FDetailBand := value;
        FDetailBand.FDetailLink := Self;
      end;
end;

function TAlDetailLink.CheckChanged (check_for:boolean):boolean;
begin
  Result := false;
  if Assigned(FDataSource) then
  begin
    if check_for = check_group_footer then
    begin
      if Assigned(pChar(lastval)) then
        Result := lastval <> FDataSource.NextValue
      else
        Result := FALSE;
    end else // for header
    begin
      if Assigned(pChar(lastval)) then
        Result := lastval<>FDataSource.value
      else
        Result := TRUE;
      // get new value
      lastval := FDataSource.value;
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////

constructor TAlReport.Create (AOwner:tComponent);
begin
   inherited Create (AOwner);
   FOrientation := poPortrait;
   FPapersize   := alr_A4;
   if {v0.31} true {/v0.31 csDesigning in ComponentState} then
      UpdateScrollBars
   else
    with Owner as TForm do begin
      HorzScrollBar.Position := 0;
      VertScrollBar.Position := 0;
    end;
   bDebugMode := false;
   bCaptionMode := false;
end;

destructor TAlReport.destroy;
begin
   inherited destroy;
end;

procedure TAlReport.SetDebugMode(value:boolean);
begin
  bDebugMode := value;
end;

function TAlReport.GetDebugMode:boolean;
begin
  Result := bDebugMode;
end;

procedure TAlReport.SetCaptionMode(value:boolean);
begin
  bCaptionMode := value;
end;

function TAlReport.GetCaptionMode:boolean;
begin
  Result := bCaptionMode;
end;

procedure TAlReport.AddNamedValue (const aName,aValue:string);
var
  i       : integer;
  current : tAlField;
begin
   for i:=0 to Owner.ComponentCount-1 do
    if Owner.Components[i] is tAlField then
     begin
       current := tAlField(Owner.Components[i]);
       if UpperCase(current.Name)=UpperCase(aName) then
        begin
          current.FValues.Add(aValue);
          exit;
        end;
     end;
end;

procedure TAlReport.ResetData;
var
  i       : integer;
  current : tAlField;
begin
  for i:=0 to Owner.ComponentCount-1 do
    if Owner.Components[i] is tAlField then
    begin
      current := tAlField(Owner.Components[i]);
      current.ResetData;
    end;
end;

Procedure TAlReport.ClearData;
var
  current : tAlField;
  i       : integer;
begin
   for i:=0 to Owner.ComponentCount-1 do
    if Owner.Components[i] is tAlField then
     begin
       current := tAlField(Owner.Components[i]);
       current.ClearData;
     end;
end;

procedure TAlReport.UpdateScrollBars;
begin
   with tForm(Owner) do
    begin
      if FOrientation=poPortrait then
       begin
         HorzScrollBar.Range := Round(sizes[FPapersize].X
                             * Screen.PixelsPerInch/InchMM);
         VertScrollBar.Range := Round(sizes[FPapersize].Y
                             * Screen.PixelsPerInch/InchMM);
       end
      else
       begin
         VertScrollBar.Range := Round(sizes[FPapersize].X
                             * Screen.PixelsPerInch/InchMM);
         HorzScrollBar.Range := Round(sizes[FPapersize].Y
                             * Screen.PixelsPerInch/InchMM);
       end;
    end;
end;

procedure TAlReport.SetOrientation(Value: TPrinterOrientation);
var
  i: integer;
begin
  if Value <> FOrientation then begin
    FOrientation := value;
    AlPrinter.Orientation := value;
    if {v0.31} true {/v0.31 csDesigning in ComponentState} then begin
      for i:=0 to Owner.ComponentCount-1 do
        if Owner.Components[i].ClassType=TAlBand then
          TAlBand(Owner.Components[i]).Refresh;
      UpdateScrollBars;
    end;
  end;
end;

procedure TAlReport.SetPapersize (value:tPapersize);
var
  i: integer;
begin
  if Value <> FPapersize then begin
    FPapersize := Value;
    AlPrinter.PaperSize := Value;
    if {v0.31} true {/v0.31 csDesigning in ComponentState} then begin
      for i := 0 to Owner.ComponentCount - 1 do
        if Owner.Components[i].ClassType = TAlBand then
          TAlBand(Owner.Components[i]).Refresh;
        UpdateScrollBars;
    end;
  end;
end;

procedure TAlReport.SetLeftmargin(value:integer);
begin
  if (value>=0) and (value<Sizes[FPaperSize].X) then
    FLeftMargin := Value;
end;

procedure TAlReport.SetRightmargin(value:integer);
begin
   if (value>=0) and (value<Sizes[FPaperSize].X) then
      FRightMargin := value;
end;

Procedure TAlReport.FinishPage;
var
  i : integer;
begin
  YPos := MaxYPos;
  for i:=0 to PgeFooters.Count-1 do
     PrintBandNC(PgeFooters.Items[i]);
end;

Procedure TAlReport.NewPage;
var
  i : integer;
begin
  if NOT FirstPage then
     AlPrinter.NewPage;
  FirstPage := False;
  YPos := 0;
  for i:=0 to PgeHeaders.Count-1 do
     PrintBandNC(PgeHeaders.Items[i]);
end;

Function TAlReport.RealHeight(aHeight:LongInt):LongInt;
{var
  PaperHeight : integer;}
begin
   // convert Screen Pixel <aHeight> to PrinterPixel <Result>
   //
{   if FOrientation=poPortrait then
      PaperHeight := Sizes[FPaperSize].Y
   else
      PaperHeight := Sizes[FPaperSize].X;}
   Result := Round(0.5 + aHeight * AlPrinter.PixelsPerInchVertical / Screen.PixelsPerInch);
end;

Function TAlReport.RealWidth(aWidth:LongInt):LongInt;
{var
   PaperWidth : integer;}
begin
{   if FOrientation=poPortrait then
      PaperWidth := Sizes[FPaperSize].X
   else
      PaperWidth := Sizes[FPaperSize].Y;}
  Result := Round(0.5 + aWidth * AlPrinter.PixelsPerInchHorizontal / Screen.PixelsPerInch);
end;

Function TAlReport.LeftMargPix:LongInt;
{var
   PaperWidth : integer;}
begin
{   if FOrientation=poPortrait then
      PaperWidth := Sizes[FPaperSize].X
   else
      PaperWidth := Sizes[FPaperSize].Y;}
   // convert leftMargin in mm to Device Pixels
   Result := Round(0.5 + leftMarginMM * AlPrinter.PixelsPerInchHorizontal / InchMM)
             - AlPrinter.LeftWaist;
end;

Function TAlReport.RightMargPix:LongInt;
{var
   PaperWidth : integer;}
begin
{   if FOrientation=poPortrait then
      PaperWidth := Sizes[FPaperSize].X
   else
      PaperWidth := Sizes[FPaperSize].Y; }
   // convert leftMargin in mm to Device Pixels
   Result := Round(0.5 + RightMarginMM * AlPrinter.PixelsPerInchHorizontal / InchMM)
end;

procedure TAlReport.PrintBandNC (aBand:TAlBand);
var
  i  : integer;                 // iteration variable
  c  : TAlControl;              // Control to Print
  R  : tRect;                   // Band Rect
  cR : tRect;                   // Control Rect
  RR : tRect;                   // Result Rect
begin
  R := Rect(LeftMargPix+RealWidth(aBand.left),   yPos,
            RealWidth(aBand.Width)-RightMargPix, yPos+RealHeight(aBand.Height)-1);
  if aBand.AltColor then
   begin
     if aBand.Alt then
      begin
        AlPrinter.Canvas.Brush.Color := aBand.Color;
        AlPrinter.Canvas.FillRect (R);
      end;
     aBand.Alt := NOT aBand.Alt;
   end;

  for i:=0 to aBand.ControlCount-1 do
   begin
     c := TAlControl(aBand.Controls[i]);
     cR := Rect(RealWidth(c.left),
                RealHeight(c.top),
                RealWidth(c.left+c.width),
                RealHeight(c.top+c.height) );
     if c is tAlLabel then // affects: tAlLabel, tAlField, tAlSysfield
        tAlLabel(c).AdjustPrintRect (cR);
     cR.Left   := cR.Left + R.Left;
     cR.Right  := cR.Right + R.Left;
     cR.Top    := cR.Top   + R.Top;
     cR.Bottom := cR.Bottom + R.Top;
     case aBand.FClipMode of
       cm_Clip      : if IntersectRect(RR,R,cR) then // clip the Control Rect
                        c.Print (RR);
       cm_expand    : if UnionRect (RR,R,cR) then   // expand the Band Rect
                       begin
                         R := RR;
                         c.Print (cR);
                       end;
       cm_overwrite : c.Print (cR);
     end;
     // the Controls Print Rect
     // AlPrinter.Canvas.Brush.Style := bsClear;
     // AlPrinter.Canvas.Pen.Color   := clBlack;
     // AlPrinter.Canvas.Rectangle (cR.left,cr.top,cr.right,cr.bottom);
   end;
  // the Band Rect
  //AlPrinter.Canvas.Pen.Color   := clGreen;
  //AlPrinter.Canvas.Rectangle (R.left,r.top,r.right,r.bottom);
  YPos := 1 + R.Bottom; // YPos + RealHeight(aBand.Height);
end;

function TAlReport.SkipBand (aBand:TAlBand):boolean;
var
  more : boolean;
  c    : TAlControl;
  i    : integer;
begin
  Result := false;
  for i:=0 to aBand.ControlCount-1 do
   begin
     c := TAlControl(aBand.Controls[i]);
     more := c.Skip;
     Result := Result OR more;
   end;
end;

procedure TAlReport.PrintDtlHeader(nr:integer);
var
  j : integer;
begin
  if nr<>0 then
     for j:=0 to DtlHeaders.Count-1 do
        if TAlBand(DtlHeaders.Items[j]).Tag=nr then
           PrintBand (DtlHeaders.Items[j]);
end;

procedure TAlReport.PrintDtlFooter(nr:integer);
var
  j : integer;
begin
  if nr<>0 then
      for j:=0 to DtlFooters.Count-1 do
        if TAlBand(DtlFooters.Items[j]).Tag=nr then
           PrintBand (DtlFooters.Items[j]);
end;

Procedure TAlReport.PrintBand (aBand:TAlBand);
var
  more   : boolean;
begin
  if aBand.FBandType = alr_NewPage then
  begin
    FinishPage;
     // NewPage;
  end else begin
  repeat
    if YPos+RealHeight(aBand.Height)>MaxYPos then
    begin
      FinishPage;
      // conditionally print page headers
      NewPage;
      // if exist, print the detail header
      if aBand.FBandType = alr_Detail then
      begin
        PrintDtlHeader (aBand.Tag);
        // when band is detail-linked then print group header
        if Assigned(aBand.FDetailLink) then
         begin
           with aBand.FDetailLink do
            begin
              CheckChanged (check_group_header);
              if Assigned(FGroupHeader) then
                 PrintBand (FGroupHeader);
            end;
         end;
      end;
    end; // if YPos+RealHeight(aBand.Height)>MaxYPos then

    if Assigned(aBand.FDetailLink) then
    begin
      with aBand.FDetailLink do
         if CheckChanged (check_group_header) then
            if Assigned(FGroupHeader) then
               PrintBand (FGroupHeader);
    end;

   PrintBandNC (aBand);

   if Assigned(aBand.FDetailLink) then
    begin
      with aBand.FDetailLink do
        if CheckChanged (check_group_footer) then
           if Assigned(FGruppenFuss) then
              PrintBand (FGruppenFuss);
    end;

   if aBand.FBandType=alr_Detail then
      more := SkipBand (aBand)
   else
      more := false;

  until (NOT more);
  end;
end;

procedure TAlReport.Print;
begin
  AlPrinter.Previewing := false;

  AlPrinter.Orientation := FOrientation;
  AlPrinter.Title := FReportTitle;
  AlPrinter.BeginDoc;
  AlPrinter.CalcMeasurements;

  ResetData;
  DoTheJob;
  AlPrinter.EndDoc;
end;

{m}
procedure TAlReport.MakePreviewPages(ListOfPages: TPages);
{/m procedure TAlReport.Preview(ListOfPages: TPages);}
begin
  AlPrinter.Previewing := true;

  AlPrinter.Orientation := FOrientation;
  AlPrinter.CalcMeasurements;

  AlPrinter.Pages := ListOfPages;
  AlPrinter.BeginDoc;
  ResetData;
  DoTheJob;
  AlPrinter.EndDoc;
{m}  AlPrinter.Pages := nil;{/m}
end;

Procedure TAlReport.DoTheJob;
var
   i{,j}: integer;
   templist: TBandList;
   current: TAlBand;
   lastab: TAlBandType;
   lastTag: integer;
begin
  { initialization }
  {----------------}
  { count and sort Abschnitte }
  templist := TBandList.Create;
  for i := 0 to Owner.ComponentCount-1 do
    if Owner.Components[i].ClassType = TAlBand then
    begin
      current := TAlBand(Owner.Components[i]);
      templist.SortInsert (current);
    end;

   RptHeaders := TBandList.Create;
   PgeHeaders := TBandList.Create;
   DtlHeaders := TBandList.Create;
   Details    := TBandList.Create;
   DtlFooters := TBandList.Create;
   PgeFooters := TBandList.Create;
   RptFooters := TBandList.Create;
   {v0.11}
   lastab := alr_Title; {to silence compiler warning}
   lastTag := 0;
   {/v0.11}
   for i:=0 to templist.Count-1 do begin
     current := templist.Items[i];
     with current do begin
       case FBandType of
         alr_Title       : RptHeaders.Add(current);
         alr_PageHeader  : PgeHeaders.Add(current);
         alr_DetailHeader : begin
           current.Tag :=  i + 1;
           lastTag :=  i + 1;
           DtlHeaders.Add(current);
         end;
         alr_Detail: begin
           if lastab = alr_DetailHeader then
             current.Tag := lastTag
           else
             lastTag := i + 1;
           Details.Add(current);
         end;
         alr_newPage: Details.Add(current);
         alr_DetailFooter: begin
           if lastab = alr_Detail then
             current.Tag := lastTag;
           DtlFooters.Add(current);
         end;
         alr_PageFooter: PgeFooters.Add(current);
         alr_ReportFooter: RptFooters.Add(current);
       end;
       lastab := FBandType;
     end;
   end;
   templist.free;

   { preparation }
   {-------------}
   MaxYPos := AlPrinter.PageHeight;
   for i:=0 to PgeFooters.Count-1 do
    begin
      current := PgeFooters.Items[i];
      MaxYPos := MaxYPos - RealHeight(current.Height);
    end;

   { printing }
   {----------}
   YPos := 99999;
   FirstPage := true;
   { print the Report-Header(s) }
   for i:=0 to RptHeaders.Count-1 do
     PrintBand (RptHeaders.Items[i]);
   { print Details }
   for i:=0 to Details.Count-1 do
   begin
     current := TAlBand(Details.Items[i]);
     { conditionaly print the Detail-Header(s) }
     PrintDtlHeader(current.Tag);
     { print the Detail }
     PrintBand (current);
     { conditionaly print the Detail-Footer(s) }
     PrintDtlFooter(current.Tag);
   end;
   { print the Report-Footer(s) }
   for i:=0 to RptFooters.Count-1 do
     PrintBand (RptFooters.Items[i]);
   FinishPage;

   { Cleanup }
   RptHeaders.Free;
   PgeHeaders.Free;
   DtlHeaders.Free;
   Details.Free;
   DtlFooters.Free;
   PgeFooters.Free;
   RptFooters.Free;
end;

///////////////////////////////////////////////////////////////////////////////

constructor TAlBand.Create (AOwner:tComponent);
begin
   inherited Create (AOwner);
   Color      := clWhite;
   BevelInner := bvNone;
   BevelOuter := bvNone;
   Ctl3D      := False;
   Caption    := '';
   Align      := alTop;
   FRuler     := alr_cmHV;

   FBandType := alr_Title;
end;

procedure TAlBand.SetAbschnittTyp(value: TAlBandType);
begin
  if value<>FBandType then
   begin
     FBandType := value;
     Refresh;
   end;
end;

procedure TAlBand.SetRulerTyp(value:tAlRulerType);
begin
  if value<>FRuler then
   begin
     FRuler := value;
     Refresh;
   end;
end;
(*
procedure TAlBand.SetColumns(value:word);
begin
  if value<>FColumns then
   begin
     FColumns := value;
     Refresh;
   end;
end;
*)
procedure TAlBand.SetParent (AParent:tWinControl);
begin
  if (AParent<>NIL) and NOT (aParent is tForm) then
     raise Exception.Create ('This component must be placed on a tForm.')
  else
     inherited SetParent(AParent);
end;

procedure TAlBand.Paint;
var
   cm : integer;
{   cw : integer;}
begin
  inherited Paint;
  if {v0.31} true {/v0.31 csDesigning in ComponentState} then
  begin
    {v0.31}
    Canvas.Rectangle(0, 0, Width - 1, Height - 1);
    {/v0.31}
    Canvas.Font.Color := clSilver;
    Canvas.Font.Size  := 8;
    Canvas.Font.Name  := 'Arial';
    Canvas.Pen.Color  := clSilver;
    Canvas.Pen.Style  := psDash;
    if (FRuler<>alr_none) then
    begin
      if FRuler in [alr_cmHV,alr_cmV] then
        for cm:=1 to Round(Width*Inch/Screen.PixelsPerInch) do
        begin
          Canvas.MoveTo (Round(cm*Screen.PixelsPerInch/Inch),0);
          Canvas.LineTo (Round(cm*Screen.PixelsPerInch/Inch),Height);
          Canvas.TextOut(Round(cm*Screen.PixelsPerInch/Inch)+2,0,
                          IntToStr(cm)+'cm');
          Canvas.TextOut(0,10,BandName[FBandType]);
        end;
        if FRuler in [alr_cmH, alr_cmHV] then
        for cm:=1 to Round(Height*Inch/Screen.PixelsPerInch) do
        begin
          Canvas.MoveTo (0,Round(cm*Screen.PixelsPerInch/Inch));
          Canvas.Lineto (Width,Round(cm*Screen.PixelsPerInch/Inch));
          Canvas.TextOut(0,Round(cm*Screen.PixelsPerInch/Inch)+2,
                          IntToStr(cm)+'cm');
        end;
      end; // if (FRuler<>alr_none) then
(*
     if FColumns>1 then
      begin
        Canvas.Pen.Style := psSolid;
        cw := AlPrinter.PhyPageWidth div FColumns;
        for cm:=1 to FColumns do
         begin
           Canvas.MoveTo (cm*cw,0);
           Canvas.LineTo (cm*cw,Height);
         end;
      end;
*)
   end; // if (csDesigning in ComponentState)
end;

///////////////////////////////////////////////////////////////////////////////

{v0.31}
function TAlControl.Designing: boolean;
begin
  Result := true;
end;

procedure TAlControl.SetAutosize(value:boolean);
begin
  if FAutoSize <> Value then
    FAutoSize := Value;
end;

var
  testi:integer = 0;
procedure TAlControl.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_LBUTTONDOWN then begin{ messages}
    testi := 1;
  end;
  inherited;
end;
{/v0.31}

procedure TAlControl.SetParent(AParent:tWinControl);
begin
  if (AParent<>NIL) and NOT (aParent is TAlBand) then
     raise Exception.Create ('This component must be placed on a TAlBand.')
  else
     inherited SetParent(AParent);
end;

function TAlControl.Skip:boolean;
begin
  Result := false;
end;

function TAlControl.GetValue:string;
begin
  Result := Caption;
end;

procedure TAlControl.Print (var aRect:tRect);
begin
  if Visible then
     PrintOut (aRect,value);
end;

function TAlControl.BasicName:string;
begin
  Result := Name;
  while Result[length(Result)]='_' do // build basic name without underline
     Result:= copy(Result,1,length(Result)-1);
end;

///////////////////////////////////////////////////////////////////////////////

constructor TAlLabel.Create (aOwner:tComponent);
begin
  inherited Create (aOwner);
  Autosize    := true;
  Transparent := true;
end;

procedure tAlLabel.AdjustPrintRect(Var aRect:tRect);
const
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
{  DC    : HDC;}
  X     : Integer;
  cRect : tRect;
begin
  if Autosize then
   begin
     cRect := Rect(0,0,aRect.Right-aRect.Left,aRect.Bottom-aRect.Top);
     // DC := GetDC(0);
     // Canvas.Handle := DC;
     // NOW Print instead of Draw
     DoPrintText(cRect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[WordWrap]);
     // Canvas.Handle := 0;
     // ReleaseDC(0, DC);
     X := aRect.Left;
     if Alignment = taRightJustify then Inc(X, (aRect.Right-aRect.Left) - cRect.Right);
     // SetBounds(X, Top, aRect.Right, aRect.Bottom);
     aRect.Left   := X;
     aRect.Right  := X + cRect.Right;
     aRect.Bottom := aRect.Top + cRect.Bottom;
   end;
end;

procedure tAlLabel.DoPrintText(var Rect:TRect; Flags: Word);
var
   Text : string;
begin
   Text := value;
   if (Flags and DT_CALCRECT <> 0) and (Text = '') then
      Text := Text + ' ';
   Flags := Flags or DT_NOPREFIX;
   AlPrinter.Canvas.Font := Self.Font;
   DrawText(AlPrinter.Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
end;

procedure tAlLabel.PrintOut (var aRect:tRect; const s:string);
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
begin
  if NOT Transparent then
   begin
     AlPrinter.Canvas.Brush.Color := Self.Color;
     AlPrinter.Canvas.Brush.Style := bsSolid;
     AlPrinter.Canvas.FillRect (aRect);
   end;
  AlPrinter.Canvas.Brush.Style := bsClear;
  DoPrintText(aRect, DT_EXPANDTABS or WordWraps[WordWrap] or
                   Alignments[Alignment]);
end;

procedure TAlLabel.Print (var aRect:tRect);
begin
  if Visible then
     PrintOut (aRect,Value);
end;

///////////////////////////////////////////////////////////////////////////////

constructor TAlField.Create (aOwner:tComponent);
begin
  inherited Create (aOwner);  // inherits from tAlLabel
  {v0.31} {/v0.31 if  csDesigning in ComponentState then
    FValues := NIL
  else}
   begin
     FValues := TStringList.Create;
     FValues.Duplicates := dupAccept;
     dIndex := 0;
   end;
end;

destructor TAlField.Destroy;
begin
  FValues.Free;
  inherited Destroy;
end;

procedure tAlField.ResetData;
begin
  dIndex := 0;
end;

procedure tAlField.ClearData;
begin
  FValues.Clear;
  dIndex := 0;
end;

function tAlField.Skip:boolean;
begin
  Result := false;
  if FValues.Count>1 then
   begin
     if dIndex<FValues.Count then
        inc (dIndex);
     Result := dIndex<FValues.Count;
   end;
end;

function TAlField.GetValue:string;
var
  c : tComponent;
begin
  if FValues.Count = 0 then
  begin
    if bCaptionMode then
      Result := Caption
    else if bDebugMode then
      Result := '['+Uppercase(Name)+']'
    else
      if Name[length(Name)]='_' then
      begin
        c := Owner.FindComponent(BasicName);
        if Assigned(c) then
          if c is tAlField then
            Result := tAlField(c).Value
          else
            Result := NoValue
        else
           Result := NoValue;
      end
      else
        Result := NoValue;
   end
  else if dIndex<FValues.Count then
     Result := FValues.Strings[dIndex]
  else if FValues.Count=1 then
     Result := FValues.Strings[0]
  else
     Result := NoValue;
end;

function TAlField.GetNextValue:string;
var
  c : tComponent;
begin
  if FValues.Count=0 then
   begin
     if Name[length(Name)]='_' then
      begin
        c := Owner.FindComponent(BasicName);
        if Assigned(c) then
           if c is tAlField then
              Result := tAlField(c).NextValue
           else
              Result := Caption
        else
           Result := Caption;
      end
     else
        Result := Caption;
   end
  else if dIndex+1<FValues.Count then
     Result := FValues.Strings[dIndex+1]
  else if FValues.Count=1 then
     Result := FValues.Strings[0]
  else
     Result := NoValue;
end;

///////////////////////////////////////////////////////////////////////////////

constructor TAlSysField.Create (AOwner:tComponent);
begin
   inherited Create (AOwner);
   Autosize    := true;
   Color       := clWhite;
   Transparent := true;

   DataType    := alr_Time;
end;

procedure TAlSysField.Loaded;
begin
  inherited Loaded;
  UpdateCaption;
end;

function TAlSysField.GetValue:string;
begin
   case FSysDataType of
     alr_Time     : Result := TimetoStr(Time);
     alr_Date     : Result := DateToStr(Date);
     alr_DateTime : Result := DateTimeToStr(Now);
     alr_PageNum  : Result := IntToStr(AlPrinter.PageNumber);
     alr_Counter  : Result := IntToStr(1+dIndex);
     alr_Count    : Result := 'E';
     alr_FormName : Result := tForm(Owner).Name;
   end;
end;

function TAlSysField.Skip:boolean;
begin
  Result := false;
  inc (dIndex);
end;

Procedure TAlSysField.SetSysDataType (value:TAlSysDataType);
begin
  // if value<>FSysDataType then
   begin
     FSysDataType := value;
     UpdateCaption;
   end;
end;

procedure TalSysField.UpdateCaption;
begin
  case FSysDataType of   // Caption is hidden, but inherited it's there !!
     alr_Time      : inherited Caption := '#hh:mm:ss#';
     alr_Date      : inherited Caption := '#tt.mm.jjjj#';
     alr_DateTime  : inherited Caption := '#tt.mm.jjjj hh:mm:ss#';
     alr_PageNum   : inherited Caption := '#Page#';
     alr_Counter   : inherited Caption := '#Counter#';
     alr_Count     : inherited Caption := '#Count#';
     alr_FormName  : inherited Caption := '#'+tForm(Owner).Name+'#';
  end;
end;

///////////////////////////////////////////////////////////////////////////////

constructor tAlShape.Create (AOwner:tcomponent);
begin
  inherited Create (AOwner);
  Caption := '';
  Autosize := false;
  height := 65;
  width  := 65;
  Transparent := TRUE;
  FShape := stRectangle;
  FBrush := tBrush.Create;
  FBrush.OnChange := StyleChanged;
  FPen   := tPen.Create;
  FPen.OnChange := StyleChanged;
end;

destructor tAlShape.Destroy;
begin
  FBrush.Free;
  FPen.Free;
  inherited destroy;
end;

procedure tAlShape.StyleChanged(Sender:tObject);
begin
  Refresh;
end;

procedure tAlShape.SetBrush (value:tBrush);
begin
  FBrush.Assign (value);
end;

procedure tAlShape.SetPen (value:tPen);
begin
  FPen.Assign (value);
end;

procedure tAlShape.SetShape (value:tShapeType);
begin
  if FShape<>value then
   begin
     FShape := value;
     Refresh;
   end;
end;

procedure tAlShape.PrintOut (var ARect: TRect; const dummy:string);
var
  ax, ay, aw, ah, s: Longint;
begin
  {v0.11}
  ax := 0;
  ay := 0;
  {/v0.11}

  with AlPrinter.Canvas do
  begin
    Pen.Assign (FPen);
    if Pen.Width < 1 then
      Pen.Width := 1;
    Brush.Assign (FBrush);
    aw := aRect.Right-aRect.Left;
    ah := aRect.Bottom-aRect.Top;
    if aw < ah then
      s := aw
    else
      s := ah;

    case FShape of
      stRectangle, stRoundRect, stEllipse :
      begin
        ax := aRect.Left + 0;
        ay := aRect.Top + 0;
      end;

      stSquare, stRoundSquare, stCircle :
      begin
        ax := aRect.Left + (aw - s) div 2;
        ay := aRect.Top + (ah - s) div 2;
        aw := s;
        ah := s;
      end;
    end;
    case FShape of
      stRectangle,
      stSquare : begin
        if (aw<=1) or (ah<=1) then
        begin
          MoveTo (ax,ay);
          if aw<=1 then
            LineTo (ax{+aw},ay+ah)
          else
            LineTo (ax+aw,ay{+ah});
        end else begin
          Rectangle (ax,ay,ax+aw,ay+ah);
        end;
      end;

      stRoundRect,
      stRoundSquare: RoundRect (ax,ay,ax+aw,ay+ah,s div 4, s div 4);

      stEllipse,
      stCircle: Ellipse (ax, ay, ax+aw, ay+ah);
    end;
  end; // with AlPrinter.Canvas do
end;

procedure tAlShape.Paint;
var
   x,y,w,h,s : integer;
begin
  {v0.11}
  x := 0;
  y := 0;
  {/v0.11}
  with Canvas do
   begin
     Pen := FPen;
     Brush := FBrush;
     w := width;
     h := height;
     if w<h then s := w else s := h;
     case FShape of
       stRectangle, stRoundRect, stEllipse :
        begin
          x := 0;
          y := 0;
        end;
       stSquare, stRoundSquare, stCircle :
        begin
          x := (w-s) div 2;
          y := (h-s) div 2;
          w := s;
          h := s;
        end;
     end;
     case FShape of
        stRectangle,
        stSquare      : if (w<=1) or (h<=1) then
                         begin
                           MoveTo (x,y);
                           if w<=1 then LineTo (x{+w},y+h)
                                   else LineTo (x+w,y{+h});
                         end
                        else
                           Rectangle (x,y,x+w,y+h);
        stRoundRect,
        stRoundSquare : RoundRect (x,y,x+w,y+h,s div 4, s div 4);
        stEllipse,
        stCircle      : Ellipse (x,y,x+W,y+h);
     end;
   end;
end;

///////////////////////////////////////////////////////////////////////////////

constructor tAlImage.Create (AOwner:tComponent);
begin
  inherited Create (AOwner);
  inherited Autosize := false;
  FStretch  := true;
  FCenter   := true;
  height    := 100;
  width     := 100;

  FPicture  := tPicture.Create;
  aPen := tPen.Create;    { used when no picture is loaded }
  aPen.Color := clBlack;
  aPen.Style := psDashDot;
end;

destructor tAlImage.Destroy;
begin
  aPen.Free;
  FPicture.Free;
  inherited destroy;
end;

procedure tAlImage.WMSize (var Message: TWMSize);
begin
end;

procedure tAlImage.PicChanged (Sender:tObject);
begin
  if csLoading in ComponentState then
  { do not draw image }
  else begin
    if Autosize then
    begin
      width  := Picture.Width;
      height := Picture.height;
    end;
    Invalidate;
  end;
end;

procedure tAlImage.Paint;
var
  x, y : integer;
begin
  if FPicture.Graphic is tBitmap or (FPicture.Graphic is TMetaFile) then
  begin
    if FStretch then
      Canvas.StretchDraw (Rect(0,0,width,height),FPicture.Graphic)
    else if FCenter then begin
      x := (width-FPicture.width) div 2;
      y := (height-FPicture.height) div 2;
      Canvas.Draw (x, y, FPicture.Graphic);
    end else
      Canvas.Draw (0,0,FPicture.Graphic);
  end else with Canvas do begin
    Pen.Assign(aPen);
    Rectangle (0,0,width,height);
  end;
end;

procedure tAlImage.PrintOut (var aRect:tRect; const dummy:string);
var
  ax,ay : integer;
  aBitmap : tBitmap;
begin
  if (FPicture.Graphic is tBitmap) or (FPicture.Graphic is TMetaFile) then
   begin
     if FStretch then
        AlPrinter.Canvas.StretchDraw (aRect, FPicture.Graphic)
     else
      begin
        if FCenter then
         begin
           ax := (Width-FPicture.Width) div 2;
           ay := (Height-FPicture.Height) div 2;
         end
        else
         begin
           ax := 0;
           ay := 0;
         end;
        aBitmap := tBitmap.Create;
        aBitmap.Height := Height;
        aBitmap.Width  := Width;
        aBitmap.Canvas.Draw (ax,ay,FPicture.Graphic);
        AlPrinter.Canvas.StretchDraw (aRect,aBitmap);
        aBitmap.Free;
      end;
   end
  else begin
     AlPrinter.Canvas.Pen.Assign(aPen);
     AlPrinter.Canvas.Rectangle (aRect.Left,aRect.Top,
                    aRect.Right-aRect.Left,aRect.Bottom-aRect.Top);
   end;
end;

procedure tAlImage.SetCenter(value:boolean);
begin
  if value<>FCenter then
   begin
     FCenter := value;
     Invalidate;
   end;
end;

procedure tAlImage.SetStretch(value:boolean);
begin
  if value<>FStretch then
   begin
     FStretch := value;
     Invalidate;
   end;
end;

procedure tAlImage.SetAutosize(value:boolean);
begin
  if value<>Autosize then
   begin
     inherited SetAutoSize(value);
     if value then
      begin
        width := Picture.Width;
        height := Picture.height;
      end;
     Invalidate;
   end;
end;

procedure tAlImage.SetPicture(value:tPicture);
begin
  FPicture.Assign(value);
  if Autosize then
   begin
     width := Picture.Width;
     height := Picture.height;
   end;
  Invalidate;
end;

///////////////////////////////////////////////////////////////////////////////

function FindReport (aForm:tForm):TAlReport;
var
  i : integer;
begin
  Result := NIL;
  for i:=0 to aForm.ComponentCount-1 do
     if aForm.Components[i] is TAlReport then
        Result := aForm.Components[i] as TAlReport;
end;

function LoadReport (const aFileName:string;
                     VAR aReport:TAlReport; VAR aForm:tForm):boolean;
{v0.64}
var
  f, r: TFileStream;
  s: string[6];{object}
  fn: string;
{/v0.64}
begin
  Result := false;
  if FileExists (aFileName) then
   begin
     try
       aForm   := tForm.Create (Application);
       {v0.64}
       f := TFileStream.Create(AFileName, fmOpenRead);
       try
         f.ReadBuffer(s[1], 6);
         SetLength(s, 6);
         f.Position := 0;
         if s = 'object' then begin
           fn := GetTempFileName;
           r := TFileStream.Create(fn, fmCreate);
           try
             ObjectTextToResource(f, r);
           finally
             r.Free;
           end;
         end else
           fn := AFileName;
       finally
         f.Free;
       end;
       aForm := ReadComponentResFile (fn, aForm) as tForm;
       if s = 'object' then
         DeleteFile(PChar(fn));
       {/v0.64
       aForm   := ReadComponentResFile (aFileName,aForm) as tForm;}
       aReport := FindReport (aForm);
       Result := Assigned(aReport);
     except
       on E:Exception do
        begin
          aForm.Free;
          MessageDlg (e.message,mtError,[mbOK],0);
        end;
     end; // try
   end; // if FileExists
end;

procedure Register;
begin
  RegisterComponents('AlRep', [
    TALREPORT,TALBAND,TALFIELD,TALLABEL,
    TALSYSFIELD,TALSHAPE,TALIMAGE,TALDETAILLINK
  ]);
end;

Initialization
  FAlPrinter := NIL;
  NoValue := '~';
{  RegisterClasses ([
    TAlReport, TAlBand, TAlField, TAlLabel,
    TAlSysField, TAlShape, TAlImage, TAlDetailLink
  ]);}
  RegisterClasses ([
    TALREPORT, TALBAND, TALFIELD, TALLABEL,
    TALSYSFIELD, TALSHAPE, TALIMAGE, TALDETAILLINK
  ]);
finalization
  if Assigned(FAlPrinter) then
     FAlPrinter.Free;
end.
