lazarus/components/fpvectorial/examples/wmfviewer/wmf_mainform.pas

unit wmf_mainform;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ShellCtrls,
  ExtCtrls, ComCtrls, StdCtrls, fpvectorial, Types;

type

  { TMainForm }

  TMainForm = class(TForm)
    BtnSaveAsWMF: TButton;
    CbHistory: TComboBox;
    Image1: TImage;
    ImageList: TImageList;
    ImageInfo: TLabel;
    LeftPanel: TPanel;
    Panel1: TPanel;
    ImagePanel: TPanel;
    RbMaxSize: TRadioButton;
    RbOrigSize: TRadioButton;
    ScrollBox1: TScrollBox;
    ShellListView: TShellListView;
    ShellTreeView: TShellTreeView;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    procedure BtnSaveAsWMFClick(Sender: TObject);
    procedure CbHistoryCloseUp(Sender: TObject);
    procedure CbHistoryDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure CbHistoryEditingDone(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    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;
    FFileName: String;
    FFormActivated: Boolean;
    procedure LoadImage(const AFileName: String);
    procedure PaintImage(APage: TvPage);
    procedure ReadIni;
    procedure UpdateHistory(const AFileName: String);
    procedure WriteIni;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

uses
  LCLType, LCLIntf,
  IniFiles, LazFileUtils, FileCtrl, fpvUtils;

const
  PROGRAM_NAME = 'wmfViewer';
  INCH = 25.4;


{ TMainForm }

procedure TMainForm.BtnSaveAsWMFClick(Sender: TObject);
var
  fn: String;
begin
  if ShellListView.Selected = nil then
    exit;
  fn := ShellListview.GetPathFromItem(ShellListview.Selected);
  fn := ChangeFileExt(fn, '') + '-saved.wmf';
  if FileExistsUTF8(fn) then begin
    if MessageDlg(Format('File "%s" already exists. Overwrite?', [fn]),
      mtConfirmation, [mbYes, mbNo], 0) <> mrYes then exit;
    DeleteFileUTF8(fn);
  end;
  FVec.WriteToFile(fn, vfWindowsMetafileWMF);
  ShowMessage(Format('Saved as "%s"', [fn]));
end;

procedure TMainForm.CbHistoryCloseUp(Sender: TObject);
var
  dir: String;
begin
  if CbHistory.ItemIndex = -1 then
    exit;
  dir := CbHistory.Items[CbHistory.ItemIndex];
  ShellTreeView.Path := dir;
end;

procedure TMainForm.CbHistoryDrawItem(Control: TWinControl; Index: Integer;
  ARect: TRect; State: TOwnerDrawState);
var
  s: String;
  combobox: TComboBox;
begin
  combobox := Control as TComboBox;
  s := MinimizeName(combobox.Items[Index], combobox.Canvas, combobox.ClientWidth);
  combobox.Canvas.TextOut(ARect.Left, ARect.Top, s);
end;

procedure TMainForm.CbHistoryEditingDone(Sender: TObject);
begin
  UpdateHistory(AppendPathDelim(CbHistory.Text)+'.');
  ShellTreeView.Path := CbHistory.Text;
  ShellTreeView.MakeSelectionVisible;
end;

procedure TMainForm.FormActivate(Sender: TObject);
var
  fn: string;
begin
  if FFormActivated then
    exit;
  FFormActivated := true;

  if (ParamCount > 0) then
    fn := ExpandfileName(ParamStr(1))
  else
    fn := FFileName;

  if (fn <> '') and FileExists(fn) then
  begin
    ShellTreeView.Path := ExtractFilePath(fn);
    ShellListView.Selected := ShellListView.Items.FindCaption(0, ExtractFileName(fn), false, true, false);
    LoadImage(fn);
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // Set correct dpi for scaling by wmf reader
  ScreenDPIX := ScreenInfo.PixelsPerInchX;
  ScreenDPIY := ScreenInfo.PixelsPerInchY;

  Caption := PROGRAM_NAME;
  {$IFNDEF MSWINDOWS}
  ShellTreeView.Images := ImageList1;
  ShellTreeView.OnGetImageIndex := @ShellTreeViewGetImageIndex;
  ShellTreeView.OnGetSelectedIndex := @ShellTreeViewGetSelectedIndex;
  {$ENDIF}
  ShellListview.Mask := '*.wmf';

  ReadIni;

  if ParamCount > 0 then begin
    ShellTreeview.Path := ExtractFilepath(ParamStr(1));
    ShellTreeview.MakeSelectionVisible;
    LoadImage(ParamStr(1));
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  WriteIni;
  FreeAndNil(FVec);
end;

procedure TMainForm.LoadImage(const AFileName: String);
var
  page: TvPage;
begin
  FreeAndNil(FVec);
  try
    FVec := TvVectorialDocument.Create;
    // Load the image file into a TvVectorialDocument
    FVec.ReadFromFile(AFilename);
    // Draw the image
    FVec.GuessDocumentSize;
    page := FVec.GetPageAsVectorial(0);
    if (page.Width = 0) or (page.Height = 0) then
      page.CalculateDocumentSize;
    PaintImage(page);
    // Misc
    Caption := Format('%s - "%s"', [PROGRAM_NAME, AFileName]);
    ImageInfo.Caption := Format('%.0f x %.0f', [page.Width, page.Height]);
    FFileName := AFileName;
  except
    on E:Exception do
      MessageDlg(E.Message, mtError, [mbOK], 0);
  end;
end;

procedure TMainForm.PaintImage(APage: TvPage);
var
  bmp: TBitmap;
  multiplierX, multiplierY: Double;
  wimg, himg: Integer;
  dx, dy: Integer;
  zoom: Double;
begin
  if APage = nil then
    exit;

  // For conversion of the mm returned by the wmf reader to screen pixels
  multiplierX := 1.0; //ScreenInfo.PixelsPerInchX / INCH;
  multiplierY := 1.0; //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
    if RbMaxSize.Checked then begin
      if himg/wimg > Scrollbox1.ClientHeight / Scrollbox1.ClientWidth then
      begin
        bmp.Height := Scrollbox1.ClientHeight;
        bmp.Width := round(wimg/himg * bmp.Height);
        multiplierX := multiplierX * Scrollbox1.ClientHeight / himg;
        multiplierY := multiplierY * Scrollbox1.ClientHeight / himg;
      end else begin
        bmp.Width := Scrollbox1.ClientWidth;
        bmp.Height := round(himg/wimg * bmp.Width);
        multiplierX := multiplierX * Scrollbox1.ClientWidth / wimg;
        multiplierY := multiplierY * Scrollbox1.ClientWidth / wimg;
      end;
    end else begin
      bmp.SetSize(wimg, himg);
      multiplierX := 1.0;
      multiplierY := 1.0;
    end;

    bmp.Canvas.Brush.Color := clWindow;
    bmp.Canvas.FillRect(0, 0, bmp.Width, bmp.Height);

   // APage.AutoFit(bmp.Canvas, wimg, wimg, wimg, dx, dy, zoom);

    if APage.UseTopLeftCoordinates then
      APage.Render(bmp.Canvas, 0, 0, multiplierX, multiplierY) else
      APage.Render(bmp.Canvas, 0, himg, multiplierX, -multiplierY);

    {
    if APage.UseTopLeftCoordinates then
      APage.Render(bmp.Canvas, dx, dy, zoom, zoom) else
      APage.Render(bmp.Canvas, dx, himg - dy, zoom, -zoom);
      }

    {
    if SameText(ExtractFileExt(FFileName), '.wmf') then
      APage.Render(bmp.Canvas, dx, dy, zoom, zoom) else
      APage.Render(bmp.Canvas, dx, himg - dy, zoom, -zoom);
     }

//    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;
  finally
    bmp.Free;
  end;
end;

procedure TMainForm.RbMaxSizeChange(Sender: TObject);
begin
  if FVec <> nil then
    PaintImage(FVec.GetPageAsVectorial(0));
end;

procedure TMainForm.RbOrigSizeChange(Sender: TObject);
begin
  if FVec <> nil then
    PaintImage(FVec.GetPageAsVectorial(0));
end;

procedure TMainForm.ShellListViewSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  fn: String;
begin
  if Selected then
  begin
    fn := ShellListview.GetPathFromItem(ShellListview.Selected);
    ShellTreeview.MakeSelectionVisible;
    LoadImage(fn);
    UpdateHistory(fn);
  end;
end;

procedure TMainForm.ShellTreeViewExpanded(Sender: TObject; Node: TTreeNode);
begin
  ShellTreeView.AlphaSort;
end;

procedure TMainForm.ShellTreeViewGetImageIndex(Sender: TObject; Node: TTreeNode);
begin
  if Node.Level = 0 then
    Node.ImageIndex := 2 else
    Node.ImageIndex := 0;
end;

procedure TMainForm.ShellTreeViewGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
  Node.SelectedIndex := 1;
end;

procedure TMainForm.ReadIni;
var
  ini: TIniFile;
  L, T, W, H, p: Integer;
  R: TRect;
  List: TStrings;
  i: Integer;
  s: String;
begin
  ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    T := Ini.ReadInteger('Position', 'Top', Top);
    L := Ini.ReadInteger('Position', 'Left', Left);
    W := Ini.ReadInteger('Position', 'Width', Width);
    H := Ini.ReadInteger('Position', 'Height', Height);
    R := Screen.WorkAreaRect;
    if W > R.Width then W := R.Width;
    if H > R.Height then H := R.Height;
    if L < R.Left then L := R.Left;
    if T < R.Top then T := R.Top;
    if L + W > R.Right then L := R.Right - W - GetSystemMetrics(SM_CXSIZEFRAME);
    if T + H > R.Bottom then T := R.Bottom - H - GetSystemMetrics(SM_CYCAPTION) - GetSystemMetrics(SM_CYSIZEFRAME);
    SetBounds(L, T, W, H);
    WindowState := wsNormal;
    Application.ProcessMessages;
    WindowState := TWindowState(ini.ReadInteger('Position', 'WindowState', 0));

    p := ini.ReadInteger('Settings', 'LeftSplitter', LeftPanel.Width);
    if p > ClientWidth then p := ClientWidth div 4;
    LeftPanel.Width := p;
    p := ini.ReadInteger('Settings', 'ShellSplitter', ShellTreeView.Height);
    if p > ClientHeight then p := ClientHeight div 2;
    ShellTreeView.Height := p;

    FFileName := ini.ReadString('Settings', 'Filename', '');

    CbHistory.Items.BeginUpdate;
    List := TStringList.Create;
    try
      ini.ReadSection('History', List);
      CbHistory.Items.Clear;
      for i := 0 to List.Count-1 do
      begin
        s := ini.ReadString('History', Format('Item%d', [i+1]), '');
        if (s <> '') and DirectoryExists(s) then
          CbHistory.Items.Add(s);
      end;
      if CbHistory.Items.Count > 0 then
        CbHistory.ItemIndex := 0;
    finally
      List.Free;
      CbHistory.Items.EndUpdate;
    end;
  finally
    ini.Free;
  end;
end;

(*
procedure TMainForm.ReadFromIni;
var
  ini: TCustomIniFile;
  L, T, W, H: Integer;
  R: TRect;
begin
  ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    L := ini.ReadInteger('MainForm', 'Left', Left);
    T := ini.ReadInteger('MainForm', 'Top', Top);
    W := ini.ReadInteger('MainForm', 'Width', Width);
    H := ini.ReadInteger('MainForm', 'Height', Height);
    R := Screen.DesktopRect;
    if L+W > R.Right then L := R.Right - W;
    if L < R.Left then L := R.Left;
    if T+H > R.Bottom then T := R.Bottom - H;
    if T < R.Top then T := R.Top;
    SetBounds(L, T, W, H);
    ShellTreeView.Height := ini.ReadInteger('MainForm', 'ShellTreeViewHeight', ShellTreeView.Height);
    LeftPanel.Width := ini.ReadInteger('MainForm', 'ShellControlsWidth', LeftPanel.Width);
    ShellTreeview.Path := ini.ReadString('Settings', 'InitialDir', '');
  finally
    ini.Free;
  end;
end;
*)
procedure TMainForm.ScrollBox1Resize(Sender: TObject);
begin
  if FVec <> nil then
    PaintImage(FVec.GetPageAsVectorial(0));
end;

procedure TMainForm.UpdateHistory(const AFileName: String);
var
  dir: String;
  idx: Integer;
begin
  if AFileName = '' then
    exit;
  dir := ExtractFilePath(AFileName);
  idx := CbHistory.Items.IndexOf(dir);
  if idx = -1 then
    CbHistory.Items.Insert(0, dir)
  else
    CbHistory.Items.Move(idx, 0);
  while CbHistory.Items.Count > 10 do
    CbHistory.Items.Delete(CbHistory.Items.Count-1);
  CbHistory.ItemIndex := 0;
end;


procedure TMainForm.WriteIni;
var
  ini: TIniFile;
  i: Integer;
begin
  ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    ini.WriteInteger('Position', 'Top', RestoredTop);
    ini.WriteInteger('Position', 'Left', RestoredLeft);
    ini.WriteInteger('Position', 'Width', RestoredWidth);
    ini.WriteInteger('Position', 'Height', RestoredHeight);
    ini.WriteInteger('Position', 'WindowState', Integer(WindowState));
    ini.WriteInteger('Settings', 'LeftSplitter', LeftPanel.Width);
    ini.WriteInteger('Settings', 'ShellSplitter', ShellTreeView.Height);
    ini.WriteString('Settings', 'FileName', FFileName);
    ini.EraseSection('History');
    for i := 0 to CbHistory.Items.Count-1 do
      ini.WriteString('History', Format('Item%d', [i+1]), CbHistory.Items[i]);
  finally
    ini.Free;
  end;
end;
           {
procedure TMainForm.WriteToIni;
var
  ini: TCustomIniFile;
begin
  ini := TMemIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  try
    if WindowState = wsNormal then begin
      ini.WriteInteger('MainForm', 'Left', Left);
      ini.WriteInteger('MainForm', 'Top', Top);
      ini.WriteInteger('MainForm', 'Width', Width);
      ini.WriteInteger('MainForm', 'Height', Height);
      ini.WriteInteger('MainForm', 'ShellTreeViewHeight', ShellTreeView.Height);
      ini.WriteInteger('MainForm', 'ShellControlsWidth', LeftPanel.Width);
    end;
    ini.WriteString('Settings', 'InitialDir', ShellTreeview.Path);
  finally
    ini.Free;
  end;
end;
            }

end.