paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 18:00:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: grids: high-DPI: rewrite ColWidth&RowHeight scaling so that it's Delphi and Lazarus 1.6 compatible.

Browse Source 
git-svn-id: trunk@54948 -
This commit is contained in:
ondrej 2017-05-17 10:08:56 +00:00
parent ff26552571
commit b54495505b
3 changed files with 78 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/dbgrids.pas
View File

@ -1447,13 +1447,13 @@ end;
function TCustomDBGrid.DefaultFieldColWidth(F: TField): Integer; function TCustomDBGrid.DefaultFieldColWidth(F: TField): Integer;
begin begin
if not HandleAllocated or (F=nil) then if not HandleAllocated or (F=nil) then
result:=GetRealDefaultColWidth result:=DefaultColWidth
else begin else begin
if F.DisplayWidth = 0 then if F.DisplayWidth = 0 then
if Canvas.HandleAllocated then if Canvas.HandleAllocated then
result := Canvas.TextWidth( F.DisplayName ) + 3 result := Canvas.TextWidth( F.DisplayName ) + 3
else else
Result := GetRealDefaultColWidth Result := DefaultColWidth
else else
result := F.DisplayWidth * CalcCanvasCharWidth(Canvas); result := F.DisplayWidth * CalcCanvasCharWidth(Canvas);
end; end;
@ -1610,7 +1610,7 @@ begin
{$ifdef dbgDBGrid} {$ifdef dbgDBGrid}
DebugLn('%s.GetBufferCount', [ClassName]); DebugLn('%s.GetBufferCount', [ClassName]);
{$endif} {$endif}
Result := ClientHeight div GetRealDefaultRowHeight; Result := ClientHeight div DefaultRowHeight;
if dgTitles in Options then if dgTitles in Options then
Dec(Result, 1); Dec(Result, 1);
end; end;

111
lcl/grids.pas
View File

