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

jvcllaz: High-dpi support for TJvTFWeeks and TJvTFMonths

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7123 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-08-12 23:06:58 +00:00
parent e0c137b7ec
commit c68617ef87
5 changed files with 154 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
components/jvcllaz/examples/JvTimeFramework/tfmain.lfm
View File

@ -169,7 +169,7 @@ object MainForm: TMainForm
SelCellAttr.Font.Color = clWindowText
SelCellAttr.TitleAttr.Color = clHighlight
SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clHighlightText
SelCellAttr.DrawBottomLine = True
SelCellAttr.DrawBottomLine = False
ScrollBtnAttr.DisabledArrowColor = clScrollBar
CellPics = StateImageList
Viewer = GlanceTextViewer1
@ -471,7 +471,7 @@ object MainForm: TMainForm
SelCellAttr.Font.Color = clWindowText
SelCellAttr.TitleAttr.Color = clHighlight
SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clHighlightText
SelCellAttr.DrawBottomLine = True
SelCellAttr.DrawBottomLine = False
ScrollBtnAttr.DisabledArrowColor = clScrollBar
Viewer = GlanceTextViewer2
DateFormat = 'ddddd'
@ -1694,6 +1694,7 @@ object MainForm: TMainForm
Title = 'SIMPLDaysPrinter Demo'
ApptAttr.Color = clLime
ApptAttr.ParentFont = False
ApptBar.Width = 5
ApptBuffer = 0
ColHdrHeight = 0
Color = clBlack

3
components/jvcllaz/examples/JvTimeFramework/tfmain.pas
View File

