{

   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit Ufrmprint;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, GmTypes, GmClasses, GmPropertyComboBox,
  ExtCtrls, GmPageNavigator, GmCanvas, GmPageList, GmPreview, GmConst, 
  GR32, GR32_Transforms, Spin, GR32_Resamplers;

type
  Tfrmprint = class(TForm)
    GmPreview1: TGmPreview;
    GmPageNavigator1: TGmPageNavigator;
    Panel1: TPanel;
    Timer1: TTimer;
    PrintDialog1: TPrintDialog;
    GroupBox1: TGroupBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox1: TCheckBox;
    Edit1: TEdit;
    Button1: TButton;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn3: TBitBtn;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure GmPreview1PageMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
    procedure GmPreview1PageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: TGmValue);
    procedure BitBtn2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure drawbitmap(sourcebmp:tbitmap32);
    procedure resize(src_bitmap,dst:tbitmap32;w,h:integer);
  public
    { Public declarations }
    srcbmp:tbitmap32;
  end;

var
  frmprint:Tfrmprint;

implementation
uses Printers, Uconfig;
{$R *.dfm}

procedure Tfrmprint.FormCreate(Sender: TObject);
begin
  GmPreview1.Align:=alclient;
  GmPreview1.Orientation:=gmPortrait;
//  srcbmp:=tbitmap32.Create;

  self.CheckBox1.Checked:=config.c_print_title;
  self.CheckBox2.Checked:=config.c_print_fitpage;
  self.CheckBox3.Checked:=config.c_print_center;

  if config.c_print_width=0 then begin

  end else begin
    self.Position:=poDesigned;
    self.Left:=config.c_print_left;
    self.Top:=config.c_print_top;
    self.Width:=config.c_print_width;
    self.Height:=config.c_print_height;
    if config.c_print_max then
      self.WindowState:=wsMaximized;
  end;
end;

procedure Tfrmprint.resize(src_bitmap,dst:tbitmap32;w,h:integer);
Var
  RectS: TRect;
  RectD: TRect;
  DstClipW,DstClipH:Trect;
  resampler:TCustomResampler;
Begin
  RectS.Top := 0;
  RectS.Left := 0;
  RectS.Right := src_bitmap.Width;
  RectS.Bottom := src_bitmap.Height;
  RectD.Top := 0;
  RectD.Left := 0;
  RectD.Right := w;
  RectD.Bottom := h;

  Dst.Clear(clGray32);
  Dst.Width:=w;
  Dst.Height:=h;

  resampler:=TKernelResampler.Create;
  (resampler as TKernelResampler).Kernel := TLanczosKernel.Create;
  try
    StretchTransfer(Dst, RectD, RectD, src_bitmap, RectS, resampler, dmCustom, nil);
  finally
    resampler.Free;
  end;
end;

procedure Tfrmprint.drawbitmap(sourcebmp:tbitmap32);
var
  bmp2:tbitmap;
  size:TGmSize;
  dst,src:trect;
  w,h,h1,h2,x,y:integer;
  s:string;
  bmp3:tbitmap32;
  diff:integer;
