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

jvcllaz: Fix font scaling of TJvTMTimeline.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7270 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-01-11 23:33:06 +00:00
parent 9b9b3fed49
commit 886abdf31d
1 changed files with 85 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

124
components/jvcllaz/run/JvCustomControls/jvtmtimeline.pas
View File

@ -75,6 +75,7 @@ type
FObjects: TStringlist; FObjects: TStringlist;
FLeftBtn: TSpeedButton; FLeftBtn: TSpeedButton;
FRightBtn: TSpeedButton; FRightBtn: TSpeedButton;
FButtonWidth: Integer;
FMonthFont: TFont; FMonthFont: TFont;
FBtnDown: TJvBtnDown; FBtnDown: TJvBtnDown;
FReadOnly: Boolean; FReadOnly: Boolean;
@ -101,10 +102,11 @@ type
FLineColor: TColor; FLineColor: TColor;
FShift: TShiftState; FShift: TShiftState;
FShowTodayIcon: Boolean; FShowTodayIcon: Boolean;
function ButtonWidthStored: Boolean; function IsStoredMaxDate: Boolean;
function DayWidthStored: Boolean; function IsStoredMinDate: Boolean;
function IconDayDistStored: Boolean; function IsStoredButtonWidth: Boolean;
function GetButtonWidth: Integer; function IsStoredDayWidth: Boolean;
function IsStoredIconDayDist: Boolean;
function GetDayWidth: Integer; function GetDayWidth: Integer;
function GetIconDayDist: Integer; function GetIconDayDist: Integer;
function GetRectForDate(ADate: TDate): TRect; function GetRectForDate(ADate: TDate): TRect;
@ -155,14 +157,11 @@ type
procedure StopTimer; procedure StopTimer;
function DateHasImage(ADate: TDateTime): Boolean; function DateHasImage(ADate: TDateTime): Boolean;
procedure SetShowTodayIcon(const Value: Boolean); procedure SetShowTodayIcon(const Value: Boolean);
protected protected
// procedure GetDlgCode(var Code: TDlgCodes); override; <--- wp // procedure GetDlgCode(var Code: TDlgCodes); override; <--- wp
// procedure CursorChanged; override; <--- wo // procedure CursorChanged; override; <--- wo
procedure Change; virtual; procedure Change; virtual;
{$IF LCL_FullVersion >= 1080000}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$IFEND}
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure EnabledChanged; override; procedure EnabledChanged; override;
@ -171,6 +170,7 @@ type
function GetVisibleDays: Integer; function GetVisibleDays: Integer;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure LoadObject(Stream: TStream; var AObject: TObject); virtual; procedure LoadObject(Stream: TStream; var AObject: TObject); virtual;
procedure MonthFontChanged(Sender: TObject);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
@ -179,22 +179,22 @@ type
procedure SaveObject(Stream: TStream; const AObject: TObject); virtual; procedure SaveObject(Stream: TStream; const AObject: TObject); virtual;
procedure SetBorderStyle(Value: TBorderStyle); override; procedure SetBorderStyle(Value: TBorderStyle); override;
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle; property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsSingle;
property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthStored; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth stored IsStoredButtonWidth;
property Cursor; property Cursor;
property DayWidth: Integer read GetDayWidth write SetDayWidth stored DayWidthStored; property DayWidth: Integer read GetDayWidth write SetDayWidth stored IsStoredDayWidth;
property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline]; property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline];
property IconDayDistance: Integer read GetIconDayDist write SetIconDayDist stored IconDayDistStored; property IconDayDistance: Integer read GetIconDayDist write SetIconDayDist stored IsStoredIconDayDist;
property ImageCursor: TCursor read FImageCursor write SetImageCursor default crHandPoint; property ImageCursor: TCursor read FImageCursor write SetImageCursor default crHandPoint;
property Images: TImageList read FImages write SetImages; property Images: TImageList read FImages write SetImages;
property LargeChange: Word read FLargeChange write SetLargeChange default 30; property LargeChange: Word read FLargeChange write SetLargeChange default 30;
property Date: TDate read FDate write SetFirstDate; property Date: TDate read FDate write SetFirstDate;
property SelDate: TDate read FSelDate write SetSelDate; property SelDate: TDate read FSelDate write SetSelDate;
property MaxDate: TDate read FMaxDate write SetMaxDate; property MaxDate: TDate read FMaxDate write SetMaxDate stored IsStoredMaxDate;
property MinDate: TDate read FMinDate write SetMinDate; property MinDate: TDate read FMinDate write SetMinDate stored IsStoredMinDate;
property MonthFont: TFont read FMonthFont write SetMonthFont; property MonthFont: TFont read FMonthFont write SetMonthFont;
property ReadOnly: Boolean read FReadOnly write SetReadOnly; property ReadOnly: Boolean read FReadOnly write SetReadOnly default false;
property RightClickSelect: Boolean read FRightClickSelect write SetRightClickSelect; property RightClickSelect: Boolean read FRightClickSelect write SetRightClickSelect default false;
property SmallChange: Word read FSmallChange write SetSmallChange default 7; property SmallChange: Word read FSmallChange write SetSmallChange default 7;
property Selection: TJvTLSelFrame read FSelection write SetSelection; property Selection: TJvTLSelFrame read FSelection write SetSelection;
property TodayColor: TColor read FTodayColor write SetTodayColor default clAqua; property TodayColor: TColor read FTodayColor write SetTodayColor default clAqua;
@ -214,6 +214,19 @@ type
property OnWriteObject: TJvObjectWriteEvent read FOnWriteObject write FOnWriteObject; property OnWriteObject: TJvObjectWriteEvent read FOnWriteObject write FOnWriteObject;
property Align default alTop; property Align default alTop;
{ lcl scaling }
{$IF LCL_FullVersion >= 1080000}
protected
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
public
procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
const AProportion: Double); override;
{$IF LCL_FullVersion >= 2010000}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
{$IFEND}
{$IFEND}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -235,9 +248,6 @@ type
property Objects[ADate: TDate]: TObject read GetObjects write SetObjects; property Objects[ADate: TDate]: TObject read GetObjects write SetObjects;
end; end;
{$IFDEF RTL230_UP}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF RTL230_UP}
TJvTMTimeline = class(TJvCustomTMTimeline) TJvTMTimeline = class(TJvCustomTMTimeline)
public public
property RightButton; property RightButton;
@ -441,6 +451,7 @@ begin
FMonthFont.Style := [fsItalic, fsBold]; FMonthFont.Style := [fsItalic, fsBold];
FMonthFont.Name := 'Times New Roman'; FMonthFont.Name := 'Times New Roman';
FMonthFont.Size := 18; FMonthFont.Size := 18;
FMonthFont.OnChange := @MonthFontChanged;
FObjectsFontStyle := [fsUnderline]; FObjectsFontStyle := [fsUnderline];
FDayWidth := -1; FDayWidth := -1;
@ -459,11 +470,13 @@ begin
Font.Size := 0; Font.Size := 0;
Font.Name := 'default'; Font.Name := 'default';
FButtonWidth := Scale96ToFont(cTMTimeLineButtonWidth);
FLeftBtn := TSpeedButton.Create(Self); FLeftBtn := TSpeedButton.Create(Self);
with FLeftBtn do with FLeftBtn do
begin begin
Align := alLeft; Align := alLeft;
Width := cTMTimeLineButtonWidth; Width := FButtonWidth;
Parent := Self; Parent := Self;
Transparent := False; Transparent := False;
Layout := blGlyphTop; Layout := blGlyphTop;
@ -475,7 +488,6 @@ begin
finally finally
png.Free; png.Free;
end; end;
OnMouseDown := @DoLMouseDown; OnMouseDown := @DoLMouseDown;
OnMouseUp := @DoMouseUp; OnMouseUp := @DoMouseUp;
// OnClick := LeftClick; // OnClick := LeftClick;
@ -485,7 +497,7 @@ begin
with FRightBtn do with FRightBtn do
begin begin
Align := alRight; Align := alRight;
Width := cTMTimeLineButtonWidth; Width := FButtonWidth;
Parent := Self; Parent := Self;
Transparent := False; Transparent := False;
Layout := blGlyphTop; Layout := blGlyphTop;
@ -497,12 +509,12 @@ begin
finally finally
png.Free; png.Free;
end; end;
OnMouseDown := @DoRMouseDown; OnMouseDown := @DoRMouseDown;
OnMouseUp := @DoMouseUp; OnMouseUp := @DoMouseUp;
end; end;
FLeftBtn.SetSubComponent(True); FLeftBtn.SetSubComponent(True);
FRightBtn.SetSubComponent(True); FRightBtn.SetSubComponent(True);
Height := 64; Height := 64;
BevelInner := bvNone; BevelInner := bvNone;
BevelOuter := bvNone; BevelOuter := bvNone;
@ -880,7 +892,7 @@ end;
procedure TJvCustomTMTimeline.SetMonthFont(const Value: TFont); procedure TJvCustomTMTimeline.SetMonthFont(const Value: TFont);
begin begin
FMonthFont.Assign(Value); FMonthFont.Assign(Value);
Invalidate; //Invalidate;
end; end;
procedure TJvCustomTMTimeline.SetSelDate(const Value: TDate); procedure TJvCustomTMTimeline.SetSelDate(const Value: TDate);
@ -904,24 +916,29 @@ begin
end; end;
end; end;
function TJvCustomTMTimeLine.ButtonWidthStored: Boolean; function TJvCustomTMTimeLine.IsStoredMaxDate: Boolean;
begin
Result := FMaxDate <> 0;
end;
function TJvCustomTMTimeLine.IsStoredMinDate: Boolean;
begin
Result := FMinDate <> 0;
end;
function TJvCustomTMTimeLine.IsStoredButtonWidth: Boolean;
begin begin
Result := ButtonWidth <> Scale96ToFont(cTMTimeLineButtonWidth); Result := ButtonWidth <> Scale96ToFont(cTMTimeLineButtonWidth);
end; end;
function TJvCustomTMTimeLine.DayWidthStored: Boolean; function TJvCustomTMTimeLine.IsStoredDayWidth: Boolean;
begin begin
Result := FDayWidth >= 0; Result := FDayWidth >= 0;
end; end;
function TJvCustomTMTimeLine.GetButtonWidth: Integer;
begin
Result := FLeftBtn.Width;
end;
function TJvCustomTMTimeLine.GetDayWidth: Integer; function TJvCustomTMTimeLine.GetDayWidth: Integer;
begin begin
if DayWidthStored then if IsStoredDayWidth then
Result := FDayWidth Result := FDayWidth
else else
Result := Scale96ToFont(cTMTimeLineDayWidth); Result := Scale96ToFont(cTMTimeLineDayWidth);
@ -929,13 +946,13 @@ end;
function TJvCustomTMTimeLine.GetIconDayDist: Integer; function TJvCustomTMTimeLine.GetIconDayDist: Integer;
begin begin
if IconDayDistStored then if IsStoredIconDayDist then
Result := FIconDayDist Result := FIconDayDist
else else
Result := Scale96ToFont(cTMTimelineIconDayDist); Result := Scale96ToFont(cTMTimelineIconDayDist);
end; end;
function TJvCustomTMTimeLine.IconDayDistStored: Boolean; function TJvCustomTMTimeLine.IsStoredIconDayDist: Boolean;
begin begin
Result := FIconDayDist >= 0; Result := FIconDayDist >= 0;
end; end;
@ -949,6 +966,11 @@ begin
end; end;
end; end;
procedure TJvCustomTMTimeline.MonthFontChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TJvCustomTMTimeline.MouseDown(Button: TMouseButton; procedure TJvCustomTMTimeline.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
begin begin
@ -1059,15 +1081,38 @@ begin
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin begin
if DayWidthStored then if IsStoredDayWidth then
FDayWidth := Round(FDayWidth * AXProportion); FDayWidth := Round(FDayWidth * AXProportion);
if IconDayDistStored then if IsStoredIconDayDist then
FIconDayDist := Round(FIconDayDist * AYProportion); FIconDayDist := Round(FIconDayDist * AYProportion);
if IsStoredButtonWidth then begin
FButtonWidth := Round(FButtonWidth * AXProportion);
FLeftBtn.Width := FButtonWidth;
FRightBtn.Width := FButtonWidth;
end;
Invalidate; Invalidate;
end; end;
end; end;
{$IFEND} {$IFEND}
{$IF LCL_FullVersion >= 1080000}
procedure TJvCustomTMTimeLine.ScaleFontsPPI(
{$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
const AProportion: Double);
begin
inherited;
DoScaleFontPPI(FMonthFont, AToPPI, AProportion);
end;
{$IFEND}
{$IF LCL_FullVersion >= 2010000}
procedure TJvCustomTMTimeLine.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(FMonthFont, ADesignTimePPI);
end;
{$IFEND}
procedure TJvCustomTMTimeline.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TJvCustomTMTimeline.MouseMove(Shift: TShiftState; X, Y: Integer);
var var
ADate: TDate; ADate: TDate;
@ -1237,10 +1282,11 @@ end;
procedure TJvCustomTMTimeline.SetButtonWidth(const Value: Integer); procedure TJvCustomTMTimeline.SetButtonWidth(const Value: Integer);
begin begin
if (GetButtonWidth <> Value) and (Value > 0) then if (FButtonWidth <> Value) and (Value > 0) then
begin begin
FLeftBtn.Width := ButtonWidth; FButtonWidth := Value;
FRightBtn.Width := ButtonWidth; FLeftBtn.Width := Value;
FRightBtn.Width := Value;
Invalidate; Invalidate;
end; end;
end; end;