spready: Add dialog for zooming

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

applications/spready/smain.lfm

@@ -1950,6 +1950,12 @@ object MainForm: TMainForm
       OnExecute = AcWorksheetShowHeadersExecute
       OnUpdate = AcWorksheetShowHeadersUpdate
     end
+    object AcZoomMore: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      Caption = 'More...'
+      Hint = 'Zoom worksheet'
+      OnExecute = AcZoomMoreExecute
+    end
   end
   object ImageList: TImageList
     left = 176
@@ -4474,6 +4480,12 @@ object MainForm: TMainForm
         object MenuItem191: TMenuItem
           Action = AcZoom300
         end
+        object MenuItem195: TMenuItem
+          Caption = '-'
+        end
+        object MenuItem196: TMenuItem
+          Action = AcZoomMore
+        end
       end
       object MenuItem193: TMenuItem
         Action = AcWorksheetShowGrid

applications/spready/smain.pas

@@ -99,6 +99,8 @@ type
     MenuItem192: TMenuItem;
     MenuItem193: TMenuItem;
     MenuItem194: TMenuItem;
+    MenuItem195: TMenuItem;
+    MenuItem196: TMenuItem;
     MenuItem2: TMenuItem;
     MenuItem3: TMenuItem;
     MenuItem4: TMenuItem;
@@ -359,6 +361,7 @@ type
     AcZoom200: TsWorksheetZoomAction;
     AcZoom300: TsWorksheetZoomAction;
     AcZoom500: TsWorksheetZoomAction;
+    AcZoomMore: TsWorksheetZoomAction;
     ToolBar2: TToolBar;
     ToolBar3: TToolBar;
     ToolButton1: TToolButton;
@@ -475,6 +478,7 @@ type
     procedure AcWorksheetShowGridUpdate(Sender: TObject);
     procedure AcWorksheetShowHeadersExecute(Sender: TObject);
     procedure AcWorksheetShowHeadersUpdate(Sender: TObject);
