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

jvcllaz: improve TvTMTimeLine and demo, in particular in Linux.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6322 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-19 14:40:24 +00:00
parent 75fd4af778
commit edccbda8d8
12 changed files with 471 additions and 258 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,7 +13,6 @@
<XPManifest> <XPManifest>
<DpiAware Value="True"/> <DpiAware Value="True"/>
</XPManifest> </XPManifest>
<Icon Value="0"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>

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

@ -1,11 +1,11 @@
object TMTimeLineMainForm: TTMTimeLineMainForm object TMTimeLineMainForm: TTMTimeLineMainForm
Left = 371 Left = 371
Height = 580 Height = 591
Top = 154 Top = 154
Width = 733 Width = 926
Caption = 'Team Manager Timeline demo' Caption = 'Team Manager Timeline demo'
ClientHeight = 580 ClientHeight = 591
ClientWidth = 733 ClientWidth = 926
Color = clBtnFace Color = clBtnFace
Constraints.MinHeight = 376 Constraints.MinHeight = 376
Constraints.MinWidth = 710 Constraints.MinWidth = 710
@ -15,149 +15,155 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
OnCreate = FormCreate OnCreate = FormCreate
OnMouseWheelDown = FormMouseWheelDown OnMouseWheelDown = FormMouseWheelDown
OnMouseWheelUp = FormMouseWheelUp OnMouseWheelUp = FormMouseWheelUp
OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
ShowHint = True ShowHint = True
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
Scaled = False Scaled = False
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 3
Top = 148
Width = 733
Align = alBottom
AutoSnap = False
ResizeAnchor = akBottom
end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 406 Height = 335
Top = 151 Top = 224
Width = 733 Width = 926
Align = alBottom Align = alBottom
AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 406 ClientHeight = 335
ClientWidth = 733 ClientWidth = 926
TabOrder = 0 TabOrder = 0
TabStop = True TabStop = True
object Label6: TLabel object LblImages: TLabel
Left = 8 AnchorSideLeft.Control = LbImages
AnchorSideTop.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 4
Height = 15 Height = 15
Top = 0 Top = 4
Width = 725 Width = 41
Align = alTop BorderSpacing.Top = 4
BorderSpacing.Left = 8
Caption = 'Images:' Caption = 'Images:'
ParentColor = False ParentColor = False
end end
object Label7: TLabel object LblKeyboardNavigation: TLabel
Left = 480 AnchorSideLeft.Control = gbDates
Height = 13 AnchorSideTop.Control = gbDates
Top = 272 AnchorSideTop.Side = asrBottom
Width = 121 Left = 597
Height = 15
Top = 188
Width = 112
BorderSpacing.Top = 24
Caption = 'Keyboard navigation:' Caption = 'Keyboard navigation:'
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentColor = False ParentColor = False
ParentFont = False
end end
object Label18: TLabel object Label18: TLabel
Left = 496 AnchorSideLeft.Control = LblKeyboardNavigation
AnchorSideTop.Control = LblKeyboardNavigation
AnchorSideTop.Side = asrBottom
Left = 613
Height = 30 Height = 30
Top = 290 Top = 207
Width = 181 Width = 181
BorderSpacing.Left = 16
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'
ParentColor = False ParentColor = False
end end
object Label19: TLabel object Label19: TLabel
Left = 496 AnchorSideLeft.Control = Label18
AnchorSideTop.Control = Label18
AnchorSideTop.Side = asrBottom
Left = 613
Height = 30 Height = 30
Top = 322 Top = 241
Width = 181 Width = 181
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
end end
object Label20: TLabel object Label20: TLabel
Left = 496 AnchorSideLeft.Control = Label19
AnchorSideTop.Control = Label19
AnchorSideTop.Side = asrBottom
Left = 613
Height = 30 Height = 30
Top = 354 Top = 275
Width = 173 Width = 173
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
end end
object lvImages: TListView
AnchorSideLeft.Control = Panel1
AnchorSideRight.Control = Panel1
Left = 8
Height = 56
Hint = 'The images available for the control'
Top = 15
Width = 717
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Columns = <>
IconOptions.Arrangement = iaLeft
LargeImages = il16
PopupMenu = popTimeLine
ReadOnly = True
SmallImages = il16
TabOrder = 0
OnSelectItem = lvImagesSelectItem
end
object gbDates: TGroupBox object gbDates: TGroupBox
Left = 480 AnchorSideLeft.Control = gbAppearance
Height = 176 AnchorSideLeft.Side = asrBottom
Top = 80 AnchorSideTop.Control = gbWidths
Width = 241 Left = 597
Height = 160
Top = 4
Width = 230
AutoSize = True
BorderSpacing.Left = 24
Caption = ' Dates: ' Caption = ' Dates: '
ClientHeight = 156 ClientHeight = 140
ClientWidth = 237 ClientWidth = 226
TabOrder = 3 TabOrder = 2
object Label2: TLabel object Label2: TLabel
Left = 8 AnchorSideLeft.Control = gbDates
AnchorSideTop.Control = gbDates
Left = 12
Height = 15 Height = 15
Top = -1 Top = 0
Width = 87 Width = 87
BorderSpacing.Left = 12
Caption = 'First visible date:' Caption = 'First visible date:'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object Label3: TLabel
Left = 8 AnchorSideLeft.Control = Label2
AnchorSideTop.Control = dtpFirstDate
AnchorSideTop.Side = asrBottom
Left = 12
Height = 15 Height = 15
Top = 47 Top = 48
Width = 73 Width = 73
BorderSpacing.Top = 8
Caption = 'Selected date:' Caption = 'Selected date:'
ParentColor = False ParentColor = False
end end
object Label4: TLabel object Label4: TLabel
Left = 136 AnchorSideLeft.Control = edImageNo
AnchorSideTop.Control = Label2
Left = 131
Height = 15 Height = 15
Top = -1 Top = 0
Width = 61 Width = 61
Caption = 'Add image:' Caption = 'Add image:'
ParentColor = False ParentColor = False
end end
object Label5: TLabel object Label5: TLabel
Left = 136 AnchorSideLeft.Control = edImageNo
AnchorSideTop.Control = Label3
Left = 131
Height = 15 Height = 15
Top = 47 Top = 48
Width = 39 Width = 39
Caption = 'at date:' Caption = 'at date:'
ParentColor = False ParentColor = False
end end
object dtpFirstDate: TDateTimePicker object dtpFirstDate: TDateTimePicker
Left = 8 AnchorSideLeft.Control = Label2
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
Left = 12
Height = 23 Height = 23
Hint = 'Sets the first displayed date' Hint = 'Sets the first displayed date'
Top = 15 Top = 17
Width = 79 Width = 79
CenturyFrom = 1941 CenturyFrom = 1941
MaxDate = 2958465 MaxDate = 2958465
MinDate = -53780 MinDate = -53780
TabOrder = 0 TabOrder = 0
BorderSpacing.Top = 2
TrailingSeparator = False TrailingSeparator = False
LeadingZeros = True LeadingZeros = True
Kind = dtkDate Kind = dtkDate
@ -173,15 +179,19 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
OnChange = dtpFirstDateChange OnChange = dtpFirstDateChange
end end
object dtpSelDate: TDateTimePicker object dtpSelDate: TDateTimePicker
Left = 8 AnchorSideLeft.Control = Label2
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
Left = 12
Height = 23 Height = 23
Hint = 'Sets the selected day' Hint = 'Sets the selected day'
Top = 63 Top = 65
Width = 79 Width = 79
CenturyFrom = 1941 CenturyFrom = 1941
MaxDate = 2958465 MaxDate = 2958465
MinDate = -53780 MinDate = -53780
TabOrder = 1 TabOrder = 1
BorderSpacing.Top = 2
TrailingSeparator = False TrailingSeparator = False
LeadingZeros = True LeadingZeros = True
Kind = dtkDate Kind = dtkDate
@ -197,37 +207,53 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
OnChange = dtpSelDateChange OnChange = dtpSelDateChange
end end
object edImageNo: TEdit object edImageNo: TEdit
Left = 136 AnchorSideLeft.Control = dtpFirstDate
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
Left = 131
Height = 23 Height = 23
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 = 15 Top = 17
Width = 81 Width = 68
BorderSpacing.Left = 40
BorderSpacing.Top = 2
TabOrder = 2 TabOrder = 2
Text = '-1' Text = '-1'
end end
object udImageNo: TUpDown object udImageNo: TUpDown
Left = 217 AnchorSideLeft.Control = edImageNo
AnchorSideLeft.Side = asrBottom
Left = 199
Height = 23 Height = 23
Top = 15 Top = 17
Width = 15 Width = 15
Associate = edImageNo Associate = edImageNo
BorderSpacing.Right = 12
Min = -1 Min = -1
Position = -1 Position = -1
TabOrder = 3 TabOrder = 3
Wrap = False Wrap = False
end end
object dtpImageDate: TDateTimePicker object dtpImageDate: TDateTimePicker
Left = 136 AnchorSideLeft.Control = edImageNo
AnchorSideTop.Control = Label5
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = udImageNo
AnchorSideRight.Side = asrBottom
Left = 131
Height = 23 Height = 23
Hint = 'Sets the date to insert / delete an image' Hint = 'Sets the date to insert / delete an image'
Top = 63 Top = 65
Width = 79 Width = 83
CenturyFrom = 1941 CenturyFrom = 1941
MaxDate = 2958465 MaxDate = 2958465
MinDate = -53780 MinDate = -53780
TabOrder = 4 TabOrder = 4
BorderSpacing.Top = 2
TrailingSeparator = False TrailingSeparator = False
LeadingZeros = True LeadingZeros = True
Anchors = [akTop, akLeft, akRight]
Kind = dtkDate Kind = dtkDate
TimeFormat = tf24 TimeFormat = tf24
TimeDisplay = tdHMS TimeDisplay = tdHMS
@ -240,47 +266,57 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
CalAlignment = dtaLeft CalAlignment = dtaLeft
end end
object btnAdd: TButton object btnAdd: TButton
Left = 157 AnchorSideRight.Control = udImageNo
AnchorSideRight.Side = asrBottom
Left = 166
Height = 25 Height = 25
Hint = 'Adds an image to the chosen date' Hint = 'Adds an image to the chosen date'
Top = 103 Top = 103
Width = 75 Width = 48
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Bottom = 12
Caption = '&Add' Caption = '&Add'
OnClick = btnAddClick OnClick = btnAddClick
TabOrder = 5 TabOrder = 5
end end
end end
object gbAppearance: TGroupBox object gbAppearance: TGroupBox
Left = 208 AnchorSideLeft.Control = gbWidths
Height = 176 AnchorSideLeft.Side = asrBottom
Top = 80 AnchorSideTop.Control = gbWidths
Width = 257 Left = 315
Height = 194
Top = 4
Width = 258
AutoSize = True
BorderSpacing.Left = 24
Caption = ' Appearance: ' Caption = ' Appearance: '
ClientHeight = 156 ClientHeight = 174
ClientWidth = 253 ClientWidth = 254
TabOrder = 2 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 = 127 Left = 128
Height = 15 Height = 15
Top = 57 Top = 63
Width = 114 Width = 114
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 12
Caption = 'Assigned object style:' Caption = 'Assigned object style:'
ParentColor = False ParentColor = False
end end
object chkReadOnly: TCheckBox object chkReadOnly: TCheckBox
AnchorSideLeft.Control = gbAppearance AnchorSideLeft.Control = gbAppearance
AnchorSideTop.Control = gbAppearance AnchorSideTop.Control = gbAppearance
Left = 11 Left = 12
Height = 19 Height = 19
Hint = 'Makes the control read-only' Hint = 'Makes the control read-only'
Top = 0 Top = 0
Width = 74 Width = 74
BorderSpacing.Left = 11 BorderSpacing.Left = 12
Caption = 'Read-only' Caption = 'Read-only'
OnClick = chkReadOnlyClick OnClick = chkReadOnlyClick
TabOrder = 0 TabOrder = 0
@ -289,11 +325,12 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkReadOnly AnchorSideTop.Control = chkReadOnly
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 Left = 12
Height = 19 Height = 19
Hint = 'Makes the control flat' Hint = 'Makes the control flat'
Top = 19 Top = 21
Width = 39 Width = 39
BorderSpacing.Top = 2
Caption = 'Flat' Caption = 'Flat'
OnClick = chkFlatClick OnClick = chkFlatClick
TabOrder = 1 TabOrder = 1
@ -302,11 +339,12 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkFlat AnchorSideTop.Control = chkFlat
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 Left = 12
Height = 19 Height = 19
Hint = 'Moves the selection on right-click too' Hint = 'Moves the selection on right-click too'
Top = 38 Top = 42
Width = 108 Width = 108
BorderSpacing.Top = 2
Caption = 'Right click select' Caption = 'Right click select'
OnClick = chkRClickClick OnClick = chkRClickClick
TabOrder = 2 TabOrder = 2
@ -315,11 +353,12 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkRClick AnchorSideTop.Control = chkRClick
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 Left = 12
Height = 19 Height = 19
Hint = 'Enables the control' Hint = 'Enables the control'
Top = 57 Top = 63
Width = 62 Width = 62
BorderSpacing.Top = 2
Caption = 'Enabled' Caption = 'Enabled'
Checked = True Checked = True
OnClick = chkEnabledClick OnClick = chkEnabledClick
@ -330,10 +369,11 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkEnabled AnchorSideTop.Control = chkEnabled
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 Left = 12
Height = 19 Height = 19
Top = 76 Top = 84
Width = 82 Width = 82
BorderSpacing.Top = 2
Caption = 'Show today' Caption = 'Show today'
Checked = True Checked = True
OnClick = chkShowTodayClick OnClick = chkShowTodayClick
@ -344,10 +384,11 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkShowTodayIcon AnchorSideTop.Control = chkShowTodayIcon
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 Left = 12
Height = 19 Height = 19
Top = 114 Top = 126
Width = 84 Width = 84
BorderSpacing.Top = 2
Caption = 'Show weeks' Caption = 'Show weeks'
Checked = True Checked = True
OnClick = chkShowWeeksClick OnClick = chkShowWeeksClick
@ -358,10 +399,12 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkShowWeeks AnchorSideTop.Control = chkShowWeeks
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 AnchorSideBottom.Side = asrBottom
Left = 12
Height = 19 Height = 19
Top = 133 Top = 147
Width = 93 Width = 93
BorderSpacing.Top = 2
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Show months' Caption = 'Show months'
Checked = True Checked = True
@ -373,16 +416,18 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label13 AnchorSideLeft.Control = Label13
AnchorSideTop.Control = Label13 AnchorSideTop.Control = Label13
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Label13
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 127 AnchorSideBottom.Control = chkShowMonths
Height = 78 AnchorSideBottom.Side = asrBottom
Left = 128
Height = 86
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 = 74 Top = 80
Width = 114 Width = 107
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 8 BorderSpacing.Right = 12
IntegralHeight = True
Items.Strings = ( Items.Strings = (
'Bold' 'Bold'
'Italic' 'Italic'
@ -400,10 +445,11 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = chkReadOnly AnchorSideLeft.Control = chkReadOnly
AnchorSideTop.Control = chkShowToday AnchorSideTop.Control = chkShowToday
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 11 Left = 12
Height = 19 Height = 19
Top = 95 Top = 105
Width = 108 Width = 108
BorderSpacing.Top = 2
Caption = 'Show today icon' Caption = 'Show today icon'
Checked = True Checked = True
OnClick = chkShowTodayIconClick OnClick = chkShowTodayIconClick
@ -412,120 +458,191 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
end end
end end
object gbMisc: TGroupBox object gbMisc: TGroupBox
Left = 264 AnchorSideLeft.Control = gbFonts
Height = 129 AnchorSideLeft.Side = asrBottom
Top = 264 AnchorSideTop.Control = gbFonts
Width = 192 AnchorSideBottom.Side = asrBottom
Left = 369
Height = 94
Top = 206
Width = 145
AutoSize = True
BorderSpacing.Left = 24
BorderSpacing.Bottom = 16
Caption = ' Misc. ' Caption = ' Misc. '
ClientHeight = 109 ClientHeight = 74
ClientWidth = 188 ClientWidth = 141
TabOrder = 5 TabOrder = 4
object btnLoad: TButton object btnLoad: TButton
Left = 14 AnchorSideLeft.Control = gbMisc
AnchorSideTop.Control = gbMisc
Left = 16
Height = 25 Height = 25
Hint = 'Loads a previously saved timeline file' Hint = 'Loads a previously saved timeline file'
Top = 6 Top = 4
Width = 110 Width = 109
AutoSize = True
BorderSpacing.Left = 16
BorderSpacing.Top = 4
BorderSpacing.Right = 16
Caption = 'Load from file...' Caption = 'Load from file...'
OnClick = btnLoadClick OnClick = btnLoadClick
TabOrder = 0 TabOrder = 0
end end
object btnSave: TButton object btnSave: TButton
Left = 14 AnchorSideLeft.Control = btnLoad
AnchorSideTop.Control = btnLoad
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnLoad
AnchorSideRight.Side = asrBottom
Left = 16
Height = 25 Height = 25
Hint = 'Saves the current content to a timeline file' Hint = 'Saves the current content to a timeline file'
Top = 38 Top = 37
Width = 110 Width = 109
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Bottom = 12
Caption = 'Save to file...' Caption = 'Save to file...'
OnClick = btnSaveClick OnClick = btnSaveClick
TabOrder = 1 TabOrder = 1
end end
end end
object gbFonts: TGroupBox object gbFonts: TGroupBox
Left = 8 AnchorSideLeft.Control = gbWidths
AnchorSideTop.Control = gbAppearance
AnchorSideTop.Side = asrBottom
Left = 100
Height = 129 Height = 129
Top = 264 Top = 206
Width = 241 Width = 245
AutoSize = True
BorderSpacing.Top = 8
Caption = ' Fonts and colors: ' Caption = ' Fonts and colors: '
ClientHeight = 109 ClientHeight = 109
ClientWidth = 237 ClientWidth = 241
TabOrder = 4 TabOrder = 3
object btnFont: TButton object btnFont: TButton
Left = 14 AnchorSideLeft.Control = btnColor
AnchorSideTop.Control = btnColor
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = btnMonthFont
AnchorSideRight.Side = asrBottom
Left = 12
Height = 25 Height = 25
Hint = 'Sets the font for days' Hint = 'Sets the font for days'
Top = 40 Top = 37
Width = 90 Width = 96
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 8
Caption = 'Font...' Caption = 'Font...'
OnClick = btnFontClick OnClick = btnFontClick
TabOrder = 1 TabOrder = 1
end end
object btnColor: TButton object btnColor: TButton
Left = 14 AnchorSideLeft.Control = btnMonthFont
AnchorSideTop.Control = gbFonts
AnchorSideRight.Control = btnMonthFont
AnchorSideRight.Side = asrBottom
Left = 12
Height = 25 Height = 25
Hint = 'Sets the background color' Hint = 'Sets the background color'
Top = 8 Top = 4
Width = 90 Width = 96
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 4
Caption = 'Color...' Caption = 'Color...'
OnClick = btnColorClick OnClick = btnColorClick
TabOrder = 0 TabOrder = 0
end end
object btnMonthFont: TButton object btnMonthFont: TButton
Left = 14 AnchorSideLeft.Control = gbFonts
AnchorSideTop.Control = btnFont
AnchorSideTop.Side = asrBottom
Left = 12
Height = 25 Height = 25
Hint = 'Sets the font for months and years' Hint = 'Sets the font for months and years'
Top = 72 Top = 70
Width = 90 Width = 96
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
Caption = 'Month font...' Caption = 'Month font...'
OnClick = btnMonthFontClick OnClick = btnMonthFontClick
TabOrder = 2 TabOrder = 2
end end
object btnTodayColor: TButton object btnTodayColor: TButton
Left = 118 AnchorSideLeft.Control = btnPenColor
AnchorSideTop.Control = btnFont
AnchorSideRight.Control = btnPenColor
AnchorSideRight.Side = asrBottom
Left = 116
Height = 25 Height = 25
Hint = 'Sets the background color for the today item' Hint = 'Sets the background color for the today item'
Top = 40 Top = 37
Width = 106 Width = 113
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'Today color...' Caption = 'Today color...'
OnClick = btnTodayColorClick OnClick = btnTodayColorClick
TabOrder = 4 TabOrder = 4
end end
object btnLineColor: TButton object btnLineColor: TButton
Left = 118 AnchorSideLeft.Control = btnPenColor
AnchorSideTop.Control = btnColor
AnchorSideRight.Control = btnPenColor
AnchorSideRight.Side = asrBottom
Left = 116
Height = 25 Height = 25
Top = 8 Top = 4
Width = 106 Width = 113
Anchors = [akTop, akLeft, akRight]
AutoSize = True
Caption = 'Line color...' Caption = 'Line color...'
OnClick = btnLineColorClick OnClick = btnLineColorClick
TabOrder = 3 TabOrder = 3
end end
object btnPenColor: TButton object btnPenColor: TButton
Left = 118 AnchorSideLeft.Control = btnMonthFont
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btnMonthFont
Left = 116
Height = 25 Height = 25
Hint = 'Sets the color of the selection frame' Hint = 'Sets the color of the selection frame'
Top = 72 Top = 70
Width = 106 Width = 113
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 14
Caption = 'Selection color...' Caption = 'Selection color...'
OnClick = btnPenColorClick OnClick = btnPenColorClick
TabOrder = 5 TabOrder = 5
end end
end end
object gbWidths: TGroupBox object gbWidths: TGroupBox
Left = 8 AnchorSideLeft.Control = LbImages
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = LblImages
Left = 100
Height = 161 Height = 161
Top = 80 Top = 4
Width = 185 Width = 191
AutoSize = True AutoSize = True
BorderSpacing.Left = 12
Caption = ' Widths and sizes: ' Caption = ' Widths and sizes: '
ClientHeight = 141 ClientHeight = 141
ClientWidth = 181 ClientWidth = 187
TabOrder = 1 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 = 28 Left = 30
Height = 15 Height = 15
Top = 60 Top = 60
Width = 56 Width = 56
@ -539,7 +656,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 8 Left = 10
Height = 15 Height = 15
Top = 87 Top = 87
Width = 76 Width = 76
@ -552,12 +669,12 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Control = edScrollSmall AnchorSideTop.Control = edScrollSmall
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
Left = 10 Left = 12
Height = 15 Height = 15
Top = 6 Top = 6
Width = 74 Width = 74
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 12
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = 'Small change:' Caption = 'Small change:'
ParentColor = False ParentColor = False
@ -567,7 +684,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 10 Left = 12
Height = 15 Height = 15
Top = 33 Top = 33
Width = 74 Width = 74
@ -581,7 +698,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label9 AnchorSideRight.Control = Label9
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 12 Left = 14
Height = 15 Height = 15
Top = 114 Top = 114
Width = 72 Width = 72
@ -594,7 +711,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edScrollSmall AnchorSideTop.Control = edScrollSmall
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 144 Left = 146
Height = 15 Height = 15
Top = 6 Top = 6
Width = 24 Width = 24
@ -605,7 +722,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edScrollLarge AnchorSideTop.Control = edScrollLarge
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 144 Left = 146
Height = 15 Height = 15
Top = 33 Top = 33
Width = 24 Width = 24
@ -615,14 +732,13 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object Label15: TLabel object Label15: TLabel
AnchorSideTop.Control = edDayWidth AnchorSideTop.Control = edDayWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = gbWidths
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 144 Left = 146
Height = 15 Height = 15
Top = 60 Top = 60
Width = 29 Width = 29
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 8 BorderSpacing.Right = 12
Caption = 'pixels' Caption = 'pixels'
ParentColor = False ParentColor = False
end end
@ -630,7 +746,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edPenWidth AnchorSideTop.Control = edPenWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 144 Left = 146
Height = 15 Height = 15
Top = 87 Top = 87
Width = 29 Width = 29
@ -641,7 +757,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideLeft.Control = Label15 AnchorSideLeft.Control = Label15
AnchorSideTop.Control = edButtonWidth AnchorSideTop.Control = edButtonWidth
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 144 Left = 146
Height = 15 Height = 15
Top = 114 Top = 114
Width = 29 Width = 29
@ -654,7 +770,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 88 Left = 90
Height = 23 Height = 23
Hint = 'Sets the width in pixels of a single day' Hint = 'Sets the width in pixels of a single day'
Top = 56 Top = 56
@ -667,7 +783,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udDayWidth: TUpDown object udDayWidth: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 125 Left = 127
Height = 23 Height = 23
Top = 56 Top = 56
Width = 15 Width = 15
@ -686,7 +802,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 88 Left = 90
Height = 23 Height = 23
Hint = 'Sets the width of the selection frame' Hint = 'Sets the width of the selection frame'
Top = 83 Top = 83
@ -699,7 +815,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udPenWidth: TUpDown object udPenWidth: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 125 Left = 127
Height = 23 Height = 23
Top = 83 Top = 83
Width = 15 Width = 15
@ -714,7 +830,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object edScrollSmall: TEdit object edScrollSmall: TEdit
AnchorSideTop.Control = gbWidths AnchorSideTop.Control = gbWidths
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
Left = 88 Left = 90
Height = 23 Height = 23
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
@ -727,7 +843,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
end end
object udScrollSmall: TUpDown object udScrollSmall: TUpDown
AnchorSideRight.Control = Label11 AnchorSideRight.Control = Label11
Left = 125 Left = 127
Height = 23 Height = 23
Top = 2 Top = 2
Width = 15 Width = 15
@ -747,7 +863,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 88 Left = 90
Height = 23 Height = 23
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 = 29
@ -760,7 +876,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udScrollLarge: TUpDown object udScrollLarge: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 125 Left = 127
Height = 23 Height = 23
Top = 29 Top = 29
Width = 15 Width = 15
@ -779,7 +895,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = edScrollSmall AnchorSideRight.Control = edScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 88 Left = 90
Height = 23 Height = 23
Hint = 'Sets the width of the scrollbuttons' Hint = 'Sets the width of the scrollbuttons'
Top = 110 Top = 110
@ -793,7 +909,7 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object udButtonWidth: TUpDown object udButtonWidth: TUpDown
AnchorSideRight.Control = udScrollSmall AnchorSideRight.Control = udScrollSmall
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 125 Left = 127
Height = 23 Height = 23
Top = 110 Top = 110
Width = 15 Width = 15
@ -807,13 +923,33 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
Wrap = False Wrap = False
end end
end end
object LbImages: TListBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = LblImages
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 312
Top = 23
Width = 84
Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 4
ItemHeight = 0
OnDrawItem = LbImagesDrawItem
OnSelectionChange = LbImagesSelectionChange
Style = lbOwnerDrawFixed
TabOrder = 5
end
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 23 Height = 23
Hint = 'Displays info about the control' Hint = 'Displays info about the control'
Top = 557 Top = 568
Width = 733 Width = 926
BorderSpacing.Top = 9
Panels = < Panels = <
item item
Width = 300 Width = 300
@ -859,8 +995,8 @@ object TMTimeLineMainForm: TTMTimeLineMainForm
object il16: TImageList object il16: TImageList
Height = 18 Height = 18
Width = 14 Width = 14
left = 560 left = 360
top = 16 top = 43
Bitmap = { Bitmap = {
4C69080000000E00000012000000000000000000000000000000000000000000 4C69080000000E00000012000000000000000000000000000000000000000000
000000000000000000FF000000FF000000000000000000000000000000000000 000000000000000000FF000000FF000000000000000000000000000000000000

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

@ -32,16 +32,18 @@ unit TMTimeLineMainFormU;
interface interface
uses uses
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, JvTMTimeLine; Menus, CheckLst, ComboEx, JvTMTimeLine, Types;
type type
{ TTMTimeLineMainForm }
TTMTimeLineMainForm = class(TForm) TTMTimeLineMainForm = class(TForm)
Splitter1: TSplitter; LbImages: TListBox;
Panel1: TPanel; Panel1: TPanel;
Label6: TLabel; LblImages: TLabel;
lvImages: TListView;
popTimeLine: TPopupMenu; popTimeLine: TPopupMenu;
mnuToday: TMenuItem; mnuToday: TMenuItem;
mnuInsertImage: TMenuItem; mnuInsertImage: TMenuItem;
@ -103,17 +105,27 @@ type
btnTodayColor: TButton; btnTodayColor: TButton;
btnLineColor: TButton; btnLineColor: TButton;
btnPenColor: TButton; btnPenColor: TButton;
Label7: TLabel; LblKeyboardNavigation: TLabel;
Label18: TLabel; Label18: TLabel;
Label19: TLabel; Label19: TLabel;
Label20: TLabel; Label20: TLabel;
chkShowTodayIcon: TCheckBox; chkShowTodayIcon: TCheckBox;
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormShow(Sender: TObject);
procedure btnFontClick(Sender: TObject); procedure btnFontClick(Sender: TObject);
procedure btnMonthFontClick(Sender: TObject); procedure btnMonthFontClick(Sender: TObject);
procedure chkReadOnlyClick(Sender: TObject); procedure chkReadOnlyClick(Sender: TObject);
procedure dtpFirstDateChange(Sender: TObject); procedure dtpFirstDateChange(Sender: TObject);
procedure dtpSelDateChange(Sender: TObject); procedure dtpSelDateChange(Sender: TObject);
procedure LbImagesDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
procedure LbImagesSelectionChange(Sender: TObject; User: boolean);
procedure udDayWidthClick(Sender: TObject; Button: TUDBtnType); procedure udDayWidthClick(Sender: TObject; Button: TUDBtnType);
procedure btnColorClick(Sender: TObject); procedure btnColorClick(Sender: TObject);
procedure chkFlatClick(Sender: TObject); procedure chkFlatClick(Sender: TObject);
@ -131,7 +143,6 @@ type
procedure udScrollLargeClick(Sender: TObject; Button: TUDBtnType); procedure udScrollLargeClick(Sender: TObject; Button: TUDBtnType);
procedure mnuRemoveImageClick(Sender: TObject); procedure mnuRemoveImageClick(Sender: TObject);
procedure mnuEditMemoClick(Sender: TObject); procedure mnuEditMemoClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure udButtonWidthClick(Sender: TObject; Button: TUDBtnType); procedure udButtonWidthClick(Sender: TObject; Button: TUDBtnType);
procedure btnLoadClick(Sender: TObject); procedure btnLoadClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject); procedure btnSaveClick(Sender: TObject);
@ -142,10 +153,6 @@ type
procedure chkShowMonthsClick(Sender: TObject); procedure chkShowMonthsClick(Sender: TObject);
procedure chkShowWeeksClick(Sender: TObject); procedure chkShowWeeksClick(Sender: TObject);
procedure chkShowTodayClick(Sender: TObject); procedure chkShowTodayClick(Sender: TObject);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure btnLineColorClick(Sender: TObject); procedure btnLineColorClick(Sender: TObject);
procedure chkShowTodayIconClick(Sender: TObject); procedure chkShowTodayIconClick(Sender: TObject);
private private
@ -164,11 +171,14 @@ var
implementation implementation
uses uses
//ShellAPI, Math,
frmMemoEdit; frmMemoEdit;
{$R *.lfm} {$R *.lfm}
const
IMAGE_DIST = 4;
procedure TTMTimeLineMainForm.FormCreate(Sender: TObject); procedure TTMTimeLineMainForm.FormCreate(Sender: TObject);
var var
i : integer; i : integer;
@ -182,6 +192,7 @@ begin
JvTimeLine1.OnDblClick := @DoDblClick; JvTimeLine1.OnDblClick := @DoDblClick;
JvTimeLine1.Images := il16; JvTimeLine1.Images := il16;
JvTimeLine1.Align := alClient; JvTimeLine1.Align := alClient;
JvTimeLine1.Constraints.MinHeight := 60;
JvTimeLine1.Hint := JvTimeLine1.Hint :=
'Double-click a date to edit it''s memo content.' + 'Double-click a date to edit it''s memo content.' +
LineEnding + LineEnding +
@ -195,14 +206,15 @@ begin
JvTimeLine1.SelDate := dtpSelDate.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
begin LbImages.Items.Add(IntToStr(i));
with lvImages.Items.Add do LblKeyboardNavigation.Font.Style := [fsBold];
begin LbImages.ItemHeight := Max(il16.Height, abs(LbImages.Font.Height)) + IMAGE_DIST;
ImageIndex := i; i := LbImages.Canvas.TextWidth('99');
Caption := IntToStr(i); LbImages.Width := Max(
end; il16.Width + 4 * abs(LbImages.Font.Height) + 3 * IMAGE_DIST,
end; LblImages.Width
Splitter1.Top := JvTimeLine1.Height + 5; );
ActiveControl := JvTimeLine1;
end; end;
// Free any stringlists still around in the Objects array by calling the ClearObjects method // Free any stringlists still around in the Objects array by calling the ClearObjects method
@ -378,6 +390,48 @@ begin
JvTimeLine1.SelDate := dtpSelDate.Date; JvTimeLine1.SelDate := dtpSelDate.Date;
end; end;
procedure TTMTimeLineMainForm.LbImagesDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
h: Integer;
begin
LbImages.Canvas.Font.Assign(LbImages.Font);
h := LbImages.Canvas.TextHeight('Tg');
if State * [odSelected, odFocused] <> [] then begin
LbImages.Canvas.Brush.Color := clHighlight;
LbImages.Canvas.font.Color := clHighlightText;
end else begin
lbImages.Canvas.Brush.Color := clWindow;
LbImages.Canvas.Font.Color := clWindowText;
end;
LbImages.Canvas.FillRect(ARect);
InflateRect(ARect, -IMAGE_DIST, 0);
il16.Draw(
LbImages.Canvas, ARect.Left,
(ARect.Top + ARect.Bottom - il16.Height) div 2,
Index
);
LbImages.Canvas.TextOut(
ARect.Left + il16.Width + IMAGE_DIST,
(ARect.Top + ARect.Bottom - h) div 2,
IntToStr(Index)
);
end;
procedure TTMTimeLineMainForm.LbImagesSelectionChange(Sender: TObject;
User: boolean);
begin
if User then
udImageNo.Position := LbImages.ItemIndex;
end;
procedure TTMTimeLineMainForm.FormShow(Sender: TObject);
begin
Constraints.MinWidth := GbDates.Left + GbDates.Width;
AutoSize := true;
AutoSize := false;
end;
// change the selection frame Pen color // change the selection frame Pen color
// You can also change any other property of the Selection, like // You can also change any other property of the Selection, like
// Pen.Width, Pen.Style, Pen.Mode and whether the Selection frame is visible or not // Pen.Width, Pen.Style, Pen.Mode and whether the Selection frame is visible or not

35
components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.lfm
View File

@ -10,38 +10,47 @@ object MemoEditFrm: TMemoEditFrm
ClientWidth = 305 ClientWidth = 305
Color = clBtnFace Color = clBtnFace
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -11 OnShow = FormShow
Font.Name = 'MS Sans Serif'
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 41 Height = 29
Top = 264 Top = 276
Width = 305 Width = 305
Align = alBottom Align = alBottom
AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 41 ClientHeight = 29
ClientWidth = 305 ClientWidth = 305
Font.Color = clWindowText Font.Color = clWindowText
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
object btnOK: TButton object btnOK: TButton
Left = 137 AnchorSideTop.Control = btnCancel
AnchorSideRight.Control = btnCancel
Left = 160
Height = 25 Height = 25
Top = 8 Top = 0
Width = 75 Width = 75
Anchors = [akRight, akBottom] Anchors = [akTop, akRight]
BorderSpacing.Right = 4
Caption = '&OK' Caption = '&OK'
Default = True Default = True
ModalResult = 1 ModalResult = 1
TabOrder = 0 TabOrder = 0
end end
object btnCancel: TButton object btnCancel: TButton
Left = 217 AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 239
Height = 25 Height = 25
Top = 8 Top = 0
Width = 75 Width = 62
Anchors = [akRight, akBottom] Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Cancel'
ModalResult = 2 ModalResult = 2
@ -50,7 +59,7 @@ object MemoEditFrm: TMemoEditFrm
end end
object reLines: TMemo object reLines: TMemo
Left = 4 Left = 4
Height = 256 Height = 268
Top = 4 Top = 4
Width = 297 Width = 297
Align = alClient Align = alClient

10
components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.pas
View File

@ -35,6 +35,9 @@ uses
StdCtrls, ComCtrls, ExtCtrls, Menus; StdCtrls, ComCtrls, ExtCtrls, Menus;
type type
{ TMemoEditFrm }
TMemoEditFrm = class(TForm) TMemoEditFrm = class(TForm)
Panel1: TPanel; Panel1: TPanel;
btnOK: TButton; btnOK: TButton;
@ -49,6 +52,7 @@ type
Paste1: TMenuItem; Paste1: TMenuItem;
Selectall1: TMenuItem; Selectall1: TMenuItem;
N2: TMenuItem; N2: TMenuItem;
procedure FormShow(Sender: TObject);
procedure Load1Click(Sender: TObject); procedure Load1Click(Sender: TObject);
procedure Save1Click(Sender: TObject); procedure Save1Click(Sender: TObject);
procedure Cut1Click(Sender: TObject); procedure Cut1Click(Sender: TObject);
@ -95,6 +99,12 @@ begin
end; end;
end; end;
procedure TMemoEditFrm.FormShow(Sender: TObject);
begin
btnOK.Width := btnCancel.Width;
btnOK.Height := btnCancel.Height;
end;
procedure TMemoEditFrm.Save1Click(Sender: TObject); procedure TMemoEditFrm.Save1Click(Sender: TObject);
begin begin
with TSaveDialog.Create(nil) do with TSaveDialog.Create(nil) do

BIN
components/jvcllaz/resource/JvTMTimeLine.res
View File

Binary file not shown.

BIN
components/jvcllaz/resource/jvtmtimeline.res Normal file
View File

Binary file not shown.

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

@ -166,7 +166,7 @@ type
function GetVisibleDays: Integer; function GetVisibleDays: Integer;
property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle; property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 12; 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 FDayWidth write SetDayWidth default 19;
property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline]; property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline];
@ -325,7 +325,7 @@ uses
LCLStrConsts, Themes, LCLStrConsts, Themes,
JvConsts, JvJCLUtils, JvJVCLUtils, JvResources; JvConsts, JvJCLUtils, JvJVCLUtils, JvResources;
{$R ..\..\resource\JvTMTimeLine.res} {$R ..\..\resource\jvtmtimeline.res}
const const
cMagic = 'Jv.TMTIMELINE1'; cMagic = 'Jv.TMTIMELINE1';
@ -388,6 +388,8 @@ end;
//=== { TJvCustomTMTimeline } ================================================ //=== { TJvCustomTMTimeline } ================================================
constructor TJvCustomTMTimeline.Create(AOwner: TComponent); constructor TJvCustomTMTimeline.Create(AOwner: TComponent);
var
png: TPortableNetworkGraphic;
begin begin
inherited Create(AOwner); inherited Create(AOwner);
DoubleBuffered := True; DoubleBuffered := True;
@ -412,7 +414,7 @@ begin
FMonthFont.Size := 18; FMonthFont.Size := 18;
FObjectsFontStyle := [fsUnderline]; FObjectsFontStyle := [fsUnderline];
FButtonWidth := 12; FButtonWidth := 16;
FDate := SysUtils.Date - 7; FDate := SysUtils.Date - 7;
FSelDate := FDate - 1; FSelDate := FDate - 1;
FDayWidth := 19; FDayWidth := 19;
@ -425,8 +427,8 @@ begin
FShowTodayIcon := True; FShowTodayIcon := True;
FShowWeeks := True; FShowWeeks := True;
FShowMonths := True; FShowMonths := True;
Font.Size := 7; Font.Size := 0;
Font.Name := 'Times New Roman'; Font.Name := 'default';
FLeftBtn := TSpeedButton.Create(Self); FLeftBtn := TSpeedButton.Create(Self);
with FLeftBtn do with FLeftBtn do
@ -436,7 +438,13 @@ begin
Parent := Self; Parent := Self;
Transparent := False; Transparent := False;
Layout := blGlyphTop; Layout := blGlyphTop;
Glyph.LoadFromResourceName(HInstance, 'JvCustomTMTimelineSCROLLLEFT'); png := TPortableNetworkGraphic.Create;
try
png.LoadFromResourceName(HInstance, 'jvcustomtmtimelinescrollleft');
Glyph.Assign(png);
finally
png.Free;
end;
OnMouseDown := @DoLMouseDown; OnMouseDown := @DoLMouseDown;
OnMouseUp := @DoMouseUp; OnMouseUp := @DoMouseUp;
@ -451,7 +459,13 @@ begin
Parent := Self; Parent := Self;
Transparent := False; Transparent := False;
Layout := blGlyphTop; Layout := blGlyphTop;
Glyph.LoadFromResourceName(HInstance, 'JvCustomTMTimelineSCROLLRIGHT'); png := TPortableNetworkGraphic.Create;
try
png.LoadFromResourceName(HInstance, 'jvcustomtmtimelinescrollright');
Glyph.Assign(png);
finally
png.Free;
end;
OnMouseDown := @DoRMouseDown; OnMouseDown := @DoRMouseDown;
OnMouseUp := @DoMouseUp; OnMouseUp := @DoMouseUp;
@ -592,40 +606,30 @@ end;
procedure TJvCustomTMTimeline.DrawToday(ACanvas: TCanvas; const ARect: TRect); procedure TJvCustomTMTimeline.DrawToday(ACanvas: TCanvas; const ARect: TRect);
var var
Tmp: TColor; Tmp: TColor;
Bmp: TBitmap; png: TPortableNetworkGraphic;
R: TRect; R: TRect;
x, y: Integer;
begin begin
if ShowTodayIcon then
Bmp := TBitmap.Create
else
Bmp := nil;
Tmp := ACanvas.Brush.Color; Tmp := ACanvas.Brush.Color;
try try
if ShowTodayIcon then if ShowToday then begin
Bmp.LoadFromResourceName(HInstance, 'JvCustomTMTimelineMILESTONELARGE');
if ShowToday then
begin
ACanvas.Brush.Color := FTodayColor; ACanvas.Brush.Color := FTodayColor;
ACanvas.FillRect(ARect); ACanvas.FillRect(ARect);
end; end;
if ShowTodayIcon then if ShowTodayIcon then begin
begin png := TPortableNetworkGraphic.Create;
R := Classes.Rect(ARect.Left + ((ARect.Right - ARect.Left) - Bmp.Width) div 2, try
ARect.Top + CanvasMaxTextHeight(ACanvas) + 2, png.LoadFromResourceName(HInstance, 'jvcustomtmtimelinemilestonelarge');
ARect.Left + ((ARect.Right - ARect.Left) - Bmp.Width) div 2 + Bmp.Width, x := (ARect.Left + ARect.Right - png.Width) div 2;
ARect.Top + Bmp.Height + CanvasMaxTextHeight(ACanvas) + 2); y := ARect.Top + CanvasMaxTextHeight(ACanvas) + 4;
(* {$IFDEF VCL} R := Classes.Rect(x, y, x + png.Width, y + png.Height);
ACanvas.BrushCopy(R, Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), clFuchsia); ACanvas.Draw(R.Left, R.Top, png);
{$ENDIF VCL} finally
{$IFDEF VisualCLX} png.Free;
*) end;
Bmp.Transparent := True;
ACanvas.Draw(R.Left, R.Top, Bmp);
// {$ENDIF VisualCLX}
end; end;
finally finally
ACanvas.Brush.Color := Tmp; ACanvas.Brush.Color := Tmp;
Bmp.Free;
end; end;
end; end;
@ -656,7 +660,7 @@ begin
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, 4, I * FDayWidth + FDayWidth, Font.Size + 4); R := Classes.Rect(I * FDayWidth, 8, I * FDayWidth + FDayWidth, 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);

BIN
components/jvcllaz/run/JvCustomControls/images/jvcustomtmtimelinemilestonelarge.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 173 B

BIN
components/jvcllaz/run/JvCustomControls/images/jvcustomtmtimelinescrollleft.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 118 B

BIN
components/jvcllaz/run/JvCustomControls/images/jvcustomtmtimelinescrollright.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 137 B

1
components/jvcllaz/run/JvCustomControls/images/make_res.bat Normal file
View File

@ -0,0 +1 @@
lazres ../../../resource/jvtmtimeline.res jvcustomtmtimelinescrollleft.png jvcustomtmtimelinescrollright.png jvcustomtmtimelinemilestonelarge.png