From 7df733f676aa0d5bf4d647f22284dad3abf9ac2d Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 12 Mar 2018 00:40:20 +0000 Subject: [PATCH] jvcllaz: Add TJvTMTimeLine incl demo. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6236 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../design/JvCustomControls/JvCustomReg.pas | 8 +- .../design/JvCustomControls/images/images.txt | 1 + .../examples/JvTMTimeLine/SimpleTLTest1.lpi | 94 ++ .../examples/JvTMTimeLine/SimpleTLTest1.lpr | 17 + .../JvTMTimeLine/TMTimeLineMainFormU.lfm | 1120 ++++++++++++++ .../JvTMTimeLine/TMTimeLineMainFormU.pas | 643 ++++++++ .../JvTMTimeLine/TeamManagerImages.bmp | Bin 0 -> 1126 bytes .../examples/JvTMTimeLine/frmMemoEdit.lfm | 103 ++ .../examples/JvTMTimeLine/frmMemoEdit.pas | 136 ++ .../jvcllaz/examples/JvTMTimeLine/il16.bmp | Bin 0 -> 4162 bytes components/jvcllaz/resource/JvTMTimeLine.res | Bin 0 -> 832 bytes components/jvcllaz/resource/jvcustomreg.res | Bin 1724 -> 3420 bytes .../run/JvCustomControls/JvTMTimeLine.pas | 1368 +++++++++++++++++ 13 files changed, 3486 insertions(+), 4 deletions(-) create mode 100644 components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpi create mode 100644 components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpr create mode 100644 components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.lfm create mode 100644 components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.pas create mode 100644 components/jvcllaz/examples/JvTMTimeLine/TeamManagerImages.bmp create mode 100644 components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.lfm create mode 100644 components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.pas create mode 100644 components/jvcllaz/examples/JvTMTimeLine/il16.bmp create mode 100644 components/jvcllaz/resource/JvTMTimeLine.res create mode 100644 components/jvcllaz/run/JvCustomControls/JvTMTimeLine.pas diff --git a/components/jvcllaz/design/JvCustomControls/JvCustomReg.pas b/components/jvcllaz/design/JvCustomControls/JvCustomReg.pas index 786984d2d..5469c1bde 100644 --- a/components/jvcllaz/design/JvCustomControls/JvCustomReg.pas +++ b/components/jvcllaz/design/JvCustomControls/JvCustomReg.pas @@ -14,14 +14,14 @@ implementation {$R ../../resource/jvcustomreg.res} uses - Classes, JvDsgnConsts, - JvTimeLine, JvTimeLineEditor, - PropEdits, ComponentEditors, Controls; + Classes, PropEdits, ComponentEditors, Controls, + JvDsgnConsts, JvTimeLine, JvTMTimeline, JvTimeLineEditor; procedure Register; begin RegisterComponents(RsPaletteJvcl, [ - TJvTimeLine + TJvTimeLine, + TJvTMTimeLine ]); RegisterComponentEditor(TJvCustomTimeLine, TJvTimeLineEditor); RegisterPropertyEditor(TypeInfo(TDate), TJvTimeLine, 'FirstVisibledate', TDatePropertyEditor) diff --git a/components/jvcllaz/design/JvCustomControls/images/images.txt b/components/jvcllaz/design/JvCustomControls/images/images.txt index dcf742822..af27d17f3 100644 --- a/components/jvcllaz/design/JvCustomControls/images/images.txt +++ b/components/jvcllaz/design/JvCustomControls/images/images.txt @@ -1 +1,2 @@ tjvtimeline.bmp +tjvtmtimeline.bmp diff --git a/components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpi b/components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpi new file mode 100644 index 000000000..af91930e1 --- /dev/null +++ b/components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpi @@ -0,0 +1,94 @@ + + + + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="3"> + <Item1> + <PackageName Value="DateTimeCtrls"/> + </Item1> + <Item2> + <PackageName Value="JvCustomLazR"/> + </Item2> + <Item3> + <PackageName Value="LCL"/> + </Item3> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="SimpleTLTest1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="frmMemoEdit.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MemoEditFrm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + <Unit2> + <Filename Value="TMTimeLineMainFormU.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="TMTimeLineMainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="SimpleTLTest1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpr b/components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpr new file mode 100644 index 000000000..d98ba266b --- /dev/null +++ b/components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpr @@ -0,0 +1,17 @@ +program SimpleTLTest1; + +{$mode objfpc}{$H+} + +uses + Forms, datetimectrls, Interfaces, + frmMemoEdit in 'frmMemoEdit.pas' {MemoEditFrm}, + TMTimeLineMainFormU in 'TMTimeLineMainFormU.pas' {TMTimeLineMainForm}; + +{$R *.RES} + +begin + Application.Scaled := True; + Application.Initialize; + Application.CreateForm(TTMTimeLineMainForm, TMTimeLineMainForm); + Application.Run; +end. diff --git a/components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.lfm b/components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.lfm new file mode 100644 index 000000000..28b0cf95c --- /dev/null +++ b/components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.lfm @@ -0,0 +1,1120 @@ +object TMTimeLineMainForm: TTMTimeLineMainForm + Left = 261 + Height = 580 + Top = 138 + Width = 733 + Caption = 'Team Manager Timeline demo' + ClientHeight = 580 + ClientWidth = 733 + Color = clBtnFace + Constraints.MinHeight = 376 + Constraints.MinWidth = 710 + DefaultMonitor = dmDesktop + Font.Color = clWindowText + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnMouseWheelDown = FormMouseWheelDown + OnMouseWheelUp = FormMouseWheelUp + Position = poScreenCenter + ShowHint = True + LCLVersion = '1.9.0.0' + 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 + Left = 0 + Height = 406 + Top = 151 + Width = 733 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 406 + ClientWidth = 733 + TabOrder = 0 + TabStop = True + object Label6: TLabel + Left = 8 + Height = 15 + Top = 0 + Width = 725 + Align = alTop + BorderSpacing.Left = 8 + Caption = 'Images:' + ParentColor = False + end + object Label7: TLabel + Left = 480 + Height = 13 + Top = 272 + Width = 121 + Caption = 'Keyboard navigation:' + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end + object Label18: TLabel + Left = 496 + Height = 30 + Top = 290 + Width = 181 + Caption = 'Left/Right arrow:'#13#10#9'move Small Change days' + ParentColor = False + end + object Label19: TLabel + Left = 496 + Height = 30 + Top = 322 + Width = 181 + Caption = 'Ctrl+Left/Right arrow:'#13#10#9'move Large Change days' + ParentColor = False + end + object Label20: TLabel + Left = 496 + Height = 30 + Top = 354 + Width = 173 + Caption = 'Shift+Left/Right arrow:'#13#10#9'move selection one day' + ParentColor = False + 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 + Left = 480 + Height = 176 + Top = 80 + Width = 241 + Caption = ' Dates: ' + ClientHeight = 156 + ClientWidth = 237 + TabOrder = 3 + object Label2: TLabel + Left = 8 + Height = 15 + Top = -1 + Width = 87 + Caption = 'First visible date:' + ParentColor = False + end + object Label3: TLabel + Left = 8 + Height = 15 + Top = 47 + Width = 73 + Caption = 'Selected date:' + ParentColor = False + end + object Label4: TLabel + Left = 136 + Height = 15 + Top = -1 + Width = 61 + Caption = 'Add image:' + ParentColor = False + end + object Label5: TLabel + Left = 136 + Height = 15 + Top = 47 + Width = 39 + Caption = 'at date:' + ParentColor = False + end + object dtpFirstDate: TDateTimePicker + Left = 8 + Height = 23 + Hint = 'Sets the first displayed date' + Top = 15 + Width = 79 + CenturyFrom = 1941 + MaxDate = 2958465 + MinDate = -53780 + TabOrder = 0 + TrailingSeparator = False + LeadingZeros = True + Kind = dtkDate + TimeFormat = tf24 + TimeDisplay = tdHMS + DateMode = dmComboBox + Date = 36854 + Time = 0.425169305599411 + UseDefaultSeparators = True + HideDateTimeParts = [] + MonthNames = 'Long' + CalAlignment = dtaLeft + OnChange = dtpFirstDateChange + end + object dtpSelDate: TDateTimePicker + Left = 8 + Height = 23 + Hint = 'Sets the selected day' + Top = 63 + Width = 79 + CenturyFrom = 1941 + MaxDate = 2958465 + MinDate = -53780 + TabOrder = 1 + TrailingSeparator = False + LeadingZeros = True + Kind = dtkDate + TimeFormat = tf24 + TimeDisplay = tdHMS + DateMode = dmComboBox + Date = 36854 + Time = 0.425169305599411 + UseDefaultSeparators = True + HideDateTimeParts = [] + MonthNames = 'Long' + CalAlignment = dtaLeft + OnChange = dtpSelDateChange + end + object edImageNo: TEdit + Left = 136 + Height = 23 + Hint = 'Sets the imageindex to insert at the current date'#13#10'(use -1 to remove image)' + Top = 15 + Width = 81 + TabOrder = 2 + Text = '-1' + end + object udImageNo: TUpDown + Left = 217 + Height = 23 + Top = 15 + Width = 15 + Associate = edImageNo + Min = -1 + Position = -1 + TabOrder = 3 + Wrap = False + end + object dtpImageDate: TDateTimePicker + Left = 136 + Height = 23 + Hint = 'Sets the date to insert / delete an image' + Top = 63 + Width = 79 + CenturyFrom = 1941 + MaxDate = 2958465 + MinDate = -53780 + TabOrder = 4 + TrailingSeparator = False + LeadingZeros = True + Kind = dtkDate + TimeFormat = tf24 + TimeDisplay = tdHMS + DateMode = dmComboBox + Date = 36854 + Time = 0.587075949100836 + UseDefaultSeparators = True + HideDateTimeParts = [] + MonthNames = 'Long' + CalAlignment = dtaLeft + end + object btnAdd: TButton + Left = 157 + Height = 25 + Hint = 'Adds an image to the chosen date' + Top = 103 + Width = 75 + Caption = '&Add' + OnClick = btnAddClick + TabOrder = 5 + end + end + object gbAppearance: TGroupBox + Left = 208 + Height = 176 + Top = 80 + Width = 257 + Caption = ' Appearance: ' + ClientHeight = 156 + ClientWidth = 253 + TabOrder = 2 + object Label13: TLabel + AnchorSideLeft.Control = chkRClick + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = chkEnabled + Left = 127 + Height = 15 + Top = 57 + Width = 114 + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 + Caption = 'Assigned object style:' + ParentColor = False + end + object chkReadOnly: TCheckBox + AnchorSideLeft.Control = gbAppearance + AnchorSideTop.Control = gbAppearance + Left = 11 + Height = 19 + Hint = 'Makes the control read-only' + Top = 0 + Width = 74 + BorderSpacing.Left = 11 + Caption = 'Read-only' + OnClick = chkReadOnlyClick + TabOrder = 0 + end + object chkFlat: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkReadOnly + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Hint = 'Makes the control flat' + Top = 19 + Width = 39 + Caption = 'Flat' + OnClick = chkFlatClick + TabOrder = 1 + end + object chkRClick: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkFlat + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Hint = 'Moves the selection on right-click too' + Top = 38 + Width = 108 + Caption = 'Right click select' + OnClick = chkRClickClick + TabOrder = 2 + end + object chkEnabled: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkRClick + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Hint = 'Enables the control' + Top = 57 + Width = 62 + Caption = 'Enabled' + Checked = True + OnClick = chkEnabledClick + State = cbChecked + TabOrder = 3 + end + object chkShowToday: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkEnabled + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Top = 76 + Width = 82 + Caption = 'Show today' + Checked = True + OnClick = chkShowTodayClick + State = cbChecked + TabOrder = 4 + end + object chkShowWeeks: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkShowTodayIcon + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Top = 114 + Width = 84 + Caption = 'Show weeks' + Checked = True + OnClick = chkShowWeeksClick + State = cbChecked + TabOrder = 6 + end + object chkShowMonths: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkShowWeeks + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Top = 133 + Width = 93 + BorderSpacing.Bottom = 8 + Caption = 'Show months' + Checked = True + OnClick = chkShowMonthsClick + State = cbChecked + TabOrder = 7 + end + object lbObjFontStyle: TCheckListBox + AnchorSideLeft.Control = Label13 + AnchorSideTop.Control = Label13 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Label13 + AnchorSideRight.Side = asrBottom + Left = 127 + Height = 78 + Hint = 'Sets the font to use for day items that'#13#10'have a non-nil Objects item' + Top = 74 + Width = 114 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Bottom = 8 + Items.Strings = ( + 'Bold' + 'Italic' + 'Underline' + 'Strikeout' + ) + ItemHeight = 17 + OnClickCheck = lbObjFontStyleClickCheck + TabOrder = 8 + Data = { + 0400000000000000 + } + end + object chkShowTodayIcon: TCheckBox + AnchorSideLeft.Control = chkReadOnly + AnchorSideTop.Control = chkShowToday + AnchorSideTop.Side = asrBottom + Left = 11 + Height = 19 + Top = 95 + Width = 108 + Caption = 'Show today icon' + Checked = True + OnClick = chkShowTodayIconClick + State = cbChecked + TabOrder = 5 + end + end + object gbMisc: TGroupBox + Left = 264 + Height = 129 + Top = 264 + Width = 192 + Caption = ' Misc. ' + ClientHeight = 109 + ClientWidth = 188 + TabOrder = 5 + object btnLoad: TButton + Left = 14 + Height = 25 + Hint = 'Loads a previously saved timeline file' + Top = 6 + Width = 110 + Caption = 'Load from file...' + OnClick = btnLoadClick + TabOrder = 0 + end + object btnSave: TButton + Left = 14 + Height = 25 + Hint = 'Saves the current content to a timeline file' + Top = 38 + Width = 110 + Caption = 'Save to file...' + OnClick = btnSaveClick + TabOrder = 1 + end + end + object gbFonts: TGroupBox + Left = 8 + Height = 129 + Top = 264 + Width = 241 + Caption = ' Fonts and colors: ' + ClientHeight = 109 + ClientWidth = 237 + TabOrder = 4 + object btnFont: TButton + Left = 14 + Height = 25 + Hint = 'Sets the font for days' + Top = 40 + Width = 90 + Caption = 'Font...' + OnClick = btnFontClick + TabOrder = 1 + end + object btnColor: TButton + Left = 14 + Height = 25 + Hint = 'Sets the background color' + Top = 8 + Width = 90 + Caption = 'Color...' + OnClick = btnColorClick + TabOrder = 0 + end + object btnMonthFont: TButton + Left = 14 + Height = 25 + Hint = 'Sets the font for months and years' + Top = 72 + Width = 90 + Caption = 'Month font...' + OnClick = btnMonthFontClick + TabOrder = 2 + end + object btnTodayColor: TButton + Left = 118 + Height = 25 + Hint = 'Sets the background color for the today item' + Top = 40 + Width = 106 + Caption = 'Today color...' + OnClick = btnTodayColorClick + TabOrder = 4 + end + object btnLineColor: TButton + Left = 118 + Height = 25 + Top = 8 + Width = 106 + Caption = 'Line color...' + OnClick = btnLineColorClick + TabOrder = 3 + end + object btnPenColor: TButton + Left = 118 + Height = 25 + Hint = 'Sets the color of the selection frame' + Top = 72 + Width = 106 + Caption = 'Selection color...' + OnClick = btnPenColorClick + TabOrder = 5 + end + end + object gbWidths: TGroupBox + Left = 8 + Height = 161 + Top = 80 + Width = 185 + AutoSize = True + Caption = ' Widths and sizes: ' + ClientHeight = 141 + ClientWidth = 181 + TabOrder = 1 + object Label1: TLabel + AnchorSideTop.Control = edDayWidth + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label9 + AnchorSideRight.Side = asrBottom + Left = 28 + Height = 15 + Top = 60 + Width = 56 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Day width:' + ParentColor = False + end + object Label8: TLabel + AnchorSideTop.Control = edPenWidth + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label9 + AnchorSideRight.Side = asrBottom + Left = 8 + Height = 15 + Top = 87 + Width = 76 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Sel. line width:' + ParentColor = False + end + object Label9: TLabel + AnchorSideTop.Control = edScrollSmall + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = edScrollSmall + Left = 10 + Height = 15 + Top = 6 + Width = 74 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + BorderSpacing.Right = 4 + Caption = 'Small change:' + ParentColor = False + end + object Label10: TLabel + AnchorSideTop.Control = edScrollLarge + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label9 + AnchorSideRight.Side = asrBottom + Left = 10 + Height = 15 + Top = 33 + Width = 74 + Anchors = [akTop, akRight] + BorderSpacing.Left = 9 + Caption = 'Large change:' + ParentColor = False + end + object Label12: TLabel + AnchorSideTop.Control = edButtonWidth + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = Label9 + AnchorSideRight.Side = asrBottom + Left = 12 + Height = 15 + Top = 114 + Width = 72 + Anchors = [akTop, akRight] + BorderSpacing.Left = 8 + Caption = 'Button width:' + ParentColor = False + end + object Label11: TLabel + AnchorSideLeft.Control = Label15 + AnchorSideTop.Control = edScrollSmall + AnchorSideTop.Side = asrCenter + Left = 144 + Height = 15 + Top = 6 + Width = 24 + Caption = 'days' + ParentColor = False + end + object Label14: TLabel + AnchorSideLeft.Control = Label15 + AnchorSideTop.Control = edScrollLarge + AnchorSideTop.Side = asrCenter + Left = 144 + Height = 15 + Top = 33 + Width = 24 + Caption = 'days' + ParentColor = False + end + object Label15: TLabel + AnchorSideTop.Control = edDayWidth + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = gbWidths + AnchorSideRight.Side = asrBottom + Left = 144 + Height = 15 + Top = 60 + Width = 29 + Anchors = [akTop, akRight] + BorderSpacing.Right = 8 + Caption = 'pixels' + ParentColor = False + end + object Label16: TLabel + AnchorSideLeft.Control = Label15 + AnchorSideTop.Control = edPenWidth + AnchorSideTop.Side = asrCenter + Left = 144 + Height = 15 + Top = 87 + Width = 29 + Caption = 'pixels' + ParentColor = False + end + object Label17: TLabel + AnchorSideLeft.Control = Label15 + AnchorSideTop.Control = edButtonWidth + AnchorSideTop.Side = asrCenter + Left = 144 + Height = 15 + Top = 114 + Width = 29 + Caption = 'pixels' + ParentColor = False + end + object edDayWidth: TEdit + AnchorSideLeft.Control = edScrollSmall + AnchorSideTop.Control = edScrollLarge + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edScrollSmall + AnchorSideRight.Side = asrBottom + Left = 88 + Height = 23 + Hint = 'Sets the width in pixels of a single day' + Top = 56 + Width = 33 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 4 + Text = '19' + end + object udDayWidth: TUpDown + AnchorSideRight.Control = udScrollSmall + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 56 + Width = 15 + Anchors = [akTop, akRight] + Associate = edDayWidth + Max = 32000 + Min = 0 + OnClick = udDayWidthClick + Position = 19 + TabOrder = 5 + Wrap = False + end + object edPenWidth: TEdit + AnchorSideLeft.Control = edScrollSmall + AnchorSideTop.Control = edDayWidth + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edScrollSmall + AnchorSideRight.Side = asrBottom + Left = 88 + Height = 23 + Hint = 'Sets the width of the selection frame' + Top = 83 + Width = 33 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 6 + Text = '2' + end + object udPenWidth: TUpDown + AnchorSideRight.Control = udScrollSmall + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 83 + Width = 15 + Anchors = [akTop, akRight] + Associate = edPenWidth + Min = 0 + OnClick = udPenWidthClick + Position = 2 + TabOrder = 7 + Wrap = False + end + object edScrollSmall: TEdit + AnchorSideTop.Control = gbWidths + AnchorSideRight.Control = udScrollSmall + Left = 88 + Height = 23 + Hint = 'Sets the number of days to scroll when clicking the buttons '#13#10'or when using the arrow-keys' + Top = 2 + Width = 33 + Anchors = [akTop, akRight] + BorderSpacing.Top = 2 + BorderSpacing.Right = 4 + TabOrder = 0 + Text = '7' + end + object udScrollSmall: TUpDown + AnchorSideRight.Control = Label11 + Left = 125 + Height = 23 + Top = 2 + Width = 15 + Anchors = [akTop, akRight] + Associate = edScrollSmall + BorderSpacing.Right = 4 + Max = 365 + Min = 1 + OnClick = udScrollSmallClick + Position = 7 + TabOrder = 1 + Wrap = False + end + object edScrollLarge: TEdit + AnchorSideLeft.Control = edScrollSmall + AnchorSideTop.Control = edScrollSmall + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edScrollSmall + AnchorSideRight.Side = asrBottom + Left = 88 + 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' + Top = 29 + Width = 33 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + TabOrder = 2 + Text = '30' + end + object udScrollLarge: TUpDown + AnchorSideRight.Control = udScrollSmall + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 29 + Width = 15 + Anchors = [akTop, akRight] + Associate = edScrollLarge + Max = 365 + Min = 1 + OnClick = udScrollLargeClick + Position = 30 + TabOrder = 3 + Wrap = False + end + object edButtonWidth: TEdit + AnchorSideLeft.Control = edScrollSmall + AnchorSideTop.Control = edPenWidth + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edScrollSmall + AnchorSideRight.Side = asrBottom + Left = 88 + Height = 23 + Hint = 'Sets the width of the scrollbuttons' + Top = 110 + Width = 33 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 8 + TabOrder = 8 + Text = '12' + end + object udButtonWidth: TUpDown + AnchorSideRight.Control = udScrollSmall + AnchorSideRight.Side = asrBottom + Left = 125 + Height = 23 + Top = 110 + Width = 15 + Anchors = [akTop, akRight] + Associate = edButtonWidth + Max = 35 + Min = 0 + OnClick = udButtonWidthClick + Position = 12 + TabOrder = 9 + Wrap = False + end + end + end + object StatusBar: TStatusBar + Left = 0 + Height = 23 + Hint = 'Displays info about the control' + Top = 557 + Width = 733 + Panels = < + item + Width = 300 + end + item + Width = 50 + end> + SimplePanel = False + OnResize = StatusBarResize + end + object popTimeLine: TPopupMenu + left = 240 + top = 43 + object mnuEditMemo: TMenuItem + Caption = 'Edit memo...' + Default = True + OnClick = mnuEditMemoClick + end + object mnuInsertImage: TMenuItem + Caption = 'Insert image' + ShortCut = 45 + OnClick = mnuInsertImageClick + end + object mnuRemoveImage: TMenuItem + Caption = 'Remove image' + ShortCut = 46 + OnClick = mnuRemoveImageClick + end + object N1: TMenuItem + Caption = '-' + end + object mnuToday: TMenuItem + Caption = 'Go to today' + ShortCut = 116 + OnClick = mnuTodayClick + end + object mnuGotoDate: TMenuItem + Caption = 'Go to selected day' + ShortCut = 118 + OnClick = mnuGotoDateClick + end + end + object il16: TImageList + Height = 18 + Width = 14 + left = 560 + top = 16 + Bitmap = { + 4C69080000000E00000012000000000000000000000000000000000000000000 + 000000000000000000FF000000FF000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000FF0000 + 00FF000000FF000000FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000FF000000FF000000FF000000FF0000 + 00FF000000FF0000000000000000000000000000000000000000000000000000 + 0000000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF0000000000000000000000000000000000000000000000FF000000FF0000 + 00FF000000FF0000000000000000000000FF000000FF000000FF000000FF0000 + 00000000000000000000000000FF000000FF000000FF000000FF000000000000 + 00FF000000FF00000000000000FF000000FF000000FF000000FF000000000000 + 00FF000000FF000000FF000000FF00000000000000FF000000FF000000FF0000 + 00FF00000000000000FF000000FF000000FF000000FF00000000000000FF0000 + 00FF00000000000000FF000000FF000000FF000000FF000000FF000000FF0000 + 0000000000FF000000FF00000000000000000000000000000000000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000000000 + 0000000000000000000000000000000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF00000000000000000000 + 0000000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF00000000000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF00000000000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000000000000000000000000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000FF000000FF00000000000000000000 + 00000000000000000000000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF00000000000000000000000000000000000000000000 + 000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000FF000000FF000000FF000000FF0000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00FF000000FF0000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF00000000000000000000 + 0000000000000000000000000000000000000000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000 + 0000000000000000F8FF0000F8FF0000F8FF0000F8FF00000000000000000000 + F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000F8FF0000 + F8FF0000F8FF0000F8FF000000000000F8FF0000F8FF000000000000F8FF0000 + F8FF0000F8FF0000F8FF000000000000F8FF0000F8FF0000F8FF0000F8FF0000 + 00000000F8FF0000F8FF0000F8FF0000F8FF000000000000F8FF0000F8FF0000 + F8FF0000F8FF000000000000F8FF0000F8FF000000000000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF000000000000F8FF0000F8FF000000000000 + 000000000000000000000000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000 + F8FF0000F8FF0000F8FF00000000000000000000000000000000000000000000 + F8FF0000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000000000000000000000000000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF000000000000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + 00000000F8FF0000F8FF0000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF00000000000000000000000000000000000000000000F8FF0000 + F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF000000000000000000000000000000000000 + 0000000000000000000000000000000000000000F8FF0000F8FF0000F8FF0000 + F8FF000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000F8FF0000F8FF00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF00000000000000000000 + 0000000000000000000000000000000000000000F8FF0000F8FF0000F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000 + 0000000000000000F8FF0000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF000000000000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF000000000000F8FF0000F8FF0000F8FF0000F8FF0000F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 0000000000000000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF000000000000000000000000000000000000 + 00000000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000 + F8FF000000000000000000000000000000000000000000000000000000000000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF00000000000000000000 + 00000000000000000000000000000000000000000000000000000000F8FF0000 + F8FF0000F8FF0000F8FF00000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000FF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000FF000000FF000000FF00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00FF000000FF000000FF000000FF000000FF0000000000000000000000000000 + 000000000000000000000000000000000000000000FF000000FF000000FF0000 + 00FF000000FF000000FF000000FF000000000000000000000000000000000000 + 000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000 + 00FF000000FF000000FF00000000000000000000000000000000000000000000 + 0000000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00FF000000FF000000FF000000FF000000FF0000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000FF0000 + 00FF000000FF0000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000FF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000F8FF0000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 00000000000000000000000000000000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000 + 00000000F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF0000000000000000000000000000F8FF0000 + F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000 + F8FF0000F8FF0000000000000000000000000000F8FF0000F8FF0000F8FF0000 + F8FFF8F8F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + 000000000000000000000000F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FF0000 + F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF00000000000000000000 + 00000000F8FF0000F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF000000000000000000000000000000000000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF00000000000000000000000000000000000000000000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000808080FF808080FF8080 + 80FF808080FF808080FF00000000000000000000000000000000000000000000 + 00000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FF000000FF0000000000000000000000000000000000000000000000008080 + 80FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FF0000 + 00FF00000000000000000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8 + F8FFF8F8F8FFF8F8F8FFF8F8F8FF008000FFF8F8F8FFF8F8F8FF000000FF0000 + 00000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FF008000FF008000FFF8F8F8FFF8F8F8FF000000FF00000000000000000000 + 0000808080FFF8F8F8FFF8F8F8FF008000FFF8F8F8FF008000FF008000FFF8F8 + F8FFF8F8F8FFF8F8F8FF000000FF000000000000000000000000808080FFF8F8 + F8FFF8F8F8FF008000FF008000FF008000FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FF000000FF000000000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8 + F8FF008000FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF0000 + 0000000000000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF0000000000000000000000000000 + 00000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FF000000FF0000000000000000000000000000000000000000000000000000 + 000000000000000000FF000000FF000000FF000000FF000000FF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000808080FF808080FF808080FF808080FF808080FF000000000000 + 0000000000000000000000000000000000000000000000000000808080FFF8F8 + F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF00000000000000000000 + 0000000000000000000000000000808080FFF8F8F8FFF8F8F8FF000000FF0000 + 00FF000000FFF8F8F8FFF8F8F8FF000000FF0000000000000000000000000000 + 0000808080FFF8F8F8FFF8F8F8FF000000FFF8F8F8FFF8F8F8FF000000FF0000 + 00FFF8F8F8FFF8F8F8FF000000FF000000000000000000000000808080FFF8F8 + F8FFF8F8F8FF000000FFF8F8F8FFF8F8F8FF000000FF000000FFF8F8F8FFF8F8 + F8FF000000FF000000000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8 + F8FFF8F8F8FF000000FF000000FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF0000 + 00000000000000000000808080FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF00000000000000000000 + 0000808080FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF000000FFF8F8 + F8FFF8F8F8FFF8F8F8FF000000FF000000000000000000000000000000008080 + 80FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF000000FFF8F8F8FFF8F8F8FF0000 + 00FF000000000000000000000000000000000000000000000000808080FFF8F8 + F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FF000000FF00000000000000000000 + 00000000000000000000000000000000000000000000000000FF000000FF0000 + 00FF000000FF000000FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF00000000000000000000000000000000000000000000 + 000000000000000000000000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000000000000000000000000000000000000000000000000000 + F8FF0000F8FF0000F8FFF8F8F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000 + F8FF000000000000000000000000000000000000F8FF0000F8FF0000F8FF0000 + F8FFF8F8F8FFF8F8F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + 000000000000000000000000F8FF0000F8FF0000F8FF0000F8FFF8F8F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF00000000000000000000 + 00000000F8FF0000F8FF0000F8FF0000F8FF0000F8FFF8F8F8FF0000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000F8FF0000 + F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FF0000000000000000000000000000F8FF0000F8FF0000F8FF0000 + F8FF0000F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000F8FF0000 + 00000000000000000000000000000000F8FF0000F8FF0000F8FFF8F8F8FFF8F8 + F8FFF8F8F8FF0000F8FF0000F8FF0000F8FF0000000000000000000000000000 + 000000000000000000000000F8FF0000F8FF0000F8FFF8F8F8FF0000F8FF0000 + F8FF0000F8FF0000000000000000000000000000000000000000000000000000 + 0000000000000000F8FF0000F8FF0000F8FF0000F8FF0000F8FF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000 + } + end +end diff --git a/components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.pas b/components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.pas new file mode 100644 index 000000000..cbcbd11cc --- /dev/null +++ b/components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.pas @@ -0,0 +1,643 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Initial Developer of the Original Code is Peter Thörnqvist [peter3 att users dott sourceforge dott net] +Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. +All Rights Reserved. + +Contributor(s): + +Last Modified: 2002-05-26 + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} + +{$mode objfpc}{$H+} + +unit TMTimeLineMainFormU; +{ + This demo demonstrates the different properties, methods and events unique to + the Team Manager Timeline. +} +interface + +uses + //Windows, Messages, + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, ComCtrls, StdCtrls, Buttons, ImgList, DateTimePicker, + Menus, CheckLst, JvTMTimeLine; + +type + TTMTimeLineMainForm = class(TForm) + Splitter1: TSplitter; + Panel1: TPanel; + Label6: TLabel; + lvImages: TListView; + popTimeLine: TPopupMenu; + mnuToday: TMenuItem; + mnuInsertImage: TMenuItem; + mnuRemoveImage: TMenuItem; + N1: TMenuItem; + mnuEditMemo: TMenuItem; + mnuGotoDate: TMenuItem; + StatusBar: TStatusBar; + il16: TImageList; + gbWidths: TGroupBox; + gbDates: TGroupBox; + gbAppearance: TGroupBox; + chkReadOnly: TCheckBox; + chkFlat: TCheckBox; + chkRClick: TCheckBox; + chkEnabled: TCheckBox; + chkShowToday: TCheckBox; + chkShowWeeks: TCheckBox; + chkShowMonths: TCheckBox; + Label13: TLabel; + lbObjFontStyle: TCheckListBox; + Label2: TLabel; + dtpFirstDate: TDateTimePicker; + Label3: TLabel; + dtpSelDate: TDateTimePicker; + Label4: TLabel; + Label5: TLabel; + edImageNo: TEdit; + udImageNo: TUpDown; + dtpImageDate: TDateTimePicker; + btnAdd: TButton; + Label1: TLabel; + Label8: TLabel; + Label9: TLabel; + Label10: TLabel; + Label12: TLabel; + edDayWidth: TEdit; + udDayWidth: TUpDown; + edPenWidth: TEdit; + udPenWidth: TUpDown; + edScrollSmall: TEdit; + udScrollSmall: TUpDown; + edScrollLarge: TEdit; + udScrollLarge: TUpDown; + edButtonWidth: TEdit; + udButtonWidth: TUpDown; + Label11: TLabel; + Label14: TLabel; + Label15: TLabel; + Label16: TLabel; + Label17: TLabel; + gbMisc: TGroupBox; + btnLoad: TButton; + btnSave: TButton; + gbFonts: TGroupBox; + btnFont: TButton; + btnColor: TButton; + btnMonthFont: TButton; + btnTodayColor: TButton; + btnLineColor: TButton; + btnPenColor: TButton; + Label7: TLabel; + Label18: TLabel; + Label19: TLabel; + Label20: TLabel; + chkShowTodayIcon: TCheckBox; + procedure FormCreate(Sender: TObject); + procedure btnFontClick(Sender: TObject); + procedure btnMonthFontClick(Sender: TObject); + procedure chkReadOnlyClick(Sender: TObject); + procedure dtpFirstDateChange(Sender: TObject); + procedure dtpSelDateChange(Sender: TObject); + procedure udDayWidthClick(Sender: TObject; Button: TUDBtnType); + procedure btnColorClick(Sender: TObject); + procedure chkFlatClick(Sender: TObject); + procedure btnAddClick(Sender: TObject); +// procedure lblWebPageClick(Sender: TObject); + procedure btnPenColorClick(Sender: TObject); + procedure udPenWidthClick(Sender: TObject; Button: TUDBtnType); + procedure udScrollSmallClick(Sender: TObject; Button: TUDBtnType); + procedure lvImagesSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure btnTodayColorClick(Sender: TObject); + procedure chkRClickClick(Sender: TObject); + procedure mnuTodayClick(Sender: TObject); + procedure mnuInsertImageClick(Sender: TObject); + procedure udScrollLargeClick(Sender: TObject; Button: TUDBtnType); + procedure mnuRemoveImageClick(Sender: TObject); + procedure mnuEditMemoClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure udButtonWidthClick(Sender: TObject; Button: TUDBtnType); + procedure btnLoadClick(Sender: TObject); + procedure btnSaveClick(Sender: TObject); + procedure lbObjFontStyleClickCheck(Sender: TObject); + procedure chkEnabledClick(Sender: TObject); + procedure mnuGotoDateClick(Sender: TObject); + procedure StatusBarResize(Sender: TObject); + procedure chkShowMonthsClick(Sender: TObject); + procedure chkShowWeeksClick(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 chkShowTodayIconClick(Sender: TObject); + private + { Private declarations } + JvTimeLine1:TJvTMTimeline; + procedure DoClick(Sender: TObject); + procedure DoDateChange(Sender: TObject); + procedure DoDblClick(Sender: TObject); + procedure DoObjectLoad(Sender: TObject; Stream: TStream;var AObject: TObject); + procedure DoObjectSave(Sender: TObject; Stream: TStream;const AObject: TObject); + end; + +var + TMTimeLineMainForm: TTMTimeLineMainForm; + +implementation + +uses + //ShellAPI, + frmMemoEdit; + +{$R *.lfm} + +procedure TTMTimeLineMainForm.FormCreate(Sender: TObject); +var + i : integer; +begin + //ForceCurrentDirectory := true; // <--- wp + JvTimeLine1 := TJvTMTimeline.Create(self); + JvTimeLine1.Parent := self; + JvTimeLine1.PopUpMenu := popTimeline; + JvTimeLine1.OnChange := @DoDateChange; + JvTimeLine1.OnClick := @DoClick; + JvTimeLine1.OnDblClick := @DoDblClick; + JvTimeLine1.Images := il16; + JvTimeLine1.Align := alClient; + JvTimeLine1.Hint := + 'Double-click a date to edit it''s memo content.' + + LineEnding + + 'Right-click to display pop-up menu.'; + dtpSelDate.Date := Date; + dtpFirstDate.Date := Date-7; + dtpImageDate.Date := Date+7; + udDayWidth.Position := JvTimeLine1.DayWidth; + chkReadOnly.Checked := JvTimeLine1.ReadOnly; + JvTimeLine1.Date := dtpFirstDate.Date; + JvTimeLine1.SelDate := dtpSelDate.Date; + lbObjFontStyle.Checked[2] := true; + for i := 0 to il16.Count - 1 do + begin + with lvImages.Items.Add do + begin + ImageIndex := i; + Caption := IntToStr(i); + end; + end; + Splitter1.Top := JvTimeLine1.Height + 5; +end; + +// Free any stringlists still around in the Objects array by calling the ClearObjects method +// Do NOT call this method unless the Objects array actually contains +// TObjects (or descendants): calling this method if you store ordinal values +// (like integers), will cause an AV +// You can freely mix object types in the array: the will be freed correctly anyway +procedure TTMTimeLineMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + JvTimeLine1.ClearObjects; +end; + +// just update the controls when an item in the listview is clicked +procedure TTMTimeLineMainForm.lvImagesSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); +begin + if Assigned(Item) and Selected then + udImageNo.Position := Item.ImageIndex; +end; + +(* +// simple trick that launches your default web-browser and tries to go to my web-page: +// this even works with modem-connections +procedure TTMTimeLineMainForm.lblWebPageClick(Sender: TObject); +begin + ShellExecute(Handle,PChar('open'),PChar('http://www.peter3.com'),nil,nil,SW_SHOWNORMAL); +end; +*) +procedure TTMTimeLineMainForm.btnLoadClick(Sender: TObject); +begin + with TOpenDialog.Create(nil) do + try + Filter := 'Timeline files|*.tm|All files|*.*'; + DefaultExt := 'TM'; + if Execute then + begin + JvTimeLine1.OnReadObject := @DoObjectLoad; + JvTimeLine1.LoadFromFile(Filename); + end; + finally + Free; + end; +end; + +procedure TTMTimeLineMainForm.btnSaveClick(Sender: TObject); +begin + with TSaveDialog.Create(nil) do + try + Filter := 'Timeline files|*.tm|All files|*.*'; + DefaultExt := 'TM'; + if Execute then + begin + JvTimeLine1.OnWriteObject := @DoObjectSave; + JvTimeLine1.SaveToFile(Filename); + end; + finally + Free; + end; +end; + +//****************************************************************************// + +// set imageindex for the chosen date +procedure TTMTimeLineMainForm.btnAddClick(Sender: TObject); +begin + JvTimeLine1.ImageIndex[dtpImageDate.DateTime] := udImageNo.Position; +end; + +// OnChange is called whenever the FirstDate (the first visible date) changes +// This happens when the user scrolls the display or when you set FirstDate programmatically +procedure TTMTimeLineMainForm.DoDateChange(Sender:TObject); +begin + dtpFirstDate.Date := JvTimeLine1.Date; + StatusBarResize(Sender); +end; + +// the click event is called when the timeline is clicked. To keep track of Date +// (i.e. the currently selected date), assign a handler to this event +// If right-click select is true, Date is updated when you right-click too +procedure TTMTimeLineMainForm.DoClick(Sender:TObject); +begin + dtpSelDate.Date := JvTimeLine1.SelDate; + dtpImageDate.Date := JvTimeLine1.SelDate; +end; + +// display the memo contents when double.clicking: the day number is +// automatically underlined when the Objects property has a non-nil value +procedure TTMTimeLineMainForm.DoDblClick(Sender:TObject); +begin + mnuEditMemo.Click; +end; + +// the timeline font is the font used for the day numbers +procedure TTMTimeLineMainForm.btnFontClick(Sender: TObject); +begin + with TFontDialog.Create(nil) do + try + Font := JvTimeLine1.Font; + if Execute then + JvTimeLine1.Font := Font; + finally + Free; + end; +end; + +// the timelines monthfont is the one used for displaying month names and the year +procedure TTMTimeLineMainForm.btnMonthFontClick(Sender: TObject); +begin + with TFontDialog.Create(nil) do + try + Font := JvTimeLine1.MonthFont; + if Execute then + JvTimeLine1.MonthFont := Font; + finally + Free; + end; +end; + +// if the timeline is readonly, the scrollbuttons disappear +// and the user cannot scroll with the mouse or keyboard +// the selection frame is also removed +procedure TTMTimeLineMainForm.chkReadOnlyClick(Sender: TObject); +begin + JvTimeLine1.ReadOnly := chkReadOnly.Checked; + StatusBarResize(Sender); +end; + +// enabled is not the same as read-only! +procedure TTMTimeLineMainForm.chkEnabledClick(Sender: TObject); +begin + JvTimeLine1.Enabled := chkEnabled.Checked; +end; + +// DayWidth is simply the width in pixels for one day +procedure TTMTimeLineMainForm.udDayWidthClick(Sender: TObject; Button: TUDBtnType); +begin + JvTimeLine1.DayWidth := udDayWidth.Position; + udDayWidth.Position := JvTimeLine1.DayWidth; + StatusBarResize(Sender); +end; + +// Color is the background color of the control +procedure TTMTimeLineMainForm.btnColorClick(Sender: TObject); +begin + with TColorDialog.Create(nil) do + try + Color := JvTimeLine1.Color; + if Execute then + JvTimeLine1.Color := Color; + finally + Free; + end; +end; + +// the timeline doesn't have a Flat property: when setting BorderStyle to bsNone, +// the scroll buttons are automatically changed to have a flat appearance +procedure TTMTimeLineMainForm.chkFlatClick(Sender: TObject); +const + cBStyle:array [boolean] of TBorderStyle = (bsSingle,bsNone); +begin + JvTimeLine1.BorderStyle := cBStyle[chkFlat.Checked]; +end; + +// update the first visible date from the datetimepicker +procedure TTMTimeLineMainForm.dtpFirstDateChange(Sender: TObject); +begin + JvTimeLine1.Date := dtpFirstDate.Date; +end; + +// update the selected date from the datetimepicker +procedure TTMTimeLineMainForm.dtpSelDateChange(Sender: TObject); +begin + JvTimeLine1.SelDate := dtpSelDate.Date; +end; + +// change the selection frame Pen color +// 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 +// Setting Pen.Width to 0, has the same effect as Selection.Visible := false +procedure TTMTimeLineMainForm.btnPenColorClick(Sender: TObject); +begin + with TColorDialog.Create(nil) do + try + Color := JvTimeLine1.Selection.Pen.Color; + if Execute then + begin + JvTimeLine1.Selection.Pen.Color := Color; + end; + finally + Free; + end; +end; + +// change the Selection frame Pen's width +procedure TTMTimeLineMainForm.udPenWidthClick(Sender: TObject; Button: TUDBtnType); +begin + JvTimeLine1.Selection.Pen.Width := udPenWidth.Position; +end; + +// changes the background Color of Today +procedure TTMTimeLineMainForm.btnTodayColorClick(Sender: TObject); +begin + with TColorDialog.Create(nil) do + try + Color := JvTimeLine1.TodayColor; + if Execute then + JvTimeLine1.TodayColor := Color; + finally + Free; + end; +end; + +// when RightClickSelect is true, a right-click changes +// the TJvTLTimeline.Date value +procedure TTMTimeLineMainForm.chkRClickClick(Sender: TObject); +begin + JvTimeLine1.RightClickSelect := chkRClick.Checked; +end; + +// move today to the middle of the timeline; looks better +procedure TTMTimeLineMainForm.mnuTodayClick(Sender: TObject); +begin + JvTimeLine1.Date := Date - JvTimeLine1.VisibleDays div 2; +end; + +// add or replace the image at the currently selected date +// if the imageindex is < 0 or > Images.Count - 1, the image is removed +procedure TTMTimeLineMainForm.mnuInsertImageClick(Sender: TObject); +begin + JvTimeLine1.ImageIndex[JvTimeLine1.SelDate] := udImageNo.Position; +end; + +// the SmallChange value is used when you scroll without holding any additional +// keys down (like Shift or Ctrl). You can scroll both with the mouse and with +// the arrow-keys +procedure TTMTimeLineMainForm.udScrollSmallClick(Sender: TObject; Button: TUDBtnType); +begin + JvTimeLine1.SmallChange := udScrollSmall.Position; +end; + +// the LargeChange value is used when you hold the Ctrl key while scrolling +procedure TTMTimeLineMainForm.udScrollLargeClick(Sender: TObject; Button: TUDBtnType); +begin + JvTimeLine1.LargeChange := udScrollLarge.Position; +end; + +// remove an image by setting the imageindex to -1 +procedure TTMTimeLineMainForm.mnuRemoveImageClick(Sender: TObject); +begin + JvTimeLine1.ImageIndex[JvTimeLine1.SelDate] := -1; +end; + +// Get or create a TStringlist for the selected date. +// If the user empties the memo, the TStringlist is freed +procedure TTMTimeLineMainForm.mnuEditMemoClick(Sender: TObject); +var S:TStringlist;i:integer;Ico:TIcon; +begin +// WARNING: if you store integers or other ordinal values in the Objects array +// you will get an AV if you call the ClearObjects method: +// JvTimeLine1.Objects[JvTimeLine1.Date] := TObject(Random(100)); + + S := TStringlist(JvTimeLine1.Objects[JvTimeLine1.SelDate]); + // here's a trick: extract the image from the imagelist and assign t to the icon property of the form: + i := JvTimeLine1.ImageIndex[JvTimeLine1.SelDate]; + if i > -1 then + begin + Ico := TIcon.Create; + il16.GetIcon(i,Ico); + end + else + Ico := nil; + + if S = nil then + S := TStringlist.Create; + // TIP: add a class function to dialogs that you show modally. + // That way, you can keep all the creating and freeing stuff in the + // dialog unit instead of in the calling unit. + // This reduces the dialog call to a one-liner: + TMemoEditFrm.Edit(S,JvTimeLine1.SelDate,Ico); // the Edit function automatically updates S if the user clicked OK in the dialog + + if Length(trim(S.Text)) = 0 then + begin // there is no text, so free the stringlist to conserve memory + S.Free; + S := nil; + end; + JvTimeLine1.Objects[JvTimeLine1.SelDate] := S; // either way, store the value (nil or TStringlist) + // if Objects[JvTimeLine1.Date] has a non-nil value, the day number is underlined for that date + Ico.Free; +end; + +// changes the widths of the scrollbuttons +procedure TTMTimeLineMainForm.udButtonWidthClick(Sender: TObject; Button: TUDBtnType); +begin + JvTimeLine1.ButtonWidth := udButtonWidth.Position; + StatusBarResize(Sender); +end; + +// By default, the timeline only stores the imageindex for the dates so if you need +// a little more functionality, here's where you have your chance: +// The OnWriteObject event is called for any date that has a non-nil Objects. +// Because we are storing stringlists in the objects array, we save each of them as a +// long text string to the stream here. +// If you want to store other values, you will have to save them accordingly. +procedure TTMTimeLineMainForm.DoObjectSave(Sender:TObject;Stream:TStream;const AObject:TObject); +var S:string;Count:integer; +begin + S := TStringlist(AObject).Text; + Count := Length(S); + // save length of string + Stream.Write(Count,sizeof(Count)); + // need we store anything ? + if Count > 0 then + Stream.Write(S[1],Count); +end; + +// The OnReadObject event is called for each object stored in a data file. +// The Timeline keeps track of all the dates that have non-nil objects and calls +// this method for each one of them. +// You don't have to worry about the actual date the object belongs to, because the +// timeline handles this for you. +// +// You must do two things in this handler: +// 1. Create an instance of your class (if it is a class you are storing) +// 2. Read the data from the stream and save it in AObject + +procedure TTMTimeLineMainForm.DoObjectLoad(Sender:TObject;Stream:TStream;var AObject:TObject); +var S:string;Count:integer; +begin + // Get the length of the string: + Stream.Read(Count,sizeof(Count)); + SetLength(S,Count); + // need we read any more ? + if Count > 0 then + begin + Stream.Read(S[1],Count); + AObject := TStringlist.Create; + TStringlist(AObject).Text := S; + end; +end; + +procedure TTMTimeLineMainForm.lbObjFontStyleClickCheck(Sender: TObject); +var F:TFontStyles; +begin + F := []; + with lbObjFontStyle do + begin + if Checked[0] then + Include(F,fsBold); + if Checked[1] then + Include(F,fsItalic); + if Checked[2] then + Include(F,fsUnderline); + if Checked[3] then + Include(F,fsStrikeOut); + end; + JvTimeLine1.ObjectsFontStyle := F; +end; + +// move to the selected day and center it on the display +procedure TTMTimeLineMainForm.mnuGotoDateClick(Sender: TObject); +begin + JvTimeLine1.Date := JvTimeLine1.SelDate - JvTimeLine1.VisibleDays div 2; +end; + +// update the statusbar whnever anything changes +procedure TTMTimeLineMainForm.StatusBarResize(Sender: TObject); +begin + StatusBar.Panels[0].Text := Format('Visible days: %d',[JvTimeLine1.VisibleDays]); + StatusBar.Panels[1].Text := Format('Last visible date: %s',[DateToStr(JvTimeLine1.LastVisibleDate)]); +end; + +// display options: +procedure TTMTimeLineMainForm.chkShowMonthsClick(Sender: TObject); +begin + JvTimeLine1.ShowMonths := chkShowMonths.Checked; +end; + +procedure TTMTimeLineMainForm.chkShowWeeksClick(Sender: TObject); +begin + JvTimeLine1.ShowWeeks := chkShowWeeks.Checked; +end; + +procedure TTMTimeLineMainForm.chkShowTodayClick(Sender: TObject); +begin + JvTimeLine1.ShowToday := chkShowToday.Checked; +end; + +// handling the wheel: +procedure TTMTimeLineMainForm.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); +begin + (* --------- FIX ME + if not JvTimeLine1.Focused and (ControlAtPos(ScreenToClient(MousePos),false,true) is TJvTMTimeline) then + begin + Handled := true; + if ssCtrl in Shift then + JvTimeLine1.ScrollDate(self,-udScrollSmall.Position) + else + JvTimeLine1.ScrollDate(self,-udScrollLarge.Position); + end; + *) +end; + +procedure TTMTimeLineMainForm.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; + MousePos: TPoint; var Handled: Boolean); +begin + (* ---------- FIXME + if not JvTimeLine1.Focused and (ControlAtPos(ScreenToClient(MousePos),false,true) is TJvTMTimeline) then + begin + Handled := true; + if ssCtrl in Shift then + JvTimeLine1.ScrollDate(self,udScrollSmall.Position) + else + JvTimeLine1.ScrollDate(self,udScrollLarge.Position); + end; + *) +end; + +procedure TTMTimeLineMainForm.btnLineColorClick(Sender: TObject); +begin + with TColorDialog.Create(nil) do + try + Color := JvTimeLine1.LineColor; + if Execute then + JvTimeLine1.LineColor := Color; + finally + Free; + end; + +end; + +procedure TTMTimeLineMainForm.chkShowTodayIconClick(Sender: TObject); +begin + JvTimeLine1.ShowTodayIcon := chkShowTodayIcon.Checked; +end; + +end. diff --git a/components/jvcllaz/examples/JvTMTimeLine/TeamManagerImages.bmp b/components/jvcllaz/examples/JvTMTimeLine/TeamManagerImages.bmp new file mode 100644 index 0000000000000000000000000000000000000000..abf0536dbdafff7ea190391c8d8593910b5cdf3f GIT binary patch literal 1126 zcmbW0F>V4u3`HF!U9=)fZa|feJEYGws8gk;q=~3qAg;m@w#*cBhZP;w<b4}Z0u&pD zvAuZw{cX?g+xz^%Vtt}tkq_h<xwAYN?#*5vQ=afkaxKi*wpgS=^Jv@c7OR66+gj5T z!cQ(#tyRMEG^2HIonnixM?)fz0%YC)N7#dduy{+tv1ni-gf0mGmg|`-GBb$mD4e3> ze{uK}l;~QcXXV28-P%AW2UC1cO#w3_0Gyx7?T<YRw_@<*S#b*(->9QAJ~61n?0K^% z8$3G^LT8xb@Er+NAAE9RGF!|FB!KBGae@=VszG>~CmwJf)pvwYl5n%>1z+FMVc(TC z;bmQ}^R?Yfbxwwf_#zn~0}9B29?CuMueA%DP>4_n+4B0Y&U5%RPg>E2NPFD<Md0Z@ h(;UxV@ATE>@{6ORIXIb%oEl@;&?D5X-_dQ~?GIw}?a}}M literal 0 HcmV?d00001 diff --git a/components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.lfm b/components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.lfm new file mode 100644 index 000000000..bb5da1406 --- /dev/null +++ b/components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.lfm @@ -0,0 +1,103 @@ +object MemoEditFrm: TMemoEditFrm + Left = 427 + Height = 305 + Top = 205 + Width = 305 + ActiveControl = reLines + BorderStyle = bsSizeToolWin + Caption = 'Memo for %s' + ClientHeight = 305 + ClientWidth = 305 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + LCLVersion = '1.9.0.0' + object Panel1: TPanel + Left = 0 + Height = 41 + Top = 264 + Width = 305 + Align = alBottom + BevelOuter = bvNone + ClientHeight = 41 + ClientWidth = 305 + Font.Color = clWindowText + ParentFont = False + TabOrder = 0 + object btnOK: TButton + Left = 137 + Height = 25 + Top = 8 + Width = 75 + Anchors = [akRight, akBottom] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object btnCancel: TButton + Left = 217 + Height = 25 + Top = 8 + Width = 75 + Anchors = [akRight, akBottom] + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + end + object reLines: TMemo + Left = 4 + Height = 256 + Top = 4 + Width = 297 + Align = alClient + BorderSpacing.Around = 4 + OnKeyUp = reLinesKeyUp + PopupMenu = popMemo + ScrollBars = ssBoth + TabOrder = 1 + end + object popMemo: TPopupMenu + left = 128 + top = 104 + object Load1: TMenuItem + Caption = 'Load...' + ShortCut = 16463 + OnClick = Load1Click + end + object Save1: TMenuItem + Caption = 'Save...' + ShortCut = 16467 + OnClick = Save1Click + end + object N1: TMenuItem + Caption = '-' + end + object Cut1: TMenuItem + Caption = 'Cut' + ShortCut = 16472 + OnClick = Cut1Click + end + object Copy1: TMenuItem + Caption = 'Copy' + ShortCut = 16451 + OnClick = Copy1Click + end + object Paste1: TMenuItem + Caption = 'Paste' + ShortCut = 16470 + OnClick = Paste1Click + end + object N2: TMenuItem + Caption = '-' + end + object Selectall1: TMenuItem + Caption = 'Select all' + ShortCut = 16449 + OnClick = Selectall1Click + end + end +end diff --git a/components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.pas b/components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.pas new file mode 100644 index 000000000..f59f2153a --- /dev/null +++ b/components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.pas @@ -0,0 +1,136 @@ +{****************************************************************** + + JEDI-VCL Demo + + Copyright (C) 2002 Project JEDI + + Original author: + + Contributor(s): + + You may retrieve the latest version of this file at the JEDI-JVCL + home page, located at http://jvcl.delphi-jedi.org + + The contents of this file are used with permission, subject to + the Mozilla Public License Version 1.1 (the "License"); you may + not use this file except in compliance with the License. You may + obtain a copy of the License at + http://www.mozilla.org/MPL/MPL-1_1Final.html + + Software distributed under the License is distributed on an + "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or + implied. See the License for the specific language governing + rights and limitations under the License. + +******************************************************************} + +{$mode objfpc}{$H+} + +unit frmMemoEdit; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, ExtCtrls, Menus; + +type + TMemoEditFrm = class(TForm) + Panel1: TPanel; + btnOK: TButton; + btnCancel: TButton; + reLines: TMemo; //RichEdit; + popMemo: TPopupMenu; + Load1: TMenuItem; + Save1: TMenuItem; + N1: TMenuItem; + Cut1: TMenuItem; + Copy1: TMenuItem; + Paste1: TMenuItem; + Selectall1: TMenuItem; + N2: TMenuItem; + procedure Load1Click(Sender: TObject); + procedure Save1Click(Sender: TObject); + procedure Cut1Click(Sender: TObject); + procedure Copy1Click(Sender: TObject); + procedure Paste1Click(Sender: TObject); + procedure Selectall1Click(Sender: TObject); + procedure reLinesKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); + public + class function Edit(Lines: TStrings;ADate:TDateTime; AIcon:TIcon = nil): boolean; + end; + + +implementation + +{$R *.lfm} + +{ TMemoEditFrm } + +class function TMemoEditFrm.Edit(Lines: TStrings;ADate:TDateTime; AIcon:TIcon = nil): boolean; +var + f:TMemoEditFrm; +begin + f := self.Create(nil); + try + f.Icon := AIcon; + f.Caption := Format(f.Caption,[DateToStr(ADate)]); + f.reLines.Lines := Lines; + Result := f.ShowModal = MROK; + if Result then + Lines.Assign(f.ReLines.Lines); + finally + f.Free; + end; +end; + +procedure TMemoEditFrm.Load1Click(Sender: TObject); +begin + with TOpenDialog.Create(nil) do + try + if Execute then + reLines.Lines.LoadFromFile(Filename); + finally + Free; + end; +end; + +procedure TMemoEditFrm.Save1Click(Sender: TObject); +begin + with TSaveDialog.Create(nil) do + try + if Execute then + reLines.Lines.SaveToFile(Filename); + finally + Free; + end; +end; + +procedure TMemoEditFrm.Cut1Click(Sender: TObject); +begin + reLines.CutToClipboard; +end; + +procedure TMemoEditFrm.Copy1Click(Sender: TObject); +begin + reLines.CopyToClipboard; +end; + +procedure TMemoEditFrm.Paste1Click(Sender: TObject); +begin + reLines.PasteFromClipboard; +end; + +procedure TMemoEditFrm.Selectall1Click(Sender: TObject); +begin + reLines.SelectAll; +end; + +procedure TMemoEditFrm.reLinesKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then + Close; +end; + +end. diff --git a/components/jvcllaz/examples/JvTMTimeLine/il16.bmp b/components/jvcllaz/examples/JvTMTimeLine/il16.bmp new file mode 100644 index 0000000000000000000000000000000000000000..0261dfcb400e1f5ddfa999f5450f935357bb987f GIT binary patch literal 4162 zcmds1+i}A%40GEBvO#`3hyS}#?%GkiNh=tJLF(n7<kG8kF)4u}2}sWRv0j$#S<Cyq z{JzQ$OE2a9R_r!`jn8daz6*FQYuB5`a?{XCwoZ`OH9Nx<_e>l4#y-T{Hlpw^>(8e~ zFUuKT=X=b&*O@Evggm!r-tvsWi|n96T}L=7^zfYRQL`~WR3wUbT_2pcuD35ho}&(S zufRBB7U9r^{9A=e{bM+D?JdXGSR<UzaMb40+bgUW!OqB=Z>%^A`7N&)bN)hG{;EOi z+|k1+#JUlKKi!)MHaioFNsM4#-T`z_*Af4M9SXz@=jYFiRHx3aPF!Cr*{ZLeLJhsl zuZ5EW?k;`@u5Nx-pyjVGU)KBGxz(*%s0Ui_mB+gQ6gjj?+ogA+K+M3b>P=sOBO-q& zutkLY`~BGe`DXmduH_ilTa-7SeYM@8&sG6<PcKI_=zizjM~=t}6b%A<L`nfvsnyYU zi`>!}zAL!u97kqHct5;3zZ{WwZrBNbG2A<-*ds$!s8&b(#{DxQ;<-oQ<j!|gPmxwY zE4IL-5v?(K>av#`F_%?CJF*peS@XKjKk}=qh#}9n&VU>`dDs@m3KeKEDT4?_)o0Z1 zy64K-`EK2BCp=+y+|hAoBUVv?kxJvN_dtBR;Po>yrjKFu3?J|GsXvFkyC1V>%!~sR ZnBy~4cVKi!W_$k!_Pn$IEBdu({|jfK(gXki literal 0 HcmV?d00001 diff --git a/components/jvcllaz/resource/JvTMTimeLine.res b/components/jvcllaz/resource/JvTMTimeLine.res new file mode 100644 index 0000000000000000000000000000000000000000..619a9c769b62e1c1068a9efe53fcb8b81c647433 GIT binary patch literal 832 zcmc(dJx;?w5QQHoLZUE=H~|F(Wv+lw5<m_}4j@X7;sa1{Bp+cfu=k)_zM1hL=ps?D z_WRlK$j-d1Bwc{k0@z>clieF=?O6AE(T$$9*OMN#gAI4^T0Q!J?$92M9;@`a)}Spe z*D4Kq1<t@ZIMM=^KAeM=KfE;ht#LF5xU2+C(?rFFFlixh%+*wDol(@er_Z#Y9g0wp zZ7Db#<vyQhf3cPz@8+%acJ>~>vyV^2cPPYn<9EDMeg%i-x+nR8)O)|y+K_y%RT|Xt zJOQU5^Ss38TBdOwEkp}21jZhiC$lnto#(d9V*a^aJN;$GfpfIg?e~=bF=OG+E1Zqu O=fdW*^I$sHdHw}2!mYai literal 0 HcmV?d00001 diff --git a/components/jvcllaz/resource/jvcustomreg.res b/components/jvcllaz/resource/jvcustomreg.res index b3d3762b445df7f5c1ed0b28770dd17578ba779d..0815e26e001f18517d46fdcafa1702f775e9e828 100644 GIT binary patch delta 557 zcmZ`#I}XAy40RDI6C)Dh0PIX<X}Tk^A!bHKZcuRsu8;%3-lOy;jcT5qrX)ytYTf#M zoXFj}-@UtXb1#XGM8v$H3!UhSdj1?9%huHO=-e<k=S&LlVDU65Z)W~az#Q*yQX%3K zLHJe=Xn^Pt4L}q+7RCvy4A`>5PQK8378QJfckV5>`j0?SK#2mnEEXDqn6NvR1LPa~ x(fgPPv){*|kOY2y-^wVl^SBQ;QX!0zfFfMz^(?nHn?dFG6jxnll@Y3p@CCL(GQI!+ delta 7 Ocmca3wTE}Z9yS0D6$3H= diff --git a/components/jvcllaz/run/JvCustomControls/JvTMTimeLine.pas b/components/jvcllaz/run/JvCustomControls/JvTMTimeLine.pas new file mode 100644 index 000000000..9358dd472 --- /dev/null +++ b/components/jvcllaz/run/JvCustomControls/JvTMTimeLine.pas @@ -0,0 +1,1368 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvTMTimeLine.PAS, released on 2002-05-26. + +The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net] +Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. +All Rights Reserved. + +Contributor(s): + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Description: + A component that mimicks the time line in MS Team Manager + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvTMTimeLine; + +{$mode objfpc}{$H+} + +//{$I jvcl.inc} + +interface + +uses + LCLIntf, LCLType, LMessages, Types, + SysUtils, Classes, Controls, Buttons, Graphics, ExtCtrls, Forms, ImgList, + {$IFDEF BCB} + JvTypes, // TDate / TTime macros + {$ENDIF BCB} + //JvExtComponent, + JvExControls; + +type + TJvTLSelFrame = class(TPersistent) + private + FVisible: Boolean; + FPen: TPen; + FOnChange: TNotifyEvent; + procedure SetPen(const Value: TPen); + procedure SetVisible(const Value: Boolean); + procedure PenChange(Sender: TObject); + protected + procedure DoChange; virtual; + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + published + property Pen: TPen read FPen write SetPen; + property Visible: Boolean read FVisible write SetVisible default True; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + TJvBtnDown = (bdNone, bdLeft, bdRight); + TJvObjectReadEvent = procedure(Sender: TObject; Stream: TStream; var AObject: TObject) of object; + TJvObjectWriteEvent = procedure(Sender: TObject; Stream: TStream; const AObject: TObject) of object; + + TJvCustomTMTimeline = class(TCustomPanel) //(TJvCustomPanel) + private + FTimer: TTimer; + FImages: TImageList; + FChangeLink: TChangeLink; + FDateImages: TStringlist; + FObjects: TStringlist; + FLeftBtn: TSpeedButton; + FRightBtn: TSpeedButton; + FMonthFont: TFont; + FBtnDown: TJvBtnDown; + FReadOnly: Boolean; + FRightClickSelect: Boolean; + FDayWidth: Integer; + FButtonWidth: Integer; + FDate: TDate; + FSelDate: TDate; + FMinDate: TDate; + FMaxDate: TDate; + FImageCursor: TCursor; + FRealCursor: TCursor; + FTodayColor: TColor; + FSelection: TJvTLSelFrame; + FOnChange: TNotifyEvent; + FLargeChange: Word; + FSmallChange: Word; + FOnWriteObject: TJvObjectWriteEvent; + FOnReadObject: TJvObjectReadEvent; + FObjectsFontStyle: TFontStyles; + FShowWeeks: Boolean; + FShowMonths: Boolean; + FShowToday: Boolean; + FLineColor: TColor; + FShift: TShiftState; + FShowTodayIcon: Boolean; + function GetRectForDate(ADate: TDate): TRect; + function DateFromPos(APos: Integer): TDate; + procedure DoTimer(Sender: TObject); + procedure SetFirstDate(const Value: TDate); + procedure SetReadOnly(const Value: Boolean); + procedure SetMonthFont(const Value: TFont); + procedure SetSelDate(const Value: TDate); + procedure SetDayWidth(const Value: Integer); + function GetBorderStyle: TBorderStyle; + procedure SetBorderStyle(const Value: TBorderStyle); + procedure SetImages(const Value: TImageList); + procedure DoChange(Sender: TObject); + function GetImageIndex(ADate: TDate): Integer; + procedure SetImageIndex(ADate: TDate; const Value: Integer); + procedure DrawDates(ACanvas: TCanvas); + procedure DrawSelectionFrame(ACanvas: TCanvas; ARect: TRect); + procedure DrawImage(ACanvas: TCanvas; ADate: TDate; const ARect: TRect); + procedure DrawToday(ACanvas: TCanvas; const ARect: TRect); + procedure SetImageCursor(const Value: TCursor); + procedure SetSelection(const Value: TJvTLSelFrame); + procedure DoLMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure DoMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure DoRMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + // this is needed so we receive the arrow keys + + procedure DrawFrame(ACanvas: TCanvas; AColor: TColor; + ALineWidth: Integer; ARect: TRect); + procedure SetTodayColor(const Value: TColor); + procedure SetLineColor(const Value: TColor); + procedure SetRightClickSelect(const Value: Boolean); + procedure SetMaxDate(const Value: TDate); + procedure SetMinDate(const Value: TDate); + procedure SetLargeChange(const Value: Word); + procedure SetSmallChange(const Value: Word); + function GetObjects(ADate: TDate): TObject; + procedure SetObjects(ADate: TDate; const Value: TObject); + procedure SetButtonWidth(const Value: Integer); + procedure SetObjectsFontStyle(const Value: TFontStyles); + procedure SetShowMonths(const Value: Boolean); + procedure SetShowToday(const Value: Boolean); + procedure SetShowWeeks(const Value: Boolean); + function ReadMagic(Stream: TStream): Boolean; + procedure StartTimer; + procedure StopTimer; + function DateHasImage(ADate: TDateTime): Boolean; + procedure SetShowTodayIcon(const Value: Boolean); + protected +// procedure GetDlgCode(var Code: TDlgCodes); override; <--- wp +// procedure CursorChanged; override; <--- wo + procedure EnabledChanged; override; + procedure Paint; override; + function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; + function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure Change; virtual; + procedure LoadObject(Stream: TStream; var AObject: TObject); virtual; + procedure SaveObject(Stream: TStream; const AObject: TObject); virtual; + function GetLastVisibleDate: TDate; + function GetVisibleDays: Integer; + + property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle; + property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 12; + property Cursor; + property DayWidth: Integer read FDayWidth write SetDayWidth default 19; + property ObjectsFontStyle: TFontStyles read FObjectsFontStyle write SetObjectsFontStyle default [fsUnderline]; + property ImageCursor: TCursor read FImageCursor write SetImageCursor default crHandPoint; + property Images: TImageList read FImages write SetImages; + property LargeChange: Word read FLargeChange write SetLargeChange default 30; + property Date: TDate read FDate write SetFirstDate; + property SelDate: TDate read FSelDate write SetSelDate; + property MaxDate: TDate read FMaxDate write SetMaxDate; + property MinDate: TDate read FMinDate write SetMinDate; + property MonthFont: TFont read FMonthFont write SetMonthFont; + property ReadOnly: Boolean read FReadOnly write SetReadOnly; + property RightClickSelect: Boolean read FRightClickSelect write SetRightClickSelect; + property SmallChange: Word read FSmallChange write SetSmallChange default 7; + property Selection: TJvTLSelFrame read FSelection write SetSelection; + property TodayColor: TColor read FTodayColor write SetTodayColor default clAqua; + property LineColor: TColor read FLineColor write SetLineColor default clBlack; + property ShowToday: Boolean read FShowToday write SetShowToday default True; + property ShowTodayIcon: Boolean read FShowTodayIcon write SetShowTodayIcon default True; + property ShowWeeks: Boolean read FShowWeeks write SetShowWeeks default True; + property ShowMonths: Boolean read FShowMonths write SetShowMonths default True; + property LastVisibleDate: TDate read GetLastVisibleDate; + property VisibleDays: Integer read GetVisibleDays; + property Height default 56; + property Color default clWindow; + property RightButton: TSpeedButton read FRightBtn; + property LeftButton: TSpeedButton read FLeftBtn; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnReadObject: TJvObjectReadEvent read FOnReadObject write FOnReadObject; + property OnWriteObject: TJvObjectWriteEvent read FOnWriteObject write FOnWriteObject; + property Align default alTop; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + // this procedure resets all imageindexes to -1 + procedure ClearImages; + // this procedure frees all the objects in the Objects array + procedure ClearObjects; + // scrools the display Delta number of days. Delta can be either negative or positive + procedure ScrollDate(Sender: TObject; Delta: Integer); + // this procedure loads data from a stream and calls the OnReadObject event + procedure LoadFromStream(Stream: TStream); + // this procedure saves data to a stream and calls the OnWriteObject event + procedure SaveToStream(Stream: TStream); + procedure LoadFromFile(const Filename: string); + procedure SaveToFile(const Filename: string); + // gets / sets the imageindex for a specific date + property ImageIndex[ADate: TDate]: Integer read GetImageIndex write SetImageIndex; + // gets / sets the TObject for a specific date + property Objects[ADate: TDate]: TObject read GetObjects write SetObjects; + end; + + {$IFDEF RTL230_UP} + [ComponentPlatformsAttribute(pidWin32 or pidWin64)] + {$ENDIF RTL230_UP} + TJvTMTimeline = class(TJvCustomTMTimeline) + public + property RightButton; + property LeftButton; + published + // gets / sets the borderstyle of the control and the scroll-buttons + property BorderStyle; + // gets / sets the width of the buttons + property ButtonWidth; + // gets / sets the selected date + property SelDate; + // gets / sets the width of each day + property DayWidth; + // gets / sets the cursor to use when a date has an image associated + property ImageCursor; + // sets / gets the imagelist associated with the control + property Images; + // sets the interval for large changes (ctrl+click or ctrl+arrows) + property LargeChange; + // gets / sets the first visible date on the left edge + // OnChange is called when this date changes + property Date; + // sets the maximum date that users can scroll to + property MaxDate; + // sets the minimum date that users can scroll to + property MinDate; + // gets / sets the font used for the month display + property MonthFont; + // gets / sets the fontstyle for Objects that are non-nil + property ObjectsFontStyle; + property ReadOnly; + // gets / sets whether a right-click changes the Date property and moves the selection frame + property RightClickSelect; + // sets the interval for small changes (left-click or arrows) + property SmallChange; + // gets / sets the properties for the selection frame + property Selection; + // displays todays date in a different color + property ShowToday; + // displays todays date with a double-diamond icon + property ShowTodayIcon; + // shows / hides the dotted week separator + property ShowWeeks; + // shows the month separator line + property ShowMonths; + // gets / sets the background color for the today item + property TodayColor; + // gets / sets color of lines (dotted and solid) + property LineColor; + // this returns the date of the last fully visible date in the control + property LastVisibleDate; + // this returns the number of fully visible days in the control + property VisibleDays; + property Action; + property Align default alTop; + property Anchors; + property Constraints; + property Cursor; + property Enabled; + property Font; + property Height; + property Hint; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property TabStop; + property Color; + // triggered when the display is scrolled or when the left-most date changes + property OnChange; + // triggered when the control is clicked + property OnClick; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + // triggered for each object when reading from a file + property OnReadObject; + // triggered for each object when writing to a file + property OnWriteObject; + property OnStartDrag; + property OnStartDock; + property OnEndDock; + end; + + +implementation + +uses + LCLStrConsts, Themes, + JvConsts, JvJCLUtils, JvJVCLUtils; // JvThemes, JclSysUtils; + +{$R ..\..\resource\JvTMTimeLine.res} + +const + cMagic = 'Jv.TMTIMELINE1'; + +resourcestring + SInvalidImage = 'Invalid image'; + +//=== { TJvTLSelFrame } ====================================================== + +constructor TJvTLSelFrame.Create; +begin + inherited Create; + FPen := TPen.Create; + FPen.OnChange := @PenChange; + FVisible := True; +end; + +destructor TJvTLSelFrame.Destroy; +begin + FPen.Free; + inherited Destroy; +end; + +procedure TJvTLSelFrame.Assign(Source: TPersistent); +begin + if Source is TJvTLSelFrame then + begin + Pen := TJvTLSelFrame(Source).Pen; + Visible := TJvTLSelFrame(Source).Visible; + PenChange(Self); + end + else + inherited Assign(Source); +end; + +procedure TJvTLSelFrame.PenChange(Sender: TObject); +begin + DoChange; +end; + +procedure TJvTLSelFrame.DoChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJvTLSelFrame.SetPen(const Value: TPen); +begin + FPen.Assign(Value); + DoChange; +end; + +procedure TJvTLSelFrame.SetVisible(const Value: Boolean); +begin + if FVisible <> Value then + begin + FVisible := Value; + DoChange; + end; +end; + +//=== { TJvCustomTMTimeline } ================================================ + +constructor TJvCustomTMTimeline.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + DoubleBuffered := True; + ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls]; + // IncludeThemeStyle(Self, [csNeedsBorderPaint]); <--- wp + + FSelection := TJvTLSelFrame.Create; + FSelection.Pen.Width := 2; + FSelection.OnChange := @DoChange; + + FChangeLink := TChangeLink.Create; + FChangeLink.OnChange := @DoChange; + + FDateImages := TStringlist.Create; + FDateImages.Sorted := True; + FObjects := TStringlist.Create; + FObjects.Sorted := True; + + FMonthFont := TFont.Create; + FMonthFont.Style := [fsItalic, fsBold]; + FMonthFont.Name := 'Times New Roman'; + FMonthFont.Size := 18; + + FObjectsFontStyle := [fsUnderline]; + FButtonWidth := 12; + FDate := SysUtils.Date - 7; + FSelDate := FDate - 1; + FDayWidth := 19; + FImageCursor := crHandPoint; + FSmallChange := 7; + FLargeChange := 30; + FTodayColor := clAqua; + FLineColor := clBlack; + FShowToday := True; + FShowTodayIcon := True; + FShowWeeks := True; + FShowMonths := True; + Font.Size := 7; + Font.Name := 'Times New Roman'; + + FLeftBtn := TSpeedButton.Create(Self); + with FLeftBtn do + begin + Align := alLeft; + Width := FButtonWidth; + Parent := Self; + Transparent := False; + Layout := blGlyphTop; + Glyph.LoadFromResourceName(HInstance, 'JvCustomTMTimelineSCROLLLEFT'); + + OnMouseDown := @DoLMouseDown; + OnMouseUp := @DoMouseUp; + // OnClick := LeftClick; + end; + + FRightBtn := TSpeedButton.Create(Self); + with FRightBtn do + begin + Align := alRight; + Width := FButtonWidth; + Parent := Self; + Transparent := False; + Layout := blGlyphTop; + Glyph.LoadFromResourceName(HInstance, 'JvCustomTMTimelineSCROLLRIGHT'); + + OnMouseDown := @DoRMouseDown; + OnMouseUp := @DoMouseUp; + end; + FLeftBtn.SetSubComponent(True); + FRightBtn.SetSubComponent(True); + Height := 56; + BevelInner := bvNone; + BevelOuter := bvNone; + Color := clWindow; + Align := alTop; + BorderStyle := bsSingle; +end; + +destructor TJvCustomTMTimeline.Destroy; +begin + FChangeLink.Free; + FMonthFont.Free; + FSelection.Free; + FDateImages.Free; + FObjects.Free; + inherited Destroy; +end; + +procedure TJvCustomTMTimeline.StartTimer; +begin + if not Assigned(FTimer) then + begin + FTimer := TTimer.Create(Self); + FTimer.OnTimer := @DoTimer; + FTimer.Interval := 400; + end; + FTimer.Enabled := True; +end; + +procedure TJvCustomTMTimeline.StopTimer; +begin + FTimer.Free; + FTimer := nil; +end; + +procedure TJvCustomTMTimeline.DoLMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbRight then + Exit; + if ssCtrl in Shift then + ScrollDate(Sender, -LargeChange) + else + ScrollDate(Sender, -SmallChange); + FBtnDown := bdLeft; + FShift := Shift; + StartTimer; +end; + +procedure TJvCustomTMTimeline.DoRMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbRight then + Exit; + if ssCtrl in Shift then + ScrollDate(Sender, LargeChange) + else + ScrollDate(Sender, SmallChange); + FShift := Shift; + FBtnDown := bdRight; + StartTimer; +end; + +procedure TJvCustomTMTimeline.DoMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + FBtnDown := bdNone; + StopTimer; +end; + +procedure TJvCustomTMTimeline.DoTimer(Sender: TObject); +begin + FTimer.Enabled := False; + case FBtnDown of + bdLeft: + if ssCtrl in FShift then + ScrollDate(Sender, -LargeChange) + else + ScrollDate(Sender, -SmallChange); + bdRight: + if ssCtrl in FShift then + ScrollDate(Sender, LargeChange) + else + ScrollDate(Sender, SmallChange); + bdNone: + begin + FTimer.Interval := 400; + Exit; + end; + end; + FTimer.Interval := 70; + FTimer.Enabled := True; +end; + +procedure TJvCustomTMTimeline.DoChange(Sender: TObject); +begin + Invalidate; +end; + +procedure TJvCustomTMTimeline.ScrollDate(Sender: TObject; Delta: Integer); +begin + Delta := Trunc(Self.Date + Delta); + if ((MinDate = 0) or (Delta > MinDate)) and + ((MaxDate = 0) or (Delta < MaxDate)) then + Self.Date := Delta; +end; + +function TJvCustomTMTimeline.GetRectForDate(ADate: TDate): TRect; +begin + // all rects are the same size... + Result := Classes.Rect(0, 0, DayWidth, ClientHeight + 1); + // ...but we must move the entire rect to the correct date + OffsetRect(Result, Trunc(ADate - Self.Date) * DayWidth, 0); + // ...and finally compensate for the inital offset + if ReadOnly then + OffsetRect(Result, 1, 0) // no buttons showing + else + OffsetRect(Result, ButtonWidth, 0); +end; + +function TJvCustomTMTimeline.DateFromPos(APos: Integer): TDate; +var + Tmp: Integer; +begin + if not ReadOnly then + Tmp := APos - ButtonWidth + else + Tmp := APos - 1; + Result := Self.Date + (Tmp div FDayWidth); +end; + +procedure TJvCustomTMTimeline.DrawToday(ACanvas: TCanvas; const ARect: TRect); +var + Tmp: TColor; + Bmp: TBitmap; + R: TRect; +begin + if ShowTodayIcon then + Bmp := TBitmap.Create + else + Bmp := nil; + Tmp := ACanvas.Brush.Color; + try + if ShowTodayIcon then + Bmp.LoadFromResourceName(HInstance, 'JvCustomTMTimelineMILESTONELARGE'); + if ShowToday then + begin + ACanvas.Brush.Color := FTodayColor; + ACanvas.FillRect(ARect); + end; + if ShowTodayIcon then + begin + R := Classes.Rect(ARect.Left + ((ARect.Right - ARect.Left) - Bmp.Width) div 2, + ARect.Top + CanvasMaxTextHeight(ACanvas) + 2, + ARect.Left + ((ARect.Right - ARect.Left) - Bmp.Width) div 2 + Bmp.Width, + ARect.Top + Bmp.Height + CanvasMaxTextHeight(ACanvas) + 2); +(* {$IFDEF VCL} + ACanvas.BrushCopy(R, Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), clFuchsia); + {$ENDIF VCL} + {$IFDEF VisualCLX} + *) + Bmp.Transparent := True; + ACanvas.Draw(R.Left, R.Top, Bmp); +// {$ENDIF VisualCLX} + end; + finally + ACanvas.Brush.Color := Tmp; + Bmp.Free; + end; +end; + +procedure TJvCustomTMTimeline.DrawDates(ACanvas: TCanvas); +var + I, FirstOffset: Integer; + Y, M, D: Word; + R: TRect; + Size: TSize; + S: string; + FTmpStyle: TFontStyles; + AContinue: Boolean; +begin + AContinue := True; + // DoBeforeDraw(ACanvas); + if not AContinue then + Exit; + if not ReadOnly then + FirstOffset := ButtonWidth + else + FirstOffset := 1; + // first loop: draw dates, today and images + FTmpStyle := Font.Style; + for I := 0 to Width div FDayWidth do + begin + R := GetRectForDate(Self.Date + I); + if Self.Date + I = SysUtils.Date then + DrawToday(ACanvas, R); + + DecodeDate(Self.Date + I, Y, M, D); + R := Classes.Rect(I * FDayWidth, 4, I * FDayWidth + FDayWidth, Font.Size + 4); + OffsetRect(R, FirstOffset, 0); + S := Format('%.2d', [D]); + SetBkMode(ACanvas.Handle, TRANSPARENT); + if Objects[Self.Date + I] <> nil then + ACanvas.Font.Style := FObjectsFontStyle + else + ACanvas.Font.Style := FTmpStyle; + + DrawText(ACanvas.Handle, PChar(S), Length(S), R, + DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP); + DrawImage(ACanvas, Self.Date + I, GetRectForDate(Self.Date + I)); + // frame should be drawn on top of text and image + if (Trunc(SelDate) = Trunc(Self.Date + I)) and not ReadOnly then + DrawSelectionFrame(ACanvas, GetRectForDate(SelDate)); + + ACanvas.Font := Font; + if not Enabled then + ACanvas.Font.Color := clGrayText; + end; + + // second loop: draw months and years and separators + if ShowWeeks or ShowMonths then + for I := 0 to (Width div DayWidth) do + begin + R := GetRectForDate(Self.Date + I); + DecodeDate(FDate + I, Y, M, D); + if ShowWeeks and (DayOfWeek(Self.Date + I) = 1) then + with ACanvas do + begin + // draw the dotted week separator between sunday and monday + Brush.Color := Color; + Pen.Width := 1; + Pen.Style := psDot; + Pen.Color := FLineColor; + MoveTo(I * FDayWidth + FDayWidth + FirstOffset, 0); + LineTo(I * FDayWidth + FDayWidth + FirstOffset, Height); + end; + + ACanvas.Font := MonthFont; + if not Enabled then + ACanvas.Font.Color := clGrayText; + if ShowMonths then + begin + if MonthDays[IsLeapYear(Y), M] = D then + begin + // draw text for end of this month: + S := FormatSettings.ShortMonthNames[M]; + Size := ACanvas.TextExtent(S); + R := Classes.Rect(I * FDayWidth + FDayWidth - Size.cx - 8, + Height - Size.cy - 4, I * FDayWidth + FDayWidth, Height - 4); + OffsetRect(R, FirstOffset, 0); + SetBkMode(ACanvas.Handle, TRANSPARENT); + DrawText(ACanvas.Handle, PChar(S), Length(S), R, + DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP); + end + else + if D = 1 then + begin + // draw text for start of this month and the year: + S := Format('%s %d', [FormatSettings.ShortMonthNames[M], Y]); + Size := ACanvas.TextExtent(S); + R := Classes.Rect(I * FDayWidth + 4, Height - Size.cy - 4, I * FDayWidth + Size.cx + 4, Height - 4); + OffsetRect(R, FirstOffset, 0); + SetBkMode(ACanvas.Handle, TRANSPARENT); + DrawText(ACanvas.Handle, PChar(S), Length(S), R, + DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP); + + // Draw the separator + with ACanvas do + begin + Pen.Width := 1; + Pen.Style := psSolid; + Pen.Color := FLineColor; + MoveTo(I * FDayWidth + FirstOffset, 0); + LineTo(I * FDayWidth + FirstOffset, Height); + end; + end; + end; + end; + + // finally, clean up the display + if (ButtonWidth > 0) and not ReadOnly then + with ACanvas do + begin + // draw a vertical line just to the right of the left scroll button and + // just to the left of the right scroll button to + // make them stand out a little bit more when buttons are flat: + Pen.Width := 1; + Pen.Color := clBlack; + Pen.Style := psSolid; + if BorderStyle = bsNone then + begin + MoveTo(FLeftBtn.Width, 0); + LineTo(FLeftBtn.Width, Height); + end; + MoveTo(FRightBtn.Left - 1, 0); + LineTo(FRightBtn.Left - 1, Height); + end; + // DoAfterDraw(ACanvas); +end; + +procedure TJvCustomTMTimeline.DrawSelectionFrame(ACanvas: TCanvas; ARect: TRect); +begin + if not FSelection.Visible then + Exit; + if (ARect.Right > 0) and (ARect.Left <= Width) then + begin + ARect.Bottom := ARect.Bottom - ACanvas.Pen.Width; + with FSelection do + DrawFrame(ACanvas, Pen.Color, Pen.Width, ARect); + end; +end; + +procedure TJvCustomTMTimeline.DrawImage(ACanvas: TCanvas; ADate: TDate; const ARect: TRect); +var + I, X, Y: Integer; +begin + if DateHasImage(ADate) then + begin + I := ImageIndex[ADate]; + X := ARect.Left + (FDayWidth - Images.Width) div 2; + // Y := Max((Height - Images.Height) div 4, CanvasMaxTextHeight(ACanvas) + 2); + Y := CanvasMaxTextHeight(ACanvas) + 2; + Images.Draw(ACanvas, X, Y, I); + end; +end; + +procedure TJvCustomTMTimeline.Paint; +begin + if not Showing or (csLoading in ComponentState) then + Exit; + inherited Canvas.Font := Font; + DrawDates(inherited Canvas); +end; + +procedure TJvCustomTMTimeline.DrawFrame(ACanvas: TCanvas; AColor: TColor; + ALineWidth: Integer; ARect: TRect); +var + Tmp: TColor; +begin + if ALineWidth = 0 then + Exit; + Tmp := ACanvas.Brush.Color; + try + ACanvas.Brush.Color := AColor; + ACanvas.FrameRect(ARect); + InflateRect(ARect, -Abs(ALineWidth) + 1, -Abs(ALineWidth) + 1); + ACanvas.FrameRect(ARect); + ACanvas.FloodFill(ARect.Left - 1, ARect.Top - 1, AColor, fsBorder); + finally + ACanvas.Brush.Color := Tmp; + end; +end; + +procedure TJvCustomTMTimeline.SetFirstDate(const Value: TDate); +begin + if Trunc(FDate) <> Trunc(Value) then + begin + if (FMinDate > 0) and (Trunc(FMinDate) > Trunc(FDate)) then + FDate := FMinDate + else + if (FMaxDate > 0) and (Trunc(FMaxDate) < Trunc(FDate)) then + FDate := Trunc(FMaxDate) + else + FDate := Trunc(Value); + Change; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetReadOnly(const Value: Boolean); +begin + if FReadOnly <> Value then + begin + FReadOnly := Value; + FLeftBtn.Visible := not FReadOnly; + FRightBtn.Visible := not FReadOnly; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetMonthFont(const Value: TFont); +begin + FMonthFont.Assign(Value); + Invalidate; +end; + +procedure TJvCustomTMTimeline.SetSelDate(const Value: TDate); +var + R: TRect; +begin + if FSelDate <> Value then + begin + // erase old selection + R := GetRectForDate(FSelDate); + InflateRect(R, Selection.Pen.Width + 1, Selection.Pen.Width + 1); + LCLIntf.InvalidateRect(Handle, @R, True); + FSelDate := Value; + if Enabled then + begin + // draw new selection + R := GetRectForDate(FSelDate); + InflateRect(R, Selection.Pen.Width + 1, Selection.Pen.Width + 1); + LCLIntf.InvalidateRect(Handle, @R, True); + end; + end; +end; + +procedure TJvCustomTMTimeline.SetDayWidth(const Value: Integer); +begin + if (FDayWidth <> Value) and (Value > 0) then + begin + FDayWidth := Value; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + inherited; + if (Button = mbLeft) or ((Button = mbRight) and RightClickSelect) then + SelDate := DateFromPos(X); + if CanFocus and not Focused then + SetFocus; +end; + +procedure TJvCustomTMTimeline.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited MouseUp(Button, Shift, X, Y); +end; + +function TJvCustomTMTimeline.GetBorderStyle: TBorderStyle; +begin + Result := inherited BorderStyle; +end; + +procedure TJvCustomTMTimeline.SetBorderStyle(const Value: TBorderStyle); +begin + if BorderStyle <> Value then + begin + inherited BorderStyle := Value; + FLeftBtn.Flat := BorderStyle = bsNone; + FRightBtn.Flat := BorderStyle = bsNone; + end; +end; + +procedure TJvCustomTMTimeline.SetImages(const Value: TImageList); +begin + if FImages <> Value then + begin + if Assigned(FImages) then + FImages.UnRegisterChanges(FChangeLink); + ReplaceComponentReference(Self, Value, TComponent(FImages)); + if Assigned(FImages) then + FImages.RegisterChanges(FChangeLink); + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (Operation = opRemove) and (AComponent = FImages) then + FImages := nil; +end; + +function TJvCustomTMTimeline.GetImageIndex(ADate: TDate): Integer; +begin + Result := FDateImages.IndexOf(IntToStr(Trunc(ADate))); + if Result > -1 then + Result := Integer(FDateImages.Objects[Result]); +end; + +procedure TJvCustomTMTimeline.SetImageIndex(ADate: TDate; + const Value: Integer); +var + I: Integer; +begin + I := FDateImages.IndexOf(IntToStr(Trunc(ADate))); + if I < 0 then + I := FDateImages.Add(IntToStr(Trunc(ADate))); + FDateImages.Objects[I] := TObject(Value); + Invalidate; +end; + +function TJvCustomTMTimeline.GetObjects(ADate: TDate): TObject; +var + I: Integer; +begin + Result := nil; + I := FObjects.IndexOf(IntToStr(Trunc(ADate))); + if I > -1 then + Result := FObjects.Objects[I]; +end; + +procedure TJvCustomTMTimeline.SetObjects(ADate: TDate; const Value: TObject); +var + I: Integer; +begin + I := FObjects.IndexOf(IntToStr(Trunc(ADate))); + if I < 0 then + I := FObjects.Add(IntToStr(Trunc(ADate))); + if Value = nil then + FObjects.Delete(I) + else + FObjects.Objects[I] := Value; + Invalidate; +end; + +procedure TJvCustomTMTimeline.Change; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TJvCustomTMTimeline.MouseMove(Shift: TShiftState; X, Y: Integer); +var + ADate: TDate; +begin + inherited MouseMove(Shift, X, Y); + ADate := DateFromPos(X); + if DateHasImage(ADate) then + inherited Cursor := FImageCursor + else + Cursor := FRealCursor; +end; + +procedure TJvCustomTMTimeline.SetImageCursor(const Value: TCursor); +begin + if FImageCursor <> Value then + begin + FImageCursor := Value; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetSelection(const Value: TJvTLSelFrame); +begin + FSelection.Assign(Value); +end; + +{ +procedure TJvCustomTMTimeline.GetDlgCode(var Code: TDlgCodes); +begin + Include(Code, dcWantArrows); + Exclude(Code, dcNative); +end; +} +procedure TJvCustomTMTimeline.EnabledChanged; +begin + inherited EnabledChanged; + // asn: VisualCLX inherited Create emits EnableChanged event + if Assigned(FRightBtn) then + begin + FLeftBtn.Enabled := Enabled; + FRightBtn.Enabled := Enabled; + end; + Invalidate; +end; + +procedure TJvCustomTMTimeline.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited KeyDown(Key, Shift); + if not Enabled or ReadOnly then + Exit; + // handling keys in KeyDown gives automatic + // scrolling when holding the key down + case Key of + VK_LEFT: + if ssCtrl in Shift then + ScrollDate(nil, -LargeChange) + else + if ssShift in Shift then + begin + SelDate := SelDate - 1; + // make sure the selection is visible: + if SelDate > GetLastVisibleDate then + Self.Date := SelDate - GetVisibleDays + 1; + if SelDate < Self.Date then + Self.Date := SelDate; + Click; + end + else + ScrollDate(nil, -SmallChange); + VK_RIGHT: + if ssCtrl in Shift then + ScrollDate(nil, LargeChange) + else + if ssShift in Shift then + begin + SelDate := SelDate + 1; + // make sure the selection is visible: + if SelDate > GetLastVisibleDate then + Self.Date := SelDate - GetVisibleDays + 1; + if SelDate < Self.Date then + Self.Date := SelDate; + Click; + end + else + ScrollDate(nil, SmallChange); + end; +end; + +procedure TJvCustomTMTimeline.SetTodayColor(const Value: TColor); +begin + if FTodayColor <> Value then + begin + FTodayColor := Value; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetRightClickSelect(const Value: Boolean); +begin + if FRightClickSelect <> Value then + FRightClickSelect := Value; +end; + +procedure TJvCustomTMTimeline.SetMaxDate(const Value: TDate); +begin + if Trunc(FMaxDate) <> Trunc(Value) then + begin + FMaxDate := Trunc(Value); + if FMaxDate <= 0 then + Exit; + if FMaxDate < Trunc(Self.Date) then + Self.Date := FMaxDate; + if FMaxDate < Trunc(FSelDate) then + SelDate := FMaxDate; + end; +end; + +procedure TJvCustomTMTimeline.SetMinDate(const Value: TDate); +begin + if Trunc(FMinDate) <> Trunc(Value) then + begin + FMinDate := Trunc(Value); + if FMinDate <= 0 then + Exit; + if FMinDate > Trunc(Self.Date) then + Self.Date := FMinDate; + if FMinDate > Trunc(FSelDate) then + SelDate := FMinDate; + end; +end; + +procedure TJvCustomTMTimeline.SetLargeChange(const Value: Word); +begin + FLargeChange := Value; +end; + +procedure TJvCustomTMTimeline.SetSmallChange(const Value: Word); +begin + FSmallChange := Value; +end; + +procedure TJvCustomTMTimeline.ClearObjects; +begin + while FObjects.Count > 0 do + begin + FObjects.Objects[0].Free; + FObjects.Delete(0); + end; + Invalidate; +end; + +procedure TJvCustomTMTimeline.ClearImages; +begin + FDateImages.Clear; +end; + +function TJvCustomTMTimeline.GetLastVisibleDate: TDate; +var + Tmp: Integer; +begin + if not ReadOnly then + Tmp := FButtonWidth * 2 + else + Tmp := 1; + Result := FDate + ((Width - Tmp) div DayWidth) - 1; +end; + +procedure TJvCustomTMTimeline.SetButtonWidth(const Value: Integer); +begin + if FButtonWidth <> Value then + begin + FButtonWidth := Value; + FLeftBtn.Width := FButtonWidth; + FRightBtn.Width := FButtonWidth; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.LoadFromFile(const Filename: string); +var + F: TFileStream; +begin + F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); + try + LoadFromStream(F); + finally + F.Free; + end; +end; + +procedure WriteInt(Stream: TStream; Value: Integer); +begin + Stream.Write(Value, SizeOf(Value)); +end; + +procedure WriteStr(Stream: TStream; const Value: string); +var + I: Integer; + UTF8Value: UTF8String; +begin + UTF8Value := UTF8Encode(Value); + I := Length(UTF8Value); + WriteInt(Stream, I); + if I > 0 then + Stream.Write(UTF8Value[1], I); +end; + +function ReadInt(Stream: TStream): Integer; +begin + Stream.Read(Result, SizeOf(Result)); +end; + +function ReadStr(Stream: TStream): string; +var + I: Integer; + UTF8Value: UTF8String; +begin + I := ReadInt(Stream); + SetLength(Result, I); + if I > 0 then + begin + Stream.Read(UTF8Value[1], I); +// Result := UTF8ToString(UTF8Value); + Result := UTF8Value; + end; +end; + +function TJvCustomTMTimeline.ReadMagic(Stream: TStream): Boolean; +begin + Result := AnsiSameStr(ReadStr(Stream), cMagic); +end; + +procedure TJvCustomTMTimeline.LoadFromStream(Stream: TStream); +var + O: TObject; + I: Integer; +begin + ClearImages; + ClearObjects; + if not ReadMagic(Stream) then + raise EStreamError.CreateRes(@SInvalidImage); + FDateImages.Text := ReadStr(Stream); + for I := 0 to FDateImages.Count - 1 do + FDateImages.Objects[I] := TObject(ReadInt(Stream)); + FObjects.Text := ReadStr(Stream); + for I := 0 to FObjects.Count - 1 do + begin + O := nil; + LoadObject(Stream, O); + FObjects.Objects[I] := O; + end; +end; + +procedure TJvCustomTMTimeline.SaveToStream(Stream: TStream); +var + I: Integer; +begin + WriteStr(Stream, cMagic); + WriteStr(Stream, FDateImages.Text); + for I := 0 to FDateImages.Count - 1 do + WriteInt(Stream, Integer(FDateImages.Objects[I])); + WriteStr(Stream, FObjects.Text); + for I := 0 to FObjects.Count - 1 do + SaveObject(Stream, FObjects.Objects[I]); +end; + +procedure TJvCustomTMTimeline.SaveToFile(const Filename: string); +var + F: TFileStream; +begin + F := TFileStream.Create(Filename, fmCreate); + try + SaveToStream(F); + finally + F.Free; + end; +end; + +procedure TJvCustomTMTimeline.LoadObject(Stream: TStream; var AObject: TObject); +begin + if Assigned(FOnReadObject) then + FOnReadObject(Self, Stream, AObject); +end; + +procedure TJvCustomTMTimeline.SaveObject(Stream: TStream; const AObject: TObject); +begin + if Assigned(FOnWriteObject) then + FOnWriteObject(Self, Stream, AObject); +end; + +procedure TJvCustomTMTimeline.SetObjectsFontStyle(const Value: TFontStyles); +begin + if FObjectsFontStyle <> Value then + begin + FObjectsFontStyle := Value; + Invalidate; + end; +end; + +function TJvCustomTMTimeline.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + Result := inherited DoMouseWheelDown(Shift, MousePos); + if not Result then + ScrollDate(Self, -1); +end; + +function TJvCustomTMTimeline.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; +begin + Result := inherited DoMouseWheelUp(Shift, MousePos); + if not Result then + ScrollDate(Self, 1); +end; + +function TJvCustomTMTimeline.GetVisibleDays: Integer; +begin + Result := Trunc(GetLastVisibleDate - Self.Date) + 1; +end; + +procedure TJvCustomTMTimeline.SetShowMonths(const Value: Boolean); +begin + if FShowMonths <> Value then + begin + FShowMonths := Value; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetShowToday(const Value: Boolean); +begin + if FShowToday <> Value then + begin + FShowToday := Value; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetShowWeeks(const Value: Boolean); +begin + if FShowWeeks <> Value then + begin + FShowWeeks := Value; + Invalidate; + end; +end; + +procedure TJvCustomTMTimeline.SetLineColor(const Value: TColor); +begin + if FLineColor <> Value then + begin + FLineColor := Value; + Invalidate; + end; +end; + { +procedure TJvCustomTMTimeline.CursorChanged; +begin + inherited CursorChanged; + FRealCursor := Cursor; +end; + } +function TJvCustomTMTimeline.DateHasImage(ADate: TDateTime): Boolean; +var + I: Integer; +begin + Result := False; + if Assigned(Images) then + begin + I := ImageIndex[ADate]; + Result := (I >= 0) and (I < Images.Count); + end; +end; + +procedure TJvCustomTMTimeline.SetShowTodayIcon(const Value: Boolean); +begin + if FShowTodayIcon <> Value then + begin + FShowTodayIcon := Value; + Invalidate; + end; +end; + + +end.