@ -830,6 +830,8 @@ type
function GetColCount: Integer; function GetColCount: Integer;
function GetColWidths(Acol: Integer): Integer; function GetColWidths(Acol: Integer): Integer;
function GetColumns: TGridColumns; function GetColumns: TGridColumns;
function GetDefColWidth: Integer;
function GetDefRowHeight: Integer;
function GetEditorBorderStyle: TBorderStyle; function GetEditorBorderStyle: TBorderStyle;
function GetBorderWidth: Integer; function GetBorderWidth: Integer;
function GetTitleImageInfo(aColumnIndex:Integer; out aWidth, aHeight: Integer; function GetTitleImageInfo(aColumnIndex:Integer; out aWidth, aHeight: Integer;
@ -1141,8 +1143,8 @@ type
property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts default false; property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts default false;
property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored; property Columns: TGridColumns read GetColumns write SetColumns stored IsColumnsStored;
property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths; property ColWidths[aCol: Integer]: Integer read GetColWidths write SetColWidths;
property DefaultColWidth: Integer read FDefColWidth write SetDefColWidth default 0; property DefaultColWidth: Integer read GetDefColWidth write SetDefColWidth default 0;
property DefaultRowHeight: Integer read FDefRowHeight write SetDefRowHeight default 0; property DefaultRowHeight: Integer read GetDefRowHeight write SetDefRowHeight default 0;
property DefaultDrawing: Boolean read FDefaultDrawing write SetDefaultDrawing default True; property DefaultDrawing: Boolean read FDefaultDrawing write SetDefaultDrawing default True;
property DefaultTextStyle: TTextStyle read FDefaultTextStyle write FDefaultTextStyle; property DefaultTextStyle: TTextStyle read FDefaultTextStyle write FDefaultTextStyle;
property DragDx: Integer read FDragDx write FDragDx; property DragDx: Integer read FDragDx write FDragDx;
@ -1247,8 +1249,8 @@ type
procedure EndUpdate(aRefresh: boolean = true); procedure EndUpdate(aRefresh: boolean = true);
procedure EraseBackground(DC: HDC); override; procedure EraseBackground(DC: HDC); override;
function Focused: Boolean; override; function Focused: Boolean; override;
function GetRealDefaultColWidth: integer; function DefaultColWidthIsStored: Boolean;
function GetRealDefaultRowHeight: integer; function DefaultRowHeightIsStored: Boolean;
function HasMultiSelection: Boolean; function HasMultiSelection: Boolean;
procedure InvalidateCell(aCol, aRow: Integer); overload; procedure InvalidateCell(aCol, aRow: Integer); overload;
procedure InvalidateCol(ACol: Integer); procedure InvalidateCol(ACol: Integer);
@ -2080,7 +2082,7 @@ begin
Result:=integer(PtrUInt(FRows[aRow])) Result:=integer(PtrUInt(FRows[aRow]))
else else
Result:=-1; Result:=-1;
if Result<0 then Result:=GetRealDefaultRowHeight; if Result<0 then Result:=DefaultRowHeight;
end; end;
function TCustomGrid.GetTopRow: Longint; function TCustomGrid.GetTopRow: Longint;
@ -2276,14 +2278,14 @@ begin
NewSize := AValue; NewSize := AValue;
if NewSize<0 then begin if NewSize<0 then begin
AValue:=-1; AValue:=-1;
NewSize := GetRealDefaultColWidth; NewSize := DefaultColWidth;
end; end;
OldSize := integer(PtrUInt(FCols[ACol])); OldSize := integer(PtrUInt(FCols[ACol]));
if NewSize<>OldSize then begin if NewSize<>OldSize then begin
if OldSize<0 then if OldSize<0 then
OldSize := GetRealDefaultColWidth; OldSize := DefaultColWidth;
Bigger := NewSize>OldSize; Bigger := NewSize>OldSize;
SetRawColWidths(ACol, AValue); SetRawColWidths(ACol, AValue);
@ -2501,7 +2503,7 @@ begin
Result:=-1; Result:=-1;
end; end;
if Result<0 then if Result<0 then
Result:=GetRealDefaultColWidth; Result:=DefaultColWidth;
end; end;
procedure TCustomGrid.SetEditor(AValue: TWinControl); procedure TCustomGrid.SetEditor(AValue: TWinControl);
@ -2758,14 +2760,14 @@ begin
NewSize := AValue; NewSize := AValue;
if NewSize<0 then begin if NewSize<0 then begin
AValue:=-1; AValue:=-1;
NewSize := GetRealDefaultRowHeight; NewSize := DefaultRowHeight;
end; end;
OldSize := integer(PtrUInt(FRows[ARow])); OldSize := integer(PtrUInt(FRows[ARow]));
if AValue<>OldSize then begin if AValue<>OldSize then begin
if OldSize<0 then if OldSize<0 then
OldSize := GetRealDefaultRowHeight; OldSize := DefaultRowHeight;
bigger := NewSize > OldSize; bigger := NewSize > OldSize;
@ -2925,8 +2927,14 @@ begin
Target.RowCount := RowCount; Target.RowCount := RowCount;
Target.FixedCols := FixedCols; Target.FixedCols := FixedCols;
Target.FixedRows := FixedRows; Target.FixedRows := FixedRows;
Target.DefaultRowHeight := DefaultRowHeight; if DefaultRowHeightIsStored then
Target.DefaultColWidth := DefaultColWidth; Target.DefaultRowHeight := DefaultRowHeight
else
Target.DefaultRowHeight := -1;
if DefaultColWidthIsStored then
Target.DefaultColWidth := DefaultColWidth
else
Target.DefaultColWidth := -1;
if not Columns.Enabled then if not Columns.Enabled then
Target.FCols.Assign(FCols); Target.FCols.Assign(FCols);
Target.FRows.Assign(FRows); Target.FRows.Assign(FRows);
@ -3000,6 +3008,7 @@ begin
if AValue=fDefColwidth then if AValue=fDefColwidth then
Exit; Exit;
FDefColWidth:=AValue; FDefColWidth:=AValue;
FRealizedDefColWidth := 0;
if EditorMode then if EditorMode then
ColRowToOffset(True, True, FCol, OldLeft, OldRight); ColRowToOffset(True, True, FCol, OldLeft, OldRight);
@ -3021,6 +3030,7 @@ begin
if (AValue<>fDefRowHeight) or (csLoading in ComponentState) then if (AValue<>fDefRowHeight) or (csLoading in ComponentState) then
begin begin
FDefRowheight:=AValue; FDefRowheight:=AValue;
FRealizedDefRowHeight := 0;
if EditorMode then if EditorMode then
ColRowToOffSet(False,True, FRow, OldTop, OldBottom); ColRowToOffSet(False,True, FRow, OldTop, OldBottom);
@ -4552,8 +4562,8 @@ begin
end; end;
SB_PAGELEFT: TrySmoothScrollBy(-(ClientWidth-FGCache.FixedWidth)*RTLSign, 0); SB_PAGELEFT: TrySmoothScrollBy(-(ClientWidth-FGCache.FixedWidth)*RTLSign, 0);
SB_PAGERIGHT: TrySmoothScrollBy((ClientWidth-FGCache.FixedWidth)*RTLSign, 0); SB_PAGERIGHT: TrySmoothScrollBy((ClientWidth-FGCache.FixedWidth)*RTLSign, 0);
SB_LINELEFT: TrySmoothScrollBy(-GetRealDefaultColWidth*RTLSign, 0); SB_LINELEFT: TrySmoothScrollBy(-DefaultColWidth*RTLSign, 0);
SB_LINERIGHT: TrySmoothScrollBy(GetRealDefaultColWidth*RTLSign, 0); SB_LINERIGHT: TrySmoothScrollBy(DefaultColWidth*RTLSign, 0);
end; end;
if EditorMode then if EditorMode then
@ -4575,8 +4585,8 @@ begin
end; end;
SB_PAGEUP: TrySmoothScrollBy(0, -(ClientHeight-FGCache.FixedHeight)); SB_PAGEUP: TrySmoothScrollBy(0, -(ClientHeight-FGCache.FixedHeight));
SB_PAGEDOWN: TrySmoothScrollBy(0, ClientHeight-FGCache.FixedHeight); SB_PAGEDOWN: TrySmoothScrollBy(0, ClientHeight-FGCache.FixedHeight);
SB_LINEUP: TrySmoothScrollBy(0, -GetRealDefaultRowHeight); SB_LINEUP: TrySmoothScrollBy(0, -DefaultRowHeight);
SB_LINEDOWN: TrySmoothScrollBy(0, GetRealDefaultRowHeight); SB_LINEDOWN: TrySmoothScrollBy(0, DefaultRowHeight);
end; end;
if EditorMode then if EditorMode then
@ -5171,22 +5181,22 @@ begin
end; end;
end; end;
function TCustomGrid.GetRealDefaultColWidth: integer; function TCustomGrid.GetDefColWidth: integer;
begin begin
if FDefColWidth = 0 then if FDefColWidth<0 then
begin begin
if FRealizedDefColWidth = 0 then if FRealizedDefColWidth <= 0 then
FRealizedDefColWidth := MulDiv(DEFCOLWIDTH, Font.PixelsPerInch, 96); FRealizedDefColWidth := MulDiv(DEFCOLWIDTH, Font.PixelsPerInch, 96);
Result := FRealizedDefColWidth; Result := FRealizedDefColWidth;
end else end else
Result := FDefColWidth; Result := FDefColWidth;
end; end;
function TCustomGrid.GetRealDefaultRowHeight: integer; function TCustomGrid.GetDefRowHeight: integer;
begin begin
if FDefRowHeight = 0 then if FDefRowHeight<0 then
begin begin
if FRealizedDefRowHeight = 0 then if FRealizedDefRowHeight <= 0 then
FRealizedDefRowHeight := GetDefaultRowHeight; FRealizedDefRowHeight := GetDefaultRowHeight;
Result := FRealizedDefRowHeight; Result := FRealizedDefRowHeight;
end else end else
@ -6631,6 +6641,16 @@ begin
{$IfDef dbgGrid}DebugLn('DoubleClick END');{$Endif} {$IfDef dbgGrid}DebugLn('DoubleClick END');{$Endif}
end; end;
function TCustomGrid.DefaultColWidthIsStored: Boolean;
begin
Result := FDefColWidth>=0;
end;
function TCustomGrid.DefaultRowHeightIsStored: Boolean;
begin
Result := FDefRowHeight>=0;
end;
procedure TCustomGrid.DefineProperties(Filer: TFiler); procedure TCustomGrid.DefineProperties(Filer: TFiler);
function SonRowsIguales(aGrid: TCustomGrid): boolean; function SonRowsIguales(aGrid: TCustomGrid): boolean;
@ -6838,15 +6858,19 @@ begin
end; end;
for i := FRows.Count - 1 downto 0 do for i := FRows.Count - 1 downto 0 do
FRows[i] := Pointer(Round(PtrInt(FRows[i]) * AYProportion)); FRows[i] := {%H-}Pointer(Round({%H-}PtrInt(FRows[i]) * AYProportion));
for i := FCols.Count - 1 downto 0 do for i := FCols.Count - 1 downto 0 do
FCols[i] := Pointer(Round(PtrInt(FCols[i]) * AXProportion)); FCols[i] := {%H-}Pointer(Round({%H-}PtrInt(FCols[i]) * AXProportion));
FDefColWidth := Round(FDefColWidth * AXProportion); if DefaultColWidthIsStored then
FDefRowHeight := Round(FDefRowHeight * AYProportion); DefaultColWidth := Round(DefaultColWidth * AXProportion)
FRealizedDefRowHeight := 0; else
FRealizedDefColWidth := 0; FRealizedDefColWidth := 0;
if DefaultRowHeightIsStored then
DefaultRowHeight := Round(DefaultRowHeight * AYProportion)
else
FRealizedDefRowHeight := 0;
finally finally
EndUpdate; EndUpdate;
end; end;
@ -8929,7 +8953,9 @@ begin
Cfg.SetValue('grid/design/fixedcols', FixedCols); Cfg.SetValue('grid/design/fixedcols', FixedCols);
Cfg.SetValue('grid/design/fixedrows', Fixedrows); Cfg.SetValue('grid/design/fixedrows', Fixedrows);
Cfg.SetValue('grid/design/defaultcolwidth', DefaultColWidth); Cfg.SetValue('grid/design/defaultcolwidth', DefaultColWidth);
Cfg.SetValue('grid/design/isdefaultcolwidth', ord(DefaultColWidthIsStored));
Cfg.SetValue('grid/design/defaultrowheight',DefaultRowHeight); Cfg.SetValue('grid/design/defaultrowheight',DefaultRowHeight);
Cfg.SetValue('grid/design/isdefaultrowheight', ord(DefaultRowHeightIsStored));
Cfg.Setvalue('grid/design/color',ColorToString(Color)); Cfg.Setvalue('grid/design/color',ColorToString(Color));
if Columns.Enabled then if Columns.Enabled then
@ -9091,8 +9117,19 @@ begin
RowCount:=Cfg.GetValue('grid/design/rowcount', 5); RowCount:=Cfg.GetValue('grid/design/rowcount', 5);
FixedCols:=Cfg.GetValue('grid/design/fixedcols', 1); FixedCols:=Cfg.GetValue('grid/design/fixedcols', 1);
FixedRows:=Cfg.GetValue('grid/design/fixedrows', 1); FixedRows:=Cfg.GetValue('grid/design/fixedrows', 1);
DefaultRowheight:=Cfg.GetValue('grid/design/defaultrowheight', -1);
DefaultColWidth:=Cfg.getValue('grid/design/defaultcolwidth', -1); k := Cfg.GetValue('grid/design/isdefaultrowheight', -1);
if k<>0 then
DefaultRowheight:=Cfg.GetValue('grid/design/defaultrowheight', -1)
else
DefaultRowheight:=-1;
k := Cfg.GetValue('grid/design/isdefaultcolwidth', -1);
if k<>0 then
DefaultColWidth:=Cfg.getValue('grid/design/defaultcolwidth', -1)
else
DefaultColWidth:=-1;
try try
Color := StringToColor(cfg.GetValue('grid/design/color', 'clWindow')); Color := StringToColor(cfg.GetValue('grid/design/color', 'clWindow'));
except except
@ -9228,8 +9265,8 @@ begin
goSmoothScroll ]; goSmoothScroll ];
FScrollbars:=ssAutoBoth; FScrollbars:=ssAutoBoth;
fGridState:=gsNormal; fGridState:=gsNormal;
FDefColWidth:=0; FDefColWidth:=-1;
FDefRowHeight:=0; FDefRowHeight:=-1;
FGridLineColor:=clSilver; FGridLineColor:=clSilver;
FFixedGridLineColor := cl3DDKShadow; FFixedGridLineColor := cl3DDKShadow;
FGridLineStyle:=psSolid; FGridLineStyle:=psSolid;
@ -10250,11 +10287,11 @@ begin
ScrollCols := (ssCtrl in shift); ScrollCols := (ssCtrl in shift);
if ScrollCols then if ScrollCols then
begin begin
if not TrySmoothScrollBy(Delta*GetRealDefaultColWidth, 0) then if not TrySmoothScrollBy(Delta*DefaultColWidth, 0) then
TryScrollTo(FTopLeft.x+Delta, FTopLeft.y, True, False); TryScrollTo(FTopLeft.x+Delta, FTopLeft.y, True, False);
end else end else
begin begin
if not TrySmoothScrollBy(0, Delta*GetRealDefaultRowHeight*Mouse.WheelScrollLines) then if not TrySmoothScrollBy(0, Delta*DefaultRowHeight*Mouse.WheelScrollLines) then
TryScrollTo(FTopLeft.x, FTopLeft.y+Delta, False, True); // scroll only 1 line if above scrolling failed (probably due to too high line) TryScrollTo(FTopLeft.x, FTopLeft.y+Delta, False, True); // scroll only 1 line if above scrolling failed (probably due to too high line)
end; end;
if EditorMode then if EditorMode then
@ -10749,7 +10786,7 @@ begin
W := W + imgWidth; W := W + imgWidth;
if W=0 then if W=0 then
W := GetRealDefaultColWidth W := DefaultColWidth
else else
W := W + DEFAUTOADJPADDING; W := W + DEFAUTOADJPADDING;
@ -11704,7 +11741,7 @@ begin
begin begin
tmpGrid := Grid; tmpGrid := Grid;
if tmpGrid<>nil then if tmpGrid<>nil then
result := tmpGrid.GetRealDefaultColWidth; result := tmpGrid.DefaultColWidth;
end; end;
end; end;
@ -11974,7 +12011,7 @@ var
begin begin
tmpGrid := Grid; tmpGrid := Grid;
if tmpGrid<>nil then if tmpGrid<>nil then
result := tmpGrid.GetRealDefaultColWidth result := tmpGrid.DefaultColWidth
else else
result := -1; result := -1;
end; end;

2
packager/confirmpkglistdlg.pas
View File

@ -79,7 +79,7 @@ begin
Cells[0, 0] := lisConfirmPackageNewPackageSet; Cells[0, 0] := lisConfirmPackageNewPackageSet;
Cells[1, 0] := lisConfirmPackageAction; Cells[1, 0] := lisConfirmPackageAction;
Cells[2, 0] := lisConfirmPackageOldPackageSet; Cells[2, 0] := lisConfirmPackageOldPackageSet;
d := RowCount * (GetRealDefaultRowHeight + GridLineWidth) - Height; d := RowCount * (DefaultRowHeight + GridLineWidth) - Height;
end; end;
// Auto-grow dialog up to 3/4 of the screen height. // Auto-grow dialog up to 3/4 of the screen height.
d := Min(d, Screen.Height * 3 div 4 - Height); d := Min(d, Screen.Height * 3 div 4 - Height);