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

jvcllaz: Fix LCL scaling of TJvTMTimeLine.ButtonWidth

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6617 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-08-28 16:48:15 +00:00
parent 5d76cc9d8c
commit b9a474c8ca
1 changed files with 27 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -39,6 +39,7 @@ uses
const
cTMTimeLineDayWidth = 19;
cTMTimeLineButtonWidth = 16;
type
TJvTLSelFrame = class(TPersistent)
@ -100,7 +101,9 @@ type
FLineColor: TColor;
FShift: TShiftState;
FShowTodayIcon: Boolean;
function ButtonWidthStored: Boolean;
function DayWidthStored: Boolean;
function GetButtonWidth: Integer;
function GetDayWidth: Integer;
function GetRectForDate(ADate: TDate): TRect;
function DateFromPos(APos: Integer): TDate;
@ -174,7 +177,7 @@ type
procedure SetBorderStyle(Value: TBorderStyle); override;
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 16;
property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthStored;
property Cursor;
property DayWidth: Integer read GetDayWidth write SetDayWidth stored DayWidthStored;
property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline];
@ -423,10 +426,10 @@ begin
FMonthFont.Size := 18;
FObjectsFontStyle := [fsUnderline];
FButtonWidth := 16;
FButtonWidth := -1;
FDayWidth := -1;
FDate := SysUtils.Date - 7;
FSelDate := FDate - 1;
FDayWidth := -1;
FImageCursor := crHandPoint;
FSmallChange := 7;
FLargeChange := 30;
@ -443,7 +446,7 @@ begin
with FLeftBtn do
begin
Align := alLeft;
Width := FButtonWidth;
Width := ButtonWidth;
Parent := Self;
Transparent := False;
Layout := blGlyphTop;
@ -464,7 +467,7 @@ begin
with FRightBtn do
begin
Align := alRight;
Width := FButtonWidth;
Width := ButtonWidth;
Parent := Self;
Transparent := False;
Layout := blGlyphTop;
@ -878,11 +881,24 @@ begin
end;
end;
function TJvCustomTMTimeLine.ButtonWidthStored: Boolean;
begin
Result := FButtonWidth >= 0;
end;
function TJvCustomTMTimeLine.DayWidthStored: Boolean;
begin
Result := FDayWidth >= 0;
end;
function TJvCustomTMTimeLine.GetButtonWidth: Integer;
begin
if ButtonWidthStored then
Result := FButtonWidth
else
Result := Scale96ToFont(cTMTimeLineButtonWidth);
end;
function TJvCustomTMTimeLine.GetDayWidth: Integer;
begin
if DayWidthStored then
@ -1012,6 +1028,8 @@ begin
begin
if FDayWidthStored then
FDayWidth := Round(FDayWidth * AXProportion);
if FButtonWidthStored then
FButtonWidth := Round(FButtonWidth * aXProportion);
Invalidate;
end;
end;
@ -1178,7 +1196,7 @@ var
Tmp: Integer;
begin
if not ReadOnly then
Tmp := FButtonWidth * 2
Tmp := ButtonWidth * 2
else
Tmp := 1;
Result := FDate + ((Width - Tmp) div DayWidth) - 1;
@ -1186,11 +1204,11 @@ end;
procedure TJvCustomTMTimeline.SetButtonWidth(const Value: Integer);
begin
if FButtonWidth <> Value then
if (FButtonWidth <> Value) and (Value <> 0) and (Value >= -1) then
begin
FButtonWidth := Value;
FLeftBtn.Width := FButtonWidth;
FRightBtn.Width := FButtonWidth;
FLeftBtn.Width := ButtonWidth;
FRightBtn.Width := ButtonWidth;
Invalidate;
end;
end;