+    procedure AcZoomMoreExecute(Sender: TObject);
     procedure EditCut1Execute(Sender: TObject);
     procedure ColorComboboxAddColors(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
@@ -526,7 +530,7 @@ uses
   fpsUtils, fpsCSV, fpsReaderWriter,
   sCSVParamsForm, sCurrencyForm, sFormatSettingsForm, sSortParamsForm,
   sHyperlinkForm, sNumFormatForm, sSearchForm, sColWidthForm, sRowHeightForm,
-  sWorksheetProtection, sAbout, sUtils;
+  sWorksheetProtection, sZoomForm, sAbout, sUtils;
 
 var
   SEARCH_DLG_POS: TPoint = (X: -1; Y: -1);
@@ -959,6 +963,20 @@ begin
   end;
 end;
 
+procedure TMainForm.AcZoomMoreExecute(Sender: TObject);
+var
+  F: TZoomForm;
+begin
+  F := TZoomForm.Create(nil);
+  try
+    F.Worksheet := WorkbookSource.Worksheet;
+    if F.ShowModal = mrOK then
+      AcZoomMore.Zoom := F.ZoomLevel;
+  finally
+    F.Free;
+  end;
+end;
+
 procedure TMainForm.AcWorksheetProtectionExecute(Sender: TObject);
 var
   F: TWorksheetProtectionForm;

applications/spready/spready.lpi

@@ -69,7 +69,7 @@
         <PackageName Value="LCL"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="spready.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -171,6 +171,13 @@
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="sWorksheetProtection"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="szoomform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="ZoomForm"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="sZoomForm"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

applications/spready/spready.lpr

@@ -7,7 +7,7 @@ uses
   cthreads,
   {$ENDIF}{$ENDIF}
   Interfaces,  // this includes the LCL widgetset
-  Forms, smain, sColWidthForm, sWorksheetProtection;
+  Forms, smain, sColWidthForm, sWorksheetProtection, sZoomForm;
 
 {$R *.res}
 
@@ -16,6 +16,7 @@ begin
   Application.Initialize;
   Application.CreateForm(TMainForm, MainForm);
   MainForm.BeforeRun;
+  Application.CreateForm(TZoomForm, ZoomForm);
   Application.Run;
 end.
 

applications/spready/szoomform.lfm

@@ -0,0 +1,94 @@
+object ZoomForm: TZoomForm
+  Left = 406
+  Height = 122
+  Top = 253
+  Width = 347
+  BorderStyle = bsDialog
+  Caption = 'Worksheet zoom factor'
+  ClientHeight = 122
+  ClientWidth = 347
+  OnClose = FormClose
+  OnCreate = FormCreate
+  Position = poMainFormCenter
+  LCLVersion = '1.9.0.0'
+  object TrackBar: TTrackBar
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = EdZoom
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    Left = 12
+    Height = 25
+    Top = 47
+    Width = 323
+    OnChange = TrackBarChange
+    Position = 0
+    TickStyle = tsNone
+    Anchors = [akTop, akLeft, akRight]
+    BorderSpacing.Left = 12
+    BorderSpacing.Top = 8
+    BorderSpacing.Right = 12
+    BorderSpacing.Bottom = 16
+    TabOrder = 0
+  end
+  object LblPercent: TLabel
+    AnchorSideLeft.Control = EdZoom
+    AnchorSideLeft.Side = asrBottom
+    AnchorSideTop.Control = EdZoom
+    AnchorSideTop.Side = asrCenter
+    Left = 218
+    Height = 15
+    Top = 16
+    Width = 10
+    BorderSpacing.Left = 8
+    Caption = '%'
+    ParentColor = False
+  end
+  object LblZoom: TLabel
+    AnchorSideTop.Control = EdZoom
+    AnchorSideTop.Side = asrCenter
+    AnchorSideRight.Control = EdZoom
+    Left = 66
+    Height = 15
+    Top = 16
+    Width = 62
+    Anchors = [akTop, akRight]
+    BorderSpacing.Right = 8
+    Caption = 'Zoom level:'
+    ParentColor = False
+  end
+  object EdZoom: TSpinEdit
+    AnchorSideLeft.Control = TrackBar
+    AnchorSideLeft.Side = asrCenter
+    AnchorSideTop.Control = Owner
+    Left = 136
+    Height = 23
+    Top = 12
+    Width = 74
+    Alignment = taRightJustify
+    BorderSpacing.Top = 12
+    BorderSpacing.Bottom = 12
+    MaxValue = 10000
+    MinValue = 1
+    OnChange = EdZoomChange
+    TabOrder = 1
+    Value = 1
+  end
+  object ButtonPanel: TButtonPanel
+    Left = 6
+    Height = 34
+    Top = 82
+    Width = 335
+    OKButton.Name = 'OKButton'
+    OKButton.DefaultCaption = True
+    OKButton.OnClick = OKButtonClick
+    HelpButton.Name = 'HelpButton'
+    HelpButton.DefaultCaption = True
+    CloseButton.Name = 'CloseButton'
+    CloseButton.DefaultCaption = True
+    CancelButton.Name = 'CancelButton'
+    CancelButton.DefaultCaption = True
+    TabOrder = 2
+    ShowButtons = [pbOK, pbCancel]
+  end
+end

applications/spready/szoomform.pas

@@ -0,0 +1,124 @@
+unit sZoomForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
+  ButtonPanel, Spin,
+  fpspreadsheet;
+
+type
+
+  { TZoomForm }
+
+  TZoomForm = class(TForm)
+    ButtonPanel: TButtonPanel;
+    EdZoom: TSpinEdit;
+    LblPercent: TLabel;
+    LblZoom: TLabel;
+    TrackBar: TTrackBar;
+    procedure EdZoomChange(Sender: TObject);
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormCreate(Sender: TObject);
+    procedure OKButtonClick(Sender: TObject);
+    procedure TrackBarChange(Sender: TObject);
+  private
+    FWorksheet: TsWorksheet;
+    FInitialZoom: Double;
+    FOKClicked: Boolean;
+    FLevels: array of Integer;
+    function GetZoomLevel: Integer;
+    procedure SetWorksheet(AValue: TsWorksheet);
+    procedure SetZoomLevel(AValue: Integer);
+  protected
+    procedure ApplyZoom;
+    function FindZoomLevelIndex(AValue: Integer): Integer;
+
+  public
+    property Worksheet: TsWorksheet read FWorksheet write SetWorksheet;
+    property ZoomLevel: Integer read GetZoomLevel;
+
+  end;
+
+var
+  ZoomForm: TZoomForm;
+
+implementation
+
+{$R *.lfm}
+
+const
+  ZOOM_LEVELS: array[0..26] of Integer = (
+    10,   20,  30,  40,  50,  60,  65,  70,  75,  80,  85,  90,  95,
+    100,
+    105, 110, 115, 120, 130, 140, 150, 160, 180, 200, 250, 300, 400);
+
+procedure TZoomForm.ApplyZoom;
+begin
+  if Assigned(FWorksheet) then
+    FWorksheet.Zoomfactor := GetZoomLevel / 100;
+end;
+
+procedure TZoomForm.EdZoomChange(Sender: TObject);
+var
+  idx: Integer;
+begin
+  idx := FindZoomLevelIndex(EdZoom.Value);
+  if idx > -1 then Trackbar.Position := idx;
+  ApplyZoom;
+end;
+
+function TZoomForm.FindZoomLevelIndex(AValue: Integer): Integer;
+begin
+  for Result := Low(ZOOM_LEVELS) to High(ZOOM_LEVELS) do
+    if ZOOM_LEVELS[Result] = AValue then exit;
+  Result := -1;
+end;
+
+procedure TZoomForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  if FWorksheet <> nil then begin
+    if not FOKClicked then
+      FWorksheet.ZoomFactor := FInitialZoom;
+  end;
+end;
+
+procedure TZoomForm.FormCreate(Sender: TObject);
+begin
+  Trackbar.Min := 0;
+  TrackBar.Max := High(ZOOM_LEVELS);
+end;
+
+function TZoomForm.GetZoomLevel: Integer;
+begin
+  Result := EdZoom.Value;
+end;
+
+procedure TZoomForm.OKButtonClick(Sender: TObject);
+begin
+  FOKClicked := true;
+end;
+
+procedure TZoomForm.TrackBarChange(Sender: TObject);
+begin
+  EdZoom.Value := ZOOM_LEVELS[Trackbar.Position];
+end;
+
+procedure TZoomForm.SetWorksheet(AValue: TsWorksheet);
+begin
+  if FWorksheet = AValue then exit;
+  FWorksheet := AValue;
+  FInitialZoom := FWorksheet.ZoomFactor;
+  SetZoomLevel(Round(FWorksheet.ZoomFactor * 100));
+end;
+
+procedure TZoomForm.SetZoomLevel(AValue: Integer);
+begin
+  if AValue = GetZoomLevel then exit;
+  EdZoom.Value := AValue;
+end;
+
+end.
+