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

jvcllaz: Fix LCL scaling of TJvTMTimeline.DayWidth

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6616 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-08-28 16:37:43 +00:00
parent 7e6025369f
commit 5d76cc9d8c
5 changed files with 269 additions and 223 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpi
View File

@ -7,6 +7,7 @@
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<Title Value="SimpleTLTest1"/> <Title Value="SimpleTLTest1"/>
<Scaled Value="True"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<XPManifest> <XPManifest>

409
components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.lfm
View File

@ -10,6 +10,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
Constraints.MinHeight = 376 Constraints.MinHeight = 376
Constraints.MinWidth = 710 Constraints.MinWidth = 710
DefaultMonitor = dmDesktop DefaultMonitor = dmDesktop
DesignTimePPI = 144
Font.Color = clWindowText Font.Color = clWindowText
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
@ -22,13 +23,13 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
Scaled = False Scaled = False
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 339 Height = 469
Top = 225 Top = 90
Width = 926 Width = 926
Align = alBottom Align = alBottom
AutoSize = True AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 339 ClientHeight = 469
ClientWidth = 926 ClientWidth = 926
TabOrder = 0 TabOrder = 0
TabStop = True TabStop = True
@ -37,9 +38,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = Panel1 AnchorSideTop.Control = Panel1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 8 Left = 8
Height = 15 Height = 25
Top = 8 Top = 8
Width = 41 Width = 62
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Images:' Caption = 'Images:'
ParentColor = False ParentColor = False
@ -48,10 +49,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = gbDates AnchorSideLeft.Control = gbDates
AnchorSideTop.Control = gbDates AnchorSideTop.Control = gbDates
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 601 Left = 760
Height = 15 Height = 25
Top = 192 Top = 245
Width = 112 Width = 168
BorderSpacing.Top = 24 BorderSpacing.Top = 24
Caption = 'Keyboard navigation:' Caption = 'Keyboard navigation:'
ParentColor = False ParentColor = False
@ -60,10 +61,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = LblKeyboardNavigation AnchorSideLeft.Control = LblKeyboardNavigation
AnchorSideTop.Control = LblKeyboardNavigation AnchorSideTop.Control = LblKeyboardNavigation
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 617 Left = 776
Height = 30 Height = 50
Top = 211 Top = 274
Width = 181 Width = 280
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'Left/Right arrow:'#13#10#9'move Small Change days' Caption = 'Left/Right arrow:'#13#10#9'move Small Change days'
@ -73,10 +74,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label18 AnchorSideLeft.Control = Label18
AnchorSideTop.Control = Label18 AnchorSideTop.Control = Label18
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 617 Left = 776
Height = 30 Height = 50
Top = 245 Top = 328
Width = 181 Width = 280
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'Ctrl+Left/Right arrow:'#13#10#9'move Large Change days' Caption = 'Ctrl+Left/Right arrow:'#13#10#9'move Large Change days'
ParentColor = False ParentColor = False
@ -85,10 +86,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label19 AnchorSideLeft.Control = Label19
AnchorSideTop.Control = Label19 AnchorSideTop.Control = Label19
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 617 Left = 776
Height = 30 Height = 50
Top = 279 Top = 382
Width = 173 Width = 268
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'Shift+Left/Right arrow:'#13#10#9'move selection one day' Caption = 'Shift+Left/Right arrow:'#13#10#9'move selection one day'
ParentColor = False ParentColor = False
@ -97,24 +98,24 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = gbAppearance AnchorSideLeft.Control = gbAppearance
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = gbWidths AnchorSideTop.Control = gbWidths
Left = 601 Left = 760
Height = 160 Height = 213
Top = 8 Top = 8
Width = 230 Width = 264
AutoSize = True AutoSize = True
BorderSpacing.Left = 24 BorderSpacing.Left = 24
BorderSpacing.Right = 8 BorderSpacing.Right = 8
Caption = ' Dates: ' Caption = ' Dates: '
ClientHeight = 140 ClientHeight = 183
ClientWidth = 226 ClientWidth = 260
TabOrder = 2 TabOrder = 2
object Label2: TLabel object Label2: TLabel
AnchorSideLeft.Control = gbDates AnchorSideLeft.Control = gbDates
AnchorSideTop.Control = gbDates AnchorSideTop.Control = gbDates
Left = 12 Left = 12
Height = 15 Height = 25
Top = 0 Top = 0
Width = 87 Width = 131
BorderSpacing.Left = 12 BorderSpacing.Left = 12
Caption = 'First visible date:' Caption = 'First visible date:'
ParentColor = False ParentColor = False
@ -124,9 +125,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = dtpFirstDate AnchorSideTop.Control = dtpFirstDate
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 15 Height = 25
Top = 48 Top = 68
Width = 73 Width = 110
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Selected date:' Caption = 'Selected date:'
ParentColor = False ParentColor = False
@ -134,20 +135,20 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object Label4: TLabel object Label4: TLabel
AnchorSideLeft.Control = edImageNo AnchorSideLeft.Control = edImageNo
AnchorSideTop.Control = Label2 AnchorSideTop.Control = Label2
Left = 131 Left = 165
Height = 15 Height = 25
Top = 0 Top = 0
Width = 61 Width = 92
Caption = 'Add image:' Caption = 'Add image:'
ParentColor = False ParentColor = False
end end
object Label5: TLabel object Label5: TLabel
AnchorSideLeft.Control = edImageNo AnchorSideLeft.Control = edImageNo
AnchorSideTop.Control = Label3 AnchorSideTop.Control = Label3
Left = 131 Left = 165
Height = 15 Height = 25
Top = 48 Top = 68
Width = 39 Width = 59
Caption = 'at date:' Caption = 'at date:'
ParentColor = False ParentColor = False
end end
@ -156,10 +157,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = Label2 AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 23 Height = 33
Hint = 'Sets the first displayed date' Hint = 'Sets the first displayed date'
Top = 17 Top = 27
Width = 79 Width = 113
CenturyFrom = 1941 CenturyFrom = 1941
MaxDate = 2958465 MaxDate = 2958465
MinDate = -53780 MinDate = -53780
@ -184,10 +185,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = Label3 AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 23 Height = 33
Hint = 'Sets the selected day' Hint = 'Sets the selected day'
Top = 65 Top = 95
Width = 79 Width = 113
CenturyFrom = 1941 CenturyFrom = 1941
MaxDate = 2958465 MaxDate = 2958465
MinDate = -53780 MinDate = -53780
@ -212,10 +213,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2 AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 131 Left = 165
Height = 23 Height = 33
Hint = 'Sets the imageindex to insert at the current date'#13#10'(use -1 to remove image)' Hint = 'Sets the imageindex to insert at the current date'#13#10'(use -1 to remove image)'
Top = 17 Top = 27
Width = 68 Width = 68
BorderSpacing.Left = 40 BorderSpacing.Left = 40
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -225,9 +226,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udImageNo: TUpDown object udImageNo: TUpDown
AnchorSideLeft.Control = edImageNo AnchorSideLeft.Control = edImageNo
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
Left = 199 Left = 233
Height = 23 Height = 33
Top = 17 Top = 27
Width = 15 Width = 15
Associate = edImageNo Associate = edImageNo
BorderSpacing.Right = 12 BorderSpacing.Right = 12
@ -241,10 +242,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = udImageNo AnchorSideRight.Control = udImageNo
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 131 Left = 165
Height = 23 Height = 33
Hint = 'Sets the date to insert / delete an image' Hint = 'Sets the date to insert / delete an image'
Top = 65 Top = 95
Width = 83 Width = 83
CenturyFrom = 1941 CenturyFrom = 1941
MaxDate = 2958465 MaxDate = 2958465
@ -266,15 +267,18 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
CalAlignment = dtaLeft CalAlignment = dtaLeft
end end
object btnAdd: TButton object btnAdd: TButton
AnchorSideTop.Control = dtpImageDate
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = udImageNo AnchorSideRight.Control = udImageNo
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 166 Left = 188
Height = 25 Height = 35
Hint = 'Adds an image to the chosen date' Hint = 'Adds an image to the chosen date'
Top = 103 Top = 136
Width = 48 Width = 60
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
Caption = '&Add' Caption = '&Add'
OnClick = btnAddClick OnClick = btnAddClick
@ -285,24 +289,24 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = gbWidths AnchorSideLeft.Control = gbWidths
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = gbWidths AnchorSideTop.Control = gbWidths
Left = 319 Left = 369
Height = 194 Height = 284
Top = 8 Top = 8
Width = 258 Width = 367
AutoSize = True AutoSize = True
BorderSpacing.Left = 24 BorderSpacing.Left = 24
Caption = ' Appearance: ' Caption = ' Appearance: '
ClientHeight = 174 ClientHeight = 254
ClientWidth = 254 ClientWidth = 363
TabOrder = 1 TabOrder = 1
object Label13: TLabel object Label13: TLabel
AnchorSideLeft.Control = chkRClick AnchorSideLeft.Control = chkRClick
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = chkEnabled AnchorSideTop.Control = chkEnabled
Left = 128 Left = 179
Height = 15 Height = 25
Top = 63 Top = 93
Width = 114 Width = 172
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 12
Caption = 'Assigned object style:' Caption = 'Assigned object style:'
@ -312,10 +316,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = gbAppearance AnchorSideLeft.Control = gbAppearance
AnchorSideTop.Control = gbAppearance AnchorSideTop.Control = gbAppearance
Left = 12 Left = 12
Height = 19 Height = 29
Hint = 'Makes the control read-only' Hint = 'Makes the control read-only'
Top = 0 Top = 0
Width = 74 Width = 111
BorderSpacing.Left = 12 BorderSpacing.Left = 12
Caption = 'Read-only' Caption = 'Read-only'
OnClick = chkReadOnlyClick OnClick = chkReadOnlyClick
@ -326,10 +330,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = chkReadOnly AnchorSideTop.Control = chkReadOnly
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Hint = 'Makes the control flat' Hint = 'Makes the control flat'
Top = 21 Top = 31
Width = 39 Width = 58
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Flat' Caption = 'Flat'
OnClick = chkFlatClick OnClick = chkFlatClick
@ -340,10 +344,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = chkFlat AnchorSideTop.Control = chkFlat
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Hint = 'Moves the selection on right-click too' Hint = 'Moves the selection on right-click too'
Top = 42 Top = 62
Width = 108 Width = 159
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Right click select' Caption = 'Right click select'
OnClick = chkRClickClick OnClick = chkRClickClick
@ -354,10 +358,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = chkRClick AnchorSideTop.Control = chkRClick
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Hint = 'Enables the control' Hint = 'Enables the control'
Top = 63 Top = 93
Width = 62 Width = 93
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Enabled' Caption = 'Enabled'
Checked = True Checked = True
@ -370,9 +374,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = chkEnabled AnchorSideTop.Control = chkEnabled
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Top = 84 Top = 124
Width = 82 Width = 125
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Show today' Caption = 'Show today'
Checked = True Checked = True
@ -385,9 +389,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = chkShowTodayIcon AnchorSideTop.Control = chkShowTodayIcon
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Top = 126 Top = 186
Width = 84 Width = 127
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Show weeks' Caption = 'Show weeks'
Checked = True Checked = True
@ -401,9 +405,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Top = 147 Top = 217
Width = 93 Width = 140
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Show months' Caption = 'Show months'
@ -416,15 +420,16 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label13 AnchorSideLeft.Control = Label13
AnchorSideTop.Control = Label13 AnchorSideTop.Control = Label13
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbAppearance
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = chkShowMonths AnchorSideBottom.Control = chkShowMonths
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 128 Left = 179
Height = 86 Height = 126
Hint = 'Sets the font to use for day items that'#13#10'have a non-nil Objects item' Hint = 'Sets the font to use for day items that'#13#10'have a non-nil Objects item'
Top = 80 Top = 120
Width = 107 Width = 172
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 12 BorderSpacing.Right = 12
IntegralHeight = True IntegralHeight = True
@ -434,7 +439,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
'Underline' 'Underline'
'Strikeout' 'Strikeout'
) )
ItemHeight = 17 ItemHeight = 27
OnClickCheck = lbObjFontStyleClickCheck OnClickCheck = lbObjFontStyleClickCheck
TabOrder = 8 TabOrder = 8
Data = { Data = {
@ -446,9 +451,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = chkShowToday AnchorSideTop.Control = chkShowToday
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 29
Top = 105 Top = 155
Width = 108 Width = 163
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Show today icon' Caption = 'Show today icon'
Checked = True Checked = True
@ -462,25 +467,25 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = gbFonts AnchorSideTop.Control = gbFonts
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 373 Left = 447
Height = 94 Height = 124
Top = 210 Top = 300
Width = 145 Width = 185
AutoSize = True AutoSize = True
BorderSpacing.Left = 24 BorderSpacing.Left = 24
BorderSpacing.Bottom = 16 BorderSpacing.Bottom = 16
Caption = ' Misc. ' Caption = ' Misc. '
ClientHeight = 74 ClientHeight = 94
ClientWidth = 141 ClientWidth = 181
TabOrder = 4 TabOrder = 4
object btnLoad: TButton object btnLoad: TButton
AnchorSideLeft.Control = gbMisc AnchorSideLeft.Control = gbMisc
AnchorSideTop.Control = gbMisc AnchorSideTop.Control = gbMisc
Left = 16 Left = 16
Height = 25 Height = 35
Hint = 'Loads a previously saved timeline file' Hint = 'Loads a previously saved timeline file'
Top = 4 Top = 4
Width = 109 Width = 149
AutoSize = True AutoSize = True
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -496,10 +501,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideRight.Control = btnLoad AnchorSideRight.Control = btnLoad
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 16 Left = 16
Height = 25 Height = 35
Hint = 'Saves the current content to a timeline file' Hint = 'Saves the current content to a timeline file'
Top = 37 Top = 47
Width = 109 Width = 149
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -514,14 +519,14 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = gbAppearance AnchorSideTop.Control = gbAppearance
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 104 Left = 104
Height = 129 Height = 169
Top = 210 Top = 300
Width = 245 Width = 319
AutoSize = True AutoSize = True
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = ' Fonts and colors: ' Caption = ' Fonts and colors: '
ClientHeight = 109 ClientHeight = 139
ClientWidth = 241 ClientWidth = 315
TabOrder = 3 TabOrder = 3
object btnFont: TButton object btnFont: TButton
AnchorSideLeft.Control = btnColor AnchorSideLeft.Control = btnColor
@ -530,10 +535,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideRight.Control = btnMonthFont AnchorSideRight.Control = btnMonthFont
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 12 Left = 12
Height = 25 Height = 35
Hint = 'Sets the font for days' Hint = 'Sets the font for days'
Top = 37 Top = 47
Width = 96 Width = 129
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -547,10 +552,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideRight.Control = btnMonthFont AnchorSideRight.Control = btnMonthFont
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 12 Left = 12
Height = 25 Height = 35
Hint = 'Sets the background color' Hint = 'Sets the background color'
Top = 4 Top = 4
Width = 96 Width = 129
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -563,10 +568,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = btnFont AnchorSideTop.Control = btnFont
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 25 Height = 35
Hint = 'Sets the font for months and years' Hint = 'Sets the font for months and years'
Top = 70 Top = 90
Width = 96 Width = 129
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 12
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -579,11 +584,11 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = btnFont AnchorSideTop.Control = btnFont
AnchorSideRight.Control = btnPenColor AnchorSideRight.Control = btnPenColor
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 116 Left = 149
Height = 25 Height = 35
Hint = 'Sets the background color for the today item' Hint = 'Sets the background color for the today item'
Top = 37 Top = 47
Width = 113 Width = 154
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
Caption = 'Today color...' Caption = 'Today color...'
@ -595,10 +600,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = btnColor AnchorSideTop.Control = btnColor
AnchorSideRight.Control = btnPenColor AnchorSideRight.Control = btnPenColor
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 116 Left = 149
Height = 25 Height = 35
Top = 4 Top = 4
Width = 113 Width = 154
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = True AutoSize = True
Caption = 'Line color...' Caption = 'Line color...'
@ -609,11 +614,11 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = btnMonthFont AnchorSideLeft.Control = btnMonthFont
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btnMonthFont AnchorSideTop.Control = btnMonthFont
Left = 116 Left = 149
Height = 25 Height = 35
Hint = 'Sets the color of the selection frame' Hint = 'Sets the color of the selection frame'
Top = 70 Top = 90
Width = 113 Width = 154
AutoSize = True AutoSize = True
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 12
@ -628,24 +633,24 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = LblImages AnchorSideTop.Control = LblImages
Left = 104 Left = 104
Height = 161 Height = 221
Top = 8 Top = 8
Width = 191 Width = 241
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 12
Caption = ' Widths and sizes: ' Caption = ' Widths and sizes: '
ClientHeight = 141 ClientHeight = 191
ClientWidth = 187 ClientWidth = 237
TabOrder = 0 TabOrder = 0
object Label1: TLabel object Label1: TLabel
AnchorSideTop.Control = edDayWidth AnchorSideTop.Control = edDayWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 30 Left = 37
Height = 15 Height = 25
Top = 60 Top = 80
Width = 56 Width = 84
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Day width:' Caption = 'Day width:'
@ -656,10 +661,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 10 Left = 9
Height = 15 Height = 25
Top = 87 Top = 117
Width = 76 Width = 112
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Sel. line width:' Caption = 'Sel. line width:'
@ -670,9 +675,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
Left = 12 Left = 12
Height = 15 Height = 25
Top = 6 Top = 6
Width = 74 Width = 109
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 12 BorderSpacing.Left = 12
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -685,9 +690,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 12 Left = 12
Height = 15 Height = 25
Top = 33 Top = 43
Width = 74 Width = 109
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 9 BorderSpacing.Left = 9
Caption = 'Large change:' Caption = 'Large change:'
@ -698,10 +703,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 14 Left = 15
Height = 15 Height = 25
Top = 114 Top = 154
Width = 72 Width = 106
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Button width:' Caption = 'Button width:'
@ -711,10 +716,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edScrollSmall AnchorSideTop.Control = edScrollSmall
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 146 Left = 181
Height = 15 Height = 25
Top = 6 Top = 6
Width = 24 Width = 37
Caption = 'days' Caption = 'days'
ParentColor = False ParentColor = False
end end
@ -722,10 +727,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edScrollLarge AnchorSideTop.Control = edScrollLarge
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 146 Left = 181
Height = 15 Height = 25
Top = 33 Top = 43
Width = 24 Width = 37
Caption = 'days' Caption = 'days'
ParentColor = False ParentColor = False
end end
@ -733,10 +738,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = edDayWidth AnchorSideTop.Control = edDayWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 146 Left = 181
Height = 15 Height = 25
Top = 60 Top = 80
Width = 29 Width = 44
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 12 BorderSpacing.Right = 12
Caption = 'pixels' Caption = 'pixels'
@ -746,10 +751,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edPenWidth AnchorSideTop.Control = edPenWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 146 Left = 181
Height = 15 Height = 25
Top = 87 Top = 117
Width = 29 Width = 44
Caption = 'pixels' Caption = 'pixels'
ParentColor = False ParentColor = False
end end
@ -757,10 +762,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edButtonWidth AnchorSideTop.Control = edButtonWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 146 Left = 181
Height = 15 Height = 25
Top = 114 Top = 154
Width = 29 Width = 44
Caption = 'pixels' Caption = 'pixels'
ParentColor = False ParentColor = False
end end
@ -770,10 +775,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 90 Left = 125
Height = 23 Height = 33
Hint = 'Sets the width in pixels of a single day' Hint = 'Sets the width in pixels of a single day'
Top = 56 Top = 76
Width = 33 Width = 33
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -783,9 +788,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udDayWidth: TUpDown object udDayWidth: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 127 Left = 162
Height = 23 Height = 33
Top = 56 Top = 76
Width = 15 Width = 15
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Associate = edDayWidth Associate = edDayWidth
@ -801,10 +806,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 90 Left = 125
Height = 23 Height = 33
Hint = 'Sets the width of the selection frame' Hint = 'Sets the width of the selection frame'
Top = 83 Top = 113
Width = 33 Width = 33
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -814,9 +819,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udPenWidth: TUpDown object udPenWidth: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 127 Left = 162
Height = 23 Height = 33
Top = 83 Top = 113
Width = 15 Width = 15
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Associate = edPenWidth Associate = edPenWidth
@ -828,8 +833,8 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object edScrollSmall: TEdit object edScrollSmall: TEdit
AnchorSideTop.Control = gbWidths AnchorSideTop.Control = gbWidths
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
Left = 90 Left = 125
Height = 23 Height = 33
Hint = 'Sets the number of days to scroll when clicking the buttons '#13#10'or when using the arrow-keys' Hint = 'Sets the number of days to scroll when clicking the buttons '#13#10'or when using the arrow-keys'
Top = 2 Top = 2
Width = 33 Width = 33
@ -841,8 +846,8 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
end end
object udScrollSmall: TUpDown object udScrollSmall: TUpDown
AnchorSideRight.Control = Label11 AnchorSideRight.Control = Label11
Left = 127 Left = 162
Height = 23 Height = 33
Top = 2 Top = 2
Width = 15 Width = 15
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
@ -860,10 +865,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 90 Left = 125
Height = 23 Height = 33
Hint = 'Sets the number of days to scroll when Ctrl + clicking the buttons '#13#10'or when using Ctrl+left arrow or Ctrl+right arrow' Hint = 'Sets the number of days to scroll when Ctrl + clicking the buttons '#13#10'or when using Ctrl+left arrow or Ctrl+right arrow'
Top = 29 Top = 39
Width = 33 Width = 33
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -873,9 +878,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udScrollLarge: TUpDown object udScrollLarge: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 127 Left = 162
Height = 23 Height = 33
Top = 29 Top = 39
Width = 15 Width = 15
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Associate = edScrollLarge Associate = edScrollLarge
@ -891,10 +896,10 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 90 Left = 125
Height = 23 Height = 33
Hint = 'Sets the width of the scrollbuttons' Hint = 'Sets the width of the scrollbuttons'
Top = 110 Top = 150
Width = 33 Width = 33
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -905,9 +910,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udButtonWidth: TUpDown object udButtonWidth: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 127 Left = 162
Height = 23 Height = 33
Top = 110 Top = 150
Width = 15 Width = 15
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Associate = edButtonWidth Associate = edButtonWidth
@ -925,8 +930,8 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideBottom.Control = Panel1 AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 312 Height = 432
Top = 27 Top = 37
Width = 84 Width = 84
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -940,9 +945,9 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 28
Hint = 'Displays info about the control' Hint = 'Displays info about the control'
Top = 568 Top = 563
Width = 926 Width = 926
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Panels = < Panels = <

12
components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.pas
View File

@ -34,7 +34,7 @@ interface
uses uses
LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, Buttons, ImgList, DateTimePicker, ExtCtrls, ComCtrls, StdCtrls, Buttons, ImgList, DateTimePicker,
Menus, CheckLst, ComboEx, JvTMTimeLine, Types; Menus, CheckLst, JvTMTimeLine, Types;
type type
@ -197,13 +197,15 @@ begin
'Double-click a date to edit it''s memo content.' + 'Double-click a date to edit it''s memo content.' +
LineEnding + LineEnding +
'Right-click to display pop-up menu.'; 'Right-click to display pop-up menu.';
JvTimeLine1.Date := dtpFirstDate.Date;
JvTimeLine1.SelDate := dtpSelDate.Date;
dtpSelDate.Date := Date; dtpSelDate.Date := Date;
dtpFirstDate.Date := Date-7; dtpFirstDate.Date := Date-7;
dtpImageDate.Date := Date+7; dtpImageDate.Date := Date+7;
udDayWidth.Position := JvTimeLine1.DayWidth; udDayWidth.Position := JvTimeLine1.DayWidth;
udButtonWidth.Position := JvTimeLine1.ButtonWidth;
chkReadOnly.Checked := JvTimeLine1.ReadOnly; chkReadOnly.Checked := JvTimeLine1.ReadOnly;
JvTimeLine1.Date := dtpFirstDate.Date;
JvTimeLine1.SelDate := dtpSelDate.Date;
lbObjFontStyle.Checked[2] := true; lbObjFontStyle.Checked[2] := true;
for i := 0 to il16.Count - 1 do for i := 0 to il16.Count - 1 do
LbImages.Items.Add(IntToStr(i)); LbImages.Items.Add(IntToStr(i));
@ -211,9 +213,10 @@ begin
LbImages.ItemHeight := Max(il16.Height, abs(LbImages.Font.Height)) + IMAGE_DIST; LbImages.ItemHeight := Max(il16.Height, abs(LbImages.Font.Height)) + IMAGE_DIST;
i := LbImages.Canvas.TextWidth('99'); i := LbImages.Canvas.TextWidth('99');
LbImages.Width := Max( LbImages.Width := Max(
il16.Width + 4 * abs(LbImages.Font.Height) + 3 * IMAGE_DIST, il16.Width + 4 * abs(LbImages.Font.Height) + 3 * Scale96ToFont(IMAGE_DIST),
LblImages.Width LblImages.Width
); );
udDayWidth.Position := jvTimeLine1.DayWidth;
ActiveControl := JvTimeLine1; ActiveControl := JvTimeLine1;
end; end;
@ -352,7 +355,6 @@ end;
procedure TTMTimeLineMainForm.udDayWidthClick(Sender: TObject; Button: TUDBtnType); procedure TTMTimeLineMainForm.udDayWidthClick(Sender: TObject; Button: TUDBtnType);
begin begin
JvTimeLine1.DayWidth := udDayWidth.Position; JvTimeLine1.DayWidth := udDayWidth.Position;
udDayWidth.Position := JvTimeLine1.DayWidth;
StatusBarResize(Sender); StatusBarResize(Sender);
end; end;

2
components/jvcllaz/run/JvCustomControls/jvtimeline.pas
View File

@ -1129,12 +1129,12 @@ begin
FItemHintImageList.Free; FItemHintImageList.Free;
inherited Destroy; inherited Destroy;
end; end;
procedure TJvCustomTimeLine.DoYearFontChange(Sender: TObject); procedure TJvCustomTimeLine.DoYearFontChange(Sender: TObject);
begin begin
Invalidate; Invalidate;
end; end;
procedure TJvCustomTimeLine.CreateWnd; procedure TJvCustomTimeLine.CreateWnd;
var var
I: TJvScrollArrow; I: TJvScrollArrow;

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

@ -33,10 +33,13 @@ unit JvTMTimeLine;
interface interface
uses uses
LCLIntf, LCLType, LMessages, Types, LCLIntf, LCLType, LMessages, LCLVersion, Types,
SysUtils, Classes, Controls, Buttons, Graphics, ExtCtrls, Forms, ImgList, SysUtils, Classes, Controls, Buttons, Graphics, ExtCtrls, Forms, ImgList,
JvExControls; JvExControls;
const
cTMTimeLineDayWidth = 19;
type type
TJvTLSelFrame = class(TPersistent) TJvTLSelFrame = class(TPersistent)
private private
@ -97,6 +100,8 @@ type
FLineColor: TColor; FLineColor: TColor;
FShift: TShiftState; FShift: TShiftState;
FShowTodayIcon: Boolean; FShowTodayIcon: Boolean;
function DayWidthStored: Boolean;
function GetDayWidth: Integer;
function GetRectForDate(ADate: TDate): TRect; function GetRectForDate(ADate: TDate): TRect;
function DateFromPos(APos: Integer): TDate; function DateFromPos(APos: Integer): TDate;
procedure DoTimer(Sender: TObject); procedure DoTimer(Sender: TObject);
@ -148,6 +153,10 @@ type
// 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;
{$IFDEF 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;
@ -167,7 +176,7 @@ type
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle; property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 16; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 16;
property Cursor; property Cursor;
property DayWidth: Integer read FDayWidth write SetDayWidth default 19; property DayWidth: Integer read GetDayWidth write SetDayWidth stored DayWidthStored;
property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline]; property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline];
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;
@ -417,7 +426,7 @@ begin
FButtonWidth := 16; FButtonWidth := 16;
FDate := SysUtils.Date - 7; FDate := SysUtils.Date - 7;
FSelDate := FDate - 1; FSelDate := FDate - 1;
FDayWidth := 19; FDayWidth := -1;
FImageCursor := crHandPoint; FImageCursor := crHandPoint;
FSmallChange := 7; FSmallChange := 7;
FLargeChange := 30; FLargeChange := 30;
@ -600,7 +609,7 @@ begin
Tmp := APos - ButtonWidth Tmp := APos - ButtonWidth
else else
Tmp := APos - 1; Tmp := APos - 1;
Result := Self.Date + (Tmp div FDayWidth); Result := Self.Date + (Tmp div DayWidth);
end; end;
procedure TJvCustomTMTimeline.DrawToday(ACanvas: TCanvas; const ARect: TRect); procedure TJvCustomTMTimeline.DrawToday(ACanvas: TCanvas; const ARect: TRect);
@ -653,14 +662,14 @@ begin
FirstOffset := 1; FirstOffset := 1;
// first loop: draw dates, today and images // first loop: draw dates, today and images
FTmpStyle := Font.Style; FTmpStyle := Font.Style;
for I := 0 to Width div FDayWidth do for I := 0 to Width div DayWidth do
begin begin
R := GetRectForDate(Self.Date + I); R := GetRectForDate(Self.Date + I);
if Self.Date + I = SysUtils.Date then if Self.Date + I = SysUtils.Date then
DrawToday(ACanvas, R); DrawToday(ACanvas, R);
DecodeDate(Self.Date + I, Y, M, D); DecodeDate(Self.Date + I, Y, M, D);
R := Classes.Rect(I * FDayWidth, 8, I * FDayWidth + FDayWidth, Font.Size+8); R := Classes.Rect(I * DayWidth, 8, I * DayWidth + DayWidth, Font.Size+8);
OffsetRect(R, FirstOffset, 0); OffsetRect(R, FirstOffset, 0);
S := Format('%.2d', [D]); S := Format('%.2d', [D]);
SetBkMode(ACanvas.Handle, TRANSPARENT); SetBkMode(ACanvas.Handle, TRANSPARENT);
@ -695,8 +704,8 @@ begin
Pen.Width := 1; Pen.Width := 1;
Pen.Style := psDot; Pen.Style := psDot;
Pen.Color := FLineColor; Pen.Color := FLineColor;
MoveTo(I * FDayWidth + FDayWidth + FirstOffset, 0); MoveTo(I * DayWidth + DayWidth + FirstOffset, 0);
LineTo(I * FDayWidth + FDayWidth + FirstOffset, Height); LineTo(I * DayWidth + DayWidth + FirstOffset, Height);
end; end;
ACanvas.Font := MonthFont; ACanvas.Font := MonthFont;
@ -709,8 +718,8 @@ begin
// draw text for end of this month: // draw text for end of this month:
S := FormatSettings.ShortMonthNames[M]; S := FormatSettings.ShortMonthNames[M];
Size := ACanvas.TextExtent(S); Size := ACanvas.TextExtent(S);
R := Classes.Rect(I * FDayWidth + FDayWidth - Size.cx - 8, R := Classes.Rect(I * DayWidth + DayWidth - Size.cx - 8,
Height - Size.cy - 4, I * FDayWidth + FDayWidth, Height - 4); Height - Size.cy - 4, I * DayWidth + DayWidth, Height - 4);
OffsetRect(R, FirstOffset, 0); OffsetRect(R, FirstOffset, 0);
SetBkMode(ACanvas.Handle, TRANSPARENT); SetBkMode(ACanvas.Handle, TRANSPARENT);
DrawText(ACanvas.Handle, PChar(S), Length(S), R, DrawText(ACanvas.Handle, PChar(S), Length(S), R,
@ -722,7 +731,7 @@ begin
// draw text for start of this month and the year: // draw text for start of this month and the year:
S := Format('%s %d', [FormatSettings.ShortMonthNames[M], Y]); S := Format('%s %d', [FormatSettings.ShortMonthNames[M], Y]);
Size := ACanvas.TextExtent(S); Size := ACanvas.TextExtent(S);
R := Classes.Rect(I * FDayWidth + 4, Height - Size.cy - 4, I * FDayWidth + Size.cx + 4, Height - 4); R := Classes.Rect(I * DayWidth + 4, Height - Size.cy - 4, I * DayWidth + Size.cx + 4, Height - 4);
OffsetRect(R, FirstOffset, 0); OffsetRect(R, FirstOffset, 0);
SetBkMode(ACanvas.Handle, TRANSPARENT); SetBkMode(ACanvas.Handle, TRANSPARENT);
DrawText(ACanvas.Handle, PChar(S), Length(S), R, DrawText(ACanvas.Handle, PChar(S), Length(S), R,
@ -734,8 +743,8 @@ begin
Pen.Width := 1; Pen.Width := 1;
Pen.Style := psSolid; Pen.Style := psSolid;
Pen.Color := FLineColor; Pen.Color := FLineColor;
MoveTo(I * FDayWidth + FirstOffset, 0); MoveTo(I * DayWidth + FirstOffset, 0);
LineTo(I * FDayWidth + FirstOffset, Height); LineTo(I * DayWidth + FirstOffset, Height);
end; end;
end; end;
end; end;
@ -781,7 +790,7 @@ begin
if DateHasImage(ADate) then if DateHasImage(ADate) then
begin begin
I := ImageIndex[ADate]; I := ImageIndex[ADate];
X := ARect.Left + (FDayWidth - Images.Width) div 2; X := ARect.Left + (DayWidth - Images.Width) div 2;
// Y := Max((Height - Images.Height) div 4, CanvasMaxTextHeight(ACanvas) + 2); // Y := Max((Height - Images.Height) div 4, CanvasMaxTextHeight(ACanvas) + 2);
Y := CanvasMaxTextHeight(ACanvas) + 2; Y := CanvasMaxTextHeight(ACanvas) + 2;
Images.Draw(ACanvas, X, Y, I); Images.Draw(ACanvas, X, Y, I);
@ -869,9 +878,22 @@ begin
end; end;
end; end;
function TJvCustomTMTimeLine.DayWidthStored: Boolean;
begin
Result := FDayWidth >= 0;
end;
function TJvCustomTMTimeLine.GetDayWidth: Integer;
begin
if DayWidthStored then
Result := FDayWidth
else
Result := Scale96ToFont(cTMTimeLineDayWidth);
end;
procedure TJvCustomTMTimeline.SetDayWidth(const Value: Integer); procedure TJvCustomTMTimeline.SetDayWidth(const Value: Integer);
begin begin
if (FDayWidth <> Value) and (Value > 0) then if (FDayWidth <> Value) and (Value <> 0) and (Value >= -1) then
begin begin
FDayWidth := Value; FDayWidth := Value;
Invalidate; Invalidate;
@ -979,6 +1001,22 @@ begin
FOnChange(Self); FOnChange(Self);
end; end;
{$IFDEF LCL_FullVersion >= 1080000}
procedure TCustomTMTimeLine.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
if FDayWidthStored then
FDayWidth := Round(FDayWidth * AXProportion);
Invalidate;
end;
end;
{$IFEND}
procedure TJvCustomTMTimeline.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TJvCustomTMTimeline.MouseMove(Shift: TShiftState; X, Y: Integer);
var var
ADate: TDate; ADate: TDate;