fpvectorial: Minor improvements of wmf demo program

git-svn-id: trunk@52798 -

components/fpvectorial/examples/wmf_mainform.lfm

@@ -54,6 +54,7 @@ object Form1: TForm1
       HideSelection = False
       Images = ImageList
       TabOrder = 2
+      OnExpanded = ShellTreeViewExpanded
       OnGetImageIndex = ShellTreeViewGetImageIndex
       OnGetSelectedIndex = ShellTreeViewGetSelectedIndex
       Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
@@ -67,28 +68,79 @@ object Form1: TForm1
     Top = 0
     Width = 5
   end
-  object ScrollBox1: TScrollBox
+  object ImagePanel: TPanel
     Left = 272
     Height = 511
     Top = 0
     Width = 466
-    HorzScrollBar.Increment = 27
-    HorzScrollBar.Page = 272
-    HorzScrollBar.Smooth = True
-    HorzScrollBar.Tracking = True
-    VertScrollBar.Increment = 18
-    VertScrollBar.Page = 183
-    VertScrollBar.Smooth = True
-    VertScrollBar.Tracking = True
     Align = alClient
-    ClientHeight = 507
-    ClientWidth = 462
+    Caption = 'ImagePanel'
+    ClientHeight = 511
+    ClientWidth = 466
     TabOrder = 2
-    object Image1: TImage
-      Left = 0
-      Height = 183
-      Top = 0
-      Width = 272
+    object ScrollBox1: TScrollBox
+      Left = 1
+      Height = 455
+      Top = 1
+      Width = 464
+      HorzScrollBar.Increment = 27
+      HorzScrollBar.Page = 272
+      HorzScrollBar.Smooth = True
+      HorzScrollBar.Tracking = True
+      VertScrollBar.Increment = 18
+      VertScrollBar.Page = 183
+      VertScrollBar.Smooth = True
+      VertScrollBar.Tracking = True
+      Align = alClient
+      ClientHeight = 451
+      ClientWidth = 460
+      TabOrder = 0
+      OnResize = ScrollBox1Resize
+      object Image1: TImage
+        Left = 0
+        Height = 183
+        Top = 0
+        Width = 272
+      end
+    end
+    object Panel1: TPanel
+      Left = 1
+      Height = 54
+      Top = 456
+      Width = 464
+      Align = alBottom
+      BevelOuter = bvNone
+      ClientHeight = 54
+      ClientWidth = 464
+      TabOrder = 1
+      object RbOrigSize: TRadioButton
+        Left = 10
+        Height = 19
+        Top = 8
+        Width = 164
+        Caption = 'Original size taken from file'
+        Checked = True
+        OnChange = RbOrigSizeChange
+        TabOrder = 1
+        TabStop = True
+      end
+      object RbMaxSize: TRadioButton
+        Left = 240
+        Height = 19
+        Top = 8
+        Width = 117
+        Caption = 'Adapt size to form'
+        OnChange = RbMaxSizeChange
+        TabOrder = 0
+      end
+      object ImageInfo: TLabel
+        Left = 27
+        Height = 15
+        Top = 30
+        Width = 18
+        Caption = '      '
+        ParentColor = False
+      end
     end
   end
   object ImageList: TImageList

components/fpvectorial/examples/wmf_mainform.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ShellCtrls,
-  ExtCtrls, ComCtrls, fpvectorial;
+  ExtCtrls, ComCtrls, StdCtrls, fpvectorial;
 
 type
 
@@ -15,7 +15,12 @@ type
   TForm1 = class(TForm)
     Image1: TImage;
     ImageList: TImageList;
+    ImageInfo: TLabel;
     LeftPanel: TPanel;
+    Panel1: TPanel;
+    ImagePanel: TPanel;
+    RbMaxSize: TRadioButton;
+    RbOrigSize: TRadioButton;
     ScrollBox1: TScrollBox;
     ShellListView: TShellListView;
     ShellTreeView: TShellTreeView;
@@ -23,14 +28,19 @@ type
     Splitter2: TSplitter;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure RbMaxSizeChange(Sender: TObject);
+    procedure RbOrigSizeChange(Sender: TObject);
+    procedure ScrollBox1Resize(Sender: TObject);
     procedure ShellListViewSelectItem(Sender: TObject; Item: TListItem;
       Selected: Boolean);
+    procedure ShellTreeViewExpanded(Sender: TObject; Node: TTreeNode);
     procedure ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
     procedure ShellTreeViewGetSelectedIndex(Sender: TObject; Node: TTreeNode);
   private
     { private declarations }
     FVec: TvVectorialDocument;
     procedure LoadImage(const AFileName: String);
+    procedure PaintImage(APage: TvPage);
     procedure ReadFromIni;
     procedure WriteToIni;
   public
@@ -49,6 +59,7 @@ uses
 
 const
   PROGRAM_NAME = 'wmfViewer';
+  INCH = 25.4;
 
 
 { TForm1 }
@@ -78,52 +89,88 @@ begin
 end;
 
 procedure TForm1.LoadImage(const AFileName: String);
-const
-  INCH = 25.4;
 var
-  bmp: TBitmap;
   page: TvPage;
-  multiplierX, multiplierY: Double;
 begin
-  // For conversion of the mm returned by the wmf reader to screen pixels
-  multiplierX := ScreenInfo.PixelsPerInchX / INCH;
-  multiplierY := ScreenInfo.PixelsPerInchY / INCH;
-
-  // Load the image file into a TvVectorialDocument
   FreeAndNil(FVec);
   try
     FVec := TvVectorialDocument.Create;
