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

GridPrinter: Fix LCLScaling for PreviewForm size parameters.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8619 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-11-13 13:20:17 +00:00
parent 1f2391e102
commit 323744eaff
2 changed files with 50 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
components/gridprinter/examples/multi-language/main.lfm
View File

@ -1,10 +1,10 @@
object MainForm: TMainForm
Left = 331
Height = 491
Height = 485
Top = 127
Width = 651
Caption = 'Multi-Language Demonstration of TGridPrinter'
ClientHeight = 491
ClientHeight = 485
ClientWidth = 651
OnCreate = FormCreate
LCLVersion = '2.3.0.0'
@ -16,7 +16,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnPrint
Left = 8
Height = 411
Height = 405
Top = 39
Width = 635
Anchors = [akTop, akLeft, akRight, akBottom]
@ -32,7 +32,7 @@ object MainForm: TMainForm
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 25
Top = 458
Top = 452
Width = 60
Anchors = [akLeft, akBottom]
AutoSize = True
@ -47,7 +47,7 @@ object MainForm: TMainForm
AnchorSideTop.Control = btnPrint
Left = 264
Height = 25
Top = 458
Top = 452
Width = 76
AutoSize = True
BorderSpacing.Left = 24
@ -62,7 +62,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter
Left = 76
Height = 23
Top = 459
Top = 453
Width = 164
DropDownCount = 24
ItemHeight = 15
@ -84,7 +84,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
Left = 348
Height = 22
Top = 459
Top = 453
Width = 295
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 8
@ -155,9 +155,10 @@ object MainForm: TMainForm
Top = 96
end
object GridPrintPreviewDialog1: TGridPrintPreviewDialog
FormParams.Width = 840
FormParams.Width = 640
FormParams.Height = 800
FormParams.Position = poDesigned
FormParams.PixelsPerInch = 96
GridPrinter = GridPrinter1
Zoom = 199
ZoomMode = zmFitHeight

42
components/gridprinter/source/gridprnpreviewdlg.pas
View File

@ -17,7 +17,14 @@ type
FTop: Integer;
FWidth: Integer;
FHeight: Integer;
FPixelsPerInch: Integer;
FPosition: TPosition;
private
procedure ReadPPI(Reader: TReader);
procedure WritePPI(Writer: TWriter);
protected
procedure AdjustSize;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AOwner: TGridPrintPreviewDialog);
published
@ -36,6 +43,7 @@ type
FZoom: Integer;
FZoomMode: TGridPrintPreviewZoomMode;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
@ -54,7 +62,7 @@ type
implementation
uses
Controls, LCLIntf, LCLType;
Graphics, Controls, LCLIntf, LCLType;
{ TGridPrintPreviewFormParams }
@ -65,6 +73,32 @@ begin
FWidth := 800;
FHeight := 600;
FPosition := poMainFormCenter;
FPixelsPerInch := ScreenInfo.PixelsPerInchY;
end;
procedure TGridPrintPreviewFormParams.AdjustSize;
var
ppi: Integer;
begin
ppi := ScreenInfo.PixelsPerInchY;
Width := MulDiv(Width, ppi, FPixelsPerInch);
Height := MulDiv(Height, ppi, FPixelsPerInch);
end;
procedure TGridPrintPreviewFormParams.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('PixelsPerInch', @ReadPPI, @WritePPI, true);
end;
procedure TGridPrintPreviewFormParams.ReadPPI(Reader: TReader);
begin
FPixelsPerInch := Reader.ReadInteger;
end;
procedure TGridPrintPreviewFormParams.WritePPI(Writer: TWriter);
begin
Writer.WriteInteger(ScreenInfo.PixelsPerInchY);
end;
@ -126,6 +160,12 @@ begin
end;
end;
procedure TGridPrintPreviewDialog.Loaded;
begin
inherited;
FFormParams.AdjustSize;
end;
procedure TGridPrintPreviewDialog.Notification(AComponent: TComponent;
Operation: TOperation);
begin