@ -1,6 +1,3 @@
// todo -cTJvTimeFramework: Remove small square at left/top corner of screen; assosciated with Days/Months/Weeks
// todo -cTJvTimeFramework: Fix text height when printing text with font size 0
{******************************************************************
JEDI-VCL Demo

18
components/jvcllaz/run/JvTimeFramework/jvtfdays.pas
View File

@ -2824,7 +2824,10 @@ var
ApptGrid: TJvTFDays;
absMinColWidth: Integer;
begin
absMinColWidth := TJvTFDaysCols(Collection).ApptGrid.Scale96ToFont(DEFAULT_MIN_COL_WIDTH);
if Assigned(ColCollection.ApptGrid) then
absMinColWidth := ColCollection.ApptGrid.Scale96ToFont(DEFAULT_MIN_COL_WIDTH)
else
absMinColWidth := DEFAULT_MIN_COL_WIDTH;
if Value < absMinColWidth then
Value := absMinColWidth;
@ -2911,7 +2914,7 @@ procedure TJvTFDaysCol.AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
if not IsStoredWidth then
if IsStoredWidth then
FWidth := round(FWidth * AXProportion);
end;
end;
@ -4254,16 +4257,16 @@ begin
with FSelGroupHdrAttr do
begin
Color := clBtnFace;
Font.Color := clBlack;
Font.Color := clWindowText;
end;
FFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self);
FSelFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self);
with FSelFancyRowHdrAttr do
begin
TickColor := clBlack;
MinorFont.Color := clBlack;
MajorFont.Color := clBlack;
TickColor := clWindowText;
MinorFont.Color := clWindowText;
MajorFont.Color := clWindowText;
end;
FSelCellAttr := TJvTFSelCellAttr.Create(Self);
@ -4277,6 +4280,7 @@ begin
// ok
FTimeBlocks := TJvTFDaysTimeBlocks.Create(Self);
FTimeBlockProps := TJvTFDaysBlockProps.Create(Self);
FTimeBlockProps.FBlockHdrWidth := Scale96ToFont(DEFAULT_BLOCK_HDR_WIDTH);
{$ENDIF Jv_TIMEBLOCKS}
FEditor := TJvTFInPlaceApptEditor.Create(Self);
@ -14643,7 +14647,7 @@ procedure TJvTFDaysBlockProps.AutoAdjustLayout(const AMode: TLayoutAdjustmentPol
begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
if not IsStoredBlockHdrWidth then
if IsStoredBlockHdrWidth then
FBlockHdrWidth := round(FBlockHdrWidth * AXProportion);
end;
end;

124
components/jvcllaz/run/JvTimeFramework/jvtfglance.pas
View File

@ -31,10 +31,14 @@ unit JvTFGlance;
interface
uses
LCLIntf, LCLType, LMessages,
LCLIntf, LCLType, LMessages, LCLVersion,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ImgList,
JvTFUtils, JvTFManager;
const
DEFAULT_GLANCE_TITLE_HEIGHT = 40;
DEFAULT_GLANCE_CELL_TITLE_HEIGHT = 20;
type
EJvTFGlanceError = class(Exception);
EGlanceViewerError = class(EJvTFGlanceError);
@ -312,6 +316,7 @@ type
FGlanceControl: TJvTFCustomGlance;
FDayTxtAttr: TJvTFTextAttr;
FPicAttr: TJvTFGlanceTitlePicAttr;
function IsStoredHeight: Boolean;
procedure SetAlign(Value: TJvTFTitleAlign);
//procedure SetDayFormat(Value: string);
procedure SetColor(Value: TColor);
@ -328,12 +333,14 @@ type
constructor Create(AOwner: TJvTFCustomGlance);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); virtual;
property GlanceControl: TJvTFCustomGlance read FGlanceControl;
published
property Align: TJvTFTitleAlign read FAlign write SetAlign default alTop;
//property DayFormat: string read FDayFormat write SetDayFormat;
property Color: TColor read FColor write SetColor default clBtnFace;
property Height: Integer read FHeight write SetHeight default 20;
property Height: Integer read FHeight write SetHeight stored IsStoredHeight;
property Visible: Boolean read FVisible write SetVisible default True;
property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
property DayTxtAttr: TJvTFTextAttr read FDayTxtAttr write SetDayTxtAttr;
@ -378,6 +385,7 @@ type
FFrameAttr: TJvTFGlanceFrameAttr;
FTxtAttr: TJvTFTextAttr;
FOnChange: TNotifyEvent;
function IsStoredHeight: Boolean;
procedure SetColor(Value: TColor);
procedure SetHeight(Value: Integer);
procedure SetVisible(Value: Boolean);
@ -389,14 +397,15 @@ type
public
constructor Create(AOwner: TJvTFCustomGlance);
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure AutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); virtual;
property GlanceControl: TJvTFCustomGlance read FGlanceControl;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property Color: TColor read FColor write SetColor default clBtnFace;
property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
property Height: Integer read FHeight write SetHeight default 40;
property Height: Integer read FHeight write SetHeight stored IsStoredHeight;
property Visible: Boolean read FVisible write SetVisible default True;
property TxtAttr: TJvTFTextAttr read FTxtAttr write SetTxtAttr;
end;
@ -599,6 +608,14 @@ type
procedure CreateParams(var Params: TCreateParams); override;
procedure SchedNamesChange(Sender: TObject);
{$IF LCL_FullVersion >= 1080000}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
const AProportion: Double); override;
{$IFEND}
property SelAppt: TJvTFAppt read FSelAppt write SetSelAppt;
property AllowCustomDates: Boolean read FAllowCustomDates write FAllowCustomDates;
// configuration properties and events
@ -1341,13 +1358,16 @@ begin
FTitleAttr := TJvTFGlanceMainTitle.Create(Self);
// obones: Commented out, it goes against the default value in TJvTFGlanceMainTitle
// FTitleAttr.Visible := False; // not visible by default. (Tim)
FTitleAttr.Height := Scale96ToFont(DEFAULT_GLANCE_TITLE_HEIGHT);
FTitleAttr.OnChange := @GlanceTitleChange;
FCellAttr := TJvTFGlanceCellAttr.Create(Self);
FCellAttr.TitleAttr.DayTxtAttr.AlignH := taLeftJustify;
FCellAttr.TitleAttr.Height := Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
FSelCellAttr := TJvTFGlanceCellAttr.Create(Self);
FSelCellAttr.TitleAttr.Color := clHighlight;
FSelCellAttr.TitleAttr.DayTxtAttr.Font.Color := clHighlightText;
FSelCellAttr.TitleAttr.Height := Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
FScrollBtnAttr := TJvTFScrollBtnAttr.Create;
FScrollBtnAttr.OnChange := @ScrollBtnChange;
@ -1502,8 +1522,6 @@ begin
end;
end;
procedure TJvTFCustomGlance.CMCtl3DChanged(var Msg: TLMessage);
begin
if FBorderStyle = bsSingle then
@ -1543,6 +1561,36 @@ begin
inherited Click;
end;
{$IF LCL_FullVersion >= 1080000}
procedure TJvTFCustomGlance.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
(*
if IsStoredColHdrHeight then
FColHdrHeight := round(FColHdrHeight * AYProportion);
if IsStoredDefColWidth then
FDefColWidth := round(FDefColWidth * AXProportion);
if IsStoredGroupHdrHeight then
FGroupHdrHeight := round(FGroupHdrHeight * AYProportion);
if IsStoredMinColWidth then
FMinColWidth := round(FMinColWidth * AXProportion);
if IsStoredMinRowHeight then
FMinRowHeight := round(FMinRowHeight * AYProportion);
if IsStoredRowHdrWidth then
FRowHdrWidth := round(FRowHdrWidth * AXProportion);
if IsStoredRowHeight then
FRowHeight := round(FRowHeight * AYProportion);
*)
FCellAttr.TitleAttr.AutoAdjustLayout(AMode, AXProportion, AYProportion);
FTitleAttr.AutoAdjustLayout(AMode, AXProportion, AYProportion);
end;
end;
{$IFEND}
procedure TJvTFCustomGlance.DoConfigCells;
begin
if Assigned(FOnConfigCells) then
@ -3180,6 +3228,28 @@ begin
end;
end;
{$IF LCL_FullVersion >= 1080100}
procedure TJvTFCustomGlance.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
begin
inherited;
DoScaleFontPPI(CellAttr.Font, AToPPI, AProportion);
DoScaleFontPPI(CellAttr.TitleAttr.DayTxtAttr.Font, AToPPI, AProportion);
DoScaleFontPPI(SelCellAttr.Font, AToPPI, AProportion);
DoScaleFontPPI(SelCellAttr.TitleAttr.DayTxtAttr.Font, AToPPI, AProportion);
DoScaleFontPPI(TitleAttr.TxtAttr.Font, AToPPI, AProportion);
end;
{$ELSEIF LCL_FullVersion >= 1080000}
procedure TJvTFDays.ScaleFontsPPI(const AProportion: Double);
begin
inherited;
DoScaleFontPPI(CellAttr.Font, AProportion);
DoScaleFontPPI(CellAttr.TitleAttr.TxtAttr.Font, AProportion);
DoScaleFontPPI(SelCellAttr.Font, AProportion);
DoScaleFontPPI(SelCellAttr.TitleAttr.TxtAttr.Font, AProportion);
DoScaleFontPPI(TitleAttr.TxtAttr.Font, AProportion);
end;
{$IFEND}
procedure TJvTFCustomGlance.SplitCell(ACell: TJvTFGlanceCell);
begin
ACell.Split;
@ -3210,7 +3280,7 @@ begin
FFrameAttr := TJvTFGlanceFrameAttr.Create(AOwner);
FColor := clBtnFace;
FHeight := 40;
FHeight := DEFAULT_GLANCE_TITLE_HEIGHT; // is scaled by GlanceControl
FVisible := True;
end;
@ -3238,12 +3308,31 @@ begin
inherited Assign(Source);
end;
procedure TJvTFGlanceTitle.AutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
if IsStoredHeight then
FHeight := round(FHeight * AYProportion);
end;
end;
procedure TJvTFGlanceTitle.Change;
begin
if Assigned(FOnChange) then
FOnChange(Self);
end;
function TJvTFGlanceTitle.IsStoredHeight: Boolean;
begin
if Assigned(GlanceControl) then
Result := FHeight <> GlanceControl.Scale96ToFont(DEFAULT_GLANCE_TITLE_HEIGHT)
else
Result := true;
end;
procedure TJvTFGlanceTitle.SetColor(Value: TColor);
begin
if Value <> FColor then
@ -3447,7 +3536,7 @@ begin
FAlign := alTop;
FColor := clBtnFace;
FHeight := 20;
FHeight := FGlanceControl.Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
FVisible := True;
//FDayFormat := 'd';
@ -3488,6 +3577,17 @@ begin
inherited Assign(Source);
end;
procedure TJvTFGlanceTitleAttr.AutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
if IsStoredHeight then
FHeight := round(FHeight * AYProportion);
end;
end;
procedure TJvTFGlanceTitleAttr.Change;
begin
if Assigned(GlanceControl) then
@ -3498,6 +3598,14 @@ begin
end;
end;
function TJvTFGlanceTitleAttr.IsStoredHeight: Boolean;
begin
if Assigned(GlanceControl) then
Result := FHeight <> GlanceControl.Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT)
else
Result := true;
end;
procedure TJvTFGlanceTitleAttr.PicAttrChange(Sender: TObject);
begin
Change;