+    // Load the image file into a TvVectorialDocument
     FVec.ReadFromFile(AFilename);
+    // Draw the image
+    page := FVec.GetPage(0);
+    PaintImage(page);
+    // Misc
+    Caption := Format('%s - "%s"', [PROGRAM_NAME, AFileName]);
+    // For conversion of the mm returned by the wmf reader to screen pixels
+    ImageInfo.Caption := Format('%.1f mm x %.1f mm', [page.Width, page.Height]);
   except
     on E:Exception do
       MessageDlg(E.Message, mtError, [mbOK], 0);
   end;
+end;
 
-  if FVec = nil then
+procedure TForm1.PaintImage(APage: TvPage);
+var
+  bmp: TBitmap;
+  multiplierX, multiplierY: Double;
+  wimg, himg: Integer;
+begin
+  if APage = nil then
+    exit;
+
+  // For conversion of the mm returned by the wmf reader to screen pixels
+  multiplierX := ScreenInfo.PixelsPerInchX / INCH;
+  multiplierY := ScreenInfo.PixelsPerInchY / INCH;
+
+  // Calc image size
+  wimg := round(APage.Width * multiplierX);   // image size in pixels
+  himg := round(APage.Height * multiplierY);
+  if (wimg = 0) or (himg = 0) then
     exit;
 
   // Create a temporary bitmap onto which the image file will be drawn
   bmp := TBitmap.Create;
   try
-    page := FVec.GetPage(0);
-    bmp.SetSize(
-      round(FVec.Width * multiplierX),    // Convert mm to pixels
-      round(FVec.Height * multiplierY)
-    );
+    if RbMaxSize.Checked then begin
+      if himg/wimg > Scrollbox1.Height / Scrollbox1.Width then
+      begin
+        bmp.Height := Scrollbox1.Height;
+        bmp.Width := round(wimg/himg * bmp.Height);
+        multiplierX := multiplierX * Scrollbox1.Height / himg;
+        multiplierY := multiplierY * Scrollbox1.Height / himg;
+      end else begin
+        bmp.Width := Scrollbox1.Width;
+        bmp.Height := round(himg/wimg * bmp.Width);
+        multiplierX := multiplierX * Scrollbox1.Width / wimg;
+        multiplierY := multiplierY * Scrollbox1.Width / wimg;
+      end;
+    end else
+      bmp.SetSize(wimg, himg);
     bmp.Canvas.Brush.Color := clWindow;
     bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);
-    page.Render(bmp.Canvas, 0, 0, multiplierX, multiplierY);
+    APage.Render(bmp.Canvas, 0, 0, multiplierX, multiplierY);
     // Assign the bitmap to the image's picture.
     Image1.Picture.Assign(bmp);
     Image1.Width := bmp.Width;
     Image1.Height := bmp.Height;
-    // Misc
-    Caption := Format('%s - "%s"', [PROGRAM_NAME, AFileName]);
   finally
     bmp.Free;
   end;
 end;
 
+procedure TForm1.RbMaxSizeChange(Sender: TObject);
+begin
+  if FVec <> nil then
+    PaintImage(FVec.GetPage(0));
+end;
+
+procedure TForm1.RbOrigSizeChange(Sender: TObject);
+begin
+  if FVec <> nil then
+    PaintImage(FVec.GetPage(0));
+end;
+
 procedure TForm1.ShellListViewSelectItem(Sender: TObject; Item: TListItem;
   Selected: Boolean);
 var
@@ -137,6 +184,11 @@ begin
   end;
 end;
 
+procedure TForm1.ShellTreeViewExpanded(Sender: TObject; Node: TTreeNode);
+begin
+  ShellTreeView.AlphaSort;
+end;
+
 procedure TForm1.ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
 begin
   if Node.Level = 0 then
@@ -175,6 +227,12 @@ begin
   end;
 end;
 
+procedure TForm1.ScrollBox1Resize(Sender: TObject);
+begin
+  if FVec <> nil then
+    PaintImage(FVec.GetPage(0));
+end;
+
 procedure TForm1.WriteToIni;
 var
   ini: TCustomIniFile;

components/fpvectorial/wmfvectorialreader.pas

@@ -539,14 +539,6 @@ begin
   ReadHeader(AStream);
   ReadRecords(AStream, AData);
 
-  if FHasPlaceableMetaHeader then begin
-    AData.Width := FPageWidth;
-    AData.Height := FPageHeight;
-  end else begin
-    AData.Width := ScaleSizeX(FWindowExtent.X); //RawExtent.Right - FRawExtent.Left);
-    AData.Height := ScaleSizeY(FWindowExtent.Y); //FRawExtent.Bottom - FRawExtent.Top);
-  end;
-
   if FErrMsg.Count > 0 then
     raise Exception.Create(FErrMsg.Text);
 end;
@@ -914,6 +906,16 @@ begin
     AStream.Position := FRecordStartPos + wmfRec.Size*SizeOf(word);
   end;
 
+  if FHasPlaceableMetaHeader then begin
+    page.Width := FPageWidth;
+    page.Height := FPageHeight;
+  end else begin
+    page.Width := ScaleSizeX(FWindowExtent.X);
+    page.Height := ScaleSizeY(FWindowExtent.Y);
+  end;
+  AData.Width := page.Width;
+  AData.Height := page.Height;
+
   SetLength(params, 0);
 end;