pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Add "Auto row height" command to menu of fps_ctrls demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5259 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-10-12 22:40:48 +00:00
parent bdeef86e41
commit 301f7034db
3 changed files with 49 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
View File

@ -1,7 +1,7 @@
object MainForm: TMainForm
Left = 350
Left = 256
Height = 621
Top = 121
Top = 119
Width = 997
Caption = 'demo_ctrls'
ClientHeight = 601
@ -662,6 +662,7 @@ object MainForm: TMainForm
end
object ActionList: TActionList
Images = ImageList
OnUpdate = ActionListUpdate
left = 176
top = 248
object AcAddWorksheet: TsWorksheetAddAction
@ -1835,6 +1836,12 @@ object MainForm: TMainForm
Hint = 'Zoom factor 500%'
Zoom = 500
end
object AcAutoRowHeights: TAction
Category = 'Edit'
Caption = 'Auto row heights'
Hint = 'Automatic row height adjustment'
OnExecute = AcAutoRowHeightsExecute
end
end
object ImageList: TImageList
left = 176
@ -4416,6 +4423,12 @@ object MainForm: TMainForm
AutoCheck = True
end
end
object MenuItem159: TMenuItem
Caption = '-'
end
object MenuItem158: TMenuItem
Action = AcAutoRowHeights
end
end
object MnuView: TMenuItem
Caption = 'View'

22
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

@ -27,6 +27,7 @@ type
AcShowHeaders: TAction;
AcFrozenRows: TAction;
AcFrozenCols: TAction;
AcAutoRowHeights: TAction;
AcWorksheetRTL: TAction;
AcViewInspector: TAction;
ActionList: TActionList;
@ -94,6 +95,8 @@ type
MenuItem155: TMenuItem;
MenuItem156: TMenuItem;
MenuItem157: TMenuItem;
MenuItem158: TMenuItem;
MenuItem159: TMenuItem;
MnuZoom: TMenuItem;
MenuItem147: TMenuItem;
MnuSettings: TMenuItem;
@ -373,6 +376,7 @@ type
WorkbookSource: TsWorkbookSource;
WorkbookTabControl: TsWorkbookTabControl;
WorksheetGrid: TsWorksheetGrid;
procedure AcAutoRowHeightsExecute(Sender: TObject);
procedure AcColAddExecute(Sender: TObject);
procedure AcColDeleteExecute(Sender: TObject);
procedure AcFileOpenAccept(Sender: TObject);
@ -386,6 +390,7 @@ type
AWorkbook: TsWorkbook; var ANumFormatStr: String);
procedure AcRowAddExecute(Sender: TObject);
procedure AcRowDeleteExecute(Sender: TObject);
procedure ActionListUpdate(AAction: TBasicAction; var Handled: Boolean);
procedure AcWorksheetRTLExecute(Sender: TObject);
procedure AcWorksheetRTLUpdate(Sender: TObject);
procedure AcSearchExecute(Sender: TObject);
@ -448,6 +453,16 @@ end;
{ TMainForm }
procedure TMainForm.AcAutoRowHeightsExecute(Sender: TObject);
begin
Screen.Cursor := crHourglass;
try
WorksheetGrid.UpdateRowHeights(0, true);
finally
Screen.Cursor := crDefault;
end;
end;
{ Adds a column before the active cell }
procedure TMainForm.AcColAddExecute(Sender: TObject);
begin
@ -683,6 +698,13 @@ begin
AcShowHeaders.Checked := WorksheetGrid.ShowHeaders;
end;
procedure TMainForm.ActionListUpdate(AAction: TBasicAction; var Handled: Boolean
);
begin
if AAction = AcAutoRowHeights then
AcAutoRowHeights.Enabled := WorkbookSource.Worksheet <> nil;
end;
{ Toggles the spreadsheet inspector on and off }
procedure TMainForm.AcViewInspectorExecute(Sender: TObject);
begin

13
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -4849,7 +4849,18 @@ begin
if (lRow <> nil) then begin
case lRow^.RowHeightType of
rhtCustom:
h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor);
begin
h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor);
if AEnforceCalcRowHeight then begin
h := CalcAutoRowHeight(ARow);
if h = 0 then begin
h := DefaultRowHeight;
lRow^.RowHeightType := rhtDefault;
end else
lRow^.RowHeightType := rhtAuto;
lRow^.Height := CalcRowHeightToSheet(round(h / ZoomFactor));
end;
end;
rhtAuto, rhtDefault:
begin
doCalcRowHeight := AEnforceCalcRowHeight or (lRow^.Height = 0);