diff --git a/components/jvcllaz/design/JvTimeFramework/images/images.txt b/components/jvcllaz/design/JvTimeFramework/images/images.txt
new file mode 100644
index 000000000..a31d63073
--- /dev/null
+++ b/components/jvcllaz/design/JvTimeFramework/images/images.txt
@@ -0,0 +1,10 @@
+tjvtfalarm.bmp
+tjvtfdays.bmp
+tjvtfdaysprinter.bmp
+tjvtfglance.bmp
+tjvtfglancetextviewer.bmp
+tjvtfmonths.bmp
+tjvtfnavigator.bmp
+tjvtfschedulemanager.bmp
+tjvtfuniversalprinter.bmp
+tjvtfweeks.bmp
diff --git a/components/jvcllaz/design/JvTimeFramework/images/make_res.bat b/components/jvcllaz/design/JvTimeFramework/images/make_res.bat
new file mode 100644
index 000000000..397361645
--- /dev/null
+++ b/components/jvcllaz/design/JvTimeFramework/images/make_res.bat
@@ -0,0 +1 @@
+lazres ../../../resource/jvtimeframeworkreg.res @images.txt
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfalarm.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfalarm.bmp
new file mode 100644
index 000000000..8ff343d3e
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfalarm.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfdays.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfdays.bmp
new file mode 100644
index 000000000..18a83cfd6
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfdays.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfdaysprinter.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfdaysprinter.bmp
new file mode 100644
index 000000000..330f8df7c
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfdaysprinter.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfglance.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfglance.bmp
new file mode 100644
index 000000000..89fb1b47c
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfglance.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfglancetextviewer.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfglancetextviewer.bmp
new file mode 100644
index 000000000..6f3ccde3d
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfglancetextviewer.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfmonths.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfmonths.bmp
new file mode 100644
index 000000000..e41d629aa
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfmonths.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfnavigator.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfnavigator.bmp
new file mode 100644
index 000000000..ec09f388c
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfnavigator.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfschedulemanager.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfschedulemanager.bmp
new file mode 100644
index 000000000..16ec0b411
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfschedulemanager.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfuniversalprinter.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfuniversalprinter.bmp
new file mode 100644
index 000000000..7527843ef
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfuniversalprinter.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/images/tjvtfweeks.bmp b/components/jvcllaz/design/JvTimeFramework/images/tjvtfweeks.bmp
new file mode 100644
index 000000000..d66379d9e
Binary files /dev/null and b/components/jvcllaz/design/JvTimeFramework/images/tjvtfweeks.bmp differ
diff --git a/components/jvcllaz/design/JvTimeFramework/jvtimeframeworkreg.pas b/components/jvcllaz/design/JvTimeFramework/jvtimeframeworkreg.pas
new file mode 100644
index 000000000..6b1211fec
--- /dev/null
+++ b/components/jvcllaz/design/JvTimeFramework/jvtimeframeworkreg.pas
@@ -0,0 +1,48 @@
+unit JvTimeFrameworkReg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+procedure Register;
+
+implementation
+
+{$R ../../resource/jvtimeframeworkreg.res}
+
+uses
+ //Controls,
+ JvDsgnConsts,
+ JvTFGlance, JvTFGlanceTextViewer, JvTFMonths, JvTFWeeks, JvTFDays,
+ JvTFAlarm, JvTFManager;
+
+procedure Register;
+begin
+ RegisterComponents(RsPaletteJvclVisual, [
+ TJvTFScheduleManager,
+ TJvTFMonths, TJvTFWeeks, TJvTFDays, TJvTFAlarm, TJvTFGlanceTextViewer,
+ TJvTFUniversalPrinter, TJvTFDaysPrinter
+ ]);
+
+// RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells, TJvTFMonths, 'Cells', nil);
+
+ (*
+// RegisterPropertyEditor(TypeInfo(string), TJvTFControl, 'Version', TutfVersionEditor);
+// RegisterPropertyEditor(TypeInfo(string), TJvTFScheduleManager, 'Version', TutfVersionEditor);
+ RegisterComponents(RsPaletteTimeFramework, [TJvTFGlanceTextViewer, TJvTFMonths,
+ TJvTFWeeks, TJvTFAlarm]);
+// RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), '', 'Cells',
+// TJvTFGlanceCellsProperty);
+
+ // register a nil property editor for now, so cells cannot be added,
+ // deleted, or moved at design time... BAD THINGS HAPPEN
+ RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), TJvTFMonths, 'Cells', nil);
+ RegisterComponents(RsPaletteTimeFramework, [TJvTFDays, TJvTFDaysPrinter]);
+*)
+end;
+
+end.
+
diff --git a/components/jvcllaz/examples/JvTimeFramework/Data.sqlite b/components/jvcllaz/examples/JvTimeFramework/Data.sqlite
new file mode 100644
index 000000000..d3a7ec302
Binary files /dev/null and b/components/jvcllaz/examples/JvTimeFramework/Data.sqlite differ
diff --git a/components/jvcllaz/examples/JvTimeFramework/JvTimeFrameDemo.lpi b/components/jvcllaz/examples/JvTimeFramework/JvTimeFrameDemo.lpi
new file mode 100644
index 000000000..3e7d04484
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/JvTimeFrameDemo.lpi
@@ -0,0 +1,127 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/examples/JvTimeFramework/JvTimeFrameDemo.lpr b/components/jvcllaz/examples/JvTimeFramework/JvTimeFrameDemo.lpr
new file mode 100644
index 000000000..8efefbd66
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/JvTimeFrameDemo.lpr
@@ -0,0 +1,35 @@
+program JvTimeFrameDemo;
+
+{%File 'dbUTF'}
+
+uses
+ InterfaceBase, SysUtils, Dialogs,
+ Forms, datetimectrls, printer4lazarus, Interfaces,
+ tfMain in 'PhotoOpUnit.pas' {PhotoOpMain},
+ tfVisibleResources in 'VisibleResourcesUnit.pas' {VisibleResources},
+ tfShare in 'ShareUnit.pas' {Share},
+ tfApptEdit in 'ApptEditUnit.pas' {ApptEdit},
+ tfPrintProgress in 'PrintProgressUnit.pas' {PrintProgress};
+
+{$R *.res}
+
+var
+ fn: String;
+begin
+ Application.Scaled:=True;
+ Application.Initialize;
+
+ fn := Application.Location + 'data.sqlite';
+ if not FileExists(fn) then begin
+ MessageDlg('Database file "' + fn + '" not found. Copy it from the source directory to here.',
+ mtError, [mbOK], 0);
+ Halt;
+ end;
+
+ Application.CreateForm(TPhotoOpMain, PhotoOpMain);
+ Application.CreateForm(TVisibleResources, VisibleResources);
+ Application.CreateForm(TShare, Share);
+ Application.CreateForm(TApptEdit, ApptEdit);
+ Application.CreateForm(TPrintProgress, PrintProgress);
+ Application.Run;
+end.
diff --git a/components/jvcllaz/examples/JvTimeFramework/readme.txt b/components/jvcllaz/examples/JvTimeFramework/readme.txt
new file mode 100644
index 000000000..2c272eff6
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/readme.txt
@@ -0,0 +1,18 @@
+The JvTimeFrameDemo of the JVCL Lazarus port uses an SQLite3 database to store
+the data. In order to run this demo you must have SQLite3 installed, or you must
+copy the sqlite3.dll to the folder with JvTimeFrameDemo.exe.
+
+It is also required to copy the data base file, data.sqlite, from the source
+directory (the directory which contains this readme.txt) to the folder with
+JvTimeFrameDemo.exe.
+
+--------------------------------------------------------------------------------
+
+Original text:
+
+The PhotoOp demo uses a Paradox database to store the data. In order to run this
+demo, you need to have the BDE installed and correctly configured. In addition,
+the path to the data is restricted in Paradox. If you get an error about the
+path being too long when you start the application, copy the executable and
+the \Data subfolder from the source folder to a folder with a shorter path and
+run the demo from that location instead.
\ No newline at end of file
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfapptedit.lfm b/components/jvcllaz/examples/JvTimeFramework/tfapptedit.lfm
new file mode 100644
index 000000000..bb9cb9bb8
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfapptedit.lfm
@@ -0,0 +1,389 @@
+object ApptEdit: TApptEdit
+ Left = 218
+ Height = 210
+ Top = 152
+ Width = 350
+ AutoSize = True
+ Caption = 'ApptEdit'
+ ClientHeight = 210
+ ClientWidth = 350
+ Color = clBtnFace
+ Font.Color = clWindowText
+ OnClose = FormClose
+ OnShow = FormShow
+ Position = poScreenCenter
+ LCLVersion = '2.1.0.0'
+ Scaled = False
+ object Bevel1: TBevel
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Edit1
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 6
+ Height = 10
+ Top = 29
+ Width = 338
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Left = 6
+ BorderSpacing.Right = 6
+ Shape = bsBottomLine
+ end
+ object Bevel2: TBevel
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = EndDatePicker
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 6
+ Height = 10
+ Top = 97
+ Width = 338
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Left = 6
+ BorderSpacing.Right = 6
+ Shape = bsBottomLine
+ end
+ object Label1: TLabel
+ AnchorSideLeft.Control = Image1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = StartDatePicker
+ AnchorSideTop.Side = asrCenter
+ Left = 50
+ Height = 15
+ Top = 51
+ Width = 56
+ BorderSpacing.Left = 12
+ Caption = 'Start &Time:'
+ FocusControl = StartDatePicker
+ ParentColor = False
+ end
+ object Label3: TLabel
+ AnchorSideLeft.Control = Label1
+ AnchorSideTop.Control = EndDatePicker
+ AnchorSideTop.Side = asrCenter
+ Left = 50
+ Height = 15
+ Top = 78
+ Width = 52
+ Caption = '&End Time:'
+ FocusControl = EndDatePicker
+ ParentColor = False
+ end
+ object Label5: TLabel
+ AnchorSideLeft.Control = UpDown1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = AlarmAdvanceEdit
+ AnchorSideTop.Side = asrCenter
+ Left = 192
+ Height = 15
+ Top = 119
+ Width = 80
+ BorderSpacing.Left = 8
+ BorderSpacing.Right = 6
+ Caption = 'minutes before'
+ ParentColor = False
+ end
+ object Label6: TLabel
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Edit1
+ AnchorSideTop.Side = asrCenter
+ Left = 6
+ Height = 15
+ Top = 10
+ Width = 42
+ BorderSpacing.Left = 6
+ Caption = '&Subject:'
+ FocusControl = Edit1
+ ParentColor = False
+ end
+ object Image1: TImage
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Bevel1
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 32
+ Top = 47
+ Width = 32
+ AutoSize = True
+ BorderSpacing.Left = 6
+ BorderSpacing.Top = 8
+ Picture.Data = {
+ 1754506F727461626C654E6574776F726B477261706869633006000089504E47
+ 0D0A1A0A0000000D4948445200000020000000200806000000737A7AF4000005
+ F7494441545885D596DD53135718C6BDE81FD10B2FFB2778D90BEFFA310326BB
+ 212ACE74A622524BA58C1843BAC9D92C84AAD4CAA0A2824644B47C683AC340B2
+ 399BC4E84C35241A3F08042480094128109290F02DF0F44241680802ED45FBDC
+ ED39EFEEEFD9739EF3EEEEDAF57FD2D72AF3A7193F998FC8096D6678C925D759
+ 07E53AEB20C34B2E39A1CD193F998F30A72CBBFF757066B1F94B86977C324E5C
+ C8A9684F16D5BE82BABE1FDAC610B48D21A8EBFB71E2460F722ADCD3324E5C60
+ 78C997A1B1C8FE399833EF51E86D5D0ABD6D4A5DDF8FB3E62848731805359DC8
+ AFF222AFD285BC4A17BEBFF414C7AB7DD0350DA2DC1243F1ED016409F604AB97
+ 7A3339F39E1DC1F7973AF3E45A71A6D0D8BD7CA66D023F5EEB44B6C18E43061B
+ 2A4D1DB8F7B00F0E6F180E6F184DCE002E983A70C86047B6C18EC21A1FCEB44D
+ A0D0E85F9671E2C27E83A3705B7086500D43E8BCAE69105C4310D906074E55BB
+ F0A26F1C6B35164F62249A5837F6A26F1CEA6A17F697D8A0B93300FEEE101842
+ E7153CADD8F29B3384CE08A61114DF7A05A59EE2FEF321FC5DCBCBCB68F707F1
+ B8EB3516979652E63D3DA33850224155DB85B29631B0449A3950E6546F0ACFE4
+ CC7BE43AEBACAE691045B53D3864B021F46722E5E12B8A4FCD20969C4919AFFF
+ DD0E00088F25917BEE010A6A7C104CC390EBC4F90CAEF5F3B4061482D45978DD
+ BFC83504A1D4D34DE1E9D4DCF610576EB7AE5E0F47A6A1D45368EE0CE0E4CD5E
+ B0BC14DA10CE0A8E0C855E9A3AD336816C8303CE0D96FD63F2F5BC4681BE0A13
+ B1C975E3DEDE31280509A75B2350963A120AC19E971A3C5EF2A9EBFBA1AAED42
+ D115D7B6E18B8B4BD0FD7A137F3CF16D38CF193D28BADE01AE2108865883EBE0
+ 5FABCC9FCA3871E1AC398A6C833D25ED5BD16F2DF771ADC19C763E3014074BAC
+ 28B7C4C0123A9559DCF2D9AA817D5A31EFDB73AE08690EE390C1B66DF8F3AE3E
+ 9C28BD8A78626AD3BAC3E54E700D41E454786272420DAB06E4843617D5BE4241
+ 4D272A4D1DDB82CFCD2F40536E84EB99FFA3B5464B37F22F3F87AA2E009648D6
+ 0F01D44BEDEAFA7EFC70D98B7B0FFBB6045E5A5A42FBF36EFC52DD8CEB8DE296
+ EE11DD21E45FF240DB18024B68CF8700123AA86D0CE1BB4A171CDE30466349B4
+ FB83884FA59EF1153D7477E0A8A602473515303BDD69EB923373707707313231
+ 094FCF288E9E7F04C13402B9CE1A496B60249AC0E3AED78826A6D33EF841FBCB
+ 5503C6A6F42B30393D8BC75DAF31341E4F6F40C14B6E757D3FF2AB9EAE6EC146
+ ED75AD16DEBEC5FDC72F70F31EC5514D05BCBEDEB4B54BCBCB0036DB029EDE2D
+ AA7D85E3D53E5CD8660801C0EBEBFDA809E07D08AB9E4155170043A8F421843A
+ E9BB6F7F754DE89A0677740CB76A62E5181EA9F4C419BDF4F387153865D92DE3
+ C485724B6CC78D68AD894432353B2B8DE8AC399ADA88DE07D15F7C7B00AA1B9D
+ 38B98356FC3191DA2728BAF6125C43107242DFA47C0BE444CACA12EC89336D13
+ D85F6283B777EC5F83FB835164E9294EB74670D0E08CB182949F62E07D43EA2D
+ 34762F6AEE0C40A9A7088F25FF313C129F45B6C186E2FAC0BB0EC8D3F05EBDF3
+ 930D0D6472E63D324E5CE0EF0EA1A0C687DC730F301C49DF0B923373989C9EDD
+ 149E7BEE010AAA3B20988621D38A730A42BFDA10BEA28306472143E86C59CB18
+ 4EDEE884524FD36E87BBFBDD2FD9CA395F2B7F308A6C830D45D77D286B194396
+ 609B3A50E22CDD14BE22054F2B585E9A174CC328BE3D00A52081AF7D8281E1F5
+ 3F1A231393181A8FAF1B0B0CC5517AEB29B2F414AABA0004D330B24AEC732CB1
+ D66C09BEA203654EB54C2BCE9DBCD98BD3AD111CBFFA122CB122A7DC09A3A51B
+ A23B044FCF283C3DA310DD21182DDDC829778225561CBFF202A75B2350D50520
+ D38A735B7EF39495D08B7B595E0A294B1D09AE2188B3E628B88620F2AB9EE1D8
+ 450F72CF3F42EEF9473876D183FCAA67585B73D0E08CB13C0DB3C4F6C58EE06B
+ B54F67FD8621D62043E8746EE59359555D00DAC61004D30804D308B48D21A8EA
+ 02C8AD7C3ACF103A2D27F44DA6CE72386DDA77AACCE296CFF67116C212C9CA10
+ EA97EBACE3729D759C21D4CF102AEDE32C24A5C3FDD7F517CAA592C8B12E2C19
+ 0000000049454E44AE426082
+ }
+ Transparent = True
+ end
+ object Image2: TImage
+ AnchorSideLeft.Control = Image1
+ AnchorSideLeft.Side = asrCenter
+ AnchorSideTop.Control = Bevel2
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Image1
+ AnchorSideRight.Side = asrBottom
+ Left = 14
+ Height = 24
+ Top = 115
+ Width = 24
+ Anchors = [akTop, akRight]
+ AutoSize = True
+ BorderSpacing.Top = 8
+ BorderSpacing.Bottom = 8
+ Picture.Data = {
+ 1754506F727461626C654E6574776F726B477261706869633102000089504E47
+ 0D0A1A0A0000000D4948445200000018000000180806000000E0773DF8000001
+ F8494441544889ED96CF6B134114C773C821070F3978E8C13FC5C3DCF266AB5E
+ 0A2D7A152A147AE8C1533D2C041A8A1091122179B3597F507A50E8C5B6C9BCD6
+ A52548A93FA07521C628B4074B1A5B83B4104ADD3C0FBA524835B39A631F7C8F
+ F3F9CCBC99612616332CCF154952F21539726BC1B5064CC799C16D112FE7C1D6
+ 08AC11983075CFB345BC3FE002DC21257743F86F89239B8490F172E2C23FC117
+ 5C6B80947C494A763697463BFBD5690EBE3CE4CEC1636ED5B3ECEB31266505A4
+ AC778B282F459BB92B12E4581F968B5782FDEA34F3D72767A655CFF28B47D7BE
+ 6B94BB9156420AD21A810FDEDFFD233CCCB74FF77FB64C41DA6CF6F9AB17B592
+ C75BA55B3DE1617C3DC65AC963CF15C99E82924A8146E03D7FCA58B0E74FB146
+ E0924A41EFF614E4B846E0A39D9CB1E06827C71A81CB0539DE53109E77537818
+ 8DC0E53CD8E78273412C56C6D483B5D9A17654C1DAEC509B14E4FE0AF75C9124
+ 4736DF3EBF1979059B8BA34C8E6C9E799B3D5724280F9735CAD72BC5C193563D
+ 1B5970B83DC32BC5C1134278B384203C5724BAFA5E991B6E1F6ECF44869FBED1
+ 95B9E176D77E8482DAEA047FACDCFEAFD45627BA37FCF473D8AF189DA8B09695
+ AC6DCCDFE0863FC90D7F9237E6AF77345A556340AF22848C4619AC3F1D09D69F
+ 8DFC7AF821D33781678B3829489382CFA464831032A6BF8A1FDBA511CB562822
+ EB0000000049454E44AE426082
+ }
+ Transparent = True
+ end
+ object StartDatePicker: TDateTimePicker
+ AnchorSideLeft.Control = Label1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Image1
+ Left = 114
+ Height = 23
+ Top = 47
+ Width = 79
+ CenturyFrom = 1941
+ MaxDate = 2958465
+ MinDate = -53780
+ TabOrder = 1
+ BorderSpacing.Left = 8
+ TrailingSeparator = False
+ LeadingZeros = True
+ Kind = dtkDate
+ TimeFormat = tf24
+ TimeDisplay = tdHMS
+ DateMode = dmComboBox
+ Date = 36235
+ Time = 0.775961111103243
+ UseDefaultSeparators = True
+ HideDateTimeParts = []
+ MonthNames = 'Long'
+ CalAlignment = dtaLeft
+ end
+ object StartTimePicker: TDateTimePicker
+ AnchorSideLeft.Control = StartDatePicker
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = StartDatePicker
+ Left = 217
+ Height = 23
+ Top = 47
+ Width = 65
+ CenturyFrom = 1941
+ MaxDate = 2958465
+ MinDate = -53780
+ TabOrder = 2
+ BorderSpacing.Left = 24
+ BorderSpacing.Right = 6
+ TrailingSeparator = False
+ LeadingZeros = True
+ Kind = dtkTime
+ TimeFormat = tf24
+ TimeDisplay = tdHMS
+ DateMode = dmComboBox
+ Date = 36235
+ Time = 0.776266203698469
+ UseDefaultSeparators = True
+ HideDateTimeParts = []
+ MonthNames = 'Long'
+ CalAlignment = dtaLeft
+ end
+ object EndDatePicker: TDateTimePicker
+ AnchorSideLeft.Control = StartDatePicker
+ AnchorSideTop.Control = StartDatePicker
+ AnchorSideTop.Side = asrBottom
+ Left = 114
+ Height = 23
+ Top = 74
+ Width = 79
+ CenturyFrom = 1941
+ MaxDate = 2958465
+ MinDate = -53780
+ TabOrder = 3
+ BorderSpacing.Top = 4
+ TrailingSeparator = False
+ LeadingZeros = True
+ Kind = dtkDate
+ TimeFormat = tf24
+ TimeDisplay = tdHMS
+ DateMode = dmComboBox
+ Date = 36235
+ Time = 0.776392129599117
+ UseDefaultSeparators = True
+ HideDateTimeParts = []
+ MonthNames = 'Long'
+ CalAlignment = dtaLeft
+ end
+ object EndTimePicker: TDateTimePicker
+ AnchorSideLeft.Control = StartTimePicker
+ AnchorSideTop.Control = EndDatePicker
+ Left = 217
+ Height = 23
+ Top = 74
+ Width = 65
+ CenturyFrom = 1941
+ MaxDate = 2958465
+ MinDate = -53780
+ TabOrder = 4
+ BorderSpacing.Right = 6
+ TrailingSeparator = False
+ LeadingZeros = True
+ Kind = dtkTime
+ TimeFormat = tf24
+ TimeDisplay = tdHMS
+ DateMode = dmComboBox
+ Date = 36235
+ Time = 0.77642199069669
+ UseDefaultSeparators = True
+ HideDateTimeParts = []
+ MonthNames = 'Long'
+ CalAlignment = dtaLeft
+ end
+ object AlarmEnabledCheck: TCheckBox
+ AnchorSideLeft.Control = Label1
+ AnchorSideTop.Control = AlarmAdvanceEdit
+ AnchorSideTop.Side = asrCenter
+ Left = 50
+ Height = 19
+ Top = 117
+ Width = 74
+ Caption = '&Reminder:'
+ TabOrder = 5
+ end
+ object AlarmAdvanceEdit: TEdit
+ AnchorSideLeft.Control = AlarmEnabledCheck
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Image2
+ Left = 132
+ Height = 23
+ Top = 115
+ Width = 37
+ BorderSpacing.Left = 8
+ BorderSpacing.Bottom = 8
+ ReadOnly = True
+ TabOrder = 6
+ Text = '0'
+ end
+ object UpDown1: TUpDown
+ AnchorSideLeft.Control = AlarmAdvanceEdit
+ AnchorSideLeft.Side = asrBottom
+ Left = 169
+ Height = 23
+ Top = 115
+ Width = 15
+ Associate = AlarmAdvanceEdit
+ Max = 60
+ Min = 0
+ OnClick = UpDown1Click
+ Position = 0
+ TabOrder = 7
+ end
+ object Edit1: TEdit
+ AnchorSideLeft.Control = Label6
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 54
+ Height = 23
+ Top = 6
+ Width = 290
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Left = 6
+ BorderSpacing.Top = 6
+ BorderSpacing.Right = 6
+ Constraints.MinWidth = 280
+ TabOrder = 0
+ end
+ object ButtonPanel1: TButtonPanel
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Image2
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 6
+ Height = 26
+ Top = 155
+ Width = 338
+ Align = alNone
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Top = 10
+ OKButton.Name = 'OKButton'
+ OKButton.DefaultCaption = True
+ HelpButton.Name = 'HelpButton'
+ HelpButton.DefaultCaption = True
+ CloseButton.Name = 'CloseButton'
+ CloseButton.DefaultCaption = True
+ CancelButton.Name = 'CancelButton'
+ CancelButton.DefaultCaption = True
+ TabOrder = 8
+ ShowButtons = [pbOK, pbCancel]
+ ShowBevel = False
+ end
+end
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfapptedit.pas b/components/jvcllaz/examples/JvTimeFramework/tfapptedit.pas
new file mode 100644
index 000000000..4033bf87f
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfapptedit.pas
@@ -0,0 +1,236 @@
+{******************************************************************
+
+ 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.
+
+******************************************************************}
+
+unit tfApptEdit;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, Buttons, ComCtrls, JvTFManager, ExtCtrls, ButtonPanel,
+ DateTimePicker;
+
+type
+
+ { TApptEdit }
+
+ TApptEdit = class(TForm)
+ ButtonPanel1: TButtonPanel;
+ Label1: TLabel;
+ Label3: TLabel;
+ Label5: TLabel;
+ StartDatePicker: TDateTimePicker;
+ StartTimePicker: TDateTimePicker;
+ EndDatePicker: TDateTimePicker;
+ EndTimePicker: TDateTimePicker;
+ AlarmEnabledCheck: TCheckBox;
+ AlarmAdvanceEdit: TEdit;
+ UpDown1: TUpDown;
+ Edit1: TEdit;
+ Label6: TLabel;
+ Bevel1: TBevel;
+ Image1: TImage;
+ Bevel2: TBevel;
+ Image2: TImage;
+ procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
+ procedure FormShow(Sender: TObject);
+ procedure FormClose(Sender: TObject; var TheAction: TCloseAction);
+ private
+ { Private declarations }
+ // This form will use this var to indicate whether the appt is being
+ // editing or whether is it being created. (This is important in the
+ // OnClose event.)
+ AddingAppt : Boolean;
+ public
+ { Public declarations }
+ // the main form will set this var to the selected appt if the user
+ // wants to edit the appt OR the main form will set this var to nil
+ // if the user wants to add a new appointment.
+ Appt : TJvTFAppt;
+ end;
+
+var
+ ApptEdit: TApptEdit;
+
+implementation
+
+Uses
+ tfMain, JvTFDays;
+
+{$R *.lfm}
+
+procedure TApptEdit.UpDown1Click(Sender: TObject; Button: TUDBtnType);
+begin
+ // Handles the Alarm Advance "spin"
+ AlarmAdvanceEdit.Text := IntToStr(UpDown1.Position);
+end;
+
+procedure TApptEdit.FormShow(Sender: TObject);
+var
+ ApptStartDate,
+ ApptEndDate : TDate;
+ ApptStartTime,
+ ApptEndTime : TTime;
+ DaysGrid : TJvTFDays;
+begin
+ // Just a short cut to save typing :)
+ DaysGrid := PhotoOpMain.JvTFDays1;
+
+ If Assigned(Appt) Then
+ Begin
+ // Assume we want to edit the selected appt
+ // Populate the window fields from the selected appt
+ StartDatePicker.Date := Appt.StartDate;
+ StartTimePicker.Time := Appt.StartTime;
+ EndDatePicker.Date := Appt.EndDate;
+ EndTimePicker.Time := Appt.EndTime;
+ AlarmEnabledCheck.Checked := Appt.AlarmEnabled;
+ AlarmAdvanceEdit.Text := IntToStr(Appt.AlarmAdvance);
+ UpDown1.Position := Appt.AlarmAdvance;
+ Edit1.Text := Appt.Description;
+ // Change the caption of the form to indicate that the appointment
+ // is being edited.
+ Caption := 'Edit Appointment';
+ // Set the AddingAppt var to false so that the form will recognize
+ // that the appt is being edited and not created.
+ AddingAppt := False;
+ End
+ Else
+ Begin
+ // Assume we are adding a new appt
+ // Request an appt from the server
+ Appt := PhotoOpMain.JvTFDays1.ScheduleManager.dbNewAppt('');
+ // Right now this appt object is in a state of flux. It is not
+ // assigned to any schedules and shouldn't be because we're unsure
+ // of its data. The caching system is programmed to automatically
+ // destroy any appt objects that are not assigned to any schedules.
+ // In this particular situation, this is bad.
+ // So...
+ // Make the Appt object persistent so the cache does not attempt to
+ // flush it while this window is open.
+ Appt.Persistent := True;
+
+ // Now populate the appt object with some default data which is
+ // retrieved from the JvTFDays grid.
+ With Appt do
+ Begin
+ If DaysGrid.ValidSelection Then
+ Begin
+ // Set the start/end dates according to the selection
+ ApptStartDate := DaysGrid.Cols[DaysGrid.SelStart.X].SchedDate;
+ ApptEndDate := DaysGrid.Cols[DaysGrid.SelEnd.X].SchedDate;
+ // Set the start/end times according to the selection
+ ApptStartTime := DaysGrid.RowToTime(DaysGrid.SelStart.Y);
+ ApptEndTime := DaysGrid.RowEndTime(DaysGrid.SelEnd.Y);
+ End
+ Else
+ Begin
+ // Set the start/end dates to today
+ ApptStartDate := Date;
+ ApptEndDate := Date;
+ // Set the start/end times to now and now + granularity
+ ApptStartTime := Time;
+ // Subtract one min from granularity, then add the minute back in.
+ // (Avoids minute overflow when granularity is 60)
+ ApptEndTime := ApptStartTime +
+ EncodeTime(0, DaysGrid.Granularity - 1, 0, 0) +
+ EncodeTime(0, 1, 0, 0);
+ End;
+
+ Appt.BeginUpdate;
+ // Call BeginUpdate so that the appt will NOT be posted when we
+ // set the following properties. Don't worry about calling
+ // EndUpdate here. It will be called if the user chooses 'OK' to
+ // save the new appt. See FormClose below.
+
+ SetStartEnd(ApptStartDate, ApptStartTime, ApptEndDate, ApptEndTime);
+ AlarmEnabled := True;
+ AlarmAdvance := 15;
+ End;
+
+ // Now call this proc again to populate the window fields
+ FormShow(nil); // Appt won't be nil now so this call will fill the
+ // window fields
+ // Set the caption of the form to indicate that the appt is being added
+ Caption := 'Add Appointment';
+ // Set the AddingAppt var to true so that the form will recognize that
+ // the appt is being added instead of edited.
+ AddingAppt := True;
+ End;
+end;
+
+procedure TApptEdit.FormClose(Sender: TObject; var TheAction: TCloseAction);
+var
+ DaysGrid : TJvTFDays;
+ I : Integer;
+begin
+ If (ModalResult = mrOK) and Assigned(Appt) Then
+ With Appt do
+ Begin
+ Appt.BeginUpdate;
+ // Call BeginUpdate so that the appt is not posted while we are
+ // setting its properties.
+
+ Try
+ // Copy the data from the window fields to the appt object
+ SetStartEnd(StartDatePicker.Date, StartTimePicker.Time,
+ EndDatePicker.Date, EndTimePicker.Time);
+ AlarmEnabled := AlarmEnabledCheck.Checked;
+ AlarmAdvance := StrToInt(AlarmAdvanceEdit.Text);
+ Description := Edit1.Text;
+
+ If AddingAppt Then
+ Begin
+ // Just a shortcut to save some typing :-)
+ DaysGrid := PhotoOpMain.JvTFDays1;
+
+ // Add the appt to selected schedule(s)
+ For I := 0 to DaysGrid.Cols.Count - 1 do
+ Appt.AddSchedule(DaysGrid.Cols[I].SchedName);
+
+ // Now that we're done working with the appointment and it is
+ // actually assigned to a schedule, we should set the Persistent
+ // property to false. This will ensure the the caching system
+ // will properly dispose of the appointment object when it is
+ // no longer needed.
+ Appt.Persistent := False;
+ End;
+ Finally
+ Appt.EndUpdate; // this causes the appt to be posted
+ End;
+ End
+ Else If AddingAppt Then
+ // The user canceled the window, but we have already created the appt
+ // object. We need to clean up the appt object we requested from the
+ // server. This can be done either by manually destroying the appt
+ // object (Appt.Free), or by setting Appt.Persistent to false.
+ Appt.Free;
+
+ // Set Appt to nil to prepare window for next opening
+ Appt := nil;
+end;
+
+end.
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfmain.lfm b/components/jvcllaz/examples/JvTimeFramework/tfmain.lfm
new file mode 100644
index 000000000..5fe084bce
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfmain.lfm
@@ -0,0 +1,1500 @@
+object PhotoOpMain: TPhotoOpMain
+ Left = 212
+ Height = 546
+ Top = 138
+ Width = 445
+ Caption = 'UTF Demo 1: PhotoOp'
+ ClientHeight = 546
+ ClientWidth = 445
+ Color = clBtnFace
+ Constraints.MinHeight = 400
+ Constraints.MinWidth = 445
+ DefaultMonitor = dmDesktop
+ Font.Color = clWindowText
+ OnCreate = FormCreate
+ OnShow = FormShow
+ Position = poScreenCenter
+ LCLVersion = '2.1.0.0'
+ Scaled = False
+ object PageControl1: TPageControl
+ Left = 0
+ Height = 448
+ Top = 73
+ Width = 445
+ ActivePage = TabSheet1
+ Align = alClient
+ TabIndex = 0
+ TabOrder = 0
+ object TabSheet1: TTabSheet
+ Caption = 'Day View'
+ ClientHeight = 420
+ ClientWidth = 437
+ object JvTFDays1: TJvTFDays
+ Left = 0
+ Height = 420
+ Top = 0
+ Width = 437
+ ScheduleManager = utfScheduleManager1
+ ColHdrHeight = 30
+ Cols = <
+ item
+ SchedDate = 0
+ Title = ' - '
+ Width = 370
+ end>
+ Template.CompDate = 36406
+ Template.LinearDayCount = 1
+ Template.LinearEndDate = 36406
+ Template.LinearStartDate = 36406
+ Grouping = grNone
+ GridStartTime = 0
+ GridEndTime = 0
+ TimeBlocks = <>
+ TimeBlockProps.BlockHdrAttr.Font.Color = clWindowText
+ TimeBlockProps.BlockHdrAttr.ParentFont = False
+ TimeBlockProps.BlockHdrAttr.FrameColor = clBlack
+ TimeBlockProps.DayStart = 0
+ TimeBlockProps.SelBlockHdrAttr.Font.Color = clBlack
+ TimeBlockProps.SelBlockHdrAttr.ParentFont = False
+ TimeBlockProps.SelBlockHdrAttr.FrameColor = clBlack
+ ApptAttr.Color = clWhite
+ ApptAttr.Font.Color = clWindowText
+ ApptAttr.ParentFont = False
+ SelApptAttr.Color = clWhite
+ SelApptAttr.Font.Color = clWindowText
+ SelApptAttr.ParentFont = False
+ HdrAttr.Font.Color = clWindowText
+ HdrAttr.ParentFont = False
+ HdrAttr.FrameColor = clBlack
+ SelHdrAttr.Font.Color = clBlack
+ SelHdrAttr.ParentFont = False
+ SelHdrAttr.FrameColor = clBlack
+ FancyRowHdrAttr.Hr2400 = False
+ FancyRowHdrAttr.MinorFont.Color = clWindowText
+ FancyRowHdrAttr.MajorFont.Color = clWindowText
+ FancyRowHdrAttr.MajorFont.Height = -21
+ SelFancyRowHdrAttr.Hr2400 = True
+ SelFancyRowHdrAttr.MinorFont.Color = clBlack
+ SelFancyRowHdrAttr.MajorFont.Color = clBlack
+ SelFancyRowHdrAttr.MajorFont.Height = -21
+ SelFancyRowHdrAttr.TickColor = clBlack
+ PrimeTime.StartTime = 0.333333333333333
+ PrimeTime.EndTime = 0.708333333333333
+ PrimeTime.Color = clYellow
+ GroupHdrAttr.Font.Color = clWindowText
+ GroupHdrAttr.ParentFont = False
+ GroupHdrAttr.FrameColor = clBlack
+ SelGroupHdrAttr.Font.Color = clBlack
+ SelGroupHdrAttr.ParentFont = False
+ SelGroupHdrAttr.FrameColor = clBlack
+ LeftCol = 0
+ OnDateChanging = JvTFDays1DateChanging
+ OnDateChanged = JvTFDays1DateChanged
+ OnGranularityChanged = JvTFDays1GranularityChanged
+ DateFormat = 'ddddd'
+ TimeFormat = 't'
+ Align = alClient
+ Color = clWindow
+ TabOrder = 0
+ OnDblClick = JvTFDays1DblClick
+ end
+ end
+ object TabSheet2: TTabSheet
+ Caption = 'Week View'
+ ClientHeight = 445
+ ClientWidth = 437
+ ImageIndex = 1
+ object JvTFWeeks1: TJvTFWeeks
+ Left = 0
+ Height = 445
+ Top = 0
+ Width = 437
+ ScheduleManager = utfScheduleManager1
+ Cells = <
+ item
+ Color = clBlack
+ CellDate = 37270
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37271
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37272
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37273
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37274
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37275
+ CellPics = <>
+ CanSelect = True
+ end>
+ GapSize = 4
+ TitleAttr.TxtAttr.Font.Color = clWindowText
+ TitleAttr.TxtAttr.Font.Height = -19
+ TitleAttr.TxtAttr.Font.Style = [fsBold]
+ TitleAttr.Title = 'Week of Jan 14, 2002'
+ CellAttr.Font.Color = clWindowText
+ CellAttr.TitleAttr.Color = clWhite
+ CellAttr.TitleAttr.FrameAttr.Color = clGray
+ CellAttr.TitleAttr.DayTxtAttr.Font.Color = clWindowText
+ CellAttr.DrawBottomLine = False
+ SelCellAttr.Font.Color = clWindowText
+ SelCellAttr.TitleAttr.Color = clNavy
+ SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clWhite
+ SelCellAttr.DrawBottomLine = False
+ CellPics = StateImageList
+ Viewer = GlanceTextViewer1
+ DateFormat = 'ddddd'
+ TimeFormat = 't'
+ Align = alClient
+ ParentColor = True
+ TabOrder = 0
+ DisplayDate = 37270
+ DisplayOrder = doLeftRight
+ DWNames.DWN_Sunday = 'S'
+ DWNames.DWN_Monday = 'M'
+ DWNames.DWN_Tuesday = 'T'
+ DWNames.DWN_Wednesday = 'W'
+ DWNames.DWN_Thursday = 'T'
+ DWNames.DWN_Friday = 'F'
+ DWNames.DWN_Saturday = 'S'
+ DWTitleAttr.Height = 20
+ DWTitleAttr.Visible = False
+ DWTitleAttr.TxtAttr.Font.Color = clWindowText
+ DWTitleAttr.TxtAttr.Font.Height = -11
+ DWTitleAttr.TxtAttr.Font.Style = [fsBold]
+ end
+ end
+ object TabSheet3: TTabSheet
+ Caption = 'Month View'
+ ClientHeight = 445
+ ClientWidth = 437
+ ImageIndex = 2
+ object JvTFMonths1: TJvTFMonths
+ Left = 0
+ Height = 445
+ Top = 0
+ Width = 437
+ ScheduleManager = utfScheduleManager1
+ Cells = <
+ item
+ Color = clBlack
+ CellDate = 37255
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37256
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37257
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37258
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37259
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37260
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37261
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37262
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37263
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37264
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37265
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37266
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37267
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37268
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37269
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37270
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37271
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37272
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37273
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37274
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37275
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37276
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37277
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37278
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37279
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37280
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37281
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37282
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37283
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37284
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37285
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37286
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37287
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37288
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37289
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37290
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37291
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37292
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37293
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37294
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37295
+ CellPics = <>
+ CanSelect = True
+ end
+ item
+ Color = clBlack
+ CellDate = 37296
+ CellPics = <>
+ CanSelect = True
+ end>
+ GapSize = 0
+ TitleAttr.TxtAttr.Font.Color = clWindowText
+ TitleAttr.TxtAttr.Font.Height = -19
+ TitleAttr.TxtAttr.Font.Style = [fsBold]
+ TitleAttr.Title = 'Januar 2002'
+ CellAttr.Font.Color = clWindowText
+ CellAttr.TitleAttr.Color = clWhite
+ CellAttr.TitleAttr.DayTxtAttr.Font.Color = clWindowText
+ CellAttr.DrawBottomLine = False
+ SelCellAttr.Font.Color = clWindowText
+ SelCellAttr.TitleAttr.Color = clNavy
+ SelCellAttr.TitleAttr.DayTxtAttr.Font.Color = clWhite
+ SelCellAttr.DrawBottomLine = False
+ Viewer = GlanceTextViewer2
+ DateFormat = 'ddddd'
+ TimeFormat = 't'
+ Align = alClient
+ ParentColor = True
+ TabOrder = 0
+ Month = 1
+ Year = 2002
+ DisplayDate = 37270
+ DWNames.DWN_Sunday = 'S'
+ DWNames.DWN_Monday = 'M'
+ DWNames.DWN_Tuesday = 'T'
+ DWNames.DWN_Wednesday = 'W'
+ DWNames.DWN_Thursday = 'T'
+ DWNames.DWN_Friday = 'F'
+ DWNames.DWN_Saturday = 'S'
+ DWTitleAttr.FrameAttr.Style = fs3DRaised
+ DWTitleAttr.Height = 20
+ DWTitleAttr.TxtAttr.Font.Color = clWindowText
+ DWTitleAttr.TxtAttr.Font.Height = -11
+ ExtraDayCellAttr.Font.Color = clWindowText
+ ExtraDayCellAttr.TitleAttr.Color = clWhite
+ ExtraDayCellAttr.TitleAttr.DayTxtAttr.Font.Color = clWindowText
+ ExtraDayCellAttr.DrawBottomLine = False
+ OffDayCellAttr.Font.Color = clWindowText
+ OffDayCellAttr.TitleAttr.Color = clWhite
+ OffDayCellAttr.TitleAttr.DayTxtAttr.Font.Color = clWindowText
+ OffDayCellAttr.DrawBottomLine = False
+ FirstDayOfMonthFormat = 'mmm d'
+ DayFormat = 'd'
+ end
+ end
+ end
+ object Panel1: TPanel
+ Left = 0
+ Height = 73
+ Top = 0
+ Width = 445
+ Align = alTop
+ ClientHeight = 73
+ ClientWidth = 445
+ TabOrder = 1
+ object ResourceCombo: TComboBox
+ Left = 198
+ Height = 23
+ Hint = 'Display Resource'
+ Top = 40
+ Width = 131
+ ItemHeight = 15
+ OnChange = ResourceComboChange
+ ParentShowHint = False
+ ShowHint = True
+ Style = csDropDownList
+ TabOrder = 11
+ end
+ object PrevDateButton: TBitBtn
+ AnchorSideLeft.Control = Panel1
+ AnchorSideTop.Control = Panel1
+ Left = 9
+ Height = 24
+ Hint = 'Previous Day'
+ Top = 9
+ Width = 24
+ BorderSpacing.Left = 8
+ BorderSpacing.Top = 8
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 0
+ OnClick = PrevDateButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 0
+ TabStop = False
+ end
+ object NextDateButton: TBitBtn
+ AnchorSideTop.Control = PrevDateButton
+ AnchorSideRight.Control = ModeCombo
+ AnchorSideRight.Side = asrBottom
+ Left = 148
+ Height = 24
+ Hint = 'Next Day'
+ Top = 9
+ Width = 24
+ Anchors = [akTop, akRight]
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 1
+ OnClick = NextDateButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 1
+ TabStop = False
+ end
+ object NewApptButton: TBitBtn
+ Left = 198
+ Height = 24
+ Hint = 'New Appointment'
+ Top = 8
+ Width = 24
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 4
+ OnClick = NewApptButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 2
+ TabStop = False
+ end
+ object EditApptButton: TBitBtn
+ Left = 225
+ Height = 24
+ Hint = 'Edit Appointment'
+ Top = 8
+ Width = 24
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 5
+ OnClick = EditApptButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 3
+ TabStop = False
+ end
+ object DeleteApptButton: TBitBtn
+ Left = 252
+ Height = 24
+ Hint = 'Delete Appointment'
+ Top = 8
+ Width = 24
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 6
+ OnClick = DeleteApptButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 4
+ TabStop = False
+ end
+ object ViewSchedsButton: TBitBtn
+ Left = 198
+ Height = 24
+ Hint = 'View Schedules ( + )'
+ Top = 40
+ Width = 24
+ Glyph.Data = {
+ 76010000424D7601000000000000760000002800000020000000100000000100
+ 0400000000000001000000000000000000001000000010000000000000000000
+ 80000080000000808000800000008000800080800000C0C0C000808080000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
+ 3333333333333333333333333333333333333333333333333333333333333333
+ 3333333333333333333333333030330333333333383833833333330308888883
+ 0333338388888883833330388F6666F88303383887FFFF788383388FF666666F
+ F88338877F8888F778838FFFF660066FFFF887777F8778F777788FFFF660066F
+ FFF887777F8778F77778388FF666666FF88338877F8888F7788330388F6666F8
+ 8303383887FFFF78838333030888888303333383888888838333333330303303
+ 3333333338383383333333333333333333333333333333333333333333333333
+ 3333333333333333333333333333333333333333333333333333
+ }
+ NumGlyphs = 2
+ OnClick = ViewSchedsButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 5
+ TabStop = False
+ end
+ object HideSchedButton: TBitBtn
+ Left = 225
+ Height = 24
+ Hint = 'Hide Selected Schedule ( + )'
+ Top = 40
+ Width = 24
+ Glyph.Data = {
+ 76010000424D7601000000000000760000002800000020000000100000000100
+ 0400000000000001000000000000000000001000000010000000000000000000
+ 80000080000000808000800000008000800080800000C0C0C000808080000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
+ 3333333333333333333333333333333333333333333333333333333333333333
+ 3333333333333333333333333033030333333333383383833333330308808083
+ 033333838FF8F8F383333038088888808303383FFFFFFFF8F383308887777778
+ 808338FFFF77777FF8F38887777777777888FFF7777777777FFF877777777777
+ 7778877777777777777838877777777778833887777777777883333887777778
+ 8333333887777778833333333888888333333333388888833333333333333333
+ 3333333333333333333333333333333333333333333333333333333333333333
+ 3333333333333333333333333333333333333333333333333333
+ }
+ NumGlyphs = 2
+ OnClick = HideSchedButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 6
+ TabStop = False
+ end
+ object ShareButton: TBitBtn
+ Left = 252
+ Height = 24
+ Hint = 'Share Appointment ( + Drag)'
+ Top = 40
+ Width = 24
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 3
+ OnClick = ShareButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 7
+ TabStop = False
+ end
+ object TimeIncCombo: TComboBox
+ Left = 328
+ Height = 23
+ Hint = 'Time Increments'
+ Top = 8
+ Width = 105
+ DropDownCount = 12
+ ItemHeight = 15
+ Items.Strings = (
+ '60 mins'
+ '30 mins'
+ '20 mins'
+ '15 mins'
+ '12 mins'
+ '10 mins'
+ '6 mins'
+ '5 mins'
+ '4 mins'
+ '3 mins'
+ '2 mins'
+ '1 min'
+ )
+ OnClick = TimeIncComboChange
+ ParentShowHint = False
+ ShowHint = True
+ Style = csDropDownList
+ TabOrder = 8
+ end
+ object GotoDatePicker: TDateTimePicker
+ AnchorSideLeft.Control = PrevDateButton
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = PrevDateButton
+ AnchorSideTop.Side = asrCenter
+ AnchorSideRight.Control = NextDateButton
+ Left = 37
+ Height = 23
+ Hint = 'Current Day'
+ Top = 10
+ Width = 107
+ CenturyFrom = 1941
+ MaxDate = 2958465
+ MinDate = -53780
+ TabOrder = 10
+ BorderSpacing.Left = 4
+ BorderSpacing.Right = 4
+ TrailingSeparator = False
+ LeadingZeros = True
+ ShowHint = True
+ ParentShowHint = False
+ Anchors = [akTop, akLeft, akRight]
+ Kind = dtkDate
+ TimeFormat = tf24
+ TimeDisplay = tdHMS
+ DateMode = dmComboBox
+ Date = 36892
+ Time = 0.414710879602353
+ UseDefaultSeparators = True
+ HideDateTimeParts = []
+ MonthNames = 'Long'
+ CalAlignment = dtaLeft
+ OnChange = GotoDatePickerChange
+ end
+ object ModeCombo: TComboBox
+ AnchorSideLeft.Control = PrevDateButton
+ AnchorSideTop.Control = PrevDateButton
+ AnchorSideTop.Side = asrBottom
+ Left = 9
+ Height = 23
+ Hint = 'Display Mode'
+ Top = 41
+ Width = 163
+ BorderSpacing.Top = 8
+ ItemHeight = 15
+ Items.Strings = (
+ 'Single'
+ 'Group'
+ )
+ OnChange = ModeComboChange
+ ParentShowHint = False
+ ShowHint = True
+ Style = csDropDownList
+ TabOrder = 9
+ end
+ object DaysCombo: TComboBox
+ Left = 344
+ Height = 23
+ Hint = 'Visible Days'
+ Top = 40
+ Width = 89
+ ItemHeight = 15
+ Items.Strings = (
+ '31 days'
+ '14 days'
+ '7 days'
+ '5 days'
+ '3 days'
+ '2 days'
+ '1 day'
+ )
+ OnChange = DaysComboChange
+ ParentShowHint = False
+ ShowHint = True
+ Style = csDropDownList
+ TabOrder = 12
+ end
+ object PrintButton: TBitBtn
+ Left = 279
+ Height = 24
+ Hint = 'Print'
+ Top = 8
+ Width = 24
+ Glyph.Data = {
+ 76010000424D7601000000000000760000002800000020000000100000000100
+ 0400000000000001000000000000000000001000000010000000000000000000
+ 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00300000000000
+ 0003377777777777777308888888888888807F33333333333337088888888888
+ 88807FFFFFFFFFFFFFF7000000000000000077777777777777770F8F8F8F8F8F
+ 8F807F333333333333F708F8F8F8F8F8F9F07F333333333337370F8F8F8F8F8F
+ 8F807FFFFFFFFFFFFFF7000000000000000077777777777777773330FFFFFFFF
+ 03333337F3FFFF3F7F333330F0000F0F03333337F77773737F333330FFFFFFFF
+ 03333337F3FF3FFF7F333330F00F000003333337F773777773333330FFFF0FF0
+ 33333337F3F37F3733333330F08F0F0333333337F7337F7333333330FFFF0033
+ 33333337FFFF7733333333300000033333333337777773333333
+ }
+ NumGlyphs = 2
+ Images = ImageList
+ ImageIndex = 2
+ OnClick = PrintButtonClick
+ ParentShowHint = False
+ ShowHint = True
+ Spacing = 0
+ TabOrder = 13
+ end
+ end
+ object Panel2: TPanel
+ Left = 0
+ Height = 25
+ Top = 521
+ Width = 445
+ Align = alBottom
+ AutoSize = True
+ BevelInner = bvLowered
+ BevelOuter = bvNone
+ BorderWidth = 2
+ ClientHeight = 25
+ ClientWidth = 445
+ TabOrder = 2
+ object Label1: TLabel
+ AnchorSideLeft.Control = Panel2
+ AnchorSideTop.Control = Panel2
+ Left = 5
+ Height = 15
+ Top = 5
+ Width = 94
+ BorderSpacing.Around = 2
+ Caption = 'Icons provided by'
+ ParentColor = False
+ end
+ object Label2: TLabel
+ AnchorSideLeft.Control = Label1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = Label1
+ AnchorSideTop.Side = asrCenter
+ Left = 103
+ Height = 15
+ Top = 5
+ Width = 61
+ BorderSpacing.Left = 4
+ Caption = 'icons8.com'
+ Font.Color = clBlue
+ ParentColor = False
+ ParentFont = False
+ OnClick = Label2Click
+ OnMouseEnter = Label2MouseEnter
+ OnMouseLeave = Label2MouseLeave
+ end
+ end
+ object utfScheduleManager1: TJvTFScheduleManager
+ OnRefreshAppt = utfScheduleManager1RefreshAppt
+ OnPostAppt = utfScheduleManager1PostAppt
+ OnDeleteAppt = utfScheduleManager1DeleteAppt
+ StateImages = StateImageList
+ StateImageMap.AlarmEnabled = 0
+ StateImageMap.AlarmDisabled = 1
+ StateImageMap.Shared = 3
+ StateImageMap.Recurring = -1
+ StateImageMap.Modified = 2
+ OnLoadBatch = utfScheduleManager1LoadBatch
+ SchedLoadMode = slmBatch
+ left = 112
+ top = 136
+ end
+ object StateImageList: TImageList
+ left = 112
+ top = 280
+ Bitmap = {
+ 4C69040000001000000010000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000FF000000FF000000FF0000000000000000000000000000
+ 000000000000000000000000000000000000000000007B7B7BFF000000FF0000
+ 00FF0000000000000000000000FF0000000000000000000000FF000000FF7B7B
+ 7BFF00000000000000000000000000000000000000FF7B7B7BFFBDBDBDFFBDBD
+ BDFF000000FF7B7B7BFF000000FF7B7B7BFF000000FFBDBDBDFFBDBDBDFF7B7B
+ 7BFF000000FF0000000000000000000000FFBDBDBDFFBDBDBDFFBDBDBDFFBDBD
+ BDFF7B7B7BFF7B7B7BFF000000FF7B7B7BFFBDBDBDFFBDBDBDFFBDBDBDFFBDBD
+ BDFF7B7B7BFF000000FF00000000000000FFBDBDBDFFBDBDBDFF7B7B7BFF0000
+ 00FF000000FF000000FF000000FF000000FF000000FF000000FFBDBDBDFF7B7B
+ 7BFF7B7B7BFF000000FF00000000000000FF000000FF000000FF000000FF0000
+ 00FF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000FF000000FF0000
+ 00FF000000FF000000FF000000000000000000000000000000FF000000FF0000
+ FFFFBDBDBDFFFFFFFFFF000000FFFFFFFFFFBDBDBDFF0000FFFF000000FF0000
+ 00FF000000000000000000000000000000007B7B7BFF000000FF0000FFFFBDBD
+ BDFF000000FFFFFFFFFF000000FFFFFFFFFF000000FFBDBDBDFF0000FFFF0000
+ 00FF7B7B7BFF000000000000000000000000000000FF0000FFFF0000FFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFF0000FFFF0000
+ FFFF000000FF000000000000000000000000000000FF0000FFFF000000FFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFF000000FF000000FF0000
+ FFFF000000FF000000000000000000000000000000FF0000FFFF0000FFFFFFFF
+ FFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FFFF0000
+ FFFF000000FF0000000000000000000000007B7B7BFF000000FF0000FFFFBDBD
+ BDFF000000FFFFFFFFFFFFFFFFFFFFFFFFFF000000FFBDBDBDFF0000FFFF0000
+ 00FF7B7B7BFF00000000000000000000000000000000000000FF000000FF0000
+ FFFFBDBDBDFFFFFFFFFF000000FFFFFFFFFFBDBDBDFF0000FFFF000000FF0000
+ 00FF000000000000000000000000000000000000000000007BFF000000FF0000
+ 00FF000000FF0000FFFF000000FF0000FFFF000000FF000000FF000000FF0000
+ 7BFF00000000000000000000000000000000000000FF000000FF00007BFF0000
+ 0000000000FF000000FF000000FF000000FF000000FF0000000000007BFF0000
+ 00FF000000FF0000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000007B7B7BFF7B7B7BFF7B7B7BFF0000000000000000000000000000
+ 000000000000000000000000000000000000000000007B7B7BFF7B7B7BFF7B7B
+ 7BFF00000000000000007B7B7BFFFFFFFFFFFFFFFFFF7B7B7BFF7B7B7BFF7B7B
+ 7BFF000000000000000000000000000000007B7B7BFF00000000FFFFFFFFFFFF
+ FFFF7B7B7BFF000000007B7B7BFFFFFFFFFF7B7B7BFF00000000FFFFFFFFFFFF
+ FFFF7B7B7BFF00000000000000007B7B7BFF00000000FFFFFFFF000000000000
+ 0000000000007B7B7BFF7B7B7BFF7B7B7BFF00000000FFFFFFFF000000000000
+ 0000000000007B7B7BFF000000007B7B7BFFFFFFFFFF00000000000000007B7B
+ 7BFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B7BFF000000000000
+ 0000000000007B7B7BFFFFFFFFFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B
+ 7BFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7B7B7BFF7B7B7BFF7B7B
+ 7BFF7B7B7BFF7B7B7BFFFFFFFFFF00000000FFFFFFFF7B7B7BFF7B7B7BFFFFFF
+ FFFFFFFFFFFF000000007B7B7BFF0000000000000000000000007B7B7BFF7B7B
+ 7BFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000007B7B7BFFFFFFFFFFFFFF
+ FFFF7B7B7BFF000000007B7B7BFFFFFFFFFF7B7B7BFF00000000000000007B7B
+ 7BFFFFFFFFFF0000000000000000000000007B7B7BFF00000000FFFFFFFF0000
+ 000000000000FFFFFFFF7B7B7BFFFFFFFFFF00000000FFFFFFFF000000000000
+ 00007B7B7BFF0000000000000000000000007B7B7BFFFFFFFFFF7B7B7BFF0000
+ 000000000000000000007B7B7BFFFFFFFFFF000000007B7B7BFF7B7B7BFF0000
+ 00007B7B7BFFFFFFFFFF00000000000000007B7B7BFFFFFFFFFF00000000FFFF
+ FFFF000000007B7B7BFF00000000FFFFFFFF0000000000000000FFFFFFFFFFFF
+ FFFF7B7B7BFFFFFFFFFF0000000000000000000000007B7B7BFF000000000000
+ 00007B7B7BFF00000000FFFFFFFF000000007B7B7BFF00000000000000007B7B
+ 7BFF00000000FFFFFFFF0000000000000000000000007B7B7BFF7B7B7BFF0000
+ 000000000000FFFFFFFF7B7B7BFF0000000000000000FFFFFFFF7B7B7BFF7B7B
+ 7BFFFFFFFFFF00000000000000000000000000000000000000007B7B7BFF7B7B
+ 7BFF7B7B7BFF000000007B7B7BFFFFFFFFFF7B7B7BFF7B7B7BFF7B7B7BFFFFFF
+ FFFFFFFFFFFF0000000000000000000000007B7B7BFF7B7B7BFF00000000FFFF
+ FFFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B7BFF7B7B7BFFFFFFFFFFFFFFFFFF7B7B
+ 7BFF7B7B7BFF0000000000000000000000000000000000000000000000FF0000
+ 000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
+ 00FF0000000000000000000000000000000000000000000000FF0000FFFF0000
+ 00FF00000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000
+ 00FF000000FF0000000000000000000000000000000000000000000000FF00FF
+ FFFF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000
+ 00FFFFFFFFFF000000FF00000000000000000000000000000000000000000000
+ 00FF00FFFFFF000000FFFFFFFFFFFFFFFFFF000000FF000000FFFFFFFFFF0000
+ 00FFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
+ 0000000000FF00FFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000
+ 00FF000000FF000000FF000000FF000000000000000000000000000000FF0000
+ 00FF000000FF000000FF00FFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FF000000FF000000FF000000FF00FFFFFFFFFF
+ FFFF00FFFFFF000000FF000000FF00FFFFFF000000FFFFFFFFFFFFFFFFFF0000
+ 00FF000000FFFFFFFFFF000000FFFFFF00FF000000FF00FFFFFFFFFFFFFF0000
+ 00FF000000FF000000FF000000FF000000FF000000FF000000FFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FFFFFF00FF000000FFFFFFFFFF00FFFFFFFFFF
+ FFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF000000FFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FFFFFF00FF000000FF00FFFFFFFFFFFFFF00FF
+ FFFFFFFFFFFF000000FF000000FF000000FF000000FF000000FF00FFFFFF0000
+ 00FFFFFFFFFFFFFFFFFF000000FFFFFF00FF000000FFFFFFFFFF00FFFFFFFFFF
+ FFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF000000FFFFFFFFFF000000FF0000
+ 00FFFFFFFFFFFFFFFFFF000000FFFFFF00FF000000FF00FFFFFFFFFFFFFF00FF
+ FFFFFFFFFFFF000000FF000000FF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFF000000FFFFFFFFFF000000FFFFFF00FF000000FF000000FF00FFFFFFFFFF
+ FFFF00FFFFFFFFFFFFFF00FFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FF000000FF000000FF00000000000000FF0000
+ 00FF000000FF000000FF000000FFFFFFFFFFFFFFFFFF000000FFFFFFFFFF0000
+ 00FF000000FFFFFFFFFF000000FF000000000000000000000000000000000000
+ 000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000
+ 000000000000000000FF000000FF000000FF000000FF000000FF000000FF0000
+ 00FF000000FF000000FF000000FF000000000000000000000000000000000000
+ 0000000000FF000000FF000000FF000000FF000000FF00000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000FF0000
+ 00FF0000000000000000000000000000000000000000000000FF000000FF0000
+ 00000000000000000000000000000000000000000000000000FF000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00FF00000000000000000000000000000000000000FF000000FF000000FF0000
+ 00FF000000FF000000FF00000000000000000000000000000000000000000000
+ 0000000000FF000000000000000000000000000000FF000000FF0000FFFF0000
+ FFFF0000FFFF000000FF0000000000000000000000FF000000FF000000FF0000
+ 0000000000FF0000000000000000000000FF00000000000000FF0000FFFF0000
+ FFFF0000FFFF000000FF00000000000000FF7B7B7BFF00FFFFFF7B7B7BFF0000
+ 00FF00000000000000FF00000000000000FF00000000000000FF0000FFFF0000
+ FFFF0000FFFF000000FF00000000000000FF00FFFFFF00FFFFFF00FFFFFF0000
+ 00FF00000000000000FF00000000000000FF00000000000000FF000000FF0000
+ 00FF000000FF000000FF00000000000000FF7B7B7BFF00FFFFFF7B7B7BFF0000
+ 00FF00000000000000FF00000000000000FF0000000000000000000000000000
+ 00000000000000000000000000FF00000000000000FF000000FF000000FF0000
+ 000000000000000000FF00000000000000FF0000000000000000000000000000
+ 000000000000000000FFFF0000FF000000FF0000000000000000000000000000
+ 000000000000000000FF0000000000000000000000FF00000000000000000000
+ 0000000000FFFF0000FFFF0000FFFF0000FF000000FF00000000000000000000
+ 0000000000FF000000000000000000000000000000FF00000000000000000000
+ 00FF000000FF000000FF000000FF000000FF000000FF000000FF000000000000
+ 0000000000FF00000000000000000000000000000000000000FF000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00FF000000000000000000000000000000000000000000000000000000FF0000
+ 00FF0000000000000000000000000000000000000000000000FF000000FF0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000FF000000FF000000FF000000FF000000FF00000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000
+ }
+ end
+ object NeedApptsQuery: TSQLQuery
+ FieldDefs = <>
+ Database = dbUTF
+ Transaction = SQLTransaction
+ SQL.Strings = (
+ 'Select * From GroupLink, GroupAppt'
+ ' Where (SchedName = :SchedName)'
+ ' And (GroupLink.ApptID = GroupAppt.ApptID)'
+ ' And ((StartDate >= :D1) and (EndDate <= :D2))'
+ )
+ Params = <
+ item
+ DataType = ftUnknown
+ Name = 'SchedName'
+ ParamType = ptInput
+ end
+ item
+ DataType = ftUnknown
+ Name = 'D1'
+ ParamType = ptInput
+ end
+ item
+ DataType = ftUnknown
+ Name = 'D2'
+ ParamType = ptInput
+ end>
+ left = 208
+ top = 328
+ end
+ object ApptSchedulesQuery: TSQLQuery
+ FieldDefs = <>
+ Database = dbUTF
+ Transaction = SQLTransaction
+ SQL.Strings = (
+ 'Select * From GroupLink'
+ ' Where ApptID = :ApptID'
+ )
+ Params = <
+ item
+ DataType = ftUnknown
+ Name = 'ApptID'
+ ParamType = ptInput
+ end>
+ left = 208
+ top = 384
+ end
+ object GetApptQuery: TSQLQuery
+ FieldDefs = <>
+ Database = dbUTF
+ Transaction = SQLTransaction
+ SQL.Strings = (
+ 'Select * From GroupAppt'
+ ' Where ApptID = :ApptID'
+ )
+ Params = <
+ item
+ DataType = ftUnknown
+ Name = 'ApptID'
+ ParamType = ptInput
+ end>
+ left = 200
+ top = 440
+ end
+ object DeleteApptLinkQuery: TSQLQuery
+ FieldDefs = <>
+ Database = dbUTF
+ Transaction = SQLTransaction
+ SQL.Strings = (
+ 'Delete From GroupLink'
+ ' Where ApptID = :ApptID'
+ )
+ Params = <
+ item
+ DataType = ftUnknown
+ Name = 'ApptID'
+ ParamType = ptInput
+ end>
+ left = 328
+ top = 440
+ end
+ object DeleteApptQuery: TSQLQuery
+ FieldDefs = <>
+ Database = dbUTF
+ Transaction = SQLTransaction
+ SQL.Strings = (
+ 'Delete From GroupAppt'
+ ' Where ApptID = :ApptID'
+ )
+ Params = <
+ item
+ DataType = ftUnknown
+ Name = 'ApptID'
+ ParamType = ptInput
+ end>
+ left = 328
+ top = 328
+ end
+ object SchedulesQuery: TSQLQuery
+ FieldDefs = <>
+ Database = dbUTF
+ Transaction = SQLTransaction
+ SQL.Strings = (
+ 'Select Distinct(SchedName) From GroupLink'
+ )
+ Params = <>
+ left = 328
+ top = 384
+ end
+ object GlanceTextViewer1: TJvTFGlanceTextViewer
+ ShowStartEndTimeInHint = False
+ LineSpacing = 2
+ left = 304
+ top = 144
+ end
+ object GlanceTextViewer2: TJvTFGlanceTextViewer
+ ShowStartEndTimeInHint = False
+ LineSpacing = 2
+ ShowStartEnd = False
+ left = 304
+ top = 224
+ end
+ object dbUTF: TSQLite3Connection
+ Connected = False
+ LoginPrompt = False
+ KeepConnection = False
+ Transaction = SQLTransaction
+ left = 104
+ top = 384
+ end
+ object SQLTransaction: TSQLTransaction
+ Active = False
+ Action = caCommit
+ Database = dbUTF
+ left = 100
+ top = 440
+ end
+ object ImageList: TImageList
+ left = 112
+ top = 211
+ Bitmap = {
+ 4C69070000001000000010000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000000000005A3B261C0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000885B3B4EB57C50B70000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000895D3A5CD69C70F9BF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000008C5F3E6FDAA074FDF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000008D603F83DDA377FDF0B78BFFF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00002F2010018D614095E0A67AFCF0B78BFFF0B78BFFF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000002A20
+ 1503B98256A4E3A97DFBF0B78BFFF0B78BFFF0B78BFFF0B78BFFBF8558BD0000
+ 00000000000000000000000000000000000000000000000000002D1D1206BD81
+ 55B2E5AC80FBF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFBF8558BD0000
+ 00000000000000000000000000000000000000000000000000002D1D1206BD81
+ 55B3E5AC80FBF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000002A20
+ 1503B98357A5E3A97DFCF0B78BFFF0B78BFFF0B78BFFF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00002F201001BD825097E0A77AFCF0B78BFFF0B78BFFF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000008D613F86DEA478FDF0B78BFFF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000008C603F74DBA175FEF0B78BFFBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000895D3C61D89D71FCBF8558BD0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000885C3B52B57B50BA0000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000000000005A3B261C0000
+ 0000000000000000000000000000000000000000000000000000000000002D1E
+ 13122C1E130A0000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630B77C51C42C1E130F00000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630D89E71F6C2875CD12F201518000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6EDB488FFC58A5EDB2F2015220000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFEEB589FFC88D61E25E40252E00000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFF0B78BFFEFB68AFFCA9064E889603A39000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFF0B78BFFF0B78BFFF0B78BFFCE9468ED885D3A440000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFD3986CF3875C
+ 3A50000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFD3986CF4885C
+ 3A50000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFF0B78BFFF0B78BFFF0B78BFFCF9568EE895A39450000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFF0B78BFFF0B68AFFCB9165E884603F3B000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6F0B78BFFEFB68AFFC88E62E25E40253000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630DCA376F6EEB589FFC68A5FDC2F2015260000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630D89E72F6C3885CD42F20151C000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000005A3D
+ 2630B77D50CA2D1E131100000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000002D1E
+ 13122C1E130A0000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000000000000000000050483F5F5048
+ 3F7550483F7550483F7550483F7550483F7550483F7550483F7550483F755048
+ 3F5F000000000000000000000000000000000000000000000000B5A99ACFF9F8
+ F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFB8AD
+ 9FD5000000000000000000000000000000000000000000000000B8AB9DCBFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBCB0
+ A3D50000000000000000000000000000000000000000493E3544B6A99BF7FFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBBAE
+ A1F84A3E35460000000000000000231D1917957F6DA09B8673D0B68C6AFFC598
+ 74FFC59874FFC59874FFC59874FFC59874FFC59874FFC59874FFC59874FFB68C
+ 6AFF9B8674D095806DA2241E191A493E3570CDB9A8FFD4C1B0FFCB9972FFF0B7
+ 8BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFCC98
+ 70FFD3C3B3FFCEBBAAFF493E3475493E3475CEBBA9FFD4C1B0FFCB9972FFF0B7
+ 8BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFCC98
+ 70FFBCD8D8FFC3C9C1FF483D347B493E3475CEBBA9FFD4C1B0FFC99873FFEFB6
+ 8AFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B78BFFF0B68AFFC997
+ 71FFD4C1B0FFD0BDACFF483D347B493E3475CEBBA9FFD4C1B0FFCFB49EFFC49A
+ 7AFFC39979FFC39979FFC39979FFC39979FFC39979FFC39979FFC39A7AFFCFB4
+ 9DFFD4C1B0FFD0BDACFF483D347B493E3475CEBBA9FFD4C1B0FFD4C1B0FFD4C1
+ B0FFD4C1B0FFD4C1B0FFD4C1B0FFD4C1B0FFD4C1B0FFD4C1B0FFD4C1B0FFD4C1
+ B0FFD4C1B0FFD0BDACFF483D347B493E3475CEBBA9FFAF9A88FFA08D7BFFAE9D
+ 8CFFAE9D8CFFAE9D8CFFAE9D8CFFAE9D8CFFAE9D8CFFAE9D8CFFAE9D8CFFA08D
+ 7BFFAD9886FFD0BDACFF483D347B493E3573CDBAA9FFB5A18FFFC4B5A7FFEDE3
+ D6FFE3D8CAFFD8CCBDFFD8CCBDFFD8CCBDFFD8CCBDFFE3D8CAFFEDE3D6FFC6B8
+ AAFFB49F8DFFCFBCABFF493E3477453E3A1F9B8673BBA38E7BD5BAAD9EF7FBF8
+ F5FFEFEBE6FFE3DDD6FFE3DDD6FFE3DDD6FFE3DDD6FFEFEBE6FFFBF8F5FFBEB1
+ A4F8A38E7BD59C8773BD443E3A24000000000000000000000000B8AB9DCBFFFF
+ FFFFE3DED9FFCAC1B7FFCAC1B7FFCAC1B7FFCAC1B7FFE3DED9FFFFFFFFFFBCB0
+ A3D5000000000000000000000000000000000000000000000000B5A99ACFF9F8
+ F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFF9F8F7FFB8AD
+ 9FD500000000000000000000000000000000000000000000000050483F5F5048
+ 3F7550483F7550483F7550483F7550483F7550483F7550483F7550483F755048
+ 3F5F0000000000000000000000004C7047004C7047004C7047004C7047004C70
+ 47004C70470080808002769B5B1C779F602D7A9B591780804004799A5E2671AA
+ 55094C7047004C7047004C7047004C7047004C7047004C7047004C70470076A7
+ 621A8DB27B9F9BBF8DD3A7CB9EEEADD1A6FA9EC292EF96BA87F5AACFA2FA9BBF
+ 8EDB8AAF75534C7047004C7047004C7047004C7047004C70470086AD73549CC2
+ 91DCBCDEB8FFBDE0BAFFB6D9B1FFB1D4AAFF9CC291FFBDE0BAFFBDE0BAFFBDE0
+ BAFF95BA86D34C7047004C7047004C7047004C70470081AE6F45A4C899E6BDE0
+ BAFFA8CC9FEA8FB37EA882AA70607B9D663C94B984D6BDE0BAFFBDE0BAFFBDE0
+ BAFF9ABE8EF880A7621A4C7047004C7047008080400495BA86CCBDE0BAFFA0C4
+ 95DE83AB71464C7047004C7047004C70470086AC746EAFD1A6F4BDE0BAFFB5D8
+ AFFF9FC292FF8EB37DAE4C7047004C70470084AA7072A1C596FEA4C79AFA85AA
+ 71664C7047004C7047004C7047004C7047004C70470085AC74568FB37D9B89AE
+ 76C6BADDB6FFA7C99CED75A05F237BAD6B1F96BA87F1B8DCB4FFAFD4A8FD8CB1
+ 7BA04C7047004C7047004C7047004C7047004C7047004C7047004C704700799E
+ 6115A2C798E7BBDEB7FF87AD74828CB17A94BDDFBAFFBDE0BAFFBDE0BAFFA5C9
+ 9BEC7A995C194C7047004C7047004C7047004C7047004C7047004C7047004C70
+ 470099BE8BCBBDE0BAFF8FB37D9B8CB07A94BDDFBAFFBDE0BAFFBDE0BAFFA4C9
+ 9BEC759F60184C7047004C7047004C7047004C7047004C7047004C7047004C70
+ 47009BBE8BCBBDE0BAFF8DB27D9B7BA76A1D96BA87F1B8DBB4FFAFD3A8FD8CB0
+ 7A9F4C7047004C7047004C7047004C7047004C7047004C7047004C7047007497
+ 5D16A2C798E7BBDEB7FF87AD74824C70470083A8716FA1C596FEA4C999FA82AC
+ 71684C7047004C7047004C7047004C7047004C70470080AA6F1E8CB17A948BB0
+ 7AD6B3D7ADFFA5CA9CEC78A562224C7047008080400496BB87CABDE0BAFFA2C6
+ 95DE83AA71484C7047004C7047004C704700809C631296BB88D6BDDFBAFFBDDF
+ BAFF9DC190FF8CB27BB24C7047004C7047004C70470085AB6E43A4C89AE5BDE0
+ BAFFA8CB9EEB8EB47DA985A9706277A0633E84AA71ACB8DBB4FFBDE0BAFFBDE0
+ BAFFB8DBB4FF84A86F784C7047004C7047004C7047004C70470087A972539DC1
+ 8FDBBBDFB8FFBDE0BAFFB6DAB1FFB1D4AAFFA8CDA0FFB0D4A9FFBDE0BAFFBDE0
+ BAFFAFD3A9F981A96C474C7047004C7047004C7047004C7047004C7047007A9B
+ 64178CB27B9E9ABD8DD2A6CA9DEDADD1A5FAA5C99AEA90B37FEBA5C899F6A5C9
+ 9AED8CB27B9E4C7047004C7047004C7047004C7047004C7047004C7047004C70
+ 47004C7047008080800271A15E1B779F602D799E61154C7047007A995C19759F
+ 60184C7047004C7047004C704700000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000005856CAFC6564D8FE6564D8FE6564
+ D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564
+ D8FE6564D8FE5856CAFC00000000000000006766D7FD8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF6767DAFE00000000000000005E5ED3FE7C7CEBFF7C7CEBFF7C7C
+ EBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7C
+ EBFF7C7CEBFF5F5ED5FE0000000000000000A59DB5F2D0D0F1FFD0D0F1FFD0D0
+ F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0
+ F1FFD0D0F1FFA7A0B7F80000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFDFCFAFFFEFDFDFFFDFCFBFFFDFCFBFFFEFDFDFFFDFCFAFFFEFEFEFFFCFB
+ F9FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFEBE4DBFFF3F0EAFFEEE9E2FFEEE9E1FFF4F0EBFFEAE4DAFFF8F5F2FFE6DE
+ D3FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFE5DED2FFF6F3
+ EFFFEAE3D9FFF2EEE8FFEEE8E0FFEDE7DFFFF3EFE9FFE3DED1FFD3DCC8FFBAC4
+ A5FFE7EEE3FFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFEFDFCFFFFFF
+ FEFFFEFEFDFFFFFEFEFFFEFEFDFFFEFEFDFFE2EADDFF9CBD8EFFACD0A4FFB2D5
+ ABFFA2C697FF95A87DFA1C27180400000000C5BBAFEFFFFFFFFFE8E2D7FFF8F5
+ F2FFECE6DDFFF4F1EBFFF0EBE4FFE9E6DCFF9DBC8EFFBDE0BAFFCBE7C8FFE9F5
+ E9FFBDE0BAFFB0D3A9FF5B784A7C00000000C5BBAFEFFFFFFFFFFAF9F6FFFEFD
+ FDFFFBFAF8FFFDFCFBFFFCFBF9FFD4DFCBFFADD0A5FFCBE7C8FFDCEFDAFFF6FB
+ F5FFCFE9CDFFC3E3C0FF8FB47EDF00000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFC9D9C0FFB2D6ACFFE9F5E9FFF6FBF5FFFDFE
+ FDFFF2F9F2FFD1EACFFF94B986F600000000C8BDB0EFF6F1EBFFF6F1EBFFF6F1
+ EBFFF6F1EBFFF6F1EBFFF6F1EBFFDFE1D0FFA3C798FFBDE0BAFFCFE9CDFFF2F9
+ F2FFBDE0BAFFBDE0B9FF84A96FBE00000000B2A494E8C8BDB0F5C8BDB0F5C8BD
+ B0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BDB0F595A87DFAB1D4AAFFC3E3C0FFD1EA
+ CFFFBDE0B9FF98BB8AFE3C4F3038000000000000000000000000000000000000
+ 0000000000000000000000000000000000001C2718045A76497A8FB47EDD94B9
+ 85F583A86EBC3B4E2F3600000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000005856CAFC6564D8FE6564D8FE6564
+ D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564
+ D8FE6564D8FE5856CAFC00000000000000006766D7FD8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF6767DAFE00000000000000005E5ED3FE7C7CEBFF7C7CEBFF7C7C
+ EBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7C
+ EBFF7C7CEBFF5F5ED5FE0000000000000000A59DB5F2D0D0F1FFD0D0F1FFD0D0
+ F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0
+ F1FFD0D0F1FFA7A0B7F80000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFDFCFAFFFEFDFDFFFDFCFBFFFDFCFBFFFEFDFDFFFDFCFAFFFEFEFEFFFCFB
+ F9FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFEBE4DBFFF3F0EAFFEEE9E2FFEEE9E1FFF4F0EBFFEAE4DAFFF8F5F2FFE6DE
+ D3FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFE5DED2FFF6F3
+ EFFFEAE3D9FFF2EEE8FFEEE8E0FFEDE7DFFFF3EFE9FFE9E2D7FFF7F4F1FFE4DC
+ D0FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFEFDFCFFFFFF
+ FEFFFEFEFDFFFFFEFEFFFEFEFDFFFEFEFDFFFFFEFEFFFEFEFDFFFFFFFEFFFEFD
+ FCFFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFE8E2D7FFF8F5
+ F2FFECE6DDFFF4F1EBFFF0EBE4FFEFEAE3FFF4F1ECFFECE6DCFFFFFFFFFFFFFF
+ FFFFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFAF9F6FFFEFD
+ FDFFFBFAF8FFFDFCFBFFFCFBF9FFFCFBF9FFFDFCFBFFFBFAF8FFFFFFFFFFFFFF
+ FFFFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFC7BDB3F50000000000000000C8BDB0EFF6F1EBFFF6F1EBFFF6F1
+ EBFFF6F1EBFFF6F1EBFFF6F1EBFFF6F1EBFFF6F1EBFFF6F1EBFFF6F1EBFFF6F1
+ EBFFF6F1EBFFC9BEB1F50000000000000000B2A494E8C8BDB0F5C8BDB0F5C8BD
+ B0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BD
+ B0F5C8BDB0F5B2A494E900000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000005856CAFC6564D8FE6564D8FE6564
+ D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564D8FE6564
+ D8FE6564D8FE5856CAFC00000000000000006766D7FD8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF6767DAFE00000000000000005E5ED3FE7C7CEBFF7C7CEBFF7C7C
+ EBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7CEBFF7C7C
+ EBFF7C7CEBFF5F5ED5FE0000000000000000A59DB5F2D0D0F1FFD0D0F1FFD0D0
+ F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0F1FFD0D0
+ F1FFD0D0F1FFA7A0B7F80000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFDFCFAFFFEFDFDFFFDFCFBFFFDFCFBFFFEFDFDFFFDFCFAFFFEFEFEFFFCFB
+ F9FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFEBE4DBFFF3F0EAFFEEE9E2FFEEE9E1FFF4F0EBFFEAE4DAFFF8F5F2FFE6DE
+ D3FFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFE5DED2FFF6F3
+ EFFFEAE3D9FFF2EEE8FFEEE8E0FFEDE7DFFFF3EFE9FFE1DAD6FFC4C2E6FFA5A0
+ CEFFDEDEF6FFC7BDB3F50000000000000000C5BBAFEFFFFFFFFFFEFDFCFFFFFF
+ FEFFFEFEFDFFFFFEFEFFFEFEFDFFFEFEFDFFD7D7F3FF7272DCFF7D7DECFF8383
+ F0FF7272E4FF7570BCFA10102F0400000000C5BBAFEFFFFFFFFFE8E2D7FFF8F5
+ F2FFECE6DDFFF4F1EBFFF0EBE4FFE7E2E1FF7171DCFF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8282EDFF3535977C00000000C5BBAFEFFFFFFFFFFAF9F6FFFEFD
+ FDFFFBFAF8FFFDFCFBFFFCFBF9FFC5C4EAFF7E7EECFFA6A6F9FFADADF9FFADAD
+ F9FFADADF9FF9999F8FF5D5DD8DF00000000C5BBAFEFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFB4B4EAFF8484F0FFDADAFDFFE9E9FEFFE9E9
+ FEFFE9E9FEFFB1B1FAFF6363DCF600000000C8BDB0EFF6F1EBFFF6F1EBFFF6F1
+ EBFFF6F1EBFFF6F1EBFFF6F1EBFFD5D1E4FF7473E5FF8F8FF7FF8F8FF7FF8F8F
+ F7FF8F8FF7FF8F8FF7FF5151D0BE00000000B2A494E8C8BDB0F5C8BDB0F5C8BD
+ B0F5C8BDB0F5C8BDB0F5C8BDB0F5C8BDB0F57470BBFA8282EEFF8F8FF7FF8F8F
+ F7FF8F8FF7FF6968DBFE22226538000000000000000000000000000000000000
+ 00000000000000000000000000000000000010102F043434967A5E5ED8DD6363
+ DCF55050D0BC2121643600000000
+ }
+ BitmapAdv = {
+ 4C69010000004C7A070000002000000020000000510F00000000000078DAED9A
+ 795093DB15C05FDBD76DFA66DA4EF769A77DD369A76FA6FDA3D37FDBCE38639F
+ CFE78A0BF6C963532480DB136509D9080828A0AC8A2C0990051114903D405040
+ 5156173645106471098B10B6B0E6F49E4F931730C1846CD5973B7326B9F9BEEF
+ FCEE77CFB9E79EF37DF9E083F7B315FB6EFA751163DB17D66097D2ED3E2E61DB
+ F51532B6712DCD2E0CD8FA4909CB6EAC8CB36BD1D2FC42E6D67F95B2764C74A4
+ 7C35D310E3366749BE84BDFDDFA5ACED8A4702DF85F1D248B0245FCAD9FDA584
+ B543F158E40FC8B624BF32788F6729CB6EB63F8BAD665B8A5F19B4872BE1EC98
+ 1EC8E62C635B825F19649F50C6DE39F33C27E80DB6B9F9D2A03D6269D0EE0959
+ DE49AD6C73F1AF73D77D58C1B5BF56196C3F31941FAA936D0E7E36D7FE2329D7
+ BEBA2AD4616CB4E8F4AA6C53F3915D1EB8ABFD46B8D34B7DD8A6E4E33E52C6D9
+ D95D7BC6656CAC24422FB6A9F8C896B0773EBB13471B35846D6A7E739CC74B6B
+ F035E6BFF79615E67FA5FFD5463A8F5ADAFF34C740D6FEEDAAB0BDE3965E7FCB
+ E3CFEEEBD743F68E593AFE2C1B43F0EE2C69D0EA31D0DCFB4F4590BDB09CBB6B
+ CA1AFB8FC6DE7F52D71E68A9FC431ABC8761ADFC43633F76C131F45D6259858F
+ AD9C63BFA3542307B434FFEBFC7BBBA233EDC4BC35F854BC66D8FD9DD862C21A
+ F5C78A1A68D45A7C6BD79FEF5D2D4FDFB6116D6A353E63AB2BD6D4E8DBD6E293
+ 7A63A1846937836BDC1AFCBAA8FDA318DB30C649D8BBF658838F71F549261330
+ D6931AC8D51A7C14DCEB24EC1D8A8AA03D81D6E0A3E09E8F7B3FC90122ADC157
+ 8D81E4417269F06E9135F8289803925C70928CA30873434BF351860BC2A02A74
+ EF1819439539C6F0363E0AD60455610EE324276DC35AC1D27C14ACCF6E45BABC
+ 2463E828E46EFDB9A5F9AA31D447BB8D9571763CC53DD8D27C9534C579C849DD
+ 2A33C5BEB5163E4A5BF2D18952B69DDCD83118C3975889DF1CEF2127317AC4D2
+ F38FFED714EBFE92D8DEE2FE876C7C4E551EB8ABD3546C43E20F3E9FC3E72496
+ 8E3FC8BE1EBA771C9F4F9A9AADCFFE5319FC5F393E97B5F4FEF37AEF9B20FC0C
+ ABE41F9C9D3352EE9E144BE71FCF5EE73EA4EE0FB674FE85B91FE69FD260FBE3
+ 96CE3F7B2F3228760577B7B3E5EB0FFB056417D1B7FFC72AF517739BC21AB5CF
+ FF43FDF94D6CE951EC58416CE0B029047519CA4F8B6167DCBE560893F2974609
+ EA109D0BBE6C285F18CB4968AEAD00635B5BD34D1BDF407E2CD38BC68B0CE836
+ 153F3D9A3D803AF5E59F0B3C745914C30193DD7F1C1712B847F2576346D33D3F
+ 8E0AA0D1CFD269DC58A6677B4E940F14C7FA40755A8851823A72A37D218EE5F5
+ 107523E34C006D592C3DEBEFE118CF3E389D11C399C88CE34E12992E8DA0919C
+ CE01EA62DC8D12D481BA50E76BDD93C88A617A1C54CF37E7D0839A5C1EB4555F
+ 55CB8D243AB4261E06436B9E95D2C13B0635E7BC97E9AECD4F07C2EC51F1E3D8
+ 5EC3B78B8466E7DFB95D0E2D3505D028C90462E3194BF29BEAAF81E8254051EF
+ A055F8F76F1643DEC03054B5DED38B8FD798828F3A56DA5F1F7E435614D444B8
+ C248E1A935B3B12EBA79661FD48BC30CE6B75ECF81AA984350C2DC0EC58C6D6B
+ 96EB515ED07AEDB2C17C95B4545C827B12F19A04AFD5A6D310BE39E4FF997FA7
+ 3C0B72934F4372E8714808FECA2482BA7292C2A0A9ECD25BF97929E1101D4003
+ 7EB81F14659C875A499651823AF8E1FE94CECB09216FE517A54751E766C406C2
+ E3B63A181DE8304AFA3BEF40467C10A5339F1FA9951FCF39D4877B02B5EEAAF2
+ A0322B11F278916FF06B8AC47AC94AFE95E470A8C83C4FE946465DB108C81EF8
+ 54CD677AD29342BCA70BC8F85472E9FC49686FAE8119F9B05A6E95E7E8259AD7
+ 3C6AA9874B64DE3575A784F94CC731BDCEAAF85C2EF743323F76F19CC31731F7
+ 413175FEA5D28B121D706037320DCD3F7B1EB6E825E6C87F6715335092CDD34B
+ F0DC773DFFB776FD65EDFAD3526DCBB1CFDE39E1A6B9FEC03FD9E5AF7E298E9F
+ FAF25D9C7D79CEBB7C792EFF3CC173F8031EF7B9E0F44BEA3772CC8FEFF48F0F
+ E0836F19CDCCB6FF5E40EA3E9740B16775A0F8A0ECCC55A6EC7C45D8586A4DDC
+ 7CCAB5A8E9B8D2E091D3574EC8D842DA14F7E2C1D9A4CA08051E8BCC670EB345
+ 1EED749EE39FD6C4E572BFCDE0EF7766093D06932A23A70BDAAF40E59372AD12
+ 2F09860B15A741DA2359F6FBD5B62C206378CE48D9FB2B43D8F404879FB284EE
+ F5E72421E392AE429D5C94BCD62C08CFF503E99332ADC7C575494B4CA187585F
+ B66F9AEB9F09FBC9A546FE82367DC50FF320FB8E0084B713E1623D8FBAF78C06
+ 9EEE31F6965373A00F9BD8F9172C216D00E74D53470599577E4DCC0C37E3908C
+ 2DF26C20FACED3F9FB4F3085EE411CB1E7939CFB19ABCE1127C36B461F3F6309
+ 6877B39A058B9AD75EB9275EE288BD640CC101B68FD0E9476FD82A7D1F53702B
+ 6151171BC71E28F65AA28BDC0EACC667A6BBB3D0CF34AF15DC4A54B044B496D5
+ FCC73FC9F9F741170F0D57F44AB4F2536FC442F2B533640E0E0EE1FAD4A6E358
+ 9AEB4F38224F59454FA9FABAACE6F4250E998F237147BEFFB6B96388DCFD4F5D
+ F191973E2A505F8FFE28BA7D01C8EF807A33EA531675F921B1E369328773AA6B
+ 255D45C0167B3EF5E539FC4C5FBF6508DD1CC85AEDC75870269F2923369B08C9
+ F29E2B7F5CA21E4FF0A523438C24C7DFACBC96F8FB8BA80236845D3E0E67F219
+ 10911BA060A4EE3FB096B881B11063A477B6FD0F892FB715767C1D37485C9A0B
+ 48DF775433C630053469649EBFF26A5B36A00D8B1EE4622C51927B6945BB1813
+ 3BFD792E9BCF4942C755FC22B276C9FA6952CFBB80164A62CCAC8EB8B1C0167B
+ 488DE1A3EF10DF9769EA650B3D87705FE072D77D48D6F1329F5B2921D9C787E9
+ A9FBFF68CC18D8428F07E5DDC56A9DC1994764DE02E7DFFAF11DFF12914797AD
+ 1637F8D5310A7F9ED317C6F039199E959A3E1079952EF3E139FDCDB2FC1CB54E
+ 64225F35FF521D710325F4B2F790B9E61F8F0592F87DA1E294421B3BB3216581
+ 25F2283397FFA9D79FD0BD3C22D75F994FD69FF4F5FA4B283FA5C4B8EB9F44FB
+ B151EB2FD5752BEEE1BAD69F3AFE080E3C8F2AC4F873E255FCB94A57D045FB69
+ 6B61DA67DB7F2720C9F59313697B3FC1FC47D3F6FCEAB85966AADB61ADF1B756
+ 23FE7617517BB621F117E792957E20047D0A7D3C3C8F3EC1CDF052F2ABA2A91C
+ 808ABF99DAE32FC639322FB2F29E9265FB0FB1C15DCC39F5F4B382736521539A
+ F104ED99288D8098622EB5FF048A3C043AF78F74F700ADFB2F89E1DAC6BCD2CE
+ E49EE5BAD6D1D97C26994FDA38E637BA74D09268DFA5F28FA6F437F20FCC7BC9
+ 5ECCE59EB7FF48EBBD93388DFB872EFEEB3CB4FDADB91FB137EEA12BF32F9C47
+ 7E75AC827B91CABF9A48AE9088F917F1DB6076865726D1BDB05A1CC11C885CD7
+ A56FFE49FCB127B3913FA735FFECBCAACE3F31EFC4DC2FF26A00B5B674F1714D
+ 73445EB5FAFA32FA234BE0713BBEF4E4B8664EA34B84B72E503996AEE3643F9F
+ 34349FC018C548DDE748FC6680F8F0547EBB6EFB62DD817996B82EF98D63171B
+ 780B18CB30DEAFB5FEF24F75762471F43AC6526DF557588EEF0BE2BB4FB1560A
+ C9F61EE35545CFA2E0FE8131DCD838AA19CFB1AEF44B71DA493EDDFC539C1D7D
+ 79AE1BE969AE1FABF371B25FF9A6B8EC453176EF32A7D8DAAB66BF533ABD6D6B
+ ED922504592BF9DBB6DC5C3A7AB41F58AC61B30A32700C2BF93BED6A16F07874
+ B4C2AC1214F4D2C6D7C2DFBAE5C6A28B4B277879F59A5590A18DEF774438723E
+ BE05048201B34A62C203F03B9A3EB5922F8A0FEA79D6FF18CCDD4664CF009FC9
+ BE6BFCC58579504C8DC39C628AEA2B954B541F05BF63C363D8C773B12DCCCF52
+ FDF9D919A3F9D313A3D0D3560B83DDF7A8FED2E202D547410EB667BDAD547F72
+ 4C46F5C764FD547F68B0CB68FE947C04FA3B9B4036D0F9FADEE6A83E0A7EC786
+ C7B08FE762938F3CA3FAA3CF7BDF79FB5B9A3FF2BC87B21D7E5AC3FEC6F0BB7B
+ EF42754B09A4149F82B08B5F4162C149A8BC9B0F7DB26EBDF98B8BF3945EE450
+ BCA545AAAF5A5B4AA592EAA3E0776CF3E47B696336901C94D4EE61406A59B87C
+ 57447D9E2F0B038ED00332A5099016C71E31B5FD717C71F98110914B273548AE
+ D6FCBCB4AB10A20B39C0E6BB2F616DB11A7F7C78909A4F952D6726C7A8BECA1E
+ 380FD847C1EF78DF9139F465BCBB2F9A6154310AAD43F797D7A1790C25A9830A
+ 4C65FFFE175DD49CAFBCEF27F257EBFEE9E4E0B2DFCBBA8B8029709FF1E5396E
+ D4C5574CCBA97B57C5DBF93905D5C77950CD37F651AEDD2F84C4F2F037E65B17
+ 1F85D4690BA45E1599C2FEA9E551948FA9E61CB928F2D971EAF8E4DC84FA3795
+ 2D2E35A5E11C749B821F71D90F9F0F507AD1DEABB58939F9EB6750B9E0CFDF37
+ 6B0A3EAF2C12447549945EBC3F9C6F14BC6FCA77E6A7D4BF3D1CE9A0CECBBE23
+ C4FBEFD5E4CB9EF6C03CB1B7A12269C882C40AC3ECCFAF8E51929AFA8A267F4C
+ F6042686FB0C96F687351028F2A4D6B73E7C7C36456AE8697CA6AB7EDF1DC391
+ 3D7DDC063886B54886340E620B039771D016686FD59CABE45C7188922DF4B8B5
+ EC7D7B0CBBC99877EC185331AEC5147195B8BEB53FFF29A5E2302375FFA25FCA
+ 97BF33750D893135206D7F26C616625FCAC7D0CFF113FB38E7E478A539D89ACD
+ 37D9790BE12433D3DD1EE11A630A0EF430D2DD449AF6B6355BFD6FABBF6DF5BF
+ ADFEB7D5FFB6FADFE67FEF53FD6F0AFE5AEA7F3C465D43CE558D91BA6671FE9D
+ B3BFA1F5BFCA66D857D5C8D6F63F63F886D4FF2A7BE331ECE3B9EFDBFEF34DE0
+ AFB5FE37445E0E3DD5C95F6BFD6F88C887FBB5F28DADFFF5156468E71B57FF1B
+ F47F7CC2B255BCB666ABFF6DF5B7ADFEB7D5FFB6FADF56FFDBFCEFFDA9FF5BEE
+ 0E4076F633F0F7BD0F7BBFA887E3C7EE82583C081D1D9366ADFFE766E72095DF
+ 0B9B3737008DD605DEDE83D49E8B9FEEEE5DB0654B239C0E6B035ED44993BFFF
+ 5F5C5482A7672B3838B44268A85CEBDE131E3E49E27F07D86DAF5E5AB7EEBA49
+ DFFF27270F80A3E37DBDF64017E77BCA4D9B9A4DF6FEBFF3E11835E7BAEE7BA5
+ 44444CC1E79F37CCAC5F7FCB24EFFF333307C9DEDA6D501E70F0E093854D9B1A
+ 4DF2FE3F20A093F231D49B9333078D8D0B3AA5B8789E3A8F4E97E11C98E4FDBF
+ 93D33D60B34728BD7D7D4BAB9E2B932D51E7A1AD3EFDB4DE24EFFFFDFC1E828F
+ CF334A2FDE5F4BCBA24E914A5FDD3F9339041B373698E4FD7F2ABFC760FB1F3E
+ DC47D640A349DEFFD7DFEC22395D23B5BEF5619F3D3B4D6251F3F4FAF5B5267B
+ FF1F12DC0A6E6EED7AF169EEEDCACD9B1B4DFAFE1F63EAF66D354B24BE29717D
+ EBBA6F77F747B0E9F39B8BEBD6D599FC1D3CC6D40D1BEA3231B61C39D247F918
+ FA397E621FE77CC386FA4A73B0351B896B5B3EFBAC2E998CE311AE31E2E73D1B
+ 36348834EDAD6AFF03880DBFF8
+ }
+ end
+end
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfmain.pas b/components/jvcllaz/examples/JvTimeFramework/tfmain.pas
new file mode 100644
index 000000000..18ff27e9f
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfmain.pas
@@ -0,0 +1,712 @@
+{******************************************************************
+
+ 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.
+
+******************************************************************}
+
+unit tfMain;
+
+interface
+
+uses
+ LCLIntf,
+ //Windows, Messages,
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ Db, sqldb, sqlite3conn, //DBTables,
+ ComCtrls, StdCtrls, Buttons, ExtCtrls, ImgList, DateTimePicker, JvTFManager,
+ JvTFDays, JvTFGlance, JvTFGlanceTextViewer, JvTFMonths, JvTFWeeks,
+ JvComponent, JvExControls;
+
+type
+
+ { TPhotoOpMain }
+
+ TPhotoOpMain = class(TForm)
+ ImageList: TImageList;
+ Label1: TLabel;
+ Label2: TLabel;
+ Panel2: TPanel;
+ utfScheduleManager1: TJvTFScheduleManager;
+ StateImageList: TImageList;
+ NeedApptsQuery: TSQLQuery;
+ ApptSchedulesQuery: TSQLQuery;
+ GetApptQuery: TSQLQuery;
+ DeleteApptLinkQuery: TSQLQuery;
+ DeleteApptQuery: TSQLQuery;
+ SchedulesQuery: TSQLQuery;
+ PageControl1: TPageControl;
+ TabSheet1: TTabSheet;
+ TabSheet2: TTabSheet;
+ TabSheet3: TTabSheet;
+ JvTFDays1: TJvTFDays;
+ JvTFWeeks1: TJvTFWeeks;
+ JvTFMonths1: TJvTFMonths;
+ GlanceTextViewer1: TJvTFGlanceTextViewer;
+ GlanceTextViewer2: TJvTFGlanceTextViewer;
+ Panel1: TPanel;
+ ResourceCombo: TComboBox;
+ PrevDateButton: TBitBtn;
+ NextDateButton: TBitBtn;
+ NewApptButton: TBitBtn;
+ EditApptButton: TBitBtn;
+ DeleteApptButton: TBitBtn;
+ ViewSchedsButton: TBitBtn;
+ HideSchedButton: TBitBtn;
+ ShareButton: TBitBtn;
+ TimeIncCombo: TComboBox;
+ GotoDatePicker: TDateTimePicker;
+ ModeCombo: TComboBox;
+ DaysCombo: TComboBox;
+ PrintButton: TBitBtn;
+ dbUTF: TSQLite3Connection;
+ SQLTransaction: TSQLTransaction;
+ procedure Label2Click(Sender: TObject);
+ procedure Label2MouseEnter(Sender: TObject);
+ procedure Label2MouseLeave(Sender: TObject);
+ procedure utfScheduleManager1PostAppt(Sender: TObject; Appt: TJvTFAppt);
+ procedure utfScheduleManager1DeleteAppt(Sender: TObject; Appt: TJvTFAppt);
+ procedure utfScheduleManager1RefreshAppt(Sender: TObject; Appt: TJvTFAppt);
+ procedure ModeComboChange(Sender: TObject);
+ procedure ViewSchedsButtonClick(Sender: TObject);
+ procedure HideSchedButtonClick(Sender: TObject);
+ procedure ResourceComboChange(Sender: TObject);
+ procedure DaysComboChange(Sender: TObject);
+ procedure ShareButtonClick(Sender: TObject);
+ procedure PrevDateButtonClick(Sender: TObject);
+ procedure NextDateButtonClick(Sender: TObject);
+ procedure GotoDatePickerChange(Sender: TObject);
+ procedure GotoDatePickerUserInput(Sender: TObject;
+ const UserString: String; var DateAndTime: TDateTime;
+ var AllowChange: Boolean);
+ procedure TimeIncComboChange(Sender: TObject);
+ procedure NewApptButtonClick(Sender: TObject);
+ procedure EditApptButtonClick(Sender: TObject);
+ procedure DeleteApptButtonClick(Sender: TObject);
+ procedure JvTFDays1DateChanging(Sender: TObject; var NewDate: TDate);
+ procedure JvTFDays1DateChanged(Sender: TObject);
+ procedure JvTFDays1GranularityChanged(Sender: TObject);
+ procedure JvTFDays1DblClick(Sender: TObject);
+ procedure JvTFDaysPrinter1ApptProgress(Sender: TObject; Current,
+ Total: Integer);
+ procedure JvTFDaysPrinter1AssembleProgress(Sender: TObject; Current,
+ Total: Integer);
+ procedure JvTFDaysPrinter1PrintProgress(Sender: TObject; Current,
+ Total: Integer);
+
+ procedure utfScheduleManager1LoadBatch(Sender: TObject; BatchName: String;
+ BatchStartDate, BatchEndDate: TDate);
+
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+
+ procedure PrintButtonClick(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ PhotoOpMain: TPhotoOpMain;
+
+implementation
+
+uses
+ tfVisibleResources, tfShare, tfApptEdit, tfPrintProgress;
+
+{$R *.lfm}
+
+procedure TPhotoOpMain.utfScheduleManager1PostAppt(Sender: TObject;
+ Appt: TJvTFAppt);
+var
+ I : Integer;
+begin
+ With GetApptQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ Open;
+
+ If RecordCount > 0 Then // SQL RecordCount not reliable except on local tables
+ Edit
+ Else
+ Begin
+ Insert;
+ FieldByName('ApptID').AsString := Appt.ID;
+ End;
+
+ FieldByName('StartDate').AsDateTime := Appt.StartDate;
+ FieldByName('StartTime').AsDateTime := Appt.StartTime;
+ FieldByName('EndDate').AsDateTime := Appt.EndDate;
+ FieldByName('EndTime').AsDateTime := Appt.EndTime;
+ FieldByName('Description').AsString := Appt.Description;
+ FieldByName('AlarmEnabled').AsBoolean := Appt.AlarmEnabled;
+ FieldByName('AlarmAdvance').AsInteger := Appt.AlarmAdvance;
+ Post;
+ Close;
+ End;
+
+ // Now update the Appt --> Schedule relationship
+ // First delete all entries in the Link table
+ With DeleteApptLinkQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ ExecSQL;
+ End;
+
+ // Now "refresh" the link table by adding a record for each of the names
+ // in Appt.Schedules. We will use the ApptSchedulesQuery to update the table.
+ With ApptSchedulesQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ Open;
+ For I := 0 to Appt.ScheduleCount - 1 do
+ Begin
+ Insert;
+ FieldByName('ApptID').AsString := Appt.ID;
+ FieldByName('SchedName').AsString := Appt.Schedules[I];
+ Post;
+ End;
+ Close;
+ End;
+end;
+
+procedure TPhotoOpMain.utfScheduleManager1DeleteAppt(Sender: TObject;
+ Appt: TJvTFAppt);
+begin
+ // First delete the appointment from the appointment table
+ With DeleteApptQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ ExecSQL;
+ End;
+
+ // Next, delete the related records from the link table
+ With DeleteApptLinkQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ ExecSQL;
+ End;
+end;
+
+procedure TPhotoOpMain.utfScheduleManager1RefreshAppt(Sender: TObject;
+ Appt: TJvTFAppt);
+begin
+ With GetApptQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ Open;
+ If RecordCount = 1 Then
+ Begin
+ Appt.SetStartEnd(FieldByName('StartDate').AsDateTime,
+ FieldByName('StartTime').AsDateTime,
+ FieldByName('EndDate').AsDateTime,
+ FieldByName('EndTime').AsDateTime);
+ Appt.Description := FieldByName('Description').AsString;
+ Appt.AlarmEnabled := FieldByName('AlarmEnabled').AsBoolean;
+ Appt.AlarmAdvance := FieldByName('AlarmAdvance').AsInteger;
+ End;
+ Close;
+ End;
+
+ // Now update the Appt --> Schedule(s) relationship
+ Appt.ClearSchedules;
+ With ApptSchedulesQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ Open;
+ First;
+ While not EOF do
+ Begin
+ Appt.AddSchedule(FieldByName('SchedName').AsString);
+ Next;
+ End;
+ Close; // ApptSchedulesQuery
+ End;
+end;
+
+procedure TPhotoOpMain.ModeComboChange(Sender: TObject);
+begin
+ If ModeCombo.ItemIndex = 0 Then
+ // Single mode
+ Begin
+ // display the appropriate tool bar controls
+ ViewSchedsButton.Visible := False;
+ HideSchedButton.Visible := False;
+ ShareButton.Visible := False;
+ ResourceCombo.Visible := True;
+ DaysCombo.Visible := True;
+ // synchronize the date
+ JvTFDays1.Template.LinearStartDate := GotoDatePicker.Date;
+ // "activate" the Linear template
+ JvTFDays1.Template.ActiveTemplate := agtLinear;
+ // set the column grouping
+ JvTFDays1.Grouping := grResource;
+ End
+ Else
+ // Group mode
+ Begin
+ // display the appropriate tool bar controls
+ ViewSchedsButton.Visible := True;
+ HideSchedButton.Visible := True;
+ ShareButton.Visible := True;
+ ResourceCombo.Visible := False;
+ DaysCombo.Visible := False;
+ // synchronize the date
+ JvTFDays1.Template.CompDate := GotoDatePicker.Date;
+ // "activate" the Comparative template
+ JvTFDays1.Template.ActiveTemplate := agtComparative;
+ // set the column grouping
+ JvTFDays1.Grouping := grDate;
+ End;
+end;
+
+procedure TPhotoOpMain.ViewSchedsButtonClick(Sender: TObject);
+begin
+ VisibleResources.ShowModal;
+end;
+
+procedure TPhotoOpMain.HideSchedButtonClick(Sender: TObject);
+var
+ I,
+ NameIndex : Integer;
+ NameList : TStringList;
+begin
+ NameList := TStringList.Create;
+
+ Try
+ With JvTFDays1 do
+ Begin
+ If ValidSelection Then
+ Begin
+ For I := SelStart.X to SelEnd.X do
+ NameList.Add(Cols[I].SchedName);
+
+ For I := 0 to NameList.Count - 1 do
+ Begin
+ NameIndex := Template.CompNames.IndexOf(NameList[I]);
+ If NameIndex > -1 Then
+ Template.CompNames.Delete(NameIndex);
+ End;
+ End
+ Else
+ MessageDlg('Please select a schedule to hide.', mtInformation, [mbOK], 0);
+ End;
+ Finally
+ NameList.Free;
+ End;
+end;
+
+procedure TPhotoOpMain.ResourceComboChange(Sender: TObject);
+begin
+ JvTFDays1.Template.LinearName := ResourceCombo.Text;
+ JvTFWeeks1.SchedNames.Clear;
+ JvTFWeeks1.SchedNames.Add(ResourceCombo.Text);
+ JvTFWeeks1.Refresh;
+ JvTFMonths1.SchedNames.Clear;
+ JvTFMonths1.SchedNames.Add(ResourceCombo.Text);
+ JvTFMonths1.Refresh;
+end;
+
+procedure TPhotoOpMain.DaysComboChange(Sender: TObject);
+begin
+ Case DaysCombo.ItemIndex of
+ 0 : JvTFDays1.Template.LinearDayCount := 31;
+ 1 : JvTFDays1.Template.LinearDayCount := 14;
+ 2 : JvTFDays1.Template.LinearDayCount := 7;
+ 3 : JvTFDays1.Template.LinearDayCount := 5;
+ 4 : JvTFDays1.Template.LinearDayCount := 3;
+ 5 : JvTFDays1.Template.LinearDayCount := 2;
+ 6 : JvTFDays1.Template.LinearDayCount := 1;
+ End;
+end;
+
+procedure TPhotoOpMain.ShareButtonClick(Sender: TObject);
+begin
+ If JvTFDays1.SelAppt <> nil Then
+ Share.ShowModal
+ Else
+ MessageDlg('Please select an appointment.', mtInformation, [mbOK], 0);
+end;
+
+procedure TPhotoOpMain.PrevDateButtonClick(Sender: TObject);
+begin
+ JvTFDays1.PrevDate;
+end;
+
+procedure TPhotoOpMain.NextDateButtonClick(Sender: TObject);
+begin
+ JvTFDays1.NextDate;
+end;
+
+procedure TPhotoOpMain.GotoDatePickerChange(Sender: TObject);
+begin
+ // GotoDatePicker.OnCloseUp should also point to this handler
+ JvTFDays1.GotoDate(GotoDatePicker.Date);
+ JvTFWeeks1.DisplayDate := GotoDatePicker.Date;
+ JvTFWeeks1.DisplayDate := GotoDatePicker.Date;
+end;
+
+procedure TPhotoOpMain.GotoDatePickerUserInput(Sender: TObject;
+ const UserString: String; var DateAndTime: TDateTime;
+ var AllowChange: Boolean);
+begin
+ AllowChange := True;
+ GotoDatePicker.OnChange(nil);
+end;
+
+procedure TPhotoOpMain.TimeIncComboChange(Sender: TObject);
+begin
+ Case TimeIncCombo.ItemIndex of
+ 0 : JvTFDays1.Granularity := 60;
+ 1 : JvTFDays1.Granularity := 30;
+ 2 : JvTFDays1.Granularity := 20;
+ 3 : JvTFDays1.Granularity := 15;
+ 4 : JvTFDays1.Granularity := 12;
+ 5 : JvTFDays1.Granularity := 10;
+ 6 : JvTFDays1.Granularity := 6;
+ 7 : JvTFDays1.Granularity := 5;
+ 8 : JvTFDays1.Granularity := 4;
+ 9 : JvTFDays1.Granularity := 3;
+ 10 : JvTFDays1.Granularity := 2;
+ 11 : JvTFDays1.Granularity := 1;
+ End;
+end;
+
+procedure TPhotoOpMain.NewApptButtonClick(Sender: TObject);
+begin
+ // Simply open the EditAppt window. The Appt var of the
+ // EditAppt form will already be nil (which indicates
+ // that the appoinment is being created).
+ ApptEdit.ShowModal;
+end;
+
+procedure TPhotoOpMain.EditApptButtonClick(Sender: TObject);
+begin
+ If Assigned(JvTFDays1.SelAppt) Then
+ Begin
+ // Set EditAppt's Appt var to the selected appointment to
+ // indicate that the appointment should be edited.
+ ApptEdit.Appt := JvTFDays1.SelAppt;
+ ApptEdit.ShowModal;
+ End
+ Else
+ MessageDlg('Please select an appointment to edit.', mtInformation,
+ [mbOK], 0);
+end;
+
+procedure TPhotoOpMain.DeleteApptButtonClick(Sender: TObject);
+var
+ Appt : TJvTFAppt;
+ dbDel : Boolean;
+ SelSchedName : String;
+begin
+ // This routine employs a simple business that asks the user what to
+ // do in the case where the user is attempting to delete a shared appt.
+ // NOTE: This is NOT required. You are completely free to implement
+ // any business rules you see fit.
+
+ // Another shortcut to save typing
+ Appt := JvTFDays1.SelAppt;
+
+ If Assigned(Appt) Then
+ Begin
+ dbDel := True;
+ If Appt.Shared Then
+ If MessageDlg('This appointment is shared with other schedules.' + #13#10 +
+ 'Do you want to delete the appointment from ' +
+ 'all schedules?' + #13#10#13#10 +
+ 'Choose ''No'' to delete the appointment from the ' +
+ 'selected schedule only.' + #13#10 +
+ 'Choose ''All'' to delete the appointment from all schedules.',
+ mtConfirmation, [mbNo, mbAll], 0) = mrNo Then
+ Begin
+ // Don't delete the appointment, but remove it from the schedule
+ // of the selected resource.
+ dbDel := False;
+
+ With JvTFDays1 do
+ Begin
+ SelSchedName := '';
+ If ValidSelection and Cols[SelStart.X].Connected Then
+ SelSchedName := Cols[SelStart.X].Schedule.SchedName;
+ End;
+
+ If SelSchedName <> '' Then
+ Appt.RemoveSchedule(SelSchedName)
+ Else
+ MessageDlg('No schedule is selected.' + #13#10 +
+ 'Could not remove appointment from schedule.',
+ mtInformation, [mbOK], 0);
+ End;
+
+ If dbDel Then
+ If MessageDlg('Are you sure you want to delete the selected appointment?',
+ mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
+ // Delete the appointment (removes it from the db)
+ // Note: Could substitute Appt.Delete; for the line below
+ JvTFDays1.ScheduleManager.dbDeleteAppt(JvTFDays1.SelAppt);
+ End
+ Else
+ MessageDlg('Please select an appointment to delete.',
+ mtInformation, [mbOK], 0);
+end;
+
+procedure TPhotoOpMain.JvTFDays1DateChanging(Sender: TObject;
+ var NewDate: TDate);
+begin
+ // Make sure all appts are posted before moving on.
+ JvTFDays1.ScheduleManager.PostAppts;
+end;
+
+procedure TPhotoOpMain.JvTFDays1DateChanged(Sender: TObject);
+begin
+ // Synchronize the tool bar
+ With JvTFDays1.Template do
+ If ActiveTemplate = agtLinear Then
+ GotoDatePicker.Date := LinearStartDate
+ Else
+ GotoDatePicker.Date := CompDate;
+end;
+
+procedure TPhotoOpMain.JvTFDays1GranularityChanged(Sender: TObject);
+begin
+ // Update the TimeIncCombo when the granularity is changed.
+ // (This can be done by + and + )
+ Case JvTFDays1.Granularity of
+ 60 : TimeIncCombo.ItemIndex := 0;
+ 30 : TimeIncCombo.ItemIndex := 1;
+ 20 : TimeIncCombo.ItemIndex := 2;
+ 15 : TimeIncCombo.ItemIndex := 3;
+ 12 : TimeIncCombo.ItemIndex := 4;
+ 10 : TimeIncCombo.ItemIndex := 5;
+ 6 : TimeIncCombo.ItemIndex := 6;
+ 5 : TimeIncCombo.ItemIndex := 7;
+ 4 : TimeIncCombo.ItemIndex := 8;
+ 3 : TimeIncCombo.ItemIndex := 9;
+ 2 : TimeIncCombo.ItemIndex := 10;
+ Else
+ TimeIncCombo.ItemIndex := 11;
+ End;
+end;
+
+procedure TPhotoOpMain.JvTFDays1DblClick(Sender: TObject);
+begin
+ With JvTFDays1 do
+ If ValidSelection Then
+ If Assigned(SelAppt) Then
+ EditApptButtonClick(nil)
+ Else
+ NewApptButtonClick(nil);
+end;
+
+procedure TPhotoOpMain.FormShow(Sender: TObject);
+var
+ ResName : String;
+begin
+ // Initialize the date
+ //GotoDatePicker.Date := Date;
+ GotoDatePicker.Date := EncodeDate(2002, 1, 1);
+
+ // Initialize the granularity
+ TimeIncCombo.ItemIndex := 1; // 30 mins
+
+ // Initialize the mode
+ ModeCombo.ItemIndex := 0; // Single mode
+ DaysCombo.ItemIndex := 6; // One day
+
+ // Populate the resource related controls
+ With SchedulesQuery do
+ try
+ Open;
+ First;
+ While not EOF do
+ Begin
+ ResName := SchedulesQuery.FieldByName('SchedName').AsString;
+ ResourceCombo.Items.Add(ResName);
+ VisibleResources.ResourcesCheckList.Items.Add(ResName);
+ Share.ResourcesCheckList.Items.Add(ResName);
+ Next;
+ End;
+ Close;
+ except
+ //on E:EDBEngineError do
+ on E: EDatabaseError do
+ begin
+ ShowMessageFmt('%s:'#13#10'Try moving the database to a shorter path.',[E.Message]);
+ Application.Terminate;
+ Exit;
+ end;
+ end;
+
+ // Initialize the resource related controls
+ ResourceCombo.ItemIndex := 0;
+ VisibleResources.ResourcesCheckList.Checked[0] := True;
+
+ // Initialize the comparative template
+ JvTFDays1.Template.CompNames.Add(VisibleResources.ResourcesCheckList.Items[0]);
+
+ // Now run the events to synchronize JvTFDays, etc.
+ ResourceComboChange(nil);
+ DaysComboChange(nil);
+ ModeComboChange(nil);
+ GotoDatePicker.Date := EncodeDate(2002, 1, 1);
+ GotoDatePickerChange(nil);
+ TimeIncComboChange(nil);
+end;
+
+procedure TPhotoOpMain.PrintButtonClick(Sender: TObject);
+begin
+ (******************** wp: deactivated due to stack overflow ************
+ With JvTFDaysPrinter1 do
+ Begin
+ // "Copy" the display properties from the JvTFDays control
+ SetProperties(JvTFDays1);
+ // Set gridline color to black for sharp display on printed page
+ GridLineColor := clBlack;
+ // print 48 rows on each page
+ PageLayout.RowsPerPage := 48;
+ // fit all the columns onto one page wide
+ PageLayout.ColsPerPage := 0;
+ // "Copy" the schedules from the JvTFDays control
+ Cols.Assign(JvTFDays1.Cols);
+ PrintProgress.Show;
+ Application.ProcessMessages;
+ // print the document
+ PrintDirect;
+ PrintProgress.Close;
+ End;
+ ************************)
+end;
+
+procedure TPhotoOpMain.JvTFDaysPrinter1ApptProgress(Sender: TObject;
+ Current, Total: Integer);
+begin
+ If Current > Total Then
+ Total := Current;
+ PrintProgress.Label2.Caption := 'Processing appointment ' + IntToStr(Current) +
+ ' of ' + IntToStr(Total) + ' (estimated)';
+ PrintProgress.ProgressBar1.Max := Total;
+ PrintProgress.ProgressBar1.Position := Current;
+end;
+
+procedure TPhotoOpMain.JvTFDaysPrinter1AssembleProgress(Sender: TObject;
+ Current, Total: Integer);
+begin
+ PrintProgress.Label2.Caption := 'Assembling page ' + IntToStr(Current) +
+ ' of ' + IntToStr(Total);
+ PrintProgress.ProgressBar1.Max := Total;
+ PrintProgress.ProgressBar1.Position := Current;
+end;
+
+procedure TPhotoOpMain.JvTFDaysPrinter1PrintProgress(Sender: TObject;
+ Current, Total: Integer);
+begin
+ PrintProgress.Label2.Caption := 'Printing page ' + IntToStr(Current) +
+ ' of ' + IntToStr(Total);
+ PrintProgress.ProgressBar1.Max := Total;
+ PrintProgress.ProgressBar1.Position := Current;
+end;
+
+procedure TPhotoOpMain.Label2Click(Sender: TObject);
+begin
+ OpenURL('https://icons8.com');
+end;
+
+procedure TPhotoOpMain.Label2MouseEnter(Sender: TObject);
+begin
+ Label2.Font.Style := Label2.Font.Style + [fsUnderline];
+ Screen.Cursor := crHandPoint;
+end;
+
+procedure TPhotoOpMain.Label2MouseLeave(Sender: TObject);
+begin
+ Label2.Font.Style := Label2.Font.Style - [fsUnderline];
+ Screen.Cursor := crDefault;
+end;
+
+procedure TPhotoOpMain.utfScheduleManager1LoadBatch(Sender: TObject;
+ BatchName: String; BatchStartDate, BatchEndDate: TDate);
+var
+ Appt : TJvTFAppt;
+ NewAppt : Boolean;
+begin
+ With NeedApptsQuery do
+ Begin
+ // Set the query parameters so the query will return
+ // all appointments for the given resource that fall
+ // on the given date.
+ ParamByName('D1').AsDate := BatchStartDate;
+ ParamByName('D2').AsDate := BatchEndDate;
+ ParamByName('SchedName').AsString := BatchName;
+
+ // Next, loop through the returned records to add the data
+ Open;
+ First;
+ While not EOF do
+ Begin
+ // Request an appointment object from the server
+ utfScheduleManager1.RequestAppt(FieldByName('ApptID').AsString,
+ Appt, NewAppt);
+
+ // If it is a newly loaded appt we want to set its properties
+ If NewAppt Then
+ Begin
+ Appt.SetStartEnd(FieldByName('StartDate').AsDateTime,
+ FieldByName('StartTime').AsDateTime,
+ FieldByName('EndDate').AsDateTime,
+ FieldByName('EndTime').AsDateTime);
+ Appt.Description := FieldByName('Description').AsString;
+ Appt.AlarmEnabled := FieldByName('AlarmEnabled').AsBoolean;
+ Appt.AlarmAdvance := FieldByName('AlarmAdvance').AsInteger;
+
+ // Now manage the Appt --> Schedule(s) relationship
+ With ApptSchedulesQuery do
+ Begin
+ ParamByName('ApptID').AsString := Appt.ID;
+ Open;
+ First;
+ While not EOF do
+ Begin
+ Appt.AddSchedule(FieldByName('SchedName').AsString);
+ Next;
+ End;
+ Close; // ApptSchedulesQuery
+ End;
+ End;
+ Next; // NeedApptsQuery record
+ End;
+ Close; // NeedApptsQuery
+ End;
+end;
+
+procedure TPhotoOpMain.FormCreate(Sender: TObject);
+var
+ fn: String;
+begin
+ fn := Application.Location + 'data.sqlite';
+ dbUTF.DatabaseName := fn;
+ dbUTF.Connected := FileExists(fn);
+end;
+
+end.
+
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfprintprogress.lfm b/components/jvcllaz/examples/JvTimeFramework/tfprintprogress.lfm
new file mode 100644
index 000000000..b98621532
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfprintprogress.lfm
@@ -0,0 +1,78 @@
+object PrintProgress: TPrintProgress
+ Left = 613
+ Height = 161
+ Top = 250
+ Width = 367
+ BorderIcons = []
+ BorderStyle = bsSingle
+ Caption = 'Print Progress'
+ ClientHeight = 161
+ ClientWidth = 367
+ Color = clBtnFace
+ Font.Color = clWindowText
+ FormStyle = fsStayOnTop
+ OnShow = FormShow
+ Position = poScreenCenter
+ LCLVersion = '2.1.0.0'
+ Scaled = False
+ object Label1: TLabel
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 16
+ Height = 33
+ Top = 16
+ Width = 335
+ Anchors = [akTop, akLeft, akRight]
+ AutoSize = False
+ BorderSpacing.Left = 16
+ BorderSpacing.Top = 16
+ BorderSpacing.Right = 16
+ Caption = 'Generating Report. This may take a while. Please be patient.'
+ ParentColor = False
+ WordWrap = True
+ end
+ object Label2: TLabel
+ AnchorSideLeft.Control = Label1
+ AnchorSideTop.Control = Label1
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Label1
+ AnchorSideRight.Side = asrBottom
+ Left = 16
+ Height = 16
+ Top = 49
+ Width = 335
+ Alignment = taCenter
+ Anchors = [akTop, akLeft, akRight]
+ AutoSize = False
+ Caption = 'Processing...'
+ ParentColor = False
+ end
+ object ProgressBar1: TProgressBar
+ AnchorSideLeft.Control = Label1
+ AnchorSideTop.Side = asrBottom
+ AnchorSideRight.Control = Label1
+ AnchorSideRight.Side = asrBottom
+ Left = 16
+ Height = 20
+ Top = 80
+ Width = 335
+ Anchors = [akTop, akLeft, akRight]
+ Max = 200
+ TabOrder = 0
+ end
+ object CancelButton: TBitBtn
+ AnchorSideLeft.Control = Owner
+ AnchorSideLeft.Side = asrCenter
+ Left = 142
+ Height = 26
+ Top = 120
+ Width = 82
+ AutoSize = True
+ Caption = 'Cancel'
+ Kind = bkCancel
+ OnClick = CancelButtonClick
+ TabOrder = 1
+ end
+end
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfprintprogress.pas b/components/jvcllaz/examples/JvTimeFramework/tfprintprogress.pas
new file mode 100644
index 000000000..6803d16f4
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfprintprogress.pas
@@ -0,0 +1,69 @@
+{******************************************************************
+
+ 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.
+
+******************************************************************}
+
+unit tfPrintProgress;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, Buttons, ComCtrls;
+
+type
+ TPrintProgress = class(TForm)
+ Label1: TLabel;
+ Label2: TLabel;
+ ProgressBar1: TProgressBar;
+ CancelButton: TBitBtn;
+ procedure CancelButtonClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ PrintProgress: TPrintProgress;
+
+implementation
+
+uses tfMain;
+
+{$R *.lfm}
+
+procedure TPrintProgress.CancelButtonClick(Sender: TObject);
+begin
+// PhotoOpMain.JvTFDaysPrinter1.AbortPrint;
+end;
+
+procedure TPrintProgress.FormShow(Sender: TObject);
+begin
+ ProgressBar1.Position := 0;
+ Label2.Caption := 'Processing...';
+end;
+
+end.
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfshare.lfm b/components/jvcllaz/examples/JvTimeFramework/tfshare.lfm
new file mode 100644
index 000000000..9f6f8be31
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfshare.lfm
@@ -0,0 +1,44 @@
+object Share: TShare
+ Left = 738
+ Top = 285
+ Width = 271
+ Height = 216
+ Caption = 'Share'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'MS Sans Serif'
+ Font.Style = []
+ OldCreateOrder = True
+ Position = poScreenCenter
+ Scaled = False
+ OnClose = FormClose
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 16
+ object ResourcesCheckList: TCheckListBox
+ Left = 16
+ Top = 8
+ Width = 225
+ Height = 129
+ ItemHeight = 16
+ TabOrder = 0
+ end
+ object OKButton: TBitBtn
+ Left = 40
+ Top = 152
+ Width = 75
+ Height = 25
+ TabOrder = 1
+ Kind = bkOK
+ end
+ object CancelButton: TBitBtn
+ Left = 152
+ Top = 152
+ Width = 75
+ Height = 25
+ TabOrder = 2
+ Kind = bkCancel
+ end
+end
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfshare.pas b/components/jvcllaz/examples/JvTimeFramework/tfshare.pas
new file mode 100644
index 000000000..948187212
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfshare.pas
@@ -0,0 +1,114 @@
+{******************************************************************
+
+ 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.
+
+******************************************************************}
+
+unit tfShare;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, Buttons, checklst;
+
+type
+ TShare = class(TForm)
+ ResourcesCheckList: TCheckListBox;
+ OKButton: TBitBtn;
+ CancelButton: TBitBtn;
+ procedure FormShow(Sender: TObject);
+ procedure FormClose(Sender: TObject; var TheAction: TCloseAction);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Share: TShare;
+
+implementation
+
+uses
+ tfMain, JvTFManager;
+
+{$R *.lfm}
+
+procedure TShare.FormShow(Sender: TObject);
+var
+ Appt : TJvTFAppt;
+ I : Integer;
+begin
+ // First, get the selected appointment
+ Appt := PhotoOpMain.JvTFDays1.SelAppt;
+
+ // now roll through the resource list and check all resources
+ // that are found in the appointment's list of schedules.
+ With ResourcesCheckList do
+ For I := 0 to Items.Count - 1 do
+ Checked[I] := Appt.IndexOfSchedule(Items[I]) > -1;
+end;
+
+procedure TShare.FormClose(Sender: TObject; var TheAction: TCloseAction);
+var
+ TempList : TStringList;
+ I : Integer;
+begin
+ If ModalResult = mrOK Then
+ Begin
+ // create and populate a temporary list of the selected resources
+ // from the checklistbox.
+ TempList := TStringList.Create;
+ Try
+ With ResourcesCheckList do
+ For I := 0 to Items.Count - 1 do
+ If Checked[I] Then
+ TempList.Add(Items[I]);
+
+ // Enforce a business rule where removing all resources from an
+ // appointment causes the appointment to be deleted.
+ // NOTE: This is NOT a requirement. Feel free to implement any
+ // business rules as you see fit.
+ If TempList.Count > 0 Then
+ // If at least one resource then change the appointment's
+ // schedule list to match the temp list.
+ PhotoOpMain.JvTFDays1.SelAppt.AssignSchedules(TempList)
+ Else
+ If MessageDlg('You have removed this appointment from all schedules.' +
+ ' This will cause the appointment to be deleted.' + #13#10 +
+ 'Are you sure this is what you want to do?',
+ mtConfirmation, [mbYes, mbNo], 0) = mrYes Then
+ With PhotoOpMain.JvTFDays1 do
+ // Delete the appointment if that is what the user wants to do.
+ ScheduleManager.dbDeleteAppt(SelAppt)
+ Else
+ TheAction := caNone;
+
+ Finally
+ TempList.Free;
+ End;
+ End;
+end;
+
+end.
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfvisibleresources.lfm b/components/jvcllaz/examples/JvTimeFramework/tfvisibleresources.lfm
new file mode 100644
index 000000000..d628ce7ae
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfvisibleresources.lfm
@@ -0,0 +1,53 @@
+object VisibleResources: TVisibleResources
+ Left = 707
+ Height = 205
+ Top = 215
+ Width = 271
+ Caption = 'Visible Resources'
+ ClientHeight = 205
+ ClientWidth = 271
+ Font.Color = clWindowText
+ OnClose = FormClose
+ OnShow = FormShow
+ Position = poScreenCenter
+ LCLVersion = '2.1.0.0'
+ Scaled = False
+ object ResourcesCheckList: TCheckListBox
+ AnchorSideLeft.Control = Owner
+ AnchorSideTop.Control = Owner
+ AnchorSideRight.Control = Owner
+ AnchorSideRight.Side = asrBottom
+ Left = 16
+ Height = 129
+ Top = 16
+ Width = 239
+ Anchors = [akTop, akLeft, akRight]
+ BorderSpacing.Left = 16
+ BorderSpacing.Top = 16
+ BorderSpacing.Right = 16
+ ItemHeight = 0
+ TabOrder = 0
+ end
+ object OKButton: TBitBtn
+ AnchorSideLeft.Control = ResourcesCheckList
+ Left = 40
+ Height = 25
+ Top = 160
+ Width = 75
+ BorderSpacing.Left = 24
+ Kind = bkOK
+ TabOrder = 1
+ end
+ object CancelButton: TBitBtn
+ AnchorSideRight.Control = ResourcesCheckList
+ AnchorSideRight.Side = asrBottom
+ Left = 156
+ Height = 25
+ Top = 160
+ Width = 75
+ Anchors = [akTop, akRight]
+ BorderSpacing.Right = 24
+ Kind = bkCancel
+ TabOrder = 2
+ end
+end
diff --git a/components/jvcllaz/examples/JvTimeFramework/tfvisibleresources.pas b/components/jvcllaz/examples/JvTimeFramework/tfvisibleresources.pas
new file mode 100644
index 000000000..3f86966ca
--- /dev/null
+++ b/components/jvcllaz/examples/JvTimeFramework/tfvisibleresources.pas
@@ -0,0 +1,94 @@
+{******************************************************************
+
+ 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.
+
+******************************************************************}
+
+unit tfVisibleResources;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, Buttons, checklst;
+
+type
+ TVisibleResources = class(TForm)
+ ResourcesCheckList: TCheckListBox;
+ OKButton: TBitBtn;
+ CancelButton: TBitBtn;
+ procedure FormShow(Sender: TObject);
+ procedure FormClose(Sender: TObject; var TheAction: TCloseAction);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ VisibleResources: TVisibleResources;
+
+implementation
+
+Uses tfMain;
+
+{$R *.lfm}
+
+procedure TVisibleResources.FormShow(Sender: TObject);
+var
+ I : Integer;
+begin
+ // Check the template and check any resources currently
+ // visible in the grid
+ With PhotoOpMain.JvTFDays1.Template do
+ For I := 0 to ResourcesCheckList.Items.Count - 1 do
+ ResourcesCheckList.Checked[I] :=
+ CompNames.IndexOf(ResourcesCheckList.Items[I]) > -1;
+end;
+
+procedure TVisibleResources.FormClose(Sender: TObject;
+ var TheAction: TCloseAction);
+var
+ I : Integer;
+begin
+ If ModalResult = mrOK Then
+ begin
+ // First, clear the old resources from the template
+ PhotoOpMain.JvTFDays1.Template.CompNames.Clear;
+ PhotoOpMain.JvTFWeeks1.SchedNames.Clear;
+ PhotoOpMain.JvTFMonths1.SchedNames.Clear;
+
+ // Next, add the new resources to the template
+ For I := 0 to ResourcesCheckList.Items.Count - 1 do
+ If ResourcesCheckList.Checked[I] Then
+ begin
+ PhotoOpMain.JvTFDays1.Template.CompNames.Add(ResourcesCheckList.Items[I]);
+ PhotoOpMain.JvTFWeeks1.SchedNames.Add(ResourcesCheckList.Items[I]);
+ PhotoOpMain.JvTFMonths1.SchedNames.Add(ResourcesCheckList.Items[I]);
+ end;
+ end;
+end;
+
+end.
diff --git a/components/jvcllaz/packages/jvcl_all.lpk b/components/jvcllaz/packages/jvcl_all.lpk
index e22ab069a..25eb382e8 100644
--- a/components/jvcllaz/packages/jvcl_all.lpk
+++ b/components/jvcllaz/packages/jvcl_all.lpk
@@ -11,55 +11,60 @@
-
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
+
+
+
diff --git a/components/jvcllaz/packages/jvcllaz_all.lpg b/components/jvcllaz/packages/jvcllaz_all.lpg
index af59c9061..38089f022 100644
--- a/components/jvcllaz/packages/jvcllaz_all.lpg
+++ b/components/jvcllaz/packages/jvcllaz_all.lpg
@@ -1,7 +1,7 @@
-
+
@@ -34,6 +34,8 @@
+
+
diff --git a/components/jvcllaz/packages/jvtimeframeworklazd.lpk b/components/jvcllaz/packages/jvtimeframeworklazd.lpk
new file mode 100644
index 000000000..efcafcbf4
--- /dev/null
+++ b/components/jvcllaz/packages/jvtimeframeworklazd.lpk
@@ -0,0 +1,46 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/packages/jvtimeframeworklazr.lpk b/components/jvcllaz/packages/jvtimeframeworklazr.lpk
new file mode 100644
index 000000000..ea823fd41
--- /dev/null
+++ b/components/jvcllaz/packages/jvtimeframeworklazr.lpk
@@ -0,0 +1,73 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/resource/jvtimeframeworkreg.res b/components/jvcllaz/resource/jvtimeframeworkreg.res
new file mode 100644
index 000000000..85a96ecfd
Binary files /dev/null and b/components/jvcllaz/resource/jvtimeframeworkreg.res differ
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfalarm.pas b/components/jvcllaz/run/JvTimeFramework/jvtfalarm.pas
new file mode 100644
index 000000000..7fb65c006
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfalarm.pas
@@ -0,0 +1,342 @@
+{-----------------------------------------------------------------------------
+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: JvTFAlarm.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFAlarm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, Controls, ExtCtrls,
+ JvTFManager;
+
+type
+ TJvTFAlarm = class;
+
+ TJvTFAlarmInfo = class(TObject)
+ private
+ FAppt: TJvTFAppt;
+ FSnoozeMins: Integer;
+ FDismiss: Boolean;
+ FNextAlarmTime: TTime;
+ protected
+ property NextAlarmTime: TTime read FNextAlarmTime write FNextAlarmTime;
+ public
+ constructor Create(AAppt: TJvTFAppt); virtual;
+ property Appt: TJvTFAppt read FAppt;
+ property SnoozeMins: Integer read FSnoozeMins write FSnoozeMins;
+ property Dismiss: Boolean read FDismiss write FDismiss;
+ end;
+
+ TJvTFAlarmList = class(TStringList)
+ private
+ FOwner: TJvTFAlarm;
+ public
+ procedure Clear; override;
+ function GetAlarmForAppt(AAppt: TJvTFAppt): TJvTFAlarmInfo;
+ function GetAlarmForApptID(const ID: string): TJvTFAlarmInfo;
+ function IndexOfAppt(AAppt: TJvTFAppt): Integer;
+ procedure AddAppt(AAppt: TJvTFAppt);
+ procedure DeleteAppt(AAppt: TJvTFAppt);
+ property Owner: TJvTFAlarm read FOwner write FOwner;
+ end;
+
+ TJvTFAlarmEvent = procedure(Sender: TObject; AAppt: TJvTFAppt;
+ var SnoozeMins: Integer; var Dismiss: Boolean) of object;
+
+ {$IFDEF RTL230_UP}
+ [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+ {$ENDIF RTL230_UP}
+ TJvTFAlarm = class(TJvTFComponent)
+ private
+ FResources: TStringList;
+ FTimer: TTimer;
+ FCurrentDate: TDate;
+ FAlarmList: TJvTFAlarmList;
+ FOnAlarm: TJvTFAlarmEvent;
+ FDefaultSnoozeMins: Integer;
+ function GetResources: TStrings;
+ procedure SetResources(Value: TStrings);
+ function GetTimerInterval: Integer;
+ procedure SetTimerInterval(Value: Integer);
+ function GetEnabled: Boolean;
+ procedure SetEnabled(Value: Boolean);
+ procedure InternalTimer(Sender: TObject);
+ protected
+ procedure DestroyApptNotification(AAppt: TJvTFAppt); override;
+ procedure ConnectSchedules; virtual;
+ procedure DisconnectSchedules; virtual;
+ procedure TimerCheck; virtual;
+ procedure AlarmCheck; virtual;
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Resources: TStrings read GetResources write SetResources;
+ property TimerInterval: Integer read GetTimerInterval write SetTimerInterval default 30000;
+ property Enabled: Boolean read GetEnabled write SetEnabled default True;
+ property DefaultSnoozeMins: Integer read FDefaultSnoozeMins write FDefaultSnoozeMins default 5;
+ property OnAlarm: TJvTFAlarmEvent read FOnAlarm write FOnAlarm;
+ end;
+
+
+implementation
+
+uses
+ JvTFUtils;
+
+//=== { TJvTFAlarm } =========================================================
+
+constructor TJvTFAlarm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FDefaultSnoozeMins := 5;
+ FCurrentDate := Date;
+ FResources := TStringList.Create;
+ FTimer := TTimer.Create(Self);
+ FTimer.Interval := 30000;
+ FTimer.Enabled := True;
+ FTimer.OnTimer := @InternalTimer;
+ FAlarmList := TJvTFAlarmList.Create;
+ FAlarmList.Owner := Self;
+end;
+
+destructor TJvTFAlarm.Destroy;
+begin
+ DisconnectSchedules;
+ FTimer.Free;
+ FResources.Free;
+ FAlarmList.Create;
+ FAlarmList.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFAlarm.Loaded;
+begin
+ inherited Loaded;
+ ConnectSchedules;
+end;
+
+procedure TJvTFAlarm.AlarmCheck;
+var
+ I, J, SnoozeMins: Integer;
+ Dismiss: Boolean;
+ Sched: TJvTFSched;
+ Appt: TJvTFAppt;
+ AlarmInfo: TJvTFAlarmInfo;
+ AlarmTime: TTime;
+begin
+ // 1. Roll through all schedules and add an alarm for each appt with a start
+ // time that is less than the current time. (Duplicate appts will be ignored.)
+ // 2. Roll through the alarm list and fire an OnAlarm event when appropriate.
+
+ // 1.
+ for I := 0 to ScheduleCount - 1 do
+ begin
+ Sched := Schedules[I];
+ for J := 0 to Sched.ApptCount - 1 do
+ begin
+ Appt := Sched.Appts[J];
+ AlarmTime := Appt.StartTime - Appt.AlarmAdvance * ONE_MINUTE;
+ if (AlarmTime < Frac(Time)) and Appt.AlarmEnabled then
+ FAlarmList.AddAppt(Appt);
+ end;
+ end;
+
+ // 2.
+ for I := 0 to FAlarmList.Count - 1 do
+ begin
+ AlarmInfo := TJvTFAlarmInfo(FAlarmList.Objects[I]);
+ if not AlarmInfo.Dismiss and (AlarmInfo.NextAlarmTime < Frac(Time)) then
+ begin
+ SnoozeMins := AlarmInfo.SnoozeMins;
+ Dismiss := False;
+ if Assigned(FOnAlarm) then
+ begin
+ FOnAlarm(Self, AlarmInfo.Appt, SnoozeMins, Dismiss);
+ AlarmInfo.SnoozeMins := SnoozeMins;
+ AlarmInfo.Dismiss := Dismiss;
+ end;
+ AlarmInfo.NextAlarmTime := Time + SnoozeMins * ONE_MINUTE;
+ end;
+ end;
+end;
+
+procedure TJvTFAlarm.ConnectSchedules;
+var
+ I: Integer;
+ CurrentSchedules: TStringList;
+ Schedule: TJvTFSched;
+begin
+ CurrentSchedules := TStringList.Create;
+ try
+ FTimer.Enabled := False;
+ // request all appropriate schedules. Store in temporary list so that
+ // we can release all schedules no longer needed.
+ for I := 0 to Resources.Count - 1 do
+ begin
+ Schedule := RetrieveSchedule(Resources[I], Date);
+ CurrentSchedules.AddObject('', Schedule);
+ end;
+
+ // Now release all schedules no longer needed. (Cross check CurrentSchedules
+ // against Schedules list.)
+ for I := 0 to ScheduleCount - 1 do
+ begin
+ Schedule := Schedules[I];
+ if CurrentSchedules.IndexOfObject(Schedule) = -1 then
+ ReleaseSchedule(Schedule.SchedName, Schedule.SchedDate);
+ end;
+ finally
+ CurrentSchedules.Free;
+ FTimer.Enabled := True;
+ end;
+end;
+
+procedure TJvTFAlarm.DestroyApptNotification(AAppt: TJvTFAppt);
+begin
+ FAlarmList.DeleteAppt(AAppt);
+ inherited DestroyApptNotification(AAppt);
+end;
+
+procedure TJvTFAlarm.DisconnectSchedules;
+begin
+ ReleaseSchedules;
+end;
+
+function TJvTFAlarm.GetEnabled: Boolean;
+begin
+ Result := FTimer.Enabled;
+end;
+
+function TJvTFAlarm.GetTimerInterval: Integer;
+begin
+ Result := FTimer.Interval;
+end;
+
+function TJvTFAlarm.GetResources: TStrings;
+begin
+ Result := FResources;
+end;
+
+procedure TJvTFAlarm.InternalTimer(Sender: TObject);
+begin
+ if Trunc(Date) <> Trunc(FCurrentDate) then
+ begin
+ FCurrentDate := Date;
+ ConnectSchedules;
+ end;
+ TimerCheck;
+end;
+
+procedure TJvTFAlarm.SetEnabled(Value: Boolean);
+begin
+ FTimer.Enabled := Value;
+end;
+
+procedure TJvTFAlarm.SetResources(Value: TStrings);
+begin
+ FResources.Assign(Value);
+ ConnectSchedules;
+end;
+
+procedure TJvTFAlarm.SetTimerInterval(Value: Integer);
+begin
+ FTimer.Interval := Value;
+end;
+
+procedure TJvTFAlarm.TimerCheck;
+begin
+ AlarmCheck;
+end;
+
+//=== { TJvTFAlarmInfo } =====================================================
+
+constructor TJvTFAlarmInfo.Create(AAppt: TJvTFAppt);
+begin
+ inherited Create;
+ FAppt := AAppt;
+end;
+
+//=== { TJvTFAlarmList } =====================================================
+
+procedure TJvTFAlarmList.AddAppt(AAppt: TJvTFAppt);
+var
+ AlarmInfo: TJvTFAlarmInfo;
+begin
+ if Assigned(AAppt) and (IndexOfAppt(AAppt) = -1) then
+ begin
+ AlarmInfo := TJvTFAlarmInfo.Create(AAppt);
+ AlarmInfo.SnoozeMins := Owner.DefaultSnoozeMins;
+ AlarmInfo.NextAlarmTime := AAppt.StartTime - AAppt.AlarmAdvance * ONE_MINUTE;
+ AddObject(AAppt.ID, AlarmInfo);
+ end;
+end;
+
+procedure TJvTFAlarmList.Clear;
+var
+ I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ Objects[I].Free;
+ inherited Clear;
+end;
+
+procedure TJvTFAlarmList.DeleteAppt(AAppt: TJvTFAppt);
+var
+ I: Integer;
+begin
+ I := IndexOfAppt(AAppt);
+ if I > -1 then
+ begin
+ Objects[I].Free;
+ Delete(I);
+ end;
+end;
+
+function TJvTFAlarmList.GetAlarmForAppt(AAppt: TJvTFAppt): TJvTFAlarmInfo;
+begin
+ Result := GetAlarmForApptID(AAppt.ID);
+end;
+
+function TJvTFAlarmList.GetAlarmForApptID(const ID: string): TJvTFAlarmInfo;
+var
+ I: Integer;
+begin
+ Result := nil;
+ I := IndexOf(ID);
+ if I > -1 then
+ Result := TJvTFAlarmInfo(Objects[I]);
+end;
+
+function TJvTFAlarmList.IndexOfAppt(AAppt: TJvTFAppt): Integer;
+begin
+ Result := IndexOf(AAppt.ID);
+end;
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfdays.pas b/components/jvcllaz/run/JvTimeFramework/jvtfdays.pas
new file mode 100644
index 000000000..ef1a5e881
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfdays.pas
@@ -0,0 +1,14562 @@
+{-----------------------------------------------------------------------------
+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: JvTFDays.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+ This version of the source contains modifications which enable the use
+ of time blocks. These modifications can be found by doing a search for
+ "DEF Jv_TIMEBLOCKS". Previously, two versions were released; one which did
+ NOT support timeblocks and one which did support timeblocks. (Hence the
+ use of the compiler defines.)
+
+ These two versions are in the process of being integrated. The compiler
+ defines remain as an indicator of exactly what has been changed. All
+ lines that are NOT compiled ($IFNDEF Jv_TIMEBLOCKS and $ELSE) remain
+ as a reference during the transition, but have been commented out to
+ reduce confusion. Many of these lines are marked by a "// remove" comment.
+
+ The conditional defines and disabled code will be removed and this file
+ will be cleaned up after the time block code has been fully integrated
+ and tested.
+Changes to JvTFDays by deanh:
+============================
+
+These changes peform the following functions.
+
+1) The addition of a new time entry is aborted if the user presses escape.
+2) New property for FancyHeader to only show the '00' minutes. This emulates outlook's behaviour.
+3) Few changes to clean up the dithering of the background.
+4) Hide the blank area that sometimes appears at the bottom of the Calendar when scrolling right down to the bottom.
+5) Remove the focus rectangle when ShowFocus is false (the focus rect is not shown in Outlook).
+
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFDays;
+
+{$mode objfpc}{$H+}
+{$define Jv_TIMEBLOCKS}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages, Types,
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ImgList,
+ JvTFManager, JvTFSparseMatrix, JvTFUtils;
+
+const
+ AbsMinColWidth = 5;
+ SizingThreshold = 5;
+ gcUndef = -3;
+ gcGroupHdr = -2;
+ gcHdr = -1;
+
+type
+ EJvTFDaysError = class(Exception);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // remove TTFDayOfWeek and TTFDaysOfWeek, they are found in JvTFUtils
+ //TTFDayOfWeek = (dowSunday, dowMonday, dowTuesday, dowWednesday,
+ // dowThursday, dowFriday, dowSaturday);
+ //TTFDaysOfWeek = set of TTFDayOfWeek;
+
+ EJvTFBlockGranError = class(EJvTFDaysError);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // Forward declarations
+ TJvTFDays = class;
+ TJvTFDaysCols = class;
+ TJvTFDaysCol = class;
+ TJvTFDaysPrinter = class;
+ TJvTFDaysTemplate = class;
+ TJvTFDaysHdrAttr = class;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // okay to leave
+ TJvTFDaysTimeBlocks = class;
+ TJvTFDaysTimeBlock = class;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ TJvTFDaysCoord = record
+ Col: Integer;
+ Row: Integer;
+ CellX: Integer;
+ CellY: Integer;
+ AbsX: Integer;
+ AbsY: Integer;
+ Schedule: TJvTFSched;
+ Appt: TJvTFAppt;
+ DragAccept: Boolean;
+ end;
+
+ TJvTFDrawPicInfo = class(TObject)
+ public
+ ImageList: TCustomImageList;
+ ImageIndex: Integer;
+ Glyph: TGraphic;
+ PicLeft: Integer;
+ PicTop: Integer;
+ end;
+
+ TJvTFDaysTemplates = (agtNone, agtLinear, agtComparative);
+
+ TJvTFListMoveEvent = procedure(Sender: TObject; CurIndex, NewIndex: Integer) of object;
+
+ TJvTFCompNamesList = class(TStringList)
+ private
+ FOnMove: TJvTFListMoveEvent;
+ public
+ procedure Move(CurIndex, NewIndex: Integer); override;
+ property OnMove: TJvTFListMoveEvent read FOnMove write FOnMove;
+ end;
+
+ TJvTFDaysTemplate = class(TPersistent)
+ private
+ FActiveTemplate: TJvTFDaysTemplates;
+ FCompDate: TDate;
+ FCompNames: TJvTFCompNamesList;
+ FLinearDayCount: Integer;
+ FLinearEndDate: TDate;
+ FLinearName: string;
+ FLinearStartDate: TDate;
+ FShortTitles: Boolean;
+ FUpdatingGrid: Boolean;
+ // Property Access Methods
+ function GetCompNames: TStrings;
+ procedure SetActiveTemplate(Value: TJvTFDaysTemplates);
+ procedure SetCompDate(Value: TDate);
+ procedure SetCompNames(Value: TStrings);
+ procedure SetLinearDayCount(Value: Integer);
+ procedure SetLinearEndDate(Value: TDate);
+ procedure SetLinearName(const Value: string);
+ procedure SetLinearStartDate(Value: TDate);
+ procedure SetShortTitles(Value: Boolean);
+ protected
+ FCompNamesChanged: Boolean;
+ FGrid: TJvTFDays;
+ FUpdatingCompNames: Boolean;
+ FIgnoreNav: Boolean;
+ procedure DoDateChangedEvent;
+ procedure DoDateChangingEvent(var NewDate: TDate);
+ procedure CompNamesChanged(Sender: TObject); virtual;
+ procedure CompNamesMoved(Sender: TObject; CurIndex, NewIndex: Integer); virtual;
+ procedure LinearDaysChanged; virtual;
+ procedure BeginGridUpdate;
+ procedure EndGridUpdate;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure BeginCompNamesUpdate;
+ procedure EndCompNamesUpdate;
+ procedure UpdateGrid;
+ property UpdatingGrid: Boolean read FUpdatingGrid;
+ property ApptGrid: TJvTFDays read FGrid;
+ published
+ property ActiveTemplate: TJvTFDaysTemplates read FActiveTemplate write SetActiveTemplate default agtNone;
+
+ property CompDate: TDate read FCompDate write SetCompDate;
+ property CompNames: TStrings read GetCompNames write SetCompNames;
+
+ property IgnoreNav: Boolean read FIgnoreNav write FIgnoreNav default False;
+ property LinearDayCount: Integer read FLinearDayCount write SetLinearDayCount;
+ property LinearEndDate: TDate read FLinearEndDate write SetLinearEndDate;
+ property LinearName: string read FLinearName write SetLinearName;
+ property LinearStartDate: TDate read FLinearStartDate write SetLinearStartDate;
+
+ property ShortTitles: Boolean read FShortTitles write SetShortTitles default True;
+ end;
+
+ TJvTFDaysPrimeTime = class(TPersistent)
+ private
+ FStartTime: TTime;
+ FEndTime: TTime;
+ FColor: TColor;
+ procedure SetStartTime(Value: TTime);
+ procedure SetEndTime(Value: TTime);
+ procedure SetColor(Value: TColor);
+ protected
+ FApptGrid: TJvTFDays;
+ FFillPic: TBitmap;
+ procedure Change;
+ procedure UpdateFillPic;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property StartTime: TTime read FStartTime write SetStartTime;
+ property EndTime: TTime read FEndTime write SetEndTime;
+ property Color: TColor read FColor write SetColor;
+ end;
+
+ TJvTFCreateQuickEntryEvent = procedure(Sender: TObject; var ApptID: string;
+ var StartDate: TDate; var StartTime: TTime; var EndDate: TDate;
+ var EndTime: TTime; var Confirm: Boolean) of object;
+
+ TJvTFDropApptEvent = procedure(Appt: TJvTFAppt; SchedName: string;
+ NewStartDate: TDate; NewStartTime: TTime; NewEndDate: TDate;
+ NewEndTime: TTime; Share: Boolean; var Confirm: Boolean) of object;
+
+ TJvTFDragRowColEvent = procedure(Sender: TObject; Index: Integer;
+ var NewInfo: Integer; var Confirm: Boolean) of object;
+
+ TJvTFSizeApptEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
+ var NewEndDT: TDateTime; var Confirm: Boolean) of object;
+
+ TJvTFSelecTJvTFApptEvent = procedure(Sender: TObject; OldSel, NewSel: TJvTFAppt) of object;
+
+ TJvTFDrawApptEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
+ Appt: TJvTFAppt; Selected: Boolean) of object;
+
+ TJvTFDrawGrabHandleEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+ ARect: TRect; Appt: TJvTFAppt; TopHandle: Boolean) of object;
+
+ TJvTFDrawDataCellEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
+ Col, Row: Integer) of object;
+
+ TJvTFDaysCorner = (agcTopLeft, agcTopRight, agcBottomLeft, agcBottomRight);
+ TJvTFDrawCornerEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
+ Corner: TJvTFDaysCorner) of object;
+
+ TJvTFDrawHdrEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
+ Index: Integer; Selected: Boolean) of object;
+
+ TJvTFDrawApptBarEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+ Appt: TJvTFAppt; Col: Integer; BarRect, TimeStampRect: TRect) of object;
+
+ TJvTFFailEditorEvent = procedure(Sender: TObject; Col: Integer; Appt: TJvTFAppt;
+ var EditorBounds: TRect; var Fail: Boolean) of object;
+
+ TJvTFDateChangingEvent = procedure(Sender: TObject; var NewDate: TDate) of object;
+
+ TJvTFGranChangingEvent = procedure(Sender: TObject; var NewGran: Integer) of object;
+
+ TJvTFShadeCellEvent = procedure(Sender: TObject; ColIndex, RowIndex: Integer;
+ var CellColor: TColor) of object;
+
+ TJvTFBeginEditEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
+ var AllowEdit: Boolean) of object;
+
+ TJvTFInPlaceApptEditor = class(TMemo)
+ private
+ FLinkedAppt: TJvTFAppt;
+ FQuickCreate: Boolean;
+ protected
+ FCancelEdit: Boolean;
+ procedure DoExit; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property LinkedAppt: TJvTFAppt read FLinkedAppt write FLinkedAppt;
+ property QuickCreate: Boolean read FQuickCreate write FQuickCreate;
+ end;
+
+ TJvTFApptMap = class(TObject)
+ private
+ FData: TJvTFSparseMatrix;
+ function GetLocation(Row, Col: Integer): TJvTFAppt;
+ protected
+ FGridCol: TJvTFDaysCol;
+ procedure Add(Appt: TJvTFAppt);
+ procedure ProcessMapGroup(GroupStart, GroupEnd: Integer);
+ procedure UpdateMapGroups;
+ public
+ constructor Create(AGridCol: TJvTFDaysCol); virtual;
+ destructor Destroy; override;
+ procedure Clear;
+ function ColCount(Row: Integer): Integer;
+ procedure GetAppts(StartRow, EndRow: Integer; ApptList: TStringList);
+ function LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer;
+ property Location[Row, Col: Integer]: TJvTFAppt read GetLocation;
+ procedure Refresh;
+ function HasAppt(Appt: TJvTFAppt): Boolean;
+ procedure Dump(AName: TFileName); // used for debugging only
+ end;
+
+ TJvTFDaysOption = (agoSizeCols, agoSizeRows, agoSizeColHdr, agoSizeRowHdr,
+ agoMoveCols, agoSizeAppt, agoMoveAppt, agoSnapMove,
+ agoSnapSize, agoEditing, agoShowPics, agoShowText,
+ agoShowApptHints, agoShowColHdrHints, agoShowSelHint,
+ agoEnforceMaxColWidth, agoQuickEntry, agoFormattedDesc);
+ TJvTFDaysOptions = set of TJvTFDaysOption;
+
+ TJvTFDaysState = (agsNormal, agsSizeCol, agsSizeRow, agsSizeColHdr,
+ agsSizeRowHdr, agsMoveCol, agsSizeAppt, agsMoveAppt);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ TJvTFColTitleStyle = (ctsSingleClip, ctsSingleEllipsis, ctsMultiClip,
+ ctsMultiEllipsis, ctsHide, ctsRotated);
+ {$ELSE}
+ // remove
+ //TJvTFColTitleStyle = (ctsSingleClip, ctsSingleEllipsis, ctsMultiClip,
+ // ctsMultiEllipsis, ctsHide);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ TJvTFDaysThresholds = class(TPersistent)
+ private
+ FDetailHeight: Integer;
+ FDetailWidth: Integer;
+ FEditHeight: Integer;
+ FEditWidth: Integer;
+ FTextHeight: Integer;
+ FTextWidth: Integer;
+ FDropTextFirst: Boolean;
+ FPicsAllOrNone: Boolean;
+ FWholePicsOnly: Boolean;
+ procedure SetDetailHeight(Value: Integer);
+ procedure SetDetailWidth(Value: Integer);
+ procedure SetEditHeight(Value: Integer);
+ procedure SetEditWidth(Value: Integer);
+ procedure SetTextHeight(Value: Integer);
+ procedure SetTextWidth(Value: Integer);
+ procedure SetDropTextFirst(Value: Boolean);
+ procedure SetPicsAllOrNone(Value: Boolean);
+ procedure SetWholePicsOnly(Value: Boolean);
+ protected
+ FApptGrid: TJvTFDays;
+ procedure Change; dynamic;
+ public
+ constructor Create(AOwner: TJvTFDays);
+ procedure Assign(Source: TPersistent); override;
+ published
+ property DetailHeight: Integer read FDetailHeight write SetDetailHeight default 10;
+ property DetailWidth: Integer read FDetailWidth write SetDetailWidth default 10;
+ property EditHeight: Integer read FEditHeight write SetEditHeight default 1;
+ property EditWidth: Integer read FEditWidth write SetEditWidth default 10;
+ property TextHeight: Integer read FTextHeight write SetTextHeight default 1;
+ property TextWidth: Integer read FTextWidth write SetTextWidth default 10;
+ property DropTextFirst: Boolean read FDropTextFirst write SetDropTextFirst default True;
+ property PicsAllOrNone: Boolean read FPicsAllOrNone write SetPicsAllOrNone default False;
+ property WholePicsOnly: Boolean read FWholePicsOnly write SetWholePicsOnly default True;
+ end;
+
+ TJvTFDaysScrollBar = class(TScrollBar)
+ protected
+ procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
+ procedure CreateWnd; override;
+ function GetLargeChange: Integer; virtual;
+ procedure SetLargeChange(Value: Integer); virtual;
+ procedure UpdateRange; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property LargeChange: Integer read GetLargeChange write SetLargeChange default 1;
+ end;
+
+ //TJvTFUpdateTitleEvent = Procedure(Sender: TObject; Col: TJvTFDaysCol;
+ //var NewTitle: string) of object;
+ TJvTFUpdateTitlesEvent = procedure(Sender: TObject; Col: TJvTFDaysCol;
+ var NewGroupTitle, NewTitle: string) of object;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ TJvTFDaysTimeBlock = class(TCollectionItem)
+ private
+ FLength: Integer;
+ FTitle: string;
+ FName: string;
+ FAllowAppts: Boolean;
+ procedure SetLength(Value: Integer);
+ procedure SetTitle(const Value: string);
+ procedure SetName(const Value: string);
+ procedure SetAllowAppts(Value: Boolean);
+ function GetGridLength: Integer;
+ function GetBlockCollection: TJvTFDaysTimeBlocks;
+ protected
+ function GetDisplayName: string; override;
+ procedure Change;
+ public
+ constructor Create(ACollection: TCollection); override;
+ procedure Assign(Source: TPersistent); override;
+ property BlockCollection: TJvTFDaysTimeBlocks read GetBlockCollection;
+ published
+ property AllowAppts: Boolean read FAllowAppts write SetAllowAppts default True;
+ property GridLength: Integer read GetGridLength;
+ property Length: Integer read FLength write SetLength default 1;
+ property Name: string read FName write SetName;
+ property Title: string read FTitle write SetTitle;
+ end;
+
+ // ok
+ TJvTFDaysTimeBlocks = class(TCollection)
+ private
+ FDaysControl: TJvTFDays;
+ function GetItem(Index: Integer): TJvTFDaysTimeBlock;
+ procedure SetItem(Index: Integer; Value: TJvTFDaysTimeBlock);
+ protected
+ function GetOwner: TPersistent; override;
+ public
+ constructor Create(ADaysControl: TJvTFDays);
+ function Add: TJvTFDaysTimeBlock;
+ property DaysControl: TJvTFDays read FDaysControl;
+ procedure Assign(Source: TPersistent); override;
+ property Items[Index: Integer]: TJvTFDaysTimeBlock read GetItem
+ write SetItem; default;
+ function BlockByName(const BlockName: string): TJvTFDaysTimeBlock;
+ function FindBlock(const BlockName: string): TJvTFDaysTimeBlock;
+ end;
+
+ // ok
+ TJvTFDaysBlockProps = class(TPersistent)
+ private
+ FBlockGran: Integer;
+ FDayStart: TTime;
+ FDaysControl: TJvTFDays;
+ FBlockHdrAttr: TJvTFDaysHdrAttr;
+ FSelBlockHdrAttr: TJvTFDaysHdrAttr;
+ FBlockHdrWidth: Integer;
+ FOffTimeColor: TColor;
+ FDataDivColor: TColor;
+ FSnapMove: Boolean;
+ FDrawOffTime: Boolean;
+ procedure SetBlockGran(Value: Integer);
+ procedure SetDayStart(Value: TTime);
+ procedure SetBlockHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetSelBlockHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetBlockHdrWidth(Value: Integer);
+ procedure SetOffTimeColor(Value: TColor);
+ procedure SetDataDivColor(Value: TColor);
+ procedure SetDrawOffTime(Value: Boolean);
+ public
+ constructor Create(ADaysControl: TJvTFDays);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ property DaysControl: TJvTFDays read FDaysControl;
+ procedure Change;
+ published
+ property BlockGran: Integer read FBlockGran write SetBlockGran default 60;
+ property BlockHdrAttr: TJvTFDaysHdrAttr read FBlockHdrAttr write SetBlockHdrAttr;
+ property BlockHdrWidth: Integer read FBlockHdrWidth write SetBlockHdrWidth default 50;
+ property DataDivColor: TColor read FDataDivColor write SetDataDivColor default clBlack;
+ property DayStart: TTime read FDayStart write SetDayStart;
+ property DrawOffTime: Boolean read FDrawOffTime write SetDrawOffTime default True;
+ property OffTimeColor: TColor read FOffTimeColor write SetOffTimeColor default clGray;
+ property SelBlockHdrAttr: TJvTFDaysHdrAttr read FSelBlockHdrAttr write SetSelBlockHdrAttr;
+ property SnapMove: Boolean read FSnapMove write FSnapMove default True;
+ end;
+
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ TJvTFDaysCol = class(TCollectionItem)
+ private
+ FMap: TJvTFApptMap;
+ FNullSchedDate: Boolean;
+ FSchedDate: TDate;
+ FSchedName: string;
+ FSchedule: TJvTFSched;
+ FGroupTitle: string;
+ FTitle: string;
+ FWidth: Integer;
+ procedure SetSchedDate(Value: TDate);
+ procedure SetSchedName(const Value: string);
+ procedure SetGroupTitle(const Value: string);
+ procedure SetTitle(const Value: string);
+ procedure SetWidth(Value: Integer);
+ protected
+ FDisconnecting: Boolean;
+ function GetDisplayName: string; override;
+ procedure CheckTemplate;
+ procedure SetIndex(Value: Integer); override;
+ public
+ constructor Create(ACollection: TCollection); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ function ColCollection: TJvTFDaysCols;
+ property Schedule: TJvTFSched read FSchedule;
+ function Connected: Boolean;
+
+ procedure Connect;
+ procedure Disconnect;
+ procedure SetSchedule(const NewSchedName: string; NewSchedDate: TDate);
+
+ function LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer;
+ function MapColCount(Row: Integer): Integer;
+ function MapLocation(Col, Row: Integer): TJvTFAppt;
+
+ procedure RefreshMap;
+ procedure CalcStartEndRows(Appt: TJvTFAppt; var StartRow, EndRow: Integer);
+ //procedure UpdateTitle;
+ procedure UpdateTitles;
+
+ function GetFirstAppt: TJvTFAppt;
+ function GetPrevAppt(RefAppt: TJvTFAppt): TJvTFAppt;
+ function GetNextAppt(RefAppt: TJvTFAppt): TJvTFAppt;
+ function GetLastAppt: TJvTFAppt;
+ procedure DumpMap;
+ function ApptInCol(Appt: TJvTFAppt): Boolean;
+ published
+ property SchedDate: TDate read FSchedDate write SetSchedDate;
+ property SchedName: string read FSchedName write SetSchedName;
+ property GroupTitle: string read FGroupTitle write SetGroupTitle;
+ property Title: string read FTitle write SetTitle;
+ property Width: Integer read FWidth write SetWidth;
+ end;
+
+ TJvTFDaysCols = class(TCollection)
+ private
+ FApptGrid: TJvTFDays;
+ FPrinter: TJvTFDaysPrinter;
+ FOldCount: Integer;
+ function GetItem(Index: Integer): TJvTFDaysCol;
+ procedure SetItem(Index: Integer; Value: TJvTFDaysCol);
+ protected
+ FAddingCol: Boolean;
+ FSizingCols: Boolean;
+ FUpdating: Boolean;
+ procedure EnsureCol(Index: Integer);
+ function GetOwner: TPersistent; override;
+ procedure SizeCols; virtual;
+ procedure Update(Item: TCollectionItem); override;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ constructor CreateForPrinter(APrinter: TJvTFDaysPrinter);
+ property ApptGrid: TJvTFDays read FApptGrid;
+ property Printer: TJvTFDaysPrinter read FPrinter;
+
+ function Add: TJvTFDaysCol;
+ property AddingCol: Boolean read FAddingCol;
+ property Updating: Boolean read FUpdating;
+
+ procedure EnsureMinColWidth;
+ procedure EnsureMaxColWidth;
+ procedure ResizeCols;
+ property SizingCols: Boolean read FSizingCols;
+ procedure MoveCol(SourceIndex, TargetIndex: Integer);
+
+ procedure Assign(Source: TPersistent); override;
+ property Items[Index: Integer]: TJvTFDaysCol read GetItem write SetItem; default;
+ procedure UpdateTitles;
+ end;
+
+ TJvTFRowHdrType = (rhGrid, rhFancy);
+
+ TJvTFDaysFancyRowHdrAttr = class(TPersistent)
+ private
+ FColor: TColor;
+ FHr2400: Boolean;
+ FMinorFont: TFont;
+ FMajorFont: TFont;
+ FTickColor: TColor;
+ FOnlyShow00Minutes: Boolean;
+ procedure SetColor(Value: TColor);
+ procedure SetHr2400(Value: Boolean);
+ procedure SetMinorFont(Value: TFont);
+ procedure SetMajorFont(Value: TFont);
+ procedure SetTickColor(Value: TColor);
+ procedure SetOnlyShow00Minutes(Value: Boolean);
+ protected
+ FGrid: TJvTFDays;
+ procedure Change; virtual;
+ procedure FontChange(Sender: TObject); virtual;
+ public
+ constructor Create(AOwner: TJvTFDays);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Color: TColor read FColor write SetColor default clBtnFace;
+ property Hr2400: Boolean read FHr2400 write SetHr2400;
+ property MinorFont: TFont read FMinorFont write SetMinorFont;
+ property MajorFont: TFont read FMajorFont write SetMajorFont;
+ property TickColor: TColor read FTickColor write SetTickColor default clGray;
+ property OnlyShow00Minutes: Boolean read FOnlyShow00Minutes write SetOnlyShow00Minutes
+ default True;
+ end;
+
+ TJvTFDaysHdrAttr = class(TPersistent)
+ private
+ FApptGrid: TJvTFDays;
+ FColor: TColor;
+ FFont: TFont;
+ FParentFont: Boolean;
+ FFrame3D: Boolean;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FFrameColor: TColor;
+ FTitleRotation: Integer;
+ {$ENDIF Jv_TIMEBLOCKS}
+ procedure SetColor(Value: TColor);
+ procedure SetFont(Value: TFont);
+ procedure SetParentFont(Value: Boolean);
+ procedure SetFrame3D(Value: Boolean);
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ procedure SetFrameColor(Value: TColor);
+ procedure SetTitleRotation(Value: Integer);
+ {$ENDIF Jv_TIMEBLOCKS}
+ protected
+ procedure Change;
+ procedure FontChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TJvTFDays);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure ParentFontChanged;
+ published
+ property Color: TColor read FColor write SetColor default clBtnFace;
+ property Font: TFont read FFont write SetFont;
+ property ParentFont: Boolean read FParentFont write SetParentFont default True;
+ property Frame3D: Boolean read FFrame3D write SetFrame3D default True;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ property FrameColor: TColor read FFrameColor write SetFrameColor nodefault;
+ property TitleRotation: Integer read FTitleRotation write SetTitleRotation default 0;
+ {$ENDIF Jv_TIMEBLOCKS}
+ end;
+
+ TJvTFTimeStampStyle = (tssNone, tssFullI, tssHalfI, tssBlock);
+
+ TJvTFDaysApptBar = class(TPersistent)
+ private
+ FColor: TColor;
+ FVisible: Boolean;
+ FWidth: Integer;
+ FTimeStampStyle: TJvTFTimeStampStyle;
+ FTimeStampColor: TColor;
+ procedure SetColor(Value: TColor);
+ procedure SetVisible(Value: Boolean);
+ procedure SetWidth(Value: Integer);
+ procedure SetTFTimeStampStyle(Value: TJvTFTimeStampStyle);
+ procedure SetTimeStampColor(Value: TColor);
+ protected
+ FApptGrid: TJvTFDays;
+ procedure Change; virtual;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Color: TColor read FColor write SetColor default clBlue;
+ property Width: Integer read FWidth write SetWidth default 5;
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property TimeStampStyle: TJvTFTimeStampStyle read FTimeStampStyle
+ write SetTFTimeStampStyle default tssBlock;
+ property TimeStampColor: TColor read FTimeStampColor
+ write SetTimeStampColor default clBlue;
+ end;
+
+ TJvTFDaysApptAttr = class(TPersistent)
+ private
+ FColor: TColor;
+ FFont: TFont;
+ FParentFont: Boolean;
+ FFrameColor: TColor;
+ FFrameWidth: Integer;
+ procedure SetColor(Value: TColor);
+ procedure SetFont(Value: TFont);
+ procedure SetParentFont(Value: Boolean);
+ procedure SetFrameColor(Value: TColor);
+ procedure SetFrameWidth(Value: Integer);
+ protected
+ FApptGrid: TJvTFDays;
+ procedure Change; virtual;
+ procedure FontChange(Sender: TObject); virtual;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure ParentFontChanged; virtual;
+ published
+ property Color: TColor read FColor write SetColor;
+ property Font: TFont read FFont write SetFont;
+ property ParentFont: Boolean read FParentFont write SetParentFont default True;
+ property FrameColor: TColor read FFrameColor write SetFrameColor default clBlack;
+ property FrameWidth: Integer read FFrameWidth write SetFrameWidth default 1;
+ end;
+
+ TJvTFSelCellStyle = (scsSolid, scsFrame, scsCombo);
+
+ TJvTFSelCellAttr = class(TPersistent)
+ private
+ FColor: TColor;
+ FFrameWidth: Integer;
+ FStyle: TJvTFSelCellStyle;
+ procedure SetColor(Value: TColor);
+ procedure SetFrameWidth(Value: Integer);
+ procedure SetStyle(Value: TJvTFSelCellStyle);
+ protected
+ FApptGrid: TJvTFDays;
+ procedure Change; virtual;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Color: TColor read FColor write SetColor default clNavy;
+ property FrameWidth: Integer read FFrameWidth write SetFrameWidth default 2;
+ property Style: TJvTFSelCellStyle read FStyle write SetStyle default scsSolid;
+ end;
+
+ TJvTFGrabStyle = (gs3D, gsFlat);
+
+ TJvTFDaysGrabHandles = class(TPersistent)
+ private
+ FColor: TColor;
+ FHeight: Integer;
+ FStyle: TJvTFGrabStyle;
+ procedure SetColor(Value: TColor);
+ procedure SetHeight(Value: Integer);
+ procedure SetStyle(Value: TJvTFGrabStyle);
+ protected
+ FApptGrid: TJvTFDays;
+ procedure Change; virtual;
+ property Style: TJvTFGrabStyle read FStyle write SetStyle default gsFlat;
+ public
+ constructor Create(AApptGrid: TJvTFDays);
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Height: Integer read FHeight write SetHeight default 6;
+ property Color: TColor read FColor write SetColor default clBlue;
+ end;
+
+ {$M+}
+ TJvTFDaysApptDrawInfo = class(TObject)
+ private
+ FColor: TColor;
+ FFrameColor: TColor;
+ FFrameWidth: Integer;
+ FFont: TFont;
+ FVisible: Boolean;
+ procedure SetColor(Value: TColor);
+ procedure SetFrameColor(Value: TColor);
+ procedure SetFont(Value: TFont);
+ procedure SetFrameWidth(const Value: Integer);
+ procedure SetVisible(Value: Boolean);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ published
+ property Color: TColor read FColor write SetColor;
+ property FrameColor: TColor read FFrameColor write SetFrameColor;
+ property FrameWidth: Integer read FFrameWidth write SetFrameWidth;
+ property Font: TFont read FFont write SetFont;
+ property Visible: Boolean read FVisible write SetVisible;
+ end;
+ {$M-}
+
+ TJvTFGetDaysApptDrawInfoEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
+ DrawInfo: TJvTFDaysApptDrawInfo) of object;
+
+ TDynPointArray = array of TPoint;
+ TDynIntArray = array of Integer;
+
+ TJvTFDaysGrouping = (grNone, grDate, grResource, grCustom);
+
+ TJvTFAutoScrollDir = (asdUp, asdDown, asdLeft, asdRight, asdNowhere);
+
+ TJvTFDays = class(TJvTFControl)
+ private
+ // internal stuff
+// FBorderStyle: TBorderStyle;
+ FHitTest: TPoint;
+ FVisibleScrollBars: TJvTFVisibleScrollBars;
+ FDitheredBackground: Boolean;
+
+ // row, col layout
+ FGranularity: Integer;
+ FColHdrHeight: Integer;
+ FRowHdrWidth: Integer;
+ FRowHeight: Integer;
+ FMinRowHeight: Integer;
+ FDefColWidth: Integer;
+ FMinColWidth: Integer;
+ FAutoSizeCols: Boolean;
+ FColTitleStyle: TJvTFColTitleStyle;
+ FGroupHdrHeight: Integer;
+
+ FCols: TJvTFDaysCols;
+ FTemplate: TJvTFDaysTemplate;
+
+ FTopRow: Integer;
+ FFocusedRow: Integer;
+ FLeftCol: Integer;
+ FFocusedCol: Integer;
+ FGrouping: TJvTFDaysGrouping;
+
+ FGridStartTime: TTime;
+ FGridEndTime: TTime;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FTimeBlockProps: TJvTFDaysBlockProps;
+ FTimeBlocks: TJvTFDaysTimeBlocks;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // visual appearance attr's
+ FHdrAttr: TJvTFDaysHdrAttr;
+ FSelHdrAttr: TJvTFDaysHdrAttr;
+ FApptAttr: TJvTFDaysApptAttr;
+ FSelApptAttr: TJvTFDaysApptAttr;
+ FFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr;
+ FSelFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr;
+ FRowHdrType: TJvTFRowHdrType;
+ FSelCellAttr: TJvTFSelCellAttr;
+ FApptBar: TJvTFDaysApptBar;
+ FApptBuffer: Integer;
+ FGridLineColor: TColor;
+ FGrabHandles: TJvTFDaysGrabHandles;
+ FThresholds: TJvTFDaysThresholds;
+ FPrimeTime: TJvTFDaysPrimeTime;
+ FGroupHdrAttr: TJvTFDaysHdrAttr;
+ FSelGroupHdrAttr: TJvTFDaysHdrAttr;
+
+ FOptions: TJvTFDaysOptions;
+ FEditor: TJvTFInPlaceApptEditor;
+ FHintProps: TJvTFHintProps;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FWeekend: TTFDaysOfWeek;
+ FWeekendColor: TColor;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // Row/Col Sizing/Moving Events
+ FOnSizeCol: TJvTFDragRowColEvent;
+ FOnSizeRow: TJvTFDragRowColEvent;
+ FOnSizeColHdr: TJvTFDragRowColEvent;
+ FOnSizeRowHdr: TJvTFDragRowColEvent;
+ FOnMoveCol: TJvTFDragRowColEvent;
+
+ // Appt mouse events
+ FOnSelectingAppt: TJvTFVarApptEvent;
+ FOnSelectAppt: TJvTFSelecTJvTFApptEvent;
+ FOnSelectedAppt: TNotifyEvent;
+ FOnSizeAppt: TJvTFSizeApptEvent;
+ FOnDropAppt: TJvTFDropApptEvent;
+
+ // Drawing events
+ FOnDrawAppt: TJvTFDrawApptEvent;
+ FOnDrawApptBar: TJvTFDrawApptBarEvent;
+ FOnDrawCorner: TJvTFDrawCornerEvent;
+ FOnDrawColHdr: TJvTFDrawHdrEvent;
+ FOnDrawDataCell: TJvTFDrawDataCellEvent;
+ FOnDrawGrabHandle: TJvTFDrawGrabHandleEvent;
+ FOnDrawMajorRowHdr: TJvTFDrawHdrEvent;
+ FOnDrawMinorRowHdr: TJvTFDrawHdrEvent;
+ FOnDrawRowHdr: TJvTFDrawHdrEvent;
+ //FOnUpdateColTitle: TJvTFUpdateTitleEvent;
+ FOnUpdateColTitles: TJvTFUpdateTitlesEvent;
+ FOnDrawGroupHdr: TJvTFDrawHdrEvent;
+ FOnShadeCell: TJvTFShadeCellEvent;
+ FOnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent;
+
+ // editor events
+ FOnFailEditor: TJvTFFailEditorEvent;
+ FOnCreateQuickEntry: TJvTFCreateQuickEntryEvent;
+ FOnQuickEntry: TNotifyEvent;
+ FOnBeginEdit: TJvTFBeginEditEvent;
+
+ // navigation events
+ FOnInsertAppt: TNotifyEvent;
+ FOnInsertSchedule: TNotifyEvent;
+ FOnDeleteAppt: TNotifyEvent;
+ FOnDeleteSchedule: TNotifyEvent;
+ FOnDateChanging: TJvTFDateChangingEvent;
+ FOnDateChanged: TNotifyEvent;
+ FOnGranularityChanging: TJvTFGranChangingEvent;
+ FOnGranularityChanged: TNotifyEvent;
+ FOnFocusedRowChanged: TNotifyEvent;
+ FOnFocusedColChanged: TNotifyEvent;
+ FShowFocus: Boolean;
+
+ // internal stuff
+// procedure CMCtl3DChanged(var Msg: TLMessage); message CM_CTL3DCHANGED;
+ procedure WMGetDlgCode(var Msg: TLMGetDlgCode); message LM_GETDLGCODE;
+// procedure SetBorderStyle(Value: TBorderStyle);
+ procedure SetTFVisibleScrollBars(Value: TJvTFVisibleScrollBars);
+ procedure AlignScrollBars;
+ function CheckSBVis: Boolean;
+ procedure SetOnShowHint(Value: TJvTFShowHintEvent);
+ function GetOnShowHint: TJvTFShowHintEvent;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ procedure UpdateWeekendFillPic;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // row, col layout
+ procedure SetGranularity(Value: Integer);
+ procedure SetColHdrHeight(Value: Integer);
+ procedure SetRowHdrWidth(Value: Integer);
+ procedure SetRowHeight(Value: Integer);
+ procedure SetMinRowHeight(Value: Integer);
+ procedure SetMinColWidth(Value: Integer);
+ procedure SetAutoSizeCols(Value: Boolean);
+ procedure SetTFColTitleStyle(Value: TJvTFColTitleStyle);
+
+ procedure SetCols(Value: TJvTFDaysCols);
+
+ procedure SetTopRow(Value: Integer);
+ procedure SetFocusedRow(Value: Integer);
+ function GetFocusedRow: Integer;
+ procedure SetLeftCol(Value: Integer);
+ procedure SetFocusedCol(Value: Integer);
+ function GetFocusedCol: Integer;
+ procedure SetGrouping(Value: TJvTFDaysGrouping);
+ procedure SetGroupHdrHeight(Value: Integer);
+
+ procedure SetGridStartTime(Value: TTime);
+ procedure SetGridEndTime(Value: TTime);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ procedure SetTimeBlockProps(Value: TJvTFDaysBlockProps);
+ // ok
+ procedure SetTimeBlocks(Value: TJvTFDaysTimeBlocks);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // visual appearance attr's
+ procedure SetHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetSelHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetApptAttr(Value: TJvTFDaysApptAttr);
+ procedure SetSelApptAttr(Value: TJvTFDaysApptAttr);
+ procedure SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr);
+ procedure SetSelFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr);
+ procedure SetTFRowHdrType(Value: TJvTFRowHdrType);
+ procedure SetTFSelCellAttr(Value: TJvTFSelCellAttr);
+ procedure SetApptBar(Value: TJvTFDaysApptBar);
+ procedure SetApptBuffer(Value: Integer);
+ procedure SetGridLineColor(Value: TColor);
+ procedure SetGrabHandles(Value: TJvTFDaysGrabHandles);
+ procedure SetGroupHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetSelGroupHdrAttr(Value: TJvTFDaysHdrAttr);
+
+ procedure SetOptions(Value: TJvTFDaysOptions);
+ procedure SetTFHintProps(Value: TJvTFHintProps);
+ procedure DrawDither(ACanvas: TCanvas; ARect: TRect; Color1, Color2: TColor);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ procedure SetWeekend(Value: TTFDaysOfWeek);
+ // ok
+ procedure SetWeekendColor(Value: TColor);
+ procedure SetDitheredBackground(const Value: Boolean);
+ procedure SetShowFocus(const Value: Boolean);
+ {$ENDIF Jv_TIMEBLOCKS}
+ protected
+ FState: TJvTFDaysState;
+ FHint: TJvTFHint;
+ FNeedCheckSBParams: Boolean;
+ PaintBuffer: TBitmap;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FWeekendFillPic: TBitmap;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ FBeginDraggingCoord: TJvTFDaysCoord;
+ FDraggingCoord: TJvTFDaysCoord;
+
+ FSelAppt: TJvTFAppt;
+ FSelStart: TPoint;
+ FSelEnd: TPoint;
+ FFromToSel: Boolean;
+ FSaveFocCol: Integer;
+
+ FHScrollBar: TJvTFDaysScrollBar;
+ FVScrollBar: TJvTFDaysScrollBar;
+
+ FAutoScrollDir: TJvTFAutoScrollDir;
+ FLiveTimer: Boolean;
+
+ FMouseMovePt: TPoint;
+ FMouseMoveState: TShiftState;
+
+ procedure SetDateFormat(const Value: string); override;
+ procedure ReqSchedNotification(Schedule: TJvTFSched); override;
+ procedure RelSchedNotification(Schedule: TJvTFSched); override;
+ procedure CreateParams(var Params: TCreateParams); override;
+
+ function GetFocusedSchedule: TJvTFSched;
+ procedure SetSelAppt(Value: TJvTFAppt);
+ //procedure SetGroupTitles; dynamic;
+ //procedure ReorderCols;
+
+ // All painting routines
+ procedure Paint; override;
+ procedure DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer);
+ procedure DrawEmptyColHdr(ACanvas: TCanvas);
+ procedure DrawAppt(ACanvas: TCanvas; Col: Integer; Appt: TJvTFAppt;
+ StartRow, EndRow: Integer);
+ procedure DrawApptDetail(ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt;
+ Selected: Boolean; Col, StartRow, EndRow: Integer);
+ procedure DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect;
+ Col, StartRow, EndRow: Integer);
+ function CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect;
+ Col, StartRow, EndRow: Integer): TRect;
+ procedure DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect);
+ procedure DrawPics(ACanvas: TCanvas; var ARect: TRect; Appt: TJvTFAppt);
+ procedure CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt; DrawList: TList);
+ procedure FilterPicDrawList(ARect: TRect; DrawList: TList;
+ var PicsHeight: Integer; var PicsWidth: Integer);
+ procedure ClearPicDrawList(DrawList: TList);
+ procedure DrawListPics(ACanvas: TCanvas; var ARect: TRect; DrawList: TList);
+ procedure DrawGrabLines(ACanvas: TCanvas; LineTop, LineLeft,
+ LineRight: Integer);
+ procedure DrawGrabHandle(ACanvas: TCanvas; ARect: TRect;
+ AAppt: TJvTFAppt; TopHandle: Boolean);
+ procedure DrawCorner(ACanvas: TCanvas; Corner: TJvTFDaysCorner);
+ procedure DrawRowHdr(ACanvas: TCanvas; Index: Integer);
+ //procedure DrawColHdr(ACanvas: TCanvas; Index: Integer);
+ function GetTallestColTitle(ACanvas: TCanvas): Integer;
+
+ procedure GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo;
+ AAppt: TJvTFAppt; Attr: TJvTFDaysApptAttr);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok to REPLACE old DrawFrame
+ procedure DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean;
+ FrameColour: TColor);
+ {$ELSE}
+ // obsolete
+ //procedure DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ procedure DrawAppts(ACanvas: TCanvas; DrawAll: Boolean);
+ procedure AdjustForMargins(var ARect: TRect);
+ procedure CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect; PicsHeight: Integer;
+ var CanDrawText, CanDrawPics: Boolean);
+ procedure ManualFocusRect(ACanvas: TCanvas; ARect: TRect);
+ // Fancy painting routines
+ procedure DrawFancyRowHdrs(ACanvas: TCanvas);
+ procedure DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer;
+ const LabelStr: string; TickLength: Integer; Selected: Boolean);
+ function GetMinorLabel(RowNum: Integer): string;
+ function GetMinorTickLength: Integer; virtual;
+ function GetMajorTickLength: Integer; virtual;
+ procedure DrawGroupHdrs(ACanvas: TCanvas);
+ //procedure DrawGroupHdr(ACanvas: TCanvas; ACol: Integer);
+ procedure DrawColGroupHdr(ACanvas: TCanvas; Index: Integer;
+ IsGroupHdr: Boolean);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ procedure DrawBlockHdr(ACanvas: TCanvas; BlockIndex: Integer);
+ // ok
+ procedure FillBlockHdrDeadSpace(ACanvas: TCanvas);
+ // REMOVE, replaced by CalcTextPos in JvTFUtils
+ //procedure CalcTextPos(var ARect: TRect; aAngle: Integer; aTxt: string);
+ // REMOVE, replaced by DrawAngleText in JvTFUtils
+ //procedure DrawAngleText(ACanvas: TCanvas; ARect: TRect; aAngle: Integer;
+ //aTxt: string);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // message handlers
+ procedure Resize; override;
+
+ procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
+ procedure WMSetCursor(var Msg: TLMSetCursor); message LM_SETCURSOR;
+ procedure WMNCHitTest(var Msg: TLMNCHitTest); message LM_NCHITTEST;
+ procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
+ procedure CNRequestRefresh(var Msg: TCNRequestRefresh); message CN_REQUESTREFRESH;
+ procedure WMTimer(var Msg: TLMTimer); message LM_TIMER;
+
+ procedure CMFontChanged(var Msg: TLMessage); message CM_FONTCHANGED;
+ procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
+ procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE;
+
+ // internal routines
+ procedure Loaded; override;
+ procedure RefreshControl; override;
+ procedure UpdateDesigner;
+
+ // scroll bar stuff
+ procedure CheckSBParams;
+ procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
+ var ScrollPos: Integer);
+ property VisibleScrollBars: TJvTFVisibleScrollBars read FVisibleScrollBars
+ write SetTFVisibleScrollBars;
+
+ // mouse routines
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure DblClick; override;
+ procedure DoApptHint(GridCoord: TJvTFDaysCoord);
+ procedure DoCellHint(GridCoord: TJvTFDaysCoord);
+
+ // Drag/Drop routines
+ procedure DoStartDrag(var DragObject: TDragObject); override;
+ procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
+ var Accept: Boolean); override;
+ procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
+ procedure DropAppt(ADragInfo: TJvTFDragInfo; X, Y: Integer);
+
+ procedure BeginDragging(Coord: TJvTFDaysCoord; DragWhat: TJvTFDaysState;
+ Appt: TJvTFAppt);
+ procedure DrawDrag(Coord: TJvTFDaysCoord; AAppt: TJvTFAppt; AClear: Boolean);
+ procedure ContinueDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt);
+ procedure EndDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt);
+ function CanDragWhat(Coord: TJvTFDaysCoord): TJvTFDaysState;
+ procedure CalcSizeEndTime(Appt: TJvTFAppt; var NewEndDT: TDateTime);
+ procedure CalcMoveStartEnd(Appt: TJvTFAppt; Coord: TJvTFDaysCoord;
+ KeepDates, KeepTimes: Boolean; var StartDT, EndDT: TDateTime);
+
+ procedure KillAutoScrollTimer;
+
+ procedure EnsureCol(ACol: Integer);
+ procedure EnsureRow(ARow: Integer);
+
+ // navigation
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char); override;
+ procedure DoInsertSchedule; dynamic;
+ procedure DoInsertAppt; dynamic;
+ procedure DoDeleteAppt; dynamic;
+ procedure DoDeleteSchedule; dynamic;
+// procedure DoNavigate; virtual;
+
+ function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
+ function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
+ procedure DestroyApptNotification(AAppt: TJvTFAppt); override;
+ procedure Navigate(AControl: TJvTFControl; SchedNames: TStringList;
+ Dates: TJvTFDateList); override;
+
+ procedure DoEnter; override;
+ procedure DoExit; override;
+
+ // Selection methods
+ function GetSelStart: TPoint;
+ function GetSelEnd: TPoint;
+ procedure SetSelStart(Value: TPoint);
+ procedure SetSelEnd(Value: TPoint);
+ procedure QuickEntry(Key: Char); virtual;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ procedure EnsureBlockRules(GridGran, BlockGran: Integer; DayStart: TTime);
+ // ok
+ function ValidateBlockRules(GridGran, BlockGran: Integer;
+ DayStart: TTime): Boolean;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ { Lazarus }
+ class function GetControlClassDefaultSize: TSize; override;
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ function GetTFHintClass: TJvTFHintClass; dynamic;
+
+ // move grab handles
+ function GetTopGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect;
+ // move grab handles
+ function GetBottomGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect;
+ function PtInTopHandle(APoint: TPoint; Col: Integer; Appt: TJvTFAppt): Boolean;
+ function PtInBottomHandle(APoint: TPoint; Col: Integer; Appt: TJvTFAppt): Boolean;
+
+ // grid region functions
+ function GetAdjClientRect: TRect;
+ function GetDataAreaRect: TRect;
+ function GetDataWidth: Integer;
+ function GetDataHeight: Integer;
+ function PtToCell(X, Y: Integer): TJvTFDaysCoord;
+ function CellRect(Col, Row: Integer): TRect;
+ function VirtualCellRect(Col, Row: Integer): TRect;
+ function GetApptRect(Col: Integer; Appt: TJvTFAppt): TRect;
+ function LocateDivCol(X, TotalWidth, SegCount: Integer): Integer;
+ function CalcGroupHdrHeight: Integer;
+ function CalcGroupColHdrsHeight: Integer;
+ function VirtualGroupHdrRect(Col: Integer): TRect;
+ procedure GetGroupStartEndCols(Col: Integer; var StartCol, EndCol: Integer);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ function RowToTimeBlock(ARow: Integer): Integer;
+ // ok
+ procedure GetTimeBlockStartEnd(ATimeBlock: Integer; var BlockStart,
+ BlockEnd: Integer);
+ // ok
+ function CalcBlockHdrWidth: Integer;
+ // ok
+ function CalcBlockRowHdrsWidth: Integer;
+ // ok
+ procedure GetBlockStartEndRows(Row: Integer; var StartRow, EndRow: Integer);
+ // ok
+ function VirtualBlockHdrRect(Row: Integer): TRect;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // editor management routines
+ procedure EditAppt(Col: Integer; Appt: TJvTFAppt);
+ procedure FinishEditAppt;
+ function Editing: Boolean;
+ function CanEdit: Boolean; dynamic;
+
+ // grid layout routines
+ function RowsPerHour: Integer;
+ function RowCount: Integer;
+ function PossVisibleRows: Integer;
+ function VisibleRows: Integer;
+ function FullVisibleRows: Integer;
+ function VisibleCols: Integer;
+ function FullVisibleCols: Integer;
+ function RowToTime(RowNum: Integer): TTime;
+ function TimeToRow(ATime: TTime): Integer;
+ procedure TimeToTop(ATime: TTime);
+ function AdjustEndTime(ATime: TTime): TTime; dynamic;
+ function RowStartsHour(RowNum: Integer): Boolean;
+ function RowEndsHour(RowNum: Integer): Boolean;
+ function RowEndTime(RowNum: Integer): TTime;
+
+ function RowToHour(RowNum: Integer): Word;
+ function HourStartRow(Hour: Word): Integer;
+ function HourEndRow(Hour: Word): Integer;
+
+ property State: TJvTFDaysState read FState;
+ function BottomRow: Integer;
+ function RightCol: Integer;
+ property SelAppt: TJvTFAppt read FSelAppt write SetSelAppt;
+ property FocusedSchedule: TJvTFSched read GetFocusedSchedule;
+
+ procedure DragDrop(Source: TObject; X, Y: Integer); override;
+ procedure CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate;
+ var StartRow, EndRow: Integer);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ function IsWeekend(ColIndex: Integer): Boolean;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // date navigation methods
+ procedure PrevDate;
+ procedure NextDate;
+ procedure GotoDate(aDate: TDate);
+ procedure ScrollDays(NumDays: Integer);
+ procedure ScrollMonths(NumMonths: Integer);
+ procedure ScrollYears(NumYears: Integer);
+
+ procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); override;
+ procedure RowInView(ARow: Integer);
+ procedure ColInView(ACol: Integer);
+
+ // selection properties and methods
+ property FocusedCol: Integer read GetFocusedCol write SetFocusedCol;
+ property FocusedRow: Integer read GetFocusedRow write SetFocusedRow;
+ property SelStart: TPoint read GetSelStart write SetSelStart;
+ property SelEnd: TPoint read GetSelEnd write SetSelEnd;
+ function CellIsSelected(ACell: TPoint): Boolean;
+ function ColIsSelected(ACol: Integer): Boolean;
+ function RowIsSelected(ARow: Integer): Boolean;
+ procedure ClearSelection;
+ function ValidSelection: Boolean;
+ procedure SelFirstAppt;
+ procedure SelPrevAppt;
+ procedure SelNextAppt;
+ procedure SelLastAppt;
+ procedure SelFirstApptNextCol;
+ procedure SelFirstApptPrevCol;
+ procedure ApptInView(AAppt: TJvTFAppt; ACol: Integer);
+ procedure SelApptCell(AAppt: TJvTFAppt; ACol: Integer);
+ function GroupHdrIsSelected(ACol: Integer): Boolean;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ function BlockHdrIsSelected(ARow: Integer): Boolean;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ function EnumSelCells: TDynPointArray;
+ function EnumSelCols: TDynIntArray;
+ function EnumSelRows: TDynIntArray;
+
+ function GetApptDispColor(Appt: TJvTFAppt; Selected: Boolean): TColor;
+ published
+ property DitheredBackground: Boolean read FDitheredBackground write SetDitheredBackground default True;
+// property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
+ // grid layout properties
+ property AutoSizeCols: Boolean read FAutoSizeCols write SetAutoSizeCols default True;
+ property Granularity: Integer read FGranularity write SetGranularity default 30;
+ property ColHdrHeight: Integer read FColHdrHeight write SetColHdrHeight default 25;
+ property Cols: TJvTFDaysCols read FCols write SetCols;
+ property DefColWidth: Integer read FDefColWidth write FDefColWidth default 100;
+ property MinColWidth: Integer read FMinColWidth write SetMinColWidth default AbsMinColWidth;
+ property MinRowHeight: Integer read FMinRowHeight write SetMinRowHeight default 12;
+ property Options: TJvTFDaysOptions read FOptions write SetOptions
+ default [agoSizeCols, agoSizeRows, agoSizeColHdr, agoSizeRowHdr,
+ agoSizeAppt, agoMoveAppt, agoEditing, agoShowPics,
+ agoShowText, agoShowApptHints, agoQuickEntry, agoShowSelHint];
+ property RowHdrWidth: Integer read FRowHdrWidth write SetRowHdrWidth default 50;
+ property RowHeight: Integer read FRowHeight write SetRowHeight default 19;
+ property ShowFocus:Boolean read FShowFocus write SetShowFocus default True;
+ property Template: TJvTFDaysTemplate read FTemplate write FTemplate;
+ property Grouping: TJvTFDaysGrouping read FGrouping write SetGrouping;
+ property GroupHdrHeight: Integer read FGroupHdrHeight write SetGroupHdrHeight default 25;
+
+ property GridStartTime: TTime read FGridStartTime write SetGridStartTime;
+ property GridEndTime: TTime read FGridEndTime write SetGridEndTime;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ property TimeBlocks: TJvTFDaysTimeBlocks read FTimeBlocks write SetTimeBlocks;
+ property TimeBlockProps: TJvTFDaysBlockProps read FTimeBlockProps write SetTimeBlockProps;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // visual appearance properties
+ property ApptAttr: TJvTFDaysApptAttr read FApptAttr write SetApptAttr;
+ property SelApptAttr: TJvTFDaysApptAttr read FSelApptAttr write SetSelApptAttr;
+ property HdrAttr: TJvTFDaysHdrAttr read FHdrAttr write SetHdrAttr;
+ property SelHdrAttr: TJvTFDaysHdrAttr read FSelHdrAttr write SetSelHdrAttr;
+ property FancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr read FFancyRowHdrAttr
+ write SetFancyRowHdrAttr;
+ property SelFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr
+ read FSelFancyRowHdrAttr write SetSelFancyRowHdrAttr;
+ property SelCellAttr: TJvTFSelCellAttr read FSelCellAttr write SetTFSelCellAttr;
+
+ property ApptBar: TJvTFDaysApptBar read FApptBar write SetApptBar;
+ property ApptBuffer: Integer read FApptBuffer write SetApptBuffer default 5;
+ property ColTitleStyle: TJvTFColTitleStyle read FColTitleStyle
+ write SetTFColTitleStyle default ctsSingleEllipsis;
+ property GrabHandles: TJvTFDaysGrabHandles read FGrabHandles
+ write SetGrabHandles;
+ property GridLineColor: TColor read FGridLineColor write SetGridLineColor
+ default clGray;
+ property PrimeTime: TJvTFDaysPrimeTime read FPrimeTime write FPrimeTime;
+ property RowHdrType: TJvTFRowHdrType read FRowHdrType write SetTFRowHdrType
+ default rhFancy;
+ property Thresholds: TJvTFDaysThresholds read FThresholds write FThresholds;
+ property HintProps: TJvTFHintProps read FHintProps
+ write SetTFHintProps;
+ property GroupHdrAttr: TJvTFDaysHdrAttr read FGroupHdrAttr
+ write SetGroupHdrAttr;
+ property SelGroupHdrAttr: TJvTFDaysHdrAttr read FSelGroupHdrAttr
+ write SetSelGroupHdrAttr;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ property Weekend: TTFDaysOfWeek read FWeekend write SetWeekend
+ default [dowSunday, dowSaturday];
+ property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clSilver;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // navigation/selection properties
+ property LeftCol: Integer read FLeftCol write SetLeftCol;
+ property TopRow: Integer read FTopRow write SetTopRow default 0;
+
+ // Drag/Drop events
+ property OnDropAppt: TJvTFDropApptEvent read FOnDropAppt write FOnDropAppt;
+ property OnSizeAppt: TJvTFSizeApptEvent read FOnSizeAppt write FOnSizeAppt;
+
+ // Grid Layout events
+ property OnSizeCol: TJvTFDragRowColEvent read FOnSizeCol write FOnSizeCol;
+ property OnSizeRow: TJvTFDragRowColEvent read FOnSizeRow write FOnSizeRow;
+ property OnSizeColHdr: TJvTFDragRowColEvent read FOnSizeColHdr write FOnSizeColHdr;
+ property OnSizeRowHdr: TJvTFDragRowColEvent read FOnSizeRowHdr write FOnSizeRowHdr;
+ property OnMoveCol: TJvTFDragRowColEvent read FOnMoveCol write FOnMoveCol;
+
+ property OnDateChanging: TJvTFDateChangingEvent read FOnDateChanging
+ write FOnDateChanging;
+ property OnDateChanged: TNotifyEvent read FOnDateChanged write FOnDateChanged;
+ property OnGranularityChanging: TJvTFGranChangingEvent read FOnGranularityChanging
+ write FOnGranularityChanging;
+ property OnGranularityChanged: TNotifyEvent read FOnGranularityChanged
+ write FOnGranularityChanged;
+
+ // Custom draw events
+ property OnDrawAppt: TJvTFDrawApptEvent read FOnDrawAppt write FOnDrawAppt;
+ property OnDrawApptBar: TJvTFDrawApptBarEvent read FOnDrawApptBar
+ write FOnDrawApptBar;
+ property OnDrawColHdr: TJvTFDrawHdrEvent read FOnDrawColHdr write FOnDrawColHdr;
+ property OnDrawCorner: TJvTFDrawCornerEvent read FOnDrawCorner
+ write FOnDrawCorner;
+ property OnDrawDataCell: TJvTFDrawDataCellEvent read FOnDrawDataCell
+ write FOnDrawDataCell;
+ property OnDrawGrabHandle: TJvTFDrawGrabHandleEvent read FOnDrawGrabHandle
+ write FOnDrawGrabHandle;
+ property OnDrawMajorRowHdr: TJvTFDrawHdrEvent read FOnDrawMajorRowHdr
+ write FOnDrawMajorRowHdr;
+ property OnDrawMinorRowHdr: TJvTFDrawHdrEvent read FOnDrawMinorRowHdr
+ write FOnDrawMinorRowHdr;
+ property OnDrawRowHdr: TJvTFDrawHdrEvent read FOnDrawRowHdr write FOnDrawRowHdr;
+ property OnDrawGroupHdr: TJvTFDrawHdrEvent read FOnDrawGroupHdr
+ write FOnDrawGroupHdr;
+ property OnShadeCell: TJvTFShadeCellEvent read FOnShadeCell write FOnShadeCell;
+ property OnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent read FOnGetApptDrawInfo
+ write FOnGetApptDrawInfo;
+
+ // Input events
+ property OnFailEditor: TJvTFFailEditorEvent read FOnFailEditor write FOnFailEditor;
+ property OnInsertAppt: TNotifyEvent read FOnInsertAppt write FOnInsertAppt;
+ property OnInsertSchedule: TNotifyEvent read FOnInsertSchedule
+ write FOnInsertSchedule;
+ property OnDeleteAppt: TNotifyEvent read FOnDeleteAppt write FOnDeleteAppt;
+ property OnDeleteSchedule: TNotifyEvent read FOnDeleteSchedule
+ write FOnDeleteSchedule;
+ property OnCreateQuickEntry: TJvTFCreateQuickEntryEvent read FOnCreateQuickEntry
+ write FOnCreateQuickEntry;
+ property OnQuickEntry: TNotifyEvent read FOnQuickEntry write FOnQuickEntry;
+ property OnBeginEdit: TJvTFBeginEditEvent read FOnBeginEdit write FOnBeginEdit;
+
+ // Help and Hint events
+ property OnShowHint: TJvTFShowHintEvent read GetOnShowHint
+ write SetOnShowHint;
+
+ // Misc events
+ property OnSelectingAppt: TJvTFVarApptEvent read FOnSelectingAppt
+ write FOnSelectingAppt;
+ property OnSelectAppt: TJvTFSelecTJvTFApptEvent read FOnSelectAppt
+ write FOnSelectAppt;
+ property OnSelectedAppt: TNotifyEvent read FOnSelectedAppt
+ write FOnSelectedAppt;
+ //property OnUpdateColTitle: TJvTFUpdateTitleEvent read FOnUpdateColTitle
+ //write FOnUpdateColTitle;
+ property OnUpdateColTitles: TJvTFUpdateTitlesEvent read FOnUpdateColTitles
+ write FOnUpdateColTitles;
+ property OnFocusedRowChanged: TNotifyEvent read FOnFocusedRowChanged
+ write FOnFocusedRowChanged;
+ property OnFocusedColChanged: TNotifyEvent read FOnFocusedColChanged
+ write FOnFocusedColChanged;
+
+ //Inherited properties
+ property DateFormat; // from TJvTFControl
+ property TimeFormat; // from TJvTFControl
+// property Navigator; // from TJvTFControl
+// property OnNavigate; // from TJvTFControl
+
+ property Align;
+ property BorderSpacing;
+ property BorderStyle;
+ property Color default clSilver;
+ property ParentColor default False;
+ property Font;
+ property ParentFont;
+ property TabStop;
+ property TabOrder;
+ property Anchors;
+ property Constraints;
+ property DragKind;
+ property DragCursor;
+ property DragMode;
+ property Enabled;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property Visible;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
+ property OnEndDock;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+ TJvTFDaysPrinterPageLayout = class(TJvTFPrinterPageLayout)
+ private
+ FColsPerPage: Integer;
+ FRowsPerPage: Integer;
+ FAlwaysShowColHdr: Boolean;
+ FAlwaysShowRowHdr: Boolean;
+ procedure SetColsPerPage(Value: Integer);
+ procedure SetRowsPerPage(Value: Integer);
+ procedure SetAlwaysShowColHdr(Value: Boolean);
+ procedure SetAlwaysShowRowHdr(Value: Boolean);
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property ColsPerPage: Integer read FColsPerPage write SetColsPerPage;
+ property RowsPerPage: Integer read FRowsPerPage write SetRowsPerPage;
+ property AlwaysShowColHdr: Boolean read FAlwaysShowColHdr
+ write SetAlwaysShowColHdr;
+ property AlwaysShowRowHdr: Boolean read FAlwaysShowRowHdr
+ write SetAlwaysShowRowHdr;
+ end;
+
+ TJvTFDaysPageInfo = class(TObject)
+ private
+ FPageNum: Integer;
+ FStartRow: Integer;
+ FEndRow: Integer;
+ FStartCol: Integer;
+ FEndCol: Integer;
+ FRowHeight: Integer;
+ FColWidth: Integer;
+ FShowRowHdr: Boolean;
+ FShowColHdr: Boolean;
+ public
+ property PageNum: Integer read FPageNum write FPageNum;
+ property StartRow: Integer read FStartRow write FStartRow;
+ property EndRow: Integer read FEndRow write FEndRow;
+ property StartCol: Integer read FStartCol write FStartCol;
+ property EndCol: Integer read FEndCol write FEndCol;
+ property RowHeight: Integer read FRowHeight write FRowHeight;
+ property ColWidth: Integer read FColWidth write FColWidth;
+ property ShowRowHdr: Boolean read FShowRowHdr write FShowRowHdr;
+ property ShowColHdr: Boolean read FShowColHdr write FShowColHdr;
+ end;
+
+ TJvTFDaysPrinter = class(TJvTFPrinter)
+ private
+ FApptCount: Integer;
+ FApptAttr: TJvTFDaysApptAttr;
+ FApptBar: TJvTFDaysApptBar;
+ FApptBuffer: Integer;
+ FColHdrHeight: Integer;
+ FColor: TColor;
+ FCols: TJvTFDaysCols;
+ FColTitleStyle: TJvTFColTitleStyle;
+ FFancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr;
+ FGranularity: Integer;
+ FGridLineColor: TColor;
+ FGroupHdrAttr: TJvTFDaysHdrAttr;
+ FGroupHdrHeight: Integer;
+ FGrouping: TJvTFDaysGrouping;
+ FHdrAttr: TJvTFDaysHdrAttr;
+ FMinColWidth: Integer;
+ FMinRowHeight: Integer;
+ FPrimeTime: TJvTFDaysPrimeTime;
+ FRowHdrType: TJvTFRowHdrType;
+ FRowHdrWidth: Integer;
+ FRowHeight: Integer;
+ FShowPics: Boolean;
+ FShowText: Boolean;
+ FFormattedDesc: Boolean;
+ FThresholds: TJvTFDaysThresholds;
+ FOnDrawCorner: TJvTFDrawCornerEvent;
+ //FOnUpdateColTitle: TJvTFUpdateTitleEvent;
+ FOnUpdateColTitles: TJvTFUpdateTitlesEvent;
+ FOnDrawColHdr: TJvTFDrawHdrEvent;
+ FOnDrawGroupHdr: TJvTFDrawHdrEvent;
+ FOnDrawRowHdr: TJvTFDrawHdrEvent;
+ FOnDrawMinorRowHdr: TJvTFDrawHdrEvent;
+ FOnDrawMajorRowHdr: TJvTFDrawHdrEvent;
+ FOnDrawDataCell: TJvTFDrawDataCellEvent;
+ FOnDrawAppt: TJvTFDrawApptEvent;
+ FOnDrawApptBar: TJvTFDrawApptBarEvent;
+ FOnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent;
+ FOnShadeCell: TJvTFShadeCellEvent;
+ FOnApptProgress: TJvTFProgressEvent;
+ FGridStartTime: TTime;
+ FGridEndTime: TTime;
+ procedure SetApptAttr(Value: TJvTFDaysApptAttr);
+ procedure SetApptBar(Value: TJvTFDaysApptBar);
+ procedure SetApptBuffer(Value: Integer);
+ procedure SetColHdrHeight(Value: Integer);
+ procedure SetColor(Value: TColor);
+ procedure SetCols(Value: TJvTFDaysCols);
+ procedure SetTFColTitleStyle(Value: TJvTFColTitleStyle);
+ procedure SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr);
+ procedure SetGranularity(Value: Integer);
+ procedure SetGridLineColor(Value: TColor);
+ procedure SetGroupHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetGroupHdrHeight(Value: Integer);
+ procedure SetGrouping(Value: TJvTFDaysGrouping);
+ procedure SetHdrAttr(Value: TJvTFDaysHdrAttr);
+ procedure SetMinColWidth(Value: Integer);
+ procedure SetMinRowHeight(Value: Integer);
+ procedure SetPrimeTime(Value: TJvTFDaysPrimeTime);
+ procedure SetTFRowHdrType(Value: TJvTFRowHdrType);
+ procedure SetRowHdrWidth(Value: Integer);
+ procedure SetRowHeight(Value: Integer);
+ procedure SetShowPics(Value: Boolean);
+ procedure SetShowText(Value: Boolean);
+ procedure SetThresholds(Value: TJvTFDaysThresholds);
+ procedure SetFormattedDesc(Value: Boolean);
+ function GetApptCount: Integer;
+ procedure SetGridStartTime(Value: TTime);
+ procedure SetGridEndTime(Value: TTime);
+ protected
+ FPageInfoList: TStringList;
+ FApptsDrawn: Integer;
+ FValidPageInfo: Boolean;
+ procedure SetMeasure(Value: TJvTFPrinterMeasure); override;
+ procedure DrawBody(ACanvas: TCanvas; ARect: TRect; PageNum: Integer); override;
+
+ procedure Loaded; override;
+
+ // Drawing routines
+ procedure DrawCorner(ACanvas: TCanvas);
+ procedure DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean);
+ procedure DrawEmptyColHdr(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo);
+ //procedure DrawColHdr(ACanvas: TCanvas; Index: Integer;
+ //PageInfo: TJvTFDaysPageInfo);
+ procedure DrawColGroupHdr(ACanvas: TCanvas; Index: Integer;
+ PageInfo: TJvTFDaysPageInfo; IsGroupHdr: Boolean);
+ procedure DrawRowHdr(ACanvas: TCanvas; Index: Integer;
+ PageInfo: TJvTFDaysPageInfo);
+ procedure DrawGroupHdrs(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo);
+
+ procedure DrawFancyRowHdrs(ACanvas: TCanvas; PageInfo: TJvTFDaysPageInfo);
+ procedure DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer;
+ const LabelStr: string; TickLength: Integer);
+ function GetMinorLabel(RowNum: Integer; PageInfo: TJvTFDaysPageInfo): string;
+ function GetMinorTickLength(ACanvas: TCanvas): Integer; virtual;
+ function GetMajorTickLength: Integer; virtual;
+
+ procedure DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer;
+ PageInfo: TJvTFDaysPageInfo);
+ procedure DrawAppts(ACanvas: TCanvas; DrawAll: Boolean;
+ PageInfo: TJvTFDaysPageInfo);
+ procedure PrintBitmap(ACanvas: TCanvas; SourceRect, DestRect: TRect;
+ aBitmap: TBitmap);
+ procedure DrawAppt(ACanvas: TCanvas; Col: Integer; Appt: TJvTFAppt;
+ StartRow, EndRow: Integer; PageInfo: TJvTFDaysPageInfo);
+ procedure DrawApptDetail(ACanvas: TCanvas; ARect: TRect; Appt: TJvTFAppt;
+ Col, StartRow, EndRow: Integer);
+ procedure DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt; BarRect: TRect;
+ Col, StartRow, EndRow: Integer);
+ function CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect;
+ Col, StartRow, EndRow: Integer): TRect;
+ procedure DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect);
+ procedure GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo; Appt: TJvTFAppt);
+
+ procedure CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt; DrawList: TList);
+ procedure FilterPicDrawList(ARect: TRect; DrawList: TList;
+ var PicsHeight: Integer; var PicsWidth: Integer);
+ procedure CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect;
+ PicsHeight, PicsWidth: Integer; var CanDrawText, CanDrawPics: Boolean);
+ procedure DrawListPics(ACanvas: TCanvas; var ARect: TRect; DrawList: TList);
+ procedure ClearPicDrawList(DrawList: TList);
+
+ function GetDataWidth(ShowRowHdr: Boolean): Integer;
+ function GetDataHeight(ShowColHdr: Boolean): Integer;
+ procedure EnsureRow(RowNum: Integer);
+ procedure CreateLayout; override;
+ procedure ClearPageInfo;
+ procedure CalcPageInfo; dynamic;
+ procedure CalcPageRowInfo(ShowColHdrs: Boolean; var CalcRowsPerPage,
+ CalcRowHeight: Integer);
+ procedure CalcPageColInfo(ShowRowHdrs: Boolean; var CalcColsPerPage,
+ CalcColWidth: Integer);
+ function GetPageLayout: TJvTFDaysPrinterPageLayout;
+ procedure SetPageLayout(Value: TJvTFDaysPrinterPageLayout);
+ procedure CreateDoc; override;
+ function GetPageInfo(PageNum: Integer): TJvTFDaysPageInfo;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetProperties(aJvTFDays: TJvTFDays); dynamic;
+ function RowCount: Integer;
+ function TimeToRow(ATime: TTime): Integer;
+ function RowToTime(RowNum: Integer): TTime;
+ function RowToHour(RowNum: Integer): Word;
+ function RowStartsHour(RowNum: Integer): Boolean;
+ function RowEndsHour(RowNum: Integer): Boolean;
+ function HourStartRow(Hour: Word): Integer;
+ function HourEndRow(Hour: Word): Integer;
+ function RowEndTime(RowNum: Integer): TTime;
+ function AdjustEndTime(ATime: TTime): TTime;
+ function DaysPageLayout: TJvTFDaysPrinterPageLayout;
+ function CellRect(Col, Row: Integer; PageInfo: TJvTFDaysPageInfo): TRect;
+ function GetApptRect(Col: Integer; Appt: TJvTFAppt;
+ PageInfo: TJvTFDaysPageInfo): TRect;
+ function GetApptDispColor(Appt: TJvTFAppt): TColor;
+ procedure CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate;
+ var StartRow, EndRow: Integer);
+ procedure Prepare; dynamic;
+ property ApptCount: Integer read GetApptCount;
+ property PageInfo[PageNum: Integer]: TJvTFDaysPageInfo read GetPageInfo;
+ procedure FreeDoc; override;
+ procedure PrintDirect; virtual;
+ function CalcGroupHdrHeight: Integer;
+ function CalcGroupColHdrsHeight: Integer;
+ function VirtualGroupHdrRect(Col: Integer; APageInfo: TJvTFDaysPageInfo): TRect;
+ procedure GetGroupStartEndCols(Col: Integer; var StartCol, EndCol: Integer);
+ published
+ property PageLayout: TJvTFDaysPrinterPageLayout read GetPageLayout
+ write SetPageLayout;
+ property ApptAttr: TJvTFDaysApptAttr read FApptAttr write SetApptAttr;
+ property ApptBar: TJvTFDaysApptBar read FApptBar write SetApptBar;
+ property ApptBuffer: Integer read FApptBuffer write SetApptBuffer;
+ property ColHdrHeight: Integer read FColHdrHeight write SetColHdrHeight;
+ property Color: TColor read FColor write SetColor;
+ property Cols: TJvTFDaysCols read FCols write SetCols;
+ property ColTitleStyle: TJvTFColTitleStyle read FColTitleStyle
+ write SetTFColTitleStyle;
+ property DateFormat; // inherited
+ property FancyRowHdrAttr: TJvTFDaysFancyRowHdrAttr read FFancyRowHdrAttr
+ write SetFancyRowHdrAttr;
+ property FormattedDesc: Boolean read FFormattedDesc write SetFormattedDesc;
+ property Granularity: Integer read FGranularity write SetGranularity;
+ property GridLineColor: TColor read FGridLineColor write SetGridLineColor;
+ property GroupHdrAttr: TJvTFDaysHdrAttr read FGroupHdrAttr
+ write SetGroupHdrAttr;
+ property GroupHdrHeight: Integer read FGroupHdrHeight
+ write SetGroupHdrHeight default 25;
+ property Grouping: TJvTFDaysGrouping read FGrouping write SetGrouping;
+ property HdrAttr: TJvTFDaysHdrAttr read FHdrAttr write SetHdrAttr;
+ property MinColWidth: Integer read FMinColWidth write SetMinColWidth;
+ property MinRowHeight: Integer read FMinRowHeight write SetMinRowHeight;
+ property PrimeTime: TJvTFDaysPrimeTime read FPrimeTime write SetPrimeTime;
+ property RowHdrType: TJvTFRowHdrType read FRowHdrType write SetTFRowHdrType;
+ property RowHdrWidth: Integer read FRowHdrWidth write SetRowHdrWidth;
+ property RowHeight: Integer read FRowHeight write SetRowHeight;
+ property ShowPics: Boolean read FShowPics write SetShowPics;
+ property ShowText: Boolean read FShowText write SetShowText;
+ property Thresholds: TJvTFDaysThresholds read FThresholds
+ write SetThresholds;
+ property TimeFormat; // inherited;
+ property OnDrawCorner: TJvTFDrawCornerEvent read FOnDrawCorner
+ write FOnDrawCorner;
+ property OnDrawGroupHdr: TJvTFDrawHdrEvent read FOnDrawGroupHdr
+ write FOnDrawGroupHdr;
+ property OnDrawMinorRowHdr: TJvTFDrawHdrEvent read FOnDrawMinorRowHdr
+ write FOnDrawMinorRowHdr;
+ property OnDrawMajorRowHdr: TJvTFDrawHdrEvent read FOnDrawMajorRowHdr
+ write FOnDrawMajorRowHdr;
+ //property OnUpdateColTitle: TJvTFUpdateTitleEvent read FOnUpdateColTitle
+ //write FOnUpdateColTitle;
+ property OnUpdateColTitles: TJvTFUpdateTitlesEvent read FOnUpdateColTitles
+ write FOnUpdateColTitles;
+ property OnDrawColHdr: TJvTFDrawHdrEvent read FOnDrawColHdr write FOnDrawColHdr;
+ property OnDrawRowHdr: TJvTFDrawHdrEvent read FOnDrawRowHdr write FOnDrawRowHdr;
+ property OnDrawDataCell: TJvTFDrawDataCellEvent read FOnDrawDataCell
+ write FOnDrawDataCell;
+ property OnDrawAppt: TJvTFDrawApptEvent read FOnDrawAppt write FOnDrawAppt;
+ property OnDrawApptBar: TJvTFDrawApptBarEvent read FOnDrawApptBar
+ write FOnDrawApptBar;
+ property OnGetApptDrawInfo: TJvTFGetDaysApptDrawInfoEvent read FOnGetApptDrawInfo
+ write FOnGetApptDrawInfo;
+ property OnShadeCell: TJvTFShadeCellEvent read FOnShadeCell write FOnShadeCell;
+ property OnApptProgress: TJvTFProgressEvent read FOnApptProgress
+ write FOnApptProgress;
+ property GridStartTime: TTime read FGridStartTime write SetGridStartTime;
+ property GridEndTime: TTime read FGridEndTime write SetGridEndTime;
+ end;
+
+
+implementation
+
+uses
+ JvResources;
+
+//Type
+ // DEF TIMEBLOCK (not conditionally compiled, just marked for reference)
+ // removed as part of TimeBlock integration
+ //TVertAlignment = (vaTop, vaCenter, vaBottom);
+
+// Utility routines
+// Most, if not all, of these will be moved out of this unit and into
+// a utilities unit.
+
+function StripCRLF(const S: string): string;
+var
+ I: Integer;
+begin
+ Result := '';
+ for I := 1 to Length(S) do
+ if (S[I] <> #13) and (S[I] <> #10) then
+ Result := Result + S[I];
+end;
+
+function EmptyRect: TRect;
+begin
+ Result := Classes.Rect(0, 0, 0, 0);
+end;
+
+function RectWidth(ARect: TRect): Integer;
+begin
+ Result := ARect.Right - ARect.Left;
+end;
+
+function RectHeight(ARect: TRect): Integer;
+begin
+ Result := ARect.Bottom - ARect.Top;
+end;
+
+// DEF TIMEBLOCK (not conditionally compiled, just marked for reference)
+// the type of VAlign was orginally TVertAlignment
+
+procedure DrawTxt(ACanvas: TCanvas; ARect: TRect;
+ const Txt: string; HAlign: TAlignment; VAlign: TJvTFVAlignment);
+var
+ TxtWidth, TxtHeight, TxtLeft, TxtTop: Integer;
+begin
+ TxtLeft := 0;
+ TxtTop := 0;
+ TxtWidth := ACanvas.TextWidth(Txt);
+ TxtHeight := ACanvas.TextHeight('Wq');
+
+ case HAlign of
+ taLeftJustify:
+ TxtLeft := ARect.Left;
+ taCenter:
+ TxtLeft := ARect.Left + RectWidth(ARect) div 2 - TxtWidth div 2;
+ taRightJustify:
+ TxtLeft := ARect.Right - TxtWidth;
+ end;
+
+ case VAlign of
+ vaTop:
+ TxtTop := ARect.Top;
+ vaCenter:
+ TxtTop := ARect.Top + RectHeight(ARect) div 2 - TxtHeight div 2;
+ vaBottom:
+ TxtTop := ARect.Bottom - TxtHeight;
+ end;
+
+ ACanvas.TextRect(ARect, TxtLeft, TxtTop, Txt);
+end;
+
+function Greater(I1, I2: Integer): Integer;
+begin
+ if I1 > I2 then
+ Result := I1
+ else
+ Result := I2;
+end;
+
+function Lesser(I1, I2: Integer): Integer;
+begin
+ if I1 < I2 then
+ Result := I1
+ else
+ Result := I2;
+end;
+
+//=== { TJvTFDaysTemplate } ==================================================
+
+constructor TJvTFDaysTemplate.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create;
+ FGrid := AApptGrid;
+
+ FCompNames := TJvTFCompNamesList.Create;
+ FCompNames.OnChange := @CompNamesChanged;
+ FCompNames.OnMove := @CompNamesMoved;
+
+ FLinearStartDate := Date;
+ FLinearEndDate := Date;
+ FLinearDayCount := 1;
+ FCompDate := Date;
+ FActiveTemplate := agtNone;
+ FShortTitles := True;
+end;
+
+destructor TJvTFDaysTemplate.Destroy;
+begin
+ FCompNames.OnChange := nil;
+ FCompNames.OnMove := nil;
+ FCompNames.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysTemplate.SetActiveTemplate(Value: TJvTFDaysTemplates);
+begin
+ if Value <> FActiveTemplate then
+ begin
+ FActiveTemplate := Value;
+ UpdateGrid;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.SetCompDate(Value: TDate);
+var
+ I: Integer;
+begin
+ if Trunc(Value) <> Trunc(FCompDate) then
+ begin
+ DoDateChangingEvent(Value);
+
+ FCompDate := Value;
+ if (ActiveTemplate = agtComparative) and Assigned(FGrid) then
+ try
+ BeginGridUpdate;
+ for I := 0 to FGrid.Cols.Count - 1 do
+ FGrid.Cols[I].SchedDate := CompDate;
+ finally
+ EndGridUpdate;
+ end;
+
+ DoDateChangedEvent;
+ end;
+end;
+
+function TJvTFDaysTemplate.GetCompNames: TStrings;
+begin
+ Result := FCompNames;
+end;
+
+procedure TJvTFDaysTemplate.SetCompNames(Value: TStrings);
+begin
+ FCompNames.Assign(Value);
+ CompNamesChanged(Self);
+end;
+
+procedure TJvTFDaysTemplate.SetLinearDayCount(Value: Integer);
+begin
+ if Value < 1 then
+ Value := 1;
+
+ if (Value <> FLinearDayCount) then
+ begin
+ FLinearDayCount := Value;
+ if not (csLoading in FGrid.ComponentState) then
+ begin
+ FLinearEndDate := FLinearStartDate + Value - 1;
+ LinearDaysChanged;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.SetLinearEndDate(Value: TDate);
+begin
+ if Trunc(Value) < Trunc(FLinearStartDate) then
+ Value := FLinearStartDate;
+
+ if (Trunc(Value) <> Trunc(FLinearEndDate)) then
+ begin
+ FLinearEndDate := Value;
+ if not (csLoading in FGrid.ComponentState) then
+ begin
+ FLinearDayCount := Trunc(FLinearEndDate - FLinearStartDate + 1);
+ LinearDaysChanged;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.SetLinearName(const Value: string);
+var
+ I: Integer;
+begin
+ if Value <> FLinearName then
+ begin
+ FLinearName := Value;
+ if (ActiveTemplate = agtLinear) and Assigned(FGrid) then
+ begin
+ try
+ BeginGridUpdate;
+
+ for I := 0 to FGrid.Cols.Count - 1 do
+ FGrid.Cols[I].SchedName := Value;
+ finally
+ EndGridUpdate;
+ end;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.SetLinearStartDate(Value: TDate);
+var
+ I: Integer;
+begin
+ if Trunc(Value) <> Trunc(FLinearStartDate) then
+ begin
+ DoDateChangingEvent(Value);
+
+ FLinearStartDate := Value;
+ FLinearEndDate := Value + FLinearDayCount - 1;
+ if (ActiveTemplate = agtLinear) and Assigned(FGrid) then
+ begin
+ BeginGridUpdate;
+ try
+ for I := 0 to FGrid.Cols.Count - 1 do
+ FGrid.Cols[I].SchedDate := Value + I;
+ finally
+ EndGridUpdate;
+ end;
+ end;
+
+ DoDateChangedEvent;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.SetShortTitles(Value: Boolean);
+begin
+ if Value <> FShortTitles then
+ begin
+ FShortTitles := Value;
+ if Assigned(FGrid) and (ActiveTemplate <> agtNone) then
+ FGrid.Cols.UpdateTitles;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.DoDateChangedEvent;
+begin
+ if Assigned(FGrid) and Assigned(FGrid.FOnDateChanged) then
+ FGrid.FOnDateChanged(FGrid);
+end;
+
+procedure TJvTFDaysTemplate.DoDateChangingEvent(var NewDate: TDate);
+begin
+ if Assigned(FGrid) and Assigned(FGrid.FOnDateChanging) then
+ FGrid.FOnDateChanging(FGrid, NewDate);
+end;
+
+procedure TJvTFDaysTemplate.CompNamesChanged(Sender: TObject);
+var
+ TempNames: TStringList;
+ I: Integer;
+ Col: TJvTFDaysCol;
+begin
+ if FUpdatingCompNames then
+ begin
+ FCompNamesChanged := True;
+ Exit;
+ end;
+
+ FCompNamesChanged := False;
+ if (ActiveTemplate = agtComparative) and Assigned(FGrid) then
+ begin
+ TempNames := TStringList.Create;
+ try
+ BeginGridUpdate;
+
+ // remove any unneeded cols
+ I := 0;
+ while I < FGrid.Cols.Count do
+ if CompNames.IndexOf(FGrid.Cols[I].SchedName) = -1 then
+ FGrid.Cols[I].Free
+ else
+ begin
+ TempNames.Add(FGrid.Cols[I].SchedName);
+ Inc(I);
+ end;
+
+ // add all new cols
+ for I := 0 to CompNames.Count - 1 do
+ if TempNames.IndexOf(CompNames[I]) = -1 then
+ begin
+ Col := FGrid.Cols.Add;
+ Col.SchedName := CompNames[I];
+ Col.SchedDate := CompDate;
+ end;
+ finally
+ TempNames.Free;
+ EndGridUpdate;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.LinearDaysChanged;
+var
+ I, DeltaDays: Integer;
+ Col: TJvTFDaysCol;
+begin
+ if (ActiveTemplate = agtLinear) and Assigned(FGrid) then
+ begin
+ try
+ BeginGridUpdate;
+
+ DeltaDays := LinearDayCount - FGrid.Cols.Count;
+
+ // ONLY ONE OF THE FOLLOWING LOOPS WILL BE EXECUTED !!
+ // Add some days
+ for I := 1 to DeltaDays do
+ begin
+ Col := FGrid.Cols.Add;
+ Col.SchedName := LinearName;
+ Col.SchedDate := LinearStartDate + FGrid.Cols.Count - 1;
+ end;
+
+ // Remove some days
+ for I := -1 downto DeltaDays do
+ if FGrid.Cols.Count > 0 then
+ FGrid.Cols[FGrid.Cols.Count - 1].Free;
+ finally
+ EndGridUpdate;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysTemplate.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysTemplate then
+ begin
+ FLinearName := TJvTFDaysTemplate(Source).LinearName;
+ FLinearStartDate := TJvTFDaysTemplate(Source).LinearStartDate;
+ FLinearEndDate := TJvTFDaysTemplate(Source).LinearEndDate;
+ FLinearDayCount := TJvTFDaysTemplate(Source).LinearDayCount;
+ FCompNames.OnChange := nil;
+ FCompNames.Assign(TJvTFDaysTemplate(Source).CompNames);
+ FCompNames.OnChange := @CompNamesChanged;
+ FCompDate := TJvTFDaysTemplate(Source).CompDate;
+ FActiveTemplate := TJvTFDaysTemplate(Source).ActiveTemplate;
+ FShortTitles := TJvTFDaysTemplate(Source).ShortTitles;
+ FIgnoreNav := TJvTFDaysTemplate(Source).IgnoreNav;
+ UpdateGrid;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysTemplate.BeginCompNamesUpdate;
+begin
+ FUpdatingCompNames := True;
+end;
+
+procedure TJvTFDaysTemplate.EndCompNamesUpdate;
+begin
+ FUpdatingCompNames := False;
+ if FCompNamesChanged then
+ CompNamesChanged(Self);
+end;
+
+procedure TJvTFDaysTemplate.UpdateGrid;
+var
+ I: Integer;
+ Col: TJvTFDaysCol;
+begin
+ if not Assigned(FGrid) then
+ Exit;
+
+ if ActiveTemplate = agtLinear then
+ begin
+ try
+ BeginGridUpdate;
+
+ FGrid.Cols.Clear;
+ for I := 0 to LinearDayCount - 1 do
+ begin
+ Col := FGrid.Cols.Add;
+ Col.SchedName := LinearName;
+ Col.SchedDate := LinearStartDate + I;
+ end;
+ finally
+ EndGridUpdate;
+ end
+ end
+ else
+ if ActiveTemplate = agtComparative then
+ begin
+ try
+ BeginGridUpdate;
+ FGrid.Cols.Clear;
+ for I := 0 to CompNames.Count - 1 do
+ begin
+ Col := FGrid.Cols.Add;
+ Col.SchedName := CompNames[I];
+ Col.SchedDate := CompDate;
+ end;
+ finally
+ EndGridUpdate;
+ end;
+ end;
+
+ FGrid.Cols.UpdateTitles;
+end;
+
+procedure TJvTFDaysTemplate.CompNamesMoved(Sender: TObject;
+ CurIndex, NewIndex: Integer);
+begin
+ if Assigned(ApptGrid) and (ActiveTemplate = agtComparative) and
+ not ApptGrid.Cols.Updating then
+ ApptGrid.Cols.MoveCol(CurIndex, NewIndex);
+end;
+
+procedure TJvTFDaysTemplate.BeginGridUpdate;
+begin
+ FUpdatingGrid := True;
+end;
+
+procedure TJvTFDaysTemplate.EndGridUpdate;
+begin
+ FUpdatingGrid := False;
+ ApptGrid.ProcessBatches;
+end;
+
+//=== { TJvTFDaysPrimeTime } =================================================
+
+constructor TJvTFDaysPrimeTime.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create;
+ FApptGrid := AApptGrid;
+ FStartTime := EncodeTime(8, 0, 0, 0);
+ FEndTime := EncodeTime(17, 0, 0, 0);
+ FColor := clYellow;
+ FFillPic := TBitmap.Create;
+ FFillPic.Width := 16;
+ FFillPic.Height := 16;
+ UpdateFillPic;
+end;
+
+destructor TJvTFDaysPrimeTime.Destroy;
+begin
+ FFillPic.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysPrimeTime.SetStartTime(Value: TTime);
+begin
+ if Assigned(FApptGrid) and not (csLoading in FApptGrid.ComponentState) and
+ (Value >= EndTime) then
+ raise EJvTFDaysError.CreateRes(@RsEInvalidPrimeTimeStartTime);
+
+ FStartTime := Value;
+ Change;
+end;
+
+procedure TJvTFDaysPrimeTime.SetEndTime(Value: TTime);
+begin
+ if Assigned(FApptGrid) and (Value <= StartTime) and
+ not (csLoading in FApptGrid.ComponentState) then
+ raise EJvTFDaysError.CreateRes(@RsEInvalidPrimeTimeEndTime);
+
+ FEndTime := Value;
+ Change;
+end;
+
+procedure TJvTFDaysPrimeTime.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ UpdateFillPic;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysPrimeTime.Change;
+begin
+ if Assigned(FApptGrid) and not (csLoading in FApptGrid.ComponentState) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFDaysPrimeTime.UpdateFillPic;
+begin
+ with FFillPic.Canvas do
+ begin
+ Brush.Color := FColor;
+ FillRect(Classes.Rect(0, 0, FFillPic.Width, FFillPic.Height));
+ end;
+end;
+
+procedure TJvTFDaysPrimeTime.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysPrimeTime then
+ begin
+ FStartTime := TJvTFDaysPrimeTime(Source).StartTime;
+ FEndTime := TJvTFDaysPrimeTime(Source).EndTime;
+ FColor := TJvTFDaysPrimeTime(Source).Color;
+ UpdateFillPic;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFInPlaceApptEditor } =============================================
+
+constructor TJvTFInPlaceApptEditor.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ ControlStyle := ControlStyle + [csNoDesignVisible];
+
+ BorderStyle := bsNone;
+ FQuickCreate := False;
+ //ParentCtl3D := False;
+ //Ctl3D := False;
+end;
+
+procedure TJvTFInPlaceApptEditor.DoExit;
+begin
+ inherited DoExit;
+ try
+ if not FCancelEdit then
+ TJvTFDays(Parent).FinishEditAppt
+ else
+ if FQuickCreate then
+ // Free the appointment
+ FLinkedAppt.Free;
+ finally
+ FCancelEdit := False;
+ Parent.SetFocus;
+ end;
+end;
+
+procedure TJvTFInPlaceApptEditor.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+
+ if Key = VK_ESCAPE then
+ begin
+ FCancelEdit := True;
+ Key := 0;
+ Visible := False;
+ end;
+end;
+
+//=== { TJvTFApptMap } =======================================================
+
+constructor TJvTFApptMap.Create(AGridCol: TJvTFDaysCol);
+begin
+ inherited Create;
+ FGridCol := AGridCol;
+ FData := TJvTFSparseMatrix.Create;
+end;
+
+destructor TJvTFApptMap.Destroy;
+begin
+ FData.Free;
+ inherited Destroy;
+end;
+
+function TJvTFApptMap.GetLocation(Row, Col: Integer): TJvTFAppt;
+begin
+ Result := nil;
+ if (Row >= 0) and (Col > 0) then
+ Result := TJvTFAppt(FData[Row, Col]);
+end;
+
+procedure TJvTFApptMap.Add(Appt: TJvTFAppt);
+var
+ StartRow, EndRow, MapRow, MapCol: Integer;
+ Empty: Boolean;
+ ApptGrid: TJvTFDays;
+begin
+ // We need to find the left-most col that does not have any appts already
+ // scheduled in any of the rows needed by the new appt. (In other words,
+ // we need a contiguous set cols for the new appt.)
+
+ FGridCol.CalcStartEndRows(Appt, StartRow, EndRow);
+
+ StartRow := Greater(StartRow, 0);
+
+ ApptGrid := FGridCol.ColCollection.ApptGrid;
+ if Assigned(ApptGrid) then
+ EndRow := Lesser(EndRow, ApptGrid.RowCount - 1)
+ else
+ EndRow := Lesser(EndRow, FGridCol.ColCollection.Printer.RowCount - 1);
+
+ MapRow := StartRow;
+ MapCol := 1;
+ repeat
+ Empty := FData[MapRow, MapCol] = 0;
+ if Empty then
+ Inc(MapRow)
+ else
+ begin
+ Inc(MapCol);
+ MapRow := StartRow;
+ end;
+ until (MapRow > EndRow) and Empty;
+
+ // Now write the new appt to the map in all rows hit by appt, using the
+ // col found above.
+ for MapRow := StartRow to EndRow do
+ begin
+ FData[MapRow, MapCol] := NativeInt(Appt);
+ FData[MapRow, -1] := FData[MapRow, -1] + 1;
+ end;
+end;
+
+procedure TJvTFApptMap.ProcessMapGroup(GroupStart, GroupEnd: Integer);
+var
+ MapRow, Examined, ApptCount, MaxCol, MapCol: Integer;
+begin
+ // Find the highest used column in group
+ MaxCol := 0;
+ for MapRow := GroupStart to GroupEnd do
+ begin
+ Examined := 0;
+ ApptCount := FData[MapRow, -1];
+ // ApptCount > 0 check added by Mike 1/14/01
+ if ApptCount > 0 then
+ begin
+ MapCol := 1;
+
+ repeat
+ if FData[MapRow, MapCol] <> 0 then
+ Inc(Examined);
+ Inc(MapCol);
+ until Examined = ApptCount;
+
+ Dec(MapCol);
+
+ MaxCol := Greater(MaxCol, MapCol);
+ end;
+ end;
+
+ // Now write MaxCol in col 0 for each row in the groups
+ for MapRow := GroupStart to GroupEnd do
+ FData[MapRow, 0] := MaxCol;
+end;
+
+procedure TJvTFApptMap.UpdateMapGroups;
+var
+ GridRowCount: Integer;
+begin
+ if Assigned(FGridCol.ColCollection.ApptGrid) then
+ GridRowCount := FGridCol.ColCollection.ApptGrid.RowCount
+ else
+ if Assigned(FGridCol.ColCollection.Printer) then
+ GridRowCount := FGridCol.ColCollection.Printer.RowCount
+ else
+ GridRowCount := 0;
+
+ // we could try to find a smaller group, by looking for the first and last
+ // row where there is at least one appt, but CPU wise, it's actually simpler
+ // to let the ProcessMapGroup function deal with it.
+ ProcessMapGroup(0, GridRowCount);
+end;
+
+procedure TJvTFApptMap.Clear;
+begin
+ FData.Clear;
+end;
+
+function TJvTFApptMap.ColCount(Row: Integer): Integer;
+begin
+ Result := FData[Row, 0];
+end;
+
+procedure TJvTFApptMap.GetAppts(StartRow, EndRow: Integer; ApptList: TStringList);
+var
+ Row, Col, Existing, Found, MapCols: Integer;
+ Appt: TJvTFAppt;
+begin
+ ApptList.Clear;
+
+ for Row := StartRow to EndRow do
+ begin
+ Existing := FData[Row, -1];
+ MapCols := FData[Row, 0];
+ Found := 0;
+ Col := 1;
+ while (Found < Existing) and (Col <= MapCols) do
+ begin
+ if FData[Row, Col] <> 0 then
+ begin
+ Inc(Found);
+ Appt := TJvTFAppt(FData[Row, Col]);
+ if ApptList.IndexOf(Appt.ID) = -1 then
+ ApptList.AddObject(Appt.ID, Appt);
+ end;
+ Inc(Col);
+ end;
+ end;
+end;
+
+function TJvTFApptMap.LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer;
+var
+ Col, MapCols, ApptVal: Integer;
+begin
+ MapCols := FData[MapSearchRow, 0];
+ Col := 1;
+ ApptVal := Integer(Appt);
+
+ while (Col <= MapCols) and (FData[MapSearchRow, Col] <> ApptVal) do
+ Inc(Col);
+
+ if FData[MapSearchRow, Col] = ApptVal then
+ Result := Col
+ else
+ Result := -2;
+end;
+
+procedure TJvTFApptMap.Refresh;
+var
+ Sched: TJvTFSched;
+ I: Integer;
+begin
+ Clear;
+
+ Sched := FGridCol.Schedule;
+ if Assigned(Sched) then
+ begin
+ for I := 0 to Sched.ApptCount - 1 do
+ Add(Sched.Appts[I]);
+
+ UpdateMapGroups;
+ end;
+end;
+
+procedure TJvTFApptMap.Dump(AName: TFileName);
+var
+ DumpData: TStringList;
+begin
+ // used for debugging only
+ DumpData := TStringList.Create;
+ try
+ FData.Dump(DumpData);
+ DumpData.SaveToFile(AName);
+ finally
+ DumpData.Free;
+ end;
+end;
+
+function TJvTFApptMap.HasAppt(Appt: TJvTFAppt): Boolean;
+var
+ MapRow, MapCol, StartRow, EndRow, ApptsExamined: Integer;
+ Test: NativeInt;
+ ApptGrid: TJvTFDays;
+begin
+ FGridCol.CalcStartEndRows(Appt, StartRow, EndRow);
+
+ StartRow := Greater(StartRow, 0);
+
+ ApptGrid := FGridCol.ColCollection.ApptGrid;
+ if Assigned(ApptGrid) then
+ EndRow := Lesser(EndRow, ApptGrid.RowCount - 1)
+ else
+ EndRow := Lesser(EndRow, FGridCol.ColCollection.Printer.RowCount - 1);
+
+ MapRow := 0;
+ Result := False;
+ while (MapRow <= EndRow) and not Result do
+ begin
+ MapCol := 1;
+ ApptsExamined := 0;
+ while (ApptsExamined < FData[MapRow, -1]) and not Result do
+ begin
+ Test := FData[MapRow, MapCol];
+ if Test > 0 then
+ begin
+ Inc(ApptsExamined);
+ if Test = NativeInt(Appt) then
+ Result := True;
+ end;
+
+ Inc(MapCol);
+ end;
+
+ Inc(MapRow);
+ end;
+end;
+
+//=== { TJvTFDaysThresholds } ================================================
+
+constructor TJvTFDaysThresholds.Create(AOwner: TJvTFDays);
+begin
+ inherited Create;
+ FApptGrid := AOwner;
+
+ FTextHeight := 1;
+ FTextWidth := 10;
+ FEditHeight := 1;
+ FEditWidth := 10;
+ FDetailWidth := 10;
+ FDetailHeight := 10;
+ FDropTextFirst := True;
+ FPicsAllOrNone := False;
+ FWholePicsOnly := True;
+end;
+
+procedure TJvTFDaysThresholds.SetDetailHeight(Value: Integer);
+begin
+ if Value < 1 then
+ Value := 1;
+ if Value <> FDetailHeight then
+ begin
+ FDetailHeight := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.SetDetailWidth(Value: Integer);
+begin
+ if Value < 1 then
+ Value := 1;
+ if Value <> FDetailWidth then
+ begin
+ FDetailWidth := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.SetEditHeight(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FEditHeight then
+ FEditHeight := Value;
+end;
+
+procedure TJvTFDaysThresholds.SetEditWidth(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FEditWidth then
+ FEditWidth := Value;
+end;
+
+procedure TJvTFDaysThresholds.SetTextHeight(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FTextHeight then
+ begin
+ FTextHeight := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.SetTextWidth(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FTextWidth then
+ begin
+ FTextWidth := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.SetDropTextFirst(Value: Boolean);
+begin
+ if Value <> FDropTextFirst then
+ begin
+ FDropTextFirst := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.SetPicsAllOrNone(Value: Boolean);
+begin
+ if Value <> FPicsAllOrNone then
+ begin
+ FPicsAllOrNone := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.SetWholePicsOnly(Value: Boolean);
+begin
+ if Value <> FWholePicsOnly then
+ begin
+ FWholePicsOnly := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysThresholds.Change;
+begin
+ if Assigned(FApptGrid) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFDaysThresholds.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysThresholds then
+ begin
+ FTextWidth := TJvTFDaysThresholds(Source).TextWidth;
+ FTextHeight := TJvTFDaysThresholds(Source).TextHeight;
+ FEditHeight := TJvTFDaysThresholds(Source).EditHeight;
+ FEditWidth := TJvTFDaysThresholds(Source).EditWidth;
+ FDropTextFirst := TJvTFDaysThresholds(Source).DropTextFirst;
+ FPicsAllOrNone := TJvTFDaysThresholds(Source).PicsAllOrNone;
+ FWholePicsOnly := TJvTFDaysThresholds(Source).WholePicsOnly;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFDaysScrollBar } =================================================
+
+constructor TJvTFDaysScrollBar.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ // if we set the csNoDesignVisible flag then visibility at design time
+ // is controled by the Visible property, which is exactly what we want.
+ ControlStyle := ControlStyle + [csNoDesignVisible];
+ //ParentCtl3D := False;
+ //Ctl3D := False;
+end;
+
+procedure TJvTFDaysScrollBar.CMDesignHitTest(var Msg: TCMDesignHitTest);
+begin
+ Msg.Result := 1;
+end;
+
+procedure TJvTFDaysScrollBar.CreateWnd;
+begin
+ inherited CreateWnd;
+ UpdateRange;
+end;
+
+function TJvTFDaysScrollBar.GetLargeChange: Integer;
+begin
+ Result := inherited LargeChange;
+end;
+
+procedure TJvTFDaysScrollBar.SetLargeChange(Value: Integer);
+begin
+ inherited LargeChange := Value;
+ UpdateRange;
+end;
+
+procedure TJvTFDaysScrollBar.UpdateRange;
+var
+ Info: TScrollInfo;
+begin
+ if not HandleAllocated then
+ exit;
+
+ FillChar(Info, SizeOf(Info), 0);
+ with Info do
+ begin
+ cbsize := SizeOf(Info);
+ fmask := SIF_PAGE;
+ nPage := LargeChange;
+ end;
+ SetScrollInfo(Handle, SB_CTL, Info, True);
+end;
+
+//=== { TJvTFDaysCol } =======================================================
+
+constructor TJvTFDaysCol.Create(ACollection: TCollection);
+begin
+ inherited Create(ACollection);
+ FNullSchedDate := True;
+ FMap := TJvTFApptMap.Create(Self);
+end;
+
+destructor TJvTFDaysCol.Destroy;
+begin
+ Disconnect;
+ FMap.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysCol.SetSchedDate(Value: TDate);
+begin
+ if Value <> FSchedDate then
+ begin
+ Disconnect;
+ FSchedDate := Value;
+ FNullSchedDate := False;
+ Connect;
+ //UpdateTitle;
+ UpdateTitles;
+ CheckTemplate;
+ end;
+end;
+
+procedure TJvTFDaysCol.SetSchedName(const Value: string);
+begin
+ if Value <> FSchedName then
+ begin
+ Disconnect;
+ FSchedName := Value;
+ Connect;
+ //UpdateTitle;
+ UpdateTitles;
+ CheckTemplate;
+ end;
+end;
+
+procedure TJvTFDaysCol.SetTitle(const Value: string);
+begin
+ if FTitle <> Value then
+ begin
+ FTitle := Value;
+ if Assigned(ColCollection.ApptGrid) then
+ ColCollection.ApptGrid.Invalidate;
+ end;
+end;
+
+procedure TJvTFDaysCol.SetWidth(Value: Integer);
+var
+ ApptGrid: TJvTFDays;
+begin
+ if Value < AbsMinColWidth then
+ Value := AbsMinColWidth;
+
+ if Assigned(ColCollection.ApptGrid) then
+ if Value > ColCollection.ApptGrid.GetDataWidth then
+ Value := ColCollection.ApptGrid.GetDataWidth;
+
+ if Value < 1 then
+ Value := 1;
+
+ // For the printer, just set the private member then EXIT
+ if Assigned(ColCollection.Printer) then
+ begin
+ FWidth := Value;
+ Exit;
+ end;
+
+ if Value <> FWidth then
+ begin
+ FWidth := Value;
+ ApptGrid := ColCollection.ApptGrid;
+
+ if not (csLoading in ApptGrid.ComponentState) then
+ begin
+ if ApptGrid.AutoSizeCols then
+ begin
+ if not ColCollection.AddingCol and
+ not (vsbHorz in ApptGrid.VisibleScrollBars) then
+ ColCollection.ResizeCols;
+ end
+ else
+ ApptGrid.CheckSBVis;
+
+ ApptGrid.CheckSBParams;
+ ApptGrid.Invalidate;
+ end;
+ end;
+end;
+
+function TJvTFDaysCol.GetDisplayName: string;
+begin
+ Result := SchedName + ' [';
+ if not FNullSchedDate then
+ Result := Result + FormatDateTime('ddddd', SchedDate);
+ Result := Result + ']';
+{
+ if Title <> '' then
+ Result := Title
+ else
+ Result := Inherited GetDisplayName;
+}
+end;
+
+procedure TJvTFDaysCol.CheckTemplate;
+begin
+ if Assigned(ColCollection.ApptGrid) then
+ with ColCollection.ApptGrid.Template do
+ if not UpdatingGrid then
+ ActiveTemplate := agtNone;
+end;
+
+procedure TJvTFDaysCol.SetIndex(Value: Integer);
+begin
+ if not Assigned(ColCollection.ApptGrid) or
+ (ColCollection.ApptGrid.Template.ActiveTemplate <> agtLinear) then
+ inherited SetIndex(Value);
+end;
+
+procedure TJvTFDaysCol.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysCol then
+ begin
+ Title := TJvTFDaysCol(Source).Title;
+ Width := TJvTFDaysCol(Source).Width;
+ SchedName := TJvTFDaysCol(Source).SchedName;
+ SchedDate := TJvTFDaysCol(Source).SchedDate;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+function TJvTFDaysCol.ColCollection: TJvTFDaysCols;
+begin
+ Result := TJvTFDaysCols(Collection);
+end;
+
+function TJvTFDaysCol.Connected: Boolean;
+begin
+ Result := Assigned(FSchedule);
+end;
+
+procedure TJvTFDaysCol.Connect;
+var
+ ApptGrid: TJvTFDays;
+ FPrinter: TJvTFDaysPrinter;
+begin
+ ApptGrid := ColCollection.ApptGrid;
+ FPrinter := ColCollection.Printer;
+
+ if Assigned(ApptGrid) then
+ begin
+ if not Connected and not (csDesigning in ApptGrid.ComponentState) and
+ not FNullSchedDate and (SchedName <> '') and Assigned(ApptGrid.ScheduleManager) and
+ not (csLoading in ApptGrid.ComponentState) then
+ begin
+ FSchedule := ApptGrid.RetrieveSchedule(SchedName, SchedDate);
+ FMap.Refresh;
+ ApptGrid.Invalidate;
+ //UpdateTitle;
+ UpdateTitles;
+ end;
+ end
+ else
+ if Assigned(FPrinter) then
+ begin
+ if not Connected and not (csDesigning in FPrinter.ComponentState) and
+ not FNullSchedDate and (SchedName <> '') and
+ Assigned(FPrinter.ScheduleManager) and
+ not (csLoading in FPrinter.ComponentState) then
+ begin
+ FSchedule := FPrinter.RetrieveSchedule(SchedName, SchedDate);
+ FMap.Refresh;
+ //UpdateTitle;
+ UpdateTitles;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysCol.Disconnect;
+var
+ ApptGrid: TJvTFDays;
+ FPrinter: TJvTFDaysPrinter;
+ lSchedName: string;
+ lSchedDate: TDate;
+begin
+ if not FDisconnecting then
+ try
+ FDisconnecting := True;
+
+ ApptGrid := ColCollection.ApptGrid;
+ FPrinter := ColCollection.Printer;
+
+ if Assigned(ApptGrid) then
+ begin
+ if Connected and Assigned(ApptGrid.ScheduleManager) then
+ begin
+ lSchedName := Schedule.SchedName;
+ lSchedDate := Schedule.SchedDate;
+ FSchedule := nil;
+ FMap.Clear;
+ ApptGrid.ReleaseSchedule(lSchedName, lSchedDate);
+ ApptGrid.Invalidate;
+ end;
+ end
+ else
+ if Assigned(FPrinter) then
+ begin
+ if Connected and Assigned(FPrinter.ScheduleManager) then
+ begin
+ lSchedName := Schedule.SchedName;
+ lSchedDate := Schedule.SchedDate;
+ FSchedule := nil;
+ FMap.Clear;
+ FPrinter.ReleaseSchedule(lSchedName, lSchedDate);
+ end;
+ end;
+ finally
+ FDisconnecting := False;
+ end;
+end;
+
+procedure TJvTFDaysCol.SetSchedule(const NewSchedName: string; NewSchedDate: TDate);
+begin
+ Disconnect;
+ FSchedName := SchedName;
+ FSchedDate := SchedDate;
+ FNullSchedDate := False;
+ Connect;
+ //UpdateTitle;
+ UpdateTitles;
+ CheckTemplate;
+end;
+
+procedure TJvTFDaysCol.RefreshMap;
+begin
+ FMap.Refresh;
+end;
+
+procedure TJvTFDaysCol.CalcStartEndRows(Appt: TJvTFAppt;
+ var StartRow, EndRow: Integer);
+var
+ ApptGrid: TJvTFDays;
+ FPrinter: TJvTFDaysPrinter;
+begin
+ ApptGrid := ColCollection.ApptGrid;
+ FPrinter := ColCollection.Printer;
+
+ if Assigned(ApptGrid) then
+ begin
+ if Trunc(Appt.StartDate) = Trunc(SchedDate) then
+ StartRow := ApptGrid.TimeToRow(Appt.StartTime)
+ else
+ StartRow := 0;
+
+ if Trunc(Appt.EndDate) = Trunc(SchedDate) then
+ EndRow := ApptGrid.TimeToRow(ApptGrid.AdjustEndTime(Appt.EndTime))
+ else
+ EndRow := ApptGrid.RowCount - 1;
+ end
+ else
+ if Assigned(FPrinter) then
+ begin
+ if Trunc(Appt.StartDate) = Trunc(SchedDate) then
+ StartRow := FPrinter.TimeToRow(Appt.StartTime)
+ else
+ StartRow := 0;
+
+ if Trunc(Appt.EndDate) = Trunc(SchedDate) then
+ EndRow := FPrinter.TimeToRow(FPrinter.AdjustEndTime(Appt.EndTime))
+ else
+ EndRow := FPrinter.RowCount - 1;
+ end;
+end;
+{
+procedure TJvTFDaysCol.UpdateTitle;
+Var
+ NewTitle: string;
+ ApptGrid: TJvTFDays;
+ FPrinter: TJvTFDaysPrinter;
+begin
+ ApptGrid := ColCollection.ApptGrid;
+ FPrinter := ColCollection.Printer;
+
+ if Assigned(ApptGrid) then
+ begin
+ if (ApptGrid.Template.ActiveTemplate = agtLinear) and
+ (ApptGrid.Template.ShortTitles) then
+ NewTitle := FormatDateTime(ApptGrid.DateFormat, SchedDate)
+ else
+ if (ApptGrid.Template.ActiveTemplate = agtComparative) and
+ (ApptGrid.Template.ShortTitles) then
+ NewTitle := SchedName
+ else
+ NewTitle := SchedName + ' - ' + FormatDateTime(ApptGrid.DateFormat, SchedDate);
+
+ if Assigned(ApptGrid.OnUpdateColTitle) then
+ ApptGrid.OnUpdateColTitle(ApptGrid, Self, NewTitle);
+ Title := NewTitle;
+ end
+ else
+ if Assigned(FPrinter) then
+ begin
+ NewTitle := SchedName + ' - ' +
+ FormatDateTime(FPrinter.DateFormat, SchedDate);
+ if Assigned(FPrinter.OnUpdateColTitle) then
+ FPrinter.OnUpdateColTitle(FPrinter, Self, NewTitle);
+ Title := NewTitle;
+ end;
+end;
+}
+
+function TJvTFDaysCol.GetFirstAppt: TJvTFAppt;
+var
+ ApptList: TStringList;
+begin
+ Result := nil;
+ ApptList := TStringList.Create;
+ try
+ FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList);
+ if ApptList.Count > 0 then
+ Result := TJvTFAppt(ApptList.Objects[0]);
+ finally
+ ApptList.Free;
+ end;
+end;
+
+function TJvTFDaysCol.GetLastAppt: TJvTFAppt;
+var
+ ApptList: TStringList;
+begin
+ Result := nil;
+ ApptList := TStringList.Create;
+ try
+ FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList);
+ if ApptList.Count > 0 then
+ Result := TJvTFAppt(ApptList.Objects[ApptList.Count - 1]);
+ finally
+ ApptList.Free;
+ end;
+end;
+
+function TJvTFDaysCol.GetNextAppt(RefAppt: TJvTFAppt): TJvTFAppt;
+var
+ ApptList: TStringList;
+ NextIndex: Integer;
+begin
+ if not Assigned(RefAppt) then
+ begin
+ Result := GetFirstAppt;
+ Exit;
+ end;
+
+ Result := nil;
+ ApptList := TStringList.Create;
+ try
+ FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList);
+ if ApptList.Count > 0 then
+ begin
+ NextIndex := ApptList.IndexOfObject(RefAppt) + 1;
+ // if NextIndex = 0 then RefAppt is in a different column,
+ // so return the first appt.
+ if (NextIndex >= 0) and (NextIndex < ApptList.Count) then
+ Result := TJvTFAppt(ApptList.Objects[NextIndex]);
+ end;
+ finally
+ ApptList.Free;
+ end;
+end;
+
+function TJvTFDaysCol.GetPrevAppt(RefAppt: TJvTFAppt): TJvTFAppt;
+var
+ ApptList: TStringList;
+ PrevIndex: Integer;
+begin
+ if RefAppt = nil then
+ begin
+ Result := GetLastAppt;
+ Exit;
+ end;
+
+ Result := nil;
+ ApptList := TStringList.Create;
+ try
+ FMap.GetAppts(0, ColCollection.ApptGrid.RowCount - 1, ApptList);
+ if ApptList.Count > 0 then
+ begin
+ PrevIndex := ApptList.IndexOfObject(RefAppt) - 1;
+ if PrevIndex > -1 then
+ Result := TJvTFAppt(ApptList.Objects[PrevIndex])
+ else
+ if PrevIndex = -2 then
+ // RefAppt is in a different column so return last appt
+ Result := GetLastAppt;
+ end;
+ finally
+ ApptList.Free;
+ end;
+end;
+
+procedure TJvTFDaysCol.SetGroupTitle(const Value: string);
+begin
+ if Value <> FGroupTitle then
+ begin
+ FGroupTitle := Value;
+ if Assigned(ColCollection.ApptGrid) then
+ ColCollection.ApptGrid.Invalidate;
+ end;
+end;
+
+procedure TJvTFDaysCol.UpdateTitles;
+var
+ NewTitle, NewGroupTitle, NameStr, DateStr: string;
+ ApptGrid: TJvTFDays;
+ FPrinter: TJvTFDaysPrinter;
+ FromGrid: Boolean;
+ Grouping: TJvTFDaysGrouping;
+begin
+ ApptGrid := ColCollection.ApptGrid;
+ FPrinter := ColCollection.Printer;
+
+ if not Assigned(ApptGrid) and not Assigned(FPrinter) then
+ Exit;
+
+ FromGrid := Assigned(ApptGrid);
+ if FromGrid then
+ Grouping := ApptGrid.Grouping
+ else
+ Grouping := FPrinter.Grouping;
+
+ if FNullSchedDate then
+ DateStr := ''
+ else
+ if FromGrid then
+ DateStr := FormatDateTime(ApptGrid.DateFormat, SchedDate)
+ else
+ DateStr := FormatDateTime(FPrinter.DateFormat, SchedDate);
+
+ if Assigned(Schedule) and (Schedule.SchedDisplayName <> '') then
+ NameStr := Schedule.SchedDisplayName
+ else
+ NameStr := SchedName;
+
+ case Grouping of
+ grNone:
+ begin
+ NewGroupTitle := '';
+ NewTitle := NameStr + ' - ' + DateStr;
+ end;
+ grDate:
+ begin
+ NewGroupTitle := DateStr;
+ NewTitle := NameStr;
+ end;
+ grResource:
+ begin
+ NewGroupTitle := NameStr;
+ NewTitle := DateStr;
+ end;
+ grCustom:
+ begin
+ NewGroupTitle := GroupTitle;
+ NewTitle := NameStr + ' - ' + DateStr;
+ end;
+ end;
+
+ if FromGrid then
+ begin
+ if Assigned(ApptGrid.OnUpdateColTitles) then
+ ApptGrid.OnUpdateColTitles(ApptGrid, Self, NewGroupTitle, NewTitle)
+ end
+ else
+ if Assigned(FPrinter.OnUpdateColTitles) then
+ FPrinter.OnUpdateColTitles(FPrinter, Self, NewGroupTitle, NewTitle);
+
+ GroupTitle := NewGroupTitle;
+ Title := NewTitle;
+end;
+
+procedure TJvTFDaysCol.DumpMap;
+begin
+ FMap.Dump('Map Dump (' + IntToStr(Index) + ').txt');
+end;
+
+function TJvTFDaysCol.ApptInCol(Appt: TJvTFAppt): Boolean;
+begin
+ Result := FMap.HasAppt(Appt);
+end;
+
+function TJvTFDaysCol.LocateMapCol(Appt: TJvTFAppt; MapSearchRow: Integer): Integer;
+begin
+ Result := FMap.LocateMapCol(Appt, MapSearchRow);
+end;
+
+function TJvTFDaysCol.MapColCount(Row: Integer): Integer;
+begin
+ Result := FMap.ColCount(Row);
+end;
+
+function TJvTFDaysCol.MapLocation(Col, Row: Integer): TJvTFAppt;
+begin
+ Result := FMap.Location[Row, Col];
+end;
+
+//=== { TJvTFDaysCols } ======================================================
+
+constructor TJvTFDaysCols.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create(TJvTFDaysCol);
+ FApptGrid := AApptGrid;
+ FOldCount := 0;
+end;
+
+constructor TJvTFDaysCols.CreateForPrinter(APrinter: TJvTFDaysPrinter);
+begin
+ inherited Create(TJvTFDaysCol);
+ FPrinter := APrinter;
+end;
+
+function TJvTFDaysCols.GetItem(Index: Integer): TJvTFDaysCol;
+begin
+ Result := TJvTFDaysCol(inherited GetItem(Index));
+end;
+
+procedure TJvTFDaysCols.SetItem(Index: Integer; Value: TJvTFDaysCol);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+procedure TJvTFDaysCols.EnsureCol(Index: Integer);
+begin
+ if (Index < 0) or (Index > Count - 1) then
+ raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds);
+end;
+
+function TJvTFDaysCols.GetOwner: TPersistent;
+begin
+ if Assigned(FApptGrid) then
+ Result := FApptGrid
+ else
+ if Assigned(FPrinter) then
+ Result := FPrinter
+ else
+ Result := nil;
+end;
+
+procedure TJvTFDaysCols.SizeCols;
+var
+ DataWidth, Base, MakeUp, I: Integer;
+begin
+ // DO NOT RUN IF WE'RE ALREADY IN THE SIZING PROCESS!!
+ if SizingCols or (Count <= 0) then
+ Exit;
+
+ if Assigned(FApptGrid) then
+ try
+ FSizingCols := True;
+ DataWidth := ApptGrid.GetDataWidth;
+
+ Base := DataWidth div Count;
+
+ if Base >= ApptGrid.MinColWidth then
+ begin
+ MakeUp := DataWidth - (Base * Count);
+ for I := 0 to MakeUp - 1 do
+ Items[I].Width := Base + 1;
+ for I := MakeUp to Count - 1 do
+ Items[I].Width := Base;
+ end
+ finally
+ FSizingCols := False;
+ end
+ else
+ begin
+ // sizing for printer
+ end;
+end;
+
+procedure TJvTFDaysCols.Update(Item: TCollectionItem);
+begin
+{*******************************************************************}
+{** DO NOT PUT ANY CALLS TO SHOWMESSAGE IN THIS ROUTINE!!!! *******}
+{** IT WILL BLOW UP WHEN REMOVING COLS AT DESIGN TIME!!!! *******}
+{*******************************************************************}
+
+ // Exit if owner is printer
+ if not Assigned(ApptGrid) or (csLoading in ApptGrid.ComponentState) then
+ Exit;
+
+ try
+ FUpdating := True;
+
+ ApptGrid.ClearSelection;
+
+ if Count > FOldCount then // we're adding a col
+ try
+ FAddingCol := True;
+
+ // if we're adding the first col then set left col to 0.
+ if FOldCount = 0 then
+ ApptGrid.LeftCol := 0;
+
+ if ApptGrid.AutoSizeCols then
+ begin
+ // default col width to grid's min col width
+ Items[Count - 1].Width := ApptGrid.MinColWidth;
+
+ if not (vsbHorz in ApptGrid.VisibleScrollBars) then
+ // run the CheckSBVis routine
+ if not ApptGrid.CheckSBVis then
+ // if CheckSBVis didn't resize the cols then recheck
+ // the visibility of the horz scroll bar. if still not
+ // visible, then size the cols.
+ if not (vsbHorz in ApptGrid.VisibleScrollBars) then
+ SizeCols;
+ end
+ else
+ Items[Count - 1].Width := ApptGrid.DefColWidth;
+ finally
+ FAddingCol := False;
+ end
+ else
+ if Count < FOldCount then // we're removing a col
+ begin
+ if ApptGrid.FocusedCol >= Count then
+ ApptGrid.FocusedCol := Count - 1;
+
+ if ApptGrid.SelStart.X >= Count then
+ ApptGrid.SelStart := Point(Count - 1, ApptGrid.SelStart.Y);
+
+ if ApptGrid.LeftCol >= Count then
+ ApptGrid.LeftCol := Count - 1;
+
+ if ApptGrid.AutoSizeCols then
+ begin
+ if vsbHorz in ApptGrid.VisibleScrollBars then
+ begin
+ // run the CheckSBVis routine
+ if not ApptGrid.CheckSBVis then
+ // if CheckSBVis didn't resize the cols then recheck
+ // the visibility of the horz scroll bar. if still not
+ // visible, then size the cols.
+ if not (vsbHorz in ApptGrid.VisibleScrollBars) then
+ SizeCols;
+ end
+ else
+ SizeCols;
+ end
+ else
+ ApptGrid.CheckSBVis;
+ end;
+
+ finally
+ FUpdating := False;
+ FOldCount := Count;
+ FApptGrid.Invalidate;
+ end;
+end;
+
+function TJvTFDaysCols.Add: TJvTFDaysCol;
+begin
+ Result := TJvTFDaysCol(inherited Add);
+end;
+
+procedure TJvTFDaysCols.EnsureMinColWidth;
+var
+ I, MCW: Integer;
+begin
+ if Assigned(ApptGrid) then
+ MCW := ApptGrid.MinColWidth
+ else
+ if Assigned(FPrinter) then
+ MCW := FPrinter.MinColWidth
+ else
+ Exit;
+
+ for I := 0 to Count - 1 do
+ if Items[I].Width < MCW then
+ Items[I].Width := MCW;
+end;
+
+procedure TJvTFDaysCols.EnsureMaxColWidth;
+var
+ I: Integer;
+ DataW: Integer;
+begin
+ if not Assigned(ApptGrid) or not (agoEnforceMaxColWidth in ApptGrid.Options) then
+ Exit;
+
+ DataW := ApptGrid.GetDataWidth;
+ for I := 0 to Count - 1 do
+ if Items[I].Width > DataW then
+ Items[I].Width := DataW;
+end;
+
+procedure TJvTFDaysCols.ResizeCols;
+begin
+ SizeCols;
+end;
+
+procedure TJvTFDaysCols.MoveCol(SourceIndex, TargetIndex: Integer);
+var
+ SelID: Integer;
+begin
+ if SourceIndex <> TargetIndex then
+ begin
+ SelID := -1;
+ EnsureCol(SourceIndex);
+ EnsureCol(TargetIndex);
+
+ if Assigned(ApptGrid) and (ApptGrid.FocusedCol > -1) then
+ SelID := Items[ApptGrid.FocusedCol].ID;
+
+ Items[SourceIndex].Index := TargetIndex;
+
+ if Assigned(ApptGrid) and (ApptGrid.FocusedCol > -1) then
+ ApptGrid.FocusedCol := FindItemID(SelID).Index;
+
+ // sychronize the CompName list
+ if Assigned(ApptGrid) and
+ (ApptGrid.Template.ActiveTemplate = agtComparative) then
+ begin
+ FUpdating := True;
+ try
+ ApptGrid.Template.CompNames.Move(SourceIndex, TargetIndex);
+ finally
+ FUpdating := False;
+ end;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysCols.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TJvTFDaysCols then
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ for I := 0 to TJvTFDaysCols(Source).Count - 1 do
+ Add.Assign(TJvTFDaysCols(Source).Items[I]);
+ finally
+ EndUpdate;
+ end;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysCols.UpdateTitles;
+var
+ I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ //Items[I].UpdateTitle;
+ Items[I].UpdateTitles;
+end;
+
+//=== { TJvTFDaysFancyRowHdrAttr } ===========================================
+
+constructor TJvTFDaysFancyRowHdrAttr.Create(AOwner: TJvTFDays);
+begin
+ inherited Create;
+ FGrid := AOwner;
+
+ FTickColor := clGray;
+ FColor := clBtnFace;
+
+ FMinorFont := TFont.Create;
+ if Assigned(FGrid) then
+ FMinorFont.Assign(FGrid.Font);
+
+ FMajorFont := TFont.Create;
+ if Assigned(FGrid) then
+ FMajorFont.Assign(FGrid.Font);
+ FMajorFont.Size := FMajorFont.Size * 2;
+
+ FMinorFont.OnChange := @FontChange;
+ FMajorFont.OnChange := @FontChange;
+ FOnlyShow00Minutes := True;
+end;
+
+destructor TJvTFDaysFancyRowHdrAttr.Destroy;
+begin
+ FMinorFont.OnChange := nil;
+ FMajorFont.OnChange := nil;
+ FMinorFont.Free;
+ FMajorFont.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.SetHr2400(Value: Boolean);
+begin
+ if Value <> FHr2400 then
+ begin
+ FHr2400 := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.SetMinorFont(Value: TFont);
+begin
+ FMinorFont.Assign(Value);
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.SetMajorFont(Value: TFont);
+begin
+ FMajorFont.Assign(Value);
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.SetTickColor(Value: TColor);
+begin
+ if Value <> FTickColor then
+ begin
+ FTickColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.SetOnlyShow00Minutes(Value: Boolean);
+begin
+ if Value <> FOnlyShow00Minutes then
+ begin
+ FOnlyShow00Minutes := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.Change;
+begin
+ if Assigned(FGrid) then
+ FGrid.Invalidate;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.FontChange(Sender: TObject);
+begin
+ Change;
+end;
+
+procedure TJvTFDaysFancyRowHdrAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysFancyRowHdrAttr then
+ begin
+ FTickColor := TJvTFDaysFancyRowHdrAttr(Source).TickColor;
+ FMinorFont.OnChange := nil;
+ FMajorFont.OnChange := nil;
+ FMinorFont.Assign(TJvTFDaysFancyRowHdrAttr(Source).MinorFont);
+ FMajorFont.Assign(TJvTFDaysFancyRowHdrAttr(Source).MajorFont);
+ FMinorFont.OnChange := @FontChange;
+ FMajorFont.OnChange := @FontChange;
+ FHr2400 := TJvTFDaysFancyRowHdrAttr(Source).Hr2400;
+ FColor := TJvTFDaysFancyRowHdrAttr(Source).Color;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFDaysHdrAttr } ===================================================
+
+constructor TJvTFDaysHdrAttr.Create(AOwner: TJvTFDays);
+begin
+ inherited Create;
+ FApptGrid := AOwner;
+ FFont := TFont.Create;
+ if Assigned(FApptGrid) then
+ begin
+ FFont.Assign(FApptGrid.Font);
+ FParentFont := True;
+ end;
+ FFont.OnChange := @FontChange;
+
+ FColor := clBtnFace;
+ FFrame3D := True;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FFrameColor := clBlack;
+ {$ENDIF Jv_TIMEBLOCKS}
+end;
+
+destructor TJvTFDaysHdrAttr.Destroy;
+begin
+ FFont.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysHdrAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysHdrAttr.SetFont(Value: TFont);
+begin
+ if Value <> FFont then
+ begin
+ FFont.Assign(Value);
+ FFont.OnChange := @FontChange;
+ if Assigned(FApptGrid) then
+ ParentFont := Value = FApptGrid.Font;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysHdrAttr.SetParentFont(Value: Boolean);
+begin
+ if Value and Assigned(FApptGrid) then
+ Font.Assign(FApptGrid.Font);
+ FParentFont := Value;
+end;
+
+procedure TJvTFDaysHdrAttr.SetFrame3D(Value: Boolean);
+begin
+ if Value <> FFrame3D then
+ begin
+ FFrame3D := Value;
+ Change;
+ end;
+end;
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+
+procedure TJvTFDaysHdrAttr.SetFrameColor(Value: TColor);
+begin
+ if Value <> FFrameColor then
+ begin
+ FFrameColor := Value;
+ Change;
+ end;
+end;
+
+// ok
+
+procedure TJvTFDaysHdrAttr.SetTitleRotation(Value: Integer);
+begin
+ if Value <> FTitleRotation then
+ begin
+ FTitleRotation := Value;
+ Change;
+ end;
+end;
+
+{$ENDIF Jv_TIMEBLOCKS}
+
+procedure TJvTFDaysHdrAttr.Change;
+begin
+ if Assigned(FApptGrid) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFDaysHdrAttr.FontChange(Sender: TObject);
+begin
+ ParentFont := False;
+ Change;
+end;
+
+procedure TJvTFDaysHdrAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysHdrAttr then
+ try
+ FParentFont := False;
+ Frame3D := TJvTFDaysHdrAttr(Source).Frame3D;
+ FColor := TJvTFDaysHdrAttr(Source).Color;
+ Font.Assign(TJvTFDaysHdrAttr(Source).Font);
+ Font.OnChange := @FontChange;
+ ParentFont := TJvTFDaysHdrAttr(Source).ParentFont;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FFrameColor := TJvTFDaysHdrAttr(Source).FrameColor;
+ // ok
+ FTitleRotation := TJvTFDaysHdrAttr(Source).TitleRotation;
+ {$ENDIF Jv_TIMEBLOCKS}
+ finally
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysHdrAttr.ParentFontChanged;
+begin
+ if ParentFont and Assigned(FApptGrid) then
+ begin
+ // Disconnect Font.OnChange
+ FFont.OnChange := nil;
+ // Assign the parent font to FFont
+ FFont.Assign(FApptGrid.Font);
+ // Reconnect Font.OnChange
+ FFont.OnChange := @FontChange;
+ end;
+end;
+
+//=== { TJvTFDaysApptBar } ===================================================
+
+constructor TJvTFDaysApptBar.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create;
+ FApptGrid := AApptGrid;
+ FColor := clBlue;
+ FWidth := 5;
+ FVisible := True;
+ FTimeStampStyle := tssBlock;
+ FTimeStampColor := clBlue;
+end;
+
+procedure TJvTFDaysApptBar.SetColor(Value: TColor);
+begin
+ if FColor <> Value then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptBar.SetVisible(Value: Boolean);
+begin
+ if FVisible <> Value then
+ begin
+ FVisible := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptBar.SetWidth(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+
+ if FWidth <> Value then
+ begin
+ FWidth := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptBar.Change;
+begin
+ if Assigned(FApptGrid) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFDaysApptBar.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysApptBar then
+ begin
+ FColor := TJvTFDaysApptBar(Source).Color;
+ FVisible := TJvTFDaysApptBar(Source).Visible;
+ FWidth := TJvTFDaysApptBar(Source).Width;
+ FTimeStampStyle := TJvTFDaysApptBar(Source).TimeStampStyle;
+ FTimeStampColor := TJvTFDaysApptBar(Source).TimeStampColor;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysApptBar.SetTimeStampColor(Value: TColor);
+begin
+ if FTimeStampColor <> Value then
+ begin
+ FTimeStampColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptBar.SetTFTimeStampStyle(Value: TJvTFTimeStampStyle);
+begin
+ if FTimeStampStyle <> Value then
+ begin
+ FTimeStampStyle := Value;
+ Change;
+ end;
+end;
+
+//=== { TJvTFDaysApptAttr } ==================================================
+
+constructor TJvTFDaysApptAttr.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create;
+ FApptGrid := AApptGrid;
+
+ FFont := TFont.Create;
+ if Assigned(FApptGrid) then
+ begin
+ FFont.Assign(FApptGrid.Font);
+ FParentFont := True;
+ end
+ else
+ FParentFont := False;
+
+ FFont.OnChange := @FontChange;
+
+ FFrameWidth := 1;
+ FFrameColor := clBlack;
+ FColor := clWhite;
+end;
+
+destructor TJvTFDaysApptAttr.Destroy;
+begin
+ FFont.OnChange := nil;
+ FFont.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysApptAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptAttr.SetFont(Value: TFont);
+begin
+ if Value <> FFont then
+ begin
+ FFont.Assign(Value);
+ FFont.OnChange := @FontChange;
+ if Assigned(FApptGrid) then
+ ParentFont := Value = FApptGrid.Font;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptAttr.SetParentFont(Value: Boolean);
+begin
+ if Assigned(FApptGrid) and Value then
+ Font.Assign(FApptGrid.Font);
+ FParentFont := Value;
+end;
+
+procedure TJvTFDaysApptAttr.SetFrameColor(Value: TColor);
+begin
+ if Value <> FFrameColor then
+ begin
+ FFrameColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptAttr.SetFrameWidth(Value: Integer);
+begin
+ if Value <> FFrameWidth then
+ begin
+ FFrameWidth := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysApptAttr.Change;
+begin
+ if Assigned(FApptGrid) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFDaysApptAttr.FontChange(Sender: TObject);
+begin
+ ParentFont := False;
+ Change;
+end;
+
+procedure TJvTFDaysApptAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysApptAttr then
+ try
+ FParentFont := False;
+ FFrameWidth := TJvTFDaysApptAttr(Source).FrameWidth;
+ FFrameColor := TJvTFDaysApptAttr(Source).FrameColor;
+ FColor := TJvTFDaysApptAttr(Source).Color;
+ Font.Assign(TJvTFDaysApptAttr(Source).Font);
+ ParentFont := TJvTFDaysApptAttr(Source).ParentFont;
+ finally
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysApptAttr.ParentFontChanged;
+begin
+ if ParentFont and Assigned(FApptGrid) then
+ begin
+ FFont.OnChange := nil;
+ FFont.Assign(FApptGrid.Font);
+ FFont.OnChange := @FontChange;
+ end;
+end;
+
+//=== { TJvTFSelCellAttr } ===================================================
+
+constructor TJvTFSelCellAttr.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create;
+
+ FApptGrid := AApptGrid;
+ FColor := clNavy;
+ FStyle := scsSolid;
+ FFrameWidth := 2;
+end;
+
+procedure TJvTFSelCellAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFSelCellAttr.SetFrameWidth(Value: Integer);
+begin
+ if Value <> FFrameWidth then
+ begin
+ FFrameWidth := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFSelCellAttr.SetStyle(Value: TJvTFSelCellStyle);
+begin
+ if Value <> FStyle then
+ begin
+ FStyle := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFSelCellAttr.Change;
+begin
+ if Assigned(FApptGrid) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFSelCellAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFSelCellAttr then
+ begin
+ FColor := TJvTFSelCellAttr(Source).Color;
+ FStyle := TJvTFSelCellAttr(Source).Style;
+ FFrameWidth := TJvTFSelCellAttr(Source).FrameWidth;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFDaysGrabHandles } ===============================================
+
+constructor TJvTFDaysGrabHandles.Create(AApptGrid: TJvTFDays);
+begin
+ inherited Create;
+ FApptGrid := AApptGrid;
+ FStyle := gsFlat;
+ FColor := clBlue;
+ FHeight := 6;
+end;
+
+procedure TJvTFDaysGrabHandles.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysGrabHandles.SetHeight(Value: Integer);
+begin
+ if Value < 1 then
+ Value := 1;
+ if Value <> FHeight then
+ begin
+ FHeight := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysGrabHandles.SetStyle(Value: TJvTFGrabStyle);
+begin
+ if Value <> FStyle then
+ begin
+ FStyle := Value;
+ if Style = gs3D then
+ FHeight := 6;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysGrabHandles.Change;
+begin
+ if Assigned(FApptGrid) then
+ FApptGrid.Invalidate;
+end;
+
+procedure TJvTFDaysGrabHandles.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysGrabHandles then
+ begin
+ FHeight := TJvTFDaysGrabHandles(Source).Height;
+ FColor := TJvTFDaysGrabHandles(Source).Color;
+ FStyle := TJvTFDaysGrabHandles(Source).Style;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFDays } ==========================================================
+
+constructor TJvTFDays.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ControlStyle := ControlStyle +
+ [csOpaque, csCaptureMouse, csClickEvents, csDoubleClicks];
+
+ (*
+ with GetControlClassDefaultSize do
+ SetInitialBounds(0, 0, CX, CY);
+ *)
+ {
+ Height := 300;
+ Width := 400;
+ }
+
+ FSaveFocCol := -1;
+
+ //set property defaults
+// FBorderStyle := bsSingle;
+ FColHdrHeight := 30;
+ FGroupHdrHeight := 25;
+ FRowHdrWidth := 50;
+ FRowHeight := 19;
+ FGranularity := 30;
+ FTopRow := 0;
+ FFocusedRow := -1;
+ FMinColWidth := AbsMinColWidth;
+ FLeftCol := -1;
+ FFocusedCol := -1;
+ FDefColWidth := 100;
+ FVisibleScrollBars := [];
+ FAutoSizeCols := True;
+ FMinRowHeight := 12;
+ ParentColor := False;
+ Color := clSilver;
+ FOptions := [agoSizeCols, agoSizeRows, agoSizeColHdr, agoSizeRowHdr,
+ agoSizeAppt, agoMoveAppt, agoEditing, agoShowPics,
+ agoShowText, agoShowApptHints, agoQuickEntry, agoShowSelHint];
+ FColTitleStyle := ctsSingleEllipsis;
+ FRowHdrType := rhFancy;
+ FSelStart := Point(-1, -1);
+ FSelEnd := FSelStart;
+ FApptBuffer := 5;
+ FFocusedCol := -1;
+ FFocusedRow := -1;
+ FGridLineColor := clGray;
+ FDitheredBackground := True;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // all ok
+ FWeekend := [dowSunday, dowSaturday];
+ FWeekendColor := clSilver;
+ FWeekendFillPic := TBitmap.Create;
+ FWeekendFillPic.Height := 16;
+ FWeekendFillPic.Width := 16;
+ UpdateWeekendFillPic;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // Create internal objects
+ FVScrollBar := TJvTFDaysScrollBar.Create(Self);
+ with FVScrollBar do
+ begin
+ Kind := sbVertical;
+ TabStop := False;
+ Anchors := [];
+ Parent := Self;
+ Visible := False;
+ OnScroll := @ScrollBarScroll;
+ end;
+
+ FHScrollBar := TJvTFDaysScrollBar.Create(Self);
+ with FHScrollBar do
+ begin
+ Kind := sbHorizontal;
+ TabStop := False;
+ Anchors := [];
+ Parent := Self;
+ Visible := False;
+ OnScroll := @ScrollBarScroll;
+ end;
+
+ FHdrAttr := TJvTFDaysHdrAttr.Create(Self);
+ FHdrAttr.Color := clBtnFace;
+
+ FSelHdrAttr := TJvTFDaysHdrAttr.Create(Self);
+ with FSelHdrAttr do
+ begin
+ Color := clBtnFace;
+ Font.Color := clBlack;
+ end;
+
+ FGroupHdrAttr := TJvTFDaysHdrAttr.Create(Self);
+ FGroupHdrAttr.Color := clBtnFace;
+
+ FSelGroupHdrAttr := TJvTFDaysHdrAttr.Create(Self);
+ with FSelGroupHdrAttr do
+ begin
+ Color := clBtnFace;
+ Font.Color := clBlack;
+ end;
+
+ FFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self);
+ FSelFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(Self);
+ with FSelFancyRowHdrAttr do
+ begin
+ TickColor := clBlack;
+ MinorFont.Color := clBlack;
+ MajorFont.Color := clBlack;
+ end;
+
+ FSelCellAttr := TJvTFSelCellAttr.Create(Self);
+
+ FApptBar := TJvTFDaysApptBar.Create(Self);
+
+ FCols := TJvTFDaysCols.Create(Self);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ FTimeBlocks := TJvTFDaysTimeBlocks.Create(Self);
+ FTimeBlockProps := TJvTFDaysBlockProps.Create(Self);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ FEditor := TJvTFInPlaceApptEditor.Create(Self);
+ with FEditor do
+ begin
+ Visible := False;
+ Parent := Self;
+ end;
+
+ FThresholds := TJvTFDaysThresholds.Create(Self);
+ FPrimeTime := TJvTFDaysPrimeTime.Create(Self);
+
+ FApptAttr := TJvTFDaysApptAttr.Create(Self);
+ FSelApptAttr := TJvTFDaysApptAttr.Create(Self);
+
+ FTemplate := TJvTFDaysTemplate.Create(Self);
+
+ FGrabHandles := TJvTFDaysGrabHandles.Create(Self);
+
+ FHintProps := TJvTFHintProps.Create(Self);
+ //FHint := TJvTFHint.Create(Self);
+ FHint := GetTFHintClass.Create(Self);
+ FHint.RefProps := FHintProps;
+ PaintBuffer := TBitmap.Create;
+ FShowFocus := True;
+
+ with GetControlClassDefaultSize do
+ SetInitialBounds(0, 0, CX, CY);
+end;
+
+destructor TJvTFDays.Destroy;
+begin
+ FVScrollBar.Free;
+ FHScrollBar.Free;
+ FHdrAttr.Free;
+ FSelHdrAttr.Free;
+ FGroupHdrAttr.Free;
+ FSelGroupHdrAttr.Free;
+
+ FFancyRowHdrAttr.Free;
+ FSelFancyRowHdrAttr.Free;
+ FSelCellAttr.Free;
+ FApptBar.Free;
+ FPrimeTime.Free;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // all ok
+ FTimeBlocks.Free;
+ FTimeBlockProps.Free;
+ FWeekendFillPic.Free;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ FEditor.Free;
+ FThresholds.Free;
+ FApptAttr.Free;
+ FSelApptAttr.Free;
+ FHint.Free;
+ FHintProps.Free;
+ FTemplate.Free;
+ FGrabHandles.Free;
+ PaintBuffer.Free;
+ inherited Destroy;
+
+ // This MUST be done after the inherited Destroy as it will set the Manager
+ // property to nil, thus triggering RelSchedNotification if ScheduleCount
+ // is still not 0. And in that very method, there is a test on Cols.Count.
+ // Hence, if FCols was to be freed before inherited, RelSchedNotification
+ // would try to access a freed object, leading to potential AVs.
+ FCols.Free;
+end;
+
+
+ {
+procedure TJvTFDays.CMCtl3DChanged(var Msg: TLMessage);
+begin
+ if FBorderStyle = bsSingle then
+ RecreateWnd;
+ inherited;
+end; }
+
+procedure TJvTFDays.WMGetDlgCode(var Msg: TLMGetDlgCode);
+begin
+ Msg.Result := DLGC_WANTALLKEYS or DLGC_WANTARROWS;
+end;
+
+
+ {
+procedure TJvTFDays.SetBorderStyle(Value: TBorderStyle);
+begin
+ if FBorderStyle <> Value then
+ begin
+ FBorderStyle := Value;
+ RecreateWnd;
+ end;
+end;
+}
+
+procedure TJvTFDays.SetTFVisibleScrollBars(Value: TJvTFVisibleScrollBars);
+begin
+ if Value <> FVisibleScrollBars then
+ begin
+ FVisibleScrollBars := Value;
+ AlignScrollBars;
+ FVScrollBar.Visible := vsbVert in FVisibleScrollBars;
+ FHScrollBar.Visible := vsbHorz in FVisibleScrollBars;
+ end;
+end;
+
+procedure TJvTFDays.AlignScrollBars;
+begin
+ // DO NOT INVALIDATE GRID IN THIS METHOD
+ if (FVScrollBar = nil) or (FHScrollbar = nil) then
+ exit;
+
+ FVScrollBar.Left := ClientWidth - FVScrollBar.Width;
+ FHScrollBar.Top := ClientHeight - FHScrollBar.Height;
+
+ with FVScrollBar do
+ begin
+ //group Top := ColHdrHeight;
+ Top := CalcGroupColHdrsHeight;
+ if vsbHorz in VisibleScrollBars then
+ Height := FHScrollBar.Top - Top
+ else
+ Height := Self.ClientHeight - Top;
+ end;
+
+ with FHScrollBar do
+ begin
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Left := CalcBlockRowHdrsWidth;
+ {$ELSE}
+ // remove
+ //Left := RowHdrWidth;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ if vsbVert in VisibleScrollBars then
+ Width := FVScrollBar.Left - Left
+ else
+ Width := Self.ClientWidth - Left;
+ end;
+end;
+
+function TJvTFDays.CheckSBVis: Boolean;
+var
+ NewSBVis: TJvTFVisibleScrollBars;
+ I, TempWidth, NewDataHeight, NewDataWidth: Integer;
+ DoColResize: Boolean;
+
+ function CalcDataRect(ForScrollBars: TJvTFVisibleScrollBars): TRect;
+ begin
+ Result := GetClientRect;
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Inc(Result.Left, CalcBlockRowHdrsWidth);
+ {$ELSE}
+ // remove
+ //Inc(Result.Left, RowHdrWidth);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ //group Inc(Result.Top, ColHdrHeight);
+ Inc(Result.Top, CalcGroupColHdrsHeight);
+ if vsbHorz in ForScrollBars then
+ Dec(Result.Bottom, FHScrollBar.Height);
+ if vsbVert in ForScrollBars then
+ Dec(Result.Right, FVScrollBar.Width);
+ end;
+
+ function CalcDataWidth(ForScrollBars: TJvTFVisibleScrollBars): Integer;
+ begin
+ Result := RectWidth(CalcDataRect(ForScrollBars));
+ end;
+
+ function CalcDataHeight(ForScrollBars: TJvTFVisibleScrollBars): Integer;
+ begin
+ Result := RectHeight(CalcDataRect(ForScrollBars));
+ end;
+
+begin
+ NewSBVis := [];
+
+ // First check vert scroll bar, assuming horz is not needed
+ NewDataHeight := CalcDataHeight(NewSBVis);
+ if (RowCount * RowHeight > NewDataHeight) or (TopRow > 0) then
+ Include(NewSBVis, vsbVert);
+
+ if Cols.Count > 0 then
+ begin
+ // Now check the horz scroll under the new conditions
+ NewDataWidth := CalcDataWidth(NewSBVis);
+ if AutoSizeCols then
+ begin
+ if (Cols.Count * MinColWidth > NewDataWidth) or (LeftCol > 0) then
+ Include(NewSBVis, vsbHorz);
+ end
+ else
+ begin
+ TempWidth := 0;
+ I := 0;
+ while (TempWidth <= NewDataWidth) and (I < Cols.Count) do
+ begin
+ Inc(TempWidth, Cols[I].Width);
+ Inc(I);
+ end;
+
+ if (TempWidth > NewDataWidth) or (LeftCol > 0) then
+ Include(NewSBVis, vsbHorz);
+ end;
+ end;
+
+ // if the horz scrollbar should show, we must recheck the vert scrollbar,
+ // since the vert scrollbar was initially checked with the assumption
+ // that the horz scrollbar was not needed.
+ if vsbHorz in NewSBVis then
+ begin
+ NewDataHeight := CalcDataHeight(NewSBVis);
+ if (RowCount * RowHeight > NewDataHeight) or (TopRow > 0) then
+ Include(NewSBVis, vsbVert);
+ end;
+
+ // if we're autosizing the cols and the vert scrollbar has been
+ // toggled and the horz scroll isn't visible then we need to resize
+ // the cols. We can't call Cols.Resize until VisibleScrollBars has
+ // been updated so just set a flag here.
+ DoColResize := AutoSizeCols and not (vsbHorz in NewSBVis) and
+ ((vsbVert in NewSBVis) xor (vsbVert in VisibleScrollBars));
+
+ // At this point NewSBVis will correctly reflect which scrollbars need to
+ // visible on the control.
+ VisibleScrollBars := NewSBVis;
+
+ // In order to optimize the resizing of cols when AutoSizeCols is on, this
+ // function needs a return value specifying whether or not the cols have
+ // been resized from within this routine. if we're not autosizing cols
+ // it'll return false, but the result is meaningless.
+ Result := DoColResize;
+
+ // Finally, resize the cols if necessary
+ if DoColResize then
+ Cols.ResizeCols;
+
+ CheckSBParams;
+end;
+
+procedure TJvTFDays.SetOnShowHint(Value: TJvTFShowHintEvent);
+begin
+ FHint.OnShowHint := Value;
+end;
+
+function TJvTFDays.GetOnShowHint: TJvTFShowHintEvent;
+begin
+ Result := FHint.OnShowHint;
+end;
+
+procedure TJvTFDays.SetGranularity(Value: Integer);
+var
+ ATime: TTime;
+ MaxRowHeight, I: Integer;
+begin
+ if Assigned(FOnGranularityChanging) then
+ FOnGranularityChanging(Self, Value);
+
+ // Enforce minimum granularity of 1 min and max of 60 mins
+ if Value < 1 then
+ Value := 1
+ else
+ if Value > 60 then
+ Value := 60;
+
+ // Ensure that granularity is evenly divisable by an hour
+ while 60 mod Value <> 0 do
+ Dec(Value);
+
+ // Sum of row heights cannot exceed 32767
+ MaxRowHeight := 32767 div (60 div Value * 24);
+ if RowHeight > MaxRowHeight then
+ RowHeight := MaxRowHeight;
+
+ if Value <> FGranularity then
+ begin
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ EnsureBlockRules(Value, TimeBlockProps.BlockGran, TimeBlockProps.DayStart);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ ATime := RowToTime(TopRow);
+ FGranularity := Value;
+ ClearSelection;
+ if not (csLoading in ComponentState) then
+ begin
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].RefreshMap;
+ TopRow := TimeToRow(ATime);
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ if Assigned(FOnGranularityChanged) then
+ FOnGranularityChanged(Self);
+ end;
+ end;
+end;
+
+procedure TJvTFDays.SetColHdrHeight(Value: Integer);
+begin
+ if Value > RectHeight(GetAdjClientRect) then
+ Value := RectHeight(GetAdjClientRect);
+ if Value < 1 then
+ Value := 1;
+
+ if Value <> ColHdrHeight then
+ begin
+ FColHdrHeight := Value;
+ AlignScrollBars;
+ if not (csLoading in ComponentState) then
+ begin
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.SetRowHdrWidth(Value: Integer);
+begin
+ if Value > RectWidth(GetAdjClientRect) then
+ Value := RectWidth(GetAdjClientRect);
+ if Value < 1 then
+ Value := 1;
+
+ if Value <> FRowHdrWidth then
+ begin
+ FRowHdrWidth := Value;
+ AlignScrollBars;
+ if AutoSizeCols then
+ begin
+ if not CheckSBVis then
+ if not (vsbHorz in VisibleScrollBars) then
+ Cols.ResizeCols;
+ end
+ else
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetRowHeight(Value: Integer);
+var
+ MaxRowHeight: Integer;
+begin
+ if Value > GetDataHeight then
+ Value := GetDataHeight;
+ if Value < MinRowHeight then
+ Value := MinRowHeight;
+ if Value < 1 then
+ Value := 1;
+
+ // Sum of row heights cannot exceed 32767.
+ MaxRowHeight := 32767 div (60 div Granularity * 24);
+ if Value > MaxRowHeight then
+ Value := MaxRowHeight;
+
+ if Value <> FRowHeight then
+ begin
+ FRowHeight := Value;
+ if not (csLoading in ComponentState) then
+ begin
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.SetMinRowHeight(Value: Integer);
+begin
+ if Value < AbsMinColWidth then
+ Value := AbsMinColWidth;
+
+ if Value <> FMinRowHeight then
+ begin
+ FMinRowHeight := Value;
+ if Value > RowHeight then
+ RowHeight := Value;
+ end;
+end;
+
+procedure TJvTFDays.SetMinColWidth(Value: Integer);
+begin
+ if Value < AbsMinColWidth then
+ Value := AbsMinColWidth;
+
+ if Value <> FMinColWidth then
+ begin
+ FMinColWidth := Value;
+ if not (csLoading in ComponentState) then
+ Cols.EnsureMinColWidth;
+ end;
+end;
+
+procedure TJvTFDays.SetAutoSizeCols(Value: Boolean);
+begin
+ if Value <> FAutoSizeCols then
+ begin
+ FAutoSizeCols := Value;
+ if FAutoSizeCols then
+ if not CheckSBVis then
+ Cols.ResizeCols;
+ end;
+end;
+
+procedure TJvTFDays.SetTFColTitleStyle(Value: TJvTFColTitleStyle);
+begin
+ if Value <> FColTitleStyle then
+ begin
+ FColTitleStyle := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetCols(Value: TJvTFDaysCols);
+begin
+ FCols.Assign(Value);
+end;
+
+procedure TJvTFDays.SetTopRow(Value: Integer);
+var
+ MaxTopRow: Integer;
+begin
+ MaxTopRow := RowCount - 1;
+ if MaxTopRow < 0 then
+ MaxTopRow := 0;
+ if Value > MaxTopRow then
+ Value := MaxTopRow;
+
+ if Value <> FTopRow then
+ if (Value > -1) and (Value < RowCount) then
+ begin
+ if Editing then
+ FinishEditAppt;
+
+ FTopRow := Value;
+ FVScrollBar.Position := Value;
+ CheckSBVis;
+ Invalidate;
+ end
+ else
+ raise EJvTFDaysError.CreateRes(@RsERowIndexOutOfBounds);
+end;
+
+procedure TJvTFDays.SetFocusedRow(Value: Integer);
+begin
+ // ALLOW -1 TO INDICATE NO SELECTED ROW
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ if (Value <> -1) and (RowToTimeBlock(Value) = -1) and (TimeBlocks.Count > 0) then
+ Exit;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ if Value <> FFocusedRow then
+ if (Value >= -1) and (Value < RowCount) then
+ begin
+ FFocusedRow := Value;
+ if not (csDesigning in ComponentState) then
+ SetFocus;
+ if not Assigned(SelAppt) and (Value > -1) then
+ RowInView(Value);
+ if Assigned(FOnFocusedRowChanged) then
+ FOnFocusedRowChanged(Self);
+ Invalidate;
+ end
+ else
+ raise EJvTFDaysError.CreateRes(@RsERowIndexOutOfBounds);
+end;
+
+function TJvTFDays.GetFocusedRow: Integer;
+begin
+ if Focused then
+ Result := FFocusedRow
+ else
+ Result := -1;
+end;
+
+procedure TJvTFDays.SetLeftCol(Value: Integer);
+begin
+ // LeftCol will be -1 when no cols are present.
+ // After the first col is added, LeftCol is set to 0, which is done in
+ // TJvTFDaysCols.Update. Likewise, when all cols are removed, LeftCol
+ // must be set to -1. This is also done in TJvTFDaysCols.Update.
+
+ if Value <> FLeftCol then
+ if Cols.Count > 0 then
+ if (Value > -1) and (Value < Cols.Count) then
+ begin
+ FLeftCol := Value;
+ FHScrollBar.Position := Value;
+ if not Cols.Updating then
+ begin
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+ end
+ else
+ raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds)
+ else
+ if Value = -1 then
+ begin
+ FLeftCol := -1;
+ Invalidate;
+ end
+ else
+ raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds);
+end;
+
+procedure TJvTFDays.SetFocusedCol(Value: Integer);
+begin
+ // ALLOW -1 TO INDICATE NO SELECTED COL
+
+ if Value <> FFocusedCol then
+ if (Value >= -1) and (Value < Cols.Count) then
+ begin
+ FFocusedCol := Value;
+ if not (csDesigning in ComponentState) then
+ SetFocus;
+ if not Cols.Updating then
+ begin
+ if Value > -1 then
+ ColInView(Value);
+ if Assigned(FOnFocusedColChanged) then
+ FOnFocusedColChanged(Self);
+ Invalidate;
+ end;
+ end
+ else
+ raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds);
+end;
+
+function TJvTFDays.GetFocusedCol: Integer;
+begin
+ if Focused then
+ Result := FFocusedCol
+ else
+ Result := -1;
+end;
+
+procedure TJvTFDays.SetHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ FHdrAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetSelHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ FSelHdrAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetApptAttr(Value: TJvTFDaysApptAttr);
+begin
+ FApptAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetSelApptAttr(Value: TJvTFDaysApptAttr);
+begin
+ FSelApptAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr);
+begin
+ FFancyRowHdrAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetSelFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr);
+begin
+ FSelFancyRowHdrAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetTFRowHdrType(Value: TJvTFRowHdrType);
+begin
+ if Value <> FRowHdrType then
+ begin
+ FRowHdrType := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetTFSelCellAttr(Value: TJvTFSelCellAttr);
+begin
+ FSelCellAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetApptBar(Value: TJvTFDaysApptBar);
+begin
+ FApptBar.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetApptBuffer(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FApptBuffer then
+ begin
+ FApptBuffer := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetGridLineColor(Value: TColor);
+begin
+ if Value <> FGridLineColor then
+ begin
+ FGridLineColor := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetGrabHandles(Value: TJvTFDaysGrabHandles);
+begin
+ FGrabHandles.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetOptions(Value: TJvTFDaysOptions);
+begin
+ FOptions := Value;
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetDateFormat(const Value: string);
+begin
+ if Value <> FDateFormat then
+ begin
+ FDateFormat := Value;
+ Cols.UpdateTitles;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.RelSchedNotification(Schedule: TJvTFSched);
+var
+ I: Integer;
+begin
+ for I := 0 to Cols.Count - 1 do
+ if Cols[I].Schedule = Schedule then
+ Cols[I].Disconnect;
+ inherited RelSchedNotification(Schedule);
+end;
+
+procedure TJvTFDays.CreateParams(var Params: TCreateParams);
+const
+ BorderStyles: array [TBorderStyle] of DWORD = (0, WS_BORDER);
+begin
+ inherited CreateParams(Params);
+ {
+ with Params do
+ begin
+ Style := Style or BorderStyles[FBorderStyle] or WS_CLIPCHILDREN;
+ if Ctl3D and (FBorderStyle = bsSingle) then
+ begin
+ Style := Style and not WS_BORDER;
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+ end;
+ end;
+ }
+end;
+
+function TJvTFDays.GetFocusedSchedule: TJvTFSched;
+begin
+ Result := nil;
+ if FocusedCol > gcHdr then
+ Result := Cols[FocusedCol].Schedule;
+end;
+
+procedure TJvTFDays.SetSelAppt(Value: TJvTFAppt);
+begin
+ // need event here with var Appt param - allows handler to set Appt
+ // to nil.
+ if Assigned(FOnSelectingAppt) then
+ FOnSelectingAppt(Self, Value);
+
+ if Value <> FSelAppt then
+ begin
+ if Editing then
+ FinishEditAppt;
+ if Assigned(FOnSelectAppt) then
+ FOnSelectAppt(Self, FSelAppt, Value);
+ FSelAppt := Value;
+ if Assigned(FOnSelectedAppt) then
+ FOnSelectedAppt(Self);
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.Paint;
+var
+ I, J, lRightCol, lBottomRow: Integer;
+begin
+{ optimization incorrectly kicks in if control is only partially
+ visible on the screen
+ if not PaintBuffer.Empty and
+ ((Canvas.ClipRect.Left <> ClientRect.Left) or
+ (Canvas.ClipRect.Top <> ClientRect.Top) or
+ (Canvas.ClipRect.Right <> ClientRect.Right) or
+ (Canvas.ClipRect.Bottom <> ClientRect.Bottom)) then
+ begin
+ With Canvas do
+ Windows.BitBlt(Canvas.Handle, ClipRect.Left, ClipRect.Top,
+ RectWidth(ClipRect), RectHeight(ClipRect),
+ PaintBuffer.Canvas.Handle,
+ ClipRect.Left, ClipRect.Top, SRCCOPY);
+ Exit;
+ end;
+ }
+
+ with PaintBuffer do
+ begin
+ Width := ClientWidth;
+ Height := ClientHeight;
+
+ with Canvas do
+ begin
+ if FDitheredBackground then
+ // added by TIM, 10/27/2001 10:36:03 PM:
+ DrawDither(Canvas, Classes.Rect(0, 0, Width, Height), Self.Color, clGray)
+ else
+ begin
+ Brush.Color := Self.Color;
+ FillRect(Classes.Rect(0, 0, Width, Height));
+ end;
+ end;
+
+ DrawCorner(Canvas, agcTopLeft);
+
+ if Cols.Count = 0 then
+ DrawEmptyColHdr(Canvas);
+
+ DrawGroupHdrs(Canvas);
+
+ lRightCol := LeftCol + VisibleCols - 1;
+ for I := LeftCol to lRightCol do
+ //DrawColHdr(Canvas, I);
+ DrawColGroupHdr(Canvas, I, False);
+
+ if vsbVert in VisibleScrollBars then
+ DrawCorner(Canvas, agcTopRight);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // all ok
+ FillBlockHdrDeadSpace(Canvas);
+ for I := 0 to TimeBlocks.Count - 1 do
+ DrawBlockHdr(Canvas, I);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ lBottomRow := TopRow + VisibleRows - 1;
+ if RowHdrType = rhFancy then
+ DrawFancyRowHdrs(Canvas)
+ else
+ for I := TopRow to lBottomRow do
+ DrawRowHdr(Canvas, I);
+
+ for I := TopRow to lBottomRow do
+ for J := LeftCol to lRightCol do
+ DrawDataCell(Canvas, J, I);
+
+ if not (csDesigning in ComponentState) then
+ DrawAppts(Canvas, False);
+
+ if vsbHorz in VisibleScrollBars then
+ begin
+ DrawCorner(Canvas, agcBottomLeft);
+ if vsbVert in VisibleScrollBars then
+ DrawCorner(Canvas, agcBottomRight);
+ end;
+ end;
+
+ if Enabled then
+ BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
+ PaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
+ else
+ BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
+ PaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
+ { wp --- to do: Above line is a work-around because LCL does not
+ support DrawState
+ Windows.DrawState(Canvas.Handle, 0, nil, PaintBuffer.Handle, 0,
+ 0, 0, 0, 0, DST_BITMAP or DSS_UNION or DSS_DISABLED);
+ }
+end;
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// OBSOLETE
+{
+procedure TJvTFDays.DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer);
+Var
+ SelFrameRect,
+ FocusRect,
+ ARect: TRect;
+ I,
+ PrimeStartRow,
+ PrimeEndRow,
+ FrameOffset: Integer;
+ CellColor: TColor;
+ IsPrimeTimeCell: Boolean;
+begin
+ // Calc the cell rect
+ ARect.Left := RowHdrWidth;
+ For I := LeftCol to ColIndex - 1 do
+ Inc(ARect.Left, Cols[I].Width);
+ ARect.Right := ARect.Left + Cols[ColIndex].Width;
+
+ //group Top := ColHdrHeight + (RowIndex - TopRow) * RowHeight;
+ ARect.Top := CalcGroupColHdrsHeight + (RowIndex - TopRow) * RowHeight;
+ ARect.Bottom := ARect.Top + RowHeight;
+
+ PrimeStartRow := TimeToRow(PrimeTime.StartTime);
+ PrimeEndRow := TimeToRow(AdjustEndTime(PrimeTime.EndTime));
+
+ IsPrimeTimeCell := (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow);
+
+ if IsPrimeTimeCell then
+ CellColor := PrimeTime.Color
+ else
+ CellColor := Color;
+
+ if Assigned(FOnShadeCell) then
+ FOnShadeCell(Self, ColIndex, RowIndex, CellColor);
+
+ if IsPrimeTimeCell and (CellColor = PrimeTime.Color) then
+ Windows.StretchBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect),
+ RectHeight(ARect), PrimeTime.FFillPic.Canvas.Handle,
+ 0, 0, PrimeTime.FFillPic.Width,
+ PrimeTime.FFillPic.Height, SRCCOPY)
+ else
+ if CellColor <> Color then
+ begin
+ ACanvas.Brush.Color := CellColor;
+ ACanvas.FillRect(ARect);
+ end;
+
+ if CellIsSelected(Point(ColIndex, RowIndex)) then
+ if SelCellAttr.Style = scsFrame then
+ begin
+ SelFrameRect := ARect;
+ FrameOffset := -(SelCellAttr.FrameWidth div 2);
+ Windows.InflateRect(SelFrameRect, FrameOffset, FrameOffset);
+
+ if SelCellAttr.FrameWidth mod 2 <> 0 then
+ begin
+ Dec(SelFrameRect.Right);
+ Dec(SelFrameRect.Bottom);
+ end;
+
+ With ACanvas do
+ begin
+ Pen.Color := SelCellAttr.Color;
+ Pen.Width := SelCellAttr.FrameWidth;
+
+ if FFromToSel then
+ begin
+ // Draw Left border
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+
+ // Draw Top border only if this cell is the same as SelStart cell
+ if (ColIndex = SelStart.X) and (RowIndex = SelStart.Y) then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ end;
+
+ // Draw Right border
+ MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+
+ // Draw bottom border only in this cell is the same as SelEnd cell
+ if (ColIndex = SelEnd.X) and (RowIndex = SelEnd.Y) then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ end;
+ end
+ else
+ begin
+ // Draw Left border only if col is left-most in selection
+ if ColIndex = SelStart.X then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ end;
+
+ // Draw Top border only if row is top-most in selection
+ if RowIndex = SelStart.Y then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ end;
+
+ // Draw Right border only if col is right-most in selection
+ if ColIndex = SelEnd.X then
+ begin
+ MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ end;
+
+ // Draw Bottom border only if row is bottom-most in selection
+ if RowIndex = SelEnd.Y then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ end;
+ end;
+ end;
+ end
+ // Refer to the private FSel* fields because we want anchor
+ else
+ if (SelCellAttr.Style = scsCombo) and
+ (FSelStart.X = ColIndex) and (FSelStart.Y = RowIndex) then
+ begin
+ SelFrameRect := ARect;
+ FrameOffset := -(SelCellAttr.FrameWidth div 2);
+ Windows.InflateRect(SelFrameRect, FrameOffset, FrameOffset);
+
+ if SelCellAttr.FrameWidth mod 2 <> 0 then
+ begin
+ Dec(SelFrameRect.Right);
+ Dec(SelFrameRect.Bottom);
+ end;
+
+ With ACanvas do
+ begin
+ Pen.Color := SelCellAttr.Color;
+ Pen.Width := SelCellAttr.FrameWidth;
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Left, SelFrameRect.Top);
+ end;
+ end
+ else
+ begin
+ ACanvas.Brush.Color := SelCellAttr.Color;
+ ACanvas.FillRect(ARect);
+ end;
+
+ if (ColIndex = FocusedCol) and (RowIndex = FocusedRow) and Focused then
+ begin
+ FocusRect := ARect;
+ Windows.InflateRect(FocusRect, -1, -1);
+ Dec(FocusRect.Bottom);
+ Dec(FocusRect.Right);
+ ManualFocusRect(ACanvas, FocusRect);
+ end;
+
+ // Draw a line across the bottom and down the right side
+ With ACanvas do
+ begin
+ Pen.Color := GridLineColor;
+ Pen.Width := 1;
+
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+ end;
+
+ if Assigned(FOnDrawDataCell) then
+ FOnDrawDataCell(Self, ACanvas, ARect, ColIndex, RowIndex);
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+procedure TJvTFDays.DrawDataCell(ACanvas: TCanvas; ColIndex, RowIndex: Integer);
+var
+ SelFrameRect, FocusRect, Rect: TRect;
+ I, PrimeStartRow, PrimeEndRow: Integer;
+ FrameOffset, BlockStart, BlockEnd, TimeBlockIndex: Integer;
+ IsPrimeTimeCell: Boolean;
+ CellColor: TColor;
+ // col buffer start
+ BufferRect: TRect;
+ // col buffer end
+begin
+ // Calc the cell rect
+ //block Left := RowHdrWidth;
+ Rect.Left := CalcBlockRowHdrsWidth;
+ for I := LeftCol to ColIndex - 1 do
+ Inc(Rect.Left, Cols[I].Width);
+ Rect.Right := Rect.Left + Cols[ColIndex].Width;
+
+ //group Top := ColHdrHeight + (RowIndex - TopRow) * RowHeight;
+ Rect.Top := CalcGroupColHdrsHeight + (RowIndex - TopRow) * RowHeight;
+ Rect.Bottom := Rect.Top + RowHeight;
+
+ PrimeStartRow := TimeToRow(PrimeTime.StartTime);
+ PrimeEndRow := TimeToRow(AdjustEndTime(PrimeTime.EndTime));
+
+ IsPrimeTimeCell := (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow);
+
+ if IsWeekend(ColIndex) then
+ CellColor := WeekendColor
+ else
+ if IsPrimeTimeCell then
+ CellColor := PrimeTime.Color
+ else
+ CellColor := Color;
+
+ if Assigned(FOnShadeCell) then
+ FOnShadeCell(Self, ColIndex, RowIndex, CellColor);
+
+ if IsWeekend(ColIndex) and (CellColor = WeekendColor) then
+ begin
+ if FDitheredBackground then
+ DrawDither(ACanvas, Rect, CellColor, clWhite)
+ else
+ StretchBlt(ACanvas.Handle, Rect.Left, Rect.Top, RectWidth(Rect),
+ RectHeight(Rect), FWeekendFillPic.Canvas.Handle,
+ 0, 0, FWeekendFillPic.Width,
+ FWeekendFillPic.Height, SRCCOPY);
+ end
+ else
+ if IsPrimeTimeCell and (CellColor = PrimeTime.Color) then
+ begin
+ if FDitheredBackground then
+ DrawDither(ACanvas, Rect, CellColor, clWhite)
+ else
+ StretchBlt(ACanvas.Handle, Rect.Left, Rect.Top, RectWidth(Rect),
+ RectHeight(Rect), PrimeTime.FFillPic.Canvas.Handle,
+ 0, 0, PrimeTime.FFillPic.Width,
+ PrimeTime.FFillPic.Height, SRCCOPY);
+ end
+ else
+ if CellColor <> Color then
+ begin
+ ACanvas.Brush.Color := CellColor;
+ ACanvas.FillRect(Rect);
+ end
+ else
+ begin
+ if FDitheredBackground then
+ DrawDither(ACanvas, Rect, CellColor, clWhite);
+ end;
+
+ {
+ if IsWeekend(ColIndex) then
+ Windows.StretchBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect),
+ RectHeight(ARect), FWeekendFillPic.Canvas.Handle,
+ 0, 0, FWeekendFillPic.Width,
+ FWeekendFillPic.Height, SRCCOPY)
+ else
+ if (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow) then
+ Windows.StretchBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect),
+ RectHeight(ARect), PrimeTime.FFillPic.Canvas.Handle,
+ 0, 0, PrimeTime.FFillPic.Width,
+ PrimeTime.FFillPic.Height, SRCCOPY);
+ }
+
+ if CellIsSelected(Point(ColIndex, RowIndex)) then
+ if SelCellAttr.Style = scsFrame then
+ begin
+ SelFrameRect := Rect;
+ FrameOffset := -(SelCellAttr.FrameWidth div 2);
+ InflateRect(SelFrameRect, FrameOffset, FrameOffset);
+
+ if SelCellAttr.FrameWidth mod 2 <> 0 then
+ begin
+ Dec(SelFrameRect.Right);
+ Dec(SelFrameRect.Bottom);
+ end;
+
+ with ACanvas do
+ begin
+ Pen.Color := SelCellAttr.Color;
+ Pen.Width := SelCellAttr.FrameWidth;
+
+ if FFromToSel then
+ begin
+ // Draw Left border
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+
+ // Draw Top border only if this cell is the same as SelStart cell
+ if (ColIndex = SelStart.X) and (RowIndex = SelStart.Y) then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ end;
+
+ // Draw Right border
+ MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+
+ // Draw bottom border only in this cell is the same as SelEnd cell
+ if (ColIndex = SelEnd.X) and (RowIndex = SelEnd.Y) then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ end;
+ end
+ else
+ begin
+ // Draw Left border only if col is left-most in selection
+ if ColIndex = SelStart.X then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ end;
+
+ // Draw Top border only if row is top-most in selection
+ if RowIndex = SelStart.Y then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ end;
+
+ // Draw Right border only if col is right-most in selection
+ if ColIndex = SelEnd.X then
+ begin
+ MoveTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ end;
+
+ // Draw Bottom border only if row is bottom-most in selection
+ if RowIndex = SelEnd.Y then
+ begin
+ MoveTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ end;
+ end;
+ end;
+ end
+ // Refer to the private FSel* fields because we want anchor
+ else
+ if (SelCellAttr.Style = scsCombo) and
+ (FSelStart.X = ColIndex) and (FSelStart.Y = RowIndex) then
+ begin
+ SelFrameRect := Rect;
+ FrameOffset := -(SelCellAttr.FrameWidth div 2);
+ InflateRect(SelFrameRect, FrameOffset, FrameOffset);
+
+ if SelCellAttr.FrameWidth mod 2 <> 0 then
+ begin
+ Dec(SelFrameRect.Right);
+ Dec(SelFrameRect.Bottom);
+ end;
+
+ with ACanvas do
+ begin
+ Pen.Color := SelCellAttr.Color;
+ Pen.Width := SelCellAttr.FrameWidth;
+ MoveTo(SelFrameRect.Left, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Top);
+ LineTo(SelFrameRect.Right - 1, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Left, SelFrameRect.Bottom - 1);
+ LineTo(SelFrameRect.Left, SelFrameRect.Top);
+ end;
+ end
+ else
+ begin
+ ACanvas.Brush.Color := SelCellAttr.Color;
+ ACanvas.FillRect(Rect);
+ end;
+
+ if (ColIndex = FocusedCol) and (RowIndex = FocusedRow) and Focused and ShowFocus then
+ begin
+ FocusRect := Rect;
+ InflateRect(FocusRect, -1, -1);
+ Dec(FocusRect.Bottom);
+ Dec(FocusRect.Right);
+ ManualFocusRect(ACanvas, FocusRect);
+ end;
+
+ // Draw a line across the bottom and down the right side
+ with ACanvas do
+ begin
+ Pen.Color := GridLineColor;
+ Pen.Width := 1;
+
+ MoveTo(Rect.Left, Rect.Bottom - 1);
+ LineTo(Rect.Right, Rect.Bottom - 1);
+ MoveTo(Rect.Right - 1, Rect.Top);
+ LineTo(Rect.Right - 1, Rect.Bottom);
+
+ if TimeBlocks.Count > 0 then
+ begin
+ GetTimeBlockStartEnd(0, BlockStart, BlockEnd);
+ if RowIndex = BlockStart - 1 then
+ begin
+ Pen.Color := TimeBlockProps.DataDivColor;
+ MoveTo(Rect.Left, Rect.Bottom - 1);
+ LineTo(Rect.Right, Rect.Bottom - 1);
+ end;
+
+ TimeBlockIndex := RowToTimeBlock(RowIndex);
+ if TimeBlockIndex > -1 then
+ begin
+ GetTimeBlockStartEnd(TimeBlockIndex, BlockStart, BlockEnd);
+ if BlockEnd = RowIndex then
+ begin
+ Pen.Color := TimeBlockProps.DataDivColor;
+ MoveTo(Rect.Left, Rect.Bottom - 1);
+ LineTo(Rect.Right, Rect.Bottom - 1);
+ end;
+ end;
+ end;
+ end;
+
+ // Col Buffer start
+ // Draw the column buffer
+ with ACanvas do
+ begin
+ BufferRect := Rect;
+ BufferRect.Right := BufferRect.Left + ApptBar.Width; // + 10 to simulate buffer
+
+ Brush.Color := clWhite;
+ FillRect(BufferRect);
+
+ Pen.Color := clBlack;
+ Pen.Width := 1;
+
+ MoveTo(BufferRect.Right, BufferRect.Top);
+ LineTo(BufferRect.Right, BufferRect.Bottom);
+ end;
+ // Col buffer end
+
+ if Assigned(FOnDrawDataCell) then
+ FOnDrawDataCell(Self, ACanvas, Rect, ColIndex, RowIndex);
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+procedure TJvTFDays.DrawEmptyColHdr(ACanvas: TCanvas);
+var
+ Rect: TRect;
+begin
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Rect.Left := CalcBlockRowHdrsWidth;
+ {$ELSE}
+ // remove
+ //Left := RowHdrWidth;
+ {$ENDIF Jv_TIMEBLOCKS}
+ Rect.Top := 0;
+ Rect.Right := Rect.Left + GetDataWidth;
+ //group Bottom := ColHdrHeight;
+ Rect.Bottom := CalcGroupColHdrsHeight;
+
+ ACanvas.Brush.Color := HdrAttr.Color;
+ ACanvas.FillRect(Rect);
+ ACanvas.Pen.Color := clGray;
+ ACanvas.MoveTo(Rect.Left, Rect.Bottom - 1);
+ ACanvas.LineTo(Rect.Right, Rect.Bottom - 1);
+end;
+
+procedure TJvTFDays.DrawAppt(ACanvas: TCanvas; Col: Integer;
+ Appt: TJvTFAppt; StartRow, EndRow: Integer);
+var
+ ApptRect: TRect;
+ ClipRgn: HRgn;
+begin
+ ApptRect := GetApptRect(Col, Appt);
+
+ if IsRectEmpty(ApptRect) then
+ Exit;
+
+ // Printer bug, fixed
+ ClipRgn := CreateRectRgn(RowHdrWidth, CalcGroupColHdrsHeight,
+ ClientWidth, ClientHeight);
+ SelectClipRgn(ACanvas.Handle, ClipRgn);
+ DrawApptDetail(ACanvas, ApptRect, Appt, Appt = SelAppt, Col, StartRow, EndRow);
+ SelectClipRgn(ACanvas.Handle, 0);
+ DeleteObject(ClipRgn);
+end;
+
+function TJvTFDays.CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect;
+ Col, StartRow, EndRow: Integer): TRect;
+var
+ Offset, ApptLength: TTime;
+ ColDate: TDate;
+ StartPercent, EndPercent: Double;
+begin
+ Result := BarRect;
+
+ if StartRow < 0 then
+ StartRow := 0;
+
+ if EndRow > RowCount - 1 then
+ EndRow := RowCount - 1;
+
+ Offset := RowToTime(StartRow);
+ ApptLength := RowEndTime(EndRow) - Offset;
+ ColDate := Cols[Col].SchedDate;
+
+ if Trunc(ColDate) <> Trunc(Appt.StartDate) then
+ StartPercent := 0
+ else
+ StartPercent := (Appt.StartTime - Offset) / ApptLength;
+
+ if Trunc(ColDate) <> Trunc(Appt.EndDate) then
+ EndPercent := 1.0
+ else
+ EndPercent := (Appt.EndTime - Offset) / ApptLength;
+
+ Result.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) + BarRect.Top;
+ Result.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) + BarRect.Top;
+end;
+
+procedure TJvTFDays.DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect);
+var
+ OldColor: TColor;
+ StampLeft: Integer;
+begin
+ with ACanvas do
+ case ApptBar.TimeStampStyle of
+ tssFullI:
+ begin
+ OldColor := Pen.Color;
+ Pen.Color := ApptBar.TimeStampColor;
+ MoveTo(TimeStampRect.Left + 1, TimeStampRect.Top);
+ LineTo(TimeStampRect.Right - 1, TimeStampRect.Top);
+ MoveTo(TimeStampRect.Left + 1, TimeStampRect.Bottom - 1);
+ LineTo(TimeStampRect.Right - 1, TimeStampRect.Bottom - 1);
+
+ if ApptBar.Width > 5 then
+ Pen.Width := 2
+ else
+ Pen.Width := 1;
+
+ // Printer bug, fixed
+ StampLeft := TimeStampRect.Left + RectWidth(TimeStampRect) div 2;
+ MoveTo(StampLeft, TimeStampRect.Top + 1);
+ LineTo(StampLeft, TimeStampRect.Bottom - 1);
+
+ Pen.Width := 1;
+
+ Pen.Color := OldColor;
+ end;
+ tssHalfI:
+ begin
+ // we only want the left half of the time stamp rect
+ TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2;
+
+ OldColor := Pen.Color;
+ Pen.Color := ApptBar.TimeStampColor;
+ MoveTo(TimeStampRect.Left, TimeStampRect.Top);
+ LineTo(TimeStampRect.Right - 0, TimeStampRect.Top);
+ MoveTo(TimeStampRect.Left, TimeStampRect.Bottom - 0);
+ LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom - 0);
+
+ if ApptBar.Width > 5 then
+ Pen.Width := 2
+ else
+ Pen.Width := 1;
+ MoveTo(TimeStampRect.Right - 0, TimeStampRect.Top + 1);
+ LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom);
+ Pen.Color := OldColor;
+ Pen.Width := 1;
+ end;
+ tssBlock:
+ begin
+ // we only want the left half of the time stamp rect
+ TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2;
+
+ OldColor := Brush.Color;
+ Brush.Color := ApptBar.TimeStampColor;
+ FillRect(TimeStampRect);
+ Brush.Color := OldColor;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt;
+ BarRect: TRect; Col, StartRow, EndRow: Integer);
+var
+ OldColor: TColor;
+ TimeStampRect: TRect;
+ Attr: TJvTFDaysApptAttr;
+begin
+ with ACanvas do
+ begin
+ if Appt <> SelAppt then
+ Attr := ApptAttr
+ else
+ Attr := SelApptAttr;
+
+ // Fill Bar Color
+ OldColor := Brush.Color;
+ if Appt.BarColor = clDefault then
+ Brush.Color := ApptBar.Color
+ else
+ Brush.Color := Appt.BarColor;
+
+ FillRect(BarRect);
+
+ // Draw Bar Border
+ Pen.Width := 1;
+ Pen.Color := Attr.FrameColor;
+
+ MoveTo(BarRect.Right - 1, BarRect.Top);
+ LineTo(BarRect.Right - 1, BarRect.Bottom);
+// Rectangle(BarRect);
+
+ Brush.Color := OldColor;
+
+ // Draw Time Stamp
+ TimeStampRect := CalcTimeStampRect(Appt, BarRect, Col, StartRow, EndRow);
+ if ApptBar.TimeStampStyle <> tssNone then
+ DrawTimeStamp(ACanvas, TimeStampRect);
+
+ if Assigned(FOnDrawApptBar) then
+ FOnDrawApptBar(Self, ACanvas, Appt, Col, BarRect, TimeStampRect);
+ end;
+end;
+
+procedure TJvTFDays.DrawApptDetail(ACanvas: TCanvas; ARect: TRect;
+ Appt: TJvTFAppt; Selected: Boolean; Col, StartRow, EndRow: Integer);
+var
+ TheFrameRect, TxtRect, DetailRect, BarRect, HandleRect: TRect;
+ Txt: string;
+ Flags: UINT;
+ CanDrawText, CanDrawPics, CanDrawAppt: Boolean;
+ PicsHeight, PicsWidth: Integer;
+ DrawList: TList;
+ Attr: TJvTFDaysApptAttr;
+ DrawInfo: TJvTFDaysApptDrawInfo;
+begin
+ with ACanvas do
+ begin
+ if Appt <> SelAppt then
+ Attr := ApptAttr
+ else
+ Attr := SelApptAttr;
+
+ DrawInfo := TJvTFDaysApptDrawInfo.Create;
+ try
+ GetApptDrawInfo(DrawInfo, Appt, Attr);
+ Font.Assign(DrawInfo.Font);
+ Brush.Color := DrawInfo.Color;
+ Pen.Color := DrawInfo.FrameColor;
+ Pen.Width := DrawInfo.FrameWidth;
+ CanDrawAppt := DrawInfo.Visible;
+ finally
+ DrawInfo.Free;
+ end;
+
+ // !!!!!!!!!!!!!!!!!!!!!!!!!!
+ // EXIT IF NOTHING TO DRAW !!
+ // !!!!!!!!!!!!!!!!!!!!!!!!!!
+ if not CanDrawAppt then
+ Exit;
+
+ FillRect(ARect);
+
+ TheFrameRect := ARect;
+ InflateRect(TheFrameRect, -(Attr.FrameWidth div 2), -(Attr.FrameWidth div 2));
+
+ // Need to fine tune the frame rect
+ if Attr.FrameWidth mod 2 = 0 then
+ begin
+ Inc(TheFrameRect.Right);
+ Inc(TheFrameRect.Bottom);
+ end;
+
+ MoveTo(TheFrameRect.Left, TheFrameRect.Top);
+ LineTo(TheFrameRect.Right - 1, TheFrameRect.Top);
+ LineTo(TheFrameRect.Right - 1, TheFrameRect.Bottom - 1);
+ LineTo(TheFrameRect.Left, TheFrameRect.Bottom - 1);
+ LineTo(TheFrameRect.Left, TheFrameRect.Top);
+
+ // Only go through the following work if all details must be drawn
+// if (RectHeight(ARect) > Thresholds.DetailHeight) and
+// (RectWidth(ARect) > Thresholds.DetailWidth) then
+ begin
+ InflateRect(TheFrameRect, -(Attr.FrameWidth div 2), -(Attr.FrameWidth div 2));
+
+ DetailRect := TheFrameRect;
+
+ if ApptBar.Visible then
+ begin
+ Inc(DetailRect.Left, ApptBar.Width);
+ SubtractRect(BarRect, TheFrameRect, DetailRect);
+ Dec(BarRect.Bottom);
+
+ DrawApptBar(ACanvas, Appt, BarRect, Col, StartRow, EndRow);
+ end;
+
+ TxtRect := DetailRect;
+
+ AdjustForMargins(TxtRect);
+
+ DrawList := TList.Create;
+ try
+ CreatePicDrawList(TxtRect, Appt, DrawList);
+ FilterPicDrawList(TxtRect, DrawList, PicsHeight, PicsWidth);
+ // Calc'ing text height and width in CanDrawWhat
+ CanDrawWhat(ACanvas, TxtRect, PicsHeight, CanDrawText, CanDrawPics);
+
+ if CanDrawPics then
+ begin
+ DrawListPics(ACanvas, TxtRect, DrawList);
+ Inc(TxtRect.Left, PicsWidth); // Tim
+ end;
+ finally
+ ClearPicDrawList(DrawList);
+ DrawList.Free;
+ end;
+
+ if CanDrawText then
+ begin
+ Flags := DT_WORDBREAK or DT_NOPREFIX or DT_EDITCONTROL;
+
+ Txt := ScheduleManager.GetApptDisplayText(Self, Appt);
+
+ if not (agoFormattedDesc in Options) then
+ begin
+ Txt := StripCRLF(Txt);
+ Flags := Flags or DT_END_ELLIPSIS;
+ end;
+
+ //PTxt := StrNew(PChar(Txt));
+ DrawText(ACanvas.Handle, PChar(Txt), -1, TxtRect, Flags);
+ end;
+ end;
+
+ if Assigned(FOnDrawAppt) then
+ FOnDrawAppt(Self, ACanvas, ARect, Appt, Selected);
+
+ if Selected then
+ begin
+ { OLD 3D HANDLES CODE
+ if agoMoveAppt in Options then
+ DrawGrabLines(ACanvas, ARect.Top + 0, ARect.Left + 2,
+ ARect.Right - 3);
+ if agoSizeAppt in Options then
+ DrawGrabLines(ACanvas, ARect.Bottom - GrabHandles.Height,
+ ARect.Left + 2, ARect.Right - 3);
+ }
+ // move grab handles
+ if agoMoveAppt in Options then
+ begin
+// HandleRect := Classes.Rect(ARect.Left + 2, ARect.Top, ARect.Right - 3,
+// ARect.Top + GrabHandles.Height);
+// DrawGrabHandle(ACanvas, HandleRect, Appt, True);
+ HandleRect := GetTopGrabHandleRect(Col, Appt);
+ DrawGrabHandle(ACanvas, HandleRect, Appt, True);
+ end;
+ if agoSizeAppt in Options then
+ begin
+// HandleRect := Classes.Rect(ARect.Left + 2,
+// ARect.Bottom - GrabHandles.Height,
+// ARect.Right - 3, ARect.Bottom);
+// DrawGrabHandle(ACanvas, HandleRect, Appt, False);
+ HandleRect := GetBottomGrabHandleRect(Col, Appt);
+ DrawGrabHandle(ACanvas, HandleRect, Appt, False);
+ end;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.DrawPics(ACanvas: TCanvas; var ARect: TRect; Appt: TJvTFAppt);
+var
+ I, PicAdjust, NextPicLeft, CustomPicLeft, ImageIndex: Integer;
+ ImageList: TCustomImageList;
+ ImageMap: TJvTFStateImageMap;
+ CustomImageMap: TJvTFCustomImageMap;
+begin
+ PicAdjust := 0;
+ NextPicLeft := ARect.Left;
+
+ if (agoShowPics in Options) and Assigned(ScheduleManager.CustomImages) then
+ begin
+ ImageList := ScheduleManager.CustomImages;
+ CustomImageMap := Appt.ImageMap;
+
+ for I := 0 to CustomImageMap.Count - 1 do
+ begin
+ ImageIndex := CustomImageMap[I];
+ ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+
+ if CustomImageMap.Count > 0 then
+ PicAdjust := ImageList.Height + 2;
+ end;
+ CustomPicLeft := NextPicLeft;
+
+ if (agoShowPics in Options) and Assigned(ScheduleManager.StateImages) then
+ begin
+ ImageList := ScheduleManager.StateImages;
+ ImageMap := ScheduleManager.StateImageMap;
+
+ if Appt.AlarmEnabled then
+ begin
+ ImageIndex := ImageMap.AlarmEnabled;
+ if ImageIndex > -1 then
+ begin
+ ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+ end
+ else
+ begin
+ ImageIndex := ImageMap.AlarmDisabled;
+ if ImageIndex > -1 then
+ begin
+ ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+ end;
+
+ ImageIndex := ImageMap.Shared;
+ if Appt.Shared and (ImageIndex > -1) then
+ begin
+ ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageIndex);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+
+ if Appt.Modified and (ImageMap.Modified > -1) then
+ begin
+ ImageList.Draw(ACanvas, NextPicLeft, ARect.Top, ImageMap.Modified);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+
+ if (NextPicLeft <> CustomPicLeft) and (ImageList.Height + 2 > PicAdjust) then
+ PicAdjust := ImageList.Height + 2;
+ end;
+
+ Inc(ARect.Top, PicAdjust);
+end;
+
+procedure TJvTFDays.CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt;
+ DrawList: TList);
+var
+ I, NextPicLeft, ImageIndex: Integer;
+ ImageList: TCustomImageList;
+ ImageMap: TJvTFStateImageMap;
+ CustomImageMap: TJvTFCustomImageMap;
+
+ procedure AddToList(AImageList: TCustomImageList; AImageIndex: Integer;
+ AGlyph: TGraphic; APicLeft, APicTop: Integer);
+ var
+ DrawInfo: TJvTFDrawPicInfo;
+ begin
+ DrawInfo := TJvTFDrawPicInfo.Create;
+ DrawInfo.ImageList := AImageList;
+ DrawInfo.ImageIndex := AImageIndex;
+ DrawInfo.Glyph := AGlyph;
+ DrawInfo.PicLeft := APicLeft;
+ DrawInfo.PicTop := APicTop;
+ DrawList.Add(DrawInfo);
+ end;
+
+begin
+ NextPicLeft := ARect.Left;
+
+ if (agoShowPics in Options) and Assigned(Appt.Glyph.Graphic) and not Appt.Glyph.Graphic.Empty then
+ begin
+ AddToList(nil, -1, Appt.Glyph.Graphic, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, Appt.Glyph.Graphic.Width + 2);
+ end;
+
+ if (agoShowPics in Options) and Assigned(ScheduleManager.CustomImages) then
+ begin
+ ImageList := ScheduleManager.CustomImages;
+ CustomImageMap := Appt.ImageMap;
+
+ for I := 0 to CustomImageMap.Count - 1 do
+ begin
+ ImageIndex := CustomImageMap[I];
+ AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+ end;
+
+ if (agoShowPics in Options) and Assigned(ScheduleManager.StateImages) then
+ begin
+ ImageList := ScheduleManager.StateImages;
+ ImageMap := ScheduleManager.StateImageMap;
+
+ if Appt.AlarmEnabled then
+ begin
+ ImageIndex := ImageMap.AlarmEnabled;
+ if ImageIndex > -1 then
+ begin
+ AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end
+ end
+ else
+ begin
+ ImageIndex := ImageMap.AlarmDisabled;
+ if ImageIndex > -1 then
+ begin
+ AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+ end;
+
+ ImageIndex := ImageMap.Shared;
+ if Appt.Shared and (ImageIndex > -1) then
+ begin
+ AddToList(ImageList, ImageIndex, nil, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+
+ if Appt.Modified and (ImageMap.Modified > -1) then
+ begin
+ AddToList(ImageList, ImageMap.Modified, nil, NextPicLeft, ARect.Top);
+ // The following line generates a compiler hint so comment out,
+ // but leave here as reminder in case method is expanded.
+ //Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+ end;
+end;
+
+procedure TJvTFDays.FilterPicDrawList(ARect: TRect; DrawList: TList;
+ var PicsHeight: Integer; var PicsWidth: Integer);
+var
+ I, NextPicLeft: Integer;
+ DrawIt: Boolean;
+ DrawInfo: TJvTFDrawPicInfo;
+begin
+ PicsHeight := 0;
+ PicsWidth := 0;
+ if DrawList.Count = 0 then
+ Exit;
+
+ if Thresholds.PicsAllOrNone then
+ begin
+ DrawInfo := TJvTFDrawPicInfo(DrawList[DrawList.Count - 1]);
+ if DrawInfo.PicLeft + DrawInfo.ImageList.Width >= ARect.Right then
+ begin
+ while DrawList.Count > 0 do
+ begin
+ TJvTFDrawPicInfo(DrawList[0]).Free;
+ DrawList.Delete(0);
+ end;
+ end;
+ end;
+
+ NextPicLeft := ARect.Left;
+ I := 0;
+ while I < DrawList.Count do
+ begin
+ DrawInfo := TJvTFDrawPicInfo(DrawList[I]);
+ with DrawInfo do
+ begin
+ DrawIt := True;
+// if Thresholds.WholePicsOnly and
+// ((PicLeft + ImageList.Width >= ARect.Right) or
+// (PicTop + ImageList.Height >= ARect.Bottom)) then
+// DrawIt := False;
+
+ if DrawIt then
+ begin
+ if Assigned(ImageList) then
+ PicsHeight := Greater(PicsHeight, ImageList.Height + 2)
+ else
+ PicsHeight := Greater(PicsHeight, Glyph.Height + 2);
+ PicLeft := NextPicLeft;
+ if Assigned(ImageList) then
+ Inc(NextPicLeft, ImageList.Width + 2)
+ else
+ Inc(NextPicLeft, Glyph.Width + 2);
+ // Increment I to move onto next pic in list
+ Inc(I);
+ end
+ else // Remove pic from list
+ begin
+ // Remove pic from list
+ DrawInfo.Free;
+ DrawList.Delete(I);
+ // DO NOT increment I - Since pic was removed from list
+ // I will now point to next pic
+ end;
+ end;
+ end;
+ PicsWidth := NextPicLeft - ARect.Left;
+end;
+
+procedure TJvTFDays.ClearPicDrawList(DrawList: TList);
+begin
+ while DrawList.Count > 0 do
+ begin
+ TJvTFDrawPicInfo(DrawList[0]).Free;
+ DrawList.Delete(0);
+ end;
+end;
+
+procedure TJvTFDays.DrawListPics(ACanvas: TCanvas; var ARect: TRect;
+ DrawList: TList);
+var
+ I: Integer;
+ DrawInfo: TJvTFDrawPicInfo;
+begin
+ for I := 0 to DrawList.Count - 1 do
+ begin
+ DrawInfo := TJvTFDrawPicInfo(DrawList[I]);
+ with DrawInfo do
+ begin
+ if Assigned(ImageList) then
+ ImageList.Draw(ACanvas, PicLeft, PicTop, ImageIndex)
+ else
+ ACanvas.Draw(PicLeft, PicTop, Glyph);
+ end;
+ end;
+end;
+
+procedure TJvTFDays.DrawGrabLines(ACanvas: TCanvas; LineTop, LineLeft,
+ LineRight: Integer);
+begin
+ // This draws the 3D grab handles, which have been replaced by flat style
+ // handles. This remains as reference for possible future comeback as option.
+ with ACanvas do
+ begin
+ Pen.Width := 1;
+ Pen.Color := clWhite;
+ MoveTo(LineLeft, LineTop);
+ LineTo(LineRight, LineTop);
+ MoveTo(LineLeft, LineTop + 1);
+ LineTo(LineLeft + 1, LineTop + 1);
+ Pen.Color := clSilver;
+ LineTo(LineRight - 1, LineTop + 1);
+ Pen.Color := clGray;
+ LineTo(LineRight, LineTop + 1);
+ MoveTo(LineLeft, LineTop + 2);
+ LineTo(LineRight, LineTop + 2);
+
+ Pen.Color := clWhite;
+ MoveTo(LineLeft, LineTop + 3);
+ LineTo(LineRight, LineTop + 3);
+ MoveTo(LineLeft, LineTop + 4);
+ LineTo(LineLeft + 1, LineTop + 4);
+ Pen.Color := clSilver;
+ LineTo(LineRight - 1, LineTop + 4);
+ Pen.Color := clGray;
+ LineTo(LineRight, LineTop + 4);
+ MoveTo(LineLeft, LineTop + 5);
+ LineTo(LineRight, LineTop + 5);
+ end
+end;
+
+procedure TJvTFDays.DrawGrabHandle(ACanvas: TCanvas; ARect: TRect;
+ AAppt: TJvTFAppt; TopHandle: Boolean);
+begin
+ with ACanvas do
+ begin
+ Pen.Color := clBlack;
+ Pen.Width := 1;
+ Brush.Color := GrabHandles.Color;
+ Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
+ end;
+ if Assigned(FOnDrawGrabHandle) then
+ FOnDrawGrabHandle(Self, ACanvas, ARect, AAppt, TopHandle);
+end;
+
+procedure TJvTFDays.DrawCorner(ACanvas: TCanvas; Corner: TJvTFDaysCorner);
+var
+ ARect: TRect;
+ CornerLeft: Integer;
+begin
+ case Corner of
+ //group agcTopLeft : ARect := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight);
+ agcTopLeft:
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ ARect := Classes.Rect(0, 0, CalcBlockRowHdrsWidth, CalcGroupColHdrsHeight);
+ {$ELSE}
+ // remove
+ // ARect := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight);
+ {$ENDIF Jv_TIMEBLOCKS}
+ agcTopRight:
+ begin
+ CornerLeft := Lesser(CellRect(RightCol, -1).Right, ClientWidth - FVScrollBar.Width);
+ //group ARect := Classes.Rect(CornerLeft, 0, ClientWidth, ColHdrHeight);
+ ARect := Classes.Rect(CornerLeft, 0, ClientWidth, CalcGroupColHdrsHeight);
+ end;
+ agcBottomLeft:
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ ARect := Classes.Rect(0, ClientHeight - FHScrollBar.Height,
+ CalcBlockRowHdrsWidth, ClientHeight);
+ {$ELSE}
+ // remove
+ // ARect := Classes.Rect(0, ClientHeight - FHScrollBar.Height,
+ // RowHdrWidth, ClientHeight);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ agcBottomRight:
+ ARect := Classes.Rect(ClientWidth - FVScrollBar.Width - 1,
+ ClientHeight - FHScrollBar.Height - 1, ClientWidth, ClientHeight);
+ end;
+
+ with ACanvas do
+ begin
+ Brush.Color := HdrAttr.Color;
+ FillRect(ARect);
+
+ if HdrAttr.Frame3D then
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ DrawFrame(ACanvas, ARect,
+ not ((Corner = agcTopLeft) and not HdrAttr.Frame3D), GridLineColor)
+ {$ELSE}
+ // remove
+ //DrawFrame(ACanvas, ARect,
+ // not ((Corner = agcTopLeft) and not HdrAttr.Frame3D))
+ {$ENDIF Jv_TIMEBLOCKS}
+ else
+ begin
+ case Corner of
+ agcTopLeft:
+ if RowHdrType = rhFancy then
+ begin
+ Pen.Color := FancyRowHdrAttr.TickColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom - 1);
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ end
+ else
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ DrawFrame(ACanvas, ARect, False, GridLineColor);
+ {$ELSE}
+ // remove
+ //DrawFrame(ACanvas, ARect, False);
+ {$ENDIF Jv_TIMEBLOCKS}
+ agcTopRight:
+ begin
+ Pen.Color := clGray;
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ if VirtualCellRect(RightCol, -1).Right > ClientWidth - FVScrollBar.Width then
+ begin
+ MoveTo(ClientWidth - FVScrollBar.Width, ARect.Top);
+ LineTo(ClientWidth - FVScrollBar.Width, ARect.Bottom - 1);
+ end;
+ end;
+ agcBottomLeft:
+ begin
+ Pen.Color := clGray;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Top);
+ end;
+ end;
+ end;
+
+ if Assigned(FOnDrawCorner) then
+ FOnDrawCorner(Self, ACanvas, ARect, Corner);
+ end;
+end;
+
+procedure TJvTFDays.DrawRowHdr(ACanvas: TCanvas; Index: Integer);
+var
+ Rect: TRect;
+ UseAttr: TJvTFDaysHdrAttr;
+ Txt: string;
+begin
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Rect.Left := CalcBlockHdrWidth;
+ {$ELSE}
+ // remove
+ //Rect.Left := 0;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ //group Rect.Top := ColHdrHeight + (Index - TopRow) * RowHeight;
+ Rect.Top := CalcGroupColHdrsHeight + (Index - TopRow) * RowHeight;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Rect.Right := Rect.Left + RowHdrWidth;
+ {$ELSE}
+ // remove
+ //Rect.Right := RowHdrWidth;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ Rect.Bottom := Rect.Top + RowHeight;
+
+ Txt := FormatDateTime(TimeFormat, RowToTime(Index));
+
+ if RowIsSelected(Index) then
+ UseAttr := SelHdrAttr
+ else
+ UseAttr := HdrAttr;
+
+ ACanvas.Brush.Color := UseAttr.Color;
+ ACanvas.Font.Assign(UseAttr.Font);
+
+ DrawTxt(ACanvas, Rect, Txt, taCenter, vaCenter);
+
+ if (Index = FocusedRow) and Focused and ShowFocus then
+ begin
+ InflateRect(Rect, -2, -2);
+ ManualFocusRect(ACanvas, Rect);
+ InflateRect(Rect, 2, 2);
+ end;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ DrawFrame(ACanvas, Rect, UseAttr.Frame3D, UseAttr.FrameColor);
+ {$ELSE}
+ // remove
+ //DrawFrame(ACanvas, ARect, UseAttr.Frame3D);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ if Assigned(FOnDrawRowHdr) then
+ FOnDrawRowHdr(Self, ACanvas, Rect, Index, RowIsSelected(Index));
+end;
+
+(*
+procedure TJvTFDays.DrawColHdr(ACanvas: TCanvas; Index: Integer);
+var
+ ARect,
+ TxtRect,
+ CalcRect: TRect;
+ Txt: string;
+ PTxt: PChar;
+ UseAttr: TJvTFDaysHdrAttr;
+ Flags: UINT;
+ TxtHt,
+ TxtRectHt: Integer;
+begin
+ ARect := CellRect(Index, -1);
+
+ //Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title));
+ Txt := Cols[Index].Title;
+
+ if ColIsSelected(Index) then
+ UseAttr := SelHdrAttr
+ else
+ UseAttr := HdrAttr;
+
+ ACanvas.Brush.Color := UseAttr.Color;
+ ACanvas.Font.Assign(UseAttr.Font);
+
+ Flags := DT_NOPREFIX or DT_CENTER;
+ Case ColTitleStyle of
+ ctsSingleClip : Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ ctsSingleEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or
+ DT_VCENTER;
+ ctsMultiClip : Flags := Flags or DT_WORDBREAK;
+ ctsMultiEllipsis : Flags := Flags or DT_END_ELLIPSIS or
+ DT_WORDBREAK or DT_EDITCONTROL;
+ ctsHide : Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ end;
+
+ ACanvas.FillRect(ARect);
+ TxtRect := ARect;
+ Windows.InflateRect(TxtRect, -2, -2);
+ CalcRect := TxtRect;
+
+ PTxt := StrNew(PChar(Txt));
+ if (ColTitleStyle = ctsMultiClip) or
+ (ColTitleStyle = ctsMultiEllipsis) then
+ begin
+ TxtHt := Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect,
+ Flags or DT_CALCRECT);
+
+ if TxtHt < RectHeight(TxtRect) then
+ begin
+ // we need to vertically center the text
+ TxtRectHt := RectHeight(TxtRect);
+ TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2;
+ TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom);
+ end;
+ end
+ else
+ if ColTitleStyle = ctsHide then
+ begin
+ Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT);
+ if RectWidth(CalcRect) > RectWidth(TxtRect) then
+ PTxt := '';
+ end;
+
+ Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+
+ if (Index = FocusedCol) and Focused then
+ begin
+ CalcRect := ARect;
+ Windows.InflateRect(CalcRect, -2, -2);
+ ManualFocusRect(ACanvas, CalcRect);
+ {
+ if Windows.IsRectEmpty(TxtRect) then
+ Windows.InflateRect(TxtRect, 5, 5);
+ ManualFocusRect(ACanvas, TxtRect);
+ }
+{ end;
+
+ DrawFrame(ACanvas, ARect, UseAttr.Frame3D);
+
+ if Assigned(FOnDrawColHdr) then
+ FOnDrawColHdr(Self, ACanvas, ARect, Index, ColIsSelected(Index));
+end;
+*)
+
+// returns height in pixels of tallest col title
+// assumes word wrap and bounds all of title
+
+function TJvTFDays.GetTallestColTitle(ACanvas: TCanvas): Integer;
+var
+ I, Tallest, ColLeft, TxtHt: Integer;
+ LRect: TRect;
+ TheCol: TJvTFDaysCol;
+ Txt: string;
+ Flags: UINT;
+begin
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ ColLeft := CalcBlockRowHdrsWidth;
+ {$ELSE}
+ // remove
+ //ColLeft := RowHdrWidth;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ Tallest := 0;
+ for I := 0 to Cols.Count - 1 do
+ begin
+ TheCol := Cols[I];
+
+ // (rom) silly assignments
+ // Just set top (0), left, and bottom (ColHdrHeight) for now.
+ //group ARect := Classes.Rect(ColLeft, 0, 0, ColHdrHeight);
+ LRect := Classes.Rect(ColLeft, CalcGroupHdrHeight, 0, CalcGroupColHdrsHeight);
+ // Set right by adding this col's width to the left value
+ LRect.Right := LRect.Left + TheCol.Width;
+ LRect := CellRect(I, -1);
+ InflateRect(LRect, -2, -2);
+
+ Txt := Copy(TheCol.Title, 1, Length(TheCol.Title));
+
+ if ColIsSelected(I) then
+ begin
+ ACanvas.Brush.Color := SelHdrAttr.Color;
+ ACanvas.Font.Assign(SelHdrAttr.Font);
+ end
+ else
+ begin
+ ACanvas.Brush.Color := HdrAttr.Color;
+ ACanvas.Font.Assign(HdrAttr.Font);
+ end;
+
+ // All parameters now specified. Now calc text height.
+ Flags := DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_CALCRECT;
+ TxtHt := DrawText(ACanvas.Handle, PChar(Txt), -1, LRect, Flags);
+
+ if TxtHt > Tallest then
+ Tallest := TxtHt;
+
+ Inc(ColLeft, TheCol.Width);
+ end;
+ Result := Tallest;
+end;
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+procedure TJvTFDays.DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean);
+var
+ OldPenColor: TColor;
+begin
+ OldPenColor := ACanvas.Pen.Color;
+
+ if Draw3D then
+ ACanvas.Pen.Color := clBtnShadow
+ else
+ ACanvas.Pen.Color := GridLineColor;
+
+ ACanvas.MoveTo(ARect.Right - 1, ARect.Top);
+ ACanvas.LineTo(ARect.Right - 1, ARect.Bottom);
+ ACanvas.MoveTo(ARect.Left, ARect.Bottom - 1);
+ ACanvas.LineTo(ARect.Right, ARect.Bottom - 1);
+
+ if Draw3D then
+ begin
+ ACanvas.Pen.Color := clBtnHighlight;
+ ACanvas.MoveTo(ARect.Left, ARect.Top);
+ ACanvas.LineTo(ARect.Right, ARect.Top);
+ ACanvas.MoveTo(ARect.Left, ARect.Top);
+ ACanvas.LineTo(ARect.Left, ARect.Bottom);
+ end;
+
+ ACanvas.Pen.Color := OldPenColor;
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+procedure TJvTFDays.DrawAppts(ACanvas: TCanvas; DrawAll: Boolean);
+var
+ FromCol, ToCol, FromRow, ToRow, Col, I: Integer;
+ ApptStartRow, ApptEndRow, SchedDate: Integer;
+ Appt: TJvTFAppt;
+ TempSelAppt: TJvTFAppt;
+begin
+ if DrawAll then
+ begin
+ FromCol := 0;
+ ToCol := Cols.Count - 1;
+ FromRow := 0;
+ ToRow := RowCount - 1;
+ end
+ else
+ begin
+ FromCol := LeftCol;
+ ToCol := RightCol;
+ FromRow := TopRow;
+ ToRow := BottomRow;
+ end;
+
+ for Col := FromCol to ToCol do
+ if Cols[Col].Connected then
+ begin
+ TempSelAppt := nil;
+ SchedDate := Trunc(Cols[Col].SchedDate);
+ for I := 0 to Cols[Col].Schedule.ApptCount - 1 do
+ begin
+ Appt := Cols[Col].Schedule.Appts[I];
+ // Added by Mike 10/31/01 7:04pm - Happy Haloween!!
+ // We want to draw the selected appt last. Check to see if the
+ // current appt is selected, if so, save a reference in TempSelAppt
+ // and then use TempSelAppt to draw the appt after the loop finishes.
+ // This solves the problem of having the bottom grab handle
+ // overwritten by an appt that lies immediately below the sel appt.
+ if Appt = SelAppt then
+ TempSelAppt := Appt
+ else
+ begin
+ CalcStartEndRows(Appt, SchedDate, ApptStartRow, ApptEndRow);
+
+ if (ApptStartRow <= ToRow) and (ApptEndRow >= FromRow) then
+ DrawAppt(ACanvas, Col, Appt, ApptStartRow, ApptEndRow);
+ end;
+ end;
+
+ // Added by Mike 10/31/01 7:04 pm - see above
+ if Assigned(TempSelAppt) then
+ begin
+ CalcStartEndRows(TempSelAppt, SchedDate, ApptStartRow, ApptEndRow);
+
+ if (ApptStartRow <= ToRow) and (ApptEndRow >= FromRow) then
+ DrawAppt(ACanvas, Col, TempSelAppt, ApptStartRow, ApptEndRow);
+ end;
+ end;
+end;
+
+procedure TJvTFDays.AdjustForMargins(var ARect: TRect);
+begin
+ // Make room for side margins and grab handles
+ // Changed by TIM:
+ // Windows.InflateRect(ARect, -2, -2);
+ InflateRect(ARect, -1, -1);
+
+ // Commented out by Tim:
+ // if agoMoveAppt in Options then
+ // Inc(ARect.Top, GrabHandles.Height - 1);
+ // if agoSizeAppt in Options then
+ // Dec(ARect.Bottom, GrabHandles.Height - 1);
+end;
+
+procedure TJvTFDays.CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect;
+ PicsHeight: Integer; var CanDrawText, CanDrawPics: Boolean);
+//var
+// TextHeightThreshold,
+// TextWidthThreshold: Integer;
+begin
+// TextHeightThreshold := CanvasMaxTextHeight(ACanvas) * Thresholds.TextHeight;
+// TextWidthThreshold := ACanvas.TextWidth('Bi') div 2 * Thresholds.TextWidth;
+
+// if TextHeightThreshold + PicsHeight < RectHeight(ApptRect) then
+// begin
+// CanDrawText := RectWidth(ApptRect) >= TextWidthThreshold;
+// CanDrawPics := True;
+// end
+// else
+// if Thresholds.DropTextFirst then
+// begin
+// CanDrawText := False;
+// CanDrawPics := True;
+// if Thresholds.WholePicsOnly then
+// if PicsHeight > RectHeight(ApptRect) then
+// CanDrawPics := False;
+// end
+// else
+// begin
+// CanDrawText := (RectHeight(ApptRect) >= TextHeightThreshold) and
+// (RectWidth(ApptRect) >= TextWidthThreshold);
+// CanDrawPics := False;
+// end;
+
+ CanDrawText := True;
+ CanDrawPics := True;
+
+ if not (agoShowPics in Options) then
+ CanDrawPics := False;
+ if not (agoShowText in Options) then
+ CanDrawText := False;
+end;
+
+procedure TJvTFDays.ManualFocusRect(ACanvas: TCanvas; ARect: TRect);
+var
+ Mark: Boolean;
+ I: Integer;
+ OldPenMode: TPenMode;
+begin
+ OldPenMode := ACanvas.Pen.Mode;
+ ACanvas.Pen.Mode := pmNot;
+
+ Mark := True;
+
+ // Top side
+ for I := ARect.Left to ARect.Right - 1 do
+ begin
+ if Mark then
+ ACanvas.Pixels[I, ARect.Top] := clBlack;
+ Mark := not Mark;
+ end;
+
+ // Right side
+ for I := ARect.Top + 1 to ARect.Bottom - 1 do
+ begin
+ if Mark then
+ ACanvas.Pixels[ARect.Right - 1, I] := clBlack;
+ Mark := not Mark;
+ end;
+
+ // Bottom side
+ for I := ARect.Right - 2 downto ARect.Left do
+ begin
+ if Mark then
+ ACanvas.Pixels[I, ARect.Bottom - 1] := clBlack;
+ Mark := not Mark;
+ end;
+
+ // Left side
+ for I := ARect.Bottom - 2 downto ARect.Top + 1 do
+ begin
+ if Mark then
+ ACanvas.Pixels[ARect.Left, I] := clBlack;
+ Mark := not Mark;
+ end;
+
+ ACanvas.Pen.Mode := OldPenMode;
+end;
+
+procedure TJvTFDays.DrawFancyRowHdrs(ACanvas: TCanvas);
+var
+ I, J, MajorTickLength, MinorTickLength, TickLength: Integer;
+ LRect: TRect;
+ Lbl: string;
+ PrevHour, CurrentHour: Word;
+ // FirstMajor,
+ Selected, PrevHrSel, CurrHrSel, Switch: Boolean;
+begin
+ MajorTickLength := GetMajorTickLength;
+ MinorTickLength := GetMinorTickLength;
+
+// FirstMajor := True;
+ PrevHour := RowToHour(TopRow);
+ PrevHrSel := False;
+ CurrHrSel := False;
+ for I := TopRow to BottomRow do
+ begin
+ CurrentHour := RowToHour(I);
+
+ Switch := (CurrentHour <> PrevHour) or (I = BottomRow);
+ if Switch then
+ begin
+ PrevHrSel := CurrHrSel;
+ CurrHrSel := False;
+ end;
+
+ // Determine if this row is selected
+ Selected := False;
+ J := 0;
+ while (J < Cols.Count) and not Selected do
+ if CellIsSelected(Point(J, I)) then
+ Selected := True
+ else
+ Inc(J);
+
+ CurrHrSel := CurrHrSel or Selected;
+
+ LRect := CellRect(-1, I);
+ Lbl := GetMinorLabel(I);
+ if not RowEndsHour(I) then
+ TickLength := MinorTickLength
+ else
+ TickLength := MajorTickLength;
+
+ DrawMinor(ACanvas, LRect, I, Lbl, TickLength, Selected);
+
+ // Draw Major if needed
+ if Switch and (Granularity <> 60) then
+ begin
+ if I <> TopRow + 1 then
+ begin
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ LRect.Left := CalcBlockHdrWidth;
+ LRect.Right := LRect.Left + RowHdrWidth - MinorTickLength;
+ {$ELSE}
+ // remove
+ //LRect.Left := 0;
+ //LRect.Right := RowHdrWidth - MinorTickLength;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ LRect.Top := VirtualCellRect(-1, HourStartRow(PrevHour)).Top;
+ //group if LRect.Top < ColHdrHeight then
+ //group LRect.Top := ColHdrHeight;
+ if LRect.Top < CalcGroupColHdrsHeight then
+ LRect.Top := CalcGroupColHdrsHeight;
+ LRect.Bottom := VirtualCellRect(-1, HourEndRow(PrevHour)).Bottom - 1;
+ if LRect.Bottom > ClientHeight then
+ LRect.Bottom := ClientHeight;
+
+ if FancyRowHdrAttr.Hr2400 then
+ Lbl := IntToStr(PrevHour)
+ else
+ begin
+ if PrevHour = 0 then
+ Lbl := '12'
+ else
+ if PrevHour > 12 then
+ Lbl := IntToStr(PrevHour - 12)
+ else
+ Lbl := IntToStr(PrevHour);
+
+{ if FirstMajor or (PrevHour = 0) or (PrevHour = 12) then
+ if PrevHour < 12 then
+ Lbl := Lbl + 'a'
+ else
+ Lbl := Lbl + 'p';
+}
+ end;
+
+ if PrevHrSel then
+ ACanvas.Font.Assign(SelFancyRowHdrAttr.MajorFont)
+ else
+ ACanvas.Font.Assign(FancyRowHdrAttr.MajorFont);
+
+ ACanvas.Brush.Style := bsClear;
+
+ DrawText(ACanvas.Handle, PChar(Lbl), -1, LRect,
+ DT_NOPREFIX or DT_SINGLELINE or DT_CENTER or DT_VCENTER);
+
+ if Assigned(FOnDrawMajorRowHdr) then
+ FOnDrawMajorRowHdr(Self, ACanvas, LRect, I - 1, PrevHrSel);
+
+// FirstMajor := False;
+ end;
+ if Switch then
+ PrevHour := CurrentHour;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.DrawMinor(ACanvas: TCanvas; ARect: TRect; RowNum: Integer;
+ const LabelStr: string; TickLength: Integer; Selected: Boolean);
+var
+ Attr: TJvTFDaysFancyRowHdrAttr;
+ MinorRect, TxtRect: TRect;
+begin
+ // do the background shading
+ ACanvas.Brush.Color := FancyRowHdrAttr.Color;
+ ACanvas.FillRect(ARect);
+
+ MinorRect := ARect;
+ MinorRect.Left := (MinorRect.Right - GetMinorTickLength) div 2;
+
+ if Selected then
+ begin
+ Attr := SelFancyRowHdrAttr;
+ // Shade the minor rect if selected
+ ACanvas.Brush.Color := Attr.Color;
+ ACanvas.FillRect(MinorRect);
+ end
+ else
+ Attr := FancyRowHdrAttr;
+
+ with ACanvas do
+ begin
+ // draw the right border line
+ Pen.Color := Attr.TickColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+
+ // now draw the tick
+ MoveTo(ARect.Right - 5, ARect.Bottom - 1);
+ LineTo(ARect.Right - 5 - TickLength, ARect.Bottom - 1);
+ end;
+
+ // set up a 2 pel margin on the right and bottom sides
+ TxtRect := ARect;
+ TxtRect.Right := TxtRect.Right - 6;
+ TxtRect.Bottom := TxtRect.Bottom - 2;
+
+ // now draw the LabelStr right aligned
+ ACanvas.Font.Assign(Attr.MinorFont);
+ ACanvas.Brush.Style := bsClear;
+
+ // draw the focus rect if needed
+ if (RowNum = FocusedRow) and Focused and ShowFocus then
+ begin
+ InflateRect(MinorRect, -2, -2);
+ MinorRect.Left := MinorRect.Right - ACanvas.TextWidth(LabelStr) - 2;
+ ManualFocusRect(ACanvas, MinorRect);
+ end;
+
+ DrawText(ACanvas.Handle, PChar(LabelStr), -1, TxtRect,
+ DT_SINGLELINE or DT_RIGHT or DT_NOPREFIX or DT_VCENTER);
+
+ if Assigned(FOnDrawMinorRowHdr) then
+ FOnDrawMinorRowHdr(Self, ACanvas, ARect, RowNum, Selected);
+end;
+
+function TJvTFDays.GetMinorLabel(RowNum: Integer): string;
+const
+ Full24 = 'h:nn';
+ FullAP = 'h:nna/p';
+ MinOnly = ':nn';
+var
+ FirstHourRow: Integer;
+ TimeFmt: string;
+ RowTime: TTime;
+// LastFullRow, LastHourStart: Integer;
+// LastHour: Word;
+begin
+ if Granularity = 60 then
+ TimeFmt := Full24
+ else
+ TimeFmt := MinOnly;
+// else
+// if (RowNum = TopRow) and (not RowStartsHour(RowNum) or (PossVisibleRows = 1)) then
+// TimeFmt := Full24
+// else
+// begin
+// LastFullRow := TopRow + FullVisibleRows - 1;
+// LastHour := RowToHour(LastFullRow);
+// LastHourStart := HourStartRow(LastHour);
+//
+// if (RowNum = LastHourStart) or
+// ((LastHourStart = TopRow) and (RowNum = TopRow)) then
+// TimeFmt := Full24
+// else
+// TimeFmt := MinOnly;
+// end;
+
+ if (TimeFmt = Full24) and not FancyRowHdrAttr.Hr2400 then
+ TimeFmt := FullAP;
+
+ // Get the Row Time
+ RowTime := RowToTime(RowNum);
+
+ if (FancyRowHdrAttr.OnlyShow00Minutes and (ExtractMins(RowTime) = 0)) or
+ (not FancyRowHdrAttr.OnlyShow00Minutes) then
+ begin
+ if (not FancyRowHdrAttr.Hr2400) and (Granularity < 60) then
+ begin
+ // Get the first row with a 00 hour
+ FirstHourRow := TopRow;
+ while (FirstHourRow < BottomRow) and (ExtractMins(RowToTime(FirstHourRow)) <> 0) do
+ Inc(FirstHourRow);
+ if RowTime = 0 then
+ Result := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF RTL220_UP}TimeAMString
+ else
+ if RowTime = 0.50 then
+ Result := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF RTL220_UP}TimePMString
+ else
+ if (RowNum = FirstHourRow) and (ExtractMins(RowTime) = 0) then
+ begin
+ if RowTime < 0.50 then
+ Result := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF RTL220_UP}TimeAMString
+ else
+ Result := {$IFDEF RTL220_UP}FormatSettings.{$ENDIF RTL220_UP}TimePMString;
+ end
+ else
+ Result := FormatDateTime(TimeFmt, RowTime);
+ end
+ else
+ Result := FormatDateTime(TimeFmt, RowTime);
+ end
+ else
+ Result := '';
+end;
+
+function TJvTFDays.GetMinorTickLength: Integer;
+var
+ TempFont: TFont;
+begin
+ TempFont := TFont.Create;
+ try
+ TempFont.Assign(Canvas.Font);
+ Canvas.Font.Assign(FancyRowHdrAttr.MinorFont);
+ Result := Canvas.TextWidth('22:22a') - 10;
+ Canvas.Font.Assign(TempFont);
+ finally
+ TempFont.Free;
+ end;
+end;
+
+function TJvTFDays.GetMajorTickLength: Integer;
+begin
+ Result := RowHdrWidth - 8;
+end;
+
+procedure TJvTFDays.Resize;
+var
+ ColsResized: Boolean;
+begin
+ if Editing then
+ FinishEditAppt;
+ AlignScrollBars;
+
+ if not (csLoading in ComponentState) then
+ begin
+ if RowHeight > GetDataHeight then
+ RowHeight := GetDataHeight;
+
+ Cols.EnsureMaxColWidth;
+
+ if AutoSizeCols then
+ begin
+ ColsResized := CheckSBVis;
+ if not (vsbHorz in VisibleScrollBars) and not ColsResized then
+ Cols.ResizeCols;
+ end
+ else
+ CheckSBVis;
+ end;
+
+ CheckSBParams;
+
+ inherited Resize;
+end;
+
+procedure TJvTFDays.WMEraseBkgnd(var Msg: TLMessage);
+begin
+ Msg.Result := LRESULT(False);
+end;
+
+procedure TJvTFDays.CMFontChanged(var Msg: TLMessage);
+begin
+ HdrAttr.ParentFontChanged;
+ SelHdrAttr.ParentFontChanged;
+ ApptAttr.ParentFontChanged;
+ SelApptAttr.ParentFontChanged;
+ inherited;
+end;
+
+procedure TJvTFDays.CMEnabledChanged(var Msg: TLMessage);
+begin
+ FVScrollBar.Enabled := Enabled;
+ FHScrollBar.Enabled := Enabled;
+ Invalidate;
+
+ if Enabled and FNeedCheckSBParams then
+ begin
+ // This is needed because of a TScrollBar bug. If the Max or LargeChange
+ // properties are changed while the scrollbar is disabled, the
+ // scrollbar will magically enable itself. Very frustrating. Anyway...
+ // This check and call to CheckSBParams will work around the problem.
+ // See TJvTFDays.CheckSBParams for other part of workaround.
+ FNeedCheckSBParams := False;
+ CheckSBParams;
+ end;
+end;
+
+procedure TJvTFDays.WMSetCursor(var Msg: TLMSetCursor);
+var
+ Cur: HCURSOR;
+ Coord: TJvTFDaysCoord;
+begin
+ exit;
+
+
+
+
+ Cur := 0;
+ with Msg do
+ if HitTest = HTCLIENT then
+ begin
+ Coord := PtToCell(FHitTest.X, FHitTest.Y);
+ case CanDragWhat(Coord) of
+ agsSizeCol, agsSizeRowHdr:
+ Cur := Screen.Cursors[crHSplit];
+ agsSizeRow, agsSizeColHdr:
+ Cur := Screen.Cursors[crVSplit];
+ agsSizeAppt:
+ Cur := Screen.Cursors[crSizeNS];
+ agsMoveAppt:
+ Cur := Screen.Cursors[crDrag];
+ end;
+ end;
+
+ if Cur <> 0 then
+ SetCursor(Cur)
+ else
+ inherited;
+end;
+
+procedure TJvTFDays.WMNCHitTest(var Msg: TLMNCHitTest);
+begin
+ DefaultHandler(Msg);
+ FHitTest := ScreenToClient(SmallPointToPoint(Msg.Pos));
+end;
+
+procedure TJvTFDays.CMDesignHitTest(var Msg: TCMDesignHitTest);
+var
+ TempState: TJvTFDaysState;
+ Coord: TJvTFDaysCoord;
+begin
+ Coord := PtToCell(Msg.Pos.X, Msg.Pos.Y);
+
+ TempState := CanDragWhat(Coord);
+ Msg.Result := LRESULT(Ord(TempState <> agsNormal));
+end;
+
+procedure TJvTFDays.CNRequestRefresh(var Msg: TCNRequestRefresh);
+var
+ I: Integer;
+begin
+ for I := 0 to Cols.Count - 1 do
+ if (Cols[I].Schedule = Msg.Schedule) or (Msg.Schedule = nil) then
+ Cols[I].RefreshMap;
+ inherited;
+end;
+
+procedure TJvTFDays.Loaded;
+var
+ I: Integer;
+begin
+ FHScrollBar.Position := LeftCol;
+ FVScrollBar.Position := TopRow;
+ inherited Loaded;
+ CheckSBVis;
+ CheckSBParams;
+
+ Template.UpdateGrid;
+
+ Cols.FOldCount := Cols.Count;
+
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].Connect;
+
+ AlignScrollBars;
+end;
+
+procedure TJvTFDays.RefreshControl;
+var
+ I: Integer;
+begin
+ for I := 0 to Cols.Count - 1 do
+ // Should do some additional checking here (which is commented out)
+ //if (Cols[I].Schedule = Msg.Schedule) or (Msg.Schedule = nil) then
+ Cols[I].RefreshMap;
+ inherited RefreshControl;
+end;
+
+procedure TJvTFDays.UpdateDesigner;
+var
+ ParentForm: TCustomForm;
+begin
+ if (csDesigning in ComponentState) and HandleAllocated and
+ not (csUpdating in ComponentState) then
+ begin
+ ParentForm := GetParentForm(Self);
+ if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
+ ParentForm.Designer.Modified;
+ end;
+end;
+
+procedure TJvTFDays.CheckSBParams;
+var
+ I, TempWidth, lRightCol: Integer;
+begin
+ if not Enabled then
+ begin
+ // This is needed because of a TScrollBar bug. if the Max or LargeChange
+ // properties are changed while the scrollbar is disabled, the
+ // scrollbar will magically enable itself. Very frustrating. Anyway...
+ // This check and exit will workaround the problem.
+ // See TJvTFDays.CMEnabledChanged for other part of workaround.
+ FNeedCheckSBParams := True;
+ Exit;
+ end;
+
+ if vsbVert in VisibleScrollBars then
+ with FVScrollBar do
+ begin
+ Max := RowCount - 2;
+ LargeChange := FullVisibleRows;
+ end;
+
+ if vsbHorz in VisibleScrollBars then
+ with FHScrollBar do
+ begin
+ Max := Cols.Count - 1;
+ lRightCol := LeftCol + VisibleCols - 1;
+
+ TempWidth := 0;
+ for I := LeftCol to lRightCol do
+ Inc(TempWidth, Cols[I].Width);
+
+ if TempWidth <= RectWidth(GetDataAreaRect) then
+ LargeChange := VisibleCols
+ else
+ LargeChange := VisibleCols - 1;
+ end;
+end;
+
+procedure TJvTFDays.ScrollBarScroll(Sender: TObject;
+ ScrollCode: TScrollCode; var ScrollPos: Integer);
+var
+ SB: TJvTFDaysScrollBar;
+ I, TempWidth: Integer;
+begin
+ if csLoading in ComponentState then
+ Exit;
+
+ if not (csDesigning in ComponentState) then
+ SetFocus;
+
+ if Editing then
+ FinishEditAppt;
+
+ SB := TJvTFDaysScrollBar(Sender);
+
+ case ScrollCode of
+ scLineUp, scLineDown, scPageUp, scPageDown, scTrack:
+ if SB.Kind = sbVertical then
+ begin
+ if (ScrollCode = scLineDown) or (ScrollCode = scPageDown) then
+ ScrollPos := Lesser(ScrollPos, RowCount - FullVisibleRows);
+ TopRow := ScrollPos;
+ UpdateDesigner;
+ end
+ else
+ begin
+ if ScrollPos > LeftCol then
+ begin
+ TempWidth := 0;
+ for I := LeftCol to Cols.Count - 1 do
+ Inc(TempWidth, Cols[I].Width);
+ if TempWidth <= GetDataWidth then
+ ScrollPos := LeftCol;
+ end;
+ LeftCol := ScrollPos;
+ UpdateDesigner;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.MouseDown(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+var
+ GridCoord: TJvTFDaysCoord;
+ DragWhat: TJvTFDaysState;
+begin
+ if not Enabled then
+ Exit;
+
+ FHint.ReleaseHandle;
+
+ inherited;
+
+ if ssDouble in Shift then
+ Exit;
+
+ if not (csDesigning in ComponentState) then
+ SetFocus;
+
+ GridCoord := PtToCell(X, Y);
+
+ if ssLeft in Shift then
+ with GridCoord do
+ begin
+ SetSelAppt(Appt);
+ // need to recalculate GridCoord here because component user may have
+ // freed the appt (esp. in a multi-user environment).
+ GridCoord := PtToCell(X, Y);
+
+ if Col > gcHdr then
+ FocusedCol := Col;
+ if Row > gcHdr then
+ FocusedRow := Row;
+
+ if (Col > gcHdr) and (Row > gcHdr) then
+ SelStart := Point(Col, Row)
+ else
+ if (Col = gcHdr) and (Row > gcHdr) then
+ SelStart := Point(FocusedCol, Row)
+ else
+ if (Col > gcHdr) and (Row = gcHdr) then
+ SelStart := Point(Col, FocusedRow);
+ end;
+
+ if (State = agsNormal) and (ssLeft in Shift) then
+ begin
+ DragWhat := CanDragWhat(GridCoord);
+ case DragWhat of
+ agsSizeCol, agsSizeRow, agsSizeColHdr, agsSizeRowHdr,
+ agsMoveCol, agsSizeAppt:
+ BeginDragging(GridCoord, DragWhat, GridCoord.Appt);
+ agsMoveAppt:
+ BeginDrag(False);
+ agsNormal:
+ if Assigned(SelAppt) then
+ EditAppt(GridCoord.Col, SelAppt);
+ end;
+
+ if DragWhat in [agsSizeAppt, agsMoveAppt, agsNormal] then
+ begin
+ FAutoScrollDir := asdNowhere;
+ FLiveTimer := True;
+ SetTimer(Handle, 1, 60, nil);
+ end;
+ end;
+end;
+
+procedure TJvTFDays.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+ GridCoord: TJvTFDaysCoord;
+ AutoScrollMargin: TRect;
+ SelStartDate, SelEndDate: TDate;
+ SelStartTime, SelEndTime: TTime;
+ OldFSelEnd, HintTopLeft: TPoint;
+ FSelEndChanged: Boolean;
+
+ procedure UpdateAutoScroll;
+ begin
+ AutoScrollMargin := GetDataAreaRect;
+ //Windows.InflateRect(AutoScrollMargin, -10, -10);
+
+ if Y < AutoScrollMargin.Top then
+ FAutoScrollDir := asdUp
+ else
+ if Y > AutoScrollMargin.Bottom then
+ FAutoScrollDir := asdDown
+ else
+ if X < AutoScrollMargin.Left then
+ FAutoScrollDir := asdLeft
+ else
+ if X > AutoScrollMargin.Right then
+ FAutoScrollDir := asdRight
+ else
+ FAutoScrollDir := asdNowhere;
+ end;
+
+begin
+ if not Enabled then
+ Exit;
+
+ inherited MouseMove(Shift, X, Y);
+
+ GridCoord := PtToCell(X, Y);
+
+ if State = agsNormal then
+ if Assigned(GridCoord.Appt) then
+ DoApptHint(GridCoord)
+ else
+ DoCellHint(GridCoord);
+
+ if not Focused and not (csDesigning in ComponentState) then
+ Exit;
+
+ FMouseMovePt := Point(X, Y);
+ FMouseMoveState := Shift;
+
+ case State of
+ agsNormal:
+ if ssLeft in Shift then
+ begin
+ with GridCoord do
+ begin
+ if Col > gcHdr then
+ FocusedCol := Col
+ else
+ FocusedCol := LeftCol;
+
+ if Row > gcHdr then
+ FocusedRow := Lesser(Row, Lesser(RowCount - 1, BottomRow + 1))
+ else
+ if FAutoScrollDir = asdDown then
+ FocusedRow := RowCount - 1
+ else
+ FocusedRow := TopRow;
+ end;
+ OldFSelEnd := FSelEnd;
+ SelEnd := Point(FocusedCol, FocusedRow);
+ FSelEndChanged := (OldFSelEnd.X <> FSelEnd.X) or
+ (OldFSelEnd.Y <> FSelEnd.Y);
+
+ if (agoShowSelHint in Options) and
+ (SelStart.X > gcHdr) and (SelStart.Y > gcHdr) and
+ (SelEnd.X > gcHdr) and (SelEnd.Y > gcHdr) and
+ ((SelStart.X <> SelEnd.X) or (SelStart.Y <> SelEnd.Y)) then
+ begin
+ HintTopLeft := CellRect(GridCoord.Col, GridCoord.Row).TopLeft;
+ if FSelEndChanged then
+ begin
+ SelStartDate := Cols[SelStart.X].SchedDate;
+ SelStartTime := RowToTime(SelStart.Y);
+ SelEndDate := Cols[SelEnd.X].SchedDate;
+ SelEndTime := RowToTime(SelEnd.Y) +
+ EncodeTime(0, Granularity - 1, 0, 0);
+
+ FHint.StartEndHint(SelStartDate, SelEndDate, SelStartTime,
+ SelEndTime, HintTopLeft.X,
+ HintTopLeft.Y, True);
+
+ end
+ end
+ else
+ FHint.ReleaseHandle;
+
+ UpdateAutoScroll;
+ end;
+ agsSizeCol..agsMoveCol:
+ ContinueDragging(GridCoord, nil);
+ agsSizeAppt:
+ begin
+ UpdateAutoScroll;
+
+ if Y > GetDataAreaRect.Bottom then
+ GridCoord.Row := Lesser(BottomRow + 1, RowCount - 1);
+
+ if FAutoScrollDir = asdNowhere then
+ ContinueDragging(GridCoord, nil);
+ end;
+ end;
+end;
+
+procedure TJvTFDays.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+var
+ GridCoord: TJvTFDaysCoord;
+begin
+ if not Enabled then
+ Exit;
+
+ inherited MouseUp(Button, Shift, X, Y);
+
+ if not Focused and not (csDesigning in ComponentState) then
+ Exit;
+
+ KillAutoScrollTimer;
+
+ GridCoord := PtToCell(X, Y);
+
+ case State of
+ agsSizeCol..agsSizeAppt:
+ EndDragging(GridCoord, nil);
+ agsNormal:
+ FHint.ReleaseHandle;
+ end;
+end;
+
+procedure TJvTFDays.DblClick;
+begin
+ if Editing then
+ FinishEditAppt;
+ inherited DblClick;
+end;
+
+procedure TJvTFDays.DoStartDrag(var DragObject: TDragObject);
+begin
+ if Editing then
+ FinishEditAppt;
+
+ inherited DoStartDrag(DragObject);
+
+ FDragInfo.Appt := SelAppt;
+
+ if FocusedCol > gcHdr then
+ FDragInfo.Schedule := Cols[FocusedCol].Schedule;
+end;
+
+procedure TJvTFDays.DragOver(Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+var
+ GridCoord: TJvTFDaysCoord;
+ Appt: TJvTFAppt;
+ SrcDragInfo: TJvTFDragInfo;
+ AutoScrollMargin: TRect;
+
+ procedure UpdateAutoScroll;
+ begin
+ AutoScrollMargin := GetDataAreaRect;
+ InflateRect(AutoScrollMargin, -10, -10);
+
+ if Y < AutoScrollMargin.Top then
+ FAutoScrollDir := asdUp
+ else
+ if Y > AutoScrollMargin.Bottom then
+ FAutoScrollDir := asdDown
+ else
+ if X < AutoScrollMargin.Left then
+ FAutoScrollDir := asdLeft
+ else
+ if X > AutoScrollMargin.Right then
+ FAutoScrollDir := asdRight
+ else
+ FAutoScrollDir := asdNowhere;
+ end;
+
+begin
+ inherited DragOver(Source, X, Y, State, Accept);
+ if Source is TJvTFControl then
+ begin
+ SrcDragInfo := TJvTFControl(Source).DragInfo;
+ GridCoord := PtToCell(X, Y);
+ Accept := GridCoord.DragAccept;
+ Appt := SrcDragInfo.Appt;
+
+ case State of
+ dsDragEnter:
+ begin
+ if not Assigned(FDragInfo) then
+ FDragInfo := SrcDragInfo;
+ BeginDragging(GridCoord, agsMoveAppt, Appt);
+ end;
+ dsDragLeave:
+ begin
+ EndDragging(GridCoord, Appt);
+ if FDragInfo.ApptCtrl <> Self then
+ FDragInfo := nil;
+ end;
+ dsDragMove:
+ begin
+ FMouseMovePt := Point(X, Y);
+ UpdateAutoScroll;
+
+ if Y > GetDataAreaRect.Bottom then
+ GridCoord.Row := Lesser(BottomRow + 1, RowCount - 1);
+
+ if FAutoScrollDir = asdNowhere then
+ ContinueDragging(GridCoord, Appt);
+ end;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.DoEndDrag(Target: TObject; X, Y: Integer);
+begin
+ KillAutoScrollTimer;
+ FState := agsNormal;
+ inherited DoEndDrag(Target, X, Y);
+end;
+
+procedure TJvTFDays.DropAppt(ADragInfo: TJvTFDragInfo; X, Y: Integer);
+const
+ cClassName = 'TJvTFCustomGlance';
+var
+ Appt: TJvTFAppt;
+ Coord: TJvTFDaysCoord;
+ Confirm, SchedNameChange, StartDateChange, Share: Boolean;
+ NewSchedName: string;
+ NewStartDate, NewEndDate: TDate;
+ NewStartTime: TTime;
+ NewEndTime: TDateTime;
+ NewStartDT, NewEndDT: TDateTime;
+begin
+ FHint.ReleaseHandle;
+ // APPOINTMENT CAN ONLY BE DROPPED IN THE DATA AREA !!!
+ Appt := ADragInfo.Appt;
+
+ // Calc new info
+ // DragAppt.Shift --> Ctrl = share, Shift = keep dates, Alt = keep times
+ Coord := PtToCell(X, Y);
+ NewSchedName := Cols[Coord.Col].SchedName;
+ CalcMoveStartEnd(Appt, Coord, ssShift in ADragInfo.Shift,
+ ssAlt in ADragInfo.Shift, NewStartDT, NewEndDT);
+
+ NewStartDate := Trunc(NewStartDT);
+ NewStartTime := Frac(NewStartDT);
+ NewEndDate := Trunc(NewEndDT);
+ NewEndTime := Frac(NewEndDT);
+
+ // Do a confirm drop event
+ Confirm := True;
+ if Assigned(FOnDropAppt) then
+ FOnDropAppt(Appt, NewSchedName, NewStartDate, NewStartTime,
+ NewEndDate, NewEndTime, ssCtrl in ADragInfo.Shift, Confirm);
+
+ if Confirm then
+ begin
+ //SchedNameChange := NewSchedName <> ADragInfo.Schedule.SchedName;
+ SchedNameChange := IsClassByName(ADragInfo.ApptCtrl, cClassName) or
+ (NewSchedName <> ADragInfo.Schedule.SchedName);
+ StartDateChange := (Trunc(NewStartDate) <> Trunc(Appt.StartDate)) or
+ (Trunc(NewEndDate) <> Trunc(Appt.EndDate));
+ Share := ssCtrl in ADragInfo.Shift;
+
+ Appt.BeginUpdate;
+ try
+ if (SchedNameChange and not StartDateChange and not Share) or
+ (not SchedNameChange and StartDateChange and not Share) or
+ (SchedNameChange and StartDateChange and not Share) or
+ (not SchedNameChange and StartDateChange and Share) or
+ (SchedNameChange and StartDateChange and Share) then
+ begin
+ if ADragInfo.ApptCtrl is TJvTFDays then
+ Appt.RemoveSchedule(ADragInfo.Schedule.SchedName)
+ else
+ if IsClassByName(ADragInfo.ApptCtrl, cClassName) then
+ Appt.ClearSchedules;
+
+ // THE FOLLOWING CODE SHOULD NOT BE NECESSARY.
+ // Make sure the old schedules get refreshed
+ {
+ aDate := Appt.StartDate;
+ while Trunc(aDate) <= Trunc(Appt.EndDate) do
+ begin
+ Sched := ScheduleManager.FindSchedule(ADragInfo.Schedule.SchedName, aDate);
+ if Assigned(Sched) then
+ ScheduleManager.RefreshConnections(Sched);
+ aDate := aDate + 1;
+ end;
+ }
+ end;
+
+ // Now we set the new StartEnd
+ Appt.SetStartEnd(NewStartDate, NewStartTime, NewEndDate, NewEndTime);
+ // if there's a change in SchedName then add the appt to the schedule
+ Appt.AddSchedule(NewSchedName);
+ // THE FOLLOWING CODE SHOULD NOT BE NECESSARY.
+ //ScheduleManager.RefreshConnections(Appt);
+ finally
+ Appt.EndUpdate;
+ end;
+ end;
+
+ if ADragInfo.ApptCtrl <> Self then
+ FState := agsNormal;
+end;
+
+procedure TJvTFDays.BeginDragging(Coord: TJvTFDaysCoord;
+ DragWhat: TJvTFDaysState; Appt: TJvTFAppt);
+begin
+ Update;
+
+ FState := DragWhat;
+ FBeginDraggingCoord := Coord;
+ FDraggingCoord := Coord;
+ if (State <> agsMoveAppt) or Coord.DragAccept then
+ DrawDrag(Coord, Appt, False);
+end;
+
+procedure TJvTFDays.DrawDrag(Coord: TJvTFDaysCoord; AAppt: TJvTFAppt;
+ AClear: Boolean);
+var
+ OldPen: TPen;
+ DragRect: TRect;
+ I, LineLeft, StartRow, EndRow, DragRectHt: Integer;
+ Sched: TJvTFSched;
+ StartDT, EndDT: TDateTime;
+ SchedName: string;
+
+ procedure InternalDrawFrame(ARect: TRect);
+ begin
+ Canvas.MoveTo(ARect.Left, ARect.Top);
+ Canvas.LineTo(ARect.Right - 2, ARect.Top);
+ Canvas.LineTo(ARect.Right - 2, ARect.Bottom - 2);
+ Canvas.LineTo(ARect.Left, ARect.Bottom - 2);
+ Canvas.LineTo(ARect.Left, ARect.Top);
+ end;
+
+begin
+ if ((State = agsSizeAppt) and not Assigned(Coord.Schedule)) or
+ ((State = agsMoveAppt) and ((Coord.Row < 0) or (Coord.Col < 0))) then
+ Exit;
+
+ OldPen := TPen.Create;
+ try
+ with Canvas, Coord do
+ begin
+ OldPen.Assign(Pen);
+ Pen.Style := psDot;
+ Pen.Mode := pmXOR;
+ Pen.Width := 1;
+
+ case State of
+ agsSizeCol, agsSizeRowHdr:
+ begin
+ MoveTo(AbsX, 0);
+ LineTo(AbsX, ClientHeight);
+ end;
+ agsSizeRow, agsSizeColHdr:
+ begin
+ MoveTo(0, AbsY);
+ LineTo(ClientWidth, AbsY);
+ end;
+ agsMoveCol:
+ begin
+ Pen.Mode := pmNotXOR;
+ Pen.Style := psSolid;
+ Pen.Width := 3;
+
+ LineLeft := AbsX - CellX;
+ if FDraggingCoord.Col > FBeginDraggingCoord.Col then
+ Inc(LineLeft, Cols[FDraggingCoord.Col].Width);
+
+ MoveTo(LineLeft, 0);
+ LineTo(LineLeft, ClientHeight);
+ end;
+ agsSizeAppt:
+ begin
+ Pen.Style := psSolid;
+ Pen.Mode := pmNotXOR;
+
+ AAppt := FBeginDraggingCoord.Appt;
+
+ CalcSizeEndTime(AAppt, EndDT);
+
+ if AClear and FHint.HandleAllocated then
+ begin
+ FHint.ReleaseHandle;
+ // Control must be updated here. if not, drag lines will
+ // not be drawn properly.
+ Update;
+ end;
+
+ SchedName := Coord.Schedule.SchedName;
+ for I := 0 to Cols.Count - 1 do
+ begin
+ Sched := Cols[I].Schedule;
+ if Assigned(Sched) and (Sched.SchedName = SchedName) and
+ ((Trunc(Sched.SchedDate) >= Trunc(AAppt.StartDate)) and
+ (Trunc(Sched.SchedDate) <= Trunc(EndDT))) then
+ begin
+ //Calc Start and end rows
+ if Trunc(Sched.SchedDate) = Trunc(AAppt.StartDate) then
+ StartRow := TimeToRow(AAppt.StartTime)
+ else
+ StartRow := 0;
+ if Trunc(Sched.SchedDate) = Trunc(EndDT) then
+ EndRow := TimeToRow(AdjustEndTime(EndDT))
+ else
+ EndRow := RowCount - 1;
+
+ DragRectHt := (EndRow - StartRow + 1) * RowHeight;
+ DragRect := VirtualCellRect(I, StartRow);
+ DragRect.Bottom := DragRect.Top + DragRectHt;
+
+ DragRect.Top := Greater(DragRect.Top, GetDataAreaRect.Top);
+ DragRect.Bottom := Lesser(DragRect.Bottom, GetDataAreaRect.Bottom);
+
+ InternalDrawFrame(DragRect);
+ end;
+ end;
+
+ if not AClear and (agoShowApptHints in Options) then
+ FHint.StartEndHint(AAppt.StartDate, Trunc(EndDT),
+ AAppt.StartTime, Frac(EndDT), DragRect.Left + 2,
+ DragRect.Bottom + 2, True);
+ end;
+ agsMoveAppt:
+ begin
+ Pen.Style := psSolid;
+ Pen.Mode := pmNotXOR;
+
+ Coord.Row := Greater(0, Greater(Coord.Row, TopRow - 1));
+
+ CalcMoveStartEnd(AAppt, Coord, ssShift in FDragInfo.Shift,
+ ssAlt in FDragInfo.Shift, StartDT, EndDT);
+
+ if AClear and FHint.HandleAllocated then
+ begin
+ FHint.ReleaseHandle;
+ Update;
+ end;
+
+ if Assigned(Coord.Schedule) then
+ SchedName := Coord.Schedule.SchedName;
+ DragRect := Classes.Rect(-1, -1, -1, -1); // Used to not show hint if outside a valid day.
+ for I := 0 to Cols.Count - 1 do
+ begin
+ Sched := Cols[I].Schedule;
+ if Assigned(Sched) and (Sched.SchedName = SchedName) and
+ ((Trunc(Sched.SchedDate) >= Trunc(StartDT)) and
+ (Trunc(Sched.SchedDate) <= Trunc(EndDT))) then
+ begin
+ //Calc Start and end rows
+ if Trunc(Sched.SchedDate) = Trunc(StartDT) then
+ StartRow := TimeToRow(StartDT)
+ else
+ StartRow := 0;
+ if Trunc(Sched.SchedDate) = Trunc(EndDT) then
+ EndRow := TimeToRow(AdjustEndTime(EndDT))
+ else
+ EndRow := RowCount - 1;
+
+ DragRectHt := (EndRow - StartRow + 1) * RowHeight;
+ DragRect := VirtualCellRect(I, StartRow);
+ DragRect.Bottom := DragRect.Top + DragRectHt;
+ DragRect.Top := Greater(DragRect.Top, GetDataAreaRect.Top);
+ InternalDrawFrame(DragRect);
+ end;
+ end;
+ if not AClear and (agoShowApptHints in Options) and
+ (DragRect.Top <> -1) and (DragRect.Left <> -1) and
+ (DragRect.Right <> -1) and (DragRect.Bottom <> -1) then
+ FHint.StartEndHint(Trunc(StartDT), Trunc(EndDT),
+ Frac(StartDT), Frac(EndDT),
+ DragRect.Right + 2, DragRect.Top + 2,
+ True);
+ end;
+ end;
+ end;
+ finally
+ Canvas.Pen.Assign(OldPen);
+ OldPen.Free;
+ end;
+end;
+
+procedure TJvTFDays.ContinueDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt);
+var
+ ValidDrag, SameSchedName, ValidEnd, DiffCoord: Boolean;
+ SameDateLaterTime, LaterDate, DoDrawDrag: Boolean;
+ OldLeft, NewLeft: Integer;
+begin
+ if State = agsSizeAppt then
+ begin
+ Coord.Row := Greater(Coord.Row, TopRow);
+ Coord.Row := Lesser(Coord.Row, BottomRow);
+ end;
+
+ DoDrawDrag := False;
+
+ case State of
+ agsSizeCol, agsSizeRowHdr, agsSizeRow, agsSizeColHdr:
+ DoDrawDrag := True;
+ agsMoveCol:
+ begin
+ OldLeft := FDraggingCoord.AbsX - FDraggingCoord.CellX;
+ NewLeft := Coord.AbsX - Coord.CellX;
+ DoDrawDrag := (OldLeft <> NewLeft) and
+ (Coord.Row = gcHdr) and (Coord.Col > gcHdr);
+ end;
+ agsSizeAppt:
+ begin
+ SameSchedName := False;
+ ValidEnd := False;
+ DiffCoord := False;
+ ValidDrag := Assigned(FBeginDraggingCoord.Schedule) and
+ Assigned(FDraggingCoord.Schedule) and Assigned(Coord.Schedule);
+ if ValidDrag then
+ begin
+ SameSchedName :=
+ FDraggingCoord.Schedule.SchedName = FBeginDraggingCoord.Schedule.SchedName;
+ LaterDate := (Trunc(Coord.Schedule.SchedDate) > Trunc(FBeginDraggingCoord.Appt.StartDate)) and
+ (Coord.Row >= 0);
+ SameDateLaterTime :=
+ (Trunc(Coord.Schedule.SchedDate) = Trunc(FBeginDraggingCoord.Appt.StartDate)) and
+ (Coord.Row >= TimeToRow(FBeginDraggingCoord.Appt.StartTime));
+ ValidEnd := LaterDate or SameDateLaterTime;
+ DiffCoord := not ((Coord.Row = FDraggingCoord.Row) and (Coord.Col = FDraggingCoord.Col));
+ end;
+ DoDrawDrag := ValidDrag and SameSchedName and ValidEnd and DiffCoord;
+ end;
+ agsMoveAppt:
+ DoDrawDrag := (Coord.Col <> FDraggingCoord.Col) or (Coord.Row <> FDraggingCoord.Row);
+ end;
+
+ if DoDrawDrag then
+ begin
+ if (State <> agsMoveAppt) or FDraggingCoord.DragAccept then
+ DrawDrag(FDraggingCoord, Appt, True); // clear old line
+ FDraggingCoord := Coord;
+ if (State <> agsMoveAppt) or FDraggingCoord.DragAccept then
+ DrawDrag(FDraggingCoord, Appt, False); // draw new line
+ end;
+end;
+
+procedure TJvTFDays.EndDragging(Coord: TJvTFDaysCoord; Appt: TJvTFAppt);
+var
+ Confirm: Boolean;
+ ColNum, DeltaSize, NewSize: Integer;
+ NewEndDT: TDateTime;
+begin
+ Confirm := True;
+ try
+ if (State <> agsMoveAppt) or FDraggingCoord.DragAccept then
+ DrawDrag(FDraggingCoord, Appt, True); // clear old line
+
+ case State of
+ agsSizeCol:
+ begin
+ ColNum := FBeginDraggingCoord.Col;
+ DeltaSize := Coord.AbsX - FBeginDraggingCoord.AbsX;
+ NewSize := Cols[ColNum].Width + DeltaSize;
+
+ if Assigned(FOnSizeCol) then
+ FOnSizeCol(Self, ColNum, NewSize, Confirm);
+
+ if Confirm then
+ begin
+ Cols[ColNum].Width := NewSize;
+ UpdateDesigner;
+ end;
+ end;
+ agsSizeRow:
+ begin
+ DeltaSize := Coord.AbsY - FBeginDraggingCoord.AbsY;
+ NewSize := RowHeight + DeltaSize;
+
+ if Assigned(FOnSizeRow) then
+ FOnSizeRow(Self, 0, NewSize, Confirm);
+
+ if Confirm then
+ begin
+ RowHeight := NewSize;
+ UpdateDesigner;
+ end;
+ end;
+ agsSizeColHdr:
+ begin
+ DeltaSize := Coord.AbsY - FBeginDraggingCoord.AbsY;
+ NewSize := ColHdrHeight + DeltaSize;
+
+ if Assigned(FOnSizeColHdr) then
+ FOnSizeColHdr(Self, 0, NewSize, Confirm);
+
+ if Confirm then
+ begin
+ ColHdrHeight := NewSize;
+ UpdateDesigner;
+ end;
+ end;
+ agsSizeRowHdr:
+ begin
+ DeltaSize := Coord.AbsX - FBeginDraggingCoord.AbsX;
+ NewSize := RowHdrWidth + DeltaSize;
+
+ if Assigned(FOnSizeRowHdr) then
+ FOnSizeRowHdr(Self, 0, NewSize, Confirm);
+
+ if Confirm then
+ begin
+ RowHdrWidth := NewSize;
+ UpdateDesigner;
+ end;
+ end;
+ agsMoveCol:
+ begin
+ NewSize := FDraggingCoord.Col;
+ if Assigned(FOnMoveCol) then
+ FOnMoveCol(Self, FBeginDraggingCoord.Col, NewSize, Confirm);
+
+ if Confirm then
+ begin
+ Cols.MoveCol(FBeginDraggingCoord.Col, NewSize);
+ UpdateDesigner;
+ end;
+ end;
+ agsSizeAppt:
+ begin
+ FHint.ReleaseHandle;
+ Appt := FBeginDraggingCoord.Appt;
+ CalcSizeEndTime(Appt, NewEndDT);
+
+ if Assigned(FOnSizeAppt) then
+ FOnSizeAppt(Self, Appt, NewEndDT, Confirm);
+
+ if Confirm then
+ begin
+ // WHY AM I CALLING RefreshControls HERE?????
+ ScheduleManager.RefreshConnections(Appt);
+ Appt.SetStartEnd(Appt.StartDate, Appt.StartTime,
+ Trunc(NewEndDT), Frac(NewEndDT));
+ ScheduleManager.RefreshConnections(Appt);
+ end;
+ end;
+ //agsMoveAppt: nothing special here - see DropAppt method
+ end;
+ finally
+ // Don't reset state if moving appt. State will be reset in DoEndDrag
+ // and/or DropAppt methods. Resetting State here will cause problems when
+ // dragging between multiple appt controls.
+ if State <> agsMoveAppt then
+ FState := agsNormal;
+ end;
+end;
+
+function TJvTFDays.CanDragWhat(Coord: TJvTFDaysCoord): TJvTFDaysState;
+var
+ TopHandleRect, BottomHandleRect: TRect;
+begin
+ case State of
+ agsSizeCol, agsSizeRow, agsSizeColHdr, agsSizeRowHdr,
+ agsMoveCol, agsSizeAppt, agsMoveAppt:
+ begin
+ Result := State;
+ Exit;
+ end;
+ else
+ Result := agsNormal;
+ end;
+
+ with Coord do
+ begin
+ if ((agoSizeCols in Options) or (csDesigning in ComponentState)) and
+ (Row = gcHdr) and (Col > gcHdr) and
+ (CellX > Cols[Col].Width - SizingThreshold) then
+ begin
+ Result := agsSizeCol;
+ Exit;
+ end;
+
+ if ((agoSizeRows in Options) or (csDesigning in ComponentState)) and
+ (Row > gcHdr) and (Col = gcHdr) and
+ (CellY > RowHeight - SizingThreshold) then
+ begin
+ Result := agsSizeRow;
+ Exit;
+ end;
+
+ if ((agoSizeColHdr in Options) or (csDesigning in ComponentState)) and
+ (Row = gcHdr) and (Col > gcUndef) and
+ (CellY > ColHdrHeight - SizingThreshold) then
+ begin
+ Result := agsSizeColHdr;
+ Exit;
+ end;
+
+ if ((agoSizeRowHdr in Options) or (csDesigning in ComponentState)) and
+ (Row > gcUndef) and (Col = gcHdr) and
+ (CellX > RowHdrWidth - SizingThreshold) then
+ begin
+ Result := agsSizeRowHdr;
+ Exit;
+ end;
+
+ if ((agoMoveCols in Options) or (csDesigning in ComponentState)) and
+ (Coord.Row = gcHdr) and (Coord.Col > gcHdr) and
+ not (Template.ActiveTemplate = agtLinear) and
+ ((State = agsNormal) or (State = agsMoveCol)) and
+ (Cols.Count > 1) then
+ begin
+ Result := agsMoveCol;
+ Exit;
+ end;
+
+ // move grab handles
+ if Assigned(SelAppt) then
+ begin
+ TopHandleRect := GetTopGrabHandleRect(Col, SelAppt);
+ BottomHandleRect := GetBottomGrabHandleRect(Col, SelAppt);
+ if PtInRect(TopHandleRect, Point(AbsX, AbsY)) and
+ (agoMoveAppt in Options) then
+ Result := agsMoveAppt
+ else
+ if PtInRect(BottomHandleRect, Point(AbsX, AbsY)) and
+ (agoSizeAppt in Options) then
+ Result := agsSizeAppt;
+ end;
+
+// if ((agoSizeAppt in Options) or (agoMoveAppt in Options)) and
+// Assigned(Appt) and (Appt = SelAppt) then
+// begin
+// ApptRect := GetApptRect(Col, Appt);
+// if (AbsY <= ApptRect.Top + GrabHandles.Height - 1) and
+// (agoMoveAppt in Options) then
+// begin
+// Result := agsMoveAppt;
+// Exit;
+// end
+// else
+// if (AbsY >= ApptRect.Bottom - GrabHandles.Height + 1) and
+// (agoSizeAppt in Options) then
+// begin
+// Result := agsSizeAppt;
+// Exit;
+// end;
+// end;
+ end;
+end;
+
+procedure TJvTFDays.CalcSizeEndTime(Appt: TJvTFAppt; var NewEndDT: TDateTime);
+var
+ TimeOffset: TTime;
+ Sched: TJvTFSched;
+begin
+ Sched := FDraggingCoord.Schedule;
+ if (Sched.SchedName = FBeginDraggingCoord.Schedule.SchedName) and
+ (Trunc(Sched.SchedDate) >= Trunc(Appt.StartDate)) then
+ if agoSnapSize in Options then
+ if FDraggingCoord.Row <> RowCount - 1 then
+ NewEndDT := Trunc(Sched.SchedDate) + Frac(RowToTime(FDraggingCoord.Row + 1))
+ else
+ NewEndDT := Trunc(Sched.SchedDate) + Frac(RowEndTime(FDraggingCoord.Row))
+ else
+ begin
+ TimeOffset := Frac(Appt.EndTime) -
+ Frac(RowToTime(TimeToRow(AdjustEndTime(Appt.EndTime))));
+ NewEndDT := Trunc(Sched.SchedDate) +
+ Frac(RowToTime(FDraggingCoord.Row)) + TimeOffset;
+ end
+ else
+ NewEndDT := Trunc(Appt.EndDate) + Frac(Appt.EndTime);
+end;
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+procedure TJvTFDays.CalcMoveStartEnd(Appt: TJvTFAppt; Coord: TJvTFDaysCoord;
+ KeepDates, KeepTimes: Boolean; var StartDT, EndDT: TDateTime);
+var
+ NewStart,
+ NewEnd: TDateTime;
+begin
+ NewStart := Trunc(Cols[Coord.Col].SchedDate) + Frac(RowToTime(Coord.Row));
+ if not (agoSnapMove in Options) then
+ NewStart := NewStart +
+ Frac(Appt.StartTime) - RowToTime(TimeToRow(Appt.StartTime));
+
+ NewEnd := (Trunc(Appt.EndDate) + Frac(Appt.EndTime)) -
+ (Trunc(Appt.StartDate) + Frac(Appt.StartTime)) +
+ NewStart;
+
+ if KeepDates then
+ begin
+ NewStart := Trunc(Appt.StartDate) + Frac(NewStart);
+ NewEnd := Trunc(Appt.EndDate) + Frac(NewEnd);
+ end;
+
+ if KeepTimes then
+ begin
+ NewStart := Trunc(NewStart) + Frac(Appt.StartTime);
+ NewEnd := Trunc(NewEnd) + Frac(Appt.EndTime);
+ end;
+
+ StartDT := NewStart;
+ EndDT := NewEnd;
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+procedure TJvTFDays.CalcMoveStartEnd(Appt: TJvTFAppt; Coord: TJvTFDaysCoord;
+ KeepDates, KeepTimes: Boolean; var StartDT, EndDT: TDateTime);
+var
+ NewStart, NewEnd: TDateTime;
+ TimeBlockIndex, BlockStartRow, BlockEndRow: Integer;
+ BlockStartTime, BlockEndTime: TTime;
+ H, M, S, MS: Word;
+begin
+ TimeBlockIndex := RowToTimeBlock(Coord.Row);
+ if TimeBlockProps.SnapMove and (TimeBlockIndex > -1) then
+ begin
+ GetTimeBlockStartEnd(TimeBlockIndex, BlockStartRow, BlockEndRow);
+ BlockStartTime := RowToTime(BlockStartRow);
+ BlockEndTime := RowEndTime(BlockEndRow);
+ NewStart := Trunc(Cols[Coord.Col].SchedDate) + Frac(BlockStartTime);
+ NewEnd := Trunc(NewStart) + Frac(BlockEndTime);
+ end
+ else
+ begin
+ NewStart := Trunc(Cols[Coord.Col].SchedDate) + Frac(RowToTime(Coord.Row));
+ if not (agoSnapMove in Options) then
+ NewStart := NewStart +
+ Frac(Appt.StartTime) - RowToTime(TimeToRow(Appt.StartTime));
+
+ NewEnd := (Trunc(Appt.EndDate) + Frac(Appt.EndTime)) -
+ (Trunc(Appt.StartDate) + Frac(Appt.StartTime)) +
+ NewStart;
+
+ // NewEnd cannot fall exactly on midnight. Bad things happen.
+ DecodeTime(NewEnd, H, M, S, MS);
+ if (H = 0) and (M = 0) and (S = 0) then
+ NewEnd := NewEnd - ONE_SECOND;
+
+ if KeepDates then
+ begin
+ NewStart := Trunc(Appt.StartDate) + Frac(NewStart);
+ NewEnd := Trunc(Appt.EndDate) + Frac(NewEnd);
+ end;
+
+ if KeepTimes then
+ begin
+ NewStart := Trunc(NewStart) + Frac(Appt.StartTime);
+ NewEnd := Trunc(NewEnd) + Frac(Appt.EndTime);
+ end;
+ end;
+
+ StartDT := NewStart;
+ EndDT := NewEnd;
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+procedure TJvTFDays.EnsureCol(ACol: Integer);
+begin
+ if (ACol < 0) or (ACol > Cols.Count - 1) then
+ raise EJvTFDaysError.CreateRes(@RsEColumnIndexOutOfBounds);
+end;
+
+procedure TJvTFDays.EnsureRow(ARow: Integer);
+begin
+ if (ARow < 0) or (ARow > RowCount - 1) then
+ raise EJvTFDaysError.CreateRes(@RsERowIndexOutOfBounds);
+end;
+
+procedure TJvTFDays.KeyDown(var Key: Word; Shift: TShiftState);
+var
+ H: Word;
+ Handled: Boolean;
+
+ procedure DoSel;
+ begin
+ if ssShift in Shift then
+ SelEnd := Point(FocusedCol, FocusedRow)
+ else
+ SelStart := Point(FocusedCol, FocusedRow);
+ ColInView(FocusedCol);
+ RowInView(FocusedRow);
+ end;
+
+begin
+ Handled := True;
+ inherited KeyDown(Key, Shift);
+
+ case Key of
+ VK_RETURN:
+ if ssAlt in Shift then
+ EditAppt(FocusedCol, SelAppt);
+ VK_UP:
+ if ssCtrl in Shift then
+ ScrollDays(-7)
+ else
+ if ssAlt in Shift then
+ SelPrevAppt
+ else
+ begin
+ FocusedRow := Greater(FocusedRow - 1, 0);
+ DoSel;
+ end;
+ VK_DOWN:
+ if ssCtrl in Shift then
+ ScrollDays(7)
+ else
+ if ssAlt in Shift then
+ SelNextAppt
+ else
+ begin
+ FocusedRow := Lesser(FocusedRow + 1, RowCount - 1);
+ DoSel;
+ end;
+ VK_RIGHT:
+ if ssCtrl in Shift then
+ NextDate
+ else
+ if ssAlt in Shift then
+ SelFirstApptNextCol
+ else
+ begin
+ FocusedCol := Lesser(FocusedCol + 1, Cols.Count - 1);
+ DoSel;
+ end;
+ VK_LEFT:
+ if ssCtrl in Shift then
+ PrevDate
+ else
+ if ssAlt in Shift then
+ SelFirstApptPrevCol
+ else
+ begin
+ FocusedCol := Greater(FocusedCol - 1, 0);
+ DoSel;
+ end;
+ VK_PRIOR:
+ if ssCtrl in Shift then
+ ScrollMonths(-1)
+ else
+ begin
+ TopRow := Greater(TopRow - FullVisibleRows, 0);
+ FocusedRow := Greater(FocusedRow - FullVisibleRows, TopRow);
+ DoSel;
+ end;
+ VK_NEXT:
+ if ssCtrl in Shift then
+ ScrollMonths(1)
+ else
+ begin
+ TopRow := Lesser(TopRow + FullVisibleRows, RowCount - FullVisibleRows);
+ FocusedRow := Lesser(FocusedRow + FullVisibleRows, RowCount - 1);
+ DoSel;
+ end;
+ VK_HOME:
+ if ssCtrl in Shift then
+ TopRow := TimeToRow(PrimeTime.StartTime)
+ else
+ begin
+ TopRow := 0;
+ FocusedRow := 0;
+ DoSel;
+ end;
+ VK_END:
+ if ssCtrl in Shift then
+ RowInView(TimeToRow(AdjustEndTime(PrimeTime.EndTime)))
+ else
+ begin
+ RowInView(RowCount - 1);
+ FocusedRow := RowCount - 1;
+ DoSel;
+ end;
+ VK_F1..VK_F12:
+ if ssCtrl in Shift then
+ begin
+ H := Key - VK_F1 + 1;
+ if ssShift in Shift then
+ Inc(H, 12);
+ if Key = VK_F12 then
+ Dec(H, 12);
+ RowInView(TimeToRow(EncodeTime(H, 0, 0, 0)));
+ end;
+ VK_INSERT:
+ if Shift = [ssCtrl] then
+ case Granularity of
+ 2:
+ Granularity := 1;
+ 3:
+ Granularity := 2;
+ 4:
+ Granularity := 3;
+ 5:
+ Granularity := 4;
+ 6:
+ Granularity := 5;
+ 10:
+ Granularity := 6;
+ 12:
+ Granularity := 10;
+ 15:
+ Granularity := 12;
+ 20:
+ Granularity := 15;
+ 30:
+ Granularity := 20;
+ 60:
+ Granularity := 30;
+ end
+ else
+ if Shift = [ssShift] then
+ DoInsertSchedule
+ else
+ if Shift = [] then
+ DoInsertAppt;
+ VK_DELETE:
+ if Shift = [ssCtrl] then
+ case Granularity of
+ 1:
+ Granularity := 2;
+ 2:
+ Granularity := 3;
+ 3:
+ Granularity := 4;
+ 4:
+ Granularity := 5;
+ 5:
+ Granularity := 6;
+ 6:
+ Granularity := 10;
+ 10:
+ Granularity := 12;
+ 12:
+ Granularity := 15;
+ 15:
+ Granularity := 20;
+ 20:
+ Granularity := 30;
+ 30:
+ Granularity := 60;
+ end
+ else
+ if Shift = [ssShift] then
+ DoDeleteSchedule
+ else
+ if Shift = [] then
+ DoDeleteAppt;
+ else
+ Handled := False;
+ end;
+
+ if Handled then
+ Key := 0;
+end;
+
+procedure TJvTFDays.KeyPress(var Key: Char);
+begin
+ inherited KeyPress(Key);
+ QuickEntry(Key);
+end;
+
+procedure TJvTFDays.DoInsertSchedule;
+begin
+ if Assigned(FOnInsertSchedule) then
+ FOnInsertSchedule(Self);
+end;
+
+procedure TJvTFDays.DoInsertAppt;
+begin
+ if Assigned(FOnInsertAppt) then
+ FOnInsertAppt(Self);
+end;
+
+procedure TJvTFDays.DoDeleteAppt;
+begin
+ if Assigned(FOnDeleteAppt) then
+ FOnDeleteAppt(Self);
+end;
+
+procedure TJvTFDays.DoDeleteSchedule;
+begin
+ if Assigned(FOnDeleteSchedule) then
+ FOnDeleteSchedule(Self);
+end;
+
+function TJvTFDays.DoMouseWheelDown(Shift: TShiftState;
+ MousePos: TPoint): Boolean;
+begin
+ Result := inherited DoMouseWheelDown(Shift, MousePos);
+ if not Result then
+ begin
+ if TopRow < RowCount - FullVisibleRows then
+ TopRow := TopRow + 1;
+ Result := True;
+ end;
+end;
+
+function TJvTFDays.DoMouseWheelUp(Shift: TShiftState;
+ MousePos: TPoint): Boolean;
+begin
+ Result := inherited DoMouseWheelUp(Shift, MousePos);
+ if not Result then
+ begin
+ if TopRow > 0 then
+ TopRow := TopRow - 1;
+ Result := True;
+ end;
+end;
+
+procedure TJvTFDays.DestroyApptNotification(AAppt: TJvTFAppt);
+begin
+ if AAppt = SelAppt then
+ SelAppt := nil;
+ inherited DestroyApptNotification(AAppt);
+end;
+
+procedure TJvTFDays.CMMouseLeave(var Msg: TLMessage);
+begin
+ FHint.ReleaseHandle;
+ inherited;
+end;
+
+procedure TJvTFDays.DoEnter;
+begin
+ inherited DoEnter;
+ if Assigned(FOnFocusedColChanged) then
+ FOnFocusedColChanged(Self);
+ if Assigned(FOnFocusedRowChanged) then
+ FOnFocusedRowChanged(Self);
+ Invalidate;
+end;
+
+procedure TJvTFDays.DoExit;
+begin
+ if Assigned(FOnFocusedColChanged) then
+ FOnFocusedColChanged(Self);
+ if Assigned(FOnFocusedRowChanged) then
+ FOnFocusedRowChanged(Self);
+ Invalidate;
+ inherited DoExit;
+end;
+
+function TJvTFDays.GetSelStart: TPoint;
+begin
+ // This routine will always return the start of the selection regardless
+ // of whether FSelStart and FSelEnd are in the correct order or not.
+ if FFromToSel then
+ if (FSelStart.X < FSelEnd.X) or
+ ((FSelStart.X = FSelEnd.X) and (FSelStart.Y < FSelEnd.Y)) then
+ Result := FSelStart
+ else
+ Result := FSelEnd
+ else
+ Result := Point(Lesser(FSelStart.X, FSelEnd.X),
+ Lesser(FSelStart.Y, FSelEnd.Y));
+end;
+
+function TJvTFDays.GetSelEnd: TPoint;
+begin
+ // This routine will always return the end of the selection regardless
+ // of whether FSelStart and FSelEnd are in the correct order or not.
+ if FFromToSel then
+ if (FSelStart.X < FSelEnd.X) or
+ ((FSelStart.X = FSelEnd.X) and (FSelStart.Y < FSelEnd.Y)) then
+ Result := FSelEnd
+ else
+ Result := FSelStart
+ else
+ Result := Point(Greater(FSelStart.X, FSelEnd.X),
+ Greater(FSelStart.Y, FSelEnd.Y));
+end;
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+procedure TJvTFDays.SetSelStart(Value: TPoint);
+begin
+ FSelStart := Value;
+ FSelEnd := Value;
+ DoNavigate;
+ Invalidate;
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+procedure TJvTFDays.SetSelStart(Value: TPoint);
+var
+ TimeBlock, StartRow, EndRow: Integer;
+begin
+ TimeBlock := RowToTimeBlock(Value.Y);
+ if (TimeBlock = -1) and (TimeBlocks.Count > 0) then
+ Exit;
+
+ FSelStart := Value;
+ FSelEnd := Value;
+
+ if TimeBlock > -1 then
+ begin
+ GetTimeBlockStartEnd(TimeBlock, StartRow, EndRow);
+ FSelStart.Y := StartRow;
+ FSelEnd.Y := EndRow;
+ end;
+
+// DoNavigate;
+ Invalidate;
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+procedure TJvTFDays.SetSelEnd(Value: TPoint);
+var
+ SameName,
+ Consecutive: Boolean;
+ I,
+ TestStart,
+ TestEnd,
+ DateDiff: Integer;
+begin
+ /////////////////////////////////////////////////////////////////////
+ // This routine enforces the rules by which cells can be selected.
+ // There are two different types of selection:
+ // 1. From/To - As mouse moves from cell(1, 4) to cell(2, 8)...
+ // Cell(1, 4) through cell(1, LastRow) is selected, AND
+ // Cell(2, TopRow) through cell(2, 8) is selected.
+ // 2. Block - As mouse moves from cell(1, 4) to cell(2, 8)...
+ // Cell(1, 4) through cell(1, 8) is selected, AND
+ // Cell(2, 4) through cell(2, 8) is selected.
+ //
+ // There are six different cases that are possible:
+ // 1. Same SchedName (resource), contiguous dates ==> From/To selection
+ // (Mike - 1/1/99 and Mike - 1/2/99)
+ // 2. Same name, non-contiguous dates ==> Selection not allowed
+ // (Mike - 1/1/99 and Mike - 2/1/99)
+ // 3. Same name, same date ==> Block selection
+ // (Mike - 1/1/99 and Mike - 1/1/99)
+ // 4. Different name, contiguous dates ==> Selection not allowed
+ // (Mike - 1/1/99 and Jennifer - 1/2/99)
+ // 5. Different name, non-contiguous dates ==> Selection not allowed
+ // (Mike - 1/1/99 and Jennifer - 2/1/99)
+ // 6. Different name, same date ==> Block selection
+ // (Mike - 1/1/99 and Jennifer - 1/1/99)
+ ///////////////////////////////////////////////////////////////////////
+
+ // Check for different end value
+ if (FSelEnd.X <> Value.X) or (FSelEnd.Y <> Value.Y) then
+ begin
+ // Check for valid end
+ if (FSelStart.X > gcHdr) and (Value.X > gcHdr) and (FSelEnd.X > gcHdr) and
+ (FSelStart.Y > gcHdr) and (Value.Y > gcHdr) and (FSelEnd.Y > gcHdr) then
+ begin
+ // FFromToSel flag needed for drawing selection frame when
+ // SelCellAttr.Style = scsFrame. Frame is drawn in DrawDataCell.
+ //FFromToSel := False;
+
+ // We need a two-level check. First check new end (Value) against
+ // old end (FSelEnd). if that is NOT a valid end then check
+ // new end (Value) against start (FSelStart).
+
+ // IMPORTANT NOTE: When in a case #1 and selection moves up or down
+ // within the same column, the code below will interpret that as
+ // Case #3. This is not exactly correct, but it still yields the
+ // correct results.
+
+ // First check new end against old end
+ SameName := Cols[FSelEnd.X].SchedName = Cols[Value.X].SchedName;
+ DateDiff := Abs(Trunc(Cols[FSelEnd.X].SchedDate) -
+ Trunc(Cols[Value.X].SchedDate));
+
+ if ( SameName and (DateDiff = 1)) or // Case #1
+ ( SameName and (DateDiff = 0)) or // Case #3
+ (not SameName and (DateDiff = 0)) then // Case #6
+ begin
+ FFromToSel := (SameName and (DateDiff = 1)) or
+ (FFromToSel and (SameName and (DateDiff = 0)));
+
+ FSelEnd := Value;
+ DoNavigate;
+ Invalidate;
+ end
+ else
+ // if first check fails then check new end against start
+ begin
+ SameName := Cols[FSelStart.X].SchedName = Cols[Value.X].SchedName;
+ DateDiff := Abs(Trunc(Cols[FSelStart.X].SchedDate) -
+ Trunc(Cols[Value.X].SchedDate));
+ if ( SameName and (DateDiff = 1)) or // Case #1
+ ( SameName and (DateDiff = 0)) or // Case #3
+ (not SameName and (DateDiff = 0)) then // Case #6
+ begin
+ FFromToSel := (SameName and (DateDiff = 1)) or
+ (FFromToSel and (SameName and (DateDiff = 0)));
+
+ FSelEnd := Value;
+ DoNavigate;
+ Invalidate;
+ end
+ else
+ // Do a third check for "lagging selection"
+ // (Sometimes mouse loses selection, especially when speed
+ // threshold is exceeded.)
+ begin
+ // Check for consecutive dates
+ TestStart := Lesser(SelStart.X, Value.X);
+ TestEnd := Greater(SelStart.X, Value.X);
+ I := TestStart;
+ Consecutive := True;
+ while (I < TestEnd) and Consecutive do
+ if Trunc(Cols[I + 1].SchedDate) -
+ Trunc(Cols[I].SchedDate) <> 1 then
+ Consecutive := False
+ else
+ Inc(I);
+
+ if Consecutive then
+ begin
+ FFromToSel := True;
+ FSelEnd := Value;
+ DoNavigate;
+ Invalidate;
+ end
+ else
+ FFromToSel := False;
+ end;
+ end;
+ end;
+ end;
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+procedure TJvTFDays.SetSelEnd(Value: TPoint);
+var
+ SameName, Consecutive, InTimeBlock: Boolean;
+ I, TestStart, TestEnd, DateDiff, TimeBlock: Integer;
+ SelStartTimeBlock, StartRow, EndRow: Integer;
+
+ procedure CheckFollowMouse;
+ begin
+ if (TimeBlocks.Count > 0) and SameName and (DateDiff = 1) and
+ (Value.X <> SelStart.X) then
+ SelStart := Point(Value.X, SelStart.Y);
+ end;
+
+begin
+ {
+ This routine enforces the rules by which cells can be selected.
+ There are two different types of selection:
+ 1. From/To - As mouse moves from cell(1, 4) to cell(2, 8)...
+ Cell(1, 4) through cell(1, LastRow) is selected, AND
+ Cell(2, TopRow) through cell(2, 8) is selected.
+ 2. Block - As mouse moves from cell(1, 4) to cell(2, 8)...
+ Cell(1, 4) through cell(1, 8) is selected, AND
+ Cell(2, 4) through cell(2, 8) is selected.
+
+ NOTE: The Block selection type should not be confused with
+ Time Blocks. They are two different things. The only
+ type of allowable selection when using Time Blocks is
+ Block, however a Block selection can exist without
+ the use of Time Blocks.
+
+ There are six different cases that are possible:
+ 1. Same SchedName (resource), contiguous dates ==> From/To selection
+ (Mike - 1/1/99 and Mike - 1/2/99)
+ 2. Same name, non-contiguous dates ==> Selection not allowed
+ (Mike - 1/1/99 and Mike - 2/1/99)
+ 3. Same name, same date ==> Block selection
+ (Mike - 1/1/99 and Mike - 1/1/99)
+ 4. Different name, contiguous dates ==> Selection not allowed
+ (Mike - 1/1/99 and Jennifer - 1/2/99)
+ 5. Different name, non-contiguous dates ==> Selection not allowed
+ (Mike - 1/1/99 and Jennifer - 2/1/99)
+ 6. Different name, same date ==> Block selection
+ (Mike - 1/1/99 and Jennifer - 1/1/99)
+ }
+
+ // Do a time block check and adjust Value.Y if necessary to always
+ // select the entire time block.
+ TimeBlock := RowToTimeBlock(Value.Y);
+ if (TimeBlock = -1) and (TimeBlocks.Count > 0) then
+ Exit;
+
+ SelStartTimeBlock := RowToTimeBlock(SelStart.Y);
+ InTimeBlock := (TimeBlock > -1) or (SelStartTimeBlock > -1);
+ if InTimeBlock then
+ begin
+ if TimeBlock > -1 then
+ begin
+ GetTimeBlockStartEnd(TimeBlock, StartRow, EndRow);
+ SelStart := Point(SelStart.X, StartRow);
+ end
+ else
+ SelStart := Point(SelStart.X, Value.Y);
+ Value.Y := EndRow;
+ end;
+
+ // Check for different end value
+ if (FSelEnd.X <> Value.X) or (FSelEnd.Y <> Value.Y) then
+ begin
+ // Check for valid end
+ if (FSelStart.X > gcHdr) and (Value.X > gcHdr) and (FSelEnd.X > gcHdr) and
+ (FSelStart.Y > gcHdr) and (Value.Y > gcHdr) and (FSelEnd.Y > gcHdr) then
+ begin
+ // FFromToSel flag needed for drawing selection frame when
+ // SelCellAttr.Style = scsFrame. Frame is drawn in DrawDataCell.
+ //FFromToSel := False;
+
+ // We need a two-level check. First check new end (Value) against
+ // old end (FSelEnd). if that is NOT a valid end then check
+ // new end (Value) against start (FSelStart).
+
+ // IMPORTANT NOTE: When in a case #1 and selection moves up or down
+ // within the same column, the code below will interpret that as
+ // Case #3. This is not exactly correct, but it still yields the
+ // correct results.
+
+ // First check new end against old end
+ SameName := Cols[FSelEnd.X].SchedName = Cols[Value.X].SchedName;
+ DateDiff := Abs(Trunc(Cols[FSelEnd.X].SchedDate) -
+ Trunc(Cols[Value.X].SchedDate));
+
+ CheckFollowMouse;
+
+ if (SameName and (DateDiff = 1) and (TimeBlocks.Count = 0)) or // Case #1 only if no timeblocks
+ (SameName and (DateDiff = 0)) or // Case #3
+ (not SameName and (DateDiff = 0)) then // Case #6
+ begin
+ FFromToSel := (SameName and (DateDiff = 1)) or
+ (FFromToSel and (SameName and (DateDiff = 0)));
+
+ FSelEnd := Value;
+// DoNavigate;
+ Invalidate;
+ end
+ else
+ // if first check fails then check new end against start
+ begin
+ SameName := Cols[FSelStart.X].SchedName = Cols[Value.X].SchedName;
+ DateDiff := Abs(Trunc(Cols[FSelStart.X].SchedDate) -
+ Trunc(Cols[Value.X].SchedDate));
+
+ CheckFollowMouse;
+
+ if (SameName and (DateDiff = 1) and (TimeBlocks.Count = 0)) or // Case #1 only if no timeblocks
+ (SameName and (DateDiff = 0)) or // Case #3
+ (not SameName and (DateDiff = 0)) then // Case #6
+ begin
+ FFromToSel := (SameName and (DateDiff = 1)) or
+ (FFromToSel and (SameName and (DateDiff = 0)));
+
+ FSelEnd := Value;
+// DoNavigate;
+ Invalidate;
+ end
+ else
+ // Do a third check for "lagging selection"
+ // (Sometimes mouse loses selection, especially when speed
+ // threshold is exceeded.)
+ begin
+ // Check for consecutive dates
+ TestStart := Lesser(SelStart.X, Value.X);
+ TestEnd := Greater(SelStart.X, Value.X);
+ I := TestStart;
+ Consecutive := False;
+ while (I < TestEnd) and Consecutive do
+ if Trunc(Cols[I + 1].SchedDate) -
+ Trunc(Cols[I].SchedDate) <> 1 then
+ Consecutive := False
+ else
+ Inc(I);
+
+ if Consecutive then
+ begin
+ FFromToSel := True;
+ FSelEnd := Value;
+// DoNavigate;
+ Invalidate;
+ end
+ else
+ FFromToSel := False;
+ end;
+ end;
+ end;
+ end;
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+procedure TJvTFDays.QuickEntry(Key: Char);
+var
+ Appt: TJvTFAppt;
+ ApptStartDate, ApptEndDate: TDate;
+ ApptStartTime, ApptEndTime: TTime;
+ I: Integer;
+ ID: string;
+ Confirm: Boolean;
+begin
+ // Ord(key) must be >= 32 to quick entry an appt.
+ if (Ord(Key) >= 32) and ValidSelection and not Assigned(SelAppt) and
+ (agoQuickEntry in Options) and (agoEditing in Options) and CanEdit then
+ begin
+ // Calc the appt's start and end info
+ ApptStartDate := Cols[SelStart.X].SchedDate;
+ ApptEndDate := Cols[SelEnd.X].SchedDate;
+ ApptStartTime := RowToTime(SelStart.Y);
+ // subtract one min from granularity and then add it back in. This
+ // avoids min overflow when granularity = 60.
+ ApptEndTime := RowToTime(SelEnd.Y) +
+ EncodeTime(0, Granularity - 1, 0, 0) +
+ EncodeTime(0, 1, 0, 0);
+ // if we're on the last row make sure end time is not = 0 (12am next day)
+ // This avoids InvalidStartEnd exception when calling Appt.SetStartEnd
+ if SelEnd.Y = RowCount - 1 then
+ ApptEndTime := ApptEndTime - EncodeTime(0, 0, 1, 0);
+
+ ID := '';
+ Confirm := True;
+
+ if Assigned(FOnCreateQuickEntry) then
+ FOnCreateQuickEntry(Self, ID, ApptStartDate, ApptStartTime,
+ ApptEndDate, ApptEndTime, Confirm);
+
+ if Confirm and Assigned(ScheduleManager) then
+ begin
+ Appt := ScheduleManager.dbNewAppt(ID);
+ Appt.Persistent := True;
+
+ // Set the Start/end info
+ Appt.SetStartEnd(ApptStartDate, ApptStartTime, ApptEndDate, ApptEndTime);
+
+ // Set the Schedule (resource) names
+ for I := SelStart.X to SelEnd.X do
+ if ColIsSelected(I) then
+ Appt.AddSchedule(Cols[I].SchedName);
+
+ Appt.Persistent := False;
+
+ SetSelAppt(Appt);
+ EditAppt(SelStart.X, SelAppt);
+ // Put the Key in the editor and set the caret
+ FEditor.Text := Key;
+ FEditor.SelStart := 1;
+ FEditor.QuickCreate := True;
+
+ if Assigned(FOnQuickEntry) then
+ FOnQuickEntry(Self);
+ end;
+ end;
+end;
+
+function TJvTFDays.GetAdjClientRect: TRect;
+begin
+ Result := GetClientRect;
+
+ if Assigned(FVScrollBar) and FVScrollBar.Visible then
+ Dec(Result.Right, FVScrollBar.Width);
+ if Assigned(FHScrollBar) and FHScrollBar.Visible then
+ Dec(Result.Bottom, FHScrollBar.Height);
+end;
+
+function TJvTFDays.GetDataAreaRect: TRect;
+begin
+ Result := GetAdjClientRect;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Inc(Result.Left, CalcBlockRowHdrsWidth);
+ {$ELSE}
+ // remove
+ //Inc(Result.Left, RowHdrWidth);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ //group Inc(Result.Top, ColHdrHeight);
+ Inc(Result.Top, CalcGroupColHdrsHeight);
+end;
+
+function TJvTFDays.GetDataWidth: Integer;
+begin
+ Result := RectWidth(GetDataAreaRect);
+end;
+
+function TJvTFDays.GetDataHeight: Integer;
+begin
+ Result := RectHeight(GetDataAreaRect);
+end;
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+function TJvTFDays.PtToCell(X, Y: Integer): TJvTFDaysCoord;
+Var
+ ColNum,
+ RowNum,
+ AdjX,
+ AdjY,
+ Temp,
+ TotalWidth,
+ SegCount,
+ MapCol: Integer;
+ Done: Boolean;
+ ApptRect: TRect;
+begin
+ With Result do
+ begin
+ Col := gcUndef;
+ Row := gcUndef;
+ CellX := -100;
+ CellY := -100;
+ AbsX := X;
+ AbsY := Y;
+ Schedule := nil;
+ Appt := nil;
+ end;
+
+ if X < RowHdrWidth then
+ begin
+ Result.Col := gcHdr;
+ Result.CellX := X;
+ end
+ else
+ if LeftCol > -1 then
+ begin
+ // Find the col that PtX falls in
+ ColNum := LeftCol;
+ AdjX := X - RowHdrWidth;
+ Done := False;
+ Temp := 0;
+
+ while (ColNum < Cols.Count) and not Done do
+ begin
+ Inc(Temp, Cols[ColNum].Width);
+ if AdjX < Temp then
+ begin
+ Done := True;
+ Result.Col := ColNum;
+ Result.CellX := AdjX - (Temp - Cols[ColNum].Width);
+ end
+ else
+ Inc(ColNum);
+ end;
+ end;
+
+ if Y < CalcGroupHdrHeight then
+ begin
+ Result.Row := gcGroupHdr;
+ Result.CellY := Y;
+ end
+ //else
+ //if Y < ColHdrHeight then
+ else
+ if Y < CalcGroupColHdrsHeight then
+ begin
+ Result.Row := gcHdr;
+ Result.CellY := Y - CalcGroupHdrHeight;
+ end
+ else
+ if TopRow > -1 then
+ begin
+ RowNum := TopRow;
+ //group AdjY := Y - ColHdrHeight;
+ AdjY := Y - CalcGroupColHdrsHeight;
+ Done := False;
+ Temp := 0;
+
+ while (RowNum < RowCount) and not Done do
+ begin
+ Inc(Temp, RowHeight);
+ if AdjY < Temp then
+ begin
+ Done := True;
+ Result.Row := RowNum;
+ Result.CellY := AdjY - (Temp - RowHeight);
+ end
+ else
+ Inc(RowNum);
+ end;
+ end;
+
+ if Result.Col > gcHdr then
+ begin
+ Result.Schedule := Cols[Result.Col].Schedule;
+
+ if (Result.Row > gcHdr) and Assigned(Result.Schedule) then
+ begin
+ TotalWidth := Cols[Result.Col].Width;
+ SegCount := Cols[Result.Col].MapColCount(Result.Row);
+ if SegCount > 0 then
+ begin
+ MapCol := LocateDivCol(Result.CellX, TotalWidth, SegCount);
+ Result.Appt := Cols[Result.Col].MapLocation(MapCol, Result.Row);
+
+ ApptRect := GetApptRect(Result.Col, Result.Appt);
+ if not Windows.PtInRect(ApptRect, Point(X, Y)) then
+ Result.Appt := nil;
+ end;
+ end;
+ end;
+
+ Result.DragAccept := (Result.Row > gcHdr) and (Result.Col > gcHdr);
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+function TJvTFDays.PtToCell(X, Y: Integer): TJvTFDaysCoord;
+var
+ ColNum, RowNum, AdjX, AdjY, Temp, TotalWidth, SegCount, MapCol: Integer;
+ Done: Boolean;
+ ApptRect: TRect;
+begin
+ with Result do
+ begin
+ Col := gcUndef;
+ Row := gcUndef;
+ CellX := -100;
+ CellY := -100;
+ AbsX := X;
+ AbsY := Y;
+ Schedule := nil;
+ Appt := nil;
+ end;
+
+ if X < CalcBlockHdrWidth then
+ begin
+ // POSSIBLE BUG!!
+ //Result.Row := gcGroupHdr; // WRONG CODE
+ Result.Col := gcGroupHdr; // UNTESTED - CORRECT CODE
+ Result.CellX := X;
+ end
+ //block if X < RowHdrWidth then
+ else
+ if X < CalcBlockRowHdrsWidth then
+ begin
+ Result.Col := gcHdr;
+ Result.CellX := X - CalcBlockHdrWidth;
+ end
+ else
+ if LeftCol > -1 then
+ begin
+ // Find the col that PtX falls in
+ ColNum := LeftCol;
+ //block AdjX := X - RowHdrWidth;
+ AdjX := X - CalcBlockRowHdrsWidth;
+ Done := False;
+ Temp := 0;
+
+ while (ColNum < Cols.Count) and not Done do
+ begin
+ Inc(Temp, Cols[ColNum].Width);
+ if AdjX < Temp then
+ begin
+ Done := True;
+ Result.Col := ColNum;
+ Result.CellX := AdjX - (Temp - Cols[ColNum].Width);
+ end
+ else
+ Inc(ColNum);
+ end;
+ if not Done then
+ begin
+ Result.Col := Cols.Count-1;
+ Result.CellX := AdjX - (Temp - Cols[Cols.Count-1].Width);
+ end;
+ end;
+
+ if Y < CalcGroupHdrHeight then
+ begin
+ Result.Row := gcGroupHdr;
+ Result.CellY := Y;
+ end
+ //else if Y < ColHdrHeight then
+ else
+ if Y < CalcGroupColHdrsHeight then
+ begin
+ Result.Row := gcHdr;
+ Result.CellY := Y - CalcGroupHdrHeight;
+ end
+ else
+ if TopRow > -1 then
+ begin
+ RowNum := TopRow;
+ //group AdjY := Y - ColHdrHeight;
+ AdjY := Y - CalcGroupColHdrsHeight;
+ Done := False;
+ Temp := 0;
+
+ while (RowNum < RowCount) and not Done do
+ begin
+ Inc(Temp, RowHeight);
+ if AdjY < Temp then
+ begin
+ Done := True;
+ Result.Row := RowNum;
+ Result.CellY := AdjY - (Temp - RowHeight);
+ end
+ else
+ Inc(RowNum);
+ end;
+ if not Done then
+ begin
+ Result.Row := RowCount-1;
+ Result.CellY := AdjY - (Temp - RowHeight);
+ end;
+ end;
+
+ if Result.Col > gcHdr then
+ begin
+ Result.Schedule := Cols[Result.Col].Schedule;
+
+ // move grab handles
+ if PtInTopHandle(Point(X, Y), Result.Col, SelAppt) then
+ Result.Appt := SelAppt
+ else
+ if PtInBottomHandle(Point(X, Y), Result.Col, SelAppt) then
+ Result.Appt := SelAppt
+ else
+ if (Result.Row > gcHdr) and Assigned(Result.Schedule) then
+ begin
+ TotalWidth := Cols[Result.Col].Width;
+ SegCount := Cols[Result.Col].MapColCount(Result.Row);
+ if SegCount > 0 then
+ begin
+ MapCol := LocateDivCol(Result.CellX, TotalWidth, SegCount);
+ Result.Appt := Cols[Result.Col].MapLocation(MapCol, Result.Row);
+
+ ApptRect := GetApptRect(Result.Col, Result.Appt);
+ if not PtInRect(ApptRect, Point(X, Y)) then
+ Result.Appt := nil;
+ end;
+ end;
+ end;
+
+ Result.DragAccept := (Result.Row > gcHdr) and (Result.Col > gcHdr);
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+function TJvTFDays.CellRect(Col, Row: Integer): TRect;
+Var
+ I: Integer;
+ VisGrpHdrRect: TRect;
+begin
+ if (Row = gcGroupHdr) and (Col > gcHdr) then
+ begin
+ VisGrpHdrRect := Classes.Rect(RowHdrWidth, 0, RowHdrWidth + GetDataWidth,
+ CalcGroupHdrHeight);
+ Windows.IntersectRect(Result, VisGrpHdrRect, VirtualGroupHdrRect(Col));
+ end
+ else
+ if Col < 0 then // Row hdr
+ if Row < 0 then
+ //group Result := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight) // origin cell
+ Result := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight) // origin cell
+ else
+ if (Row >= TopRow) and (Row <= BottomRow) then
+ // Row Hdr for visible data row
+ begin
+ Result.Left := 0;
+ //group Top := ColHdrHeight + (Row - TopRow) * RowHeight;
+ Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight;
+ Result.Right := RowHdrWidth;
+ Result.Bottom := Result.Top + RowHeight;
+ end
+ else
+ // Row Hdr for non-visible data row
+ Result := EmptyRect
+
+ else
+ if (Col >= LeftCol) and (Col <= RightCol) then // visible data col
+ if Row < 0 then
+ // Col hdr for visible data col
+ begin
+ Result.Left := RowHdrWidth;
+ For I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ //group Top := 0;
+ Result.Top := CalcGroupHdrHeight;
+ //group Bottom := ColHdrHeight;
+ Result.Bottom := CalcGroupColHdrsHeight;
+ end
+ else
+ if (Row >= TopRow) and (Row <= BottomRow) then
+ // visible data cell
+ begin
+ Result.Left := RowHdrWidth;
+ For I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ //group Top := ColHdrHeight + (Row - TopRow) * RowHeight;
+ Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight;
+ Result.Bottom := Result.Top + RowHeight;
+ end
+ else
+ // non-visible data cell (visible col, but non-visible row)
+ Result := EmptyRect
+
+ else // non-visible data col
+ Result := EmptyRect;
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+function TJvTFDays.CellRect(Col, Row: Integer): TRect;
+var
+ I: Integer;
+ VisGrpHdrRect: TRect;
+begin
+ if (Col = gcGroupHdr) and (Row > gcHdr) then
+ begin
+ VisGrpHdrRect := Classes.Rect(0, CalcGroupColHdrsHeight, CalcBlockRowHdrsWidth,
+ CalcGroupColHdrsHeight + GetDataHeight);
+ IntersectRect(Result, VisGrpHdrRect, VirtualBlockHdrRect(Row));
+ end
+ else
+ if (Row = gcGroupHdr) and (Col > gcHdr) then
+ begin
+ //block VisGrpHdrRect := Classes.Rect(RowHdrWidth, 0, RowHdrWidth + GetDataWidth,
+ // CalcGroupHdrHeight);
+ VisGrpHdrRect := Classes.Rect(CalcBlockRowHdrsWidth, 0,
+ CalcBlockRowHdrsWidth + GetDataWidth, CalcGroupHdrHeight);
+ IntersectRect(Result, VisGrpHdrRect, VirtualGroupHdrRect(Col));
+ end
+ else
+ if Col < 0 then // Row hdr
+ if Row < 0 then
+ //group Result := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight) // origin cell
+ //block Result := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight) // origin cell
+ Result := Classes.Rect(0, 0, CalcBlockRowHdrsWidth, CalcGroupColHdrsHeight)
+ else
+ if (Row >= TopRow) and (Row <= BottomRow) then
+ // Row Hdr for visible data row
+ begin
+ //block Left := 0;
+ Result.Left := CalcBlockHdrWidth;
+ //group Top := ColHdrHeight + (Row - TopRow) * RowHeight;
+ Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight;
+ //block Right := RowHdrWidth;
+ Result.Right := Result.Left + RowHdrWidth;
+ Result.Bottom := Result.Top + RowHeight;
+ end
+ else
+ // Row Hdr for non-visible data row
+ Result := EmptyRect
+ else
+ if (Col >= LeftCol) and (Col <= RightCol) then // visible data col
+ if Row < 0 then
+ // Col hdr for visible data col
+ begin
+ //block Result.Left := RowHdrWidth;
+ Result.Left := CalcBlockRowHdrsWidth;
+ for I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ //group Result.Top := 0;
+ Result.Top := CalcGroupHdrHeight;
+ //group Result.Bottom := ColHdrHeight;
+ Result.Bottom := CalcGroupColHdrsHeight;
+ end
+ else
+ if (Row >= TopRow) and (Row <= BottomRow) then
+ // visible data cell
+ begin
+ //block Result.Left := RowHdrWidth;
+ Result.Left := CalcBlockRowHdrsWidth;
+ for I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ //group Result.Top := ColHdrHeight + (Row - TopRow) * RowHeight;
+ Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight;
+ Result.Bottom := Result.Top + RowHeight;
+ end
+ else
+ // non-visible data cell (visible col, but non-visible row)
+ Result := EmptyRect
+
+ else // non-visible data col
+ Result := EmptyRect;
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+{$IFNDEF Jv_TIMEBLOCKS}
+// remove
+{
+function TJvTFDays.VirtualCellRect(Col, Row: Integer): TRect;
+Var
+ I: Integer;
+begin
+ if Row = gcGroupHdr then
+ Result := VirtualGroupHdrRect(Col)
+ else
+ begin
+ if Col > -1 then
+ begin
+ Result.Left := RowHdrWidth;
+ // At most, only one of the following For loops will execute
+ // depending on whether Col is to the left or to the right of LeftCol
+ For I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+
+ For I := LeftCol - 1 downto Col do
+ Dec(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ end
+ else
+ begin
+ Result.Left := 0;
+ Result.Right := RowHdrWidth;
+ end;
+
+ if Row > -1 then
+ begin
+ //group Result.Top := ColHdrHeight + (Row - TopRow) * RowHeight;
+ Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight;
+ Result.Bottom := Result.Top + RowHeight;
+ end
+ else
+ begin
+ //group Result.Top := 0;
+ Result.Top := CalcGroupHdrHeight;
+ Result.Bottom := Result.Top + ColHdrHeight;
+ end;
+ end;
+end;
+}
+{$ENDIF !Jv_TIMEBLOCKS}
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+function TJvTFDays.VirtualCellRect(Col, Row: Integer): TRect;
+var
+ I: Integer;
+begin
+ if (Col = gcGroupHdr) and (Row > gcHdr) then
+ Result := VirtualBlockHdrRect(Row)
+ else
+ if (Row = gcGroupHdr) and (Col > gcHdr) then
+ Result := VirtualGroupHdrRect(Col)
+ else
+ begin
+ if Col > -1 then
+ begin
+ //block Result.Left := RowHdrWidth;
+ Result.Left := CalcBlockRowHdrsWidth;
+ // At most, only one of the following For loops will execute
+ // depending on whether Col is to the Result.Left or to the Result.Right of LeftCol
+ for I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+
+ for I := LeftCol - 1 downto Col do
+ Dec(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ end
+ else
+ begin
+ //block Result.Left := 0;
+ Result.Left := CalcBlockHdrWidth;
+ //block Result.Right := RowHdrWidth;
+ Result.Right := Result.Left + RowHdrWidth;
+ end;
+
+ if Row > -1 then
+ begin
+ //group Result.Top := ColHdrHeight + (Row - TopRow) * RowHeight;
+ Result.Top := CalcGroupColHdrsHeight + (Row - TopRow) * RowHeight;
+ Result.Bottom := Result.Top + RowHeight;
+ end
+ else
+ begin
+ //group Result.Top := 0;
+ Result.Top := CalcGroupHdrHeight;
+ Result.Bottom := Result.Top + ColHdrHeight;
+ end;
+ end;
+end;
+{$ENDIF Jv_TIMEBLOCKS}
+
+function TJvTFDays.GetApptRect(Col: Integer; Appt: TJvTFAppt): TRect;
+var
+ MapCol, MapColCount, Base, MakeUp, BaseWidth, MakeUpWidth: Integer;
+ BaseCount, GridColWidth, ApptWidth, StartRow, EndRow: Integer;
+ VirtCellRect: TRect;
+begin
+ if not Assigned(Appt) then
+ begin
+ Result := EmptyRect;
+ Exit;
+ end;
+
+ CalcStartEndRows(Appt, Cols[Col].SchedDate, StartRow, EndRow);
+
+ if (StartRow < 0) and (EndRow >= 0) then
+ StartRow := 0;
+ // if the above condition fails and the StartRow is STILL invalid then
+ // let the 'Map col not found' catch the error.
+
+ EndRow := Lesser(EndRow, RowCount - 1);
+
+ MapCol := Cols[Col].LocateMapCol(Appt, StartRow);
+
+ if MapCol < 1 then
+ begin
+ //Cols[Col].DumpMap;
+ raise EJvTFDaysError.CreateRes(@RsEMapColNotFoundForAppointment);
+ end;
+
+ MapColCount := Cols[Col].MapColCount(StartRow);
+ if MapColCount < 1 then
+ begin
+ //Cols[Col].FMap.Dump('corrupt dump.txt'); !!! FOR DEBUGGING ONLY !!!!
+ //Cols[Col].DumpMap;
+ raise EJvTFDaysError.CreateRes(@RsECorruptAppointmentMap);
+ end;
+
+ // Col guaranteed to be partially visible
+ VirtCellRect := VirtualCellRect(Col, StartRow);
+ GridColWidth := RectWidth(VirtCellRect);
+
+ // The Base* and MakeUp* code that follows calcs the appt width and Result.Left
+ // and takes into account a total width that isn't evenly divisible by
+ // the map col count. If there is a discrepancy then that discrepancy
+ // is divided up among the cols working Result.Left to Result.Right.
+ //
+ // Example: Total width = 113, col count = 5
+ // col 1 = 23
+ // col 2 = 23
+ // col 3 = 23
+ // col 4 = 22
+ // col 5 = 22
+ // Total = 113
+ //
+ // As opposed to:
+ // width of all cols = Total div colcount = 22
+ // ==> Total = 22 * 5 = 110 [110 <> 113]
+ Base := GridColWidth div MapColCount;
+ MakeUp := GridColWidth mod MapColCount;
+
+ MakeUpWidth := Lesser(MapCol - 1, MakeUp) * (Base + 1);
+ BaseCount := MapCol - 1 - MakeUp;
+ if BaseCount > 0 then
+ BaseWidth := BaseCount * Base
+ else
+ BaseWidth := 0;
+
+ ApptWidth := Base;
+ if MapCol <= MakeUp then
+ Inc(ApptWidth);
+
+ Result.Left := VirtCellRect.Left + MakeUpWidth + BaseWidth;
+ Result.Right := Result.Left + ApptWidth - ApptBuffer;
+ Result.Top := VirtCellRect.Top;
+ Result.Bottom := VirtualCellRect(Col, EndRow).Bottom;
+end;
+
+function TJvTFDays.LocateDivCol(X, TotalWidth, SegCount: Integer): Integer;
+var
+ Base, MakeUp, ApproxSeg, MakeUpWidth: Integer;
+ BaseCount, BaseWidth, SegWidth, NextSegStart: Integer;
+begin
+ if X <= 0 then
+ Result := 1
+ else
+ if X >= TotalWidth then
+ Result := SegCount
+ else
+ begin
+ Base := TotalWidth div SegCount;
+ // Protect against div by zero
+ if Base < 1 then
+ Base := 1;
+ MakeUp := TotalWidth mod SegCount;
+
+ ApproxSeg := X div Base;
+
+ MakeUpWidth := Lesser(ApproxSeg - 1, MakeUp) * (Base + 1);
+ BaseCount := ApproxSeg - 1 - MakeUp;
+ if BaseCount > 0 then
+ BaseWidth := BaseCount * Base
+ else
+ BaseWidth := 0;
+
+ SegWidth := Base;
+ if ApproxSeg <= MakeUp then
+ Inc(SegWidth);
+
+ NextSegStart := MakeUpWidth + BaseWidth + SegWidth;
+ if X < NextSegStart then
+ Result := ApproxSeg
+ else
+ Result := ApproxSeg + 1;
+ end;
+end;
+
+procedure TJvTFDays.EditAppt(Col: Integer; Appt: TJvTFAppt);
+var
+ Schedule: TJvTFSched;
+ ApptRect, EditorRect: TRect;
+ // EditHeightThreshold, EditWidthThreshold: Integer;
+ FailEditor: Boolean;
+ PicsHeight, PicsWidth, FrameOffset: Integer;
+ DrawList: TList;
+ CanDrawText, CanDrawPics: Boolean;
+ DrawInfo: TJvTFDaysApptDrawInfo;
+ AllowEdit: Boolean;
+begin
+ FEditor.QuickCreate := False;
+ EnsureCol(Col);
+ Schedule := Cols[Col].Schedule;
+ if not Assigned(Schedule) or not Assigned(Appt) or
+ not (agoEditing in Options) or not CanEdit then
+ Exit;
+
+ AllowEdit := True;
+ if Assigned(FOnBeginEdit) then
+ FOnBeginEdit(Self, Appt, AllowEdit);
+ if not AllowEdit then
+ Exit;
+
+ DrawInfo := TJvTFDaysApptDrawInfo.Create;
+ try
+ GetApptDrawInfo(DrawInfo, Appt, SelApptAttr);
+ FrameOffset := DrawInfo.FrameWidth div 2 * 2;
+ Canvas.Font := DrawInfo.Font;
+ FEditor.Font := DrawInfo.Font;
+ FEditor.Color := DrawInfo.Color;
+ finally
+ DrawInfo.Free;
+ end;
+
+ ApptRect := GetApptRect(Col, Appt);
+
+ InflateRect(ApptRect, -FrameOffset, -FrameOffset);
+
+ if ApptBar.Visible then
+ Inc(ApptRect.Left, ApptBar.Width);
+
+ AdjustForMargins(ApptRect);
+
+ DrawList := TList.Create;
+ try
+ CreatePicDrawList(ApptRect, Appt, DrawList);
+ FilterPicDrawList(ApptRect, DrawList, PicsHeight, PicsWidth);
+ CanDrawWhat(Canvas, ApptRect, PicsHeight, CanDrawText, CanDrawPics);
+ finally
+ ClearPicDrawList(DrawList);
+ DrawList.Free;
+ end;
+
+ if CanDrawPics then
+ Inc(ApptRect.Left, PicsHeight);
+
+ IntersectRect(EditorRect, GetDataAreaRect, ApptRect);
+
+// Commented out by Tim - No longer required since no editor failure.
+// EditHeightThreshold := CanvasMaxTextHeight(Canvas) * Thresholds.EditHeight;
+// EditWidthThreshold := Canvas.TextWidth('Bi') div 2 * Thresholds.EditWidth;
+
+// Commented out by Tim - The editor should no longer ever fail.
+// FailEditor := (RectHeight(EditorRect) < EditHeightThreshold) or
+// (RectWidth(EditorRect) < EditWidthThreshold);
+ FailEditor := False;
+
+ if FailEditor then
+ begin
+ if Assigned(FOnFailEditor) then
+ FOnFailEditor(Self, Col, Appt, EditorRect, FailEditor);
+ if not FailEditor then
+ FEditor.BorderStyle := bsSingle;
+ end
+ else
+ FEditor.BorderStyle := bsNone;
+
+ if not FailEditor then
+ with FEditor do
+ begin
+ FEditor.LinkedAppt := Appt;
+ BoundsRect := EditorRect;
+
+ if agoFormattedDesc in Options then
+ Text := Appt.Description
+ else
+ Text := StripCRLF(Appt.Description);
+
+ Self.Update; // not calling update here increases flicker
+ Visible := True;
+
+ if not (csDesigning in ComponentState) and CanFocus then
+ SetFocus;
+ SelLength := 0;
+ SelStart := 0;
+ end;
+end;
+
+procedure TJvTFDays.FinishEditAppt;
+begin
+ if Assigned(FEditor.LinkedAppt) then
+ FEditor.LinkedAppt.Description := FEditor.Text;
+ FEditor.Visible := False;
+end;
+
+function TJvTFDays.Editing: Boolean;
+begin
+ Result := (FEditor <> nil) and FEditor.Visible;
+end;
+
+function TJvTFDays.CanEdit: Boolean;
+begin
+ Result := agoShowText in Options;
+end;
+
+function TJvTFDays.RowsPerHour: Integer;
+begin
+ Result := 60 div Granularity;
+end;
+
+function TJvTFDays.RowCount: Integer;
+var
+ Adjustment, H, M, S, MS: Word;
+ WorkTime: TTime;
+begin
+ WorkTime := GridEndTime;
+
+ DecodeTime(WorkTime, H, M, S, MS);
+ Adjustment := 0;
+
+ if (H = 0) and (M = 0) then
+ begin
+ WorkTime := EncodeTime(23, 59, 59, 999);
+ Adjustment := 1;
+ end;
+
+ //DecodeTime(GridEndTime - GridStartTime, H, M, S, MS);
+ DecodeTime(WorkTime - GridStartTime, H, M, S, MS);
+ Result := (H * 60 + M) div Granularity + Adjustment;
+end;
+
+function TJvTFDays.PossVisibleRows: Integer;
+var
+ DataHt: Integer;
+begin
+ //group DataHt := GetAdjClientRect.Bottom - ColHdrHeight;
+ DataHt := GetAdjClientRect.Bottom - CalcGroupColHdrsHeight;
+ Result := DataHt div RowHeight;
+ if DataHt mod RowHeight <> 0 then
+ Inc(Result);
+end;
+
+function TJvTFDays.VisibleRows: Integer;
+begin
+ Result := Lesser(PossVisibleRows, RowCount - TopRow);
+end;
+
+function TJvTFDays.FullVisibleRows: Integer;
+var
+ Poss, Vis: Integer;
+begin
+ Poss := PossVisibleRows;
+ Vis := VisibleRows;
+
+ if Poss = Vis then
+ if GetDataHeight mod RowHeight = 0 then
+ Result := Vis
+ else
+ Result := Vis - 1
+ else
+ Result := Vis;
+end;
+
+function TJvTFDays.VisibleCols: Integer;
+var
+ DataWidth, ColNum, TempColWidths: Integer;
+begin
+ if Cols.Count > 0 then
+ begin
+ // Calc the width of the data area
+ DataWidth := GetDataWidth;
+
+ // loop through cols until sum of col widths is >= width of data area
+ TempColWidths := 0;
+ ColNum := LeftCol;
+ repeat
+ Inc(TempColWidths, Cols[ColNum].Width);
+ Inc(ColNum);
+ until (TempColWidths >= DataWidth) or (ColNum = Cols.Count);
+
+ Result := ColNum - LeftCol;
+ end
+ else
+ Result := 0;
+end;
+
+function TJvTFDays.FullVisibleCols: Integer;
+var
+ I, lRightCol, TempWidth: Integer;
+begin
+ // sum the widths of all visible cols
+ lRightCol := LeftCol + VisibleCols - 1;
+ TempWidth := 0;
+ for I := LeftCol to lRightCol do
+ Inc(TempWidth, Cols[I].Width);
+
+ // if TempWidth > Data width then fully vis cols = one less the visible cols
+ if TempWidth <= GetDataWidth then
+ Result := VisibleCols
+ else
+ Result := VisibleCols - 1;
+end;
+
+function TJvTFDays.RowToTime(RowNum: Integer): TTime;
+var
+ TotalMins: Integer;
+ WorkHours, WorkMins: Word;
+ H, M, S, MS: Word;
+ Offset: Integer;
+begin
+ EnsureRow(RowNum);
+
+ DecodeTime(GridStartTime, H, M, S, MS);
+ Offset := H * 60 + M;
+ TotalMins := RowNum * Granularity + Offset;
+
+ WorkHours := TotalMins div 60;
+ WorkMins := TotalMins mod 60;
+ if WorkHours < 24 then
+ Result := EncodeTime(WorkHours, WorkMins, 0, 0)
+ else
+ Result := EncodeTime(23, 59, 59, 999);
+end;
+
+function TJvTFDays.TimeToRow(ATime: TTime): Integer;
+var
+ TotalMins: Integer;
+ WorkHours, WorkMins, WorkSecs, WorkMSecs: Word;
+ H, M, S, MS: Word;
+ Offset: Integer;
+begin
+ DecodeTime(ATime, WorkHours, WorkMins, WorkSecs, WorkMSecs);
+
+ // Convert the given time to minutes
+ DecodeTime(GridStartTime, H, M, S, MS);
+ Offset := H * 60 + M;
+ TotalMins := WorkHours * 60 + WorkMins - Offset;
+
+ // Find the row number by dividing the time in minutes by the granularity
+ Result := TotalMins div Granularity;
+ if (TotalMins < 0) and (TotalMins mod Granularity <> 0) then
+ Dec(Result);
+end;
+
+procedure TJvTFDays.TimeToTop(ATime: TTime);
+begin
+ TopRow := TimeToRow(ATime);
+end;
+
+function TJvTFDays.AdjustEndTime(ATime: TTime): TTime;
+begin
+ Result := Frac(Frac(ATime) - Frac(EncodeTime(0, 0, 1, 0)));
+end;
+
+function TJvTFDays.RowStartsHour(RowNum: Integer): Boolean;
+var
+ H, M, S, MS: Word;
+begin
+ EnsureRow(RowNum);
+
+ DecodeTime(RowToTime(RowNum), H, M, S, MS);
+ Result := M = 0;
+end;
+
+function TJvTFDays.RowEndsHour(RowNum: Integer): Boolean;
+var
+ H, M, S, MS: Word;
+ TempTime: TTime;
+begin
+ EnsureRow(RowNum);
+
+ TempTime := RowToTime(RowNum) + EncodeTime(0, Granularity - 1, 0, 0);
+ DecodeTime(TempTime, H, M, S, MS);
+ Result := M = 59;
+end;
+
+function TJvTFDays.RowEndTime(RowNum: Integer): TTime;
+begin
+ Result := RowToTime(RowNum) +
+ Granularity * EncodeTime(0, 1, 0, 0) - EncodeTime(0, 0, 1, 0);
+end;
+
+function TJvTFDays.RowToHour(RowNum: Integer): Word;
+var
+ H, M, S, MS: Word;
+begin
+ DecodeTime(RowToTime(RowNum), H, M, S, MS);
+ Result := H;
+end;
+
+function TJvTFDays.HourStartRow(Hour: Word): Integer;
+begin
+ Result := TimeToRow(EncodeTime(Hour, 0, 0, 0));
+end;
+
+function TJvTFDays.HourEndRow(Hour: Word): Integer;
+begin
+ Result := TimeToRow(EncodeTime(Hour, 59, 0, 0));
+end;
+
+function TJvTFDays.BottomRow: Integer;
+begin
+ Result := TopRow + VisibleRows - 1;
+end;
+
+function TJvTFDays.RightCol: Integer;
+begin
+ Result := LeftCol + VisibleCols - 1;
+end;
+
+procedure TJvTFDays.DragDrop(Source: TObject; X, Y: Integer);
+begin
+ if Source is TJvTFControl then
+ DropAppt(TJvTFControl(Source).DragInfo, X, Y);
+
+ inherited DragDrop(Source, X, Y);
+end;
+
+procedure TJvTFDays.CalcStartEndRows(AAppt: TJvTFAppt; SchedDate: TDate;
+ var StartRow, EndRow: Integer);
+begin
+ if Trunc(AAppt.StartDate) = Trunc(SchedDate) then
+ StartRow := TimeToRow(AAppt.StartTime)
+ else
+ StartRow := 0;
+
+ if Trunc(AAppt.EndDate) = Trunc(SchedDate) then
+ EndRow := TimeToRow(AdjustEndTime(AAppt.EndTime))
+ else
+ EndRow := RowCount - 1;
+end;
+
+procedure TJvTFDays.PrevDate;
+begin
+ case Template.ActiveTemplate of
+ agtLinear:
+ Template.LinearStartDate := Template.LinearStartDate - 1;
+ agtComparative:
+ Template.CompDate := Template.CompDate - 1;
+ end;
+end;
+
+procedure TJvTFDays.NextDate;
+begin
+ case Template.ActiveTemplate of
+ agtLinear:
+ Template.LinearStartDate := Template.LinearStartDate + 1;
+ agtComparative:
+ Template.CompDate := Template.CompDate + 1;
+ end;
+end;
+
+procedure TJvTFDays.GotoDate(aDate: TDate);
+begin
+ case Template.ActiveTemplate of
+ agtLinear:
+ Template.LinearStartDate := aDate;
+ agtComparative:
+ Template.CompDate := aDate;
+ end;
+end;
+
+procedure TJvTFDays.ScrollDays(NumDays: Integer);
+var
+ OldDate: TDate;
+ CanScroll: Boolean;
+begin
+ CanScroll := True;
+ OldDate := Template.LinearStartDate;
+ case Template.ActiveTemplate of
+ agtLinear:
+ OldDate := Template.LinearStartDate;
+ agtComparative:
+ OldDate := Template.CompDate;
+ else
+ CanScroll := False;
+ end;
+
+ if CanScroll then
+ GotoDate(OldDate + NumDays);
+end;
+
+procedure TJvTFDays.ScrollMonths(NumMonths: Integer);
+var
+ OldDate, EOM: TDate;
+ CanScroll: Boolean;
+ Y, M, D, EOMY, EOMM, EOMD, DeltaY, DeltaM: Word;
+begin
+ CanScroll := True;
+ OldDate := Template.LinearStartDate;
+ case Template.ActiveTemplate of
+ agtLinear: OldDate := Template.LinearStartDate;
+ agtComparative: OldDate := Template.CompDate;
+ else
+ CanScroll := False;
+ end;
+
+ if CanScroll then
+ begin
+ DecodeDate(OldDate, Y, M, D);
+
+ DeltaY := NumMonths div 12;
+ DeltaM := NumMonths mod 12;
+ M := M + DeltaM;
+ if M < 1 then
+ begin
+ Dec(DeltaY);
+ M := 12 + M;
+ end
+ else
+ if M > 12 then
+ begin
+ Inc(DeltaY);
+ M := M - 12;
+ end;
+
+ Y := Y + DeltaY;
+ EOM := EndOfMonth(EncodeDate(Y, M, 1));
+ DecodeDate(EOM, EOMY, EOMM, EOMD);
+ D := Lesser(D, EOMD);
+ GotoDate(EncodeDate(Y, M, D));
+ end;
+end;
+
+procedure TJvTFDays.ScrollYears(NumYears: Integer);
+var
+ OldDate, EOM: TDate;
+ Y, M, D, EOMY, EOMM, EOMD: Word;
+ CanScroll: Boolean;
+begin
+ CanScroll := True;
+ OldDate := Template.LinearStartDate;
+ case Template.ActiveTemplate of
+ agtLinear:
+ OldDate := Template.LinearStartDate;
+ agtComparative:
+ OldDate := Template.CompDate;
+ else
+ CanScroll := False;
+ end;
+
+ if CanScroll then
+ begin
+ DecodeDate(OldDate, Y, M, D);
+ Inc(Y, NumYears);
+ EOM := EndOfMonth(EncodeDate(Y, M, 1));
+ DecodeDate(EOM, EOMY, EOMM, EOMD);
+ D := Lesser(D, EOMD);
+ GotoDate(EncodeDate(Y, M, D));
+ end;
+end;
+
+procedure TJvTFDays.ReleaseSchedule(const SchedName: string; SchedDate: TDate);
+var
+ Used: Boolean;
+ I: Integer;
+ Col: TJvTFDaysCol;
+begin
+ // Only release schedule if not used by any grid cols
+ Used := False;
+ for I := 0 to Cols.Count - 1 do
+ begin
+ Col := Cols[I];
+ if (Col.SchedName = SchedName) and
+ (Trunc(Col.SchedDate) = Trunc(SchedDate)) and Col.Connected then
+ Used := True and not (csDestroying in ScheduleManager.ComponentState);
+ end;
+
+ if not Used then
+ inherited ReleaseSchedule(SchedName, SchedDate);
+end;
+
+procedure TJvTFDays.RowInView(ARow: Integer);
+begin
+ EnsureRow(ARow);
+
+ if ARow < TopRow then
+ TopRow := ARow
+ else
+ if ARow > TopRow + FullVisibleRows - 1 then
+ TopRow := Greater(ARow - FullVisibleRows + 1, 0);
+end;
+
+procedure TJvTFDays.ColInView(ACol: Integer);
+var
+ I, ColSizes: Integer;
+ DataWidth: Integer;
+begin
+ EnsureCol(ACol);
+
+ if ACol < LeftCol then
+ LeftCol := ACol
+ else
+ if ACol > RightCol then
+ begin
+ ColSizes := 0;
+ DataWidth := RectWidth(GetDataAreaRect);
+ I := ACol + 1;
+ while (ColSizes < DataWidth) and (I >= 0) do
+ begin
+ Dec(I);
+ Inc(ColSizes, Cols[I].Width);
+ end;
+ LeftCol := I + 1;
+ end;
+end;
+
+function TJvTFDays.CellIsSelected(ACell: TPoint): Boolean;
+var
+ SelSameName, SelSameDate: Boolean;
+ NameList: TStringList;
+ I, TestStart, TestEnd: Integer;
+ TestDate: TDate;
+
+ function PointInDataArea(APoint: TPoint): Boolean;
+ begin
+ Result := (APoint.X > gcHdr) and (APoint.Y > gcHdr);
+ end;
+
+begin
+ Result := False;
+ if PointInDataArea(SelStart) and PointInDataArea(SelEnd) and PointInDataArea(ACell) then
+ begin
+ SelSameName := Cols[SelStart.X].SchedName = Cols[SelEnd.X].SchedName;
+ SelSameDate := Trunc(Cols[SelStart.X].SchedDate) =
+ Trunc(Cols[SelEnd.X].SchedDate);
+
+ if SelSameName and SelSameDate then
+ begin
+ if (Cols[ACell.X].SchedName = Cols[SelStart.X].SchedName) and
+ (Trunc(Cols[ACell.X].SchedDate) = Trunc(Cols[SelStart.X].SchedDate)) then
+ Result := (ACell.Y >= SelStart.Y) and (ACell.Y <= SelEnd.Y)
+ end
+ else
+ if SelSameName then
+ begin
+ if Cols[ACell.X].SchedName = Cols[SelStart.X].SchedName then
+ begin
+ TestDate := Cols[ACell.X].SchedDate;
+ if Trunc(TestDate) = Trunc(Cols[SelStart.X].SchedDate) then
+ Result := ACell.Y >= SelStart.Y
+ else
+ if (Trunc(TestDate) > Trunc(Cols[SelStart.X].SchedDate)) and
+ (Trunc(TestDate) < Trunc(Cols[SelEnd.X].SchedDate)) then
+ Result := True
+ else
+ if Trunc(TestDate) = Trunc(Cols[SelEnd.X].SchedDate) then
+ Result := ACell.Y <= SelEnd.Y;
+ end
+ end
+ else
+ if SelSameDate then
+ begin
+ NameList := TStringList.Create;
+ NameList.Sorted := True;
+ NameList.Duplicates := dupIgnore;
+
+ try
+ for I := SelStart.X to SelEnd.X do
+ NameList.Add(Cols[I].SchedName);
+
+ if (NameList.IndexOf(Cols[ACell.X].SchedName) > -1) and
+ (Trunc(Cols[SelStart.X].SchedDate) = Trunc(Cols[ACell.X].SchedDate)) then
+ begin
+ TestStart := Lesser(SelStart.Y, SelEnd.Y);
+ TestEnd := Greater(SelStart.Y, SelEnd.Y);
+ Result := (ACell.Y >= TestStart) and (ACell.Y <= TestEnd);
+ end;
+ finally
+ NameList.Free;
+ end;
+ end;
+ end;
+end;
+
+function TJvTFDays.ColIsSelected(ACol: Integer): Boolean;
+var
+ SelSameName, SelSameDate: Boolean;
+ I: Integer;
+ StartCol, EndCol, TestCol: TJvTFDaysCol;
+begin
+ Result := False;
+ if (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then
+ // Don't know if we really should be doing the follow check
+ //and (ACol >= SelStart.X) and (ACol <= SelEnd.X) then
+ begin
+ // Determine type of selection (case)
+ StartCol := Cols[SelStart.X];
+ EndCol := Cols[SelEnd.X];
+ TestCol := Cols[ACol];
+
+ SelSameName := StartCol.SchedName = EndCol.SchedName;
+ SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate);
+
+ if SelSameName and SelSameDate then
+ Result := (TestCol.SchedName = StartCol.SchedName) and
+ (Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate))
+ else
+ if SelSameName then
+ Result := (TestCol.SchedName = StartCol.SchedName) and
+ (Trunc(TestCol.SchedDate) >= Trunc(StartCol.SchedDate)) and
+ (Trunc(TestCol.SchedDate) <= Trunc(EndCol.SchedDate))
+ else
+ if SelSameDate then
+ if Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate) then
+ begin
+ I := SelStart.X;
+ while (I <= SelEnd.X) and not Result do
+ if TestCol.SchedName = Cols[I].SchedName then
+ Result := True
+ else
+ Inc(I);
+ end;
+ end;
+end;
+
+function TJvTFDays.RowIsSelected(ARow: Integer): Boolean;
+var
+ SelSameName, SelSameDate: Boolean;
+ StartCol, EndCol: TJvTFDaysCol;
+begin
+ Result := False;
+ if (SelStart.Y > gcHdr) and (SelEnd.Y > gcHdr) and
+ (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then
+ begin
+ StartCol := Cols[SelStart.X];
+ EndCol := Cols[SelEnd.X];
+
+ SelSameName := StartCol.SchedName = EndCol.SchedName;
+ SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate);
+
+ if (SelSameName and SelSameDate) or SelSameDate then
+ Result := (ARow >= SelStart.Y) and (ARow <= SelEnd.Y)
+ else
+ if SelSameName then
+ Result := (ARow >= SelStart.Y) or (ARow <= SelEnd.Y);
+ end;
+end;
+
+procedure TJvTFDays.ClearSelection;
+begin
+ SelStart := Point(-1, -1);
+end;
+
+function TJvTFDays.ValidSelection: Boolean;
+begin
+ Result := (SelStart.X > gcHdr) and (SelStart.Y > gcHdr) and
+ (SelEnd.X > gcHdr) and (SelEnd.Y > gcHdr);
+end;
+
+function TJvTFDays.EnumSelCells: TDynPointArray;
+var
+ SelSameName, SelSameDate: Boolean;
+ NameList: TStringList;
+ NextEntry, ACol, ARow: Integer;
+ TestDate: TDate;
+
+ procedure AddToArray(X, Y: Integer);
+ begin
+ Result[NextEntry] := Point(X, Y);
+ Inc(NextEntry);
+ end;
+
+ procedure BumpLength(Bump: Integer);
+ begin
+ SetLength(Result, Length(Result) + Bump);
+ end;
+
+begin
+ SetLength(Result, 0);
+ NextEntry := 0;
+
+ // EXIT IF NOTHING SELECTED
+ if (SelStart.X <= gcHdr) or (SelStart.Y <= gcHdr) or
+ (SelEnd.X <= gcHdr) or (SelEnd.Y <= gcHdr) then
+ Exit;
+
+ SelSameName := Cols[SelStart.X].SchedName = Cols[SelEnd.X].SchedName;
+ SelSameDate := Trunc(Cols[SelStart.X].SchedDate) =
+ Trunc(Cols[SelEnd.X].SchedDate);
+
+ if SelSameName and SelSameDate then
+ for ACol := 0 to Cols.Count - 1 do
+ begin
+ if (Cols[ACol].SchedName = Cols[SelStart.X].SchedName) and
+ (Trunc(Cols[ACol].SchedDate) = Trunc(Cols[SelStart.X].SchedDate)) then
+ begin
+ BumpLength(SelEnd.Y - SelStart.Y + 1);
+ for ARow := SelStart.Y to SelEnd.Y do
+ AddToArray(ACol, ARow);
+ end;
+ end
+ else
+ if SelSameName then
+ // only have to go to SelEnd.X??
+ // What about if two cols have same SchedName and SchedDate??
+ for ACol := 0 to Cols.Count - 1 do
+ begin
+ if Cols[ACol].SchedName = Cols[SelStart.X].SchedName then
+ begin
+ TestDate := Cols[ACol].SchedDate;
+
+ if Trunc(TestDate) = Trunc(Cols[SelStart.X].SchedDate) then
+ begin
+ BumpLength(RowCount - SelStart.Y);
+ for ARow := SelStart.Y to RowCount - 1 do
+ AddToArray(ACol, ARow);
+ end
+ else
+ if (Trunc(TestDate) > Trunc(Cols[SelStart.X].SchedDate)) and
+ (Trunc(TestDate) < Trunc(Cols[SelEnd.X].SchedDate)) then
+ begin
+ BumpLength(RowCount);
+ for ARow := 0 to RowCount - 1 do
+ AddToArray(ACol, ARow);
+ end
+ else
+ if Trunc(TestDate) = Trunc(Cols[SelEnd.X].SchedDate) then
+ begin
+ BumpLength(SelEnd.Y + 1);
+ for ARow := 0 to SelEnd.Y do
+ AddToArray(ACol, ARow);
+ end;
+ end;
+ end
+ else
+ if SelSameDate then
+ begin
+ NameList := TStringList.Create;
+ NameList.Sorted := True;
+ NameList.Duplicates := dupIgnore;
+ TestDate := Cols[SelStart.X].SchedDate;
+
+ try
+ for ACol := SelStart.X to SelEnd.X do
+ NameList.Add(Cols[ACol].SchedName);
+
+ for ACol := 0 to Cols.Count - 1 do
+ if (NameList.IndexOf(Cols[ACol].SchedName) > -1) and
+ (Trunc(Cols[ACol].SchedDate) = Trunc(TestDate)) then
+ begin
+ BumpLength(SelEnd.Y - SelStart.Y + 1);
+ for ARow := SelStart.Y to SelEnd.Y do
+ AddToArray(ACol, ARow);
+ end;
+ finally
+ NameList.Free;
+ end;
+ end;
+end;
+
+function TJvTFDays.EnumSelCols: TDynIntArray;
+var
+ SelSameName, SelSameDate: Boolean;
+ I: Integer;
+ TempList: TStringList;
+ StartCol, EndCol, TestCol: TJvTFDaysCol;
+
+ procedure AddToArray(ACol: Integer);
+ begin
+ SetLength(Result, Length(Result) + 1);
+ Result[Length(Result) - 1] := ACol;
+ end;
+
+begin
+ SetLength(Result, 0);
+
+ if (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then
+ begin
+ StartCol := Cols[SelStart.X];
+ EndCol := Cols[SelEnd.X];
+
+ SelSameName := StartCol.SchedName = EndCol.SchedName;
+ SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate);
+
+ if SelSameName and SelSameDate then
+ for I := 0 to Cols.Count - 1 do
+ begin
+ TestCol := Cols[I];
+ if (TestCol.SchedName = StartCol.SchedName) and
+ (Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate)) then
+ AddToArray(I);
+ end
+ else
+ if SelSameName then
+ for I := 0 to Cols.Count - 1 do
+ begin
+ TestCol := Cols[I];
+ if (TestCol.SchedName = StartCol.SchedName) and
+ ((Trunc(TestCol.SchedDate) >= Trunc(StartCol.SchedDate)) and
+ (Trunc(TestCol.SchedDate) <= Trunc(EndCol.SchedDate))) then
+ AddToArray(I);
+ end
+ else
+ if SelSameDate then
+ begin
+ TempList := TStringList.Create;
+ TempList.Sorted := True;
+ TempList.Duplicates := dupIgnore;
+
+ try
+ for I := SelStart.X to SelEnd.X do
+ TempList.Add(Cols[I].SchedName);
+
+ for I := 0 to Cols.Count - 1 do
+ begin
+ TestCol := Cols[I];
+ if (Trunc(TestCol.SchedDate) = Trunc(StartCol.SchedDate)) and
+ (TempList.IndexOf(TestCol.SchedName) > -1) then
+ AddToArray(I);
+ end;
+ finally
+ TempList.Free;
+ end;
+ end;
+ end;
+end;
+
+function TJvTFDays.EnumSelRows: TDynIntArray;
+var
+ SelSameName, SelSameDate: Boolean;
+ StartCol, EndCol: TJvTFDaysCol;
+ I: Integer;
+
+ procedure AddToArray(ACol: Integer);
+ begin
+ SetLength(Result, Length(Result) + 1);
+ Result[Length(Result) - 1] := ACol;
+ end;
+
+begin
+ SetLength(Result, 0);
+
+ if (SelStart.Y > gcHdr) and (SelEnd.Y > gcHdr) and
+ (SelStart.X > gcHdr) and (SelEnd.X > gcHdr) then
+ begin
+ StartCol := Cols[SelStart.X];
+ EndCol := Cols[SelEnd.X];
+
+ SelSameName := StartCol.SchedName = EndCol.SchedName;
+ SelSameDate := Trunc(StartCol.SchedDate) = Trunc(EndCol.SchedDate);
+
+ if (SelSameName and SelSameDate) or SelSameDate then
+ for I := SelStart.Y to SelEnd.Y do
+ AddToArray(I)
+ else
+ if SelSameName then
+ for I := 0 to RowCount - 1 do
+ if (I >= SelStart.Y) or (I <= SelEnd.Y) then
+ AddToArray(I);
+ end;
+end;
+
+function TJvTFDays.GetApptDispColor(Appt: TJvTFAppt; Selected: Boolean): TColor;
+begin
+ if Selected then
+ if SelApptAttr.Color = clDefault then
+ if Appt.Color = clDefault then
+ Result := ApptAttr.Color
+ else
+ Result := Appt.Color
+ else
+ Result := SelApptAttr.Color
+ else
+ if Appt.Color = clDefault then
+ Result := ApptAttr.Color
+ else
+ Result := Appt.Color;
+end;
+
+procedure TJvTFDays.ReqSchedNotification(Schedule: TJvTFSched);
+var
+ I: Integer;
+ Col: TJvTFDaysCol;
+begin
+ inherited ReqSchedNotification(Schedule);
+
+ for I := 0 to Cols.Count - 1 do
+ begin
+ Col := Cols[I];
+ if (Col.SchedName = Schedule.SchedName) and
+ (Trunc(Col.SchedDate) = Trunc(Schedule.SchedDate)) then
+ Col.Connect;
+ end;
+end;
+
+procedure TJvTFDays.SelFirstAppt;
+var
+ FirstAppt: TJvTFAppt;
+ RefCol: Integer;
+begin
+ RefCol := 0;
+ FirstAppt := nil;
+
+ while not Assigned(FirstAppt) and (RefCol < Cols.Count) do
+ begin
+ FirstAppt := Cols[RefCol].GetFirstAppt;
+ Inc(RefCol);
+ end;
+
+ if Assigned(FirstAppt) then
+ begin
+ SelAppt := FirstAppt;
+ // The actual Reference Col will be one less than RefCol coming out of
+ // the above loop.
+ ApptInView(FirstAppt, RefCol - 1);
+ SelApptCell(FirstAppt, RefCol - 1);
+ end;
+end;
+
+procedure TJvTFDays.SelLastAppt;
+var
+ LastAppt: TJvTFAppt;
+ RefCol: Integer;
+begin
+ RefCol := Cols.Count - 1;
+ LastAppt := nil;
+
+ while not Assigned(LastAppt) and (RefCol > -1) do
+ begin
+ LastAppt := Cols[RefCol].GetLastAppt;
+ Dec(RefCol);
+ end;
+
+ if Assigned(LastAppt) then
+ begin
+ SelAppt := LastAppt;
+ ApptInView(LastAppt, RefCol + 1);
+ SelApptCell(LastAppt, RefCol + 1);
+ end;
+
+{
+ if Cols.Count > 0 then
+ LastAppt := Cols[Cols.Count - 1].GetLastAppt;
+
+ if not Assigned(LastAppt) and (Cols.Count > 1) then
+ begin
+ RefCol := Cols.Count - 2;
+ while not Assigned(LastAppt) and (RefCol >= 0) do
+ begin
+ LastAppt := Cols[RefCol].GetLastAppt;
+ Dec(RefCol);
+ end;
+ if Assigned(LastAppt) then
+ Inc(RefCol);
+ end;
+
+ SelAppt := LastAppt;
+ ApptInView(LastAppt, RefCol);
+ SelApptCell(LastAppt, RefCol);
+}
+end;
+
+procedure TJvTFDays.SelNextAppt;
+var
+ RefAppt, NextAppt: TJvTFAppt;
+ RefCol: Integer;
+begin
+ RefAppt := SelAppt;
+ RefCol := FocusedCol;
+ if RefCol < 0 then
+ RefCol := 0;
+
+ NextAppt := nil;
+ while not Assigned(NextAppt) and (RefCol < Cols.Count) do
+ begin
+ NextAppt := Cols[RefCol].GetNextAppt(RefAppt);
+ Inc(RefCol);
+ end;
+
+ if Assigned(NextAppt) then
+ begin
+ SelAppt := NextAppt;
+ ApptInView(NextAppt, RefCol - 1);
+ SelApptCell(NextAppt, RefCol - 1);
+ end;
+
+{
+ RefAppt := SelAppt;
+ RefCol := Greater(FocusedCol, 0);
+
+ if Assigned(RefAppt) then
+ NextAppt := Cols[RefCol].GetNextAppt(RefAppt)
+ else
+ NextAppt := Cols[RefCol].GetFirstAppt;
+
+ if not Assigned(NextAppt) then
+ begin
+ NextCol := RefCol + 1;
+ if NextCol = Cols.Count then
+ NextCol := 0;
+
+ while not Assigned(NextAppt) and (NextCol <> RefCol) do
+ begin
+ NextAppt := Cols[NextCol].GetFirstAppt;
+ if not Assigned(NextAppt) then
+ begin
+ Inc(NextCol);
+ if NextCol = Cols.Count then
+ NextCol := 0;
+ end;
+ end;
+ RefCol := NextCol;
+ end;
+
+ SelAppt := NextAppt;
+ ApptInView(NextAppt, RefCol);
+ SelApptCell(NextAppt, RefCol);
+}
+end;
+
+procedure TJvTFDays.SelPrevAppt;
+var
+ RefAppt, PrevAppt: TJvTFAppt;
+ RefCol: Integer;
+begin
+ RefAppt := SelAppt;
+ RefCol := FocusedCol;
+ if RefCol < 0 then
+ RefCol := Cols.Count - 1;
+
+ PrevAppt := nil;
+ while not Assigned(PrevAppt) and (RefCol > -1) do
+ begin
+ PrevAppt := Cols[RefCol].GetPrevAppt(RefAppt);
+ Dec(RefCol);
+ end;
+
+ if Assigned(PrevAppt) then
+ begin
+ SelAppt := PrevAppt;
+ ApptInView(PrevAppt, RefCol + 1);
+ SelApptCell(PrevAppt, RefCol + 1);
+ end;
+
+{
+ if Assigned(RefAppt) then
+ PrevAppt := Cols[RefCol].GetPrevAppt(RefAppt)
+ else
+ PrevAppt := Cols[RefCol].GetFirstAppt;
+
+ if not Assigned(PrevAppt) then
+ begin
+ PrevCol := RefCol - 1;
+ if PrevCol = -1 then
+ PrevCol := Cols.Count - 1;
+
+ while not Assigned(PrevAppt) and (PrevCol <> RefCol) do
+ begin
+ PrevAppt := Cols[PrevCol].GetLastAppt;
+ if not Assigned(PrevAppt) then
+ begin
+ Dec(PrevCol);
+ if PrevCol = -1 then
+ PrevCol := Cols.Count - 1;
+ end;
+ end;
+
+ RefCol := PrevCol;
+ end;
+
+ SelAppt := PrevAppt;
+ ApptInView(PrevAppt, RefCol);
+ SelApptCell(PrevAppt, RefCol);
+}
+end;
+
+procedure TJvTFDays.ApptInView(AAppt: TJvTFAppt; ACol: Integer);
+var
+ StartRow, EndRow: Integer;
+begin
+ if Assigned(AAppt) and Assigned(Cols[ACol].Schedule) then
+ begin
+ CalcStartEndRows(AAppt, Cols[ACol].Schedule.SchedDate, StartRow, EndRow);
+ RowInView(StartRow);
+ ColInView(ACol);
+ //TopRow := StartRow;
+ //LeftCol := ACol;
+ end;
+end;
+
+procedure TJvTFDays.SelApptCell(AAppt: TJvTFAppt; ACol: Integer);
+var
+ StartRow, EndRow: Integer;
+begin
+ if Assigned(AAppt) and Assigned(Cols[ACol].Schedule) and
+ (Cols[ACol].Schedule.ApptByID(AAppt.ID) <> nil) then
+ begin
+ CalcStartEndRows(AAppt, Cols[ACol].Schedule.SchedDate, StartRow, EndRow);
+ SelStart := Point(ACol, StartRow);
+ FocusedCol := ACol;
+ FocusedRow := StartRow;
+ end;
+end;
+
+procedure TJvTFDays.SetGrouping(Value: TJvTFDaysGrouping);
+var
+ CheckSB: Boolean;
+begin
+ if Value <> FGrouping then
+ begin
+ CheckSB := (Value = grNone) or (FGrouping = grNone);
+ FGrouping := Value;
+ Cols.UpdateTitles;
+ if CheckSB then
+ begin
+ AlignScrollBars;
+ if not (csLoading in ComponentState) then
+ begin
+ CheckSBVis;
+ CheckSBParams;
+ end;
+ end;
+ Invalidate;
+ end;
+end;
+
+{
+procedure TJvTFDays.SetGroupTitles;
+var
+ I: Integer;
+begin
+ Case Grouping of
+ grNone :
+ For I := 0 to Cols.Count - 1 do
+ begin
+ Cols[I].GroupTitle := '';
+ //Cols[I].UpdateTitle;
+ Cols[I].UpdateTitles;
+ end;
+ grDate :
+ For I := 0 to Cols.Count - 1 do
+ begin
+ Cols[I].GroupTitle := FormatDateTime(DateFormat, Cols[I].SchedDate);
+ Cols[I].Title := Cols[I].SchedName;
+ end;
+ grResource :
+ For I := 0 to Cols.Count - 1 do
+ begin
+ Cols[I].GroupTitle := Cols[I].SchedName;
+ Cols[I].Title := FormatDateTime(DateFormat, Cols[I].SchedDate);
+ end;
+ grCustom :
+ For I := 0 to Cols.Count - 1 do
+ begin
+ Cols[I].GroupTitle := '';
+ end;
+ end;
+end;
+}
+
+procedure TJvTFDays.SetTFHintProps(Value: TJvTFHintProps);
+begin
+ FHintProps.Assign(Value);
+end;
+
+procedure TJvTFDays.DrawDither(ACanvas: TCanvas; ARect: TRect;
+ Color1, Color2: TColor);
+var
+ DitherBitmap: TBitmap;
+ I, J: Integer;
+// TL: TPoint;
+// ClipRgn: HRgn;
+begin
+ DitherBitmap := TBitmap.Create;
+ try
+ // create dithered bitmap
+// DitherBitmap.Width := RectWidth(ARect);
+// DitherBitmap.Height := RectHeight(ARect);
+ DitherBitmap.Width := 8;
+ DitherBitmap.Height := 8;
+ for I := 0 to DitherBitmap.Width - 1 do
+ for J := 0 to DitherBitmap.Height - 1 do
+ if (I + J) mod 2 = 0 then
+ DitherBitmap.Canvas.Pixels[I, J] := Color1
+ else
+ DitherBitmap.Canvas.Pixels[I, J] := Color2;
+
+ // copy bitmap into canvas
+// ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top, ARect.Right + 1, ARect.Bottom + 1);
+// try
+// Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);
+// TL.X := ARect.Left;
+// while (TL.X <= ARect.Right) do
+// begin
+// TL.Y := ARect.Top;
+// while (TL.Y <= ARect.Bottom) do
+// begin
+// Windows.BitBlt(ACanvas.Handle, TL.X, TL.Y, DitherBitmap.Width, DitherBitmap.Height,
+// DitherBitmap.Canvas.Handle, 0, 0, SRCCOPY);
+// TL.Y := TL.Y + DitherBitmap.Height;
+// end;
+// TL.X := TL.X + DitherBitmap.Width;
+// end;
+// finally
+// Windows.SelectClipRgn(ACanvas.Handle, 0);
+// Windows.DeleteObject(ClipRgn);
+// end;
+
+ ACanvas.Brush.Bitmap := DitherBitmap;
+ ACanvas.FillRect(ARect);
+
+// Windows.BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, DitherBitmap.Width, DitherBitmap.Height,
+// DitherBitmap.Canvas.Handle, 0, 0, SRCCOPY);
+ finally
+ DitherBitmap.Free;
+ end;
+end;
+
+procedure TJvTFDays.SelFirstApptNextCol;
+var
+ FirstAppt: TJvTFAppt;
+ RefCol: Integer;
+begin
+ RefCol := FocusedCol + 1;
+ FirstAppt := nil;
+
+ while not Assigned(FirstAppt) and (RefCol < Cols.Count) do
+ begin
+ FirstAppt := Cols[RefCol].GetFirstAppt;
+ Inc(RefCol);
+ end;
+
+ if Assigned(FirstAppt) then
+ begin
+ SelAppt := FirstAppt;
+ // The actual Reference Col will be one less than RefCol coming out of
+ // the above loop.
+ ApptInView(FirstAppt, RefCol - 1);
+ SelApptCell(FirstAppt, RefCol - 1);
+ end;
+end;
+
+procedure TJvTFDays.SelFirstApptPrevCol;
+var
+ FirstAppt: TJvTFAppt;
+ RefCol: Integer;
+begin
+ if Cols.Count = 0 then
+ Exit;
+
+ RefCol := FocusedCol - 1;
+ if RefCol < 0 then
+ RefCol := 0;
+ FirstAppt := nil;
+
+ while not Assigned(FirstAppt) and (RefCol > -1) do
+ begin
+ FirstAppt := Cols[RefCol].GetFirstAppt;
+ Dec(RefCol);
+ end;
+
+ if Assigned(FirstAppt) then
+ begin
+ SelAppt := FirstAppt;
+ ApptInView(FirstAppt, RefCol + 1);
+ SelApptCell(FirstAppt, RefCol + 1);
+ end;
+end;
+
+procedure TJvTFDays.SetGroupHdrHeight(Value: Integer);
+begin
+ if Value > RectHeight(GetAdjClientRect) then
+ Value := RectHeight(GetAdjClientRect);
+ if Value < 0 then
+ Value := 0;
+
+ if Value <> FGroupHdrHeight then
+ begin
+ FGroupHdrHeight := Value;
+ AlignScrollBars;
+ if not (csLoading in ComponentState) then
+ begin
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.DrawGroupHdrs(ACanvas: TCanvas);
+var
+ CurrGroup: string;
+ I: Integer;
+begin
+ if (CalcGroupHdrHeight > 0) and (Cols.Count > 0) then
+ begin
+ CurrGroup := Cols[LeftCol].GroupTitle;
+ DrawColGroupHdr(ACanvas, LeftCol, True);
+ for I := LeftCol + 1 to RightCol do
+ if Cols[I].GroupTitle <> CurrGroup then
+ begin
+ CurrGroup := Cols[I].GroupTitle;
+ DrawColGroupHdr(ACanvas, I, True);
+ end;
+ end;
+end;
+
+function TJvTFDays.CalcGroupColHdrsHeight: Integer;
+begin
+ Result := CalcGroupHdrHeight + ColHdrHeight;
+end;
+
+function TJvTFDays.CalcGroupHdrHeight: Integer;
+begin
+ if Grouping = grNone then
+ Result := 0
+ else
+ Result := GroupHdrHeight;
+end;
+
+function TJvTFDays.VirtualGroupHdrRect(Col: Integer): TRect;
+var
+ I, GroupStartCol, GroupEndCol, GroupWidth: Integer;
+begin
+ EnsureCol(Col);
+
+ Result.Top := 0;
+ Result.Bottom := CalcGroupHdrHeight;
+
+ GetGroupStartEndCols(Col, GroupStartCol, GroupEndCol);
+ GroupWidth := 0;
+ for I := GroupStartCol to GroupEndCol do
+ Inc(GroupWidth, Cols[I].Width);
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // ok
+ Result.Left := CalcBlockRowHdrsWidth;
+ {$ELSE}
+ // remove
+ //Result.Left := RowHdrWidth;
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ // At most, only one of the following For loops will execute
+ // depending on whether Col is to the left or to the right of LeftCol
+ for I := LeftCol - 1 downto GroupStartCol do
+ Dec(Result.Left, Cols[I].Width);
+
+ for I := LeftCol to GroupStartCol - 1 do
+ Inc(Result.Left, Cols[I].Width);
+
+ Result.Right := Result.Left + GroupWidth;
+end;
+
+procedure TJvTFDays.GetGroupStartEndCols(Col: Integer;
+ var StartCol, EndCol: Integer);
+var
+ I: Integer;
+begin
+ EnsureCol(Col);
+
+ // find group start col
+ I := Col;
+ while (I >= 0) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do
+ begin
+ StartCol := I;
+ Dec(I);
+ end;
+
+ // find group end col
+ I := Col;
+ while (I < Cols.Count) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do
+ begin
+ EndCol := I;
+ Inc(I);
+ end;
+end;
+
+(*
+procedure TJvTFDays.DrawGroupHdr(ACanvas: TCanvas; ACol: Integer);
+var
+ ARect: TRect;
+ Attr: TJvTFDaysHdrAttr;
+begin
+ ARect := VirtualGroupHdrRect(ACol);
+ if GroupHdrIsSelected(ACol) then
+ Attr := SelGroupHdrAttr
+ else
+ Attr := GroupHdrAttr;
+
+ With ACanvas do
+ begin
+ Font.Assign(Attr.Font);
+ Brush.Color := Attr.Color;
+ FillRect(ARect);
+
+ {
+ Brush.Color := clWhite;
+ FillRect(ARect);
+ Pen.Color := clBlack;
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom - 1);
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Left, ARect.Bottom - 1);
+ }
+ {
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom - 1);
+ LineTo(ARect.Left, ARect.Bottom - 1);
+ }
+{ end;
+end;
+*)
+
+procedure TJvTFDays.SetGroupHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ FGroupHdrAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFDays.SetSelGroupHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ FSelGroupHdrAttr.Assign(Value);
+ Invalidate;
+end;
+
+function TJvTFDays.GroupHdrIsSelected(ACol: Integer): Boolean;
+var
+ I, GroupStartCol, GroupEndCol: Integer;
+begin
+ GetGroupStartEndCols(ACol, GroupStartCol, GroupEndCol);
+ Result := False;
+ I := GroupStartCol;
+ while (I <= GroupEndCol) and not Result do
+ begin
+ if ColIsSelected(I) then
+ Result := True;
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFDays.DrawColGroupHdr(ACanvas: TCanvas; Index: Integer;
+ IsGroupHdr: Boolean);
+var
+ ARect, TxtRect, CalcRect, TxtBounds: TRect;
+ Txt: string;
+ PTxt: PChar;
+ UseAttr: TJvTFDaysHdrAttr;
+ Flags: UINT;
+ TxtHt, TxtRectHt: Integer;
+begin
+ if IsGroupHdr then
+ begin
+ ARect := VirtualGroupHdrRect(Index);
+ ARect.Left := Greater(ARect.Left, GetDataAreaRect.Left);
+ Txt := Copy(Cols[Index].GroupTitle, 1, Length(Cols[Index].GroupTitle));
+ if GroupHdrIsSelected(Index) then
+ UseAttr := SelGroupHdrAttr
+ else
+ UseAttr := GroupHdrAttr;
+ end
+ else
+ begin
+ ARect := CellRect(Index, -1);
+ //Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title));
+ Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title));
+ if ColIsSelected(Index) then
+ UseAttr := SelHdrAttr
+ else
+ UseAttr := HdrAttr;
+ end;
+
+ ACanvas.Brush.Color := UseAttr.Color;
+ ACanvas.Font.Assign(UseAttr.Font);
+
+ Flags := DT_NOPREFIX or DT_CENTER;
+ case ColTitleStyle of
+ ctsSingleClip:
+ Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ ctsSingleEllipsis:
+ Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER;
+ ctsMultiClip:
+ Flags := Flags or DT_WORDBREAK;
+ ctsMultiEllipsis:
+ Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or DT_EDITCONTROL;
+ ctsHide:
+ Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ end;
+
+ ACanvas.FillRect(ARect);
+ TxtRect := ARect;
+ InflateRect(TxtRect, -2, -2);
+ CalcRect := TxtRect;
+
+ // Allocate length of Txt + 4 chars
+ // (1 char for null terminator, 3 chars for ellipsis)
+ // Ahh, what the hell. Allocate + dozen chars for good measure.
+ // (This is continuing to give me problems and I don't know why.)
+ //PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char));
+ PTxt := StrAlloc((Length(Txt) + 12) * SizeOf(Char));
+ try
+ StrPCopy(PTxt, Txt);
+
+ if (ColTitleStyle = ctsMultiClip) or (ColTitleStyle = ctsMultiEllipsis) then
+ begin
+ TxtHt := DrawText(ACanvas.Handle, PTxt, -1, CalcRect,
+ Flags or DT_CALCRECT);
+ // "reset" PTxt
+ StrPCopy(PTxt, Txt);
+
+ if TxtHt < RectHeight(TxtRect) then
+ begin
+ // we need to vertically center the text
+ TxtRectHt := RectHeight(TxtRect);
+ TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2;
+ TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom);
+ end;
+ end
+ else
+ if ColTitleStyle = ctsHide then
+ begin
+ DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT);
+ if RectWidth(CalcRect) > RectWidth(TxtRect) then
+ StrPCopy(PTxt, '');
+ end
+ {$IFDEF Jv_TIMEBLOCKS}
+ // okay to leave
+ else
+ if ColTitleStyle = ctsRotated then
+ //DrawAngleText(ACanvas, TxtRect, UseAttr.TitleRotation, Txt);
+ DrawAngleText(ACanvas, TxtRect, TxtBounds, UseAttr.TitleRotation,
+ taCenter, vaCenter, Txt);
+ {$ELSE}
+ // remove
+ //; // semi-colon needed to terminate last end
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // okay to leave
+ if ColTitleStyle <> ctsRotated then
+ DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+ {$ELSE}
+ // remove
+ //Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+ {$ENDIF Jv_TIMEBLOCKS}
+ finally
+ StrDispose(PTxt);
+ end;
+
+ if not IsGroupHdr and (Index = FocusedCol) and Focused then
+ begin
+ CalcRect := ARect;
+ InflateRect(CalcRect, -2, -2);
+ ManualFocusRect(ACanvas, CalcRect);
+ {
+ if Windows.IsRectEmpty(TxtRect) then
+ Windows.InflateRect(TxtRect, 5, 5);
+ ManualFocusRect(ACanvas, TxtRect);
+ }
+ end;
+
+ {$IFDEF Jv_TIMEBLOCKS}
+ // okay to leave
+ DrawFrame(ACanvas, ARect, UseAttr.Frame3D, UseAttr.FrameColor);
+ {$ELSE}
+ // remove
+ //DrawFrame(ACanvas, ARect, UseAttr.Frame3D);
+ {$ENDIF Jv_TIMEBLOCKS}
+
+ if IsGroupHdr then
+ begin
+ if Assigned(FOnDrawGroupHdr) then
+ FOnDrawGroupHdr(Self, ACanvas, ARect, Index, GroupHdrIsSelected(Index));
+ end
+ else
+ if Assigned(FOnDrawColHdr) then
+ FOnDrawColHdr(Self, ACanvas, ARect, Index, ColIsSelected(Index));
+end;
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+
+procedure TJvTFDays.SetTimeBlocks(Value: TJvTFDaysTimeBlocks);
+begin
+ FTimeBlocks.Assign(Value);
+end;
+
+procedure TJvTFDays.SetTimeBlockProps(Value: TJvTFDaysBlockProps);
+begin
+ FTimeBlockProps.Assign(Value);
+end;
+
+procedure TJvTFDays.SetWeekend(Value: TTFDaysOfWeek);
+begin
+ if Value <> FWeekend then
+ begin
+ FWeekend := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetWeekendColor(Value: TColor);
+begin
+ if Value <> FWeekendColor then
+ begin
+ FWeekendColor := Value;
+ UpdateWeekendFillPic;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.UpdateWeekendFillPic;
+begin
+ FWeekendFillPic.Canvas.Brush.Color := WeekendColor;
+ FWeekendFillPic.Canvas.FillRect(Classes.Rect(0, 0, FWeekendFillPic.Width,
+ FWeekendFillPic.Height));
+end;
+
+procedure TJvTFDays.DrawBlockHdr(ACanvas: TCanvas; BlockIndex: Integer);
+var
+ ARect, HdrPicRect, TxtBounds: TRect;
+ StartRow, EndRow: Integer;
+ ClipIt: Boolean;
+ Attr: TJvTFDaysHdrAttr;
+ TimeBlock: TJvTFDaysTimeBlock;
+ HdrPic: TBitmap;
+begin
+ TimeBlock := TimeBlocks[BlockIndex];
+ GetTimeBlockStartEnd(BlockIndex, StartRow, EndRow);
+ //ARect := VirtualBlockHdrRect(StartRow);
+ ARect := CellRect(gcGroupHdr, StartRow);
+ HdrPicRect := VirtualBlockHdrRect(StartRow);
+ ClipIt := HdrPicRect.Top < ARect.Top;
+
+ OffsetRect(HdrPicRect, -HdrPicRect.Left, -HdrPicRect.Top);
+
+ HdrPic := TBitmap.Create;
+ try
+ HdrPic.Width := RectWidth(HdrPicRect);
+ HdrPic.Height := RectHeight(HdrPicRect);
+
+ if BlockHdrIsSelected(StartRow) then
+ Attr := TimeBlockProps.SelBlockHdrAttr
+ else
+ Attr := TimeBlockProps.BlockHdrAttr;
+
+ //With ACanvas do
+ with HdrPic.Canvas do
+ begin
+ Brush.Color := Attr.Color;
+ FillRect(HdrPicRect);
+
+ Font.Assign(Attr.Font);
+ //DrawAngleText(HdrPic.Canvas, HdrPicRect, Attr.TitleRotation,
+ //TimeBlock.Title);
+ DrawAngleText(HdrPic.Canvas, HdrPicRect, TxtBounds, Attr.TitleRotation,
+ taCenter, vaCenter, TimeBlock.Title);
+
+ if Attr.Frame3D then
+ DrawFrame(HdrPic.Canvas, HdrPicRect, True, Attr.FrameColor)
+ else
+ begin
+ Pen.Color := Attr.FrameColor;
+ MoveTo(HdrPicRect.Right - 1, HdrPicRect.Top);
+ LineTo(HdrPicRect.Right - 1, HdrPicRect.Bottom);
+ MoveTo(HdrPicRect.Left, HdrPicRect.Bottom - 1);
+ LineTo(HdrPicRect.Right, HdrPicRect.Bottom - 1);
+ end;
+ end;
+
+ if ClipIt then
+ HdrPicRect.Top := HdrPicRect.Bottom - RectHeight(ARect);
+
+ BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, RectWidth(ARect),
+ RectHeight(ARect), HdrPic.Canvas.Handle, 0, HdrPicRect.Top, SRCCOPY);
+ finally
+ HdrPic.Free;
+ end;
+end;
+
+procedure TJvTFDays.FillBlockHdrDeadSpace(ACanvas: TCanvas);
+var
+ ARect: TRect;
+ StartRow, EndRow: Integer;
+
+ procedure FillIt;
+ begin
+ with ACanvas do
+ begin
+ //Brush.Color := TimeBlockProps.BlockHdrAttr.Color;
+ Brush.Color := TimeBlockProps.OffTimeColor;
+ FillRect(ARect);
+
+ Pen.Color := TimeBlockProps.BlockHdrAttr.FrameColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ end;
+ end;
+
+begin
+ if TimeBlocks.Count = 0 then
+ Exit;
+
+ ARect.Left := 0;
+ ARect.Right := CalcBlockHdrWidth;
+
+ GetTimeBlockStartEnd(0, StartRow, EndRow);
+ if StartRow > TopRow then
+ begin
+ ARect.Top := CalcGroupColHdrsHeight;
+ ARect.Bottom := Lesser(VirtualBlockHdrRect(StartRow).Top,
+ GetDataAreaRect.Bottom);
+ FillIt;
+ end;
+
+ GetTimeBlockStartEnd(TimeBlocks.Count - 1, StartRow, EndRow);
+ if EndRow < BottomRow then
+ begin
+ ARect.Top := Greater(VirtualBlockHdrRect(EndRow).Bottom,
+ GetDataAreaRect.Top);
+ ARect.Bottom := GetDataAreaRect.Bottom;
+ FillIt;
+ end;
+end;
+
+//////////////////////////////////////////////////////////////////
+// Credit for the CalcTextPos routine goes to Joerg Lingner. //
+// It comes from his JLLabel component (freeware - Torry's). //
+// It is used here with his permission. Thanks Joerg! //
+// He can be reached at jlingner att t-online dott de //
+//////////////////////////////////////////////////////////////////
+{
+procedure TJvTFDays.CalcTextPos(var ARect: TRect; aAngle: Integer;
+ aTxt: string);
+//==========================================================================
+// Calculate text pos. depend. on: Font, Escapement, Alignment and length
+//--------------------------------------------------------------------------
+var
+ DC : HDC;
+ hSavFont: HFont;
+ Size : TSize;
+ x,y : Integer;
+ cStr : array [0..255] of Char;
+ SaveRect: TRect;
+begin
+ aAngle := aAngle div 10;
+ SaveRect := ARect;
+
+ StrPCopy(cStr, aTxt);
+ DC := GetDC(HWND_DESKTOP);
+ hSavFont := SelectObject(DC, Font.Handle);
+ GetTextExtentPoint32(DC, cStr, Length(aTxt), Size);
+ SelectObject(DC, hSavFont);
+ ReleaseDC(HWND_DESKTOP, DC);
+
+ x := 0;
+ y := 0;
+
+ if aAngle<=90 then
+ begin // 1.Quadrant
+ x := 0;
+ y := Trunc(Size.cx * sin(aAngle*Pi/180));
+ end
+ else
+ if aAngle<=180 then
+ begin // 2.Quadrant
+ x := Trunc(Size.cx * -cos(aAngle*Pi/180));
+ y := Trunc(Size.cx * sin(aAngle*Pi/180) + Size.cy * cos((180-aAngle)*Pi/180));
+ end
+ else
+ if aAngle<=270 then
+ begin // 3.Quadrant
+ x := Trunc(Size.cx * -cos(aAngle*Pi/180) + Size.cy * sin((aAngle-180)*Pi/180));
+ y := Trunc(Size.cy * sin((270-aAngle)*Pi/180));
+ end
+ else
+ if aAngle<=360 then
+ begin // 4.Quadrant
+ x := Trunc(Size.cy * sin((360-aAngle)*Pi/180));
+ y := 0;
+ end;
+ ARect.Top := ARect.Top + y;
+ ARect.Left := ARect.Left + x;
+
+ x := Abs(Trunc(Size.cx * cos(aAngle*Pi/180))) + Abs(Trunc(Size.cy * sin(aAngle*Pi/180)));
+ y := Abs(Trunc(Size.cx * sin(aAngle*Pi/180))) + Abs(Trunc(Size.cy * cos(aAngle*Pi/180)));
+
+ //Mike:
+ ARect.Left := ARect.Left + ((RectWidth(SaveRect) - X) div 2); // align center
+ //ARect.Left := ARect.Left + RectWidth(SaveRect) - X; // align right
+ ARect.Top := ARect.Top + ((RectHeight(SaveRect) - Y) div 2); // align center
+ //ARect.Top := ARect.Top + RectHeight(SaveRect) - Y; // align bottom
+end;
+}
+
+{
+procedure TJvTFDays.DrawAngleText(ACanvas: TCanvas; ARect: TRect;
+ aAngle: Integer; aTxt: string);
+var
+ LogFont: TLogFont;
+ TxtRect: TRect;
+ Flags: UINT;
+ PTxt: PChar;
+ ClipRgn: HRgn;
+begin
+ TxtRect := ARect;
+ CalcTextPos(TxtRect, aAngle, aTxt);
+
+ Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
+ LogFont.lfEscapement := aAngle;
+ LogFont.lfOrientation := LogFont.lfEscapement;
+ ACanvas.Font.Handle := CreateFontIndirect(LogFont);
+
+ Flags := DT_NOPREFIX or DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE;
+
+ PTxt := StrAlloc((Length(aTxt) + 4) * SizeOf(Char));
+ StrPCopy(PTxt, aTxt);
+
+ ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top,
+ ARect.Right, ARect.Bottom);
+ Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);
+
+ Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+
+ Windows.SelectClipRgn(ACanvas.Handle, 0);
+ Windows.DeleteObject(ClipRgn);
+ StrDispose(PTxt);
+ ACanvas.Font.Handle := 0;
+end;
+}
+
+procedure TJvTFDays.EnsureBlockRules(GridGran, BlockGran: Integer;
+ DayStart: TTime);
+var
+ GridHrs, GridMins, BlockHrs, BlockMins, S, MS: Word;
+ RowStartTime: TTime;
+begin
+ if TimeBlocks.Count > 0 then
+ begin
+ if GridGran > BlockGran then
+ raise EJvTFBlockGranError.CreateRes(@RsEGridGranularityCannotBeGreater);
+
+ if (BlockGran mod GridGran) <> 0 then
+ raise EJvTFBlockGranError.CreateRes(@RsETimeBlockGranularityMustBeEvenly);
+
+ DecodeTime(DayStart, BlockHrs, BlockMins, S, MS);
+ RowStartTime := RowToTime(TimeToRow(DayStart));
+ DecodeTime(RowStartTime, GridHrs, GridMins, S, MS);
+ if (BlockHrs <> GridHrs) or (BlockMins <> GridMins) then
+ raise EJvTFBlockGranError.CreateRes(@RsETimeBlocksMustBeginExactlyOn);
+ end;
+end;
+
+function TJvTFDays.ValidateBlockRules(GridGran, BlockGran: Integer;
+ DayStart: TTime): Boolean;
+var
+ GridHrs, GridMins, BlockHrs, BlockMins, S, MS: Word;
+ RowStartTime: TTime;
+begin
+ Result := True;
+ if TimeBlocks.Count > 0 then
+ begin
+ if GridGran > BlockGran then
+ Result := False;
+
+ if (BlockGran mod GridGran) <> 0 then
+ Result := False;
+
+ DecodeTime(DayStart, BlockHrs, BlockMins, S, MS);
+ RowStartTime := RowToTime(TimeToRow(DayStart));
+ DecodeTime(RowStartTime, GridHrs, GridMins, S, MS);
+ if (BlockHrs <> GridHrs) or (BlockMins <> GridMins) then
+ Result := False;
+ end;
+end;
+
+function TJvTFDays.RowToTimeBlock(ARow: Integer): Integer;
+var
+ I, BlockStart, BlockEnd: Integer;
+begin
+ Result := -1;
+ if TimeBlocks.Count = 0 then
+ Exit;
+
+ I := 0;
+ repeat
+ GetTimeBlockStartEnd(I, BlockStart, BlockEnd);
+ if (BlockStart <= ARow) and (ARow <= BlockEnd) then
+ Result := I;
+ Inc(I);
+ until (I = TimeBlocks.Count) or (Result <> -1);
+end;
+
+procedure TJvTFDays.GetTimeBlockStartEnd(ATimeBlock: Integer;
+ var BlockStart, BlockEnd: Integer);
+var
+ I: Integer;
+begin
+ if ATimeBlock < 0 then
+ begin
+ BlockStart := -1;
+ BlockEnd := -1;
+ Exit;
+ end;
+
+ BlockStart := TimeToRow(TimeBlockProps.DayStart);
+ I := 0;
+ while (I < ATimeBlock) do
+ begin
+ //Inc(BlockStart, TimeBlocks[I].Length);
+ Inc(BlockStart, TimeBlocks[I].GridLength);
+ Inc(I);
+ end;
+ //BlockEnd := BlockStart + TimeBlocks[ATimeBlock].Length - 1;
+ BlockEnd := BlockStart + TimeBlocks[ATimeBlock].GridLength - 1;
+end;
+
+function TJvTFDays.CalcBlockHdrWidth: Integer;
+begin
+ if TimeBlocks.Count > 0 then
+ Result := TimeBlockProps.BlockHdrWidth
+ else
+ Result := 0;
+end;
+
+function TJvTFDays.CalcBlockRowHdrsWidth: Integer;
+begin
+ Result := CalcBlockHdrWidth + RowHdrWidth;
+end;
+
+procedure TJvTFDays.GetBlockStartEndRows(Row: Integer;
+ var StartRow, EndRow: Integer);
+begin
+ GetTimeBlockStartEnd(RowToTimeBlock(Row), StartRow, EndRow);
+end;
+
+function TJvTFDays.VirtualBlockHdrRect(Row: Integer): TRect;
+var
+ BlockStartRow, BlockEndRow, BlockHeight: Integer;
+begin
+ EnsureRow(Row);
+
+ Result.Left := 0;
+ Result.Right := CalcBlockHdrWidth;
+
+ GetBlockStartEndRows(Row, BlockStartRow, BlockEndRow);
+ BlockHeight := (BlockEndRow - BlockStartRow + 1) * RowHeight;
+
+ Result.Top := CalcGroupColHdrsHeight + ((BlockStartRow - TopRow) * RowHeight);
+ Result.Bottom := Result.Top + BlockHeight;
+end;
+
+function TJvTFDays.IsWeekend(ColIndex: Integer): Boolean;
+begin
+ Result := BorlToDOW(DayOfWeek(Cols[ColIndex].SchedDate)) in Weekend;
+end;
+
+function TJvTFDays.BlockHdrIsSelected(ARow: Integer): Boolean;
+var
+ I, StartRow, EndRow: Integer;
+begin
+ GetBlockStartEndRows(ARow, StartRow, EndRow);
+ Result := False;
+ I := StartRow;
+ while (I <= EndRow) and not Result do
+ begin
+ if RowIsSelected(I) then
+ Result := True;
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFDays.DrawFrame(ACanvas: TCanvas; ARect: TRect; Draw3D: Boolean;
+ FrameColour: TColor);
+var
+ OldPenColor: TColor;
+begin
+ with ACanvas, ARect do
+ begin
+ OldPenColor := Pen.Color;
+
+ if Draw3D then
+ Pen.Color := clBtnShadow
+ else
+ Pen.Color := FrameColour;
+
+ MoveTo(Right - 1, Top);
+ LineTo(Right - 1, Bottom);
+ MoveTo(Left, Bottom - 1);
+ LineTo(Right, Bottom - 1);
+
+ if Draw3D then
+ begin
+ Pen.Color := clBtnHighlight;
+ MoveTo(Left, Top);
+ LineTo(Right, Top);
+ MoveTo(Left, Top);
+ LineTo(Left, Bottom);
+ end;
+
+ Pen.Color := OldPenColor;
+ end;
+end;
+
+{$ENDIF Jv_TIMEBLOCKS}
+
+procedure TJvTFDays.SetGridEndTime(Value: TTime);
+var
+ I, NewTopRow: Integer;
+ TopTime: TTime;
+ WorkEnd: TTime;
+ H, M, S, MS: Word;
+begin
+ WorkEnd := Value;
+ DecodeTime(WorkEnd, H, M, S, MS);
+ if (H = 0) and (M = 0) then
+ WorkEnd := EncodeTime(23, 59, 59, 999);
+
+ if not (csLoading in ComponentState) and (WorkEnd <= GridStartTime) then
+ raise EJvTFDaysError.CreateRes(@RsEGridEndTimeCannotBePriorToGridStart);
+
+ TopTime := RowToTime(TopRow);
+ FGridEndTime := Value;
+
+ ClearSelection;
+ if not (csLoading in ComponentState) then
+ begin
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].RefreshMap;
+ //TopRow := TimeToRow(TopTime);
+
+ if RowCount <= PossVisibleRows then
+ TopRow := 0
+ else
+ begin
+ if TopTime < GridStartTime then
+ NewTopRow := 0
+ else
+ NewTopRow := TimeToRow(TopTime);
+ TopRow := Lesser(NewTopRow, RowCount - 1 - VisibleRows + 1);
+ end;
+
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.SetGridStartTime(Value: TTime);
+var
+ I, NewTopRow: Integer;
+ TopTime: TTime;
+ WorkEnd: TTime;
+ H, M, S, MS: Word;
+begin
+ WorkEnd := GridEndTime;
+ DecodeTime(WorkEnd, H, M, S, MS);
+ if (H = 0) and (M = 0) then
+ WorkEnd := EncodeTime(23, 59, 59, 999);
+
+ if not (csLoading in ComponentState) and (Value >= WorkEnd) then
+ raise EJvTFDaysError.CreateRes(@RsEGridStartTimeCannotBeAfterGridEndTi);
+
+ TopTime := RowToTime(TopRow);
+ FGridStartTime := Value;
+
+ ClearSelection;
+ if not (csLoading in ComponentState) then
+ begin
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].RefreshMap;
+ //TopRow := TimeToRow(TopTime);
+
+ if RowCount <= PossVisibleRows then
+ TopRow := 0
+ else
+ begin
+ if TopTime < GridStartTime then
+ NewTopRow := 0
+ else
+ NewTopRow := TimeToRow(TopTime);
+ TopRow := Lesser(NewTopRow, RowCount - 1 - VisibleRows + 1);
+ end;
+
+ CheckSBVis;
+ CheckSBParams;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFDays.WMTimer(var Msg: TLMTimer);
+var
+ I, TempWidth: Integer;
+ PtInfo: TJvTFDaysCoord;
+ OldTopRow, OldLeftCol: Integer;
+ X, Y: Integer;
+begin
+ if Cols.Count = 0 then
+ Exit;
+
+ OldTopRow := TopRow;
+ OldLeftCol := LeftCol;
+
+ case FAutoScrollDir of
+ asdUp:
+ TopRow := Greater(TopRow - 1, 0);
+ asdDown:
+ TopRow := Lesser(TopRow + 1, RowCount - FullVisibleRows);
+ asdLeft:
+ LeftCol := Greater(LeftCol - 1, 0);
+ asdRight:
+ begin
+ TempWidth := 0;
+ for I := LeftCol to Cols.Count - 1 do
+ Inc(TempWidth, Cols[I].Width);
+ if TempWidth > GetDataWidth then
+ LeftCol := LeftCol + 1;
+ end;
+ end;
+
+ if (FAutoScrollDir <> asdNowhere) and
+ ((TopRow <> OldTopRow) or (LeftCol <> OldLeftCol)) then
+ begin
+ X := FMouseMovePt.X;
+ Y := FMouseMovePt.Y;
+
+ if State <> agsMoveAppt then
+ MouseMove(FMouseMoveState, X, Y);
+
+ Update;
+
+ PtInfo := PtToCell(FMouseMovePt.X, FMouseMovePt.Y);
+
+ if Y >= GetDataAreaRect.Bottom then
+ PtInfo.Row := Lesser(BottomRow + 1, RowCount - 1);
+
+ if State = agsSizeAppt then
+ begin
+ DrawDrag(PtInfo, nil, False);
+ ContinueDragging(PtInfo, nil);
+ end
+ else
+ if State = agsMoveAppt then
+ begin
+ DrawDrag(PtInfo, FDragInfo.Appt, False);
+ FDraggingCoord.Row := PtInfo.Row;
+ end;
+ end;
+end;
+
+procedure TJvTFDays.KillAutoScrollTimer;
+begin
+ if FLiveTimer then
+ begin
+ FLiveTimer := False;
+ KillTimer(Handle, 1);
+ end;
+end;
+
+procedure TJvTFDays.Navigate(AControl: TJvTFControl;
+ SchedNames: TStringList; Dates: TJvTFDateList);
+var
+ I, J: Integer;
+ ACol: TJvTFDaysCol;
+begin
+ inherited Navigate(AControl, SchedNames, Dates);
+
+ if not Template.IgnoreNav and (Dates.Count > 0) then
+ case Template.ActiveTemplate of
+ agtLinear:
+ Template.LinearStartDate := Dates[0];
+ agtComparative:
+ Template.CompDate := Dates[0];
+ agtNone:
+ begin
+ Cols.BeginUpdate;
+ try
+ Cols.Clear;
+ if Grouping = grDate then
+ for I := 0 to Dates.Count - 1 do
+ for J := 0 to SchedNames.Count - 1 do
+ begin
+ ACol := Cols.Add;
+ ACol.SchedName := SchedNames[J];
+ ACol.SchedDate := Dates[I];
+ end
+ else
+ for I := 0 to SchedNames.Count - 1 do
+ for J := 0 to Dates.Count - 1 do
+ begin
+ ACol := Cols.Add;
+ ACol.SchedName := SchedNames[I];
+ ACol.SchedDate := Dates[J];
+ end;
+ finally
+ Cols.EndUpdate;
+ end;
+ end;
+ end;
+end;
+
+{
+procedure TJvTFDays.ReorderCols;
+var
+ NewList: TStringList;
+ I, Slot: Integer;
+ ColToAdd: TJvTFDaysCol;
+
+ function SortCompare: Boolean;
+ var
+ CurrCol: TJvTFDaysCol;
+ begin
+ CurrCol := TJvTFDaysCol(NewList.Objects[Slot]);
+ if Grouping = grDate then
+ Result := Trunc(CurrCol.SchedDate) > Trunc(ColToAdd.SchedDate)
+ else
+ if Grouping = grResource then
+ Result := CurrCol.SchedName > ColToAdd.SchedName
+ else
+ Result := True;
+ end;
+
+begin
+ NewList := TStringList.Create;
+ Try
+ For I := 0 to Cols.Count - 1 do
+ begin
+ ColToAdd := Cols[I];
+
+ Slot := 0;
+ while (Slot < NewList.Count) and not SortCompare do
+ Inc(Slot);
+
+ NewList.InsertObject(Slot, '', ColToAdd);
+ end;
+
+ For I := 0 to NewList.Count - 1 do
+ TJvTFDaysCol(NewList.Objects[I]).Index := I;
+ Finally
+ NewList.Free;
+ end;
+end;
+}
+
+//procedure TJvTFDays.DoNavigate;
+//var
+// SchedNameList: TStringList;
+// DateList: TJvTFDateList;
+// I,
+// SMIndex: Integer;
+// ACol: TJvTFDaysCol;
+//begin
+// if not Assigned(Navigator) then
+// Exit;
+//
+// SchedNameList := TStringList.Create;
+// DateList := TJvTFDateList.Create;
+// try
+// for I := 0 to Cols.Count - 1 do
+// begin
+// ACol := Cols[I];
+// if ColIsSelected(I) then
+// begin
+// SMIndex := SchedNameList.IndexOf(ACol.SchedName);
+// if SMIndex = -1 then
+// SchedNameList.Add(ACol.SchedName);
+// DateList.Add(ACol.SchedDate);
+// end;
+// end;
+//
+// Navigator.Navigate(Self, SchedNameList, DateList);
+// finally
+// SchedNameList.Free;
+// DateList.Free;
+// end;
+//end;
+
+function TJvTFDays.GetTFHintClass: TJvTFHintClass;
+begin
+ Result := TJvTFHint;
+end;
+
+procedure TJvTFDays.DoApptHint(GridCoord: TJvTFDaysCoord);
+var
+ ApptRect, VisApptRect: TRect;
+begin
+ if Assigned(GridCoord.Appt) and not Editing and (agoShowApptHints in Options) then
+ begin
+ ApptRect := GetApptRect(GridCoord.Col, GridCoord.Appt);
+ IntersectRect(VisApptRect, ApptRect, GetDataAreaRect);
+ FHint.ApptHint(GridCoord.Appt, VisApptRect.Left + 2,
+ VisApptRect.Bottom + 2, True, True,
+ agoFormattedDesc in Options);
+ end;
+end;
+
+procedure TJvTFDays.DoCellHint(GridCoord: TJvTFDaysCoord);
+var
+ ColHdrRect: TRect;
+ HintText: string;
+begin
+ if csDesigning in ComponentState then
+ Exit;
+
+ if (GridCoord.Row = -1) and (GridCoord.Col > -1) and (agoShowColHdrHints in Options) then
+ HintText := Cols[GridCoord.Col].Title
+ else
+ HintText := '';
+
+ ColHdrRect := CellRect(GridCoord.Col, GridCoord.Row);
+ FHint.CellHint(GridCoord.Row, GridCoord.Col, HintText, ColHdrRect);
+end;
+
+procedure TJvTFDays.GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo;
+ AAppt: TJvTFAppt; Attr: TJvTFDaysApptAttr);
+begin
+ DrawInfo.Color := GetApptDispColor(AAppt, AAppt = SelAppt);
+ DrawInfo.FrameColor := Attr.FrameColor;
+ DrawInfo.FrameWidth := Attr.FrameWidth;
+ DrawInfo.Font := Attr.Font;
+ DrawInfo.Visible := True;
+
+ if Assigned(FOnGetApptDrawInfo) then
+ FOnGetApptDrawInfo(Self, AAppt, DrawInfo);
+end;
+
+// move grab handles
+//function TJvTFDays.GetBottomGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect;
+//begin
+// Result := Classes.Rect(0, 0, 0, 0);
+// if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and
+// Cols[Col].ApptInCol(Appt) then
+// begin
+// Result := GetApptRect(Col, Appt);
+// Result.Top := Result.Bottom - GrabHandles.Height;
+// Windows.OffsetRect(Result, 0, GrabHandles.Height);
+// end;
+//end;
+//
+//// move grab handles
+//function TJvTFDays.GetTopGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect;
+//begin
+// Result := Classes.Rect(0, 0, 0, 0);
+// if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and
+// Cols[Col].ApptInCol(Appt) then
+// begin
+// Result := GetApptRect(Col, Appt);
+// Result.Bottom := Result.Top + GrabHandles.Height;
+// Windows.OffsetRect(Result, 0, -GrabHandles.Height);
+// end;
+//end;
+
+// move grab handles
+
+function TJvTFDays.GetBottomGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect;
+begin
+ Result := Classes.Rect(0, 0, 0, 0);
+// if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and
+ if (Col > gcHdr) and Assigned(Appt) and Cols[Col].ApptInCol(Appt) then
+ begin
+ Result := GetApptRect(Col, Appt);
+ Result.Top := Result.Bottom - GrabHandles.Height;
+ OffsetRect(Result, 0, GrabHandles.Height);
+ end;
+end;
+
+// move grab handles
+
+function TJvTFDays.GetTopGrabHandleRect(Col: Integer; Appt: TJvTFAppt): TRect;
+begin
+ Result := Classes.Rect(0, 0, 0, 0);
+// if (Col = FocusedCol) and (Col > gcHdr) and Assigned(Appt) and
+ if (Col > gcHdr) and Assigned(Appt) and Cols[Col].ApptInCol(Appt) then
+ begin
+ Result := GetApptRect(Col, Appt);
+ Result.Bottom := Result.Top + GrabHandles.Height;
+ OffsetRect(Result, 0, -GrabHandles.Height);
+ end;
+end;
+
+function TJvTFDays.PtInBottomHandle(APoint: TPoint; Col: Integer;
+ Appt: TJvTFAppt): Boolean;
+var
+ HandleRect: TRect;
+begin
+ Result := False;
+ // move grab handles
+ if Assigned(Appt) and Cols[Col].ApptInCol(Appt) then
+ begin
+ HandleRect := GetBottomGrabHandleRect(Col, Appt);
+ Result := PtInRect(HandleRect, APoint) and
+ (agoSizeAppt in Options);
+ end;
+end;
+
+function TJvTFDays.PtInTopHandle(APoint: TPoint; Col: Integer;
+ Appt: TJvTFAppt): Boolean;
+var
+ HandleRect: TRect;
+begin
+ Result := False;
+ // move grab handles
+ if Assigned(Appt) and Cols[Col].ApptInCol(Appt) then
+ begin
+ HandleRect := GetTopGrabHandleRect(Col, Appt);
+ Result := PtInRect(HandleRect, APoint) and
+ (agoMoveAppt in Options);
+ end;
+end;
+
+procedure TJvTFDays.SetDitheredBackground(const Value: Boolean);
+begin
+ FDitheredBackground := Value;
+ Refresh;
+end;
+
+procedure TJvTFDays.SetShowFocus(const Value: Boolean);
+begin
+ if FShowFocus <> Value then
+ begin
+ FShowFocus := Value;
+ Invalidate;
+ end;
+end;
+
+class function TJvTFDays.GetControlClassDefaultSize: TSize;
+begin
+ Result.CX := 500;
+ Result.CY := 300;
+end;
+
+
+//=== { TJvTFDaysPrinter } ===================================================
+
+constructor TJvTFDaysPrinter.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FGroupHdrHeight := 25;
+
+ FPageInfoList := TStringList.Create;
+ FApptAttr := TJvTFDaysApptAttr.Create(nil);
+ FApptBar := TJvTFDaysApptBar.Create(nil);
+ FCols := TJvTFDaysCols.CreateForPrinter(Self);
+ FFancyRowHdrAttr := TJvTFDaysFancyRowHdrAttr.Create(nil);
+ FHdrAttr := TJvTFDaysHdrAttr.Create(nil);
+ FGroupHdrAttr := TJvTFDaysHdrAttr.Create(nil);
+ FPrimeTime := TJvTFDaysPrimeTime.Create(nil);
+ FThresholds := TJvTFDaysThresholds.Create(nil);
+end;
+
+destructor TJvTFDaysPrinter.Destroy;
+begin
+ FCols.Free;
+ FApptAttr.Free;
+ FApptBar.Free;
+ FFancyRowHdrAttr.Free;
+ FHdrAttr.Free;
+ FGroupHdrAttr.Free;
+ FPrimeTime.Free;
+ FThresholds.Free;
+
+ // ClearPageInfo *MUST* be called here. FreeDoc will not call ClearPageInfo
+ // since we are freeing FPageInfoList here and the inherited Destroy calls
+ // FreeDoc. (That call to FreeDoc would call ClearPageInfo AFTER
+ // FPageInfoList has been destroyed.)
+ ClearPageInfo;
+ FPageInfoList.Free;
+ FPageInfoList := nil;
+
+ inherited Destroy;
+end;
+
+function TJvTFDaysPrinter.AdjustEndTime(ATime: TTime): TTime;
+begin
+ Result := Frac(Frac(ATime) - Frac(EncodeTime(0, 0, 1, 0)));
+end;
+
+procedure TJvTFDaysPrinter.CalcPageColInfo(ShowRowHdrs: Boolean;
+ var CalcColsPerPage, CalcColWidth: Integer);
+var
+ DataWidth, TargetColsPerPage: Integer;
+begin
+ // Calculate the cols per page
+ if DaysPageLayout.ColsPerPage = 0 then
+ TargetColsPerPage := Cols.Count
+ else
+ TargetColsPerPage := DaysPageLayout.ColsPerPage;
+
+ DataWidth := GetDataWidth(ShowRowHdrs);
+ if TargetColsPerPage > 0 then
+ begin
+ CalcColWidth := DataWidth div TargetColsPerPage;
+ CalcColWidth := Greater(CalcColWidth, MinColWidth);
+ CalcColsPerPage := DataWidth div CalcColWidth;
+ end
+ else
+ begin
+ CalcColsPerPage := 1;
+ CalcColWidth := DataWidth;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.CalcPageInfo;
+var
+ Segments: TStringList;
+ lPageInfo, SegmentInfo: TJvTFDaysPageInfo;
+ WorkRowHeight, WorkRowsPerPage, WorkColWidth, WorkColsPerPage: Integer;
+ CurrRow, CurrCol, I, WorkEndCol: Integer;
+ WorkShowRowHdr: Boolean;
+begin
+ // ALL MEASUREMENTS ARE ASSUMED TO BE IN PIXELS !!
+ ClearPageInfo;
+
+ // Calculate the segments
+ // A segment is concerned with rows only (if all rows fit on one page then
+ // there is one segment. if the rows fit on two pages then there are two
+ // segments...)
+ Segments := TStringList.Create;
+
+ try
+ // create the segments
+ CurrRow := 0;
+ while CurrRow < RowCount do
+ begin
+ lPageInfo := TJvTFDaysPageInfo.Create;
+ Segments.AddObject('', lPageInfo);
+ with lPageInfo do
+ begin
+ PageNum := Segments.Count;
+ StartRow := CurrRow;
+
+ ShowColHdr := (CurrRow = 0) or DaysPageLayout.AlwaysShowColHdr;
+ CalcPageRowInfo(ShowColHdr, WorkRowsPerPage, WorkRowHeight);
+ EndRow := Lesser(CurrRow + WorkRowsPerPage - 1, RowCount - 1);
+ RowHeight := WorkRowHeight;
+ end;
+ CurrRow := lPageInfo.EndRow + 1;
+ end;
+
+ // create the pages
+ CurrCol := 0;
+ while CurrCol < Cols.Count do
+ begin
+ WorkShowRowHdr := (CurrCol = 0) or DaysPageLayout.AlwaysShowRowHdr;
+ CalcPageColInfo(WorkShowRowHdr, WorkColsPerPage, WorkColWidth);
+ WorkEndCol := CurrCol + WorkColsPerPage - 1;
+ WorkEndCol := Lesser(WorkEndCol, Cols.Count - 1);
+
+ for I := 0 to Segments.Count - 1 do
+ begin
+ SegmentInfo := TJvTFDaysPageInfo(Segments.Objects[I]);
+
+ lPageInfo := TJvTFDaysPageInfo.Create;
+ FPageInfoList.AddObject('', lPageInfo);
+ with lPageInfo do
+ begin
+ PageNum := FPageInfoList.Count;
+ StartRow := SegmentInfo.StartRow;
+ EndRow := SegmentInfo.EndRow;
+ RowHeight := SegmentInfo.RowHeight;
+ ShowColHdr := SegmentInfo.ShowColHdr;
+ StartCol := CurrCol;
+ EndCol := WorkEndCol;
+ ColWidth := WorkColWidth;
+ ShowRowHdr := WorkShowRowHdr;
+ end;
+ end;
+ CurrCol := WorkEndCol + 1;
+ end;
+ finally
+ // clean up the segments
+ while Segments.Count > 0 do
+ begin
+ Segments.Objects[0].Free;
+ Segments.Delete(0);
+ end;
+ Segments.Free;
+ FValidPageInfo := True;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.CalcPageRowInfo(ShowColHdrs: Boolean;
+ var CalcRowsPerPage, CalcRowHeight: Integer);
+var
+ DataHeight, TargetRowsPerPage: Integer;
+begin
+ // Calculate the rows per page
+ if DaysPageLayout.RowsPerPage = 0 then
+ TargetRowsPerPage := RowCount
+ else
+ TargetRowsPerPage := DaysPageLayout.RowsPerPage;
+
+ DataHeight := GetDataHeight(ShowColHdrs);
+ CalcRowHeight := DataHeight div TargetRowsPerPage;
+ CalcRowHeight := Greater(CalcRowHeight, MinRowHeight);
+ CalcRowsPerPage := DataHeight div CalcRowHeight;
+end;
+
+procedure TJvTFDaysPrinter.CalcStartEndRows(AAppt: TJvTFAppt;
+ SchedDate: TDate; var StartRow, EndRow: Integer);
+begin
+ if Trunc(AAppt.StartDate) = Trunc(SchedDate) then
+ StartRow := TimeToRow(AAppt.StartTime)
+ else
+ StartRow := 0;
+
+ if Trunc(AAppt.EndDate) = Trunc(SchedDate) then
+ EndRow := TimeToRow(AdjustEndTime(AAppt.EndTime))
+ else
+ EndRow := RowCount - 1;
+end;
+
+procedure TJvTFDaysPrinter.CanDrawWhat(ACanvas: TCanvas; ApptRect: TRect;
+ PicsHeight, PicsWidth: Integer; var CanDrawText, CanDrawPics: Boolean);
+var
+ TextHeightThreshold, TextWidthThreshold: Integer;
+begin
+ TextHeightThreshold := ACanvas.TextHeight('Wq') * Thresholds.TextHeight;
+ TextWidthThreshold := ACanvas.TextWidth('Bi') div 2 * Thresholds.TextWidth;
+
+ if TextHeightThreshold < RectHeight(ApptRect) then
+ begin
+ CanDrawText := RectWidth(ApptRect) >= TextWidthThreshold;
+ CanDrawPics := True;
+ end
+ else
+ if Thresholds.DropTextFirst then
+ begin
+ CanDrawText := False;
+ CanDrawPics := True;
+ if Thresholds.WholePicsOnly then
+ if PicsHeight > RectHeight(ApptRect) then
+ CanDrawPics := False;
+ end
+ else
+ begin
+ CanDrawText := (RectHeight(ApptRect) >= TextHeightThreshold) and
+ (RectWidth(ApptRect) >= TextWidthThreshold);
+ CanDrawPics := False;
+ end;
+
+ if not ShowPics then
+ CanDrawPics := False;
+ if not ShowText then
+ CanDrawText := False;
+end;
+
+function TJvTFDaysPrinter.CellRect(Col, Row: Integer;
+ PageInfo: TJvTFDaysPageInfo): TRect;
+var
+ VisGrpHdrRect: TRect;
+begin
+ if (Row = gcGroupHdr) and (Col > gcHdr) then
+ begin
+ VisGrpHdrRect := Classes.Rect(RowHdrWidth, 0,
+ RowHdrWidth + GetDataWidth(PageInfo.ShowRowHdr),
+ CalcGroupHdrHeight);
+ IntersectRect(Result, VisGrpHdrRect,
+ VirtualGroupHdrRect(Col, PageInfo));
+ end
+ else
+ if Col < 0 then // Row hdr
+ if Row < 0 then
+ // origin cell
+ if PageInfo.ShowColHdr and PageInfo.ShowRowHdr then
+ //group Result := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight)
+ Result := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight)
+ else
+ Result := EmptyRect
+ else
+ if (Row >= PageInfo.StartRow) and (Row <= PageInfo.EndRow) then
+ // Row Hdr for visible data row
+ if PageInfo.ShowRowHdr then
+ begin
+ Result.Left := 0;
+ if PageInfo.ShowColHdr then
+ //group Result.Top := ColHdrHeight
+ Result.Top := CalcGroupColHdrsHeight
+ else
+ Result.Top := 0;
+ Result.Top := Result.Top + (Row - PageInfo.StartRow) * PageInfo.RowHeight;
+ Result.Right := RowHdrWidth;
+ Result.Bottom := Result.Top + PageInfo.RowHeight;
+ end
+ else
+ Result := EmptyRect
+ else
+ // Row Hdr for non-visible data row
+ Result := EmptyRect
+ else
+ if (Col >= PageInfo.StartCol) and (Col <= PageInfo.EndCol) then
+ // visible data col
+ if Row < 0 then
+ // Col hdr for visible data col
+ if PageInfo.ShowColHdr then
+ begin
+ if PageInfo.ShowRowHdr then
+ Result.Left := RowHdrWidth
+ else
+ Result.Left := 0;
+ Inc(Result.Left, PageInfo.ColWidth * (Col - PageInfo.StartCol));
+ Result.Right := Result.Left + PageInfo.ColWidth;
+
+ { variable width columns, leave for future reference
+ For I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ }
+
+ //group Result.Top := 0;
+ Result.Top := CalcGroupHdrHeight;
+ //group Result.Bottom := ColHdrHeight;
+ Result.Bottom := Result.Top + ColHdrHeight;
+ end
+ else
+ Result := EmptyRect
+ else
+ if (Row >= PageInfo.StartRow) and (Row <= PageInfo.EndRow) then
+ // visible data cell
+ begin
+ if PageInfo.ShowRowHdr then
+ Result.Left := RowHdrWidth
+ else
+ Result.Left := 0;
+ Inc(Result.Left, PageInfo.ColWidth * (Col - PageInfo.StartCol));
+ Result.Right := Result.Left + PageInfo.ColWidth;
+
+ { variable width cols, leave for future reference
+ For I := LeftCol to Col - 1 do
+ Inc(Result.Left, Cols[I].Width);
+ Result.Right := Result.Left + Cols[Col].Width;
+ }
+
+ if PageInfo.ShowColHdr then
+ //group Result.Top := ColHdrHeight
+ Result.Top := CalcGroupColHdrsHeight
+ else
+ Result.Top := 0;
+ Inc(Result.Top, (Row - PageInfo.StartRow) * PageInfo.RowHeight);
+ Result.Bottom := Result.Top + PageInfo.RowHeight;
+ end
+ else
+ // non-visible data cell (visible col, but non-visible row)
+ Result := EmptyRect
+
+ else // non-visible data col
+ Result := EmptyRect;
+end;
+
+procedure TJvTFDaysPrinter.ClearPageInfo;
+begin
+ if not Assigned(FPageInfoList) then
+ Exit;
+
+ while FPageInfoList.Count > 0 do
+ begin
+ FPageInfoList.Objects[0].Free;
+ FPageInfoList.Delete(0);
+ end;
+ FValidPageInfo := False;
+end;
+
+procedure TJvTFDaysPrinter.ClearPicDrawList(DrawList: TList);
+begin
+ while DrawList.Count > 0 do
+ begin
+ TJvTFDrawPicInfo(DrawList[0]).Free;
+ DrawList.Delete(0);
+ end;
+end;
+
+procedure TJvTFDaysPrinter.CreateLayout;
+begin
+ FPageLayout := TJvTFDaysPrinterPageLayout.Create(Self);
+end;
+
+procedure TJvTFDaysPrinter.CreatePicDrawList(ARect: TRect; Appt: TJvTFAppt;
+ DrawList: TList);
+var
+ I, NextPicLeft, ImageIndex, PicWidth: Integer;
+ ImageList: TCustomImageList;
+ ImageMap: TJvTFStateImageMap;
+ CustomImageMap: TJvTFCustomImageMap;
+
+ procedure AddToList(AImageList: TCustomImageList; AImageIndex: Integer;
+ APicLeft, APicTop: Integer);
+ var
+ DrawInfo: TJvTFDrawPicInfo;
+ begin
+ DrawInfo := TJvTFDrawPicInfo.Create;
+ DrawInfo.ImageList := AImageList;
+ DrawInfo.ImageIndex := AImageIndex;
+ DrawInfo.PicLeft := APicLeft;
+ DrawInfo.PicTop := APicTop;
+ DrawList.Add(DrawInfo);
+ end;
+
+begin
+ NextPicLeft := ARect.Left;
+
+ if ShowPics and Assigned(ScheduleManager.CustomImages) then
+ begin
+ ImageList := ScheduleManager.CustomImages;
+ CustomImageMap := Appt.ImageMap;
+ PicWidth := ScreenToPrinter(ImageList.Width + 2, True);
+
+ for I := 0 to CustomImageMap.Count - 1 do
+ begin
+ ImageIndex := CustomImageMap[I];
+ AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, PicWidth);
+ end;
+ end;
+
+ if ShowPics and Assigned(ScheduleManager.StateImages) then
+ begin
+ ImageList := ScheduleManager.StateImages;
+ PicWidth := ScreenToPrinter(ImageList.Width + 2, True);
+ ImageMap := ScheduleManager.StateImageMap;
+
+ if Appt.AlarmEnabled then
+ begin
+ ImageIndex := ImageMap.AlarmEnabled;
+ if ImageIndex > -1 then
+ begin
+ AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, PicWidth);
+ end
+ end
+ else
+ begin
+ ImageIndex := ImageMap.AlarmDisabled;
+ if ImageIndex > -1 then
+ begin
+ AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top);
+ Inc(NextPicLeft, PicWidth);
+ end;
+ end;
+
+ ImageIndex := ImageMap.Shared;
+ if Appt.Shared and (ImageIndex > -1) then
+ begin
+ AddToList(ImageList, ImageIndex, NextPicLeft, ARect.Top);
+ // The following line generates a compiler hint so comment out,
+ // but leave here as reminder in case method is expanded.
+ //Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+
+ { don't show modified pic in printed page
+ if Appt.Modified and (ImageMap.Modified > -1) then
+ begin
+ AddToList(ImageList, ImageMap.Modified, NextPicLeft, ARect.Top);
+ // The following line generates a compiler hint so comment out,
+ // but leave here as reminder in case method is expanded.
+ //Inc(NextPicLeft, ImageList.Width + 2);
+ end;
+ }
+ end;
+end;
+
+function TJvTFDaysPrinter.DaysPageLayout: TJvTFDaysPrinterPageLayout;
+begin
+ Result := TJvTFDaysPrinterPageLayout(PageLayout);
+end;
+
+{***************************************************************************
+ * The following routine was based off of a routine originally found in the
+ * PrinterDemo #1 project of Earl F. Glynn's Computer Lab and is used with
+ * permission.
+ * http://www.efg2.com/Lab/OtherProjects/PrinterDemo1.htm
+ *
+ * This routine solves a color "washing" problem encountered on some printers.
+ * It demonstrates the proper use of StretchDIBits. Many thanks to Earl
+ * for providing the Computer Lab. This solution saved me several hours
+ * of research and trial and error.
+ ****************************************************************************}
+
+procedure TJvTFDaysPrinter.PrintBitmap(ACanvas: TCanvas; SourceRect,
+ DestRect: TRect; aBitmap: TBitmap);
+var
+ BitmapHeader: pBitmapInfo;
+ BitmapImage: POINTER;
+
+ HeaderSize: LongWord;
+ ImageSize: LongWord;
+
+begin
+ { wp --- to do (GetDIBSizes not in LCL)
+ GetDIBSizes(aBitmap.Handle, HeaderSize, ImageSize);
+ GetMem(BitmapHeader, HeaderSize);
+ GetMem(BitmapImage, ImageSize);
+ try
+ GetDIB(aBitmap.Handle, aBitmap.Palette, BitmapHeader^, BitmapImage^);
+ StretchDIBits(ACanvas.Handle,
+ DestRect.Left, DestRect.Top,
+ DestRect.Right - DestRect.Left,
+ DestRect.Bottom - DestRect.Top,
+ SourceRect.Left, SourceRect.Top,
+ RectWidth(SourceRect),
+ RectHeight(SourceRect),
+ BitmapImage,
+ TBitmapInfo(BitmapHeader^),
+ DIB_RGB_COLORS,
+ SRCCOPY);
+ finally
+ FreeMem(BitmapHeader);
+ FreeMem(BitmapImage)
+ end;
+ }
+end;
+
+procedure TJvTFDaysPrinter.DrawAppt(ACanvas: TCanvas; Col: Integer;
+ Appt: TJvTFAppt; StartRow, EndRow: Integer; PageInfo: TJvTFDaysPageInfo);
+var
+ ApptRect, DataRect: TRect;
+ ClipRgn: HRgn;
+begin
+ ApptRect := GetApptRect(Col, Appt, PageInfo);
+
+ if IsRectEmpty(ApptRect) then
+ Exit;
+
+ // Printer bug start, fixed
+ // Calc the data area rect on the given canvas
+ if PageInfo.ShowRowHdr then
+ DataRect.Left := RowHdrWidth
+ else
+ DataRect.Left := 0;
+
+ if PageInfo.ShowColHdr then
+ DataRect.Top := CalcGroupColHdrsHeight
+ else
+ DataRect.Top := 0;
+
+ DataRect.Right := DataRect.Left + BodyWidth;
+ DataRect.Bottom := DataRect.Top + BodyHeight;
+
+ // Need to add BodyLeft and BodyTop to account for ViewPortOrg adjustment
+ ClipRgn := CreateRectRgn(DataRect.Left + BodyLeft,
+ DataRect.Top + BodyTop, DataRect.Right + BodyLeft, DataRect.Bottom + BodyTop);
+
+ SelectClipRgn(ACanvas.Handle, ClipRgn);
+ DrawApptDetail(ACanvas, ApptRect, Appt, Col, StartRow, EndRow);
+ SelectClipRgn(ACanvas.Handle, 0);
+ DeleteObject(ClipRgn);
+ // Printer bug end, fixed
+end;
+
+function TJvTFDaysPrinter.CalcTimeStampRect(Appt: TJvTFAppt; BarRect: TRect;
+ Col, StartRow, EndRow: Integer): TRect;
+var
+ Offset, ApptLength: TTime;
+ ColDate: TDate;
+ StartPercent, EndPercent: Double;
+begin
+ Result := BarRect;
+
+ if StartRow < 0 then
+ StartRow := 0;
+
+ if EndRow > RowCount - 1 then
+ EndRow := RowCount - 1;
+
+ Offset := RowToTime(StartRow);
+ ApptLength := RowEndTime(EndRow) - Offset;
+ ColDate := Cols[Col].SchedDate;
+
+ if Trunc(ColDate) <> Trunc(Appt.StartDate) then
+ StartPercent := 0
+ else
+ StartPercent := (Appt.StartTime - Offset) / ApptLength;
+
+ if Trunc(ColDate) <> Trunc(Appt.EndDate) then
+ EndPercent := 1.0
+ else
+ EndPercent := (Appt.EndTime - Offset) / ApptLength;
+
+ Result.Top := Round((BarRect.Bottom - BarRect.Top) * StartPercent) +
+ BarRect.Top;
+ Result.Bottom := Round((BarRect.Bottom - BarRect.Top) * EndPercent) +
+ BarRect.Top;
+end;
+
+procedure TJvTFDaysPrinter.DrawTimeStamp(ACanvas: TCanvas; TimeStampRect: TRect);
+var
+ OldColor: TColor;
+ StampLeft: Integer;
+begin
+ with ACanvas do
+ case ApptBar.TimeStampStyle of
+ tssFullI:
+ begin
+ OldColor := Pen.Color;
+ Pen.Color := ApptBar.TimeStampColor;
+ Pen.Width := ScreenToPrinter(2, False);
+
+ MoveTo(TimeStampRect.Left + 1, TimeStampRect.Top);
+ LineTo(TimeStampRect.Right - 1, TimeStampRect.Top);
+ MoveTo(TimeStampRect.Left + 1, TimeStampRect.Bottom - 1);
+ LineTo(TimeStampRect.Right - 1, TimeStampRect.Bottom - 1);
+
+ if ApptBar.Width > 5 then
+ Pen.Width := ScreenToPrinter(2, True)
+ else
+ Pen.Width := ScreenToPrinter(1, True);
+
+ // Printer bug, fixed
+ StampLeft := TimeStampRect.Left + RectWidth(TimeStampRect) div 2;
+ MoveTo(StampLeft, TimeStampRect.Top + 1);
+ LineTo(StampLeft, TimeStampRect.Bottom - 1);
+
+ Pen.Width := 1;
+
+ Pen.Color := OldColor;
+ end;
+ tssHalfI:
+ begin
+ // we only want the left half of the time stamp rect
+ TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2;
+
+ OldColor := Pen.Color;
+ Pen.Color := ApptBar.TimeStampColor;
+ Pen.Width := ScreenToPrinter(2, False);
+
+ MoveTo(TimeStampRect.Left, TimeStampRect.Top);
+ LineTo(TimeStampRect.Right - 0, TimeStampRect.Top);
+ MoveTo(TimeStampRect.Left, TimeStampRect.Bottom - 0);
+ LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom - 0);
+
+ if ApptBar.Width > 5 then
+ Pen.Width := ScreenToPrinter(2, True)
+ else
+ Pen.Width := ScreenToPrinter(1, True);
+
+ MoveTo(TimeStampRect.Right - 0, TimeStampRect.Top + 1);
+ LineTo(TimeStampRect.Right - 0, TimeStampRect.Bottom);
+ Pen.Color := OldColor;
+ Pen.Width := 1;
+ end;
+ tssBlock:
+ begin
+ // we only want the left half of the time stamp rect
+ TimeStampRect.Right := (TimeStampRect.Left + TimeStampRect.Right) div 2;
+
+ OldColor := Brush.Color;
+ Brush.Color := ApptBar.TimeStampColor;
+ FillRect(TimeStampRect);
+ Brush.Color := OldColor;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt;
+ BarRect: TRect; Col, StartRow, EndRow: Integer);
+var
+ OldColor: TColor;
+ TimeStampRect: TRect;
+begin
+ with ACanvas do
+ begin
+ // Fill Bar Color
+ OldColor := Brush.Color;
+ if Appt.BarColor = clDefault then
+ Brush.Color := ApptBar.Color
+ else
+ Brush.Color := Appt.BarColor;
+
+ FillRect(BarRect);
+ Brush.Color := OldColor;
+
+ // Draw Bar Border
+ Pen.Width := 1;
+ Pen.Color := ApptAttr.FrameColor;
+ MoveTo(BarRect.Right - 1, BarRect.Top);
+ LineTo(BarRect.Right - 1, BarRect.Bottom);
+
+ // Draw Time Stamp
+ TimeStampRect := CalcTimeStampRect(Appt, BarRect, Col, StartRow, EndRow);
+ if ApptBar.TimeStampStyle <> tssNone then
+ DrawTimeStamp(ACanvas, TimeStampRect);
+
+ if Assigned(FOnDrawApptBar) then
+ FOnDrawApptBar(Self, ACanvas, Appt, Col, BarRect, TimeStampRect);
+ end;
+end;
+
+{
+procedure TJvTFDaysPrinter.DrawApptBar(ACanvas: TCanvas; Appt: TJvTFAppt;
+ BarRect: TRect; Col, StartRow, EndRow: Integer);
+var
+ OldColor: TColor;
+ MarkerRect: TRect;
+ Offset,
+ ApptLength: TTime;
+ ColDate: TDate;
+ StartPercent,
+ EndPercent: Double;
+begin
+ With ACanvas do
+ begin
+ // Fill Bar Color
+ OldColor := Brush.Color;
+ if Appt.BarColor = clDefault then
+ Brush.Color := ApptBar.Color
+ else
+ Brush.Color := Appt.BarColor;
+
+ FillRect(BarRect);
+ Brush.Color := OldColor;
+
+ // Draw Bar Border
+ Pen.Width := 1;
+ Pen.Color := ApptAttr.FrameColor;
+ MoveTo(BarRect.Right - 1, BarRect.Top);
+ LineTo(BarRect.Right - 1, BarRect.Bottom);
+
+ // Draw Time Stamp
+ Case ApptBar.TimeStampStyle of
+ tssFullI :
+ begin
+ MarkerRect := BarRect;
+
+ Offset := RowToTime(StartRow);
+ ApptLength := RowEndTime(EndRow) - Offset;
+ ColDate := Cols[Col].SchedDate;
+
+ if Trunc(ColDate) <> Trunc(Appt.StartDate) then
+ StartPercent := 0
+ else
+ StartPercent := (Appt.StartTime - Offset) / ApptLength;
+
+ if Trunc(ColDate) <> Trunc(Appt.EndDate) then
+ EndPercent := 1.0
+ else
+ EndPercent := (Appt.EndTime - Offset) / ApptLength;
+
+ MarkerRect.Top := Round((BarRect.Bottom - BarRect.Top) *
+ StartPercent) + BarRect.Top;
+ MarkerRect.Bottom := Round((BarRect.Bottom - BarRect.Top) *
+ EndPercent) + BarRect.Top;
+
+ OldColor := Pen.Color;
+ Pen.Color := ApptBar.TimeStampColor;
+ Pen.Width := ScreenToPrinter(2, False);
+
+ MoveTo(MarkerRect.Left + 1, MarkerRect.Top);
+ LineTo(MarkerRect.Right - 1, MarkerRect.Top);
+ MoveTo(MarkerRect.Left + 1, MarkerRect.Bottom - 1);
+ LineTo(MarkerRect.Right - 1, MarkerRect.Bottom - 1);
+
+ if ApptBar.Width > 5 then
+ Pen.Width := ScreenToPrinter(2, True)
+ else
+ Pen.Width := ScreenToPrinter(1, True);
+
+ MoveTo((MarkerRect.Right) div 2, MarkerRect.Top + 1);
+ LineTo((MarkerRect.Right) div 2, MarkerRect.Bottom - 1);
+ Pen.Width := 1;
+
+ Pen.Color := OldColor;
+ end;
+
+ tssHalfI :
+ begin
+ MarkerRect := BarRect;
+ MarkerRect.Right := MarkerRect.Right div 2;
+
+ Offset := RowToTime(StartRow);
+ ApptLength := RowEndTime(EndRow) - Offset;
+ ColDate := Cols[Col].SchedDate;
+
+ if Trunc(ColDate) <> Trunc(Appt.StartDate) then
+ StartPercent := 0
+ else
+ StartPercent := (Appt.StartTime - Offset) / ApptLength;
+
+ if Trunc(ColDate) <> Trunc(Appt.EndDate) then
+ EndPercent := 1.0
+ else
+ EndPercent := (Appt.EndTime - Offset) / ApptLength;
+
+ MarkerRect.Top := Round((BarRect.Bottom - BarRect.Top) *
+ StartPercent) + BarRect.Top;
+ MarkerRect.Bottom := Round((BarRect.Bottom - BarRect.Top) *
+ EndPercent) + BarRect.Top;
+
+ OldColor := Pen.Color;
+ Pen.Color := ApptBar.TimeStampColor;
+ Pen.Width := ScreenToPrinter(2, False);
+
+ MoveTo(MarkerRect.Left, MarkerRect.Top);
+ LineTo(MarkerRect.Right - 0, MarkerRect.Top);
+ MoveTo(MarkerRect.Left, MarkerRect.Bottom - 0);
+ LineTo(MarkerRect.Right - 0, MarkerRect.Bottom - 0);
+
+ if ApptBar.Width > 5 then
+ Pen.Width := ScreenToPrinter(2, True)
+ else
+ Pen.Width := ScreenToPrinter(1, True);
+ MoveTo(MarkerRect.Right - 0, MarkerRect.Top + 1);
+ LineTo(MarkerRect.Right - 0, MarkerRect.Bottom);
+ Pen.Color := OldColor;
+ Pen.Width := 1;
+ end;
+
+ tssBlock :
+ begin
+ MarkerRect := BarRect;
+ MarkerRect.Right := MarkerRect.Right div 2;
+
+ Offset := RowToTime(StartRow);
+ ApptLength := RowEndTime(EndRow) - Offset;
+ ColDate := Cols[Col].SchedDate;
+
+ if Trunc(ColDate) <> Trunc(Appt.StartDate) then
+ StartPercent := 0
+ else
+ StartPercent := (Appt.StartTime - Offset) / ApptLength;
+
+ if Trunc(ColDate) <> Trunc(Appt.EndDate) then
+ EndPercent := 1.0
+ else
+ EndPercent := (Appt.EndTime - Offset) / ApptLength;
+
+ MarkerRect.Top := Round((BarRect.Bottom - BarRect.Top) *
+ StartPercent) + BarRect.Top;
+ MarkerRect.Bottom := Round((BarRect.Bottom - BarRect.Top) *
+ EndPercent) + BarRect.Top;
+
+ OldColor := Brush.Color;
+ Brush.Color := ApptBar.TimeStampColor;
+ FillRect(MarkerRect);
+ Brush.Color := OldColor;
+ end;
+ end;
+ end;
+end;
+}
+
+procedure TJvTFDaysPrinter.DrawApptDetail(ACanvas: TCanvas; ARect: TRect;
+ Appt: TJvTFAppt; Col, StartRow, EndRow: Integer);
+var
+ TheFrameRect, TxtRect, DetailRect, BarRect: TRect;
+ Txt: string;
+ Flags: UINT;
+ CanDrawText, CanDrawPics, CanDrawAppt: Boolean;
+ PicsHeight, PicsWidth: Integer;
+ DrawList: TList;
+ DrawInfo: TJvTFDaysApptDrawInfo;
+begin
+ with ACanvas do
+ begin
+ DrawInfo := TJvTFDaysApptDrawInfo.Create;
+ try
+ GetApptDrawInfo(DrawInfo, Appt);
+ Font.Assign(DrawInfo.Font);
+ Brush.Color := DrawInfo.Color;
+ Pen.Color := DrawInfo.FrameColor;
+ Pen.Width := DrawInfo.FrameWidth;
+ CanDrawAppt := DrawInfo.Visible;
+ finally
+ DrawInfo.Free;
+ end;
+
+ // !!!!!!!!!!!!!!!!!!!!!!!!!!
+ // EXIT IF NOTHING TO DRAW !!
+ // !!!!!!!!!!!!!!!!!!!!!!!!!!
+ if not CanDrawAppt then
+ Exit;
+
+ //Brush.Color := GetApptDispColor(Appt);
+ FillRect(ARect);
+
+ //Pen.Color := ApptAttr.FrameColor;
+ //Pen.Width := ApptAttr.FrameWidth;
+ TheFrameRect := ARect;
+ InflateRect(TheFrameRect, -(ApptAttr.FrameWidth div 2), -(ApptAttr.FrameWidth div 2));
+
+ // Need to fine tune the frame rect
+ if ApptAttr.FrameWidth mod 2 = 0 then
+ begin
+ Inc(TheFrameRect.Right);
+ Inc(TheFrameRect.Bottom);
+ end;
+
+ MoveTo(TheFrameRect.Left, TheFrameRect.Top);
+ LineTo(TheFrameRect.Right - 1, TheFrameRect.Top);
+ LineTo(TheFrameRect.Right - 1, TheFrameRect.Bottom - 1);
+ LineTo(TheFrameRect.Left, TheFrameRect.Bottom - 1);
+ LineTo(TheFrameRect.Left, TheFrameRect.Top);
+
+ // Only go through the following work if all details must be drawn
+ if (RectHeight(ARect) > Thresholds.DetailHeight) and
+ (RectWidth(ARect) > Thresholds.DetailWidth) then
+ begin
+ InflateRect(TheFrameRect, -(ApptAttr.FrameWidth div 2), -(ApptAttr.FrameWidth div 2));
+
+ DetailRect := TheFrameRect;
+
+ if ApptBar.Visible then
+ begin
+ Inc(DetailRect.Left, ApptBar.Width);
+ SubtractRect(BarRect, TheFrameRect, DetailRect);
+ Dec(BarRect.Bottom);
+ DrawApptBar(ACanvas, Appt, BarRect, Col, StartRow, EndRow);
+ end;
+
+ TxtRect := DetailRect;
+
+ InflateRect(TxtRect, -2, -2);
+
+ DrawList := TList.Create;
+ try
+ // Set the canvas' font now so text height and width calc's will
+ // be correct.
+ //Font := ApptAttr.Font;
+ CreatePicDrawList(TxtRect, Appt, DrawList);
+ FilterPicDrawList(TxtRect, DrawList, PicsHeight, PicsWidth);
+ // Calc'ing text height and width in CanDrawWhat
+ CanDrawWhat(ACanvas, TxtRect, PicsHeight, PicsWidth, CanDrawText, CanDrawPics);
+
+ if CanDrawPics then
+ begin
+ DrawListPics(ACanvas, TxtRect, DrawList);
+ Inc(TxtRect.Left, PicsWidth); // Mantis 2340: Be coherent with JvTFDays
+ end;
+ finally
+ ClearPicDrawList(DrawList);
+ DrawList.Free;
+ end;
+
+ if CanDrawText then
+ begin
+ Flags := DT_WORDBREAK or DT_NOPREFIX or DT_EDITCONTROL;
+
+ Txt := ScheduleManager.GetApptDisplayText(Self, Appt);
+
+ if not FormattedDesc then
+ begin
+ Txt := StripCRLF(Txt);
+ Flags := Flags or DT_END_ELLIPSIS;
+ end;
+
+ DrawText(ACanvas.Handle, PChar(Txt), -1, TxtRect, Flags);
+ end;
+ end;
+
+ if Assigned(FOnDrawAppt) then
+ FOnDrawAppt(Self, ACanvas, ARect, Appt, False);
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawAppts(ACanvas: TCanvas; DrawAll: Boolean;
+ PageInfo: TJvTFDaysPageInfo);
+var
+ FromCol, ToCol, FromRow, ToRow, Col, I: Integer;
+ ApptStartRow, ApptEndRow, SchedDate: Integer;
+ Appt: TJvTFAppt;
+begin
+ if Aborted then
+ Exit;
+
+ if DrawAll then
+ begin
+ FromCol := 0;
+ ToCol := Cols.Count - 1;
+ FromRow := 0;
+ ToRow := RowCount - 1;
+ end
+ else
+ begin
+ FromCol := PageInfo.StartCol;
+ ToCol := PageInfo.EndCol;
+ FromRow := PageInfo.StartRow;
+ ToRow := PageInfo.EndRow;
+ end;
+
+ if Assigned(FOnApptProgress) and (FApptsDrawn = 0) then
+ FOnApptProgress(Self, 0, ApptCount);
+ Application.ProcessMessages;
+
+ Col := FromCol;
+ while (Col <= ToCol) and not Aborted do
+ //For Col := FromCol to ToCol do
+ begin
+ if Cols[Col].Connected and not Aborted then
+ begin
+ SchedDate := Trunc(Cols[Col].SchedDate);
+ I := 0;
+ while (I < Cols[Col].Schedule.ApptCount) and not Aborted do
+ //For I := 0 to Cols[Col].Schedule.ApptCount - 1 do
+ begin
+ Appt := Cols[Col].Schedule.Appts[I];
+
+ CalcStartEndRows(Appt, SchedDate, ApptStartRow, ApptEndRow);
+
+ if (ApptStartRow <= ToRow) and (ApptEndRow >= FromRow) then
+ begin
+ DrawAppt(ACanvas, Col, Appt, ApptStartRow, ApptEndRow, PageInfo);
+ Inc(FApptsDrawn);
+ if Assigned(FOnApptProgress) then
+ FOnApptProgress(Self, FApptsDrawn, ApptCount);
+ Application.ProcessMessages;
+ end;
+ Inc(I);
+ end;
+ end;
+ Inc(Col);
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawBody(ACanvas: TCanvas; ARect: TRect;
+ PageNum: Integer);
+var
+ SaveMeasure: TJvTFPrinterMeasure;
+ lPageInfo: TJvTFDaysPageInfo;
+ I, J: Integer;
+begin
+ if Aborted then
+ Exit;
+
+ SaveMeasure := Measure;
+ Measure := pmPixels;
+
+ lPageInfo := TJvTFDaysPageInfo(FPageInfoList.Objects[PageNum - 1]);
+
+ with ACanvas do
+ begin
+ Brush.Color := Self.Color;
+ FillRect(ARect);
+
+ DrawCorner(ACanvas);
+
+ if lPageInfo.ShowColHdr then
+ begin
+ if Cols.Count = 0 then
+ DrawEmptyColHdr(ACanvas, lPageInfo)
+ else
+ begin
+ DrawGroupHdrs(ACanvas, lPageInfo);
+ for I := lPageInfo.StartCol to lPageInfo.EndCol do
+ begin
+ if Aborted then
+ Break;
+ //DrawColHdr(ACanvas, I, lPageInfo);
+ DrawColGroupHdr(ACanvas, I, lPageInfo, False);
+ end;
+ end;
+ end;
+
+ if lPageInfo.ShowRowHdr then
+ if RowHdrType = rhFancy then
+ DrawFancyRowHdrs(ACanvas, lPageInfo)
+ else
+ for I := lPageInfo.StartRow to lPageInfo.EndRow do
+ begin
+ if Aborted then
+ Break;
+ DrawRowHdr(ACanvas, I, lPageInfo);
+ end;
+
+ for I := lPageInfo.StartRow to lPageInfo.EndRow do
+ for J := lPageInfo.StartCol to lPageInfo.EndCol do
+ begin
+ if Aborted then
+ Break;
+ DrawDataCell(ACanvas, J, I, lPageInfo);
+ end;
+
+ if not (csDesigning in ComponentState) and not Aborted then
+ DrawAppts(ACanvas, False, lPageInfo);
+ end;
+
+ Measure := SaveMeasure;
+
+ inherited DrawBody(ACanvas, ARect, PageNum);
+end;
+
+{
+procedure TJvTFDaysPrinter.DrawColHdr(ACanvas: TCanvas; Index: Integer;
+ PageInfo: TJvTFDaysPageInfo);
+var
+ ARect,
+ TxtRect,
+ CalcRect: TRect;
+ Txt: string;
+ PTxt: PChar;
+ Flags: UINT;
+ TxtHt,
+ TxtRectHt: Integer;
+begin
+ ARect := CellRect(Index, -1, PageInfo);
+
+ //Txt := Copy(Cols[Index].Title, 1, Length(Cols[Index].Title));
+ Txt := Cols[Index].Title;
+
+ ACanvas.Brush.Color := HdrAttr.Color;
+ ACanvas.Font.Assign(HdrAttr.Font);
+
+ Flags := DT_NOPREFIX or DT_CENTER;
+ Case ColTitleStyle of
+ ctsSingleClip : Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ ctsSingleEllipsis: Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or
+ DT_VCENTER;
+ ctsMultiClip : Flags := Flags or DT_WORDBREAK;
+ ctsMultiEllipsis : Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or
+ DT_EDITCONTROL;
+ ctsHide : Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ end;
+
+ ACanvas.FillRect(ARect);
+ TxtRect := ARect;
+ Windows.InflateRect(TxtRect, -2, -2);
+ CalcRect := TxtRect;
+
+ //PTxt := StrNew(PChar(Txt));
+ PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char));
+ StrPCopy(PTxt, Txt);
+
+ if (ColTitleStyle = ctsMultiClip) or
+ (ColTitleStyle = ctsMultiEllipsis) then
+ begin
+ TxtHt := Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect,
+ Flags or DT_CALCRECT);
+
+ if TxtHt < RectHeight(TxtRect) then
+ begin
+ // we need to vertically center the text
+ TxtRectHt := RectHeight(TxtRect);
+ TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2;
+ TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom);
+ end;
+ end
+ else
+ if ColTitleStyle = ctsHide then
+ begin
+ Windows.DrawText(ACanvas.Handle, PTxt, -1, CalcRect, Flags or DT_CALCRECT);
+ if RectWidth(CalcRect) > RectWidth(TxtRect) then
+ StrPCopy(PTxt, '');
+ end;
+
+ Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+ StrDispose(PTxt);
+
+ DrawFrame(ACanvas, ARect, HdrAttr.Frame3D);
+
+ if Assigned(FOnDrawColHdr) then
+ FOnDrawColHdr(Self, ACanvas, ARect, Index, False);
+end;
+}
+
+procedure TJvTFDaysPrinter.DrawCorner(ACanvas: TCanvas);
+var
+ ARect: TRect;
+begin
+ //group ARect := Classes.Rect(0, 0, RowHdrWidth, ColHdrHeight);
+ ARect := Classes.Rect(0, 0, RowHdrWidth, CalcGroupColHdrsHeight);
+ with ACanvas do
+ begin
+ Brush.Color := HdrAttr.Color;
+ FillRect(ARect);
+
+ if HdrAttr.Frame3D then
+ DrawFrame(ACanvas, ARect, HdrAttr.Frame3D)
+ else
+ begin
+ if RowHdrType = rhFancy then
+ begin
+ Pen.Color := FancyRowHdrAttr.TickColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom - 1);
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ end
+ else
+ DrawFrame(ACanvas, ARect, False);
+ end;
+
+ if Assigned(FOnDrawCorner) then
+ FOnDrawCorner(Self, ACanvas, ARect, agcTopLeft);
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawDataCell(ACanvas: TCanvas; ColIndex,
+ RowIndex: Integer; PageInfo: TJvTFDaysPageInfo);
+var
+ ARect: TRect;
+ PrimeStartRow, PrimeEndRow: Integer;
+ CellColor: TColor;
+begin
+ // Calc the cell rect
+ if PageInfo.ShowRowHdr then
+ ARect.Left := RowHdrWidth
+ else
+ ARect.Left := 0;
+
+ ARect.Left := ARect.Left + (ColIndex - PageInfo.StartCol) * PageInfo.ColWidth;
+ ARect.Right := ARect.Left + PageInfo.ColWidth;
+
+ { variable col widths, leave for future reference
+ For I := LeftCol to ColIndex - 1 do
+ Inc(ARect.Left, Cols[I].Width);
+ ARect.Right := ARect.Left + Cols[ColIndex].Width;
+ }
+
+ if PageInfo.ShowColHdr then
+ //group ARect.Top := ColHdrHeight
+ ARect.Top := CalcGroupColHdrsHeight
+ else
+ ARect.Top := 0;
+
+ ARect.Top := ARect.Top + (RowIndex - PageInfo.StartRow) * PageInfo.RowHeight;
+ ARect.Bottom := ARect.Top + PageInfo.RowHeight;
+
+ PrimeStartRow := TimeToRow(PrimeTime.StartTime);
+ PrimeEndRow := TimeToRow(AdjustEndTime(PrimeTime.EndTime));
+
+ if (RowIndex >= PrimeStartRow) and (RowIndex <= PrimeEndRow) then
+ CellColor := PrimeTime.Color
+ else
+ CellColor := Color;
+
+ if Assigned(FOnShadeCell) then
+ FOnShadeCell(Self, ColIndex, RowIndex, CellColor);
+
+ if CellColor <> Color then
+ begin
+ ACanvas.Brush.Color := CellColor;
+ ACanvas.FillRect(ARect);
+ end;
+
+ // Draw a line across the ARect.Bottom and down the ARect.Right side
+ with ACanvas do
+ begin
+ Pen.Color := GridLineColor;
+ Pen.Width := 1;
+
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom - 1);
+ end;
+
+ if Assigned(FOnDrawDataCell) then
+ FOnDrawDataCell(Self, ACanvas, ARect, ColIndex, RowIndex);
+end;
+
+procedure TJvTFDaysPrinter.DrawEmptyColHdr(ACanvas: TCanvas;
+ PageInfo: TJvTFDaysPageInfo);
+var
+ ARect: TRect;
+begin
+ ARect.Left := RowHdrWidth;
+ ARect.Top := 0;
+ ARect.Right := ARect.Left + GetDataWidth(PageInfo.ShowRowHdr);
+ //group ARect.Bottom := ColHdrHeight;
+ ARect.Bottom := CalcGroupColHdrsHeight;
+
+ with ACanvas do
+ begin
+ Brush.Color := HdrAttr.Color;
+ FillRect(ARect);
+ Pen.Color := clGray;
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawFancyRowHdrs(ACanvas: TCanvas;
+ PageInfo: TJvTFDaysPageInfo);
+var
+ I, MajorTickLength, MinorTickLength, TickLength: Integer;
+ ARect: TRect;
+ Lbl: string;
+ PrevHour, CurrentHour: Word;
+ FirstMajor, Switch: Boolean;
+begin
+ MajorTickLength := GetMajorTickLength;
+ MinorTickLength := GetMinorTickLength(ACanvas);
+
+ FirstMajor := True;
+ PrevHour := RowToHour(PageInfo.StartRow);
+ for I := PageInfo.StartRow to PageInfo.EndRow do
+ begin
+ CurrentHour := RowToHour(I);
+
+ Switch := (CurrentHour <> PrevHour) or (I = PageInfo.EndRow);
+
+ ARect := CellRect(-1, I, PageInfo);
+ Lbl := GetMinorLabel(I, PageInfo);
+ if not RowEndsHour(I) then
+ TickLength := MinorTickLength
+ else
+ TickLength := MajorTickLength;
+
+ DrawMinor(ACanvas, ARect, I, Lbl, TickLength);
+
+ // Draw Major if needed
+ if Switch and (Granularity <> 60) then
+ begin
+ if I <> PageInfo.StartRow + 1 then
+ begin
+ ARect.Left := 1; // Allow for a small margin on ARect.Left side
+ ARect.Right := RowHdrWidth; // No "cutting" before the end of the cell.
+ ARect.Top := CellRect(-1, HourStartRow(PrevHour), PageInfo).Top;
+
+ //group if ARect.Top < ColHdrHeight then
+ //group ARect.Top := ColHdrHeight;
+ if ARect.Top < CalcGroupColHdrsHeight then
+ ARect.Top := CalcGroupColHdrsHeight;
+ ARect.Bottom := CellRect(-1, HourEndRow(PrevHour), PageInfo).Bottom - 1;
+
+ // No need to check for ARect.Bottom to be outside the page, CellRect
+ // calculates it so that it does not happen. And using GetDataHeight
+ // is not a good idea as it removes the column header height, which
+ // is NOT what we want here as we want the page's integral height.
+ // If we wer to use it, we would trigger Mantis 2340.
+
+ if FancyRowHdrAttr.Hr2400 then
+ Lbl := IntToStr(PrevHour)
+ else
+ begin
+ if PrevHour = 0 then
+ Lbl := '12'
+ else
+ if PrevHour > 12 then
+ Lbl := IntToStr(PrevHour - 12)
+ else
+ Lbl := IntToStr(PrevHour);
+
+ if FirstMajor or (PrevHour = 0) or (PrevHour = 12) then
+ if PrevHour < 12 then
+ Lbl := Lbl + 'a'
+ else
+ Lbl := Lbl + 'p';
+ end;
+
+ ACanvas.Font.Assign(FancyRowHdrAttr.MajorFont);
+ ACanvas.Brush.Style := bsClear;
+
+ DrawText(ACanvas.Handle, PChar(Lbl), -1, ARect,
+ DT_NOPREFIX or DT_SINGLELINE or DT_LEFT or DT_VCENTER);
+
+ if Assigned(FOnDrawMajorRowHdr) then
+ FOnDrawMajorRowHdr(Self, ACanvas, ARect, I - 1, False);
+
+ FirstMajor := False;
+ end;
+ if Switch then
+ PrevHour := CurrentHour;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawFrame(ACanvas: TCanvas; ARect: TRect;
+ Draw3D: Boolean);
+var
+ OldPenColor: TColor;
+begin
+ with ACanvas do
+ begin
+ OldPenColor := Pen.Color;
+
+ if Draw3D then
+ Pen.Color := clBtnShadow
+ else
+ Pen.Color := GridLineColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+
+ if Draw3D then
+ begin
+ Pen.Color := clBtnHighlight;
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Right, ARect.Top);
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Left, ARect.Bottom);
+ end;
+
+ Pen.Color := OldPenColor;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawListPics(ACanvas: TCanvas;
+ var ARect: TRect; DrawList: TList);
+var
+ I: Integer;
+ DrawInfo: TJvTFDrawPicInfo;
+ Pic: TBitmap;
+ DestRect: TRect;
+begin
+ Pic := TBitmap.Create;
+ Pic.Canvas.Brush.Color := ACanvas.Brush.Color;
+ try
+ for I := 0 to DrawList.Count - 1 do
+ begin
+ DrawInfo := TJvTFDrawPicInfo(DrawList[I]);
+ Pic.Height := DrawInfo.ImageList.Height;
+ Pic.Width := DrawInfo.ImageList.Width;
+ Pic.Canvas.FillRect(Classes.Rect(0, 0, Pic.Width, Pic.Height));
+ with DrawInfo do
+ ImageList.Draw(Pic.Canvas, 0, 0, ImageIndex);
+ DestRect.Left := DrawInfo.PicLeft;
+ DestRect.Top := DrawInfo.PicTop;
+ DestRect.Right := DrawInfo.PicLeft +
+ ScreenToPrinter(DrawInfo.ImageList.Width + 2, True);
+ DestRect.Bottom := DrawInfo.PicTop +
+ ScreenToPrinter(DrawInfo.ImageList.Height + 2, False);
+ PrintBitmap(ACanvas, Classes.Rect(0, 0, Pic.Width, Pic.Height), DestRect, Pic);
+ end;
+ finally
+ Pic.Free;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.DrawMinor(ACanvas: TCanvas; ARect: TRect;
+ RowNum: Integer; const LabelStr: string; TickLength: Integer);
+var
+ MinorRect, TxtRect: TRect;
+begin
+ // do the background shading
+ ACanvas.Brush.Color := FancyRowHdrAttr.Color;
+ ACanvas.FillRect(ARect);
+
+ MinorRect := ARect;
+ MinorRect.Left := MinorRect.Right - GetMinorTickLength(ACanvas);
+
+ with ACanvas do
+ begin
+ // draw the right border line
+ Pen.Color := FancyRowHdrAttr.TickColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+
+ // now draw the tick
+ MoveTo(ARect.Right - 1, ARect.Bottom - 1);
+ LineTo(ARect.Right - 1 - TickLength, ARect.Bottom - 1);
+ end;
+
+ // set up a 2 pel margin on the right and bottom sides
+ TxtRect := ARect;
+ TxtRect.Right := TxtRect.Right - 2;
+ TxtRect.Bottom := TxtRect.Bottom - 2;
+
+ // now draw the LabelStr right aligned
+ ACanvas.Font.Assign(FancyRowHdrAttr.MinorFont);
+ ACanvas.Brush.Style := bsClear;
+
+ DrawText(ACanvas.Handle, PChar(LabelStr), -1, TxtRect,
+ DT_SINGLELINE or DT_RIGHT or DT_NOPREFIX or DT_VCENTER);
+
+ if Assigned(FOnDrawMinorRowHdr) then
+ FOnDrawMinorRowHdr(Self, ACanvas, ARect, RowNum, False);
+end;
+
+procedure TJvTFDaysPrinter.DrawRowHdr(ACanvas: TCanvas; Index: Integer;
+ PageInfo: TJvTFDaysPageInfo);
+var
+ ARect: TRect;
+ Txt: string;
+begin
+ ARect.Left := 0;
+ if PageInfo.ShowColHdr then
+ //group Top := ColHdrHeight
+ ARect.Top := CalcGroupColHdrsHeight
+ else
+ ARect.Top := 0;
+ ARect.Top := ARect.Top + (Index - PageInfo.StartRow) * PageInfo.RowHeight;
+ ARect.Right := RowHdrWidth;
+ ARect.Bottom := ARect.Top + PageInfo.RowHeight;
+
+ Txt := FormatDateTime(TimeFormat, RowToTime(Index));
+
+ ACanvas.Brush.Color := HdrAttr.Color;
+ ACanvas.Font.Assign(HdrAttr.Font);
+
+ DrawTxt(ACanvas, ARect, Txt, taCenter, vaCenter);
+
+ DrawFrame(ACanvas, ARect, HdrAttr.Frame3D);
+
+ if Assigned(FOnDrawRowHdr) then
+ FOnDrawRowHdr(Self, ACanvas, ARect, Index, False);
+end;
+
+procedure TJvTFDaysPrinter.EnsureRow(RowNum: Integer);
+begin
+ if RowNum >= RowCount then
+ raise EJvTFPrinterError.CreateResFmt(@RsEInvalidRowd, [RowNum]);
+end;
+
+procedure TJvTFDaysPrinter.FilterPicDrawList(ARect: TRect;
+ DrawList: TList; var PicsHeight: Integer; var PicsWidth: Integer);
+var
+ I, NextPicLeft, PicRight, PicBottom: Integer;
+ DrawIt: Boolean;
+ DrawInfo: TJvTFDrawPicInfo;
+begin
+ PicsHeight := 0;
+ PicsWidth := 0;
+ if DrawList.Count = 0 then
+ Exit;
+
+ if Thresholds.PicsAllOrNone then
+ begin
+ DrawInfo := TJvTFDrawPicInfo(DrawList[DrawList.Count - 1]);
+ PicRight := DrawInfo.PicLeft + ScreenToPrinter(DrawInfo.ImageList.Width, True);
+ if PicRight >= ARect.Right then
+ begin
+ while DrawList.Count > 0 do
+ begin
+ TJvTFDrawPicInfo(DrawList[0]).Free;
+ DrawList.Delete(0);
+ end;
+ end;
+ end;
+
+ PicsHeight := 0;
+ NextPicLeft := ARect.Left;
+ I := 0;
+ while I < DrawList.Count do
+ begin
+ DrawInfo := TJvTFDrawPicInfo(DrawList[I]);
+ with DrawInfo do
+ begin
+ PicRight := PicLeft + ScreenToPrinter(ImageList.Width + 2, True);
+ PicBottom := PicTop + ScreenToPrinter(ImageList.Height + 2, False);
+ DrawIt := True;
+
+ if Thresholds.WholePicsOnly and
+ (PicRight >= ARect.Right) or (PicBottom >= ARect.Bottom) then
+ DrawIt := False;
+
+ if DrawIt then
+ begin
+ //PicsHeight := Greater(PicsHeight, ImageList.Height + 2);
+ PicsHeight := Greater(PicsHeight, PicBottom - PicTop + 2);
+ PicLeft := NextPicLeft;
+ //Inc(NextPicLeft, ImageList.Width + 2);
+ Inc(NextPicLeft, PicRight - PicLeft + 2);
+ // Increment I to move onto next pic in list
+ Inc(I);
+ end
+ else // Remove pic from list
+ begin
+ // Remove pic from list
+ DrawInfo.Free;
+ DrawList.Delete(I);
+ // DO NOT increment I - Since pic was removed from list
+ // I will now point to next pic
+ end;
+ end;
+ end;
+ PicsWidth := NextPicLeft - ARect.Left;
+end;
+
+function TJvTFDaysPrinter.GetApptDispColor(Appt: TJvTFAppt): TColor;
+begin
+ if Appt.Color = clDefault then
+ Result := ApptAttr.Color
+ else
+ Result := Appt.Color;
+end;
+
+function TJvTFDaysPrinter.GetApptRect(Col: Integer; Appt: TJvTFAppt;
+ PageInfo: TJvTFDaysPageInfo): TRect;
+var
+ MapCol, MapColCount, Base, MakeUp, BaseWidth, MakeUpWidth: Integer;
+ BaseCount, GridColWidth, ApptWidth, StartRow, EndRow: Integer;
+ WorkLeft, WorkTop: Integer;
+begin
+ if not Assigned(Appt) then
+ begin
+ Result := EmptyRect;
+ Exit;
+ end;
+
+ CalcStartEndRows(Appt, Cols[Col].SchedDate, StartRow, EndRow);
+
+ if (StartRow < 0) and (EndRow >= 0) then
+ StartRow := 0;
+ // if the above condition fails and the StartRow is STILL invalid then
+ // let the 'Map col not found' catch the error.
+
+ // Printer bug, fixed
+ EndRow := Lesser(EndRow, PageInfo.EndRow);
+
+ MapCol := Cols[Col].LocateMapCol(Appt, StartRow);
+ if MapCol < 1 then
+ begin
+ raise EJvTFDaysError.CreateRes(@RsEMapColNotFoundForAppointment);
+ end;
+
+ MapColCount := Cols[Col].MapColCount(StartRow);
+ if MapColCount < 1 then
+ begin
+ //Cols[Col].FMap.Dump('corrupt dump.txt'); !!! FOR DEBUGGING ONLY !!!!
+ raise EJvTFPrinterError.CreateRes(@RsECorruptAppointmentMap);
+ end;
+
+ // Col guaranteed to be partially visible
+ // Printer bug start, fixed
+ WorkLeft := CellRect(Col, Greater(StartRow, PageInfo.StartRow), PageInfo).Left;
+ if StartRow < PageInfo.StartRow then
+ WorkTop := CellRect(Col, PageInfo.StartRow, PageInfo).Top -
+ PageInfo.RowHeight * (PageInfo.StartRow - StartRow)
+ else
+ WorkTop := CellRect(Col, StartRow, PageInfo).Top;
+ // Printer bug end, fixed
+
+ GridColWidth := PageInfo.ColWidth;
+
+ // The Base* and MakeUp* code that follows calc's the appt width and left
+ // and takes into account a total width that isn't evenly divisible by
+ // the map col count. if there is a discrepency then that discrepency
+ // is divvied up amoung the cols working Result.Left to Result.Right.
+ //
+ // Example: Total width = 113, col count = 5
+ // col 1 = 23
+ // col 2 = 23
+ // col 3 = 23
+ // col 4 = 22
+ // col 5 = 22
+ // Total = 113
+ //
+ // As opposed to:
+ // width of all cols = Total div colcount = 22
+ // ==> Total = 22 * 5 = 110 [110 <> 113]
+ Base := GridColWidth div MapColCount;
+ MakeUp := GridColWidth mod MapColCount;
+
+ MakeUpWidth := Lesser(MapCol - 1, MakeUp) * (Base + 1);
+ BaseCount := MapCol - 1 - MakeUp;
+ if BaseCount > 0 then
+ BaseWidth := BaseCount * Base
+ else
+ BaseWidth := 0;
+
+ ApptWidth := Base;
+ if MapCol <= MakeUp then
+ Inc(ApptWidth);
+
+ // Printer bug, fixed
+ Result.Left := WorkLeft + MakeUpWidth + BaseWidth;
+
+ Result.Right := Result.Left + ApptWidth - ApptBuffer;
+
+ // Printer bug, fixed
+ Result.Top := WorkTop;
+
+ Result.Bottom := CellRect(Col, EndRow, PageInfo).Bottom;
+end;
+
+function TJvTFDaysPrinter.GetDataHeight(ShowColHdr: Boolean): Integer;
+begin
+ Result := BodyHeight;
+ if ShowColHdr then
+ //group Dec(Result, ConvertMeasure(ColHdrHeight, Measure, pmPixels, False));
+ Dec(Result, ConvertMeasure(CalcGroupColHdrsHeight, Measure, pmPixels, False));
+end;
+
+function TJvTFDaysPrinter.GetDataWidth(ShowRowHdr: Boolean): Integer;
+begin
+ Result := BodyWidth;
+ if ShowRowHdr then
+ Dec(Result, ConvertMeasure(RowHdrWidth, Measure, pmPixels, True));
+end;
+
+function TJvTFDaysPrinter.GetMajorTickLength: Integer;
+begin
+ Result := RowHdrWidth;
+end;
+
+function TJvTFDaysPrinter.GetMinorLabel(RowNum: Integer;
+ PageInfo: TJvTFDaysPageInfo): string;
+const
+ Full24 = 'h:nn';
+ FullAP = 'h:nna/p';
+ MinOnly = ':nn';
+var
+ TimeFmt: string;
+ LastFullRow, LastHourStart: Integer;
+ LastHour: Word;
+begin
+ if Granularity = 60 then
+ TimeFmt := Full24
+ else
+ if (RowNum = PageInfo.StartRow) and not RowStartsHour(RowNum) then
+ TimeFmt := Full24
+ else
+ begin
+ LastFullRow := PageInfo.EndRow;
+ LastHour := RowToHour(LastFullRow);
+ LastHourStart := HourStartRow(LastHour);
+
+ if ((RowNum = LastHourStart) and not RowStartsHour(RowNum)) or
+ ((LastHourStart = PageInfo.StartRow) and (RowNum = PageInfo.StartRow)) then
+ TimeFmt := Full24
+ else
+ TimeFmt := MinOnly;
+ end;
+
+ if (TimeFmt = Full24) and not FancyRowHdrAttr.Hr2400 then
+ TimeFmt := FullAP;
+
+ Result := FormatDateTime(TimeFmt, RowToTime(RowNum));
+end;
+
+function TJvTFDaysPrinter.GetMinorTickLength(ACanvas: TCanvas): Integer;
+var
+ TempFont: TFont;
+begin
+ TempFont := TFont.Create;
+ try
+ TempFont.Assign(ACanvas.Font);
+ ACanvas.Font.Assign(FancyRowHdrAttr.MinorFont);
+ Result := ACanvas.TextWidth('22:22a');
+ ACanvas.Font.Assign(TempFont);
+ finally
+ TempFont.Free;
+ end;
+end;
+
+function TJvTFDaysPrinter.HourEndRow(Hour: Word): Integer;
+begin
+ Result := TimeToRow(EncodeTime(Hour, 59, 0, 0));
+end;
+
+function TJvTFDaysPrinter.HourStartRow(Hour: Word): Integer;
+begin
+ Result := TimeToRow(EncodeTime(Hour, 0, 0, 0));
+end;
+
+procedure TJvTFDaysPrinter.Loaded;
+var
+ I: Integer;
+begin
+ inherited Loaded;
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].Connect;
+end;
+
+procedure TJvTFDaysPrinter.Prepare;
+var
+ I: Integer;
+begin
+ NewDoc;
+ try
+ FApptsDrawn := 0;
+ CalcPageInfo;
+ if FPageInfoList.Count = 0 then
+ raise EJvTFPrinterError.CreateRes(@RsEThereIsNoDataToPrint);
+
+ for I := 0 to FPageInfoList.Count - 1 do
+ NewPage;
+ //Except on EJvTFPrinterError do
+ except
+ begin
+ FreeDoc;
+ raise;
+ end;
+ end;
+ FApptsDrawn := 0;
+ FinishDoc;
+end;
+
+function TJvTFDaysPrinter.RowCount: Integer;
+var
+ Adjustment, H, M, S, MS: Word;
+ WorkTime: TTime;
+begin
+ WorkTime := GridEndTime;
+
+ DecodeTime(WorkTime, H, M, S, MS);
+ Adjustment := 0;
+
+ if (H = 0) and (M = 0) then
+ begin
+ WorkTime := EncodeTime(23, 59, 59, 999);
+ Adjustment := 1;
+ end;
+
+ //DecodeTime(GridEndTime - GridStartTime, H, M, S, MS);
+ DecodeTime(WorkTime - GridStartTime, H, M, S, MS);
+ Result := (H * 60 + M) div Granularity + Adjustment;
+end;
+
+function TJvTFDaysPrinter.RowEndsHour(RowNum: Integer): Boolean;
+var
+ H, M, S, MS: Word;
+ TempTime: TTime;
+begin
+ EnsureRow(RowNum);
+
+ TempTime := RowToTime(RowNum) + EncodeTime(0, Granularity - 1, 0, 0);
+ DecodeTime(TempTime, H, M, S, MS);
+ Result := M = 59;
+end;
+
+function TJvTFDaysPrinter.RowEndTime(RowNum: Integer): TTime;
+begin
+ Result := RowToTime(RowNum) +
+ Granularity * EncodeTime(0, 1, 0, 0) - EncodeTime(0, 0, 1, 0);
+end;
+
+function TJvTFDaysPrinter.RowStartsHour(RowNum: Integer): Boolean;
+var
+ H, M, S, MS: Word;
+begin
+ EnsureRow(RowNum);
+
+ DecodeTime(RowToTime(RowNum), H, M, S, MS);
+ Result := M = 0;
+end;
+
+function TJvTFDaysPrinter.RowToHour(RowNum: Integer): Word;
+var
+ H, M, S, MS: Word;
+begin
+ DecodeTime(RowToTime(RowNum), H, M, S, MS);
+ Result := H;
+end;
+
+function TJvTFDaysPrinter.RowToTime(RowNum: Integer): TTime;
+var
+ TotalMins: Integer;
+ WorkHours, WorkMins: Word;
+ H, M, S, MS: Word;
+ Offset: Integer;
+begin
+ DecodeTime(GridStartTime, H, M, S, MS);
+ Offset := H * 60 + M;
+ TotalMins := RowNum * Granularity + Offset;
+
+ WorkHours := TotalMins div 60;
+ WorkMins := TotalMins mod 60;
+ if WorkHours < 24 then
+ Result := EncodeTime(WorkHours, WorkMins, 0, 0)
+ else
+ Result := EncodeTime(23, 59, 59, 999);
+end;
+
+procedure TJvTFDaysPrinter.SetApptAttr(Value: TJvTFDaysApptAttr);
+begin
+ SetPropertyCheck;
+ FApptAttr.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetApptBar(Value: TJvTFDaysApptBar);
+begin
+ SetPropertyCheck;
+ FApptBar.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetApptBuffer(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < 0 then
+ Value := 0;
+ FApptBuffer := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetColHdrHeight(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < 0 then
+ Value := 0;
+ FColHdrHeight := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetColor(Value: TColor);
+begin
+ SetPropertyCheck;
+ FColor := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetCols(Value: TJvTFDaysCols);
+begin
+ FCols.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetTFColTitleStyle(Value: TJvTFColTitleStyle);
+begin
+ SetPropertyCheck;
+ FColTitleStyle := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetFancyRowHdrAttr(Value: TJvTFDaysFancyRowHdrAttr);
+begin
+ SetPropertyCheck;
+ FFancyRowHdrAttr.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetGranularity(Value: Integer);
+var
+ MaxRowHeight, I: Integer;
+begin
+ SetPropertyCheck;
+
+ // Enforce minimum granularity of 1 min and max of 60 mins
+ if Value < 1 then
+ Value := 1
+ else
+ if Value > 60 then
+ Value := 60;
+
+ // Ensure that granularity is evenly divisable by an hour
+ while 60 mod Value <> 0 do
+ Dec(Value);
+
+ // Sum of row heights cannot exceed 32767
+ MaxRowHeight := 32767 div (60 div Value * 24);
+ if RowHeight > MaxRowHeight then
+ RowHeight := MaxRowHeight;
+
+ if Value <> FGranularity then
+ begin
+ FGranularity := Value;
+ if not (csLoading in ComponentState) then
+ begin
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].RefreshMap;
+ end;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.SetGridLineColor(Value: TColor);
+begin
+ SetPropertyCheck;
+ FGridLineColor := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ SetPropertyCheck;
+ FHdrAttr.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetMeasure(Value: TJvTFPrinterMeasure);
+var
+ I: Integer;
+begin
+ try
+ FConvertingProps := True;
+ if Value <> Measure then
+ begin
+ // convert properties
+ ApptAttr.FrameWidth := ConvertMeasure(ApptAttr.FrameWidth, Measure,
+ Value, False);
+ ApptBar.Width := ConvertMeasure(ApptBar.Width, Measure, Value, True);
+ ApptBuffer := ConvertMeasure(ApptBuffer, Measure, Value, True);
+ ColHdrHeight := ConvertMeasure(ColHdrHeight, Measure, Value, False);
+ GroupHdrHeight := ConvertMeasure(GroupHdrHeight, Measure, Value, False);
+
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].Width := ConvertMeasure(Cols[I].Width, Measure, Value, True);
+
+ MinColWidth := ConvertMeasure(MinColWidth, Measure, Value, True);
+ MinRowHeight := ConvertMeasure(MinRowHeight, Measure, Value, False);
+ RowHdrWidth := ConvertMeasure(RowHdrWidth, Measure, Value, True);
+ RowHeight := ConvertMeasure(RowHeight, Measure, Value, False);
+ Thresholds.DetailHeight := ConvertMeasure(Thresholds.DetailHeight,
+ Measure, Value, False);
+ Thresholds.DetailWidth := ConvertMeasure(Thresholds.DetailWidth,
+ Measure, Value, True);
+
+ inherited SetMeasure(Value);
+ end;
+ finally
+ FConvertingProps := False;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.SetMinColWidth(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < AbsMinColWidth then
+ Value := AbsMinColWidth;
+ FMinColWidth := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetMinRowHeight(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < 1 then
+ Value := 1;
+ FMinRowHeight := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetPrimeTime(Value: TJvTFDaysPrimeTime);
+begin
+ SetPropertyCheck;
+ FPrimeTime.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetProperties(aJvTFDays: TJvTFDays);
+begin
+ ApptAttr := aJvTFDays.ApptAttr;
+ ApptAttr.FrameWidth :=
+ ConvertMeasure(ScreenToPrinter(ApptAttr.FrameWidth, False), pmPixels,
+ Measure, False);
+
+ ApptBar := aJvTFDays.ApptBar;
+ ApptBar.Width := ConvertMeasure(ScreenToPrinter(ApptBar.Width, True), pmPixels,
+ Measure, True);
+
+ ApptBuffer := ConvertMeasure(ScreenToPrinter(aJvTFDays.ApptBuffer, True),
+ pmPixels, Measure, True);
+ ColHdrHeight := ConvertMeasure(ScreenToPrinter(aJvTFDays.ColHdrHeight, False),
+ pmPixels, Measure, False);
+
+ Color := aJvTFDays.Color;
+ ColTitleStyle := aJvTFDays.ColTitleStyle;
+ DateFormat := aJvTFDays.DateFormat;
+ FancyRowHdrAttr := aJvTFDays.FancyRowHdrAttr;
+ FormattedDesc := agoFormattedDesc in aJvTFDays.Options;
+ Granularity := aJvTFDays.Granularity;
+ GridLineColor := aJvTFDays.GridLineColor;
+ GroupHdrAttr := aJvTFDays.GroupHdrAttr;
+ //GroupHdrHeight := aJvTFDays.GroupHdrHeight;
+ GroupHdrHeight := ConvertMeasure(ScreenToPrinter(aJvTFDays.GroupHdrHeight,
+ False), pmPixels, Measure, False);
+ Grouping := aJvTFDays.Grouping;
+ HdrAttr := aJvTFDays.HdrAttr;
+
+ MinColWidth := ConvertMeasure(ScreenToPrinter(aJvTFDays.MinColWidth, True),
+ pmPixels, Measure, True);
+
+ PrimeTime := aJvTFDays.PrimeTime;
+ RowHdrType := aJvTFDays.RowHdrType;
+
+ RowHdrWidth := ConvertMeasure(ScreenToPrinter(aJvTFDays.RowHdrWidth, True),
+ pmPixels, Measure, True);
+ RowHeight := ConvertMeasure(ScreenToPrinter(aJvTFDays.RowHeight, False),
+ pmPixels, Measure, False);
+
+ ShowPics := agoShowPics in aJvTFDays.Options;
+ ShowText := agoShowText in aJvTFDays.Options;
+ Thresholds := aJvTFDays.Thresholds;
+ Thresholds.DetailHeight :=
+ ConvertMeasure(ScreenToPrinter(Thresholds.DetailHeight, False), pmPixels,
+ Measure, False);
+ Thresholds.DetailWidth :=
+ ConvertMeasure(ScreenToPrinter(Thresholds.DetailWidth, True), pmPixels,
+ Measure, True);
+
+ TimeFormat := aJvTFDays.TimeFormat;
+
+ // Set the property fields directly to avoid validity check. Assume
+ // settings from aJvTFDays are already validated.
+ FGridStartTime := aJvTFDays.GridStartTime;
+ FGridEndTime := aJvTFDays.GridEndTime;
+end;
+
+procedure TJvTFDaysPrinter.SetTFRowHdrType(Value: TJvTFRowHdrType);
+begin
+ SetPropertyCheck;
+ FRowHdrType := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetRowHdrWidth(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < 0 then
+ Value := 0;
+ FRowHdrWidth := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetRowHeight(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < 0 then
+ Value := 0;
+ FRowHeight := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetShowPics(Value: Boolean);
+begin
+ SetPropertyCheck;
+ FShowPics := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetShowText(Value: Boolean);
+begin
+ SetPropertyCheck;
+ FShowText := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetThresholds(Value: TJvTFDaysThresholds);
+begin
+ SetPropertyCheck;
+ FThresholds.Assign(Value);
+end;
+
+function TJvTFDaysPrinter.TimeToRow(ATime: TTime): Integer;
+var
+ TotalMins: Integer;
+ WorkHours, WorkMins, WorkSecs, WorkMSecs: Word;
+ H, M, S, MS: Word;
+ Offset: Integer;
+begin
+ DecodeTime(ATime, WorkHours, WorkMins, WorkSecs, WorkMSecs);
+
+ // Convert the given time to minutes
+ DecodeTime(GridStartTime, H, M, S, MS);
+ Offset := H * 60 + M;
+ TotalMins := WorkHours * 60 + WorkMins - Offset;
+
+ // Find the row number by dividing the time in minutes by the granularity
+ Result := TotalMins div Granularity;
+ if (TotalMins < 0) and (TotalMins mod Granularity <> 0) then
+ Dec(Result);
+end;
+
+function TJvTFDaysPrinter.GetPageLayout: TJvTFDaysPrinterPageLayout;
+begin
+ Result := TJvTFDaysPrinterPageLayout(inherited PageLayout);
+end;
+
+procedure TJvTFDaysPrinter.SetPageLayout(Value: TJvTFDaysPrinterPageLayout);
+begin
+ inherited PageLayout := Value;
+end;
+
+procedure TJvTFDaysPrinter.CreateDoc;
+var
+ I: Integer;
+begin
+ inherited CreateDoc;
+ FApptCount := 0;
+ for I := 0 to Cols.Count - 1 do
+ Inc(FApptCount, Cols[I].Schedule.ApptCount);
+end;
+
+function TJvTFDaysPrinter.GetApptCount: Integer;
+var
+ I: Integer;
+begin
+ if State = spsNoDoc then
+ begin
+ Result := 0;
+ for I := 0 to Cols.Count - 1 do
+ Inc(Result, Cols[I].Schedule.ApptCount);
+ end
+ else
+ Result := FApptCount;
+end;
+
+function TJvTFDaysPrinter.GetPageInfo(PageNum: Integer): TJvTFDaysPageInfo;
+begin
+ if not FValidPageInfo then
+ raise EJvTFPrinterError.CreateRes(@RsENoPageInfoExists);
+
+ Result := TJvTFDaysPageInfo(FPageInfoList.Objects[PageNum - 1]);
+end;
+
+procedure TJvTFDaysPrinter.FreeDoc;
+begin
+ inherited FreeDoc;
+
+ // Do not call ClearPageInfo if component is being destroyed. This must be
+ // done in TJvTFDaysPrinter.Destroy. TJvTFPrinter.Destroy calls FreeDoc
+ // and since TJvTFDaysPrinter.Destroy frees FPageInfo a NASTY AV happens.
+ if not (csDestroying in ComponentState) then
+ ClearPageInfo;
+end;
+
+procedure TJvTFDaysPrinter.SetFormattedDesc(Value: Boolean);
+begin
+ SetPropertyCheck;
+ FFormattedDesc := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetGroupHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ SetPropertyCheck;
+ FGroupHdrAttr.Assign(Value);
+end;
+
+procedure TJvTFDaysPrinter.SetGroupHdrHeight(Value: Integer);
+begin
+ SetPropertyCheck;
+ if Value < 0 then
+ Value := 0;
+ FGroupHdrHeight := Value;
+end;
+
+procedure TJvTFDaysPrinter.SetGrouping(Value: TJvTFDaysGrouping);
+begin
+ SetPropertyCheck;
+ FGrouping := Value;
+ Cols.UpdateTitles;
+end;
+
+procedure TJvTFDaysPrinter.DrawColGroupHdr(ACanvas: TCanvas;
+ Index: Integer; PageInfo: TJvTFDaysPageInfo; IsGroupHdr: Boolean);
+var
+ ARect, TxtRect, CalcRect: TRect;
+ Txt: string;
+ Flags: UINT;
+ TxtHt, TxtRectHt: Integer;
+ UseAttr: TJvTFDaysHdrAttr;
+begin
+ if IsGroupHdr then
+ begin
+ ARect := VirtualGroupHdrRect(Index, PageInfo);
+ Txt := Cols[Index].GroupTitle;
+ UseAttr := GroupHdrAttr;
+ end
+ else
+ begin
+ ARect := CellRect(Index, -1, PageInfo);
+ Txt := Cols[Index].Title;
+ UseAttr := HdrAttr;
+ end;
+
+ ACanvas.Brush.Color := UseAttr.Color;
+ ACanvas.Font.Assign(UseAttr.Font);
+
+ Flags := DT_NOPREFIX or DT_CENTER;
+ case ColTitleStyle of
+ ctsSingleClip:
+ Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ ctsSingleEllipsis:
+ Flags := Flags or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER;
+ ctsMultiClip:
+ Flags := Flags or DT_WORDBREAK;
+ ctsMultiEllipsis:
+ Flags := Flags or DT_END_ELLIPSIS or DT_WORDBREAK or DT_EDITCONTROL;
+ ctsHide:
+ Flags := Flags or DT_SINGLELINE or DT_VCENTER;
+ end;
+
+ ACanvas.FillRect(ARect);
+ TxtRect := ARect;
+ InflateRect(TxtRect, -2, -2);
+ CalcRect := TxtRect;
+
+ if (ColTitleStyle = ctsMultiClip) or (ColTitleStyle = ctsMultiEllipsis) then
+ begin
+ TxtHt := DrawText(ACanvas.Handle, PChar(Txt), -1, CalcRect,
+ Flags or DT_CALCRECT);
+
+ if TxtHt < RectHeight(TxtRect) then
+ begin
+ // we need to vertically center the text
+ TxtRectHt := RectHeight(TxtRect);
+ TxtRect.Top := TxtRect.Top + RectHeight(TxtRect) div 2 - TxtHt div 2;
+ TxtRect.Bottom := Lesser(TxtRect.Top + TxtRectHt, TxtRect.Bottom);
+ end;
+ end
+ else
+ if ColTitleStyle = ctsHide then
+ begin
+ DrawText(ACanvas.Handle, PChar(Txt), -1, CalcRect, Flags or DT_CALCRECT);
+ if RectWidth(CalcRect) > RectWidth(TxtRect) then
+ Txt := '';
+ end;
+
+ DrawText(ACanvas.Handle, PChar(Txt), -1, TxtRect, Flags);
+
+ DrawFrame(ACanvas, ARect, HdrAttr.Frame3D);
+
+ if IsGroupHdr then
+ begin
+ if Assigned(FOnDrawGroupHdr) then
+ FOnDrawGroupHdr(Self, ACanvas, ARect, Index, False);
+ end
+ else
+ if Assigned(FOnDrawColHdr) then
+ FOnDrawColHdr(Self, ACanvas, ARect, Index, False);
+end;
+
+procedure TJvTFDaysPrinter.DrawGroupHdrs(ACanvas: TCanvas;
+ PageInfo: TJvTFDaysPageInfo);
+var
+ CurrGroup: string;
+ I: Integer;
+begin
+ if CalcGroupHdrHeight > 0 then
+ begin
+ CurrGroup := Cols[PageInfo.StartCol].GroupTitle;
+ DrawColGroupHdr(ACanvas, PageInfo.StartCol, PageInfo, True);
+ for I := PageInfo.StartCol + 1 to PageInfo.EndCol do
+ if Cols[I].GroupTitle <> CurrGroup then
+ begin
+ CurrGroup := Cols[I].GroupTitle;
+ DrawColGroupHdr(ACanvas, I, PageInfo, True);
+ end;
+ end;
+end;
+
+function TJvTFDaysPrinter.CalcGroupColHdrsHeight: Integer;
+begin
+ Result := CalcGroupHdrHeight + ColHdrHeight;
+end;
+
+function TJvTFDaysPrinter.CalcGroupHdrHeight: Integer;
+begin
+ if Grouping = grNone then
+ Result := 0
+ else
+ Result := GroupHdrHeight;
+end;
+
+function TJvTFDaysPrinter.VirtualGroupHdrRect(Col: Integer;
+ APageInfo: TJvTFDaysPageInfo): TRect;
+var
+ I, GroupStartCol, GroupEndCol, GroupWidth: Integer;
+begin
+ Result.Top := 0;
+ Result.Bottom := CalcGroupHdrHeight;
+
+ GetGroupStartEndCols(Col, GroupStartCol, GroupEndCol);
+ GroupWidth := 0;
+ for I := GroupStartCol to GroupEndCol do
+ Inc(GroupWidth, APageInfo.ColWidth);
+
+ Result.Left := RowHdrWidth;
+ // At most, only one of the following For loops will execute
+ // depending on whether Col is to the left or to the right of LeftCol
+ //For I := LeftCol - 1 downto GroupStartCol do
+ for I := APageInfo.StartCol - 1 downto GroupStartCol do
+ Dec(Result.Left, APageInfo.ColWidth);
+
+ //For I := LeftCol to GroupStartCol - 1 do
+ for I := APageInfo.StartCol to GroupStartCol - 1 do
+ Inc(Result.Left, APageInfo.ColWidth);
+
+ Result.Right := Result.Left + GroupWidth;
+end;
+
+procedure TJvTFDaysPrinter.GetGroupStartEndCols(Col: Integer;
+ var StartCol, EndCol: Integer);
+var
+ I: Integer;
+begin
+ // find group start col
+ I := Col;
+ while (I >= 0) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do
+ begin
+ StartCol := I;
+ Dec(I);
+ end;
+
+ // find group end col
+ I := Col;
+ while (I < Cols.Count) and (Cols[I].GroupTitle = Cols[Col].GroupTitle) do
+ begin
+ EndCol := I;
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFDaysPrinter.PrintDirect;
+begin
+ DirectPrint := True;
+ try
+ try
+ Prepare;
+ finally
+ FreeDoc;
+ end;
+ finally
+ DirectPrint := False;
+ end;
+end;
+
+procedure TJvTFDaysPrinter.GetApptDrawInfo(DrawInfo: TJvTFDaysApptDrawInfo;
+ Appt: TJvTFAppt);
+begin
+ DrawInfo.Color := GetApptDispColor(Appt);
+ DrawInfo.FrameColor := ApptAttr.FrameColor;
+ DrawInfo.FrameWidth := ApptAttr.FrameWidth;
+ DrawInfo.Font := ApptAttr.Font;
+ DrawInfo.Visible := True;
+
+ if Assigned(FOnGetApptDrawInfo) then
+ FOnGetApptDrawInfo(Self, Appt, DrawInfo);
+end;
+
+procedure TJvTFDaysPrinter.SetGridEndTime(Value: TTime);
+var
+ I: Integer;
+ WorkEnd: TTime;
+ H, M, S, MS: Word;
+begin
+ WorkEnd := Value;
+ DecodeTime(WorkEnd, H, M, S, MS);
+ if (H = 0) and (M = 0) then
+ WorkEnd := EncodeTime(23, 59, 59, 999);
+
+ if not (csLoading in ComponentState) and (WorkEnd <= GridStartTime) then
+ raise EJvTFDaysError.CreateRes(@RsEGridEndTimeCannotBePriorToGridStart);
+
+ FGridEndTime := Value;
+
+ if not (csLoading in ComponentState) then
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].RefreshMap;
+end;
+
+procedure TJvTFDaysPrinter.SetGridStartTime(Value: TTime);
+var
+ I: Integer;
+ WorkEnd: TTime;
+ H, M, S, MS: Word;
+begin
+ WorkEnd := GridEndTime;
+ DecodeTime(WorkEnd, H, M, S, MS);
+ if (H = 0) and (M = 0) then
+ WorkEnd := EncodeTime(23, 59, 59, 999);
+
+ if not (csLoading in ComponentState) and (Value >= WorkEnd) then
+ raise EJvTFDaysError.CreateRes(@RsEGridStartTimeCannotBeAfterGridEndTi);
+
+ FGridStartTime := Value;
+
+ if not (csLoading in ComponentState) then
+ for I := 0 to Cols.Count - 1 do
+ Cols[I].RefreshMap;
+end;
+
+//=== { TJvTFDaysPrinterPageLayout } =========================================
+
+procedure TJvTFDaysPrinterPageLayout.Assign(Source: TPersistent);
+begin
+ inherited Assign(Source);
+ if Source is TJvTFDaysPrinterPageLayout then
+ begin
+ FColsPerPage := TJvTFDaysPrinterPageLayout(Source).ColsPerPage;
+ FRowsPerPage := TJvTFDaysPrinterPageLayout(Source).RowsPerPage;
+ FAlwaysShowColHdr := TJvTFDaysPrinterPageLayout(Source).AlwaysShowColHdr;
+ FAlwaysShowRowHdr := TJvTFDaysPrinterPageLayout(Source).AlwaysShowRowHdr;
+ // Don't call Change. Ancestor will call it.
+ end;
+end;
+
+procedure TJvTFDaysPrinterPageLayout.SetAlwaysShowColHdr(Value: Boolean);
+begin
+ SetPropertyCheck;
+
+ if Value <> FAlwaysShowColHdr then
+ begin
+ FAlwaysShowColHdr := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysPrinterPageLayout.SetAlwaysShowRowHdr(Value: Boolean);
+begin
+ SetPropertyCheck;
+
+ if Value <> FAlwaysShowRowHdr then
+ begin
+ FAlwaysShowRowHdr := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysPrinterPageLayout.SetColsPerPage(Value: Integer);
+begin
+ SetPropertyCheck;
+
+ if Value < 0 then
+ Value := 0;
+ if Value <> FColsPerPage then
+ begin
+ FColsPerPage := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysPrinterPageLayout.SetRowsPerPage(Value: Integer);
+begin
+ SetPropertyCheck;
+
+ if Value < 0 then
+ Value := 0;
+ if Value <> FRowsPerPage then
+ begin
+ FRowsPerPage := Value;
+ Change;
+ end;
+end;
+
+//=== { TJvTFCompNamesList } =================================================
+
+procedure TJvTFCompNamesList.Move(CurIndex, NewIndex: Integer);
+begin
+ inherited Move(CurIndex, NewIndex);
+ if Assigned(FOnMove) then
+ FOnMove(Self, CurIndex, NewIndex);
+end;
+
+{$IFDEF Jv_TIMEBLOCKS}
+// ok
+
+//=== { TJvTFDaysTimeBlock } =================================================
+
+constructor TJvTFDaysTimeBlock.Create(ACollection: TCollection);
+begin
+ inherited Create(ACollection);
+ FLength := 1;
+ FName := 'Block' + IntToStr(Index);
+ FTitle := Name;
+ FAllowAppts := True;
+end;
+
+procedure TJvTFDaysTimeBlock.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysTimeBlock then
+ begin
+ FLength := TJvTFDaysTimeBlock(Source).Length;
+ FTitle := TJvTFDaysTimeBlock(Source).Title;
+ FAllowAppts := TJvTFDaysTimeBlock(Source).AllowAppts;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysTimeBlock.Change;
+begin
+ if Assigned(BlockCollection) and Assigned(BlockCollection.DaysControl) then
+ BlockCollection.DaysControl.Invalidate;
+end;
+
+function TJvTFDaysTimeBlock.GetBlockCollection: TJvTFDaysTimeBlocks;
+begin
+ Result := TJvTFDaysTimeBlocks(Collection);
+end;
+
+function TJvTFDaysTimeBlock.GetDisplayName: string;
+begin
+ Result := Name;
+ if Result = '' then
+ Result := inherited GetDisplayName;
+end;
+
+function TJvTFDaysTimeBlock.GetGridLength: Integer;
+var
+ Days: TJvTFDays;
+begin
+ Days := BlockCollection.DaysControl;
+ Result := Length * (Days.TimeBlockProps.BlockGran div Days.Granularity);
+end;
+
+procedure TJvTFDaysTimeBlock.SetAllowAppts(Value: Boolean);
+begin
+ FAllowAppts := Value;
+end;
+
+procedure TJvTFDaysTimeBlock.SetLength(Value: Integer);
+begin
+ if Value < 1 then
+ Value := 1;
+ if Value <> FLength then
+ begin
+ FLength := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysTimeBlock.SetName(const Value: string);
+begin
+ if Value = '' then
+ raise EJvTFDaysError.CreateRes(@RsEATimeBlockNameCannotBeNull);
+
+ if Value <> FName then
+ if not Assigned(BlockCollection.FindBlock(Value)) then
+ begin
+ if Title = Name then
+ Title := Value;
+ FName := Value;
+ Change;
+ end
+ else
+ raise EJvTFDaysError.CreateResFmt(@RsEAnotherTimeBlockWithTheName, [Value]);
+end;
+
+procedure TJvTFDaysTimeBlock.SetTitle(const Value: string);
+begin
+ if Value <> FTitle then
+ begin
+ FTitle := Value;
+ Change;
+ end;
+end;
+
+//=== { TJvTFDaysTimeBlocks } ================================================
+
+constructor TJvTFDaysTimeBlocks.Create(ADaysControl: TJvTFDays);
+begin
+ inherited Create(TJvTFDaysTimeBlock);
+ FDaysControl := ADaysControl;
+end;
+
+function TJvTFDaysTimeBlocks.Add: TJvTFDaysTimeBlock;
+begin
+ Result := TJvTFDaysTimeBlock(inherited Add);
+end;
+
+procedure TJvTFDaysTimeBlocks.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TJvTFDaysTimeBlocks then
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ for I := 0 to TJvTFDaysTimeBlocks(Source).Count - 1 do
+ Add.Assign(TJvTFDaysTimeBlocks(Source).Items[I]);
+ finally
+ EndUpdate;
+ end;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+function TJvTFDaysTimeBlocks.BlockByName(const BlockName: string): TJvTFDaysTimeBlock;
+begin
+ Result := FindBlock(BlockName);
+ if not Assigned(Result) then
+ raise EJvTFDaysError.CreateResFmt(@RsEATimeBlockWithTheNamesDoesNotExist,
+ [BlockName]);
+end;
+
+function TJvTFDaysTimeBlocks.FindBlock(const BlockName: string): TJvTFDaysTimeBlock;
+var
+ I: Integer;
+begin
+ Result := nil;
+ I := 0;
+ while (I < Count) and not Assigned(Result) do
+ begin
+ if Items[I].Name = BlockName then
+ Result := Items[I];
+ Inc(I);
+ end;
+end;
+
+function TJvTFDaysTimeBlocks.GetItem(Index: Integer): TJvTFDaysTimeBlock;
+begin
+ Result := TJvTFDaysTimeBlock(inherited GetItem(Index));
+end;
+
+function TJvTFDaysTimeBlocks.GetOwner: TPersistent;
+begin
+ Result := DaysControl;
+end;
+
+procedure TJvTFDaysTimeBlocks.SetItem(Index: Integer;
+ Value: TJvTFDaysTimeBlock);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+//=== { TJvTFDaysBlockProps } ================================================
+
+constructor TJvTFDaysBlockProps.Create(ADaysControl: TJvTFDays);
+begin
+ inherited Create;
+ FBlockGran := 60;
+ FDaysControl := ADaysControl;
+ FBlockHdrWidth := 50;
+ FBlockHdrAttr := TJvTFDaysHdrAttr.Create(DaysControl);
+ FSelBlockHdrAttr := TJvTFDaysHdrAttr.Create(DaysControl);
+ FOffTimeColor := clGray;
+ FDataDivColor := clBlack;
+ FSnapMove := True;
+ FDrawOffTime := True;
+ with FSelBlockHdrAttr do
+ begin
+ Color := clBtnFace;
+ Font.Color := clBlack;
+ FrameColor := clBlack;
+ end;
+end;
+
+destructor TJvTFDaysBlockProps.Destroy;
+begin
+ FBlockHdrAttr.Free;
+ FSelBlockHdrAttr.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysBlockProps.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDaysBlockProps then
+ begin
+ FBlockGran := TJvTFDaysBlockProps(Source).BlockGran;
+ FDayStart := TJvTFDaysBlockProps(Source).DayStart;
+ FBlockHdrWidth := TJvTFDaysBlockProps(Source).BlockHdrWidth;
+ FBlockHdrAttr.Assign(TJvTFDaysBlockProps(Source).BlockHdrAttr);
+ FSelBlockHdrAttr.Assign(TJvTFDaysBlockProps(Source).SelBlockHdrAttr);
+ FOffTimeColor := TJvTFDaysBlockProps(Source).OffTimeColor;
+ FDataDivColor := TJvTFDaysBlockProps(Source).DataDivColor;
+ FSnapMove := TJvTFDaysBlockProps(Source).SnapMove;
+ FDrawOffTime := TJvTFDaysBlockProps(Source).DrawOffTime;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDaysBlockProps.Change;
+begin
+ if Assigned(DaysControl) then
+ DaysControl.Invalidate;
+end;
+
+procedure TJvTFDaysBlockProps.SetBlockGran(Value: Integer);
+begin
+ if csLoading in DaysControl.ComponentState then
+ begin
+ FBlockGran := Value;
+ Exit;
+ end;
+
+ // Enforce minimum granularity of 1 min and max of 60 mins
+ if Value < 1 then
+ Value := 1
+ else
+ if Value > 60 then
+ Value := 60;
+
+ // Ensure that granularity is evenly divisible by an hour
+ //while 60 mod Value <> 0 do
+ //Dec(Value);
+ Value := Value - 60 mod Value;
+
+ if Value <> FBlockGran then
+ begin
+ DaysControl.EnsureBlockRules(DaysControl.Granularity, Value, DayStart);
+ FBlockGran := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysBlockProps.SetBlockHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ FBlockHdrAttr.Assign(Value);
+ DaysControl.Invalidate;
+end;
+
+procedure TJvTFDaysBlockProps.SetBlockHdrWidth(Value: Integer);
+begin
+ if Value <> FBlockHdrWidth then
+ begin
+ FBlockHdrWidth := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysBlockProps.SetDataDivColor(Value: TColor);
+begin
+ if Value <> FDataDivColor then
+ begin
+ FDataDivColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysBlockProps.SetDayStart(Value: TTime);
+begin
+ if Value <> FDayStart then
+ begin
+ DaysControl.EnsureBlockRules(DaysControl.Granularity, BlockGran, Value);
+ FDayStart := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysBlockProps.SetDrawOffTime(Value: Boolean);
+begin
+ if Value <> FDrawOffTime then
+ begin
+ FDrawOffTime := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysBlockProps.SetOffTimeColor(Value: TColor);
+begin
+ if Value <> FOffTimeColor then
+ begin
+ FOffTimeColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFDaysBlockProps.SetSelBlockHdrAttr(Value: TJvTFDaysHdrAttr);
+begin
+ FSelBlockHdrAttr.Assign(Value);
+ DaysControl.Invalidate;
+end;
+
+{$ENDIF Jv_TIMEBLOCKS}
+
+//=== { TJvTFDaysApptDrawInfo } ==============================================
+
+constructor TJvTFDaysApptDrawInfo.Create;
+begin
+ inherited Create;
+ FFont := TFont.Create;
+end;
+
+destructor TJvTFDaysApptDrawInfo.Destroy;
+begin
+ FFont.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFDaysApptDrawInfo.SetColor(Value: TColor);
+begin
+ FColor := Value;
+end;
+
+procedure TJvTFDaysApptDrawInfo.SetFont(Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+procedure TJvTFDaysApptDrawInfo.SetFrameColor(Value: TColor);
+begin
+ FFrameColor := Value;
+end;
+
+procedure TJvTFDaysApptDrawInfo.SetFrameWidth(const Value: Integer);
+begin
+ FFrameWidth := Value;
+end;
+
+procedure TJvTFDaysApptDrawInfo.SetVisible(Value: Boolean);
+begin
+ FVisible := Value;
+end;
+
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfgantt.pas b/components/jvcllaz/run/JvTimeFramework/jvtfgantt.pas
new file mode 100644
index 000000000..e0f03a162
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfgantt.pas
@@ -0,0 +1,548 @@
+{-----------------------------------------------------------------------------
+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: JvTFGantt.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
+located at http://jvcl.delphi-jedi.org
+
+ .CDK.REGLINK=JvTFGanttComponentsReg.pas
+ Created 10/6/2001 6:14:06 PM
+ Eagle Software CDK, Version 5.13 Rev. B
+
+Known Issues:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFGantt;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages,
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
+ JvTFUtils, JvTFManager;
+
+type
+ TJvTFGanttScrollBar = class(TScrollBar)
+ private
+ procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
+ protected
+ procedure CreateWnd; override;
+ function GetLargeChange: Integer; virtual;
+ procedure SetLargeChange(Value: Integer); virtual;
+ procedure UpdateRange; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property LargeChange: Integer read GetLargeChange write SetLargeChange default 1;
+ end;
+
+ TJvTFGanttScale = (ugsYear, ugsQuarter, ugsMonth, ugsWeek, ugsDay, ugsHour, ugsHalfHour, ugsQuarterHour, ugsMinute);
+
+ TJvTFGanttScaleFormat = class(TPersistent)
+ private
+ FScale: TJvTFGanttScale;
+ FFont: TFont;
+ FFormat: string;
+ FWidth: Integer;
+ function GetFont: TFont;
+ procedure SetFont(const Value: TFont);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ published
+ property Format: string read FFormat write FFormat;
+ property Font: TFont read GetFont write SetFont;
+ property Scale: TJvTFGanttScale read FScale write FScale;
+ property Width: Integer read FWidth write FWidth;
+ end;
+
+ TJvTFGantt = class(TJvTFControl)
+ private
+ // property fields
+ FMajorScale: TJvTFGanttScaleFormat;
+ FMinorScale: TJvTFGanttScaleFormat;
+ FHScrollBar: TJvTFGanttScrollBar;
+ FVScrollBar: TJvTFGanttScrollBar;
+ FVisibleScrollBars: TJvTFVisibleScrollBars;
+ FCustomGlyphs: TBitmap;
+ // Other class variables
+ FPaintBuffer: TBitmap;
+ procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE;
+ procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
+ procedure CMFontChanged(var Msg: TLMessage); message CM_FONTCHANGED;
+ protected
+ procedure DrawMajor(ACanvas: TCanvas); virtual;
+ procedure DrawMinor(ACanvas: TCanvas); virtual;
+ procedure SetVisibleScrollBars(Value: TJvTFVisibleScrollBars); virtual;
+ function CalcHeaderHeight: Integer;
+ procedure AlignScrollBars; virtual;
+ function GetMinorScale: TJvTFGanttScaleFormat; virtual;
+ procedure SetMinorScale(const Value: TJvTFGanttScaleFormat); virtual;
+ function GetMajorScale: TJvTFGanttScaleFormat; virtual;
+ procedure SetMajorScale(const Value: TJvTFGanttScaleFormat); virtual;
+ procedure DrawClientArea; virtual;
+ procedure DrawHeader(ACanvas: TCanvas); virtual;
+ procedure Loaded; override;
+ procedure Resize; override;
+ procedure DrawCustomGlyph(SomeBitmap: TBitmap;
+ TargetLeft, TargetTop, ImageIndex, NumGlyphsPerBitmap: Integer); dynamic;
+ function ClientCursorPos: TPoint;
+ function ValidMouseAtDesignTime: Boolean;
+ procedure AdjustComponentHeightBasedOnFontChange; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure PrepareAllBitmaps;
+ procedure PrepareBitmaps(SomeGlyph: TBitmap; ResourceName: PChar); dynamic;
+ procedure Paint; override;
+ published
+ property MajorScale: TJvTFGanttScaleFormat read GetMajorScale write SetMajorScale;
+ property MinorScale: TJvTFGanttScaleFormat read GetMinorScale write SetMinorScale;
+ property VisibleScrollBars: TJvTFVisibleScrollBars read FVisibleScrollBars write SetVisibleScrollBars
+ default [vsbHorz, vsbVert];
+ property Align;
+ property Anchors;
+ end;
+
+
+implementation
+
+uses
+ JvJVCLUtils, JvResources;
+
+//=== { TJvTFGantt } =========================================================
+
+constructor TJvTFGantt.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPaintBuffer := TBitmap.Create;
+ FCustomGlyphs := TBitmap.Create;
+ FVisibleScrollBars := [vsbHorz, vsbVert];
+
+ FVScrollBar := TJvTFGanttScrollBar.Create(Self);
+ with FVScrollBar do
+ begin
+ Kind := sbVertical;
+ TabStop := False;
+ Anchors := [];
+ Parent := Self;
+ Visible := True;
+ // OnScroll := ScrollBarScroll;
+ end;
+
+ FHScrollBar := TJvTFGanttScrollBar.Create(Self);
+ with FHScrollBar do
+ begin
+ Kind := sbHorizontal;
+ TabStop := False;
+ Anchors := [];
+ Parent := Self;
+ Visible := True;
+ // OnScroll := ScrollBarScroll;
+ end;
+
+ FMajorScale := TJvTFGanttScaleFormat.Create;
+ FMajorScale.Scale := ugsMonth;
+ FMajorScale.Format := 'mmmm';
+ FMinorScale := TJvTFGanttScaleFormat.Create;
+ FMinorScale.Scale := ugsDay;
+ FMinorScale.Format := 'dd';
+
+ PrepareAllBitmaps;
+end;
+
+destructor TJvTFGantt.Destroy;
+begin
+ FPaintBuffer.Free;
+ FMajorScale.Free;
+ FMinorScale.Free;
+ FVScrollBar.Free;
+ FHScrollBar.Free;
+ FCustomGlyphs.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFGantt.Loaded;
+begin
+ inherited Loaded;
+ AlignScrollBars;
+end;
+
+procedure TJvTFGantt.DrawMajor(ACanvas: TCanvas);
+var
+ lCaption: string;
+begin
+ ACanvas.Font.Assign(FMajorScale.Font);
+ lCaption := RsThisIsTheMajorScale;
+ ACanvas.TextOut((Width div 2) - (ACanvas.TextWidth(Caption) div 2), 2, lCaption);
+end;
+
+procedure TJvTFGantt.DrawMinor(ACanvas: TCanvas);
+var
+ lCaption: string;
+begin
+ ACanvas.Font.Assign(FMinorScale.Font);
+ lCaption := RsThisIsTheMinorScale;
+ ACanvas.TextOut((Width div 2) - (ACanvas.TextWidth(Caption) div 2),
+ (CalcHeaderHeight div 2) + 2, lCaption);
+end;
+
+function TJvTFGantt.CalcHeaderHeight: Integer;
+begin
+ Result := 0;
+
+ Canvas.Font.Assign(FMajorScale.Font);
+ Result := Result + CanvasMaxTextHeight(Canvas);
+
+ Canvas.Font.Assign(FMinorScale.Font);
+ Result := Result + CanvasMaxTextHeight(Canvas);
+
+ Result := Result + 4;
+end;
+
+procedure TJvTFGantt.Resize;
+begin
+ inherited Resize;
+ AlignScrollBars;
+end;
+
+procedure TJvTFGantt.SetMajorScale(const Value: TJvTFGanttScaleFormat);
+begin
+ FMajorScale.Assign(Value);
+end;
+
+function TJvTFGantt.GetMajorScale: TJvTFGanttScaleFormat;
+begin
+ Result := FMajorScale;
+end;
+
+procedure TJvTFGantt.SetMinorScale(const Value: TJvTFGanttScaleFormat);
+begin
+ FMinorScale.Assign(Value);
+end;
+
+function TJvTFGantt.GetMinorScale: TJvTFGanttScaleFormat;
+begin
+ Result := FMinorScale;
+end;
+
+procedure TJvTFGantt.SetVisibleScrollBars(Value: TJvTFVisibleScrollBars);
+begin
+ if Value <> FVisibleScrollBars then
+ begin
+ FVisibleScrollBars := Value;
+ AlignScrollBars;
+ FVScrollBar.Visible := vsbVert in FVisibleScrollBars;
+ FHScrollBar.Visible := vsbHorz in FVisibleScrollBars;
+ end;
+end;
+
+procedure TJvTFGantt.AlignScrollBars;
+begin
+ // DO NOT INVALIDATE GRID IN THIS METHOD
+ FVScrollBar.Left := ClientWidth - FVScrollBar.Width;
+ FVScrollBar.Top := CalcHeaderHeight;
+ FVScrollBar.Height := FHScrollBar.Top - FVScrollBar.Top;
+
+ FHScrollBar.Top := ClientHeight - FHScrollBar.Height;
+ FHScrollBar.Left := 0;
+ FHScrollBar.Width := FVScrollBar.Left - FHScrollBar.Left;
+
+ with FVScrollBar do
+ if vsbHorz in VisibleScrollBars then
+ Height := FHScrollBar.Top - Top
+ else
+ Height := Self.ClientHeight - Top;
+
+ with FHScrollBar do
+ if vsbVert in VisibleScrollBars then
+ Width := FVScrollBar.Left - Left
+ else
+ Width := Self.ClientWidth - Left;
+end;
+
+procedure TJvTFGantt.DrawClientArea;
+begin
+ // Draw the client area
+end;
+
+procedure TJvTFGantt.DrawHeader(ACanvas: TCanvas);
+begin
+ DrawMajor(ACanvas);
+ DrawMinor(ACanvas);
+end;
+
+procedure TJvTFGantt.Paint;
+begin
+ inherited Paint;
+ with FPaintBuffer do
+ begin
+ Width := ClientWidth;
+ Height := ClientHeight;
+
+ with Canvas do
+ begin
+ Brush.Color := Self.Color;
+ FillRect(Rect(0, 0, Width, Height));
+ end;
+
+ DrawHeader(Canvas);
+ DrawClientArea;
+ end;
+ if Enabled then
+ BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, FPaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
+ else
+ BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, FPaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
+ { wp --- to do: Above line is a workaround because DrawState is not available in the LCL
+ Windows.DrawState(Canvas.Handle, 0, nil, FPaintBuffer.Handle, 0, 0, 0, 0, 0, DST_BITMAP or DSS_UNION or
+ DSS_DISABLED);
+ }
+
+end;
+
+{ Draws SomeBitmap out to the canvas. Use ImageIndex = 0 and NumGlyphsPerBitmap = 1 to draw the entire image,
+ or use other values to specify sub-glyphs within the image (for bitmaps that contain several same-sized
+ images aligned side-to-side in a single row).
+
+ TargetLeft and TargetTop are the left and top coordinates in the Canvas where you would like this image to appear.
+ Use 0 and 0 to place the image in the top left corner.
+
+ CDK: Call this method from an appropriate point in your code (e.g., a "Paint" or "DrawItem" override).
+
+ Examples:
+
+ // Draws entire image:
+ DrawCustomGlyph(FCustomGlyphs, 0, 0, 0, 1);
+
+ // Draws last image within FCustomGlyph (which contains four side-to-side images):
+ DrawCustomGlyph(FCustomGlyphs, 0, 0, 3, 4);
+}
+
+procedure TJvTFGantt.DrawCustomGlyph(SomeBitmap: TBitmap;
+ TargetLeft, TargetTop, ImageIndex, NumGlyphsPerBitmap: Integer);
+var
+ LocalImageWidth: Integer;
+ SourceRect, DestRect: TRect;
+begin
+ with Canvas do
+ begin
+ if NumGlyphsPerBitmap = 0 then
+ NumGlyphsPerBitmap := 1;
+ LocalImageWidth := SomeBitmap.Width div NumGlyphsPerBitmap;
+
+ SourceRect.Left := ImageIndex * LocalImageWidth;
+ SourceRect.Top := 0;
+ SourceRect.Right := SourceRect.Left + LocalImageWidth;
+ SourceRect.Bottom := SourceRect.Top + SomeBitmap.Height;
+
+ DestRect.Left := TargetLeft;
+ DestRect.Top := TargetTop;
+ DestRect.Right := DestRect.Left + LocalImageWidth;
+ DestRect.Bottom := DestRect.Top + SomeBitmap.Height;
+ CopyRect(DestRect, SomeBitmap.Canvas, SourceRect);
+ end;
+end;
+
+{ Prepares glyphs for display.
+ The following colors in your glyphs will be replaced:
+
+ Yellow with clBtnHighlight
+ Silver with clBtnFace
+ Gray with clBtnShadow
+ White with clWindow
+ Red with clWindowText
+
+ CDK: Modify your glyphs so that they conform to the colors above, or alternatively
+ modify the colors referenced in the code below.
+}
+
+procedure TJvTFGantt.PrepareBitmaps(SomeGlyph: TBitmap; ResourceName: PChar);
+var
+ LocalBitmap: TBitmap;
+
+ procedure ReplaceColors(SourceBmp, TargetBmp: TBitmap; SourceColor, TargetColor: TColor);
+ begin
+ TargetBmp.Canvas.Brush.Color := TargetColor;
+ TargetBmp.Canvas.BrushCopy(SourceBmp.Canvas.ClipRect, SourceBmp,
+ SourceBmp.Canvas.ClipRect, SourceColor);
+ end;
+
+begin
+ LocalBitmap := TBitmap.Create;
+ try
+ LocalBitmap.LoadFromResourceName(HInstance, ResourceName);
+ SomeGlyph.Width := LocalBitmap.Width;
+ SomeGlyph.Height := LocalBitmap.Height;
+
+ { Replace the following colors after loading bitmap:
+
+ clYellow with clBtnHighlight
+ clSilver with clBtnFace
+ clGray with clBtnShadow
+ clWhite with clWindow
+ clRed with clWindowText
+ }
+
+ { Must call ReplaceColors an odd number of times, to ensure that final image ends up in SomeGlyph.
+ As it turns out, we need to make exactly five replacements. Note that each subsequent call to
+ ReplaceColors switches the order of parameters LocalBitmap and SomeGlyph. This is because
+ we are copying the image back and forth, replacing individual colors with each copy. }
+
+ ReplaceColors(LocalBitmap, SomeGlyph, clYellow, clBtnHighlight);
+ ReplaceColors(SomeGlyph, LocalBitmap, clSilver, clBtnFace);
+ ReplaceColors(LocalBitmap, SomeGlyph, clGray, clBtnShadow);
+ ReplaceColors(SomeGlyph, LocalBitmap, clWhite, clWindow);
+ ReplaceColors(LocalBitmap, SomeGlyph, clRed, clWindowText);
+ finally
+ LocalBitmap.Free;
+ end;
+end;
+
+procedure TJvTFGantt.PrepareAllBitmaps;
+begin
+ { CDK: Replace BITMAP_RESOURCE_NAME with the name of your bitmap resource. }
+// PrepareBitmaps(FCustomGlyphs, 'BITMAP_RESOURCE_NAME');
+ { CDK: If you have other Glyphs that need loading/preparing, place additional
+ calls to PrepareBitmaps here. }
+end;
+
+procedure TJvTFGantt.CMSysColorChange(var Msg: TLMessage);
+begin
+ inherited;
+ PrepareAllBitmaps;
+end;
+
+function TJvTFGantt.ClientCursorPos: TPoint;
+begin
+ GetCursorPos(Result);
+ Result := ScreenToClient(Result);
+end;
+
+function TJvTFGantt.ValidMouseAtDesignTime: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TJvTFGantt.CMDesignHitTest(var Msg: TCMDesignHitTest);
+begin
+ // True = Allow design-time mouse hits to get through if Alt key is down.
+ Msg.Result := Ord(ValidMouseAtDesignTime);
+end;
+
+procedure TJvTFGantt.CMFontChanged(var Msg: TLMessage);
+begin
+ inherited;
+ AdjustComponentHeightBasedOnFontChange;
+end;
+
+procedure TJvTFGantt.AdjustComponentHeightBasedOnFontChange;
+begin
+{ CDK: Add code to calculate the new height. If this is a composite component
+ and you have any edit boxes, the edit box size will have already changed
+ based on the new font (providing this method is called from a CM_FontChanged
+ message handler).
+
+ For example, your code might look like this:
+
+ LockHeight := False;
+ Height := Edit1.Height;
+ Button1.Height := Height;
+ LockHeight := True;
+}
+end;
+
+//=== { TJvTFGanttScaleFormat } ==============================================
+
+constructor TJvTFGanttScaleFormat.Create;
+begin
+ // (rom) added inherited Create
+ inherited Create;
+ FFont := TFont.Create;
+end;
+
+destructor TJvTFGanttScaleFormat.Destroy;
+begin
+ FFont.Free;
+ inherited Destroy;
+end;
+
+function TJvTFGanttScaleFormat.GetFont: TFont;
+begin
+ Result := FFont;
+end;
+
+procedure TJvTFGanttScaleFormat.SetFont(const Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+//=== { TJvTFGanttScrollBar } ================================================
+
+constructor TJvTFGanttScrollBar.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ // If we set the csNoDesignVisible flag then visibility at design time
+ // is controlled by the Visible property, which is exactly what we want.
+ ControlStyle := ControlStyle + [csNoDesignVisible];
+ {
+ ParentCtl3D := False;
+ Ctl3D := False;
+ }
+end;
+
+procedure TJvTFGanttScrollBar.CMDesignHitTest(var Msg: TCMDesignHitTest);
+begin
+ Msg.Result := 1;
+end;
+
+procedure TJvTFGanttScrollBar.CreateWnd;
+begin
+ inherited CreateWnd;
+ UpdateRange;
+end;
+
+function TJvTFGanttScrollBar.GetLargeChange: Integer;
+begin
+ Result := inherited LargeChange;
+end;
+
+procedure TJvTFGanttScrollBar.SetLargeChange(Value: Integer);
+begin
+ inherited LargeChange := Value;
+ UpdateRange;
+end;
+
+procedure TJvTFGanttScrollBar.UpdateRange;
+var
+ Info: TScrollInfo;
+begin
+ FillChar(Info, SizeOf(Info), 0);
+ with Info do
+ begin
+ cbSize := SizeOf(Info);
+ fMask := SIF_PAGE;
+ nPage := LargeChange;
+ end;
+ SetScrollInfo(Handle, SB_CTL, Info, True);
+end;
+
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfglance.pas b/components/jvcllaz/run/JvTimeFramework/jvtfglance.pas
new file mode 100644
index 000000000..1b66b9c30
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfglance.pas
@@ -0,0 +1,4076 @@
+{-----------------------------------------------------------------------------
+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: JvTFGlance.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFGlance;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages,
+ SysUtils, Classes, {Windows, Messages, } Graphics, Controls, Forms, Dialogs, ImgList,
+ JvTFUtils, JvTFManager;
+
+type
+ EJvTFGlanceError = class(Exception);
+ EGlanceViewerError = class(EJvTFGlanceError);
+
+ TJvTFGlanceCell = class;
+ TJvTFGlanceCells = class;
+ TJvTFCustomGlance = class;
+ TJvTFGlanceViewer = class;
+ TJvTFCellPics = class;
+
+ TJvTFUpdateTitleEvent = procedure(Sender: TObject; var NewTitle: string) of object;
+ TJvApptHintEvent = procedure(Sender: TObject; Appt: TJvTFAppt; var Handled: Boolean) of object;
+
+ TJvTFCellPic = class(TCollectionItem)
+ private
+ FPicName: string;
+ FPicIndex: Integer;
+ FPicPoint: TPoint;
+ FHints: TStringList;
+ function GetHints: TStrings;
+ procedure SetPicName(const Value: string);
+ procedure SetPicIndex(Value: Integer);
+ procedure SetHints(Value: TStrings);
+ protected
+ function GetDisplayName: string; override;
+ procedure Change; virtual;
+ procedure SetPicPoint(X, Y: Integer);
+ public
+ constructor Create(ACollection: TCollection); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ function PicCollection: TJvTFCellPics;
+ property PicPoint: TPoint read FPicPoint;
+ published
+ property PicName: string read FPicName write SetPicName;
+ property PicIndex: Integer read FPicIndex write SetPicIndex;
+ property Hints: TStrings read GetHints write SetHints;
+ end;
+
+ TJvTFCellPics = class(TCollection)
+ private
+ function GetItem(Index: Integer): TJvTFCellPic;
+ procedure SetItem(Index: Integer; Value: TJvTFCellPic);
+ protected
+ FGlanceCell: TJvTFGlanceCell;
+ function GetOwner: TPersistent; override;
+ public
+ constructor Create(AGlanceCell: TJvTFGlanceCell);
+ function Add: TJvTFCellPic;
+ property GlanceCell: TJvTFGlanceCell read FGlanceCell;
+ procedure Assign(Source: TPersistent); override;
+ property Items[Index: Integer]: TJvTFCellPic read GetItem write SetItem; default;
+ function PicByName(const PicName: string): TJvTFCellPic;
+ function GetPicIndex(const PicName: string): Integer;
+ function AddPic(const PicName: string; PicIndex: Integer): TJvTFCellPic;
+ end;
+
+ TJvTFSplitOrientation = (soHorizontal, soVertical);
+
+ TJvTFGlanceCell = class(TCollectionItem)
+ private
+ FColor: TColor;
+ FCellDate: TDate;
+ FColIndex: Integer;
+ FRowIndex: Integer;
+ FCellPics: TJvTFCellPics;
+ FCanSelect: Boolean;
+ FSchedules: TStringList;
+ FTitleText: string;
+
+ FSplitRef: TJvTFGlanceCell;
+ FSplitOrientation: TJvTFSplitOrientation;
+ FIsSubCell: Boolean;
+
+ procedure SetColor(Value: TColor);
+ procedure SetCellPics(Value: TJvTFCellPics);
+ procedure SetCanSelect(Value: Boolean);
+ function GetSchedule(AIndex: Integer): TJvTFSched;
+ procedure SetSplitOrientation(Value: TJvTFSplitOrientation);
+ function GetParentCell: TJvTFGlanceCell;
+ function GetSubCell: TJvTFGlanceCell;
+ protected
+ // (rom) bad names
+ FDestroying: Boolean;
+ FCellCollection: TJvTFGlanceCells;
+ function GetDisplayName: string; override;
+ procedure InternalSetCellDate(Value: TDate);
+ procedure SetCellDate(Value: TDate);
+ procedure SetColIndex(Value: Integer);
+ procedure SetRowIndex(Value: Integer);
+ procedure Change; virtual;
+ procedure SetTitleText(const Value: string);
+ procedure Split;
+ procedure Combine;
+ public
+ constructor Create(ACollection: TCollection); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ property CellCollection: TJvTFGlanceCells read FCellCollection;
+
+ function ScheduleCount: Integer;
+ property Schedules[AIndex: Integer]: TJvTFSched read GetSchedule;
+ function IndexOfSchedule(const SchedName: string; SchedDate: TDate): Integer;
+ function IndexOfSchedObj(ASched: TJvTFSched): Integer;
+ procedure CheckConnections;
+ function IsSchedUsed(ASched: TJvTFSched): Boolean;
+ property TitleText: string read FTitleText;
+ property SplitOrientation: TJvTFSplitOrientation read FSplitOrientation
+ write SetSplitOrientation default soHorizontal;
+ property SplitRef: TJvTFGlanceCell read FSplitRef;
+ function IsParent: Boolean;
+ function IsSubCell: Boolean;
+ function IsSplit: Boolean;
+ property ParentCell: TJvTFGlanceCell read GetParentCell;
+ property SubCell: TJvTFGlanceCell read GetSubCell;
+ published
+ property Color: TColor read FColor write SetColor;
+ property CellDate: TDate read FCellDate write SetCellDate;
+ property ColIndex: Integer read FColIndex;
+ property RowIndex: Integer read FRowIndex;
+ property CellPics: TJvTFCellPics read FCellPics write SetCellPics;
+ property CanSelect: Boolean read FCanSelect write SetCanSelect;
+ end;
+
+{ TODO: Clean up AddError, DestroyError, etc. in TJvTFGlanceCells and TJvTFGlanceCell }
+ TJvTFGlanceCells = class(TCollection)
+ private
+ FGlanceControl: TJvTFCustomGlance;
+ FDestroying: Boolean;
+ function GetItem(Index: Integer): TJvTFGlanceCell;
+ procedure SetItem(Index: Integer; Value: TJvTFGlanceCell);
+ function GetCell(ColIndex, RowIndex: Integer): TJvTFGlanceCell;
+ protected
+ // (rom) bad names
+ FAllowAdd: Boolean;
+ FAllowDestroy: Boolean;
+ FCheckingAllConnections: Boolean;
+ FConfiguring: Boolean;
+ function GetOwner: TPersistent; override;
+ function InternalAdd: TJvTFGlanceCell;
+ procedure AddError; dynamic;
+ procedure DestroyError; dynamic;
+ procedure EnsureCellCount;
+ procedure EnsureCells;
+ procedure ConfigCells; virtual;
+ procedure Update(Item: TCollectionItem); override;
+ public
+ constructor Create(AGlanceControl: TJvTFCustomGlance);
+ destructor Destroy; override;
+ function Add: TJvTFGlanceCell;
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ procedure Assign(Source: TPersistent); override;
+ property Items[Index: Integer]: TJvTFGlanceCell read GetItem write SetItem; default;
+ property AllowAdd: Boolean read FAllowAdd;
+ property AllowDestroy: Boolean read FAllowDestroy;
+ property Cells[ColIndex, RowIndex: Integer]: TJvTFGlanceCell read GetCell;
+ procedure CheckConnections;
+ property Configuring: Boolean read FConfiguring;
+ procedure ReconfigCells;
+
+ function IsSchedUsed(ASched: TJvTFSched): Boolean;
+ end;
+
+ TJvTFFrameStyle = (fs3DRaised, fs3DLowered, fsFlat, fsNone);
+ TJvTFFrameAttr = class(TPersistent)
+ private
+ FStyle: TJvTFFrameStyle;
+ FColor: TColor;
+ FWidth: Integer;
+ FControl: TJvTFControl;
+ FOnChange: TNotifyEvent;
+ procedure SetStyle(Value: TJvTFFrameStyle);
+ procedure SetColor(Value: TColor);
+ procedure SetWidth(Value: Integer);
+ protected
+ procedure Change; virtual;
+ public
+ constructor Create(AOwner: TJvTFControl);
+ procedure Assign(Source: TPersistent); override;
+ property Control: TJvTFControl read FControl;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ published
+ property Style: TJvTFFrameStyle read FStyle write SetStyle default fsFlat;
+ property Color: TColor read FColor write SetColor default clBlack;
+ property Width: Integer read FWidth write SetWidth default 1;
+ end;
+
+ TJvTFGlanceFrameAttr = class(TJvTFFrameAttr)
+ private
+ FGlanceControl: TJvTFCustomGlance;
+ protected
+ procedure Change; override;
+ public
+ constructor Create(AOwner: TJvTFCustomGlance);
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ end;
+
+ TJvTFTextAttr = class(TPersistent)
+ private
+ FFont: TFont;
+ FOnChange: TNotifyEvent;
+ FRotation: Integer;
+ FAlignH: TAlignment;
+ FAlignV: TJvTFVAlignment;
+ procedure SetFont(Value: TFont);
+ procedure SetRotation(Value: Integer);
+ procedure SetAlignH(Value: TAlignment);
+ procedure SetAlignV(Value: TJvTFVAlignment);
+ protected
+ procedure FontChange(Sender: TObject);
+ procedure DoChange; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ published
+ property Font: TFont read FFont write SetFont;
+ property Rotation: Integer read FRotation write SetRotation default 0;
+ property AlignH: TAlignment read FAlignH write SetAlignH default taLeftJustify;
+ property AlignV: TJvTFVAlignment read FAlignV write SetAlignV default vaCenter;
+ end;
+
+ TJvTFGlanceTitlePicAttr = class(TPersistent)
+ private
+ FAlignH: TAlignment;
+ FAlignV: TJvTFVAlignment;
+ FOnChange: TNotifyEvent;
+ procedure SetAlignH(Value: TAlignment);
+ procedure SetAlignV(Value: TJvTFVAlignment);
+ protected
+ procedure DoChange;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ published
+ property AlignH: TAlignment read FAlignH write SetAlignH default taLeftJustify;
+ property AlignV: TJvTFVAlignment read FAlignV write SetAlignV default vaCenter;
+ end;
+
+ TJvTFTitleAlign = alTop..alRight;
+ TJvTFGlanceTitleAttr = class(TPersistent)
+ private
+ FAlign: TJvTFTitleAlign;
+ //FDayFormat: string;
+ FColor: TColor;
+ FHeight: Integer;
+ FVisible: Boolean;
+ FFrameAttr: TJvTFGlanceFrameAttr;
+ FGlanceControl: TJvTFCustomGlance;
+ FDayTxtAttr: TJvTFTextAttr;
+ FPicAttr: TJvTFGlanceTitlePicAttr;
+ procedure SetAlign(Value: TJvTFTitleAlign);
+ //procedure SetDayFormat(Value: string);
+ procedure SetColor(Value: TColor);
+ procedure SetHeight(Value: Integer);
+ procedure SetVisible(Value: Boolean);
+ procedure SetFrameAttr(Value: TJvTFGlanceFrameAttr);
+ procedure SetDayTxtAttr(Value: TJvTFTextAttr);
+ procedure SetPicAttr(Value: TJvTFGlanceTitlePicAttr);
+ protected
+ procedure Change;
+ procedure TxtAttrChange(Sender: TObject);
+ procedure PicAttrChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TJvTFCustomGlance);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ published
+ property Align: TJvTFTitleAlign read FAlign write SetAlign default alTop;
+ //property DayFormat: string read FDayFormat write SetDayFormat;
+ property Color: TColor read FColor write SetColor default clBtnFace;
+ property Height: Integer read FHeight write SetHeight default 20;
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
+ property DayTxtAttr: TJvTFTextAttr read FDayTxtAttr write SetDayTxtAttr;
+ property PicAttr: TJvTFGlanceTitlePicAttr read FPicAttr write SetPicAttr;
+ end;
+
+ TJvTFGlanceCellAttr = class(TPersistent)
+ private
+ FColor: TColor;
+ FFrameAttr: TJvTFGlanceFrameAttr;
+ FTitleAttr: TJvTFGlanceTitleAttr;
+ FGlanceControl: TJvTFCustomGlance;
+ FFont: TFont;
+ FDrawBottomLine: Boolean;
+ procedure SetColor(Value: TColor);
+ procedure SetFrameAttr(Value: TJvTFGlanceFrameAttr);
+ procedure SetTitleAttr(Value: TJvTFGlanceTitleAttr);
+ procedure SetFont(Value: TFont);
+ procedure SetDrawBottomLine(Value: Boolean);
+ protected
+ procedure FontChange(Sender: TObject);
+ procedure Change;
+ public
+ constructor Create(AOwner: TJvTFCustomGlance);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ published
+ property Color: TColor read FColor write SetColor default clWhite;
+ property Font: TFont read FFont write SetFont;
+ property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
+ property TitleAttr: TJvTFGlanceTitleAttr read FTitleAttr write SetTitleAttr;
+ property DrawBottomLine: Boolean read FDrawBottomLine write SetDrawBottomLine;
+ end;
+
+ TJvTFGlanceTitle = class(TPersistent)
+ private
+ FColor: TColor;
+ FHeight: Integer;
+ FVisible: Boolean;
+ FGlanceControl: TJvTFCustomGlance;
+ FFrameAttr: TJvTFGlanceFrameAttr;
+ FTxtAttr: TJvTFTextAttr;
+ FOnChange: TNotifyEvent;
+ procedure SetColor(Value: TColor);
+ procedure SetHeight(Value: Integer);
+ procedure SetVisible(Value: Boolean);
+ procedure SetFrameAttr(Value: TJvTFGlanceFrameAttr);
+ procedure SetTxtAttr(Value: TJvTFTextAttr);
+ protected
+ procedure Change;
+ procedure TxtAttrChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TJvTFCustomGlance);
+ destructor Destroy; override;
+
+ procedure Assign(Source: TPersistent); override;
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ published
+ property Color: TColor read FColor write SetColor default clBtnFace;
+ property FrameAttr: TJvTFGlanceFrameAttr read FFrameAttr write SetFrameAttr;
+ property Height: Integer read FHeight write SetHeight default 40;
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property TxtAttr: TJvTFTextAttr read FTxtAttr write SetTxtAttr;
+ end;
+
+ TJvTFGlanceMainTitle = class(TJvTFGlanceTitle)
+ private
+ FTitle: string;
+ procedure SetTitle(const Value: string);
+ public
+ constructor Create(AOwner: TJvTFCustomGlance);
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Title: string read FTitle write SetTitle;
+ end;
+
+ TJvTFGlanceCoord = record
+ Col: Integer;
+ Row: Integer;
+ Cell: TJvTFGlanceCell;
+ CellX: Integer;
+ CellY: Integer;
+ AbsX: Integer;
+ AbsY: Integer;
+ DragAccept: Boolean;
+ InCellTitle: Boolean;
+ CellTitlePic: TJvTFCellPic;
+ Appt: TJvTFAppt;
+ end;
+
+ TJvTFGlanceSelOrder = (soColMajor, soRowMajor, soRect);
+
+ TJvTFGlanceSelList = class(TJvTFDateList)
+ private
+ FGlanceControl: TJvTFCustomGlance;
+ public
+ constructor Create(AOwner: TJvTFCustomGlance);
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ end;
+
+ TJvTFGlanceDrawTitleEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+ ARect: TRect) of object;
+ TJvTFGlanceDrawCellEvent = procedure(Sender: TObject; ACanvas: TCanvas;
+ ACellRect, ATitleRect, ABodyRect: TRect; Attr: TJvTFGlanceCellAttr;
+ Cell: TJvTFGlanceCell) of object;
+
+ TJvTFGlanceDropApptEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
+ var NewStartDate, NewEndDate: TDate; var Confirm: Boolean) of object;
+
+ TJvTFUpdateCellTitleTextEvent = procedure(Sender: TObject; Cell: TJvTFGlanceCell;
+ var NewText: string) of object;
+
+ TJvTFCustomGlance = class(TJvTFControl)
+ private
+ FGapSize: Integer;
+ FBorderStyle: TBorderStyle;
+ //FStartOfWeek: Word;
+ FStartOfWeek: TTFDayOfWeek;
+
+ FRowCount: Integer;
+ FColCount: Integer;
+ FCells: TJvTFGlanceCells;
+ FStartDate: TDate;
+ FOriginDate: TDate;
+ FCellPics: TCustomImageList;
+
+ FTitleAttr: TJvTFGlanceMainTitle;
+ FAllowCustomDates: Boolean;
+
+ FCellAttr: TJvTFGlanceCellAttr;
+ FSelCellAttr: TJvTFGlanceCellAttr;
+ FSelOrder: TJvTFGlanceSelOrder;
+ FSel: TJvTFGlanceSelList;
+ FUpdatingSel: Boolean;
+
+ FViewer: TJvTFGlanceViewer;
+
+ FOnConfigCells: TNotifyEvent;
+ FOnDrawTitle: TJvTFGlanceDrawTitleEvent;
+ FOnDrawCell: TJvTFGlanceDrawCellEvent;
+ FOnSelChanged: TNotifyEvent;
+ FOnDropAppt: TJvTFGlanceDropApptEvent;
+ FOnUpdateCellTitleText: TJvTFUpdateCellTitleTextEvent;
+
+ FHintProps: TJvTFHintProps;
+
+ FSchedNames: TStringList;
+
+ FSelAppt: TJvTFAppt;
+ FOnApptHint: TJvApptHintEvent;
+
+ function GetSchedNames: TStrings;
+ procedure SetBorderStyle(Value: TBorderStyle);
+
+ procedure SetRowCount(Value: Integer);
+ procedure SetCells(Value: TJvTFGlanceCells);
+ procedure SetStartDate(Value: TDate);
+ procedure SetOriginDate(Value: TDate);
+ procedure SetTitleAttr(Value: TJvTFGlanceMainTitle);
+
+ procedure SetCellAttr(Value: TJvTFGlanceCellAttr);
+ procedure SetTFSelCellAttr(Value: TJvTFGlanceCellAttr);
+ procedure SetViewer(Value: TJvTFGlanceViewer);
+ procedure SetCellPics(Value: TCustomImageList);
+
+ procedure SetHintProps(Value: TJvTFHintProps);
+ procedure SetSchedNames(Value: TStrings);
+
+ procedure SetSelAppt(Value: TJvTFAppt);
+ protected
+ // (rom) bad names
+ FCreatingControl: Boolean;
+
+ FPaintBuffer: TBitmap;
+ FSelAnchor: TJvTFGlanceCell;
+ FMouseCell: TJvTFGlanceCell;
+ FImageChangeLink: TChangeLink;
+ FHint: TJvTFHint;
+
+ procedure SetColCount(Value: Integer); virtual;
+ procedure SetStartOfWeek(Value: TTFDayOfWeek); virtual;
+
+ procedure EnsureCol(Col: Integer);
+ procedure EnsureRow(Row: Integer);
+ procedure EnsureCell(ACell: TJvTFGlanceCell);
+ function ValidCol(Col: Integer): Boolean;
+ function ValidRow(Row: Integer): Boolean;
+ function ValidCell(Col, Row: Integer): Boolean;
+
+ procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
+ procedure CMCtl3DChanged(var Msg: TLMessage); message CM_CTL3DCHANGED;
+ procedure Loaded; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure ImageListChange(Sender: TObject);
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); override;
+
+ procedure GlanceTitleChange(Sender: TObject);
+
+ // mouse routines
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure DblClick; override;
+ procedure Click; override;
+
+ procedure CheckApptHint(Info: TJvTFGlanceCoord); virtual;
+
+ // Drag/Drop routines
+ procedure DoStartDrag(var DragObject: TDragObject); override;
+ procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
+ var Accept: Boolean); override;
+ procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
+ procedure DropAppt(ADragInfo: TJvTFDragInfo; X, Y: Integer);
+
+ // selection routines
+ procedure UpdateSelection;
+ procedure SelChange(Sender: TObject); virtual;
+ property SelOrder: TJvTFGlanceSelOrder read FSelOrder write FSelOrder;
+ procedure InternalSelectCell(ACell: TJvTFGlanceCell); virtual;
+ procedure InternalDeselectCell(ACell: TJvTFGlanceCell); virtual;
+
+ // Drawing routines
+ procedure Paint; override;
+ procedure DrawTitle(ACanvas: TCanvas); virtual;
+ procedure DrawCells(ACanvas: TCanvas);
+ procedure DrawCell(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
+ procedure DrawCellTitle(ACanvas: TCanvas; ATitleRect: TRect;
+ Attr: TJvTFGlanceCellAttr; Cell: TJvTFGlanceCell);
+ procedure DrawCellTitleFrame(ACanvas: TCanvas; ATitleRect: TRect;
+ Attr: TJvTFGlanceCellAttr);
+ procedure DrawCellFrame(ACanvas: TCanvas; ARect: TRect;
+ Attr: TJvTFGlanceCellAttr; ACell: TJvTFGlanceCell);
+ procedure Draw3DFrame(ACanvas: TCanvas; ARect: TRect; TLColor,
+ BRColor: TColor);
+ function PicsToDraw(ACell: TJvTFGlanceCell): Boolean;
+ procedure GetPicsWidthHeight(ACell: TJvTFGlanceCell; PicBuffer: Integer;
+ Horz: Boolean; var PicsWidth, PicsHeight: Integer);
+ function ValidPicIndex(PicIndex: Integer): Boolean;
+
+ // Drawing event dispatch methods
+ procedure DoDrawTitle(ACanvas: TCanvas; ARect: TRect); virtual;
+ procedure DoDrawCell(ACanvas: TCanvas; ACellRect, ATitleRect,
+ ABodyRect: TRect; Attr: TJvTFGlanceCellAttr; Cell: TJvTFGlanceCell); virtual;
+
+ procedure ConfigCells; virtual;
+ procedure DoConfigCells; virtual;
+ procedure SetCellDate(ACell: TJvTFGlanceCell; CellDate: TDate);
+ procedure UpdateCellTitles;
+ procedure UpdateCellTitleText(Cell: TJvTFGlanceCell);
+ function GetCellTitleText(Cell: TJvTFGlanceCell): string; virtual;
+
+ procedure CreateParams(var Params: TCreateParams); override;
+
+ procedure SchedNamesChange(Sender: TObject);
+ property SelAppt: TJvTFAppt read FSelAppt write SetSelAppt;
+ property AllowCustomDates: Boolean read FAllowCustomDates write FAllowCustomDates;
+ // configuration properties and events
+ property RowCount: Integer read FRowCount write SetRowCount default 6;
+ property ColCount: Integer read FColCount write SetColCount default 7;
+ property StartDate: TDate read FStartDate write SetStartDate;
+ property OriginDate: TDate read FOriginDate write SetOriginDate;
+ property OnConfigCells: TNotifyEvent read FOnConfigCells write FOnConfigCells;
+ property StartOfWeek: TTFDayOfWeek read FStartOfWeek write SetStartOfWeek default dowSunday;
+ public
+ function GetTFHintClass: TJvTFHintClass; dynamic;
+
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
+
+ procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); override;
+ procedure SafeReleaseSchedule(ASched: TJvTFSched);
+
+ function GetDataTop: Integer; dynamic;
+ function GetDataLeft: Integer; dynamic;
+ function GetDataWidth: Integer; dynamic;
+ function GetDataHeight: Integer; dynamic;
+
+ procedure SplitRects(Col, Row: Integer; var ParentRect, SubRect: TRect);
+ function CellRect(ACell: TJvTFGlanceCell): TRect;
+ function WholeCellRect(Col, Row: Integer): TRect;
+ function TitleRect: TRect;
+ function CellTitleRect(ACell: TJvTFGlanceCell): TRect;
+ function CellBodyRect(ACell: TJvTFGlanceCell): TRect;
+ function CalcCellTitleRect(ACell: TJvTFGlanceCell; Selected, Full: Boolean): TRect;
+ function CalcCellBodyRect(ACell: TJvTFGlanceCell; Selected, Full: Boolean): TRect;
+ function PtToCell(X, Y: Integer): TJvTFGlanceCoord;
+ property Sel: TJvTFGlanceSelList read FSel write FSel;
+ function DateIsSelected(ADate: TDate): Boolean;
+ function CellIsSelected(ACell: TJvTFGlanceCell): Boolean;
+ procedure SelectCell(ACell: TJvTFGlanceCell; Clear: Boolean = True); virtual;
+ procedure DeselectCell(ACell: TJvTFGlanceCell); virtual;
+ procedure BeginSelUpdate;
+ procedure EndSelUpdate;
+ property UpdatingSel: Boolean read FUpdatingSel;
+
+ function GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr; virtual;
+ procedure CheckViewerApptHint(X, Y: Integer);
+
+ procedure DragDrop(Source: TObject; X, Y: Integer); override;
+ procedure ReconfigCells;
+ procedure SplitCell(ACell: TJvTFGlanceCell);
+ procedure CombineCell(ACell: TJvTFGlanceCell);
+ published
+ property Cells: TJvTFGlanceCells read FCells write SetCells;
+ property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
+ property GapSize: Integer read FGapSize write FGapSize;
+ property TitleAttr: TJvTFGlanceMainTitle read FTitleAttr write SetTitleAttr;
+ property CellAttr: TJvTFGlanceCellAttr read FCellAttr write SetCellAttr;
+ property SelCellAttr: TJvTFGlanceCellAttr read FSelCellAttr write SetTFSelCellAttr;
+ property CellPics: TCustomImageList read FCellPics write SetCellPics;
+ property Viewer: TJvTFGlanceViewer read FViewer write SetViewer;
+ property HintProps: TJvTFHintProps read FHintProps write SetHintProps;
+ property SchedNames: TStrings read GetSchedNames write SetSchedNames;
+ property OnDrawTitle: TJvTFGlanceDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;
+ property OnDrawCell: TJvTFGlanceDrawCellEvent read FOnDrawCell write FOnDrawCell;
+ property OnSelChanged: TNotifyEvent read FOnSelChanged write FOnSelChanged;
+ property OnDropAppt: TJvTFGlanceDropApptEvent read FOnDropAppt write FOnDropAppt;
+ property OnUpdateCellTitleText: TJvTFUpdateCellTitleTextEvent read FOnUpdateCellTitleText
+ write FOnUpdateCellTitleText;
+ property OnApptHint: TJvApptHintEvent read FOnApptHint write FOnApptHint;
+
+ property DateFormat; // from TJvTFControl
+ property TimeFormat; // from TJvTFControl
+
+ property Align;
+ property Color default clWindow;
+ property ParentColor default False;
+ property TabStop default True;
+ property TabOrder;
+ property Anchors;
+ property Constraints;
+ property DragKind;
+ property DragCursor;
+ property DragMode;
+ property Enabled;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property Visible;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
+ property OnEndDock;
+ property OnStartDock;
+ property OnStartDrag;
+ end;
+
+ TJvTFGlanceViewer = class(TComponent)
+ private
+ FGlanceControl: TJvTFCustomGlance;
+ FVisible: Boolean;
+ FCell: TJvTFGlanceCell;
+ FPhysicalCell: TJvTFGlanceCell;
+ FRepeatGrouped: Boolean;
+ FShowSchedNamesInHint: Boolean;
+ FShowStartEndTimeInHint: Boolean;
+ FOnApptHint: TJvApptHintEvent;
+ procedure DoGlanceControlApptHint(Sender: TObject; Appt: TJvTFAppt; var Handled: Boolean);
+ procedure SetShowSchedNamesInHint(const Value: Boolean);
+ function GetRepeatAppt(Index: Integer): TJvTFAppt;
+ function GetSchedule(Index: Integer): TJvTFSched;
+ function GetDate: TDate;
+ procedure SetRepeatGrouped(Value: Boolean);
+ function GetDistinctAppt(Index: Integer): TJvTFAppt;
+ function GetAppt(Index: Integer): TJvTFAppt;
+ procedure SetShowStartEndTimeInHint(const Value: Boolean);
+ protected
+ FInPlaceEdit: Boolean;
+
+ procedure SetInplaceEdit(const Value: Boolean); virtual;
+ procedure SetVisible(Value: Boolean); virtual; abstract;
+ procedure SetGlanceControl(Value: TJvTFCustomGlance); virtual;
+ procedure ParentReconfig; virtual;
+ procedure EnsureCol(ACol: Integer);
+ procedure EnsureRow(ARow: Integer);
+ procedure MouseAccel(X, Y: Integer); virtual;
+ procedure GetDistinctAppts(ApptList: TStringList);
+
+ procedure FinishEditAppt; virtual;
+ function Editing: Boolean; virtual;
+ function CanEdit: Boolean; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;
+
+ procedure SetTo(ACell: TJvTFGlanceCell); virtual;
+ procedure MoveTo(ACell: TJvTFGlanceCell); virtual;
+ procedure Refresh; virtual; abstract;
+ procedure Realign; virtual; abstract;
+ procedure PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell); virtual; abstract;
+
+ property GlanceControl: TJvTFCustomGlance read FGlanceControl;
+ property Cell: TJvTFGlanceCell read FCell;
+ property PhysicalCell: TJvTFGlanceCell read FPhysicalCell;
+ property Date: TDate read GetDate;
+ property Visible: Boolean read FVisible write SetVisible;
+ function CalcBoundsRect(ACell: TJvTFGlanceCell): TRect; virtual;
+
+ function ApptCount: Integer;
+ property Appts[Index: Integer]: TJvTFAppt read GetAppt;
+ function ScheduleCount: Integer;
+ property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
+ function GetApptAt(X, Y: Integer): TJvTFAppt; virtual;
+ published
+ property RepeatGrouped: Boolean read FRepeatGrouped write SetRepeatGrouped default True;
+ property ShowSchedNamesInHint: Boolean read FShowSchedNamesInHint write SetShowSchedNamesInHint default True;
+ property ShowStartEndTimeInHint: Boolean read FShowStartEndTimeInHint write SetShowStartEndTimeInHint default True;
+ property InPlaceEdit: Boolean read FInPlaceEdit write SetInplaceEdit default True;
+ property OnApptHint: TJvApptHintEvent read FOnApptHint write FOnApptHint;
+ end;
+
+ TJvTFGlance = class(TJvTFCustomGlance)
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property RowCount;
+ property ColCount;
+ property OriginDate;
+ property OnConfigCells;
+ end;
+
+
+implementation
+
+uses
+ JvResources, {JclStrings,} JvJVCLUtils;
+
+//=== { TJvTFGlanceCell } ====================================================
+
+constructor TJvTFGlanceCell.Create(ACollection: TCollection);
+begin
+ inherited Create(ACollection);
+ FCellCollection := TJvTFGlanceCells(ACollection);
+
+ if Assigned(CellCollection) and not CellCollection.AllowAdd then
+ CellCollection.AddError;
+
+ FCellPics := TJvTFCellPics.Create(Self);
+ FCanSelect := True;
+
+ FSchedules := TStringList.Create;
+ FSplitOrientation := soHorizontal;
+end;
+
+destructor TJvTFGlanceCell.Destroy;
+var
+ DisconnectList: TStringList;
+ I: Integer;
+ ASched: TJvTFSched;
+begin
+ FDestroying := True;
+
+ //if not CellCollection.AllowDestroy and not CellCollection.FDestroying then
+ //CellCollection.DestroyError;
+
+ if not IsSubCell then
+ FSplitRef.Free
+ else
+ if Assigned(FSplitRef) then
+ begin
+ FSplitRef.FSplitRef := nil;
+ FSplitRef := nil;
+ end;
+
+ FCellPics.Free;
+
+ DisconnectList := TStringList.Create;
+ try
+ DisconnectList.Assign(FSchedules);
+ FSchedules.Clear;
+
+ for I := 0 to DisconnectList.Count - 1 do
+ begin
+ ASched := TJvTFSched(DisconnectList.Objects[I]);
+ CellCollection.GlanceControl.ReleaseSchedule(ASched.SchedName,
+ ASched.SchedDate);
+ end;
+ finally
+ DisconnectList.Free;
+ end;
+ FSchedules.Free;
+
+ inherited Destroy;
+end;
+
+{ TODO 3 -cMisc: Complete TGlance.Assign }
+
+procedure TJvTFGlanceCell.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFGlanceCell then
+ begin
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceCell.Change;
+begin
+ if Assigned(CellCollection.GlanceControl) then
+ CellCollection.GlanceControl.Invalidate;
+end;
+
+procedure TJvTFGlanceCell.CheckConnections;
+var
+ GlanceControl: TJvTFCustomGlance;
+ I: Integer;
+ ASched: TJvTFSched;
+ ASchedName, ASchedID: string;
+begin
+ GlanceControl := CellCollection.GlanceControl;
+
+ if CellCollection.Configuring or not Assigned(GlanceControl.ScheduleManager) or
+ (csLoading in GlanceControl.ComponentState) then
+ Exit;
+
+ // First, disconnect any schedules that shouldn't be connected
+ I := 0;
+ while I < FSchedules.Count do
+ begin
+ ASched := TJvTFSched(FSchedules.Objects[I]);
+ if (GlanceControl.SchedNames.IndexOf(ASched.SchedName) = -1) or
+ not EqualDates(ASched.SchedDate, CellDate) then
+ begin
+ FSchedules.Delete(I);
+ GlanceControl.SafeReleaseSchedule(ASched);
+ end
+ else
+ Inc(I);
+ end;
+
+ // Now connect any schedules that are not connected and should be
+ for I := 0 to GlanceControl.SchedNames.Count - 1 do
+ begin
+ ASchedName := GlanceControl.SchedNames[I];
+ ASchedID := TJvTFScheduleManager.GetScheduleID(ASchedName, CellDate);
+ if FSchedules.IndexOf(ASchedID) = -1 then
+ begin
+ ASched := GlanceControl.RetrieveSchedule(ASchedName, CellDate);
+ FSchedules.AddObject(ASchedID, ASched);
+ end;
+ end;
+
+ if not CellCollection.FCheckingAllConnections then
+ GlanceControl.ScheduleManager.ProcessBatches;
+end;
+
+procedure TJvTFGlanceCell.Combine;
+var
+ LSubCell: TJvTFGlanceCell;
+begin
+ if IsSplit then
+ begin
+ LSubCell := SubCell;
+ FSplitRef.FSplitRef := nil;
+ FSplitRef := nil;
+ CellCollection.ReconfigCells;
+ if not FDestroying and (LSubCell <> Self) then
+ LSubCell.Free;
+ end;
+end;
+
+function TJvTFGlanceCell.GetDisplayName: string;
+var
+ Glance: TJvTFCustomGlance;
+begin
+ Glance := CellCollection.GlanceControl;
+ if Assigned(Glance) then
+ Result := FormatDateTime(Glance.DateFormat, CellDate)
+ else
+ Result := FormatDateTime('m/d/yyyy', CellDate);
+end;
+
+function TJvTFGlanceCell.GetParentCell: TJvTFGlanceCell;
+begin
+ if IsParent then
+ Result := Self
+ else
+ Result := SplitRef;
+end;
+
+function TJvTFGlanceCell.GetSchedule(AIndex: Integer): TJvTFSched;
+begin
+ Result := TJvTFSched(FSchedules.Objects[AIndex]);
+end;
+
+function TJvTFGlanceCell.GetSubCell: TJvTFGlanceCell;
+begin
+ if IsSubCell then
+ Result := Self
+ else
+ Result := SplitRef;
+end;
+
+function TJvTFGlanceCell.IndexOfSchedObj(ASched: TJvTFSched): Integer;
+begin
+ Result := FSchedules.IndexOfObject(ASched);
+end;
+
+function TJvTFGlanceCell.IndexOfSchedule(const SchedName: string; SchedDate: TDate): Integer;
+begin
+ Result := FSchedules.IndexOf(TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate));
+end;
+
+procedure TJvTFGlanceCell.InternalSetCellDate(Value: TDate);
+begin
+ if not EqualDates(Value, FCellDate) then
+ begin
+ FCellDate := Value;
+ if not CellCollection.Configuring and
+ not (csLoading in CellCollection.GlanceControl.ComponentState) then
+ begin
+ CellCollection.GlanceControl.UpdateCellTitleText(Self);
+ CheckConnections;
+ end;
+ end;
+end;
+
+function TJvTFGlanceCell.IsParent: Boolean;
+begin
+ Result := not IsSubCell;
+end;
+
+function TJvTFGlanceCell.IsSchedUsed(ASched: TJvTFSched): Boolean;
+begin
+ Result := IndexOfSchedObj(ASched) <> -1;
+end;
+
+function TJvTFGlanceCell.IsSplit: Boolean;
+begin
+ //Result := Assigned(ParentCell.SubCell);
+ Result := Assigned(FSplitRef);
+end;
+
+function TJvTFGlanceCell.IsSubCell: Boolean;
+begin
+ Result := FIsSubCell;
+end;
+
+function TJvTFGlanceCell.ScheduleCount: Integer;
+begin
+ Result := FSchedules.Count;
+end;
+
+procedure TJvTFGlanceCell.SetCanSelect(Value: Boolean);
+begin
+ FCanSelect := Value;
+end;
+
+procedure TJvTFGlanceCell.SetCellDate(Value: TDate);
+begin
+ if Assigned(CellCollection.GlanceControl) and
+ (not CellCollection.GlanceControl.AllowCustomDates and
+ not (csLoading in CellCollection.GlanceControl.ComponentState)) then
+ raise EJvTFGlanceError.CreateRes(@RsECellDatesCannotBeChanged);
+
+ InternalSetCellDate(Value);
+end;
+
+procedure TJvTFGlanceCell.SetCellPics(Value: TJvTFCellPics);
+begin
+ FCellPics.Assign(Value);
+ Change;
+end;
+
+procedure TJvTFGlanceCell.SetColIndex(Value: Integer);
+begin
+ FColIndex := Value;
+end;
+
+procedure TJvTFGlanceCell.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceCell.SetRowIndex(Value: Integer);
+begin
+ FRowIndex := Value;
+end;
+
+//=== { TJvTFGlanceCells } ===================================================
+
+constructor TJvTFGlanceCells.Create(AGlanceControl: TJvTFCustomGlance);
+begin
+ inherited Create(TJvTFGlanceCell);
+ FGlanceControl := AGlanceControl;
+end;
+
+destructor TJvTFGlanceCells.Destroy;
+begin
+ FDestroying := True;
+ inherited Destroy;
+end;
+
+function TJvTFGlanceCells.Add: TJvTFGlanceCell;
+begin
+ Result := nil;
+ AddError;
+end;
+
+procedure TJvTFGlanceCells.AddError;
+begin
+ //if Assigned(GlanceControl) and not (csLoading in GlanceControl.ComponentState) then
+ //raise EJvTFGlanceError.Create('Cells cannot be manually added');
+end;
+
+procedure TJvTFGlanceCells.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TJvTFGlanceCells then
+ begin
+ BeginUpdate;
+ try
+ FAllowDestroy := True;
+ try
+ Clear;
+ finally
+ FAllowDestroy := False;
+ end;
+
+ for I := 0 to TJvTFGlanceCells(Source).Count - 1 do
+ InternalAdd.Assign(TJvTFGlanceCells(Source).Items[I]);
+ finally
+ EndUpdate;
+ end;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceCells.CheckConnections;
+var
+ I: Integer;
+begin
+ if (not Assigned(GlanceControl) or not Assigned(GlanceControl.ScheduleManager)) or
+ (csLoading in GlanceControl.ComponentState) then
+ Exit;
+
+ FCheckingAllConnections := True;
+ try
+ {
+ for I := 0 to Count - 1 do
+ Items[I].CheckConnections;
+ }
+ for I := 0 to Count - 1 do
+ with Items[I] do
+ begin
+ CheckConnections;
+ if IsSplit then
+ SubCell.CheckConnections;
+ end;
+ finally
+ FCheckingAllConnections := False;
+ GlanceControl.ScheduleManager.ProcessBatches;
+ end;
+end;
+
+procedure TJvTFGlanceCells.ConfigCells;
+begin
+ {
+ if not Assigned(GlanceControl) or
+ (csDesigning in GlanceControl.ComponentState) then
+ Exit;
+ }
+ if Configuring then
+ Exit;
+
+ FConfiguring := True;
+ try
+ GlanceControl.ConfigCells;
+ finally
+ FConfiguring := False;
+ end;
+
+ // connect and release cells to/from schedule objects here.
+ CheckConnections;
+
+ if Assigned(GlanceControl.Viewer) then
+ GlanceControl.Viewer.ParentReconfig;
+end;
+
+procedure TJvTFGlanceCells.DestroyError;
+begin
+ //raise EJvTFGlanceError.Create('Cells cannot be manually destroyed');
+end;
+
+procedure TJvTFGlanceCells.EnsureCellCount;
+var
+ I, DeltaCount: Integer;
+begin
+ {
+ if not Assigned(GlanceControl) or
+ (csDesigning in GlanceControl.ComponentState) then
+ Exit;
+ }
+ if not Assigned(GlanceControl) then
+ Exit;
+
+ // Adjust the cell count
+ DeltaCount := GlanceControl.RowCount * GlanceControl.ColCount - Count;
+
+ for I := 1 to DeltaCount do
+ InternalAdd;
+
+ FAllowDestroy := True;
+ try
+ for I := -1 downto DeltaCount do
+ Items[Count - 1].Free;
+ finally
+ FAllowDestroy := False;
+ end;
+end;
+
+procedure TJvTFGlanceCells.EnsureCells;
+var
+ I, J, K: Integer;
+ SaveConfiguring: Boolean;
+begin
+ SaveConfiguring := Configuring;
+ FConfiguring := True;
+ try
+ EnsureCellCount;
+
+ K := 0;
+ for I := 0 to GlanceControl.RowCount - 1 do
+ for J := 0 to GlanceControl.ColCount - 1 do
+ with Items[K] do
+ begin
+ SetColIndex(J);
+ SetRowIndex(I);
+ CellPics.Clear;
+ Combine;
+ Inc(K);
+ end;
+ finally
+ FConfiguring := SaveConfiguring;
+ end;
+end;
+
+function TJvTFGlanceCells.GetCell(ColIndex, RowIndex: Integer): TJvTFGlanceCell;
+var
+ AbsIndex: Integer;
+ S: string;
+begin
+ Result := nil;
+ if not Assigned(GlanceControl) then
+ Exit;
+
+ AbsIndex := RowIndex * GlanceControl.ColCount + ColIndex;
+ if (AbsIndex >= 0) and (AbsIndex < Count) then
+ begin
+ Result := Items[AbsIndex];
+ if ((Result.ColIndex <> ColIndex) or (Result.RowIndex <> RowIndex)) and not (csDesigning in GlanceControl.ComponentState) then
+ begin
+ S := '(' + IntToStr(Result.ColIndex) + ':' + IntToStr(ColIndex) + ') ' +
+ '(' + IntToStr(Result.RowIndex) + ':' + IntToStr(RowIndex) + ')';
+ raise EJvTFGlanceError.CreateResFmt(@RsECellMapHasBeenCorrupteds, [S]);
+ end;
+ end;
+end;
+
+function TJvTFGlanceCells.GetItem(Index: Integer): TJvTFGlanceCell;
+begin
+ Result := TJvTFGlanceCell(inherited GetItem(Index));
+end;
+
+function TJvTFGlanceCells.GetOwner: TPersistent;
+begin
+ Result := GlanceControl;
+end;
+
+function TJvTFGlanceCells.InternalAdd: TJvTFGlanceCell;
+begin
+ FAllowAdd := True;
+ try
+ Result := TJvTFGlanceCell(inherited Add);
+ finally
+ FAllowAdd := False;
+ end;
+end;
+
+function TJvTFGlanceCells.IsSchedUsed(ASched: TJvTFSched): Boolean;
+var
+ I: Integer;
+ ACell: TJvTFGlanceCell;
+begin
+ Result := False;
+ I := 0;
+ while (I < Count) and not Result do
+ begin
+ ACell := Items[I];
+
+ if ACell.IsSchedUsed(ASched) then
+ Result := True
+ else
+ if ACell.IsSplit and ACell.SubCell.IsSchedUsed(ASched) then
+ Result := True
+ else
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFGlanceCells.ReconfigCells;
+var
+ I: Integer;
+begin
+ if FConfiguring then
+ Exit;
+
+ FConfiguring := True;
+ try
+ for I := 0 to Count - 1 do
+ with Items[I] do
+ begin
+ CellPics.Clear;
+ if IsSplit then
+ SubCell.CellPics.Clear;
+ end;
+ EnsureCells;
+ GlanceControl.ConfigCells;
+ finally
+ FConfiguring := False;
+ end;
+
+ // connect and release cells to/from schedule objects here.
+ CheckConnections;
+
+ if Assigned(GlanceControl.Viewer) then
+ GlanceControl.Viewer.ParentReconfig;
+ GlanceControl.Invalidate;
+end;
+
+procedure TJvTFGlanceCells.SetItem(Index: Integer; Value: TJvTFGlanceCell);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+procedure TJvTFGlanceCells.Update(Item: TCollectionItem);
+begin
+end;
+
+//=== { TJvTFCustomGlance } ==================================================
+
+constructor TJvTFCustomGlance.Create(AOwner: TComponent);
+begin
+ FCreatingControl := True;
+
+ AllowCustomDates := False;
+ inherited Create(AOwner);
+ ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csClickEvents,
+ csDoubleClicks];
+ TabStop := True;
+ Height := 300;
+ Width := 300;
+
+ //Color := clRed;
+ FBorderStyle := bsSingle;
+ FStartOfWeek := dowSunday;
+ FGapSize := 0;
+ FRowCount := 6;
+ FColCount := 7;
+
+ FPaintBuffer := TBitmap.Create;
+
+ FSchedNames := TStringList.Create;
+ FSchedNames.OnChange := @SchedNamesChange;
+
+ FCells := TJvTFGlanceCells.Create(Self);
+ StartDate := Date;
+
+ FTitleAttr := TJvTFGlanceMainTitle.Create(Self);
+
+// obones: Commented out, it goes against the default value in TJvTFGlanceMainTitle
+// FTitleAttr.Visible := False; // not visible by default. (Tim)
+ FTitleAttr.OnChange := @GlanceTitleChange;
+
+ FCellAttr := TJvTFGlanceCellAttr.Create(Self);
+ FCellAttr.TitleAttr.DayTxtAttr.AlignH := taLeftJustify;
+ FSelCellAttr := TJvTFGlanceCellAttr.Create(Self);
+ FSelCellAttr.TitleAttr.Color := clNavy;
+ FSelCellAttr.TitleAttr.DayTxtAttr.Font.Color := clWhite;
+
+ //FSelOrder := soColMajor;
+ FSelOrder := soRowMajor;
+ FSel := TJvTFGlanceSelList.Create(Self);
+ FSel.OnChange := @SelChange;
+
+ FImageChangeLink := TChangeLink.Create;
+ FImageChangeLink.OnChange := @ImageListChange;
+
+ FHintProps := TJvTFHintProps.Create(Self);
+ //FHint := TJvTFHint.Create(Self);
+ FHint := GetTFHintClass.Create(Self);
+ FHint.RefProps := FHintProps;
+
+ FCreatingControl := False;
+
+ Cells.EnsureCells;
+ Cells.ConfigCells;
+end;
+
+destructor TJvTFCustomGlance.Destroy;
+begin
+ FCells.Free;
+ FTitleAttr.Free;
+ FCellAttr.Free;
+ FSelCellAttr.Free;
+ FSel.OnChange := nil;
+ FSel.Free;
+ FPaintBuffer.Free;
+ FImageChangeLink.Free;
+
+ FHint.Free;
+ FHintProps.Free;
+
+ FSchedNames.OnChange := nil;
+ FSchedNames.Free;
+
+ Viewer := nil;
+
+ inherited Destroy;
+end;
+
+function TJvTFCustomGlance.CalcCellBodyRect(ACell: TJvTFGlanceCell;
+ Selected, Full: Boolean): TRect;
+var
+ Attr: TJvTFGlanceCellAttr;
+ Offset: Integer;
+begin
+ {
+ Windows.SubtractRect(Result, CellRect(ACell),
+ CalcCellTitleRect(ACell, Selected, True));
+ }
+ SubtractRect(Result, CellRect(ACell),
+ CalcCellTitleRect(ACell, Selected, True));
+ if not Full then
+ begin
+ if Selected then
+ Attr := SelCellAttr
+ else
+ Attr := CellAttr;
+
+ case Attr.FrameAttr.Style of
+ fs3DRaised, fs3DLowered:
+ Offset := 1;
+ fsFlat:
+ Offset := Attr.FrameAttr.Width;
+ else
+ Offset := 0;
+ end;
+
+ // Col 0 has frame running down left side of cell, whereas others
+ // do not.
+ if ACell.ColIndex = 0 then
+ Inc(Result.Left, Offset);
+
+ Dec(Result.Bottom, Offset);
+ Dec(Result.Right, Offset);
+ end;
+end;
+
+function TJvTFCustomGlance.CellIsSelected(ACell: TJvTFGlanceCell): Boolean;
+begin
+ Result := False;
+ if Assigned(ACell) then
+ Result := DateIsSelected(ACell.CellDate);
+end;
+
+function TJvTFCustomGlance.CellRect(ACell: TJvTFGlanceCell): TRect;
+var
+ ParentRect, SubRect: TRect;
+begin
+ Result := EmptyRect;
+ if Assigned(ACell) then
+ begin
+ SplitRects(ACell.ColIndex, ACell.RowIndex, ParentRect, SubRect);
+ if ACell.IsParent then
+ Result := ParentRect
+ else
+ Result := SubRect;
+ end;
+end;
+
+function TJvTFCustomGlance.CalcCellTitleRect(ACell: TJvTFGlanceCell;
+ Selected, Full: Boolean): TRect;
+var
+ Attr: TJvTFGlanceCellAttr;
+begin
+ if Selected then
+ Attr := SelCellAttr
+ else
+ Attr := CellAttr;
+
+ if not Attr.TitleAttr.Visible then
+ begin
+ Result := Rect(0, 0, 0, 0);
+ Exit;
+ end
+ else
+ Result := CellRect(ACell);
+
+ case Attr.TitleAttr.Align of
+ alTop:
+ Result.Bottom := Result.Top + Attr.TitleAttr.Height;
+ alBottom:
+ Result.Top := Result.Bottom - Attr.TitleAttr.Height;
+ alLeft:
+ Result.Right := Result.Left + Attr.TitleAttr.Height;
+ alRight:
+ Result.Left := Result.Right - Attr.TitleAttr.Height;
+ end;
+
+ if not Full then
+ begin
+ case Attr.TitleAttr.FrameAttr.Style of
+ fs3DLowered, fs3DRaised:
+ InflateRect(Result, -1, -1);
+ fsFlat:
+ case Attr.TitleAttr.Align of
+ alTop:
+ Dec(Result.Bottom, Attr.TitleAttr.FrameAttr.Width);
+ alBottom:
+ Inc(Result.Top, Attr.TitleAttr.FrameAttr.Width);
+ alLeft:
+ Dec(Result.Right, Attr.TitleAttr.FrameAttr.Width);
+ alRight:
+ Inc(Result.Left, Attr.TitleAttr.FrameAttr.Width);
+ end;
+ end;
+ end;
+end;
+
+
+
+procedure TJvTFCustomGlance.CMCtl3DChanged(var Msg: TLMessage);
+begin
+ if FBorderStyle = bsSingle then
+// RecreateWnd;
+ RecreateWnd(self);
+ inherited;
+end;
+
+procedure TJvTFCustomGlance.CreateParams(var Params: TCreateParams);
+const
+ BorderStyles: array [TBorderStyle] of DWORD = (0, WS_BORDER);
+begin
+ inherited CreateParams(Params);
+ with Params do
+ begin
+ Style := Style or BorderStyles[FBorderStyle] or WS_CLIPCHILDREN;
+ if {Ctl3D and} (FBorderStyle = bsSingle) then // wp: commented Ctl3D
+ begin
+ Style := Style and not WS_BORDER;
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+ end;
+ end;
+end;
+
+
+
+function TJvTFCustomGlance.DateIsSelected(ADate: TDate): Boolean;
+begin
+ Result := Sel.IndexOf(ADate) <> -1;
+end;
+
+procedure TJvTFCustomGlance.DblClick;
+begin
+ inherited DblClick;
+end;
+
+procedure TJvTFCustomGlance.Click;
+begin
+ inherited Click;
+end;
+
+procedure TJvTFCustomGlance.DoConfigCells;
+begin
+ if Assigned(FOnConfigCells) then
+ FOnConfigCells(Self);
+end;
+
+procedure TJvTFCustomGlance.Draw3DFrame(ACanvas: TCanvas; ARect: TRect;
+ TLColor, BRColor: TColor);
+var
+ OldPenColor: TColor;
+begin
+ with ACanvas do
+ begin
+ OldPenColor := Pen.Color;
+ Pen.Color := TLColor;
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Right, ARect.Top);
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Left, ARect.Bottom);
+
+ Pen.Color := BRColor;
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ Pen.Color := OldPenColor;
+ end;
+end;
+
+procedure TJvTFCustomGlance.DrawCell(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
+var
+ ARect, lTitleRect, BodyRect: TRect;
+ Attr: TJvTFGlanceCellAttr;
+begin
+ with ACanvas do
+ begin
+ ARect := CellRect(ACell);
+ Attr := GetCellAttr(ACell);
+ lTitleRect := CellTitleRect(ACell);
+
+ // Calc the body rect
+ SubtractRect(BodyRect, ARect, lTitleRect);
+
+ // Draw the cell title
+ if Attr.TitleAttr.Visible then
+ DrawCellTitle(ACanvas, lTitleRect, Attr, ACell);
+
+ // Shade the body of the cell
+ Brush.Color := Attr.Color;
+ FillRect(BodyRect);
+
+ DrawCellFrame(ACanvas, ARect, Attr, ACell);
+
+ // Draw the cell data
+ if Assigned(Viewer) and not (csDesigning in ComponentState) then
+ Viewer.PaintTo(ACanvas, ACell);
+
+ DoDrawCell(ACanvas, ARect, lTitleRect, BodyRect, Attr, ACell);
+ end;
+end;
+
+procedure TJvTFCustomGlance.DrawCells(ACanvas: TCanvas);
+var
+ Col, Row: Integer;
+ ACell: TJvTFGlanceCell;
+begin
+ for Col := 0 to ColCount - 1 do
+ for Row := 0 to RowCount - 1 do
+ begin
+ ACell := Cells.Cells[Col, Row];
+ DrawCell(ACanvas, ACell);
+ if Assigned(ACell.SubCell) then
+ DrawCell(ACanvas, ACell.SubCell);
+ end;
+end;
+
+procedure TJvTFCustomGlance.DrawTitle(ACanvas: TCanvas);
+var
+ ARect, TxtRect: TRect;
+ OldPen: TPen;
+ OldBrush: TBrush;
+ OldFont: TFont;
+ I, LineBottom: Integer;
+ ts: TTextStyle;
+begin
+ if not TitleAttr.Visible then
+ Exit;
+
+ ARect := TitleRect;
+ TxtRect := ARect;
+ InflateRect(TxtRect, -2, -2);
+
+ with ACanvas do
+ begin
+ OldPen := TPen.Create;
+ OldPen.Assign(Pen);
+ OldBrush := TBrush.Create;
+ OldBrush.Assign(Brush);
+ OldFont := TFont.Create;
+ OldFont.Assign(Font);
+
+ Brush.Color := TitleAttr.Color;
+ FillRect(ARect);
+
+ //Pen.Color := clBlack;
+ //MoveTo(ARect.Left, ARect.Bottom - 1);
+ //LineTo(ARect.Right, ARect.Bottom - 1);
+
+ case TitleAttr.FrameAttr.Style of
+ fs3DRaised:
+ Draw3DFrame(ACanvas, ARect, clBtnHighlight, clBtnShadow);
+ fs3DLowered:
+ Draw3DFrame(ACanvas, ARect, clBtnShadow, clBtnHighlight);
+ {
+ fs3DRaised, fs3DLowered :
+ begin
+ if TitleAttr.FrameAttr.Style = fs3DRaised then
+ Pen.Color := clBtnHighlight
+ else
+ Pen.Color := clBtnShadow;
+
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Right, ARect.Top);
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Left, ARect.Bottom);
+
+ if TitleAttr.FrameAttr.Style = fs3DRaised then
+ Pen.Color := clBtnShadow
+ else
+ Pen.Color := clBtnHighlight;
+
+ MoveTo(ARect.Right - 1, ARect.Top);
+ LineTo(ARect.Right - 1, ARect.Bottom);
+ MoveTo(ARect.Left, ARect.Bottom - 1);
+ LineTo(ARect.Right, ARect.Bottom - 1);
+ end;
+ }
+ fsFlat:
+ begin
+ Pen.Color := TitleAttr.FrameAttr.Color;
+ {
+ Pen.Width := TitleAttr.FrameAttr.Width;
+ LineBottom := ARect.Bottom - Pen.Width div 2;
+ if Odd(Pen.Width) then
+ Dec(LineBottom);
+ MoveTo(ARect.Left, LineBottom);
+ LineTo(ARect.Right, LineBottom);
+ }
+ Pen.Width := 1;
+ LineBottom := ARect.Bottom - 1;
+ for I := 1 to TitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(ARect.Left, LineBottom);
+ LineTo(ARect.Right, LineBottom);
+ Dec(LineBottom);
+ end;
+ end;
+ end;
+
+ //Font.Assign(TitleAttr.Font);
+ Font.Assign(TitleAttr.TxtAttr.Font);
+ ts := Canvas.TextStyle;
+ ts.Alignment := taCenter;
+ ts.Layout := tlCenter;
+ ACanvas.TextRect(TxtRect, txtRect.Left, txtRect.Top, TitleAttr.Title, ts);
+
+ Pen.Assign(OldPen);
+ Brush.Assign(OldBrush);
+ Font.Assign(OldFont);
+ OldPen.Free;
+ OldBrush.Free;
+ OldFont.Free;
+ end;
+
+ DoDrawTitle(ACanvas, ARect);
+end;
+
+procedure TJvTFCustomGlance.EnsureCell(ACell: TJvTFGlanceCell);
+begin
+ if not Assigned(ACell) then
+ raise EJvTFGlanceError.CreateRes(@RsECellObjectNotAssigned);
+end;
+
+procedure TJvTFCustomGlance.EnsureCol(Col: Integer);
+begin
+ if (Col < 0) or (Col >= ColCount) then
+ raise EJvTFGlanceError.CreateResFmt(@RsEInvalidColIndexd, [Col]);
+end;
+
+procedure TJvTFCustomGlance.EnsureRow(Row: Integer);
+begin
+ if (Row < 0) or (Row >= RowCount) then
+ raise EJvTFGlanceError.CreateResFmt(@RsEInvalidRowIndexd, [Row]);
+end;
+
+function TJvTFCustomGlance.GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr;
+begin
+ if CellIsSelected(ACell) then
+ Result := SelCellAttr
+ else
+ Result := CellAttr;
+end;
+
+function TJvTFCustomGlance.GetDataHeight: Integer;
+begin
+ Result := ClientHeight - GetDataTop;
+end;
+
+function TJvTFCustomGlance.GetDataLeft: Integer;
+begin
+ Result := 0;
+end;
+
+function TJvTFCustomGlance.GetDataTop: Integer;
+begin
+ Result := 0;
+ if TitleAttr.Visible then
+ Inc(Result, TitleAttr.Height);
+end;
+
+function TJvTFCustomGlance.GetDataWidth: Integer;
+begin
+ Result := ClientWidth - GetDataLeft;
+end;
+
+procedure TJvTFCustomGlance.ImageListChange(Sender: TObject);
+begin
+ Invalidate;
+end;
+
+procedure TJvTFCustomGlance.InternalSelectCell(ACell: TJvTFGlanceCell);
+begin
+ if Assigned(ACell) and ACell.CanSelect then
+ Sel.Add(ACell.CellDate);
+end;
+
+procedure TJvTFCustomGlance.Loaded;
+begin
+ inherited Loaded;
+ Cells.EnsureCells;
+ Cells.ConfigCells;
+end;
+
+procedure TJvTFCustomGlance.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+var
+ Info: TJvTFGlanceCoord;
+begin
+ inherited MouseDown(Button, Shift, X, Y);
+
+ if Enabled then
+ SetFocus;
+
+ Info := PtToCell(X, Y);
+ if Assigned(Viewer) and (Viewer.Cell <> Info.Cell) then
+ Viewer.Visible := False;
+
+ if ssLeft in Shift then
+ begin
+ if ssShift in Shift then
+ begin
+ // contiguous selection
+ if Info.Cell.CanSelect then
+ begin
+ FMouseCell := Info.Cell;
+ UpdateSelection;
+ end;
+ end
+ else
+ if ssCtrl in Shift then
+ begin
+ // non-contiguous selection
+ if CellIsSelected(Info.Cell) then
+ DeselectCell(Info.Cell)
+ else
+ SelectCell(Info.Cell, False);
+ end
+ else
+ begin
+ if Assigned(Info.Cell) and Info.Cell.CanSelect then
+ SelectCell(Info.Cell, True);
+ SelAppt := Info.Appt;
+ if Assigned(Info.Appt) then
+ BeginDrag(False);
+ end;
+ end;
+end;
+
+procedure TJvTFCustomGlance.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+ //S: string;
+ Info: TJvTFGlanceCoord;
+ Hints: TStrings;
+begin
+ inherited MouseMove(Shift, X, Y);
+
+ Info := PtToCell(X, Y);
+
+ if not Focused and not (csDesigning in ComponentState) then
+ Exit;
+
+ if Assigned(Info.CellTitlePic) then
+ Hints := Info.CellTitlePic.Hints
+ else
+ Hints := nil;
+
+ FHint.MultiLineObjHint(Info.CellTitlePic, X, Y, Hints);
+ {
+ if Assigned(Info.CellTitlePic) then
+ FHint.MultiLineObjHint(Info.CellTitlePic, X, Y, Info.CellTitlePic.Hints)
+ else
+ FHint.ReleaseHandle;
+ }
+
+ if (Info.Col > -1) and (Info.Row > -1) and not Info.InCellTitle then
+ CheckApptHint(Info);
+
+ // EXIT if we've already processed a mouse move for the current cell
+ if Info.Cell = FMouseCell then
+ Exit;
+
+ FMouseCell := Info.Cell;
+
+ // TESTING ONLY!!!
+ //S := IntToStr(Info.Col) + ', ' + IntToStr(Info.Row);
+ //GetParentForm(Self).Caption := S;
+
+ if ssLeft in Shift then
+ begin
+ UpdateSelection;
+ end;
+end;
+
+procedure TJvTFCustomGlance.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+var
+ Info: TJvTFGlanceCoord;
+begin
+ inherited MouseUp(Button, Shift, X, Y);
+
+ if (Sel.Count = 1) and Assigned(Viewer) then
+ begin
+ Info := PtToCell(X, Y);
+ Viewer.MoveTo(Info.Cell);
+ Viewer.Visible := True;
+ if not Info.InCellTitle then
+ Viewer.MouseAccel(X, Y);
+ end;
+end;
+
+procedure TJvTFCustomGlance.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = Viewer then
+ Viewer := nil
+ else
+ if AComponent = CellPics then
+ CellPics := nil;
+end;
+
+procedure TJvTFCustomGlance.Paint;
+begin
+ with FPaintBuffer do
+ begin
+ Height := ClientHeight;
+ Width := ClientWidth;
+
+ with Canvas do
+ begin
+ Brush.Color := Color;
+ FillRect(ClientRect);
+ end;
+
+ DrawTitle(Canvas);
+ DrawCells(Canvas);
+ end;
+
+ if Enabled then
+ //Windows.BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
+ BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
+ FPaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
+ else
+ { wp ---- to do: the following BitBlt is a workaround for DrawState missing in LCL
+ Windows.DrawState(Canvas.Handle, 0, nil, FPaintBuffer.Handle, 0,
+ 0, 0, 0, 0, DST_BITMAP or DSS_UNION or DSS_DISABLED);
+ }
+ BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
+ FPaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
+end;
+
+function TJvTFCustomGlance.PtToCell(X, Y: Integer): TJvTFGlanceCoord;
+var
+ I, AdjX, AdjY, ViewerX, ViewerY: Integer;
+ PicRect, ViewerBounds, ParentRect, SubRect: TRect;
+ VCell: TJvTFGlanceCell;
+ InSubRect: Boolean;
+begin
+ with Result do
+ begin
+ AbsX := X;
+ AbsY := Y;
+
+ AdjY := Y - GetDataTop;
+ if AdjY < 0 then
+ Row := -1
+ else
+ Row := GetDivNum(GetDataHeight, RowCount, AdjY);
+
+ AdjX := X - GetDataLeft;
+ if AdjX < 0 then
+ Col := -1
+ else
+ Col := GetDivNum(GetDataWidth, ColCount, AdjX);
+
+ if (Col >= 0) and (Row >= 0) then
+ begin
+ Cell := Cells.Cells[Col, Row];
+ SplitRects(Col, Row, ParentRect, SubRect);
+ InSubRect := PtInRect(SubRect, Point(X, Y));
+ if InSubRect then
+ Cell := Cell.SubCell;
+ end
+ else
+ begin
+ InSubRect := False;
+ Cell := nil;
+ end;
+
+ if Col < 0 then
+ CellX := X
+ else
+ if InSubRect and (Cell.SplitOrientation = soVertical) then
+ CellX := X - SubRect.Left
+ else
+ CellX := X - ParentRect.Left;
+
+ if Row < 0 then
+ CellY := Y
+ else
+ if InSubRect and (Cell.SplitOrientation = soHorizontal) then
+ CellY := Y - SubRect.Top
+ else
+ CellY := Y - ParentRect.Top;
+
+ DragAccept := (Col > -1) and (Row > -1) and Assigned(ScheduleManager);
+
+ CellTitlePic := nil;
+ InCellTitle := PtInRect(CellTitleRect(Cell), Point(X, Y));
+ if InCellTitle and Assigned(Cell) and Assigned(CellPics) then
+ begin
+ I := 0;
+ while (I < Cell.CellPics.Count) and not Assigned(CellTitlePic) do
+ begin
+ PicRect.TopLeft := Cell.CellPics[I].PicPoint;
+ PicRect.Right := PicRect.Left + CellPics.Width;
+ PicRect.Bottom := PicRect.Top + CellPics.Height;
+ if PtInRect(PicRect, Point(X, Y)) then
+ CellTitlePic := Cell.CellPics[I]
+ else
+ Inc(I);
+ end;
+ end;
+
+ Appt := nil;
+ if Assigned(Viewer) and not InCellTitle and
+ (Col > -1) and (Row > -1) then
+ begin
+ VCell := Viewer.Cell;
+
+ Viewer.SetTo(Cell);
+ ViewerBounds := Viewer.CalcBoundsRect(Cell);
+
+ ViewerX := AbsX - ViewerBounds.Left;
+ ViewerY := AbsY - ViewerBounds.Top;
+
+ Appt := Viewer.GetApptAt(ViewerX, ViewerY);
+
+ Viewer.SetTo(VCell);
+ end;
+ end;
+end;
+
+// Parameter Clear defaults to True for D4+ versions
+
+procedure TJvTFCustomGlance.SelectCell(ACell: TJvTFGlanceCell; Clear: Boolean);
+begin
+ EnsureCell(ACell);
+
+ BeginSelUpdate;
+ try
+ if Clear then
+ begin
+ Sel.Clear;
+ FSelAnchor := ACell;
+ end;
+ InternalSelectCell(ACell);
+ finally
+ EndSelUpdate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetBorderStyle(Value: TBorderStyle);
+begin
+ if FBorderStyle <> Value then
+ begin
+ FBorderStyle := Value;
+ RecreateWnd(self);
+// RecreateWnd;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+begin
+ inherited SetBounds(ALeft, ATop, AWidth, AHeight);
+ if Assigned(Viewer) then
+ Viewer.Realign;
+end;
+
+procedure TJvTFCustomGlance.SetCellAttr(Value: TJvTFGlanceCellAttr);
+begin
+ FCellAttr.Assign(Value);
+end;
+
+procedure TJvTFCustomGlance.SetCellPics(Value: TCustomImageList);
+begin
+ if ReplaceImageListReference (Self, Value, FCellPics, FImageChangeLink) then
+ Invalidate;
+end;
+
+procedure TJvTFCustomGlance.SetCells(Value: TJvTFGlanceCells);
+begin
+ FCells.Assign(Value);
+end;
+
+procedure TJvTFCustomGlance.SetColCount(Value: Integer);
+begin
+ Value := Greater(Value, 1);
+
+ if Value <> FColCount then
+ begin
+ FColCount := Value;
+ Cells.EnsureCells;
+ Cells.ConfigCells;
+ if Assigned(Viewer) then
+ Viewer.Realign;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetOriginDate(Value: TDate);
+begin
+ if not EqualDates(Value, FOriginDate) then
+ begin
+ FOriginDate := Value;
+ StartOfWeek := BorlToDOW(DayOfWeek(Value));
+ if not FCreatingControl and not (csLoading in ComponentState) then
+ Cells.ConfigCells;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetRowCount(Value: Integer);
+begin
+ Value := Greater(Value, 1);
+
+ if Value <> FRowCount then
+ begin
+ FRowCount := Value;
+ Cells.EnsureCells;
+ Cells.ConfigCells;
+ if Assigned(Viewer) then
+ Viewer.Realign;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetTFSelCellAttr(Value: TJvTFGlanceCellAttr);
+begin
+ FSelCellAttr.Assign(Value);
+end;
+
+procedure TJvTFCustomGlance.SetStartDate(Value: TDate);
+begin
+ if not EqualDates(Value, FStartDate) then
+ begin
+ FStartDate := Value;
+ while BorlToDOW(DayOfWeek(Value)) <> StartOfWeek do
+ Value := Value - 1;
+ OriginDate := Value;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetStartOfWeek(Value: TTFDayOfWeek);
+var
+ WorkDate: TDate;
+begin
+ if Value <> FStartOfWeek then
+ begin
+ FStartOfWeek := Value;
+
+ WorkDate := StartDate;
+ while BorlToDOW(DayOfWeek(WorkDate)) <> FStartOfWeek do
+ WorkDate := WorkDate - 1;
+ OriginDate := WorkDate;
+
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetTitleAttr(Value: TJvTFGlanceMainTitle);
+begin
+ FTitleAttr.Assign(Value);
+ Invalidate;
+end;
+
+procedure TJvTFCustomGlance.SetViewer(Value: TJvTFGlanceViewer);
+begin
+ if Value <> FViewer then
+ begin
+ if Assigned(FViewer) then
+ FViewer.Notify(Self, sncDisconnectControl);
+ if Assigned(Value) then
+ Value.Notify(Self, sncConnectControl);
+ ReplaceComponentReference(Self, Value, TComponent(FViewer));
+ if Assigned(FViewer) then
+ begin
+ FViewer.MoveTo(Cells.Cells[0, 0]);
+ FViewer.Visible := (csDesigning in ComponentState);
+ end;
+ end;
+end;
+
+function TJvTFCustomGlance.TitleRect: TRect;
+begin
+ Result := Rect(0, 0, ClientWidth, 0);
+ if TitleAttr.Visible then
+ Result.Bottom := TitleAttr.Height;
+end;
+
+procedure TJvTFCustomGlance.UpdateSelection;
+var
+ Col, Row, StartCol, EndCol, StartRow, EndRow: Integer;
+ ACell, ACell1, ACell2: TJvTFGlanceCell;
+begin
+ BeginSelUpdate;
+
+ try
+ if not Assigned(FMouseCell) or not Assigned(FSelAnchor) then
+ Exit;
+
+ Sel.Clear;
+ if SelOrder = soColMajor then
+ begin
+ // handle the first sel col
+ if FMouseCell.ColIndex < FSelAnchor.ColIndex then // sel end is left of anchor
+ begin
+ for Row := 0 to FSelAnchor.RowIndex do
+ begin
+ ACell := Cells.Cells[FSelAnchor.ColIndex, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ if not FSelAnchor.IsSubCell then
+ InternalDeselectCell(FSelAnchor.SubCell);
+ end
+ else
+ if FMouseCell.ColIndex = FSelAnchor.ColIndex then // sel end is in same col as anchor
+ begin
+ StartRow := Lesser(FSelAnchor.RowIndex, FMouseCell.RowIndex);
+ EndRow := Greater(FSelAnchor.RowIndex, FMouseCell.RowIndex);
+ for Row := StartRow to EndRow do
+ begin
+ ACell := Cells.Cells[FSelAnchor.ColIndex, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+
+ if (FMouseCell.RowIndex < FSelAnchor.RowIndex) then
+ begin
+ if FMouseCell.IsSubCell then
+ InternalDeselectCell(FMouseCell.ParentCell);
+ if FSelAnchor.IsParent then
+ InternalDeselectCell(FSelAnchor.SubCell);
+ end
+ else
+ if FMouseCell = FSelAnchor then
+ InternalDeselectCell(FMouseCell.SplitRef)
+ else
+ if FMouseCell.RowIndex > FSelAnchor.RowIndex then
+ begin
+ if FMouseCell.IsParent then
+ InternalDeselectCell(FMouseCell.SubCell);
+ if FSelAnchor.IsSubCell then
+ InternalDeselectCell(FSelAnchor.ParentCell);
+ end;
+ end
+ else // sel end is to the right of anchor
+ begin
+ InternalSelectCell(FSelAnchor);
+ if FSelAnchor.IsParent then
+ InternalSelectCell(FSelAnchor.SubCell);
+
+ for Row := FSelAnchor.RowIndex + 1 to RowCount - 1 do
+ begin
+ InternalSelectCell(FSelAnchor.ParentCell);
+ InternalSelectCell(FSelAnchor.SubCell);
+ end;
+ end;
+
+ // handle any intermediate cols (all rows in col will be selected)
+ StartCol := Lesser(FSelAnchor.ColIndex, FMouseCell.ColIndex);
+ EndCol := Greater(FSelAnchor.ColIndex, FMouseCell.ColIndex);
+ for Col := StartCol + 1 to EndCol - 1 do
+ for Row := 0 to RowCount - 1 do
+ begin
+ ACell := Cells.Cells[Col, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+
+ // handle the last sel col
+ if FMouseCell.ColIndex < FSelAnchor.ColIndex then
+ begin
+ InternalSelectCell(FMouseCell);
+ if FMouseCell.IsParent then
+ InternalSelectCell(FMouseCell.SubCell);
+
+ for Row := FMouseCell.RowIndex + 1 to RowCount - 1 do
+ begin
+ ACell := Cells.Cells[FMouseCell.ColIndex, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ end
+ else
+ if FMouseCell.ColIndex > FSelAnchor.ColIndex then
+ begin
+ for Row := 0 to FMouseCell.RowIndex do
+ begin
+ ACell := Cells.Cells[FMouseCell.ColIndex, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ if FMouseCell.IsParent then
+ InternalDeselectCell(FMouseCell.SubCell);
+ end
+ end
+ else
+ if SelOrder = soRowMajor then
+ begin
+ // handle the first sel row
+ if FMouseCell.RowIndex < FSelAnchor.RowIndex then
+ begin
+ for Col := 0 to FSelAnchor.ColIndex do
+ begin
+ ACell := Cells.Cells[Col, FSelAnchor.RowIndex];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ if FSelAnchor.IsParent then
+ InternalDeselectCell(FSelAnchor.SubCell);
+ end
+ else
+ if FMouseCell.RowIndex = FSelAnchor.RowIndex then
+ begin
+ if FMouseCell = FSelAnchor then
+ InternalSelectCell(FMouseCell)
+ else
+ begin
+ if FMouseCell.ColIndex < FSelAnchor.ColIndex then
+ begin
+ ACell1 := FMouseCell;
+ ACell2 := FSelAnchor;
+ end
+ else
+ begin
+ ACell1 := FSelAnchor;
+ ACell2 := FMouseCell;
+ end;
+
+ InternalSelectCell(ACell1);
+ if ACell1.IsParent then
+ InternalSelectCell(ACell1.SubCell);
+
+ InternalSelectCell(ACell2);
+ if ACell2.IsSubCell then
+ InternalSelectCell(ACell2.ParentCell);
+
+ for Col := ACell1.ColIndex + 1 to ACell2.ColIndex - 1 do
+ begin
+ ACell := Cells.Cells[Col, FMouseCell.RowIndex];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ end;
+ end
+ else
+ begin
+ InternalSelectCell(FSelAnchor);
+ if FSelAnchor.IsParent then
+ InternalSelectCell(FSelAnchor.SubCell);
+
+ for Col := FSelAnchor.ColIndex + 1 to ColCount - 1 do
+ begin
+ ACell := Cells.Cells[Col, FSelAnchor.RowIndex];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ end;
+
+ // handle any intermediate rows (all cols in row will be selected)
+ StartRow := Lesser(FSelAnchor.RowIndex, FMouseCell.RowIndex);
+ EndRow := Greater(FSelAnchor.RowIndex, FMouseCell.RowIndex);
+ for Col := 0 to ColCount - 1 do
+ for Row := StartRow + 1 to EndRow - 1 do
+ begin
+ ACell := Cells.Cells[Col, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+
+ // handle last sel row
+ if FMouseCell.RowIndex < FSelAnchor.RowIndex then
+ begin
+ InternalSelectCell(FMouseCell);
+ if FMouseCell.IsParent then
+ InternalSelectCell(FMouseCell.SubCell);
+
+ for Col := FMouseCell.ColIndex + 1 to ColCount - 1 do
+ begin
+ ACell := Cells.Cells[Col, FMouseCell.RowIndex];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ end
+ else
+ if FMouseCell.RowIndex > FSelAnchor.RowIndex then
+ begin
+ for Col := 0 to FMouseCell.ColIndex do
+ begin
+ ACell := Cells.Cells[Col, FMouseCell.RowIndex];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+ if FMouseCell.IsParent then
+ InternalDeselectCell(FMouseCell.SubCell);
+ end
+ end
+ else
+ begin
+ StartRow := Lesser(FSelAnchor.RowIndex, FMouseCell.RowIndex);
+ EndRow := Greater(FSelAnchor.RowIndex, FMouseCell.RowIndex);
+ StartCol := Lesser(FSelAnchor.ColIndex, FMouseCell.ColIndex);
+ EndCol := Greater(FSelAnchor.ColIndex, FMouseCell.ColIndex);
+
+ // select all cells and subcells in square
+ for Col := StartCol to EndCol do
+ for Row := StartRow to EndRow do
+ begin
+ ACell := Cells.Cells[Col, Row];
+ InternalSelectCell(ACell);
+ InternalSelectCell(ACell.SubCell);
+ end;
+
+ // for direction (anchor --> mouse)
+ // W, NW, N, NE: if anchor is parent, anchor subcell is NOT selected and
+ // if mouse is subcell, mouse parent is NOT selected
+ if (FMouseCell.RowIndex < FSelAnchor.RowIndex) or // all northerly dir
+ ((FMouseCell.RowIndex = FSelAnchor.RowIndex) and
+ (FMouseCell.ColIndex < FSelAnchor.ColIndex)) then // west
+ begin
+ if FSelAnchor.IsParent then
+ InternalDeselectCell(FSelAnchor.SubCell);
+
+ if FMouseCell.IsSubCell then
+ InternalDeselectCell(FMouseCell.ParentCell);
+ end
+ // for direction E, SE, S, SW:
+ // if anchor is subcell, anchor parent is NOT selected and
+ // if mouse is parent, mouse subcell is NOT selected
+ else
+ begin
+ if FSelAnchor.IsSubCell then
+ InternalDeselectCell(FSelAnchor.ParentCell);
+
+ if FMouseCell.IsParent then
+ InternalDeselectCell(FMouseCell.SubCell);
+ end;
+ end;
+ finally
+ EndSelUpdate;
+ end;
+end;
+
+function TJvTFCustomGlance.ValidCell(Col, Row: Integer): Boolean;
+begin
+ Result := False;
+ if ValidCol(Col) and ValidRow(Row) then
+ Result := Assigned(Cells.Cells[Col, Row]);
+end;
+
+function TJvTFCustomGlance.ValidCol(Col: Integer): Boolean;
+begin
+ Result := (Col >= 0) and (Col < ColCount);
+end;
+
+function TJvTFCustomGlance.ValidRow(Row: Integer): Boolean;
+begin
+ Result := (Row >= 0) and (Row < RowCount);
+end;
+
+procedure TJvTFCustomGlance.WMEraseBkgnd(var Msg: TLMessage);
+begin
+ Msg.Result := LRESULT(False);
+end;
+
+function TJvTFCustomGlance.CellBodyRect(ACell: TJvTFGlanceCell): TRect;
+begin
+ Result := CalcCellBodyRect(ACell, CellIsSelected(ACell), True);
+end;
+
+function TJvTFCustomGlance.CellTitleRect(ACell: TJvTFGlanceCell): TRect;
+begin
+ Result := CalcCellTitleRect(ACell, CellIsSelected(ACell), True);
+end;
+
+procedure TJvTFCustomGlance.DrawCellTitle(ACanvas: TCanvas; ATitleRect: TRect;
+ Attr: TJvTFGlanceCellAttr; Cell: TJvTFGlanceCell);
+const
+ PicBuffer = 2;
+var
+ Txt: string;
+ DayRect, PicRect, AdjTitleRect, TextBounds: TRect;
+ HorzLayout: Boolean;
+ I, PicIndex, PicLeft, PicTop, PicsHeight, PicsWidth: Integer;
+begin
+ // shade the title
+ ACanvas.Brush.Color := Attr.TitleAttr.Color;
+ ACanvas.FillRect(ATitleRect);
+
+ HorzLayout := (Attr.TitleAttr.Align = alTop) or
+ (Attr.TitleAttr.Align = alBottom);
+
+ if Assigned(Cell) then
+ begin
+ //Txt := FormatDateTime(Attr.TitleAttr.DayFormat, Cell.CellDate);
+ Txt := Cell.TitleText;
+ AdjTitleRect := ATitleRect;
+ InflateRect(AdjTitleRect, -2, -2);
+
+ // Draw the day text and Calc the rects
+ if Txt <> '' then
+ begin
+ ACanvas.Font := Attr.TitleAttr.DayTxtAttr.Font;
+ DrawAngleText(ACanvas, AdjTitleRect, TextBounds,
+ Attr.TitleAttr.DayTxtAttr.Rotation,
+ Attr.TitleAttr.DayTxtAttr.AlignH,
+ Attr.TitleAttr.DayTxtAttr.AlignV, Txt);
+
+ DayRect := AdjTitleRect;
+ case Attr.TitleAttr.Align of
+ alTop, alBottom:
+ case Attr.TitleAttr.DayTxtAttr.AlignH of
+ taLeftJustify:
+ DayRect.Right := TextBounds.Right;
+ taRightJustify:
+ DayRect.Left := TextBounds.Left;
+ end;
+ alLeft, alRight:
+ case Attr.TitleAttr.DayTxtAttr.AlignV of
+ vaTop:
+ DayRect.Bottom := TextBounds.Bottom;
+ vaBottom:
+ DayRect.Top := TextBounds.Top;
+ end;
+ end;
+ SubtractRect(PicRect, AdjTitleRect, DayRect);
+// Windows.SubtractRect(PicRect, AdjTitleRect, DayRect);
+ end
+ else
+ begin
+ DayRect := Rect(0, 0, 0, 0);
+ PicRect := AdjTitleRect;
+ end;
+
+ // draw the pics
+ if PicsToDraw(Cell) then
+ begin
+ GetPicsWidthHeight(Cell, PicBuffer, HorzLayout, PicsWidth, PicsHeight);
+
+ // find PicLeft of first pic
+ case Attr.TitleAttr.PicAttr.AlignH of
+ taLeftJustify:
+ PicLeft := PicRect.Left;
+ taCenter:
+ PicLeft := PicRect.Left + RectWidth(PicRect) div 2 - PicsWidth div 2;
+ else
+ PicLeft := PicRect.Right - PicsWidth;
+ end;
+
+ // find PicTop of first pic
+ case Attr.TitleAttr.PicAttr.AlignV of
+ vaTop:
+ PicTop := PicRect.Top;
+ vaCenter:
+ PicTop := PicRect.Top + RectHeight(PicRect) div 2 - PicsHeight div 2;
+ else
+ PicTop := PicRect.Bottom - PicsHeight;
+ end;
+
+ for I := 0 to Cell.CellPics.Count - 1 do
+ begin
+ PicIndex := Cell.CellPics[I].PicIndex;
+ if ValidPicIndex(PicIndex) then
+ begin
+ Cell.CellPics[I].SetPicPoint(PicLeft, PicTop);
+ CellPics.Draw(ACanvas, PicLeft, PicTop, PicIndex);
+ if HorzLayout then
+ Inc(PicLeft, CellPics.Width + PicBuffer)
+ else
+ Inc(PicTop, CellPics.Height + PicBuffer);
+ end;
+ end;
+ end;
+ end;
+
+ // draw the title frame
+ DrawCellTitleFrame(ACanvas, ATitleRect, Attr);
+end;
+
+procedure TJvTFCustomGlance.DrawCellFrame(ACanvas: TCanvas; ARect: TRect;
+ Attr: TJvTFGlanceCellAttr; ACell: TJvTFGlanceCell);
+var
+ I, LineBottom: Integer;
+begin
+ with ACanvas do
+ begin
+ // draw the cell frame
+ case Attr.FrameAttr.Style of
+ fs3DRaised:
+ Draw3DFrame(ACanvas, ARect, clBtnHighlight, clBtnShadow);
+ fs3DLowered:
+ Draw3DFrame(ACanvas, ARect, clBtnShadow, clBtnHighlight);
+ fsFlat:
+ begin
+ Pen.Color := Attr.FrameAttr.Color;
+ Pen.Width := 1;
+
+ // draw the bottom line
+ LineBottom := ARect.Bottom - 1;
+ for I := 1 to Attr.FrameAttr.Width do
+ begin
+ MoveTo(ARect.Left, LineBottom);
+ LineTo(ARect.Right, LineBottom);
+ Dec(LineBottom);
+ end;
+
+ // draw the right line
+ LineBottom := ARect.Right - 1;
+ for I := 1 to Attr.FrameAttr.Width do
+ begin
+ MoveTo(LineBottom, ARect.Top);
+ LineTo(LineBottom, ARect.Bottom);
+ Dec(LineBottom);
+ end;
+
+ // draw the left line only for col 0 cells
+ if ACell.ColIndex = 0 then
+ begin
+ LineBottom := ARect.Left;
+ for I := 1 to Attr.FrameAttr.Width do
+ begin
+ MoveTo(LineBottom, ARect.Top);
+ LineTo(LineBottom, ARect.Bottom);
+ Inc(LineBottom);
+ end;
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TJvTFCustomGlance.DrawCellTitleFrame(ACanvas: TCanvas; ATitleRect: TRect;
+ Attr: TJvTFGlanceCellAttr);
+var
+ I, LineBottom: Integer;
+begin
+ with ACanvas do
+ begin
+ // draw the title frame
+ case Attr.TitleAttr.FrameAttr.Style of
+ fs3DRaised:
+ Draw3DFrame(ACanvas, ATitleRect, clBtnHighlight, clBtnShadow);
+ fs3DLowered:
+ Draw3DFrame(ACanvas, ATitleRect, clBtnShadow, clBtnHighlight);
+ fsFlat:
+ begin
+ Pen.Color := Attr.TitleAttr.FrameAttr.Color;
+ case Attr.TitleAttr.Align of
+ alTop:
+ begin
+ if Attr.DrawBottomLine then
+ begin
+ LineBottom := ATitleRect.Bottom - 1;
+ for I := 1 to Attr.TitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(ATitleRect.Left + FGapSize, LineBottom);
+ LineTo(ATitleRect.Right - FGapSize, LineBottom);
+ Dec(LineBottom);
+ end;
+ end;
+ end;
+ alBottom:
+ begin
+ LineBottom := ATitleRect.Top;
+ for I := 1 to Attr.TitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(ATitleRect.Left + 4, LineBottom);
+ LineTo(ATitleRect.Right - 4, LineBottom);
+ Inc(LineBottom);
+ end;
+ end;
+ alLeft:
+ begin
+ LineBottom := ATitleRect.Right - 1;
+ for I := 1 to Attr.TitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(LineBottom, ATitleRect.Top);
+ LineTo(LineBottom, ATitleRect.Bottom);
+ Dec(LineBottom);
+ end;
+ end;
+ alRight:
+ begin
+ LineBottom := ATitleRect.Left;
+ for I := 1 to Attr.TitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(LineBottom, ATitleRect.Top);
+ LineTo(LineBottom, ATitleRect.Bottom);
+ Inc(LineBottom);
+ end;
+ end;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function TJvTFCustomGlance.PicsToDraw(ACell: TJvTFGlanceCell): Boolean;
+var
+ I: Integer;
+begin
+ Result := False;
+ if Assigned(CellPics) and (CellPics.Count > 0) then
+ begin
+ I := 0;
+ while (I < ACell.CellPics.Count) and not Result do
+ if ACell.CellPics[I].PicIndex > -1 then
+ Result := True
+ else
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFCustomGlance.GetPicsWidthHeight(ACell: TJvTFGlanceCell;
+ PicBuffer: Integer; Horz: Boolean; var PicsWidth, PicsHeight: Integer);
+var
+ I, PicIndex: Integer;
+begin
+ if Horz then
+ begin
+ PicsWidth := 0;
+ PicsHeight := CellPics.Height;
+ end
+ else
+ begin
+ PicsWidth := CellPics.Width;
+ PicsHeight := 0;
+ end;
+
+ for I := 0 to ACell.CellPics.Count - 1 do
+ begin
+ PicIndex := ACell.CellPics[I].PicIndex;
+ if ValidPicIndex(PicIndex) then
+ if Horz then
+ Inc(PicsWidth, CellPics.Width + PicBuffer)
+ else
+ Inc(PicsHeight, CellPics.Height + PicBuffer);
+ end;
+
+ if Horz and (PicsWidth > 0) then
+ Dec(PicsWidth, PicBuffer);
+
+ if not Horz and (PicsHeight > 0) then
+ Dec(PicsHeight, PicBuffer);
+end;
+
+function TJvTFCustomGlance.ValidPicIndex(PicIndex: Integer): Boolean;
+begin
+ Result := (PicIndex >= 0) and (PicIndex < CellPics.Count);
+end;
+
+procedure TJvTFCustomGlance.SetHintProps(Value: TJvTFHintProps);
+begin
+ FHintProps.Assign(Value);
+end;
+
+procedure TJvTFCustomGlance.DoDrawCell(ACanvas: TCanvas;
+ ACellRect, ATitleRect, ABodyRect: TRect; Attr: TJvTFGlanceCellAttr;
+ Cell: TJvTFGlanceCell);
+begin
+ if Assigned(FOnDrawCell) then
+ FOnDrawCell(Self, ACanvas, ACellRect, ATitleRect, ABodyRect, Attr, Cell);
+end;
+
+procedure TJvTFCustomGlance.DoDrawTitle(ACanvas: TCanvas; ARect: TRect);
+begin
+ if Assigned(FOnDrawTitle) then
+ FOnDrawTitle(Self, ACanvas, ARect);
+end;
+
+procedure TJvTFCustomGlance.InternalDeselectCell(ACell: TJvTFGlanceCell);
+var
+ I: Integer;
+begin
+ if Assigned(ACell) then
+ begin
+ I := Sel.IndexOf(ACell.CellDate);
+ if I > -1 then
+ Sel.Delete(I);
+ end;
+end;
+
+procedure TJvTFCustomGlance.DeselectCell(ACell: TJvTFGlanceCell);
+begin
+ EnsureCell(ACell);
+ InternalDeselectCell(ACell);
+end;
+
+procedure TJvTFCustomGlance.BeginSelUpdate;
+begin
+ FUpdatingSel := True;
+end;
+
+procedure TJvTFCustomGlance.EndSelUpdate;
+begin
+ FUpdatingSel := False;
+ SelChange(Self);
+end;
+
+procedure TJvTFCustomGlance.SelChange(Sender: TObject);
+//var
+// SchedNameList: TStringList;
+// DateList: TJvTFDateList;
+// I: Integer;
+begin
+ if not UpdatingSel then
+ begin
+ if Assigned(FOnSelChanged) then
+ FOnSelChanged(Self);
+
+ // DoNavigate
+// if Assigned(Navigator) then
+// begin
+// SchedNameList := TStringList.Create;
+// DateList := TJvTFDateList.Create;
+// Try
+// SchedNameList.Assign(SchedNames);
+//
+// For I := 0 to Sel.Count - 1 do
+// DateList.Add(Sel[I]);
+//
+// Navigator.Navigate(Self, SchedNameList, DateList);
+// Finally
+// SchedNameList.Free;
+// DateList.Free;
+// end;
+// end;
+
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.ReleaseSchedule(const SchedName: string;
+ SchedDate: TDate);
+begin
+ // ALWAYS RELEASE SCHEDULE HERE
+ inherited ReleaseSchedule(SchedName, SchedDate);
+end;
+
+function TJvTFCustomGlance.GetSchedNames: TStrings;
+begin
+ Result := FSchedNames;
+end;
+
+procedure TJvTFCustomGlance.SetSchedNames(Value: TStrings);
+begin
+ FSchedNames.Assign(Value);
+ // SchedNamesChange will run
+end;
+
+procedure TJvTFCustomGlance.SafeReleaseSchedule(ASched: TJvTFSched);
+begin
+ if not Cells.IsSchedUsed(ASched) then
+ ReleaseSchedule(ASched.SchedName, ASched.SchedDate);
+end;
+
+procedure TJvTFCustomGlance.SchedNamesChange(Sender: TObject);
+begin
+ if not (csDesigning in ComponentState) and not (csCreating in ControlState) then
+ Cells.CheckConnections;
+end;
+
+procedure TJvTFCustomGlance.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ inherited Notify(Sender, Code);
+
+ // WHAT IS THIS CODE FOR ??!!?!!
+ if Assigned(Viewer) then
+ Viewer.Refresh;
+end;
+
+procedure TJvTFCustomGlance.CheckApptHint(Info: TJvTFGlanceCoord);
+var
+ ExtraDesc: string = '';
+ Handled: Boolean;
+begin
+ if Assigned(FViewer) and FViewer.ShowSchedNamesInHint then
+ ExtraDesc := StringsToStr(SchedNames, ', ', False);
+ ExtraDesc := ExtraDesc + #13#10;
+
+ Handled := False;
+ if Assigned(OnApptHint) then
+ FOnApptHint(Self, Info.Appt, Handled);
+ if not Handled then
+ FHint.ApptHint(Info.Appt, Info.AbsX + 8, Info.AbsY + 8,
+ not Assigned(FViewer) or FViewer.ShowStartEndTimeInHint, True, False, ExtraDesc);
+end;
+
+procedure TJvTFCustomGlance.CheckViewerApptHint(X, Y: Integer);
+var
+ Info: TJvTFGlanceCoord;
+begin
+ Info := PtToCell(X, Y);
+ CheckApptHint(Info);
+end;
+
+procedure TJvTFCustomGlance.DoEndDrag(Target: TObject; X, Y: Integer);
+begin
+ inherited DoEndDrag(Target, X, Y);
+end;
+
+procedure TJvTFCustomGlance.DoStartDrag(var DragObject: TDragObject);
+begin
+ if Assigned(Viewer) and Viewer.Editing then
+ Viewer.FinishEditAppt;
+
+ inherited DoStartDrag(DragObject);
+
+ FDragInfo.Appt := SelAppt;
+end;
+
+procedure TJvTFCustomGlance.DragOver(Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+var
+ SrcDragInfo: TJvTFDragInfo;
+ PtInfo: TJvTFGlanceCoord;
+ //Appt: TJvTFAppt;
+begin
+ //Viewer.Visible := False;
+
+ inherited DragOver(Source, X, Y, State, Accept);
+
+ if Source is TJvTFControl then
+ begin
+ SrcDragInfo := TJvTFControl(Source).DragInfo;
+ PtInfo := PtToCell(X, Y);
+ Accept := PtInfo.DragAccept;
+ //Appt := SrcDragInfo.Appt;
+
+ case State of
+ dsDragEnter:
+ begin
+ if not Assigned(FDragInfo) then
+ FDragInfo := SrcDragInfo;
+ //BeginDragging(GridCoord, agsMoveAppt, Appt);
+ end;
+ dsDragLeave:
+ begin
+ //EndDragging(GridCoord, Appt);
+ if FDragInfo.ApptCtrl <> Self then
+ FDragInfo := nil;
+ end;
+ //dsDragMove: ContinueDragging(GridCoord, Appt);
+ end;
+ end;
+end;
+
+procedure TJvTFCustomGlance.SetSelAppt(Value: TJvTFAppt);
+begin
+ if Value <> FSelAppt then
+ begin
+ FSelAppt := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFCustomGlance.DragDrop(Source: TObject; X, Y: Integer);
+begin
+ if Source is TJvTFControl then
+ DropAppt(TJvTFControl(Source).DragInfo, X, Y);
+
+ inherited DragDrop(Source, X, Y);
+end;
+
+procedure TJvTFCustomGlance.DropAppt(ADragInfo: TJvTFDragInfo; X, Y: Integer);
+var
+ NewStart, NewEnd: TDate;
+ Appt: TJvTFAppt;
+ PtInfo: TJvTFGlanceCoord;
+ Confirm: Boolean;
+begin
+ FHint.ReleaseHandle;
+ Appt := ADragInfo.Appt;
+
+ if not Assigned(Appt) then
+ Exit; // happens sometimes
+
+ // calc new info
+ // Schedule(s) do not change
+ PtInfo := PtToCell(X, Y);
+ NewStart := PtInfo.Cell.CellDate;
+ NewEnd := Trunc(Appt.EndDate) - Trunc(Appt.StartDate) + NewStart;
+
+ Confirm := True;
+ if Assigned(FOnDropAppt) then
+ FOnDropAppt(Self, Appt, NewStart, NewEnd, Confirm);
+
+ if Confirm then
+ begin
+ {
+ DateChange := (Trunc(Appt.StartDate) <> Trunc(NewStart)) or
+ (Trunc(Appt.EndDate) <> Trunc(NewEnd));
+
+ if DateChange then
+ begin
+ end;
+ }
+
+ Appt.SetStartEnd(NewStart, Appt.StartTime, NewEnd, Appt.EndTime);
+ ScheduleManager.RefreshConnections(Appt);
+ end;
+end;
+
+procedure TJvTFCustomGlance.ConfigCells;
+begin
+ // DO NOT DIRECTLY CALL THIS ROUTINE!
+ // This routine is called by TJvTFGlanceCells.ConfigCells.
+ // Use this routine to set the cell dates by calling
+ // TJvTFCustomGlance.SetCellDate.
+ // Override this routine in successors to customize
+ // cell/date configuration.
+
+ { Example:
+ CellDate := OriginDate;
+ For Row := 0 to RowCount - 1 do
+ For Col := 0 to ColCount - 1 do
+ begin
+ SetCellDate(Col, Row, CellDate);
+ CellDate := CellDate + 1;
+ end;
+ }
+ DoConfigCells;
+ UpdateCellTitles;
+end;
+
+procedure TJvTFCustomGlance.SetCellDate(ACell: TJvTFGlanceCell; CellDate: TDate);
+begin
+ ACell.InternalSetCellDate(CellDate);
+end;
+
+procedure TJvTFCustomGlance.ReconfigCells;
+begin
+ Cells.ReconfigCells;
+end;
+
+procedure TJvTFCustomGlance.GlanceTitleChange(Sender: TObject);
+begin
+ if Assigned(Viewer) then
+ Viewer.Realign;
+ Invalidate;
+end;
+
+procedure TJvTFCustomGlance.UpdateCellTitleText(Cell: TJvTFGlanceCell);
+var
+ NewTitleText: string;
+begin
+ NewTitleText := GetCellTitleText(Cell);
+ if Assigned(FOnUpdateCellTitleText) then
+ FOnUpdateCellTitleText(Self, Cell, NewTitleText);
+ Cell.SetTitleText(NewTitleText);
+end;
+
+function TJvTFCustomGlance.GetCellTitleText(Cell: TJvTFGlanceCell): string;
+begin
+ Result := FormatDateTime('mm/d/yyyy', Cell.CellDate);
+end;
+
+function TJvTFCustomGlance.WholeCellRect(Col, Row: Integer): TRect;
+begin
+ Result.Left := GetDataLeft + GetDivStart(GetDataWidth, ColCount, Col);
+ Result.Right := Result.Left + GetDivLength(GetDataWidth, ColCount, Col);
+ Result.Top := GetDataTop + GetDivStart(GetDataHeight, RowCount, Row);
+ Result.Bottom := Result.Top + GetDivLength(GetDataHeight, RowCount, Row);
+end;
+
+procedure TJvTFCustomGlance.SplitRects(Col, Row: Integer;
+ var ParentRect, SubRect: TRect);
+var
+ ACell: TJvTFGlanceCell;
+ WorkRect: TRect;
+begin
+ ParentRect := EmptyRect;
+ SubRect := EmptyRect;
+ if not (ValidCol(Col) and ValidRow(Row)) then
+ Exit;
+
+ WorkRect := WholeCellRect(Col, Row);
+ ParentRect := WorkRect;
+
+ ACell := Cells.Cells[Col, Row];
+ if ACell.IsSplit then
+ begin
+ if ACell.SplitOrientation = soHorizontal then
+ ParentRect.Bottom := ParentRect.Top + RectHeight(ParentRect) div 2
+ else
+ ParentRect.Right := ParentRect.Left + RectWidth(ParentRect) div 2;
+ SubtractRect(SubRect, WorkRect, ParentRect);
+// Windows.SubtractRect(SubRect, WorkRect, ParentRect);
+ end;
+end;
+
+procedure TJvTFCustomGlance.UpdateCellTitles;
+var
+ I: Integer;
+ ACell: TJvTFGlanceCell;
+begin
+ for I := 0 to Cells.Count - 1 do
+ begin
+ ACell := Cells[I];
+ UpdateCellTitleText(ACell);
+ if Assigned(ACell.SubCell) then
+ UpdateCellTitleText(ACell.SubCell);
+ end;
+end;
+
+procedure TJvTFCustomGlance.SplitCell(ACell: TJvTFGlanceCell);
+begin
+ ACell.Split;
+end;
+
+procedure TJvTFCustomGlance.CombineCell(ACell: TJvTFGlanceCell);
+begin
+ ACell.Combine;
+end;
+
+function TJvTFCustomGlance.GetTFHintClass: TJvTFHintClass;
+begin
+ Result := TJvTFHint;
+end;
+
+//=== { TJvTFGlanceTitle } ===================================================
+
+constructor TJvTFGlanceTitle.Create(AOwner: TJvTFCustomGlance);
+begin
+ inherited Create;
+ FGlanceControl := AOwner;
+
+ FTxtAttr := TJvTFTextAttr.Create;
+ FTxtAttr.Font.Size := 16;
+ FTxtAttr.Font.Style := FTxtAttr.Font.Style + [fsBold];
+ FTxtAttr.OnChange := @TxtAttrChange;
+
+ FFrameAttr := TJvTFGlanceFrameAttr.Create(AOwner);
+
+ FColor := clBtnFace;
+ FHeight := 40;
+ FVisible := True;
+end;
+
+destructor TJvTFGlanceTitle.Destroy;
+begin
+ FFrameAttr.Free;
+ FTxtAttr.OnChange := nil;
+ FTxtAttr.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFGlanceTitle.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFGlanceTitle then
+ begin
+ FColor := TJvTFGlanceTitle(Source).Color;
+ FHeight := TJvTFGlanceTitle(Source).Height;
+ FVisible := TJvTFGlanceTitle(Source).Visible;
+ FFrameAttr.Assign(TJvTFGlanceTitle(Source).FrameAttr);
+ FTxtAttr.Assign(TJvTFGlanceTitle(Source).TxtAttr);
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceTitle.Change;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TJvTFGlanceTitle.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTitle.SetFrameAttr(Value: TJvTFGlanceFrameAttr);
+begin
+ FFrameAttr.Assign(Value);
+end;
+
+procedure TJvTFGlanceTitle.SetHeight(Value: Integer);
+begin
+ Value := Greater(Value, 0);
+ if Assigned(GlanceControl) then
+ Value := Lesser(Value, GlanceControl.Height - 5);
+
+ if Value <> FHeight then
+ begin
+ FHeight := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTitle.SetTxtAttr(Value: TJvTFTextAttr);
+begin
+ FTxtAttr.Assign(Value);
+ Change;
+end;
+
+procedure TJvTFGlanceTitle.SetVisible(Value: Boolean);
+begin
+ if Value <> FVisible then
+ begin
+ FVisible := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTitle.TxtAttrChange(Sender: TObject);
+begin
+ Change;
+end;
+
+//=== { TJvTFFrameAttr } =====================================================
+
+constructor TJvTFFrameAttr.Create(AOwner: TJvTFControl);
+begin
+ inherited Create;
+ FControl := AOwner;
+
+ FStyle := fsFlat;
+ FColor := clBlack;
+ FWidth := 1;
+end;
+
+procedure TJvTFFrameAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFFrameAttr then
+ begin
+ FStyle := TJvTFFrameAttr(Source).Style;
+ FColor := TJvTFFrameAttr(Source).Color;
+ FWidth := TJvTFFrameAttr(Source).Width;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFFrameAttr.Change;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+
+ if Assigned(Control) then
+ Control.Invalidate;
+end;
+
+procedure TJvTFFrameAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFFrameAttr.SetStyle(Value: TJvTFFrameStyle);
+begin
+ if Value <> FStyle then
+ begin
+ FStyle := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFFrameAttr.SetWidth(Value: Integer);
+begin
+ Value := Greater(Value, 1);
+
+ if Value <> FWidth then
+ begin
+ FWidth := Value;
+ Change;
+ end;
+end;
+
+//=== { TJvTFGlanceCellAttr } ================================================
+
+constructor TJvTFGlanceCellAttr.Create(AOwner: TJvTFCustomGlance);
+begin
+ inherited Create;
+ FGlanceControl := AOwner;
+
+ FColor := clWhite;
+ FFrameAttr := TJvTFGlanceFrameAttr.Create(AOwner);
+ FTitleAttr := TJvTFGlanceTitleAttr.Create(AOwner);
+
+ FFont := TFont.Create;
+ FFont.OnChange := @FontChange;
+end;
+
+destructor TJvTFGlanceCellAttr.Destroy;
+begin
+ FFrameAttr.Free;
+ FTitleAttr.Free;
+ FFont.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFGlanceCellAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFGlanceCellAttr then
+ begin
+ FColor := TJvTFGlanceCellAttr(Source).Color;
+ FFrameAttr.Assign(TJvTFGlanceCellAttr(Source).FrameAttr);
+ FTitleAttr.Assign(TJvTFGlanceCellAttr(Source).TitleAttr);
+ FFont.Assign(TJvTFGlanceCellAttr(Source).Font);
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceCellAttr.Change;
+begin
+ if Assigned(GlanceControl) then
+ GlanceControl.Invalidate;
+end;
+
+procedure TJvTFGlanceCellAttr.FontChange(Sender: TObject);
+begin
+ Change;
+end;
+
+procedure TJvTFGlanceCellAttr.SetDrawBottomLine(Value: Boolean);
+begin
+ if Value <> FDrawBottomLine then
+ begin
+ FDrawBottomLine := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceCellAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceCellAttr.SetFont(Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+procedure TJvTFGlanceCellAttr.SetFrameAttr(Value: TJvTFGlanceFrameAttr);
+begin
+ FFrameAttr.Assign(Value);
+end;
+
+procedure TJvTFGlanceCellAttr.SetTitleAttr(Value: TJvTFGlanceTitleAttr);
+begin
+ FTitleAttr.Assign(Value);
+end;
+
+//=== { TJvTFGlanceTitleAttr } ===============================================
+
+constructor TJvTFGlanceTitleAttr.Create(AOwner: TJvTFCustomGlance);
+begin
+ inherited Create;
+ FGlanceControl := AOwner;
+
+ FAlign := alTop;
+
+ FColor := clBtnFace;
+ FHeight := 20;
+ FVisible := True;
+ //FDayFormat := 'd';
+
+ FFrameAttr := TJvTFGlanceFrameAttr.Create(AOwner);
+
+ FDayTxtAttr := TJvTFTextAttr.Create;
+ FDayTxtAttr.OnChange := @TxtAttrChange;
+
+ FPicAttr := TJvTFGlanceTitlePicAttr.Create;
+ FPicAttr.OnChange := @PicAttrChange;
+end;
+
+destructor TJvTFGlanceTitleAttr.Destroy;
+begin
+ FFrameAttr.Free;
+ FDayTxtAttr.OnChange := nil;
+ FDayTxtAttr.Free;
+ FPicAttr.OnChange := nil;
+ FPicAttr.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFGlanceTitleAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFGlanceTitleAttr then
+ begin
+ FAlign := TJvTFGlanceTitleAttr(Source).Align;
+ //FDayFormat := TJvTFGlanceTitleAttr(Source).DayFormat;
+ FColor := TJvTFGlanceTitleAttr(Source).Color;
+ FHeight := TJvTFGlanceTitleAttr(Source).Height;
+ FVisible := TJvTFGlanceTitleAttr(Source).Visible;
+ FFrameAttr.Assign(TJvTFGlanceTitleAttr(Source).FrameAttr);
+ FDayTxtAttr.Assign(TJvTFGlanceTitleAttr(Source).DayTxtAttr);
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceTitleAttr.Change;
+begin
+ if Assigned(GlanceControl) then
+ begin
+ if Assigned(GlanceControl.Viewer) then
+ GlanceControl.Viewer.Realign;
+ GlanceControl.Invalidate;
+ end;
+end;
+
+procedure TJvTFGlanceTitleAttr.PicAttrChange(Sender: TObject);
+begin
+ Change;
+end;
+
+procedure TJvTFGlanceTitleAttr.SetAlign(Value: TJvTFTitleAlign);
+begin
+ if Value <> FAlign then
+ begin
+ FAlign := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTitleAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+{
+procedure TJvTFGlanceTitleAttr.SetDayFormat(const Value: string);
+begin
+ if Value <> FDayFormat then
+ begin
+ FDayFormat := Value;
+ Change;
+ end;
+end;
+}
+
+procedure TJvTFGlanceTitleAttr.SetDayTxtAttr(Value: TJvTFTextAttr);
+begin
+ FDayTxtAttr.Assign(Value);
+ Change;
+end;
+
+procedure TJvTFGlanceTitleAttr.SetFrameAttr(Value: TJvTFGlanceFrameAttr);
+begin
+ FFrameAttr.Assign(Value);
+ Change;
+end;
+
+procedure TJvTFGlanceTitleAttr.SetHeight(Value: Integer);
+begin
+ if Value <> FHeight then
+ begin
+ FHeight := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTitleAttr.SetPicAttr(Value: TJvTFGlanceTitlePicAttr);
+begin
+ FPicAttr.Assign(Value);
+ Change;
+end;
+
+procedure TJvTFGlanceTitleAttr.SetVisible(Value: Boolean);
+begin
+ if Value <> FVisible then
+ begin
+ FVisible := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTitleAttr.TxtAttrChange(Sender: TObject);
+begin
+ Change;
+end;
+
+//=== { TJvTFGlanceSelList } =================================================
+
+constructor TJvTFGlanceSelList.Create(AOwner: TJvTFCustomGlance);
+begin
+ inherited Create;
+ FGlanceControl := AOwner;
+end;
+
+//=== { TJvTFGlanceViewer } ==================================================
+
+constructor TJvTFGlanceViewer.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FRepeatGrouped := True;
+ FShowSchedNamesInHint := True;
+ FInplaceEdit := True;
+end;
+
+function TJvTFGlanceViewer.ApptCount: Integer;
+var
+ I: Integer;
+ ApptList: TStringList;
+begin
+ if RepeatGrouped then
+ begin
+ Result := 0;
+ for I := 0 to ScheduleCount - 1 do
+ Inc(Result, Schedules[I].ApptCount);
+ end
+ else
+ begin
+ ApptList := TStringList.Create;
+ try
+ GetDistinctAppts(ApptList);
+ Result := ApptList.Count;
+ finally
+ ApptList.Free;
+ end;
+ end;
+end;
+
+procedure TJvTFGlanceViewer.EnsureCol(ACol: Integer);
+begin
+ GlanceControl.EnsureCol(ACol);
+end;
+
+procedure TJvTFGlanceViewer.EnsureRow(ARow: Integer);
+begin
+ GlanceControl.EnsureRow(ARow);
+end;
+
+function TJvTFGlanceViewer.GetRepeatAppt(Index: Integer): TJvTFAppt;
+var
+ I, AbsIndex: Integer;
+begin
+ if (Index < 0) or (Index > ApptCount - 1) then
+ raise EGlanceViewerError.CreateResFmt(@RsEApptIndexOutOfBoundsd, [Index]);
+
+ AbsIndex := 0;
+ I := -1;
+
+ repeat
+ Inc(I);
+ Inc(AbsIndex, Schedules[I].ApptCount);
+ until AbsIndex - 1 >= Index;
+
+ Result := Schedules[I].Appts[Schedules[I].ApptCount - (AbsIndex - Index)];
+end;
+
+function TJvTFGlanceViewer.GetDate: TDate;
+begin
+ Result := Cell.CellDate;
+end;
+
+function TJvTFGlanceViewer.GetDistinctAppt(Index: Integer): TJvTFAppt;
+var
+ ApptList: TStringList;
+begin
+ Result := nil;
+ ApptList := TStringList.Create;
+ try
+ GetDistinctAppts(ApptList);
+ if (Index < 0) or (Index >= ApptList.Count) then
+ raise EGlanceViewerError.CreateResFmt(@RsEApptIndexOutOfBoundsd, [Index]);
+
+ Result := TJvTFAppt(ApptList.Objects[Index]);
+ finally
+ ApptList.Free;
+ end;
+end;
+
+procedure TJvTFGlanceViewer.GetDistinctAppts(ApptList: TStringList);
+var
+ I,
+ J: Integer;
+ Sched: TJvTFSched;
+ Appt: TJvTFAppt;
+begin
+ ApptList.Clear;
+
+ for I := 0 to ScheduleCount - 1 do
+ begin
+ Sched := Schedules[I];
+ for J := 0 to Sched.ApptCount - 1 do
+ begin
+ Appt := Sched.Appts[J];
+ if ApptList.IndexOf(Appt.ID) = -1 then
+ ApptList.AddObject(Appt.ID, Appt);
+ end;
+ end;
+end;
+
+function TJvTFGlanceViewer.GetSchedule(Index: Integer): TJvTFSched;
+begin
+ Result := Cell.Schedules[Index];
+end;
+
+procedure TJvTFGlanceViewer.MouseAccel(X, Y: Integer);
+begin
+ // do nothing, leave implemenation to successors
+end;
+
+procedure TJvTFGlanceViewer.MoveTo(ACell: TJvTFGlanceCell);
+begin
+ SetTo(ACell);
+ FPhysicalCell := ACell;
+ Realign;
+end;
+
+procedure TJvTFGlanceViewer.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ case Code of
+ sncConnectControl:
+ SetGlanceControl(TJvTFCustomGlance(Sender));
+ sncDisconnectControl:
+ if GlanceControl = Sender then
+ SetGlanceControl(nil);
+ end;
+end;
+
+procedure TJvTFGlanceViewer.ParentReconfig;
+begin
+ // do nothing, leave implementation to successors
+end;
+
+function TJvTFGlanceViewer.ScheduleCount: Integer;
+begin
+ if Assigned(Cell) then
+ Result := Cell.ScheduleCount
+ else
+ Result := 0;
+end;
+
+procedure TJvTFGlanceViewer.SetGlanceControl(Value: TJvTFCustomGlance);
+begin
+ FGlanceControl := Value;
+ if Assigned(FGlanceControl) then
+ FGlanceControl.OnApptHint := @DoGlanceControlApptHint;
+end;
+
+procedure TJvTFGlanceViewer.SetInplaceEdit(const Value: Boolean);
+begin
+ FInPlaceEdit := Value;
+end;
+
+procedure TJvTFGlanceViewer.SetRepeatGrouped(Value: Boolean);
+begin
+ if Value <> FRepeatGrouped then
+ begin
+ FRepeatGrouped := Value;
+ Refresh;
+ end;
+end;
+
+procedure TJvTFGlanceViewer.SetShowSchedNamesInHint(
+ const Value: Boolean);
+begin
+ if FShowSchedNamesInHint <> Value then
+ begin
+ FShowSchedNamesInHint := Value;
+ Refresh;
+ end;
+end;
+
+procedure TJvTFGlanceViewer.SetTo(ACell: TJvTFGlanceCell);
+begin
+ FCell := ACell;
+end;
+
+function TJvTFGlanceViewer.GetAppt(Index: Integer): TJvTFAppt;
+begin
+ if RepeatGrouped then
+ Result := GetRepeatAppt(Index)
+ else
+ Result := GetDistinctAppt(Index);
+end;
+
+function TJvTFGlanceViewer.CalcBoundsRect(ACell: TJvTFGlanceCell): TRect;
+begin
+ if Assigned(GlanceControl) and Assigned(ACell) then
+ with GlanceControl do
+ Result := CalcCellBodyRect(ACell, CellIsSelected(ACell), False)
+ else
+ Result := Rect(0, 0, 0, 0);
+end;
+
+function TJvTFGlanceViewer.GetApptAt(X, Y: Integer): TJvTFAppt;
+begin
+ Result := nil;
+end;
+
+function TJvTFGlanceViewer.CanEdit: Boolean;
+begin
+ Result := False;
+end;
+
+function TJvTFGlanceViewer.Editing: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TJvTFGlanceViewer.FinishEditAppt;
+begin
+ // do nothing, leave implementation to successors
+end;
+
+//=== { TJvTFGlanceFrameAttr } ===============================================
+
+procedure TJvTFGlanceFrameAttr.Change;
+begin
+ inherited Change;
+ if Assigned(GlanceControl) and Assigned(GlanceControl.Viewer) then
+ GlanceControl.Viewer.Realign;
+end;
+
+constructor TJvTFGlanceFrameAttr.Create(AOwner: TJvTFCustomGlance);
+begin
+ inherited Create(AOwner);
+ FGlanceControl := AOwner;
+end;
+
+//=== { TJvTFTextAttr } ======================================================
+
+constructor TJvTFTextAttr.Create;
+begin
+ inherited Create;
+
+ FFont := TFont.Create;
+ FFont.OnChange := @FontChange;
+ FAlignH := taLeftJustify;
+ FAlignV := vaCenter;
+end;
+
+destructor TJvTFTextAttr.Destroy;
+begin
+ FFont.OnChange := nil;
+ FFont.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFTextAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFTextAttr then
+ begin
+ FFont.Assign(TJvTFTextAttr(Source).Font);
+ FRotation := TJvTFTextAttr(Source).Rotation;
+ FAlignH := TJvTFTextAttr(Source).AlignH;
+ FAlignV := TJvTFTextAttr(Source).AlignV;
+ DoChange;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFTextAttr.DoChange;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TJvTFTextAttr.FontChange(Sender: TObject);
+begin
+ DoChange;
+end;
+
+procedure TJvTFTextAttr.SetAlignH(Value: TAlignment);
+begin
+ if Value <> FAlignH then
+ begin
+ FAlignH := Value;
+ DoChange;
+ end;
+end;
+
+procedure TJvTFTextAttr.SetAlignV(Value: TJvTFVAlignment);
+begin
+ if Value <> FAlignV then
+ begin
+ FAlignV := Value;
+ DoChange;
+ end;
+end;
+
+procedure TJvTFTextAttr.SetFont(Value: TFont);
+begin
+ FFont.Assign(Value);
+ DoChange;
+end;
+
+procedure TJvTFTextAttr.SetRotation(Value: Integer);
+begin
+ if Value <> FRotation then
+ begin
+ FRotation := Value;
+ DoChange;
+ end;
+end;
+
+//=== { TJvTFCellPics } ======================================================
+
+constructor TJvTFCellPics.Create(AGlanceCell: TJvTFGlanceCell);
+begin
+ inherited Create(TJvTFCellPic);
+ FGlanceCell := AGlanceCell;
+end;
+
+function TJvTFCellPics.Add: TJvTFCellPic;
+begin
+ Result := TJvTFCellPic(inherited Add);
+end;
+
+function TJvTFCellPics.AddPic(const PicName: string; PicIndex: Integer): TJvTFCellPic;
+begin
+ Result := Add;
+ Result.PicName := PicName;
+ Result.PicIndex := PicIndex;
+end;
+
+procedure TJvTFCellPics.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TJvTFCellPics then
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ for I := 0 to TJvTFCellPics(Source).Count - 1 do
+ Add.Assign(TJvTFCellPics(Source).Items[I]);
+ finally
+ EndUpdate;
+ end
+ end
+ else
+ inherited Assign(Source);
+end;
+
+function TJvTFCellPics.GetItem(Index: Integer): TJvTFCellPic;
+begin
+ Result := TJvTFCellPic(inherited GetItem(Index));
+end;
+
+function TJvTFCellPics.GetOwner: TPersistent;
+begin
+ Result := GlanceCell;
+end;
+
+function TJvTFCellPics.GetPicIndex(const PicName: string): Integer;
+var
+ CellPic: TJvTFCellPic;
+begin
+ Result := -1;
+ CellPic := PicByName(PicName);
+ if Assigned(CellPic) then
+ Result := CellPic.PicIndex;
+end;
+
+function TJvTFCellPics.PicByName(const PicName: string): TJvTFCellPic;
+var
+ I: Integer;
+begin
+ Result := nil;
+ I := 0;
+ while (I < Count) and not Assigned(Result) do
+ begin
+ if Items[I].PicName = PicName then
+ Result := Items[I];
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFCellPics.SetItem(Index: Integer; Value: TJvTFCellPic);
+begin
+ inherited SetItem(Index, Value);
+end;
+
+//=== { TJvTFCellPic } =======================================================
+
+constructor TJvTFCellPic.Create(ACollection: TCollection);
+begin
+ inherited Create(ACollection);
+ FPicIndex := -1;
+ FHints := TStringList.Create;
+end;
+
+destructor TJvTFCellPic.Destroy;
+begin
+ FHints.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFCellPic.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFCellPic then
+ begin
+ FPicName := TJvTFCellPic(Source).PicName;
+ FPicIndex := TJvTFCellPic(Source).PicIndex;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFCellPic.Change;
+begin
+ if Assigned(PicCollection.GlanceCell.CellCollection.GlanceControl) then
+ PicCollection.GlanceCell.CellCollection.GlanceControl.Invalidate;
+end;
+
+function TJvTFCellPic.GetDisplayName: string;
+begin
+ if PicName <> '' then
+ Result := PicName
+ else
+ Result := inherited GetDisplayName;
+end;
+
+function TJvTFCellPic.PicCollection: TJvTFCellPics;
+begin
+ Result := TJvTFCellPics(Collection);
+end;
+
+function TJvTFCellPic.GetHints: TStrings;
+begin
+ Result := FHints;
+end;
+
+procedure TJvTFCellPic.SetHints(Value: TStrings);
+begin
+ FHints.Assign(Value);
+end;
+
+procedure TJvTFCellPic.SetPicIndex(Value: Integer);
+begin
+ if Value <> FPicIndex then
+ begin
+ FPicIndex := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFCellPic.SetPicName(const Value: string);
+begin
+ if Value <> FPicName then
+ begin
+ FPicName := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFCellPic.SetPicPoint(X, Y: Integer);
+begin
+ FPicPoint := Point(X, Y);
+end;
+
+//=== { TJvTFGlanceTitlePicAttr } ============================================
+
+constructor TJvTFGlanceTitlePicAttr.Create;
+begin
+ inherited Create;
+ FAlignH := taLeftJustify;
+ FAlignV := vaCenter;
+end;
+
+procedure TJvTFGlanceTitlePicAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFGlanceTitlePicAttr then
+ begin
+ FAlignH := TJvTFGlanceTitlePicAttr(Source).AlignH;
+ FAlignV := TJvTFGlanceTitlePicAttr(Source).AlignV;
+ DoChange;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceTitlePicAttr.DoChange;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TJvTFGlanceTitlePicAttr.SetAlignH(Value: TAlignment);
+begin
+ if Value <> FAlignH then
+ begin
+ FAlignH := Value;
+ DoChange;
+ end;
+end;
+
+procedure TJvTFGlanceTitlePicAttr.SetAlignV(Value: TJvTFVAlignment);
+begin
+ if Value <> FAlignV then
+ begin
+ FAlignV := Value;
+ DoChange;
+ end;
+end;
+
+//=== { TJvTFGlance } ========================================================
+
+constructor TJvTFGlance.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ AllowCustomDates := True;
+end;
+
+//=== { TJvTFGlanceMainTitle } ===============================================
+
+constructor TJvTFGlanceMainTitle.Create(AOwner: TJvTFCustomGlance);
+begin
+ inherited Create(AOwner);
+ FTitle := RsGlanceMainTitle;
+end;
+
+procedure TJvTFGlanceMainTitle.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFGlanceMainTitle then
+ FTitle := TJvTFGlanceMainTitle(Source).Title;
+
+ inherited Assign(Source);
+end;
+
+procedure TJvTFGlanceMainTitle.SetTitle(const Value: string);
+begin
+ if Value <> FTitle then
+ begin
+ FTitle := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceCell.SetSplitOrientation(Value: TJvTFSplitOrientation);
+begin
+ if Value <> FSplitOrientation then
+ begin
+ FSplitOrientation := Value;
+ if IsSubCell then
+ ParentCell.SplitOrientation := Value
+ else
+ if IsSplit then
+ begin
+ SubCell.SplitOrientation := Value;
+ Change;
+ end;
+ end;
+end;
+
+procedure TJvTFGlanceCell.SetTitleText(const Value: string);
+begin
+ FTitleText := Value;
+end;
+
+procedure TJvTFGlanceCell.Split;
+begin
+ if Assigned(CellCollection.GlanceControl) and
+ not CellCollection.GlanceControl.AllowCustomDates and
+ not CellCollection.Configuring then
+ raise EJvTFGlanceError.CreateRes(@RsECellCannotBeSplit);
+
+ if IsSubCell then
+ raise EJvTFGlanceError.CreateRes(@RsEASubcellCannotBeSplit);
+
+ if not IsSplit then
+ begin
+ FSplitRef := TJvTFGlanceCell.Create(nil);
+ //FSplitRef := TJvTFGlanceCell.Create(CellCollection);
+ FSplitRef.FCellCollection := CellCollection;
+ FSplitRef.SetColIndex(ColIndex);
+ FSplitRef.SetRowIndex(RowIndex);
+ FSplitRef.FSplitOrientation := SplitOrientation;
+ FSplitRef.FSplitRef := Self;
+ FSplitRef.FIsSubCell := True;
+ if not CellCollection.Configuring then
+ CellCollection.ReconfigCells;
+ end;
+end;
+
+procedure TJvTFGlanceViewer.SetShowStartEndTimeInHint(const Value: Boolean);
+begin
+ if FShowStartEndTimeInHint <> Value then
+ begin
+ FShowStartEndTimeInHint := Value;
+ Refresh;
+ end;
+end;
+
+procedure TJvTFGlanceViewer.DoGlanceControlApptHint(Sender: TObject;
+ Appt: TJvTFAppt; var Handled: Boolean);
+begin
+ if Assigned(FOnApptHint) then
+ FOnApptHint(Sender, Appt, Handled);
+end;
+
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas b/components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas
new file mode 100644
index 000000000..2c79a695d
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfglancetextviewer.pas
@@ -0,0 +1,1585 @@
+{-----------------------------------------------------------------------------
+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: JvTFGlanceTextViewer.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFGlanceTextViewer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages,
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
+ JvComponent,
+ JvTFManager, JvTFGlance, JvTFUtils;
+
+type
+ TJvTFGlanceTextViewer = class;
+
+ TJvTFGlTxtVwDrawInfo = record
+ Cell: TJvTFGlanceCell;
+ Font: TFont;
+ Color: TColor;
+ aRect: TRect;
+ end;
+
+ TJvTFGlTxtVwPointInfo = record
+ AbsX: Integer;
+ AbsY: Integer;
+ AbsLineNum: Integer;
+ RelLineNum: Integer;
+ end;
+
+ TJvDrawApptEvent = procedure(Sender: TObject; ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo;
+ Appt: TJvTFAppt; Rect:TRect; var Handled: Boolean) of object;
+ TJvApptHintEvent = procedure(Sender: TObject; Appt: TJvTFAppt; var Handled: Boolean) of object;
+
+ TJvTFGVTxtEditor = class(TMemo)
+ private
+ FLinkedAppt: TJvTFAppt;
+ protected
+ FCancelEdit: Boolean;
+ procedure DoExit; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property LinkedAppt: TJvTFAppt read FLinkedAppt write FLinkedAppt;
+ end;
+
+ TJvTFGVTextControl = class(TJvCustomControl)
+ private
+ FViewer: TJvTFGlanceTextViewer;
+ FReplicating: Boolean;
+ FMouseLine: Integer;
+ FCanEdit: Boolean;
+ FShowDDButton: Boolean;
+
+ function GetGlanceControl: TJvTFCustomGlance;
+ procedure SetTopLine(Value: Integer);
+ function GetTopLine: Integer;
+ procedure SetCanEdit(const Value: Boolean);
+ procedure SetShowDDButton(const Value: Boolean);
+ protected
+ FMousePtInfo: TJvTFGlTxtVwPointInfo;
+ FDDBtnRect: TRect;
+ FMouseInControl: Boolean;
+ FScrollUpBtnBMP: TBitmap;
+ FScrollDnBtnBMP: TBitmap;
+ FEditor: TJvTFGVTxtEditor;
+
+ // See in MouseDown for details on usage of these three members
+ FWasMovedTicks: Cardinal;
+ FWasInDblClick: Boolean;
+ FHasScrolled: Boolean;
+
+ procedure MouseEnter(Control: TControl); override;
+ procedure MouseLeave(Control: TControl); override;
+
+ procedure WMEraseBkgnd(var Msg: TLMessage); message LM_ERASEBKGND;
+ procedure DoEnter; override;
+ procedure DoExit; override;
+
+ procedure SetMouseLine(Value: Integer);
+ property MouseLine: Integer read FMouseLine write SetMouseLine;
+ procedure UpdateDDBtnRect;
+
+ procedure DblClick; override;
+ procedure DoViewerDblClick;
+ procedure DoViewerClick;
+ procedure DoViewerEnter;
+
+ 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 MouseAccel(X, Y: Integer);
+ procedure Click; override;
+
+ procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
+ var Accept: Boolean); override;
+
+ property Replicating: Boolean read FReplicating;
+ procedure Paint; override;
+ procedure DrawDDButton(ACanvas: TCanvas);
+ procedure DrawArrow(ACanvas: TCanvas; aRect: TRect; Direction: TJvTFDirection);
+ procedure DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
+ procedure DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
+ function GetStartEndString(Appt: TJvTFAppt): string;
+
+ function CalcLineHeight: Integer;
+ function CalcAbsLineNum(Y: Integer): Integer;
+ function LineRect(AbsLineNum: Integer): TRect;
+ function CalcPointInfo(X, Y: Integer): TJvTFGlTxtVwPointInfo;
+ function RelToAbs(Rel: Integer): Integer;
+ function AbsToRel(Abs: Integer): Integer;
+ function FindApptAtLine(RelLineNum: Integer): TJvTFAppt;
+ function GetApptRelLineNum(Appt: TJvTFAppt): Integer;
+
+ procedure Scroll(ADelta: Integer);
+ function ScrollUpBtnRect(aCellRect: TRect): TRect;
+ function ScrollDnBtnRect(aCellRect: TRect): TRect;
+ procedure InitScrollUpBtnBMP;
+ procedure InitScrollDnBtnBMP;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ procedure PaintTo(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo); overload;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
+
+ property Viewer: TJvTFGlanceTextViewer read FViewer;
+ property GlanceControl: TJvTFCustomGlance read GetGlanceControl;
+
+ // editor management routines
+ //procedure EditAppt(Col, Row: Integer; Appt: TJvTFAppt);
+ procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
+ procedure FinishEditAppt;
+ function Editing: Boolean;
+
+ function LineCount: Integer;
+ function AbsLineCount: Integer;
+ function ViewableLines: Integer;
+ function FullViewableLines: Integer;
+ property TopLine: Integer read GetTopLine write SetTopLine;
+
+ function GetApptAt(X, Y: Integer): TJvTFAppt;
+ function GetApptAccel(X, Y: Integer): TJvTFAppt;
+
+ property CanEdit: Boolean read FCanEdit write SetCanEdit;
+ property ShowDDButton: Boolean read FShowDDButton write SetShowDDButton default True;
+ end;
+
+ TJvTFLineDDClickEvent = procedure(Sender: TObject; LineNum: Integer) of object;
+
+ TJvTFTxtVwApptAttr = class(TPersistent)
+ private
+ FColor: TColor;
+ FFontColor: TColor;
+ FOnChange: TNotifyEvent;
+ procedure SetColor(Value: TColor);
+ procedure SetFontColor(Value: TColor);
+ protected
+ procedure Change;
+ public
+ constructor Create(AOwner: TComponent);
+ procedure Assign(Source: TPersistent); override;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ published
+ property Color: TColor read FColor write SetColor default clBlue;
+ property FontColor: TColor read FFontColor write SetFontColor default clWhite;
+ end;
+
+ TJvTFGlTxtVwEditorAlign = (eaLine, eaCell);
+
+ TJvTFGlanceTextViewer = class(TJvTFGlanceViewer)
+ private
+ FViewControl: TJvTFGVTextControl;
+ FLineSpacing: Integer;
+ FEditorAlign: TJvTFGlTxtVwEditorAlign;
+ FOnLineDDClick: TJvTFLineDDClickEvent;
+ FShowStartEnd: Boolean;
+ FTopLines: TStringList;
+ FSelApptAttr: TJvTFTxtVwApptAttr;
+ FSelAppt: TJvTFAppt;
+ FOnDblClick: TNotifyEvent;
+ FOnClick: TNotifyEvent;
+ FOnEnter: TNotifyEvent;
+ FOnDrawAppt: TJvDrawApptEvent;
+
+ procedure SetLineSpacing(Value: Integer);
+ procedure SetSelApptAttr(Value: TJvTFTxtVwApptAttr);
+ procedure SetEditorAlign(Value: TJvTFGlTxtVwEditorAlign);
+ procedure SetShowStartEnd(Value: Boolean);
+ function GetCellString(ACell: TJvTFGlanceCell): string;
+ procedure SetShowLineDDButton(const Value: Boolean);
+ function GetShowLineDDButton: Boolean;
+ protected
+ procedure SetVisible(Value: Boolean); override;
+ procedure SetGlanceControl(Value: TJvTFCustomGlance); override;
+ procedure SelApptAttrChange(Sender: TObject);
+ procedure Change; virtual;
+ procedure LineDDClick(LineNum: Integer); virtual;
+
+ procedure DoDblClick(); virtual;
+ procedure DoClick; virtual;
+ procedure DoEnter; virtual;
+ procedure DoDrawAppt(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo;
+ Appt: TJvTFAppt; Rect: TRect; var Handled: Boolean);
+
+ procedure ParentReconfig; override;
+ procedure SetSelAppt(Value: TJvTFAppt);
+ procedure SetInplaceEdit(const Value: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); override;
+ procedure MouseAccel(X, Y: Integer); override;
+
+ procedure Refresh; override;
+ procedure Realign; override;
+ procedure PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell); override;
+ function GetDrawInfo(ACell: TJvTFGlanceCell): TJvTFGlTxtVwDrawInfo;
+ procedure ResetTopLines;
+ property SelAppt: TJvTFAppt read FSelAppt;
+
+ procedure SetTopLine(ACell: TJvTFGlanceCell; Value: Integer);
+ function GetTopLine(ACell: TJvTFGlanceCell): Integer;
+ function GetApptAt(X, Y: Integer): TJvTFAppt; override;
+
+ // editor management routines
+ procedure EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
+ procedure FinishEditAppt; override;
+ function Editing: Boolean; override;
+ function CanEdit: Boolean; override;
+ published
+ property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 0;
+ property OnLineDDClick: TJvTFLineDDClickEvent read FOnLineDDClick write FOnLineDDClick;
+ property SelApptAttr: TJvTFTxtVwApptAttr read FSelApptAttr write SetSelApptAttr;
+ property EditorAlign: TJvTFGlTxtVwEditorAlign read FEditorAlign write SetEditorAlign default eaLine;
+ property ShowStartEnd: Boolean read FShowStartEnd write SetShowStartEnd default True;
+ property ShowLineDDButton: Boolean read GetShowLineDDButton write SetShowLineDDButton default True;
+ property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
+ property OnClick: TNotifyEvent read FOnClick write FOnClick;
+ property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
+ property OnDrawAppt: TJvDrawApptEvent read FOnDrawAppt write FOnDrawAppt;
+ property OnApptHint;
+ end;
+
+
+implementation
+
+uses
+ JvResources;
+
+//=== { TJvTFGVTextControl } =================================================
+
+constructor TJvTFGVTextControl.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ if AOwner is TJvTFGlanceTextViewer then
+ FViewer := TJvTFGlanceTextViewer(AOwner);
+
+ DoubleBuffered := True;
+ FShowDDButton := True;
+
+ FReplicating := True;
+ FMouseLine := -1;
+
+ FScrollUpBtnBMP := TBitmap.Create;
+ InitScrollUpBtnBMP;
+ FScrollDnBtnBMP := TBitmap.Create;
+ InitScrollDnBtnBMP;
+
+ FEditor := TJvTFGVTxtEditor.Create(Self);
+ FEditor.Visible := False;
+ FEditor.Parent := Self;
+
+ FWasMovedTicks := 0;
+ FWasInDblClick := False;
+
+ //FEditor.Parent := Viewer.GlanceControl;
+ // (rom) deactivated seems of no use
+ // if FEditor.Parent = nil then
+ // Beep;
+end;
+
+function TJvTFGVTextControl.CalcAbsLineNum(Y: Integer): Integer;
+begin
+ Result := Y div CalcLineHeight;
+end;
+
+procedure TJvTFGVTextControl.DrawDDButton(ACanvas: TCanvas);
+begin
+ with ACanvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(FDDBtnRect);
+
+ DrawArrow(ACanvas, FDDBtnRect, dirDown);
+
+ Pen.Color := clBlack;
+ Polyline([FDDBtnRect.TopLeft, Point(FDDBtnRect.Right, FDDBtnRect.Top),
+ FDDBtnRect.BottomRight, Point(FDDBtnRect.Left, FDDBtnRect.Bottom),
+ FDDBtnRect.TopLeft]);
+ {
+ if Windows.PtInRect(aRect, FMouseLoc) then
+ begin
+ Pen.Color := clBtnHighlight;
+ MoveTo(aRect.Left, aRect.Top);
+ LineTo(aRect.Left, aRect.Bottom);
+ MoveTo(aRect.Left, aRect.Top);
+ LineTo(aRect.Right, aRect.Top);
+
+ Pen.Color := clBtnShadow;
+ MoveTo(aRect.Right - 1, aRect.Top);
+ LineTo(aRect.Right - 1, aRect.Bottom);
+ MoveTo(aRect.Right, aRect.Bottom - 1);
+ LineTo(aRect.Left, aRect.Bottom - 1);
+ end;
+ }
+ end;
+end;
+
+function TJvTFGVTextControl.GetGlanceControl: TJvTFCustomGlance;
+begin
+ Result := nil;
+ if Assigned(Viewer) then
+ Result := Viewer.GlanceControl;
+end;
+
+function TJvTFGVTextControl.CalcLineHeight: Integer;
+begin
+ Result := Canvas.TextHeight('Wq') + Viewer.LineSpacing;
+end;
+
+function TJvTFGVTextControl.LineRect(AbsLineNum: Integer): TRect;
+var
+ LineHt: Integer;
+begin
+ LineHt := CalcLineHeight;
+ Result := ClientRect;
+ Result.Top := LineHt * AbsLineNum;
+ Result.Bottom := Lesser(Result.Top + LineHt, Result.Bottom);
+end;
+
+procedure TJvTFGVTextControl.Paint;
+var
+ DrawInfo: TJvTFGlTxtVwDrawInfo;
+begin
+ {
+ All drawing should be done in a PaintTo method. PaintTo should have ACanvas
+ and aRect Params. All drawing code within PaintTo should rely solely on
+ the ACanvas and aRect parameters given.
+
+ This method (Paint) should then call PaintTo(Canvas, ClientRect) to draw the
+ info on the viewer control. TJvTFCustomGlance.DrawCell should call
+ PaintTo(PaintBuffer, CellBodyRect(Col, Row, Selected, False)) to draw the
+ info on the GlanceControl.
+ }
+
+ Viewer.SetTo(Viewer.PhysicalCell);
+ DrawInfo := Viewer.GetDrawInfo(Viewer.Cell);
+ DrawInfo.aRect := ClientRect;
+
+ FReplicating := False;
+ try
+ PaintTo(Canvas, DrawInfo);
+ finally
+ FReplicating := True;
+ end;
+
+{
+ // for TESTING PURPOSES ONLY!!
+ with Canvas do
+ begin
+ Pen.Color := clBlack;
+ MoveTo(0, 0);
+ LineTo(ClientWidth, ClientHeight);
+ end;
+}
+end;
+
+procedure TJvTFGVTextControl.PaintTo(ACanvas: TCanvas; DrawInfo: TJvTFGlTxtVwDrawInfo);
+var
+ I, NextLineTop, LastLine, lLine: Integer;
+ aRect, lLineRect, TxtRect, BtnRect: TRect;
+ Flags: UINT;
+ Txt: string;
+ Appt: TJvTFAppt;
+ RegFontColor,
+ RegBrushColor: TColor;
+ DrawingHandled: Boolean;
+begin
+ Viewer.SetTo(DrawInfo.Cell);
+
+ with ACanvas do
+ begin
+ aRect := DrawInfo.aRect;
+
+ //Brush.Color := Viewer.Color;
+ Brush.Color := DrawInfo.Color;
+ FillRect(aRect);
+
+ //Font.Assign(Viewer.Font);
+ Font.Assign(DrawInfo.Font);
+ Self.Canvas.Font.Assign(DrawInfo.Font);
+
+ RegBrushColor := Brush.Color;
+ RegFontColor := Font.Color;
+
+ NextLineTop := aRect.Top;
+ lLineRect.Left := aRect.Left;
+ lLineRect.Right := aRect.Right;
+
+ //Flags := DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER;
+ Flags := DT_LEFT or DT_NOPREFIX or DT_SINGLELINE or DT_TOP;
+
+ if csDesigning in ComponentState then
+ LastLine := 2
+ else
+ LastLine := Lesser(ViewableLines - 1, LineCount - TopLine - 1);
+
+ for I := 0 to LastLine do
+ begin
+ Brush.Color := RegBrushColor;
+ Font.Color := RegFontColor;
+
+ lLineRect.Top := NextLineTop;
+ lLineRect.Bottom := Lesser(NextLineTop + CalcLineHeight, aRect.Bottom);
+
+ if csDesigning in ComponentState then
+ begin
+ Txt := 'Appt ' + IntToStr(I);
+ Appt := nil;
+ end
+ else
+ begin
+ lLine := AbsToRel(I);
+ if lLine < 0 then
+ lLine := 0;
+ if lLine >= Viewer.ApptCount then
+ lLine := 0;
+ Appt := Viewer.Appts[lLine];
+
+ Txt := '';
+ if Viewer.ShowStartEnd then
+ Txt := GetStartEndString(Appt) + ': ';
+ Txt := Txt + StringReplace(Appt.Description, #13#10, ' ', [rfReplaceAll]);
+
+ if Appt = Viewer.SelAppt then
+ begin
+ Brush.Color := Viewer.SelApptAttr.Color;
+ Font.Color := Viewer.SelApptAttr.FontColor;
+
+ FillRect(lLineRect);
+
+ if I <> 0 then
+ begin
+ MoveTo(aRect.Left, lLineRect.Top);
+ LineTo(aRect.Right, lLineRect.Top);
+ end;
+ if I <> AbsLineCount - 1 then
+ begin
+ MoveTo(aRect.Left, lLineRect.Bottom - 1);
+ LineTo(aRect.Right, lLineRect.Bottom - 1);
+ end;
+ end
+ else
+ begin
+ if Appt.Color <> clDefault then
+ begin
+ Brush.Color := Appt.Color;
+ FillRect(lLineRect);
+ end;
+ end;
+ end;
+
+ TxtRect := lLineRect;
+ InflateRect(TxtRect, -1, -1);
+
+ DrawingHandled := False;
+ if Assigned(Viewer) then
+ Viewer.DoDrawAppt(ACanvas, DrawInfo, Appt, lLineRect, DrawingHandled);
+
+ if not DrawingHandled then
+ begin
+ // PTxt := StrAlloc((Length(Txt) + 4) * SizeOf(Char));
+ // StrPCopy(PTxt, Txt);
+ // Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+ // StrDispose(PTxt);
+ DrawText(ACanvas.Handle, PChar(Txt), Length(Txt), TxtRect, Flags);
+ end;
+
+ Inc(NextLineTop, CalcLineHeight);
+ end;
+ end;
+
+ if not (csDesigning in ComponentState) then
+ begin
+ if not Replicating and (FMousePtInfo.RelLineNum < Viewer.ApptCount) and
+ FMouseInControl and FShowDDButton then
+ DrawDDButton(ACanvas);
+
+ BtnRect := ScrollUpBtnRect(DrawInfo.aRect);
+ if not IsRectEmpty(BtnRect) then
+ DrawScrollUpBtn(ACanvas, DrawInfo.aRect);
+
+ BtnRect := ScrollDnBtnRect(DrawInfo.aRect);
+ if not IsRectEmpty(BtnRect) then
+ DrawScrollDnBtn(ACanvas, DrawInfo.aRect);
+
+ {
+ if TopLine > 0 then
+ DrawScrollUpBtn(ACanvas, DrawInfo.aRect);
+
+ BottomLine := TopLine + FullViewableLines - 1;
+ LastLine := LineCount - 1;
+ if BottomLine < LastLine then
+ DrawScrollDnBtn(ACanvas, DrawInfo.aRect);
+ }
+ end;
+end;
+
+procedure TJvTFGVTextControl.WMEraseBkgnd(var Msg: TLMessage);
+begin
+ Msg.Result := LRESULT(False);
+end;
+
+procedure TJvTFGVTextControl.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+ GlancePt: TPoint;
+begin
+ inherited MouseMove(Shift, X, Y);
+ FMousePtInfo := CalcPointInfo(X, Y);
+ MouseLine := FMousePtInfo.AbsLineNum;
+ //SetFocus;
+
+ GlancePt := Point(X, Y);
+ GlancePt := Viewer.GlanceControl.ScreenToClient(ClientToScreen(Point(X, Y)));
+ Viewer.GlanceControl.CheckViewerApptHint(GlancePt.X, GlancePt.Y);
+
+ // for TESTING ONLY!!!
+ //Invalidate;
+ ////////////////////
+end;
+
+procedure TJvTFGVTextControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+begin
+ // If the control is being moved, we keep track of when this happened.
+ // See in MouseUp for details of usage of this value.
+ if (Left <> ALeft) or (Top <> ATop) then
+ FWasMovedTicks := GetTickCount
+ else
+ FWasMovedTicks := 0;
+
+ inherited SetBounds(ALeft, ATop, AWidth, AHeight);
+end;
+
+procedure TJvTFGVTextControl.SetMouseLine(Value: Integer);
+begin
+ if Value <> FMouseLine then
+ begin
+ FMouseLine := Value;
+ UpdateDDBtnRect;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFGVTextControl.DrawArrow(ACanvas: TCanvas; aRect: TRect;
+ Direction: TJvTFDirection);
+var
+ I, ArrowHeight, ArrowWidth, BaseX, BaseY: Integer;
+begin
+ ArrowWidth := RectWidth(aRect) - 2;
+ if not Odd(ArrowWidth) then
+ Dec(ArrowWidth);
+ ArrowHeight := (ArrowWidth + 1) div 2;
+
+ case Direction of
+ dirUp:
+ begin
+ BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowWidth div 2;
+ BaseY := aRect.Top + RectHeight(aRect) div 2 + ArrowHeight div 2 - 1;
+
+ for I := ArrowHeight downto 1 do
+ with ACanvas do
+ begin
+ MoveTo(BaseX, BaseY);
+ LineTo(BaseX + I * 2 - 1, BaseY);
+ Inc(BaseX);
+ Dec(BaseY);
+ end;
+ end;
+ dirDown:
+ begin
+ BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowWidth div 2;
+ BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowHeight div 2 + 1;
+
+ for I := ArrowHeight downto 1 do
+ with ACanvas do
+ begin
+ MoveTo(BaseX, BaseY);
+ LineTo(BaseX + I * 2 - 1, BaseY);
+ Inc(BaseX);
+ Inc(BaseY);
+ end;
+ end;
+ dirLeft:
+ begin
+ BaseX := aRect.Left + RectWidth(aRect) div 2 + ArrowHeight div 2;
+ BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowWidth div 2;
+
+ for I := ArrowHeight downto 1 do
+ with ACanvas do
+ begin
+ MoveTo(BaseX, BaseY);
+ LineTo(BaseX, BaseY + I * 2 - 1);
+ Dec(BaseX);
+ Inc(BaseY);
+ end;
+ end;
+ else
+ BaseX := aRect.Left + RectWidth(aRect) div 2 - ArrowHeight div 2;
+ BaseY := aRect.Top + RectHeight(aRect) div 2 - ArrowWidth div 2;
+
+ for I := ArrowHeight downto 1 do
+ with ACanvas do
+ begin
+ MoveTo(BaseX, BaseY);
+ LineTo(BaseX, BaseY + I * 2 - 1);
+ Inc(BaseX);
+ Inc(BaseY);
+ end;
+ end;
+end;
+
+procedure TJvTFGVTextControl.UpdateDDBtnRect;
+begin
+ FDDBtnRect := LineRect(FMousePtInfo.AbsLineNum);
+ FDDBtnRect.Right := ClientRect.Right - 1;
+ FDDBtnRect.Left := FDDBtnRect.Right - 10;
+ Inc(FDDBtnRect.Top, 2);
+ Dec(FDDBtnRect.Bottom, 1);
+end;
+
+procedure TJvTFGVTextControl.DoEnter;
+begin
+ inherited DoEnter;
+ Viewer.SetSelAppt(FindApptAtLine(FMousePtInfo.RelLineNum));
+ DoViewerEnter;
+end;
+
+procedure TJvTFGVTextControl.DoExit;
+begin
+ inherited DoExit;
+ FMouseLine := -1;
+end;
+
+{
+function TJvTFGVTextControl.LineCount: Integer;
+var
+ ACell: TJvTFGlanceCell;
+ I: Integer;
+begin
+ Result := 0;
+ ACell := Viewer.GlanceControl.Cells.Cells[Viewer.Col, Viewer.Row];
+
+ for I := 0 to ACell.ScheduleCount - 1 do
+ Inc(Result, ACell.Schedules[I].ApptCount);
+end;
+}
+
+function TJvTFGVTextControl.LineCount: Integer;
+begin
+ Result := Viewer.ApptCount;
+end;
+
+procedure TJvTFGVTextControl.SetTopLine(Value: Integer);
+begin
+ Viewer.SetTopLine(Viewer.Cell, Value);
+end;
+
+function TJvTFGVTextControl.CalcPointInfo(X, Y: Integer): TJvTFGlTxtVwPointInfo;
+begin
+ with Result do
+ begin
+ AbsX := X;
+ AbsY := Y;
+ AbsLineNum := CalcAbsLineNum(Y);
+ RelLineNum := TopLine + AbsLineNum;
+ end;
+end;
+
+function TJvTFGVTextControl.ViewableLines: Integer;
+var
+ aRect: TRect;
+begin
+ aRect := GlanceControl.CalcCellBodyRect(Viewer.Cell,
+ GlanceControl.CellIsSelected(Viewer.Cell), False);
+
+ Result := RectHeight(aRect) div CalcLineHeight;
+ if RectHeight(aRect) mod CalcLineHeight > 0 then
+ Inc(Result);
+end;
+
+function TJvTFGVTextControl.AbsToRel(Abs: Integer): Integer;
+begin
+ Result := TopLine + Abs;
+end;
+
+function TJvTFGVTextControl.RelToAbs(Rel: Integer): Integer;
+begin
+ Result := Rel - TopLine;
+end;
+
+procedure TJvTFGVTextControl.DoViewerDblClick;
+begin
+ if FHasScrolled then
+ Exit;
+
+ Viewer.DoDblClick;
+ FWasInDblClick := True;
+end;
+
+procedure TJvTFGVTextControl.DoViewerClick;
+begin
+ Viewer.DoClick;
+end;
+
+procedure TJvTFGVTextControl.DoViewerEnter;
+begin
+ Viewer.DoEnter;
+end;
+
+procedure TJvTFGVTextControl.DblClick;
+begin
+ if FHasScrolled then
+ Exit;
+
+ inherited DblClick;
+ DoViewerDblClick;
+end;
+
+procedure TJvTFGVTextControl.MouseDown(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+var
+ Appt: TJvTFAppt;
+ ticks: Cardinal;
+begin
+ inherited MouseDown(Button, Shift, X, Y);
+ SetFocus;
+
+ // In order not to trigger double clicks when clicking too fast on the
+ // little arrows in the list, we keep track of wether or not scrolling
+ // occured. But of course, we have to reinitialize this, and the best
+ // Place to do it is here, in MouseDown.
+ FHasScrolled := False;
+
+ if PtInRect(ScrollDnBtnRect(ClientRect), Point(X, Y)) then
+ Scroll(1)
+ else
+ if PtInRect(ScrollUpBtnRect(ClientRect), Point(X, Y)) then
+ Scroll(-1)
+ else
+ begin
+ Appt := FindApptAtLine(FMousePtInfo.RelLineNum);
+ if Assigned(Appt) then
+ begin
+ if Viewer.SelAppt <> Appt then
+ begin
+ Viewer.SetSelAppt(Appt);
+ Click;
+ end;
+ end;
+
+ if PtInRect(FDDBtnRect, Point(X, Y)) and Assigned(Viewer) then
+ begin
+ EditAppt(Viewer.Cell, FMousePtInfo.RelLineNum, Appt);
+ Viewer.LineDDClick(MouseLine);
+ end
+ else
+ begin
+ // When the user double clicks in a cell that is not already selected,
+ // we are moved to the new place. As a result, the second MouseUp is
+ // sent to us, not the grid, which result in a double click not being
+ // triggered. In order to trigger the double click, we keep track of
+ // the change of location in SetBounds and if we get a MouseUp event
+ // in less than the double click time, we know it's a because of a
+ // double click and we trigger the appropriate event.
+ ticks := GetTickCount;
+ if (ticks - FWasMovedTicks < GetDoubleClickTime) then
+ begin
+ DoViewerDblClick;
+ end;
+ FWasMovedTicks := 0;
+
+ // only start dragging if the mouse down has not happened in the double
+ // click window. That's because if we get a MouseDown right after a
+ // DoubleClick, then we will never receive the MouseUp. The code below
+ // would lead to the start of a drag of an appointment leading to potential
+ // problems when clicking again (like dropping an non existent appointment).
+ // To avoid this, we keep track of the fact that we went through a double
+ // click and do nothing when we get a mouse down right after that.
+ if not PtInRect(FDDBtnRect, Point(X, Y)) and Assigned(Appt) and
+ not FWasInDblClick then
+ Viewer.GlanceControl.BeginDrag(False);
+ end;
+ end;
+
+ FWasInDblClick := False;
+end;
+
+procedure TJvTFGVTextControl.MouseUp(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ inherited MouseUp(Button, Shift, X, Y);
+end;
+
+procedure TJvTFGVTextControl.MouseEnter(Control: TControl);
+begin
+ FMouseInControl := True;
+ inherited MouseEnter(Control);
+ Invalidate;
+end;
+
+procedure TJvTFGVTextControl.MouseLeave(Control: TControl);
+begin
+ FMouseInControl := False;
+ inherited MouseLeave(Control);
+ Invalidate;
+end;
+
+procedure TJvTFGVTextControl.Scroll(ADelta: Integer);
+var
+ CurrTop: Integer;
+begin
+ CurrTop := Viewer.GetTopLine(Viewer.Cell);
+ Viewer.SetTopLine(Viewer.Cell, CurrTop + ADelta);
+ FHasScrolled := True;
+end;
+
+function TJvTFGVTextControl.GetTopLine: Integer;
+begin
+ Result := Viewer.GetTopLine(Viewer.Cell);
+end;
+
+function TJvTFGVTextControl.ScrollDnBtnRect(aCellRect: TRect): TRect;
+var
+ BtnLeft,
+ BtnTop: Integer;
+begin
+ if TopLine + FullViewableLines - 1 < LineCount - 1 then
+ begin
+ Result := Rect(0, 0, FScrollDnBtnBMP.Width, FScrollDnBtnBMP.Height);
+ BtnLeft := aCellRect.Right - 10 - RectWidth(Result);
+ BtnTop := aCellRect.Bottom - RectHeight(Result);
+ OffsetRect(Result, BtnLeft, BtnTop);
+ end
+ else
+ Result := Rect(0, 0, 0, 0);
+end;
+
+function TJvTFGVTextControl.ScrollUpBtnRect(aCellRect: TRect): TRect;
+var
+ BtnLeft: Integer;
+begin
+ if TopLine > 0 then
+ begin
+ Result := Rect(0, 0, FScrollUpBtnBMP.Width, FScrollUpBtnBMP.Height);
+ BtnLeft := aCellRect.Right - 10 - RectWidth(Result);
+ OffsetRect(Result, BtnLeft, aCellRect.Top);
+ end
+ else
+ Result := Rect(0, 0, 0, 0);
+end;
+
+procedure TJvTFGVTextControl.SetCanEdit(const Value: Boolean);
+begin
+ FCanEdit := Value;
+end;
+
+procedure TJvTFGVTextControl.SetShowDDButton(const Value: Boolean);
+begin
+ FShowDDButton := Value;
+end;
+
+destructor TJvTFGVTextControl.Destroy;
+begin
+ FEditor.Free;
+ FScrollUpBtnBMP.Free;
+ FScrollDnBtnBMP.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFGVTextControl.InitScrollDnBtnBMP;
+begin
+ with FScrollDnBtnBMP do
+ begin
+ Height := 9;
+ Width := 16;
+
+ with Canvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(0, 0, Width, Height));
+
+ Pen.Color := clBlack;
+ Polyline([Point(0, 0), Point(Width - 1, 0),
+ Point(Width - 1, Height - 1), Point(0, Height - 1),
+ Point(0, 0)]);
+
+ MoveTo(2, 2);
+ LineTo(14, 2);
+ MoveTo(2, 3);
+ LineTo(14, 3);
+ MoveTo(7, 4);
+ LineTo(13, 4);
+ MoveTo(8, 5);
+ LineTo(12, 5);
+ MoveTo(9, 6);
+ LineTo(11, 6);
+ end;
+ end;
+end;
+
+procedure TJvTFGVTextControl.InitScrollUpBtnBMP;
+begin
+ with FScrollUpBtnBMP do
+ begin
+ Height := 9;
+ Width := 16;
+
+ with Canvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(0, 0, Width, Height));
+
+ Pen.Color := clBlack;
+ Polyline([Point(0, 0), Point(Width - 1, 0),
+ Point(Width - 1, Height - 1), Point(0, Height - 1),
+ Point(0, 0)]);
+
+ MoveTo(9, 2);
+ LineTo(11, 2);
+ MoveTo(8, 3);
+ LineTo(12, 3);
+ MoveTo(7, 4);
+ LineTo(13, 4);
+ MoveTo(2, 5);
+ LineTo(14, 5);
+ MoveTo(2, 6);
+ LineTo(14, 6);
+ end;
+ end;
+end;
+
+procedure TJvTFGVTextControl.DrawScrollDnBtn(ACanvas: TCanvas; aCellRect: TRect);
+var
+ aRect: TRect;
+begin
+ aRect := ScrollDnBtnRect(aCellRect);
+ BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
+ RectHeight(aRect), FScrollDnBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
+end;
+
+procedure TJvTFGVTextControl.DrawScrollUpBtn(ACanvas: TCanvas; aCellRect: TRect);
+var
+ aRect: TRect;
+begin
+ aRect := ScrollUpBtnRect(aCellRect);
+ BitBlt(ACanvas.Handle, aRect.Left, aRect.Top, RectWidth(aRect),
+ RectHeight(aRect), FScrollUpBtnBMP.Canvas.Handle, 0, 0, SRCCOPY);
+end;
+
+function TJvTFGVTextControl.FullViewableLines: Integer;
+var
+ aRect: TRect;
+begin
+ aRect := GlanceControl.CalcCellBodyRect(Viewer.Cell,
+ GlanceControl.CellIsSelected(Viewer.Cell), False);
+
+ Result := RectHeight(aRect) div CalcLineHeight;
+end;
+
+(*
+procedure TJvTFGVTextControl.EditAppt(Col, Row: Integer; Appt: TJvTFAppt);
+var
+ EditLine: Integer;
+ EditorRect: TRect;
+begin
+ EditLine := RelToAbs(GetApptRelLineNum(Appt));
+ if not Assigned(Appt) or not CanEdit or
+ ((EditLine < 0) or (EditLine > AbsLineCount)) then
+ Exit;
+
+ Viewer.EnsureCol(Col);
+ Viewer.EnsureRow(Row);
+ if (Viewer.Col <> Col) or (Viewer.Row <> Row) then
+ Viewer.MoveTo(Col, Row);
+
+ if Viewer.EditorAlign = eaLine then
+ begin
+ EditorRect := LineRect(EditLine);
+ FEditor.WordWrap := False;
+ FEditor.BorderStyle := bsSingle;
+ end
+ else
+ begin
+ EditorRect := ClientRect;
+ FEditor.WordWrap := True;
+ FEditor.BorderStyle := bsNone;
+ end;
+
+ with FEditor do
+ begin
+ LinkedAppt := Appt;
+ Color := Viewer.SelApptAttr.Color;
+ Font := Viewer.GlanceControl.SelCellAttr.Font;
+ Font.Color := Viewer.SelApptAttr.FontColor;
+ BoundsRect := EditorRect;
+
+ Text := Appt.Description;
+ {
+ if agoFormattedDesc in Options then
+ Text := Appt.Description
+ else
+ Text := StripCRLF(Appt.Description);
+ }
+
+{ //Self.Update; // not calling update here increases flicker
+ Visible := True;
+ SetFocus;
+ SelLength := 0;
+ SelStart := 0;
+ end;
+end;
+}
+*)
+
+procedure TJvTFGVTextControl.EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer; Appt: TJvTFAppt);
+var
+ EditLine: Integer;
+ EditorRect: TRect;
+begin
+ //EditLine := RelToAbs(GetApptRelLineNum(Appt));
+ EditLine := RelToAbs(RelLine);
+ if not Assigned(Appt) or not CanEdit or
+ ((EditLine < 0) or (EditLine > AbsLineCount)) then
+ Exit;
+
+ Viewer.MoveTo(ACell);
+
+ if Viewer.EditorAlign = eaLine then
+ begin
+ EditorRect := LineRect(EditLine);
+ FEditor.WordWrap := False;
+ FEditor.BorderStyle := bsSingle;
+ end
+ else
+ begin
+ EditorRect := ClientRect;
+ FEditor.WordWrap := True;
+ FEditor.BorderStyle := bsNone;
+ end;
+
+ with FEditor do
+ begin
+ LinkedAppt := Appt;
+ Color := Viewer.SelApptAttr.Color;
+ Font := Viewer.GlanceControl.SelCellAttr.Font;
+ Font.Color := Viewer.SelApptAttr.FontColor;
+ BoundsRect := EditorRect;
+
+ Text := Appt.Description;
+ {
+ if agoFormattedDesc in Options then
+ Text := Appt.Description
+ else
+ Text := StripCRLF(Appt.Description);
+ }
+
+ //Self.Update; // not calling update here increases flicker
+ Visible := True;
+ SetFocus;
+ SelLength := 0;
+ SelStart := 0;
+ end;
+end;
+
+
+function TJvTFGVTextControl.Editing: Boolean;
+begin
+ Result := FEditor.Visible;
+end;
+
+procedure TJvTFGVTextControl.FinishEditAppt;
+begin
+ if Assigned(FEditor.LinkedAppt) then
+ FEditor.LinkedAppt.Description := FEditor.Text;
+ FEditor.Visible := False;
+end;
+
+function TJvTFGVTextControl.FindApptAtLine(RelLineNum: Integer): TJvTFAppt;
+begin
+ if Assigned(Viewer) and
+ (RelLineNum >= 0) and (RelLineNum < Viewer.ApptCount) then
+ Result := Viewer.Appts[RelLineNum]
+ else
+ Result := nil;
+end;
+
+function TJvTFGVTextControl.GetApptRelLineNum(Appt: TJvTFAppt): Integer;
+var
+ I: Integer;
+begin
+ Result := -1;
+ if not Assigned(Appt) then
+ Exit;
+
+ I := 0;
+ while (I < Viewer.ApptCount) and (Result = -1) do
+ if Viewer.Appts[I] = Appt then
+ Result := I
+ else
+ Inc(I);
+end;
+
+function TJvTFGVTextControl.AbsLineCount: Integer;
+begin
+ //Result := Lesser(ViewableLines - 1, LineCount - TopLine - 1);
+ Result := RectHeight(ClientRect) div CalcLineHeight;
+ if RectHeight(ClientRect) mod CalcLineHeight > 0 then
+ Inc(Result);
+end;
+
+procedure TJvTFGVTextControl.MouseAccel(X, Y: Integer);
+var
+ Appt: TJvTFAppt;
+begin
+ Appt := GetApptAccel(X, Y);
+ if Assigned(Appt) then
+ Viewer.SetSelAppt(Appt);
+end;
+
+procedure TJvTFGVTextControl.Click;
+begin
+ DoViewerClick;
+end;
+
+function TJvTFGVTextControl.GetStartEndString(Appt: TJvTFAppt): string;
+var
+ ShowDates: Boolean;
+ DateFormat,
+ TimeFormat: string;
+begin
+ ShowDates := (Trunc(Appt.StartDate) <> Trunc(Viewer.Date)) or
+ (Trunc(Appt.EndDate) <> Trunc(Viewer.Date));
+ DateFormat := Viewer.GlanceControl.DateFormat;
+ TimeFormat := Viewer.GlanceControl.TimeFormat;
+
+ Result := '';
+ if ShowDates then
+ Result := FormatDateTime(DateFormat, Appt.StartDate) + ' ';
+
+ Result := Result + FormatDateTime(TimeFormat, Appt.StartTime) + ' - ';
+
+ if ShowDates then
+ Result := Result + FormatDateTime(DateFormat, Appt.EndDate) + ' ';
+
+ Result := Result + FormatDateTime(TimeFormat, Appt.EndTime);
+end;
+
+function TJvTFGVTextControl.GetApptAccel(X, Y: Integer): TJvTFAppt;
+var
+ LocalPt: TPoint;
+begin
+ LocalPt := ScreenToClient(Viewer.GlanceControl.ClientToScreen(Point(X, Y)));
+ Result := GetApptAt(LocalPt.X, LocalPt.Y);
+end;
+
+function TJvTFGVTextControl.GetApptAt(X, Y: Integer): TJvTFAppt;
+var
+ PtInfo: TJvTFGlTxtVwPointInfo;
+begin
+ PtInfo := CalcPointInfo(X, Y);
+ Result := FindApptAtLine(PtInfo.RelLineNum);
+end;
+
+procedure TJvTFGVTextControl.DragOver(Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+begin
+ inherited DragOver(Source, X, Y, State, Accept);
+ if Source is TJvTFControl then
+ Viewer.Visible := False;
+end;
+
+//=== { TJvTFGlanceTextViewer } ==============================================
+
+constructor TJvTFGlanceTextViewer.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FTopLines := TStringList.Create;
+ FViewControl := TJvTFGVTextControl.Create(Self);
+ FSelApptAttr := TJvTFTxtVwApptAttr.Create(Self);
+ FSelApptAttr.OnChange := @SelApptAttrChange;
+ FEditorAlign := eaLine;
+ FShowStartEnd := True;
+end;
+
+destructor TJvTFGlanceTextViewer.Destroy;
+begin
+ FViewControl.Free;
+ FTopLines.Free;
+ FSelApptAttr.OnChange := nil;
+ FSelApptAttr.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFGlanceTextViewer.Change;
+begin
+ Refresh;
+end;
+
+procedure TJvTFGlanceTextViewer.SetEditorAlign(Value: TJvTFGlTxtVwEditorAlign);
+begin
+ FEditorAlign := Value;
+end;
+
+function TJvTFGlanceTextViewer.GetDrawInfo(ACell: TJvTFGlanceCell): TJvTFGlTxtVwDrawInfo;
+var
+ Attr: TJvTFGlanceCellAttr;
+begin
+ if not Assigned(GlanceControl) then
+ raise EGlanceViewerError.CreateRes(@RsEGlanceControlNotAssigned);
+
+ with Result do
+ begin
+ Cell := ACell;
+ Attr := GlanceControl.GetCellAttr(ACell);
+ Font := Attr.Font;
+ Color := Attr.Color;
+ aRect := GlanceControl.CalcCellBodyRect(ACell,
+ GlanceControl.CellIsSelected(ACell), False);
+ end;
+end;
+
+function TJvTFGlanceTextViewer.GetTopLine(ACell: TJvTFGlanceCell): Integer;
+var
+ I: Integer;
+begin
+ I := FTopLines.IndexOf(GetCellString(ACell));
+ if I > -1 then
+ Result := Integer(FTopLines.Objects[I])
+ else
+ Result := 0;
+end;
+
+procedure TJvTFGlanceTextViewer.LineDDClick(LineNum: Integer);
+begin
+ if Assigned(FOnLineDDClick) then
+ FOnLineDDClick(Self, LineNum);
+end;
+
+procedure TJvTFGlanceTextViewer.DoDblClick;
+begin
+ if Assigned(FOnDblClick) then
+ FOnDblClick(Self);
+end;
+
+procedure TJvTFGlanceTextViewer.DoClick;
+begin
+ if Assigned(FOnClick) then
+ FOnClick(Self);
+end;
+
+procedure TJvTFGlanceTextViewer.DoEnter;
+begin
+ if Assigned(FOnEnter) then
+ FOnEnter(Self);
+end;
+
+procedure TJvTFGlanceTextViewer.MouseAccel(X, Y: Integer);
+begin
+ inherited MouseAccel(X, Y);
+ FViewControl.MouseAccel(X, Y);
+ DoClick;
+end;
+
+procedure TJvTFGlanceTextViewer.Notify(Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ inherited Notify(Sender, Code);
+end;
+
+procedure TJvTFGlanceTextViewer.PaintTo(ACanvas: TCanvas; ACell: TJvTFGlanceCell);
+begin
+ FViewControl.PaintTo(ACanvas, GetDrawInfo(ACell));
+end;
+
+procedure TJvTFGlanceTextViewer.ParentReconfig;
+begin
+ inherited ParentReconfig;
+ FTopLines.Clear;
+end;
+
+procedure TJvTFGlanceTextViewer.Realign;
+begin
+ if not Assigned(GlanceControl) then
+ Exit;
+
+ FViewControl.BoundsRect := CalcBoundsRect(Cell);
+ if not FViewControl.Replicating then
+ SetSelAppt(nil);
+end;
+
+procedure TJvTFGlanceTextViewer.Refresh;
+begin
+ FViewControl.Invalidate;
+end;
+
+procedure TJvTFGlanceTextViewer.ResetTopLines;
+begin
+ FTopLines.Clear;
+ GlanceControl.Invalidate;
+end;
+
+procedure TJvTFGlanceTextViewer.SelApptAttrChange(Sender: TObject);
+begin
+ //Change;
+ FViewControl.Invalidate;
+end;
+
+procedure TJvTFGlanceTextViewer.SetGlanceControl(Value: TJvTFCustomGlance);
+begin
+ inherited SetGlanceControl(Value);
+ if csDestroying in ComponentState then
+ exit;
+ FViewControl.Parent := Value;
+end;
+
+procedure TJvTFGlanceTextViewer.SetInplaceEdit(const Value: Boolean);
+begin
+ inherited SetInplaceEdit(Value);
+
+ FViewControl.CanEdit := InPlaceEdit;
+ FViewControl.Invalidate;
+end;
+
+procedure TJvTFGlanceTextViewer.SetLineSpacing(Value: Integer);
+begin
+ //Value := Greater(Value, 0);
+ if Value <> FLineSpacing then
+ begin
+ FLineSpacing := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFGlanceTextViewer.SetSelAppt(Value: TJvTFAppt);
+begin
+ FSelAppt := Value;
+ FViewControl.Invalidate;
+end;
+
+procedure TJvTFGlanceTextViewer.SetSelApptAttr(Value: TJvTFTxtVwApptAttr);
+begin
+ FSelApptAttr.Assign(Value);
+end;
+
+procedure TJvTFGlanceTextViewer.SetTopLine(ACell: TJvTFGlanceCell; Value: Integer);
+var
+ I: Integer;
+ CellStr: string;
+begin
+ Value := Greater(Value, 0);
+ Value := Lesser(Value, ApptCount - 1);
+
+ // bug fix - this effectively hides the hint window. The showing/hiding
+ // of the hint window was causing the viewer to be positioned at the
+ // wrong cell due to repainting as the hint window would hide/show.
+ GlanceControl.CheckViewerApptHint(-1, -1);
+
+ CellStr := GetCellString(ACell);
+ I := FTopLines.IndexOf(CellStr);
+ if I > -1 then
+ if Value = 0 then
+ FTopLines.Delete(I)
+ else
+ FTopLines.Objects[I] := TObject(Value)
+ else
+ if Value <> 0 then
+ FTopLines.AddObject(CellStr, TObject(Value));
+ Refresh;
+end;
+
+procedure TJvTFGlanceTextViewer.SetVisible(Value: Boolean);
+begin
+ // MORE STUFF NEEDS TO BE ADDED HERE!
+ FViewControl.Visible := Value;
+end;
+
+procedure TJvTFGlanceTextViewer.SetShowStartEnd(Value: Boolean);
+begin
+ if Value <> FShowStartEnd then
+ begin
+ FShowStartEnd := Value;
+ if not (csLoading in ComponentState) then
+ begin
+ GlanceControl.Invalidate;
+ FViewControl.Invalidate;
+ end;
+ end;
+end;
+
+function TJvTFGlanceTextViewer.GetApptAt(X, Y: Integer): TJvTFAppt;
+begin
+ Result := FViewControl.GetApptAt(X, Y);
+end;
+
+function TJvTFGlanceTextViewer.CanEdit: Boolean;
+begin
+ Result := FViewControl.CanEdit and InPlaceEdit;
+end;
+
+procedure TJvTFGlanceTextViewer.EditAppt(ACell: TJvTFGlanceCell; RelLine: Integer;
+ Appt: TJvTFAppt);
+begin
+ FViewControl.EditAppt(ACell, RelLine, Appt);
+end;
+
+function TJvTFGlanceTextViewer.Editing: Boolean;
+begin
+ Result := FViewControl.Editing;
+end;
+
+procedure TJvTFGlanceTextViewer.FinishEditAppt;
+begin
+ FViewControl.FinishEditAppt;
+end;
+
+function TJvTFGlanceTextViewer.GetCellString(ACell: TJvTFGlanceCell): string;
+begin
+ Result := '';
+ if Assigned(ACell) then
+ begin
+ Result := IntToStr(ACell.ColIndex) + ',' + IntToStr(ACell.RowIndex);
+ if ACell.IsSubcell then
+ Result := Result + 'S';
+ end;
+end;
+
+function TJvTFGlanceTextViewer.GetShowLineDDButton: Boolean;
+begin
+ Result := FViewControl.ShowDDButton;
+end;
+
+procedure TJvTFGlanceTextViewer.DoDrawAppt(ACanvas: TCanvas;
+ DrawInfo: TJvTFGlTxtVwDrawInfo; Appt: TJvTFAppt; Rect: TRect; var Handled: Boolean);
+begin
+ if Assigned(FOnDrawAppt) then
+ FOnDrawAppt(Self, ACanvas, DrawInfo, Appt, Rect, Handled);
+end;
+
+procedure TJvTFGlanceTextViewer.SetShowLineDDButton(const Value: Boolean);
+begin
+ FViewControl.ShowDDButton := Value;
+end;
+
+//=== { TJvTFGVTxtEditor } ===================================================
+
+constructor TJvTFGVTxtEditor.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ ControlStyle := ControlStyle + [csNoDesignVisible];
+ {
+ ParentCtl3D := False;
+ Ctl3D := False;
+ }
+end;
+
+destructor TJvTFGVTxtEditor.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TJvTFGVTxtEditor.DoExit;
+begin
+ inherited DoExit;
+ try
+ if not FCancelEdit then
+ TJvTFGVTextControl(Owner).FinishEditAppt;
+ finally
+ FCancelEdit := False;
+ Parent.SetFocus;
+ end;
+end;
+
+procedure TJvTFGVTxtEditor.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+
+ if Key = VK_ESCAPE then
+ begin
+ FCancelEdit := True;
+ Key := 0;
+ Visible := False;
+ end
+ else
+ if (Key = VK_RETURN) and (ssCtrl in Shift) then
+ TJvTFGVTextControl(Owner).FinishEditAppt;
+end;
+
+//=== { TJvTFTxtVwApptAttr } =================================================
+
+constructor TJvTFTxtVwApptAttr.Create(AOwner: TComponent);
+begin
+ inherited Create;
+ FColor := clBlue;
+ FFontColor := clWhite;
+end;
+
+procedure TJvTFTxtVwApptAttr.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFTxtVwApptAttr then
+ begin
+ FColor := TJvTFTxtVwApptAttr(Source).Color;
+ FFontColor := TJvTFTxtVwApptAttr(Source).FontColor;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFTxtVwApptAttr.Change;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TJvTFTxtVwApptAttr.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFTxtVwApptAttr.SetFontColor(Value: TColor);
+begin
+ if Value <> FFontColor then
+ begin
+ FFontColor := Value;
+ Change;
+ end;
+end;
+
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfmanager.pas b/components/jvcllaz/run/JvTimeFramework/jvtfmanager.pas
new file mode 100644
index 000000000..cd396fea0
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfmanager.pas
@@ -0,0 +1,5369 @@
+{-----------------------------------------------------------------------------
+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: JvTFManager.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFManager;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType,
+ Classes, SysUtils, Controls, //Windows, Messages,
+ Graphics, ImgList, ExtCtrls, Printers, Forms,
+ //JvComponentBase,
+ JvComponent, JvTypes, JvTFUtils;
+
+const
+ CN_REQUESTREFRESH = $BD01;
+
+type
+ // Redeclaration of this type. It is used in JvTFMonths.TJvTFDrawDWTitleEvent.
+ // If not redeclared here, Delphi complains of 'unknown type' because it
+ // will not automatically bring in 'JvTFUtils' into the uses clause when
+ // a TJvTFDrawDWTitleEvent prototype is created.
+ TTFDayOfWeek = JvTFUtils.TTFDayOfWeek;
+ EJvTFScheduleManagerError = class(Exception);
+
+ TJvTFTimeRange = record
+ StartTime: TTime;
+ EndTime: TTime;
+ end;
+
+ TJvTFServNotifyCode = (sncDestroyAppt,
+ sncDestroySchedule,
+ sncLoadAppt,
+ sncSchedLoadAppt,
+ sncSchedUnloadAppt,
+ sncPostAppt,
+ sncDeleteAppt,
+ sncRequestSchedule,
+ sncReleaseSchedule,
+ sncConnectComponent,
+ sncDisconnectComponent,
+ sncConnectControl,
+ sncDisconnectControl,
+ sncConnectAppt,
+ sncDisconnectAppt,
+ sncRefresh);
+
+ TJvTFScheduleManager = class;
+ {$M+}
+ TJvTFSched = class;
+ {$M-}
+ TJvTFAppt = class;
+ TJvTFComponent = class;
+ TJvTFControl = class;
+ TJvTFPrinter = class;
+ TJvTFHint = class;
+ // TJvTFNavigator = class;
+
+ TJvTFSchedClass = class of TJvTFSched;
+ TJvTFApptClass = class of TJvTFAppt;
+ TJvTFHintClass = class of TJvTFHint;
+
+ TCNRequestRefresh = record
+ Msg: Cardinal;
+ Schedule: TJvTFSched;
+ Unused: Longint;
+ Result: Longint;
+ end;
+
+ TJvTFDateList = class
+ private
+ FOnChange: TNotifyEvent;
+ protected
+ FList: TStringList;
+ function GetDate(Index: Integer): TDate;
+ procedure Change; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Add(ADate: TDate): Integer;
+ procedure Delete(Index: Integer);
+ procedure Clear;
+ function Count: Integer;
+ function IndexOf(ADate: TDate): Integer;
+ property Dates[Index: Integer]: TDate read GetDate; default;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ end;
+
+ TJvTFNavEvent = procedure(Sender: TObject; aControl: TJvTFControl;
+ SchedNames: TStringList; Dates: TJvTFDateList) of object;
+ TJvTFControlEvent = procedure(Sender: TObject; aControl: TJvTFControl) of object;
+ TJvTFSchedEvent = procedure(Sender: TObject; Schedule: TJvTFSched) of object;
+ TJvTFApptEvent = procedure(Sender: TObject; Appt: TJvTFAppt) of object;
+ TJvTFVarApptEvent = procedure(Sender: TObject; var Appt: TJvTFAppt) of object;
+ TJvTFFlushEvent = procedure(Sender, FlushObj: TObject; var FlushIt: Boolean) of object;
+
+ // implicit post fix
+ TJvTFPostApptQueryEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
+ var CanPost: Boolean) of object;
+
+ TJvTFCustomImageMap = class(TPersistent)
+ private
+ FMap: TStringList;
+ function GetImage(MapIndex: Integer): Integer;
+ procedure SetImage(MapIndex: Integer; Value: Integer);
+ function GetImageName(MapIndex: Integer): string;
+ protected
+ FAppt: TJvTFAppt;
+ procedure Change;
+ public
+ constructor Create(anAppt: TJvTFAppt);
+ destructor Destroy; override;
+ property Images[MapIndex: Integer]: Integer read GetImage write SetImage; default;
+ property ImageNames[MapIndex: Integer]: string read GetImageName;
+ function Count: Integer;
+ procedure Add(const ImageName: string; ImageIndex: Integer);
+ procedure Delete(MapIndex: Integer);
+ procedure Move(SrcMapIndex, DestMapIndex: Integer);
+ function FindMapIndex(const ImageName: string): Integer;
+ function FindImageIndex(const ImageName: string): Integer;
+ procedure Clear;
+ procedure Assign(Source: TPersistent); override;
+ end;
+
+ TJvTFStatePic = (spAlarmEnabled, spAlarmDisabled, spShared, spRecurring,
+ spModified);
+
+ TJvTFStateImageMap = class(TPersistent)
+ private
+ FPics: array[Low(TJvTFStatePic)..High(TJvTFStatePic)] of Integer;
+
+ procedure SetImage(StatePicID: TJvTFStatePic; Value: Integer);
+ function GetImage(StatePicID: TJvTFStatePic): Integer;
+ function GetAlarmDisabled: Integer;
+ function GetAlarmEnabled: Integer;
+ function GetModified: Integer;
+ function GetRecurring: Integer;
+ function GetShared: Integer;
+ procedure SetAlarmDisabled(const Value: Integer);
+ procedure SetAlarmEnabled(const Value: Integer);
+ procedure SetModified(const Value: Integer);
+ procedure SetRecurring(const Value: Integer);
+ procedure SetShared(const Value: Integer);
+ protected
+ FScheduleManager: TJvTFScheduleManager;
+ FUpdating: Boolean;
+ procedure Change;
+ public
+ constructor Create(Serv: TJvTFScheduleManager);
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ procedure Clear;
+ procedure Assign(Source: TPersistent); override;
+ property Pics[Index: TJvTFStatePic]: Integer read GetImage write SetImage;
+ published
+ property AlarmEnabled: Integer {index spAlarmEnabled}
+ read GetAlarmEnabled write SetAlarmEnabled;
+ property AlarmDisabled: Integer {index spAlarmDisabled}
+ read GetAlarmDisabled write SetAlarmDisabled;
+ property Shared: Integer {index spShared}
+ read GetShared write SetShared;
+ property Recurring: Integer {index spRecurring}
+ read GetRecurring write SetRecurring;
+ //read GetImage write SetImage;
+ property Modified: Integer {index spModified}
+ read GetModified write SetModified;
+ end;
+
+ TDynTimeRangeArray = array of TJvTFTimeRange;
+
+ TDynApptArray = array of TJvTFAppt;
+
+ TDynSchedArray = array of TJvTFSched;
+
+ TJvTFAppt = class(TPersistent)
+ private
+ FStartDate: TDate;
+ FEndDate: TDate;
+ FStartTime: TTime;
+ FEndTime: TTime;
+ FDescription: string;
+ FAlarmEnabled: Boolean;
+ FAlarmAdvance: Integer;
+ FImageMap: TJvTFCustomImageMap;
+ FData: Integer;
+ FPersistent: Boolean;
+ FColor: TColor;
+ FBarColor: TColor;
+ FRefreshed: Boolean;
+ FGlyph: TPicture;
+ FDestroying: Boolean;
+
+ function GetDescription: string;
+ procedure SetDescription(Value: string);
+ procedure SetAlarmEnabled(Value: Boolean);
+ procedure SetAlarmAdvance(Value: Integer);
+ procedure SetColor(Value: TColor);
+ procedure SetBarColor(Value: TColor);
+ function GetStartDateTime: TDateTime;
+ function GetEndDateTime: TDateTime;
+ function GetStartDate: TDate;
+ function GetEndDate: TDate;
+ function GetStartTime: TTime;
+ function GetEndTime: TTime;
+ procedure SetRefreshed(Value: Boolean);
+ procedure SetGlyph(const Value: TPicture);
+ protected
+ FID: string;
+ FModified: Boolean;
+ FScheduleManager: TJvTFScheduleManager;
+ FConnections: TStringList;
+ FSchedules: TStringList;
+ FDeleting: Boolean;
+ // implicit post fix
+ FUpdating: Boolean;
+
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+ procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure NotifySchedule(Sched: TJvTFSched; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+
+ function GetConnection(Index: Integer): TJvTFSched;
+ function GetSchedule(Index: Integer): string;
+ procedure CheckConnections;
+
+ procedure Connect(Schedule: TJvTFSched);
+ procedure Disconnect(Schedule: TJvTFSched);
+ procedure Change;
+ procedure InternalClearSchedules;
+ procedure DeleteApptNotification;
+ // implicit post fix
+ procedure PostApptNotification;
+ procedure RefreshNotification;
+
+ property Destroying: Boolean read FDestroying;
+ public
+ constructor Create(Serv: TJvTFScheduleManager; const ApptID: string); virtual;
+ destructor Destroy; override;
+
+ procedure Assign(Source: TPersistent); override;
+ procedure SetStartEnd(NewStartDate: TDate; NewStartTime: TTime;
+ NewEndDate: TDate; NewEndTime: TTime);
+
+ procedure SetModified;
+ function Modified: Boolean; dynamic;
+ property ScheduleManager: TJvTFScheduleManager read FScheduleManager;
+
+ function ConnectionCount: Integer;
+ property Connections[Index: Integer]: TJvTFSched read GetConnection;
+
+ function ScheduleCount: Integer;
+ property Schedules[Index: Integer]: string read GetSchedule;
+ procedure AddSchedule(const SchedName: string);
+ procedure RemoveSchedule(const SchedName: string);
+ procedure AssignSchedules(List: TStrings);
+ procedure ClearSchedules;
+ function IndexOfSchedule(const SchedName: string): Integer;
+ function Shared: Boolean;
+
+ procedure Post;
+ procedure Refresh;
+ procedure Delete;
+
+ // implicit post fix
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ property Updating: Boolean read FUpdating;
+
+ property ImageMap: TJvTFCustomImageMap read FImageMap write FImageMap;
+ procedure RefreshControls;
+ property Refreshed: Boolean read FRefreshed write SetRefreshed;
+ published
+ property ID: string read FID;
+ property StartDate: TDate read GetStartDate;
+ property EndDate: TDate read GetEndDate;
+ property StartTime: TTime read GetStartTime;
+ property EndTime: TTime read GetEndTime;
+ property StartDateTime: TDateTime read GetStartDateTime;
+ property EndDateTime: TDateTime read GetEndDateTime;
+ property Description: string read GetDescription write SetDescription;
+ property AlarmEnabled: Boolean read FAlarmEnabled write SetAlarmEnabled;
+ property AlarmAdvance: Integer read FAlarmAdvance write SetAlarmAdvance;
+ property Data: Integer read FData write FData;
+ property Persistent: Boolean read FPersistent write FPersistent;
+ property Color: TColor read FColor write SetColor default clDefault;
+ property BarColor: TColor read FBarColor write SetBarColor default clDefault;
+ property Glyph: TPicture read FGlyph write SetGlyph;
+ end;
+
+ {$M+}
+ TJvTFSched = class(TObject)
+ private
+ FAppts: TStringList;
+ FConControls: TStringList;
+ FConComponents: TStringList;
+ FDestroying: Boolean;
+ FData: Integer;
+ FPersistent: Boolean;
+ FSchedDisplayName: string;
+ procedure SetSchedDisplayName(const Value: string);
+
+ function GetAppt(Index: Integer): TJvTFAppt;
+ protected
+ FSchedName: string;
+ FSchedDate: TDate;
+ FScheduleManager: TJvTFScheduleManager;
+ FCached: Boolean;
+ FCachedTime: Int64; //DWORD;
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+ procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ function GetConControl(Index: Integer): TJvTFControl;
+ function GetConComponent(Index: Integer): TJvTFComponent;
+ procedure ConnectAppt(Appt: TJvTFAppt);
+ procedure DisconnectAppt(Appt: TJvTFAppt);
+ procedure ConnectionsOnChange(Sender: TObject);
+ procedure CheckConnections;
+ function GetFreeUsedTime(FreeTime: Boolean): TDynTimeRangeArray; dynamic;
+ public
+ constructor Create(Serv: TJvTFScheduleManager; const AName: string; ADate: TDate); virtual;
+ destructor Destroy; override;
+
+ function ApptCount: Integer;
+ function ApptByID(const ID: string): TJvTFAppt;
+ property Appts[Index: Integer]: TJvTFAppt read GetAppt;
+
+ function ConControlCount: Integer;
+ property ConControls[Index: Integer]: TJvTFControl read GetConControl;
+
+ function ConComponentCount: Integer;
+ property ConComponents[Index: Integer]: TJvTFComponent read GetConComponent;
+
+ procedure AddAppt(Appt: TJvTFAppt);
+ procedure RemoveAppt(Appt: TJvTFAppt);
+
+ //procedure RefreshAppts;
+ procedure Refresh;
+ procedure PostAppts;
+
+ // Conflict and free time methods
+ function GetFreeTime: TDynTimeRangeArray; dynamic;
+ function GetUsedTime: TDynTimeRangeArray; dynamic;
+ function TimeIsFree(TimeRange: TJvTFTimeRange): Boolean; overload; dynamic;
+ function TimeIsFree(RangeStart, RangeEnd: TTime): Boolean; overload; dynamic;
+ // The ApptHasConflicts(anAppt: TJvTFAppt) method declared here checks
+ // ONLY THIS SCHEDULE!!
+ function ApptHasConflicts(anAppt: TJvTFAppt): Boolean; dynamic;
+ function EnumConflicts(TimeRange: TJvTFTimeRange): TDynApptArray;
+ overload; dynamic;
+ function EnumConflicts(RangeStart, RangeEnd: TTime): TDynApptArray;
+ overload; dynamic;
+ // The following EnumConflicts(anAppt: TJvTFAppt) checks
+ // ONLY THIS SCHEDULE!!
+ function EnumConflicts(anAppt: TJvTFAppt): TDynApptArray;
+ overload; dynamic;
+
+ property Cached: Boolean read FCached;
+ property CachedTime: Int64 {DWORD} read FCachedTime;
+ property Destroying: Boolean read FDestroying;
+
+ function GetFirstAppt: TJvTFAppt;
+ function GetLastAppt: TJvTFAppt;
+ published
+ property SchedDisplayName: string read FSchedDisplayName
+ write SetSchedDisplayName;
+ property SchedName: string read FSchedName;
+ property SchedDate: TDate read FSchedDate;
+ property ScheduleManager: TJvTFScheduleManager read FScheduleManager;
+ property Data: Integer read FData write FData;
+ property Persistent: Boolean read FPersistent write FPersistent;
+ end;
+ {$M-}
+
+ TJvTFScheduleManagerCacheType = (ctNone, ctTimed, ctBuffer);
+ TJvTFScheduleManagerCache = class(TPersistent)
+ private
+ FCacheType: TJvTFScheduleManagerCacheType;
+ FTimedDelay: Integer;
+ FBufferCount: Integer;
+ FTimer: TTimer;
+ procedure SetCacheType(Value: TJvTFScheduleManagerCacheType);
+ procedure SetTimedDelay(Value: Integer);
+ procedure SetBufferCount(Value: Integer);
+ protected
+ FScheduleManager: TJvTFScheduleManager;
+ procedure FlushManager; virtual;
+ procedure TimerOnTimer(Sender: TObject); virtual;
+ public
+ constructor Create(SchedManager: TJvTFScheduleManager);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property CacheType: TJvTFScheduleManagerCacheType read FCacheType write SetCacheType
+ default ctTimed;
+ property TimedDelay: Integer read FTimedDelay write SetTimedDelay
+ default 30000;
+ property BufferCount: Integer read FBufferCount write SetBufferCount
+ default 7;
+ end;
+
+ TJvTFSchedLoadMode = (slmOnDemand, slmBatch);
+ TJvTFLoadBatchEvent = procedure(Sender: TObject; BatchName: string;
+ BatchStartDate, BatchEndDate: TDate) of object;
+
+ TJvTFGetApptDisplayTextEvent = procedure(Sender: TObject; Source: TComponent;
+ Appt: TJvTFAppt; var DisplayText: string) of object;
+
+ TJvTFApptDescEvent = procedure(Sender: TObject; Appt: TJvTFAppt;
+ var Description: string) of object;
+
+ {$IFDEF RTL230_UP}
+ [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+ {$ENDIF RTL230_UP}
+ TJvTFScheduleManager = class(TComponent)
+ private
+ FAlwaysPost: Boolean;
+ FAppts: TStringList;
+ FSchedules: TStringList;
+ FConControls: TStringList;
+ FConComponents: TStringList;
+ FOnNeedAppts: TJvTFSchedEvent;
+ FOnRefreshAppt: TJvTFApptEvent;
+ FOnRefreshSched: TJvTFSchedEvent;
+ FOnRefreshAll: TNotifyEvent;
+ FOnDeleteAppt: TJvTFApptEvent;
+ FOnPostAppt: TJvTFApptEvent;
+ FOnFlush: TJvTFFlushEvent;
+ FOnCreateAppt: TJvTFApptEvent;
+ FOnCreateSchedule: TJvTFSchedEvent;
+ FOnDestroyAppt: TJvTFApptEvent;
+ FOnDestroySchedule: TJvTFSchedEvent;
+ FOnGetApptDisplayText: TJvTFGetApptDisplayTextEvent;
+ FOnGetApptDescription: TJvTFApptDescEvent;
+ FOnSetApptDescription: TJvTFApptDescEvent;
+
+ FSchedLoadMode: TJvTFSchedLoadMode;
+ FOnLoadBatch: TJvTFLoadBatchEvent;
+ FOnBatchesProcessed: TNotifyEvent;
+
+ FRefreshAutoReconcile: Boolean;
+
+ FStateImages: TCustomImageList;
+ FCustomImages: TCustomImageList;
+ FStateImageMap: TJvTFStateImageMap;
+ FCache: TJvTFScheduleManagerCache;
+
+ // implicit post fix
+ FOnPostApptQuery: TJvTFPostApptQueryEvent;
+
+ function GetAppt(Index: Integer): TJvTFAppt;
+ function GetSchedule(Index: Integer): TJvTFSched;
+ function GetConControl(Index: Integer): TJvTFControl;
+ function GetConComponent(Index: Integer): TJvTFComponent;
+ procedure SetStateImages(Value: TCustomImageList);
+ procedure SetCustomImages(Value: TCustomImageList);
+ procedure SetCache(Value: TJvTFScheduleManagerCache);
+
+ procedure SetTFSchedLoadMode(Value: TJvTFSchedLoadMode);
+ procedure SetRefreshAutoReconcile(Value: Boolean);
+ protected
+ FLoadingAppts: Boolean;
+ FRefreshing: Boolean;
+ FImageChangeLink: TChangeLink;
+ FFlushing: Boolean;
+ FDestroying: Boolean;
+ FSchedBatch: TStringList;
+ FApptBeingDestroyed: TJvTFAppt;
+
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure ConnectControl(ApptCtrl: TJvTFControl);
+ procedure DisconnectControl(ApptCtrl: TJvTFControl);
+ procedure ConnectComponent(Comp: TJvTFComponent);
+ procedure DisconnectComponent(Comp: TJvTFComponent);
+
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;
+ procedure NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure NotifySchedule(Sched: TJvTFSched; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure NotifyApptCtrl(ApptCtrl: TJvTFControl; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure NotifyComp(Comp: TJvTFComponent; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+
+ procedure RetrieveSchedule(const SchedName: string; SchedDate: TDate;
+ var Schedule: TJvTFSched; var LoadedNow: Boolean);
+
+ procedure NeedAppts(Schedule: TJvTFSched); virtual;
+ procedure AddAppt(Appt: TJvTFAppt);
+ procedure RemoveAppt(Appt: TJvTFAppt);
+ procedure RemoveSchedule(Sched: TJvTFSched);
+
+ //procedure RefreshAppt(Appt: TJvTFAppt);
+ procedure DeleteAppt(Appt: TJvTFAppt);
+ procedure PostAppt(Appt: TJvTFAppt);
+
+ // implicit post fix
+ function QueryPostAppt(Appt: TJvTFAppt): Boolean;
+
+ procedure AddToBatch(ASched: TJvTFSched);
+ procedure LoadBatch(const BatchName: string; BatchStartDate,
+ BatchEndDate: TDate); virtual;
+
+ procedure RequestRefresh(ApptCtrl: TJvTFControl;
+ Schedule: TJvTFSched); overload; dynamic;
+ procedure RequestRefresh(Comp: TJvTFComponent;
+ Schedule: TJvTFSched); overload; dynamic;
+
+ procedure ImageListChange(Sender: TObject);
+ procedure FlushAppts;
+ function FlushObject(FlushObj: TObject): Boolean;
+
+ procedure DoCreateApptEvent(anAppt: TJvTFAppt); dynamic;
+ procedure DoCreateScheduleEvent(aSchedule: TJvTFSched); dynamic;
+ procedure DoDestroyApptEvent(anAppt: TJvTFAppt); dynamic;
+ procedure DoDestroyScheduleEvent(aSchedule: TJvTFSched); dynamic;
+
+ procedure SetApptDescription(Appt: TJvTFAppt; var Value: string); virtual;
+ procedure GetApptDescription(Appt: TJvTFAppt; var Value: string); virtual;
+ public
+ class function GetScheduleID(const SchedName: string; SchedDate: TDate): string;
+ class function GenerateApptID: string; virtual;
+
+ function GetSchedClass: TJvTFSchedClass; dynamic;
+ function GetApptClass: TJvTFApptClass; dynamic;
+
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ function ApptCount: Integer;
+ property Appts[Index: Integer]: TJvTFAppt read GetAppt;
+ function FindAppt(const ID: string): TJvTFAppt;
+
+ function ScheduleCount: Integer;
+ property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
+ function FindSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
+
+ function ConControlCount: Integer;
+ property ConControls[Index: Integer]: TJvTFControl read GetConControl;
+ function ConComponentCount: Integer;
+ property ConComponents[Index: Integer]: TJvTFComponent read GetConComponent;
+
+ function RequestSchedule(ApptCtrl: TJvTFControl; const SchedName: string;
+ SchedDate: TDate): TJvTFSched; overload;
+ function RequestSchedule(ApptCtrl: TJvTFControl; const SchedName: string;
+ SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched; overload;
+
+ function RequestSchedule(Comp: TJvTFComponent; const SchedName: string;
+ SchedDate: TDate): TJvTFSched; overload;
+ function RequestSchedule(Comp: TJvTFComponent; const SchedName: string;
+ SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched; overload;
+
+ procedure ReleaseSchedule(ApptCtrl: TJvTFControl; const SchedName: string;
+ SchedDate: TDate); overload;
+ procedure ReleaseSchedule(Comp: TJvTFComponent; const SchedName: string;
+ SchedDate: TDate); overload;
+
+ procedure ProcessBatches;
+
+ procedure RequestAppt(const ID: string; var Appt: TJvTFAppt; var New: Boolean);
+
+ property LoadingAppts: Boolean read FLoadingAppts;
+ property Refreshing: Boolean read FRefreshing;
+
+ procedure dbPostAppt(Appt: TJvTFAppt);
+ procedure dbDeleteAppt(Appt: TJvTFAppt);
+ procedure dbDeleteAllAppt;
+ procedure dbRefreshAppt(Appt: TJvTFAppt);
+ procedure dbRefreshSched(Sched: TJvTFSched);
+ procedure dbRefreshAll;
+ procedure dbRefreshOrphans;
+ function dbNewAppt(const ID: string): TJvTFAppt;
+
+ procedure PostAppts;
+ procedure RefreshAppts;
+ procedure ReconcileRefresh(Scope: TObject);
+
+ procedure RefreshConnections(Trigger: TObject); virtual;
+ property Flushing: Boolean read FFlushing;
+ procedure Flush(All: Boolean = False); virtual;
+
+ function GetApptDisplayText(AComponent: TComponent;
+ Appt: TJvTFAppt): string; virtual;
+ published
+ property AlwaysPost: Boolean read FAlwaysPost write FAlwaysPost default False;
+ property OnNeedAppts: TJvTFSchedEvent read FOnNeedAppts write FOnNeedAppts;
+ property OnRefreshAppt: TJvTFApptEvent read FOnRefreshAppt write FOnRefreshAppt;
+ property OnRefreshSched: TJvTFSchedEvent read FOnRefreshSched
+ write FOnRefreshSched;
+ property OnRefreshAll: TNotifyEvent read FOnRefreshAll write FOnRefreshAll;
+ property OnPostAppt: TJvTFApptEvent read FOnPostAppt write FOnPostAppt;
+ property OnDeleteAppt: TJvTFApptEvent read FOnDeleteAppt write FOnDeleteAppt;
+ property StateImages: TCustomImageList read FStateImages write SetStateImages;
+ property CustomImages: TCustomImageList read FCustomImages write SetCustomImages;
+ property StateImageMap: TJvTFStateImageMap read FStateImageMap write FStateImageMap;
+ property Cache: TJvTFScheduleManagerCache read FCache write SetCache;
+ // implicit post fix
+ property OnPostApptQuery: TJvTFPostApptQueryEvent read FOnPostApptQuery
+ write FOnPostApptQuery;
+ property OnFlush: TJvTFFlushEvent read FOnFlush write FOnFlush;
+ property OnCreateAppt: TJvTFApptEvent read FOnCreateAppt write FOnCreateAppt;
+ property OnDestroyAppt: TJvTFApptEvent read FOnDestroyAppt write FOnDestroyAppt;
+ property OnCreateSchedule: TJvTFSchedEvent read FOnCreateSchedule
+ write FOnCreateSchedule;
+ property OnDestroySchedule: TJvTFSchedEvent read FOnDestroySchedule
+ write FOnDestroySchedule;
+ property OnLoadBatch: TJvTFLoadBatchEvent read FOnLoadBatch write FOnLoadBatch;
+ property OnBatchesProcessed: TNotifyEvent read FOnBatchesProcessed
+ write FOnBatchesProcessed;
+ property OnGetApptDisplayText: TJvTFGetApptDisplayTextEvent
+ read FOnGetApptDisplayText write FOnGetApptDisplayText;
+ property OnGetApptDescription: TJvTFApptDescEvent read FOnGetApptDescription
+ write FOnGetApptDescription;
+ property OnSetApptDescription: TJvTFApptDescEvent read FOnSetApptDescription
+ write FOnSetApptDescription;
+
+ property SchedLoadMode: TJvTFSchedLoadMode read FSchedLoadMode
+ write SetTFSchedLoadMode default slmOnDemand;
+ property RefreshAutoReconcile: Boolean read FRefreshAutoReconcile
+ write SetRefreshAutoReconcile default False;
+ end;
+
+ TJvTFHintProps = class(TPersistent)
+ private
+ FHintColor: TColor;
+ FHintHidePause: Integer;
+ FHintPause: Integer;
+ procedure SetHintColor(Value: TColor);
+ procedure SetHintHidePause(Value: Integer);
+ procedure SetHintPause(Value: Integer);
+ protected
+ FControl: TJvTFControl;
+ procedure Change; virtual;
+ public
+ constructor Create(AOwner: TJvTFControl);
+ procedure Assign(Source: TPersistent); override;
+ published
+ property HintColor: TColor read FHintColor write SetHintColor default clDefault;
+ property HintHidePause: Integer read FHintHidePause write SetHintHidePause default -1;
+ property HintPause: Integer read FHintPause write SetHintPause default -1;
+ end;
+
+ TJvTFHintType = (shtAppt, shtStartEnd, shtCell, shtObj);
+
+ TJvTFShowHintEvent = procedure(Sender: TObject; HintType: TJvTFHintType;
+ Ref: TObject; var HintRect: TRect; var HintText: string) of object;
+
+ // NOTE:
+ // The Pause property has the same meaning as the Application.HintPause
+ // property. The ShortPause property has the same meaning as the
+ // Application.HintHidePause property.
+ TJvTFHint = class(THintWindow)
+ private
+ FTimer: TTimer;
+ FPause: Integer;
+ FShortPause: Integer;
+ FOnShowHint: TJvTFShowHintEvent;
+ FRefProps: TJvTFHintProps;
+ procedure SetPause(Value: Integer);
+ procedure SetShortPause(Value: Integer);
+ protected
+ FApptCtrl: TJvTFControl;
+ FOldAppt: TJvTFAppt;
+ FOldObj: TObject;
+ FShortTimer: Boolean;
+ FHintRect: TRect;
+ FHintText: string;
+ FHintCell: TPoint;
+ FHintType: TJvTFHintType;
+ procedure TimerOnTimer(Sender: TObject); virtual;
+ procedure PrepTimer(Short: Boolean);
+ procedure SetHintText(StartDate, EndDate: TDate; StartTime, EndTime: TTime;
+ const Desc: string; ShowDatesTimes, ShowDesc: Boolean);
+ procedure DoHint(Sustained: Boolean);
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure PropertyCheck; dynamic;
+ public
+ constructor Create(anApptCtrl: TJvTFControl); reintroduce;
+ destructor Destroy; override;
+ procedure ActivateHint(Rect: TRect; const AHint: THintString); override;
+ procedure ApptHint(Appt: TJvTFAppt; X, Y: Integer;
+ ShowDatesTimes, ShowDesc, FormattedDesc: Boolean; const ExtraDesc: string = ''); virtual;
+ procedure StartEndHint(StartDate, EndDate: TDate; StartTime, EndTime: TTime;
+ X, Y: Integer; ShowDates: Boolean);
+ procedure CellHint(Row, Col: Integer; const HintText: string; CellRect: TRect);
+
+ procedure MultiLineObjHint(Obj: TObject; X, Y: Integer; Hints: TStrings);
+
+ procedure ReleaseHandle; virtual;
+ // See above note on Pause and ShortPause properties
+ property Pause: Integer read FPause write SetPause default 3000;
+ property ShortPause: Integer read FShortPause write SetShortPause default 1500;
+ property OnShowHint: TJvTFShowHintEvent read FOnShowHint write FOnShowHint;
+ property HintType: TJvTFHintType read FHintType;
+ property RefProps: TJvTFHintProps read FRefProps write FRefProps;
+ end;
+
+ TJvTFDragInfo = class(TObject)
+ private
+ FApptCtrl: TJvTFControl;
+ FSchedule: TJvTFSched;
+ FAppt: TJvTFAppt;
+ FShift: TShiftState;
+ public
+ property ApptCtrl: TJvTFControl read FApptCtrl write FApptCtrl;
+ property Schedule: TJvTFSched read FSchedule write FSchedule;
+ property Appt: TJvTFAppt read FAppt write FAppt;
+ property Shift: TShiftState read FShift write FShift;
+ end;
+
+ TJvTFComponent = class(TComponent) //TJvComponent)
+ private
+ FScheduleManager: TJvTFScheduleManager;
+ FSchedules: TStringList;
+ procedure SetManager(Value: TJvTFScheduleManager);
+ function GetSchedule(Index: Integer): TJvTFSched;
+ protected
+ FDateFormat: string;
+ FTimeFormat: string;
+
+ procedure UpdateDesigner;
+
+ procedure SetDateFormat(const Value: string); virtual;
+ procedure SetTimeFormat(const Value: string); virtual;
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;
+ procedure ReqSchedNotification(Schedule: TJvTFSched); virtual;
+ procedure RelSchedNotification(Schedule: TJvTFSched); virtual;
+ procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure RefreshComponent; dynamic;
+ property DateFormat: string read FDateFormat write SetDateFormat;
+ property TimeFormat: string read FTimeFormat write SetTimeFormat;
+ procedure DestroyApptNotification(anAppt: TJvTFAppt); virtual;
+ procedure DestroySchedNotification(ASched: TJvTFSched); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ function ScheduleCount: Integer;
+ property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
+ function FindSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
+ function RetrieveSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
+ procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); virtual;
+ procedure ReleaseSchedules;
+ procedure ProcessBatches;
+ published
+ property ScheduleManager: TJvTFScheduleManager read FScheduleManager write SetManager;
+ end;
+
+ TJvTFControl = class(TJvCustomControl)
+ private
+ FScheduleManager: TJvTFScheduleManager;
+ FSchedules: TStringList;
+ // FNavigator: TJvTFNavigator;
+ // FOnNavigate: TJvTFNavEvent;
+ procedure SetManager(Value: TJvTFScheduleManager);
+ function GetSchedule(Index: Integer): TJvTFSched;
+ // procedure SetNavigator(Value: TJvTFNavigator);
+ protected
+ FDateFormat: string;
+ FTimeFormat: string;
+ FDragInfo: TJvTFDragInfo;
+ FShift: TShiftState;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetDateFormat(const Value: string); virtual;
+ procedure SetTimeFormat(const Value: string); virtual;
+ procedure Notify(Sender: TObject; Code: TJvTFServNotifyCode); virtual;
+ procedure ReqSchedNotification(Schedule: TJvTFSched); virtual;
+ procedure RelSchedNotification(Schedule: TJvTFSched); virtual;
+ procedure NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+ procedure CNRequestRefresh(var Msg: TCNRequestRefresh); message CN_REQUESTREFRESH;
+ procedure RefreshControl; dynamic;
+ property DateFormat: string read FDateFormat write SetDateFormat;
+ property TimeFormat: string read FTimeFormat write SetTimeFormat;
+ procedure DestroyApptNotification(anAppt: TJvTFAppt); virtual;
+ procedure DestroySchedNotification(ASched: TJvTFSched); virtual;
+ procedure DoStartDrag(var DragObject: TDragObject); override;
+ procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure Navigate(aControl: TJvTFControl; SchedNames: TStringList;
+ Dates: TJvTFDateList); virtual;
+ // property Navigator: TJvTFNavigator read FNavigator write SetNavigator;
+ // property OnNavigate: TJvTFNavEvent read FOnNavigate write FOnNavigate;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ function ScheduleCount: Integer;
+ property Schedules[Index: Integer]: TJvTFSched read GetSchedule;
+ function FindSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
+ function RetrieveSchedule(const SchedName: string; SchedDate: TDate): TJvTFSched;
+ procedure ReleaseSchedule(const SchedName: string; SchedDate: TDate); virtual;
+ procedure ReleaseSchedules;
+ property DragInfo: TJvTFDragInfo read FDragInfo;
+ procedure ProcessBatches;
+ published
+ property ScheduleManager: TJvTFScheduleManager read FScheduleManager write SetManager;
+ end;
+
+ EJvTFPrinterError = class(Exception);
+ TJvTFMargins = TRect;
+ TJvTFPrinterMeasure = (pmPixels, pmInches, pmMM);
+ TJvTFPrinterState = (spsNoDoc, spsCreating, spsAssembling, spsFinished);
+ TJvTFPrinterDrawEvent = procedure(Sender: TObject; aCanvas: TCanvas;
+ ARect: TRect; PageNum: Integer) of object;
+
+ TJvTFProgressEvent = procedure(Sender: TObject; Current, Total: Integer)
+ of object;
+
+ TJvTFPrinterPageLayout = class(TPersistent)
+ private
+ FFooterHeight: Integer;
+ FHeaderHeight: Integer;
+ FMargins: TJvTFMargins;
+ FPrinter: TJvTFPrinter;
+ procedure SetFooterHeight(Value: Integer);
+ procedure SetHeaderHeight(Value: Integer);
+ function GetMargin(Index: Integer): Integer;
+ procedure SetMargin(Index: Integer; Value: Integer);
+ protected
+ procedure Change; virtual;
+ property Printer: TJvTFPrinter read FPrinter;
+ procedure SetPropertyCheck;
+ public
+ constructor Create(aPrinter: TJvTFPrinter); virtual;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property FooterHeight: Integer read FFooterHeight write SetFooterHeight;
+ property HeaderHeight: Integer read FHeaderHeight write SetHeaderHeight;
+ property MarginLeft: Integer index 1 read GetMargin write SetMargin;
+ property MarginTop: Integer index 2 read GetMargin write SetMargin;
+ property MarginRight: Integer index 3 read GetMargin write SetMargin;
+ property MarginBottom: Integer index 4 read GetMargin write SetMargin;
+ end;
+
+ TJvTFPrinter = class(TJvTFComponent)
+ private
+ FPages: TStringList;
+ FBodies: TStringList;
+ FMarginOffsets: TJvTFMargins; // always in pixels
+ FMeasure: TJvTFPrinterMeasure;
+ FOnDrawBody: TJvTFPrinterDrawEvent;
+ FOnDrawHeader: TJvTFPrinterDrawEvent;
+ FOnDrawFooter: TJvTFPrinterDrawEvent;
+ FOnPrintProgress: TJvTFProgressEvent;
+ FOnAssembleProgress: TJvTFProgressEvent;
+ FOnMarginError: TNotifyEvent;
+ FTitle: string;
+ FDirectPrint: Boolean;
+ { wp --- to do
+ function GetPage(Index: Integer): TMetafile;
+ }
+ function GetBodyHeight: Integer; // always in pixels
+ function GetBodyWidth: Integer; // always in pixels
+ function GetBodyLeft: Integer; // always in pixels
+ function GetBodyTop: Integer; // always in pixels
+ function GetDocDateTime: TDateTime;
+ procedure SetPageLayout(Value: TJvTFPrinterPageLayout);
+ procedure SetDirectPrint(Value: Boolean);
+ protected
+ FPageLayout: TJvTFPrinterPageLayout;
+ FState: TJvTFPrinterState;
+ FDocDateTime: TDateTime;
+ FPageCount: Integer; // NOTE: SEE GetPageCount !!
+ FConvertingProps: Boolean;
+ FAborted: Boolean;
+ procedure SetMarginOffset(Index: Integer; Value: Integer); // always in pixels
+ function GetMarginOffset(Index: Integer): Integer; // always in pixels
+ function GetUnprintable: TJvTFMargins; // always in pixels
+ procedure MarginError; dynamic;
+ procedure InitializeMargins;
+ property BodyHeight: Integer read GetBodyHeight; // always in pixels
+ property BodyWidth: Integer read GetBodyWidth; // always in pixels
+ property BodyLeft: Integer read GetBodyLeft; // always in pixels
+ property BodyTop: Integer read GetBodyTop; // always in pixels
+ procedure DrawBody(aCanvas: TCanvas; ARect: TRect; PageNum: Integer); virtual;
+ procedure DrawHeader(aCanvas: TCanvas; ARect: TRect; PageNum: Integer); virtual;
+ procedure DrawFooter(aCanvas: TCanvas; ARect: TRect; PageNum: Integer); virtual;
+ procedure SetTitle(const Value: string); virtual;
+ function GetPageCount: Integer;
+ procedure SetMeasure(Value: TJvTFPrinterMeasure); virtual;
+ procedure CreateLayout; virtual;
+ procedure SetPropertyCheck; dynamic;
+
+ procedure GetHeaderFooterRects(var HeaderRect, FooterRect: TRect);
+
+ // document management methods
+ procedure CreateDoc; dynamic;
+ procedure NewPage; dynamic;
+ procedure FinishDoc; dynamic;
+ procedure NewDoc; dynamic;
+ property DirectPrint: Boolean read FDirectPrint write SetDirectPrint
+ default False;
+ public
+
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ property PageCount: Integer read GetPageCount;
+ { wp --- to do
+ property Pages[Index: Integer]: TMetafile read GetPage;
+ }
+ function ConvertMeasure(Value: Integer; FromMeasure,
+ ToMeasure: TJvTFPrinterMeasure; Horizontal: Boolean): Integer;
+ function ScreenToPrinter(Value: Integer; Horizontal: Boolean): Integer;
+ function PrinterToScreen(Value: Integer; Horizontal: Boolean): Integer;
+
+ property State: TJvTFPrinterState read FState;
+ procedure FreeDoc; dynamic;
+ procedure Print; dynamic;
+ procedure AbortPrint;
+ property DocDateTime: TDateTime read GetDocDateTime;
+ property ConvertingProps: Boolean read FConvertingProps;
+ procedure SaveDocToFiles(BaseFileName: TFileName);
+ property Aborted: Boolean read FAborted;
+ published
+ property PageLayout: TJvTFPrinterPageLayout read FPageLayout
+ write SetPageLayout;
+ property Measure: TJvTFPrinterMeasure read FMeasure write SetMeasure
+ default pmInches;
+ property OnDrawBody: TJvTFPrinterDrawEvent read FOnDrawBody
+ write FOnDrawBody;
+ property OnDrawHeader: TJvTFPrinterDrawEvent read FOnDrawHeader
+ write FOnDrawHeader;
+ property OnDrawFooter: TJvTFPrinterDrawEvent read FOnDrawFooter
+ write FOnDrawFooter;
+ property OnPrintProgress: TJvTFProgressEvent read FOnPrintProgress
+ write FOnPrintProgress;
+ property OnAssembleProgress: TJvTFProgressEvent read FOnAssembleProgress
+ write FOnAssembleProgress;
+ property OnMarginError: TNotifyEvent read FOnMarginError
+ write FOnMarginError;
+ property Title: string read FTitle write SetTitle;
+ end;
+
+ {$IFDEF RTL230_UP}
+ [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+ {$ENDIF RTL230_UP}
+ TJvTFUniversalPrinter = class(TJvTFPrinter)
+ public
+ procedure NewDoc; override;
+ procedure CreateDoc; override;
+ procedure NewPage; override;
+ procedure FinishDoc; override;
+ published
+ property DirectPrint;
+ end;
+
+ TJvTFDWNameSource = (dwnsSysLong, dwnsSysShort, dwnsCustom);
+
+ TJvTFDrawDWTitleEvent = procedure(Sender: TObject; aCanvas: TCanvas;
+ ARect: TRect; DOW: TTFDayOfWeek; DWName: string) of object;
+
+ TJvTFDWNames = class(TPersistent)
+ private
+ FSource: TJvTFDWNameSource;
+ FDWN_Sunday: string;
+ FDWN_Monday: string;
+ FDWN_Tuesday: string;
+ FDWN_Wednesday: string;
+ FDWN_Thursday: string;
+ FDWN_Friday: string;
+ FDWN_Saturday: string;
+ FOnChange: TNotifyEvent;
+ procedure SetDWN(Index: Integer; const Value: string);
+ function GetDWN(Index: Integer): string;
+ procedure SetSource(Value: TJvTFDWNameSource);
+ protected
+ procedure Change; virtual;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ function GetDWName(DWIndex: Integer): string;
+ published
+ property Source: TJvTFDWNameSource read FSource write SetSource default dwnsSysShort;
+ property DWN_Sunday: string index 1 read GetDWN write SetDWN;
+ property DWN_Monday: string index 2 read GetDWN write SetDWN;
+ property DWN_Tuesday: string index 3 read GetDWN write SetDWN;
+ property DWN_Wednesday: string index 4 read GetDWN write SetDWN;
+ property DWN_Thursday: string index 5 read GetDWN write SetDWN;
+ property DWN_Friday: string index 6 read GetDWN write SetDWN;
+ property DWN_Saturday: string index 7 read GetDWN write SetDWN;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ end;
+
+ // TJvTFNavigator = class(TComponent)
+ // private
+ // FBeforeNavigate: TJvTFNavEvent;
+ // FAfterNavigate: TJvTFNavEvent;
+ // FControls: TStringList;
+ // function GetControl(Index: Integer): TJvTFControl;
+ // protected
+ // FNavigating: Boolean;
+ // procedure RegisterControl(aControl: TJvTFControl);
+ // procedure UnregisterControl(aControl: TJvTFControl);
+ // public
+ // constructor Create(AOwner: TComponent); override;
+ // destructor Destroy; override;
+ //
+ // function ControlCount: Integer;
+ // property Controls[Index: Integer]: TJvTFControl read GetControl;
+ //
+ // procedure Navigate(aControl: TJvTFControl; SchedNames: TStringList;
+ // Dates: TJvTFDateList); virtual;
+ // property Navigating: Boolean read FNavigating;
+ // published
+ // property BeforeNavigate: TJvTFNavEvent read FBeforeNavigate
+ // write FBeforeNavigate;
+ // property AfterNavigate: TJvTFNavEvent read FAfterNavigate
+ // write FAfterNavigate;
+ // end;
+
+
+implementation
+
+uses
+ Dialogs,
+ JvResources, JvJVCLUtils; //, JclSysUtils;
+
+function AdjustEndTime(ATime: TTime): TTime;
+begin
+ Result := Frac(Frac(ATime) - Frac(EncodeTime(0, 0, 1, 0)));
+end;
+
+function CenterRect(Rect1, Rect2: TRect): TRect;
+var
+ Rect1Width, Rect1Height, Rect2Width, Rect2Height: Integer;
+begin
+ Rect1Width := Rect1.Right - Rect1.Left - 1;
+ Rect1Height := Rect1.Bottom - Rect1.Top - 1;
+ Rect2Width := Rect2.Right - Rect2.Left - 1;
+ Rect2Height := Rect2.Bottom - Rect2.Top - 1;
+
+ Result.Left := Rect1.Left + ((Rect1Width - Rect2Width) div 2) - 1;
+ Result.Top := Rect1.Top + ((Rect1Height - Rect2Height) div 2) - 1;
+ Result.Right := Result.Left + Rect2Width;
+ Result.Bottom := Result.Top + Rect2Height;
+end;
+
+function MoveRect(ARect: TRect; NewLeft, NewTop: Integer): TRect;
+begin
+ Result := ARect;
+ OffsetRect(Result, NewLeft - ARect.Left, NewTop - ARect.Top);
+end;
+
+function StripCRLF(const S: string): string;
+var
+ I: Integer;
+begin
+ Result := '';
+ for I := 1 to Length(S) do
+ if (S[I] <> #13) and (S[I] <> #10) then
+ Result := Result + S[I];
+end;
+
+//=== { TJvTFCustomImageMap } ================================================
+
+constructor TJvTFCustomImageMap.Create(anAppt: TJvTFAppt);
+begin
+ if not Assigned(anAppt) then
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotCreateCustomImageMap);
+
+ inherited Create;
+ FAppt := anAppt;
+ FMap := TStringList.Create;
+end;
+
+destructor TJvTFCustomImageMap.Destroy;
+begin
+ FMap.Free;
+ inherited Destroy;
+end;
+
+function TJvTFCustomImageMap.GetImage(MapIndex: Integer): Integer;
+begin
+ Result := Integer(FMap.Objects[MapIndex]);
+end;
+
+procedure TJvTFCustomImageMap.SetImage(MapIndex, Value: Integer);
+begin
+ FMap.Objects[MapIndex] := TObject(Value);
+end;
+
+function TJvTFCustomImageMap.GetImageName(MapIndex: Integer): string;
+begin
+ Result := FMap[MapIndex];
+end;
+
+procedure TJvTFCustomImageMap.Change;
+begin
+ if Assigned(FAppt.ScheduleManager) then
+ begin
+ FAppt.ScheduleManager.RefreshConnections(FAppt);
+ // implicit post fix
+ FAppt.Change;
+ end;
+end;
+
+function TJvTFCustomImageMap.Count: Integer;
+begin
+ Result := FMap.Count;
+end;
+
+procedure TJvTFCustomImageMap.Add(const ImageName: string; ImageIndex: Integer);
+begin
+ if FMap.IndexOf(ImageName) = -1 then
+ begin
+ FMap.AddObject(ImageName, TObject(ImageIndex));
+ Change;
+ end;
+end;
+
+procedure TJvTFCustomImageMap.Delete(MapIndex: Integer);
+begin
+ FMap.Delete(MapIndex);
+ Change;
+end;
+
+procedure TJvTFCustomImageMap.Move(SrcMapIndex, DestMapIndex: Integer);
+begin
+ FMap.Move(SrcMapIndex, DestMapIndex);
+end;
+
+function TJvTFCustomImageMap.FindMapIndex(const ImageName: string): Integer;
+begin
+ Result := FMap.IndexOf(ImageName);
+end;
+
+function TJvTFCustomImageMap.FindImageIndex(const ImageName: string): Integer;
+begin
+ Result := FindMapIndex(ImageName);
+ if Result > -1 then
+ Result := GetImage(Result);
+end;
+
+procedure TJvTFCustomImageMap.Clear;
+begin
+ while FMap.Count > 0 do
+ FMap.Delete(0);
+ Change;
+end;
+
+procedure TJvTFCustomImageMap.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TJvTFCustomImageMap then
+ begin
+ while FMap.Count > 0 do
+ FMap.Delete(0);
+
+ for I := 0 to TJvTFCustomImageMap(Source).Count - 1 do
+ Add(TJvTFCustomImageMap(Source).ImageNames[I],
+ TJvTFCustomImageMap(Source).Images[I]);
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFStateImageMap } =================================================
+
+constructor TJvTFStateImageMap.Create(Serv: TJvTFScheduleManager);
+var
+ I: TJvTFStatePic;
+begin
+ inherited Create;
+
+ for I := Low(TJvTFStatePic) to High(TJvTFStatePic) do
+ FPics[I] := -1;
+
+ FUpdating := False;
+end;
+
+procedure TJvTFStateImageMap.SetImage(StatePicID: TJvTFStatePic; Value: Integer);
+begin
+ if Value < -1 then
+ Value := -1;
+ if FPics[StatePicID] <> Value then
+ begin
+ FPics[StatePicID] := Value;
+ Change;
+ end;
+end;
+
+function TJvTFStateImageMap.GetImage(StatePicID: TJvTFStatePic): Integer;
+begin
+ Result := FPics[StatePicID];
+end;
+
+function TJvTFStateImageMap.GetAlarmDisabled: Integer;
+begin
+ Result := GetImage(spAlarmDisabled);
+end;
+
+function TJvTFStateImageMap.GetAlarmEnabled: Integer;
+begin
+ Result := GetImage(spAlarmEnabled);
+end;
+
+function TJvTFStateImageMap.GetModified: Integer;
+begin
+ Result := GetImage(spModified);
+end;
+
+function TJvTFStateImageMap.GetRecurring: Integer;
+begin
+ Result := GetImage(spRecurring);
+end;
+
+function TJvTFStateImageMap.GetShared: Integer;
+begin
+ Result := GetImage(spShared);
+end;
+
+procedure TJvTFStateImageMap.SetAlarmDisabled(const Value: Integer);
+begin
+ SetImage(spAlarmDisabled, Value);
+end;
+
+procedure TJvTFStateImageMap.SetAlarmEnabled(const Value: Integer);
+begin
+ SetImage(spAlarmEnabled, Value);
+end;
+
+procedure TJvTFStateImageMap.SetModified(const Value: Integer);
+begin
+ SetImage(spModified, Value);
+end;
+
+procedure TJvTFStateImageMap.SetRecurring(const Value: Integer);
+begin
+ SetImage(spRecurring, Value);
+end;
+
+procedure TJvTFStateImageMap.SetShared(const Value: Integer);
+begin
+ SetImage(spShared, Value);
+end;
+
+procedure TJvTFStateImageMap.Change;
+begin
+ if Assigned(FScheduleManager) and not (csLoading in FScheduleManager.ComponentState) and
+ not (csDesigning in FScheduleManager.ComponentState) and not FUpdating then
+ FScheduleManager.RefreshConnections(nil);
+end;
+
+procedure TJvTFStateImageMap.BeginUpdate;
+begin
+ FUpdating := True;
+end;
+
+procedure TJvTFStateImageMap.EndUpdate;
+begin
+ if FUpdating then
+ begin
+ FUpdating := False;
+ Change;
+ end;
+end;
+
+procedure TJvTFStateImageMap.Clear;
+var
+ I: TJvTFStatePic;
+begin
+ for I := Low(TJvTFStatePic) to High(TJvTFStatePic) do
+ FPics[I] := -1;
+ Change;
+end;
+
+procedure TJvTFStateImageMap.Assign(Source: TPersistent);
+var
+ Pic: TJvTFStatePic;
+begin
+ if Source is TJvTFStateImageMap then
+ begin
+ for Pic := Low(TJvTFStatePic) to High(TJvTFStatePic) do
+ FPics[Pic] := TJvTFStateImageMap(Source).Pics[Pic];
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFAppt } ==========================================================
+
+constructor TJvTFAppt.Create(Serv: TJvTFScheduleManager; const ApptID: string);
+begin
+ if not Assigned(Serv) then
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotCreateAppointmentObject);
+
+ inherited Create;
+
+ FGlyph := TPicture.Create;
+
+ FSchedules := TStringList.Create;
+ FConnections := TStringList.Create;
+
+ FStartDate := Date;
+ FStartTime := Time;
+ FEndDate := Date;
+ FEndTime := FStartTime + EncodeTime(0, 1, 0, 0);
+ FScheduleManager := Serv;
+ FDestroying := False;
+
+ if ApptID <> '' then
+ FID := ApptID
+ else
+ FID := FScheduleManager.GenerateApptID;
+
+ FModified := False;
+ FColor := clDefault;
+ FBarColor := clDefault;
+
+ FImageMap := TJvTFCustomImageMap.Create(Self);
+
+ ScheduleManager.Notify(Self, sncLoadAppt);
+
+ Serv.DoCreateApptEvent(Self);
+end;
+
+destructor TJvTFAppt.Destroy;
+begin
+ FDestroying := True;
+ if Assigned(ScheduleManager) then
+ ScheduleManager.DoDestroyApptEvent(Self);
+
+ ScheduleManager.Notify(Self, sncDestroyAppt);
+
+ FSchedules.Free;
+ FConnections.Free;
+ FImageMap.Free;
+
+ FGlyph.Free;
+
+ inherited Destroy;
+end;
+
+function TJvTFAppt.GetDescription: string;
+begin
+ Result := FDescription;
+ ScheduleManager.GetApptDescription(Self, Result);
+end;
+
+procedure TJvTFAppt.SetDescription(Value: string);
+begin
+ ScheduleManager.SetApptDescription(Self, Value);
+ if Value <> FDescription then
+ begin
+ FDescription := Value;
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ Change;
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.SetAlarmEnabled(Value: Boolean);
+begin
+ if Value <> FAlarmEnabled then
+ begin
+ FAlarmEnabled := Value;
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ Change;
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.SetAlarmAdvance(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+
+ if Value <> FAlarmAdvance then
+ begin
+ FAlarmAdvance := Value;
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ Change;
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.SetColor(Value: TColor);
+begin
+ if Value <> FColor then
+ begin
+ FColor := Value;
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ Change;
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.SetBarColor(Value: TColor);
+begin
+ if Value <> FBarColor then
+ begin
+ FBarColor := Value;
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ Change;
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ case Code of
+ sncConnectAppt:
+ Connect(TJvTFSched(Sender));
+ sncDisconnectAppt:
+ Disconnect(TJvTFSched(Sender));
+ // implicit post fix
+ //sncPostAppt: FModified := False;
+ sncPostAppt:
+ PostApptNotification;
+ sncDeleteAppt:
+ InternalClearSchedules;
+ sncRefresh:
+ FModified := False;
+ end;
+end;
+
+procedure TJvTFAppt.NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Serv) then
+ Serv.Notify(Sender, Code)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
+end;
+
+procedure TJvTFAppt.NotifySchedule(Sched: TJvTFSched; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Sched) then
+ Sched.Notify(Sender, Code)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleNotificationFailed);
+end;
+
+function TJvTFAppt.GetConnection(Index: Integer): TJvTFSched;
+begin
+ Result := TJvTFSched(FConnections.Objects[Index]);
+end;
+
+function TJvTFAppt.GetSchedule(Index: Integer): string;
+begin
+ Result := FSchedules[Index];
+end;
+
+procedure TJvTFAppt.CheckConnections;
+var
+ Schedule: TJvTFSched;
+ I: Integer;
+ ADate: TDate;
+ Temp: TStringList;
+begin
+ // Schedules --> Connections
+ for I := 0 to ScheduleCount - 1 do
+ begin
+ ADate := StartDate;
+ while Trunc(ADate) <= Trunc(EndDate) do
+ begin
+ Schedule := ScheduleManager.FindSchedule(Schedules[I], ADate);
+ if Assigned(Schedule) and (FConnections.IndexOfObject(Schedule) = -1) then
+ Connect(Schedule);
+
+ ADate := ADate + 1;
+ end;
+ end;
+
+ // Connections --> Schedules
+ Temp := TStringList.Create;
+ try
+ Temp.Assign(FConnections);
+ for I := 0 to Temp.Count - 1 do
+ begin
+ Schedule := TJvTFSched(Temp.Objects[I]);
+ if (FSchedules.IndexOf(Schedule.SchedName) = -1) or
+ ((Trunc(Schedule.SchedDate) < Trunc(StartDate)) or
+ (Trunc(Schedule.SchedDate) > Trunc(EndDate))) then
+ Disconnect(Schedule);
+ end;
+ finally
+ Temp.Free;
+ end;
+
+ { implicit post fix
+ If not FDeleting and not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing Then
+ // To avoid display anomolies we need to post the appt here.
+ Post;
+ }
+end;
+
+procedure TJvTFAppt.Connect(Schedule: TJvTFSched);
+var
+ SchedID: string;
+ I: Integer;
+begin
+ if Assigned(Schedule) then
+ begin
+ Schedule.Notify(Self, sncConnectAppt);
+
+ SchedID := ScheduleManager.GetScheduleID(Schedule.SchedName, Schedule.SchedDate);
+ I := FConnections.IndexOf(SchedID);
+ if I = -1 then
+ begin
+ FConnections.AddObject(SchedID, Schedule);
+ ScheduleManager.RefreshConnections(Schedule);
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.Disconnect(Schedule: TJvTFSched);
+var
+ I: Integer;
+begin
+ if Assigned(Schedule) then
+ begin
+ Schedule.Notify(Self, sncDisconnectAppt);
+
+ I := FConnections.IndexOfObject(Schedule);
+ if I > -1 then
+ begin
+ FConnections.Delete(I);
+ ScheduleManager.RefreshConnections(Schedule);
+ end;
+ end;
+end;
+
+procedure TJvTFAppt.Change;
+begin
+ // implicit post fix
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing and not Updating then
+ Post;
+ ScheduleManager.RefreshConnections(Self);
+end;
+
+procedure TJvTFAppt.InternalClearSchedules;
+begin
+ FSchedules.Clear;
+ CheckConnections;
+end;
+
+procedure TJvTFAppt.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TJvTFAppt then
+ begin
+ for I := 0 to TJvTFAppt(Source).ScheduleCount - 1 do
+ AddSchedule(TJvTFAppt(Source).Schedules[I]);
+ ImageMap.Assign(TJvTFAppt(Source).ImageMap);
+ SetStartEnd(TJvTFAppt(Source).StartDate, TJvTFAppt(Source).StartTime,
+ TJvTFAppt(Source).EndDate, TJvTFAppt(Source).EndTime);
+ Description := TJvTFAppt(Source).Description;
+ AlarmEnabled := TJvTFAppt(Source).AlarmEnabled;
+ AlarmAdvance := TJvTFAppt(Source).AlarmAdvance;
+ Data := TJvTFAppt(Source).Data;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFAppt.SetStartEnd(NewStartDate: TDate; NewStartTime: TTime;
+ NewEndDate: TDate; NewEndTime: TTime);
+begin
+ // The following avoids time overflow into next day when it is not
+ // intended. (Add appt to last row of days would cause invalid
+ // start/end exception.)
+ if Frac(NewEndTime) <= EncodeTime(0, 0, 0, 999) then
+ NewEndTime := EncodeTime(23, 59, 59, 0);
+
+ if Trunc(NewStartDate) <= Trunc(NewEndDate) then
+ begin
+ if Trunc(NewStartDate) = Trunc(NewEndDate) then
+ if Frac(NewStartTime) >= Frac(NewEndTime) then
+ raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidStartAndEndTimes);
+
+ FStartDate := NewStartDate;
+ FEndDate := NewEndDate;
+ FStartTime := NewStartTime;
+ FEndTime := NewEndTime;
+
+ CheckConnections;
+
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ Change;
+ end
+ end
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidStartAndEndDates);
+end;
+
+procedure TJvTFAppt.SetModified;
+begin
+ FModified := True;
+ // implicit post fix
+ Change;
+end;
+
+function TJvTFAppt.Modified: Boolean;
+begin
+ Result := FModified;
+end;
+
+function TJvTFAppt.ConnectionCount: Integer;
+begin
+ Result := FConnections.Count;
+end;
+
+function TJvTFAppt.ScheduleCount: Integer;
+begin
+ Result := FSchedules.Count;
+end;
+
+procedure TJvTFAppt.AddSchedule(const SchedName: string);
+var
+ ADate: TDate;
+ Schedule: TJvTFSched;
+begin
+ if SchedName = '' then
+ Exit;
+
+ // Add it to the schedules list
+ if FSchedules.IndexOf(SchedName) = -1 then
+ begin
+ FSchedules.Add(SchedName);
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ // implicit post fix
+ Change;
+ end;
+ end;
+
+ // Check for needed connections
+ // (Only connects to currently loaded schedules. Will not load a schedule.)
+ ADate := StartDate;
+ while Trunc(ADate) <= Trunc(EndDate) do
+ begin
+ Schedule := ScheduleManager.FindSchedule(SchedName, ADate);
+ if Assigned(Schedule) then
+ Connect(Schedule);
+ ADate := ADate + 1;
+ end;
+
+ { implicit post fix
+ // To avoid display anomolies we need to post the appt here.
+ If not FDeleting and not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing Then
+ Post;
+ }
+end;
+
+procedure TJvTFAppt.RemoveSchedule(const SchedName: string);
+var
+ I: Integer;
+ ADate: TDate;
+ Schedule: TJvTFSched;
+begin
+ if SchedName = '' then
+ Exit;
+
+ // Remove it from the schedule list
+ I := FSchedules.IndexOf(SchedName);
+ if I > -1 then
+ begin
+ FSchedules.Delete(I);
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ // implicit post fix
+ Change;
+ end;
+ end;
+
+ // Check for invalid connections and disconnect
+ ADate := StartDate;
+ while Trunc(ADate) <= Trunc(EndDate) do
+ begin
+ Schedule := ScheduleManager.FindSchedule(SchedName, ADate);
+ if Assigned(Schedule) then
+ Disconnect(Schedule);
+
+ ADate := ADate + 1;
+ end;
+
+ { implicit post fix
+ // To avoid display anomolies we need to post the appt here.
+ If not FDeleting and not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing Then
+ Post;
+ }
+end;
+
+procedure TJvTFAppt.AssignSchedules(List: TStrings);
+begin
+ FSchedules.Assign(List);
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ // implicit post fix
+ Change;
+ end;
+
+ CheckConnections;
+end;
+
+procedure TJvTFAppt.ClearSchedules;
+begin
+ FSchedules.Clear;
+
+ if not ScheduleManager.LoadingAppts and not ScheduleManager.Refreshing then
+ begin
+ FModified := True;
+ // implicit post fix
+ Change;
+ end;
+
+ CheckConnections;
+end;
+
+function TJvTFAppt.IndexOfSchedule(const SchedName: string): Integer;
+begin
+ Result := FSchedules.IndexOf(SchedName);
+end;
+
+function TJvTFAppt.Shared: Boolean;
+begin
+ Result := ScheduleCount > 1;
+end;
+
+procedure TJvTFAppt.Post;
+begin
+ ScheduleManager.dbPostAppt(Self);
+end;
+
+procedure TJvTFAppt.Refresh;
+begin
+ ScheduleManager.dbRefreshAppt(Self);
+end;
+
+procedure TJvTFAppt.Delete;
+begin
+ ScheduleManager.dbDeleteAppt(Self);
+end;
+
+procedure TJvTFAppt.RefreshControls;
+begin
+ ScheduleManager.RefreshConnections(Self);
+end;
+
+function TJvTFAppt.GetEndDateTime: TDateTime;
+begin
+ Result := Trunc(EndDate) + Frac(EndTime);
+end;
+
+function TJvTFAppt.GetStartDateTime: TDateTime;
+begin
+ Result := Trunc(StartDate) + Frac(StartTime);
+end;
+
+function TJvTFAppt.GetEndDate: TDate;
+begin
+ Result := Int(FEndDate);
+end;
+
+function TJvTFAppt.GetEndTime: TTime;
+begin
+ Result := Frac(FEndTime);
+end;
+
+function TJvTFAppt.GetStartDate: TDate;
+begin
+ Result := Int(FStartDate);
+end;
+
+function TJvTFAppt.GetStartTime: TTime;
+begin
+ Result := Frac(FStartTime);
+end;
+
+procedure TJvTFAppt.DeleteApptNotification;
+begin
+ FDeleting := True;
+ try
+ InternalClearSchedules;
+ finally
+ FDeleting := False;
+ end;
+end;
+
+procedure TJvTFAppt.PostApptNotification;
+begin
+ FModified := False;
+ FUpdating := False;
+end;
+
+procedure TJvTFAppt.BeginUpdate;
+begin
+ FUpdating := True;
+end;
+
+procedure TJvTFAppt.EndUpdate;
+begin
+ if FUpdating then
+ begin
+ FUpdating := False;
+ Change;
+ end;
+end;
+
+procedure TJvTFAppt.SetRefreshed(Value: Boolean);
+begin
+ FRefreshed := Value;
+end;
+
+procedure TJvTFAppt.SetGlyph(const Value: TPicture);
+begin
+ FGlyph.Assign(Value);
+end;
+
+procedure TJvTFAppt.RefreshNotification;
+begin
+ FModified := False;
+ Refreshed := False;
+end;
+
+//=== { TJvTFSched } =========================================================
+
+constructor TJvTFSched.Create(Serv: TJvTFScheduleManager; const AName: string;
+ ADate: TDate);
+begin
+ inherited Create;
+
+ FScheduleManager := Serv;
+ FSchedName := AName;
+ FSchedDate := ADate;
+
+ FAppts := TStringList.Create;
+ FConControls := TStringList.Create;
+ FConControls.OnChange := @ConnectionsOnChange;
+ FConComponents := TStringList.Create;
+ FConComponents.OnChange := @ConnectionsOnChange;
+
+ if Assigned(Serv) then
+ Serv.DoCreateScheduleEvent(Self);
+end;
+
+destructor TJvTFSched.Destroy;
+var
+ Ctrl: TJvTFControl;
+ Comp: TJvTFComponent;
+ Appt: TJvTFAppt;
+begin
+ FDestroying := True;
+
+ if Assigned(ScheduleManager) then
+ ScheduleManager.DoDestroyScheduleEvent(Self);
+
+ while ConControlCount > 0 do
+ begin
+ Ctrl := TJvTFControl(FConControls.Objects[0]);
+ ScheduleManager.ReleaseSchedule(Ctrl, SchedName, SchedDate);
+ end;
+
+ while ConComponentCount > 0 do
+ begin
+ Comp := TJvTFComponent(FConComponents.Objects[0]);
+ ScheduleManager.ReleaseSchedule(Comp, SchedName, SchedDate);
+ end;
+
+ while ApptCount > 0 do
+ begin
+ Appt := Appts[0];
+ Appt.Notify(Self, sncDisconnectAppt);
+ end;
+
+ ScheduleManager.Notify(Self, sncDestroySchedule);
+
+ FAppts.Free;
+ FConControls.Free;
+ FConComponents.Free;
+
+ inherited Destroy;
+end;
+
+function TJvTFSched.GetAppt(Index: Integer): TJvTFAppt;
+begin
+ Result := TJvTFAppt(FAppts.Objects[Index]);
+end;
+
+procedure TJvTFSched.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+var
+ I: Integer;
+ ConList: TStringList;
+begin
+ if Sender is TJvTFControl then
+ ConList := FConControls
+ else
+ if Sender is TJvTFComponent then
+ ConList := FConComponents
+ else
+ ConList := nil;
+
+ case Code of
+ sncRequestSchedule:
+ if ConList.IndexOfObject(Sender) = -1 then
+ ConList.AddObject('', Sender);
+ sncReleaseSchedule:
+ begin
+ I := ConList.IndexOfObject(Sender);
+ if I > -1 then
+ ConList.Delete(I);
+ end;
+ sncConnectAppt:
+ ConnectAppt(TJvTFAppt(Sender));
+ sncDisconnectAppt:
+ DisconnectAppt(TJvTFAppt(Sender));
+ end;
+end;
+
+procedure TJvTFSched.NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Serv) then
+ Serv.Notify(Sender, Code)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
+end;
+
+procedure TJvTFSched.NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Appt) then
+ Appt.Notify(Sender, Code)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEAppointmentNotificationFailed);
+end;
+
+function TJvTFSched.GetConControl(Index: Integer): TJvTFControl;
+begin
+ Result := TJvTFControl(FConControls.Objects[Index]);
+end;
+
+function TJvTFSched.GetConComponent(Index: Integer): TJvTFComponent;
+begin
+ Result := TJvTFComponent(FConComponents.Objects[Index]);
+end;
+
+procedure TJvTFSched.ConnectAppt(Appt: TJvTFAppt);
+begin
+ if FAppts.IndexOf(Appt.ID) = -1 then
+ FAppts.AddObject(Appt.ID, Appt);
+end;
+
+procedure TJvTFSched.DisconnectAppt(Appt: TJvTFAppt);
+var
+ I: Integer;
+begin
+ I := FAppts.IndexOf(Appt.ID);
+ if I > -1 then
+ FAppts.Delete(I);
+end;
+
+procedure TJvTFSched.ConnectionsOnChange(Sender: TObject);
+begin
+ if (FConControls.Count = 0) and (FConComponents.Count = 0) then
+ begin
+ FCached := True;
+ FCachedTime := GetTickCount64; //Windows.GetTickCount;
+ end
+ else
+ FCached := False;
+end;
+
+procedure TJvTFSched.CheckConnections;
+var
+ I: Integer;
+ Appt: TJvTFAppt;
+ DateHit, NameMatch, NotConnected: Boolean;
+begin
+ // Check each appt in the ScheduleManager to see if that appt should be connected
+ // to this schedule. If so, then connect it.
+ for I := 0 to ScheduleManager.ApptCount - 1 do
+ begin
+ Appt := ScheduleManager.Appts[I];
+ DateHit := (Trunc(SchedDate) >= Trunc(Appt.StartDate)) and
+ (Trunc(SchedDate) <= Trunc(Appt.EndDate));
+ NameMatch := Appt.IndexOfSchedule(SchedName) > -1;
+ NotConnected := ApptByID(Appt.ID) = nil;
+ if DateHit and NameMatch and NotConnected then
+ Appt.Notify(Self, sncConnectAppt);
+ end;
+end;
+
+function TJvTFSched.GetFreeUsedTime(FreeTime: Boolean): TDynTimeRangeArray;
+var
+ // 60 mins X 24 hrs = 1440 ==> minutes in a day
+ DayArray: array [0..1439] of Boolean; // I'm a poet and don't know it.
+ I, J, MinStart, MinEnd: Integer;
+ anAppt: TJvTFAppt;
+ StartTime, EndTime: TTime;
+ Switch, MinIsFree, InRange: Boolean;
+
+ function TimeToMinNum(ATime: TTime): Integer;
+ var
+ H, M, S, MS: Word;
+ begin
+ DecodeTime(ATime, H, M, S, MS);
+ Result := H * 60 + M;
+ end;
+
+ function MinNumToTime(MinNum: Integer): TTime;
+ begin
+ Result := EncodeTime(MinNum div 60, MinNum mod 60, 0, 0);
+ end;
+
+ procedure StartRange;
+ begin
+ StartTime := MinNumToTime(I);
+ InRange := True;
+ end;
+
+ procedure EndRange;
+ begin
+ EndTime := MinNumToTime(I);
+
+ // add range to resultant array
+ SetLength(Result, Length(Result) + 1);
+ Result[High(Result)].StartTime := StartTime;
+ Result[High(Result)].EndTime := EndTime;
+
+ InRange := False;
+ end;
+
+begin
+ // Initialize resultant array
+ SetLength(Result, 1);
+ Result[0].StartTime := 0.0;
+ Result[0].EndTime := EncodeTime(23, 59, 59, 0);
+
+ // EXIT if nothing to do
+ if ApptCount = 0 then
+ begin
+ if not FreeTime then
+ SetLength(Result, 0);
+ Exit;
+ end;
+
+ // Initialize working array
+ // True ==> free minute
+ // False ==> used minute
+ for I := 0 to 1439 do
+ DayArray[I] := True;
+
+ // Go through the appts and mark used minutes in the working array
+ for I := 0 to ApptCount - 1 do
+ begin
+ anAppt := Appts[I];
+ MinStart := TimeToMinNum(anAppt.StartTime);
+ MinEnd := TimeToMinNum(AdjustEndTime(anAppt.EndTime));
+
+ for J := MinStart to MinEnd do
+ DayArray[J] := False;
+ end;
+
+ // Now convert working array to resultant array
+ SetLength(Result, 0);
+ MinIsFree := not FreeTime;
+ for I := 0 to 1439 do
+ begin
+ Switch := DayArray[I] xor MinIsFree;
+ MinIsFree := DayArray[I];
+ if Switch then
+ if MinIsFree then
+ if FreeTime then
+ StartRange
+ else
+ EndRange
+ else
+ if FreeTime then
+ EndRange
+ else
+ StartRange
+ end;
+
+ // close and add the last range if needed
+ if InRange then
+ begin
+ I := 1439; // set I to last min of day
+ EndRange;
+ end;
+end;
+
+function TJvTFSched.ApptCount: Integer;
+begin
+ Result := FAppts.Count;
+end;
+
+function TJvTFSched.ApptByID(const ID: string): TJvTFAppt;
+var
+ I: Integer;
+begin
+ Result := nil;
+ I := FAppts.IndexOf(ID);
+ if I > -1 then
+ Result := TJvTFAppt(FAppts.Objects[I]);
+end;
+
+function TJvTFSched.ConControlCount: Integer;
+begin
+ Result := FConControls.Count;
+end;
+
+function TJvTFSched.ConComponentCount: Integer;
+begin
+ Result := FConComponents.Count;
+end;
+
+procedure TJvTFSched.AddAppt(Appt: TJvTFAppt);
+begin
+ if Assigned(Appt) then
+ Appt.AddSchedule(SchedName);
+end;
+
+procedure TJvTFSched.RemoveAppt(Appt: TJvTFAppt);
+begin
+ if Assigned(Appt) then
+ Appt.RemoveSchedule(SchedName);
+end;
+{
+procedure TJvTFSched.RefreshAppts;
+Var
+ I,
+ J,
+ K: Integer;
+ ApptIDList,
+ RefList: TStringList;
+ Appt: TJvTFAppt;
+ Sched: TJvTFSched;
+ RefID: string;
+begin
+ // In a multi-user environment, appt objects may be deleted as a result
+ // of calling dbRefreshAppt. (Component user may call Appt.Free.)
+ // To account for this we need to build a list of appt ID's instead of
+ // working directly from the ScheduleManager's appointment list.
+ // We also need to build a list of connections (Components and
+ // TJvTFControls) that need to be refreshed.
+
+ ApptIDList := TStringList.Create;
+ RefList := TStringList.Create;
+ RefList.Duplicates := dupIgnore;
+ Try
+ For I := 0 to ApptCount - 1 do
+ Begin
+ Appt := Appts[I];
+ ApptIDList.Add(Appt.ID);
+ For J := 0 to Appt.ConnectionCount - 1 do
+ Begin
+ Sched := Appt.Connections[J];
+ For K := 0 to Sched.ConComponentCount - 1 do
+ Begin
+ RefID := IntToStr(Integer(Sched.ConComponents[K]));
+ RefList.AddObject(RefID, Sched.ConComponents[K]);
+ End;
+ For K := 0 to Sched.ConControlCount - 1 do
+ Begin
+ RefID := IntToStr(Integer(Sched.ConControls[K]));
+ RefList.AddObject(RefID, Sched.ConControls[K]);
+ End;
+ End;
+ End;
+
+ For I := 0 to ApptIDList.Count - 1 do
+ Begin
+ Appt := ScheduleManager.FindAppt(ApptIDList[I]);
+ If Assigned(Appt) Then
+ ScheduleManager.dbRefreshAppt(Appt);
+ End;
+
+ For I := 0 to RefList.Count - 1 do
+ ScheduleManager.RefreshConnections(RefList.Objects[I]);
+ Finally
+ ApptIDList.Free;
+ RefList.Free;
+ End;
+end;
+}
+
+procedure TJvTFSched.PostAppts;
+var
+ I: Integer;
+begin
+ for I := 0 to ApptCount - 1 do
+ ScheduleManager.dbPostAppt(Appts[I]);
+end;
+
+function TJvTFSched.GetFreeTime: TDynTimeRangeArray;
+begin
+ Result := GetFreeUsedTime(True);
+end;
+
+function TJvTFSched.GetUsedTime: TDynTimeRangeArray;
+begin
+ Result := GetFreeUsedTime(False);
+end;
+
+function TJvTFSched.TimeIsFree(TimeRange: TJvTFTimeRange): Boolean;
+var
+ Appt: TJvTFAppt;
+ I: Integer;
+begin
+ Result := True;
+ I := 0;
+
+ while (I < ApptCount) and Result do
+ begin
+ Appt := Appts[I];
+ if (Frac(Appt.StartTime) <= Frac(AdjustEndTime(TimeRange.EndTime))) and
+ (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(TimeRange.StartTime)) then
+ Result := False
+ else
+ Inc(I);
+ end;
+end;
+
+function TJvTFSched.TimeIsFree(RangeStart, RangeEnd: TTime): Boolean;
+var
+ TimeRange: TJvTFTimeRange;
+begin
+ TimeRange.StartTime := RangeStart;
+ TimeRange.EndTime := RangeEnd;
+ Result := TimeIsFree(TimeRange);
+end;
+
+function TJvTFSched.ApptHasConflicts(anAppt: TJvTFAppt): Boolean;
+var
+ Appt: TJvTFAppt;
+ I: Integer;
+begin
+ Result := False;
+ I := 0;
+
+ while (I < ApptCount) and not Result do
+ begin
+ Appt := Appts[I];
+ if (Appt <> anAppt) and // Don't flag for the given appt
+ (Frac(Appt.StartTime) <= Frac(AdjustEndTime(anAppt.EndTime))) and
+ (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(anAppt.StartTime)) then
+ Result := True
+ else
+ Inc(I);
+ end;
+end;
+
+function TJvTFSched.EnumConflicts(TimeRange: TJvTFTimeRange): TDynApptArray;
+var
+ Appt: TJvTFAppt;
+ I: Integer;
+begin
+ SetLength(Result, 0);
+ for I := 0 to ApptCount - 1 do
+ begin
+ Appt := Appts[I];
+ if (Frac(Appt.StartTime) <= Frac(AdjustEndTime(TimeRange.EndTime))) and
+ (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(TimeRange.StartTime)) then
+ begin
+ SetLength(Result, Length(Result) + 1);
+ Result[High(Result)] := Appt;
+ end;
+ end;
+end;
+
+function TJvTFSched.EnumConflicts(RangeStart, RangeEnd: TTime): TDynApptArray;
+var
+ TimeRange: TJvTFTimeRange;
+begin
+ TimeRange.StartTime := RangeStart;
+ TimeRange.EndTime := RangeEnd;
+ Result := EnumConflicts(TimeRange);
+end;
+
+function TJvTFSched.EnumConflicts(anAppt: TJvTFAppt): TDynApptArray;
+var
+ Appt: TJvTFAppt;
+ I: Integer;
+begin
+ SetLength(Result, 0);
+ for I := 0 to ApptCount - 1 do
+ begin
+ Appt := Appts[I];
+ if (Appt <> anAppt) and // don't add the given appt
+ (Frac(Appt.StartTime) <= Frac(AdjustEndTime(anAppt.EndTime))) and
+ (Frac(AdjustEndTime(Appt.EndTime)) >= Frac(anAppt.StartTime)) then
+ begin
+ SetLength(Result, Length(Result) + 1);
+ Result[High(Result)] := Appt;
+ end;
+ end;
+end;
+
+function TJvTFSched.GetFirstAppt: TJvTFAppt;
+var
+ I: Integer;
+ anAppt: TJvTFAppt;
+begin
+ Result := nil;
+ I := 0;
+ while (I < ApptCount) do
+ begin
+ anAppt := Appts[I];
+ if Trunc(anAppt.StartDate) < Trunc(SchedDate) then
+ begin
+ Result := anAppt;
+ Break; // APPOINTMENT STARTS AT 0:00 (12:00am) SO LEAVE LOOP
+ end
+ else
+ if not Assigned(Result) then
+ Result := anAppt
+ else
+ if Frac(anAppt.StartTime) < Frac(Result.StartTime) then
+ Result := anAppt;
+ Inc(I);
+ end;
+end;
+
+function TJvTFSched.GetLastAppt: TJvTFAppt;
+var
+ I: Integer;
+ anAppt: TJvTFAppt;
+begin
+ Result := nil;
+ I := 0;
+ while (I < ApptCount) do
+ begin
+ anAppt := Appts[I];
+ if Trunc(anAppt.EndDate) > Trunc(SchedDate) then
+ begin
+ Result := anAppt;
+ Break; // APPOINTMENT ENDS AT 23:59 (11:59pm) SO LEAVE LOOP
+ end
+ else
+ if not Assigned(Result) then
+ Result := anAppt
+ else
+ if Frac(anAppt.EndTime) > Frac(Result.EndTime) then
+ Result := anAppt;
+ Inc(I);
+ end;
+end;
+
+procedure TJvTFSched.Refresh;
+begin
+ ScheduleManager.dbRefreshSched(Self);
+end;
+
+procedure TJvTFSched.SetSchedDisplayName(const Value: string);
+begin
+ if FSchedDisplayName <> Value then
+ begin
+ FSchedDisplayName := Value;
+ ScheduleManager.RefreshConnections(Self);
+ end;
+end;
+
+//=== { TJvTFScheduleManagerCache } ==========================================
+
+constructor TJvTFScheduleManagerCache.Create(SchedManager: TJvTFScheduleManager);
+begin
+ inherited Create;
+ FScheduleManager := SchedManager;
+
+ FCacheType := ctTimed;
+ FTimedDelay := 30000;
+ FBufferCount := 7;
+
+ FTimer := TTimer.Create(nil);
+ FTimer.OnTimer := @TimerOnTimer;
+ FTimer.Interval := FTimedDelay;
+ FTimer.Enabled := FCacheType = ctTimed;
+end;
+
+destructor TJvTFScheduleManagerCache.Destroy;
+begin
+ FTimer.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFScheduleManagerCache.SetCacheType(Value: TJvTFScheduleManagerCacheType);
+begin
+ if Value <> FCacheType then
+ begin
+ FCacheType := Value;
+ FTimer.Enabled := Value = ctTimed;
+ FlushManager;
+ end;
+end;
+
+procedure TJvTFScheduleManagerCache.SetTimedDelay(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FTimedDelay then
+ begin
+ FTimedDelay := Value;
+ FTimer.Enabled := False;
+ FTimer.Interval := Value;
+ if CacheType = ctTimed then
+ begin
+ FTimer.Enabled := True;
+ FlushManager;
+ end;
+ end;
+end;
+
+procedure TJvTFScheduleManagerCache.SetBufferCount(Value: Integer);
+begin
+ if Value < 0 then
+ Value := 0;
+ if Value <> FBufferCount then
+ begin
+ FBufferCount := Value;
+ if CacheType = ctBuffer then
+ FlushManager;
+ end;
+end;
+
+procedure TJvTFScheduleManagerCache.FlushManager;
+begin
+ if Assigned(FScheduleManager) then
+ FScheduleManager.Flush(False);
+end;
+
+procedure TJvTFScheduleManagerCache.TimerOnTimer(Sender: TObject);
+begin
+ FlushManager;
+end;
+
+procedure TJvTFScheduleManagerCache.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFScheduleManagerCache then
+ begin
+ FCacheType := TJvTFScheduleManagerCache(Source).CacheType;
+ FTimedDelay := TJvTFScheduleManagerCache(Source).TimedDelay;
+ FBufferCount := TJvTFScheduleManagerCache(Source).BufferCount;
+ if FTimer.Enabled then
+ begin
+ FTimer.Enabled := False;
+ FTimer.Interval := FTimedDelay;
+ FTimer.Enabled := FCacheType = ctTimed;
+ end;
+ FlushManager;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+//=== { TJvTFScheduleManager } ===============================================
+
+constructor TJvTFScheduleManager.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FSchedLoadMode := slmOnDemand;
+ FAppts := TStringList.Create;
+ FSchedules := TStringList.Create;
+
+ FSchedBatch := TStringList.Create;
+ FSchedBatch.Sorted := True;
+ FSchedBatch.Duplicates := dupIgnore;
+
+ FConControls := TStringList.Create;
+ FConComponents := TStringList.Create;
+
+ FStateImageMap := TJvTFStateImageMap.Create(Self);
+ FImageChangeLink := TChangeLink.Create;
+ FImageChangeLink.OnChange := @ImageListChange;
+
+ FCache := TJvTFScheduleManagerCache.Create(Self);
+ FApptBeingDestroyed := nil;
+end;
+
+destructor TJvTFScheduleManager.Destroy;
+begin
+ FDestroying := True;
+
+ while ConControlCount > 0 do
+ ConControls[0].ScheduleManager := nil;
+
+ while ConComponentCount > 0 do
+ ConComponents[0].ScheduleManager := nil;
+
+ while ScheduleCount > 0 do
+ Schedules[0].Free;
+
+ while ApptCount > 0 do
+ Appts[0].Free;
+
+ FAppts.Free;
+ FSchedBatch.Free;
+ FSchedules.Free;
+ FConControls.Free;
+ FConComponents.Free;
+ FStateImageMap.Free;
+
+ StateImages := nil;
+ CustomImages := nil;
+ FImageChangeLink.Free;
+
+ FCache.Free;
+
+ inherited Destroy;
+end;
+
+class function TJvTFScheduleManager.GetScheduleID(const SchedName: string;
+ SchedDate: TDate): string;
+begin
+ Result := SchedName + IntToStr(Trunc(SchedDate));
+end;
+
+class function TJvTFScheduleManager.GenerateApptID: string;
+var
+ I: Integer;
+begin
+ Result := FloatToStr(Now);
+ Randomize;
+ for I := 1 to 5 do
+ Result := Result + Chr(Random(25) + 65);
+end;
+
+function TJvTFScheduleManager.GetAppt(Index: Integer): TJvTFAppt;
+begin
+ Result := TJvTFAppt(FAppts.Objects[Index]);
+end;
+
+function TJvTFScheduleManager.GetSchedule(Index: Integer): TJvTFSched;
+begin
+ Result := TJvTFSched(FSchedules.Objects[Index]);
+end;
+
+function TJvTFScheduleManager.GetConControl(Index: Integer): TJvTFControl;
+begin
+ Result := TJvTFControl(FConControls.Objects[Index]);
+end;
+
+function TJvTFScheduleManager.GetConComponent(Index: Integer): TJvTFComponent;
+begin
+ Result := TJvTFComponent(FConComponents.Objects[Index]);
+end;
+
+procedure TJvTFScheduleManager.SetStateImages(Value: TCustomImageList);
+begin
+ ReplaceImageListReference(Self, Value, FStateImages, FImageChangeLink);
+end;
+
+procedure TJvTFScheduleManager.SetCustomImages(Value: TCustomImageList);
+begin
+ ReplaceImageListReference(Self, Value, FCustomImages, FImageChangeLink);
+end;
+
+procedure TJvTFScheduleManager.SetCache(Value: TJvTFScheduleManagerCache);
+begin
+ FCache.Assign(Value);
+end;
+
+procedure TJvTFScheduleManager.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = StateImages then
+ begin
+ StateImages := nil;
+ RefreshConnections(nil);
+ end
+ else
+ if AComponent = CustomImages then
+ begin
+ CustomImages := nil;
+ RefreshConnections(nil);
+ end;
+end;
+
+procedure TJvTFScheduleManager.ConnectControl(ApptCtrl: TJvTFControl);
+var
+ I: Integer;
+begin
+ if not Assigned(ApptCtrl) then
+ Exit;
+
+ I := FConControls.IndexOfObject(ApptCtrl);
+ if I = -1 then
+ FConControls.AddObject('', ApptCtrl);
+end;
+
+procedure TJvTFScheduleManager.DisconnectControl(ApptCtrl: TJvTFControl);
+var
+ I: Integer;
+begin
+ if not Assigned(ApptCtrl) then
+ Exit;
+
+ I := FConControls.IndexOfObject(ApptCtrl);
+ if I > -1 then
+ begin
+ ApptCtrl.ReleaseSchedules;
+ FConControls.Delete(I);
+ end;
+end;
+
+procedure TJvTFScheduleManager.ConnectComponent(Comp: TJvTFComponent);
+var
+ I: Integer;
+begin
+ if not Assigned(Comp) then
+ Exit;
+
+ I := FConComponents.IndexOfObject(Comp);
+ if I = -1 then
+ FConComponents.AddObject('', Comp);
+end;
+
+procedure TJvTFScheduleManager.DisconnectComponent(Comp: TJvTFComponent);
+var
+ I: Integer;
+begin
+ if not Assigned(Comp) then
+ Exit;
+
+ I := FConComponents.IndexOfObject(Comp);
+ if I > -1 then
+ begin
+ Comp.ReleaseSchedules;
+ FConComponents.Delete(I);
+ end;
+end;
+
+procedure TJvTFScheduleManager.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ case Code of
+ sncConnectComponent:
+ ConnectComponent(TJvTFComponent(Sender));
+ sncDisconnectComponent:
+ DisconnectComponent(TJvTFComponent(Sender));
+ sncConnectControl:
+ ConnectControl(TJvTFControl(Sender));
+ sncDisconnectControl:
+ DisconnectControl(TJvTFControl(Sender));
+ sncLoadAppt:
+ AddAppt(TJvTFAppt(Sender));
+ sncDestroyAppt:
+ RemoveAppt(TJvTFAppt(Sender));
+ sncDestroySchedule:
+ RemoveSchedule(TJvTFSched(Sender));
+ end;
+end;
+
+procedure TJvTFScheduleManager.NotifyAppt(Appt: TJvTFAppt; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Appt) then
+ Appt.Notify(Sender, Code);
+end;
+
+procedure TJvTFScheduleManager.NotifySchedule(Sched: TJvTFSched; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Sched) then
+ Sched.Notify(Sender, Code);
+end;
+
+procedure TJvTFScheduleManager.NotifyApptCtrl(ApptCtrl: TJvTFControl;
+ Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ if Assigned(ApptCtrl) then
+ ApptCtrl.Notify(Sender, Code);
+end;
+
+procedure TJvTFScheduleManager.NotifyComp(Comp: TJvTFComponent;
+ Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Comp) then
+ Comp.Notify(Sender, Code);
+end;
+
+procedure TJvTFScheduleManager.RetrieveSchedule(const SchedName: string; SchedDate: TDate;
+ var Schedule: TJvTFSched; var LoadedNow: Boolean);
+var
+ SchedID: string;
+ I: Integer;
+begin
+ SchedID := GetScheduleID(SchedName, SchedDate);
+ I := FSchedules.IndexOf(SchedID);
+
+ if I > -1 then
+ begin
+ Schedule := TJvTFSched(FSchedules.Objects[I]);
+ LoadedNow := False;
+ end
+ else
+ begin
+ //Schedule := TJvTFSched.Create(Self, SchedName, SchedDate);
+ Schedule := GetSchedClass.Create(Self, SchedName, SchedDate);
+ FSchedules.AddObject(SchedID, Schedule);
+ LoadedNow := True;
+ if Cache.CacheType = ctBuffer then
+ Flush(False);
+ Schedule.CheckConnections;
+ end;
+end;
+
+procedure TJvTFScheduleManager.NeedAppts(Schedule: TJvTFSched);
+begin
+ FLoadingAppts := True;
+ try
+ if Assigned(FOnNeedAppts) then
+ FOnNeedAppts(Self, Schedule);
+ finally
+ FLoadingAppts := False;
+ RefreshConnections(Schedule);
+ end;
+end;
+
+procedure TJvTFScheduleManager.AddAppt(Appt: TJvTFAppt);
+begin
+ if FAppts.IndexOfObject(Appt) = -1 then
+ FAppts.AddObject(Appt.ID, Appt);
+end;
+
+procedure TJvTFScheduleManager.RemoveAppt(Appt: TJvTFAppt);
+var
+ I: Integer;
+ IndexOfAppt: Integer;
+begin
+ if Appt = FApptBeingDestroyed then
+ Exit; // Do Nothing if this is already the Appt we are
+ // destroying ourselves
+
+ IndexOfAppt := FAppts.IndexOfObject(Appt);
+ if IndexOfAppt = -1 then
+ Exit; // Nothing to do if the appt is not in our list
+
+ for I := 0 to ConControlCount - 1 do
+ NotifyApptCtrl(ConControls[I], Appt, sncDestroyAppt);
+
+ for I := 0 to ConComponentCount - 1 do
+ NotifyComp(ConComponents[I], Appt, sncDestroyAppt);
+
+ while Appt.ConnectionCount > 0 do
+ Appt.Notify(Appt.Connections[0], sncDisconnectAppt);
+
+ FAppts.Delete(IndexOfAppt);
+
+ // Do not free if the appt is being destroyed by someone else
+ if not Appt.Destroying then
+ begin
+ FApptBeingDestroyed := Appt;
+ try
+ Appt.Free;
+ finally
+ FApptBeingDestroyed := nil;
+ end;
+ end;
+end;
+
+procedure TJvTFScheduleManager.RemoveSchedule(Sched: TJvTFSched);
+var
+ I: Integer;
+begin
+ for I := 0 to ConControlCount - 1 do
+ NotifyApptCtrl(ConControls[I], Sched, sncDestroySchedule);
+
+ for I := 0 to ConComponentCount - 1 do
+ NotifyComp(ConComponents[I], Sched, sncDestroySchedule);
+
+ FSchedules.Delete(FSchedules.IndexOfObject(Sched));
+ Flush(False);
+end;
+
+{
+procedure TJvTFScheduleManager.RefreshAppt(Appt: TJvTFAppt);
+begin
+ FLoadingAppts := True;
+ Try
+ NotifyAppt(Appt, Self, sncRefresh);
+ If Assigned(FOnRefreshAppt) Then
+ FOnRefreshAppt(Self, Appt);
+ Finally
+ FLoadingAppts := False;
+ End;
+end;
+}
+
+procedure TJvTFScheduleManager.DeleteAppt(Appt: TJvTFAppt);
+begin
+ if Assigned(FOnDeleteAppt) then
+ FOnDeleteAppt(Self, Appt);
+end;
+
+procedure TJvTFScheduleManager.PostAppt(Appt: TJvTFAppt);
+begin
+ if Assigned(FOnPostAppt) then
+ FOnPostAppt(Self, Appt);
+end;
+
+procedure TJvTFScheduleManager.RequestRefresh(ApptCtrl: TJvTFControl;
+ Schedule: TJvTFSched);
+begin
+ NotifyApptCtrl(ApptCtrl, Self, sncRefresh);
+ {
+ If Assigned(ApptCtrl) Then
+ Windows.PostMessage(ApptCtrl.Handle, CN_REQUESTREFRESH, WPARAM(Schedule), 0)
+ Else
+ Raise EJvTFScheduleManagerError.Create('Could not send refresh request. ' +
+ 'ApptCtrl not assigned');
+ }
+end;
+
+procedure TJvTFScheduleManager.RequestRefresh(Comp: TJvTFComponent;
+ Schedule: TJvTFSched);
+begin
+ NotifyComp(Comp, Self, sncRefresh);
+end;
+
+procedure TJvTFScheduleManager.ImageListChange(Sender: TObject);
+begin
+ if not (csDestroying in ComponentState) then
+ RefreshConnections(nil);
+end;
+
+procedure TJvTFScheduleManager.FlushAppts;
+var
+ I: Integer;
+begin
+ I := 0;
+ while I < ApptCount do
+ if (Appts[I].ConnectionCount = 0) and not Appts[I].Persistent then
+ begin
+ if not FlushObject(Appts[I]) then
+ Inc(I);
+ end
+ else
+ Inc(I);
+end;
+
+function TJvTFScheduleManager.FlushObject(FlushObj: TObject): Boolean;
+var
+ FlushIt: Boolean;
+begin
+ Result := False;
+ if Assigned(FlushObj) then
+ begin
+ FlushIt := True;
+ if Assigned(FOnFlush) then
+ FOnFlush(Self, FlushObj, FlushIt);
+ if FlushIt then
+ FlushObj.Free;
+ Result := FlushIt;
+ end;
+end;
+
+procedure TJvTFScheduleManager.DoCreateApptEvent(anAppt: TJvTFAppt);
+begin
+ if Assigned(FOnCreateAppt) then
+ FOnCreateAppt(Self, anAppt);
+end;
+
+procedure TJvTFScheduleManager.DoCreateScheduleEvent(aSchedule: TJvTFSched);
+begin
+ if Assigned(FOnCreateSchedule) then
+ FOnCreateSchedule(Self, aSchedule);
+end;
+
+procedure TJvTFScheduleManager.DoDestroyApptEvent(anAppt: TJvTFAppt);
+begin
+ if Assigned(FOnDestroyAppt) then
+ FOnDestroyAppt(Self, anAppt);
+end;
+
+procedure TJvTFScheduleManager.DoDestroyScheduleEvent(aSchedule: TJvTFSched);
+begin
+ if Assigned(FOnDestroySchedule) then
+ FOnDestroySchedule(Self, aSchedule);
+end;
+
+function TJvTFScheduleManager.ApptCount: Integer;
+begin
+ Result := FAppts.Count;
+end;
+
+function TJvTFScheduleManager.FindAppt(const ID: string): TJvTFAppt;
+var
+ I: Integer;
+begin
+ Result := nil;
+ I := FAppts.IndexOf(ID);
+ if I > -1 then
+ Result := TJvTFAppt(FAppts.Objects[I]);
+end;
+
+function TJvTFScheduleManager.ScheduleCount: Integer;
+begin
+ Result := FSchedules.Count;
+end;
+
+function TJvTFScheduleManager.FindSchedule(const SchedName: string;
+ SchedDate: TDate): TJvTFSched;
+var
+ I: Integer;
+begin
+ Result := nil;
+ I := FSchedules.IndexOf(GetScheduleID(SchedName, SchedDate));
+ if I > -1 then
+ Result := TJvTFSched(FSchedules.Objects[I]);
+end;
+
+function TJvTFScheduleManager.ConControlCount: Integer;
+begin
+ Result := FConControls.Count;
+end;
+
+function TJvTFScheduleManager.ConComponentCount: Integer;
+begin
+ Result := FConComponents.Count;
+end;
+
+function TJvTFScheduleManager.RequestSchedule(ApptCtrl: TJvTFControl;
+ const SchedName: string; SchedDate: TDate): TJvTFSched;
+var
+ ApptsNeeded: Boolean;
+begin
+ RetrieveSchedule(SchedName, SchedDate, Result, ApptsNeeded);
+
+ if Assigned(ApptCtrl) then
+ begin
+ Result.Notify(ApptCtrl, sncRequestSchedule);
+ ApptCtrl.Notify(Result, sncRequestSchedule);
+ end;
+
+ if ApptsNeeded then
+ if SchedLoadMode = slmOnDemand then
+ NeedAppts(Result)
+ else
+ begin
+ AddToBatch(Result);
+ end;
+end;
+
+function TJvTFScheduleManager.RequestSchedule(ApptCtrl: TJvTFControl;
+ const SchedName: string; SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched;
+begin
+ RetrieveSchedule(SchedName, SchedDate, Result, LoadedNow);
+
+ if Assigned(ApptCtrl) then
+ begin
+ Result.Notify(ApptCtrl, sncRequestSchedule);
+ ApptCtrl.Notify(Result, sncRequestSchedule);
+ end;
+
+ if LoadedNow then
+ begin
+ if SchedLoadMode = slmOnDemand then
+ NeedAppts(Result)
+ else
+ AddToBatch(Result);
+ end;
+end;
+
+function TJvTFScheduleManager.RequestSchedule(Comp: TJvTFComponent;
+ const SchedName: string; SchedDate: TDate): TJvTFSched;
+var
+ ApptsNeeded: Boolean;
+begin
+ RetrieveSchedule(SchedName, SchedDate, Result, ApptsNeeded);
+
+ if Assigned(Comp) then
+ begin
+ Result.Notify(Comp, sncRequestSchedule);
+ Comp.Notify(Result, sncRequestSchedule);
+ end;
+
+ if ApptsNeeded then
+ begin
+ if SchedLoadMode = slmOnDemand then
+ NeedAppts(Result)
+ else
+ AddToBatch(Result);
+ end;
+end;
+
+function TJvTFScheduleManager.RequestSchedule(Comp: TJvTFComponent;
+ const SchedName: string; SchedDate: TDate; var LoadedNow: Boolean): TJvTFSched;
+begin
+ RetrieveSchedule(SchedName, SchedDate, Result, LoadedNow);
+
+ if Assigned(Comp) then
+ begin
+ Result.Notify(Comp, sncRequestSchedule);
+ Comp.Notify(Result, sncRequestSchedule);
+ end;
+
+ if LoadedNow then
+ begin
+ if SchedLoadMode = slmOnDemand then
+ NeedAppts(Result)
+ else
+ AddToBatch(Result);
+ end;
+end;
+
+procedure TJvTFScheduleManager.ReleaseSchedule(ApptCtrl: TJvTFControl;
+ const SchedName: string; SchedDate: TDate);
+var
+ SchedID: string;
+ I: Integer;
+ Schedule: TJvTFSched;
+begin
+ SchedID := GetScheduleID(SchedName, SchedDate);
+ I := FSchedules.IndexOf(SchedID);
+
+ if I > -1 then
+ begin
+ Schedule := TJvTFSched(FSchedules.Objects[I]);
+
+ if Assigned(ApptCtrl) then
+ begin
+ Schedule.Notify(ApptCtrl, sncReleaseSchedule);
+ ApptCtrl.Notify(Schedule, sncReleaseSchedule);
+ end;
+
+ if (Cache.CacheType = ctBuffer) then
+ Flush(False);
+ end;
+end;
+
+procedure TJvTFScheduleManager.ReleaseSchedule(Comp: TJvTFComponent;
+ const SchedName: string; SchedDate: TDate);
+var
+ SchedID: string;
+ I: Integer;
+ Schedule: TJvTFSched;
+begin
+ SchedID := GetScheduleID(SchedName, SchedDate);
+ I := FSchedules.IndexOf(SchedID);
+
+ if I > -1 then
+ begin
+ Schedule := TJvTFSched(FSchedules.Objects[I]);
+
+ if Assigned(Comp) then
+ begin
+ Schedule.Notify(Comp, sncReleaseSchedule);
+ Comp.Notify(Schedule, sncReleaseSchedule);
+ end;
+
+ if Cache.CacheType = ctBuffer then
+ Flush(False);
+ end;
+end;
+
+procedure TJvTFScheduleManager.RequestAppt(const ID: string; var Appt: TJvTFAppt;
+ var New: Boolean);
+var
+ I: Integer;
+begin
+ I := -1;
+ if ID <> '' then
+ I := FAppts.IndexOf(ID);
+
+ if I > -1 then
+ begin
+ Appt := TJvTFAppt(FAppts.Objects[I]);
+ New := False;
+ end
+ else
+ begin
+ //Appt := TJvTFAppt.Create(Self, ID);
+ Appt := GetApptClass.Create(Self, ID);
+ New := True;
+ end;
+end;
+
+procedure TJvTFScheduleManager.dbPostAppt(Appt: TJvTFAppt);
+begin
+ { implicit post fix
+ If Assigned(Appt) Then
+ If (AlwaysPost or Appt.Modified) Then
+ Begin
+ PostAppt(Appt);
+ Appt.Notify(Self, sncPostAppt);
+ End;
+ }
+
+ // implicit post fix
+ if Assigned(Appt) and
+ (AlwaysPost or Appt.Modified) and
+ QueryPostAppt(Appt) then
+ begin
+ PostAppt(Appt);
+ Appt.Notify(Self, sncPostAppt);
+ end;
+end;
+
+procedure TJvTFScheduleManager.dbDeleteAppt(Appt: TJvTFAppt);
+begin
+ if Assigned(Appt) then
+ begin
+ DeleteAppt(Appt);
+ Appt.Notify(Self, sncDeleteAppt);
+ end;
+end;
+
+procedure TJvTFScheduleManager.dbDeleteAllAppt;
+var
+ I: Integer;
+begin
+ for I := FAppts.Count - 1 downto 0 do
+ RemoveAppt(TJvTFAppt(FAppts.Objects[0]));
+end;
+
+procedure TJvTFScheduleManager.dbRefreshAppt(Appt: TJvTFAppt);
+begin
+ if Assigned(Appt) then
+ begin
+ FRefreshing := True;
+ try
+ Appt.Notify(Self, sncRefresh);
+ if Assigned(FOnRefreshAppt) then
+ FOnRefreshAppt(Self, Appt);
+ if RefreshAutoReconcile then
+ ReconcileRefresh(Appt);
+ finally
+ FRefreshing := False;
+
+ // BUG - IT'S A LITTLE LATE TO BE USING THE APPT AS A REFRESH TRIGGER!!!
+ //RefreshConnections(Appt);
+ // Use nil as trigger to refresh everything
+ RefreshConnections(nil);
+ end;
+ end;
+ {
+ If Assigned(Appt) Then
+ RefreshAppt(Appt);
+ }
+end;
+
+function TJvTFScheduleManager.dbNewAppt(const ID: string): TJvTFAppt;
+var
+ New: Boolean;
+begin
+ Result := nil;
+ RequestAppt(ID, Result, New);
+ if not New then
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotCreateNewAppointment);
+end;
+
+procedure TJvTFScheduleManager.PostAppts;
+var
+ I: Integer;
+begin
+ for I := 0 to ApptCount - 1 do
+ dbPostAppt(Appts[I]);
+end;
+
+procedure TJvTFScheduleManager.RefreshAppts;
+var
+ I: Integer;
+ ApptIDList: TStringList;
+ Appt: TJvTFAppt;
+begin
+ // In a multi-user environment, appt objects may be deleted as a result
+ // of calling dbRefreshAppt. (Component user may call Appt.Free.)
+ // To account for this we need to build a list of appt ID's instead of
+ // working directly from the ScheduleManager's appointment list.
+
+ ApptIDList := TStringList.Create;
+ try
+ for I := 0 to ApptCount - 1 do
+ begin
+ Appt := Appts[I];
+ ApptIDList.Add(Appt.ID);
+ end;
+
+ for I := 0 to ApptIDList.Count - 1 do
+ begin
+ Appt := FindAppt(ApptIDList[I]);
+ if Assigned(Appt) then
+ dbRefreshAppt(Appt);
+ end;
+
+ RefreshConnections(nil);
+ finally
+ ApptIDList.Free;
+ end;
+end;
+
+procedure TJvTFScheduleManager.RefreshConnections(Trigger: TObject);
+var
+ Sched: TJvTFSched;
+ Appt: TJvTFAppt;
+ I: Integer;
+begin
+ // Do not refresh if we're loading or refreshing appts
+ if FLoadingAppts or Refreshing then
+ Exit;
+
+ if Trigger = nil then
+ begin
+ // refresh all schedules for all controls connected to ScheduleManager
+ for I := 0 to ConControlCount - 1 do
+ RequestRefresh(ConControls[I], nil);
+ // refresh all schedules for all components connected to the ScheduleManager
+ for I := 0 to ConComponentCount - 1 do
+ RequestRefresh(ConComponents[I], nil);
+ end
+ else
+ if Trigger is TJvTFComponent then
+ begin
+ // refresh all schedules for given component
+ RequestRefresh(TJvTFComponent(Trigger), nil);
+ end
+ else
+ if Trigger is TJvTFControl then
+ begin
+ // refresh all schedules for given control
+ RequestRefresh(TJvTFControl(Trigger), nil);
+ end
+ else
+ if Trigger is TJvTFSched then
+ begin
+ // refresh all appt controls connected to schedule
+ Sched := TJvTFSched(Trigger);
+ for I := 0 to Sched.ConControlCount - 1 do
+ RequestRefresh(Sched.ConControls[I], Sched);
+ // refresh all utf components connected to schedule
+ for I := 0 to Sched.ConComponentCount - 1 do
+ RequestRefresh(Sched.ConComponents[I], Sched);
+ end
+ else
+ if Trigger is TJvTFAppt then
+ begin
+ // refresh all appt controls for all schedules connected to this appt
+ Appt := TJvTFAppt(Trigger);
+ for I := 0 to Appt.ConnectionCount - 1 do
+ RefreshConnections(Appt.Connections[I]);
+ end
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidTriggerForRefreshControls)
+end;
+
+procedure TJvTFScheduleManager.Flush(All: Boolean); //param All defaults to False
+var
+ I: Integer;
+ Sched: TJvTFSched;
+ MRUList: TStringList;
+ CacheTimeUp: Boolean;
+begin
+ if FFlushing or FDestroying then
+ Exit;
+
+ FFlushing := True;
+ try
+ if All then
+ begin
+ I := 0;
+ while I < ScheduleCount do
+ begin
+ Sched := Schedules[I];
+ if Sched.Cached and not Sched.Persistent then
+ begin
+ if not FlushObject(Sched) then
+ Inc(I);
+ end
+ else
+ Inc(I);
+ end;
+ FlushAppts;
+ end
+ else
+ if Cache.CacheType = ctTimed then
+ begin
+ I := 0;
+ while I < ScheduleCount do
+ begin
+ Sched := Schedules[I];
+ CacheTimeUp := GetTickCount64 - Sched.CachedTime >= Cache.TimedDelay;
+// CacheTimeUp := Windows.GetTickCount - Sched.CachedTime >= UINT(Cache.TimedDelay);
+ if Sched.Cached and CacheTimeUp then
+ begin
+ if not FlushObject(Sched) then
+ Inc(I);
+ end
+ else
+ Inc(I);
+ end;
+ FlushAppts;
+ end
+ else
+ if Cache.CacheType = ctBuffer then
+ begin
+ MRUList := TStringList.Create;
+ try
+ MRUList.Sorted := True;
+ MRUList.Duplicates := dupAccept;
+ for I := 0 to ScheduleCount - 1 do
+ begin
+ Sched := Schedules[I];
+ if Sched.Cached then
+ MRUList.AddObject(IntToHex(Sched.CachedTime, 8), Sched);
+ end;
+ for I := 0 to MRUList.Count - 1 - Cache.BufferCount do
+ FlushObject(MRUList.Objects[I]);
+ FlushAppts;
+ finally
+ MRUList.Free;
+ end;
+ end;
+
+ finally
+ FFlushing := False;
+ end;
+end;
+
+procedure TJvTFScheduleManager.dbRefreshAll;
+var
+ I: Integer;
+begin
+ FRefreshing := True;
+ try
+ for I := 0 to ApptCount - 1 do
+ NotifyAppt(Appts[I], Self, sncRefresh);
+ if Assigned(FOnRefreshAll) then
+ FOnRefreshAll(Self);
+ if RefreshAutoReconcile then
+ ReconcileRefresh(Self);
+ finally
+ FRefreshing := False;
+ RefreshConnections(nil);
+ end;
+end;
+
+procedure TJvTFScheduleManager.dbRefreshOrphans;
+var
+ I: Integer;
+begin
+ for I := 0 to ApptCount - 1 do
+ if Appts[I].ConnectionCount = 0 then
+ dbRefreshAppt(Appts[I]);
+end;
+
+procedure TJvTFScheduleManager.dbRefreshSched(Sched: TJvTFSched);
+var
+ I: Integer;
+begin
+ if Assigned(Sched) then
+ begin
+ FRefreshing := True;
+ try
+ for I := 0 to Sched.ApptCount - 1 do
+ NotifyAppt(Sched.Appts[I], Self, sncRefresh);
+ if Assigned(FOnRefreshSched) then
+ FOnRefreshSched(Self, Sched);
+ if RefreshAutoReconcile then
+ ReconcileRefresh(Sched);
+ finally
+ FRefreshing := False;
+ RefreshConnections(Sched);
+ end;
+ end;
+end;
+
+procedure TJvTFScheduleManager.SetTFSchedLoadMode(Value: TJvTFSchedLoadMode);
+begin
+ if (Value <> FSchedLoadMode) and (Value = slmOnDemand) then
+ // make sure we process any queued batches before changing mode
+ ProcessBatches;
+
+ FSchedLoadMode := Value;
+end;
+
+procedure TJvTFScheduleManager.AddToBatch(ASched: TJvTFSched);
+var
+ SchedID: string;
+begin
+ SchedID := TJvTFScheduleManager.GetScheduleID(ASched.SchedName, ASched.SchedDate);
+ FSchedBatch.AddObject(SchedID, ASched);
+end;
+
+procedure TJvTFScheduleManager.ProcessBatches;
+var
+ I: Integer;
+ ASched: TJvTFSched;
+ CompName: string;
+ CompDate: TDate;
+ BatchName: string;
+ BatchStartDate: TDate;
+ BatchEndDate: TDate;
+
+ procedure UpdateCompares(ASched: TJvTFSched);
+ begin
+ CompName := ASched.SchedName;
+ CompDate := ASched.SchedDate;
+ end;
+
+ procedure NewBatch(ASched: TJvTFSched);
+ begin
+ BatchName := ASched.SchedName;
+ BatchStartDate := ASched.SchedDate;
+ BatchEndDate := ASched.SchedDate;
+ end;
+
+begin
+ if FSchedBatch.Count = 0 then
+ Exit;
+
+ // added by Mike 1/14/01
+ FLoadingAppts := True;
+ try
+ // Prime the process (reminds me of COBOL - yuck!)
+ ASched := TJvTFSched(FSchedBatch.Objects[0]);
+ UpdateCompares(ASched);
+ NewBatch(ASched);
+
+ for I := 1 to FSchedBatch.Count - 1 do
+ begin
+ ASched := TJvTFSched(FSchedBatch.Objects[I]);
+
+ if (ASched.SchedName <> CompName) or
+ (Trunc(ASched.SchedDate) - 1 <> Trunc(CompDate)) then
+ begin
+ // Hit new batch. Load the current batch and then
+ // set batch info to new batch.
+ LoadBatch(BatchName, BatchStartDate, BatchEndDate);
+ NewBatch(ASched);
+ end
+ else
+ // Still in current batch. Update the batch end date.
+ BatchEndDate := ASched.SchedDate;
+
+ UpdateCompares(ASched);
+ end;
+
+ // Load the last batch
+ LoadBatch(BatchName, BatchStartDate, BatchEndDate);
+
+ FSchedBatch.Clear;
+
+ // ADD OnBatchesProcessed EVENT HERE !!
+ if Assigned(FOnBatchesProcessed) then
+ FOnBatchesProcessed(Self);
+ finally
+ // added by Mike 1/14/01
+ FLoadingAppts := False;
+ // added by Mike 1/14/01
+ RefreshConnections(nil);
+ end;
+end;
+
+procedure TJvTFScheduleManager.LoadBatch(const BatchName: string; BatchStartDate,
+ BatchEndDate: TDate);
+begin
+ if Assigned(FOnLoadBatch) then
+ FOnLoadBatch(Self, BatchName, BatchStartDate, BatchEndDate);
+end;
+
+function TJvTFScheduleManager.QueryPostAppt(Appt: TJvTFAppt): Boolean;
+begin
+ Result := True;
+ if Assigned(FOnPostApptQuery) then
+ FOnPostApptQuery(Self, Appt, Result);
+end;
+
+function TJvTFScheduleManager.GetApptDisplayText(AComponent: TComponent;
+ Appt: TJvTFAppt): string;
+begin
+ if Assigned(Appt) then
+ Result := Appt.Description
+ else
+ Result := '';
+
+ if Assigned(FOnGetApptDisplayText) then
+ FOnGetApptDisplayText(Self, AComponent, Appt, Result);
+end;
+
+procedure TJvTFScheduleManager.SetApptDescription(Appt: TJvTFAppt; var Value: string);
+begin
+ if Assigned(FOnSetApptDescription) then
+ FOnSetApptDescription(Self, Appt, Value);
+end;
+
+procedure TJvTFScheduleManager.GetApptDescription(Appt: TJvTFAppt; var Value: string);
+begin
+ if Assigned(FOnGetApptDescription) then
+ FOnGetApptDescription(Self, Appt, Value);
+end;
+
+function TJvTFScheduleManager.GetApptClass: TJvTFApptClass;
+begin
+ Result := TJvTFAppt;
+end;
+
+function TJvTFScheduleManager.GetSchedClass: TJvTFSchedClass;
+begin
+ Result := TJvTFSched;
+end;
+
+procedure TJvTFScheduleManager.ReconcileRefresh(Scope: TObject);
+var
+ Appt: TJvTFAppt;
+ Sched: TJvTFSched;
+ I: Integer;
+begin
+ if Scope is TJvTFAppt then
+ begin
+ Appt := TJvTFAppt(Scope);
+ if not Appt.Refreshed then
+ Appt.ClearSchedules;
+ end
+ else
+ if Scope is TJvTFSched then
+ begin
+ Sched := TJvTFSched(Scope);
+ I := 0;
+ while I < Sched.ApptCount do
+ begin
+ Appt := Sched.Appts[I];
+ if not Appt.Refreshed then
+ Appt.ClearSchedules
+ else
+ Inc(I);
+ end;
+ end
+ else
+ if Scope is TJvTFScheduleManager then
+ for I := 0 to ApptCount - 1 do
+ ReconcileRefresh(Appts[I])
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEInvalidScopeInReconcileRefresh);
+end;
+
+procedure TJvTFScheduleManager.SetRefreshAutoReconcile(Value: Boolean);
+begin
+ FRefreshAutoReconcile := Value;
+end;
+
+//=== { TJvTFHint } ==========================================================
+
+constructor TJvTFHint.Create(anApptCtrl: TJvTFControl);
+begin
+ inherited Create(anApptCtrl);
+ FApptCtrl := anApptCtrl;
+ FTimer := TTimer.Create(Self);
+ FShortPause := 1000;
+ FPause := 3000;
+ FTimer.OnTimer := @TimerOnTimer;
+ PrepTimer(True);
+end;
+
+destructor TJvTFHint.Destroy;
+begin
+ FTimer.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFHint.SetPause(Value: Integer);
+begin
+ FPause := Value;
+end;
+
+procedure TJvTFHint.SetShortPause(Value: Integer);
+begin
+ FShortPause := Value;
+end;
+
+procedure TJvTFHint.TimerOnTimer(Sender: TObject);
+begin
+ FTimer.Enabled := False;
+
+ if FShortTimer then
+ DoHint(False)
+ else
+ begin
+ ReleaseHandle;
+ PrepTimer(True);
+ end;
+end;
+
+procedure TJvTFHint.PrepTimer(Short: Boolean);
+begin
+ ReleaseHandle;
+ FShortTimer := Short;
+ if Short then
+ FTimer.Interval := FShortPause
+ else
+ FTimer.Interval := FPause;
+end;
+
+procedure TJvTFHint.SetHintText(StartDate, EndDate: TDate; StartTime,
+ EndTime: TTime; const Desc: string; ShowDatesTimes, ShowDesc: Boolean);
+var
+ ShowDates: Boolean;
+ HintText, DFormat, TFormat: string;
+begin
+ HintText := '';
+ if ShowDatesTimes then
+ begin
+ DFormat := FApptCtrl.DateFormat;
+ TFormat := FApptCtrl.TimeFormat;
+ ShowDates := Trunc(StartDate) <> Trunc(EndDate);
+
+ if ShowDates then
+ HintText := FormatDateTime(DFormat, StartDate) + ' ';
+ HintText := HintText + FormatDateTime(TFormat, StartTime) + ' - ';
+ if ShowDates then
+ HintText := HintText + FormatDateTime(DFormat, EndDate) + ' ';
+ HintText := HintText + FormatDateTime(TFormat, EndTime);
+ end;
+
+ if ShowDesc then
+ begin
+ if HintText <> '' then
+ HintText := HintText + #13#10;
+ HintText := HintText + Desc;
+ end;
+ FHintText := HintText;
+end;
+
+procedure TJvTFHint.DoHint(Sustained: Boolean);
+var
+ Ref: TObject;
+begin
+ PropertyCheck;
+ {
+ If Assigned(FOnShowHint) Then
+ FOnShowHint(Self, HintType, FHintRect, FHintText);
+ }
+
+ if Assigned(FOnShowHint) then
+ begin
+ if HintType = shtAppt then
+ Ref := FOldAppt
+ else
+ if HintType = shtObj then
+ Ref := FOldObj
+ else
+ Ref := nil;
+
+ FOnShowHint(Self, HintType, Ref, FHintRect, FHintText);
+ end;
+// if not Windows.IsRectEmpty(FHintRect) and (FHintText <> '') then
+ if not IsRectEmpty(FHintRect) and (FHintText <> '') then
+ if Sustained then
+ begin
+ inherited ActivateHint(FHintRect, FHintText);
+ end
+ else
+ ActivateHint(FHintRect, FHintText);
+end;
+
+
+
+procedure TJvTFHint.CreateParams(var Params: TCreateParams);
+begin
+ inherited CreateParams(Params);
+ { wp --- to do
+ with Params do
+ begin
+ WindowClass.Style := WindowClass.Style and not CS_SAVEBITS;
+ end;
+ }
+end;
+
+
+procedure TJvTFHint.ActivateHint(Rect: TRect; const AHint: THintString);
+begin
+ PrepTimer(False);
+ inherited ActivateHint(Rect, AHint);
+ // Reset the timer so we get the full interval
+ FTimer.Enabled := False;
+ FTimer.Enabled := True;
+end;
+
+procedure TJvTFHint.ApptHint(Appt: TJvTFAppt; X, Y: Integer; ShowDatesTimes,
+ ShowDesc, FormattedDesc: Boolean; const ExtraDesc: string = '');
+var
+ HintTopLeft: TPoint;
+ Immediate: Boolean;
+ ApptDesc: string;
+begin
+ if Appt <> FOldAppt then
+ begin
+ FHintType := shtAppt;
+ Immediate := not FShortTimer;
+ FHintCell := Point(-100, -100);
+ FOldAppt := Appt;
+ if Assigned(Appt) then
+ begin
+ ApptDesc := Appt.Description;
+ if not FormattedDesc then
+ ApptDesc := StripCRLF(ApptDesc);
+ ApptDesc := ExtraDesc + ApptDesc;
+ SetHintText(Appt.StartDate, Appt.EndDate, Appt.StartTime, Appt.EndTime,
+ ApptDesc, ShowDatesTimes, ShowDesc);
+ FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
+ HintTopLeft := FApptCtrl.ClientToScreen(Point(X, Y));
+ FHintRect := MoveRect(FHintRect, HintTopLeft.X, HintTopLeft.Y);
+ if Immediate then
+ DoHint(False)
+ else
+ begin
+ PrepTimer(True);
+ FTimer.Enabled := True;
+ end;
+ end
+ else
+ begin
+ ReleaseHandle;
+ PrepTimer(True);
+ end;
+ end;
+end;
+
+procedure TJvTFHint.StartEndHint(StartDate, EndDate: TDate; StartTime,
+ EndTime: TTime; X, Y: Integer; ShowDates: Boolean);
+var
+ HintTopLeft: TPoint;
+begin
+ FHintType := shtStartEnd;
+ SetHintText(StartDate, EndDate, StartTime, EndTime, '', True, False);
+ FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
+ HintTopLeft := FApptCtrl.ClientToScreen(Point(X, Y));
+ FHintRect := MoveRect(FHintRect, HintTopLeft.X, HintTopLeft.Y);
+ if HandleAllocated and Showing then
+ BoundsRect := FHintRect
+ else
+ DoHint(True);
+end;
+
+procedure TJvTFHint.CellHint(Row, Col: Integer; const HintText: string; CellRect: TRect);
+var
+ Immediate: Boolean;
+ DiffCell: Boolean;
+begin
+ DiffCell := (Row <> FHintCell.Y) or (Col <> FHintCell.X);
+ if DiffCell or not FTimer.Enabled then
+ begin
+ FHintType := shtCell;
+ FOldAppt := nil;
+ ReleaseHandle;
+ FHintCell.X := Col;
+ FHintCell.Y := Row;
+ Immediate := not FShortTimer;
+ FHintText := HintText;
+ //If (FHintText <> '') and DiffCell Then
+ if FHintText <> '' then
+ begin
+ CellRect.TopLeft := FApptCtrl.ClientToScreen(CellRect.TopLeft);
+ CellRect.BottomRight := FApptCtrl.ClientToScreen(CellRect.BottomRight);
+ FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
+ FHintRect := CenterRect(CellRect, FHintRect);
+ if Immediate then
+ DoHint(False)
+ else
+ begin
+ PrepTimer(True);
+ FTimer.Enabled := True;
+ end;
+ end
+ else
+ begin
+ ReleaseHandle;
+ PrepTimer(True);
+ end;
+ end;
+end;
+
+procedure TJvTFHint.ReleaseHandle;
+begin
+ FTimer.Enabled := False;
+ DestroyHandle;
+end;
+
+procedure TJvTFHint.PropertyCheck;
+begin
+ if Assigned(RefProps) then
+ begin
+ if RefProps.HintColor = clDefault then
+ Color := Application.HintColor
+ else
+ Color := RefProps.HintColor;
+
+ if RefProps.HintHidePause = -1 then
+ Pause := Application.HintHidePause
+ else
+ Pause := RefProps.HintHidePause;
+
+ if RefProps.HintPause = -1 then
+ ShortPause := Application.HintPause
+ else
+ ShortPause := RefProps.HintPause;
+ end;
+end;
+
+procedure TJvTFHint.MultiLineObjHint(Obj: TObject; X, Y: Integer;
+ Hints: TStrings);
+var
+ Immediate: Boolean;
+ HintTopLeft: TPoint;
+begin
+ if Obj <> FOldObj then
+ begin
+ FOldAppt := nil;
+ FHintType := shtObj;
+ Immediate := not FShortTimer;
+ FHintCell := Point(-100, -100);
+ FOldObj := Obj;
+ if Assigned(Obj) and (Hints.Count > 0) then
+ begin
+ FHintText := Hints.Text;
+ FHintRect := CalcHintRect(FApptCtrl.Width, FHintText, nil);
+ HintTopLeft := FApptCtrl.ClientToScreen(Point(X + 8, Y + 16));
+ FHintRect := MoveRect(FHintRect, HintTopLeft.X, HintTopLeft.Y);
+
+ if Immediate then
+ DoHint(False)
+ else
+ begin
+ PrepTimer(True);
+ FTimer.Enabled := True;
+ end;
+ end
+ else
+ begin
+ ReleaseHandle;
+ PrepTimer(True);
+ end;
+ end;
+end;
+
+//=== { TJvTFControl } =======================================================
+
+constructor TJvTFControl.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FSchedules := TStringList.Create;
+ FTimeFormat := 't'; // global short time format
+ FDateFormat := 'ddddd'; // global short date format
+end;
+
+destructor TJvTFControl.Destroy;
+begin
+ ScheduleManager := nil;
+ FSchedules.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFControl.SetManager(Value: TJvTFScheduleManager);
+begin
+ if Value <> FScheduleManager then
+ begin
+ if Assigned(FScheduleManager) then
+ FScheduleManager.Notify(Self, sncDisconnectControl);
+ FScheduleManager := nil;
+
+ if Assigned(Value) then
+ Value.Notify(Self, sncConnectControl);
+ FScheduleManager := Value;
+ end;
+end;
+
+function TJvTFControl.GetSchedule(Index: Integer): TJvTFSched;
+begin
+ Result := TJvTFSched(FSchedules.Objects[Index]);
+end;
+
+procedure TJvTFControl.SetDateFormat(const Value: string);
+begin
+ if FDateFormat <> Value then
+ begin
+ FDateFormat := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFControl.SetTimeFormat(const Value: string);
+begin
+ if FTimeFormat <> Value then
+ begin
+ FTimeFormat := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFControl.Notify(Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ case Code of
+ sncRequestSchedule:
+ ReqSchedNotification(TJvTFSched(Sender));
+ sncReleaseSchedule:
+ RelSchedNotification(TJvTFSched(Sender));
+ sncRefresh:
+ RefreshControl;
+ sncDestroyAppt:
+ DestroyApptNotification(TJvTFAppt(Sender));
+ sncDestroySchedule:
+ DestroySchedNotification(TJvTFSched(Sender));
+ end;
+end;
+
+procedure TJvTFControl.ReqSchedNotification(Schedule: TJvTFSched);
+var
+ SchedID: string;
+begin
+ SchedID := TJvTFScheduleManager.GetScheduleID(Schedule.SchedName, Schedule.SchedDate);
+ if FSchedules.IndexOf(SchedID) = -1 then
+ FSchedules.AddObject(SchedID, Schedule);
+end;
+
+procedure TJvTFControl.RelSchedNotification(Schedule: TJvTFSched);
+var
+ I: Integer;
+begin
+ I := FSchedules.IndexOfObject(Schedule);
+ if I > -1 then
+ FSchedules.Delete(I);
+end;
+
+procedure TJvTFControl.NotifyManager(Serv: TJvTFScheduleManager;
+ Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Serv) then
+ Serv.Notify(Sender, Code)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
+end;
+
+procedure TJvTFControl.CNRequestRefresh(var Msg: TCNRequestRefresh);
+begin
+ Invalidate;
+end;
+
+procedure TJvTFControl.RefreshControl;
+begin
+ Invalidate;
+end;
+
+procedure TJvTFControl.DestroyApptNotification(anAppt: TJvTFAppt);
+begin
+ // do nothing, leave implementation to successors
+end;
+
+procedure TJvTFControl.DestroySchedNotification(ASched: TJvTFSched);
+begin
+ // do nothing, leave implementation to successors
+end;
+
+procedure TJvTFControl.DoStartDrag(var DragObject: TDragObject);
+begin
+ inherited DoStartDrag(DragObject);
+
+ FDragInfo := TJvTFDragInfo.Create;
+ with FDragInfo do
+ begin
+ ApptCtrl := Self;
+ Shift := Self.FShift;
+ end;
+
+ {
+ Originally, a specific drag object was created and given to the DragObject
+ param. This worked fine. Because of differences in the VCL DragObject
+ hierarachy between D3 and D4, the decision was made to move away from
+ using a drag object.
+
+ FDragAppt := TDragAppt.Create(Self);
+ With FDragAppt do
+ Begin
+ ApptCtrl := Self;
+ Schedule := SelSchedule;
+ Appt := SelAppt;
+ Shift := FDragShift;
+ End;
+ DragObject := FDragAppt;
+ }
+end;
+
+procedure TJvTFControl.DoEndDrag(Target: TObject; X, Y: Integer);
+begin
+ inherited DoEndDrag(Target, X, Y);
+
+ FDragInfo.Free;
+ FDragInfo := nil;
+end;
+
+procedure TJvTFControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ inherited MouseDown(Button, Shift, X, Y);
+ FShift := Shift;
+end;
+
+function TJvTFControl.ScheduleCount: Integer;
+begin
+ Result := FSchedules.Count;
+end;
+
+function TJvTFControl.FindSchedule(const SchedName: string;
+ SchedDate: TDate): TJvTFSched;
+var
+ I: Integer;
+begin
+ Result := nil;
+
+ I := FSchedules.IndexOf(TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate));
+ if I > -1 then
+ Result := TJvTFSched(FSchedules.Objects[I]);
+end;
+
+function TJvTFControl.RetrieveSchedule(const SchedName: string;
+ SchedDate: TDate): TJvTFSched;
+begin
+ Result := FindSchedule(SchedName, SchedDate);
+
+ if not Assigned(Result) then
+ if Assigned(ScheduleManager) then
+ Result := ScheduleManager.RequestSchedule(Self, SchedName, SchedDate)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotRetrieveSchedule);
+end;
+
+procedure TJvTFControl.ReleaseSchedule(const SchedName: string;
+ SchedDate: TDate);
+var
+ SchedID: string;
+begin
+ SchedID := TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate);
+ if FSchedules.IndexOf(SchedID) > -1 then
+ if Assigned(ScheduleManager) then
+ ScheduleManager.ReleaseSchedule(Self, SchedName, SchedDate)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotReleaseSchedule);
+
+end;
+
+procedure TJvTFControl.ReleaseSchedules;
+begin
+ while ScheduleCount > 0 do
+ ReleaseSchedule(Schedules[0].SchedName, Schedules[0].SchedDate);
+end;
+
+procedure TJvTFControl.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ // If (AComponent = Navigator) and (Operation = opRemove) Then
+ // Navigator := nil;
+end;
+
+//procedure TJvTFControl.SetNavigator(Value: TJvTFNavigator);
+//begin
+// If Value <> FNavigator Then
+// Begin
+// If Assigned(FNavigator) Then
+// FNavigator.UnregisterControl(Self);
+// FNavigator := nil;
+//
+// If Assigned(Value) Then
+// Value.RegisterControl(Self);
+// FNavigator := Value;
+// End;
+//end;
+
+procedure TJvTFControl.Navigate(aControl: TJvTFControl;
+ SchedNames: TStringList; Dates: TJvTFDateList);
+begin
+ // If Assigned(FOnNavigate) Then
+ // FOnNavigate(Self, aControl, SchedNames, Dates);
+end;
+
+procedure TJvTFControl.ProcessBatches;
+begin
+ if Assigned(ScheduleManager) and (ScheduleManager.SchedLoadMode = slmBatch) then
+ ScheduleManager.ProcessBatches;
+end;
+
+//=== { TJvTFComponent } =====================================================
+
+constructor TJvTFComponent.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FSchedules := TStringList.Create;
+ FTimeFormat := 't'; // global short time format
+ FDateFormat := 'ddddd'; // global short date format
+end;
+
+destructor TJvTFComponent.Destroy;
+begin
+ ScheduleManager := nil;
+ FSchedules.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJvTFComponent.DestroyApptNotification(anAppt: TJvTFAppt);
+begin
+ // do nothing, leave implementation to descendants
+end;
+
+procedure TJvTFComponent.DestroySchedNotification(ASched: TJvTFSched);
+begin
+ // do nothing, leave implementation to descendants
+end;
+
+function TJvTFComponent.FindSchedule(const SchedName: string;
+ SchedDate: TDate): TJvTFSched;
+var
+ I: Integer;
+begin
+ Result := nil;
+
+ I := FSchedules.IndexOf(TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate));
+ if I > -1 then
+ Result := TJvTFSched(FSchedules.Objects[I]);
+end;
+
+function TJvTFComponent.GetSchedule(Index: Integer): TJvTFSched;
+begin
+ Result := TJvTFSched(FSchedules.Objects[Index]);
+end;
+
+procedure TJvTFComponent.Notify(Sender: TObject; Code: TJvTFServNotifyCode);
+begin
+ case Code of
+ sncRequestSchedule:
+ ReqSchedNotification(TJvTFSched(Sender));
+ sncReleaseSchedule:
+ RelSchedNotification(TJvTFSched(Sender));
+ sncRefresh:
+ RefreshComponent;
+ sncDestroyAppt:
+ DestroyApptNotification(TJvTFAppt(Sender));
+ sncDestroySchedule:
+ DestroySchedNotification(TJvTFSched(Sender));
+ end;
+end;
+
+procedure TJvTFComponent.NotifyManager(Serv: TJvTFScheduleManager; Sender: TObject;
+ Code: TJvTFServNotifyCode);
+begin
+ if Assigned(Serv) then
+ Serv.Notify(Sender, Code)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsEScheduleManagerNotificationFailedSc);
+end;
+
+procedure TJvTFComponent.ProcessBatches;
+begin
+ if Assigned(ScheduleManager) and (ScheduleManager.SchedLoadMode = slmBatch) then
+ ScheduleManager.ProcessBatches;
+end;
+
+procedure TJvTFComponent.RefreshComponent;
+begin
+ // do nothing, leave implementation to descendants
+end;
+
+procedure TJvTFComponent.ReleaseSchedule(const SchedName: string;
+ SchedDate: TDate);
+var
+ SchedID: string;
+begin
+ SchedID := TJvTFScheduleManager.GetScheduleID(SchedName, SchedDate);
+ if FSchedules.IndexOf(SchedID) > -1 then
+ if Assigned(ScheduleManager) then
+ ScheduleManager.ReleaseSchedule(Self, SchedName, SchedDate)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotReleaseSchedule);
+end;
+
+procedure TJvTFComponent.ReleaseSchedules;
+begin
+ while ScheduleCount > 0 do
+ ReleaseSchedule(Schedules[0].SchedName, Schedules[0].SchedDate);
+end;
+
+procedure TJvTFComponent.RelSchedNotification(Schedule: TJvTFSched);
+var
+ I: Integer;
+begin
+ I := FSchedules.IndexOfObject(Schedule);
+ if I > -1 then
+ FSchedules.Delete(I);
+end;
+
+procedure TJvTFComponent.ReqSchedNotification(Schedule: TJvTFSched);
+var
+ SchedID: string;
+begin
+ SchedID := TJvTFScheduleManager.GetScheduleID(Schedule.SchedName, Schedule.SchedDate);
+ if FSchedules.IndexOf(SchedID) = -1 then
+ FSchedules.AddObject(SchedID, Schedule);
+end;
+
+function TJvTFComponent.RetrieveSchedule(const SchedName: string;
+ SchedDate: TDate): TJvTFSched;
+begin
+ Result := FindSchedule(SchedName, SchedDate);
+
+ if not Assigned(Result) then
+ if Assigned(ScheduleManager) then
+ Result := ScheduleManager.RequestSchedule(Self, SchedName, SchedDate)
+ else
+ raise EJvTFScheduleManagerError.CreateRes(@RsECouldNotRetrieveSchedule);
+end;
+
+function TJvTFComponent.ScheduleCount: Integer;
+begin
+ Result := FSchedules.Count;
+end;
+
+procedure TJvTFComponent.SetDateFormat(const Value: string);
+begin
+ FDateFormat := Value;
+end;
+
+procedure TJvTFComponent.SetManager(Value: TJvTFScheduleManager);
+begin
+ if Value <> FScheduleManager then
+ begin
+ if Assigned(FScheduleManager) then
+ FScheduleManager.Notify(Self, sncDisconnectComponent);
+ FScheduleManager := nil;
+
+ if Assigned(Value) then
+ Value.Notify(Self, sncConnectComponent);
+ FScheduleManager := Value;
+ end;
+end;
+
+procedure TJvTFComponent.SetTimeFormat(const Value: string);
+begin
+ FTimeFormat := Value;
+end;
+
+procedure TJvTFComponent.UpdateDesigner;
+var
+ ParentForm: TCustomForm;
+begin
+ if (csDesigning in ComponentState) and not (csUpdating in ComponentState) then
+ begin
+ try
+ ParentForm := TCustomForm(Owner);
+ if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
+ ParentForm.Designer.Modified;
+ except
+ // handle the exception by doing nothing
+ end;
+ end;
+end;
+
+//=== { TJvTFPrinter } =======================================================
+
+constructor TJvTFPrinter.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ CreateLayout;
+ FMeasure := pmInches;
+ FPages := TStringList.Create;
+ FBodies := TStringList.Create;
+ InitializeMargins;
+end;
+
+destructor TJvTFPrinter.Destroy;
+begin
+ FreeDoc;
+ FBodies.Free;
+ FPages.Free;
+
+ FPageLayout.Free;
+ inherited Destroy;
+end;
+
+procedure TJvTFPrinter.AbortPrint;
+begin
+ if Printer.Printing then
+ Printer.Abort
+ else
+ FAborted := True;
+end;
+
+function TJvTFPrinter.ConvertMeasure(Value: Integer; FromMeasure,
+ ToMeasure: TJvTFPrinterMeasure; Horizontal: Boolean): Integer;
+const
+ MMFactor = 2.54;
+var
+ PPI: Integer;
+begin
+ PPI := 300; // wp -- just a workaround for next commented lines...
+ { wp --- to do
+ if Horizontal then
+ PPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX)
+ else
+ PPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSY);
+ }
+ if (FromMeasure = pmPixels) and (ToMeasure = pmInches) then
+ Result := round(Value / PPI * 100)
+ else
+ if (FromMeasure = pmPixels) and (ToMeasure = pmMM) then
+ Result := round(Value / PPI * 100 * MMFactor)
+ else
+ if (FromMeasure = pmInches) and (ToMeasure = pmPixels) then
+ Result := round(Value / 100 * PPI)
+ else
+ if (FromMeasure = pmInches) and (ToMeasure = pmMM) then
+ Result := round(Value * MMFactor)
+ else
+ if (FromMeasure = pmMM) and (ToMeasure = pmPixels) then
+ Result := round(Value / MMFactor / 100 * PPI)
+ else
+ if (FromMeasure = pmMM) and (ToMeasure = pmInches) then
+ Result := round(Value / MMFactor)
+ else
+ Result := Value;
+end;
+
+procedure TJvTFPrinter.CreateDoc;
+begin
+ if State = spsNoDoc then
+ begin
+ FState := spsCreating;
+ FAborted := False;
+
+ FDocDateTime := Now;
+ if DirectPrint then
+ Printer.BeginDoc;
+ end
+ else
+ raise EJvTFPrinterError.CreateRes(@RsECouldNotCreateADocumentBecauseA);
+end;
+
+procedure TJvTFPrinter.CreateLayout;
+begin
+ FPageLayout := TJvTFPrinterPageLayout.Create(Self);
+end;
+
+procedure TJvTFPrinter.DrawBody(aCanvas: TCanvas; ARect: TRect;
+ PageNum: Integer);
+begin
+ if Assigned(FOnDrawBody) then
+ FOnDrawBody(Self, aCanvas, ARect, PageNum);
+end;
+
+procedure TJvTFPrinter.DrawFooter(aCanvas: TCanvas; ARect: TRect;
+ PageNum: Integer);
+begin
+ if Assigned(FOnDrawFooter) then
+ FOnDrawFooter(Self, aCanvas, ARect, PageNum);
+end;
+
+procedure TJvTFPrinter.DrawHeader(aCanvas: TCanvas; ARect: TRect;
+ PageNum: Integer);
+begin
+ if Assigned(FOnDrawHeader) then
+ FOnDrawHeader(Self, aCanvas, ARect, PageNum);
+end;
+
+procedure TJvTFPrinter.FinishDoc;
+var
+ I: Integer;
+ { wp --- to do
+ aCanvas: TMetafileCanvas;
+ }
+ HeaderRect, FooterRect: TRect;
+begin
+ if Aborted then
+ Exit;
+
+ if State <> spsCreating then
+ raise EJvTFPrinterError.CreateRes(@RsECouldNotFinishDocumentBecauseNo);
+
+ FPageCount := FBodies.Count;
+ FState := spsAssembling;
+ try
+ if Assigned(FOnAssembleProgress) then
+ FOnAssembleProgress(Self, 0, FBodies.Count);
+
+ if DirectPrint then
+ Printer.EndDoc
+ else
+ begin
+ GetHeaderFooterRects(HeaderRect, FooterRect);
+ I := 0;
+ while (I < FBodies.Count) and not Aborted do
+ begin
+ { wp --- to do ...
+ aCanvas := TMetafileCanvas(FBodies.Objects[I]);
+
+ try
+ DrawHeader(aCanvas, HeaderRect, I + 1);
+ DrawFooter(aCanvas, FooterRect, I + 1);
+ finally
+ aCanvas.Free;
+ FBodies.Objects[I] := nil;
+ end;
+ }
+
+ if Assigned(FOnAssembleProgress) then
+ FOnAssembleProgress(Self, I + 1, FBodies.Count);
+
+ Inc(I);
+ Application.ProcessMessages;
+ end;
+ end;
+
+ FBodies.Clear;
+ finally
+ FState := spsFinished;
+ end;
+end;
+
+procedure TJvTFPrinter.FreeDoc;
+begin
+ while FBodies.Count > 0 do
+ begin
+ FBodies.Objects[0].Free;
+ FBodies.Delete(0);
+ end;
+
+ while FPages.Count > 0 do
+ begin
+ FPages.Objects[0].Free;
+ FPages.Delete(0);
+ end;
+
+ FState := spsNoDoc;
+end;
+
+function TJvTFPrinter.GetBodyHeight: Integer; // always in pixels
+var
+ PhysHeight, TopMarginPels, BottomMarginPels, HeaderPels, FooterPels: Integer;
+begin
+ { wp --- to do
+ PhysHeight := Windows.GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
+ }
+ TopMarginPels := ConvertMeasure(PageLayout.MarginTop, Measure, pmPixels, False);
+ BottomMarginPels := ConvertMeasure(PageLayout.MarginBottom, Measure, pmPixels, False);
+ HeaderPels := ConvertMeasure(PageLayout.HeaderHeight, Measure, pmPixels, False);
+ FooterPels := ConvertMeasure(PageLayout.FooterHeight, Measure, pmPixels, False);
+
+ Result := PhysHeight - TopMarginPels - BottomMarginPels -
+ HeaderPels - FooterPels;
+end;
+
+function TJvTFPrinter.GetBodyLeft: Integer; // always in pixels
+begin
+ Result := GetMarginOffset(1);
+end;
+
+function TJvTFPrinter.GetBodyTop: Integer; // always in pixels
+begin
+ Result := GetMarginOffset(2) +
+ ConvertMeasure(PageLayout.HeaderHeight, Measure, pmPixels, False) + 1;
+end;
+
+function TJvTFPrinter.GetBodyWidth: Integer; // always in pixels
+var
+ PhysWidth, LeftMarginPels, RightMarginPels: Integer;
+begin
+ { wp --- to do
+ PhysWidth := Windows.GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
+ }
+ LeftMarginPels := ConvertMeasure(PageLayout.MarginLeft, Measure, pmPixels, True);
+ RightMarginPels := ConvertMeasure(PageLayout.MarginRight, Measure, pmPixels, True);
+
+ Result := PhysWidth - LeftMarginPels - RightMarginPels;
+end;
+
+function TJvTFPrinter.GetDocDateTime: TDateTime;
+begin
+ if State = spsNoDoc then
+ raise EJvTFPrinterError.CreateRes(@RsEDocumentDoesNotExist);
+
+ Result := FDocDateTime;
+end;
+
+procedure TJvTFPrinter.GetHeaderFooterRects(var HeaderRect, FooterRect: TRect);
+begin
+ HeaderRect.Left := FMarginOffsets.Left;
+ HeaderRect.Top := FMarginOffsets.Top;
+ HeaderRect.Right := HeaderRect.Left + BodyWidth;
+ HeaderRect.Bottom := HeaderRect.Top + ConvertMeasure(PageLayout.HeaderHeight,
+ Measure, pmPixels, False);
+
+ FooterRect.Left := HeaderRect.Left;
+ FooterRect.Right := HeaderRect.Right;
+ FooterRect.Top := BodyTop + BodyHeight;
+ FooterRect.Bottom := FooterRect.Top + ConvertMeasure(PageLayout.FooterHeight,
+ Measure, pmPixels, False);
+end;
+
+function TJvTFPrinter.GetMarginOffset(Index: Integer): Integer;
+begin
+ case Index of
+ 1:
+ Result := FMarginOffsets.Left;
+ 2:
+ Result := FMarginOffsets.Top;
+ 3:
+ Result := FMarginOffsets.Right;
+ else
+ Result := FMarginOffsets.Bottom;
+ end;
+end;
+
+
+{ wp --- to do
+function TJvTFPrinter.GetPage(Index: Integer): TMetafile;
+begin
+ if DirectPrint then
+ raise EJvTFPrinterError.CreateRes(@RsEDocumentPagesCannotBeAccessedIf);
+
+ if State <> spsFinished then
+ raise EJvTFPrinterError.CreateRes(@RsEDocumentPagesAreInaccessibleUntil);
+ Result := TMetafile(FPages.Objects[Index]);
+end;
+}
+
+function TJvTFPrinter.GetPageCount: Integer;
+begin
+ case State of
+ spsNoDoc:
+ raise EJvTFPrinterError.CreateRes(@RsECouldNotRetrievePageCount);
+ spsCreating:
+ Result := FBodies.Count;
+ spsAssembling:
+ Result := FPageCount;
+ spsFinished:
+ Result := FPages.Count;
+ else
+ Result := -1;
+ end;
+end;
+
+function TJvTFPrinter.GetUnprintable: TJvTFMargins;
+var
+ LeftMarg, TopMarg, WidthPaper, HeightPaper, WidthPrintable, HeightPrintable: Integer;
+begin
+ { wp --- to do
+ LeftMarg := Windows.GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
+ TopMarg := Windows.GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
+ WidthPaper := Windows.GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
+ HeightPaper := Windows.GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
+ }
+ WidthPrintable := Printer.PageWidth;
+ HeightPrintable := Printer.PageHeight;
+
+ with Result do
+ begin
+ Left := LeftMarg;
+ Top := TopMarg;
+ Right := WidthPaper - WidthPrintable - LeftMarg;
+ Bottom := HeightPaper - HeightPrintable - TopMarg;
+ end;
+end;
+
+procedure TJvTFPrinter.InitializeMargins;
+var
+ I, Unprintable, NewMargin: Integer;
+ Horz: Boolean;
+begin
+ for I := 1 to 4 do
+ begin
+ SetMarginOffset(I, 0);
+
+ case I of
+ 1:
+ Unprintable := GetUnprintable.Left;
+ 2:
+ Unprintable := GetUnprintable.Top;
+ 3:
+ Unprintable := GetUnprintable.Right;
+ else
+ Unprintable := GetUnprintable.Bottom;
+ end;
+
+ Horz := (I = 1) or (I = 3);
+ NewMargin := ConvertMeasure(Unprintable, pmPixels, Measure, Horz);
+
+ case I of
+ 1:
+ PageLayout.FMargins.Left := NewMargin;
+ 2:
+ PageLayout.FMargins.Top := NewMargin;
+ 3:
+ PageLayout.FMargins.Right := NewMargin;
+ else
+ PageLayout.FMargins.Bottom := NewMargin;
+ end;
+ end;
+end;
+
+procedure TJvTFPrinter.MarginError;
+begin
+ if Assigned(FOnMarginError) then
+ FOnMarginError(Self);
+end;
+
+procedure TJvTFPrinter.NewDoc;
+begin
+ FreeDoc;
+ CreateDoc;
+end;
+
+procedure TJvTFPrinter.NewPage;
+var
+ { wp --- to do
+ aMetafile: TMetafile;
+ }
+ aCanvas: TCanvas;
+ HeaderRect, FooterRect: TRect;
+begin
+ if Aborted then
+ Exit;
+
+ { wp --- to do
+ if DirectPrint then
+ begin
+ if PageCount > 0 then
+ Printer.NewPage;
+ aCanvas := Printer.Canvas;
+ FPages.Add('');
+ end
+ else
+ begin
+ // Create a TMetafile for the page
+ aMetafile := TMetafile.Create;
+ FPages.AddObject('', aMetafile);
+ // Create a TMetafileCanvas as a canvas for the page.
+ // Store the canvas in FBodies so we can retrieve it later to draw
+ // the header and footer.
+ aCanvas := TMetafileCanvas.Create(aMetafile, Printer.Handle);
+ end;
+ FBodies.AddObject('', aCanvas);
+ aCanvas.Font.PixelsPerInch := Windows.GetDeviceCaps(Printer.Handle,
+ LOGPIXELSX);
+
+ Windows.SetViewPortOrgEx(aCanvas.Handle, BodyLeft, BodyTop, nil);
+ DrawBody(aCanvas, Rect(BodyLeft, BodyTop, BodyWidth - BodyLeft,
+ BodyHeight - BodyTop), FPages.Count);
+ Windows.SetViewPortOrgEx(aCanvas.Handle, 0, 0, nil);
+ if DirectPrint then
+ begin
+ GetHeaderFooterRects(HeaderRect, FooterRect);
+ DrawHeader(aCanvas, HeaderRect, PageCount);
+ DrawFooter(aCanvas, FooterRect, PageCount);
+ end;
+ }
+end;
+
+procedure TJvTFPrinter.Print;
+var
+ I: Integer;
+begin
+ if Aborted or DirectPrint then
+ Exit;
+
+ if State <> spsFinished then
+ raise EJvTFPrinterError.CreateRes(@RsEOnlyAFinishedDocumentCanBePrinted);
+ if PageCount = 0 then
+ raise EJvTFPrinterError.CreateRes(@RsEThereAreNoPagesToPrint);
+
+ if Assigned(FOnPrintProgress) then
+ FOnPrintProgress(Self, 0, PageCount);
+ Application.ProcessMessages;
+
+ Printer.Title := Title;
+ Printer.BeginDoc;
+ { wp --- to do ...
+ if not Printer.Aborted then
+ Printer.Canvas.Draw(0, 0, Pages[0]);
+
+ if Assigned(FOnPrintProgress) then
+ FOnPrintProgress(Self, 1, PageCount);
+ Application.ProcessMessages;
+
+ I := 1;
+ while (I < PageCount) and not Printer.Aborted do
+ begin
+ if not Printer.Aborted then
+ Printer.NewPage;
+ if not Printer.Aborted then
+ Printer.Canvas.Draw(0, 0, Pages[I]);
+ Inc(I);
+ if Assigned(FOnPrintProgress) then
+ FOnPrintProgress(Self, I, PageCount);
+ Application.ProcessMessages;
+ end;
+ }
+ if not Printer.Aborted then
+ Printer.EndDoc;
+end;
+
+function TJvTFPrinter.PrinterToScreen(Value: Integer;
+ Horizontal: Boolean): Integer;
+var
+ ScreenPPI, PrinterPPI: Integer;
+begin
+ { wp --- to do
+ ScreenPPI := Screen.PixelsPerInch;
+ if Horizontal then
+ PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX)
+ else
+ PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSY);
+ }
+ Result := Trunc(ScreenPPI / PrinterPPI * Value);
+end;
+
+procedure TJvTFPrinter.SaveDocToFiles(BaseFileName: TFileName);
+var
+ I: Integer;
+begin
+ if State <> spsFinished then
+ raise EJvTFPrinterError.CreateRes(@RsEDocumentMustBeFinishedToSaveToFile);
+
+ { wp --- to do
+ for I := 0 to PageCount - 1 do
+ Pages[I].SaveToFile(BaseFileName + '_' + IntToStr(I + 1) + '.emf');
+ }
+end;
+
+function TJvTFPrinter.ScreenToPrinter(Value: Integer;
+ Horizontal: Boolean): Integer;
+var
+ ScreenPPI, PrinterPPI: Integer;
+begin
+ ScreenPPI := Screen.PixelsPerInch;
+ { wp --- to do
+ if Horizontal then
+ PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSX)
+ else
+ PrinterPPI := Windows.GetDeviceCaps(Printer.Handle, LOGPIXELSY);
+ }
+ Result := Trunc(PrinterPPI / ScreenPPI * Value);
+end;
+
+procedure TJvTFPrinter.SetDirectPrint(Value: Boolean);
+begin
+ SetPropertyCheck;
+ FDirectPrint := Value;
+end;
+
+procedure TJvTFPrinter.SetMarginOffset(Index, Value: Integer);
+begin
+ // Allow negative value...
+ // SetMargin will catch that case and throw exception
+ case Index of
+ 1:
+ FMarginOffsets.Left := Value;
+ 2:
+ FMarginOffsets.Top := Value;
+ 3:
+ FMarginOffsets.Right := Value;
+ else
+ FMarginOffsets.Bottom := Value;
+ end;
+end;
+
+procedure TJvTFPrinter.SetMeasure(Value: TJvTFPrinterMeasure);
+begin
+ try
+ FConvertingProps := True;
+ if Value <> FMeasure then
+ begin
+ PageLayout.FHeaderHeight := ConvertMeasure(PageLayout.FHeaderHeight,
+ FMeasure, Value, False);
+ PageLayout.FFooterHeight := ConvertMeasure(PageLayout.FFooterHeight,
+ FMeasure, Value, False);
+
+ PageLayout.FMargins.Left := ConvertMeasure(PageLayout.FMargins.Left,
+ FMeasure, Value, True);
+ PageLayout.FMargins.Right := ConvertMeasure(PageLayout.FMargins.Right,
+ FMeasure, Value, True);
+ PageLayout.FMargins.Top := ConvertMeasure(PageLayout.FMargins.Top,
+ FMeasure, Value, False);
+ PageLayout.FMargins.Bottom := ConvertMeasure(PageLayout.FMargins.Bottom,
+ FMeasure, Value, False);
+ FMeasure := Value;
+ end;
+ finally
+ FConvertingProps := False;
+ end;
+end;
+
+procedure TJvTFPrinter.SetPageLayout(Value: TJvTFPrinterPageLayout);
+begin
+ FPageLayout.Assign(Value);
+end;
+
+procedure TJvTFPrinter.SetPropertyCheck;
+begin
+ if (State <> spsNoDoc) and not ConvertingProps then
+ raise EJvTFPrinterError.CreateRes(@RsEThisPropertyCannotBeChangedIfA);
+end;
+
+procedure TJvTFPrinter.SetTitle(const Value: string);
+begin
+ FTitle := Value;
+end;
+
+//=== { TJvTFPrinterPageLayout } =============================================
+
+constructor TJvTFPrinterPageLayout.Create(aPrinter: TJvTFPrinter);
+begin
+ inherited Create;
+ if not Assigned(aPrinter) then
+ raise EJvTFPrinterError.CreateRes(@RsECouldNotCreateTJvTFPrinterPageLayou);
+
+ FPrinter := aPrinter;
+end;
+
+procedure TJvTFPrinterPageLayout.Assign(Source: TPersistent);
+var
+ SourceMeas, DestMeas: TJvTFPrinterMeasure;
+ WorkVal: Integer;
+ SourceLayout: TJvTFPrinterPageLayout;
+begin
+ if (Source is TJvTFPrinterPageLayout) then
+ begin
+ if not Assigned(Printer) or not Assigned(TJvTFPrinterPageLayout(Source).Printer) then
+ Exit; // raise?
+ SourceLayout := TJvTFPrinterPageLayout(Source);
+ SourceMeas := SourceLayout.Printer.Measure;
+ DestMeas := Printer.Measure;
+
+ WorkVal := SourceLayout.MarginLeft;
+ WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, True);
+ SetMargin(1, WorkVal);
+
+ WorkVal := SourceLayout.MarginTop;
+ WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
+ SetMargin(2, WorkVal);
+
+ WorkVal := SourceLayout.MarginRight;
+ WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, True);
+ SetMargin(3, WorkVal);
+
+ WorkVal := SourceLayout.MarginBottom;
+ WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
+ SetMargin(4, WorkVal);
+
+ WorkVal := SourceLayout.HeaderHeight;
+ WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
+ SetHeaderHeight(WorkVal);
+
+ WorkVal := SourceLayout.FooterHeight;
+ WorkVal := Printer.ConvertMeasure(WorkVal, SourceMeas, DestMeas, False);
+ SetFooterHeight(WorkVal);
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFPrinterPageLayout.Change;
+begin
+ // do nothing, leave to descendants
+end;
+
+function TJvTFPrinterPageLayout.GetMargin(Index: Integer): Integer;
+begin
+ case Index of
+ 1:
+ Result := FMargins.Left;
+ 2:
+ Result := FMargins.Top;
+ 3:
+ Result := FMargins.Right;
+ else
+ Result := FMargins.Bottom;
+ end;
+end;
+
+procedure TJvTFPrinterPageLayout.SetFooterHeight(Value: Integer);
+var
+ Check: Integer;
+begin
+ SetPropertyCheck;
+
+ if Value < 0 then
+ Value := 0;
+
+ if Value <> FFooterHeight then
+ begin
+ Check := FFooterHeight;
+ FFooterHeight := Value;
+ if Printer.BodyHeight < 1 then
+ begin
+ FFooterHeight := Check;
+ raise EJvTFPrinterError.CreateResFmt(@RsEInvalidFooterHeightd, [Value]);
+ end
+ else
+ Change;
+ end;
+end;
+
+procedure TJvTFPrinterPageLayout.SetHeaderHeight(Value: Integer);
+var
+ Check: Integer;
+begin
+ SetPropertyCheck;
+
+ if Value < 0 then
+ Value := 0;
+ if Value <> FHeaderHeight then
+ begin
+ Check := FHeaderHeight;
+ FHeaderHeight := Value;
+ if Printer.BodyHeight < 1 then
+ begin
+ FHeaderHeight := Check;
+ raise EJvTFPrinterError.CreateResFmt(@RsEInvalidHeaderHeightd, [Value]);
+ end
+ else
+ Change;
+ end;
+end;
+
+procedure TJvTFPrinterPageLayout.SetMargin(Index, Value: Integer);
+var
+ Unprintable, UserMarginPels, CurrMargin, NewMargin: Integer;
+ Horz, Err: Boolean;
+begin
+ SetPropertyCheck;
+
+ CurrMargin := GetMargin(Index);
+ if Value <> CurrMargin then
+ begin
+ Horz := (Index = 1) or (Index = 3);
+ case Index of
+ 1:
+ Unprintable := Printer.GetUnprintable.Left;
+ 2:
+ Unprintable := Printer.GetUnprintable.Top;
+ 3:
+ Unprintable := Printer.GetUnprintable.Right;
+ else
+ Unprintable := Printer.GetUnprintable.Bottom;
+ end;
+
+ UserMarginPels := Printer.ConvertMeasure(Value, Printer.Measure,
+ pmPixels, Horz);
+ Printer.SetMarginOffset(Index, UserMarginPels - Unprintable);
+
+ if Printer.GetMarginOffset(Index) >= 0 then
+ begin
+ Err := False;
+ NewMargin := Value;
+ end
+ else
+ begin
+ Err := True;
+ Printer.SetMarginOffset(Index, 0);
+ NewMargin := Printer.ConvertMeasure(Unprintable, pmPixels,
+ Printer.Measure, Horz);
+ end;
+
+ if not Err then
+ case Index of
+ 1:
+ FMargins.Left := NewMargin;
+ 2:
+ FMargins.Top := NewMargin;
+ 3:
+ FMargins.Right := NewMargin;
+ else
+ FMargins.Bottom := NewMargin;
+ end
+ else
+ //SetMargin(Index, NewMargin);
+ case Index of
+ 1:
+ MarginLeft := NewMargin;
+ 2:
+ MarginTop := NewMargin;
+ 3:
+ MarginRight := NewMargin;
+ else
+ MarginBottom := NewMargin;
+ end;
+
+ if Err and Assigned(Printer) then
+ begin
+ Printer.UpdateDesigner;
+ Printer.MarginError;
+ end;
+
+ Change;
+ end;
+end;
+
+procedure TJvTFPrinterPageLayout.SetPropertyCheck;
+begin
+ Printer.SetPropertyCheck;
+end;
+
+//=== { TJvTFUniversalPrinter } ==============================================
+
+procedure TJvTFUniversalPrinter.CreateDoc;
+begin
+ inherited CreateDoc;
+end;
+
+procedure TJvTFUniversalPrinter.FinishDoc;
+begin
+ inherited FinishDoc;
+end;
+
+procedure TJvTFUniversalPrinter.NewDoc;
+begin
+ inherited NewDoc;
+end;
+
+procedure TJvTFUniversalPrinter.NewPage;
+begin
+ inherited NewPage;
+end;
+
+//=== { TJvTFHintProps } =====================================================
+
+constructor TJvTFHintProps.Create(AOwner: TJvTFControl);
+begin
+ inherited Create;
+ FControl := AOwner;
+
+ FHintColor := clDefault;
+ FHintHidePause := -1;
+ FHintPause := -1;
+end;
+
+procedure TJvTFHintProps.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFHint then
+ begin
+ FHintColor := TJvTFHintProps(Source).HintColor;
+ FHintHidePause := TJvTFHintProps(Source).HintHidePause;
+ FHintPause := TJvTFHintProps(Source).HintPause;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFHintProps.Change;
+begin
+ // do nothing
+end;
+
+procedure TJvTFHintProps.SetHintColor(Value: TColor);
+begin
+ if Value <> FHintColor then
+ begin
+ FHintColor := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFHintProps.SetHintHidePause(Value: Integer);
+begin
+ if Value < -1 then
+ Value := -1;
+
+ if Value <> FHintHidePause then
+ begin
+ FHintHidePause := Value;
+ Change;
+ end;
+end;
+
+procedure TJvTFHintProps.SetHintPause(Value: Integer);
+begin
+ if Value < -1 then
+ Value := -1;
+
+ if Value <> HintPause then
+ begin
+ FHintPause := Value;
+ Change;
+ end;
+end;
+
+//=== { TJvTFDWNames } =======================================================
+
+constructor TJvTFDWNames.Create;
+begin
+ inherited Create;
+ FSource := dwnsSysShort;
+ FDWN_Sunday := 'S';
+ FDWN_Monday := 'M';
+ FDWN_Tuesday := 'T';
+ FDWN_Wednesday := 'W';
+ FDWN_Thursday := 'T';
+ FDWN_Friday := 'F';
+ FDWN_Saturday := 'S';
+end;
+
+procedure TJvTFDWNames.Assign(Source: TPersistent);
+begin
+ if Source is TJvTFDWNames then
+ begin
+ FDWN_Sunday := TJvTFDWNames(Source).DWN_Sunday;
+ FDWN_Monday := TJvTFDWNames(Source).DWN_Monday;
+ FDWN_Tuesday := TJvTFDWNames(Source).DWN_Tuesday;
+ FDWN_Wednesday := TJvTFDWNames(Source).DWN_Wednesday;
+ FDWN_Thursday := TJvTFDWNames(Source).DWN_Thursday;
+ FDWN_Friday := TJvTFDWNames(Source).DWN_Friday;
+ FDWN_Saturday := TJvTFDWNames(Source).DWN_Saturday;
+ FSource := TJvTFDWNames(Source).Source;
+ Change;
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TJvTFDWNames.Change;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+function TJvTFDWNames.GetDWN(Index: Integer): string;
+begin
+ case Index of
+ 1:
+ Result := FDWN_Sunday;
+ 2:
+ Result := FDWN_Monday;
+ 3:
+ Result := FDWN_Tuesday;
+ 4:
+ Result := FDWN_Wednesday;
+ 5:
+ Result := FDWN_Thursday;
+ 6:
+ Result := FDWN_Friday;
+ 7:
+ Result := FDWN_Saturday;
+ else
+ Result := '';
+ end;
+end;
+
+function TJvTFDWNames.GetDWName(DWIndex: Integer): string;
+begin
+ case Source of
+ dwnsSysLong:
+ Result := FormatSettings.LongDayNames[DWIndex];
+ dwnsSysShort:
+ Result := FormatSettings.ShortDayNames[DWIndex];
+ else // dwnsCustom
+ Result := GetDWN(DWIndex);
+ end;
+end;
+
+procedure TJvTFDWNames.SetDWN(Index: Integer; const Value: string);
+begin
+ case Index of
+ 1:
+ FDWN_Sunday := Value;
+ 2:
+ FDWN_Monday := Value;
+ 3:
+ FDWN_Tuesday := Value;
+ 4:
+ FDWN_Wednesday := Value;
+ 5:
+ FDWN_Thursday := Value;
+ 6:
+ FDWN_Friday := Value;
+ 7:
+ FDWN_Saturday := Value;
+ end;
+
+ if Source = dwnsCustom then
+ Change;
+end;
+
+procedure TJvTFDWNames.SetSource(Value: TJvTFDWNameSource);
+begin
+ if Value <> FSource then
+ begin
+ FSource := Value;
+ Change;
+ end;
+end;
+
+//=== { TJvTFDateList } ======================================================
+
+constructor TJvTFDateList.Create;
+begin
+ inherited Create;
+ FList := TStringList.Create;
+ FList.Sorted := True;
+ FList.Duplicates := dupIgnore;
+end;
+
+destructor TJvTFDateList.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TJvTFDateList.Add(ADate: TDate): Integer;
+begin
+ Result := FList.Add(IntToStr(Trunc(ADate)));
+ Change;
+end;
+
+procedure TJvTFDateList.Change;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TJvTFDateList.Clear;
+begin
+ FList.Clear;
+ Change;
+end;
+
+function TJvTFDateList.Count: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TJvTFDateList.Delete(Index: Integer);
+begin
+ FList.Delete(Index);
+ Change;
+end;
+
+function TJvTFDateList.GetDate(Index: Integer): TDate;
+begin
+ Result := StrToInt(FList[Index]);
+end;
+
+function TJvTFDateList.IndexOf(ADate: TDate): Integer;
+begin
+ Result := FList.IndexOf(IntToStr(Trunc(ADate)));
+end;
+
+//=== { TJvTFNavigator } =====================================================
+
+//constructor TJvTFNavigator.Create(AOwner: TComponent);
+//begin
+// inherited Create(AOwner);
+// FControls := TStringList.Create;
+//end;
+//
+//destructor TJvTFNavigator.Destroy;
+//begin
+// While ControlCount > 0 do
+// UnregisterControl(Controls[0]);
+// FControls.Free;
+//
+// inherited Destroy;
+//end;
+//
+//function TJvTFNavigator.ControlCount: Integer;
+//begin
+// Result := FControls.Count;
+//end;
+//
+//function TJvTFNavigator.GetControl(Index: Integer): TJvTFControl;
+//begin
+// Result := TJvTFControl(FControls.Objects[Index]);
+//end;
+//
+//procedure TJvTFNavigator.Navigate(aControl: TJvTFControl;
+// SchedNames: TStringList; Dates: TJvTFDateList);
+//var
+// I: Integer;
+// Control: TJvTFControl;
+//begin
+// If Navigating or not Assigned(aControl) Then
+// Exit;
+//
+// If Assigned(FBeforeNavigate) Then
+// FBeforeNavigate(Self, aControl, SchedNames, Dates);
+//
+// FNavigating := True;
+// Try
+// For I := 0 to ControlCount - 1 do
+// Begin
+// Control := Controls[I];
+// If Control <> aControl Then
+// //Controls[I].Notify(aControl, sncNavigate);
+// Control.Navigate(aControl, SchedNames, Dates);
+// End;
+// Finally
+// FNavigating := False;
+// End;
+//
+// If Assigned(FAfterNavigate) Then
+// FAfterNavigate(Self, aControl, SchedNames, Dates);
+//end;
+//
+//procedure TJvTFNavigator.RegisterControl(aControl: TJvTFControl);
+//var
+// I: Integer;
+//begin
+// I := FControls.IndexOfObject(aControl);
+// If I = -1 Then
+// FControls.AddObject('', aControl);
+//end;
+//
+//procedure TJvTFNavigator.UnregisterControl(aControl: TJvTFControl);
+//var
+// I: Integer;
+//begin
+// I := FControls.IndexOfObject(aControl);
+// If I > -1 Then
+// FControls.Delete(I);
+//end;
+
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfmonths.pas b/components/jvcllaz/run/JvTimeFramework/jvtfmonths.pas
new file mode 100644
index 000000000..236f49dbd
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfmonths.pas
@@ -0,0 +1,611 @@
+{-----------------------------------------------------------------------------
+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: JvTFMonths.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFMonths;
+
+{$mode objfpc}{$H+}
+//{$mode delphi}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages,
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ JvTFGlance, JvTFUtils, JvTFManager;
+
+type
+ TJvTFMonthsScrollSize = (mssMonth, mssWeek);
+
+ TJvTFMonths = class(TJvTFCustomGlance)
+ private
+ FDisplayDate: TDate;
+ FDWNames: TJvTFDWNames;
+ FDWTitleAttr: TJvTFGlanceTitle;
+ FOnDrawDWTitle: TJvTFDrawDWTitleEvent;
+ FOnUpdateTitle: TJvTFUpdateTitleEvent;
+ FOffDays: TTFDaysOfWeek;
+ FExtraDayCellAttr: TJvTFGlanceCellAttr;
+ FOffDayCellAttr: TJvTFGlanceCellAttr;
+ FScrollSize: TJvTFMonthsScrollSize;
+ FSplitSatSun: Boolean;
+ FDayFormat: string;
+ FFirstDayOfMonthFormat: string;
+ function GetMonth: Word;
+ procedure SetMonth(Value: Word);
+ function GetYear: Word;
+ procedure SetYear(Value: Word);
+ procedure SetDisplayDate(Value: TDate);
+ procedure SetDWNames(Value: TJvTFDWNames);
+ procedure SetDWTitleAttr(Value: TJvTFGlanceTitle);
+ procedure SetOffDays(Value: TTFDaysOfWeek);
+ procedure SetExtraDayCellAttr(Value: TJvTFGlanceCellAttr);
+ procedure SetOffDayCellAttr(Value: TJvTFGlanceCellAttr);
+ procedure SetSplitSatSun(Value: Boolean);
+ procedure SetDayFormat(const Value: string);
+ procedure SetFirstDayOfMonthFormat(const Value: string);
+ protected
+ procedure SetStartOfWeek(Value: TTFDayOfWeek); override;
+ procedure SetColCount(Value: Integer); override;
+ procedure ConfigCells; override;
+ procedure DWNamesChange(Sender: TObject);
+ procedure Navigate(AControl: TJvTFControl; ASchedNames: TStringList;
+ Dates: TJvTFDateList); override;
+ // draws the DWTitles
+ procedure DrawTitle(ACanvas: TCanvas); override;
+ procedure UpdateTitle;
+ procedure NextMonth;
+ procedure PrevMonth;
+ procedure NextWeek;
+ procedure PrevWeek;
+ function GetCellTitleText(Cell: TJvTFGlanceCell): string; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDataTop: Integer; override;
+ function GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr; override;
+ function CellIsExtraDay(ACell: TJvTFGlanceCell): Boolean;
+ function CellIsOffDay(ACell: TJvTFGlanceCell): Boolean;
+ function DOWShowing(DOW: TTFDayOfWeek): Boolean;
+ procedure ScrollPrev;
+ procedure ScrollNext;
+ published
+ property ScrollSize: TJvTFMonthsScrollSize read FScrollSize write FScrollSize default mssMonth;
+ property Month: Word read GetMonth write SetMonth;
+ property Year: Word read GetYear write SetYear;
+ property DisplayDate: TDate read FDisplayDate write SetDisplayDate;
+ property DWNames: TJvTFDWNames read FDWNames write SetDWNames;
+ property DWTitleAttr: TJvTFGlanceTitle read FDWTitleAttr write SetDWTitleAttr;
+ property OffDays: TTFDaysOfWeek read FOffDays write SetOffDays default [dowSunday, dowSaturday];
+ property ExtraDayCellAttr: TJvTFGlanceCellAttr read FExtraDayCellAttr write SetExtraDayCellAttr;
+ property OffDayCellAttr: TJvTFGlanceCellAttr read FOffDayCellAttr write SetOffDayCellAttr;
+ property SplitSatSun: Boolean read FSplitSatSun write SetSplitSatSun default False;
+ property OnDrawDWTitle: TJvTFDrawDWTitleEvent read FOnDrawDWTitle write FOnDrawDWTitle;
+ property OnUpdateTitle: TJvTFUpdateTitleEvent read FOnUpdateTitle write FOnUpdateTitle;
+ property StartOfWeek;
+ property ColCount;
+ property FirstDayOfMonthFormat: string read FFirstDayOfMonthFormat write SetFirstDayOfMonthFormat;
+ property DayFormat: string read FDayFormat write SetDayFormat;
+// property Navigator;
+// property OnNavigate;
+ end;
+
+
+implementation
+
+uses
+ DateUtils;
+
+constructor TJvTFMonths.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ DisplayDate := Date;
+
+ FOffDays := [dowSunday, dowSaturday];
+ FScrollSize := mssMonth;
+
+ FDWNames := TJvTFDWNames.Create;
+ FDWNames.OnChange := @DWNamesChange;
+
+ FExtraDayCellAttr := TJvTFGlanceCellAttr.Create(Self);
+ FOffDayCellAttr := TJvTFGlanceCellAttr.Create(Self);
+
+ CellAttr.TitleAttr.Color := clWhite;
+ FExtraDayCellAttr.TitleAttr.Color := clWhite;
+ FOffDayCellAttr.TitleAttr.Color := clWhite;
+
+ FDayFormat := 'd';
+ FFirstDayOfMonthFormat := 'mmm d';
+
+ FDWTitleAttr := TJvTFGlanceTitle.Create(Self);
+ with FDWTitleAttr do
+ begin
+// Assign(TitleAttr);
+ TxtAttr.Font.Size := 8;
+ TxtAttr.Font.Style := [];
+ Height := 20;
+ Visible := True;
+ FrameAttr.Style := fs3DRaised;
+ OnChange := @GlanceTitleChange;
+ end;
+end;
+
+destructor TJvTFMonths.Destroy;
+begin
+ FDWNames.OnChange := nil;
+ FDWNames.Free;
+ FDWTitleAttr.Free;
+ FExtraDayCellAttr.Free;
+ FOffDayCellAttr.Free;
+
+ inherited Destroy;
+end;
+
+function TJvTFMonths.CellIsExtraDay(ACell: TJvTFGlanceCell): Boolean;
+var
+ Y, M, D: Word;
+begin
+ DecodeDate(ACell.CellDate, Y, M, D);
+ Result := (Y <> Self.Year) or (M <> Self.Month);
+end;
+
+function TJvTFMonths.CellIsOffDay(ACell: TJvTFGlanceCell): Boolean;
+begin
+ Result := DateToDOW(ACell.CellDate) in OffDays
+end;
+
+procedure TJvTFMonths.ConfigCells;
+var
+ Row, Col, SplitCount: Integer;
+ Cell: TJvTFGlanceCell;
+begin
+(*
+ For Row := 0 to RowCount - 1 do
+ For Col := 0 to ColCount - 1 do
+ begin
+ Cell := Cells.Cells[Col, Row];
+ if SplitSatSun and (DateToDow(Cell.CellDate) = dowSaturday) Then
+ SplitCell(Cell)
+ else
+ Cell.Combine;
+ end;
+
+{
+ Found := False;
+ Col := 0;
+ While (Col < ColCount) and not Found do
+ if DateToDOW(Cells.Cells[Col, 0].CellDate) = dowSaturday Then
+ Found := True
+ else
+ Inc(Col);
+
+ if Found Then
+ For Row := 0 to RowCount - 1 do
+ if SplitSatSun Then
+ SplitCell(Cells.Cells[Col, Row])
+ else
+ Cells.Cells[Col, Row].Combine;
+}
+*)
+
+ for Row := 0 to RowCount - 1 do
+ begin
+ SplitCount := 0;
+
+ for Col := 0 to ColCount - 1 do
+ begin
+ Cell := Cells.Cells[Col, Row];
+ SetCellDate(Cell, OriginDate + Row * 7 + Col + SplitCount);
+
+ if SplitSatSun and (DateToDOW(Cell.CellDate) = dowSaturday) then
+ SplitCell(Cell)
+ else
+ CombineCell(Cell);
+
+ if Cell.IsSplit then
+ begin
+ Inc(SplitCount);
+ SetCellDate(Cell.SubCell, OriginDate + Row * 7 + Col + SplitCount);
+ end;
+ end;
+ end;
+
+ inherited ConfigCells;
+end;
+
+function TJvTFMonths.DOWShowing(DOW: TTFDayOfWeek): Boolean;
+var
+ I: Integer;
+ TestDOW: TTFDayOfWeek;
+begin
+ // THIS ROUTINE SUPPORTS ONLY SAT/SUN SPLITS
+ if (DOW = dowSunday) and SplitSatSun then
+ Result := DOWShowing(dowSaturday)
+ else
+ begin
+ I := 0;
+ Result := False;
+ TestDOW := StartOfWeek;
+ while (I < ColCount) and not Result do
+ if TestDOW = DOW then
+ Result := True
+ else
+ IncDOW(TestDOW, 1);
+ end;
+end;
+
+procedure TJvTFMonths.DrawTitle(ACanvas: TCanvas);
+var
+ I, Col, LineBottom: Integer;
+ CurrDOW: TTFDayOfWeek;
+ R, TempRect, TxtRect, TextBounds: TRect;
+ OldPen: TPen;
+ OldBrush: TBrush;
+ OldFont: TFont;
+ Txt: string;
+begin
+ inherited DrawTitle(ACanvas);
+ if not DWTitleAttr.Visible then
+ Exit;
+
+ with ACanvas do
+ begin
+ OldPen := TPen.Create;
+ OldPen.Assign(Pen);
+ OldBrush := TBrush.Create;
+ OldBrush.Assign(Brush);
+ OldFont := TFont.Create;
+ OldFont.Assign(Font);
+ end;
+
+ // draw the DWTitles
+ R.Top := inherited GetDataTop;
+ R.Bottom := GetDataTop;
+
+ CurrDOW := StartOfWeek;
+
+ for Col := 0 to ColCount - 1 do
+ begin
+ TempRect := WholeCellRect(Col, 0);
+ R.Left := TempRect.Left;
+ R.Right := TempRect.Right;
+ TxtRect := R;
+ InflateRect(TxtRect, -1, -1);
+
+ with ACanvas do
+ begin
+ Brush.Color := DWTitleAttr.Color;
+ FillRect(R);
+
+ case DWTitleAttr.FrameAttr.Style of
+ fs3DRaised:
+ Draw3DFrame(ACanvas, R, clBtnHighlight, clBtnShadow);
+ fs3DLowered:
+ Draw3DFrame(ACanvas, R, clBtnShadow, clBtnHighlight);
+ fsFlat:
+ begin
+ Pen.Color := DWTitleAttr.FrameAttr.Color;
+ Pen.Width := DWTitleAttr.FrameAttr.Width;
+ if Col = 0 then
+ begin
+ MoveTo(R.Left, R.Top);
+ LineTo(R.Left, R.Bottom);
+ end;
+ PolyLine([Point(R.Right - 1, R.Top),
+ Point(R.Right - 1, R.Bottom - 1),
+ Point(R.Left - 1, R.Bottom - 1)]);
+ end;
+ fsNone:
+ begin
+ Pen.Color := DWTitleAttr.FrameAttr.Color;
+ Pen.Width := 1;
+ LineBottom := R.Bottom - 1;
+ for I := 1 to DWTitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(R.Left, LineBottom);
+ LineTo(R.Right, LineBottom);
+ Dec(LineBottom);
+ end;
+ end;
+ end;
+
+ Txt := DWNames.GetDWName(DOWToBorl(CurrDOW));
+ if SplitSatSun and (CurrDOW = dowSaturday) then
+ begin
+ IncDOW(CurrDOW, 1);
+ Txt := Txt + '/' + DWNames.GetDWName(DOWToBorl(CurrDOW));
+ end;
+
+ Font := DWTitleAttr.TxtAttr.Font;
+ DrawAngleText(ACanvas, TxtRect, TextBounds,
+ DWTitleAttr.TxtAttr.Rotation,
+ DWTitleAttr.TxtAttr.AlignH,
+ DWTitleAttr.TxtAttr.AlignV, Txt);
+ end;
+
+ if Assigned(FOnDrawDWTitle) then
+ FOnDrawDWTitle(Self, ACanvas, R, CurrDOW, Txt);
+
+ IncDOW(CurrDOW, 1);
+ end;
+
+ with ACanvas do
+ begin
+ Pen.Assign(OldPen);
+ Brush.Assign(OldBrush);
+ Font.Assign(OldFont);
+ OldPen.Free;
+ OldBrush.Free;
+ OldFont.Free;
+ end;
+end;
+
+procedure TJvTFMonths.DWNamesChange(Sender: TObject);
+begin
+ Invalidate;
+end;
+
+function TJvTFMonths.GetCellAttr(ACell: TJvTFGlanceCell): TJvTFGlanceCellAttr;
+begin
+ if CellIsSelected(ACell) then
+ Result := SelCellAttr
+ else
+ if CellIsExtraDay(ACell) then
+ Result := ExtraDayCellAttr
+ else
+ if CellIsOffDay(ACell) then
+ Result := OffDayCellAttr
+ else
+ Result := CellAttr;
+end;
+
+function TJvTFMonths.GetCellTitleText(Cell: TJvTFGlanceCell): string;
+begin
+ if CellIsExtraDay(Cell) and (IsFirstOfMonth(Cell.CellDate) or EqualDates(Cell.CellDate, OriginDate)) then
+ Result := FormatDateTime(FirstDayOfMonthFormat, Cell.CellDate)
+ else
+ Result := FormatDateTime(DayFormat, Cell.CellDate);
+end;
+
+function TJvTFMonths.GetDataTop: Integer;
+begin
+ Result := inherited GetDataTop;
+ if DWTitleAttr.Visible then
+ Inc(Result, DWTitleAttr.Height);
+end;
+
+function TJvTFMonths.GetMonth: Word;
+begin
+ Result := ExtractMonth(DisplayDate);
+end;
+
+function TJvTFMonths.GetYear: Word;
+begin
+ Result := ExtractYear(DisplayDate);
+end;
+
+procedure TJvTFMonths.Navigate(AControl: TJvTFControl;
+ ASchedNames: TStringList; Dates: TJvTFDateList);
+begin
+ inherited Navigate(AControl, ASchedNames, Dates);
+ if Dates.Count > 0 then
+ DisplayDate := Dates[0];
+end;
+
+procedure TJvTFMonths.NextMonth;
+var
+ Temp: TDateTime;
+begin
+ Temp := DisplayDate;
+ IncMonths(Temp, 1);
+ DisplayDate := Temp;
+end;
+
+procedure TJvTFMonths.NextWeek;
+var
+ Temp: TDateTime;
+begin
+ Temp := DisplayDate;
+ IncWeeks(Temp, 1);
+ DisplayDate := Temp;
+end;
+
+procedure TJvTFMonths.PrevMonth;
+var
+ Temp: TDateTime;
+begin
+ Temp := DisplayDate;
+ IncMonths(Temp, -1);
+ DisplayDate := Temp;
+end;
+
+procedure TJvTFMonths.PrevWeek;
+var
+ Temp: TDateTime;
+begin
+ Temp := DisplayDate;
+ IncWeeks(Temp, -1);
+ DisplayDate := Temp;
+end;
+
+procedure TJvTFMonths.ScrollNext;
+begin
+ if ScrollSize = mssMonth then
+ NextMonth
+ else
+ NextWeek;
+end;
+
+procedure TJvTFMonths.ScrollPrev;
+begin
+ if ScrollSize = mssMonth then
+ PrevMonth
+ else
+ PrevWeek;
+end;
+
+procedure TJvTFMonths.SetColCount(Value: Integer);
+begin
+ Value := Lesser(Value, 7);
+ inherited SetColCount(Value);
+end;
+
+procedure TJvTFMonths.SetDayFormat(const Value: string);
+begin
+ if Value <> FDayFormat then
+ begin
+ FDayFormat := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFMonths.SetDisplayDate(Value: TDate);
+begin
+ FDisplayDate := Value;
+ if ScrollSize = mssMonth then
+ StartDate := FirstOfMonth(Value)
+ else
+ StartDate := Value;
+ UpdateTitle;
+end;
+
+procedure TJvTFMonths.SetDWNames(Value: TJvTFDWNames);
+begin
+ FDWNames.Assign(Value);
+end;
+
+procedure TJvTFMonths.SetDWTitleAttr(Value: TJvTFGlanceTitle);
+begin
+ FDWTitleAttr.Assign(Value);
+end;
+
+procedure TJvTFMonths.SetExtraDayCellAttr(Value: TJvTFGlanceCellAttr);
+begin
+ FExtraDayCellAttr.Assign(Value);
+end;
+
+procedure TJvTFMonths.SetFirstDayOfMonthFormat(const Value: string);
+begin
+ if Value <> FFirstDayOfMonthFormat then
+ begin
+ FFirstDayOfMonthFormat := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFMonths.SetMonth(Value: Word);
+var
+ Y, M, D: Word;
+begin
+ // Don't set the month while loading, the DisplayDate will be loaded as well
+ if csLoading in ComponentState then
+ Exit;
+
+ EnsureMonth(Value);
+
+ DecodeDate(DisplayDate, Y, M, D);
+ if Value <> M then
+ begin
+ // Ensure the day is still inside the valid values for the new month
+ if D > DaysInAMonth(Y, Value) then
+ D := DaysInAMonth(Y, Value);
+ DisplayDate := EncodeDate(Y, Value, D);
+ end;
+end;
+
+procedure TJvTFMonths.SetOffDayCellAttr(Value: TJvTFGlanceCellAttr);
+begin
+ FOffDayCellAttr.Assign(Value);
+end;
+
+procedure TJvTFMonths.SetOffDays(Value: TTFDaysOfWeek);
+begin
+ if Value <> FOffDays then
+ begin
+ FOffDays := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TJvTFMonths.SetSplitSatSun(Value: Boolean);
+begin
+ if Value <> FSplitSatSun then
+ begin
+ if DOWShowing(dowSunday) or DOWShowing(dowSaturday) then
+ if Value then
+ begin
+ if StartOfWeek = dowSunday then
+ StartOfWeek := dowMonday;
+ ColCount := ColCount - 1;
+ end
+ else
+ ColCount := ColCount + 1;
+
+ FSplitSatSun := Value;
+ Cells.ReconfigCells;
+ end;
+end;
+
+procedure TJvTFMonths.SetStartOfWeek(Value: TTFDayOfWeek);
+begin
+ if SplitSatSun and (Value = dowSunday) then
+ Value := dowSaturday;
+ inherited SetStartOfWeek(Value);
+end;
+
+procedure TJvTFMonths.SetYear(Value: Word);
+var
+ Y, M, D: Word;
+begin
+ // Don't set the year while loading, the DisplayDate will be loaded as well
+ if csLoading in ComponentState then
+ Exit;
+
+ DecodeDate(DisplayDate, Y, M, D);
+ if Value <> Y then
+ begin
+ // Ensure the day is still inside the valid values for the month of
+ // the new year. This case only happens with February, by the way.
+ if D > DaysInAMonth(Value, M) then
+ D := DaysInAMonth(Value, M);
+ DisplayDate := EncodeDate(Value, M, D);
+ end;
+end;
+
+procedure TJvTFMonths.UpdateTitle;
+var
+ NewTitle: string;
+begin
+ NewTitle := FormatDateTime('mmmm yyyy', DisplayDate);
+ if NewTitle <> TitleAttr.Title then
+ begin
+ if Assigned(FOnUpdateTitle) then
+ FOnUpdateTitle(Self, NewTitle);
+ TitleAttr.Title := NewTitle;
+ end;
+end;
+
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfsparsematrix.pas b/components/jvcllaz/run/JvTimeFramework/jvtfsparsematrix.pas
new file mode 100644
index 000000000..a9402f30f
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfsparsematrix.pas
@@ -0,0 +1,269 @@
+{-----------------------------------------------------------------------------
+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: JvTFSparseMatrix.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFSparseMatrix;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+// NativeInt = Integer;
+
+ EJvTFSparseMatrixError = class(Exception);
+ PSMQuantum = ^TSMQuantum;
+ TSMQuantum = record
+ Index: Integer;
+ Data: NativeInt;
+ Link: PSMQuantum;
+ end;
+
+ TJvTFSparseMatrix = class(TObject)
+ private
+ FMatrix: TSMQuantum;
+ FNullValue: NativeInt;
+ procedure SetNullValue(Value: NativeInt);
+ function GetData(Row, Col: Integer): NativeInt;
+ procedure SetData(Row, Col: Integer; Value: NativeInt);
+ procedure Put(Row, Col: Integer; Data: NativeInt);
+ function Get(Row, Col: Integer): NativeInt;
+ function FindQuantum(Row, Col: Integer;
+ var Prev, Curr: PSMQuantum; var RowExists: Boolean): Boolean;
+ public
+ destructor Destroy; override;
+ procedure Clear;
+ procedure Pack;
+ procedure CopyTo(DestMatrix: TJvTFSparseMatrix);
+ property Data[Row, Col: Integer]: NativeInt read GetData write SetData; default;
+ property NullValue: NativeInt read FNullValue write SetNullValue default 0;
+ procedure Dump(const DumpList: TStrings);
+ end;
+
+
+implementation
+
+uses
+ JvResources;
+
+destructor TJvTFSparseMatrix.Destroy;
+begin
+ Clear;
+ inherited Destroy;
+end;
+
+procedure TJvTFSparseMatrix.Clear;
+var
+ P, CurrRow, CurrCol: PSMQuantum;
+begin
+ CurrRow := PSMQuantum(FMatrix.Data);
+
+ while CurrRow <> nil do
+ begin
+ CurrCol := CurrRow^.Link;
+ while CurrCol <> nil do
+ begin
+ P := CurrCol;
+ CurrCol := CurrCol^.Link;
+ Dispose(P);
+ end;
+
+ P := CurrRow;
+ CurrRow := PSMQuantum(CurrRow^.Data);
+ Dispose(P);
+ end;
+
+ FMatrix.Data := 0;
+end;
+
+procedure TJvTFSparseMatrix.CopyTo(DestMatrix: TJvTFSparseMatrix);
+var
+ CurrRow, CurrCol: PSMQuantum;
+begin
+ DestMatrix.Clear;
+ DestMatrix.NullValue := NullValue;
+
+ CurrRow := PSMQuantum(FMatrix.Data);
+
+ while CurrRow <> nil do
+ begin
+ CurrCol := CurrRow^.Link;
+ while CurrCol <> nil do
+ begin
+ DestMatrix[CurrRow^.Index, CurrCol^.Index] := CurrCol^.Data;
+ CurrCol := CurrCol^.Link;
+ end;
+
+ CurrRow := PSMQuantum(CurrRow^.Data);
+ end;
+end;
+
+procedure TJvTFSparseMatrix.Dump(const DumpList: TStrings);
+var
+ CurrRow, CurrCol: PSMQuantum;
+begin
+ DumpList.Clear;
+ CurrRow := PSMQuantum(FMatrix.Data);
+ DumpList.BeginUpdate;
+ try
+ while CurrRow <> nil do
+ begin
+ CurrCol := CurrRow^.Link;
+ while CurrCol <> nil do
+ begin
+ DumpList.Add('(' + IntToStr(CurrRow^.Index) + ', ' +
+ IntToStr(CurrCol^.Index) + ') ' +
+ IntToStr(CurrCol^.Data));
+ CurrCol := CurrCol^.Link;
+ end;
+ CurrRow := PSMQuantum(CurrRow^.Data);
+ end;
+ finally
+ DumpList.EndUpdate;
+ end;
+end;
+
+function TJvTFSparseMatrix.FindQuantum(Row, Col: Integer;
+ var Prev, Curr: PSMQuantum; var RowExists: Boolean): Boolean;
+begin
+ Prev := @FMatrix;
+ Curr := PSMQuantum(FMatrix.Data);
+ Result := False;
+ RowExists := False;
+
+ // Find Row Header
+ while (Curr <> nil) and (Curr^.Index < Row) do
+ begin
+ Prev := Curr;
+ Curr := PSMQuantum(Curr^.Data);
+ end;
+
+ // If Row Header found, then find col
+ if (Curr <> nil) and (Curr^.Index = Row) then
+ begin
+ RowExists := True;
+ Prev := Curr;
+ Curr := Curr^.Link;
+ while (Curr <> nil) and (Curr^.Index < Col) do
+ begin
+ Prev := Curr;
+ Curr := Curr^.Link;
+ end;
+
+ Result := (Curr <> nil) and (Curr^.Index = Col);
+ end;
+end;
+
+function TJvTFSparseMatrix.Get(Row, Col: Integer): NativeInt;
+var
+ Prev, Curr: PSMQuantum;
+ RowExists: Boolean;
+begin
+ if FindQuantum(Row, Col, Prev, Curr, RowExists) then
+ Result := Curr^.Data
+ else
+ Result := NullValue;
+end;
+
+function TJvTFSparseMatrix.GetData(Row, Col: Integer): NativeInt;
+begin
+ Result := Get(Row, Col);
+end;
+
+procedure TJvTFSparseMatrix.Put(Row, Col: Integer; Data: NativeInt);
+var
+ P, Prev, Curr: PSMQuantum;
+ RowExists: Boolean;
+begin
+ if FindQuantum(Row, Col, Prev, Curr, RowExists) then
+ if Data <> NullValue then
+ Curr^.Data := Data
+ else
+ begin
+ Prev^.Link := Curr^.Link;
+ Dispose(Curr);
+ end
+ else
+ if Data <> NullValue then
+ begin
+ if not RowExists then
+ begin
+ New(P);
+ P^.Index := Row;
+ P^.Link := nil;
+ P^.Data := Prev^.Data;
+ PSMQuantum(Prev^.Data) := P;
+ Prev := P;
+ end;
+
+ New(P);
+ P^.Index := Col;
+ P^.Data := Data;
+ P^.Link := Prev^.Link;
+ Prev^.Link := P;
+ end;
+end;
+
+procedure TJvTFSparseMatrix.SetData(Row, Col: Integer; Value: NativeInt);
+begin
+ Put(Row, Col, Value);
+end;
+
+procedure TJvTFSparseMatrix.SetNullValue(Value: NativeInt);
+begin
+ if FMatrix.Data = 0 then
+ FNullValue := Value
+ else
+ raise EJvTFSparseMatrixError.CreateRes(@RsEMatrixMustBeEmpty);
+end;
+
+procedure TJvTFSparseMatrix.Pack;
+var
+ P, Prev, CurrRow: PSMQuantum;
+begin
+ CurrRow := PSMQuantum(FMatrix.Data);
+ Prev := @FMatrix;
+
+ while CurrRow <> nil do
+ begin
+ if CurrRow^.Link <> nil then
+ begin
+ Prev := CurrRow;
+ CurrRow := PSMQuantum(CurrRow^.Data);
+ end
+ else
+ begin
+ P := CurrRow;
+ Prev^.Data := CurrRow^.Data;
+ Dispose(P);
+ CurrRow := PSMQuantum(Prev^.Data);
+ end;
+ end;
+end;
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas b/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas
new file mode 100644
index 000000000..b6bb036c6
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfutils.pas
@@ -0,0 +1,827 @@
+{-----------------------------------------------------------------------------
+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: JvTFUtils.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ //Windows,
+ LCLType, LCLIntf, Types,
+ Graphics, Controls, Classes, SysUtils;
+
+(*
+{$IFNDEF COMPILER12_UP} // Delphi 2009 knows System::TDate and System::TTime
+{$HPPEMIT '#ifndef TDate'}
+{$HPPEMIT '#define TDate Controls::TDate'}
+{$HPPEMIT '#define TTime Controls::TTime'}
+{$HPPEMIT '#endif'}
+{$ENDIF ~COMPILER12_UP}
+*)
+
+type
+ TJvTFVisibleScrollBars = set of (vsbHorz, vsbVert);
+ EJvTFDateError = class(Exception);
+
+ TTFDayOfWeek = (dowSunday, dowMonday, dowTuesday, dowWednesday,
+ dowThursday, dowFriday, dowSaturday);
+ TTFDaysOfWeek = set of TTFDayOfWeek;
+
+ TJvTFVAlignment = (vaTop, vaCenter, vaBottom);
+
+ TJvTFDirection = (dirUp, dirDown, dirLeft, dirRight);
+
+const
+ DOW_WEEK: TTFDaysOfWeek = [dowSunday..dowSaturday];
+ DOW_WEEKEND: TTFDaysOfWeek = [dowSunday, dowSaturday];
+ DOW_WORKWEEK: TTFDaysOfWeek = [dowMonday..dowFriday];
+
+ ONE_HOUR = 1 / 24;
+ ONE_MINUTE = ONE_HOUR / 60;
+ ONE_SECOND = ONE_MINUTE / 60;
+ ONE_MILLISECOND = ONE_SECOND / 1000;
+
+function ExtractYear(ADate: TDateTime): Word;
+function ExtractMonth(ADate: TDateTime): Word;
+function ExtractDay(ADate: TDateTime): Word;
+function ExtractHours(ATime: TDateTime): Word;
+function ExtractMins(ATime: TDateTime): Word;
+function ExtractSecs(ATime: TDateTime): Word;
+function ExtractMSecs(ATime: TDateTime): Word;
+function FirstOfMonth(ADate: TDateTime): TDateTime;
+function GetDayOfNthDOW(Year, Month, DOW, N: Word): Word;
+function GetWeeksInMonth(Year, Month: Word; StartOfWeek: Integer): Word;
+
+procedure IncBorlDOW(var BorlDOW: Integer; N: Integer = 1);
+procedure IncDOW(var DOW: TTFDayOfWeek; N: Integer = 1);
+procedure IncDays(var ADate: TDateTime; N: Integer = 1);
+procedure IncWeeks(var ADate: TDateTime; N: Integer = 1);
+procedure IncMonths(var ADate: TDateTime; N: Integer = 1);
+procedure IncYears(var ADate: TDateTime; N: Integer = 1);
+
+function EndOfMonth(ADate: TDateTime): TDateTime;
+function IsFirstOfMonth(ADate: TDateTime): Boolean;
+function IsEndOfMonth(ADate: TDateTime): Boolean;
+procedure EnsureMonth(Month: Word);
+procedure EnsureDOW(DOW: Word);
+function EqualDates(D1, D2: TDateTime): Boolean;
+function Lesser(N1, N2: Integer): Integer;
+function Greater(N1, N2: Integer): Integer;
+function GetDivLength(TotalLength, DivCount, DivNum: Integer): Integer;
+function GetDivNum(TotalLength, DivCount, X: Integer): Integer;
+function GetDivStart(TotalLength, DivCount, DivNum: Integer): Integer;
+function DOWToBorl(ADOW: TTFDayOfWeek): Integer;
+function BorlToDOW(BorlDOW: Integer): TTFDayOfWeek;
+function DateToDOW(ADate: TDateTime): TTFDayOfWeek;
+
+procedure CalcTextPos(ACanvas: TCanvas;
+ HostRect: TRect; var TextLeft, TextTop: Integer;
+ var TextBounds: TRect; AFont: TFont; AAngle: Integer;
+ HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: String);
+{
+procedure CalcTextPos(HostRect: TRect; var TextLeft, TextTop: Integer;
+ var TextBounds: TRect; AFont: TFont; AAngle: Integer;
+ HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: string);
+}
+procedure DrawAngleText(ACanvas: TCanvas; HostRect: TRect;
+ var TextBounds: TRect; AAngle: Integer; HAlign: TAlignment;
+ VAlign: TJvTFVAlignment; ATxt: string);
+
+function RectWidth(ARect: TRect): Integer;
+function RectHeight(ARect: TRect): Integer;
+function EmptyRect: TRect;
+function IsClassByName(Obj: TObject; ClassName: string): Boolean;
+
+function StringsToStr(const List: TStrings; const Sep: string;
+ const AllowEmptyString: Boolean = True): string;
+
+implementation
+
+uses
+ Math, JvResources;
+
+function ExtractYear(ADate: TDateTime): Word;
+var
+ M, D: Word;
+begin
+ DecodeDate(ADate, Result, M, D);
+end;
+
+function ExtractMonth(ADate: TDateTime): Word;
+var
+ Y, D: Word;
+begin
+ DecodeDate(ADate, Y, Result, D);
+end;
+
+function ExtractDay(ADate: TDateTime): Word;
+var
+ Y, M: Word;
+begin
+ DecodeDate(ADate, Y, M, Result);
+end;
+
+function FirstOfMonth(ADate: TDateTime): TDateTime;
+var
+ Y, M, D: Word;
+begin
+ DecodeDate(ADate, Y, M, D);
+ Result := EncodeDate(Y, M, 1);
+end;
+
+function GetDayOfNthDOW(Year, Month, DOW, N: Word): Word;
+var
+ FirstDayDOW: Word;
+ WorkDate: TDateTime;
+begin
+ WorkDate := EncodeDate(Year, Month, 1);
+ FirstDayDOW := DayOfWeek(WorkDate);
+ WorkDate := WorkDate + (DOW - FirstDayDOW);
+ if DOW < FirstDayDOW then
+ WorkDate := WorkDate + 7;
+
+ // WorkDate is now at the first DOW
+ // Now adjust for N
+ WorkDate := WorkDate + (7 * (N - 1));
+
+ Result := ExtractDay(WorkDate);
+ // Finally, check to make sure WorkDate is in the given month
+ if Trunc(EncodeDate(Year, Month, 1)) <> Trunc(FirstOfMonth(WorkDate)) then
+ raise EJvTFDateError.CreateRes(@RsEResultDoesNotFallInMonth);
+end;
+
+function GetWeeksInMonth(Year, Month: Word; StartOfWeek: Integer): Word;
+var
+ DOW,
+ EndOfWeek: Integer;
+ EOM,
+ WorkDate: TDateTime;
+begin
+ // Get the end of the week
+ EndOfWeek := StartOfWeek;
+ IncBorlDOW(EndOfWeek, -1);
+
+ // Start working at the first of the month
+ WorkDate := EncodeDate(Year, Month, 1);
+
+ // Get the end of the month
+ EOM := EndOfMonth(WorkDate);
+
+ // Get the day the first falls on
+ DOW := DayOfWeek(WorkDate);
+
+ // Advance WorkDate to the end of the week
+ while DOW <> EndOfWeek do
+ begin
+ IncBorlDOW(DOW, 1);
+ WorkDate := WorkDate + 1;
+ end;
+
+ // We're now on week 1
+ Result := 1;
+ // Now roll through the rest of the month
+ while Trunc(WorkDate) < Trunc(EOM) do
+ begin
+ Inc(Result);
+ IncWeeks(WorkDate, 1);
+ end;
+end;
+
+procedure IncBorlDOW(var BorlDOW: Integer; N: Integer); // N defaults to 1
+begin
+ BorlDOW := (BorlDOW + (N mod 7)) mod 7;
+ if BorlDOW = 0 then
+ BorlDOW := 7;
+ BorlDOW := Abs(BorlDOW);
+end;
+
+procedure IncDOW(var DOW: TTFDayOfWeek; N: Integer);
+ // N defaults to 1
+var
+ BorlDOW: Integer;
+begin
+ BorlDOW := DOWToBorl(DOW);
+ IncBorlDOW(BorlDOW, N);
+ DOW := BorlToDOW(BorlDOW);
+end;
+
+procedure IncDays(var ADate: TDateTime; N: Integer);
+ // N defaults to 1
+begin
+ ADate := ADate + N;
+end;
+
+procedure IncWeeks(var ADate: TDateTime; N: Integer);
+ // N defaults to 1
+begin
+ ADate := ADate + N * 7;
+end;
+
+procedure IncMonths(var ADate: TDateTime; N: Integer);
+ // N defaults to 1
+var
+ Y, M, D, EOMD: Word;
+ X : Cardinal;
+begin
+ DecodeDate(ADate, Y, M, D);
+ X := ((Y * 12) + M - 1 + N);
+ Y := X div 12;
+ M := (X mod 12) + 1;
+
+ // Be careful not to get invalid date in Feb.
+ if M = 2 then
+ begin
+ EOMD := ExtractDay(EndOfMonth(EncodeDate(Y, M, 1)));
+ if D > EOMD then
+ D := EOMD;
+ end;
+
+ ADate := EncodeDate(Y, M, D);
+end;
+
+procedure IncYears(var ADate: TDateTime; N: Integer);
+ // N defaults to 1
+var
+ Y, M, D, EOMD: Word;
+begin
+ DecodeDate(ADate, Y, M, D);
+ Inc(Y, N);
+
+ // Be careful not to get invalid date in Feb.
+ if M = 2 then
+ begin
+ EOMD := ExtractDay(EndOfMonth(EncodeDate(Y, M, 1)));
+ if D > EOMD then
+ D := EOMD;
+ end;
+
+ ADate := EncodeDate(Y, M, D);
+end;
+
+function EndOfMonth(ADate: TDateTime): TDateTime;
+var
+ Y, M, D: Word;
+begin
+ DecodeDate(ADate, Y, M, D);
+ Inc(M);
+ if M > 12 then
+ begin
+ M := 1;
+ Inc(Y);
+ end;
+ Result := EncodeDate(Y, M, 1) - 1;
+end;
+
+function IsFirstOfMonth(ADate: TDateTime): Boolean;
+var
+ Y, M, D: Word;
+begin
+ DecodeDate(ADate, Y, M, D);
+ Result := D = 1;
+end;
+
+function IsEndOfMonth(ADate: TDateTime): Boolean;
+begin
+ Result := EqualDates(ADate, EndOfMonth(ADate));
+end;
+
+procedure EnsureMonth(Month: Word);
+begin
+ if (Month < 1) or (Month > 12) then
+ raise EJvTFDateError.CreateResFmt(@RsEInvalidMonthValue, [Month]);
+end;
+
+procedure EnsureDOW(DOW: Word);
+begin
+ if (DOW < 1) or (DOW > 7) then
+ raise EJvTFDateError.CreateResFmt(@RsEInvalidDayOfWeekValue, [DOW]);
+end;
+
+function EqualDates(D1, D2: TDateTime): Boolean;
+begin
+ Result := Trunc(D1) = Trunc(D2);
+end;
+
+function ExtractHours(ATime: TDateTime): Word;
+var
+ M, S, MS: Word;
+begin
+ DecodeTime(ATime, Result, M, S, MS);
+end;
+
+function ExtractMins(ATime: TDateTime): Word;
+var
+ H, S, MS: Word;
+begin
+ DecodeTime(ATime, H, Result, S, MS);
+end;
+
+function ExtractSecs(ATime: TDateTime): Word;
+var
+ H, M, MS: Word;
+begin
+ DecodeTime(ATime, H, M, Result, MS);
+end;
+
+function ExtractMSecs(ATime: TDateTime): Word;
+var
+ H, M, S: Word;
+begin
+ DecodeTime(ATime, H, M, S, Result);
+end;
+
+function Lesser(N1, N2: Integer): Integer;
+begin
+ if N1 < N2 then
+ Result := N1
+ else
+ Result := N2;
+end;
+
+function Greater(N1, N2: Integer): Integer;
+begin
+ if N1 > N2 then
+ Result := N1
+ else
+ Result := N2;
+end;
+
+function GetDivLength(TotalLength, DivCount, DivNum: Integer): Integer;
+begin
+ if (DivNum < 0) or (DivNum >= DivCount) then
+ Result := -1
+ else
+ begin
+ Result := TotalLength div DivCount;
+ if DivNum < TotalLength mod DivCount then
+ Inc(Result);
+ end;
+end;
+
+function GetDivNum(TotalLength, DivCount, X: Integer): Integer;
+var
+ Base,
+ MakeUp,
+ MakeUpWidth: Integer;
+begin
+ if (X < 0) or (X >= TotalLength) then
+ Result := -1
+ else
+ begin
+ Base := TotalLength div DivCount;
+ MakeUp := TotalLength mod DivCount;
+ MakeUpWidth := MakeUp * (Base + 1);
+
+ if X < MakeUpWidth then
+ Result := X div (Base + 1)
+ else
+ Result := (X - MakeUpWidth) div Base + MakeUp;
+ end;
+end;
+
+function GetDivStart(TotalLength, DivCount, DivNum: Integer): Integer;
+var
+ Base,
+ MakeUp,
+ MakeUpWidth: Integer;
+begin
+ if (DivNum < 0) or (DivNum >= DivCount) then
+ Result := -1
+ else
+ begin
+ Base := TotalLength div DivCount;
+ MakeUp := TotalLength mod DivCount;
+ MakeUpWidth := MakeUp * (Base + 1);
+
+ if DivNum <= MakeUp then
+ Result := DivNum * (Base + 1)
+ else
+ Result := (DivNum - MakeUp) * Base + MakeUpWidth;
+ end;
+end;
+
+function DOWToBorl(ADOW: TTFDayOfWeek): Integer;
+begin
+ Result := Ord(ADOW) + 1;
+end;
+
+function BorlToDOW(BorlDOW: Integer): TTFDayOfWeek;
+begin
+ Result := TTFDayOfWeek(BorlDOW - 1);
+end;
+
+function DateToDOW(ADate: TDateTime): TTFDayOfWeek;
+var
+ BorlDOW: Integer;
+begin
+ BorlDOW := DayOfWeek(ADate);
+ Result := BorlToDOW(BorlDOW);
+end;
+
+procedure CalcTextPos(ACanvas: TCanvas; HostRect: TRect; var TextLeft, TextTop: Integer;
+ var TextBounds: TRect; AFont: TFont; AAngle: Integer;
+ HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: String);
+var
+ sinAngle, cosAngle: Extended;
+ size: TSize;
+ X, Y: Integer;
+ A, B, C, D: Integer;
+ lb, lt, rb, rt: TPoint;
+begin
+ SinCos(AAngle * pi / 18000, sinAngle, cosAngle);
+ ACanvas.Font := AFont;
+ size := ACanvas.TextExtent(ATxt);
+
+ X := 0;
+ Y := 0;
+
+ if AAngle <= 90 then
+ begin { 1.Quadrant }
+ X := 0;
+ Y := Trunc(size.cx * sinAngle);
+// Y := Trunc(Size.cx * Sin(AAngle * Pi / 180));
+ end
+ else
+ if AAngle <= 180 then
+ begin { 2.Quadrant }
+ X := Trunc(size.cx * -cosAngle);
+// X := Trunc(Size.cx * -Cos(AAngle * Pi / 180));
+ Y := Trunc(size.cx * sinAngle + size.cy * -cosAngle);
+// Y := Trunc(Size.cx * Sin(AAngle * Pi / 180) + Size.cy * Cos((180 - AAngle) * Pi / 180));
+ end
+ else
+ if AAngle <= 270 then
+ begin { 3.Quadrant }
+ X := Trunc(size.cx * -cosAngle + size.cy * -sinAngle);
+// X := Trunc(Size.cx * -Cos(AAngle * Pi / 180) + Size.cy * Sin((AAngle - 180) * Pi / 180));
+ Y := Trunc(Size.cy * -cosAngle);
+// Y := Trunc(Size.cy * Sin((270 - AAngle) * Pi / 180));
+ end
+ else
+ if AAngle <= 360 then
+ begin { 4.Quadrant }
+ X := Trunc(size.cy * -sinAngle);
+// X := Trunc(Size.cy * Sin((360 - AAngle) * Pi / 180));
+ Y := 0;
+ end;
+
+ TextLeft := HostRect.Left + X;
+ TextTop := HostRect.Top + Y;
+ //ARect.Top := ARect.Top + Y;
+ //ARect.Left := ARect.Left + X;
+
+ X := Abs(Trunc(size.cx * cosAngle)) + Abs(Trunc(size.cy * sinAngle));
+// X := Abs(Trunc(Size.cx * Cos(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Sin(AAngle * Pi / 180)));
+ Y := Abs(Trunc(size.cx * sinAngle)) + Abs(Trunc(size.cy * cosAngle));
+// Y := Abs(Trunc(Size.cx * Sin(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Cos(AAngle * Pi / 180)));
+
+ case HAlign of
+ taCenter:
+ //ARect.Left := ARect.Left + ((RectWidth(SaveRect) - X) div 2);
+ TextLeft := TextLeft + ((RectWidth(HostRect) - X) div 2);
+ taRightJustify:
+ //ARect.Left := ARect.Left + RectWidth(SaveRect) - X;
+ TextLeft := TextLeft + RectWidth(HostRect) - X;
+ end;
+
+ case VAlign of
+ vaCenter:
+ //ARect.Top := ARect.Top + ((RectHeight(SaveRect) - Y) div 2);
+ TextTop := TextTop + ((RectHeight(HostRect) - Y) div 2);
+ vaBottom:
+ //ARect.Top := ARect.Top + RectHeight(SaveRect) - Y;
+ TextTop := TextTop + RectHeight(HostRect) - Y;
+ end;
+
+ //ARect.Right := ARect.Left + X;
+ //ARect.Bottom := ARect.Top + Y;
+//********************************************
+// calculate the border areas
+
+ A := Trunc(size.cy * sinAngle);
+// A := Trunc(size.cy * Sin(AAngle * Pi / 180));
+ B := Trunc(size.cy * cosAngle);
+// B := Trunc(size.cy * Cos(AAngle * Pi / 180));
+ C := Trunc(size.cx * cosAngle);
+// C := Trunc(size.cx * Cos(AAngle * Pi / 180));
+ D := Trunc(size.cx * sinAngle);
+// D := Trunc(Size.cx * Sin(AAngle * Pi / 180));
+
+ //lt := ARect.TopLeft;
+ lt := Point(TextLeft, TextTop);
+ lb := lt;
+ lb.X := lb.X + A;
+ lb.Y := lb.Y + B;
+ rb := lb;
+ rb.X := rb.X + C;
+ rb.Y := rb.Y - D;
+ rt := rb;
+ rt.X := rt.X - A;
+ rt.Y := rt.Y - B;
+
+ TextBounds.Left := Lesser(Lesser(lt.X, lb.X), Lesser(rb.X, rt.X));
+ TextBounds.Right := Greater(Greater(lt.X, lb.X), Greater(rb.X, rt.X));
+ TextBounds.Top := Lesser(Lesser(lt.Y, lb.Y), Lesser(rb.Y, rt.Y));
+ TextBounds.Bottom := Greater(Greater(lt.Y, lb.Y), Greater(rb.Y, rt.Y));
+//*********************************************************************************************
+end;
+
+ (*
+//////////////////////////////////////////////////////////////////
+// Credit for the CalcTextPos routine goes to Joerg Lingner. //
+// It comes from his JLLabel component (freeware - Torry's). //
+// It is used here with his permission. Thanks Joerg! //
+// He can be reached at jlingner att t-online dott de //
+//////////////////////////////////////////////////////////////////
+
+procedure CalcTextPos(HostRect: TRect; var TextLeft, TextTop: Integer;
+ var TextBounds: TRect; AFont: TFont; AAngle: Integer;
+ HAlign: TAlignment; VAlign: TJvTFVAlignment; ATxt: string);
+{==========================================================================}
+{ Calculate text pos. depend. on: Font, Escapement, Alignment and length }
+{--------------------------------------------------------------------------}
+var
+ DC: HDC;
+ hSavFont: HFONT;
+ Size: TSize;
+ X, Y: Integer;
+ //cStr : array[0..255] of Char;
+ PTxt: PChar;
+ A, B, C, D: Integer;
+ lb, lt, rb, rt: TPoint;
+begin
+ AAngle := AAngle div 10;
+
+ PTxt := StrAlloc((Length(ATxt) + 4) * SizeOf(Char));
+ StrPCopy(PTxt, ATxt);
+
+ //StrPCopy(cStr, ATxt);
+ DC := GetDC(HWND_DESKTOP);
+ hSavFont := SelectObject(DC, AFont.Handle);
+ //GetTextExtentPoint32(DC, cStr, Length(ATxt), Size);
+ Windows.GetTextExtentPoint32(DC, PTxt, StrLen(PTxt), Size);
+ StrDispose(PTxt);
+ SelectObject(DC, hSavFont);
+ ReleaseDC(HWND_DESKTOP, DC);
+
+ X := 0;
+ Y := 0;
+
+ if AAngle <= 90 then
+ begin { 1.Quadrant }
+ X := 0;
+ Y := Trunc(Size.cx * Sin(AAngle * Pi / 180));
+ end
+ else
+ if AAngle <= 180 then
+ begin { 2.Quadrant }
+ X := Trunc(Size.cx * -Cos(AAngle * Pi / 180));
+ Y := Trunc(Size.cx * Sin(AAngle * Pi / 180) + Size.cy * Cos((180 - AAngle) * Pi / 180));
+ end
+ else
+ if AAngle <= 270 then
+ begin { 3.Quadrant }
+ X := Trunc(Size.cx * -Cos(AAngle * Pi / 180) + Size.cy * Sin((AAngle - 180) * Pi / 180));
+ Y := Trunc(Size.cy * Sin((270 - AAngle) * Pi / 180));
+ end
+ else
+ if AAngle <= 360 then
+ begin { 4.Quadrant }
+ X := Trunc(Size.cy * Sin((360 - AAngle) * Pi / 180));
+ Y := 0;
+ end;
+
+ TextLeft := HostRect.Left + X;
+ TextTop := HostRect.Top + Y;
+ //ARect.Top := ARect.Top + Y;
+ //ARect.Left := ARect.Left + X;
+
+ X := Abs(Trunc(Size.cx * Cos(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Sin(AAngle * Pi / 180)));
+ Y := Abs(Trunc(Size.cx * Sin(AAngle * Pi / 180))) + Abs(Trunc(Size.cy * Cos(AAngle * Pi / 180)));
+
+ case HAlign of
+ taCenter:
+ //ARect.Left := ARect.Left + ((RectWidth(SaveRect) - X) div 2);
+ TextLeft := TextLeft + ((RectWidth(HostRect) - X) div 2);
+ taRightJustify:
+ //ARect.Left := ARect.Left + RectWidth(SaveRect) - X;
+ TextLeft := TextLeft + RectWidth(HostRect) - X;
+ end;
+
+ case VAlign of
+ vaCenter:
+ //ARect.Top := ARect.Top + ((RectHeight(SaveRect) - Y) div 2);
+ TextTop := TextTop + ((RectHeight(HostRect) - Y) div 2);
+ vaBottom:
+ //ARect.Top := ARect.Top + RectHeight(SaveRect) - Y;
+ TextTop := TextTop + RectHeight(HostRect) - Y;
+ end;
+
+ //ARect.Right := ARect.Left + X;
+ //ARect.Bottom := ARect.Top + Y;
+//********************************************
+// calculate the border areas
+
+ A := Trunc(Size.cy * Sin(AAngle * Pi / 180));
+ B := Trunc(Size.cy * Cos(AAngle * Pi / 180));
+ C := Trunc(Size.cx * Cos(AAngle * Pi / 180));
+ D := Trunc(Size.cx * Sin(AAngle * Pi / 180));
+
+ //lt := ARect.TopLeft;
+ lt := Point(TextLeft, TextTop);
+ lb := lt;
+ lb.X := lb.X + A;
+ lb.Y := lb.Y + B;
+ rb := lb;
+ rb.X := rb.X + C;
+ rb.Y := rb.Y - D;
+ rt := rb;
+ rt.X := rt.X - A;
+ rt.Y := rt.Y - B;
+
+ TextBounds.Left := Lesser(Lesser(lt.X, lb.X), Lesser(rb.X, rt.X));
+ TextBounds.Right := Greater(Greater(lt.X, lb.X), Greater(rb.X, rt.X));
+ TextBounds.Top := Lesser(Lesser(lt.Y, lb.Y), Lesser(rb.Y, rt.Y));
+ TextBounds.Bottom := Greater(Greater(lt.Y, lb.Y), Greater(rb.Y, rt.Y));
+//*********************************************************************************************
+end; *)
+
+procedure DrawAngleText(ACanvas: TCanvas; HostRect: TRect;
+ var TextBounds: TRect; AAngle: Integer; HAlign: TAlignment;
+ VAlign: TJvTFVAlignment; ATxt: string);
+var
+// LogFont: TLogFont;
+ TxtRect: TRect;
+ Flags: UINT;
+ PTxt: PChar;
+ ClipRgn: HRgn;
+ TextLeft, TextTop: Integer;
+ ts: TTextStyle;
+begin
+ //TxtRect := ARect;
+ CalcTextPos(ACanvas, HostRect, TextLeft, TextTop, TextBounds, ACanvas.Font,
+ AAngle, HAlign, VAlign, ATxt);
+
+ ACanvas.Font.Orientation := AAngle;
+ {
+ Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
+ LogFont.lfEscapement := AAngle;
+ LogFont.lfOrientation := LogFont.lfEscapement;
+ ACanvas.Font.Handle := CreateFontIndirect(LogFont);
+ Flags := DT_NOPREFIX or DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE;
+ }
+ ts := ACanvas.TextStyle;
+ ts.Alignment := taLeftJustify;
+ ts.Layout := tlTop;
+ ts.Clipping := false; // why need a ClipRect then?
+
+ {
+ PTxt := StrAlloc((Length(ATxt) + 4) * SizeOf(Char));
+ StrPCopy(PTxt, ATxt);
+ }
+ //ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top,
+ // ARect.Right, ARect.Bottom);
+ ACanvas.ClipRect := HostRect;
+ {
+ ClipRgn := Windows.CreateRectRgn(HostRect.Left, HostRect.Top,
+ HostRect.Right, HostRect.Bottom);
+ Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);
+ }
+
+ //Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+ TxtRect := Rect(TextLeft, TextTop, TextLeft + 1, TextTop + 1);
+ ACanvas.TextRect(TxtRect, TxtRect.Left, TxtRect.Top, ATxt, ts);
+// Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+
+{
+ Windows.SelectClipRgn(ACanvas.Handle, 0);
+ Windows.DeleteObject(ClipRgn);
+ StrDispose(PTxt);
+ ACanvas.Font.Handle := 0;
+}
+ //ARect := TxtRect;
+end;
+
+(*
+procedure DrawAngleText(ACanvas: TCanvas; HostRect: TRect;
+ var TextBounds: TRect; AAngle: Integer; HAlign: TAlignment;
+ VAlign: TJvTFVAlignment; ATxt: string);
+var
+ LogFont: TLogFont;
+ TxtRect: TRect;
+ Flags: UINT;
+ PTxt: PChar;
+ ClipRgn: HRgn;
+ TextLeft,
+ TextTop: Integer;
+begin
+ //TxtRect := ARect;
+ //CalcTextPos(TxtRect, ACanvas.Font, AAngle, HAlign, VAlign, ATxt);
+ CalcTextPos(HostRect, TextLeft, TextTop, TextBounds, ACanvas.Font, AAngle,
+ HAlign, VAlign, ATxt);
+ Windows.GetObject(ACanvas.Font.Handle, SizeOf(LogFont), @LogFont);
+ LogFont.lfEscapement := AAngle;
+ LogFont.lfOrientation := LogFont.lfEscapement;
+ ACanvas.Font.Handle := CreateFontIndirect(LogFont);
+ Flags := DT_NOPREFIX or DT_LEFT or DT_TOP or DT_NOCLIP or DT_SINGLELINE;
+
+ PTxt := StrAlloc((Length(ATxt) + 4) * SizeOf(Char));
+ StrPCopy(PTxt, ATxt);
+ //ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top,
+ // ARect.Right, ARect.Bottom);
+ ClipRgn := Windows.CreateRectRgn(HostRect.Left, HostRect.Top,
+ HostRect.Right, HostRect.Bottom);
+ Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);
+
+ //Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+ TxtRect := Rect(TextLeft, TextTop, TextLeft + 1, TextTop + 1);
+ Windows.DrawText(ACanvas.Handle, PTxt, -1, TxtRect, Flags);
+
+ Windows.SelectClipRgn(ACanvas.Handle, 0);
+ Windows.DeleteObject(ClipRgn);
+ StrDispose(PTxt);
+ ACanvas.Font.Handle := 0;
+
+ //ARect := TxtRect;
+end;
+*)
+function RectWidth(ARect: TRect): Integer;
+begin
+ Result := ARect.Right - ARect.Left;
+end;
+
+function RectHeight(ARect: TRect): Integer;
+begin
+ Result := ARect.Bottom - ARect.Top;
+end;
+
+function EmptyRect: TRect;
+begin
+ Result := Rect(0, 0, 0, 0);
+end;
+
+function IsClassByName(Obj: TObject; ClassName: string): Boolean;
+var
+ ClassRef: TClass;
+begin
+ Result := False;
+ ClassRef := Obj.ClassType;
+ while (ClassRef <> nil) and not Result do
+ if ClassRef.ClassName = ClassName then
+ Result := True
+ else
+ ClassRef := ClassRef.ClassParent;
+end;
+
+
+{ Routines copied from JcStrings }
+
+function StringsToStr(const List: TStrings; const Sep: string;
+ const AllowEmptyString: Boolean = True): string;
+var
+ I, L: SizeInt;
+begin
+ Result := '';
+ for I := 0 to List.Count - 1 do
+ begin
+ if (List[I] <> '') or AllowEmptyString then
+ begin
+ // don't combine these into one addition, somehow it hurts performance
+ Result := Result + List[I];
+ Result := Result + Sep;
+ end;
+ end;
+ // remove terminating separator
+ if List.Count > 0 then
+ begin
+ L := Length(Sep);
+ Delete(Result, Length(Result) - L + 1, L);
+ end;
+end;
+
+end.
diff --git a/components/jvcllaz/run/JvTimeFramework/jvtfweeks.pas b/components/jvcllaz/run/JvTimeFramework/jvtfweeks.pas
new file mode 100644
index 000000000..722519cee
--- /dev/null
+++ b/components/jvcllaz/run/JvTimeFramework/jvtfweeks.pas
@@ -0,0 +1,494 @@
+{-----------------------------------------------------------------------------
+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: JvTFWeeks.PAS, released on 2003-08-01.
+
+The Initial Developer of the Original Code is Unlimited Intelligence Limited.
+Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
+All Rights Reserved.
+
+Contributor(s):
+Mike Kolter (original code)
+
+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:
+-----------------------------------------------------------------------------}
+// $Id$
+
+unit JvTFWeeks;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType, LMessages,
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ JvTFManager, JvTFGlance, JvTFUtils;
+
+type
+ TJvTFDispOrder = (doLeftRight, doTopBottom);
+
+ TJvTFWeeks = class(TJvTFCustomGlance)
+ private
+ FWeekCount: Integer;
+ FDisplayDays: TTFDaysOfWeek;
+ FSplitDay: TTFDayOfWeek;
+ FIgnoreSplit: Boolean;
+ FDisplayOrder: TJvTFDispOrder;
+ FDWNames: TJvTFDWNames;
+ FDWTitleAttr: TJvTFGlanceTitle;
+ FOnDrawDWTitle: TJvTFDrawDWTitleEvent;
+ FOnUpdateTitle: TJvTFUpdateTitleEvent;
+ function GetDisplayDate: TDate;
+ procedure SetDisplayDate(Value: TDate);
+ procedure SetWeekCount(Value: Integer);
+ procedure SetDisplayDays(Value: TTFDaysOfWeek);
+ procedure SetSplitDay(Value: TTFDayOfWeek);
+ procedure SetIgnoreSplit(Value: Boolean);
+ procedure SetDisplayOrder(Value: TJvTFDispOrder);
+ procedure SetDWNames(Value: TJvTFDWNames);
+ procedure SetDWTitleAttr(Value: TJvTFGlanceTitle);
+ protected
+ procedure ConfigCells; override;
+ procedure SetStartOfWeek(Value: TTFDayOfWeek); override;
+ procedure DWNamesChange(Sender: TObject);
+ procedure Navigate(AControl: TJvTFControl; ASchedNames: TStringList;
+ Dates: TJvTFDateList); override;
+
+ function GetSplitParentDay: TTFDayOfWeek;
+ function GetCellTitleText(Cell: TJvTFGlanceCell): string; override;
+
+ // draws the DW Titles
+ procedure DrawTitle(ACanvas: TCanvas); override;
+ procedure UpdateTitle;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDataTop: Integer; override;
+ function DisplayDayCount: Integer;
+ procedure PrevWeek;
+ procedure NextWeek;
+ published
+ property DisplayDate: TDate read GetDisplayDate write SetDisplayDate;
+ property DisplayDays: TTFDaysOfWeek read FDisplayDays write SetDisplayDays
+ default [dowSunday..dowSaturday];
+ property DisplayOrder: TJvTFDispOrder read FDisplayOrder write SetDisplayOrder;
+ property DWNames: TJvTFDWNames read FDWNames write SetDWNames;
+ property DWTitleAttr: TJvTFGlanceTitle read FDWTitleAttr write SetDWTitleAttr;
+ property IgnoreSplit: Boolean read FIgnoreSplit write SetIgnoreSplit default False;
+ property SplitDay: TTFDayOfWeek read FSplitDay write SetSplitDay default dowSunday;
+ property WeekCount: Integer read FWeekCount write SetWeekCount default 1;
+ property OnDrawDWTitle: TJvTFDrawDWTitleEvent read FOnDrawDWTitle write FOnDrawDWTitle;
+ property OnUpdateTitle: TJvTFUpdateTitleEvent read FOnUpdateTitle write FOnUpdateTitle;
+ property StartOfWeek default dowMonday;
+// property Navigator;
+// property OnNavigate;
+ end;
+
+
+implementation
+
+uses
+ JvResources;
+
+procedure TJvTFWeeks.ConfigCells;
+var
+ Row, Col, CalcRowCount: Integer;
+ CurrDate: TDateTime;
+ DayToSplit: TTFDayOfWeek;
+ CanSplit: Boolean;
+
+ procedure DisplayDateCheck;
+ begin
+ while not (DateToDOW(CurrDate) in DisplayDays) do
+ IncDays(CurrDate, 1);
+ end;
+
+ procedure ConfigCell(ACell: TJvTFGlanceCell);
+ var
+ TestDay: TTFDayOfWeek;
+ begin
+ DisplayDateCheck;
+ SetCellDate(ACell, CurrDate);
+ TestDay := DateToDOW(CurrDate);
+ IncDays(CurrDate, 1);
+
+ if (TestDay = DayToSplit) and (SplitDay in DisplayDays) and CanSplit then
+ begin
+ SplitCell(ACell);
+ DisplayDateCheck;
+ SetCellDate(ACell.Subcell, CurrDate);
+ IncDays(CurrDate, 1);
+ end
+ else
+ CombineCell(ACell);
+ end;
+
+begin
+ if WeekCount = 1 then
+ begin
+ ColCount := 2;
+
+ CalcRowCount := DisplayDayCount;
+ if Odd(CalcRowCount) and not (SplitDay in DisplayDays) then
+ Inc(CalcRowCount);
+ RowCount := CalcRowCount div 2;
+
+ CanSplit := not IgnoreSplit and Odd(DisplayDayCount);
+ end
+ else
+ begin
+ if not IgnoreSplit and (SplitDay in DisplayDays) then
+ ColCount := DisplayDayCount - 1
+ else
+ ColCount := DisplayDayCount;
+ RowCount := WeekCount;
+ CanSplit := not IgnoreSplit;
+ end;
+
+ DayToSplit := GetSplitParentDay;
+
+ CurrDate := OriginDate;
+ if DisplayOrder = doLeftRight then
+ for Row := 0 to RowCount - 1 do
+ for Col := 0 to ColCount - 1 do
+ ConfigCell(Cells.Cells[Col, Row])
+ else
+ for Col := 0 to ColCount - 1 do
+ for Row := 0 to RowCount - 1 do
+ ConfigCell(Cells.Cells[Col, Row]);
+
+ inherited ConfigCells;
+end;
+
+constructor TJvTFWeeks.Create(AOwner: TComponent);
+begin
+ FWeekCount := 1;
+ FDisplayDays := DOW_WEEK;
+ FSplitDay := dowSunday;
+ FIgnoreSplit := False;
+
+ inherited Create(AOwner);
+
+ GapSize := 4;
+ CellAttr.TitleAttr.Color := clWhite;
+ CellAttr.TitleAttr.FrameAttr.Color := clGray;
+
+ FDWNames := TJvTFDWNames.Create;
+ FDWNames.OnChange := @DWNamesChange;
+
+ FDWTitleAttr := TJvTFGlanceTitle.Create(Self);
+ with FDWTitleAttr do
+ begin
+ Assign(TitleAttr);
+ TxtAttr.Font.Size := 8;
+ Height := 20;
+ OnChange := @GlanceTitleChange;
+ end;
+
+ StartOfWeek := dowMonday;
+ DisplayDate := Date;
+end;
+
+destructor TJvTFWeeks.Destroy;
+begin
+ FDWNames.OnChange := nil;
+ FDWNames.Free;
+ FDWTitleAttr.OnChange := nil;
+ FDWTitleAttr.Free;
+ inherited Destroy;
+end;
+
+function TJvTFWeeks.DisplayDayCount: Integer;
+var
+ DOW: TTFDayOfWeek;
+begin
+ Result := 0;
+ for DOW := Low(TTFDayOfWeek) to High(TTFDayOfWeek) do
+ if DOW in DisplayDays then
+ Inc(Result);
+end;
+
+procedure TJvTFWeeks.DrawTitle(ACanvas: TCanvas);
+var
+ I, Col, LineBottom: Integer;
+ SplitParentDay, CurrDOW: TTFDayOfWeek;
+ ARect, TempRect, TxtRect, TextBounds: TRect;
+ OldPen: TPen;
+ OldBrush: TBrush;
+ OldFont: TFont;
+ Txt: string;
+
+ procedure CheckCurrDOW;
+ begin
+ while not (CurrDOW in DisplayDays) do
+ IncDOW(CurrDOW, 1);
+ end;
+
+begin
+ inherited DrawTitle(ACanvas);
+
+ // Don't draw the DW Titles if we're only showing one week.
+ if not DWTitleAttr.Visible or (WeekCount = 1) then
+ Exit;
+
+ with ACanvas do
+ begin
+ OldPen := TPen.Create;
+ OldPen.Assign(Pen);
+ OldBrush := TBrush.Create;
+ OldBrush.Assign(Brush);
+ OldFont := TFont.Create;
+ OldFont.Assign(Font);
+ end;
+
+ // draw the DWTitles
+ ARect.Top := inherited GetDataTop;
+ ARect.Bottom := GetDataTop;
+
+ CurrDOW := StartOfWeek;
+ SplitParentDay := GetSplitParentDay;
+
+ for Col := 0 to ColCount - 1 do
+ begin
+ TempRect := WholeCellRect(Col, 0);
+ ARect.Left := TempRect.Left;
+ ARect.Right := TempRect.Right;
+ TxtRect := ARect;
+ InflateRect(TxtRect, -1, -1);
+
+ with ACanvas do
+ begin
+ Brush.Color := DWTitleAttr.Color;
+ FillRect(ARect);
+
+ case DWTitleAttr.FrameAttr.Style of
+ fs3DRaised:
+ Draw3DFrame(ACanvas, ARect, clBtnHighlight, clBtnShadow);
+ fs3DLowered:
+ Draw3DFrame(ACanvas, ARect, clBtnShadow, clBtnHighlight);
+ fsFlat:
+ begin
+ Pen.Color := DWTitleAttr.FrameAttr.Color;
+ Pen.Width := DWTitleAttr.FrameAttr.Width;
+ if Col = 0 then
+ begin
+ MoveTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Left, ARect.Bottom);
+ end;
+ Polyline([
+ Point(ARect.Right - 1, ARect.Top),
+ Point(ARect.Right - 1, ARect.Bottom - 1),
+ Point(ARect.Left - 1, ARect.Bottom - 1)
+ ]);
+ end;
+ fsNone:
+ begin
+ Pen.Color := DWTitleAttr.FrameAttr.Color;
+ Pen.Width := 1;
+ LineBottom := ARect.Bottom - 1;
+ for I := 1 to DWTitleAttr.FrameAttr.Width do
+ begin
+ MoveTo(ARect.Left, LineBottom);
+ LineTo(ARect.Right, LineBottom);
+ Dec(LineBottom);
+ end;
+ end;
+ end;
+
+ CheckCurrDOW;
+ Txt := DWNames.GetDWName(DOWToBorl(CurrDOW));
+
+ if (CurrDOW = SplitParentDay) and (SplitDay in DisplayDays) and not IgnoreSplit then
+ begin
+ IncDOW(CurrDOW, 1);
+ CheckCurrDOW;
+ Txt := Txt + '/' + DWNames.GetDWName(DOWToBorl(CurrDOW));
+ end;
+
+ Font := DWTitleAttr.TxtAttr.Font;
+ DrawAngleText(ACanvas, TxtRect, TextBounds,
+ DWTitleAttr.TxtAttr.Rotation,
+ DWTitleAttr.TxtAttr.AlignH,
+ DWTitleAttr.TxtAttr.AlignV, Txt);
+ end;
+
+ if Assigned(FOnDrawDWTitle) then
+ FOnDrawDWTitle(Self, ACanvas, ARect, CurrDOW, Txt);
+
+ IncDOW(CurrDOW, 1);
+ end;
+
+ with ACanvas do
+ begin
+ Pen.Assign(OldPen);
+ Brush.Assign(OldBrush);
+ Font.Assign(OldFont);
+ OldPen.Free;
+ OldBrush.Free;
+ OldFont.Free;
+ end;
+end;
+
+procedure TJvTFWeeks.DWNamesChange(Sender: TObject);
+begin
+ UpdateCellTitles;
+ Invalidate;
+end;
+
+function TJvTFWeeks.GetCellTitleText(Cell: TJvTFGlanceCell): string;
+begin
+ Result := '';
+ //Result := FormatDateTime('dddd, mmm d', Cell.CellDate);
+ if Assigned(DWNames) then
+ begin
+ if WeekCount = 1 then
+ Result := DWNames.GetDWName(DayOfWeek(Cell.CellDate)) + ', ';
+ if DateFormat = '' then
+ Result := Result + FormatDateTime('mmm d', Cell.CellDate)
+ else
+ Result := Result + FormatDateTime(DateFormat, Cell.CellDate);
+ end
+ else
+ Result := FormatDateTime(DateFormat, Cell.CellDate);
+end;
+
+function TJvTFWeeks.GetDataTop: Integer;
+begin
+ Result := inherited GetDataTop;
+ if DWTitleAttr.Visible and (WeekCount > 1) then
+ Inc(Result, DWTitleAttr.Height);
+end;
+
+function TJvTFWeeks.GetDisplayDate: TDate;
+begin
+ Result := StartDate;
+end;
+
+function TJvTFWeeks.GetSplitParentDay: TTFDayOfWeek;
+begin
+ Result := SplitDay;
+ IncDOW(Result, -1);
+ while not (Result in DisplayDays) and (Result <> SplitDay) do
+ IncDOW(Result, -1);
+end;
+
+procedure TJvTFWeeks.Navigate(AControl: TJvTFControl;
+ ASchedNames: TStringList; Dates: TJvTFDateList);
+begin
+ inherited Navigate(AControl, ASchedNames, Dates);
+ if Dates.Count > 0 then
+ DisplayDate := Dates[0];
+end;
+
+procedure TJvTFWeeks.NextWeek;
+begin
+ DisplayDate := DisplayDate + 7;
+end;
+
+procedure TJvTFWeeks.PrevWeek;
+begin
+ DisplayDate := DisplayDate - 7;
+end;
+
+procedure TJvTFWeeks.SetDisplayDate(Value: TDate);
+begin
+ StartDate := Value;
+ UpdateTitle;
+end;
+
+procedure TJvTFWeeks.SetDisplayDays(Value: TTFDaysOfWeek);
+begin
+ if Value = [] then
+ Exit;
+
+ if Value <> FDisplayDays then
+ begin
+ FDisplayDays := Value;
+ ReconfigCells;
+ end;
+end;
+
+procedure TJvTFWeeks.SetDisplayOrder(Value: TJvTFDispOrder);
+begin
+ if WeekCount > 1 then
+ Value := doLeftRight;
+
+ if Value <> FDisplayOrder then
+ begin
+ FDisplayOrder := Value;
+ ReconfigCells;
+ end;
+end;
+
+procedure TJvTFWeeks.SetDWNames(Value: TJvTFDWNames);
+begin
+ FDWNames.Assign(Value);
+end;
+
+procedure TJvTFWeeks.SetDWTitleAttr(Value: TJvTFGlanceTitle);
+begin
+ FDWTitleAttr.Assign(Value);
+end;
+
+procedure TJvTFWeeks.SetIgnoreSplit(Value: Boolean);
+begin
+ if Value <> FIgnoreSplit then
+ begin
+ FIgnoreSplit := Value;
+ ReconfigCells;
+ end;
+end;
+
+procedure TJvTFWeeks.SetSplitDay(Value: TTFDayOfWeek);
+begin
+ if Value <> FSplitDay then
+ begin
+ FSplitDay := Value;
+ ReconfigCells;
+ end;
+end;
+
+procedure TJvTFWeeks.SetStartOfWeek(Value: TTFDayOfWeek);
+begin
+ if not IgnoreSplit and (Value = SplitDay) then
+ IncDOW(Value, -1);
+ inherited SetStartOfWeek(Value);
+end;
+
+procedure TJvTFWeeks.SetWeekCount(Value: Integer);
+begin
+ Value := Greater(Value, 1);
+ if Value <> FWeekCount then
+ begin
+ DisplayOrder := doLeftRight;
+ FWeekCount := Value;
+ ReconfigCells;
+ end;
+end;
+
+procedure TJvTFWeeks.UpdateTitle;
+var
+ NewTitle: string;
+begin
+ NewTitle := Format(RsWeekOf, [FormatDateTime('mmm d, yyyy', OriginDate)]);
+ if NewTitle <> TitleAttr.Title then
+ begin
+ if Assigned(FOnUpdateTitle) then
+ FOnUpdateTitle(Self, NewTitle);
+ TitleAttr.Title := NewTitle;
+ end;
+end;
+
+
+end.