27
components/jvcllaz/run/JvTimeFramework/jvtfweeks.pas
View File

@ -31,7 +31,7 @@ unit JvTFWeeks;
interface
uses
LCLIntf, LCLType, LMessages,
LCLIntf, LCLType, LMessages, LCLVersion,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
JvTFManager, JvTFGlance, JvTFUtils;
@ -68,6 +68,14 @@ type
function GetSplitParentDay: TTFDayOfWeek;
function GetCellTitleText(Cell: TJvTFGlanceCell): string; override;
{$IF LCL_FullVersion >= 1080000}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{ procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
const AProportion: Double); override;
}
{$IFEND}
// draws the DW Titles
procedure DrawTitle(ACanvas: TCanvas); override;
procedure UpdateTitle;
@ -190,8 +198,8 @@ begin
with FDWTitleAttr do
begin
Assign(TitleAttr);
TxtAttr.Font.Size := 8;
Height := 20;
// TxtAttr.Font.Size := 8;
Height := Scale96ToFont(DEFAULT_GLANCE_CELL_TITLE_HEIGHT);
OnChange := @GlanceTitleChange;
end;
@ -208,6 +216,19 @@ begin
inherited Destroy;
end;
{$IF LCL_FullVersion >= 1080000}
procedure TJvTFWeeks.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
FDWTitleAttr.AutoAdjustLayout(AMode, AXProportion, AYProportion);
end;
end;
{$IFEND}
function TJvTFWeeks.DisplayDayCount: Integer;
var
DOW: TTFDayOfWeek;