fpvviewer: Starts adding print support

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2791 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/fpvviewer/fpvv_mainform.lfm

@@ -82,7 +82,7 @@ object frmFPVViewer: TfrmFPVViewer
     TabOrder = 1
     object editFileName: TFileNameEdit
       Left = 8
-      Height = 22
+      Height = 23
       Top = 8
       Width = 304
       DialogOptions = []
@@ -104,7 +104,7 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object spinScale: TFloatSpinEdit
       Left = 72
-      Height = 16
+      Height = 23
       Top = 97
       Width = 168
       DecimalPlaces = 6
@@ -117,9 +117,9 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object Label1: TLabel
       Left = 8
-      Height = 16
+      Height = 15
       Top = 97
-      Width = 55
+      Width = 46
       Caption = 'Scale by:'
       ParentColor = False
     end
@@ -161,15 +161,15 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object Label2: TLabel
       Left = 8
-      Height = 16
+      Height = 15
       Top = 72
-      Width = 88
+      Width = 73
       Caption = 'Y adjustment:'
       ParentColor = False
     end
     object spinAdjustY: TSpinEdit
       Left = 80
-      Height = 16
+      Height = 23
       Top = 72
       Width = 72
       Increment = 100
@@ -180,7 +180,7 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object spinAdjustX: TSpinEdit
       Left = 232
-      Height = 16
+      Height = 23
       Top = 72
       Width = 72
       Increment = 50
@@ -191,9 +191,9 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object Label3: TLabel
       Left = 160
-      Height = 16
+      Height = 15
       Top = 72
-      Width = 88
+      Width = 73
       Caption = 'X adjustment:'
       ParentColor = False
     end
@@ -208,18 +208,18 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object Label4: TLabel
       Left = 9
-      Height = 16
+      Height = 15
       Top = 126
-      Width = 153
+      Width = 128
       Caption = 'Force encoding on read:'
       ParentColor = False
     end
     object comboEncoding: TComboBox
       Left = 144
-      Height = 20
+      Height = 23
       Top = 126
       Width = 128