begin
Screen.Cursor:=crHourGlass;
bmp2:=tbitmap.Create;
bmp3:=nil;
try
  GmPreview1.Clear;

  size:=GmPreview1.GetPageSize(gmPixels);

  diff:=0;
  if self.CheckBox1.Checked then begin
    GmPreview1.Canvas.Font.Size:=12;
    h2:=20+GmPreview1.Canvas.TextHeight('gh').AsPixels[SCREEN_PPI];
  end else
    h2:=0;

  if (SpinEdit1.Value=100) and (self.CheckBox2.Checked) then begin
    bmp3:=tbitmap32.Create;
    if sourcebmp.Width>(size.Width-diff) then
      w:=round(size.Width-diff)
    else
      w:=sourcebmp.Width;
    h:=(w*sourcebmp.Height) div sourcebmp.Width;
    if h>(size.Height-h2-diff) then begin
      h:=round(size.Height-h2-diff);
      w:=(h*sourcebmp.Width) div sourcebmp.Height;
    end;

    resize(sourcebmp,bmp3,w,h);
    sourcebmp:=bmp3;

  end else if (SpinEdit1.Value<>100) then begin
    bmp3:=tbitmap32.Create;
    w:=round(sourcebmp.Width*(SpinEdit1.Value / 100));
    h:=(w*sourcebmp.Height) div sourcebmp.Width;

    resize(sourcebmp,bmp3,w,h);
    sourcebmp:=bmp3;

  end;

  h1:=0;
  while true do begin
    w:=sourcebmp.Width;
    h:=round(size.Height)-h2;

    src:=rect(0,h1,w,h+h1);
    if src.Bottom>sourcebmp.Height then src.Bottom:=sourcebmp.Height;
    dst:=rect(0,h2,w,h2+src.Bottom-src.Top);
    if self.CheckBox3.Checked then
      dst.Left:=round((size.Width / 2)-(sourcebmp.Width div 2))
    else
      dst.Left:=diff div 2;
    dst.Right:=dst.Left+w;

    bmp2.Width:=dst.Right-dst.Left;
    bmp2.Height:=dst.Bottom-dst.Top;
    bmp2.Canvas.Brush.Color:=clwhite;
    bmp2.Canvas.FillRect(rect(0,0,bmp2.Width,bmp2.Height));

    bmp2.Canvas.CopyRect(rect(0,0,bmp2.Width,bmp2.Height),
      sourcebmp.Canvas,src);

    GmPreview1.Canvas.Draw(dst.Left,dst.Top,bmp2,1,gmPixels);

    h1:=h1+h;
    if h1<sourcebmp.Height then begin
      GmPreview1.NewPage;
    end else
      break;
    h2:=0;
  end;

  GmPreview1.FirstPage;
  if self.CheckBox1.Checked then begin
    s:=edit1.Text;
    if self.CheckBox3.Checked then begin
      x:=round((size.Width / 2)-
        (GmPreview1.Canvas.TextWidth(s).AsPixels[SCREEN_PPI] / 2));
    end else begin
      x:=diff div 2;
    end;
    y:=10;
    GmPreview1.Canvas.TextOut(x,y,s,gmPixels);
  end;

  GmPreview1.Update;
finally
  bmp2.Free;
  if assigned(bmp3) then
    bmp3.Free;
  Screen.Cursor:=crdefault;    
end;
end;

procedure Tfrmprint.Timer1Timer(Sender: TObject);
begin
  timer1.Enabled:=false;
  drawbitmap(srcbmp);
//  GmPreview1.FitWidth;
  GmPreview1.Zoom:=config.c_print_zoom;
end;

procedure Tfrmprint.FormShow(Sender: TObject);
begin
  timer1.Enabled:=true;
end;

procedure Tfrmprint.FormDestroy(Sender: TObject);
begin
//  srcbmp.Free;
  config.c_print_zoom:=GmPreview1.Zoom;
  config.c_print_title:=self.CheckBox1.Checked;
  config.c_print_fitpage:=self.CheckBox2.Checked;
  config.c_print_center:=self.CheckBox3.Checked;

  if WindowState=wsNormal then begin
    config.c_print_left:=self.Left;
    config.c_print_top:=self.Top;
    config.c_print_width:=self.Width;
    config.c_print_height:=self.Height;
    config.c_print_max:=false;
  end else if WindowState=wsMaximized then
    config.c_print_max:=true;
end;

procedure Tfrmprint.BitBtn1Click(Sender: TObject);
begin
  GmPreview1.Print;
end;

procedure Tfrmprint.GmPreview1PageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
begin
  GmPreview1.StartPanning;
end;

procedure Tfrmprint.GmPreview1PageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue);
begin
  GmPreview1.StopPanning;
end;

procedure Tfrmprint.BitBtn2Click(Sender: TObject);
begin
  if GmPreview1.Orientation=gmPortrait then
    Printer.Orientation:=poPortrait
  else
    Printer.Orientation:=poLandscape;
  if PrintDialog1.Execute then begin
    if Printer.Orientation=poPortrait then
      GmPreview1.Orientation:=gmPortrait
    else
      GmPreview1.Orientation:=gmLandscape;
    drawbitmap(srcbmp);
  end;
end;

procedure Tfrmprint.Button1Click(Sender: TObject);
begin
  drawbitmap(srcbmp);
end;

end.