-      ItemHeight = 0
+      ItemHeight = 15
       ItemIndex = 0
       Items.Strings = (
         'Read from the file'
@@ -255,17 +255,17 @@ object frmFPVViewer: TfrmFPVViewer
     end
     object labelFileEncoding: TLabel
       Left = 278
-      Height = 16
+      Height = 15
       Top = 130
-      Width = 88
+      Width = 74
       Caption = 'File encoding:'
       ParentColor = False
     end
     object checkForceWhiteBackground: TCheckBox
       Left = 9
-      Height = 18
+      Height = 19
       Top = 152
-      Width = 178
+      Width = 153
       Caption = 'Force white background?'
       TabOrder = 11
     end
@@ -278,5 +278,23 @@ object frmFPVViewer: TfrmFPVViewer
       OnClick = buttonViewDebugInfoClick
       TabOrder = 12
     end
+    object buttonPrint: TButton
+      Left = 416
+      Height = 25
+      Top = 8
+      Width = 59
+      Caption = 'Print'
+      OnClick = buttonPrintClick
+      TabOrder = 13
+    end
+    object buttonAdjust: TButton
+      Left = 344
+      Height = 25
+      Top = 8
+      Width = 56
+      Caption = 'Adjust'
+      OnClick = buttonAdjustClick
+      TabOrder = 14
+    end
   end
 end

applications/fpvviewer/fpvv_mainform.pas

@@ -7,7 +7,10 @@ interface
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn,
   StdCtrls, Spin, ExtCtrls, ComCtrls, Grids, ColorBox, Math,
-  fpvv_drawer, fpimage, fpcanvas, coreconrec, fpvutils;
+  Printers, PrintersDlgs, LCLIntf, LCLType,
+  fpvv_drawer, fpimage, fpcanvas, coreconrec, fpvutils,
+  fpvectorial, lasvectorialreader, svgvectorialwriter,
+  dxfvectorialreader, epsvectorialreader, fpvtocanvas, dxftokentotree;
 
 type
 
@@ -20,6 +23,8 @@ type
     btnVisualize: TButton;
     Button1: TButton;
     Button2: TButton;
+    buttonPrint: TButton;
+    buttonAdjust: TButton;
     buttonViewDebugInfo: TButton;
     buttonRenderingTest: TButton;
     checkForceWhiteBackground: TCheckBox;
@@ -47,6 +52,8 @@ type
     procedure btnViewDXFTokensClick(Sender: TObject);
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
+    procedure buttonAdjustClick(Sender: TObject);
+    procedure buttonPrintClick(Sender: TObject);
     procedure buttonRenderingTestClick(Sender: TObject);
     procedure buttonViewDebugInfoClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -55,6 +62,7 @@ type
     procedure spinAdjustYChange(Sender: TObject);
     procedure spinScaleChange(Sender: TObject);
   private
+    FVec: TvVectorialDocument;
     procedure MyContourLineDrawingProc(z,x1,y1,x2,y2: Double);
     function FPVDebugAddItemProc(AStr: string; AParent: Pointer): Pointer;
     procedure HandleDrawerMouseWheel(Sender: TObject; Shift: TShiftState;
@@ -62,6 +70,11 @@ type
     procedure HandleDrawerPosChanged(Sender: TObject);
     procedure HandleDrawerRedraw(Sender: TObject);
     procedure ViewerDebugOutCallback(AStr: string);
+    //
+    procedure Render_PrepareFile();
+    procedure Render_DoRender(ACanvasSizeX, ACanvasSizeY,
+      ADrawerPosX, ADrawerPosY: Integer; AScale: Double);
+    procedure Render_FreeFile();
   public
     { public declarations }
     Drawer: TFPVVDrawer;
@@ -72,12 +85,6 @@ var
 
 implementation
 
-uses
-  fpvectorial, lasvectorialreader, svgvectorialwriter,
-  dxfvectorialreader, epsvectorialreader,
-  fpvtocanvas,
-  dxftokentotree;
-
 {$R *.lfm}
 
 { TfrmFPVViewer }
@@ -320,6 +327,72 @@ begin
   end;
 end;
 
+procedure TfrmFPVViewer.buttonAdjustClick(Sender: TObject);
+const
+  FPVVIEWER_MAX_IMAGE_SIZE = 1000;
+  FPVVIEWER_MIN_IMAGE_SIZE = 100;
+  FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS = 100;
+var
+  CanvasSize: TPoint;
+begin
+  Render_PrepareFile();
+  try
+    // We need to be robust, because sometimes the document size won't be given
+    // also give up drawing everything if we need more then 4MB of RAM for the image
+    // and also give some space in the image to allow for negative coordinates
+    if FVec.Width * spinScale.Value > FPVVIEWER_MAX_IMAGE_SIZE then CanvasSize.X := FPVVIEWER_MAX_IMAGE_SIZE
+    else if FVec.Width < FPVVIEWER_MIN_IMAGE_SIZE then CanvasSize.X := Drawer.Width
+    else CanvasSize.X := Round(FVec.Width * spinScale.Value);
+    if CanvasSize.X < Drawer.Width then CanvasSize.X := Drawer.Width;
+
+    if FVec.Height * spinScale.Value > FPVVIEWER_MAX_IMAGE_SIZE then CanvasSize.Y := FPVVIEWER_MAX_IMAGE_SIZE
+    else  if FVec.Height < FPVVIEWER_MIN_IMAGE_SIZE then CanvasSize.Y := Drawer.Height
+    else CanvasSize.Y := Round(FVec.Height * spinScale.Value);
+    if CanvasSize.Y < Drawer.Height then CanvasSize.Y := Drawer.Height;
+
+    Render_DoRender(Drawer.Width, Drawer.Height, 4, 4, FVec.Width / Drawer.Width);
+  finally
+    Render_FreeFile();
+  end;
+end;
+
+procedure TfrmFPVViewer.buttonPrintClick(Sender: TObject);
+var
+  printDialog: TPrintDialog;
+  ScaleX, ScaleY: Double;
+  lRectSrc, lRectDest: TRect;
+begin
+  // Create a printer selection dialog
+  printDialog := TPrintDialog.Create(Self);
+
+  // Set up print dialog options
+  printDialog.Options := [];
+
+  // if the user has selected a printer (or default), then print!
+  if printDialog.Execute then
+  begin
+    // Generate the image
+    btnVisualizeClick(Sender);
+
+    // Start printing
+    Printer.BeginDoc;
+
+    // Draw the image
+    ScaleX := LCLIntf.GetDeviceCaps(Handle, logPixelsX) / PixelsPerInch; // Don't know why, but GetDeviceCaps is returning zero...
+    ScaleY := LCLIntf.GetDeviceCaps(Handle, logPixelsY) / PixelsPerInch;
+    lRectSrc := Bounds(0, 0, Drawer.Drawing.Width, Drawer.Drawing.Height);
+    lRectDest := Bounds(0, 0, Printer.PageWidth, Printer.PageHeight);
+    Printer.Canvas.StretchDraw(
+      lRectDest,
+      Drawer.Drawing);
+
+    // Finish printing
+    Printer.EndDoc;
+  end;
+
+  printDialog.Free;
+end;
+
 procedure TfrmFPVViewer.buttonRenderingTestClick(Sender: TObject);
 var
   VecDoc: TvVectorialDocument;
@@ -448,5 +521,55 @@ begin
   memoDebug.Lines.Add(AStr);
 end;
 
+procedure TfrmFPVViewer.Render_PrepareFile;
+begin
+  // First check the in input
+  if editFileName.FileName = '' then Exit; // silent exit in this simple case
+  //if not CheckInput() then Exit;
+
+  notebook.PageIndex := 0;
+
+  FVec := TvVectorialDocument.Create;
+
+  // If we desire, force a encoding for the read operation
+  if comboEncoding.ItemIndex > 0 then
+    FVec.ForcedEncodingOnRead := comboEncoding.Text
+  else FVec.ForcedEncodingOnRead := '';
+
+  FVec.ReadFromFile(editFileName.FileName);
+end;
+
+procedure TfrmFPVViewer.Render_DoRender(ACanvasSizeX, ACanvasSizeY,
+  ADrawerPosX, ADrawerPosY: Integer; AScale: Double);
+const
+  FPVVIEWER_MAX_IMAGE_SIZE = 1000;
+  FPVVIEWER_MIN_IMAGE_SIZE = 100;
+  FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS = 100;
+begin
+  // Show document properties
+  labelFileEncoding.Caption := 'File encoding: ' + FVec.Encoding;
+
+  Drawer.Drawing.Width := ACanvasSizeX;
+  Drawer.Drawing.Height := ACanvasSizeY;
+  Drawer.Drawing.Canvas.Brush.Color := clWhite;
+  Drawer.Drawing.Canvas.Brush.Style := bsSolid;
+  Drawer.Drawing.Canvas.FillRect(0, 0, Drawer.Drawing.Width, Drawer.Drawing.Height);
+  if checkForceWhiteBackground.Checked then FVec.GetPageAsVectorial(0).BackgroundColor := colWhite;
+  if not checkForceWhiteBackground.Checked then
+    FVec.GetPageAsVectorial(0).DrawBackground(Drawer.Drawing.Canvas);
+  FVec.GetPageAsVectorial(0).Render(
+    Drawer.Drawing.Canvas,
+    FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS + ADrawerPosX,
+    Drawer.Drawing.Height - FPVVIEWER_SPACE_FOR_NEGATIVE_COORDS + ADrawerPosY,
+    spinScale.Value,
+    -1 * spinScale.Value);
+  Drawer.Invalidate;
+end;
+
+procedure TfrmFPVViewer.Render_FreeFile;
+begin
+  FVec.Free;
+end;
+
 end.
 

applications/fpvviewer/fpvviewer.lpi

@@ -61,11 +61,9 @@
             </CompilerMessages>
             <CompilerPath Value="$(CompPath)"/>
           </Other>
+          <LCLWidgetType Value="qt"/>
         </CompilerOptions>
       </Item3>
-      <SharedMatrixOptions Count="1">
-        <Item1 ID="194024408686" Modes="qt" Type="IDEMacro" MacroName="LCLWidgetType" Value="qt"/>
-      </SharedMatrixOptions>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
@@ -77,17 +75,20 @@
         <FormatVersion Value="1"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="3">
+    <RequiredPackages Count="4">
       <Item1>
-        <PackageName Value="fpvectorialpkg"/>
+        <PackageName Value="Printer4Lazarus"/>
       </Item1>
       <Item2>
-        <PackageName Value="LCLBase"/>
+        <PackageName Value="fpvectorialpkg"/>
-        <MinVersion Major="1" Release="1" Valid="True"/>
       </Item2>
       <Item3>
-        <PackageName Value="LCL"/>
+        <PackageName Value="LCLBase"/>
+        <MinVersion Major="1" Release="1" Valid="True"/>
       </Item3>
+      <Item4>
+        <PackageName Value="LCL"/>
+      </Item4>
     </RequiredPackages>
     <Units Count="5">
       <Unit0>

applications/fpvviewer/fpvviewer.lpr

@@ -7,7 +7,8 @@ uses
   cthreads,
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, fpvv_mainform, dxftokentotree, fpvv_drawer, fpvectorialpkg, CoreConRec;
+  Forms, fpvv_mainform, dxftokentotree, fpvv_drawer, fpvectorialpkg,
+  printer4lazarus, CoreConRec;
 
 {$R *.res}