From c1641e380d8110ca2c352f61eea2d9d9699d6972 Mon Sep 17 00:00:00 2001 From: christian_u Date: Sun, 3 Feb 2008 12:05:55 +0000 Subject: [PATCH] Initial import git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/packages/v103_lazarus.lpk | 283 + components/tvplanit/readme.txt | 89 + components/tvplanit/source/vp.inc | 119 + components/tvplanit/source/vpabout.lfm | 1299 ++ components/tvplanit/source/vpabout.lrs | 1730 +++ components/tvplanit/source/vpabout.pas | 227 + components/tvplanit/source/vpabout.rst | 5 + components/tvplanit/source/vpadvds.pas | 1227 ++ components/tvplanit/source/vpalarmdlg.lfm | 154 + components/tvplanit/source/vpalarmdlg.pas | 267 + components/tvplanit/source/vpbase.pas | 967 ++ components/tvplanit/source/vpbase.res | Bin 0 -> 24000 bytes components/tvplanit/source/vpbaseds.pas | 1380 ++ components/tvplanit/source/vpbdeds.pas | 1282 ++ components/tvplanit/source/vpcalendar.pas | 2105 ++++ components/tvplanit/source/vpcanvasutils.pas | 2162 ++++ components/tvplanit/source/vpclock.pas | 1379 ++ components/tvplanit/source/vpconst.pas | 256 + .../tvplanit/source/vpcontactbuttons.pas | 538 + .../tvplanit/source/vpcontacteditdlg.lfm | 486 + .../tvplanit/source/vpcontacteditdlg.lrs | 125 + .../tvplanit/source/vpcontacteditdlg.pas | 673 + components/tvplanit/source/vpcontactgrid.pas | 2669 ++++ components/tvplanit/source/vpdata.pas | 2310 ++++ components/tvplanit/source/vpdateedit.pas | 792 ++ components/tvplanit/source/vpdatepropedit.lfm | 52 + components/tvplanit/source/vpdatepropedit.pas | 72 + components/tvplanit/source/vpdayview.pas | 4618 +++++++ components/tvplanit/source/vpdbds.pas | 1812 +++ components/tvplanit/source/vpdbintf.pas | 140 + components/tvplanit/source/vpdbisamds.pas | 2016 +++ components/tvplanit/source/vpdlg.pas | 207 + components/tvplanit/source/vpedelem.lfm | 361 + components/tvplanit/source/vpedelem.lrs | 98 + components/tvplanit/source/vpedelem.pas | 342 + components/tvplanit/source/vpedfmt.lfm | 119 + components/tvplanit/source/vpedfmt.lrs | 35 + components/tvplanit/source/vpedfmt.pas | 148 + components/tvplanit/source/vpedfmtlst.lfm | 258 + components/tvplanit/source/vpedfmtlst.pas | 691 + components/tvplanit/source/vpedpop.pas | 223 + components/tvplanit/source/vpedshape.lfm | 167 + components/tvplanit/source/vpedshape.pas | 278 + components/tvplanit/source/vpeventrpt.pas | 2022 +++ components/tvplanit/source/vpevnteditdlg.lfm | 478 + components/tvplanit/source/vpevnteditdlg.pas | 734 ++ components/tvplanit/source/vpexception.pas | 188 + components/tvplanit/source/vpff2ds.pas | 538 + components/tvplanit/source/vpflxds.pas | 2105 ++++ components/tvplanit/source/vpflxdsed1.lfm | 158 + components/tvplanit/source/vpflxdsed1.pas | 605 + components/tvplanit/source/vpledlabel.pas | 550 + components/tvplanit/source/vplocalize.pas | 827 ++ components/tvplanit/source/vplocalize.xml | 10456 ++++++++++++++++ components/tvplanit/source/vpmisc.pas | 575 + components/tvplanit/source/vpmonthview.pas | 1695 +++ components/tvplanit/source/vpnabed.lfm | 347 + components/tvplanit/source/vpnabed.pas | 611 + components/tvplanit/source/vpnavbar.pas | 3097 +++++ components/tvplanit/source/vpprtfmt.pas | 2935 +++++ components/tvplanit/source/vpprtfmtcbox.pas | 284 + components/tvplanit/source/vpprtfmtdlg.pas | 130 + components/tvplanit/source/vpprtfmted.pas | 112 + components/tvplanit/source/vpprtprv.pas | 1354 ++ components/tvplanit/source/vpprtprvdlg.lfm | 378 + components/tvplanit/source/vpprtprvdlg.pas | 420 + components/tvplanit/source/vpreg.pas | 414 + components/tvplanit/source/vpreg.res | Bin 0 -> 14484 bytes components/tvplanit/source/vpregad.pas | 57 + components/tvplanit/source/vpregf2.pas | 57 + components/tvplanit/source/vpregis.pas | 56 + components/tvplanit/source/vpreseditdlg.lfm | 133 + components/tvplanit/source/vpreseditdlg.lrs | 53 + components/tvplanit/source/vpreseditdlg.pas | 243 + components/tvplanit/source/vpruntime.dpk | 96 + components/tvplanit/source/vpruntime.res | Bin 0 -> 1788 bytes components/tvplanit/source/vpselresdlg.lfm | 86 + components/tvplanit/source/vpselresdlg.pas | 80 + components/tvplanit/source/vpsqlbde.pas | 112 + components/tvplanit/source/vpsqldialect.pas | 301 + components/tvplanit/source/vpsqlds.pas | 445 + .../tvplanit/source/vpsqlparadoxdialect.pas | 95 + components/tvplanit/source/vpsr.inc | 417 + components/tvplanit/source/vpsr.pas | 92 + components/tvplanit/source/vpsr.rst | 1316 ++ components/tvplanit/source/vptaskeditdlg.lfm | 316 + components/tvplanit/source/vptaskeditdlg.pas | 229 + components/tvplanit/source/vptasklist.pas | 1758 +++ components/tvplanit/source/vptimerpool.pas | 640 + components/tvplanit/source/vpwavdlg.lfm | 99 + components/tvplanit/source/vpwavdlg.lrs | 40 + components/tvplanit/source/vpwavdlg.pas | 192 + components/tvplanit/source/vpwavpe.pas | 98 + components/tvplanit/source/vpweekview.pas | 1956 +++ components/tvplanit/source/vpxbase.pas | 682 + components/tvplanit/source/vpxchrflt.pas | 648 + components/tvplanit/source/vpxparsr.pas | 2296 ++++ 97 files changed, 77767 insertions(+) create mode 100644 components/tvplanit/packages/v103_lazarus.lpk create mode 100644 components/tvplanit/readme.txt create mode 100644 components/tvplanit/source/vp.inc create mode 100644 components/tvplanit/source/vpabout.lfm create mode 100644 components/tvplanit/source/vpabout.lrs create mode 100644 components/tvplanit/source/vpabout.pas create mode 100644 components/tvplanit/source/vpabout.rst create mode 100644 components/tvplanit/source/vpadvds.pas create mode 100644 components/tvplanit/source/vpalarmdlg.lfm create mode 100644 components/tvplanit/source/vpalarmdlg.pas create mode 100644 components/tvplanit/source/vpbase.pas create mode 100644 components/tvplanit/source/vpbase.res create mode 100644 components/tvplanit/source/vpbaseds.pas create mode 100644 components/tvplanit/source/vpbdeds.pas create mode 100644 components/tvplanit/source/vpcalendar.pas create mode 100644 components/tvplanit/source/vpcanvasutils.pas create mode 100644 components/tvplanit/source/vpclock.pas create mode 100644 components/tvplanit/source/vpconst.pas create mode 100644 components/tvplanit/source/vpcontactbuttons.pas create mode 100644 components/tvplanit/source/vpcontacteditdlg.lfm create mode 100644 components/tvplanit/source/vpcontacteditdlg.lrs create mode 100644 components/tvplanit/source/vpcontacteditdlg.pas create mode 100644 components/tvplanit/source/vpcontactgrid.pas create mode 100644 components/tvplanit/source/vpdata.pas create mode 100644 components/tvplanit/source/vpdateedit.pas create mode 100644 components/tvplanit/source/vpdatepropedit.lfm create mode 100644 components/tvplanit/source/vpdatepropedit.pas create mode 100644 components/tvplanit/source/vpdayview.pas create mode 100644 components/tvplanit/source/vpdbds.pas create mode 100644 components/tvplanit/source/vpdbintf.pas create mode 100644 components/tvplanit/source/vpdbisamds.pas create mode 100644 components/tvplanit/source/vpdlg.pas create mode 100644 components/tvplanit/source/vpedelem.lfm create mode 100644 components/tvplanit/source/vpedelem.lrs create mode 100644 components/tvplanit/source/vpedelem.pas create mode 100644 components/tvplanit/source/vpedfmt.lfm create mode 100644 components/tvplanit/source/vpedfmt.lrs create mode 100644 components/tvplanit/source/vpedfmt.pas create mode 100644 components/tvplanit/source/vpedfmtlst.lfm create mode 100644 components/tvplanit/source/vpedfmtlst.pas create mode 100644 components/tvplanit/source/vpedpop.pas create mode 100644 components/tvplanit/source/vpedshape.lfm create mode 100644 components/tvplanit/source/vpedshape.pas create mode 100644 components/tvplanit/source/vpeventrpt.pas create mode 100644 components/tvplanit/source/vpevnteditdlg.lfm create mode 100644 components/tvplanit/source/vpevnteditdlg.pas create mode 100644 components/tvplanit/source/vpexception.pas create mode 100644 components/tvplanit/source/vpff2ds.pas create mode 100644 components/tvplanit/source/vpflxds.pas create mode 100644 components/tvplanit/source/vpflxdsed1.lfm create mode 100644 components/tvplanit/source/vpflxdsed1.pas create mode 100644 components/tvplanit/source/vpledlabel.pas create mode 100644 components/tvplanit/source/vplocalize.pas create mode 100644 components/tvplanit/source/vplocalize.xml create mode 100644 components/tvplanit/source/vpmisc.pas create mode 100644 components/tvplanit/source/vpmonthview.pas create mode 100644 components/tvplanit/source/vpnabed.lfm create mode 100644 components/tvplanit/source/vpnabed.pas create mode 100644 components/tvplanit/source/vpnavbar.pas create mode 100644 components/tvplanit/source/vpprtfmt.pas create mode 100644 components/tvplanit/source/vpprtfmtcbox.pas create mode 100644 components/tvplanit/source/vpprtfmtdlg.pas create mode 100644 components/tvplanit/source/vpprtfmted.pas create mode 100644 components/tvplanit/source/vpprtprv.pas create mode 100644 components/tvplanit/source/vpprtprvdlg.lfm create mode 100644 components/tvplanit/source/vpprtprvdlg.pas create mode 100644 components/tvplanit/source/vpreg.pas create mode 100644 components/tvplanit/source/vpreg.res create mode 100644 components/tvplanit/source/vpregad.pas create mode 100644 components/tvplanit/source/vpregf2.pas create mode 100644 components/tvplanit/source/vpregis.pas create mode 100644 components/tvplanit/source/vpreseditdlg.lfm create mode 100644 components/tvplanit/source/vpreseditdlg.lrs create mode 100644 components/tvplanit/source/vpreseditdlg.pas create mode 100644 components/tvplanit/source/vpruntime.dpk create mode 100644 components/tvplanit/source/vpruntime.res create mode 100644 components/tvplanit/source/vpselresdlg.lfm create mode 100644 components/tvplanit/source/vpselresdlg.pas create mode 100644 components/tvplanit/source/vpsqlbde.pas create mode 100644 components/tvplanit/source/vpsqldialect.pas create mode 100644 components/tvplanit/source/vpsqlds.pas create mode 100644 components/tvplanit/source/vpsqlparadoxdialect.pas create mode 100644 components/tvplanit/source/vpsr.inc create mode 100644 components/tvplanit/source/vpsr.pas create mode 100644 components/tvplanit/source/vpsr.rst create mode 100644 components/tvplanit/source/vptaskeditdlg.lfm create mode 100644 components/tvplanit/source/vptaskeditdlg.pas create mode 100644 components/tvplanit/source/vptasklist.pas create mode 100644 components/tvplanit/source/vptimerpool.pas create mode 100644 components/tvplanit/source/vpwavdlg.lfm create mode 100644 components/tvplanit/source/vpwavdlg.lrs create mode 100644 components/tvplanit/source/vpwavdlg.pas create mode 100644 components/tvplanit/source/vpwavpe.pas create mode 100644 components/tvplanit/source/vpweekview.pas create mode 100644 components/tvplanit/source/vpxbase.pas create mode 100644 components/tvplanit/source/vpxchrflt.pas create mode 100644 components/tvplanit/source/vpxparsr.pas diff --git a/components/tvplanit/packages/v103_lazarus.lpk b/components/tvplanit/packages/v103_lazarus.lpk new file mode 100644 index 000000000..96801a7ff --- /dev/null +++ b/components/tvplanit/packages/v103_lazarus.lpk @@ -0,0 +1,283 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/tvplanit/readme.txt b/components/tvplanit/readme.txt new file mode 100644 index 000000000..0d6c1c486 --- /dev/null +++ b/components/tvplanit/readme.txt @@ -0,0 +1,89 @@ +TurboPower Visual PlanIt + + +Table of contents + +1. Introduction +2. Package names +3. Installation +4. Version history +4.1 Release 1.03 + +============================================== + + +1. Introduction + +Visual PlanIt is a set of synchronized, data-aware components for +adding time, task, & contact management capabilities to applications +written in Borland Delphi & C++Builder. Get that Outlook look & feel +without the hassle. + +This is a source-only release of TurboPower Visual PlanIt. It includes +designtime packages for Delphi 4 through 7 and C++Builder 4 through 6. + +============================================== + +2. Package names + + +TurboPower Visual PlanIt package names have the following form: + + VNNNKKVV.* + | | | + | | +------ VV VCL version (30=Delphi 3, 40=Delphi 4, 70=Delphi 7) + | +-------- K Kind of package (_D=designtime, AD = Advantage DataStore, + | IS = DBISAM DataStore, F2 = FlashFiler 2 DataStore) + | + +----------- NNN Product version number (e.g., 403=version 4.03) + + +For example, the Visual PlanIt designtime package files for Delphi 7 have +the filename V103_D70.*. + +============================================== + +3. Installation + + +To install TurboPower Visual PlanIt into your IDE, take the following +steps: + + 1. Unzip the release files into a directory (e.g., d:\vplanit). + + 2. Start Delphi or C++Builder. + + 3. Add the source subdirectory (e.g., d:\vplanit\source) to the + IDE's library path. + + 4. Open & install the designtime package specific to the IDE being + used. The IDE should notify you the components have been + installed. + + 5. Make sure the PATH environmental variable contains the directory + in which the compiled packages (i.e., BPL or DPL files) were + placed. + +============================================== + +4. Version history + + +4.1 Release 1.03 + + Please note that the following issue #s are from Bugzilla. These + bugs were not exported to SourceForge. + + Bug fixes + ------------------------------------------------------------- + 3547 - List Index out of Bounds error + 3589 - Needs OnDblClick Event + 3877 - ContactGrid won't scroll to a newly selected contact if it is + out of view. + 3979 - FlexDataStore bug + 4021 - TVpTask.SetChanged marks Events dirty instead of taks. (duh!) + 4076 - VPDBISAMDataStore needs an AfterPost event. + 4078 - 12 and 24 hour display backward in the Events + 4079 - Using the DBIsamDataStore, recurring events show up under all + resources. + 4080 - De Piggify the DBIsamDataStore component. diff --git a/components/tvplanit/source/vp.inc b/components/tvplanit/source/vp.inc new file mode 100644 index 000000000..f137598b5 --- /dev/null +++ b/components/tvplanit/source/vp.inc @@ -0,0 +1,119 @@ +{*********************************************************} +{* VP.INC 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (c) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{Conditional defines that affect compilation} + +{$Q-} {Overflow Checking} +{$R-} {Range-Checking} +{$S-} {Stack-Overflow Checking} +{$V-} {Var-String Checking} +{$T-} {No type-checked pointers} +{$X+} {Extended syntax} +{$P-} {No open string parameters} +{$B-} {Incomplete Boolean evaluation} +{$J+} {Writable constants} +{$H+} {Huge strings} +{$A+} {Word Align Data} +{$I+} {Input/Output-Checking} + +{-Invalid Platform Defines----------------------------------------------} +{ Visual PlanIt only supports D3 - D6 and BCB3 - BCB6 } +{$IFDEF VER80} {Delphi 1} + {$DEFINE INVALID_PLATFORM} +{$ENDIF} + +{$IFDEF VER90} {Delphi 2} + {$DEFINE INVALID_PLATFORM} +{$ENDIF} + +{$IFDEF VER93} {BCB1} + {$DEFINE INVALID_PLATFORM} +{$ENDIF} + +{$IFDEF INVALID_PLATFORM} + Error!!! Visual PlanIt supports Delphi 3/BCB3 and above ONLY. +{$ENDIF} + +{-C++Builder General Defines--------------------------------------------} +{$IFDEF VER110} {BCB3} + {$DEFINE CBUILDER} + {$ObjExportAll On} +{$ENDIF} +{$IFDEF VER125} {BCB4} + {$DEFINE CBUILDER} + {$ObjExportAll On} +{$ENDIF} +{$IFDEF VER135} {BCB5} + {$DEFINE CBuilder} + {$ObjExportAll On} +{$ENDIF} +{$IFDEF VER145} {BCB6} + {$DEFINE CBuilder} + {$ObjExportAll On} +{$ENDIF} + +{-Version Test----------------------------------------------------------} +{$IFNDEF INVALID_PLATFORM} {D1, D2, or BCB1} + {$DEFINE VERSION3} +{$ENDIF} + +{$IFDEF VERSION3} + {$IFNDEF VER100} {Delphi 3} + {$IFNDEF VER110} {BCB 3} + {$DEFINE VERSION4} {Delphi 4.0 or higher} + {$ENDIF} + {$ENDIF} +{$ENDIF} + +{$IFDEF VERSION4} + {$IFNDEF VER120} {Delphi 4} + {$IFNDEF VER125} {BCB 4} + {$DEFINE VERSION5} {Delphi 5.0 or higher} + {$ENDIF} + {$ENDIF} +{$ENDIF} + +{$IFDEF VERSION5} + {$IFNDEF VER130} {Delphi 5} + {$IFNDEF VER135} {BCB 5} + {$DEFINE VERSION6} {Delphi 6.0 or higher} + {$ENDIF} + {$ENDIF} +{$ENDIF} + +{$IFDEF VERSION6} + {$IFNDEF VER140} {Delphi 6} + {$IFNDEF VER145} {BCB 6} + {$DEFINE VERSION7} {Delphi 7.0 or higher} + {$ENDIF} + {$ENDIF} +{$ENDIF} diff --git a/components/tvplanit/source/vpabout.lfm b/components/tvplanit/source/vpabout.lfm new file mode 100644 index 000000000..1ecfeeb4e --- /dev/null +++ b/components/tvplanit/source/vpabout.lfm @@ -0,0 +1,1299 @@ +object frmAbout: TfrmAbout + Left = 282 + Height = 312 + Top = 205 + Width = 471 + HorzScrollBar.Page = 470 + VertScrollBar.Page = 311 + BorderStyle = bsDialog + Caption = 'About Visual PlanIt' + ClientHeight = 312 + ClientWidth = 471 + Font.Height = -11 + Font.Name = 'MS Sans Serif' + OnActivate = FormActivate + OnMouseMove = FormMouseMove + Position = poScreenCenter + object Bevel3: TBevel + Left = 152 + Height = 96 + Top = 160 + Width = 305 + Shape = bsFrame + end + object Bevel2: TBevel + Left = 6 + Height = 17 + Top = 265 + Width = 451 + Shape = bsTopLine + end + object ProgramName: TLabel + Left = 152 + Height = 14 + Top = 8 + Width = 92 + Caption = 'Visual PlanIt' + Font.Height = -13 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentColor = False + end + object VisitUsLabel: TLabel + Left = 153 + Height = 15 + Top = 109 + Width = 287 + Caption = 'Visit the Visual PlanIt project on SourceForge' + ParentColor = False + end + object GeneralNewsgroupsLabel: TLabel + Left = 160 + Height = 15 + Top = 168 + Width = 179 + Caption = 'Visual PlanIt support groups' + ParentColor = False + end + object lblTurboLink: TLabel + Cursor = crHandPoint + Left = 161 + Height = 13 + Top = 125 + Width = 232 + Caption = 'http://sourceforge.net/projects/tpvplanit/' + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsUnderline] + ParentColor = False + OnClick = lblTurboLinkClick + OnMouseMove = lblTurboLinkMouseMove + end + object lblHelp: TLabel + Cursor = crHandPoint + Left = 168 + Height = 13 + Top = 198 + Width = 334 + Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241880' + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsUnderline] + ParentColor = False + OnClick = lblHelpClick + OnMouseMove = lblTurboLinkMouseMove + end + object CopyrightLabel: TLabel + Left = 7 + Height = 15 + Top = 273 + Width = 332 + Caption = '(C) Copyright 2001, TurboPower Software Company.' + ParentColor = False + end + object RightsReservedLabel: TLabel + Left = 7 + Height = 15 + Top = 289 + Width = 120 + Caption = 'All rights reserved.' + ParentColor = False + end + object lblGeneralDiscussion: TLabel + Cursor = crHandPoint + Left = 168 + Height = 13 + Top = 230 + Width = 334 + Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241879' + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsUnderline] + ParentColor = False + OnClick = lblGeneralDiscussionClick + OnMouseMove = lblTurboLinkMouseMove + end + object Label2: TLabel + Left = 168 + Height = 15 + Top = 186 + Width = 34 + Caption = 'Help:' + ParentColor = False + end + object Label3: TLabel + Left = 168 + Height = 15 + Top = 217 + Width = 127 + Caption = 'General Discussion:' + ParentColor = False + end + object Label1: TLabel + Left = 160 + Height = 49 + Top = 40 + Width = 265 + AutoSize = False + Caption = 'Visual PlanIt was released under the Mozilla 1.1 license in January, 2003. The project is hosted on SourceForge at sourceforge.net/projects/tpvplanit.' + ParentColor = False + WordWrap = True + end + object Panel1: TPanel + Left = 6 + Height = 251 + Top = 6 + Width = 139 + BevelOuter = bvLowered + ClientHeight = 251 + ClientWidth = 139 + TabOrder = 0 + object Image1: TImage + Left = 1 + Height = 249 + Top = 1 + Width = 137 + Align = alClient + Picture.Data = { + 07544269746D6170628C0000424D628C00000000000036040000280000008900 + 0000F900000001000800000000002C8800000000000000000000000100000001 + 0000000000000000800000800000008080008000000080008000808000008080 + 8000C0DCC000F0CAA600AA3F2A00FF3F2A00005F2A00555F2A00AA5F2A00FF5F + 2A00007F2A00557F2A00AA7F2A00FF7F2A00009F2A00559F2A00AA9F2A00FF9F + 2A0000BF2A0055BF2A00AABF2A00FFBF2A0000DF2A0055DF2A00AADF2A00FFDF + 2A0000FF2A0055FF2A00AAFF2A00FFFF2A000000550055005500AA005500FF00 + 5500001F5500551F5500AA1F5500FF1F5500003F5500553F5500AA3F5500FF3F + 5500005F5500555F5500AA5F5500FF5F5500007F5500557F5500AA7F5500FF7F + 5500009F5500559F5500AA9F5500FF9F550000BF550055BF5500AABF5500FFBF + 550000DF550055DF5500AADF5500FFDF550000FF550055FF5500AAFF5500FFFF + 550000007F0055007F00AA007F00FF007F00001F7F00551F7F00AA1F7F00FF1F + 7F00003F7F00553F7F00AA3F7F00FF3F7F00005F7F00555F7F00AA5F7F00FF5F + 7F00007F7F00557F7F00AA7F7F00FF7F7F00009F7F00559F7F00AA9F7F00FF9F + 7F0000BF7F0055BF7F00AABF7F00FFBF7F0000DF7F0055DF7F00AADF7F00FFDF + 7F0000FF7F0055FF7F00AAFF7F00FFFF7F000000AA005500AA00AA00AA00FF00 + AA00001FAA00551FAA00AA1FAA00FF1FAA00003FAA00553FAA00AA3FAA00FF3F + AA00005FAA00555FAA00AA5FAA00FF5FAA00007FAA00557FAA00AA7FAA00FF7F + AA00009FAA00559FAA00AA9FAA00FF9FAA0000BFAA0055BFAA00AABFAA00FFBF + AA0000DFAA0055DFAA00AADFAA00FFDFAA0000FFAA0055FFAA00AAFFAA00FFFF + AA000000D4005500D400AA00D400FF00D400001FD400551FD400AA1FD400FF1F + D400003FD400553FD400AA3FD400FF3FD400005FD400555FD400AA5FD400FF5F + D400007FD400557FD400AA7FD400FF7FD400009FD400559FD400AA9FD400FF9F + D40000BFD40055BFD400AABFD400FFBFD40000DFD40055DFD400AADFD400FFDF + D40000FFD40055FFD400AAFFD400FFFFD4005500FF00AA00FF00001FFF00551F + FF00AA1FFF00FF1FFF00003FFF00553FFF00AA3FFF00FF3FFF00005FFF00555F + FF00AA5FFF00FF5FFF00007FFF00557FFF00AA7FFF00FF7FFF00009FFF00559F + FF00AA9FFF00FF9FFF0000BFFF0055BFFF00AABFFF00FFBFFF0000DFFF0055DF + FF00AADFFF00FFDFFF0055FFFF00AAFFFF00FFCCCC00FFCCFF00FFFF3300FFFF + 6600FFFF9900FFFFCC00007F0000557F0000AA7F0000FF7F0000009F0000559F + 0000AA9F0000FF9F000000BF000055BF0000AABF0000FFBF000000DF000055DF + 0000AADF0000FFDF000055FF0000AAFF000000002A0055002A00AA002A00FF00 + 2A00001F2A00551F2A00AA1F2A00FF1F2A00003F2A00553F2A00F0FBFF00A4A0 + A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000F700000000 + 0000F5F100000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000055FFF000002DF007FFF000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000031F5FF310031FFF508AF0000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000F131000031FFF0F6 + F62D59FFECFF0700000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FF00000000 + 0000000007F6F100F5FF31F7FF2D0708F5FFF600F7FF2CF507F0000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000F6FF072D08862DFFF1820707F6F531 + FF31F1FFFFF10000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FF00000000000000003100AFFF + 822DFFF1FFF00831D4F700FFF7F0FF0800000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FFF70008FF0008310855082DF6ECAF82F0FFFF0700000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FF0000000000000000F7FFF7000886558207868631 + 08F708F0FFFF07F0F52D00000000000000000000072D0000000000F582AF0831 + 0000003107000000F0F7F5310707073100000000000007AAAF860700000000F5 + F700000000000000000007AAAFAA07000000000000002DF10000000000310000 + 0000F0070707F707F7002D07000000F0F72D00000000000000000000F0F50000 + 002DFF86ECD4080831FF82F7F686F1F60700F5AAFFFFF5000000000000000000 + FFF70000000007FFFFAAAFFF86000008FF000000AFFFF008FFF6FFF6F6F00000 + 31FFFFAFAAAFFFF631000007FF000000000000002DFFFFAFAAAFFFFF31000000 + 0000080700000000F0FFF5000000F1FFFFFFFFFFFFF086FF000000AFFFF00000 + 000000FF00000000F5F6F6F7F6310008AF00AAFF07083186F62DF60731AFF686 + 31F02D310000000000000000FFF7000000F0FF8200000031FF550086FF0000F7 + F6F500AFAA0000F1F6AF002DFF08F0000000F0AFF62D0007FF0000000000002D + FF08F0000000F008FF3100000000FFF60000000055FF07000000F4FF31000000 + 000086F6000007FFF50000000000000000000000000786FFFFFFF7F00708F186 + 2D00000000AFFF868607F12D07F6F6F60700000000000000FFF7000000F7FF00 + 00000000AF080082F600F0FFF70000080800000007FF00FF0800000000000000 + AFF60007FF000000000000FFF60000000000000008FF00000007FFFFF5000000 + 08FFF6000000F1FF31000000000086D100F0FFF700000000000000FF00000000 + 00F02DF0F55586AF08F6F60000000000002D0755F786FFFFF6AF31F100000000 + 00000000FFF700000086FF0000000000F7FF0086AF00D108000000AFAA000000 + F7F607F6F1000000000000002DFFF555FF000000000031FF2D00000000000000 + F1FF310000FF86AFF70000F1FFF7FF2D0000F4FF310000000000860800D10800 + 0000000000000002520A000000F5FFF6AFF7072D31F7F70000000000000008FF + 8207F0F5313100000000000000000000F6F700000086F6000000000007FF00F7 + D108FF31000000AB0800F007FF0782FF000000000000000000FF0731F6F70731 + 0000F7FF000000000000000000FF86002DFFF007FF0000F7FF00AF080000F1FF + 31000000000086D108FF310000000000000000FF00000000000031070782AA86 + 868231000000000000000782868686F755312D000000000000000000FFF70000 + 0086F6000000000007FF00F7FF0808FF86000008FFFFFFFF070008AF00000000 + 0000000000FFF731FFAFF6FFF600F7F600000000000000000008AA0008FF0000 + FF3100FFF70007FFF000F0FF0886AA08860082FF0808FFAA0000000000000000 + 000000000000003131F5F507AAFF8600000000000000865A312D0782F6FFFFF4 + 0000000000000000FFF700000008D1000000000007FF0086F60000F5FF070008 + 080031FF310082FF000000000000000000FF0731FF0000F0FF8207FF00000000 + 0000000000FFF700FF070000AF0831F6F00000FF0700F1FFAFAA0808AA0082AF + 0000F5FF07000000000000FF00000000F0F131F6FFF6F6865A31072D00000000 + 0000FFF608D18631F5F031F10000000000000000FFF700000086F60000000000 + 07FF0082FF000000AA0800AFAA000007FF0031F62D0000000000000031FFF031 + FF00000007FF2DFF31000000000000002DF6F531FFF0000031FFF6AF00000008 + FF00F0FF31000000000086F600000082AF000000000000000000000082FFF6AF + 072DF10786AAFF08000000002D082DAA07F086FFFFFF86310000000000000000 + FF0700000086AF000000000007FF0082F60000000808000808000007FF0000AF + F600000000000000FFAF0007FF00000007FF0008FF00000000000000FFAF00F6 + 0800000000FFFF310000002DFFF500FF31000000000086AF0000000808F02DF5 + 000000FF870900000031F5F03108F6082DF7082DF6F7558607FF08F5AF820059 + FF07F6FF0000000000000000FFF7000000AAF6000000000007FF0086F600F007 + FF3100AFAA00F5FF080000F0FFF62D0000002DFFFFF00007FF000031FF8600F0 + FFFF2D0000002DF6FFF0F5FF3100000000F7FF0000000000FF86F0FF31000000 + 000086F600F007FF072D07070000003E3F350000000031FFF686F100F7AF2D08 + D10786FF2D86F7AFF008FFF1F00000F5F00000000008FFFFFFFFFFFF2D86F600 + 00000000F7F60082FFFFFFFF5E000008FFFFFF0800000000F108FFFFF6FFFF08 + F0000007FFFFFFFF08000000F008FFFFF6FFFF08F00008FF00000000002DF700 + 0000000007FF31F6FFFFFFFFFFF0F7FFFFFFFF5E002D0707000000FF1D4D0000 + 00000031F1F0F7FFFFF0AB070831AA0807862D86AFEC86FF0700000000000000 + 002D31313131313100F52D0000000000F13100F531312DF0000000F53131F000 + 0000000000002D07F707F500000000F031312DF0000000000000F507F7072D00 + 000031F5000000000000F000000000000031F52D313131313100F131312DF000 + 0000F5000000005450460000000000000007FFF6F00886F0AF31860786070800 + FF080082FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FF0000000000000000F0AFF600 + 82F60008860782F5F62DFFF0F7FFF60031000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000F5FFF6F05EFFF131FF5582F72DFFF508F7F107FFFF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FF00000000000000F007F131FF07F0FFFFF5FF0731 + FF0759FFF000F0FF310000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000007FFF0FF3159D108F1FF2D0000F5F00000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FF9A72000000000000000000000000F68231F62D0031FFF03100000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000F5F631 + F1F50000F5F63100000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFA11B0000 + 000000000000000000F0F5000000000000F70000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000C7C7C7A5C7A5C7C7C7CBC7C7C7A4C7A5C7A5C6CBA5CCCBCCCBCCCBCCCBCB + A9CBCCCCCBCCCCCBCCCCCCCCCBCCCCCCCBC7C7A5CBCBCCCCCBCCCCCCCCCBCCCC + CBCCCCCBCCCCCCCCCBCBC7C7C7C6C7CBCBCCCCCBCCCCCCCBCCCCCCCBCCCCCCCB + CCCBCCCBCBCBCBCBCBCBCBCBCBCBCBC7CBC7C7A5C7A4C7C6C7C7C7C7C7C7C7A5 + C6C7C7C7C6A5C7C7C7A5C6FF0000A5A4A5C6A5C6A5A4A5CBA5A0A5C7A0C7A4C3 + A5A5CBA9CCA9AAA9AACBAAC7A5C7A5A9AACBAACCA9CCA9AACCA5CCA9A5A5A5C7 + A5AACBAAAACBAAA9AACCA9CCAACBAACCA9AAA9AACBA5A5A4A5A5A5C7A9A5CBA6 + CBAAA9AAA9AACBAAA9A6CBAAA9AACBAAA5A5A5A5C7A5C7A5A5A5A5C7A5A5A5C6 + A5C7A5A5C7A4A5A5A0A5A4C7A5C7A4A5A5C7A4A5A4C7A5000000A5C3A5A1A4A1 + A5A5A5A5A5A5A0A5A5A4A5A4A5A5A5A5AAC8A9C8AAA5AAA9A5A5A9C8A9AAA5A9 + AAA5CCA9AAA9AACBA5A4A5A5A5A9A6CBAAAACBA6A9AAA5AAA5AAA9A9CCA9CCA9 + AAC7A5A1A4A5A5A5C8A9A5AAA9CCA6CBAAA9AAA9CCA9AACBA6A9A6CBAAC7A9A5 + A5A9A5A5C7A5A5A5A5A5A5A5A4A5A0A5A5A5A4A5A5C7A5A4A5A5A1A4A5A4A5C7 + A1A4A5FF8709A4A5A4A5A5A5C6A0A5A5C7A4A5A5A0A5A1A5A5C7A5AACBA9AAA9 + A9CBAAC7A5A5C7A9A6A9CCAACBAAA9A6CBAAAAA5A5C7A5A5C7AAA9AAA5AAAAA9 + CCA9CCA9AACBAAA6A9AAA5AAA5A9A5C7A5A5A5A5A9A5AAA9C8A9AAAAA5CCA5CC + A9A6CBA6A9CCA9AAA5AAA5C8A9A5A5A5A5A5A5A5C7A5A5A5A5A5C7A5A0A5C7A5 + A4A1A4A5A1A4C7A5A1A5A1A4A5A5A50DFC0BA5A1A5A0A5A0A5A5C7A5A5A5C3A4 + A5A5C6A5A4A5A9AAA9A6A9A6CCAAA5A9A5A5A9AAAACBAAA5AAA5AACBAAA6CBA5 + A5A5A5A5AAA9C8A9CCA9CBA6A9A6A9AAC7AAA5CBAAA5CCAACBA5A5A5A4C7A5C7 + A9CCA5CCA9AAA5A9CCA9AAA9A6A9AAA9AAA9A6A9AACBAAA9A5A5C7A9A5A5A5A5 + A5A5A5C7A5A5A4A5C7A5A1A4C7A5A5A5A4A5A1A5C6A5A4A5A5C7A5FF0B02A4A5 + A4A5C7A5A0A5A5A5A5A4A5A1A4A1A5A0A5A5C7A9CCA9CCA9A9A5AAA5A5A9A5CC + A9A6AAA9AACCA9A6A9A9AAA5A5A5A5A9C7AAA9AAA9A6AAA9AACBAAA9AAA9AAAA + A9AAA9A9A6A9A5A1A5A5A5A9A6A9AAA9AAA9CCAAA9AAA5CCA9CCA9CCA5CCA9CC + A5AAA5AACBA9A5A5C7A9C7A5A5C7A5A5A5A5A5A4A5A4A5A5A4A1A4C3A5A4A5A0 + A5A5A5A5A5A5A5800080A5A1C7A0A5A5A5A4A5C7A5A5A4C7A5A4A5A5A5A5A5A5 + A6A9A6AACCAACBA9A5C7A9A5CCA9A9C8A9AAA9CCAAC7AACBA5A5A5A5AAA9C8A9 + AACBAAC7AAAAC7AAC7AACBA6CBAAC8A9AAC7A5A4A5A5A5A5A9CCA5AAC7AAA5AA + C7AAA9A6AAA9A6A9AAA9A6A9AACBAAA9A6AAA9A5A5A5A9A5A5A5A5A5A5A5A5A5 + A5A5A4A5A5A5A5A4A1A5C7A5A4A5C7A5A5A5A5FF0000A4A5A4A5A4A1C6A1A5A5 + A5A5A1A4A1A5A0C7A4C7A5A9AACBA9CBA5A9A5A5A5A5A5AAA9A6CCA9AAA5CCA9 + A6AAA9A5A5A5C7A5CBAAA9AAA9A6A9AAA9AAAAA9AAA9AAA9AAA9AAAAA9A5A5C7 + A5A5A5CBA6A9AAA9AAA9CCA9AAA9C8A9AAA6CBAAA5AACBAAC7AAA5CCA9CCAAA5 + A9A5A5C7A5A5A5C7A5A5C7A5A5A5A5C7A4A5A4A5A4A5A4A5A5A5A5A5A9C7A500 + 0000A5A1A5A1A5A4A5A5A5A5A5C7A4A5A5A4A5A5A1A5A5C7A5A5A5A5A5A5A5C7 + A5A5A9CCA9AAA9A6CBAAA9AAA9A9CCA5A5A5A5A9AAA6A9C8AACBAAA5CCA5A9CC + A5AAC7AAA5AAC7A9C7A5A5A4A5C7A9A5AACBA6CCA9C8A9AAC7AAA9AACBA9AAA9 + CCA9A6A9AAA9AAA9AAA9A5CCA5C7A5A5A9A5A5A5A5A5A5A5C7A5A5A5A5A5C7A5 + A5A5A5A5A5A5A5A5A5A5A9FF0000A5A4A5A4C3A5A0A5A4C7A9A5A5A4A1C7A0A5 + A4A5A5A5A5A5A5A5C7A5A5A5A5C7AAA5CCA5CCA9AAA9C8A9C8AAAAA5C7A5A5A5 + A9CBAAA9A5AACBAAA9CCA6A9CCA9AAA9CCA9AAAAA9A5A5A5A5A5A5CCA9AAA9A9 + AAA9AAA9AAA9CCA9A6AACBA6A9CCA9AAA5CCA9CCA5CCAAA9AAA5A9A5A5C7A5A5 + A5A5A5A5A5A5A5A5A5A5A5A5A5C7A5A5CBA5A5A5C7A5A5545046A5C3A4A5A4A5 + A5A1A5A5A5A5A1A5A4A5A5A1A5C7A5A5CBA9A6A9AAA5AAA5A5A5A9AAA9AAA9A6 + CBAAA9AAA9A9CCA9A5A5A5C7A6A9CCAAA9AAA5AAA9A9AAAAA5AACBA6AAA9C7AA + A5A5C6A5A5A5A5AAA5CCAAA5CCA9C8AAC7AAA5AACBA5AAA9A6A9AACBAAA5A6A9 + AAA9A6CBAAA9C7A5A5A5A5C7A5A5C7A5A5C7A5A5C7A5A5A5A5A5A5A5A5A5C7A5 + A9A5A9FF0000A4A5A5A1A5A0C7A4A5A5A5C7A5A4A1A4A5A4A5A5A5A9A6A9CCA9 + A6CBAACBA5A5C7AAC8A9AAA9AAA5CCA9C8AAA5AAA9A5A5A5A9AAA5AACCA5CCA9 + C8AACBAAA9AAA6A9CBAAAAA9C7A5A5A5A5C7AACBAAA9A6AAA9AAA9AAA9AACCA9 + AAAACBAACBAAC7AAA9AACBAAA5AACBAAA9AAAAA9AAA5A9A5A5A5A9A5A5A5A5A5 + A5A5A5C7A5A5A5A5A5A5A5A5A5A5CC000000A5A1A4A5A4A5A5A5A0C7A5A5A4A1 + A5C7A0A5C3A5A5A6CBAAA5AACBAAA5AAA5A5AAA9A9AACBA6A9CCAAA9AAA9AACB + A6C7A5A5C7A9CCA9A9AAAAA9AAA9A6A9C8A9CBAAAAA6CBA5A5A5A5A5A5AAA9AA + A5AACBA9CCA5AAA9C8A9AAA5CCA9A6A9A6A9AAA9C8A9A6A9CCA9A6AAC7AAC7AA + C7A5A5A5A5C7A5A5A5A5A5A5A5A5A5A5A5A5C7A5A5C7A5A9C7AAA9FF0000A5A4 + A1A4C3A4A1A4A5A5A5A5A5A5A4A5A5A4A5A5C7A9AAA9CCA9A6A9AAA9CCA5A5CC + AAA5AACBAAAAA9A6A9CCA9A6A9A5A5A5A5A5A9CCA6A9C7AAA5AACBAAA9AAAAC7 + A9A9A5A5A5A4A5A5CBA9A6A9CCA9AAA6AAA9CCA9AAA9CBAAA9AAA9CCA9AAC7AA + A9AACBAAA6A9CCA9AAA9AAA9AAA9C7A9A5A5A5C7A5A5C7A5A5C7A5A5A5A5A5A5 + A5A5A5A5A5A9A5000000A5A5C7A5A5A5A5A5A0A5C7A5A4A1A5A0A5A1A4A5A9A5 + CBA6A9AACBAAC7AAA9A5A9A5AACBAAA6A9C7AACBAAA5AACBAAA9A5A5A5A5A5A9 + CCAAAAAACBAAA5CCAAA5AAAACCA5A5A4C7A5A5A5A5AACBAAA5CCA9A9CCA5AAA5 + CCA6A9AAA6CBA6A9CCA9AAA5CCA9A6A9CBA6A9A6CBAAA5CCA9A6A9A5A6A9A5A5 + A5A5A5A5A5A5A5A5C7A5A5A5A5A5C7A5AAC7AAFF0000A4A1A4A1A4A1C6A1A5A5 + A5A5A5C7A4A5A5A4A5A5A5A5AAA9CCA5AAA9AAA9C8A9A5AACBA6A9CBAAAAA9AA + A5CCA9A6AAA5CCA5A5C7A5A5A9A5A9CBA6A9AAA9A9CCA9A9A5A5C7A5A5A5A5A5 + A9C8AAA9AAA9A6AAA9AACBAAA9AACCA5CCA9AAA9A6AACBAAA9AACBAAAAA9CCA9 + AAA5A9AAA5CCA9C8A9C7A5A5A9A5A5A5A5A5A5A5A5A5A5C7A5A5A9AAA9AAA900 + 0000A5A5A5A4A5A5A5A4C6A5A5A5A5A4A1A5C2A5A1C6A5A9CCA5AAAAA9AAC7AA + A9A5C7AAA9AAA9A6AACBA6A9CCA9AACBA9CCA9A5A5A5A5A5A9CCAAA6AAA9C8AA + C8A9A5C7A5A4A5A5A5A5A5CCAAA9A9AAC8A9CCA9CCA5AAA5CCA5A9AAA9AAC7AA + CBA9A6A9AAC7AAA9C7AAAAA5AACBA6CBAAA9A6A9A5A9A5AAC7A5A5C7A5A5C7A5 + A5A5A5A5AAA5A9C8A9CCA5FF0000A4A1A4A5C3A4A1A5A1A4A5C7A5A5A4A5A5A4 + A5A5A5A5A9AACBA9C8A9AAA6CBA5A9C8AAA5CCAAA9AAA9AAA5AAA5AAAAA9A6A9 + A5A5A5C7A5A5CBA9CBAAA9A9A9A5A5A5A5A5A5A5A5CBA9AAA5AAC8AAA9AAA9A6 + A9CCA9AAA9AAAAA9C8A9AAA9A6AAA9CCA9AAA9AAAAAAA9CCA9AAA9AAA5AACBAA + A9A6CCA9AAA5A9A5A5A5A5A5A9C7A9A5A9CCAAA9A6A9AA000000A5C7A1A4A5A5 + A4A5A5A5A5A5A5A1A5A0A5A1A4A5A5C7A5AAA6AAA9CCA9A9AAA5A5A9CBAAA9C7 + AAC7AACBAACBAACBA6A9CCA6CBA5A5A5A5A5A5A5A5A5C7A5A5C7A5A5A5C7A5A5 + A5A6CBA9CCA9A9CBA6CBAAA9AAA5CCA9C8A9CCA9AACCA5AACBAAA5AAA5CCA6CB + A6CBA6A9A6CBA6A9CCA9A6A9CCA9AAA5AACBA6A9C7AAA9A5A5AAA5CCA5A5CBAA + A9C8A9FF0000A4A5A4A5A1A4C3A4A5A0A5CBA5A5C6A5A5C6A5A1A5A5AAA9CBA9 + A6A9A6CCA9C7A5A5AAA9AAAAA9AAA9A6A9AAA9A6A9AAA9AAA9AAA5A9A5C7A5A5 + C7A5A5A5A5A5A5A5A5A5A5A5AAA9A6AAA9AAAAAAA9AAA5CCA9AAA9AAA9AAA5AA + A9AAAAA9A6A9CCAAA9AAA9AAA9AAA9CCA9AAA9AAA5AACBAAA5AACBAACBA6A9CB + A6A9C8A9A9A5A9A5A9A5AAA5AAA9AA000000A5A1A5A1A4A5A5A5A0C7A5A5A5A4 + A1A5A0A5A1A4A5A5CBAAA6AAAACBAAA9A5A5A5A9AAC7AAA5CCA9AACBAAA5CCA9 + CCA9C8A9AAC7AAC7A5A5A5A5A5A5A5A5A5A5A5A5A5A5A9CCA9CCA9AAC7AAC7A9 + A6CBAAA9A6CBA6A9C8A9AACBA6A9C7AACBAAA9A9C8A9AAC7AACBA6A9AAA5CCA5 + CCA9A6A9CCA9AAA5AAA9AAA6A9A6A9AAC7AAC7A9A6CBA5AACBAAA5FF0000A5A4 + A5A4C7A5A0A5A5A4A5A5A5A5A5A4A5A4A5A5C7A5A5CBA9CBA5A9A5A5A5A5A5C7 + A9AACBAAA9C8A9A6A9AAA9AAA5AAA9AAA9AAAAA9AAAAA5A9A5A5A5A5C7A5A5A5 + C8A9A6A9AAA5AAA9AAA9AACCA9AAA5CCA9AAA9AAA9CCA5AACBAAAAA9AACBA6AA + A9AAA9AAA9AAA9CCA9AAA9AAA9AACBAAAAA5AACBAAA6CCA9CCA9CCA9AAA5A9A6 + A9AACBAAA5CCAA4C1214A0A5C3A5A0A5A5A0A5A1A5A5C7A0A5A1A5A1A4A5A5A5 + A5A5A5A5A5C7A5C7A5A5A5A5AAA5AAA9AAA9AACBAACBA6CBAAA9C8A9C8A9CBA6 + A9CCA9A6A9C7A9A6A9A6CBAAA9AACBA6A9CCA9C8A9A6A9AAA5CCA9A6CBAAC8A9 + A6A9AAA5AACBA6A9A6AACBA9C8A9C8A9AAC7AAA5AAC7AAA9C8A9A6A9A9CCA9A6 + CBA9A5AAA9A6A9A6CBA9A6CBAAA5AAA9AAA5A9FF285CA5A4A5A4A5A5A4C7A4A5 + C6A5A5A5A4C7A4A5C7A0A5A5A5A5A5A5AAA9AAA5AACBA5A5CBAAA9C8AACBAAA5 + AAA6A9AAA5AAA9AAA9AAAAA9AAA9A6A9CCAAA6CBAAA9AAA5CCA9AAA9AAA5AAA9 + AACBAAA9AAA9AAA9AAA9AAAACBAACBAAA9AAA9CCA9AAA6AAA9AAA9AAA5AAA9CC + A9AAA9AAA9AACBAAC8A9AAA9AAAACCA9AACBAAAAA9A6A9A5AACCA9C8A9AAAA4C + 1214A5A1A5A1A5C6A1A5A1A4A1A5A5A4A1A4A1A5A0A5C7A5A5CBA6A9C7AAA5CC + A9A6A5A5AAA5CCA9A9A6A9AACBA9AACBAACBAACCA9C8A9CCA5CCA9CCA6A9A9AA + A9A6CBAAA9A6CBA6CCA9AACBAAA5AAC7AACBA6CCA9A6CBA9A6A9A6A9AAC7AAA9 + A6CBAAA9CCA9A6CBAACBAAA5AAC7AAC8A9CCA5AAA9AACBA6CCA5A9AAC7AAA9C7 + AAC7A9AAC7A9A5AAA9CCA9FFB032A4C7A4A5A0A5A5A4A5A5A4A5C7A5A5A5A4A5 + A5A4A5A5A5A9CBAAAAA9AAA9AAA9A5A5CBAAA9A6AAA9CCA9AAAAAAA5AAA9AAA5 + AAA9A6A9AAA9A6AAA9AACCA5CCA9AAA5CCA9AAA9AAC7AAA6A9CCA9AAA6A9AAA9 + AAA9AAAACBAAA9CCA9AAA5CCA9AACBAAA5CCA9AAA9A6A9CCA9AAAAA9AAA9AAAA + CBA6AAA9A9AACCA9AAA5AAAAA9AAA5AAA9A6A9CCAAA5AA45CD35A5A0A5A5A5A4 + A1A5A0A5A5A5A5A5A4C7A1A4A1A5A5A5A5A6AAA5CBAAC7AAC7AACBA5A5AACBA9 + CCA6A9C8A9C7AACBAAA6CBAACBAAA9CCA5CCA9A9C8A9AAA9AAA6CBAAA9A6CBAA + A9AAA9CCA9A6CBA9A9CCA5AAC7AAC7AAA5CCAAA5AACBAAA9A6A9A6A9AAA5AAA5 + CCA9A6A9A6CBA9C8A9A6CBA9AAA9CCA6A9A9A6A9CCAACBA6A9CCA9C7AAA9A5A5 + A9CCA9FF9139A5A5A4C3A4A1C7A4A5C7A0A5A5A5A5A5A4A5C7A4A1C7A5CBA9AA + AAA9AAAAA9AAA5A5A5A9A6AAA9A9AAA9AAAAA9A6A9AAAAA5AAA5AAA9AAA9A6AA + A9AAC7AAA9AAAAA5AACBAAA5CCA9AAA5AAAAAAA6AAA9AACBAAA9AAA9AAA9AACC + A9A6A9CCA9CCA9CCA9AACBAAA9A6CBAAA9AAAAA9AAA9AAA6CBAAA9AACCA6CBAA + A5AAA9AAAAA5AAA5A9C8A9CCAAA5AA33B510A5A0A5A5A5A5A4A5A5A0A5A5A5C7 + A5A0A5A1A4A1A4A5A5A9AAC8A9A6CBA9A6CBA5A5CBAACCA9AACCA6A9CCA5AACB + AAC7A9CCA9CCA9CCA6A9CCA9C8A9AAA9CCA5CBAACBA6A9AAA9A6A9CCA9C7A9CB + A9C8A9AAA5AAA9C8A9C8A9A5AACBAAA5AAA5AAA9A6CBAAA5CCA9AAA9A6CBA5AA + CBA6CCA9AAA5AAC7A9A9AAA9AAA9C8A9C7AAA9C7AAA5A9AAA5CBAAFF9139A5A5 + A4A1A4A1A5A0A5A5A4C3A5A5A5A5A4A5A5A5A4A5A5C7AAA9CCA9AACCA9AAA9A5 + A5AAA5CCA5AACBAAA9AAA9A6A9AAAAA9AAAAA5AAA9AAA5AAA9CCA9A6A9AAAAAA + A9AAA9C7AACBA6A9AAAAAAAAAAA9AACBAACBAAA9AAA9AACCAAA5AACBAAA9AACB + A9AAA9AAA9A6A9CCAAAAAAA9AAA9A9A6A9CCA9AAAAAAC7AAC7AAA9AAAAA9A6A9 + A5A9A5CCA9A6A94C1214A0A5C7A5A5C6A5A5A0A5A5A4A5A9A5C3A5A4C3A5A1A5 + A5A5A9A6A9AAA9A6A9CCA6CBA5A9AAA9AAA9AAA5CCA9CCA9AAC7AAA9C8A9AACB + A6CBAAA9AAA5AACBAAC7A9A6CBA6AAA9AAAAA9CCA5A9CBA5CCAAA5AAA6A9A6CC + A9A6A9A9AACBAAA6A9C7AAA6AAC8A9C8A9CCA9A5A9CBA6CBA6AACCA9A6A9AAC7 + A9AAA9AAA9C8A9A5CCA9CBAACBA6A9A5AACBAAFF7A42A5A5A0A5A0A5A1A4C7A5 + A0A5A5C7A5A4A5A1A4A5A4C7A5A5CCA9CCA5CCA9AAA9AAA5A5C8A9CCA5CCA5CC + A9A6A9AACBAAA9C8A9AAC7AAA9AAA5CCA5CCA9A6A9AAAACBAAA9CCA6A9A9C8A9 + AACCAAAAA9A5CCA9A9AACBA9AACBAAC8A9A6A9CCAAAAA9CBA9A9AAA9AAA9A6CC + AAAAA9AAA9CBA5AACBAAA9AAAAC7AAA9AAA9AACCA9A6AAA9AAA9C7AAA5A5A932 + A506A5A0A5A4A5A5A4A5A1A4A5A5A4A5A5A1A5A4A5A4A1A5A5A5A9AAA5AAA9AA + A9CCA5A9A5A9AAA9AAA9AAA9AAA9CCA5AAA9AAA9AAA9AAA9AAA9CCA9AAA9AAAA + A9CCA9A6A9AAA9A9CCA6AAA9AAA9A9A5AAAAAAA9C8AAA9A6AAA5AAA9AAA9AAA9 + A9C7AAAAA6AAAAC7AAA6AAA9A9C7AAA9A6AAAAAAA9AAA5A6A9A9AAA5A6A5AAA5 + A9AAA5A6AAA5AAA5A5A5AAFF793FA5A5A5A1A4A1A5A4A5A1A4A1A5A5A5A4A5A5 + A1A5A4A5A5A5A5A9AACBAAA5A6A9AAC7A5A5A5A6AACBAAA5A6A5AAAAA5AAA5A6 + A9CCA5AAA5A6A9AAA9A6A5A5A6A9AAA9A6A5A6AAAAA981A6A5A6CCAAA5A5A5AA + AAA9A681A5AACCA9A6A5A5A6AAAAA581A5A5A9AAA581A5A6AAAAA5A681A5A5CB + A6A5A5A5AAAAA5A57DA5AAAAA6818181A5CBA581A181A53FEA33A0A5A4A5A17C + A1A1A4A5A57CA1A0A5A5A07D7CA1A5A4A57D7DA5AAA9AAA581A6A9AAA5A58181 + A5AAA5F78181A9CCAAA57D81A6A9AAA57D81A6A5AAA5F781A5A6A9A6817DA5A5 + A9A68181A5A9A9A681F7A5A5A9A681F7A5A5A9AA81F781A5CBA98281F7A5CCA9 + 828181A5A9AAA58181A5AAA9AA81F7A5A5CCA68181A5A5CBAAA582A5A5A6A9A5 + F7A5A5FF91397DA0A5A47D7C7DA0A5A4A17D7CA1A9A5A17C7DA0A5A1A1817DA5 + A5AAA58281A5AAA5A57D81A5A6A9AAA581A6A5AAA9A5F7A5A5AAA9A68181A5AA + AAA581A5A5AAA9A6A5F7A5A6AAA582A5A6AAAAA9A681A5AACCA9A5A5A5A6AAA5 + A5A5A5A6AAAAA5A5A5A5A5A9A5A5A5A5AAA9A6A5A5A6A5AAC7A6A5A5A6A9AAA5 + A6A5AAAAA9A6A5A5AAA9AAA5A5A5A533B510A0A1A5A1A0A1A0A5A1C7A0A1A0A1 + A5A5A5A0A1A0A5A4A5A57DA5AACBAAA5A5A6A9CCA5A5A5A5AACBA6A9A6A5CBAA + A9A6A5A5AAA5CCA5A6A5A6A9CBA6A5A6AAA5CCA9A5A5A9A9A9A9A5A5A5CBA5CB + A5A5A5A5A9A5AAA5AAA9A9CCAAA5AACBA5A5C7A5A5A5A5A5C7A5A5A5A5C7A9A9 + A6A9CBAAA9AAA9A6CBAAA5CCA9AACBA9A6CBAAA9A6CBA6CBA6A9A5FF9139A5A5 + A4C7A5A4A5A5A4A5A5A4A5A5A4A5C2A5A1A5A1A5A4C7A5A6A9A6CBAAAACBA6A9 + A9A5AAA5AAAACBAAA9AAAACBA6A9AAAACBAAA9AAA9AACBAAAAA9CCA9CBAAA9A5 + A5A5C7A5C7A5A5C7A5A5A5A5A5C7A5A5A5C7A5A9AACCA6A9A5AAA5A5A5A5A5A5 + A4C7A5A5A5A5A5C7A5A5A5A5CBAAAAA5AAC7AAA9AACBAAA9C8A9A6AAAAA9A6CB + AAA9AAA9A5CBA5435513A0C7A1A4A1A5C2A5A1A4A1A5A0A5C3A4A5A4A5A4A5C3 + A5A5A9C7AAA9AACBAAA9A5A5A5A5CBAACBA5AAC7AAA9A6A9AACBA5AAAAC7AAA9 + CCA5AAA9CCA5AAAAA9C8A9A5C7A5A5A5A5A5A5A4A5A5A5A5A5A5A5C7A5A5A9C8 + A9A9AACCA9C7A5A5A4C7A4A5A5A5A5A5A5C7A5A5A5A5C7A5A5C7A9CCA9AAA9CC + A5AAA5AAA9AACBA5A9C7A9A6A9A6CBA6A9A5A5FF7A42A5A5A4A5A5A4A5A5A4C7 + A5A4A5A5A4A5A1A5C7A5A4A5A4A1A5A5A9C7A5A5A5A5CBA6C7A5A5A5AAAAA9AA + A9CCA9CCA9AAAACBAAAAA9A6A9AACBA6A9AACBA6AAAAA9A5A5A5AAA5A6A5C7A5 + A5C7A5A5A9A5A5AAA5A9A6A9AAC8A9A5A5A5A4C7A5A5A5A5A5A5A5A5A5A5A5A5 + A5A5A5A5A5A5A9A5AACBA6A9AACBAACBA6CBAAAACCAAA9CBAACBAAA9C7A5A535 + 2D33A5A0A5A1C6A1A5A0A5A1A4A1A5A0A5A1A4A5A5A5A1A4A1A5C7A5A5A5A5A5 + C7AAA5A9A9A5C7A9AACBAAC7AAA5AAA9A6CCA9A6A9C7AACBAAC7AAA9CCA5AAA9 + A9CBA6AAA9AACBAACBA5A5A5A4A5A5A9C8A9CCA9A9CCA9CCA9A9A5A5A4A5A5A5 + A5A5A5A5A5C7A9C8A9AAA5AAC7A5A5A5A5A5A5C7A9A5AACBAAA9A6A9AAA9AAA5 + A9A5A9A6A9A5A9A5A5A5A5FF9139A5A5A4A5A5A4A5A5A4A5A5A4C7A5A4A5C7A4 + A5A5A4C7A5A4A5A5C7AAA9AAAAA9AACCAAA9A5A5A9A6A9AAA9CCAACBAAA9CCA9 + AAAAA9A6A9AAA9A6A9AACBA6AAAACBA9CCA5AAA5AAA9A5A5A5A5C7AAA9A6A9CC + A6AAA9A6A5A5C7A5A5C7A5A5A5A5A5CBAAA5AAA9A6A9CCA9A6A9AAA5C7A5A5A5 + A5CBAAAAA5AAA9CCA9A6A9CCAAAACCA9A5A5C7A5A5A4A533B510A4A1C7A0A5A1 + A4A1C7A0A5A1A4A1A5A0A5A1A4A1A5A0A5A5A5A5A5A5CCA5CBAAA5A9A6CCA5A5 + CBAAA9C8AAA9A5AAA9A6A9A6CBAAA9CCAAA5CCA9CCA5AAA9CBA6AAA5AAA9CCA9 + CCA5A5A5A5A5A5A9CCA9A6A9A9C8A9A9C7A5A4A5A5A5A5A5AAC7AAA5AACBA5AA + CBAAA5CCA9A6CBAAA5A5A5A5A5A5A5CBAAC8A9AAAACBAAA9C7A9A6A9C7A5A5A5 + A5A5A5FF9139A5A5A4A5A5A4C7A5A4A5A5A4A5A5C6A5A4A5A5C6A5A5A4C3A4A5 + A5AAA9AAAAA9CCAACBA9A5A5AAA5CCA9AACCAAA9CCA9CCA9AAA5CCA5AAAAA9A6 + A9AAA9C8AAA9CCAAAACBA6AAA5AAA5C7A5A5A9A6A9A6CBAAAAA9AAC7A5A5A5A5 + A5A5A5A5CCA9AACBAAA5AAA5AAA9AAA9AAA9AAA9AACBA5A5A5A5C7A5A9A9AAA5 + CBA6A9A6AAAACBA5A5A5A4A5C7A5A5435513A5A0A5A1A4A1A5A0A5A1A4A1A5A4 + A1A5A1A5A0A5A1A4A1A5A5C7A5AACBA6A9C8A9A9A6AAA5A5CBAAA9A6A9A9A5CC + A5AAA9A6CBAAA9AAA9C7AACBAACCA9AAA9AAA5A9C7AAA9A9AACBA5A5A4A5C7A9 + CCA9AAA5A9CCA5A5A5A5A5C7A5A5CBAAA9A6A9A6A9AAA9CCA9CCA5CCA5CCA9C8 + A9AAA5CBA5A5A5A5A9AAC8A9AAAACBAACBA9A5A5A5A5A5A5A5A5A5FF7A42A5A5 + A4A5C7A4A5A5A4A5A5C6A1A5A4A5A4C7A5A4A5A5A4A5A4A5C7A9AAA9AAA9AAAA + A9CBAAA5A5AAAACBA6CCAAA9AAA9CCA9AAA5AACBAAAAA9AAAAA5CCA5CCA9CCAA + AAA5AACCA9A5A5A5A5A5A9A6A9A6A9CCA6A9A5A4A5A5A5A5AAA9AAA5CCA9CCAA + A9CCA5AAA5AAA9AAA9A6A9AAC7AAA9AAA5A5A5A5C7A9A9CCAAA9A6A9A5A5A5C6 + A5A5C7A5A5A9A545CD35A4A1A5A0A5A1A4A1A5C2A5A5A4A1C7A0A5A0A5A1A4A1 + C7A1A5A5A5A5C7AACBA6A9C8AAA5CBA5A5C7A9AAA9A9A6CCA9A6A9C8A9CCA9A6 + A9CCA9C8A9AAA9AAA9A6A9CBAACCA9A6CCA9A5A5A5A5C7A9AACBAAA9CBA5A5A5 + C7A5A5A5A5CBA6A9A9A6A9CBA6A9AACBAAA5CCA9CCA9A6A9AACBA6CBAAA5C7A5 + A5A5AAA9A5CCA9A5A5C7A5A5A5A5A5A5A5CCAAFF285CA5A5C6A5A5A4A5C7A4A5 + A5A0A5A5A4A5A5A5A5C6A5A4A5A4A5A4A5A5AAA9AAA9CCA9AAAAAAA5A9A5AAC7 + AAAAA9AAAACBAAA9AAA9A6CBAAA5AAA9AACBAAA5CCA9AAAAA5AAA9AAA9AAC7A5 + A5A5A5AACBA6A9A6A5A5C7A4A5A5A5CCA9A6A9CCA6A9AAA6A9CCA5AAA9AAAAA5 + AAA9CCA9A5AAA9AAA5A9A5A5A5C7A9C8AAA9A5C7A5A4A5A5A5A5A9A5AAA5A94C + 1214A5A0A5A1A4A1A5A0A5A1A4A5A5A4A1A5A0A5A0A5A1A5A0A5A1A5A5C7A9AA + C7AAA9A6CBA9C7AAA5C7A9AAA9C7AAC7A9A6A9AAA5CCA9AAA9AAA9C8A9A6A9CC + AAA9A6CBAAA9CCA5CCA5A5A5C6A5C7A9A6A9AACBA5A5A5A5A5A5A9A6A9CCA9A6 + A9CBAACBAAA9AACBAAC7A9AACBA6A9A6CBAAA5CCA9CCA5A5A5A5A5A9A9C7A5A5 + A5A5A5A5A5CBA6CBAACBAAFF7A42A5A5A4A5A5C6A5A5A4A5A1A4C3A5A4A5A5C6 + A5A4A5A4A5A4A5C6A5A5AAA9AAA9CCA9AAAAAAA9A5A5A5CCAAAAA9AAAACCA9CC + AAA9AAC7AAC7AAA9AACBAAAAA5CCA9AAA9A6A9AAA9CCA5A5A5A5A5AAA9CCAAA5 + A5A4A5A5A5A5CCA9AAA5AACBAAAAA5AAA9A6A9A6A9AAA6A9AACBAAA9A6A9AAA9 + A6A9A6A5A5A5C7A5A5A5A4A5A5A5C7A9A6A9AAA5AAA5AA45CD35A4A1A5A0A5A1 + A4A1A5A4C7A5A4A5A1C6A1A5A1A5A1A5A1C7A0A5A5A5C7AAC7AAA5AACBA5AACC + A5A5A9A5CCA9CCA5A9A9A6A9AAC7AAAAA9AAA9C8A9AAA5CBAAA9C8A9CCA9CCA5 + AAA9A5A5A5A5A9C7AAA9A9C7A5C7A5A5C7A5A9CCA9CCA5AAA5CCA9A6CBAACBAA + A5A9CCA9A6A9A6CBAAC7AACBAAA9CBA9A5A5A5A5C7A5A5A5A5A5A5A5CBAAC7AA + A9CCA9FF6248A5A5C6A5A5A4A5C7A4A1A5A0A5A1A4A5A4A5A4A5C6A5A4A5A5A5 + A4A5A5A9AAA9CCA9A6AAA9AAA5A9A5AAA9AAA9AACCAAA9AACBAAA9CCA9A6A9AA + A9CCAAAAA5AAA9AAA5AAA9AACBAAC7A5A5A5A5A9AACCA6A5A5A5A5A5A5A5AAA5 + AAA9AAA9CCA9AACBAAA5AAA5CBA6A9A6CBAACBAAA5AAA9AAA5C7A6A5C7A5A5A5 + A4A5C7A5A5A9A6A9A6A9A6A9A6A9AA45CD35A5A0A5A1A4A1A5A4A1A5A4A5A5A4 + A5A5A1A4A1A5A1A4C3A5A1A4C3A5A5A9CCA5AAA9AACBAAC7A9C7A5CBAAA5CCAA + A5A9C8A9A6A9CCA5AACBAACCA5AAA5A9AACBA6CBAAA9CCA9A6A9A5A5A5C7A5CC + A5A9A9A5A5A4A5A5A9CCA9AAA9C8A9CCA5AAA5AAA5AACBA9AAA9CCA9AAA9A6A9 + AAA9C8A5A9AAA9A9A5A5A4A5A5A5A5A5CBA6CBAAA9CCA9CCA9CCA5FFB032A5A5 + A4A5A5C6A1A5A4A5A1A4A1C7A0A5A4A5C7A4A5A5A4A5A4A5A4A5C7A5AAAAA9C8 + AAA5A9AAAAA5A5A5CCA9AAA9CCAAA9AACBAAA9AAA9A6AAA9AACBAACCA5AAA9AA + A9AAA6A9CCA9A5A5A5A5A5A9AAAAC7A5A5A5A5C7A5AAA9C8A9AAA9AAA9CCA9CC + A9AAAAA6CBA6A9A6A9AACBAAC7AAA9AAC7AAC7A5A5A5C7A5A5A5A9A5A5A9AAA5 + AAA5AAA5AAA9AA45CD35A4A1A5A0A5A5A4A1A5A4A5C7A4A5A5A5C3A4A1A5A0A5 + A1A4A1A5A1A5A5A5CBAAA9A9CCAAAAC7AAA9A5A5A9A6CBA6A9AAC7AAAAA5CCA5 + CCA9CBA6A9AAA5AACBAAAACBA6CBA9AAA5AAC7A5A4A5A5A5CBAAA5A5A5C7A5A5 + AACBA6A9AAC7AAA5AAA5AAA6A9C7A9AAAAA9CCA9C8A9A6AAA9A6CBAAA9A5A5A5 + C7A5A5A5A5C7A5AAA5CBAACBA5AACBAAA5CCA9FF9139A5A5C6A5A5A0A5C7A4A1 + A5A0A5A0A5A0A5A5A5A4C7A5A4A5C7A4A5A4A5A5A9A6CCAAA9A9A5A9A5C7A5A5 + CCA9AAA9CCA9AAA9CCAAA9AAA9A6AAA9CCA9AAA9AAA5CCA6A9AAA6CBAAAAA5A5 + C7A5A5C7AAA9C7A5A4A5A5A5A9A6A9CBA5AAA9CCA9AAA9CBAAAAAAC7A9A6A9A6 + A9AACBA9A5A9A5A9C7A5A5A4A5A4A5A5A5A5A9C8A9A6A5A9AAC7AAA9AAA9A64C + 1214A5A0A5A1A4A5A5A4A1C7A4A5A5A5A4A5A5A5A0A5A1A4A1A5A0A5A1C7A5A5 + C7A9A9A5A5C7A5C7A9A5A5A5A9AAA5CCA5AACBAAA5A9CCA6A9CCA9C8A9A6CBA6 + CBAAA9A9AACCA9A9AACBA5A5A5A5A5A9AAA9A5A5A5A5A5CBA5CCA9A6A5AACBAA + A5CCA9A6AACBA5A5AACBAAA9CBA6A9AAC7AAC7A5A5A4A5A5A5A5A5A4C7A5A9AA + A9A5A9C8A9AAA9AAC7AACBFF7A42A5A5A4A5A1C6A1A5A4A5A1A5C2A5A1C6A1A4 + C7A4A5A5C6A5A5A4A5A0A5A5A5A5C7A5A9A5A5AAA5AAA9A5A5CCAAA9AAA9A6A9 + CCAAA9A9AAA5AAA9AAA9AAA9AACBAACCAAA5AAC8A9A6A9A5A5A5A5C7AAC7A5A5 + C7A5A5A5AAA5A9A5CBA5A5AAAAA5AACBA5AAA9C7A9A6A9A6AAAACBA6A9A5A5A5 + A5A5C7A5A5C7A5A5A5A5CCA9AAC8A9AAA9AAC7AAA9AAAA4C1214A4A1A5A4A5A5 + A4A1A5A4A5A5A5A4A5A5A4A1A5A5A0A5A1A4A1A5A4A5A4A5A5A5A5A5C7AAA5AA + CBA6A9CBA5A5A9CCA5CCA9AAA5AAC8A9CCAAA9C8A9CCA9A6A9A6A9A5CBAAA9AA + A9CCA5C7A4A5A5A9AAA9A5A5A5A5A9C7A9A5C7A5A5A9A5CBA5CBA5AACBA5A5A9 + A5CBA5CBA5A9AAA9C7A5A5A4A5A5A5A5A5A5A5A5A5A5A5C8A9A9A6CBA6A9AAA5 + CCA5A9FF793FA5A5C6A1A5A0A5C7A4A1A4A1A4A1A5A0A5A5A4A1A5A5A4A5A5C6 + A1A5A1C7A5A5A9AAA9AACBAAA9AACCA5A5A9A5AAAAA9A6CBAAA9AAAAA5AACCA9 + AAA5AACBAACBAAAAAAA9CCA5AAA9A5A5A5A5A5A5AAC7A5A5A4A5A5A5A5A5A5A5 + A5C7A5A5A5A5AAA5AAA5A9A5A5A9A5AAAACBA5A5A5A4C7A5A5A5A5A9AAA5A5C6 + A5A5A9A9AACCA9AAA9CCA5AAA9AACC269F04A5A0A5A5A4A5A5A4A1A5C7A4A5A5 + A4A5A5C6A1A5A5A4C3A5A0A5A5A5A4A5A5A5CBA6AAC8A9AAC7AAA9A6A9C7AACB + A5AACBAAA9CCA5A9CCA9A9A6A9CCA9A6AAA9A6A9C7AAA5AAA9C8A9A5A5A5C7A9 + CCA9A5A5A5C7A5A9C7A5A5A5A5A9A5A5A9A9C7A9A5CBA6C7A5A5A6CBA5A5A5A5 + A5A5A5A5C7A5AAC7AAC7A5A5A5A5A5CCA6A9AAC7AAA5AACBAAAAA5FF6248A5A5 + A1A4A1C6A1A5A5A4A1A5A0A5C3A4A1A5A4C7A0A5A4A5A5A0A5C2A5A0A5A5A5CB + A9A9AAA9AAA9CCA9A6A5A5AAAAA9AAA9A6A9CCAAA9A6AACBAAA9CCAAA9AACBAA + AAA9AACBAAA9A5A5A5A5A5A5AAA5A5A5A5A5A5A6A9A5A5C7A9A6A9C7A5A5A5A5 + A9A5A9AAA9C7A9A9A5A5A5C6A5A5A5A5A9A5A9AAA9A5A5A5A5A5A9AAA9C8A9AA + A9CCA9AAA5CBAA4C1214A5A4A5A5A5A5A4A1A5A5A4A5C7A4A5A5A4A1A5A4A5A5 + A1A4A5A5A4A5A5A5C6A5A5A5AACBA6CCA9A6A9AACBA9A5C7A9CCA5CCA9AAA5AA + CBAAA9A6A9A6A9A5CCA5AAA9C8A9AAA5AACCA5C7A5A5A5CBAAA9C7A5A5A5CBA5 + AACBA9A5A9C7A5A5A5C7A5A5C7A5A5CBAAA5A5A5C7A4A5A5A5A5C7A5AAC7AAC7 + AAA5A5A5A5A5C7A9AAA9AAC7AAA9A6CBAAA5A9FF574DA4A1C7A0A5A0A5C6A5A0 + A5A1A4A1A5A0A5A5A4A1A5A0A5A5C3A4A1A5A4A1A5A5A5A5A5AAA9AAA6CBAAA5 + AAA5A5A9A6A9AAA9A6CBAAA9A6A9CBAACBAACCAAA9AACBAAA9AAC7AAA9AAA5A5 + A5A4A5A5A9AAA5A5A4A5A5AAA9A5A5A5C7A5A5A4A5A5A4A1A5A5A5A5A5C7A5A5 + A5A5A5A5A5A5A5AAA5AAA9AAA9C7A5A5A5C7A9AAC7AAA9AAA9CCA9AAA5CCAA4C + 1214A5A5A4A5A5A5A5A1A4C7A5A4A5A5A4C7A5A0C7A5A4C7A5A5A4A5A5A4A1A5 + A4A5C7A5CCA9A6CBA9AAA9CCA9CCA5A5CBAAA5CCA9AAA5AACBAAA6AAA9A6A9A9 + C8A9AAA5AACBAAA9CCA5A9A5A5A5C7A9C8A5A5A5A5A5C7A9A5C7A5A5A4A5A5C7 + A5A4A5A5A4A1C6A5A4A5A4C7A5A5A5C7A9A5AAA9CCA9A6CBA5A5A5A5A5A5AAA5 + AAA9A6CBA6A9A6CCA9AAA9FF9139A4A1A5A0A5C2A5A4A5A0A5C3A4A1A5A0A5A5 + A4A1A5A0A5A0A5A0A5A5C6A5A1A4A5A9A5AAA9AAAAC7AAA9A6A9AAA5A5A9AAA9 + C8A9CCA9A6CBAACBAAA9CCAAA9AAA9CCA5AAA5AAA9CCA5C7A5A5A5A5A9A5A5C7 + A5A5A5C7A5A5A5C7A5A5A5A0A5A5A5C7A5A5A5A5C7A5A5A5A5A5A5AAA5AACBAA + A5AAA9AAA9A5A4A5A5A5CBAAA9CCA9AAA9CCAAA9AAC7AA45CD35A5A4A5A5A4A5 + A5A1A5A5A4A5A5A4A5A5A0A5A5A4A5A5A4A5A5A5C2A5A5A4A5A5A5A5A9C7AAC7 + AAA9A6CBAAA5CBA9A5C8A9AAA9AAA5AAA9AAA5AAC7AAA9C8A9C8A9AACBAACBA6 + A9AAA9A5A4A5A5A5A5CBA9A5A4A5A5A9A5A5A5A5A5A0A5A5A4A1A4A5A4A5A0A5 + A5A4A5A5A5C7A5A5CCA9A6CBAAC7AACBA5C7A5A5C7A5A6CBAAA5CCA5AAA9A5CC + A9AAA9FF9139A5A1C6A1A5A0A5C6A5A0A5A1A4C3A5A4C7A5A0A5A1A4C3A5A0A5 + A5A5A0A5C2A5A0A5C7A9AAA9AACBAAA9AAAAAAA5C7A9A6CBAACBAACBA6CBAAA9 + AAA9A6A9AAA9AAA5AAA9AAAACBA6A5A5A5C7A5C7A9A5A6A5A5A5A5A5C7A5A5A4 + A5A5C7A5A5A5A5A5A5A5A5A5A0A5A5A5A5AAA9AAA9A6A9AAA5AAA9A5A5A5A5A5 + A5A5A9AAA5AAA9AACBAAAAA9A6CBAA352D33A5A4A5A5A4A5A5A1A4A5A5A4A5A5 + A4A1A5A0A5C7A4A5A5A4C7A5A5A0A5A5A5A5C7A5A5A9A5AAC7AAAAC7AACBA5A9 + A5A5A9AAA5AAA5AAA9AAA9AAC7AACBAAA9CCAACBAAA5CCA5A9AACBA5A5A4A5A5 + A9A6A9C7A5A5C7A5A5A5A4A5A5A4A5A4A5A5A4A5C7A0A5A4A5A5A5A5CBAAC7AA + C7AACBA6A9AACBA5A5A5A4A5A5A5C7AACBAACBAAA5AAA5CCA9AAA5FF7A42A5A1 + A4A1A5C2A5A4A5A0C7A1A4A1A5A4A5A5A4A1A5A0A5A1A4A1A4A5C6A1A4A1A4A5 + A5A5CCA9AAAAA9AAA5AACCAAA5A5C7A9AAA9CCA9AAA9C8A9AAA9AACBA6AAA5AA + CBAAA9AACCAAA5A5A5A5A5A5AACBAAA5A5A5A4A5A5A5A5C3A5A5A5A5A1C7A5A5 + A5A5C7A5A5C7A5A5A5A9AAA9AAA5AAA9CCA5AAA5A5A5A5C7A5A9AAA9A6A9A6A9 + AACBAAA9AACBAA352D33A4A5A5A4A5A5A5A1A5A5A4A5A5C6A1A5A0C7A5A4A5C7 + A4A5A5C6A5A1A5A5A5A4A5A5C7A9A5AACBA5CCA9AAA9A5CBA5A5A9A5CCAAA5AA + C7AAA9CCA5AAA5AAA9CBAAA9A6A9CCA5A9A5CCA5A4A5A5CBA5AAA9CBA5A5A5C7 + A5A4A5A4A5A4C7A5A4A5A5A0A5A4A5A4A5A4A5A5A5CCA9C8A9AACBA6A9AACBA5 + C7A5A5A5A5C7AAAACBAAA9CCA5AAA9C8A9A6A9FF4056A5A1C6A1A4A1A4C7A4A1 + A5A1A4A5A5A4A5A5A0A5A1A4A1A5A4A1A5A4A5A0C7A5A0A5A0A5C7A5AAAAA9AA + C7A5A5A5A5A5A5C7A9A5AACBAAAAA5AAA9CCA9CCAAA6A9CCA9AAAAAACCAAA9A5 + A5C7A5A5A9CCA5A5A5A5A4A1A4A5A5A5A5A1A5A4A5A5A5A5A5A5A5A1A5A5A5A5 + A5A9A6A9AAA5AAA9CCA9A5A5A5A5A5A5A5A9A5A9A5AAC7AAAACBAAA9AACBAA45 + CD35A5A4A5A5A5A4A5A1A5A4A5A4A5A1A4A1A5A0A5A5A4A5A5A4A1A5A4A5A1A5 + A5A5A5A5A5A5A5A9A5A9C7A5A5A9A5A9C7A9A5A5A9CCAAA9A6CBAACBA6AAA9A6 + A9CBAAA5AAA6CBA5A9A9C8A5A5A4A5A5A5A5A5AAA5A5A5A5A5A1C7A4A5A4A5A5 + A5A4A1C6A5A5A4A5A4A5A4C7A9CCA9AACBAACBAAAAA5A5A5A4A5A5CBA6A9CCA6 + CCA9AAA9A9A6A9C8A9AAA5FF6248A5A1A5A0A5C3A4A5A4C3A5A1A4A5A5A5C6A5 + A4A5C3A4A1C7A5A4A1A4C7A4A5A5A4A1A4C7A5A5C7A5A5A5A5A5CCA5AAAAA5C7 + A5A5A9CCA9AAA5AAA9A9AACBAAA6A9AACBA9AAAAC8AAA9A5A5A5A5C7AAC7A9A5 + C7A5C7A4A5A4A5A1A5A5A5A4C7A5A5A5A4C3A5A5C7A1A5A5A5AAAAA5AAA5AAC7 + A9C7A5A5C7A5A5A5A9A6A9A9A9A6A9C8AACBAAA9AACBAA33B510A5A4A5A5A4A5 + A1A5A5A4A5A5A1A4C3A4A1A5A1A4A5A5A4A1A5A5C7A1A4A1A4A1A5C6A1A4A5A5 + A5A5A5A9CBA6A9AAA9CCA9A9A5AAA5AAC7AAA9CCA6CCA5AAA9CCA9A5A5A5CBA9 + A9AAA9C7A5A4A5A5A5A9A5A9A5A5A5A5A5A5A4A5C6A5A5A5A0A5A5A5A5A4A1A4 + A5A4A5A5A5A5CCA9CCA9AAAAA9A5A5A5A5A5A5CBA6CBA6AAA9CCA9A9AAA6CBAA + A5AAA9FF6248A4A1C7A0A5A5A4A5A0A5A0C7A4A5A5A5A5A4C7A5A1A4A5A4A5A0 + A5A4A5A5A5C6A5A5A5A5A5C7A5A9CBA6AAA9CCA5CCA5AAC7A5C7A9AAA9AAC8A9 + A9A9AACBA6A9A6CBA5A5A5A5CCA6C7A5A5A1A5A5A5A5C7A5A5A5A4A1C6A5A5A5 + A5A5A0A5A5A5A4A5A4A5A5A5A5A5A5C7A9CCA9A6A9A6CBA5A5A5A5A5A5A5A9AA + A9A9A9CBA6A9AAC8A9A9AAA5AACBA645CD35A5A5A4A5A5A0A5A0A5A5A5A4A5C7 + A0A5A0A5A0A5A4A5C3A5A0A5A5A5A0A5A0A5A1A4A5A0A1A5A5A5A5AACBA6A9AA + A9AAA9AAA5A5A5A9C8A9A9AAAACCAAAAA9CCA9A6A5A5C7A5A9A9A9A5A5A4C7A5 + CBA9AAAECBA5A5A5A5A1A5A4A5A5A9C7A5A4A5C7A1A5A5A5A5A5A5A5AAA5AAA9 + CCAEAEAECBA5A5A5C7A9A6CBAAAACCAAA9CCA6A9A9CCAAAED0AAA9FF9139A5A4 + A1A4C7A9CBA9C7A4A1A5A0A5A9A9CBA9A9A5A1A4A5A4A5A9CFADCBA9A5A5A4A5 + A5C7A9ADD3AECFAAA9A9C8A9CCAEF6D3AEA9C7AAA9AACCAEF6B2D0D3AEAAAAA9 + CCA9AEB1CFADCFA9A5A5A5A5AAD3B2D0ADCFA5A4A5A4A5CBD2ADCFADA9A1A5A4 + A9CFADCFCFADCBA5A9AACBAA08F6D0CFADCFA5A5A6A9D008F6D008D0AAA9A9CC + AAAEF6F608D3AE352D33A1A5A5A9B1CFA9CFADA9C6A5A5A9D2ADA9CBADCFA9A1 + A5A1ADD2ADCBA4CFB1C7A1A5A5ADD2CBA9CFAED0AAAAA9AAB3F6AEAAD0B2ADC7 + AAA9AEB3D0AAAAAEF6D0AAA9AAF6F6CCA5C7A9CFA9A0A5A5D3AECBA5A5CFA9C3 + A5A5A9B2CFA5A5CBD2A9A1A5ADD3ADA9CBAEF6AECCA6A9D0D3ADA5A5CBB1D0A9 + A9CCAFFFAEAAC7AEF6AAAAA9F6B3D0A9C7AEF6FF9139A4A5A0CFADC7A0A1CBB1 + A5A5A0CFB1C7A4C3A4CFADC7A4A5CFADA5A0A1C7B1ADA0A4A9D2A9A4A1A5CFB2 + D0A5A9F6B3D0AAC7A9CBD3A9A5AAF6F6AAA9C7AAAED0AAC7AAB3AEA9A5A5C7B1 + CBA5A5A5B2D0A5A1C7ADCFA5A4A1A9D2A9A5C3A5ADCBA4A1CBADCBA5A5C708F6 + A9A9A5ADB2CBA5A5CBB2D0A9A6A9F6B3AACBAAAEF6D0A9A6D0AFB2AEAAD00835 + 2D33A5A1A5CFADA5A1C7A9D2CBA0A5A5D2ADC7A5A5CFB1A4A1A5CBB1CBA9C7A9 + CFCFA5A1C7A9CFA9A5CBAED3AACCA6A9F6AFD0AEAED3ADA5C7AAD0AFF6D0AED0 + F6AEA5AAA9F6F6F6AECFAECFA5C7A4C7CFB2ADCBADCFA9A1A5A5C7CBB1CFA9CF + CBA4A1A5A5ADD3ADD0B2D3AEA5C7A5C7CFB1CBCBB2D0A9A6CBAACBAED3AAD0F6 + AEA9A6CBAACBCCF6F6B3F6FF9139A5C6A5A4CBADCFADCFA5A5A5A4C6A5CFA9CF + CFA9C7A5A4A5A0CBADCFADCFADA5C6A5A4A5CBCBCFADD0A9A5A9CBA6A9D0AED3 + CFA9C7A5A5C7A9CCAEAED0AEAACCA9AACBAAAAD0AEAECFA9A5A5A5A5A5CBCBAD + CBA5C7A4A5A4A5A5C7ADCFA9A5A5A5A4A5C6A5CFAACBA9C7A4A5A5A5A5CBADAD + CCA9CCA9AAA5AAA5D0AEAECCA9CCA9AAA5AAA9AAAACCAA435513A4A5A1A5A0C7 + A9C6A5C7A0A5A1A5A1A1A4A5A5A4A5A1C7A0A5A1A0A5C6A5C7A0A5A1A5A0A5A1 + A5C6A5C7A5AAA9AACCA9A5A5A5A5A5A5A5A5A9A5CCA9AAC7A9A6CBA6A9CCA9A5 + CCA9A5C7A5A5A5A5A5A1A5A0A5A4A5A5A5A5A5A5A5A5A5C7A5A5A5C7A5A5A5A1 + A4A5A5A5A5A5C7A5A5A5C7A5A6A9A6CBAAAACBAAA5CCA9AAA6A9CCA9AAA5CCA5 + CBA6A9FF9139A5A1A4C7A5A5A0A5A5A4A5A4A5A4A5A4A1C7A4A5C2A5A4A5A5A4 + C7A4A1A5A4A5A4A5C6A5A4A5A4A1A5A5A5A9C8A9A5A5C7A5A5A5A9A5A9A5A5CB + A5AACBAAAAA9AAA9AAA5AACCA9A6CCA5A9A5C7A5A4A5A4C7A5A5A5A5A5C7A5A5 + A5CCAAA5A5A5A5A5A5A5A5A5C7A5A5A5A5A5A5A5A5A5AAA9AACBAAAAA9CCAAA5 + CCA9A6CBA9AAA5AACBAAA9AAAAA9CC4C1214A5A4A5A1A5A0A5A1A4A1A5C3A5A1 + A4A1A5A4A5A1A5A5A5A0A5A1A5A1A5A0A5A1A5A1A5A1A5A5A1A5A4A5A5C7A9A5 + A5A5A5A5CBA6A9CCA5C7A5A9AAAAA5AAA5CCA9C8AACBAAA5A9AAA9A5A5A5A5A5 + A5A5A5A5A5A5C7A5A5A5A9A5A9A5A5A9A5CBA6A5A5A5A5A5A5A5A5A5A5A5A5A5 + A9CCA9C8A9A6A9A9C8A9CCA9AAA6A9AAA6AACCAAA5AACBA6CBAAA5FF9139A5C3 + A4A5A4A5A4C7A5A4A5A4A5A4A5C7A4A1A4A5A4A1A4A5C6A5A4A5A4C7A5A4C7A4 + A5A4A5C6A5A4C7A1A4A5A5A5C7A5A5A5A9CCA5AAAAA5A5A5A5CBAACBAAA9AAAA + A9A6A9AACCA5CCA9C7A5A5A4C7A5A5A5A5A5A6A9AAA5C7A5C7A5A9C7A5A5A9AA + A5CBA5A9A5A5A9C7AAA9CCAAA9A6A9AACCA9CCAAA9AAA5CCA9A9CCA9CBA9A5A9 + CCA5AAA9A6A9AA33B510A4A5A1A4A1C7A1A4A1A5A0A5A1C7A0A5A5A5A1A4A5C7 + A1A5A1A4A1A5A1A4A1A5A0A5A5A1A4A1A5A1A4A5A5A5A5A5A5A5CCA9A6A9AACB + A5AAA5C7A5A9A6AACBA6CBA5AACBAAA5AAA9AAA5A5A4A5A5A5A5A5C7A5A9C7A5 + A9A5A9A5A5A5A5A5A9A5A5CBAAA5AAC7AAA9A6A9A6A9A5AACCA9AAA5A9AAA5CC + A9AAA9A6CCA5AAA6AAAACCAAA9AACBAAA9CCA9FF285CA5A5A4A5A5A4A5A5A5C6 + A5A4A5A4A5A4A1C6A5A5A0A5A4A5A4A5C6A5A4A5A4A5A5A4A1C6A5A5A4A5A5A1 + C6A5A5A5A5AAA9A6CBA5A5A5AAC7A9A5A5C7A9A9AAA9AAAAA9A6A9CCA9C8A9A5 + A5A5A5A5A5A5A5A9A5A5A5A9C7A5A5A5A5C7A5A5A5C7AAA9A5CCA9AAA9CCA9AA + CBAACCA9A5AACBAACCA9AAA9A6CBAAA9A9AAA9CBA9A5A9A5CBA5A5A9C7A5A533 + B510A5A0A5C3A4A1A5A1A4A1A5A1A5A1A5A1A4A5A5C2A5A5A5A0A5A1A5A1A5A1 + C7A1A4A1A5A5A5A0A5A1A5A4A5A5C7A5A9A9C7A5A9A5A5CBA5A9A5A5A5A5A5CC + A6A9CCA5CCA9CCA9A6A9A5C7A5A5CBA5A6CBA9A6C7A5A9A5A5A5C7A5A9A5A5A9 + A5AAA9C8A9AAA9A6CCA5AACCA5AAA5AAAACCA9AAA5AAA5CCA9AAA5A5C7A5C7A5 + A5C7A5A5A5A5A5A5A5A5A5FF6248A5A5A4A5A5A4A5C6A5A4A5A4A5A4A5C6A5A0 + A5A5A4A1A4A5C7A4A5A4A5A4A5A4C7A4A5A0A5C7A4A5C2A5A0A5A5A5C7A5AAAA + A5A5A5A5A5A5C7A5A5A5A5A9A9A6A9AAA9A6A9AAA9A5A5A5A5A5A6A9A9A6A9A9 + A5A5C7A5A5A9A5A5A5A9A5C7AAC7AAA9AACBAAA9A9AAA6A9AAA9AACBAAA9A6A9 + AACBAAA9A6CCA9A5A5A5A5A5A5A5A5C7A5A5A5C7A5A5A54F8A36A0C7A1A4A1A5 + A0A5A1A5A1A5C2A5A1A5A5A5A0A5A5A5C3A4A1A5A0A5A1A5A0A5A1A5A5A5A0A5 + A5A4A5A5A5A4A5A5A5A9C7A9AACBA5A5C7A5A5A5A5C7A5A5CCA9CCA5CCA9AAC7 + A9C7A5A5CCA9AAC8A9AAC7A6A9A9A6A9C7A5A9C8A9C7AAA5A9AAA9A5CCB3F6CC + AAA9CBA6A9CCA5AAC7AAA9CCA5AAA9CCA9A9C8A9A6A9AAA5AAA5A5A5A5A5A5A5 + A9CCA9FF7A42A5A5A4A5A5C6A5A5A4A5C6A5A5A4A5A4A1C6A5A5A0A5A4A5A4A5 + A5C6A5A4A5A4A5A4C3A4A5A5A0A5A1A4C3A4A1A4A5A5A9A6CBA5A5A5A5A5A5A9 + A5A9A5C7A9A6A9AAA9AAA5A5A5A5A5AAA9A6CBAAAAA5AAA9C7AAA5A9AAA9C8A9 + A9A6A9AACCA5CCA5AAF6AFAEC7AAAAA9CCA9AAA9AAA9C8A9AACBA6A9AAAAA9AA + CBA6CBAACBA5A5A5A5C7A5A9A6A9A632A506A5A0A5A1A4A1A5A0A5A0A5A1A4A1 + A5A1A4A5A5A0C7A5A5A1C7A0A5A1A5C3A5A1A5A1A4A5C7A0A5A5A4A5A5A5C7A5 + A5C7A5A9A5A5A5A5A5A5AAC7AAA5A5A5A5A9AAC7AAA5C7A9A5CCA9A5CCA9AAA5 + CBAACBA6A9AAA9C7AAA5A9A9A6A9CBA6A9AAA9AAAACBA9CCA9AAC7AAA9A6CBAA + C7AAA9AAA5AAAAA9C8A9AAC7AAA9AAA5AAA5A5A5A4A5A5AAAACBAAFF7A42A5A5 + A4C7A5A4A5A5C7A4A5A4A5A4A5C6A5A1A4A5A4A1A4A5A4A5A4A5A4A5A4C7A4A5 + A5A0A5A5A4C3A5A0A5A5A5A5A4A5C7A5C7A5A5A5AAC7A9AAA9CCA9A5A5C7A9AA + CCA9AAA5AAA5AAAAA9A6CBAAAAA5AAA9AAC7AAA5AACBAAAACBA6AAA9C8A9AAC7 + A9A6AAA9C8A9AAA9CCA9A6A9AAA9C8A9CCAAC7AAA9C8A9AAA9A6A9CCA9A5A5C7 + A5A5A5CBA9A6A9435513A4A1A5A0A5A5A0A5A1A5A1A5A1C7A1A5A4A5A1A5A5A4 + A1A5A1A5A1A4A1A5A1A4A1A4A5A5A0A5A5A4A5A5C6A5A5A0A5A1A5A5A5A5A5C7 + A9AAA6CBA6A9AACBA5A5AAA5A9AACBAAA9CCA9C8A9AAAAA5CCA9AAC8A9AAA9CC + A5AACBA6A9AACBAAA9CCA5AAA9CBA6AAA9A6CBA6A9AACBAAA5AAA9AAA5A9AAA9 + AAA9AAC7AACBA6A9AACBA5A5A5A5A5A6A9CCAAFFB032A5A4A5A4A5C2A5A4A5A4 + C7A4A5A4A5A4A1C6A5A4A1A5C6A5A4A5C6A5A4A5A4A5A5C7A0A5A5A5A0A5A1A4 + A1A5A4C7A4A5A4A5A5A5C7AAAAA9CCA9AACBA6AAA5A9CCAAAAA5AAA5CCA9AAA9 + AAC7A9AAA9A6A9AAA9C8AAA9AAA9A6A9CCA5AAA5AAA9AACBA6AAA9CCA9AAA9AA + CCA5AAA9CCA9A6CBAAAACBA6CBAAA9AAA9AAA9AAC7A5A5A5A5A5C7A9A6A9A545 + CD35A5A1A5A5A1A5A5A5A0A5A1A5A0A5A1A5A5A5A4C3A5A4A5A1A5A0A5A1C7A1 + A5A0A5A0A5C7A5A0C7A5A4A5A5A4A5A1A5C2A5A5C7A9A9AAA9C8A9AAA5AAA9A9 + CBAAA9A5CBAACBAAA9A6A9A6CBAAAAC7AACBAAC7AAA9A9AAC7AACBAAA9AAA9CC + A9AAC7AAA9CBA6A9A6A9CCA5A9AAA9CCA5AACCA9AAC7AAA9AAA5AAC7AAA6CBAA + A5AAA5C7A5A5A5A5A9C7AAFF4056A4A5A0C7A4A5A0A5C7A4A5A4A5A4A5C2A5A0 + A5A4A5A1A4A5A4A5A4A5A4A5A4C7A5A5A4A1A4A5A4A1A5A0A5C3A4A5A4A5A4A5 + A5A5A5C7AAA9AAAACBA5C7A5A5AAC7A5A5A9AAA5AAA9CCA9AAA6A9AAA9A6A9AA + A5AAC7AAA9AAA5AAA5CCA5A9C8A9AAA9A6AAA9AACBAAA9AAAACCA5AAA9AAA9A6 + A9AAA5AAA9CCAAA9AAA9AACCA9A5A5A5A5A5A5CBA6A9A9435513A5C6A5A1A5A4 + A5A4A1A5A1A5A1A5A4A5A5A5A1A5A4A5A1A5A1C7A1A4A1A5A1A4A1A5A5A4A1A5 + A5A4C7A5A4A5A5A1A5A1A5A5A5A5A5A9A5CCA5A9AAA5A5A5A5AAA9A5A5A5CBA9 + CCA6A9AACBA9CCA5CCA9AACBAAA9AAA9C8A9AACBAAA9AAAAA9AAC7AACBAAC7AA + AAA5CCA5A9AAA9CCA6CBAAA9CCA9AACBA6A9C7AACBA6A9A5AACBA5A5A5A5A5A5 + A9C8AAFF9139A5A1A4A5A4C3A5A1A4A5C6A5A4C7A1A4A1C6A5A4A1A4A5C6A5A4 + A5A5A4C7A4A5A4C7A0A5C7A4A1A5A0A5A1A4A1C6A5A4A5C2A5C7A9A5A5A9AACC + A5A5A5A5CCA9C7A5A5C7A5AAA5A9CCA5AAAAA9AAA9A6A9A6A9C8AAA9AAAAA5AA + A5CCA9C8A9AAA9AAA5AAAAA9CBAAA9AACCA5AAA9AAAAA9C8A9A6CBAAA9AAAAA9 + AAA9CCAAA9A5A5A5A4C7A5A5AAA9A945CD35A5A4A5A1A5A5A5A4A5A5A5A0A5A1 + A4A5A5A5A4A1C7A5A5A1A4A1A5A0A5A1A5A1A5A0A5A5A4A1A5A4A5A5A4A5A5A5 + A4A1A5A5A4A5A5C7A5CBAAA5AACBA9A6A9A5A5A5A5A5A5A9AACCAAA9CCA5AAC7 + AACBAACCA9AAA9CCA5CBAACBAAA9A6A9AACBA6CCA9AAC7A9A6AACBA6A9AACBAA + A9A5CCA9AAA9AAAAA5CCA9A6CCA5AAA9C8A9A5C7A5A5A5CBA5CCA6FF793FA5A1 + A4C7A4A1A4A1C6A1A4A5A5A4A5A0A5A0A5A4A5A0A5A4A5A5A4C7A5A4A5A4A5A5 + A4A1A5A4A5C3A5A0C7A0A5A0A5A4A5A0A5A0A5A5A5A5A9CCA9AAA6A9C7A5A5A5 + AAA5A5C7A9A5A9A6A9AAA9AAA9AAA6A9CCA9A6A9AAAAAAA9A6A9AACBA6A9AAA9 + A6A9AAAACCA9AAA9CCA5AAA5CCAAA5AAA9CCA6CBAAA9CCA9AAA9CCA9AAA5A5A5 + A5A5A5A6A9A9AA26AF0EA5A4A1A5A5A4A5A5A5A5A1A4A1A5C7A5A5C7A1A5A4C7 + A5A1A4A1A5A0A5A5A0A5C2A5A5A4A1A5A4A5A4A5A5A5A5C7A1A5C7A5A5C7A4A5 + A5A5A5A9A6A9CBA5A5A5A5CCA5CCA5A5A5AACBAACCA5CCA9C8A9A9AAA5AACBAA + C7A9A5CCA9C8A9AACBAAA5CCA9CCA5A9A9CCA5AAA9AACBAAA9AACCA9A6A9A9AA + A5AAA5AACBA6A9A6CBAAA5A5A5A5C7A9A6CBA9FF9139A4A5A5A4A1C7A0A5A0A5 + C6A5A5A4A1A4A1A4A5A4A1A5A0A5A5C6A5A5A5C2A5A5A5A5A0C7A5A4A1A5A1A5 + A0A5A0A5A4A5A0A5A0A5A1A5C7A5A5C7A9C7A5A5A5C7AAA9AAA9A9A5CBA5AAA5 + AAA9AAAAA9AACCA5CCA9A6A9AAAAAAA9AAA9AAA5AAA9CCA9A6A9AACCA6A9AACB + A6A9AAA9C8A9A5AACBAAA6CBAACBAAA9AAA9CCA9AAA5CBA5A5A5A5A5A9AAA633 + B510A5A1A4A1A5A4A5A5A5A4A5A1C6A1A4A5A5A5A4A1A5A4A5A5A4A5A1A5A0A5 + A5A4A1A4A5A5A4C3A5A4A5A4A5A4A5A5A1A4A5A5A5A4A5A4A1A1A5A5A5A5A5A5 + A9AAA9CCA5AACCA6A5A5A9CBAAC7AAA5CBA6A9AAA9AACCA9A6CBA9C8A9A6CBAA + CBA6A9AAA9AAC7AAA9CCA6A9AAA9C8A9AAA9CCAAA5AACBAAA9AAA5CCA5CCA9A6 + CBAAA5A5A5A5A5CBA6CCA9FF7A42A4A5A5C6A5A1A4A1C6A1A5A4A5A5A5A0A5A0 + A5A4A5A5A0C7A1A4A5A4A5A4A1A5A4A1A4A1A5A4A5A1CBAACCA5A0A5A4A1A4A1 + A4A1A5A09C98A0A5A5A5A9A5CCA9A6A9AAA5A9A9A5A5A5A5AAAAA9AAAACCA9AA + CCAAA9AAA9AAAAA9AAA9AAA5AAA9C8A9C8A9AAA9A6A9AAA9C8AAA9A6CBAAA6A9 + CCA9AAA9A6CBAAA9AAA9AAA9A6A9A5A5C7A5A5A5A9A9AA32A506A1C6A1A5A4A5 + A5A5A5A4A1A5A0A5A9FFFFF6CCA1C6A5A5A4A5A1A4A1C7A5A4AAFFFFFFA9A0A5 + A9F6FFFFFFF6F6C7A5FFFFF6CCA4CCFFFFFFA5C7A5A5C7AAA5F6FFFFFFCCAACC + FFFFFFAEC7A9C8A9A9AAF6FFFFFFFFCCAAA5CCA5CCAACBAAA9AAA9AAA9AAC7AA + CBAAC7AAA9AACBAAAACBA9AAA5AAC7AAA9AAA5CCA9A6CBAACBAAC7A5A5A5C7A5 + AAC7AAFF6248A5A5A4A5A1A4C3A4A1A5C7A4A5A5C7FFFFFFCCA4A5A0A5A1A5C6 + A5A5A4A1A5CCF6FFFFC7A5A5FFFFFFFFFFFFFFFFA5FFFFFFA0A4AAFFFFFFCBA5 + A5A9A5A9A5F6FFFFFFA5A9AAFFFFFFCCA5A9A9AACCFFFFFFFFF6F6AACBAAA9AA + A9A6AAA9C8A9AACBA6A9AAA9A6A9AAA9C8A9A6A9A6AAAACBAAA9AAAAC7AACCA9 + AAA9AAAAA5A9A5A5A5A5A5A5A9AAA945CD35A5A0A5A1A4A5A5A5A4A5A4A1A5A0 + A9FFFFFFAAA4A1A5A5A5A4A5A1A4A1A5A4CCF6FFFFA9A0FFFFFFFFD0A5CBD1FF + F6FFFFFFA5A1CCF6FFFFA5A5A5A5A5C7A9F6F6FFFFA9AACCF6FFFFAEA5A5A5C7 + FFFFFFFFFFF6F6CCAAA9CCA5AAA9CBA6A9AAC7AAA9CCA5CCA9AAC7AAA9AAA9CC + A9CBA9A6A9CCA5A9AAA9A9A6A9C8AAC7A9A6C7A5A5A4A5A5CBA6A9FF285CA5A5 + A4A5C7A0A5A0A5A1A5A4A5A5C7FFFFFFCCA5A5A4A1C6A1A4A5A5A4A5A0CCFFFF + FFA5CBFFFFFFD0A4A1A4A0F6FFFFFFFFA0A4CCFFFFFFCBA0A5C7A5A5A5F6FFFF + F6A6CBAAFFFFFFD0A5C7A5A9F6FFFFFFCBA9A6AAA9A6A9AACBA6AAA9CCA9AAA9 + A6A9AAA9AAA9AAA9AAC7AAA9AAA6AACBA6A9CCAACBA6AACBAAA9A9AAA9A9A5A5 + A5C7A5A5A9CCAA435513A4A5C3A4A5A5A5A5A4A5A5C3A4A1A9FFFFF6CCA0A5C7 + A4A5A5A1A4A1C7A5A4AAFFFFFFC7AAFFFFFFCBA0A5A1A4A5FFFFFFFFA1A4AAFF + FFF6AAA5A4A5A5A5A5F6FFFFFFA9AACCFFFFFFD0A9A5A5AAFFFFFFD0A6AACBA5 + CCA9CCA5AAA9CCA5AAA6CBAACBAAA5CCA5CCA5CCA9AAA9C8A9A9AAA9AAAAA5AA + AACBAAA5AACCA5AAC7AAA5A5A5A5A5A5A6A9A9FF9139A5A1A4A5A1A4C3A4A1C6 + A1A4A5A5C7FFFFFFCCA4A5A0A5A1A4C7A5A4A5A0A5CCFFFFFFA5F6F6FFFFA0A5 + A5A4A5A0F6FFFFFFA0A4CCFFFFFFCCA5A5A0A5C7A5D0FFFFFFA9A5AAFFFFFFD0 + A6A9A5D0FFFFFFAAA9A9AAAAA9A6A9AACBA6A9AACBAAAAA5AAA9CCAAA9AAAAA9 + AAC7AAA9AAC8A9A6CBAACBAAA9A6A9CCA9A6AACBAAA5C7A5A5A5A5C7A9CCAA33 + B510A5A4A5A5A4A5A5A5A5A5A4A5A5A0A9FFFFFFAAA4A1A5A5A4A5A5A0A5A1A5 + A4CCF6FFFFA5D0FFFFFFA4A1A4C3A5A0F6FFFFFFA5A1CCF6FFFFA5A5A4A5A5A1 + A5F6F6FFFFA6AACCFFFFFFAEA9C7A5CCFFFFFFCCA9C8AAC7AAA9CCA5AAA9CCA9 + AAA5A9AACCA9A6A9AAA5CBA6CCA9AAC7AAA9AACBAAA5AAA5AACBAAA5AAA9CBAA + A5A9A5A5A5A5A5A5A9A6A9FF9139A5A1A4A1C7A0A5A0A5A0A5A0A5A5C7FFFFF6 + CCA5A4A5A0C7A0A5A5A5A4A5A0CCFFFFFFA5D0FFFFFFA0A5A5A5A4A1D0FFFFFF + A0A4AAFFFFFFCBA1A5C7A4A5A0F6FFFFFFA9CBAAFFFFFFD0A5A5A5D0FFFFFFAA + A9AAA9AAA9A6A9AACBAAA9A6CBAACCAAA5AACBAACBAAAAA9A5AAA9AAA9CCA5AA + A9AAA9CCA5AAA9AACBAAAAA5AACBA5A5C6A5A5A5AACBAA3C7311A4C7A5A4A5A5 + A4A5C7A5A5A5C2A5A9FFFFF6CCA0A5A5A5A5A5A0A5A0C7A5A4AAFFFFFFA5CCFF + FFFFAAA0A4A1A5A4F6FFFFFFA1A4CCFFFFFFA5C6A5A5A1A4A1D0FFFFFFA5A9CC + FFFFFFD0A5A5A5AAFFFFFFCBA5A5CCA9CCA9CCA5AAC7AAA9AAA5A9A9CCA9A6A9 + A6A9CCAAA9CCA5CCA6A9AACBA6CBAAA9AACBA6A9AAA5CCA9A6A9A5A5A5A5A5C7 + A5AAA9FF9139A5A1A4A1A4A1A5A0A5A0A5A4A5A5A5FFFFFFCCA5A4C3A4A1A4A5 + C7A5A4A1A5CCFFFFFFA5A5F6FFFFD0A5A5A5A4A1D0FFFFFFA0A4AAFFFFFFA9A1 + A4A1A5A5A4F6FFFFFFA5A5AAFFFFFFCCA5CBAAD0FFFFFFAAA5A5A9A6A9A6A9AA + AAA9AAC8A9CCAAA6A9AACBAAA9AAA5AAC8A9AAA9AACBAAA6A9AAA5CCA5AAA9CC + A5AAA9AACBAAA5A5A5A5C7A5A9C7AA33B510A5A4A5A5A5A5C6A5A5A5A4A1A5A0 + CBFFFFFFAAA4A1A5A5A4A5A5A1A4A1A5A4CCF6FFFFA9A4CCF6FFFFCCA0A4A1A4 + D1FFFFFFA5A1CCF6FFFFA5A5A5A4C7A4A1D0FFFFFFA5A5CBFFFFFFAEA5AAA5D0 + FFFFFFCCA9A5C7A9AACBAACBA9C8A9A9AAA6A9A9CCA5AAA9C8A9CCA9A9AAA5AA + CBA6A9A9AACBAAA9AACBA6A9AAA9CCA5A9A6CBA5A5A5A5A5A5AAA9FF6248A1A5 + A0C7A0A5A4A1A4A1A5C6A5A5A5FFFFFFCCA4A5A4A1A5C2A5A4A5A4A5A0CCFFFF + FFC7A1A5F6FFFFF6F6CCA5A0D0FFFFFFA0A4CCFFFFFFCBA4A1A5A0A5A0F6FFFF + F6A5A5CCFFFFFFCCA5A9AAD0FFFFFFAAA9A5A5A5A5AAA9A6AAA9AAA6CBA9CCAA + A9CCA9AAA9AAA9A6CCA9CCA9AAA9A6CCA9A6A9C8A9AAA9AACBA6A9AACCA9A5C7 + A5A5A5A5CBAAAA33B510A4A5A5A4A5A1A5A5C7A4A5A1A4A1A9FFFFF6AAA1A0A5 + A4A5A5A4A1A5C3A5A4AAFFFFFFA9A0A5A5D0F6FFFFFFFFFFFFFFFFFFA1A4AAFF + FFFFA5A5C6A5A5A5A5D0FFFFFFA5A5A9FFFFFFD0AACBA6AEFFFFF6CCC8A9A5C7 + A5A5CCA9AAC8A9AAAAA6A9A5AAA5AAC7AAC7AAA9AAA5AAC7AACCA9AAA9CCAAA9 + CCA5CCA5AAA9CCA5AAAAA9A5A5A5A5A5A5C7A9FF285CA5A1A4A1A4A5A4A1A4A1 + A5A4A5A5C7FFFFFFF6D0F6CCAAA5A0A5A5A4A5A4A5CCF6FFFFC7A5A4A0A1CCF6 + FFF6FFFFFFFFFFFFA0A4CCFFFFFFCBA0A5A5A0A5A0F6F6FFFFA0A5CCF6FFFFAE + C7AAA9D0FFFFFFAAA9AAA5A9A5C7A9A6A9A9AAC7A9A9AACCA9AACBAAA9AAA9CC + A5AAAAA9AAA9A6CBA6A9AAAAA5AAA9AACCA5AAA9CCA9CBA5A5C6A5A5A9AAAA32 + A506A5A4A5A5C7A4A1A5A5A5A4A1A5C2A9FFFFFFFFFFFFFFFFFFF6A5A4A1A5A1 + A0CCF6FFFFA9A5A0C7A5A4A0C7AACCD0FFFFFFFFA5A1CCF6FFFFA5A5A5A0A5A5 + A0F6F6FFFFA0A5AAFFFFFFD0AAA9A6D0FFFFFFCCAACBAAA5A9A5A5CBA9C8AAA9 + AAC8AAA9A6CBAAA6A9AAC7AAA9CCA9CCA5AACBAAA9CCA5CBAAA9CCAAA5AACBA6 + A9A5A6A5A5A5A5C7A9A6CBFF6248A5C7A1A4A1A5C6A5A4A1C7A4A5A5A5FFFFFF + FFFFFFFFFFFFFFFFCCA4A5A4A5CCFFFFFFC7A5A5A1A4C3A5A0C6A5A0D0FFFFFF + A0A4AAFFFFFFA9A0A5A5C6A5A0F6FFFFF6A1A4CBFFFFFFCCA5AAA9D0FFFFFFAA + A9A6A9CCA5A9A5A5A5A9A9C8A9A9CBAAA9AAAAA9CCA9AAA5AAA9A6A9AAA5AAA9 + A6A9AAA6A9AAA5A9CCA9AAA9AACCA9A5A5A5A5A5AAA9AA33B510A0A5A5A5A4A1 + A5A1A5A4A1A5A0A5A9FFFFFFAEC7A9CCD0FFFFFFFFCCA0A5A4AAFFFFFFA5A4A5 + A5A5A4A5A5A1A4A5D0FFFFF6A1A4CCFFFFF6CCA5A0A5A1A4A5D0FFFFFFA0A5AA + FFFFFFD0A5CBA6D0FFFFFFCCAACBAAA5CCA5A5A5A5C7A5AAAAA6AAC7AACBA5AA + A5CCAACBAACCA9CCA9CCA9CCA9CCA9CCA9CCAAA9AAA5CCA6A9A6A9C7A5A5A5C7 + A5CCA9FF793FA5A4A1A4A5A5A4A5A4A5A5A4A5A5C7FFFFFFCCA0A4A1A5C7FFFF + FFFFA5A5A0CCFFFFFFCBA1A4A5A0A5A5A0A5A5A0F6FFFFF6A0A5AAF6FFFFD0A0 + A5A5A4A5A0FFFFFFF6A1A5CCF6FFFFAEA5A5A9D0FFFFFFAAA9A6A9AAA9AACBA5 + A5A5A9CBA5CBA9AAA9A6AACBAAA9A6A9A6A9A6A9A6A9A6A9A6A9A6A9A6A9A6CC + A5CCA9A9CCA9A9A5A5A4A5A5A9A5AA435513A5A1A4A5A1A4A1A4A1A5A0A5A1A4 + A5FFFFFFAAA4A1A5A0A4A5FFFFFFF6A0A5AAF6FFFFA5A5A1A4A5A5A0A5A4A0A5 + FFFFFFD0A1A4CCF6FFFFFFA5A1A4A5A1A5FFFFFFD0A4A0A5FFFFFFCCA5A5A5AE + FFFFFFCCA9AACBAAA5A5A5A5A5A5A5A5A9AAAAA6A9AAA9AAA5AAA9AAA9AAA9AA + A9AAA9AAA9AAA9AAA9AAA9A9AAA9AAAAA6A9A6A5A5A5A5A5A5AAA9FF9139C6C7 + C7C6C7C7C7C7C6C7C7C7C6C7CBFFFFF6CCC7C7C6C7C7C6D0FFFFFFC7C6CCFFFF + FFCBA4C7C7C7A4A5C7A5C7D0FFFFFFCBC7C6CCFFFFFFFFD0A4A5C2A4F6FFFFF6 + CCA5C7CBFFFFFFCBA5C7C7CCFFFFFFAAC7A9A6CBCCCBA5C7A5C7A5C7A5C7A9CB + CCCBCCCBAACBCCCBCCCBCCCBCCCBCCCBCCCBCCCBCCCBCCA5C7A5C7CBA9CCCBC7 + C7C7C7A5CCCBCC352D33590359595859035959035903595981FFFFF686585959 + 03595981FFFFFFF758AAFFFFFF815958AEFFAA81818108FFFFFFFF59035986FF + FFF6F6FFF6AA86F6FFFFFFFF59785981FFFFF6AA8108AFF6FFFFFFF6AFF6F608 + 818181598181F7817D5D8181F78281F785F781F781F781F781F781F781F781F7 + 81F7818181815981818181597D0359818181F7FF574DDAF5DBF40D0C0DDBF4DB + F5DBF5DA11FFFFFF5EF4DBF4DBF5DA0DFFFFFF620C3AFFFFFF110C0DB3F6FFFF + FFFFFFFFFFFF350CF5DA5EFFFF083AFFFFFFFFFFFFFFF65EF4DBDA11FFFFFF3A + 11FFFFFFFFFFFFFFFFFFFF08110D1186626286620811AF1111393A39073A393A + 3A393A393A393A393A393A3A393A393A1111DB0D1111110DDBDB0D11113A3545 + CD35DB0DDA0DDB0DDBF4DB0DDA0DDAF511FFFFFF5EDB0CDB0DDAF5DAFFFFFF08 + F45EF6FFFF110D0D07AFFFFFFFF6F6FFD111DB0DDBF409F6B3620C35B3FFFFF6 + FFF65EDB0C0DF511FFFFFF5E11FFFFFFFFFFFFFFFFF6F6AF111111095E5E0808 + F65EAF110D11353A3A3907073907393A07393A07393A073907393A0739361111 + 0D111111DB0D111135393AFF91390DDAF5DB0C0DDADBF4DB0D0CDBDA35FFFFFF + 5EDAF5DB0C0DDBF4FFFFF6D4DA5EFFFFFF35DBDA0D0C0D115E5E5E0DDAF5DAF5 + DA0DDAF50CF40DDAF5115E5E07DB0C0C0DDBDA35FFFFFF5E0CDBF407FFFFFF39 + 0D11110D111139086235F6AF8608863511113539073A3A393A393A07393A3907 + 3A393A393A07393A3907351111110D100D0C1A3E11073A45CD35DB0DDA0DDB0C + F5DBDB0CDB0DF5DB35FFFFF65EF4DB0CDB0CF5DAFFFFFF08F45EFFFFFF11F4DB + 0CDBF4DBF4DB0C0D0CDB0DDA0DDBF4DB0DDAF5DB0CDBF4DBF4DB0DDB0CF5DB35 + FFFFF65E0C0DDA5EFFFFFF5E11110D11113507866235F6083AD1083A35111111 + 3535393A073A393A07073A390707073A393A3A393A393A3635110D0DDB0D1516 + 353907FF91390C0D0DDAF5DBDA0D0CDBF4DBDA0D11FFFFFF5EDA0DDBF5DBDB35 + FFFFFF5EDA5EFFFFFF350CDBF5DA0DDB0C0D0CDB0D0CDBF5DAF5DB0CDB0D0CDB + 0D0CDB0CDBF4DBF4DBDB0C11FFFFFF5EDB0D0C5EFFFFFF1111351111353A08D1 + B386AF6239088639073911363535353907393A07393A393A393A393A07390739 + 073A3939351111110D0D1011353A393C73110DDBDA0DDB0C0DF4DB0DDB0C0D0D + 11FFFFFF5E0DDA0DDA0DF462FFFFFF35F45EF6FFFF35DB0D0CDB0DDAF5DBDB0D + 0CDB0DDA0DDB0CDBF5DA0DDBF4DB0CDB0DDB0CDB0D0C0D11FFFFFF62DAF4DB5E + F6FFFF350D1111113535393A39073A39073A393A3A390739111111353A3A0739 + 3A3907073A39073939073A073A0739073A3911110D11110D35393AFF4056DB0C + F5DB0C0DDBDB0CDB0C0DDB0C35FFFFFF5EDAF5DBF5DA11FFFFFFF6DBDA5EFFFF + FF35DB0CDB0D0C0DDB0C0D0CDBF5DA0D0DDAF5DB0C0DDB0CDBF5DBF4DBF4DB0D + 0CDB0C35FFFFF65E0DDBF4DB0708FF35DA11351111113535363907393A390707 + 393A3A3939110D113535353A073A393A393A073A073A393A39393A39073A3911 + 110D0D11353A0732A5060DDBDA0DDB0C0D0CDBF5DB0C0DDB35FFFFF63A0CDA0C + DB35FFFFFFF65EF5DA5EFFFFFF11F5DB0CDB0DDAF5DBDAF5DADBF5DA0D0DDA0D + DB0CF5DB0CDB0CDB0DDB0CDB0D0DDB35FFFFF65E0C0DDB0CDBF4110D0D0D3535 + 35111111353A393A073A393A0739073A07111111351135353A39073A07393A39 + 3A3907073A07393A3907073A11110D1111393AFF91390C0D0DDAF5DB0DDBF4DB + 0CDB0DDA35FFFFFFF65E5E5E08FFFFFFF6AF0DDAF562F6FFFF35DAF5DB0CDB0D + DA0D0DDB0D0CDB0DDA0D0DDAF5DBDA0D0DDB0D0C0D0CDBF4DB0CDB35FFFFFF5E + 0CDBF4DBF5DA0DDA0DDA11363A35111135353A3907393A07393A393A35111135 + 15111111353A3907393A0707393A393A39073A073A393A390711111135360743 + 5513DB0DDA0DDB0CDB0CDB0CDBF5DAF511FFFFFFFFFFFFFFFFFFFFF6AF0DDA0D + 0C5EFFFFFF35DB0DDAF5DB0C0D0DDA0D0CDBF5DA0D0DDA0DDB0C0D0DDAF5DA0D + DADB0DDB0CDBF511FFFFFF5EDA0DDB0CDB0CDBF5DA0D35393511351111353535 + 353A07393A073A393511353A0739351135353A353A353A393A073A39073A393A + 393A39073A3911353A3939FF6248F4DB0D0CDBF5DAF5DBF5DA0D0CDB35FFFFFF + FFF6F6F6FFF6F63AF4DAF5DB0C5EFFFFFF350CDB0DDAF5DB0CDBF5DA0DDA0DDB + 0CDBF5DAF5DB0CDB0DDAF5DB0DF4DB0C0D0DDA35FFFFFF5EDBF5DAF5DB0D0DDA + 0D0D110DDA0D1135113511111135393A390739351135353A39073A3911351135 + 3539073A0739073A39073A3907073A393A39073A39073A33B510DB0CDB0D0CDB + 0DDA0DDA0DDB0DDBF4DB11353A5E5E5E11DBF50C0D0DDA0DDA5EFFFFFF110DF4 + DB0DDA0DDB0CDB0DDBF5DAF5DB0CDB0DDA0DDBF4DB0DDA0DDADBF5DBDAF5DB0D + 3511350D0CDB0DDA0DDA0D0DDADBF5DAF5DB11351111351111353A073A353511 + 113639073A390707393A35111135353A393A39393A39073A393A3907073A3907 + 3A3907FFD7370DDB0CDB0D0CDBF5DB0D0CDBF4DB0CDBF4DB0C0DDAF50C0DDA0D + DB0C0DDBF5DB3535350DDADB0D0CDBF5DAF5DAF5DA0DDB0CDB0D0C0DDB0C0DDB + 0C0DDB0D0D0CDB0C0DDA0DDA0DF4DB0DDA0D0CDBF4DB0DDA0D0DDA0DDB0C3535 + DB0D11111111353539110D1111393A3A39073A393A07391111113535353A073A + 35073A3907393A393A39073A39073A435513DBF4DBF5DA0DDB0CDBF4DB0DDB0C + DB0D0CDBF5DAF5DBDA0DDBF5DAF5DB0CDB0C0DDAF5DA0D0DF4DB0DDA0DDB0DDA + 0DDB0CDBF5DA0DDB0C0DDB0C0DDBF4DB0CDB0C0DDBF5DA0D0CDB0C110D0DDB0D + DB0D0CDBF5DA0DDBF4DB0D110D0CDB3535111135110D11113A073907073A393A + 39393A35110D111135353535353A39073A3A073A39073A39073A39FFB0320DDB + 0CDBF5DA0D0DDA0DDAF5DAF5DAF5DB0DDA0DDA0D0D0CDB0CDB0C0DDBF4DB0D0C + DB0D0DDADB0CDBF5DA0D0CDBF5DAF5DB0C0DDBF4DB0DDAF5DA0DDBF4DB0D0DDA + 0DDA0D0DDB0D0D110DDAF5DA0D0CDB0DDA0DDA0DDB0CDBF4DB0C0D0D11111111 + 1111113507393A393A3907073A073535110D1111111135113535353A39073907 + 393A39073A390745CD350CDB0DDA0D0DDA0D0DDB0DDA0DDB0DDA0DDAF5DB0DDA + 0DDBF4DB0DDB0C0DDB0CDB0D0CDB0C0DDBF5DA0D0DDA0D0CDB0DDA0DDB0CDBDB + F4DB0DDB0D0CDB0DDA0DDBF5DA0DDA0D35DA0DDA0D0DDA0DDAF5DAF5DBF5DBF4 + DB0D0CDB0DDB0CDBF4DB0D11351111353A35353A393A393A393A351111113511 + 11111111113535353A393A3A07393A39073A39FF91390D0D0C0DDB0C0DDAF5DA + F5DB0C0DDAF5DA0DDA0DDAF5DB0C0DDA0D0CDB0C0DDBF4DBDBF5DB0C0DDA0DDA + 0D0DDB0DDA0D0DDAF5DBF40DDB0C0D0CDB0DDA0D0DDA0CDB0DDB0D0D110DDAF5 + DA0DDB0D0DDB0DDA0DDA0DDB0CDB0D0C0DDAF5DB0C0DDAF51111111135113539 + 073A07393A0739110D1111353536111111111135353A3907393A073A39073A43 + 5513DB0CDBDB0C0DDB0DDA0DDB0C0DDB0DDB0DF5DB0C0DDB0C0DDB0D0CDB0D0D + DB0CDB0D0C0DDA0DDA0D0DDB0DDA0DDAF50DDA0DDBF4DBDB0C0DDADB0DDAF50D + DAF5DBF50CDBF4DB0DDA0D0DDBF5DAF5DA0DDAF5DA0DDBF4DBF5DA0DDA0DDB0C + 0DDB0D0CDB351111111135353A07393A0739110D113535353A39351111110D11 + 353535353A073A39073A39FF9139F5DB0C0D0DDA0DDAF5DA0D0DDAF5DAF5DADB + F4DBDBF4DB0CDBF4DB0C0DDA0DDBF4DA0DDA0DDBF5DA113535DBF4DBDADBF5DB + 0CDB0D0C11625E07DA0DDADB0DDA0DDADB0C0D395E5E11DA0DDA0DDA0DDA0DDB + F4DB0CDB0CDBF5DBF5DA0D0DDA0D0CDB0D353A35351111113539363539350D11 + 11113511353535110D110D1111111111353A393A393A077B3871DA0DDB0CDBF5 + DAF5DB0DDA0DDB0CDB0C0DDA0D0CFFFFFFFF0DDB0DDB0CDBF4DB62FFFFFF3535 + 08FFFFFFFFF6B307F5DADB0C0DDA11AFFFFFFFFFF63AF486FFFF08F5DB39F6FF + FFFFFF081111FFFFFF120C62FFFFFF35DB0CDB0CDB0DDA0D0DDA0D0C113535DB + 0D113511351135353511110D1135111135113511110D11113511111135353535 + 07393AFF62480DDBF4DB0DDA0DDADB0C0D0DDA0D0DDB0D0DDB11FFFFFFFF39DA + 0D0CDBF5DB0C5EFFFFFF1108FFFFFFF6FFFFFFFF080DF4DBDB0DF6FFFFFFFFFF + FFFF6208FFFF5EDA35FFFFFFFFFFFFFFFF35FFFFF6F4DA5EFFFFFF11DB0D0CDB + F5DAF5DB0C0DDB0DDB0D0C0C0CDB113511351111110D0D1111111135110D1111 + 0D1111353A3935111111110D353535579916DB0CDB0DDAF5DB0D0CF5DBDAF50D + DA0D0CDB0C3AFFFFFFFF62F50DDB0CDB0C0D5EF6FFFF353AF6FF865E62AFFFFF + FF62DADBF45EFFFFFFFF625E09FFFFF6FFFF5E0CAFFFFFFF86113508FFF6FFFF + FFDBF55EF6FFFF350DF4DB0DDA0DDB0CDB0DDA0D0C0DDB0DDB0D35DB0D111111 + 110D1111353511111111110D1111353A39073A3935351111111111FF793F0D0D + DAF5DBDA0D0CDBDA0D0DDADBF5DA0DDAF586FFFFFFFF08DADBF4DB0CDB0C5EFF + FFFF110D3EF4DB0CF50C62F6FFFF0D0DDAF6FFFFFF110CDAF45EFFFFFFFF5E39 + FFFFFF86DBF4DBF408FFFFFFFFF4DA5EFFFFFF35DBDB0CDBF5DA0DDBF4DB0D0C + DB0DDA0D0CDB350DDA0D113511111111111135111111110D113539073A390739 + 3A393935110D1133B510DAF5DB0C0D0DDA0D0D0DDA0D0DDADBF5DB0DDAF6FFFF + F6FFF6F50CDB0D0DF5DA62FFFFFF110CF5DAF5DADBF40DFFFFFF5E0C0DFFFFF6 + AFF4F50DDAF408FFFFFF5D5EFFFFFF11F4DBF4DB11FFFFFFFFF5DA5EFFFFFF11 + F4DB0D0CDB0DF4DBDBF4DB0D0CDBF5DA0D0D0DDB0DDA0D113A35351135111135 + 3511110D11113A39393A393A073A073A111111FF79530DDB0CDB0DDAF5DA0DDA + F5DB0C0D0CDB0CDB0DFFFFF662FFFF35DBF4DBDADB0D5EF6FFFF35DA0D0DDA0D + 0DDADB08FFFF86DA11FFFFFF5EDADBDAF5DB5EFFFFFF3A08FFFFF6F4DB0CDB0D + F4AFFFFFF6F4DA5EFFFFFF35DB0DDA0D0DDADB0D0CDB0DDA0D0DDA0DDA0DDAF5 + DAF5DB35350D11111111351111110D0D113535073A0707393A393A393511114C + 1214DB0CDBF5DA0DDB0DDA0DDB0CDB0DDB0CDBF439FFFFAF07FFFF5E0CDB0C0D + 0D0C5EF6FFFF35DB0DDA0D0DDA0DF408FFFF080D5EF6FFFF390D0CF50DDA35FF + FFFF0708FFFFFFDB0C0DDBF4DA08FFFFFFDBF55EF6FFFF35DB0C0D0DDA0D0D0C + DB0D0C0DDB0CDB0D0DDA0DDB0DDA0D390DDA0D11351111110D110D1111353A3A + 393A393A39073907113535FF91390D0D0CDB0D0CDBF4DBF4DB0D0CDBF4DB0D0D + 62FFFF0811FFFF08DB0DDB0CDB0C5EFFFFFF35F4DB0D0DDAF5DA0DFFFFFF08F4 + 5EFFFFFF35DBDBDADB0D11FFFFF65E62FFFFFF0C0DDB0CDBF508FFFFFFF4DA5E + FFFFFF350DDB0CDBF5DA0DDB0C0DDBDAF5DB0C0DDAF5DBF4DB0D0C0DDBF5DA0D + 11111111110D11113511390739073A39073A3A3511353A4F8A36DA0DDB0CDB0D + 0CDB0DDB0CDB0D0DDB0CDB0CAFFFF65E11FFFFFFF4DAF5DB0DDA5EFFFFFF11DB + 0CDB0DDB0DDA5EFFFFF65EDA5EFFFFFF11F40D0DDA0D35FFFFFF5D5EFFFFFF35 + DAF5DB0CDB08FFFFFF0D0C62FFFFFF110C0DDB0CDB0DDA0DDB0CF5DB0CDB0DDB + 0DDA0DDB0CDB0DDB0CDB0DDA0D353511113511111135353A3A39073639073511 + 111139FF91390DDBF4DB0DDA0DDB0C0DDBF4DB0C0DDB0DDAFFFFFF3A0CFFFFFF + 110DDA0DDAF562FFFFFF350D0DDA0D0CDB5EF6FFFFFFDBF462FFFFFF35DBDB0C + 0DDB35FFFFFF5E0DF6FFFF080DDA0DDBF408FFFFF6F4DA5EFFFFFF350DDB0C0D + DBF4DB0D0CDB0DDA0D0DDA0D0CDB0D0CDB0D0CDBF5DA0D0DDA0D0DDA0DDB3511 + 11113535353A35393A35111111113533B510DB0CDB0DDAF5DB0C0DDB0CDB0DDB + 0CDBF411FFFFFF35F4AFFFFF5EDA0DDBF5DA5EF6FFFF35DBDA0D0CDB86FFFFFF + FF5E0C0D5EF6FFFF35DBF40DDB0C11FFFFFF5EDA5EF6F6FF620CDB0CDB08FFFF + FFDBF55EF6FFFF35DB0C0DDB0CDB0D0CDB0DDA0D0DDA0D0DDB0D0CDB0D0CDB0D + DA0D0DDA0D0DDBF5DA0D0D1111111111351135113511113535393AFF91390D0D + DA0D0DDA0D0DDA0D0DDA0D0CDB0DDA5EFFFFF6DB0C86FFFF62F5DB0CDB0C5EFF + FFFF350DF5DB11FFFFFFFFFF86DA0D0C62FFFFFF350DDBDAF5DB35FFFFFF5EF4 + DBAFFFFFF6AF07DBF408FFFFFFF4DA5EFFFFFF35DB0DDAF5DB0C0DDB0CDBF5DA + 0DDB0CDBF4DB0DDA0DDBF4DB0D0CDB0D0DDA0DDA0D0C11353535351111113511 + 350D1111363907435513DA0D0DDA0DDB0CDB0DDA0D0DDB0DF4DBF508FFFFAFF4 + DB5EFFFFD1DAF4DB0DDA5EFFFFFF11DADA07FFFFFFFFFF5E0DF4DB0C5EFFFFFF + 110C0DDB0CDB35FFFFF65EDBF4DB08FFFFFFFFFFFFFFFFFFFFF5DA5EFFFFFF11 + F4DB0DDA0DDB0C0DDB0CDB0DDAF5DB0CDB0CDBF5DA0DDB0CDB0DDA0DDAF5DB0D + DB0D11391115110D1111111111111111353A35FFD7370DDBF4DB0D0CDBF5DAF5 + DB0C0DDADB0DDAFFFFFF86DAF411FFFFFF11DB0CDBF562F6FFFF35F511FFFFFF + FFFF350D0CDB0CDB5EF6FFFF35DB0D0CDB0D35FFFFFF5EDA0D0C0D3AAEFFFFFF + FFFFFFFFF6F4DA5EFFFFFF350DDB0C0DDBF4DB0DDAF5DB0C0DDA0D0CDB0D0DDA + 0D0DDA0D0DDAF5DB0DDA0D0CDBF4DB0D35070DDAF50D11351111111135353545 + CD35DB0CDB0D0CDB0DDA0DDB0CDB0DDB0D0C11FFFFFF5E0D0DDBF6FFFF07DA0D + 0DDA5EF6FFFF35DAAFF6FFFFAF0CDB0CDB0DDBF45EF6FFFF35DB0CDB0D0C11FF + FFFF620C0DDA0D0CDB0D075E08FFFFFFFFDBF55EF6FFFF35DB0C0DDB0CDBDB0C + 0DDB0C0DDB0D0DDB0D0DDA0D0DDA0D0DDA0DDB0D0CDB0DDB0CDB0D0C11110DDB + 0DDA0C1111113511111111FF91390D0DDA0DDBF4DB0D0CDB0DF4DB0C0DDA07FF + FFFF11DA0D0CAFFFF662F5DADBF45EFFFFFF3511FFFFFFAFDA0D0C0DDA0D0CDB + 62FFFFFF11F5DB0C0DDB35FFFFFF07DBDB0D0DDAF5DBF4DBF408FFFFFFF4DA5E + FFFFFF35DB0DDAF5DB0C0D0DDA0D0DDA0D0CDB0C0DDA0D0CDB0DDA0DDB0C0D0C + DBF4DB0C0DDB0CDB0DDA0D0CDB0D11363535111111111133B510DA0D0DDA0DDB + 0CDB0D0CDBDB0CDB0DDB86FFFFFFF40DDA0D08FFFFAF0CF5DBDA62FFFFFF115E + FFFFFF11F4DBDB0D0DDA0D0C5EFFFFFF35DB0CDB0CDB35FFFFF65EF40DDA0D0D + DA0DDBF4DB08FFFFF6DB0C5EFFFFFF11F4DB0DDA0DDB0CDBF5DA0DDB0CDB0DDB + 0C0DDB0DDAF5DB0C0DDB0CDB0DDB0DDB0C0DDBF4DB0DDB0D0CDB0D1135350DDA + 0D1111FF91390DDBF4DB0D0CDBF5DA0D0D0CDBF5DAF4B3FFFFAF0CDBF5DA5EFF + FFFFDBDA0D0D5EF6FFFF1162F6FFF6F4DB0C0DDA0D0DDBDA5EFFFFFF350C0DDB + 0D0D11FFFFFF5EDB0C0DDB0C0DDB0CDBF4B3FFFFAFF4DA5EFFFFFF350DDB0C0D + DBF4DB0DDADB0D0CDBF5DAF5DB0CDB0C0DDB0CDB0D0CDBF4DB0C0DDA0DDB0CDB + 0DDAF5DADB0D0CDA0D110DDAF5DB3533B510DB0CDB0D0CDB0DDA0DDB0CDB0DDA + 0DDBFFFFFF86DA0DDA0D11FFFFFF350DF4DA5EF6FFFF1107FFFFFFDBDAF5DB0D + 0CDB0CF55EF6FFFF35DBDBF40DDA35FFFFFF620C0DDB0CDB0DDAF5DA0DFFFFFF + 08DAF562FFFFFF35DB0C0DDB0CDB0DDA0D0D0CDB0DDA0DDB0CDBF50DDB0C0DDB + F4DB0DDB0D0DDA0D0DDAF5DB0C0DDA0D0D0CDB0DDB0CDB0DDB0C35FF91390D0D + DA0DDB0C0DDB0C0DDB0DDA0D0C35FFFFF63AF4DB0D0CDAFFFFFF5EDADB0D62FF + FFFF35DBFFFFFF5E0CDB0CDBDA0DDBDA5EFFFFFF110D0CDBDA0D11FFFFF65EDA + DA35DBF4DB0DDB0D08FFFFFF070DDA07FFFFFF35DB0DDAF5DB0CDBF5DA0DDBF4 + DB0D0CDB0D0DDADB0C0DDA0DDB0CDB0C0DDA0D0DDA0DDA0D0DDB0D0DDADB0C0D + DAF5DB0C0DDB1132A506DA0D0DDA0DDB0C0DDB0CF5DBF5DBDB62FFFFFF0DDBF4 + DB0DF5F6FFFF08F5DA0C5EFFFFFF11F486FFFFFF8611355EF65E0D0C62FFFFFF + 35DA0D0DDB0D35FFFFF65EF5DB86FF6239353908FFFFFFF6DBF4DB62FFFFFF11 + F4DB0DDA0D0D0CDB0DDA0DDB0CDB0D0CDB0D0DDA0DDB0D0CDBF5DA0DDB0DDAF5 + DB0DDB0CDB0CDB0C0D0DDB0D0DDA0DDB0C0DDBFF7A420DDBF4DB0D0CDB0D0CDB + DA0DDA0DF408FFFFFFDA0DDB0CDBDA86FFFFFF0C0DDB5EF6FFFF35DB0D08FFFF + FFFFFFFFFFAF0CDB5EF6FFFF350DDB0C0DDA35FFFFFF5EDAF4FFFFFFFFFFFFFF + FFFFFF350DDB0C5EFFFFFF35DB0D0CDB0DDADB0D0C0D0CDBF4DB0CDB0CDB0C0D + DBF4DB0D0CDB0DDAF5DA0DDB0C0D0CDBF4DB0DDB0CDBF4DB0C0DDBF4DB0C0D45 + CD35DB0CDB0D0CDB0DDA0DDB0D0CDBF5DAFFFFFF080CF5DA0DDBF45EFFFFFF11 + DB0C5EFFFFB335DBF4DB5EF6FFFFFFFFFF08DBF45EFFFFB335DB0C0DDB0D11FF + FFB3620DDB07AFFFF6F6F6FFFFB3110DDA0D0C5EF6FFFF35DB0CDB0D0CDBF50C + DB0DDB0DDB0D0DDBF5DA0DDB0CDB0DDA0DDB0C0DDB0DDB0C0DDBDB0DDB0D0D0C + DB0DDB0CDB0DDA0DDB0DDAFF91390D0DDA0DDBF4DBF5DA0D0CDB0CDB35FFFFFF + F7DBDB0DDA0DDB11FFFFFF5EF4DBF4DAF4F5DA0C0DDAF5DB395E5E390DF5DADB + F5DAF4F5DA0DDBDAF5DAF5DAF50CF5DAF5DB0C0D113A5E3A11F40DDA0D0DDA5E + FFFFFF11F5DB0C0DDB0CDBDB0CDB0CDB0C0DDA0DDA0D0CDBF5DA0D0DDB0C0DDB + 0C0DDA0DDA0D0C0D0CDBDA0DDAF5DA0D0CDB0D0DDA0D0D45CD35DA0D0DDA0DDB + 0CDB0DDB0DDBF5DA62FFFFFF39F4DB0DF5DA0DF4FFFFF609DA0DDB0DDA0D0DDB + 0DDB0CF5DBF4DAF5DA0D0DDA0D0DDA0DDBF40D0DDA0DDBF4DB0CDB0DDA0DDA0D + 0D0D0C0C0DDAF5DBDAF5DA62FFFFFF35DA0DDBF4DB0D0CDBF5DAF5DB0DDAF5DB + 0DDB0D0CDB0DDA0D0DDB0CDB0DDAF5DB0DDA0DDB0DF4DB0D0DDB0DDB0D0CDB0D + 0DDA0DFF7A420DDBF4DB0D0CDB0C0DDA0D0CDB0D86FFFFFF0DDB0CDBDA0DDBDA + AFF6FFFF0CF5DA0D0DDA0DDA0D0CDBDA0D0DDB0CDB0DDAF5DB0CDB0D0CDBDB0C + DB0D0CDB0DDA0DDAF5DAF5DA0DDA0DDB0C0DDB0C0DDB0D5EF6FFFF110DDB0CDB + 0DDA0D0DDA0DDB0C0DDB0CDB0C0DDA0DDB0C0DDA0DDA0D0DDAF5DB0CDBF5DB0C + DBDB0CDB0C0DDAF5DA0D0CDB0C0DDB352D33DB0CDB0D0CDB0D0DDAF5DB0DDAF4 + FFFFFFFFDB0CF5DA0D0DDAF586FFFFFF11DADB0DDA0DDB0D0CDB0D0D0CDB0CDB + F5DAF5DBDA0D0DDA0DDB0C0D0D0CDB0DDAF50D0DDB0DDB0DDAF5DB0C0DDB0C0D + DB0C0C5EF6FFFF350DDAF5DB0C0D0DDA0DDB0C0DDB0CDB0D0DDA0DDBF40DDB0D + 0CDBF5DA0DDBDA0D0DDB0CDB0D0C0DDBF5DA0DDB0DDB0DDA0DDB0CFF91390D0D + DA0DDB0D0CDB0DDAF5DA0D11FFFFFF08F4DBDB0D0CDBF5DA5EFFFFFF3AF43508 + FF860C0DDB0C0DDADB0D0DDADB0DDA0D0D0CDBF5DA0D0DDADB0DDA0D0DDBDADB + 0C0DDA0D0DDA0D0DDB0C0DDAF5DB0D5EFFFFFF35DB0DDA0D0DDADB0D0C0D0DDA + 0DDBF4DB0CDB0D0CDBDB0C0DDB0DDAF5DA0D0D0CDB0CDBF4DB0DDA0DDA0DDA0D + DAF5DA0D0CDB0D45CD35DAF5DB0C0DDB0D0CDB0DDB0DDA07FFFFFF5E0C0DDA0D + DB0CDB0D11FFFFF686DB08FFFFFF5EDAF5DB0D0D0CDB0D0D0CDB0DDA0DDB0CDB + 0DDA0DF5DA0D0DDA0D0C0D0DDB0C0DDA0DDB0CDB0DDB0DDB0CDB0C62FFFFFF11 + F4DB0DDA0D0DDA0DDBDAF5DB0C0DDB0DDBF4DB0D0C0DDB0C0DDB0DDB0DDA0DDB + F4DB0DDB0CDBF5DB0DDBF5DA0DDB0DDB0D0CDBFF62480DDB0CDB0C0DDADB0D0C + DBF4DB86FFFFF635DB0C0DDBF4DB0CDBF4FFFFFFAFF4FFFFFFFF080DDB0CDB0C + DBF4DB0CDBF5DA0DDB0C0DDB0C0DDBDA0DDB0C0DDB0DDA0D0CDB0DDB0D0CDBF4 + DB0C0DDA0D0DDA5EF6FFFF35DB0DDAF5DB0C0DDB0C0DDB0CDB0DDA0D0CDB0CDB + 0DDBF4DB0CDB0C0DDAF5DB0CDB0D0CDBF5DA0DDA0D0CDB0D0CDB0C0DDA0D0D32 + A506DB0CDB0D0DDA0D0D0CDB0DDB0CAFFFFFFF0DDAF5DB0CDB0DDBF4DB08FFFF + FF0CAFFFFFFF86DB0CDBF5DB0DDB0CDB0DDA0DDBF40DDB0C0DDB0C0D0DDAF5DB + 0DDA0DDB0DDB0C0D0CDB0DDB0C0DDB0D0DDA0D5EF6FFFF35DB0C0DDB0CDB0DDA + F5DB0CDBF5DA0D0DDB0DDB0CDB0CDB0DDBF40DDB0DDB0CDB0D0CDB0DDA0DDB0D + 0CDB0D0CDB0D0DDA0D0DDAFF91390D0DDB0CDBF5DA0DDBF4DB0C0DFFFFFFF6DB + 0DDA0D0DDA0D0CDB0C62FFFFFF3A39FFFFB30DF4DB0CDBF4DB0C0DDAF5DB0C0D + DBDA0D0DDA0DDB0CDB0DDA0DDAF5DAF5DAF5DB0CDBF4DB0C0DDA0D0CDB0D0C5E + FFFFFF35DB0DDA0DDBF4DB0DDA0DDB0CDB0D0CDB0C0DDAF5DAF5DA0D0CDBDA0D + 0CDB0D0C0DDB0C0DDBF4DB0CDB0C0DDB0C0DDA0D0CDB0D3C7311DB0CF5DB0CDB + 0DDA0DDB0CDB0D35113511F4DB0DDA0D0DDB0D0DDB0D3511350D0C0D11F4DB0D + 0DDB0CDB0DDB0D0DDA0DDB0C0D0DDAF5DB0C0DDBF4DB0DDA0DDB0DDB0DDA0DDB + 0DDB0DDB0DDB0DDB0CDBDB5EFFFFFF35F4DBF5DA0DDB0C0DDBF40D0DDA0DDB0C + DB0D0DDB0DDB0DDB0D0D0DDB0D0CDBDB0C0DDB0C0DDB0D0DDB0DDA0DDB0D0DDB + 0DDA0DFF91390CDBDA0D0CDBF4DB0D0CDB0C0DDAF5DB0CDB0D0CDB0CDB0CDB0C + 0DDA0D0DDADA0DDBDA0D0CDBDA0D0DDA0D0CDB0C0DDB0CDB0DDA0DDB0CDB0D0C + DB0D0C0D0CDB0C0DDA0D0D0C0DDA0D0CDBF4DBF4DB0DF4111111350DDA0DDADB + 0D0CDB0D0CDBDB0C0DDAF5DBF4DB0CDB0C0DDAF5DA0DDAF5DA0D0D0CDB0D0CDB + 0C0DDA0D0CDB0D0C0DDA0DDA0D0DDB26AF0EDB0D0D0DDB0DDB0D0CDB0D0DDB0D + DB0CDBF50CDB0D0DDBF5DA0DDB0D0DDA0D0DF5DA0D0DDB0C0D0DDA0D0DDB0C0D + DB0C0D0DDAF5DB0C0DDBF4DB0DDA0DDBDB0D0DDA0D0DDADBDB0D0CDB0DDB0CDB + 0D0CDBDBF40D0CDB0DDB0D0D0CDB0DDA0DDB0C0DDB0DDB0CDB0DDB0C0DDB0DDA + 0DDB0DDA0DDB0CDB0DDA0DDB0DDB0DDA0DDBF4DBDB0DDAF50DDA0DFF285C0D0C + DBDAF5DA0D0CDB0C0DDA0D0CDB0D0CDBDB0C0DDA0DDA0D0DDA0DDA0D0CDBDA0D + 0CDBF4DB0CDBF5DA0DDA0DDA0D0DDADB0DDA0D0DDA0DDB0DDAF5DA0D0C0DDA0D + 0CDB0D0C0D0CDBF5DA0D0DDA0DDB0C0DDBDA0D0DDAF5DA0DDBF4DBF5DA0D0DDB + F4DB0C0DDB0C0D0DDA0D0CDB0D0C0DDBF4DB0D0CDBF5DA0D0CDB0C0DDA0DDB0C + F5DA0DDADB0D0C435513DB0D0C0DDB0DDA0DDB0DDB0DDA0D0CDB0D0CDB0DDAF5 + DB0DDA0D0DDAF5DB0D0DDB0DDB0CDB0DDB0CDB0DDBF5DBF5DA0DF5DA0DDB0CDB + F5DA0DDA0DDB0DDA0DDB0DDB0DDA0DDB0DDB0CDB0DDA0D0DDAF5DB0C0DDB0CDB + 0DDA0DDA0DDB0CDB0DDA0DDADB0DDB0C0DDBDA0D0DDB0D0CDBDB0C0DDB0CDB0D + 0CDB0DDA0D0DDB0DF5DA0DDBDB0D0D0DDA0DDBFF91390CDBDB0C0D0CDB0C0DDA + F5DA0DDB0D0DDA0D0DDA0DDA0D0C0DDB0C0DDB0CDB0C0DDAF5DB0D0C0D0CDB0C + 0DDA0DDA0DDBDA0D0D0CDB0DDA0D0D0D0D0CDB0D0CDBF4DB0C0DDAF5DA0D0DDA + F5DA0DDAF5DB0CDB0D0CDBF50CDB0D0D0DDA0D0DDA0D0D0D0CDBF4DB0D0C0DDB + 0C0DDA0D0D0CDB0DDA0D0DDA0DDA0D0DDA0D0CDBDA0D0D0C0DDADB0C0DDB0C33 + B510DB0D0C0DDBDB0D0DDB0DDA0DDB0C0DDA0D0DDA0DDB0D0DDB0DDA0DDB0CDB + 0D0DDA0DDB0DDA0DDBDB0D0DDA0DDB0DDB0C0D0DDADB0DDA0D0DDADBDADB0D0C + DB0DDB0C0DDB0DDB0D0CDB0DDB0DDB0DDB0CDB0D0CDB0DDADB0D0CDBDA0D0DDA + 0D0DDB0CDB0DDB0DDA0DDB0C0DDB0DDB0CDB0D0C0D0DDA0D0D0D0DDA0D0DDB0C + 0D0DDA0DDB0D0C0DDB0C0DFF91390DDA0DDB0C0C0DDA0D0CDB0D0CDBDA0D0CDB + 0DDA0CDBDA0DDA0D0CDA0D0CDBDA0D0CDB0C0DDA0D0C0DDA0D0DDA0D0CDB0CDA + 0D0C0D0DDADB0D0C0D0C0DDB0C0DDA0DDB0C0CDB0CDB0C0CDB0C0DDA0CDB0C0C + DB0CDB0D0C0DDB0C0D0CDB0DDADB0CDB0C0DDA0C0DDA0CDBDA0C0DDA0D0CDADB + 0CDA0DDBDA0DDA0DDADB0C0DDBDA0DDA0DDA0DDB0C0DDB33B5100D0DDA0DDB0D + DA0DDA0D0CDB0C0D0DDB0D0CDB0D0D0C0DDA0DDB0D0DDB0C0D0DDB0C0DDA0D0D + DB0DDA0DDA0D0DDA0D0DDB0DDB0DDA0D0D0CDB0DDB0DDA0DDA0D0DDA0DDB0D0C + DB0DDB0D0DDA0D0D0DDB0DDB0D0D0CDB0DDA0DDB0DDB0C0D0C0DDA0DDB0D0DDB + 0D0D0D0D0DDB0C0DDB0D0D0DDB0D0C0D0CDB0D0D0C0DDB0C0D0DDB0C0D0DDA0D + DB0C0DFF9139E1E017DD16E1E113E117E1DD17E1E013E0E117DCE1E117DD1716 + E1DC17E1E1DC17E1E11317E0E112E117E1DDE017E1DC17E017DCE117E0DD17E0 + E112E11717DDE017E112E1E1171617E0E113E1E01712E116E1E0E113E017E112 + E116E1DDE117E11316E1E013E0E1E0E116E1DDE116E1DCE116E1DDE117E116E1 + E117DC17E1E013E1E116E117DCE1E14355131717E117E11717E017E11617E1E1 + 1717E117E1E11717E0E117E1E117E1171717E11717E1E1E117E117E1161717E1 + 1717E117E11717E1E117E11717E117E1E1E117E117E1E11717E1E1E117E11717 + E1E1E117E11717E117E117E1E117E11717E117E1E1E11717E117E117E1171717 + E1E11717E117E116E117E1E117E117E1E117E1E117E117E1171717FF793FE1E1 + 17E017E1E1E117E1E1E11716E1E1E117E017E1E1E117E0E117E117E1E0E117E1 + E0E11617E117E117E1E1E117E0E1E117E1E1E01717E116E1E1E11716E116E117 + E1E017E1E0E11717E116E1E1E11717E117E1E116E117E01717E117E0E116E116 + E117E1E1E11717E117E1E1E0E117E1E117E117E117E0E117E116E1E116E11717 + E017E116E1E1E126AF0E16E1E117E11617E1E01717E0E1E11716E117E11716E1 + 17E11717E017E01717E0E11717E1E116E1E017E01717E0E11717E0E11617E1E0 + E117E11716E1E1E117E116E11717E11717E0E1E017E11617E0E116E1E017E1E1 + 17E1E1E1E017E117E1E117E116E11617E0E116E1E11617E117E017E0E116E117 + E11717E017E117E117E1E017E1E117E11716E1FF9139E117E1E017E1E11717E1 + E117E116E1E1E116E1E1E117E017E1E117E117E1E117E1E0E117E1E117E117E1 + E1E117E1E0E11717E1E1171717E017E1E117E017E117E1E1E0E116E1E1171713 + E117E1E117E1E117DD17E017E0171717E1E116E116E1E117E117E1E117E1E113 + E0E1E117E017E117E1E117E017E0E117DD16E116E117E1E116E116E1E0E11743 + 551317E01717E1DC17E0E1E017E017E117E116E1E11617E017E1E017DD16E1E0 + 17E017E117E01717E017E1E01716E117E117E0E1E116E1DCE1E117E013E017E1 + 16E116E11717E1DD17E0E5E5E017E017E1161BE51EE51BE1E117E0E1E017E51B + E517E017E017E116E51B1AE517E117E017E117E41B1BE0E117E117E0E51BE51B + E5E01716E113E11B1B1FE5FF0080E117E0E1E11BE91F1B1BE117E017E017E51F + 1FE5E117E11717E01BE91F1FE51BE116E117E0E51FE91F1FE5DD16E116E11F1F + 1FE91F1BE116E117E51FE91FE91FE117E0E1171AE91F231F1FE117E1E11FFE1F + E91F231F16E1E1171BE91F1FE91F1BE1E1E11BE923E91F23E516E117E11BFE1F + E91F231BE116E11F23FE1BE91F1FE1E1E1E51FFEE9E51B32A5061BE11716E523 + 1FE5E51F1FE517E117E923E5171BE91FE0E117E51F23E91B1BE91FE113E11B23 + E91BE51B23E517E11BFE23E5171BE9231BDDE01FFE1F1B171BE91FE117E0E523 + 1FE91B1F23E91716E5231BE113E11B23E117E0E9231BE1E116E5231F13E02323 + E51BE11B23E117E01FFE1FE117E1E523E513E11BFE1BE112E11F231716E1231F + 1713E1FF91391FE1E1E11F23E51316E11F1FDDE1E123E917DCE11B231BE1DC1B + FE1F17E1E11B231BE017E9FE1BE112E11F1FE112E523E913E0DD1B231BE117E9 + 23E5DDDCE11B1F17E113E923E917E1E51F1FE0DD1BFEE917E117E51F17E1171F + FEE51717E11B23E516E11BFE1BE117E51F1BE113E5231FE1E1171F1FE517E017 + E91FE5E11B1F1FE1E1E11FE9E5E11745CD351FDD1613E523E91BE1E5231BE017 + 161BE91BE51B1F23E51317E5231FE5E11B1F23E117DD1B1F1FE5E51B1F1BE1E1 + 171F1FE51B1BFE1FE116DD1B1FE91F1B1F1F1FE1E017E11B1FE51B1F231BE117 + E1171F1FE91F1F1FE1DC17E11B1F1FE9231FE117E1E1131B1FE91F231FE1E017 + E117E91F1F2323E517E0E113E01B1F1F231FE1E0171716E91F1F1FFF285CE117 + E1E017E11FE91F1F1FE517E1E1E117E91F1FE517E1E0E113E5E91F1F1F1FE517 + E1E017E1E51F1FE91BE1E017E1DDE51FE91F1BE117E1E117E11BE91FE51BE1E1 + 17E1DD17E51F1F1BE117E1E017DDE1E11BE91BE1E117E1DD17E1E117E1E117DD + E017E1E1E11BE517E1DD17E1E112E117E51BE117DDE117E1DD17E1E117E1DD17 + E1E1DD1717E51B33B51016E117E1E116DD17E117E113E01717E01317E01717DC + 1717E01717DC17E116E113E01717E01713E01713E01317E01717E01317E01712 + E11617E112E112E113E01316E11617E116DD16E113E01717E01717E01317DC17 + 16E11617E11217E01317E01717E01717E01317DC1716E11617E116E112E113E0 + 1716E11617E11617DC1717E01716E1E1E013E1FF6248E117E017E1E117E01713 + E1E117E1E117E1E113E1E117E1E117E1E117E1DD17E1E117E1E117E1E117DDE1 + 17E1E117E1E117E1E113E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1 + E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117 + E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E017E1E117E117E11680 + 008017E117E11716E117E1E0E116E1E116E1E116E1E116E1E116E1E116E1E116 + E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E1 + 16E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1 + E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116E1E116 + E1E117E1E117E017E017E1FF0080E116E116E1E117E0E11717E11617E11617E1 + 1617E11617E11617E11617E11617E11617E11617E11617E11617E11617E11617 + E11617E11617E11617E11617E11617E11617E11617E11617E11617E11617E116 + 17E11617E11617E11617E11617E11617E11617E11617E11617E11617E11617E1 + 1617E11617E11617E11617E11617E01716E117E117E1E133B510E117E1E117E0 + 1717E0E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117 + E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E1 + 17E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1 + E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E017 + E11617FF6248E1E017E117E1E1E117E1E017E1E017E1E017E1E017E1E017E1E0 + 17E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1 + E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017 + E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E017E1E0 + 17E1E017E1E017E1E017E1E116E1E18000801717E116E1E11617E01717E11617 + E11617E11617E11617E11617E11617E11617E11617E11617E11617E11617E116 + 17E11617E11617E11617E11617E11617E11617E11617E11617E11617E11617E1 + 1617E11617E11617E11617E11617E11617E11617E11617E11617E11617E11617 + E11617E11617E11617E11617E11617E11617E11617E11617E1E117FF0080E1E0 + E117E017E1E117E1E017E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1 + E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117 + E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E1 + 17E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1E117E1 + E117E1E1E116E145CD351717E1E117E116E1E117E11717E0E117E01717E0E117 + E01717E0E117E01717E0E117E01717E0E117E01717E0E117E01717E0E117E017 + 17E0E117E01717E0E117E01717E0E117E01717E0E117E01717E0E117E01717E0 + E117E01717E0E117E01717E0E117E01717E0E117E01717E0E117E01717E0E117 + E01717E0E117E01717E0E117E01717E017E117FF9139E1E116E1E017E117E017 + E0E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1 + E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017 + E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116 + E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E132 + A506E116E11717E116E117E1E11717E117E1E11717E117E1E11717E117E1E117 + 17E117E1E11717E117E1E11717E117E1E11717E117E1E11717E117E1E11717E1 + 17E1E11717E117E1E11717E117E1E11717E117E1E11717E117E1E11717E117E1 + E11717E117E1E11717E117E1E11717E117E1E11717E117E1E11717E117E1E117 + 17E117E1E11717E117E117FF7A4217E117E1E017E117E0E117E0E117E0E117E0 + E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117 + E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E1 + 17E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0E117E0 + E117E0E117E0E117E0E117E0E117E0E117E0E117E0E1E1435513E116E117E1E1 + 16E11716E117E0E11716E117E0E11716E117E0E11716E117E0E11716E117E0E1 + 1716E117E0E11716E117E0E11716E117E0E11716E117E0E11716E117E0E11716 + E117E0E11716E117E0E11716E117E0E11716E117E0E11716E117E0E11716E117 + E0E11716E117E0E11716E117E0E11716E117E0E11716E117E0E11716E117E0E1 + 171617FF9E4BE1E117E017E1E117E1E117E11717E1E117E11717E1E117E11717 + E1E117E11717E1E117E11717E1E117E11717E1E117E11717E1E117E11717E1E1 + 17E11717E1E117E11717E1E117E11717E1E117E11717E1E117E11717E1E117E1 + 1717E1E117E11717E1E117E11717E1E117E11717E1E117E11717E1E117E11717 + E1E117E11717E1E117E117E1E1E1E145CD351716E117E11617E1E017E116E1E1 + E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017 + E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116 + E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1E017E116E1E1 + E017E116E1E1E017E116E1E1E017E116E1E1E017E116E117E01717FF6248E1E1 + 17E017E1E01717E017E1E01717E017E1E01717E017E1E01717E017E1E01717E0 + 17E1E01717E017E1E01717E017E1E01717E017E1E01717E017E1E01717E017E1 + E01717E017E1E01717E017E1E01717E017E1E01717E017E1E01717E017E1E017 + 17E017E1E01717E017E1E01717E017E1E01717E017E1E01717E017E1E01717E0 + 17E1E01717E0E180008017E1E117E117E1E1E117E117E1E1E117E117E1E1E117 + E117E1E1E117E117E1E1E117E117E1E1E117E117E1E1E117E117E1E1E117E117 + E1E1E117E117E1E1E117E117E1E1E117E117E1E1E117E117E1E1E117E117E1E1 + E117E117E1E1E117E117E1E1E117E117E1E1E117E117E1E1E117E117E1E1E117 + E117E1E1E117E117E1E1E117E117E1E1E117E1FFD737E116E1E017E017E017E0 + 17E017E017E017E017E017E017E017E017E017E017E017E017E017E017E017E0 + 17E017E017E017E017E017E017E017E017E017E017E017E017E017E017E017E0 + 17E017E017E017E017E017E017E017E017E017E017E017E017E017E017E017E0 + 17E017E017E017E017E017E017E017E017E017E017E017E017E017E017E01733 + B510E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117 + E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117 + E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117 + E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117 + E117E117E117E117E117E1FF9139 + } + Transparent = False + end + end + object OKButton: TButton + Left = 380 + Height = 25 + Top = 277 + Width = 75 + Cancel = True + Caption = 'OK' + OnClick = OKButtonClick + TabOrder = 1 + end +end diff --git a/components/tvplanit/source/vpabout.lrs b/components/tvplanit/source/vpabout.lrs new file mode 100644 index 000000000..ceecade68 --- /dev/null +++ b/components/tvplanit/source/vpabout.lrs @@ -0,0 +1,1730 @@ +{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei } + +LazarusResources.Add('TfrmAbout','FORMDATA',[ + 'TPF0'#9'TfrmAbout'#8'frmAbout'#4'Left'#3#26#1#6'Height'#3'8'#1#3'Top'#3#205#0 + +#5'Width'#3#215#1#18'HorzScrollBar.Page'#3#214#1#18'VertScrollBar.Page'#3'7' + +#1#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#19'About Visual PlanIt'#12'Cli' + +'entHeight'#3'8'#1#11'ClientWidth'#3#215#1#11'Font.Height'#2#245#9'Font.Name' + +#6#13'MS Sans Serif'#10'OnActivate'#7#12'FormActivate'#11'OnMouseMove'#7#13 + +'FormMouseMove'#8'Position'#7#14'poScreenCenter'#0#6'TBevel'#6'Bevel3'#4'Lef' + +'t'#3#152#0#6'Height'#2'`'#3'Top'#3#160#0#5'Width'#3'1'#1#5'Shape'#7#7'bsFra' + +'me'#0#0#6'TBevel'#6'Bevel2'#4'Left'#2#6#6'Height'#2#17#3'Top'#3#9#1#5'Width' + +#3#195#1#5'Shape'#7#9'bsTopLine'#0#0#6'TLabel'#11'ProgramName'#4'Left'#3#152 + +#0#6'Height'#2#14#3'Top'#2#8#5'Width'#2'\'#7'Caption'#6#13'Visual PlanIt'#11 + +'Font.Height'#2#243#9'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#6'fsB' + +'old'#0#11'ParentColor'#8#0#0#6'TLabel'#12'VisitUsLabel'#4'Left'#3#153#0#6'H' + +'eight'#2#15#3'Top'#2'm'#5'Width'#3#31#1#7'Caption'#6'.Visit the Visual Plan' + +'It project on SourceForge'#11'ParentColor'#8#0#0#6'TLabel'#22'GeneralNewsgr' + +'oupsLabel'#4'Left'#3#160#0#6'Height'#2#15#3'Top'#3#168#0#5'Width'#3#179#0#7 + +'Caption'#6#28'Visual PlanIt support groups'#11'ParentColor'#8#0#0#6'TLabel' + +#12'lblTurboLink'#6'Cursor'#7#11'crHandPoint'#4'Left'#3#161#0#6'Height'#2#13 + +#3'Top'#2'}'#5'Width'#3#232#0#7'Caption'#6'*http://sourceforge.net/projects/' + +'tpvplanit/'#10'Font.Color'#7#6'clBlue'#11'Font.Height'#2#245#9'Font.Name'#6 + +#13'MS Sans Serif'#10'Font.Style'#11#11'fsUnderline'#0#11'ParentColor'#8#7'O' + +'nClick'#7#17'lblTurboLinkClick'#11'OnMouseMove'#7#21'lblTurboLinkMouseMove' + +#0#0#6'TLabel'#7'lblHelp'#6'Cursor'#7#11'crHandPoint'#4'Left'#3#168#0#6'Heig' + +'ht'#2#13#3'Top'#3#198#0#5'Width'#3'N'#1#7'Caption'#6'6http://sourceforge.ne' + +'t/forum/forum.php?forum_id=241880'#10'Font.Color'#7#6'clBlue'#11'Font.Heigh' + +'t'#2#245#9'Font.Name'#6#13'MS Sans Serif'#10'Font.Style'#11#11'fsUnderline' + +#0#11'ParentColor'#8#7'OnClick'#7#12'lblHelpClick'#11'OnMouseMove'#7#21'lblT' + +'urboLinkMouseMove'#0#0#6'TLabel'#14'CopyrightLabel'#4'Left'#2#7#6'Height'#2 + +#15#3'Top'#3#17#1#5'Width'#3'L'#1#7'Caption'#6'0(C) Copyright 2001, TurboPow' + +'er Software Company.'#11'ParentColor'#8#0#0#6'TLabel'#19'RightsReservedLabe' + +'l'#4'Left'#2#7#6'Height'#2#15#3'Top'#3'!'#1#5'Width'#2'x'#7'Caption'#6#20'A' + +'ll rights reserved.'#11'ParentColor'#8#0#0#6'TLabel'#20'lblGeneralDiscussio' + +'n'#6'Cursor'#7#11'crHandPoint'#4'Left'#3#168#0#6'Height'#2#13#3'Top'#3#230#0 + +#5'Width'#3'N'#1#7'Caption'#6'6http://sourceforge.net/forum/forum.php?forum_' + +'id=241879'#10'Font.Color'#7#6'clBlue'#11'Font.Height'#2#245#9'Font.Name'#6 + +#13'MS Sans Serif'#10'Font.Style'#11#11'fsUnderline'#0#11'ParentColor'#8#7'O' + +'nClick'#7#25'lblGeneralDiscussionClick'#11'OnMouseMove'#7#21'lblTurboLinkMo' + +'useMove'#0#0#6'TLabel'#6'Label2'#4'Left'#3#168#0#6'Height'#2#15#3'Top'#3#186 + +#0#5'Width'#2'"'#7'Caption'#6#5'Help:'#11'ParentColor'#8#0#0#6'TLabel'#6'Lab' + +'el3'#4'Left'#3#168#0#6'Height'#2#15#3'Top'#3#217#0#5'Width'#2''#7'Caption' + +#6#19'General Discussion:'#11'ParentColor'#8#0#0#6'TLabel'#6'Label1'#4'Left' + +#3#160#0#6'Height'#2'1'#3'Top'#2'('#5'Width'#3#9#1#8'AutoSize'#8#7'Caption'#6 + +#150'Visual PlanIt was released under the Mozilla 1.1 license in January, 20' + +'03. The project is hosted on SourceForge at sourceforge.net/projects/tpvpla' + +'nit.'#11'ParentColor'#8#8'WordWrap'#9#0#0#6'TPanel'#6'Panel1'#4'Left'#2#6#6 + +'Height'#3#251#0#3'Top'#2#6#5'Width'#3#139#0#10'BevelOuter'#7#9'bvLowered'#12 + +'ClientHeight'#3#251#0#11'ClientWidth'#3#139#0#8'TabOrder'#2#0#0#6'TImage'#6 + +'Image1'#4'Left'#2#1#6'Height'#3#249#0#3'Top'#2#1#5'Width'#3#137#0#5'Align'#7 + +#8'alClient'#12'Picture.Data'#10'n'#140#0#0#7'TBitmapb'#140#0#0'BMb'#140#0#0 + +#0#0#0#0'6'#4#0#0'('#0#0#0#137#0#0#0#249#0#0#0#1#0#8#0#0#0#0#0','#136#0#0#0#0 + +#0#0#0#0#0#0#0#1#0#0#0#1#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0 + +#0#128#0#128#0#128#128#0#0#128#128#128#0#192#220#192#0#240#202#166#0#170'?*' + +#0#255'?*'#0#0'_*'#0'U_*'#0#170'_*'#0#255'_*'#0#0'*'#0'U*'#0#170'*'#0#255 + +'*'#0#0#159'*'#0'U'#159'*'#0#170#159'*'#0#255#159'*'#0#0#191'*'#0'U'#191'*' + +#0#170#191'*'#0#255#191'*'#0#0#223'*'#0'U'#223'*'#0#170#223'*'#0#255#223'*'#0 + +#0#255'*'#0'U'#255'*'#0#170#255'*'#0#255#255'*'#0#0#0'U'#0'U'#0'U'#0#170#0'U' + +#0#255#0'U'#0#0#31'U'#0'U'#31'U'#0#170#31'U'#0#255#31'U'#0#0'?U'#0'U?U'#0#170 + +'?U'#0#255'?U'#0#0'_U'#0'U_U'#0#170'_U'#0#255'_U'#0#0'U'#0'UU'#0#170'U'#0 + +#255'U'#0#0#159'U'#0'U'#159'U'#0#170#159'U'#0#255#159'U'#0#0#191'U'#0'U'#191 + +'U'#0#170#191'U'#0#255#191'U'#0#0#223'U'#0'U'#223'U'#0#170#223'U'#0#255#223 + +'U'#0#0#255'U'#0'U'#255'U'#0#170#255'U'#0#255#255'U'#0#0#0''#0'U'#0''#0#170 + +#0''#0#255#0''#0#0#31''#0'U'#31''#0#170#31''#0#255#31''#0#0'?'#0'U?' + +#0#170'?'#0#255'?'#0#0'_'#0'U_'#0#170'_'#0#255'_'#0#0''#0'U'#0#170 + +''#0#255''#0#0#159''#0'U'#159''#0#170#159''#0#255#159''#0#0#191''#0 + +'U'#191''#0#170#191''#0#255#191''#0#0#223''#0'U'#223''#0#170#223''#0 + ,#255#223''#0#0#255''#0'U'#255''#0#170#255''#0#255#255''#0#0#0#170#0'U'#0 + +#170#0#170#0#170#0#255#0#170#0#0#31#170#0'U'#31#170#0#170#31#170#0#255#31#170 + +#0#0'?'#170#0'U?'#170#0#170'?'#170#0#255'?'#170#0#0'_'#170#0'U_'#170#0#170'_' + +#170#0#255'_'#170#0#0''#170#0'U'#170#0#170''#170#0#255''#170#0#0#159#170 + +#0'U'#159#170#0#170#159#170#0#255#159#170#0#0#191#170#0'U'#191#170#0#170#191 + +#170#0#255#191#170#0#0#223#170#0'U'#223#170#0#170#223#170#0#255#223#170#0#0 + +#255#170#0'U'#255#170#0#170#255#170#0#255#255#170#0#0#0#212#0'U'#0#212#0#170 + +#0#212#0#255#0#212#0#0#31#212#0'U'#31#212#0#170#31#212#0#255#31#212#0#0'?' + +#212#0'U?'#212#0#170'?'#212#0#255'?'#212#0#0'_'#212#0'U_'#212#0#170'_'#212#0 + +#255'_'#212#0#0''#212#0'U'#212#0#170''#212#0#255''#212#0#0#159#212#0'U' + +#159#212#0#170#159#212#0#255#159#212#0#0#191#212#0'U'#191#212#0#170#191#212#0 + +#255#191#212#0#0#223#212#0'U'#223#212#0#170#223#212#0#255#223#212#0#0#255#212 + +#0'U'#255#212#0#170#255#212#0#255#255#212#0'U'#0#255#0#170#0#255#0#0#31#255#0 + +'U'#31#255#0#170#31#255#0#255#31#255#0#0'?'#255#0'U?'#255#0#170'?'#255#0#255 + +'?'#255#0#0'_'#255#0'U_'#255#0#170'_'#255#0#255'_'#255#0#0''#255#0'U'#255#0 + +#170''#255#0#255''#255#0#0#159#255#0'U'#159#255#0#170#159#255#0#255#159#255 + +#0#0#191#255#0'U'#191#255#0#170#191#255#0#255#191#255#0#0#223#255#0'U'#223 + +#255#0#170#223#255#0#255#223#255#0'U'#255#255#0#170#255#255#0#255#204#204#0 + +#255#204#255#0#255#255'3'#0#255#255'f'#0#255#255#153#0#255#255#204#0#0''#0#0 + +'U'#0#0#170''#0#0#255''#0#0#0#159#0#0'U'#159#0#0#170#159#0#0#255#159#0#0#0 + +#191#0#0'U'#191#0#0#170#191#0#0#255#191#0#0#0#223#0#0'U'#223#0#0#170#223#0#0 + +#255#223#0#0'U'#255#0#0#170#255#0#0#0#0'*'#0'U'#0'*'#0#170#0'*'#0#255#0'*'#0 + +#0#31'*'#0'U'#31'*'#0#170#31'*'#0#255#31'*'#0#0'?*'#0'U?*'#0#240#251#255#0 + +#164#160#160#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0 + +#255#0#255#255#0#0#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#0#0#0#0#0#0#245#241#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0'U'#255#240#0#0'-'#240#7#255#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +'1'#245#255'1'#0'1'#255#245#8#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#241'1'#0#0'1'#255#240 + +#246#246'-Y'#255#236#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#7#246#241#0#245#255'1'#247 + +#255'-'#7#8#245#255#246#0#247#255','#245#7#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#7'-'#8#134 + +'-'#255#241#130#7#7#246#245'1'#255'1'#241#255#255#241#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0'1'#0#175#255 + +#130'-'#255#241#255#240#8'1'#212#247#0#255#247#240#255#8#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#247 + +#0#8#255#0#8'1'#8'U'#8'-'#246#236#175#130#240#255#255#7#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#247#255 + +#247#0#8#134'U'#130#7#134#134'1'#8#247#8#240#255#255#7#240#245'-'#0#0#0#0#0#0 + +#0#0#0#0#7'-'#0#0#0#0#0#245#130#175#8'1'#0#0#0'1'#7#0#0#0#240#247#245'1'#7#7 + +#7'1'#0#0#0#0#0#0#7#170#175#134#7#0#0#0#0#245#247#0#0#0#0#0#0#0#0#0#7#170#175 + +#170#7#0#0#0#0#0#0#0'-'#241#0#0#0#0#0'1'#0#0#0#0#240#7#7#7#247#7#247#0'-'#7#0 + ,#0#0#240#247'-'#0#0#0#0#0#0#0#0#0#0#240#245#0#0#0'-'#255#134#236#212#8#8'1' + +#255#130#247#246#134#241#246#7#0#245#170#255#255#245#0#0#0#0#0#0#0#0#0#255 + +#247#0#0#0#0#7#255#255#170#175#255#134#0#0#8#255#0#0#0#175#255#240#8#255#246 + +#255#246#246#240#0#0'1'#255#255#175#170#175#255#246'1'#0#0#7#255#0#0#0#0#0#0 + +#0'-'#255#255#175#170#175#255#255'1'#0#0#0#0#0#8#7#0#0#0#0#240#255#245#0#0#0 + +#241#255#255#255#255#255#255#240#134#255#0#0#0#175#255#240#0#0#0#0#0#255#0#0 + +#0#0#245#246#246#247#246'1'#0#8#175#0#170#255#7#8'1'#134#246'-'#246#7'1'#175 + +#246#134'1'#240'-1'#0#0#0#0#0#0#0#0#255#247#0#0#0#240#255#130#0#0#0'1'#255'U' + +#0#134#255#0#0#247#246#245#0#175#170#0#0#241#246#175#0'-'#255#8#240#0#0#0#240 + +#175#246'-'#0#7#255#0#0#0#0#0#0'-'#255#8#240#0#0#0#240#8#255'1'#0#0#0#0#255 + +#246#0#0#0#0'U'#255#7#0#0#0#244#255'1'#0#0#0#0#0#134#246#0#0#7#255#245#0#0#0 + +#0#0#0#0#0#0#0#0#0#7#134#255#255#255#247#240#7#8#241#134'-'#0#0#0#0#175#255 + +#134#134#7#241'-'#7#246#246#246#7#0#0#0#0#0#0#0#255#247#0#0#0#247#255#0#0#0#0 + +#0#175#8#0#130#246#0#240#255#247#0#0#8#8#0#0#0#7#255#0#255#8#0#0#0#0#0#0#0 + +#175#246#0#7#255#0#0#0#0#0#0#255#246#0#0#0#0#0#0#0#8#255#0#0#0#7#255#255#245 + +#0#0#0#8#255#246#0#0#0#241#255'1'#0#0#0#0#0#134#209#0#240#255#247#0#0#0#0#0#0 + +#0#255#0#0#0#0#0#240'-'#240#245'U'#134#175#8#246#246#0#0#0#0#0#0'-'#7'U'#247 + +#134#255#255#246#175'1'#241#0#0#0#0#0#0#0#0#255#247#0#0#0#134#255#0#0#0#0#0 + +#247#255#0#134#175#0#209#8#0#0#0#175#170#0#0#0#247#246#7#246#241#0#0#0#0#0#0 + +#0'-'#255#245'U'#255#0#0#0#0#0'1'#255'-'#0#0#0#0#0#0#0#241#255'1'#0#0#255#134 + +#175#247#0#0#241#255#247#255'-'#0#0#244#255'1'#0#0#0#0#0#134#8#0#209#8#0#0#0 + +#0#0#0#0#0#2'R'#10#0#0#0#245#255#246#175#247#7'-1'#247#247#0#0#0#0#0#0#0#8 + +#255#130#7#240#245'11'#0#0#0#0#0#0#0#0#0#0#246#247#0#0#0#134#246#0#0#0#0#0#7 + +#255#0#247#209#8#255'1'#0#0#0#171#8#0#240#7#255#7#130#255#0#0#0#0#0#0#0#0#0 + +#255#7'1'#246#247#7'1'#0#0#247#255#0#0#0#0#0#0#0#0#0#255#134#0'-'#255#240#7 + +#255#0#0#247#255#0#175#8#0#0#241#255'1'#0#0#0#0#0#134#209#8#255'1'#0#0#0#0#0 + +#0#0#0#255#0#0#0#0#0#0'1'#7#7#130#170#134#134#130'1'#0#0#0#0#0#0#0#7#130#134 + +#134#134#247'U1-'#0#0#0#0#0#0#0#0#0#255#247#0#0#0#134#246#0#0#0#0#0#7#255#0 + +#247#255#8#8#255#134#0#0#8#255#255#255#255#7#0#8#175#0#0#0#0#0#0#0#0#0#255 + +#247'1'#255#175#246#255#246#0#247#246#0#0#0#0#0#0#0#0#0#8#170#0#8#255#0#0#255 + +'1'#0#255#247#0#7#255#240#0#240#255#8#134#170#8#134#0#130#255#8#8#255#170#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0'11'#245#245#7#170#255#134#0#0#0#0#0#0#0#134'Z1-'#7 + +#130#246#255#255#244#0#0#0#0#0#0#0#0#255#247#0#0#0#8#209#0#0#0#0#0#7#255#0 + +#134#246#0#0#245#255#7#0#8#8#0'1'#255'1'#0#130#255#0#0#0#0#0#0#0#0#0#255#7'1' + +#255#0#0#240#255#130#7#255#0#0#0#0#0#0#0#0#0#255#247#0#255#7#0#0#175#8'1'#246 + +#240#0#0#255#7#0#241#255#175#170#8#8#170#0#130#175#0#0#245#255#7#0#0#0#0#0#0 + +#255#0#0#0#0#240#241'1'#246#255#246#246#134'Z1'#7'-'#0#0#0#0#0#0#255#246#8 + +#209#134'1'#245#240'1'#241#0#0#0#0#0#0#0#0#255#247#0#0#0#134#246#0#0#0#0#0#7 + +#255#0#130#255#0#0#0#170#8#0#175#170#0#0#7#255#0'1'#246'-'#0#0#0#0#0#0#0'1' + +#255#240'1'#255#0#0#0#7#255'-'#255'1'#0#0#0#0#0#0#0'-'#246#245'1'#255#240#0#0 + +'1'#255#246#175#0#0#0#8#255#0#240#255'1'#0#0#0#0#0#134#246#0#0#0#130#175#0#0 + +#0#0#0#0#0#0#0#0#0#130#255#246#175#7'-'#241#7#134#170#255#8#0#0#0#0'-'#8'-' + +#170#7#240#134#255#255#255#134'1'#0#0#0#0#0#0#0#0#255#7#0#0#0#134#175#0#0#0#0 + +#0#7#255#0#130#246#0#0#0#8#8#0#8#8#0#0#7#255#0#0#175#246#0#0#0#0#0#0#0#255 + +#175#0#7#255#0#0#0#7#255#0#8#255#0#0#0#0#0#0#0#255#175#0#246#8#0#0#0#0#255 + +#255'1'#0#0#0'-'#255#245#0#255'1'#0#0#0#0#0#134#175#0#0#0#8#8#240'-'#245#0#0 + +#0#255#135#9#0#0#0'1'#245#240'1'#8#246#8'-'#247#8'-'#246#247'U'#134#7#255#8 + +#245#175#130#0'Y'#255#7#246#255#0#0#0#0#0#0#0#0#255#247#0#0#0#170#246#0#0#0#0 + +#0#7#255#0#134#246#0#240#7#255'1'#0#175#170#0#245#255#8#0#0#240#255#246'-'#0 + +#0#0'-'#255#255#240#0#7#255#0#0'1'#255#134#0#240#255#255'-'#0#0#0'-'#246#255 + +#240#245#255'1'#0#0#0#0#247#255#0#0#0#0#0#255#134#240#255'1'#0#0#0#0#0#134 + +#246#0#240#7#255#7'-'#7#7#0#0#0'>?5'#0#0#0#0'1'#255#246#134#241#0#247#175'-' + +#8#209#7#134#255'-'#134#247#175#240#8#255#241#240#0#0#245#240#0#0#0#0#8#255 + +#255#255#255#255#255'-'#134#246#0#0#0#0#0#247#246#0#130#255#255#255#255'^'#0 + +#0#8#255#255#255#8#0#0#0#0#241#8#255#255#246#255#255#8#240#0#0#7#255#255#255 + +#255#8#0#0#0#240#8#255#255#246#255#255#8#240#0#8#255#0#0#0#0#0'-'#247#0#0#0#0 + +#0#7#255'1'#246#255#255#255#255#255#240#247#255#255#255#255'^'#0'-'#7#7#0#0#0 + +#255#29'M'#0#0#0#0#0'1'#241#240#247#255#255#240#171#7#8'1'#170#8#7#134'-'#134 + +#175#236#134#255#7#0#0#0#0#0#0#0#0'-111111'#0#245'-'#0#0#0#0#0#241'1'#0#245 + +'11-'#240#0#0#0#245'11'#240#0#0#0#0#0#0#0'-'#7#247#7#245#0#0#0#0#240'11-'#240 + +#0#0#0#0#0#0#245#7#247#7'-'#0#0#0'1'#245#0#0#0#0#0#0#240#0#0#0#0#0#0'1'#245 + +'-11111'#0#241'11-'#240#0#0#0#245#0#0#0#0'TPF'#0#0#0#0#0#0#0#7#255#246#240#8 + +#134#240#175'1'#134#7#134#7#8#0#255#8#0#130#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#240#175#246#0#130 + +#246#0#8#134#7#130#245#246'-'#255#240#247#255#246#0'1'#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#255#246 + +#240'^'#255#241'1'#255'U'#130#247'-'#255#245#8#247#241#7#255#255#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0 + +#240#7#241'1'#255#7#240#255#255#245#255#7'1'#255#7'Y'#255#240#0#240#255'1'#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#7#255#240#255'1Y'#209#8#241#255'-'#0#0#245#240#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#154'r'#0#0#0#0 + +#0#0#0#0#0#0#0#0#246#130'1'#246'-'#0'1'#255#240'1'#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#245#246'1'#241#245#0#0#245#246'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#161#27#0#0#0#0#0#0#0#0#0#0#0 + +#240#245#0#0#0#0#0#0#247#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0 + +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#199#199 + +#199#165#199#165#199#199#199#203#199#199#199#164#199#165#199#165#198#203#165 + +#204#203#204#203#204#203#204#203#203#169#203#204#204#203#204#204#203#204#204 + +#204#204#203#204#204#204#203#199#199#165#203#203#204#204#203#204#204#204#204 + +#203#204#204#203#204#204#203#204#204#204#204#203#203#199#199#199#198#199#203 + +#203#204#204#203#204#204#204#203#204#204#204#203#204#204#204#203#204#203#204 + +#203#203#203#203#203#203#203#203#203#203#203#203#199#203#199#199#165#199#164 + +#199#198#199#199#199#199#199#199#199#165#198#199#199#199#198#165#199#199#199 + +#165#198#255#0#0#165#164#165#198#165#198#165#164#165#203#165#160#165#199#160 + +#199#164#195#165#165#203#169#204#169#170#169#170#203#170#199#165#199#165#169 + +#170#203#170#204#169#204#169#170#204#165#204#169#165#165#165#199#165#170#203 + +#170#170#203#170#169#170#204#169#204#170#203#170#204#169#170#169#170#203#165 + +#165#164#165#165#165#199#169#165#203#166#203#170#169#170#169#170#203#170#169 + +#166#203#170#169#170#203#170#165#165#165#165#199#165#199#165#165#165#165#199 + +#165#165#165#198#165#199#165#165#199#164#165#165#160#165#164#199#165#199#164 + +#165#165#199#164#165#164#199#165#0#0#0#165#195#165#161#164#161#165#165#165 + +#165#165#165#160#165#165#164#165#164#165#165#165#165#170#200#169#200#170#165 + +#170#169#165#165#169#200#169#170#165#169#170#165#204#169#170#169#170#203#165 + +#164#165#165#165#169#166#203#170#170#203#166#169#170#165#170#165#170#169#169 + +#204#169#204#169#170#199#165#161#164#165#165#165#200#169#165#170#169#204#166 + +#203#170#169#170#169#204#169#170#203#166#169#166#203#170#199#169#165#165#169 + +#165#165#199#165#165#165#165#165#165#165#164#165#160#165#165#165#164#165#165 + +#199#165#164#165#165#161#164#165#164#165#199#161#164#165#255#135#9#164#165 + +#164#165#165#165#198#160#165#165#199#164#165#165#160#165#161#165#165#199#165 + +#170#203#169#170#169#169#203#170#199#165#165#199#169#166#169#204#170#203#170 + +#169#166#203#170#170#165#165#199#165#165#199#170#169#170#165#170#170#169#204 + +#169#204#169#170#203#170#166#169#170#165#170#165#169#165#199#165#165#165#165 + +#169#165#170#169#200#169#170#170#165#204#165#204#169#166#203#166#169#204#169 + ,#170#165#170#165#200#169#165#165#165#165#165#165#165#199#165#165#165#165#165 + +#199#165#160#165#199#165#164#161#164#165#161#164#199#165#161#165#161#164#165 + +#165#165#13#252#11#165#161#165#160#165#160#165#165#199#165#165#165#195#164 + +#165#165#198#165#164#165#169#170#169#166#169#166#204#170#165#169#165#165#169 + +#170#170#203#170#165#170#165#170#203#170#166#203#165#165#165#165#165#170#169 + +#200#169#204#169#203#166#169#166#169#170#199#170#165#203#170#165#204#170#203 + +#165#165#165#164#199#165#199#169#204#165#204#169#170#165#169#204#169#170#169 + +#166#169#170#169#170#169#166#169#170#203#170#169#165#165#199#169#165#165#165 + +#165#165#165#165#199#165#165#164#165#199#165#161#164#199#165#165#165#164#165 + +#161#165#198#165#164#165#165#199#165#255#11#2#164#165#164#165#199#165#160#165 + +#165#165#165#164#165#161#164#161#165#160#165#165#199#169#204#169#204#169#169 + +#165#170#165#165#169#165#204#169#166#170#169#170#204#169#166#169#169#170#165 + +#165#165#165#169#199#170#169#170#169#166#170#169#170#203#170#169#170#169#170 + +#170#169#170#169#169#166#169#165#161#165#165#165#169#166#169#170#169#170#169 + +#204#170#169#170#165#204#169#204#169#204#165#204#169#204#165#170#165#170#203 + +#169#165#165#199#169#199#165#165#199#165#165#165#165#165#164#165#164#165#165 + +#164#161#164#195#165#164#165#160#165#165#165#165#165#165#165#128#0#128#165 + +#161#199#160#165#165#165#164#165#199#165#165#164#199#165#164#165#165#165#165 + +#165#165#166#169#166#170#204#170#203#169#165#199#169#165#204#169#169#200#169 + +#170#169#204#170#199#170#203#165#165#165#165#170#169#200#169#170#203#170#199 + +#170#170#199#170#199#170#203#166#203#170#200#169#170#199#165#164#165#165#165 + +#165#169#204#165#170#199#170#165#170#199#170#169#166#170#169#166#169#170#169 + +#166#169#170#203#170#169#166#170#169#165#165#165#169#165#165#165#165#165#165 + +#165#165#165#165#165#164#165#165#165#165#164#161#165#199#165#164#165#199#165 + +#165#165#165#255#0#0#164#165#164#165#164#161#198#161#165#165#165#165#161#164 + +#161#165#160#199#164#199#165#169#170#203#169#203#165#169#165#165#165#165#165 + +#170#169#166#204#169#170#165#204#169#166#170#169#165#165#165#199#165#203#170 + +#169#170#169#166#169#170#169#170#170#169#170#169#170#169#170#169#170#170#169 + +#165#165#199#165#165#165#203#166#169#170#169#170#169#204#169#170#169#200#169 + +#170#166#203#170#165#170#203#170#199#170#165#204#169#204#170#165#169#165#165 + +#199#165#165#165#199#165#165#199#165#165#165#165#199#164#165#164#165#164#165 + +#164#165#165#165#165#165#169#199#165#0#0#0#165#161#165#161#165#164#165#165 + +#165#165#165#199#164#165#165#164#165#165#161#165#165#199#165#165#165#165#165 + +#165#165#199#165#165#169#204#169#170#169#166#203#170#169#170#169#169#204#165 + +#165#165#165#169#170#166#169#200#170#203#170#165#204#165#169#204#165#170#199 + +#170#165#170#199#169#199#165#165#164#165#199#169#165#170#203#166#204#169#200 + +#169#170#199#170#169#170#203#169#170#169#204#169#166#169#170#169#170#169#170 + +#169#165#204#165#199#165#165#169#165#165#165#165#165#165#165#199#165#165#165 + +#165#165#199#165#165#165#165#165#165#165#165#165#165#165#169#255#0#0#165#164 + +#165#164#195#165#160#165#164#199#169#165#165#164#161#199#160#165#164#165#165 + +#165#165#165#165#165#199#165#165#165#165#199#170#165#204#165#204#169#170#169 + +#200#169#200#170#170#165#199#165#165#165#169#203#170#169#165#170#203#170#169 + +#204#166#169#204#169#170#169#204#169#170#170#169#165#165#165#165#165#165#204 + +#169#170#169#169#170#169#170#169#170#169#204#169#166#170#203#166#169#204#169 + +#170#165#204#169#204#165#204#170#169#170#165#169#165#165#199#165#165#165#165 + +#165#165#165#165#165#165#165#165#165#165#165#199#165#165#203#165#165#165#199 + +#165#165'TPF'#165#195#164#165#164#165#165#161#165#165#165#165#161#165#164#165 + +#165#161#165#199#165#165#203#169#166#169#170#165#170#165#165#165#169#170#169 + +#170#169#166#203#170#169#170#169#169#204#169#165#165#165#199#166#169#204#170 + +#169#170#165#170#169#169#170#170#165#170#203#166#170#169#199#170#165#165#198 + +#165#165#165#165#170#165#204#170#165#204#169#200#170#199#170#165#170#203#165 + +#170#169#166#169#170#203#170#165#166#169#170#169#166#203#170#169#199#165#165 + +#165#165#199#165#165#199#165#165#199#165#165#199#165#165#165#165#165#165#165 + +#165#165#199#165#169#165#169#255#0#0#164#165#165#161#165#160#199#164#165#165 + +#165#199#165#164#161#164#165#164#165#165#165#169#166#169#204#169#166#203#170 + +#203#165#165#199#170#200#169#170#169#170#165#204#169#200#170#165#170#169#165 + +#165#165#169#170#165#170#204#165#204#169#200#170#203#170#169#170#166#169#203 + +#170#170#169#199#165#165#165#165#199#170#203#170#169#166#170#169#170#169#170 + +#169#170#204#169#170#170#203#170#203#170#199#170#169#170#203#170#165#170#203 + +#170#169#170#170#169#170#165#169#165#165#165#169#165#165#165#165#165#165#165 + +#165#199#165#165#165#165#165#165#165#165#165#165#204#0#0#0#165#161#164#165 + +#164#165#165#165#160#199#165#165#164#161#165#199#160#165#195#165#165#166#203 + +#170#165#170#203#170#165#170#165#165#170#169#169#170#203#166#169#204#170#169 + +#170#169#170#203#166#199#165#165#199#169#204#169#169#170#170#169#170#169#166 + ,#169#200#169#203#170#170#166#203#165#165#165#165#165#165#170#169#170#165#170 + +#203#169#204#165#170#169#200#169#170#165#204#169#166#169#166#169#170#169#200 + +#169#166#169#204#169#166#170#199#170#199#170#199#165#165#165#165#199#165#165 + +#165#165#165#165#165#165#165#165#165#165#199#165#165#199#165#169#199#170#169 + +#255#0#0#165#164#161#164#195#164#161#164#165#165#165#165#165#165#164#165#165 + +#164#165#165#199#169#170#169#204#169#166#169#170#169#204#165#165#204#170#165 + +#170#203#170#170#169#166#169#204#169#166#169#165#165#165#165#165#169#204#166 + +#169#199#170#165#170#203#170#169#170#170#199#169#169#165#165#165#164#165#165 + +#203#169#166#169#204#169#170#166#170#169#204#169#170#169#203#170#169#170#169 + +#204#169#170#199#170#169#170#203#170#166#169#204#169#170#169#170#169#170#169 + +#199#169#165#165#165#199#165#165#199#165#165#199#165#165#165#165#165#165#165 + +#165#165#165#165#169#165#0#0#0#165#165#199#165#165#165#165#165#160#165#199 + +#165#164#161#165#160#165#161#164#165#169#165#203#166#169#170#203#170#199#170 + +#169#165#169#165#170#203#170#166#169#199#170#203#170#165#170#203#170#169#165 + +#165#165#165#165#169#204#170#170#170#203#170#165#204#170#165#170#170#204#165 + +#165#164#199#165#165#165#165#170#203#170#165#204#169#169#204#165#170#165#204 + +#166#169#170#166#203#166#169#204#169#170#165#204#169#166#169#203#166#169#166 + +#203#170#165#204#169#166#169#165#166#169#165#165#165#165#165#165#165#165#165 + +#165#199#165#165#165#165#165#199#165#170#199#170#255#0#0#164#161#164#161#164 + +#161#198#161#165#165#165#165#165#199#164#165#165#164#165#165#165#165#170#169 + +#204#165#170#169#170#169#200#169#165#170#203#166#169#203#170#170#169#170#165 + +#204#169#166#170#165#204#165#165#199#165#165#169#165#169#203#166#169#170#169 + +#169#204#169#169#165#165#199#165#165#165#165#165#169#200#170#169#170#169#166 + +#170#169#170#203#170#169#170#204#165#204#169#170#169#166#170#203#170#169#170 + +#203#170#170#169#204#169#170#165#169#170#165#204#169#200#169#199#165#165#169 + +#165#165#165#165#165#165#165#165#165#165#199#165#165#169#170#169#170#169#0#0 + +#0#165#165#165#164#165#165#165#164#198#165#165#165#165#164#161#165#194#165 + +#161#198#165#169#204#165#170#170#169#170#199#170#169#165#199#170#169#170#169 + +#166#170#203#166#169#204#169#170#203#169#204#169#165#165#165#165#165#169#204 + +#170#166#170#169#200#170#200#169#165#199#165#164#165#165#165#165#165#204#170 + +#169#169#170#200#169#204#169#204#165#170#165#204#165#169#170#169#170#199#170 + +#203#169#166#169#170#199#170#169#199#170#170#165#170#203#166#203#170#169#166 + +#169#165#169#165#170#199#165#165#199#165#165#199#165#165#165#165#165#170#165 + +#169#200#169#204#165#255#0#0#164#161#164#165#195#164#161#165#161#164#165#199 + +#165#165#164#165#165#164#165#165#165#165#169#170#203#169#200#169#170#166#203 + +#165#169#200#170#165#204#170#169#170#169#170#165#170#165#170#170#169#166#169 + +#165#165#165#199#165#165#203#169#203#170#169#169#169#165#165#165#165#165#165 + +#165#165#203#169#170#165#170#200#170#169#170#169#166#169#204#169#170#169#170 + +#170#169#200#169#170#169#166#170#169#204#169#170#169#170#170#170#169#204#169 + +#170#169#170#165#170#203#170#169#166#204#169#170#165#169#165#165#165#165#165 + +#169#199#169#165#169#204#170#169#166#169#170#0#0#0#165#199#161#164#165#165 + +#164#165#165#165#165#165#165#161#165#160#165#161#164#165#165#199#165#170#166 + +#170#169#204#169#169#170#165#165#169#203#170#169#199#170#199#170#203#170#203 + +#170#203#166#169#204#166#203#165#165#165#165#165#165#165#165#165#199#165#165 + +#199#165#165#165#199#165#165#165#166#203#169#204#169#169#203#166#203#170#169 + +#170#165#204#169#200#169#204#169#170#204#165#170#203#170#165#170#165#204#166 + +#203#166#203#166#169#166#203#166#169#204#169#166#169#204#169#170#165#170#203 + +#166#169#199#170#169#165#165#170#165#204#165#165#203#170#169#200#169#255#0#0 + +#164#165#164#165#161#164#195#164#165#160#165#203#165#165#198#165#165#198#165 + +#161#165#165#170#169#203#169#166#169#166#204#169#199#165#165#170#169#170#170 + +#169#170#169#166#169#170#169#166#169#170#169#170#169#170#165#169#165#199#165 + +#165#199#165#165#165#165#165#165#165#165#165#165#165#170#169#166#170#169#170 + +#170#170#169#170#165#204#169#170#169#170#169#170#165#170#169#170#170#169#166 + +#169#204#170#169#170#169#170#169#170#169#204#169#170#169#170#165#170#203#170 + +#165#170#203#170#203#166#169#203#166#169#200#169#169#165#169#165#169#165#170 + +#165#170#169#170#0#0#0#165#161#165#161#164#165#165#165#160#199#165#165#165 + +#164#161#165#160#165#161#164#165#165#203#170#166#170#170#203#170#169#165#165 + +#165#169#170#199#170#165#204#169#170#203#170#165#204#169#204#169#200#169#170 + +#199#170#199#165#165#165#165#165#165#165#165#165#165#165#165#165#165#169#204 + +#169#204#169#170#199#170#199#169#166#203#170#169#166#203#166#169#200#169#170 + +#203#166#169#199#170#203#170#169#169#200#169#170#199#170#203#166#169#170#165 + +#204#165#204#169#166#169#204#169#170#165#170#169#170#166#169#166#169#170#199 + +#170#199#169#166#203#165#170#203#170#165#255#0#0#165#164#165#164#199#165#160 + +#165#165#164#165#165#165#165#165#164#165#164#165#165#199#165#165#203#169#203 + ,#165#169#165#165#165#165#165#199#169#170#203#170#169#200#169#166#169#170#169 + +#170#165#170#169#170#169#170#170#169#170#170#165#169#165#165#165#165#199#165 + +#165#165#200#169#166#169#170#165#170#169#170#169#170#204#169#170#165#204#169 + +#170#169#170#169#204#165#170#203#170#170#169#170#203#166#170#169#170#169#170 + +#169#170#169#204#169#170#169#170#169#170#203#170#170#165#170#203#170#166#204 + +#169#204#169#204#169#170#165#169#166#169#170#203#170#165#204#170'L'#18#20#160 + +#165#195#165#160#165#165#160#165#161#165#165#199#160#165#161#165#161#164#165 + +#165#165#165#165#165#165#165#199#165#199#165#165#165#165#170#165#170#169#170 + +#169#170#203#170#203#166#203#170#169#200#169#200#169#203#166#169#204#169#166 + +#169#199#169#166#169#166#203#170#169#170#203#166#169#204#169#200#169#166#169 + +#170#165#204#169#166#203#170#200#169#166#169#170#165#170#203#166#169#166#170 + +#203#169#200#169#200#169#170#199#170#165#170#199#170#169#200#169#166#169#169 + +#204#169#166#203#169#165#170#169#166#169#166#203#169#166#203#170#165#170#169 + +#170#165#169#255'(\'#165#164#165#164#165#165#164#199#164#165#198#165#165#165 + +#164#199#164#165#199#160#165#165#165#165#165#165#170#169#170#165#170#203#165 + +#165#203#170#169#200#170#203#170#165#170#166#169#170#165#170#169#170#169#170 + +#170#169#170#169#166#169#204#170#166#203#170#169#170#165#204#169#170#169#170 + +#165#170#169#170#203#170#169#170#169#170#169#170#169#170#170#203#170#203#170 + +#169#170#169#204#169#170#166#170#169#170#169#170#165#170#169#204#169#170#169 + +#170#169#170#203#170#200#169#170#169#170#170#204#169#170#203#170#170#169#166 + +#169#165#170#204#169#200#169#170#170'L'#18#20#165#161#165#161#165#198#161#165 + +#161#164#161#165#165#164#161#164#161#165#160#165#199#165#165#203#166#169#199 + +#170#165#204#169#166#165#165#170#165#204#169#169#166#169#170#203#169#170#203 + +#170#203#170#204#169#200#169#204#165#204#169#204#166#169#169#170#169#166#203 + +#170#169#166#203#166#204#169#170#203#170#165#170#199#170#203#166#204#169#166 + +#203#169#166#169#166#169#170#199#170#169#166#203#170#169#204#169#166#203#170 + +#203#170#165#170#199#170#200#169#204#165#170#169#170#203#166#204#165#169#170 + +#199#170#169#199#170#199#169#170#199#169#165#170#169#204#169#255#176'2'#164 + +#199#164#165#160#165#165#164#165#165#164#165#199#165#165#165#164#165#165#164 + +#165#165#165#169#203#170#170#169#170#169#170#169#165#165#203#170#169#166#170 + +#169#204#169#170#170#170#165#170#169#170#165#170#169#166#169#170#169#166#170 + +#169#170#204#165#204#169#170#165#204#169#170#169#170#199#170#166#169#204#169 + +#170#166#169#170#169#170#169#170#170#203#170#169#204#169#170#165#204#169#170 + +#203#170#165#204#169#170#169#166#169#204#169#170#170#169#170#169#170#170#203 + +#166#170#169#169#170#204#169#170#165#170#170#169#170#165#170#169#166#169#204 + +#170#165#170'E'#205'5'#165#160#165#165#165#164#161#165#160#165#165#165#165 + +#165#164#199#161#164#161#165#165#165#165#166#170#165#203#170#199#170#199#170 + +#203#165#165#170#203#169#204#166#169#200#169#199#170#203#170#166#203#170#203 + +#170#169#204#165#204#169#169#200#169#170#169#170#166#203#170#169#166#203#170 + +#169#170#169#204#169#166#203#169#169#204#165#170#199#170#199#170#165#204#170 + +#165#170#203#170#169#166#169#166#169#170#165#170#165#204#169#166#169#166#203 + +#169#200#169#166#203#169#170#169#204#166#169#169#166#169#204#170#203#166#169 + +#204#169#199#170#169#165#165#169#204#169#255#145'9'#165#165#164#195#164#161 + +#199#164#165#199#160#165#165#165#165#165#164#165#199#164#161#199#165#203#169 + +#170#170#169#170#170#169#170#165#165#165#169#166#170#169#169#170#169#170#170 + +#169#166#169#170#170#165#170#165#170#169#170#169#166#170#169#170#199#170#169 + +#170#170#165#170#203#170#165#204#169#170#165#170#170#170#166#170#169#170#203 + +#170#169#170#169#170#169#170#204#169#166#169#204#169#204#169#204#169#170#203 + +#170#169#166#203#170#169#170#170#169#170#169#170#166#203#170#169#170#204#166 + +#203#170#165#170#169#170#170#165#170#165#169#200#169#204#170#165#170'3'#181 + +#16#165#160#165#165#165#165#164#165#165#160#165#165#165#199#165#160#165#161 + +#164#161#164#165#165#169#170#200#169#166#203#169#166#203#165#165#203#170#204 + +#169#170#204#166#169#204#165#170#203#170#199#169#204#169#204#169#204#166#169 + +#204#169#200#169#170#169#204#165#203#170#203#166#169#170#169#166#169#204#169 + +#199#169#203#169#200#169#170#165#170#169#200#169#200#169#165#170#203#170#165 + +#170#165#170#169#166#203#170#165#204#169#170#169#166#203#165#170#203#166#204 + +#169#170#165#170#199#169#169#170#169#170#169#200#169#199#170#169#199#170#165 + +#169#170#165#203#170#255#145'9'#165#165#164#161#164#161#165#160#165#165#164 + +#195#165#165#165#165#164#165#165#165#164#165#165#199#170#169#204#169#170#204 + +#169#170#169#165#165#170#165#204#165#170#203#170#169#170#169#166#169#170#170 + +#169#170#170#165#170#169#170#165#170#169#204#169#166#169#170#170#170#169#170 + +#169#199#170#203#166#169#170#170#170#170#170#169#170#203#170#203#170#169#170 + +#169#170#204#170#165#170#203#170#169#170#203#169#170#169#170#169#166#169#204 + +#170#170#170#169#170#169#169#166#169#204#169#170#170#170#199#170#199#170#169 + ,#170#170#169#166#169#165#169#165#204#169#166#169'L'#18#20#160#165#199#165#165 + +#198#165#165#160#165#165#164#165#169#165#195#165#164#195#165#161#165#165#165 + +#169#166#169#170#169#166#169#204#166#203#165#169#170#169#170#169#170#165#204 + +#169#204#169#170#199#170#169#200#169#170#203#166#203#170#169#170#165#170#203 + +#170#199#169#166#203#166#170#169#170#170#169#204#165#169#203#165#204#170#165 + +#170#166#169#166#204#169#166#169#169#170#203#170#166#169#199#170#166#170#200 + +#169#200#169#204#169#165#169#203#166#203#166#170#204#169#166#169#170#199#169 + +#170#169#170#169#200#169#165#204#169#203#170#203#166#169#165#170#203#170#255 + +'zB'#165#165#160#165#160#165#161#164#199#165#160#165#165#199#165#164#165#161 + +#164#165#164#199#165#165#204#169#204#165#204#169#170#169#170#165#165#200#169 + +#204#165#204#165#204#169#166#169#170#203#170#169#200#169#170#199#170#169#170 + +#165#204#165#204#169#166#169#170#170#203#170#169#204#166#169#169#200#169#170 + +#204#170#170#169#165#204#169#169#170#203#169#170#203#170#200#169#166#169#204 + +#170#170#169#203#169#169#170#169#170#169#166#204#170#170#169#170#169#203#165 + +#170#203#170#169#170#170#199#170#169#170#169#170#204#169#166#170#169#170#169 + +#199#170#165#165#169'2'#165#6#165#160#165#164#165#165#164#165#161#164#165#165 + +#164#165#165#161#165#164#165#164#161#165#165#165#169#170#165#170#169#170#169 + +#204#165#169#165#169#170#169#170#169#170#169#170#169#204#165#170#169#170#169 + +#170#169#170#169#170#169#204#169#170#169#170#170#169#204#169#166#169#170#169 + +#169#204#166#170#169#170#169#169#165#170#170#170#169#200#170#169#166#170#165 + +#170#169#170#169#170#169#169#199#170#170#166#170#170#199#170#166#170#169#169 + +#199#170#169#166#170#170#170#169#170#165#166#169#169#170#165#166#165#170#165 + +#169#170#165#166#170#165#170#165#165#165#170#255'y?'#165#165#165#161#164#161 + +#165#164#165#161#164#161#165#165#165#164#165#165#161#165#164#165#165#165#165 + +#169#170#203#170#165#166#169#170#199#165#165#165#166#170#203#170#165#166#165 + +#170#170#165#170#165#166#169#204#165#170#165#166#169#170#169#166#165#165#166 + +#169#170#169#166#165#166#170#170#169#129#166#165#166#204#170#165#165#165#170 + +#170#169#166#129#165#170#204#169#166#165#165#166#170#170#165#129#165#165#169 + +#170#165#129#165#166#170#170#165#166#129#165#165#203#166#165#165#165#170#170 + +#165#165'}'#165#170#170#166#129#129#129#165#203#165#129#161#129#165'?'#234'3' + +#160#165#164#165#161'|'#161#161#164#165#165'|'#161#160#165#165#160'}|'#161 + +#165#164#165'}}'#165#170#169#170#165#129#166#169#170#165#165#129#129#165#170 + +#165#247#129#129#169#204#170#165'}'#129#166#169#170#165'}'#129#166#165#170 + +#165#247#129#165#166#169#166#129'}'#165#165#169#166#129#129#165#169#169#166 + +#129#247#165#165#169#166#129#247#165#165#169#170#129#247#129#165#203#169#130 + +#129#247#165#204#169#130#129#129#165#169#170#165#129#129#165#170#169#170#129 + +#247#165#165#204#166#129#129#165#165#203#170#165#130#165#165#166#169#165#247 + +#165#165#255#145'9}'#160#165#164'}|}'#160#165#164#161'}|'#161#169#165#161'|}' + +#160#165#161#161#129'}'#165#165#170#165#130#129#165#170#165#165'}'#129#165 + +#166#169#170#165#129#166#165#170#169#165#247#165#165#170#169#166#129#129#165 + +#170#170#165#129#165#165#170#169#166#165#247#165#166#170#165#130#165#166#170 + +#170#169#166#129#165#170#204#169#165#165#165#166#170#165#165#165#165#166#170 + +#170#165#165#165#165#165#169#165#165#165#165#170#169#166#165#165#166#165#170 + +#199#166#165#165#166#169#170#165#166#165#170#170#169#166#165#165#170#169#170 + +#165#165#165#165'3'#181#16#160#161#165#161#160#161#160#165#161#199#160#161 + +#160#161#165#165#165#160#161#160#165#164#165#165'}'#165#170#203#170#165#165 + +#166#169#204#165#165#165#165#170#203#166#169#166#165#203#170#169#166#165#165 + +#170#165#204#165#166#165#166#169#203#166#165#166#170#165#204#169#165#165#169 + +#169#169#169#165#165#165#203#165#203#165#165#165#165#169#165#170#165#170#169 + +#169#204#170#165#170#203#165#165#199#165#165#165#165#165#199#165#165#165#165 + +#199#169#169#166#169#203#170#169#170#169#166#203#170#165#204#169#170#203#169 + +#166#203#170#169#166#203#166#203#166#169#165#255#145'9'#165#165#164#199#165 + +#164#165#165#164#165#165#164#165#165#164#165#194#165#161#165#161#165#164#199 + +#165#166#169#166#203#170#170#203#166#169#169#165#170#165#170#170#203#170#169 + +#170#170#203#166#169#170#170#203#170#169#170#169#170#203#170#170#169#204#169 + +#203#170#169#165#165#165#199#165#199#165#165#199#165#165#165#165#165#199#165 + +#165#165#199#165#169#170#204#166#169#165#170#165#165#165#165#165#165#164#199 + +#165#165#165#165#165#199#165#165#165#165#203#170#170#165#170#199#170#169#170 + +#203#170#169#200#169#166#170#170#169#166#203#170#169#170#169#165#203#165'CU' + +#19#160#199#161#164#161#165#194#165#161#164#161#165#160#165#195#164#165#164 + +#165#164#165#195#165#165#169#199#170#169#170#203#170#169#165#165#165#165#203 + +#170#203#165#170#199#170#169#166#169#170#203#165#170#170#199#170#169#204#165 + +#170#169#204#165#170#170#169#200#169#165#199#165#165#165#165#165#165#164#165 + +#165#165#165#165#165#165#199#165#165#169#200#169#169#170#204#169#199#165#165 + ,#164#199#164#165#165#165#165#165#165#199#165#165#165#165#199#165#165#199#169 + +#204#169#170#169#204#165#170#165#170#169#170#203#165#169#199#169#166#169#166 + +#203#166#169#165#165#255'zB'#165#165#164#165#165#164#165#165#164#199#165#164 + +#165#165#164#165#161#165#199#165#164#165#164#161#165#165#169#199#165#165#165 + +#165#203#166#199#165#165#165#170#170#169#170#169#204#169#204#169#170#170#203 + +#170#170#169#166#169#170#203#166#169#170#203#166#170#170#169#165#165#165#170 + +#165#166#165#199#165#165#199#165#165#169#165#165#170#165#169#166#169#170#200 + +#169#165#165#165#164#199#165#165#165#165#165#165#165#165#165#165#165#165#165 + +#165#165#165#165#165#169#165#170#203#166#169#170#203#170#203#166#203#170#170 + +#204#170#169#203#170#203#170#169#199#165#165'5-3'#165#160#165#161#198#161#165 + +#160#165#161#164#161#165#160#165#161#164#165#165#165#161#164#161#165#199#165 + +#165#165#165#165#199#170#165#169#169#165#199#169#170#203#170#199#170#165#170 + +#169#166#204#169#166#169#199#170#203#170#199#170#169#204#165#170#169#169#203 + +#166#170#169#170#203#170#203#165#165#165#164#165#165#169#200#169#204#169#169 + +#204#169#204#169#169#165#165#164#165#165#165#165#165#165#165#165#199#169#200 + +#169#170#165#170#199#165#165#165#165#165#165#199#169#165#170#203#170#169#166 + +#169#170#169#170#165#169#165#169#166#169#165#169#165#165#165#165#255#145'9' + +#165#165#164#165#165#164#165#165#164#165#165#164#199#165#164#165#199#164#165 + +#165#164#199#165#164#165#165#199#170#169#170#170#169#170#204#170#169#165#165 + +#169#166#169#170#169#204#170#203#170#169#204#169#170#170#169#166#169#170#169 + +#166#169#170#203#166#170#170#203#169#204#165#170#165#170#169#165#165#165#165 + +#199#170#169#166#169#204#166#170#169#166#165#165#199#165#165#199#165#165#165 + +#165#165#203#170#165#170#169#166#169#204#169#166#169#170#165#199#165#165#165 + +#165#203#170#170#165#170#169#204#169#166#169#204#170#170#204#169#165#165#199 + +#165#165#164#165'3'#181#16#164#161#199#160#165#161#164#161#199#160#165#161 + +#164#161#165#160#165#161#164#161#165#160#165#165#165#165#165#165#204#165#203 + +#170#165#169#166#204#165#165#203#170#169#200#170#169#165#170#169#166#169#166 + +#203#170#169#204#170#165#204#169#204#165#170#169#203#166#170#165#170#169#204 + +#169#204#165#165#165#165#165#165#169#204#169#166#169#169#200#169#169#199#165 + +#164#165#165#165#165#165#170#199#170#165#170#203#165#170#203#170#165#204#169 + +#166#203#170#165#165#165#165#165#165#165#203#170#200#169#170#170#203#170#169 + +#199#169#166#169#199#165#165#165#165#165#165#255#145'9'#165#165#164#165#165 + +#164#199#165#164#165#165#164#165#165#198#165#164#165#165#198#165#165#164#195 + +#164#165#165#170#169#170#170#169#204#170#203#169#165#165#170#165#204#169#170 + +#204#170#169#204#169#204#169#170#165#204#165#170#170#169#166#169#170#169#200 + +#170#169#204#170#170#203#166#170#165#170#165#199#165#165#169#166#169#166#203 + +#170#170#169#170#199#165#165#165#165#165#165#165#165#204#169#170#203#170#165 + +#170#165#170#169#170#169#170#169#170#169#170#203#165#165#165#165#199#165#169 + +#169#170#165#203#166#169#166#170#170#203#165#165#165#164#165#199#165#165'CU' + +#19#165#160#165#161#164#161#165#160#165#161#164#161#165#164#161#165#161#165 + +#160#165#161#164#161#165#165#199#165#170#203#166#169#200#169#169#166#170#165 + +#165#203#170#169#166#169#169#165#204#165#170#169#166#203#170#169#170#169#199 + +#170#203#170#204#169#170#169#170#165#169#199#170#169#169#170#203#165#165#164 + +#165#199#169#204#169#170#165#169#204#165#165#165#165#165#199#165#165#203#170 + +#169#166#169#166#169#170#169#204#169#204#165#204#165#204#169#200#169#170#165 + +#203#165#165#165#165#169#170#200#169#170#170#203#170#203#169#165#165#165#165 + +#165#165#165#165#165#255'zB'#165#165#164#165#199#164#165#165#164#165#165#198 + +#161#165#164#165#164#199#165#164#165#165#164#165#164#165#199#169#170#169#170 + +#169#170#170#169#203#170#165#165#170#170#203#166#204#170#169#170#169#204#169 + +#170#165#170#203#170#170#169#170#170#165#204#165#204#169#204#170#170#165#170 + +#204#169#165#165#165#165#165#169#166#169#166#169#204#166#169#165#164#165#165 + +#165#165#170#169#170#165#204#169#204#170#169#204#165#170#165#170#169#170#169 + +#166#169#170#199#170#169#170#165#165#165#165#199#169#169#204#170#169#166#169 + +#165#165#165#198#165#165#199#165#165#169#165'E'#205'5'#164#161#165#160#165 + +#161#164#161#165#194#165#165#164#161#199#160#165#160#165#161#164#161#199#161 + +#165#165#165#165#199#170#203#166#169#200#170#165#203#165#165#199#169#170#169 + +#169#166#204#169#166#169#200#169#204#169#166#169#204#169#200#169#170#169#170 + +#169#166#169#203#170#204#169#166#204#169#165#165#165#165#199#169#170#203#170 + +#169#203#165#165#165#199#165#165#165#165#203#166#169#169#166#169#203#166#169 + +#170#203#170#165#204#169#204#169#166#169#170#203#166#203#170#165#199#165#165 + +#165#170#169#165#204#169#165#165#199#165#165#165#165#165#165#165#204#170#255 + +'(\'#165#165#198#165#165#164#165#199#164#165#165#160#165#165#164#165#165#165 + +#165#198#165#164#165#164#165#164#165#165#170#169#170#169#204#169#170#170#170 + +#165#169#165#170#199#170#170#169#170#170#203#170#169#170#169#166#203#170#165 + ,#170#169#170#203#170#165#204#169#170#170#165#170#169#170#169#170#199#165#165 + +#165#165#170#203#166#169#166#165#165#199#164#165#165#165#204#169#166#169#204 + +#166#169#170#166#169#204#165#170#169#170#170#165#170#169#204#169#165#170#169 + +#170#165#169#165#165#165#199#169#200#170#169#165#199#165#164#165#165#165#165 + +#169#165#170#165#169'L'#18#20#165#160#165#161#164#161#165#160#165#161#164#165 + +#165#164#161#165#160#165#160#165#161#165#160#165#161#165#165#199#169#170#199 + +#170#169#166#203#169#199#170#165#199#169#170#169#199#170#199#169#166#169#170 + +#165#204#169#170#169#170#169#200#169#166#169#204#170#169#166#203#170#169#204 + +#165#204#165#165#165#198#165#199#169#166#169#170#203#165#165#165#165#165#165 + +#169#166#169#204#169#166#169#203#170#203#170#169#170#203#170#199#169#170#203 + +#166#169#166#203#170#165#204#169#204#165#165#165#165#165#169#169#199#165#165 + +#165#165#165#165#165#203#166#203#170#203#170#255'zB'#165#165#164#165#165#198 + +#165#165#164#165#161#164#195#165#164#165#165#198#165#164#165#164#165#164#165 + +#198#165#165#170#169#170#169#204#169#170#170#170#169#165#165#165#204#170#170 + +#169#170#170#204#169#204#170#169#170#199#170#199#170#169#170#203#170#170#165 + +#204#169#170#169#166#169#170#169#204#165#165#165#165#165#170#169#204#170#165 + +#165#164#165#165#165#165#204#169#170#165#170#203#170#170#165#170#169#166#169 + +#166#169#170#166#169#170#203#170#169#166#169#170#169#166#169#166#165#165#165 + +#199#165#165#165#164#165#165#165#199#169#166#169#170#165#170#165#170'E'#205 + +'5'#164#161#165#160#165#161#164#161#165#164#199#165#164#165#161#198#161#165 + +#161#165#161#165#161#199#160#165#165#165#199#170#199#170#165#170#203#165#170 + +#204#165#165#169#165#204#169#204#165#169#169#166#169#170#199#170#170#169#170 + +#169#200#169#170#165#203#170#169#200#169#204#169#204#165#170#169#165#165#165 + +#165#169#199#170#169#169#199#165#199#165#165#199#165#169#204#169#204#165#170 + +#165#204#169#166#203#170#203#170#165#169#204#169#166#169#166#203#170#199#170 + +#203#170#169#203#169#165#165#165#165#199#165#165#165#165#165#165#165#203#170 + +#199#170#169#204#169#255'bH'#165#165#198#165#165#164#165#199#164#161#165#160 + +#165#161#164#165#164#165#164#165#198#165#164#165#165#165#164#165#165#169#170 + +#169#204#169#166#170#169#170#165#169#165#170#169#170#169#170#204#170#169#170 + +#203#170#169#204#169#166#169#170#169#204#170#170#165#170#169#170#165#170#169 + +#170#203#170#199#165#165#165#165#169#170#204#166#165#165#165#165#165#165#165 + +#170#165#170#169#170#169#204#169#170#203#170#165#170#165#203#166#169#166#203 + +#170#203#170#165#170#169#170#165#199#166#165#199#165#165#165#164#165#199#165 + +#165#169#166#169#166#169#166#169#166#169#170'E'#205'5'#165#160#165#161#164 + +#161#165#164#161#165#164#165#165#164#165#165#161#164#161#165#161#164#195#165 + +#161#164#195#165#165#169#204#165#170#169#170#203#170#199#169#199#165#203#170 + +#165#204#170#165#169#200#169#166#169#204#165#170#203#170#204#165#170#165#169 + +#170#203#166#203#170#169#204#169#166#169#165#165#165#199#165#204#165#169#169 + +#165#165#164#165#165#169#204#169#170#169#200#169#204#165#170#165#170#165#170 + +#203#169#170#169#204#169#170#169#166#169#170#169#200#165#169#170#169#169#165 + +#165#164#165#165#165#165#165#203#166#203#170#169#204#169#204#169#204#165#255 + +#176'2'#165#165#164#165#165#198#161#165#164#165#161#164#161#199#160#165#164 + +#165#199#164#165#165#164#165#164#165#164#165#199#165#170#170#169#200#170#165 + +#169#170#170#165#165#165#204#169#170#169#204#170#169#170#203#170#169#170#169 + +#166#170#169#170#203#170#204#165#170#169#170#169#170#166#169#204#169#165#165 + +#165#165#165#169#170#170#199#165#165#165#165#199#165#170#169#200#169#170#169 + +#170#169#204#169#204#169#170#170#166#203#166#169#166#169#170#203#170#199#170 + +#169#170#199#170#199#165#165#165#199#165#165#165#169#165#165#169#170#165#170 + +#165#170#165#170#169#170'E'#205'5'#164#161#165#160#165#165#164#161#165#164 + +#165#199#164#165#165#165#195#164#161#165#160#165#161#164#161#165#161#165#165 + +#165#203#170#169#169#204#170#170#199#170#169#165#165#169#166#203#166#169#170 + +#199#170#170#165#204#165#204#169#203#166#169#170#165#170#203#170#170#203#166 + +#203#169#170#165#170#199#165#164#165#165#165#203#170#165#165#165#199#165#165 + +#170#203#166#169#170#199#170#165#170#165#170#166#169#199#169#170#170#169#204 + +#169#200#169#166#170#169#166#203#170#169#165#165#165#199#165#165#165#165#199 + +#165#170#165#203#170#203#165#170#203#170#165#204#169#255#145'9'#165#165#198 + +#165#165#160#165#199#164#161#165#160#165#160#165#160#165#165#165#164#199#165 + +#164#165#199#164#165#164#165#165#169#166#204#170#169#169#165#169#165#199#165 + +#165#204#169#170#169#204#169#170#169#204#170#169#170#169#166#170#169#204#169 + +#170#169#170#165#204#166#169#170#166#203#170#170#165#165#199#165#165#199#170 + +#169#199#165#164#165#165#165#169#166#169#203#165#170#169#204#169#170#169#203 + +#170#170#170#199#169#166#169#166#169#170#203#169#165#169#165#169#199#165#165 + +#164#165#164#165#165#165#165#169#200#169#166#165#169#170#199#170#169#170#169 + +#166'L'#18#20#165#160#165#161#164#165#165#164#161#199#164#165#165#165#164#165 + ,#165#165#160#165#161#164#161#165#160#165#161#199#165#165#199#169#169#165#165 + +#199#165#199#169#165#165#165#169#170#165#204#165#170#203#170#165#169#204#166 + +#169#204#169#200#169#166#203#166#203#170#169#169#170#204#169#169#170#203#165 + +#165#165#165#165#169#170#169#165#165#165#165#165#203#165#204#169#166#165#170 + +#203#170#165#204#169#166#170#203#165#165#170#203#170#169#203#166#169#170#199 + +#170#199#165#165#164#165#165#165#165#165#164#199#165#169#170#169#165#169#200 + +#169#170#169#170#199#170#203#255'zB'#165#165#164#165#161#198#161#165#164#165 + +#161#165#194#165#161#198#161#164#199#164#165#165#198#165#165#164#165#160#165 + +#165#165#165#199#165#169#165#165#170#165#170#169#165#165#204#170#169#170#169 + +#166#169#204#170#169#169#170#165#170#169#170#169#170#169#170#203#170#204#170 + +#165#170#200#169#166#169#165#165#165#165#199#170#199#165#165#199#165#165#165 + +#170#165#169#165#203#165#165#170#170#165#170#203#165#170#169#199#169#166#169 + +#166#170#170#203#166#169#165#165#165#165#165#199#165#165#199#165#165#165#165 + +#204#169#170#200#169#170#169#170#199#170#169#170#170'L'#18#20#164#161#165#164 + +#165#165#164#161#165#164#165#165#165#164#165#165#164#161#165#165#160#165#161 + +#164#161#165#164#165#164#165#165#165#165#165#199#170#165#170#203#166#169#203 + +#165#165#169#204#165#204#169#170#165#170#200#169#204#170#169#200#169#204#169 + +#166#169#166#169#165#203#170#169#170#169#204#165#199#164#165#165#169#170#169 + +#165#165#165#165#169#199#169#165#199#165#165#169#165#203#165#203#165#170#203 + +#165#165#169#165#203#165#203#165#169#170#169#199#165#165#164#165#165#165#165 + +#165#165#165#165#165#165#165#200#169#169#166#203#166#169#170#165#204#165#169 + +#255'y?'#165#165#198#161#165#160#165#199#164#161#164#161#164#161#165#160#165 + +#165#164#161#165#165#164#165#165#198#161#165#161#199#165#165#169#170#169#170 + +#203#170#169#170#204#165#165#169#165#170#170#169#166#203#170#169#170#170#165 + +#170#204#169#170#165#170#203#170#203#170#170#170#169#204#165#170#169#165#165 + +#165#165#165#165#170#199#165#165#164#165#165#165#165#165#165#165#165#199#165 + +#165#165#165#170#165#170#165#169#165#165#169#165#170#170#203#165#165#165#164 + +#199#165#165#165#165#169#170#165#165#198#165#165#169#169#170#204#169#170#169 + +#204#165#170#169#170#204'&'#159#4#165#160#165#165#164#165#165#164#161#165#199 + +#164#165#165#164#165#165#198#161#165#165#164#195#165#160#165#165#165#164#165 + +#165#165#203#166#170#200#169#170#199#170#169#166#169#199#170#203#165#170#203 + +#170#169#204#165#169#204#169#169#166#169#204#169#166#170#169#166#169#199#170 + +#165#170#169#200#169#165#165#165#199#169#204#169#165#165#165#199#165#169#199 + +#165#165#165#165#169#165#165#169#169#199#169#165#203#166#199#165#165#166#203 + +#165#165#165#165#165#165#165#165#199#165#170#199#170#199#165#165#165#165#165 + +#204#166#169#170#199#170#165#170#203#170#170#165#255'bH'#165#165#161#164#161 + +#198#161#165#165#164#161#165#160#165#195#164#161#165#164#199#160#165#164#165 + +#165#160#165#194#165#160#165#165#165#203#169#169#170#169#170#169#204#169#166 + +#165#165#170#170#169#170#169#166#169#204#170#169#166#170#203#170#169#204#170 + +#169#170#203#170#170#169#170#203#170#169#165#165#165#165#165#165#170#165#165 + +#165#165#165#165#166#169#165#165#199#169#166#169#199#165#165#165#165#169#165 + +#169#170#169#199#169#169#165#165#165#198#165#165#165#165#169#165#169#170#169 + +#165#165#165#165#165#169#170#169#200#169#170#169#204#169#170#165#203#170'L' + +#18#20#165#164#165#165#165#165#164#161#165#165#164#165#199#164#165#165#164 + +#161#165#164#165#165#161#164#165#165#164#165#165#165#198#165#165#165#170#203 + +#166#204#169#166#169#170#203#169#165#199#169#204#165#204#169#170#165#170#203 + +#170#169#166#169#166#169#165#204#165#170#169#200#169#170#165#170#204#165#199 + +#165#165#165#203#170#169#199#165#165#165#203#165#170#203#169#165#169#199#165 + +#165#165#199#165#165#199#165#165#203#170#165#165#165#199#164#165#165#165#165 + +#199#165#170#199#170#199#170#165#165#165#165#165#199#169#170#169#170#199#170 + +#169#166#203#170#165#169#255'WM'#164#161#199#160#165#160#165#198#165#160#165 + +#161#164#161#165#160#165#165#164#161#165#160#165#165#195#164#161#165#164#161 + +#165#165#165#165#165#170#169#170#166#203#170#165#170#165#165#169#166#169#170 + +#169#166#203#170#169#166#169#203#170#203#170#204#170#169#170#203#170#169#170 + +#199#170#169#170#165#165#165#164#165#165#169#170#165#165#164#165#165#170#169 + +#165#165#165#199#165#165#164#165#165#164#161#165#165#165#165#165#199#165#165 + +#165#165#165#165#165#165#165#170#165#170#169#170#169#199#165#165#165#199#169 + +#170#199#170#169#170#169#204#169#170#165#204#170'L'#18#20#165#165#164#165#165 + +#165#165#161#164#199#165#164#165#165#164#199#165#160#199#165#164#199#165#165 + +#164#165#165#164#161#165#164#165#199#165#204#169#166#203#169#170#169#204#169 + +#204#165#165#203#170#165#204#169#170#165#170#203#170#166#170#169#166#169#169 + +#200#169#170#165#170#203#170#169#204#165#169#165#165#165#199#169#200#165#165 + +#165#165#165#199#169#165#199#165#165#164#165#165#199#165#164#165#165#164#161 + +#198#165#164#165#164#199#165#165#165#199#169#165#170#169#204#169#166#203#165 + ,#165#165#165#165#165#170#165#170#169#166#203#166#169#166#204#169#170#169#255 + +#145'9'#164#161#165#160#165#194#165#164#165#160#165#195#164#161#165#160#165 + +#165#164#161#165#160#165#160#165#160#165#165#198#165#161#164#165#169#165#170 + +#169#170#170#199#170#169#166#169#170#165#165#169#170#169#200#169#204#169#166 + +#203#170#203#170#169#204#170#169#170#169#204#165#170#165#170#169#204#165#199 + +#165#165#165#165#169#165#165#199#165#165#165#199#165#165#165#199#165#165#165 + +#160#165#165#165#199#165#165#165#165#199#165#165#165#165#165#165#170#165#170 + +#203#170#165#170#169#170#169#165#164#165#165#165#203#170#169#204#169#170#169 + +#204#170#169#170#199#170'E'#205'5'#165#164#165#165#164#165#165#161#165#165 + +#164#165#165#164#165#165#160#165#165#164#165#165#164#165#165#165#194#165#165 + +#164#165#165#165#165#169#199#170#199#170#169#166#203#170#165#203#169#165#200 + +#169#170#169#170#165#170#169#170#165#170#199#170#169#200#169#200#169#170#203 + +#170#203#166#169#170#169#165#164#165#165#165#165#203#169#165#164#165#165#169 + +#165#165#165#165#165#160#165#165#164#161#164#165#164#165#160#165#165#164#165 + +#165#165#199#165#165#204#169#166#203#170#199#170#203#165#199#165#165#199#165 + +#166#203#170#165#204#165#170#169#165#204#169#170#169#255#145'9'#165#161#198 + +#161#165#160#165#198#165#160#165#161#164#195#165#164#199#165#160#165#161#164 + +#195#165#160#165#165#165#160#165#194#165#160#165#199#169#170#169#170#203#170 + +#169#170#170#170#165#199#169#166#203#170#203#170#203#166#203#170#169#170#169 + +#166#169#170#169#170#165#170#169#170#170#203#166#165#165#165#199#165#199#169 + +#165#166#165#165#165#165#165#199#165#165#164#165#165#199#165#165#165#165#165 + +#165#165#165#165#160#165#165#165#165#170#169#170#169#166#169#170#165#170#169 + +#165#165#165#165#165#165#165#169#170#165#170#169#170#203#170#170#169#166#203 + +#170'5-3'#165#164#165#165#164#165#165#161#164#165#165#164#165#165#164#161#165 + +#160#165#199#164#165#165#164#199#165#165#160#165#165#165#165#199#165#165#169 + +#165#170#199#170#170#199#170#203#165#169#165#165#169#170#165#170#165#170#169 + +#170#169#170#199#170#203#170#169#204#170#203#170#165#204#165#169#170#203#165 + +#165#164#165#165#169#166#169#199#165#165#199#165#165#165#164#165#165#164#165 + +#164#165#165#164#165#199#160#165#164#165#165#165#165#203#170#199#170#199#170 + +#203#166#169#170#203#165#165#165#164#165#165#165#199#170#203#170#203#170#165 + +#170#165#204#169#170#165#255'zB'#165#161#164#161#165#194#165#164#165#160#199 + +#161#164#161#165#164#165#165#164#161#165#160#165#161#164#161#164#165#198#161 + +#164#161#164#165#165#165#204#169#170#170#169#170#165#170#204#170#165#165#199 + +#169#170#169#204#169#170#169#200#169#170#169#170#203#166#170#165#170#203#170 + +#169#170#204#170#165#165#165#165#165#165#170#203#170#165#165#165#164#165#165 + +#165#165#195#165#165#165#165#161#199#165#165#165#165#199#165#165#199#165#165 + +#165#169#170#169#170#165#170#169#204#165#170#165#165#165#165#199#165#169#170 + +#169#166#169#166#169#170#203#170#169#170#203#170'5-3'#164#165#165#164#165#165 + +#165#161#165#165#164#165#165#198#161#165#160#199#165#164#165#199#164#165#165 + +#198#165#161#165#165#165#164#165#165#199#169#165#170#203#165#204#169#170#169 + +#165#203#165#165#169#165#204#170#165#170#199#170#169#204#165#170#165#170#169 + +#203#170#169#166#169#204#165#169#165#204#165#164#165#165#203#165#170#169#203 + +#165#165#165#199#165#164#165#164#165#164#199#165#164#165#165#160#165#164#165 + +#164#165#164#165#165#165#204#169#200#169#170#203#166#169#170#203#165#199#165 + +#165#165#165#199#170#170#203#170#169#204#165#170#169#200#169#166#169#255'@V' + +#165#161#198#161#164#161#164#199#164#161#165#161#164#165#165#164#165#165#160 + +#165#161#164#161#165#164#161#165#164#165#160#199#165#160#165#160#165#199#165 + +#170#170#169#170#199#165#165#165#165#165#165#199#169#165#170#203#170#170#165 + +#170#169#204#169#204#170#166#169#204#169#170#170#170#204#170#169#165#165#199 + +#165#165#169#204#165#165#165#165#164#161#164#165#165#165#165#161#165#164#165 + +#165#165#165#165#165#165#161#165#165#165#165#165#169#166#169#170#165#170#169 + +#204#169#165#165#165#165#165#165#165#169#165#169#165#170#199#170#170#203#170 + +#169#170#203#170'E'#205'5'#165#164#165#165#165#164#165#161#165#164#165#164 + +#165#161#164#161#165#160#165#165#164#165#165#164#161#165#164#165#161#165#165 + +#165#165#165#165#165#165#169#165#169#199#165#165#169#165#169#199#169#165#165 + +#169#204#170#169#166#203#170#203#166#170#169#166#169#203#170#165#170#166#203 + +#165#169#169#200#165#165#164#165#165#165#165#165#170#165#165#165#165#165#161 + +#199#164#165#164#165#165#165#164#161#198#165#165#164#165#164#165#164#199#169 + +#204#169#170#203#170#203#170#170#165#165#165#164#165#165#203#166#169#204#166 + +#204#169#170#169#169#166#169#200#169#170#165#255'bH'#165#161#165#160#165#195 + +#164#165#164#195#165#161#164#165#165#165#198#165#164#165#195#164#161#199#165 + +#164#161#164#199#164#165#165#164#161#164#199#165#165#199#165#165#165#165#165 + +#204#165#170#170#165#199#165#165#169#204#169#170#165#170#169#169#170#203#170 + +#166#169#170#203#169#170#170#200#170#169#165#165#165#165#199#170#199#169#165 + ,#199#165#199#164#165#164#165#161#165#165#165#164#199#165#165#165#164#195#165 + +#165#199#161#165#165#165#170#170#165#170#165#170#199#169#199#165#165#199#165 + +#165#165#169#166#169#169#169#166#169#200#170#203#170#169#170#203#170'3'#181 + +#16#165#164#165#165#164#165#161#165#165#164#165#165#161#164#195#164#161#165 + +#161#164#165#165#164#161#165#165#199#161#164#161#164#161#165#198#161#164#165 + +#165#165#165#165#169#203#166#169#170#169#204#169#169#165#170#165#170#199#170 + +#169#204#166#204#165#170#169#204#169#165#165#165#203#169#169#170#169#199#165 + +#164#165#165#165#169#165#169#165#165#165#165#165#165#164#165#198#165#165#165 + +#160#165#165#165#165#164#161#164#165#164#165#165#165#165#204#169#204#169#170 + +#170#169#165#165#165#165#165#165#203#166#203#166#170#169#204#169#169#170#166 + +#203#170#165#170#169#255'bH'#164#161#199#160#165#165#164#165#160#165#160#199 + +#164#165#165#165#165#164#199#165#161#164#165#164#165#160#165#164#165#165#165 + +#198#165#165#165#165#165#199#165#169#203#166#170#169#204#165#204#165#170#199 + +#165#199#169#170#169#170#200#169#169#169#170#203#166#169#166#203#165#165#165 + +#165#204#166#199#165#165#161#165#165#165#165#199#165#165#165#164#161#198#165 + +#165#165#165#165#160#165#165#165#164#165#164#165#165#165#165#165#165#199#169 + +#204#169#166#169#166#203#165#165#165#165#165#165#165#169#170#169#169#169#203 + +#166#169#170#200#169#169#170#165#170#203#166'E'#205'5'#165#165#164#165#165 + +#160#165#160#165#165#165#164#165#199#160#165#160#165#160#165#164#165#195#165 + +#160#165#165#165#160#165#160#165#161#164#165#160#161#165#165#165#165#170#203 + +#166#169#170#169#170#169#170#165#165#165#169#200#169#169#170#170#204#170#170 + +#169#204#169#166#165#165#199#165#169#169#169#165#165#164#199#165#203#169#170 + +#174#203#165#165#165#165#161#165#164#165#165#169#199#165#164#165#199#161#165 + +#165#165#165#165#165#165#170#165#170#169#204#174#174#174#203#165#165#165#199 + +#169#166#203#170#170#204#170#169#204#166#169#169#204#170#174#208#170#169#255 + +#145'9'#165#164#161#164#199#169#203#169#199#164#161#165#160#165#169#169#203 + +#169#169#165#161#164#165#164#165#169#207#173#203#169#165#165#164#165#165#199 + +#169#173#211#174#207#170#169#169#200#169#204#174#246#211#174#169#199#170#169 + +#170#204#174#246#178#208#211#174#170#170#169#204#169#174#177#207#173#207#169 + +#165#165#165#165#170#211#178#208#173#207#165#164#165#164#165#203#210#173#207 + +#173#169#161#165#164#169#207#173#207#207#173#203#165#169#170#203#170#8#246 + +#208#207#173#207#165#165#166#169#208#8#246#208#8#208#170#169#169#204#170#174 + +#246#246#8#211#174'5-3'#161#165#165#169#177#207#169#207#173#169#198#165#165 + +#169#210#173#169#203#173#207#169#161#165#161#173#210#173#203#164#207#177#199 + +#161#165#165#173#210#203#169#207#174#208#170#170#169#170#179#246#174#170#208 + +#178#173#199#170#169#174#179#208#170#170#174#246#208#170#169#170#246#246#204 + +#165#199#169#207#169#160#165#165#211#174#203#165#165#207#169#195#165#165#169 + +#178#207#165#165#203#210#169#161#165#173#211#173#169#203#174#246#174#204#166 + +#169#208#211#173#165#165#203#177#208#169#169#204#175#255#174#170#199#174#246 + +#170#170#169#246#179#208#169#199#174#246#255#145'9'#164#165#160#207#173#199 + +#160#161#203#177#165#165#160#207#177#199#164#195#164#207#173#199#164#165#207 + +#173#165#160#161#199#177#173#160#164#169#210#169#164#161#165#207#178#208#165 + +#169#246#179#208#170#199#169#203#211#169#165#170#246#246#170#169#199#170#174 + +#208#170#199#170#179#174#169#165#165#199#177#203#165#165#165#178#208#165#161 + +#199#173#207#165#164#161#169#210#169#165#195#165#173#203#164#161#203#173#203 + +#165#165#199#8#246#169#169#165#173#178#203#165#165#203#178#208#169#166#169 + +#246#179#170#203#170#174#246#208#169#166#208#175#178#174#170#208#8'5-3'#165 + +#161#165#207#173#165#161#199#169#210#203#160#165#165#210#173#199#165#165#207 + +#177#164#161#165#203#177#203#169#199#169#207#207#165#161#199#169#207#169#165 + +#203#174#211#170#204#166#169#246#175#208#174#174#211#173#165#199#170#208#175 + +#246#208#174#208#246#174#165#170#169#246#246#246#174#207#174#207#165#199#164 + +#199#207#178#173#203#173#207#169#161#165#165#199#203#177#207#169#207#203#164 + +#161#165#165#173#211#173#208#178#211#174#165#199#165#199#207#177#203#203#178 + +#208#169#166#203#170#203#174#211#170#208#246#174#169#166#203#170#203#204#246 + +#246#179#246#255#145'9'#165#198#165#164#203#173#207#173#207#165#165#165#164 + +#198#165#207#169#207#207#169#199#165#164#165#160#203#173#207#173#207#173#165 + +#198#165#164#165#203#203#207#173#208#169#165#169#203#166#169#208#174#211#207 + +#169#199#165#165#199#169#204#174#174#208#174#170#204#169#170#203#170#170#208 + +#174#174#207#169#165#165#165#165#165#203#203#173#203#165#199#164#165#164#165 + +#165#199#173#207#169#165#165#165#164#165#198#165#207#170#203#169#199#164#165 + +#165#165#165#203#173#173#204#169#204#169#170#165#170#165#208#174#174#204#169 + +#204#169#170#165#170#169#170#170#204#170'CU'#19#164#165#161#165#160#199#169 + +#198#165#199#160#165#161#165#161#161#164#165#165#164#165#161#199#160#165#161 + +#160#165#198#165#199#160#165#161#165#160#165#161#165#198#165#199#165#170#169 + ,#170#204#169#165#165#165#165#165#165#165#165#169#165#204#169#170#199#169#166 + +#203#166#169#204#169#165#204#169#165#199#165#165#165#165#165#161#165#160#165 + +#164#165#165#165#165#165#165#165#165#165#199#165#165#165#199#165#165#165#161 + +#164#165#165#165#165#165#199#165#165#165#199#165#166#169#166#203#170#170#203 + +#170#165#204#169#170#166#169#204#169#170#165#204#165#203#166#169#255#145'9' + +#165#161#164#199#165#165#160#165#165#164#165#164#165#164#165#164#161#199#164 + +#165#194#165#164#165#165#164#199#164#161#165#164#165#164#165#198#165#164#165 + +#164#161#165#165#165#169#200#169#165#165#199#165#165#165#169#165#169#165#165 + +#203#165#170#203#170#170#169#170#169#170#165#170#204#169#166#204#165#169#165 + +#199#165#164#165#164#199#165#165#165#165#165#199#165#165#165#204#170#165#165 + +#165#165#165#165#165#165#165#199#165#165#165#165#165#165#165#165#165#170#169 + +#170#203#170#170#169#204#170#165#204#169#166#203#169#170#165#170#203#170#169 + +#170#170#169#204'L'#18#20#165#164#165#161#165#160#165#161#164#161#165#195#165 + +#161#164#161#165#164#165#161#165#165#165#160#165#161#165#161#165#160#165#161 + +#165#161#165#161#165#165#161#165#164#165#165#199#169#165#165#165#165#165#203 + +#166#169#204#165#199#165#169#170#170#165#170#165#204#169#200#170#203#170#165 + +#169#170#169#165#165#165#165#165#165#165#165#165#165#165#199#165#165#165#169 + +#165#169#165#165#169#165#203#166#165#165#165#165#165#165#165#165#165#165#165 + +#165#165#169#204#169#200#169#166#169#169#200#169#204#169#170#166#169#170#166 + +#170#204#170#165#170#203#166#203#170#165#255#145'9'#165#195#164#165#164#165 + +#164#199#165#164#165#164#165#164#165#199#164#161#164#165#164#161#164#165#198 + +#165#164#165#164#199#165#164#199#164#165#164#165#198#165#164#199#161#164#165 + +#165#165#199#165#165#165#169#204#165#170#170#165#165#165#165#203#170#203#170 + +#169#170#170#169#166#169#170#204#165#204#169#199#165#165#164#199#165#165#165 + +#165#165#166#169#170#165#199#165#199#165#169#199#165#165#169#170#165#203#165 + +#169#165#165#169#199#170#169#204#170#169#166#169#170#204#169#204#170#169#170 + +#165#204#169#169#204#169#203#169#165#169#204#165#170#169#166#169#170'3'#181 + +#16#164#165#161#164#161#199#161#164#161#165#160#165#161#199#160#165#165#165 + +#161#164#165#199#161#165#161#164#161#165#161#164#161#165#160#165#165#161#164 + +#161#165#161#164#165#165#165#165#165#165#165#204#169#166#169#170#203#165#170 + +#165#199#165#169#166#170#203#166#203#165#170#203#170#165#170#169#170#165#165 + +#164#165#165#165#165#165#199#165#169#199#165#169#165#169#165#165#165#165#165 + +#169#165#165#203#170#165#170#199#170#169#166#169#166#169#165#170#204#169#170 + +#165#169#170#165#204#169#170#169#166#204#165#170#166#170#170#204#170#169#170 + +#203#170#169#204#169#255'(\'#165#165#164#165#165#164#165#165#165#198#165#164 + +#165#164#165#164#161#198#165#165#160#165#164#165#164#165#198#165#164#165#164 + +#165#165#164#161#198#165#165#164#165#165#161#198#165#165#165#165#170#169#166 + +#203#165#165#165#170#199#169#165#165#199#169#169#170#169#170#170#169#166#169 + +#204#169#200#169#165#165#165#165#165#165#165#165#169#165#165#165#169#199#165 + +#165#165#165#199#165#165#165#199#170#169#165#204#169#170#169#204#169#170#203 + +#170#204#169#165#170#203#170#204#169#170#169#166#203#170#169#169#170#169#203 + +#169#165#169#165#203#165#165#169#199#165#165'3'#181#16#165#160#165#195#164 + +#161#165#161#164#161#165#161#165#161#165#161#164#165#165#194#165#165#165#160 + +#165#161#165#161#165#161#199#161#164#161#165#165#165#160#165#161#165#164#165 + +#165#199#165#169#169#199#165#169#165#165#203#165#169#165#165#165#165#165#204 + +#166#169#204#165#204#169#204#169#166#169#165#199#165#165#203#165#166#203#169 + +#166#199#165#169#165#165#165#199#165#169#165#165#169#165#170#169#200#169#170 + +#169#166#204#165#170#204#165#170#165#170#170#204#169#170#165#170#165#204#169 + +#170#165#165#199#165#199#165#165#199#165#165#165#165#165#165#165#165#165#255 + +'bH'#165#165#164#165#165#164#165#198#165#164#165#164#165#164#165#198#165#160 + +#165#165#164#161#164#165#199#164#165#164#165#164#165#164#199#164#165#160#165 + +#199#164#165#194#165#160#165#165#165#199#165#170#170#165#165#165#165#165#165 + +#199#165#165#165#165#169#169#166#169#170#169#166#169#170#169#165#165#165#165 + +#165#166#169#169#166#169#169#165#165#199#165#165#169#165#165#165#169#165#199 + +#170#199#170#169#170#203#170#169#169#170#166#169#170#169#170#203#170#169#166 + +#169#170#203#170#169#166#204#169#165#165#165#165#165#165#165#165#199#165#165 + +#165#199#165#165#165'O'#138'6'#160#199#161#164#161#165#160#165#161#165#161 + +#165#194#165#161#165#165#165#160#165#165#165#195#164#161#165#160#165#161#165 + +#160#165#161#165#165#165#160#165#165#164#165#165#165#164#165#165#165#169#199 + +#169#170#203#165#165#199#165#165#165#165#199#165#165#204#169#204#165#204#169 + +#170#199#169#199#165#165#204#169#170#200#169#170#199#166#169#169#166#169#199 + +#165#169#200#169#199#170#165#169#170#169#165#204#179#246#204#170#169#203#166 + +#169#204#165#170#199#170#169#204#165#170#169#204#169#169#200#169#166#169#170 + +#165#170#165#165#165#165#165#165#165#169#204#169#255'zB'#165#165#164#165#165 + ,#198#165#165#164#165#198#165#165#164#165#164#161#198#165#165#160#165#164#165 + +#164#165#165#198#165#164#165#164#165#164#195#164#165#165#160#165#161#164#195 + +#164#161#164#165#165#169#166#203#165#165#165#165#165#165#169#165#169#165#199 + +#169#166#169#170#169#170#165#165#165#165#165#170#169#166#203#170#170#165#170 + +#169#199#170#165#169#170#169#200#169#169#166#169#170#204#165#204#165#170#246 + +#175#174#199#170#170#169#204#169#170#169#170#169#200#169#170#203#166#169#170 + +#170#169#170#203#166#203#170#203#165#165#165#165#199#165#169#166#169#166'2' + +#165#6#165#160#165#161#164#161#165#160#165#160#165#161#164#161#165#161#164 + +#165#165#160#199#165#165#161#199#160#165#161#165#195#165#161#165#161#164#165 + +#199#160#165#165#164#165#165#165#199#165#165#199#165#169#165#165#165#165#165 + +#165#170#199#170#165#165#165#165#169#170#199#170#165#199#169#165#204#169#165 + +#204#169#170#165#203#170#203#166#169#170#169#199#170#165#169#169#166#169#203 + +#166#169#170#169#170#170#203#169#204#169#170#199#170#169#166#203#170#199#170 + +#169#170#165#170#170#169#200#169#170#199#170#169#170#165#170#165#165#165#164 + +#165#165#170#170#203#170#255'zB'#165#165#164#199#165#164#165#165#199#164#165 + +#164#165#164#165#198#165#161#164#165#164#161#164#165#164#165#164#165#164#165 + +#164#199#164#165#165#160#165#165#164#195#165#160#165#165#165#165#164#165#199 + +#165#199#165#165#165#170#199#169#170#169#204#169#165#165#199#169#170#204#169 + +#170#165#170#165#170#170#169#166#203#170#170#165#170#169#170#199#170#165#170 + +#203#170#170#203#166#170#169#200#169#170#199#169#166#170#169#200#169#170#169 + +#204#169#166#169#170#169#200#169#204#170#199#170#169#200#169#170#169#166#169 + +#204#169#165#165#199#165#165#165#203#169#166#169'CU'#19#164#161#165#160#165 + +#165#160#165#161#165#161#165#161#199#161#165#164#165#161#165#165#164#161#165 + +#161#165#161#164#161#165#161#164#161#164#165#165#160#165#165#164#165#165#198 + +#165#165#160#165#161#165#165#165#165#165#199#169#170#166#203#166#169#170#203 + +#165#165#170#165#169#170#203#170#169#204#169#200#169#170#170#165#204#169#170 + +#200#169#170#169#204#165#170#203#166#169#170#203#170#169#204#165#170#169#203 + +#166#170#169#166#203#166#169#170#203#170#165#170#169#170#165#169#170#169#170 + +#169#170#199#170#203#166#169#170#203#165#165#165#165#165#166#169#204#170#255 + +#176'2'#165#164#165#164#165#194#165#164#165#164#199#164#165#164#165#164#161 + +#198#165#164#161#165#198#165#164#165#198#165#164#165#164#165#165#199#160#165 + +#165#165#160#165#161#164#161#165#164#199#164#165#164#165#165#165#199#170#170 + +#169#204#169#170#203#166#170#165#169#204#170#170#165#170#165#204#169#170#169 + +#170#199#169#170#169#166#169#170#169#200#170#169#170#169#166#169#204#165#170 + +#165#170#169#170#203#166#170#169#204#169#170#169#170#204#165#170#169#204#169 + +#166#203#170#170#203#166#203#170#169#170#169#170#169#170#199#165#165#165#165 + +#165#199#169#166#169#165'E'#205'5'#165#161#165#165#161#165#165#165#160#165 + +#161#165#160#165#161#165#165#165#164#195#165#164#165#161#165#160#165#161#199 + +#161#165#160#165#160#165#199#165#160#199#165#164#165#165#164#165#161#165#194 + +#165#165#199#169#169#170#169#200#169#170#165#170#169#169#203#170#169#165#203 + +#170#203#170#169#166#169#166#203#170#170#199#170#203#170#199#170#169#169#170 + +#199#170#203#170#169#170#169#204#169#170#199#170#169#203#166#169#166#169#204 + +#165#169#170#169#204#165#170#204#169#170#199#170#169#170#165#170#199#170#166 + +#203#170#165#170#165#199#165#165#165#165#169#199#170#255'@V'#164#165#160#199 + +#164#165#160#165#199#164#165#164#165#164#165#194#165#160#165#164#165#161#164 + +#165#164#165#164#165#164#165#164#199#165#165#164#161#164#165#164#161#165#160 + +#165#195#164#165#164#165#164#165#165#165#165#199#170#169#170#170#203#165#199 + +#165#165#170#199#165#165#169#170#165#170#169#204#169#170#166#169#170#169#166 + +#169#170#165#170#199#170#169#170#165#170#165#204#165#169#200#169#170#169#166 + +#170#169#170#203#170#169#170#170#204#165#170#169#170#169#166#169#170#165#170 + +#169#204#170#169#170#169#170#204#169#165#165#165#165#165#165#203#166#169#169 + +'CU'#19#165#198#165#161#165#164#165#164#161#165#161#165#161#165#164#165#165 + +#165#161#165#164#165#161#165#161#199#161#164#161#165#161#164#161#165#165#164 + +#161#165#165#164#199#165#164#165#165#161#165#161#165#165#165#165#165#169#165 + +#204#165#169#170#165#165#165#165#170#169#165#165#165#203#169#204#166#169#170 + +#203#169#204#165#204#169#170#203#170#169#170#169#200#169#170#203#170#169#170 + +#170#169#170#199#170#203#170#199#170#170#165#204#165#169#170#169#204#166#203 + +#170#169#204#169#170#203#166#169#199#170#203#166#169#165#170#203#165#165#165 + +#165#165#165#169#200#170#255#145'9'#165#161#164#165#164#195#165#161#164#165 + +#198#165#164#199#161#164#161#198#165#164#161#164#165#198#165#164#165#165#164 + +#199#164#165#164#199#160#165#199#164#161#165#160#165#161#164#161#198#165#164 + +#165#194#165#199#169#165#165#169#170#204#165#165#165#165#204#169#199#165#165 + +#199#165#170#165#169#204#165#170#170#169#170#169#166#169#166#169#200#170#169 + +#170#170#165#170#165#204#169#200#169#170#169#170#165#170#170#169#203#170#169 + ,#170#204#165#170#169#170#170#169#200#169#166#203#170#169#170#170#169#170#169 + +#204#170#169#165#165#165#164#199#165#165#170#169#169'E'#205'5'#165#164#165 + +#161#165#165#165#164#165#165#165#160#165#161#164#165#165#165#164#161#199#165 + +#165#161#164#161#165#160#165#161#165#161#165#160#165#165#164#161#165#164#165 + +#165#164#165#165#165#164#161#165#165#164#165#165#199#165#203#170#165#170#203 + +#169#166#169#165#165#165#165#165#165#169#170#204#170#169#204#165#170#199#170 + +#203#170#204#169#170#169#204#165#203#170#203#170#169#166#169#170#203#166#204 + +#169#170#199#169#166#170#203#166#169#170#203#170#169#165#204#169#170#169#170 + +#170#165#204#169#166#204#165#170#169#200#169#165#199#165#165#165#203#165#204 + +#166#255'y?'#165#161#164#199#164#161#164#161#198#161#164#165#165#164#165#160 + +#165#160#165#164#165#160#165#164#165#165#164#199#165#164#165#164#165#165#164 + +#161#165#164#165#195#165#160#199#160#165#160#165#164#165#160#165#160#165#165 + +#165#165#169#204#169#170#166#169#199#165#165#165#170#165#165#199#169#165#169 + +#166#169#170#169#170#169#170#166#169#204#169#166#169#170#170#170#169#166#169 + +#170#203#166#169#170#169#166#169#170#170#204#169#170#169#204#165#170#165#204 + +#170#165#170#169#204#166#203#170#169#204#169#170#169#204#169#170#165#165#165 + +#165#165#165#166#169#169#170'&'#175#14#165#164#161#165#165#164#165#165#165 + +#165#161#164#161#165#199#165#165#199#161#165#164#199#165#161#164#161#165#160 + +#165#165#160#165#194#165#165#164#161#165#164#165#164#165#165#165#165#199#161 + +#165#199#165#165#199#164#165#165#165#165#169#166#169#203#165#165#165#165#204 + +#165#204#165#165#165#170#203#170#204#165#204#169#200#169#169#170#165#170#203 + +#170#199#169#165#204#169#200#169#170#203#170#165#204#169#204#165#169#169#204 + +#165#170#169#170#203#170#169#170#204#169#166#169#169#170#165#170#165#170#203 + +#166#169#166#203#170#165#165#165#165#199#169#166#203#169#255#145'9'#164#165 + +#165#164#161#199#160#165#160#165#198#165#165#164#161#164#161#164#165#164#161 + +#165#160#165#165#198#165#165#165#194#165#165#165#165#160#199#165#164#161#165 + +#161#165#160#165#160#165#164#165#160#165#160#165#161#165#199#165#165#199#169 + +#199#165#165#165#199#170#169#170#169#169#165#203#165#170#165#170#169#170#170 + +#169#170#204#165#204#169#166#169#170#170#170#169#170#169#170#165#170#169#204 + +#169#166#169#170#204#166#169#170#203#166#169#170#169#200#169#165#170#203#170 + +#166#203#170#203#170#169#170#169#204#169#170#165#203#165#165#165#165#165#169 + +#170#166'3'#181#16#165#161#164#161#165#164#165#165#165#164#165#161#198#161 + +#164#165#165#165#164#161#165#164#165#165#164#165#161#165#160#165#165#164#161 + +#164#165#165#164#195#165#164#165#164#165#164#165#165#161#164#165#165#165#164 + +#165#164#161#161#165#165#165#165#165#165#169#170#169#204#165#170#204#166#165 + +#165#169#203#170#199#170#165#203#166#169#170#169#170#204#169#166#203#169#200 + +#169#166#203#170#203#166#169#170#169#170#199#170#169#204#166#169#170#169#200 + +#169#170#169#204#170#165#170#203#170#169#170#165#204#165#204#169#166#203#170 + +#165#165#165#165#165#203#166#204#169#255'zB'#164#165#165#198#165#161#164#161 + +#198#161#165#164#165#165#165#160#165#160#165#164#165#165#160#199#161#164#165 + +#164#165#164#161#165#164#161#164#161#165#164#165#161#203#170#204#165#160#165 + +#164#161#164#161#164#161#165#160#156#152#160#165#165#165#169#165#204#169#166 + +#169#170#165#169#169#165#165#165#165#170#170#169#170#170#204#169#170#204#170 + +#169#170#169#170#170#169#170#169#170#165#170#169#200#169#200#169#170#169#166 + +#169#170#169#200#170#169#166#203#170#166#169#204#169#170#169#166#203#170#169 + +#170#169#170#169#166#169#165#165#199#165#165#165#169#169#170'2'#165#6#161#198 + +#161#165#164#165#165#165#165#164#161#165#160#165#169#255#255#246#204#161#198 + +#165#165#164#165#161#164#161#199#165#164#170#255#255#255#169#160#165#169#246 + +#255#255#255#246#246#199#165#255#255#246#204#164#204#255#255#255#165#199#165 + +#165#199#170#165#246#255#255#255#204#170#204#255#255#255#174#199#169#200#169 + +#169#170#246#255#255#255#255#204#170#165#204#165#204#170#203#170#169#170#169 + +#170#169#170#199#170#203#170#199#170#169#170#203#170#170#203#169#170#165#170 + +#199#170#169#170#165#204#169#166#203#170#203#170#199#165#165#165#199#165#170 + +#199#170#255'bH'#165#165#164#165#161#164#195#164#161#165#199#164#165#165#199 + +#255#255#255#204#164#165#160#165#161#165#198#165#165#164#161#165#204#246#255 + +#255#199#165#165#255#255#255#255#255#255#255#255#165#255#255#255#160#164#170 + +#255#255#255#203#165#165#169#165#169#165#246#255#255#255#165#169#170#255#255 + +#255#204#165#169#169#170#204#255#255#255#255#246#246#170#203#170#169#170#169 + +#166#170#169#200#169#170#203#166#169#170#169#166#169#170#169#200#169#166#169 + +#166#170#170#203#170#169#170#170#199#170#204#169#170#169#170#170#165#169#165 + +#165#165#165#165#165#169#170#169'E'#205'5'#165#160#165#161#164#165#165#165 + +#164#165#164#161#165#160#169#255#255#255#170#164#161#165#165#165#164#165#161 + +#164#161#165#164#204#246#255#255#169#160#255#255#255#255#208#165#203#209#255 + +#246#255#255#255#165#161#204#246#255#255#165#165#165#165#165#199#169#246#246 + ,#255#255#169#170#204#246#255#255#174#165#165#165#199#255#255#255#255#255#246 + +#246#204#170#169#204#165#170#169#203#166#169#170#199#170#169#204#165#204#169 + +#170#199#170#169#170#169#204#169#203#169#166#169#204#165#169#170#169#169#166 + +#169#200#170#199#169#166#199#165#165#164#165#165#203#166#169#255'(\'#165#165 + +#164#165#199#160#165#160#165#161#165#164#165#165#199#255#255#255#204#165#165 + +#164#161#198#161#164#165#165#164#165#160#204#255#255#255#165#203#255#255#255 + +#208#164#161#164#160#246#255#255#255#255#160#164#204#255#255#255#203#160#165 + +#199#165#165#165#246#255#255#246#166#203#170#255#255#255#208#165#199#165#169 + +#246#255#255#255#203#169#166#170#169#166#169#170#203#166#170#169#204#169#170 + +#169#166#169#170#169#170#169#170#169#170#199#170#169#170#166#170#203#166#169 + +#204#170#203#166#170#203#170#169#169#170#169#169#165#165#165#199#165#165#169 + +#204#170'CU'#19#164#165#195#164#165#165#165#165#164#165#165#195#164#161#169 + +#255#255#246#204#160#165#199#164#165#165#161#164#161#199#165#164#170#255#255 + +#255#199#170#255#255#255#203#160#165#161#164#165#255#255#255#255#161#164#170 + +#255#255#246#170#165#164#165#165#165#165#246#255#255#255#169#170#204#255#255 + +#255#208#169#165#165#170#255#255#255#208#166#170#203#165#204#169#204#165#170 + +#169#204#165#170#166#203#170#203#170#165#204#165#204#165#204#169#170#169#200 + +#169#169#170#169#170#170#165#170#170#203#170#165#170#204#165#170#199#170#165 + +#165#165#165#165#165#166#169#169#255#145'9'#165#161#164#165#161#164#195#164 + +#161#198#161#164#165#165#199#255#255#255#204#164#165#160#165#161#164#199#165 + +#164#165#160#165#204#255#255#255#165#246#246#255#255#160#165#165#164#165#160 + +#246#255#255#255#160#164#204#255#255#255#204#165#165#160#165#199#165#208#255 + +#255#255#169#165#170#255#255#255#208#166#169#165#208#255#255#255#170#169#169 + +#170#170#169#166#169#170#203#166#169#170#203#170#170#165#170#169#204#170#169 + +#170#170#169#170#199#170#169#170#200#169#166#203#170#203#170#169#166#169#204 + +#169#166#170#203#170#165#199#165#165#165#165#199#169#204#170'3'#181#16#165 + +#164#165#165#164#165#165#165#165#165#164#165#165#160#169#255#255#255#170#164 + +#161#165#165#164#165#165#160#165#161#165#164#204#246#255#255#165#208#255#255 + +#255#164#161#164#195#165#160#246#255#255#255#165#161#204#246#255#255#165#165 + +#164#165#165#161#165#246#246#255#255#166#170#204#255#255#255#174#169#199#165 + +#204#255#255#255#204#169#200#170#199#170#169#204#165#170#169#204#169#170#165 + +#169#170#204#169#166#169#170#165#203#166#204#169#170#199#170#169#170#203#170 + +#165#170#165#170#203#170#165#170#169#203#170#165#169#165#165#165#165#165#165 + +#169#166#169#255#145'9'#165#161#164#161#199#160#165#160#165#160#165#160#165 + +#165#199#255#255#246#204#165#164#165#160#199#160#165#165#165#164#165#160#204 + +#255#255#255#165#208#255#255#255#160#165#165#165#164#161#208#255#255#255#160 + +#164#170#255#255#255#203#161#165#199#164#165#160#246#255#255#255#169#203#170 + +#255#255#255#208#165#165#165#208#255#255#255#170#169#170#169#170#169#166#169 + +#170#203#170#169#166#203#170#204#170#165#170#203#170#203#170#170#169#165#170 + +#169#170#169#204#165#170#169#170#169#204#165#170#169#170#203#170#170#165#170 + +#203#165#165#198#165#165#165#170#203#170''#17#7':E'#205'5'#219#13#218#13#219#12#245#219#219#12#219#13 + +#245#219'5'#255#255#246'^'#244#219#12#219#12#245#218#255#255#255#8#244'^'#255 + +#255#255#17#244#219#12#219#244#219#244#219#12#13#12#219#13#218#13#219#244#219 + +#13#218#245#219#12#219#244#219#244#219#13#219#12#245#219'5'#255#255#246'^'#12 + +#13#218'^'#255#255#255'^'#17#17#13#17#17'5'#7#134'b5'#246#8':'#209#8':5'#17 + +#17#17'559:'#7':9:'#7#7':9'#7#7#7':9::9:9:65'#17#13#13#219#13#21#22'59'#7#255 + +#145'9'#12#13#13#218#245#219#218#13#12#219#244#219#218#13#17#255#255#255'^' + +#218#13#219#245#219#219'5'#255#255#255'^'#218'^'#255#255#255'5'#12#219#245 + +#218#13#219#12#13#12#219#13#12#219#245#218#245#219#12#219#13#12#219#13#12#219 + +#12#219#244#219#244#219#219#12#17#255#255#255'^'#219#13#12'^'#255#255#255#17 + +#17'5'#17#17'5:'#8#209#179#134#175'b9'#8#134'9'#7'9'#17'65559'#7'9:'#7'9:9:9' + +':9:'#7'9'#7'9'#7':995'#17#17#17#13#13#16#17'5:9'#244#219#12#245#12'b' + +#246#255#255#13#13#218#246#255#255#255#17#12#218#244'^'#255#255#255#255'^9' + +#255#255#255#134#219#244#219#244#8#255#255#255#255#244#218'^'#255#255#255'5' + +#219#219#12#219#245#218#13#219#244#219#13#12#219#13#218#13#12#219'5'#13#218 + +#13#17'5'#17#17#17#17#17#17'5'#17#17#17#17#13#17'59'#7':9'#7'9:995'#17#13#17 + +'3'#181#16#218#245#219#12#13#13#218#13#13#13#218#13#13#218#219#245#219#13#218 + +#246#255#255#246#255#246#245#12#219#13#13#245#218'b'#255#255#255#17#12#245 + +#218#245#218#219#244#13#255#255#255'^'#12#13#255#255#246#175#244#245#13#218 + +#244#8#255#255#255']^'#255#255#255#17#244#219#244#219#17#255#255#255#255#245 + +#218'^'#255#255#255#17#244#219#13#12#219#13#244#219#219#244#219#13#12#219#245 + +#218#13#13#13#219#13#218#13#17':55'#17'5'#17#17'55'#17#17#13#17#17':99:9:'#7 + +':'#7':'#17#17#17#255'yS'#13#219#12#219#13#218#245#218#13#218#245#219#12#13 + +#12#219#12#219#13#255#255#246'b'#255#255'5'#219#244#219#218#219#13'^'#246#255 + +#255'5'#218#13#13#218#13#13#218#219#8#255#255#134#218#17#255#255#255'^'#218 + +#219#218#245#219'^'#255#255#255':'#8#255#255#246#244#219#12#219#13#244#175 + +#255#255#246#244#218'^'#255#255#255'5'#219#13#218#13#13#218#219#13#12#219#13 + +#218#13#13#218#13#218#13#218#245#218#245#219'55'#13#17#17#17#17'5'#17#17#17 + +#13#13#17'55'#7':'#7#7'9:9:95'#17#17'L'#18#20#219#12#219#245#218#13#219#13 + +#218#13#219#12#219#13#219#12#219#244'9'#255#255#175#7#255#255'^'#12#219#12#13 + +#13#12'^'#246#255#255'5'#219#13#218#13#13#218#13#244#8#255#255#8#13'^'#246 + +#255#255'9'#13#12#245#13#218'5'#255#255#255#7#8#255#255#255#219#12#13#219#244 + +#218#8#255#255#255#219#245'^'#246#255#255'5'#219#12#13#13#218#13#13#12#219#13 + +#12#13#219#12#219#13#13#218#13#219#13#218#13'9'#13#218#13#17'5'#17#17#17#13 + +#17#13#17#17'5::9:9:9'#7'9'#7#17'55'#255#145'9'#13#13#12#219#13#12#219#244 + +#219#244#219#13#12#219#244#219#13#13'b'#255#255#8#17#255#255#8#219#13#219#12 + +#219#12'^'#255#255#255'5'#244#219#13#13#218#245#218#13#255#255#255#8#244'^' + +#255#255#255'5'#219#219#218#219#13#17#255#255#246'^b'#255#255#255#12#13#219 + +#12#219#245#8#255#255#255#244#218'^'#255#255#255'5'#13#219#12#219#245#218#13 + +#219#12#13#219#218#245#219#12#13#218#245#219#244#219#13#12#13#219#245#218#13 + +#17#17#17#17#17#13#17#17'5'#17'9'#7'9'#7':9'#7'::5'#17'5:O'#138'6'#218#13#219 + +#12#219#13#12#219#13#219#12#219#13#13#219#12#219#12#175#255#246'^'#17#255#255 + +#255#244#218#245#219#13#218'^'#255#255#255#17#219#12#219#13#219#13#218'^'#255 + +#255#246'^'#218'^'#255#255#255#17#244#13#13#218#13'5'#255#255#255']^'#255#255 + +#255'5'#218#245#219#12#219#8#255#255#255#13#12'b'#255#255#255#17#12#13#219#12 + +#219#13#218#13#219#12#245#219#12#219#13#219#13#218#13#219#12#219#13#219#12 + +#219#13#218#13'55'#17#17'5'#17#17#17'55::9'#7'69'#7'5'#17#17#17'9'#255#145'9' + +#13#219#244#219#13#218#13#219#12#13#219#244#219#12#13#219#13#218#255#255#255 + +':'#12#255#255#255#17#13#218#13#218#245'b'#255#255#255'5'#13#13#218#13#12#219 + +'^'#246#255#255#255#219#244'b'#255#255#255'5'#219#219#12#13#219'5'#255#255 + +#255'^'#13#246#255#255#8#13#218#13#219#244#8#255#255#246#244#218'^'#255#255 + +#255'5'#13#219#12#13#219#244#219#13#12#219#13#218#13#13#218#13#12#219#13#12 + +#219#13#12#219#245#218#13#13#218#13#13#218#13#219'5'#17#17#17'555:59:5'#17#17 + +#17#17'53'#181#16#219#12#219#13#218#245#219#12#13#219#12#219#13#219#12#219 + +#244#17#255#255#255'5'#244#175#255#255'^'#218#13#219#245#218'^'#246#255#255 + +'5'#219#218#13#12#219#134#255#255#255#255'^'#12#13'^'#246#255#255'5'#219#244 + +#13#219#12#17#255#255#255'^'#218'^'#246#246#255'b'#12#219#12#219#8#255#255 + +#255#219#245'^'#246#255#255'5'#219#12#13#219#12#219#13#12#219#13#218#13#13 + +#218#13#13#219#13#12#219#13#12#219#13#218#13#13#218#13#13#219#245#218#13#13 + +#17#17#17#17#17'5'#17'5'#17'5'#17#17'559:'#255#145'9'#13#13#218#13#13#218#13 + +#13#218#13#13#218#13#12#219#13#218'^'#255#255#246#219#12#134#255#255'b'#245 + +#219#12#219#12'^'#255#255#255'5'#13#245#219#17#255#255#255#255#255#134#218#13 + +#12'b'#255#255#255'5'#13#219#218#245#219'5'#255#255#255'^'#244#219#175#255 + +#255#246#175#7#219#244#8#255#255#255#244#218'^'#255#255#255'5'#219#13#218#245 + +#219#12#13#219#12#219#245#218#13#219#12#219#244#219#13#218#13#219#244#219#13 + +#12#219#13#13#218#13#218#13#12#17'5555'#17#17#17'5'#17'5'#13#17#17'69'#7'CU' + +#19#218#13#13#218#13#219#12#219#13#218#13#13#219#13#244#219#245#8#255#255#175 + +#244#219'^'#255#255#209#218#244#219#13#218'^'#255#255#255#17#218#218#7#255 + +#255#255#255#255'^'#13#244#219#12'^'#255#255#255#17#12#13#219#12#219'5'#255 + ,#255#246'^'#219#244#219#8#255#255#255#255#255#255#255#255#255#255#245#218'^' + +#255#255#255#17#244#219#13#218#13#219#12#13#219#12#219#13#218#245#219#12#219 + +#12#219#245#218#13#219#12#219#13#218#13#218#245#219#13#219#13#17'9'#17#21#17 + +#13#17#17#17#17#17#17#17#17'5:5'#255#215'7'#13#219#244#219#13#12#219#245#218 + +#245#219#12#13#218#219#13#218#255#255#255#134#218#244#17#255#255#255#17#219 + +#12#219#245'b'#246#255#255'5'#245#17#255#255#255#255#255'5'#13#12#219#12#219 + +'^'#246#255#255'5'#219#13#12#219#13'5'#255#255#255'^'#218#13#12#13':'#174#255 + +#255#255#255#255#255#255#246#244#218'^'#255#255#255'5'#13#219#12#13#219#244 + +#219#13#218#245#219#12#13#218#13#12#219#13#13#218#13#13#218#13#13#218#245#219 + +#13#218#13#12#219#244#219#13'5'#7#13#218#245#13#17'5'#17#17#17#17'555E'#205 + +'5'#219#12#219#13#12#219#13#218#13#219#12#219#13#219#13#12#17#255#255#255'^' + +#13#13#219#246#255#255#7#218#13#13#218'^'#246#255#255'5'#218#175#246#255#255 + +#175#12#219#12#219#13#219#244'^'#246#255#255'5'#219#12#219#13#12#17#255#255 + +#255'b'#12#13#218#13#12#219#13#7'^'#8#255#255#255#255#219#245'^'#246#255#255 + +'5'#219#12#13#219#12#219#219#12#13#219#12#13#219#13#13#219#13#13#218#13#13 + +#218#13#13#218#13#219#13#12#219#13#219#12#219#13#12#17#17#13#219#13#218#12#17 + +#17#17'5'#17#17#17#17#255#145'9'#13#13#218#13#219#244#219#13#12#219#13#244 + +#219#12#13#218#7#255#255#255#17#218#13#12#175#255#246'b'#245#218#219#244'^' + +#255#255#255'5'#17#255#255#255#175#218#13#12#13#218#13#12#219'b'#255#255#255 + +#17#245#219#12#13#219'5'#255#255#255#7#219#219#13#13#218#245#219#244#219#244 + +#8#255#255#255#244#218'^'#255#255#255'5'#219#13#218#245#219#12#13#13#218#13 + +#13#218#13#12#219#12#13#218#13#12#219#13#218#13#219#12#13#12#219#244#219#12 + +#13#219#12#219#13#218#13#12#219#13#17'655'#17#17#17#17#17'3'#181#16#218#13#13 + +#218#13#219#12#219#13#12#219#219#12#219#13#219#134#255#255#255#244#13#218#13 + +#8#255#255#175#12#245#219#218'b'#255#255#255#17'^'#255#255#255#17#244#219#219 + +#13#13#218#13#12'^'#255#255#255'5'#219#12#219#12#219'5'#255#255#246'^'#244#13 + +#218#13#13#218#13#219#244#219#8#255#255#246#219#12'^'#255#255#255#17#244#219 + +#13#218#13#219#12#219#245#218#13#219#12#219#13#219#12#13#219#13#218#245#219 + +#12#13#219#12#219#13#219#13#219#12#13#219#244#219#13#219#13#12#219#13#17'55' + +#13#218#13#17#17#255#145'9'#13#219#244#219#13#12#219#245#218#13#13#12#219#245 + +#218#244#179#255#255#175#12#219#245#218'^'#255#255#255#219#218#13#13'^'#246 + +#255#255#17'b'#246#255#246#244#219#12#13#218#13#13#219#218'^'#255#255#255'5' + +#12#13#219#13#13#17#255#255#255'^'#219#12#13#219#12#13#219#12#219#244#179#255 + +#255#175#244#218'^'#255#255#255'5'#13#219#12#13#219#244#219#13#218#219#13#12 + +#219#245#218#245#219#12#219#12#13#219#12#219#13#12#219#244#219#12#13#218#13 + +#219#12#219#13#218#245#218#219#13#12#218#13#17#13#218#245#219'53'#181#16#219 + +#12#219#13#12#219#13#218#13#219#12#219#13#218#13#219#255#255#255#134#218#13 + +#218#13#17#255#255#255'5'#13#244#218'^'#246#255#255#17#7#255#255#255#219#218 + +#245#219#13#12#219#12#245'^'#246#255#255'5'#219#219#244#13#218'5'#255#255#255 + +'b'#12#13#219#12#219#13#218#245#218#13#255#255#255#8#218#245'b'#255#255#255 + +'5'#219#12#13#219#12#219#13#218#13#13#12#219#13#218#13#219#12#219#245#13#219 + +#12#13#219#244#219#13#219#13#13#218#13#13#218#245#219#12#13#218#13#13#12#219 + +#13#219#12#219#13#219#12'5'#255#145'9'#13#13#218#13#219#12#13#219#12#13#219 + +#13#218#13#12'5'#255#255#246':'#244#219#13#12#218#255#255#255'^'#218#219#13 + +'b'#255#255#255'5'#219#255#255#255'^'#12#219#12#219#218#13#219#218'^'#255#255 + +#255#17#13#12#219#218#13#17#255#255#246'^'#218#218'5'#219#244#219#13#219#13#8 + +#255#255#255#7#13#218#7#255#255#255'5'#219#13#218#245#219#12#219#245#218#13 + +#219#244#219#13#12#219#13#13#218#219#12#13#218#13#219#12#219#12#13#218#13#13 + +#218#13#218#13#13#219#13#13#218#219#12#13#218#245#219#12#13#219#17'2'#165#6 + +#218#13#13#218#13#219#12#13#219#12#245#219#245#219#219'b'#255#255#255#13#219 + +#244#219#13#245#246#255#255#8#245#218#12'^'#255#255#255#17#244#134#255#255 + +#255#134#17'5^'#246'^'#13#12'b'#255#255#255'5'#218#13#13#219#13'5'#255#255 + +#246'^'#245#219#134#255'b959'#8#255#255#255#246#219#244#219'b'#255#255#255#17 + +#244#219#13#218#13#13#12#219#13#218#13#219#12#219#13#12#219#13#13#218#13#219 + +#13#12#219#245#218#13#219#13#218#245#219#13#219#12#219#12#219#12#13#13#219#13 + +#13#218#13#219#12#13#219#255'zB'#13#219#244#219#13#12#219#13#12#219#218#13 + +#218#13#244#8#255#255#255#218#13#219#12#219#218#134#255#255#255#12#13#219'^' + +#246#255#255'5'#219#13#8#255#255#255#255#255#255#255#175#12#219'^'#246#255 + +#255'5'#13#219#12#13#218'5'#255#255#255'^'#218#244#255#255#255#255#255#255 + +#255#255#255#255'5'#13#219#12'^'#255#255#255'5'#219#13#12#219#13#218#219#13 + +#12#13#12#219#244#219#12#219#12#219#12#13#219#244#219#13#12#219#13#218#245 + +#218#13#219#12#13#12#219#244#219#13#219#12#219#244#219#12#13#219#244#219#12 + +#13'E'#205'5'#219#12#219#13#12#219#13#218#13#219#13#12#219#245#218#255#255 + +#255#8#12#245#218#13#219#244'^'#255#255#255#17#219#12'^'#255#255#179'5'#219 + ,#244#219'^'#246#255#255#255#255#255#8#219#244'^'#255#255#179'5'#219#12#13#219 + +#13#17#255#255#179'b'#13#219#7#175#255#246#246#246#255#255#179#17#13#218#13 + +#12'^'#246#255#255'5'#219#12#219#13#12#219#245#12#219#13#219#13#219#13#13#219 + +#245#218#13#219#12#219#13#218#13#219#12#13#219#13#219#12#13#219#219#13#219#13 + +#13#12#219#13#219#12#219#13#218#13#219#13#218#255#145'9'#13#13#218#13#219#244 + +#219#245#218#13#12#219#12#219'5'#255#255#255#247#219#219#13#218#13#219#17#255 + +#255#255'^'#244#219#244#218#244#245#218#12#13#218#245#219'9^^9'#13#245#218 + +#219#245#218#244#245#218#13#219#218#245#218#245#218#245#12#245#218#245#219#12 + +#13#17':^:'#17#244#13#218#13#13#218'^'#255#255#255#17#245#219#12#13#219#12 + +#219#219#12#219#12#219#12#13#218#13#218#13#12#219#245#218#13#13#219#12#13#219 + +#12#13#218#13#218#13#12#13#12#219#218#13#218#245#218#13#12#219#13#13#218#13 + +#13'E'#205'5'#218#13#13#218#13#219#12#219#13#219#13#219#245#218'b'#255#255 + +#255'9'#244#219#13#245#218#13#244#255#255#246#9#218#13#219#13#218#13#13#219 + +#13#219#12#245#219#244#218#245#218#13#13#218#13#13#218#13#219#244#13#13#218 + +#13#219#244#219#12#219#13#218#13#218#13#13#13#12#12#13#218#245#219#218#245 + +#218'b'#255#255#255'5'#218#13#219#244#219#13#12#219#245#218#245#219#13#218 + +#245#219#13#219#13#12#219#13#218#13#13#219#12#219#13#218#245#219#13#218#13 + +#219#13#244#219#13#13#219#13#219#13#12#219#13#13#218#13#255'zB'#13#219#244 + +#219#13#12#219#12#13#218#13#12#219#13#134#255#255#255#13#219#12#219#218#13 + +#219#218#175#246#255#255#12#245#218#13#13#218#13#218#13#12#219#218#13#13#219 + +#12#219#13#218#245#219#12#219#13#12#219#219#12#219#13#12#219#13#218#13#218 + +#245#218#245#218#13#218#13#219#12#13#219#12#13#219#13'^'#246#255#255#17#13 + +#219#12#219#13#218#13#13#218#13#219#12#13#219#12#219#12#13#218#13#219#12#13 + +#218#13#218#13#13#218#245#219#12#219#245#219#12#219#219#12#219#12#13#218#245 + +#218#13#12#219#12#13#219'5-3'#219#12#219#13#12#219#13#13#218#245#219#13#218 + +#244#255#255#255#255#219#12#245#218#13#13#218#245#134#255#255#255#17#218#219 + +#13#218#13#219#13#12#219#13#13#12#219#12#219#245#218#245#219#218#13#13#218#13 + +#219#12#13#13#12#219#13#218#245#13#13#219#13#219#13#218#245#219#12#13#219#12 + +#13#219#12#12'^'#246#255#255'5'#13#218#245#219#12#13#13#218#13#219#12#13#219 + +#12#219#13#13#218#13#219#244#13#219#13#12#219#245#218#13#219#218#13#13#219#12 + +#219#13#12#13#219#245#218#13#219#13#219#13#218#13#219#12#255#145'9'#13#13#218 + +#13#219#13#12#219#13#218#245#218#13#17#255#255#255#8#244#219#219#13#12#219 + +#245#218'^'#255#255#255':'#244'5'#8#255#134#12#13#219#12#13#218#219#13#13#218 + +#219#13#218#13#13#12#219#245#218#13#13#218#219#13#218#13#13#219#218#219#12#13 + +#218#13#13#218#13#13#219#12#13#218#245#219#13'^'#255#255#255'5'#219#13#218#13 + +#13#218#219#13#12#13#13#218#13#219#244#219#12#219#13#12#219#219#12#13#219#13 + +#218#245#218#13#13#12#219#12#219#244#219#13#218#13#218#13#218#13#218#245#218 + +#13#12#219#13'E'#205'5'#218#245#219#12#13#219#13#12#219#13#219#13#218#7#255 + +#255#255'^'#12#13#218#13#219#12#219#13#17#255#255#246#134#219#8#255#255#255 + +'^'#218#245#219#13#13#12#219#13#13#12#219#13#218#13#219#12#219#13#218#13#245 + +#218#13#13#218#13#12#13#13#219#12#13#218#13#219#12#219#13#219#13#219#12#219 + +#12'b'#255#255#255#17#244#219#13#218#13#13#218#13#219#218#245#219#12#13#219 + +#13#219#244#219#13#12#13#219#12#13#219#13#219#13#218#13#219#244#219#13#219#12 + +#219#245#219#13#219#245#218#13#219#13#219#13#12#219#255'bH'#13#219#12#219#12 + +#13#218#219#13#12#219#244#219#134#255#255#246'5'#219#12#13#219#244#219#12#219 + +#244#255#255#255#175#244#255#255#255#255#8#13#219#12#219#12#219#244#219#12 + +#219#245#218#13#219#12#13#219#12#13#219#218#13#219#12#13#219#13#218#13#12#219 + +#13#219#13#12#219#244#219#12#13#218#13#13#218'^'#246#255#255'5'#219#13#218 + +#245#219#12#13#219#12#13#219#12#219#13#218#13#12#219#12#219#13#219#244#219#12 + +#219#12#13#218#245#219#12#219#13#12#219#245#218#13#218#13#12#219#13#12#219#12 + +#13#218#13#13'2'#165#6#219#12#219#13#13#218#13#13#12#219#13#219#12#175#255 + +#255#255#13#218#245#219#12#219#13#219#244#219#8#255#255#255#12#175#255#255 + +#255#134#219#12#219#245#219#13#219#12#219#13#218#13#219#244#13#219#12#13#219 + +#12#13#13#218#245#219#13#218#13#219#13#219#12#13#12#219#13#219#12#13#219#13 + +#13#218#13'^'#246#255#255'5'#219#12#13#219#12#219#13#218#245#219#12#219#245 + +#218#13#13#219#13#219#12#219#12#219#13#219#244#13#219#13#219#12#219#13#12#219 + +#13#218#13#219#13#12#219#13#12#219#13#13#218#13#13#218#255#145'9'#13#13#219 + +#12#219#245#218#13#219#244#219#12#13#255#255#255#246#219#13#218#13#13#218#13 + +#12#219#12'b'#255#255#255':9'#255#255#179#13#244#219#12#219#244#219#12#13#218 + +#245#219#12#13#219#218#13#13#218#13#219#12#219#13#218#13#218#245#218#245#218 + +#245#219#12#219#244#219#12#13#218#13#12#219#13#12'^'#255#255#255'5'#219#13 + +#218#13#219#244#219#13#218#13#219#12#219#13#12#219#12#13#218#245#218#245#218 + +#13#12#219#218#13#12#219#13#12#13#219#12#13#219#244#219#12#219#12#13#219#12 + +#13#218#13#12#219#13'= :STime AND EndTime <= :ETime)' + + ' OR (RepeatCode > 0 AND :STime <= RepeatRangeEnd)'; + + FContactsTable := TAdsQuery.Create(self); + FContactsTable.RequestLive := true; + FContactsTable.SQL.Text := 'SELECT * FROM ' + ContactsTableName + + ' WHERE ResourceID = :ResID'; + + FTasksTable := TAdsQuery.Create(self); + FTasksTable.RequestLive := true; + FTasksTable.SQL.Text := 'SELECT * FROM ' + TasksTableName + + ' WHERE ResourceID = :ResID'; + + FRecordIDTable := TAdsQuery.Create(self); + FRecordIDTable.RequestLive := true; +end; +{=====} + +destructor TVpAdvDataStore.Destroy; +begin + FParams.Free; + + { free tables } + FResourceTable.Close; + FResourceTable.Free; + FEventsTable.Close; + FEventsTable.Free; + FContactsTable.Close; + FContactsTable.Free; + FTasksTable.Close; + FTasksTable.Free; + FRecordIDTable.Close; + FRecordIDTable.Free; + + inherited; +end; +{=====} + +function TVpAdvDataStore.GetConnected: Boolean; +begin + { If the resource table is active, then we can be considered "Connected" } + result := FResourceTable.Active; +end; +{=====} + +function TVpAdvDataStore.GetDatabaseName: string; +begin + result := FDatabaseName; +end; +{=====} + +function TVpAdvDataStore.GetResourceTable : TDataset; +begin + Result := FResourceTable; +end; +{=====} + +function TVpAdvDataStore.GetEventsTable : TDataset; +begin + Result := FEventsTable; +end; +{=====} + +function TVpAdvDataStore.GetContactsTable : TDataset; +begin + Result := FContactsTable +end; +{=====} + +function TVpAdvDataStore.GetTasksTable : TDataset; +begin + Result := FTasksTable; +end; +{=====} + +procedure TVpAdvDataStore.Load; +begin +// if not Connected then exit; + + FResourceTable.Close; + FEventsTable.Close; + FContactsTable.Close; + FTasksTable.Close; + + inherited; +end; +{=====} + +function TVpAdvDataStore.GetNextID(TableName: string): Integer; +var + Query: TAdsQuery; + GotIt: Boolean; + Attempts : Word; + ID : Integer; + FieldName: string; +begin + { The BDEDataStore uses a support table called RecordIDS, or whatever is } + { defined in the RecordIDTableName constant. It has one record, and is } + { used to keep track of the last ID used for each table. } + + { In a multi-user environment, This prevents collisions between two users } + { who happen to enter the same type of new record at the same time. } + + { New record ID's are created here and then the Record ID table is } + { immediately updated to reflect the new value. If the table is } + { unsuccessfully updated, then it is assumed that another user has claimed } + { that ID, so the ID is incremented and another attempt is made, until we } + { are successful. } + + Query := TAdsQuery.Create(self); + Query.RequestLive := true; + ID := 0; + Attempts := 0; + try + Query.DatabaseName := FDatabaseName; + + Query.Sql.Text := 'Select * from ' + RecordIDTableName; + Query.Open; + + if TableName = ResourceTableName then begin + FieldName := 'ResourceID'; + ID := Query.FieldByName('ResourceID').AsInteger; + + end else if TableName = TasksTableName then begin + FieldName := 'TaskID'; + ID := Query.FieldByName('TaskID').AsInteger; + + end else if TableName = EventsTableName then begin + FieldName := 'EventID'; + ID := Query.FieldByName('EventID').AsInteger; + + end else if TableName = ContactsTableName then begin + FieldName := 'ContactID'; + ID := Query.FieldByName('ContactID').AsInteger; + + end else begin + raise EInvalidTable.Create; + Exit; + end; + + Query.Close; + Query.SQL.Text := 'Update ' + RecordIDTableName + ' Set ' + FieldName + + ' = :NewID Where (' + FieldName + ' = :OldID)'; + + GotIt := false; + while (not GotIt) and (Attempts < 100) do begin + Inc(ID); + Query.ParamByName('NewID').AsInteger := ID; + Query.ParamByName('OldID').AsInteger := ID - 1; + Query.ExecSQL; + + GotIt := (Query.RowsAffected = 1); + Inc(Attempts); + end; + + if not GotIt then + raise exception.Create('Error: Unable to update ' + RecordIDTableName); + finally + Query.Close; + Query.Free; + end; + + result := ID; +end; +{=====} + +procedure TVpAdvDataStore.CreateTable(TableName: string); +var + Table: TAdsTable; +begin + Table := TAdsTable.Create(self); + try + Table.DatabaseName := FDatabaseName; + + if TableName = ResourceTableName then begin + { Create Resources Table } + Table.Active := false; + Table.TableName := ResourceTableName; + end + + else if TableName = EventsTableName then begin + { Create Events Table } + Table.Active := false; + Table.TableName := EventsTableName; + end + + else if TableName = ContactsTableName then begin + { Create Contacts Table } + Table.Active := false; + Table.TableName := ContactsTableName; + end + + else if TableName = TasksTableName then begin + { Create Tasks Table } + Table.Active := false; + Table.TableName := TasksTableName; + end + + else if TableName = RecordIDTableName then begin + { Create Tasks Table } + Table.Active := false; + Table.TableName := RecordIDTableName; + end; + + Table.DatabaseName := FDatabaseName; + CreateFieldDefs(TableName, Table.FieldDefs); + CreateIndexDefs(TableName, Table.IndexDefs); + + if Table <> nil then + Table.CreateTable; + + if TableName = RecordIDTableName then + InitializeRecordIDTable; + + finally + Table.Free; + end; +end; +{=====} + +procedure TVpAdvDataStore.InitializeRecordIDTable; +var + Qry: TAdsQuery; + ID: Integer; +begin + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDatabaseName; + Qry.RequestLive := true; + + Qry.SQL.Text := 'Select * from ' + RecordIDTableName; + Qry.Open; + if Qry.RowsAffected < 1 then begin + { create one record in the table } + Qry.SQL.Clear; + Qry.SQL.Text := 'INSERT INTO ' + RecordIDTableName + + '(ResourceID, EventID, TaskID, ContactID) ' + + 'VALUES(0, 0, 0, 0)'; + Qry.ExecSQL; + end; + Qry.Close; + + { Initialize Resource ID } + Qry.SQL.Text := 'Select Max(ResourceID) as MaxRes from ' + + ResourceTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := ID; + Qry.ExecSQL; + + { Initialize Event RecordID } + Qry.SQL.Text := 'Select Max(RecordID) as MaxEvent from ' + + EventsTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set EventID = :EvID'; + Qry.ParamByName('EvID').AsInteger := ID; + Qry.ExecSQL; + + { Initialize Contact RecordID } + Qry.SQL.Text := 'Select Max(RecordID) as MaxContact from ' + + ContactsTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set ContactID = :CoID'; + Qry.ParamByName('CoID').AsInteger := ID; + Qry.ExecSQL; + + { Initialize Task RecordID } + Qry.SQL.Text := 'Select Max(RecordID) as MaxTask from ' + TasksTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set TaskID = :TsID'; + Qry.ParamByName('TsID').AsInteger := ID; + Qry.ExecSQL; + + finally + Qry.Free; + end; +end; +{=====} + +procedure TVpAdvDataStore.Loaded; +begin + inherited; + if not (csDesigning in ComponentState) then + Connected := AutoConnect; +end; +{=====} + +procedure TVpAdvDataStore.PostResources; +var + I: Integer; + Resource: TVpResource; + Qry: TAdsQuery; +begin + if (Resources.Count > 0) then begin + Qry := TAdsQuery.Create(self); + Qry.DatabaseName := FDatabaseName; + Qry.RequestLive := true; + try + for I := pred(Resources.Count) downto 0 do begin + Resource := Resources.Items[I]; + if Resource = nil then begin + Continue; + end; + + if Resource.Deleted then begin + PurgeEvents(Resource); + PurgeContacts(Resource); + PurgeTasks(Resource); + Qry.SQL.Text := 'DELETE FROM Resources ' + + 'WHERE ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + Resource.Free; + Continue; + end + + else if Resource.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Resources ' + + 'WHERE ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.Open; + + if Qry.Locate('ResourceID', Resource.ResourceID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('Description').AsString := Resource.Description; + Qry.FieldByName('Notes').AsString := Resource.Notes; + Qry.FieldByName('ResourceActive').AsBoolean := Resource.Active; + Qry.FieldByName('UserField0').AsString := Resource.UserField0; + Qry.FieldByName('UserField1').AsString := Resource.UserField1; + Qry.FieldByName('UserField2').AsString := Resource.UserField2; + Qry.FieldByName('UserField3').AsString := Resource.UserField3; + Qry.FieldByName('UserField4').AsString := Resource.UserField4; + Qry.FieldByName('UserField5').AsString := Resource.UserField5; + Qry.FieldByName('UserField6').AsString := Resource.UserField6; + Qry.FieldByName('UserField7').AsString := Resource.UserField7; + Qry.FieldByName('UserField8').AsString := Resource.UserField8; + Qry.FieldByName('UserField9').AsString := Resource.UserField9; + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.SQL.Clear; + Qry.SQL.Text := 'INSERT INTO Resources ' + + '(ResourceID, Description, Notes, ResourceActive, UserField0, ' + + 'UserField1, UserField2, UserField3, UserField4, UserField5, ' + + 'UserField6, UserField7, UserField8, UserField9) ' + + 'VALUES(:ResID, :Descr, :Notes, :ResActive, :UserField0, ' + + ':UserField1, :UserField2, :UserField3, :UserField4, ' + + ':UserField5, :UserField6, :UserField7, :UserField8, ' + + ':UserField9)'; + + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ParamByName('Descr').Asstring := Resource.Description; + Qry.ParamByName('Notes').AsString := Resource.Notes; + Qry.ParamByName('ResActive').AsBoolean := Resource.Active; + Qry.ParamByName('UserField0').AsString := Resource.UserField0; + Qry.ParamByName('UserField1').AsString := Resource.UserField1; + Qry.ParamByName('UserField2').AsString := Resource.UserField2; + Qry.ParamByName('UserField3').AsString := Resource.UserField3; + Qry.ParamByName('UserField4').AsString := Resource.UserField4; + Qry.ParamByName('UserField5').AsString := Resource.UserField5; + Qry.ParamByName('UserField6').AsString := Resource.UserField6; + Qry.ParamByName('UserField7').AsString := Resource.UserField7; + Qry.ParamByName('UserField8').AsString := Resource.UserField8; + Qry.ParamByName('UserField9').AsString := Resource.UserField9; + + Qry.ExecSQL; + end; + Resource.Changed := false; + end; + { if this is the active resource, then update all of its stuff } + if Resource.ResourceID = ResourceID then begin + PostEvents; + PostContacts; + PostTasks; + end; + end; + Resources.Sort; + NotifyDependents; + finally + Qry.Close; + Qry.Free; + end; + end; +end; +{=====} + +procedure TVpAdvDataStore.PostEvents; +var + I: Integer; + Event: TVpEvent; + Qry: TAdsQuery; +begin + if (Resource <> nil) and Resource.EventsDirty then begin + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDatabaseName; + Qry.RequestLive := true; + + for I := pred(Resource.Schedule.EventCount) downto 0 do begin + Event := Resource.Schedule.GetEvent(I); + if Event.Deleted then begin + Qry.SQL.Text := 'DELETE FROM Events ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Event.RecordID; + Qry.ExecSQL; + Event.Free; + Continue; + end + + else if Event.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Events ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Event.RecordID; + Qry.Open; + + if Qry.Locate('RecordID', Event.RecordID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('RecordID').AsInteger := Event.RecordID; + Qry.FieldByName('StartTime').AsDateTime := Event.StartTime; + Qry.FieldByName('EndTime').AsDateTime := Event.EndTime; + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('Description').AsString := Event.Description; + Qry.FieldByName('Notes').AsString := Event.Note; + Qry.FieldByName('Category').AsInteger := Event.Category; + Qry.FieldByName('DingPath').AsString := Event.AlarmWavPath; + Qry.FieldByName('AllDayEvent').AsBoolean := Event.AllDayEvent; + Qry.FieldByName('AlarmSet').AsBoolean := Event.AlarmSet; + Qry.FieldByName('AlarmAdvance').AsInteger := Event.AlarmAdv; + Qry.FieldByName('AlarmAdvanceType').AsInteger := Ord(Event.AlarmAdvType); + Qry.FieldByName('SnoozeTime').AsDateTime := Event.SnoozeTime; + Qry.FieldByName('RepeatCode').AsInteger := Ord(Event.RepeatCode); + Qry.FieldByName('RepeatRangeEnd').AsDateTime := Event.RepeatRangeEnd; + Qry.FieldByName('CustomInterval').AsInteger := Event.CustInterval; + Qry.FieldByName('UserField0').AsString := Event.UserField0; + Qry.FieldByName('UserField1').AsString := Event.UserField1; + Qry.FieldByName('UserField2').AsString := Event.UserField2; + Qry.FieldByName('UserField3').AsString := Event.UserField3; + Qry.FieldByName('UserField4').AsString := Event.UserField4; + Qry.FieldByName('UserField5').AsString := Event.UserField5; + Qry.FieldByName('UserField6').AsString := Event.UserField6; + Qry.FieldByName('UserField7').AsString := Event.UserField7; + Qry.FieldByName('UserField8').AsString := Event.UserField8; + Qry.FieldByName('UserField9').AsString := Event.UserField9; + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.Close; + Qry.SQL.Text := 'INSERT INTO Events ' + + '(RecordID, StartTime, EndTime, ResourceID, Description, Notes, ' + + 'SnoozeTime, Category, DingPath, AllDayEvent, AlarmSet, ' + + 'AlarmAdvance, AlarmAdvanceType, RepeatCode, ' + + 'RepeatRangeEnd, CustomInterval, ' + + 'UserField0, UserField1, UserField2, UserField3, UserField4, ' + + 'UserField5, UserField6, UserField7, UserField8, UserField9) ' + + 'VALUES(:RecID, :STime, :ETime, :ResID, :Desc, :Notes, :SnTime, ' + + ':Cat, :DPath, :ADEvent, :ASet, :AAdvance, :AAdvanceType, ' + + ':RCode, :RRangeEnd, :CInterval, :UserField0, ' + + ':UserField1, :UserField2, :UserField3, :UserField4, ' + + ':UserField5, :UserField6, :UserField7, :UserField8, ' + + ':UserField9)'; + + Qry.ParamByName('RecID').AsInteger := Event.RecordID; + Qry.ParamByName('STime').AsDateTime := Event.StartTime; + Qry.ParamByName('ETime').AsDateTime := Event.EndTime; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ParamByName('Desc').AsString := Event.Description; + Qry.ParamByName('Notes').AsString := Event.Note; + Qry.ParamByName('SnTime').AsDateTime := Event.SnoozeTime; + Qry.ParamByName('Cat').AsInteger := Event.Category; + Qry.ParamByName('DPath').AsString := Event.AlarmWavPath; + Qry.ParamByName('ADEvent').AsBoolean := Event.AllDayEvent; + Qry.ParamByName('ASet').AsBoolean := Event.AlarmSet; + Qry.ParamByName('AAdvance').AsInteger := Event.AlarmAdv; + Qry.ParamByName('AAdvanceType').AsInteger := Ord(Event.AlarmAdvType); + Qry.ParamByName('RCode').AsInteger := Ord(Event.RepeatCode); + Qry.ParamByName('RRangeEnd').AsDateTime := Event.RepeatRangeEnd; + Qry.ParamByName('CInterval').AsInteger := Event.CustInterval; + Qry.ParamByName('UserField0').AsString := Event.UserField0; + Qry.ParamByName('UserField1').AsString := Event.UserField1; + Qry.ParamByName('UserField2').AsString := Event.UserField2; + Qry.ParamByName('UserField3').AsString := Event.UserField3; + Qry.ParamByName('UserField4').AsString := Event.UserField4; + Qry.ParamByName('UserField5').AsString := Event.UserField5; + Qry.ParamByName('UserField6').AsString := Event.UserField6; + Qry.ParamByName('UserField7').AsString := Event.UserField7; + Qry.ParamByName('UserField8').AsString := Event.UserField8; + Qry.ParamByName('UserField9').AsString := Event.UserField9; + + Qry.ExecSQL; + end; + Event.Changed := false; + end; + end; + Resource.Schedule.Sort; + NotifyDependents; + finally + Qry.Close; + Qry.Free; + end; + Resource.EventsDirty := false; + end; +end; +{=====} + +procedure TVpAdvDataStore.PostContacts; +var + I: Integer; + Contact: TVpContact; + Qry: TAdsQuery; +begin + if (Resource <> nil) and Resource.ContactsDirty then begin + { Dump this resource's dirty contacts to the DB } + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDatabaseName; + Qry.RequestLive := true; + + for I := pred(Resource.Contacts.Count) downto 0 do begin + Contact := Resource.Contacts.GetContact(I); + + if Contact.Deleted then begin + Qry.SQL.Text := 'DELETE FROM Contacts ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Contact.RecordID; + Qry.ExecSQL; + Contact.Free; + Continue; + end + + else if Contact.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Contacts ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Contact.RecordID; + Qry.Open; + + if Qry.Locate('RecordID', Contact.RecordID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('RecordID').AsInteger := Contact.RecordID; + Qry.FieldByName('FirstName').AsString := Contact.FirstName; + Qry.FieldByName('LastName').AsString := Contact.LastName; + { - begin} + Qry.FieldByName('Birthdate').AsDateTime := Contact.BirthDate; + Qry.FieldByName('Anniversary').AsDateTime := Contact.Anniversary; + { - end} + Qry.FieldByName('Title').AsString := Contact.Title; + Qry.FieldByName('Company').AsString := Contact.Company; + Qry.FieldByName('Job_Position').AsString := Contact.Position; + Qry.FieldByName('EMail').AsString := Contact.EMail; + Qry.FieldByName('Address').AsString := Contact.Address; + Qry.FieldByName('City').AsString := Contact.City; + Qry.FieldByName('State').AsString := Contact.State; + Qry.FieldByName('Zip').AsString := Contact.Zip; + Qry.FieldByName('Country').AsString := Contact.Country; + Qry.FieldByName('Note').AsString := Contact.Note; + Qry.FieldByName('Phone1').AsString := Contact.Phone1; + Qry.FieldByName('Phone2').AsString := Contact.Phone2; + Qry.FieldByName('Phone3').AsString := Contact.Phone3; + Qry.FieldByName('Phone4').AsString := Contact.Phone4; + Qry.FieldByName('Phone5').AsString := Contact.Phone5; + Qry.FieldByName('PhoneType1').AsInteger := Contact.PhoneType1; + Qry.FieldByName('PhoneType2').AsInteger := Contact.PhoneType2; + Qry.FieldByName('PhoneType3').AsInteger := Contact.PhoneType3; + Qry.FieldByName('PhoneType4').AsInteger := Contact.PhoneType4; + Qry.FieldByName('PhoneType5').AsInteger := Contact.PhoneType5; + Qry.FieldByName('Category').AsInteger := Contact.Category; + Qry.FieldByName('Custom1').AsString := Contact.Custom1; + Qry.FieldByName('Custom2').AsString := Contact.Custom2; + Qry.FieldByName('Custom3').AsString := Contact.Custom3; + Qry.FieldByName('Custom4').AsString := Contact.Custom4; + Qry.FieldByName('UserField0').AsString := Contact.UserField0; + Qry.FieldByName('UserField1').AsString := Contact.UserField1; + Qry.FieldByName('UserField2').AsString := Contact.UserField2; + Qry.FieldByName('UserField3').AsString := Contact.UserField3; + Qry.FieldByName('UserField4').AsString := Contact.UserField4; + Qry.FieldByName('UserField5').AsString := Contact.UserField5; + Qry.FieldByName('UserField6').AsString := Contact.UserField6; + Qry.FieldByName('UserField7').AsString := Contact.UserField7; + Qry.FieldByName('UserField8').AsString := Contact.UserField8; + Qry.FieldByName('UserField9').AsString := Contact.UserField9; + + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.Close; + + { - Modified} + Qry.SQL.Text := 'INSERT INTO Contacts ' + + '(ResourceID, RecordID, FirstName, LastName, Birthdate, ' + + 'Anniversary, Title, Company, Job_Position, EMail, Address, ' + + 'City, State, Zip, Country, Note, Phone1, Phone2, Phone3, ' + + 'Phone4, Phone5, PhoneType1, PhoneType2, PhoneType3, PhoneType4, ' + + 'PhoneType5, Category, Custom1, Custom2, Custom3, Custom4, ' + + 'UserField0, UserField1, UserField2, UserField3, UserField4, ' + + 'UserField5, UserField6, UserField7, UserField8, UserField9 ) ' + + + 'VALUES(:ResourceID, :RecordID, :FirstName, :LastName, ' + + ':Birthdate, :Anniversary, :Title, :Company, :Job_Position, ' + + ':EMail, :Address, :City, :State, :Zip, :Country, :Note, ' + + ':Phone1, :Phone2, :Phone3, :Phone4, :Phone5, :PhoneType1, ' + + ':PhoneType2, :PhoneType3, :PhoneType4, :PhoneType5, :Category, ' + + ':Custom1, :Custom2, :Custom3, :Custom4, :UserField0, ' + + ':UserField1, :UserField2, :UserField3, :UserField4, :UserField5, ' + + ':UserField6, :UserField7, :UserField8, :UserField9)'; + + Qry.ParamByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.ParamByName('RecordID').AsInteger := Contact.RecordID; + Qry.ParamByName('FirstName').AsString := Contact.FirstName; + Qry.ParamByName('LastName').AsString := Contact.LastName; + { - begin} + Qry.ParamByName('Birthdate').AsDateTime := Contact.Birthdate; + Qry.ParamByName('Anniversary').AsDateTime := Contact.Anniversary; + { - end} + Qry.ParamByName('Title').AsString := Contact.Title; + Qry.ParamByName('Company').AsString := Contact.Company; + Qry.ParamByName('Job_Position').AsString := Contact.Position; + Qry.ParamByName('EMail').AsString := Contact.EMail; + Qry.ParamByName('Address').AsString := Contact.Address; + Qry.ParamByName('City').AsString := Contact.City; + Qry.ParamByName('State').AsString := Contact.State; + Qry.ParamByName('Zip').AsString := Contact.Zip; + Qry.ParamByName('Country').AsString := Contact.Country; + Qry.ParamByName('Note').AsString := Contact.Note; + Qry.ParamByName('Phone1').AsString := Contact.Phone1; + Qry.ParamByName('Phone2').AsString := Contact.Phone2; + Qry.ParamByName('Phone3').AsString := Contact.Phone3; + Qry.ParamByName('Phone4').AsString := Contact.Phone4; + Qry.ParamByName('Phone5').AsString := Contact.Phone5; + Qry.ParamByName('PhoneType1').AsInteger := Contact.PhoneType1; + Qry.ParamByName('PhoneType2').AsInteger := Contact.PhoneType2; + Qry.ParamByName('PhoneType3').AsInteger := Contact.PhoneType3; + Qry.ParamByName('PhoneType4').AsInteger := Contact.PhoneType4; + Qry.ParamByName('PhoneType5').AsInteger := Contact.PhoneType5; + Qry.ParamByName('Category').AsInteger := Contact.Category; + Qry.ParamByName('Custom1').AsString := Contact.Custom1; + Qry.ParamByName('Custom2').AsString := Contact.Custom2; + Qry.ParamByName('Custom3').AsString := Contact.Custom3; + Qry.ParamByName('Custom4').AsString := Contact.Custom4; + Qry.ParamByName('UserField0').AsString := Contact.UserField0; + Qry.ParamByName('UserField1').AsString := Contact.UserField1; + Qry.ParamByName('UserField2').AsString := Contact.UserField2; + Qry.ParamByName('UserField3').AsString := Contact.UserField3; + Qry.ParamByName('UserField4').AsString := Contact.UserField4; + Qry.ParamByName('UserField5').AsString := Contact.UserField5; + Qry.ParamByName('UserField6').AsString := Contact.UserField6; + Qry.ParamByName('UserField7').AsString := Contact.UserField7; + Qry.ParamByName('UserField8').AsString := Contact.UserField8; + Qry.ParamByName('UserField9').AsString := Contact.UserField9; + + Qry.ExecSQL; + end; + Contact.Changed := false; + end; + end; + + finally + Qry.Free; + end; + Resource.ContactsDirty := false; + end; +end; +{=====} + +procedure TVpAdvDataStore.PostTasks; +var + I: Integer; + Task: TVpTask; + Qry : TAdsQuery; +begin + if (Resource <> nil) and Resource.TasksDirty then begin + { Dump this resource's dirty contacts to the DB } + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDatabaseName; + Qry.RequestLive := true; + + for I := pred(Resource.Tasks.Count) downto 0 do begin + Task := Resource.Tasks.GetTask(I); + if Task.Deleted then begin + Qry.SQL.Text := 'DELETE FROM Tasks ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Task.RecordID; + Qry.ExecSQL; + Task.Free; + Continue; + end + + else if Task.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Tasks ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Task.RecordID; + Qry.Open; + + if Qry.Locate('RecordID', Task.RecordID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('Description').AsString := Task.Description; + Qry.FieldByName('Details').AsString := Task.Details; + Qry.FieldByName('Complete').AsBoolean := Task.Complete; + Qry.FieldByName('DueDate').AsDateTime := Task.DueDate; + Qry.FieldByName('CreatedOn').AsDateTime := Task.CreatedOn; + Qry.FieldByName('CompletedOn').AsDateTime := Task.CompletedOn; + Qry.FieldByName('Priority').AsInteger := Task.Priority; + Qry.FieldByName('Category').AsInteger := Task.Category; + Qry.FieldByName('UserField0').AsString := Task.UserField0; + Qry.FieldByName('UserField1').AsString := Task.UserField1; + Qry.FieldByName('UserField2').AsString := Task.UserField2; + Qry.FieldByName('UserField3').AsString := Task.UserField3; + Qry.FieldByName('UserField4').AsString := Task.UserField4; + Qry.FieldByName('UserField5').AsString := Task.UserField5; + Qry.FieldByName('UserField6').AsString := Task.UserField6; + Qry.FieldByName('UserField7').AsString := Task.UserField7; + Qry.FieldByName('UserField8').AsString := Task.UserField8; + Qry.FieldByName('UserField9').AsString := Task.UserField9; + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.Close; + Qry.SQL.Text := 'INSERT INTO Tasks ' + + '(RecordID, ResourceID, Description, Details, ' + + 'Complete, DueDate, CreatedOn, CompletedOn, Priority, Category, ' + + 'UserField0, UserField1, UserField2, UserField3, UserField4, ' + + 'UserField5, UserField6, UserField7, UserField8, UserField9) ' + + + 'VALUES(:RecordID, :ResourceID, :Description, :Details, ' + + ':Complete, :DueDate, :CreatedOn, :CompletedOn, :Priority, ' + + ':Category, :UserField0, :UserField1, :UserField2, :UserField3, ' + + ':UserField4, :UserField5, :UserField6, :UserField7, ' + + ':UserField8, :UserField9)'; + + Qry.ParamByName('RecordID').AsInteger := Task.RecordID; + Qry.ParamByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.ParamByName('Description').AsString := Task.Description; + Qry.ParamByName('Details').AsString := Task.Details; + Qry.ParamByName('Complete').AsBoolean := Task.Complete; + Qry.ParamByName('DueDate').AsDateTime := Task.DueDate; + Qry.ParamByName('CreatedOn').AsDateTime := Task.CreatedOn; + Qry.ParamByName('CompletedOn').AsDateTime := Task.CompletedOn; + Qry.ParamByName('Priority').AsInteger := Task.Priority; + Qry.ParamByName('Category').AsInteger := Task.Category; + Qry.ParamByName('UserField0').AsString := Task.UserField0; + Qry.ParamByName('UserField1').AsString := Task.UserField1; + Qry.ParamByName('UserField2').AsString := Task.UserField2; + Qry.ParamByName('UserField3').AsString := Task.UserField3; + Qry.ParamByName('UserField4').AsString := Task.UserField4; + Qry.ParamByName('UserField5').AsString := Task.UserField5; + Qry.ParamByName('UserField6').AsString := Task.UserField6; + Qry.ParamByName('UserField7').AsString := Task.UserField7; + Qry.ParamByName('UserField8').AsString := Task.UserField8; + Qry.ParamByName('UserField9').AsString := Task.UserField9; + Qry.ExecSQL; + end; + Task.Changed := false; + end + end; + + finally + Qry.Free; + end; + + Resource.TasksDirty := false; + end; +end; +{=====} + +procedure TVpAdvDataStore.PurgeResource(Res: TVpResource); +begin + Resource.Deleted := true; + PostResources; + Load; +end; +{=====} + +procedure TVpAdvDataStore.PurgeEvents(Res: TVpResource); +var + Qry: TAdsQuery; +begin + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDataBaseName; + + Qry.SQL.Text := 'delete from Events where ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + finally + Qry.Free; + end; + Resource.Schedule.ClearEvents; +end; +{=====} + +procedure TVpAdvDataStore.PurgeContacts(Res: TVpResource); +var + Qry: TAdsQuery; +begin + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDataBaseName; + + Qry.SQL.Text := 'delete from Contacts where ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + finally + Qry.Free; + end; + Resource.Contacts.ClearContacts; +end; +{=====} + +procedure TVpAdvDataStore.PurgeTasks(Res: TVpResource); +var + Qry: TAdsQuery; +begin + Qry := TAdsQuery.Create(self); + try + Qry.DatabaseName := FDataBaseName; + + Qry.SQL.Text := 'delete from Tasks where ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + finally + Qry.Free; + end; + Resource.Tasks.ClearTasks; +end; +{=====} + +procedure TVpAdvDataStore.SetConnected(const Value: boolean); +var + TmpTable: TAdsTable; +begin + { disconnect if destroying } + if csDestroying in ComponentState then begin + Exit; + end; + + { Don't connect at designtime } + if csDesigning in ComponentState then Exit; + + { Don't try to connect until we're all loaded up } + if csLoading in ComponentState then Exit; + + { we are attempting a disconnect } + if not Value then begin + FResourceTable.Close; + FEventsTable.Close; + FContactsTable.Close; + FTasksTable.Close; + FRecordIDTable.Close; + Exit; + end; + + { By default, put the data directory in the same place as the application } + { executable. } + if FDatabaseName = '' then + FDatabaseName := ExtractFilePath(ParamStr(0)) + 'Data'; + + if not DirectoryExists(FDatabaseName) then + ForceDirectories(FDatabaseName); + + TmpTable := TAdsTable.Create(self); + + try + TmpTable.DatabaseName := FDatabaseName; + + { Create / Open Resources Table} + FResourceTable.DatabaseName := FDatabaseName; + + {See of the Resources table exists} + TmpTable.TableName := ResourceTableName; + if not TmpTable.Exists then + CreateTable(ResourceTableName); + + try + FResourceTable.Open; + except + if AutoCreate then begin + CreateTable(ResourceTableName); + FResourceTable.Open; + end; + end; + + { Create / Open Events Table } + FEventsTable.DatabaseName := FDatabaseName; + + {See of the Events table exists} + TmpTable.TableName := EventsTableName; + if not TmpTable.Exists then + CreateTable(EventsTableName); + + SetFilterCriteria(FEventsTable, + True, + ResourceTable.FieldByName('ResourceID').AsInteger, + TimeRange.StartTime, + TimeRange.EndTime); + try + FEventsTable.Open; + except + if AutoCreate then begin + CreateTable(EventsTableName); + FEventsTable.Open; + end; + end; + + { Create / Open Contacts Table } + FContactsTable.DatabaseName := FDatabaseName; + + {See of the Contacts table exists} + TmpTable.TableName := ContactsTableName; + if not TmpTable.Exists then + CreateTable(ContactsTableName); + + SetFilterCriteria(FContactsTable, False, + ResourceTable.FieldByName('ResourceID').AsInteger, + 0, 0); + try + FContactsTable.Open; + except + if AutoCreate then begin + CreateTable(ContactsTableName); + FContactsTable.Open; + end; + end; + + + { Create / Open Tasks Table } + FTasksTable.DatabaseName := FDatabaseName; + + {See of the Tasks table exists} + TmpTable.TableName := TasksTableName; + if not TmpTable.Exists then + CreateTable(TasksTableName); + + SetFilterCriteria(FTasksTable, False, + ResourceTable.FieldByName('ResourceID').AsInteger, + 0, 0); + try + FTasksTable.Open; + except + if AutoCreate then begin + CreateTable(TasksTableName); + FTasksTable.Open; + end; + end; + + { Create / Open RecordID Table } + FRecordIDTable.DatabaseName := FDatabaseName; + {See of the Resources table exists} + TmpTable.TableName := RecordIDTableName; + if not TmpTable.Exists then + CreateTable(RecordIDTableName); + + finally + TmpTable.Free; + end; + + Load; + + inherited SetConnected(GetConnected); +end; +{=====} + +procedure TVpAdvDataStore.SetDatabaseName(const Value: string); +var + ConStatus: Boolean; +begin + if FDatabaseName <> Value then begin + ConStatus := Connected; + Connected := false; + FDatabaseName := Value; + Connected := ConStatus; + end; +end; +{=====} + +procedure TVpAdvDataStore.SetParams(const Value: TStrings); +begin + FParams.Assign(Value); +end; +{=====} + +{ Called by the ancestor to properly filter the data for each table, } +{ based on the ResourceID, Date and DayBuffer values. } +{ Each TVpCustomDBDataStore descendant should define their own } +{ SetFilterCriteria procedure. } +procedure TVpAdvDataStore.SetFilterCriteria(aTable : TDataset; + aUseDateTime : Boolean; aResourceID : Integer; aStartDateTime : TDateTime; + aEndDateTime : TDateTime); +var + Qry: TAdsQuery; +begin + Qry := (aTable as TAdsQuery); + + Qry.Close; + + Qry.ParamByName('ResID').AsInteger := aResourceID; + + if Qry = EventsTable then begin + Qry.ParamByName('STime').AsDateTime := aStartDateTime; + Qry.ParamByName('ETime').AsDateTime := aEndDateTime; + end; + + Qry.Open; +end; +{=====} + +procedure TVpAdvDataStore.CreateIndexDefs(const TableName: string; + IndexDefs: TIndexDefs); +begin + if TableName = ResourceTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'ResourceID'; + Options := [ixPrimary]; + end; + end; + end else if TableName = EventsTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'RecordID'; + Options := [ixUnique, ixPrimary]; + end; + end; + end else if TableName = ContactsTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'RecordID'; + Options := [ixPrimary]; + end; + end; + end else if TableName = TasksTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'RecordID'; + Options := [ixPrimary]; + end; + end; + end; + + inherited CreateIndexDefs(TableName, IndexDefs); +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpalarmdlg.lfm b/components/tvplanit/source/vpalarmdlg.lfm new file mode 100644 index 000000000..6821096d2 --- /dev/null +++ b/components/tvplanit/source/vpalarmdlg.lfm @@ -0,0 +1,154 @@ +object AlarmNotifyForm: TAlarmNotifyForm + Left = 225 + Height = 207 + Top = 143 + Width = 405 + HorzScrollBar.Page = 404 + VertScrollBar.Page = 206 + BorderStyle = bsToolWindow + Caption = 'Reminder' + ClientHeight = 207 + ClientWidth = 405 + Color = clInfoBk + Font.Height = -11 + Font.Name = 'MS Sans Serif' + KeyPreview = True + OnKeyDown = FormKeyDown + OnShow = FormShow + Position = poDefault + object Bevel1: TBevel + Left = 312 + Height = 161 + Top = 8 + Width = 89 + end + object Bevel2: TBevel + Left = 4 + Height = 38 + Top = 168 + Width = 397 + end + object SubjectCaption: TLabel + Left = 8 + Height = 14 + Top = 3 + Width = 74 + Caption = 'SubjectCaption' + ParentColor = False + end + object NotesCaption: TLabel + Left = 8 + Height = 14 + Top = 48 + Width = 66 + Caption = 'NotesCaption' + ParentColor = False + end + object SnoozeCaption: TLabel + Left = 10 + Height = 13 + Top = 181 + Width = 276 + Alignment = taRightJustify + AutoSize = False + Caption = 'SnoozeCaption' + ParentColor = False + end + object DismissBtn: TButton + Left = 320 + Height = 25 + Top = 16 + Width = 75 + Caption = 'DismissBtn' + OnClick = DismissBtnClick + TabOrder = 2 + end + object SnoozeBtn: TButton + Left = 320 + Height = 25 + Top = 48 + Width = 75 + Caption = 'SnoozeBtn' + OnClick = SnoozeBtnClick + TabOrder = 3 + end + object OpenItemBtn: TButton + Left = 320 + Height = 25 + Top = 96 + Width = 75 + Caption = 'OpenItemBtn' + OnClick = OpenItemBtnClick + TabOrder = 4 + end + object SubjectEdit: TEdit + Left = 8 + Height = 21 + Top = 19 + Width = 297 + ReadOnly = True + TabOrder = 0 + end + object NotesMemo: TMemo + Left = 8 + Height = 97 + Top = 64 + Width = 297 + Lines.Strings = ( + '1' + '2' + '3' + '4' + '5' + '6' + ) + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + end + object SnoozeCombo: TComboBox + Left = 290 + Height = 21 + Top = 178 + Width = 106 + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + ItemHeight = 13 + Items.Strings = ( + '5 Minutes' + '10 Minutes' + '15 Minutes' + '30 Minutes' + '45 Minutes' + '1 Hours' + '2 Hours' + '3 Hours' + '4 Hours' + '5 Hours' + '6 Hours' + '7 Hours' + '8 Hours' + '1 Days' + '2 Days' + '3 Days' + '4 Days' + '5 Days' + '6 Days' + '1 Week' + ) + OnChange = SnoozeComboChange + ParentColor = True + Style = csDropDownList + TabOrder = 5 + end + object EventDialog: TVpEventEditDialog + Version = 'v1.03' + TimeFormat = tf24Hour + Placement.Position = mpCenterTop + Placement.Top = 10 + Placement.Left = 10 + Placement.Height = 412 + Placement.Width = 705 + left = 272 + top = 8 + end +end diff --git a/components/tvplanit/source/vpalarmdlg.pas b/components/tvplanit/source/vpalarmdlg.pas new file mode 100644 index 000000000..c902c0569 --- /dev/null +++ b/components/tvplanit/source/vpalarmdlg.pas @@ -0,0 +1,267 @@ +{*********************************************************} +{* VPALARMDLG.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpAlarmDlg; + { Alarm Notification Dialog } + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + VpDlg, VpData, ExtCtrls, StdCtrls, VpBase, VpEvntEditDlg, VpBaseDS, VpConst, + VpMisc; + +type + { forward declarations } + TVpNotificationDialog = class; + + TAlarmNotifyForm = class(TForm) + DismissBtn: TButton; + SnoozeBtn: TButton; + OpenItemBtn: TButton; + Bevel1: TBevel; + Bevel2: TBevel; + SubjectCaption: TLabel; + NotesCaption: TLabel; + SnoozeCaption: TLabel; + SubjectEdit: TEdit; + NotesMemo: TMemo; + SnoozeCombo: TComboBox; + EventDialog: TVpEventEditDialog; + procedure SnoozeComboChange(Sender: TObject); + procedure SnoozeBtnClick(Sender: TObject); + procedure DismissBtnClick(Sender: TObject); + procedure OpenItemBtnClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure FormShow(Sender: TObject); + private + SnoozeDelay: TDateTime; + ShowTime : TDateTime; + + procedure CalcSnooze; + public + Event: TVpEvent; + DataStore: TVpCustomDataStore; + procedure PopulateSelf; + end; + + TVpNotificationDialog = class(TVpBaseDialog) + protected {private} + FBGColor : TColor; + ceEditDlg : TAlarmNotifyForm; + ceTask : TVpTask; + public + constructor Create(AOwner : TComponent); override; + procedure Execute(Event: TVpEvent); reintroduce; + published + {properties} + property BackgroundColor: TColor + read FBGColor write FBGColor default clInfoBk; + property DataStore; + property Placement; + end; + +implementation + +{$IFNDEF LCL} +{$R *.DFM} +{$ENDIF} + +uses VpSR; + +{ TVpNotificationDialog } + +constructor TVpNotificationDialog.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + FBGColor := clInfoBk; + FPlacement.Position := mpCustom; + FPlacement.Width := 412; +end; +{=====} + + +procedure TVpNotificationDialog.Execute(Event: TVpEvent); +var + AlarmNotifyForm: TAlarmNotifyForm; +begin + if (Event <> nil) and (not Event.AlertDisplayed) then begin + Application.CreateForm(TAlarmNotifyForm, AlarmNotifyForm); + try + DoFormPlacement(AlarmNotifyForm); + AlarmNotifyForm.Color := BackgroundColor; + AlarmNotifyForm.DataStore := DataStore; + AlarmNotifyForm.Event := Event; + AlarmNotifyForm.PopulateSelf; + Event.AlertDisplayed := true; + try + AlarmNotifyForm.ShowModal; + finally + Event.AlertDisplayed := false; + end; + if Event.Changed then + DataStore.PostEvents; + finally + AlarmNotifyForm.Release; + end; + end; +end; +{=====} + +{ TAlarmNotifyForm } + +procedure TAlarmNotifyForm.PopulateSelf; +begin + if Event <> nil then begin + Caption := RSReminder; + SubjectCaption.Caption := RSSubjectCaption; + NotesCaption.Caption := RSNotesCaption; + SnoozeCaption.Caption := RSSnoozeCaption; + DismissBtn.Caption := RSDismissBtn; + SnoozeBtn.Caption := RSSnoozeBtn; + OpenItemBtn.Caption := RSOpenItemBtn; + NotesMemo.Text := Event.Note; + SubjectEdit.Text := Event.Description; + + if Now > Event.StartTime then + Self.Caption := RSOverdue + ' : ' + else + Self.Caption := RSReminder + ' : '; + + Self.Caption := Self.Caption + FormatDateTime(ShortDateFormat + ' ' + + ShortTimeFormat, Event.StartTime); + + SnoozeCombo.Items.Clear; + SnoozeCombo.Items.Add(RS5Minutes); + SnoozeCombo.Items.Add(RS10Minutes); + SnoozeCombo.Items.Add(RS15Minutes); + SnoozeCombo.Items.Add(RS30Minutes); + SnoozeCombo.Items.Add(RS45Minutes); + SnoozeCombo.Items.Add(RS1Hour); + SnoozeCombo.Items.Add(RS2Hours); + SnoozeCombo.Items.Add(RS3Hours); + SnoozeCombo.Items.Add(RS4Hours); + SnoozeCombo.Items.Add(RS5Hours); + SnoozeCombo.Items.Add(RS6Hours); + SnoozeCombo.Items.Add(RS7Hours); + SnoozeCombo.Items.Add(RS8Hours); + SnoozeCombo.Items.Add(RS1Days); + SnoozeCombo.Items.Add(RS2Days); + SnoozeCombo.Items.Add(RS3Days); + SnoozeCombo.Items.Add(RS4Days); + SnoozeCombo.Items.Add(RS5Days); + SnoozeCombo.Items.Add(RS6Days); + SnoozeCombo.Items.Add(RS1Week); + SnoozeCombo.ItemIndex := 0; + SnoozeDelay := 5 / MinutesInDay; + ShowTime := Now; + end; +end; +{=====} + + +procedure TAlarmNotifyForm.SnoozeComboChange(Sender: TObject); +begin + case SnoozeCombo.ItemIndex of + 0 : SnoozeDelay := 5 / MinutesInDay; { 5 minutes } + 1 : SnoozeDelay := 10 / MinutesInDay; {10 Minutes } + 2 : SnoozeDelay := 15 / MinutesInDay; {15 Minutes } + 3 : SnoozeDelay := 30 / MinutesInDay; {30 Minutes } + 4 : SnoozeDelay := 45 / MinutesInDay; {45 Minutes } + 5 : SnoozeDelay := 60 / MinutesInDay; {1 Hour } + 6 : SnoozeDelay := 120 / MinutesInDay; {2 Hours } + 7 : SnoozeDelay := 180 / MinutesInDay; {3 Hours } + 8 : SnoozeDelay := 240 / MinutesInDay; {4 Hours } + 9 : SnoozeDelay := 300 / MinutesInDay; {5 Hours } + 10: SnoozeDelay := 360 / MinutesInDay; {6 Hours } + 11: SnoozeDelay := 420 / MinutesInDay; {7 Hours } + 12: SnoozeDelay := 480 / MinutesInDay; {8 Hours } + 13: SnoozeDelay := 1.0; {1 day } + 14: SnoozeDelay := 2.0; {2 day } + 15: SnoozeDelay := 3.0; {3 day } + 16: SnoozeDelay := 4.0; {4 day } + 17: SnoozeDelay := 5.0; {5 day } + 18: SnoozeDelay := 6.0; {6 day } + 19: SnoozeDelay := 7.0; {1 week } + end; +end; +{=====} + +procedure TAlarmNotifyForm.SnoozeBtnClick(Sender: TObject); +begin + CalcSnooze; + Close; +end; +{=====} + +procedure TAlarmNotifyForm.DismissBtnClick(Sender: TObject); +begin + Event.AlarmSet := false; + Close; +end; +{=====} + +procedure TAlarmNotifyForm.OpenItemBtnClick(Sender: TObject); +begin + Self.Hide; + EventDialog.DataStore := DataStore; + EventDialog.Execute(Event); + Close; +end; +{=====} + +procedure TAlarmNotifyForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then begin + CalcSnooze; + Close; + end; +end; +{=====} + +procedure TAlarmNotifyForm.CalcSnooze; +begin + Event.SnoozeTime := Now + SnoozeDelay; +end; +{=====} +procedure TAlarmNotifyForm.FormShow(Sender: TObject); +begin + OpenItemBtn.SetFocus; +end; + +end. + diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas new file mode 100644 index 000000000..2d7cedfd8 --- /dev/null +++ b/components/tvplanit/source/vpbase.pas @@ -0,0 +1,967 @@ +{*********************************************************} +{* VPBASE.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpBase; + +{$IFDEF WINDOWS} +{$R VpBASE.RES} +{$ENDIF} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType, + {$ELSE} + Windows, + {$ENDIF} + Messages,Classes, Graphics, Controls, Dialogs, Forms, StdCtrls, + ExtCtrls, SysUtils, VpConst, + VpSR; + +const + {Message base} + Vp_First = $7DF0; {Sets base for all Vp messages} + +const + {Custom message types} + Vp_PrintFormatChanged = Vp_First + 1; {Print formats have changed} + Vp_DataStoreChanged = Vp_First + 2; {Data Store has changed} + Vp_DayViewInit = Vp_First + 3; {Initialize the DayView} + +type + TVpRotationAngle = (ra0, ra90, ra180, ra270); + TVpItemMeasurement = (imAbsolutePixel, imPercent, imInches); + TVpItemType = (itDayView, itWeekView, itMonthView, itCalendar, + itShape, itCaption, itTasks, itContacts); + + TVpHours = (h_00, h_01, h_02, h_03, h_04, h_05, h_06, h_07, h_08, + h_09, h_10, h_11, h_12, h_13, h_14, h_15, h_16, h_17, + h_18, h_19, h_20, h_21, h_22, h_23); + + TVpGranularity = (gr05Min, gr06Min, gr10Min, gr15Min, gr20Min, gr30Min, + gr60Min); + + TVpEditorReturnCode = (rtCommit, rtAbandon); + + TVpCheckStyle = (csX, csCheck); + + TVpTimeFormat = (tf24Hour, tf12Hour); + + { XML definitions } + DOMString = WideString; + + { miscellaneous stuff } + TVpDrawingStyle = (dsFlat, ds3d); + + { event method types } + TVpMouseWheelEvent = procedure(Sender : TObject; Shift : TShiftState; + Delta, XPos, YPos : Word) of object; + + TVpOwnerDrawEvent = procedure(Sender: TObject; const Canvas: TCanvas; + R: TRect; var Drawn: Boolean) of object; + + TVpOwnerDrawRowEvent = procedure(Sender: TObject; const Canvas: TCanvas; + R: TRect; RowHeight: Integer; var Drawn: Boolean) of object; + + TVpOwnerDrawDayEvent = procedure(Sender: TObject; const Canvas: TCanvas; + R: TRect; Day: Integer; var Drawn: Boolean) of object; + + TVpItemSelectedEvent = procedure(Sender : TObject; + Index : Integer) of object; + + TVpGetEditorCaption = procedure(var Caption : string) of object; + + + { XML exceptions } + EXML = class (Exception); + + EVpStreamError = class(EXML) + private + seFilePos : Longint; + public + constructor CreateError(const FilePos : Longint; + const Reason : DOMString); + property FilePos : Longint + read seFilePos; + end; + + EVpFilterError = class(EVpStreamError) + private + feReason : DOMString; + feLine : Longint; + feLinePos : Longint; + public + constructor CreateError(const FilePos, Line, LinePos : Longint; + const Reason : DOMString); + property Reason : DOMString + read feReason; + property Line : Longint + read feLine; + property LinePos : Longint + read feLinePos; + end; + + EVpParserError = class(EVpFilterError) + protected + public + constructor CreateError(Line, LinePos : Longint; + const Reason : DOMString); + end; + + { implements the Version property with its associated design time About box } + TVpComponent = class(TComponent) + protected { private } + function GetVersion : string; + procedure SetVersion(const Value : string); + public + constructor Create(AOwner: TComponent); override; + published + { properties } + property Version : string read GetVersion write SetVersion stored False; + end; + + { Ancestor for all Visual PlanIt visual controls } + TVpCustomControl = class(TCustomControl) + protected { private } + FAfterEnter : TNotifyEvent; + FAfterExit : TNotifyEvent; + FOnMouseWheel : TVpMouseWheelEvent; + FAutoScroll : Boolean; + function GetVersion : string; + procedure SetVersion(const Value : string); + procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED; + {$IFNDEF LCL} + procedure WMMouseWheel(var Msg : TMessage); message WM_MOUSEWHEEL; + {$ELSE} + procedure WMMouseWheel(var Msg : TLMessage); message LM_MOUSEWHEEL; + {$ENDIF} + + protected + procedure DoOnMouseWheel(Shift : TShiftState; + Delta, XPos, YPos : SmallInt); dynamic; + procedure CreateWnd; override; + property AfterEnter : TNotifyEvent read FAfterEnter write FAfterEnter; + property AfterExit : TNotifyEvent read FAfterExit write FAfterExit; + property OnMouseWheel : TVpMouseWheelEvent read FOnMouseWheel + write FOnMouseWheel; + + public + constructor Create (AOwner : TComponent); override; + + published + property Version : string read GetVersion write SetVersion stored False; + {$IFNDEF LCL} + {$IFDEF VERSION6} + property BevelEdges; + property BevelInner; + property BevelOuter; + property BevelKind; + property BevelWidth; + {$ENDIF} + {$ENDIF} + + { The Hint property is published in TControl, but the ShowHint } + { property is left public. odd. } + { surfacing here will make it published in all our descendants } + property ShowHint; + end; + + TVpPersistent = class(TPersistent) + public + procedure Invalidate; virtual; abstract; + end; + + {TVpCategoryColorMap} + TVpCategoryInfo= class(TPersistent) + private + FCategoryIndex: Integer; + protected + FBackgroundColor : TColor; + FColor : TColor; + FDescription : string; + FIndex : Integer; + FBitmap : TBitmap; + procedure SetBackgroundColor (const v : TColor); + procedure SetBitmap (v : TBitmap); + procedure SetColor(Value: TColor); + procedure SetDescription(Value: string); + public + constructor Create; + destructor Destroy; override; + published + property BackgroundColor : TColor + read FBackgroundColor write SetBackgroundColor + default clWindow; + property Bitmap : TBitmap read FBitmap write SetBitmap; + property Color: TColor read FColor write SetColor; + property Description: string read FDescription write SetDescription; + property CategoryIndex: Integer read FCategoryIndex; + end; + + TVpCategoryColorMap = class(TPersistent) + protected + FCat0 : TVpCategoryInfo; + FCat1 : TVpCategoryInfo; + FCat2 : TVpCategoryInfo; + FCat3 : TVpCategoryInfo; + FCat4 : TVpCategoryInfo; + FCat5 : TVpCategoryInfo; + FCat6 : TVpCategoryInfo; + FCat7 : TVpCategoryInfo; + FCat8 : TVpCategoryInfo; + FCat9 : TVpCategoryInfo; + public + constructor Create; + destructor Destroy; override; + function GetColor(Index: Integer): TColor; + function GetName(Index: Integer):string; + published + property Category0 : TVpCategoryInfo read FCat0 write FCat0; + property Category1 : TVpCategoryInfo read FCat1 write FCat1; + property Category2 : TVpCategoryInfo read FCat2 write FCat2; + property Category3 : TVpCategoryInfo read FCat3 write FCat3; + property Category4 : TVpCategoryInfo read FCat4 write FCat4; + property Category5 : TVpCategoryInfo read FCat5 write FCat5; + property Category6 : TVpCategoryInfo read FCat6 write FCat6; + property Category7 : TVpCategoryInfo read FCat7 write FCat7; + property Category8 : TVpCategoryInfo read FCat8 write FCat8; + property Category9 : TVpCategoryInfo read FCat9 write FCat9; + end; + + { TVpFont } + TVpFont = class(TFont) + protected + FOwner: TObject; + procedure Changed; override; + public + constructor Create(AOwner: TObject); virtual; + property Owner: TObject read FOwner write FOwner; + end; + + { Collections } + TVpCollectionItem = class(TCollectionItem) + protected { private } + FName: String; + FDisplayText: String; + function GetVersion: String; + procedure SetVersion(const Value: String); + procedure SetName(Value: String); virtual; + public + property DisplayText : string read FDisplayText write FDisplayText; + property Name: String read FName write SetName; + published + property Version : String read GetVersion write SetVersion; + end; + + TVpCollection = class(TCollection) + protected { private } + { property variables } + FItemEditor : TForm; + FReadOnly : Boolean; + FOwner : TPersistent; + { event variables } + FOnChanged : TNotifyEvent; + FOnItemSelected : TVpItemSelectedEvent; + FOnGetEditorCaption : TVpGetEditorCaption; + { Internal variables } + InLoaded : Boolean; + IsLoaded : Boolean; + InChanged : Boolean; + protected + function GetCount : Integer; + procedure Loaded; + public + constructor Create(AOwner : TPersistent; + ItemClass : TCollectionItemClass); virtual; + destructor Destroy; override; + property ItemEditor : TForm read FItemEditor write FItemEditor; + function Add : TVpCollectionItem; dynamic; + {$IFNDEF VERSION4} + function Insert(Index: Integer): TVpCollectionItem; dynamic; + {$ENDIF} + function GetItem(Index: Integer): TVpCollectionItem; + function GetOwner: TPersistent; override; + procedure SetItem(Index: Integer; Value: TVpCollectionItem); + procedure DoOnItemSelected(Index : Integer); + function GetEditorCaption : string; + function ItemByName(const Name : string) : TVpCollectionItem; + function ParentForm : TForm; + property Count: Integer read GetCount; + property Item[Index: Integer] : TVpCollectionItem + read GetItem write SetItem; default; + property OnGetEditorCaption : TVpGetEditorCaption + read FOnGetEditorCaption write FOnGetEditorCaption; + property ReadOnly : Boolean + read FReadOnly write FReadOnly default False; + property OnChanged : TNotifyEvent + read FOnChanged write FOnChanged; + property OnItemSelected : TVpItemSelectedEvent + read FOnItemSelected write FOnItemSelected; + end; + + TVpContainerList = class(TList) + protected{ private } + FOwner: TComponent; + public + constructor Create(AOwner: TComponent); virtual; + destructor Destroy; override; + end; + { End - Collections } + + TVpTimeRange = class(TPersistent) + protected{private} + FOwner: TObject; + FStartTime: TDateTime; + FEndTime: TDateTime; + FRangeBegin: TVpHours; + FRangeEnd: TVpHours; + procedure SetRangeBegin(const Value: TVpHours); + procedure SetRangeEnd(const Value: TVpHours); + procedure SetEndTime(const Value: TDateTime); + procedure SetStartTime(const Value: TDateTime); + public + constructor Create(aOwner: TObject); + destructor Destroy; override; + property StartTime: TDateTime read FStartTime write SetStartTime; + property EndTime: TDateTime read FEndTime write SetEndTime; + published + property RangeBegin: TVpHours read FRangeBegin write SetRangeBegin; + property RangeEnd: TVpHours read FRangeEnd write SetRangeEnd; + end; + + TVpTimeSlotColor = class(TPersistent) + protected { private } + FOwner: TVpCustomControl; + FActiveRange: TVpTimeRange; + FInactive: TColor; + FHoliday: TColor; + FWeekend: TColor; + FActive: TColor; + FWeekday: TColor; + procedure SetActive(const Value: TColor); + procedure SetHoliday(const Value: TColor); + procedure SetInactive(const Value: TColor); + procedure SetWeekday(const Value: TColor); + procedure SetWeekend(const Value: TColor); + public + constructor Create(AOwner: TVpCustomControl); + destructor Destroy; override; + procedure Changed; + published + property Active: TColor read FActive write SetActive; + property Inactive: TColor read FInactive write SetInactive; + property Holiday: TColor read FHoliday write SetHoliday; + property Weekday: TColor read FWeekday write SetWeekday; + property Weekend: TColor read FWeekend write SetWeekend; + property ActiveRange: TVpTimeRange + read FActiveRange write FActiveRange; + end; + +implementation + +uses + Math + {$IFNDEF LCL} + , CommCtrl + {$ENDIF} + ; + +{ EAdStreamError } + +constructor EVpStreamError.CreateError(const FilePos: Integer; + const Reason: DOMString); +begin + inherited Create (Reason); + seFilePos := FilePos; +end; + +{ EAdFilterError } + +constructor EVpFilterError.CreateError(const FilePos, Line, + LinePos: Integer; const Reason: DOMString); +begin + inherited CreateError(FilePos, Reason); + + feLine := Line; + feLinePos := LinePos; + feReason := Reason; +end; + +{ EAdParserError } + +constructor EVpParserError.CreateError(Line, LinePos: Integer; + const Reason: DOMString); +begin + inherited CreateError(FilePos, Line, LinePos, Reason); +end; + +(*****************************************************************************) +{ TVpCustomControl } + +constructor TVpCustomControl.Create (AOwner : TComponent); +begin + inherited Create (AOwner); + TabStop := True; +end; +{=====} + +procedure TVpCustomControl.CMVisibleChanged(var Msg: TMessage); +begin + inherited; + if csLoading in ComponentState then + Exit; +end; +{=====} + +procedure TVpCustomControl.CreateWnd; +begin + inherited CreateWnd; +end; +{=====} + +procedure TVpCustomControl.DoOnMouseWheel(Shift: TShiftState; Delta, XPos, + YPos: SmallInt); +begin + if Assigned(FOnMouseWheel) then + FOnMouseWheel(Self, Shift, Delta, XPos, YPos); +end; +{=====} + +function TVpCustomControl.GetVersion: string; +begin + Result := VpVersionStr; +end; +{=====} + +procedure TVpCustomControl.SetVersion(const Value: string); +begin +// This method left intentionally blank. +end; +{=====} + +{$IFNDEF LCL} +procedure TVpCustomControl.WMMouseWheel(var Msg: TMessage); +{$ELSE} +procedure TVpCustomControl.WMMouseWheel(var Msg: TLMessage); +{$ENDIF} +begin + with Msg do + DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys}, + HIWORD(wParam) {zDelta}, + LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos}); +end; +{=====} + +(*****************************************************************************) +{ TVpCollection } + +constructor TVpCollection.Create(AOwner : TPersistent; + ItemClass : TCollectionItemClass); +begin + FOwner := AOwner; + Inherited Create(ItemClass); +end; +{=====} + +destructor TVpCollection.Destroy; +begin + ItemEditor.Free; + Clear; + inherited Destroy; +end; +{=====} + +procedure TVpCollection.DoOnItemSelected(Index : Integer); +begin + if Assigned(FOnItemSelected) then + FOnItemSelected(Self, Index); +end; +{=====} + +function TVpCollection.GetCount : Integer; +begin + Result := inherited Count; +end; +{=====} + +function TVpCollection.GetEditorCaption : string; +begin + Result := 'Editing ' + ClassName; + if Assigned(FOnGetEditorCaption) then + FOnGetEditorCaption(Result); +end; +{=====} + +function TVpCollection.Add : TVpCollectionItem; +begin + Result := TVpCollectionItem(inherited Add); + if ItemEditor <> nil then +//TODO: SendMessage(ItemEditor.Handle, Vp_PROPCHANGE, 0, 0); +end; +{=====} + +{$IFNDEF VERSION4} +function TVpCollection.Insert(Index: Integer): TVpCollectionItem; +var + I: Integer; +begin + result := Add; + for I := Index to Count - 2 do + Items[I].Index := I + 1; + Items[Count - 1].Index := Index; +end; +{=====} +{$ENDIF} + +function TVpCollection.GetItem(Index : Integer) : TVpCollectionItem; +begin + Result := TVpCollectionItem(inherited GetItem(Index)); +end; + +function TVpCollection.GetOwner: TPersistent; +begin + result := FOwner; +end; +{=====} + +procedure TVpCollection.SetItem(Index : Integer; Value : TVpCollectionItem); +begin + inherited SetItem(Index, Value); +end; +{=====} + +function TVpCollection.ItemByName(const Name : string) : TVpCollectionItem; +var + i : Integer; +begin + for i := 0 to pred(Count) do + if Item[i].Name = Name then begin + Result := Item[i]; + exit; + end; + Result := nil; +end; +{=====} + +procedure TVpCollection.Loaded; +begin + InLoaded := True; + try + Changed; + finally + InLoaded := False; + end; + IsLoaded := True; +end; +{=====} + +function TVpCollection.ParentForm : TForm; +var + Temp : TObject; +begin + Temp := GetOwner; + while (Temp <> nil) and not (Temp is TForm) do + Temp := TComponent(Temp).Owner; + Result := TForm(Temp); +end; +{=====} + +(*****************************************************************************) +{ TVpCollectionItem } + +function TVpCollectionItem.GetVersion: String; +begin + Result := VpVersionStr; +end; +{=====} + +procedure TVpCollectionItem.SetVersion(const Value: String); +begin +end; +{=====} + +procedure TVpCollectionItem.SetName(Value: String); +begin + FName := Value; +end; +{=====} + +(*****************************************************************************) +{ TO32ContainerList } + +constructor TVpContainerList.Create(AOwner: TComponent); +begin + inherited Create; + FOwner := TComponent(AOwner); +end; +{=====} + +destructor TVpContainerList.Destroy; +var + I: Integer; +begin + for I := 0 to Count - 1 do + TPanel(Items[I]).Free; + inherited; +end; +{=====} + +(*****************************************************************************) +{ TVpComponent } + +constructor TVpComponent.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +end; +{=====} + +function TVpComponent.GetVersion: string; +begin + Result := VpVersionStr; +end; +{=====} + +procedure TVpComponent.SetVersion(const Value: string); +begin +// This method left intentionally blank. +end; +{=====} + +(*****************************************************************************) +{ VpFont } + +procedure TVpFont.Changed; +begin + inherited; + Assert((FOwner is TControl) or (FOwner is TVpPersistent), + Format('TVpFont.Changed: Unexpected parent class: %s', + [FOwner.ClassName])); + if FOwner is TControl then + TControl(FOwner).Invalidate + else if FOwner is TVpPersistent then + TVpPersistent(FOwner).Invalidate; +end; +{=====} + +constructor TVpFont.Create(AOwner: TObject); +begin + inherited Create; + FOwner := AOwner; +end; +{=====} + +(*****************************************************************************) +{ TVpCategoryColorMap } + +constructor TVpCategoryColorMap.Create; +begin + inherited Create; + + FCat0 := TVpCategoryInfo.Create; + FCat0.Color := clNavy; + FCat0.Description := RSCategoryDesc0; + FCat0.FIndex := 0; + FCat1 := TVpCategoryInfo.Create; + FCat1.Color := clRed; + FCat1.Description := RSCategoryDesc1; + FCat1.FIndex := 1; + FCat2 := TVpCategoryInfo.Create; + FCat2.Color := clYellow; + FCat2.Description := RSCategoryDesc2; + FCat2.FIndex := 2; + FCat3 := TVpCategoryInfo.Create; + FCat3.Color := clLime; + FCat3.Description := RSCategoryDesc3; + FCat3.FIndex := 3; + FCat4 := TVpCategoryInfo.Create; + FCat4.Color := clPurple; + FCat4.Description := RSCategoryDesc4; + FCat4.FIndex := 4; + FCat5 := TVpCategoryInfo.Create; + FCat5.Color := clTeal; + FCat5.Description := RSCategoryDesc5; + FCat5.FIndex := 5; + FCat6 := TVpCategoryInfo.Create; + FCat6.Color := clFuchsia; + FCat6.Description := RSCategoryDesc6; + FCat6.FIndex := 6; + FCat7 := TVpCategoryInfo.Create; + FCat7.Color := clOlive; + FCat7.Description := RSCategoryDesc7; + FCat7.FIndex := 7; + FCat8 := TVpCategoryInfo.Create; + FCat8.Color := clAqua; + FCat8.Description := RSCategoryDesc8; + FCat8.FIndex := 8; + FCat9 := TVpCategoryInfo.Create; + FCat9.Color := clMaroon; + FCat9.Description := RSCategoryDesc9; + FCat9.FIndex := 9; +end; +{=====} + +destructor TVpCategoryColorMap.Destroy; +begin + FCat0.Free; + FCat1.Free; + FCat2.Free; + FCat3.Free; + FCat4.Free; + FCat5.Free; + FCat6.Free; + FCat7.Free; + FCat8.Free; + FCat9.Free; + inherited; +end; +{=====} + +function TVpCategoryColorMap.GetColor(Index: Integer): TColor; +begin + case Index of + 0 : result := FCat0.Color; + 1 : result := FCat1.Color; + 2 : result := FCat2.Color; + 3 : result := FCat3.Color; + 4 : result := FCat4.Color; + 5 : result := FCat5.Color; + 6 : result := FCat6.Color; + 7 : result := FCat7.Color; + 8 : result := FCat8.Color; + 9 : result := FCat9.Color; + else + result := clBlack; + end; +end; +{=====} + +function TVpCategoryColorMap.GetName(Index: Integer): string; +begin + case Index of + 0 : result := FCat0.Description; + 1 : result := FCat1.Description; + 2 : result := FCat2.Description; + 3 : result := FCat3.Description; + 4 : result := FCat4.Description; + 5 : result := FCat5.Description; + 6 : result := FCat6.Description; + 7 : result := FCat7.Description; + 8 : result := FCat8.Description; + 9 : result := FCat9.Description; + else + result := ''; + end; +end; +{=====} + +(*****************************************************************************) +{ TVpCategoryInfo } + +constructor TVpCategoryInfo.Create; +begin + inherited Create; + + FBitmap := TBitmap.Create; + FBackgroundColor := clWindow; +end; + +destructor TVpCategoryInfo.Destroy; +begin + FBitmap.Free; + + inherited Destroy; +end; + +procedure TVpCategoryInfo.SetBackgroundColor (const v : TColor); +begin + if v <> FBackgroundColor then + FBackgroundColor := v; +end; + +procedure TVpCategoryInfo.SetBitmap (v : TBitmap); +begin + FBitmap.Assign (v); +end; + +procedure TVpCategoryInfo.SetColor(Value: TColor); +begin + if Value <> FColor then + FColor := Value; +end; +{=====} + +procedure TVpCategoryInfo.SetDescription(Value: string); +begin + if Value <> FDescription then + FDescription := Value; +end; +{=====} + + + +{ TVpTimeRange } +(*****************************************************************************) +constructor TVpTimeRange.Create(aOwner: TObject); +begin + inherited Create; + FOwner := aOwner; +end; + +destructor TVpTimeRange.Destroy; +begin + inherited; +end; + +procedure TVpTimeRange.SetRangeBegin(const Value: TVpHours); +begin + { if the start time is being set to greater than the end, then force the } + { end to be one hour later than the start } + if FRangeEnd < Value then + FRangeEnd := TVpHours(Ord(Value) + 1); + + FRangeBegin := Value; + SetStartTime((Ord(Value) * 60) / MinutesInDay); +end; +{=====} + +procedure TVpTimeRange.SetRangeEnd(const Value: TVpHours); +begin + { if the end time is being set to less than the start, then force the } + { start to be one hour earlier than the end } + if FRangeBegin > Value then + FRangeBegin := TVpHours(Ord(Value) - 1); + + FRangeEnd := Value; + SetEndTime((Ord(Value) * 60) / MinutesInDay); +end; +{=====} + +procedure TVpTimeRange.SetEndTime(const Value: TDateTime); +begin + if Value < StartTime then + StartTime := Value - (30 / MinutesInDay); + FEndTime := Value; + + if FOwner is TVpTimeSlotColor then + (FOwner as TVpTimeSlotColor).Changed; +end; +{=====} + +procedure TVpTimeRange.SetStartTime(const Value: TDateTime); +begin + if Value > EndTime then + EndTime := Value + (30 / MinutesInDay); + FStartTime := Value; + + if FOwner is TVpTimeSlotColor then + (FOwner as TVpTimeSlotColor).Changed; +end; +{=====} + + + + +(*****************************************************************************) +{ TVpTimeSlotColor } + +constructor TVpTimeSlotColor.Create(AOwner: TVpCustomControl); +begin + inherited Create; + FOwner := AOwner; + FActiveRange := TVpTimeRange.Create(Self); + FInactive := $0080FFFF; + FHoliday := $00FF80FF; + FWeekend := $00FFFF80; + FActive := clWhite; + FWeekday := clWhite; +end; +{=====} + +destructor TVpTimeSlotColor.Destroy; +begin + FActiveRange.Free; + inherited; +end; +{=====} + +procedure TVpTimeSlotColor.Changed; +begin + FOwner.Invalidate; +end; +{=====} + +procedure TVpTimeSlotColor.SetActive(const Value: TColor); +begin + if FActive <> Value then begin + FActive := Value; + Changed; + end; +end; +{=====} + +procedure TVpTimeSlotColor.SetHoliday(const Value: TColor); +begin + if FHoliday <> Value then begin + FHoliday := Value; + Changed; + end; +end; +{=====} + +procedure TVpTimeSlotColor.SetInactive(const Value: TColor); +begin + if FInactive <> Value then begin + FInactive := Value; + Changed; + end; +end; +{=====} + +procedure TVpTimeSlotColor.SetWeekday(const Value: TColor); +begin + if FWeekday <> Value then begin + FWeekday := Value; + Changed; + end; +end; +{=====} + +procedure TVpTimeSlotColor.SetWeekend(const Value: TColor); +begin + if FWeekend <> Value then begin + FWeekend := Value; + Changed; + end; +end; +{=====} + +end. + diff --git a/components/tvplanit/source/vpbase.res b/components/tvplanit/source/vpbase.res new file mode 100644 index 0000000000000000000000000000000000000000..54943719e3f200f514a2a9b69ed513804e90a0bf GIT binary patch literal 24000 zcmdsFkoeVLh_ks^tl-G80?`ObGa*Qy@poU4H>^B_3p?miLnPf&&kZfR+(h&xTR2I}Ah z|Kt*TPCqgc+RxoNbZ!!VPTJ2sPW*W2gazs^+&OgT!4<;K=hzrHw~+wif19VRkgrt}360b0-Q z1owh*nciZ3s><|EQa&`9TI>5gOp;`tNIcwt$iD)K^*aDDF1$}3Z~}4nRq*@Z4saVV z24L%m?k45;Hau?Ln`Jk@nq}|*F8C}N5+B$Bd*CK`A6R;VKLA6p1NOkpahZy*|3f>q z)}8x3`WIkH1D+sAGf4M5$r9*?Vy7@GH*it*FIieZ@%QgUO2DLfub1qZjVxQrN_#xM zo!$xu<1&pIi64obY7h%Iku8u#3K6&!#Q)>msn;;ff6kHMU!y$!pWy$gCV<=_io+d) z_I(C#fDPh2?I!86NI}*qBmv|lluH=!llV7H0Js7DSO!^ki+kKX>h5=!+{5kxcb|JG z@1f5R5y|&tjuX!7;2R-x%1`{nn`9n&jm%jx46}q-bV+(j(sNtar$} zee*}(mmjU+@aIjZsJXAawYK&)?fs0{-5~JmIXwr@XW_Z&3-gprf)mf0T!g^$YRJs} zr6Qh)Q8DQ~o&=3w@ofz6!}Gh|x#6v6&z^Pfx?vQbJ==NLy_4*9I-NV*JDqGTTf=|( z`L{RTy2A}$UVA>pe`n+Qx1Qg@-@Li;*3P@`oln30{C_0W-`q&EJMdq5<;361U;4~v zmfn5W1v=BRxZuvA`#-}D?n55IEiK)CYY0mgp9TlXB9t{jB*fs`Je~x>ocd?NGBe$g z-;r^<#l6!noBzV8j`^p4b=v$a``pV`F8fu-``PK-|5ff=IfcQp+v{lIURm)t^Z7}; zc*s3svN(?{9zZVMP0HeFl7$m4wgO9^^W~~VU0EXV|>NWg2XoCdwzyJ)rNw#bFbK^r8X=XQRbxjy9*+B;}okLGgyW&_u3He0RkR=3q9 zq-K%n!FTdLDc3Ti?cGJU~IHW|k;ne@jG-+j%~MRk2sE^8)-qO+kF)(-F-zeDaw%B7vMx zg!--8h^6XiD)c>1mZIchuNLHWFp&uog(!S0JX0odH$j%>QPwESc7y509pTHFQi^wJO2@m7S|OoHf;V9}87IO_%k*sam*q2I zsD?yJM*6PBgjQtrU9;P)$WpTNdv~tstqY6pDtJ`buL>TUC9e&3?0Wqts7c zC#YmhT8+ny4P?+Sn=6T=)02wNw1uQBXCY1e@wV2-ZmY6iF*dgPGT371^k1;gaf^C(Wu&Xo&}Ui^z?Ut*+BT(m+&fbS%$5BBa+mqNp_Ej55;)jbQqtk@ns& zq6x)BwVhk75oxh1jViNkh5SK5c94OFikYysw_41MCMu0T%>mxAqDmhjIy+t7 z2#t!3BZF|46I>XADQ9Kc>9Wt@GU*5{P8Q|3pk;yfkd@IWhB^Cj<{G#hjgGfn2(&o$ z$Y^LUH5$A9?ZAgG;wSVEz=w^3uGR+J2z~6b_ca>ZLFYM*FnfB!M|qk}c6DmRjj*c- z8V#EgS)puaWhPZUI31;Zl}&Bw(d;`)wQbmi1{;05Q$T(;Kw7R_E&@j-pz?k8Cbn^4 zRrEBrFWVATnXme-*7kAQF6xx?Rp6uP=iLu5dlZdN2S&T>dv?=CH>@9(d#~xz$4Ftn z$nY>4D9Nvb+Ue#lVn)yeY7;|9JfhDU#Nw zrVi2ISjs*z?BNQ@K)@fD!=x}5FWt($3X4#mQO;c+E0*ndy|Bv7PwI9(4Q-R>cB58x z8y-a(fpJVr&}cM7W4F>;!N-wkXkjR}v-FJ184kU>cI@<{klAJAMH$B&Z&G8N`?a~* zP{F8jqL8S#F;DFx%P%2VR?Li#tKWCIpjCYa7PlAcrfSZlc14m1GX?8d{mFz)PjRH`hAYiF=w;jU_|$G zGc-IG4Kv4T&v-$?fWwGN5~dMosBB+rap{ghqsvtsJ99{kDr`hi&IrelaHo-znV`X5 zmBm=D?7I~yd&SEOQ#d5JhOas_B1Wd9H9;eF+~)E^PaCx0CTU<(v)Et;ZoCSOZQE#- zlOwjGF_jN28cp5wJ<6Cx#0Ux!Quye`*mWWtv5Y{(4mf2Wc{{_jl9n4T_!x1O9$3J) zB4s?{;yT*yM<%JMD|as~slyL=)zfAPGUXc&XehNZy;gHo1umFxAu;L}_k4v?IQ@tb zZ@{^@MlshmoK*ZIL<>e^YwlhKklqcDAw< zNd#gh^H{HKWwfw$02d+^i0DnKE}=%1w>H&gi||MzQY*Jk#HQ}UNK}Zh0YhLBvd%Xw zzS*jw*{dN2q-lcPl#!U{vjeU-WL?~3GZ%=AX`vYX#d}G_Ho_)Y?TiQ62`=5wXiI%4 z#Q9B=urB32l?Zu_q#K#C-fioxLaaTcq{CMSyoa#q18bc9UT~a%Vyygrf=v04VHalT zUu<-cy=e5oh_|XnfUbBkNw9}#yGo0P?sSWi8|<_0ey4A*n|yKm1nF|h z4^H14-v;#EdHDYN3n6pLf73bsyEotT9#4XNug6!1NkRr6U-KX0Q{SBPt+A!^v9T}b z7V+ielcsdasN5_b&bhO^AiHEW^!PY<@a&1Vga4_Vc(@x>_0Zr;_>1lwy7+kcU@@d$ z9y{5haU+?ED~nh1e?t11F+R@mTZV?ySKH^YsfQ2XMc=Xu!LHhbt8S@?B+l_4Bk~?k zf^*r`8|Iw5Ms*o6zhU_PE35f$8Sq2;8yMEk8_vD4*y(tGpSaplxxC%$L^U2tJw5`* z7gfsKatPpSEa}_*Pl3SmqlBw&sfZ-U=Gkv%On(YWmvW_Vnv^#4f0OwW@gLEraa+|~ z@$jMZ#_iP8+!1)K%7SF~Vez^{Tl!U<`TPjSeE(Aer?AhrpD@^OP`+a2{cmn$qYp86 zXw*GG=n)%%XDQ*`atPoD{T=lCi>0D`@}cQZ{nz|=^4B>0#W!(t#H}lo+fgm_zvtY` zV|I}1`DYY71A+}#W%3BWN6{~Ig8QV%L+gNh{q@(c;h#MDgCG1r^0;ORZjte++3Mu4 zPo6xP%j=q#mwuwXmss395f?lV4nUx9<1_ns=KW*HOkA;8$r%Ok6BaVM2-dozCjZdwcx8 z$kI2mth2tpYT?bzz0T$uHB@e$bdoK+M!JPJ*Yfl==t3!^?^mAm&6hjtF}})o*7p*5 zgg5yYtLub$(r3Ev`!7oBf0ZxQ^3H{1YPb&KsgBE1N80Ip4ShXI3GbFe0AKS|oFnL| zMtrtQj<2W9&CPWj-c0|e5UhhRuRLU<=s_&(tnD_ZSCHv_o5qw7`1ni0!7YV=`N>Q^ z=Gl9$m|N!eXmaK+cz?O={oAfAD1G_LmA3rbu3WjYu*@FwwkzuK3JI1!<@4KA-=4L* zzdRm7CgZbAU~N*b2gxJU@&0Ui%rpK>4C8Xh<#C($mth1~>|_+_Gft>;U-|S33FEpi`Z@r~Ci^V;^y5!P{Y&u9We)>(0tkt*C2#SoJAZ*N5{I-+rDOi&mvB z#nq0bpr|4o%CJca<*iIew_2;d|9YycGi=UqNlqSSv%H~^}Ii2 zKRv~quGJk&@f0_$%?dALWu{~}E@$I9?|DTFITyaS$9OU?_`gtcjOQ8l*2`Eep?TfEHFuNt|0udCtzUnOX8iADe4O@wZ|ACGKyOg3C_n;Efv zv73>Ktl)ex7&yT`p%DvwUr%ow? zr@-k`r#l^BiTo`aMM?1S&I_kcS;7mJs+{1g4Kgj~1$>`CL#L_E!?#a_0F|!6`=neR zx3P37m&){da@d?)RMZIK|8d4r&X3($b*^^Yi~Oad&Wr2#7s$GRuM+qd@_6UP3(6<) z#j_9UPRpFr8LfK8+5gl&&F4pTPTOIMV3h$ZpLSN0Pn>jy_S89T77rKUQ%<@J?lb}I zuRfCXQwK}>%YWVA+JEt*|Kdsi%Xprjm$wOwq+2KMdz-waD{mA6htoX%R?cUb+y5~L zV9HO9ZI4gOzyV)|EXJ4i7GB$Ag`Oib64nn^#+I_KZ z_UFHQjj8_|An0DUFxw?Fbw3XuW}mj>lXcs&Yin&)<`=pBI)}CTTLs^Pk9R%s>nm>{ zlBB~$eQh}Oi7i(d2$Odd_<9lG(|tJ-tR8i&9hIgi6kpZ9Yr zJ!h|M$KJ8#rq-AX`Mg9Xuh9!DCG=p^>|F`TegsD*E#6 zpNm#W@M(n6ln43OC|AA5xC9sa>yJ;W0o=0p>?xZ)Y(KPAluwS`f1875pHX)*e@5kg z*UqTK?TjjWo;sucguaaHN_Pk6I6rAzep0@NK?4{BpRZgy>Azz!|2mV7#jn5Q)32Yr zc9NoR6u!GAJ9_E57x+upU%LJV^*h&J>X?r~%l{GC(qUM4X1%#kesI#U_E5Khu+CKT zRc=WSbIAwN@eXYSaLm-7qRe+w>aVRowg4&p7vPNY^S{mdB>L0psV`p+dq=)RJt6Ru z5T5Olnf%Oi9$xm_m<7Ex;oXt_U-1#Yu|dn%2rVq@L#2h~<&~3YoB|8-RomjFpQnd% zyqlpK4KHhB1rfqNYA^E^+QokIQ}(xO&oLuCYL@;4qgkgM@0Kf!Hyh{Ae}j5Y-1qpo zD}Qsfrc?7RNa@t$&i%vZ6}i>b+GqL@f#1Hf28q1^Qr;E>i?>kS|&OiIzZ-1+H_a800Z+;J-biI~PN8|z}AM<&$($$lz zWIXls)n}f$x_(uACbjWj82NX<{hb;?b0JSOrt+Tpi)TW;=C{5{Uu&11`s;7imY45x N&*XWkH=g$;_rJS8@W}uG literal 0 HcmV?d00001 diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas new file mode 100644 index 000000000..984f66996 --- /dev/null +++ b/components/tvplanit/source/vpbaseds.pas @@ -0,0 +1,1380 @@ +{*********************************************************} +{* VPBASEDS.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpBaseDS; + { Base DataStore classes } + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Classes, Dialogs, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls, + Messages, VpBase, VpData, Forms, VpPrtFmt, VpLocalize, VpException; + +type + TVpResourceUpdate = (ruOnChange, ruOnExit, ruOnDropDownClose); + + { Forward Declarations } + TVpCustomDataStore = class; + TVpLinkableControl = class; + TVpControlLink = class; + + { enumerated types } + TVpNotificationType = (neDateChange, neResourceChange, neDataStoreChange, + neInvalidate); + + { Printing events } + TVpOnGetVariableEvent = procedure (Sender : TObject; VarName : string; + Found : Boolean; var Value : string; var Change : TVpChangeVar) + of object; + + TVpOnPageStartEvent = procedure (Sender : TObject; PageNum : Integer; + ADate : TDateTime) of object; + + TVpOnPageEndEvent = procedure (Sender : TObject; PageNum : Integer; + ADate : TDateTime; LastPage : Boolean) of object; + + { generic events } + TVpControlNotifyEvent = procedure(Sender: TComponent; + NotificationEvent: TVpNotificationType; const Value: Variant) of object; + + TVpNoResources = procedure(Sender: TObject; + Resource: TVpResource) of object; + + TVpNoLocalizationFile = procedure (Sender : TObject; + FileName : string) of object; + + TVpDateChangedEvent = procedure (Sender: TObject; + Date: TDateTime) of object; + + { contact events } + TVpContactEvent = procedure(Sender: TObject; Contact: TVpContact) of object; + + TVpEditContactEvent = procedure(Sender: TObject; Contact: TVpContact; + Resource: TVpResource; var AllowIt: Boolean) of object; + + TVpOwnerDrawContactEvent = procedure(Sender: TObject; const Canvas: TCanvas; + R: TRect; Contact: TVpContact; var Drawn: Boolean) of object; + + TVpCGColWidthChangeEvent = procedure(Sender: TObject; + NewColWidth: Integer) of object; + + { task events } + TVpBeforeEditTask = procedure(Sender: TObject; Task: TVpTask; + var AllowIt: Boolean) of object; + + TVpAfterEditTask = procedure(Sender: TObject; Task: TVpTask) of object; + + TVpEditTask = procedure(Sender: TObject; Task: TVpTask; + Resource: TVpResource; var AllowIt: Boolean) of object; + + TVpOwnerDrawTask = procedure(Sender: TObject; const Canvas: TCanvas; + R: TRect; Task: TVpTask; var Drawn: Boolean) of object; + + { event events } + TVpBeforeEditEvent = procedure(Sender: TObject; Event: TVpEvent; + var AllowIt: Boolean) of object; + + TVpEventEvent = procedure(Sender: TObject; Event: TVpEvent) of object; + + TVpAfterEditEvent = procedure(Sender: TObject; Event: TVpEvent) of object; + + TVpEditEvent = procedure(Sender: TObject; Event: TVpEvent; + Resource:TVpResource; var AllowIt: Boolean) of object; + + TVpOnAddNewEvent = procedure (Sender: TObject; + Event: TVpEvent) of object; + + { resource events } + + TVpResourceEvent = procedure(Sender: TObject; + Resource: TVpResource) of object; + + { Is created by the control where dragging starts. The Event property } + { holds a reference to the event being dragged, and the Sender contains } + { a reference to the control where dragging started. } + TVpEventDragObject = class(TDragObject) + protected {private} + FEvent: TVpEvent; + FSender: TObject; + public + property Event: TVpEvent + read FEvent write FEvent; + property Sender: TObject + read FSender write FSender; + end; + + + TVpResourceCombo = class(TCustomComboBox) + protected {private} + FDataStore : TVpCustomDataStore; + {internal variables} + rcLoading : Boolean; + OldItemIndex : Integer; + FResourceUpdateStyle : TVpResourceUpdate; + + procedure VpDataStoreChanged (var Msg : TMessage); message Vp_DataStoreChanged; + procedure SetDataStore (const Value : TVpCustomDataStore); + function GetAbout : string; + procedure SetAbout (const Value : string); + procedure SetResourceUpdateStyle (const v : TVpResourceUpdate); + procedure ResourceChanged (Sender : TObject); + procedure LoadItems; + {$IFNDEF LCL} + procedure CNCommand (var Msg: TWMCommand); message CN_COMMAND; + {$ENDIF} + + public + constructor Create (AOwner : TComponent); override; + destructor Destroy; override; + + published + property DataStore : TVpCustomDataStore + read FDataStore write SetDataStore; + property ResourceUpdateStyle : TVpResourceUpdate + read FResourceUpdateStyle write SetResourceUpdateStyle + default ruOnChange; + property Version : string + read GetAbout write SetAbout stored False; + + property Anchors; + property Constraints; + property Style; + end; + + + TVpDependentInfo = class { Used by the ControlLink component } + protected{private} + FComponent: Pointer; + FEventHandler: TVpControlNotifyEvent; + public + property Component: Pointer read FComponent write FComponent; + property EventHandler: TVpControlNotifyEvent + read FEventHandler write FEventHandler; + end; + + + TVpCustomDataStore = class(TVpComponent) + protected{private} + FAutoCreate : Boolean; + FAutoConnect : Boolean; + FLoading : Boolean; + FCategoryColorMap : TVpCategoryColorMap; + FResources : TVpResources; + FTimeRange : TVpTimeRange; + FActiveDate : TDateTime; + FConnected : Boolean; + FEventTimerEnabled : Boolean; + FPlayEventSounds : Boolean; + FDefaultEventSound : string; + FDayBuffer : Integer; + FResourceID : Integer; + FResource : TVpResource; + dsAlertTimer : TTimer; { fires the alerts } + FNotifiers : TList; + + {events} + FOnConnect : TNotifyEvent; + FOnDisconnect : TNotifyEvent; + FOnAlert : TVpEventEvent; + FOnResourceChange : TVpResourceEvent; + FOnDateChanged : TVpDateChangedEvent; + + procedure dsOnTimer(Sender: TObject); + procedure dsDoOnAlert(Event: TVpEvent); + procedure SetActiveDate(Value: TDateTime); + procedure SetAutoConnect(Value: Boolean); + procedure SetConnected(const Value: boolean); virtual; + procedure SetResourceID(Value: Integer); + procedure SetResource(Value: TVpResource); + procedure SetEventTimerEnabled(Value: Boolean); + procedure SetDayBuffer(Value: Integer); + procedure SetRange(StartTime, EndTime: TDateTime); + procedure NotifyLinked; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure DeregisterAllWatchers; + procedure DeregisterWatcher (Watcher : THandle); + function GetNextID(TableName: string): integer; virtual; abstract; + property Resources: TVpResources read FResources; + procedure Load; virtual; + procedure LoadEvents; virtual; abstract; + procedure LoadContacts; virtual; abstract; + procedure LoadTasks; virtual; abstract; + procedure NotifyDependents; + procedure RefreshEvents; virtual; + procedure RefreshContacts; virtual; + procedure RefreshTasks; virtual; + procedure RefreshResource; virtual; +{ - Increased visibility to Public} + procedure PurgeResource(Res: TVpResource); virtual; {abstract;} + procedure PurgeEvents(Res: TVpResource); virtual; {abstract;} + procedure PurgeContacts(Res: TVpResource); virtual; {abstract;} + procedure PurgeTasks(Res: TVpResource); virtual; {abstract;} +{ - End} + procedure SetResourceByName(Value: string); virtual; abstract; + property Connected : boolean read FConnected write SetConnected; + procedure PostEvents; virtual; abstract; + procedure PostContacts; virtual; abstract; + procedure PostTasks; virtual; abstract; + procedure PostResources; virtual; abstract; + procedure RegisterWatcher (Watcher : THandle); + property Loading : Boolean + read FLoading write FLoading; + property Resource: TVpResource + read FResource write SetResource; + property ResourceID: Integer + read FResourceID write SetResourceID; + property DayBuffer: Integer + read FDayBuffer write SetDayBuffer; + property Date: TDateTime + read FActiveDate write SetActiveDate; + property TimeRange: TVpTimeRange + read FTimeRange; + published + property AutoConnect: Boolean + read FAutoConnect write SetAutoConnect; + property AutoCreate: Boolean + read FAutoCreate write FAutoCreate; + property CategoryColorMap: TVpCategoryColorMap + read FCategoryColorMap write FCategoryColorMap; + property DefaultEventSound: string + read FDefaultEventSound write FDefaultEventSound; + property EnableEventTimer: Boolean + read FEventTimerEnabled write SetEventTimerEnabled; + property PlayEventSounds: Boolean + read FPlayEventSounds write FPlayEventSounds; + {events} + property OnAlert: TVpEventEvent + read FOnAlert write FOnAlert; + property OnConnect: TNotifyEvent + read FOnConnect write FOnConnect; + property OnDateChanged: TVpDateChangedEvent + read FOnDateChanged write FOnDateChanged; + property OnDisconnect: TNotifyEvent + read FOnDisconnect write FOnDisconnect; + property OnResourceChange: TVpResourceEvent + read FOnResourceChange write FOnResourceChange; + end; + + + {TVpLinkableControl} + TVpLinkableControl = class(TVpCustomControl) + protected{private} + FDataStore : TVpCustomDataStore; + FReadOnly : Boolean; + FControlLink : TVpControlLink; + FLastPrintLine : Integer; + function CheckCreateResource : Boolean; + procedure SetDataStore (const Value : TVpCustomDataStore); virtual; + procedure SetControlLink (const Value : TVpControlLink); + procedure CMEnter(var Msg : TMessage); message CM_ENTER; + procedure CMExit(var Msg : TMessage); message CM_EXIT; + public + constructor Create (AOwner : TComponent); override; + destructor Destroy; override; + function GetLastPrintLine : Integer; + function GetControlType : TVpItemType; virtual; abstract; + procedure RenderToCanvas (RenderCanvas: TCanvas; RenderIn: TRect; + Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; + StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity; + DisplayOnly: Boolean); virtual; abstract; + procedure LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; const Value: Variant); + virtual; abstract; + property ReadOnly : Boolean read FReadOnly write FReadOnly; + published + property PopupMenu; + property DataStore: TVpCustomDataStore read FDataStore write SetDataStore; + property ControlLink: TVpControlLink read FControlLink write SetControlLink; + + property Color; + property Ctl3D; + property Font; + property ParentColor; + property ParentFont; + property ParentShowHint; + + property AfterEnter; + property AfterExit; + property OnMouseWheel; + + end; + + + {TVpControlLink} + TVpControlLink = class(TVpComponent) + private + FPrinter : TVpPrinter; + FDataStore : TVpCustomDataStore; + FOnGetVariable : TVpOnGetVariableEvent; + FOnNoLocalizationFile : TVpNoLocalizationFile; + FOnPageStart : TVpOnPageStartEvent; + FOnPageEnd : TVpOnPageEndEvent; + FLocalization : TVpLocalization; + FLocalizationFile : string; + FDefaultCountry : string; + + + protected{private} + DependentList: TList; + procedure Attach (Sender : TComponent); + procedure Detach (Sender : TComponent); + procedure ReleaseDependents; + procedure SetDataStore (const Value : TVpCustomDataStore); + procedure SetDefaultCountry (const v : string); + procedure SetLocalizationFile (const v : string); + procedure SetPrinter (const v : TVpPrinter); + public + constructor Create (AOwner : TComponent); override; + destructor Destroy; override; + function GetDependentList : TList; + procedure LoadLocalizationInfo (const FileName : string); + procedure Notify (Sender: TComponent; NotificationType: TVpNotificationType; + const Value: Variant); + procedure TriggerOnGetVariable (Sender : TObject; VarName: string; + Found: Boolean; var Value: string; var Change: TVpChangeVar); + procedure TriggerOnPageEnd (Sender: TObject; PageNum: Integer; + ADate: TDateTime; LastPage: Boolean); + procedure TriggerOnPageStart (Sender: TObject; PageNum: Integer; + ADate: TDateTime); + + property Localization : TVpLocalization read FLocalization write FLocalization; + + published + property DataStore: TVpCustomDataStore read FDataStore write SetDataStore; + property DefaultCountry : string + read FDefaultCountry write SetDefaultCountry; + property LocalizationFile : string + read FLocalizationFile write SetLocalizationFile; + property Printer : TVpPrinter read FPrinter write SetPrinter; + property OnGetVariable : TVpOnGetVariableEvent + read FOnGetVariable write FOnGetVariable; + property OnNoLocalizationFile : TVpNoLocalizationFile + read FOnNoLocalizationFile write FOnNoLocalizationFile; + property OnPageStart : TVpOnPageStartEvent + read FOnPageStart write FOnPageStart; + property OnPageEnd : TVpOnPageEndEvent + read FOnPageEnd write FOnPageEnd; + end; + + +implementation + +uses + VpSR, VpConst, VpMisc, VpResEditDlg, VpAlarmDlg, +{$IFNDEF LCL} + mmSystem, +{$ENDIF} + VpDlg, VpSelResDlg; + +(*****************************************************************************) +{ TVpCustomDataStore } + +type +ProtectedTComponent = class(TComponent); + +constructor TVpCustomDataStore.Create(AOwner: TComponent); +var + I: Integer; +begin + inherited; + + FNotifiers := TList.Create; + + FAutoCreate := true; + FResources := TVpResources.Create(Self); + FTimeRange := TVpTimeRange.Create(Self); + FCategoryColorMap := TVpCategoryColorMap.Create; + FActiveDate := Now; + FDayBuffer := 31; {One full month before and after the current date. } + FTimeRange.StartTime := Now - FDayBuffer; + FTimeRange.EndTime := Now + FDayBuffer; + + FPlayEventSounds := true; + + FEventTimerEnabled := true; + + { Set Alert Timer } + if not (csDesigning in ComponentState) then begin + dsAlertTimer := TTimer.Create(self); + dsAlertTimer.Enabled := false; + { Create the event timer and allow it to fire within the next half second } + dsAlertTimer.OnTimer := dsOnTimer; + dsAlertTimer.Interval := 500; + end; + + + { If the DataStore is being dropped onto a form for the first time... } + if (csDesigning in ComponentState) and not (csLoading in ComponentState) then + begin + I := 0; + { Auto connect to the first available ControlLink component found } + while (I < Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpControlLink) + and (TVpControlLink(Owner.Components[I]).DataStore = nil) then begin + TVpControlLink(Owner.Components[I]).DataStore := self; + Break; + end; + Inc(I); + end; + + I := 0; + { Then Auto connect to all available LinkableControl components found } + while (I < Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpLinkableControl) then begin + if TVpLinkableControl(Owner.Components[I]).DataStore = nil then + TVpLinkableControl(Owner.Components[I]).DataStore := self; + end + else if (Owner.Components[I] is TVpResourceCombo) then begin + if TVpResourceCombo(Owner.Components[I]).DataStore = nil then + TVpResourceCombo(Owner.Components[I]).DataStore := self; + end + else if (Owner.Components[I] is TVpBaseDialog) then begin + if TVpBaseDialog(Owner.Components[I]).DataStore = nil then + TVpBaseDialog(Owner.Components[I]).DataStore := self; + end + else if (Owner.Components[I] is TVpControlLink) then begin + if TVpControlLink(Owner.Components[I]).DataStore = nil then + TVpControlLink(Owner.Components[I]).DataStore := self; + end; + Inc(I); + end; + end; + + { enable the event timer } + if not (csDesigning in ComponentState) then + dsAlertTimer.Enabled := true; +end; +{=====} + +destructor TVpCustomDataStore.Destroy; +var + I: Integer; +begin + DeregisterAllWatchers; + FNotifiers.Free; + FNotifiers := nil; + + { Remove self from all dependent controls } + if Owner <> nil then begin + I := 0; + { Remove self from dependent Control Links first } + while (I < Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpControlLink) then begin + if TVpControlLink(Owner.Components[I]).DataStore = self then + TVpControlLink(Owner.Components[I]).DataStore := nil; + end; + Inc(I); + end; + + I := 0; + { Then remove self from dependent controls } + while (I < Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpLinkableControl) then begin + if TVpLinkableControl(Owner.Components[I]).DataStore = self then + TVpLinkableControl(Owner.Components[I]).DataStore := nil; + end + else if (Owner.Components[I] is TVpResourceCombo) then begin + if TVpResourceCombo(Owner.Components[I]).DataStore = self then + TVpResourceCombo(Owner.Components[I]).DataStore := nil; + end + else if (Owner.Components[I] is TVpBaseDialog) then begin + if TVpBaseDialog(Owner.Components[I]).DataStore = self then + TVpBaseDialog(Owner.Components[I]).DataStore := nil; + end; + Inc(I); + end; + end; + + FResources.Free; + FTimeRange.Free; + FCategoryColorMap.Free; + + if dsAlertTimer <> nil then + dsAlertTimer.Free; + + inherited; +end; +{=====} + +procedure TVpCustomDataStore.DeregisterAllWatchers; +var + i : Integer; + +begin + for i := FNotifiers.Count - 1 downto 0 do + if Assigned (FNotifiers[i]) then begin + FreeMem (FNotifiers[i]); + FNotifiers.Delete (i); + end; +end; +{=====} + +procedure TVpCustomDataStore.DeregisterWatcher (Watcher : THandle); +var + i : Integer; + +begin + for i := FNotifiers.Count - 1 downto 0 do + if Assigned (FNotifiers[i]) then + if PVpWatcher (FNotifiers[i]).Handle = Watcher then begin + FreeMem (FNotifiers[i]); + FNotifiers.Delete (i); + Exit; + end; +end; +{=====} + +procedure TVpCustomDataStore.dsOnTimer(Sender: TObject); +var +// Hour, Min, Sec, MSec: Word; + NHour, NMin, NSec, NMSec: Word; + Event: TVpEvent; + I: integer; + AdvanceTime: TDateTime; + AlarmTime: TDateTime; +begin + { don't fire the timer at designtime } + if csDesigning in ComponentState then begin + dsAlertTimer.Enabled := false; + Exit; + end; + + if Resource <> nil then begin + for I := 0 to pred(Resource.Schedule.EventCount) do begin + Event := Resource.Schedule.GetEvent(I); + + if (Event <> nil) and Event.AlarmSet then begin + AdvanceTime := GetAlarmAdvanceTime(Event.AlarmAdv, Event.AlarmAdvType); + AlarmTime := Event.StartTime - AdvanceTime; + + { if the AlarmTime has already passed, then show the alarm notification } + if (AlarmTime < Now) then begin + if Event.SnoozeTime < now then + dsDoOnAlert(Event); + end; + +(* Simplified + else begin + { Check to see if the event comes due today before going further } + if (Trunc(AlarmTime) = Trunc(Now)) then begin + DecodeTime(AlarmTime, Hour, Min, Sec, MSec); + DecodeTime(Now, NHour, NMin, NSec, NMsec); + if (Hour = NHour) and (Min = NMin) then begin + { this event has come due so spawn the alert dialog } + dsDoOnAlert(Event); + end; + end; {if (Trunc(AlarmTime) = Trunc(Now))} + end; {if (AlarmTime < Now)} +*) + + end; {if Event.AlarmSet} + end; {for} + end; + + { Set next interval } + DecodeTime(Now, NHour, NMin, NSec, NMSec); + dsAlertTimer.Interval := (60 - NSec) * 1000; +end; +{=====} + +procedure TVpCustomDataStore.dsDoOnAlert(Event: TVpEvent); +begin + if Event.AlertDisplayed then Exit; + + if Assigned(FOnAlert) then + FOnAlert(Self, Event) + else begin + {Ding!} + if FPlayEventSounds then begin + {$IFNDEF LCL} + if FileExists(Event.AlarmWavPath) then + { if the event has a sound of its own, then play that one. } + SndPlaySound(PChar(Event.AlarmWavPath), snd_Async) + else if FileExists(FDefaultEventSound) then + { otherwise, if there is a default sound assigned, then play that one } + SndPlaySound(PChar(FDefaultEventSound), snd_Async) + else + { otherwise just ding } + {$ENDIF} + Beep; + end; + + with TVpNotificationDialog.Create(nil) do + try + DataStore := Self; + Execute(Event); + finally + Free; + end; { with } + end; { if } +end; +{=====} + +procedure TVpCustomDataStore.NotifyLinked; +var + i : Integer; + +begin + for i := 0 to FNotifiers.Count - 1 do + if Assigned (FNotifiers[i]) then + PostMessage (PVpWatcher (FNotifiers[i]).Handle, + Vp_DataStoreChanged, 0, 0); +end; +{=====} + +procedure TVpCustomDataStore.SetActiveDate(Value: TDateTime); +var + OY, OM, Day, NY, NM: Word; + OldDate: TDateTime; +begin + OldDate := FActiveDate; + FActiveDate := Value; + + DecodeDate(OldDate, oy, om, Day); + DecodeDate(FActiveDate, ny, nm, Day); + + { If the date has reached the end of the data buffer } + if (FActiveDate >= FTimeRange.EndTime) + or (FActiveDate <= FTimeRange.StartTime) + { or the month or year has changed... } + or (nm <> om) or (ny <> oy) then begin + { then load the data that falls into the current time range } + SetRange(FActiveDate - FDayBuffer, FActiveDate + FDayBuffer); + RefreshEvents; + end; + + if Assigned(FOnDateChanged) then + FOnDateChanged(Self, FActiveDate); +end; +{=====} + +procedure TVpCustomDataStore.SetAutoConnect(Value: Boolean); +begin + if Value <> FAutoConnect then + FAutoConnect := value; +end; +{=====} + +procedure TVpCustomDataStore.SetConnected(const Value: boolean); +var + WasConnected: Boolean; +begin + WasConnected := FConnected; + if Value <> FConnected then begin + FConnected := Value; + if not FConnected then begin + FResources.ClearResources; + FResource := nil; + if WasConnected and Assigned(OnDisconnect) then + FOnDisconnect(self); + end + else begin + if not WasConnected and Assigned(OnConnect) then + FOnConnect(self); + end; + + if not (csDestroying in ComponentState) then + NotifyDependents; + end; +end; +{=====} + +procedure TVpCustomDataStore.SetResourceID(Value: Integer); +begin + if (Value <> FResourceID) or (Value = 0) then begin + FResource := FResources.GetResource(Value); + if FResource = nil then + Exit; + FResourceID := Value; + RefreshEvents; + RefreshContacts; + RefreshTasks; + if Assigned(FOnResourceChange) then + FOnResourceChange(Self, FResource); + if not Loading then + NotifyDependents; + end; +end; +{=====} + +procedure TVpCustomDataStore.SetResource(Value: TVpResource); +begin + if Value <> FResource then begin + FResource := Value; + if FResource <> nil then begin + FResourceID := FResource.ResourceID; + RefreshEvents; + RefreshContacts; + RefreshTasks; + end else + FResourceID := -1; + if not Loading then + NotifyDependents; + end; +end; +{=====} + +procedure TVpCustomDataStore.SetEventTimerEnabled(Value: Boolean); +begin + if Value <> FEventTimerEnabled then begin + FEventTimerEnabled := Value; + if not (csDesigning in ComponentState) then begin + if FEventTimerEnabled and (dsAlertTimer = nil) then + dsAlertTimer := TTimer.Create(self); + dsAlertTimer.Enabled := FEventTimerEnabled; + dsAlertTimer.Interval := 500; { Make it fire within a half second } + end; + end; +end; +{=====} + +procedure TVpCustomDataStore.SetDayBuffer(Value: Integer); +begin + FDayBuffer := Value; + SetRange(FActiveDate - FDayBuffer, FActiveDate + FDayBuffer); +end; +{=====} + +procedure TVpCustomDataStore.Load; +begin + FResources.Sort; + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.RefreshEvents; +begin + if not Loading then + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.RefreshContacts; +begin + if not Loading then + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.RefreshTasks; +begin + if not Loading then + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.RefreshResource; +begin + if not Loading then + NotifyDependents; +end; +{=====} + +{ - Added} +procedure TVpCustomDataStore.PurgeResource(Res: TVpResource); +begin + if not Loading then + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.PurgeEvents(Res: TVpResource); +begin + Res.Schedule.ClearEvents; + if not Loading then + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.PurgeContacts(Res: TVpResource); +begin + Res.Contacts.ClearContacts; + if not Loading then + NotifyDependents; +end; +{=====} + +procedure TVpCustomDataStore.PurgeTasks(Res: TVpResource); +begin + Res.Tasks.ClearTasks; + if not Loading then + NotifyDependents; +end; +{=====} +{ - End} + +procedure TVpCustomDataStore.RegisterWatcher (Watcher : THandle); +var + i : Integer; + NewHandle : PVpWatcher; + +begin + for i := 0 to FNotifiers.Count - 1 do + if Assigned (FNotifiers[i]) then + if PVpWatcher (FNotifiers[i]).Handle = Watcher then + Exit; + GetMem (NewHandle, SizeOf (TVpWatcher)); + NewHandle.Handle := Watcher; + FNotifiers.Add (NewHandle); +end; +{=====} + +procedure TVpCustomDataStore.NotifyDependents; +var + I: Integer; +begin + if (Owner = nil) or Loading then + Exit; + + for I := 0 to pred(Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpLinkableControl) then begin + if (TVpLinkableControl(Owner.Components[I]).DataStore = self) then + TVpLinkableControl(Owner.Components[I]).Invalidate; + end + end; + NotifyLinked; +end; +{=====} + +procedure TVpCustomDataStore.SetRange(StartTime, EndTime: TDateTime); +begin + if EndTime > StartTime then begin + { Force the startdate's time to 12:00 am } + FTimeRange.StartTime := trunc(StartTime); + { Force the enddate's time to midnight } + FTimeRange.EndTime := trunc(EndTime) + 1; + end; +end; +{=====} + + + + +{ TVpResourceCombo } +constructor TVpResourceCombo.Create(AOwner: TComponent); +var + I: Integer; +begin + inherited; + + OnChange := ResourceChanged; + + FResourceUpdateStyle := ruOnChange; + + Style := csDropDownList; + + DoubleBuffered := true; + + { If the ResourceCombo is being dropped onto a form for the first } + { time then connect to the first DataStore component found. } + I := 0; + if (csDesigning in ComponentState) and not (csLoading in ComponentState) then + while (I < Owner.ComponentCount) and (DataStore = nil) do + if (Owner.Components[I] is TVpCustomDataStore) then + DataStore := TVpCustomDataStore(Owner.Components[I]) + else + Inc(I); +end; +{=====} + +destructor TVpResourceCombo.Destroy; +begin + inherited; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpResourceCombo.CNCommand (var Msg: TWMCommand); +begin + if Msg.NotifyCode = CBN_CLOSEUP then begin + if (FResourceUpdateStyle = ruOnDropDownClose) then + ResourceChanged (Self) + else + inherited; + end else + inherited; +end; +{$ENDIF} +{=====} + +procedure TVpResourceCombo.VpDataStoreChanged (var Msg : TMessage); +begin + LoadItems; +end; +{=====} + +function TVpResourceCombo.GetAbout: string; +begin + Result := VpVersionStr; +end; +{=====} + +procedure TVpResourceCombo.LoadItems; +var + I: Integer; + Res: TVpResource; +begin + if DataStore = nil then + Exit; + + rcLoading := true; + try + Items.Clear; + + for I := 0 to pred(DataStore.Resources.Count) do begin + Res := DataStore.Resources.Items[I]; + if Res = nil then + Continue; + if Res.Description <> '' then begin + Items.Add(Res.Description); + end; + end; + + if DataStore.Resource = nil then + ItemIndex := -1 + else + ItemIndex := Items.IndexOf(DataStore.Resource.Description); + + finally + rcLoading := false; + end; +end; +{=====} + +procedure TVpResourceCombo.ResourceChanged(Sender: TObject); +begin + if (OldItemIndex <> ItemIndex) or (ItemIndex = 0) then begin + if (DataStore <> nil) and not rcLoading then + DataStore.SetResourceByName(Text); + OldItemIndex := ItemIndex; + end; +end; +{=====} + +procedure TVpResourceCombo.SetAbout(const Value: string); +begin + //Empty on purpose +end; +{=====} +procedure TVpResourceCombo.SetResourceUpdateStyle ( + const v : TVpResourceUpdate); +begin + if v <> FResourceUpdateStyle then begin + FResourceUpdateStyle := v; + case FResourceUpdateStyle of + ruOnChange : begin + OnChange := ResourceChanged; + OnExit := nil; + end; + ruOnExit : begin + OnChange := nil; + OnExit := ResourceChanged; + end; + ruOnDropDownClose : begin + OnChange := nil; + OnExit := nil; + end; + end; + end; +end; +{=====} + +procedure TVpResourceCombo.SetDataStore(const Value: TVpCustomDataStore); +begin + if FDataStore <> Value then begin + if (Assigned (FDataStore)) and + (not (csDesigning in ComponentState)) then + FDataStore.DeregisterWatcher (Handle); + FDataStore := Value; + if (Assigned (FDataStore)) and + (not (csDesigning in ComponentState)) then + FDataStore.RegisterWatcher (Handle); + if not (csDesigning in ComponentState) then + LoadItems; + Invalidate; + end; +end; +{=====} + + + +{ TVpLinkableControl } + +constructor TVpLinkableControl.Create(AOwner: TComponent); +var + I: Integer; +begin + inherited; + { If the control is being dropped onto a form for the first time then } + { Auto connect to the first ControlLink component found } + if (csDesigning in ComponentState) and not (csLoading in ComponentState) then + begin + I := 0; + while (I < Owner.ComponentCount) and (ControlLink = nil) do begin + if (Owner.Components[I] is TVpControlLink) then + ControlLink := TVpControlLink(Owner.Components[I]); + Inc(I); + end; + end; + FLastPrintLine := -1; +end; +{=====} + +destructor TVpLinkableControl.Destroy; +begin + if ControlLink <> nil then + ControlLink.Detach(Self); + inherited; +end; +{=====} + +function TVpLinkableControl.CheckCreateResource : Boolean; +var + ResEdit : TVpResourceEditDialog; + frmSelectResource : TfrmSelectResource; + +begin + Result := False; + if not Assigned (DataStore) then + Exit; + if not Assigned (DataStore.Resource) then begin + if DataStore.Resources.Count > 0 then begin + { No resource is selected, select one } + if MessageDlg (RSSelectResource, mtConfirmation, + [mbYes, mbNo], 0) = mrYes then begin + frmSelectResource := TfrmSelectResource.Create (Self); + try + frmSelectResource.VpResourceCombo1.DataStore := DataStore; + frmSelectResource.VpResourceEditDialog1.DataStore := DataStore; + if frmSelectResource.ShowModal = mrOk then begin + Result := True; + end else + Exit; + finally + frmSelectResource.Free; + end; + end else + Exit; + end else begin + { There are no resources at all, add one } + if MessageDlg (RSAddNewResource, mtConfirmation, + [mbYes, mbNo], 0) = mrYes then begin + ResEdit := TVpResourceEditDialog.Create (Self); + try + ResEdit.DataStore := DataStore; + Result := ResEdit.AddNewResource; + Exit; + finally + ResEdit.Free; + end; + end else + Exit; + end; + end else + Result := True; +end; + +{=====} +function TVpLinkableControl.GetLastPrintLine : Integer; +begin + Result := FLastPrintLine; +end; +{=====} +procedure TVpLinkableControl.SetDataStore(const Value: TVpCustomDataStore); +begin + if Value = nil then begin + FDataStore := nil; + Invalidate; + end else if FDataStore <> Value then begin + FDataStore := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpLinkableControl.SetControlLink(const Value: TVpControlLink); +var + CL: TVpControlLink; +begin + if (FControlLink <> Value) then begin + + if (FControlLink <> nil) then begin + { FControlLink is currently set to a ControlLink component } + { save old control link value } + CL := FControlLink; + + if (Value = nil) then begin + { We are detaching ourself from the control link and not replacing } + { it with another one. } + FControlLink := nil; + CL.Detach(Self); + end; + + if (Value <> nil) then begin + { We are replacing the current ControlLink with another one } + FControlLink := nil; + CL.Detach(Self); + FControlLink := Value; + FControlLink.Attach(Self); + end; + end else begin + { FControlLink was nil and is now being set } + FControlLink := Value; + FControlLink.Attach(Self); + end; + end; +end; +{=====} + +procedure TVpLinkableControl.CMEnter(var Msg : TMessage); +begin + invalidate; +end; +{=====} + +procedure TVpLinkableControl.CMExit(var Msg : TMessage); +begin + invalidate; +end; +{=====} + + +{ TVpControlLink } + +constructor TVpControlLink.Create(AOwner: TComponent); +var + I: Integer; +begin + inherited; + DependentList := TList.Create; + + { If the ControlLink is being dropped onto a form for the first time ... } + if (csDesigning in ComponentState) and not (csLoading in ComponentState) then + begin + { Auto connect to the first DataStore found } + I := 0; + while (I < Owner.ComponentCount) and (DataStore = nil) do begin + if (Owner.Components[I] is TVpCustomDataStore) then + DataStore := TVpCustomDataStore(Owner.Components[I]); + Inc(I); + end; + + { Then auto connect to all available LinkableControl components found.} + I := 0; + while (I < Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpLinkableControl) then begin + if (TVpLinkableControl(Owner.Components[I]).ControlLink = nil) + and (TVpLinkableControl(Owner.Components[I]).DataStore = DataStore) + then + TVpLinkableControl(Owner.Components[I]).ControlLink := self; + end; + Inc(I); + end; + end; + FPrinter := TVpPrinter.Create (Self); + FLocalization := TVpLocalization.Create; +end; +{=====} + +destructor TVpControlLink.Destroy; +var + I: Integer; +begin + FPrinter.Free; + FPrinter := nil; + + FLocalization.Free; + FLocalization := nil; + + { Detach self from any dependent controls } + if Owner <> nil then begin + I := 0; + while (I < Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpLinkableControl) + and (TVpLinkableControl(Owner.Components[I]).ControlLink = self) then + Detach(TVpLinkableControl(Owner.Components[I])); + Inc(I); + end; + end; + + ReleaseDependents; + DependentList.Free; + inherited; +end; +{=====} + +procedure TVpControlLink.ReleaseDependents; +var + I : Integer; +begin + for I := 0 to pred(DependentList.Count) do + Detach(TVpDependentInfo(DependentList.List^[I]).Component); +end; +{=====} + +procedure TVpControlLink.Detach(Sender: TComponent); +var + I: Integer; +begin + try + for I := 0 to pred(DependentList.Count) do + if TVpDependentInfo(DependentList.List^[I]).Component = Sender then + begin + TVpDependentInfo(DependentList.List^[I]).Free; + DependentList.Delete(I); + if Sender is TVpLinkableControl then + TVpLinkableControl(Sender).ControlLink := nil; + Exit; + end; + except + // swallow exceptions + end; +end; +{=====} + +procedure TVpControlLink.Attach(Sender: TComponent); +var + I : Integer; + Exists: Boolean; + Link: TVpDependentInfo; +begin + Exists := false; + for I := 0 to pred(DependentList.Count) do + if TVpDependentInfo(DependentList.List^[I]).Component = Sender then begin + Exists := true; + Break; + end; + + if not Exists then begin + Link := TVpDependentInfo.Create; + Link.Component := Sender; + if Sender is TVpLinkableCOntrol then + Link.EventHandler := TVpLinkableControl(Sender).LinkHandler; + DependentList.Add(Link); + end; +end; +{=====} + +function TVpControlLink.GetDependentList : TList; +begin + Result := DependentList; +end; +{=====} + +procedure TVpControlLink.LoadLocalizationInfo (const FileName : string); +begin + LocalizationFile := FileName; +end; +{=====} + +procedure TVpControlLink.Notify(Sender: TComponent; + NotificationType: TVpNotificationType; const Value: Variant); +var + I : Integer; +begin + for I := 0 to pred(DependentList.Count) do begin + with TVpDependentInfo(DependentList.List^[I]) do begin + if Component <> Sender then + EventHandler(Sender, NotificationType, Value); + end; + end; +end; +{=====} + +procedure TVpControlLink.SetDataStore(const Value: TVpCustomDataStore); +begin + if FDataStore <> Value then + FDataStore := Value; +end; +{=====} +procedure TVpControlLink.SetDefaultCountry (const v : string); +begin + if v <> FDefaultCountry then begin + FDefaultCountry := v; + end; +end; +{=====} + +procedure TVpControlLink.SetLocalizationFile (const v : string); +begin + if v <> FLocalizationFile then begin + FLocalizationFile := v; + if (FLocalizationFile <> '') and + not (csDesigning in ComponentState) then begin + if not FileExists (v) then begin + if Assigned (FOnNoLocalizationFile) then + FOnNoLocalizationFile (Self, v); + end else + FLocalization.LoadFromFile (FLocalizationFile, False); + end; + end; +end; +{=====} + +procedure TVpControlLink.SetPrinter (const v : TVpPrinter); +begin + FPrinter.Assign (v); +end; +{=====} + +procedure TVpControlLink.TriggerOnGetVariable(Sender : TObject; + VarName: string; Found: Boolean; var Value: string; + var Change: TVpChangeVar); +begin + if Assigned (FOnGetVariable) then + FOnGetVariable (Sender, VarName, Found, Value, Change); +end; +{=====} + +procedure TVpControlLink.TriggerOnPageEnd(Sender: TObject; PageNum: Integer; + ADate: TDateTime; LastPage: Boolean); +begin + if Assigned (FOnPageEnd) then + FOnPageEnd (Sender, PageNum, ADate, LastPage); +end; +{=====} + +procedure TVpControlLink.TriggerOnPageStart(Sender: TObject; PageNum : Integer; + ADate : TDateTime); +begin + if Assigned (FOnPageStart) then + FOnPageStart (Sender, PageNum, ADate); +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpbdeds.pas b/components/tvplanit/source/vpbdeds.pas new file mode 100644 index 000000000..85d4b8f11 --- /dev/null +++ b/components/tvplanit/source/vpbdeds.pas @@ -0,0 +1,1282 @@ +{*********************************************************} +{* VPBDEDS.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpBDEDS; + { BDE DataStore Component } + +interface + +uses + Windows, Classes, Dialogs, SysUtils, Db, DbTables, + VpBase, VpData, VpSR, VpBaseDS, VpDBDS, VpException; + +type + TVpBDEDataStore = class(TVpCustomDBDataStore) + protected{private} + FDatabase : TDatabase; + FAutoCreateAlias : Boolean; + FResourceTable : TQuery; + FEventsTable : TQuery; + FContactsTable : TQuery; + FTasksTable : TQuery; + FRecordIDTable : TQuery; + FAliasName : string; + FDriverName : string; + FLoginPrompt : boolean; + FParams : TStrings; + FSessionName : string; + { property getters } + function GetDatabaseName: string; + function GetConnected: Boolean; + + { anscestor property getters } + function GetResourceTable : TDataset; override; + function GetEventsTable : TDataset; override; + function GetContactsTable : TDataset; override; + function GetTasksTable : TDataset; override; + + { property setters } + procedure SetAutoCreateAlias(Value: Boolean); + procedure InitializeRecordIDTable; + procedure SetAliasName(const Value: string); + procedure SetConnected(const Value: boolean); override; + procedure SetDriverName(const Value: string); + procedure SetLoginPrompt(const Value: boolean); + procedure SetParams(const Value: TStrings); + procedure SetFilterCriteria(aTable : TDataset; aUseDateTime : Boolean; + aResourceID : Integer; aStartDateTime : TDateTime; + aEndDateTime : TDateTime); override; + + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetNextID(TableName: string): integer; override; + procedure Load; override; + procedure CreateTable(TableName: string); + procedure CreateIndexDefs(const TableName : string; + IndexDefs : TIndexDefs); override; + + procedure PostResources; override; + procedure PostEvents; override; + procedure PostContacts; override; + procedure PostTasks; override; + + procedure PurgeResource(Res: TVpResource); override; + procedure PurgeEvents(Res: TVpResource); override; + procedure PurgeContacts(Res: TVpResource); override; + procedure PurgeTasks(Res: TVpResource); override; + + property Database: TDatabase read FDatabase; + + published + property AutoConnect; + property AutoCreate; + + { properties } + property AutoCreateAlias: Boolean + read FAutoCreateAlias write SetAutoCreateAlias; + property DayBuffer; + property ResourceID; + property AliasName: string read FAliasName write SetAliasName; + property DriverName : string read FDriverName write SetDriverName; + property LoginPrompt : boolean read FLoginPrompt write SetLoginPrompt; + property Params : TStrings read FParams write SetParams; + property ReadOnly; + { events } + end; + +implementation + +uses +{$IFDEF VERSION6} + Variants, +{$ELSE} + FileCtrl, +{$ENDIF} + VpConst; + +(*****************************************************************************) +{ TVpBDEDataStore } + +constructor TVpBDEDataStore.Create(AOwner: TComponent); +begin + inherited; + + FParams := TStringList.Create; + + FAliasName := ''; + FConnected := false; + FDriverName := 'STANDARD'; + FLoginPrompt := false; + FParams.Clear; + FSessionName := 'Default'; + FResourceID := 0; + + FDatabase := TDatabase.Create(self); + FDatabase.TransIsolation := tiDirtyRead; + + FResourceTable := TQuery.Create(self); + FResourceTable.DatabaseName := FDatabase.Name; + FResourceTable.CachedUpdates := false; + FResourceTable.SQL.Text := 'SELECT * FROM Resources'; + + FEventsTable := TQuery.Create(self); + FEventsTable.DatabaseName := FDatabase.Name; + FEventsTable.CachedUpdates := false; + FEventsTable.SQL.Text := 'SELECT * FROM Events ' + + 'WHERE (ResourceID = :ResID) ' + + 'AND ((StartTime >= :STime AND EndTime <= :ETime) ' + + 'OR (RepeatCode > 0 AND :STime <= RepeatRangeEnd))'; + + FContactsTable := TQuery.Create(self); + FContactsTable.DatabaseName := FDatabase.Name; + FContactsTable.CachedUpdates := false; + FContactsTable.SQL.Text := 'SELECT * FROM Contacts ' + + 'WHERE ResourceID = :ResID'; + + FTasksTable := TQuery.Create(self); + FTasksTable.DatabaseName := FDatabase.Name; + FTasksTable.CachedUpdates := false; + FTasksTable.SQL.Text := 'SELECT * FROM Tasks ' + + 'WHERE ResourceID = :ResID'; + + FRecordIDTable := TQuery.Create(self); + FRecordIDTable.DatabaseName := FDatabase.Name; + FRecordIDTable.CachedUpdates := false; + + FDatabase.DatabaseName := ''; + FDatabase.AliasName := FAliasName; + FDatabase.Connected := false; + FDatabase.DriverName := FDriverName; + FDatabase.LoginPrompt := FLoginPrompt; + FDatabase.Params := FParams; + FDatabase.ReadOnly := FReadOnly; + FDatabase.SessionName := FSessionName; +end; +{=====} + +destructor TVpBDEDataStore.Destroy; +begin + FParams.Free; + + { free tables } + FDatabase.Close; + FDatabase.Free; + FResourceTable.Free; + FEventsTable.Free; + FContactsTable.Free; + FTasksTable.Free; + FRecordIDTable.Free; + + inherited; +end; +{=====} + +function TVpBDEDataStore.GetDatabaseName: string; +begin + result := FDataBase.DatabaseName; +end; +{=====} + +function TVpBDEDataStore.GetConnected: Boolean; +begin + result := FDatabase.Connected; +end; +{=====} + +function TVpBDEDataStore.GetResourceTable : TDataset; +begin + Result := FResourceTable; +end; +{=====} + +function TVpBDEDataStore.GetEventsTable : TDataset; +begin + Result := FEventsTable; +end; +{=====} + +function TVpBDEDataStore.GetContactsTable : TDataset; +begin + Result := FContactsTable +end; +{=====} + +function TVpBDEDataStore.GetTasksTable : TDataset; +begin + Result := FTasksTable; +end; +{=====} + +procedure TVpBDEDataStore.Load; +begin + if not FDatabase.Connected then exit; + + FResourceTable.Close; + FEventsTable.Close; + FContactsTable.Close; + FTasksTable.Close; + + inherited; +end; +{=====} + +function TVpBDEDataStore.GetNextID(TableName: string): Integer; +var + Query: TQuery; + GotIt: Boolean; + ID : Integer; + FieldName: string; +begin + { The BDEDataStore uses a support table called RecordIDS, or whatever is } + { defined in the RecordIDTableName constant. It has one record, and is } + { used to keep track of the last ID used for each table. } + + { In a multi-user environment, This prevents collisions between two users } + { who happen to enter the same type of new record at the same time. } + + { New record ID's are created here and then the Record ID table is } + { immediately updated to reflect the new value. If the table is } + { unsuccessfully updated, then it is assumed that another user has claimed } + { that ID, so the ID is incremented and another attempt is made, until we } + { are successful. } + + Query := TQuery.Create(self); + ID := 0; + try + Query.DatabaseName := FDatabase.DatabaseName; + + Query.Sql.Text := 'Select * from ' + RecordIDTableName; + Query.Open; + + if TableName = ResourceTableName then begin + FieldName := 'ResourceID'; + ID := Query.FieldByName('ResourceID').AsInteger; + + end else if TableName = TasksTableName then begin + FieldName := 'TaskID'; + ID := Query.FieldByName('TaskID').AsInteger; + + end else if TableName = EventsTableName then begin + FieldName := 'EventID'; + ID := Query.FieldByName('EventID').AsInteger; + + end else if TableName = ContactsTableName then begin + FieldName := 'ContactID'; + ID := Query.FieldByName('ContactID').AsInteger; + + end else begin + raise EInvalidTable.Create; + Exit; + end; + + Query.Close; + Query.SQL.Text := 'Update ' + RecordIDTableName + ' Set ' + FieldName + + ' = :NewID Where (' + FieldName + ' = :OldID)'; + + GotIt := false; + while not GotIt do begin + Inc(ID); + Query.ParamByName('NewID').AsInteger := ID; + Query.ParamByName('OldID').AsInteger := ID - 1; + Query.ExecSQL; + + GotIt := (Query.RowsAffected = 1); + end; + finally + Query.Close; + Query.Free; + end; + + result := ID; +end; +{=====} + +procedure TVpBDEDataStore.CreateTable(TableName: string); +var + Table: TTable; +begin + Table := TTable.Create(self); + try + Table.DatabaseName := FDatabase.DatabaseName; + + if TableName = ResourceTableName then begin + { Create Resources Table } + Table.Active := false; + Table.TableName := ResourceTableName; + end + + else if TableName = EventsTableName then begin + { Create Events Table } + Table.Active := false; + Table.TableName := EventsTableName; + end + + else if TableName = ContactsTableName then begin + { Create Contacts Table } + Table.Active := false; + Table.TableName := ContactsTableName; + end + + else if TableName = TasksTableName then begin + { Create Tasks Table } + Table.Active := false; + Table.TableName := TasksTableName; + end + + else if TableName = RecordIDTableName then begin + { Create Tasks Table } + Table.Active := false; + Table.TableName := RecordIDTableName; + end; + + Table.DatabaseName := FDatabase.DatabaseName; + Table.TableType := ttParadox; + CreateFieldDefs(TableName, Table.FieldDefs); + CreateIndexDefs(TableName, Table.IndexDefs); + + if Table <> nil then + Table.CreateTable; + + if TableName = RecordIDTableName then + InitializeRecordIDTable; + + finally + Table.Free; + end; +end; +{=====} + +procedure TVpBDEDataStore.InitializeRecordIDTable; +var + Qry: TQuery; + ID: Integer; +begin + Qry := TQuery.Create(self); + try + Qry.DatabaseName := FDatabase.DatabaseName; + + Qry.SQL.Text := 'Select * from ' + RecordIDTableName; + Qry.Open; + if Qry.RowsAffected = 0 then begin + { create one record in the table } + Qry.SQL.Clear; + Qry.SQL.Text := 'INSERT INTO ' + RecordIDTableName + + '(ResourceID, EventID, TaskID, ContactID) ' + + 'VALUES(0, 0, 0, 0)'; + Qry.ExecSQL; + end; + Qry.Close; + + { Initialize Resource ID } + Qry.SQL.Text := 'Select Max(ResourceID) as MaxRes from ' + + ResourceTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := ID; + Qry.ExecSQL; + + { Initialize Event RecordID } + Qry.SQL.Text := 'Select Max(RecordID) as MaxEvent from ' + + EventsTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set EventID = :EvID'; + Qry.ParamByName('EvID').AsInteger := ID; + Qry.ExecSQL; + + { Initialize Contact RecordID } + Qry.SQL.Text := 'Select Max(RecordID) as MaxContact from ' + + ContactsTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set ContactID = :CoID'; + Qry.ParamByName('CoID').AsInteger := ID; + Qry.ExecSQL; + + { Initialize Task RecordID } + Qry.SQL.Text := 'Select Max(RecordID) as MaxTask from ' + TasksTableName; + Qry.Open; + ID := Qry.Fields[0].AsInteger; + Qry.Close; + + Qry.SQL.Text := 'Update ' + RecordIDTableName + ' Set TaskID = :TsID'; + Qry.ParamByName('TsID').AsInteger := ID; + Qry.ExecSQL; + + finally + Qry.Free; + end; +end; +{=====} + +procedure TVpBDEDataStore.SetAliasName(const Value: string); +var + WasOpen: Boolean; +begin + WasOpen := Connected; + SetConnected(False); + if FAliasName <> Value then begin + FAliasName := Value; + FDatabase.AliasName := FAliasName; + end; + SetConnected(WasOpen); +end; +{=====} + +procedure TVpBDEDataStore.SetAutoCreateAlias(Value: Boolean); +begin + if Value <> FAutoCreateAlias then + FAutoCreateAlias := Value; +end; +{=====} + +procedure TVpBDEDataStore.Loaded; +begin + inherited; + if not (csDesigning in ComponentState) then + Connected := AutoConnect; +end; +{=====} + +procedure TVpBDEDataStore.PostResources; +var + I: Integer; + Resource: TVpResource; + Qry: TQuery; +begin + if (Resources.Count > 0) then begin + Qry := TQuery.Create(self); + Qry.DatabaseName := AliasName; + Qry.RequestLive := true; + try + for I := pred(Resources.Count) downto 0 do begin + Resource := Resources.Items[I]; + if Resource = nil then begin + Continue; + end; + + if Resource.Deleted then begin + PurgeEvents(Resource); + PurgeContacts(Resource); + PurgeTasks(Resource); + Qry.SQL.Text := 'DELETE FROM Resources ' + + 'WHERE ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + Resource.Free; + Continue; + end + + else if Resource.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Resources ' + + 'WHERE ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.Open; + + if Qry.Locate('ResourceID', Resource.ResourceID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('Description').AsString := Resource.Description; + Qry.FieldByName('Notes').AsString := Resource.Notes; + Qry.FieldByName('ResourceActive').AsBoolean := Resource.Active; + Qry.FieldByName('UserField0').AsString := Resource.UserField0; + Qry.FieldByName('UserField1').AsString := Resource.UserField1; + Qry.FieldByName('UserField2').AsString := Resource.UserField2; + Qry.FieldByName('UserField3').AsString := Resource.UserField3; + Qry.FieldByName('UserField4').AsString := Resource.UserField4; + Qry.FieldByName('UserField5').AsString := Resource.UserField5; + Qry.FieldByName('UserField6').AsString := Resource.UserField6; + Qry.FieldByName('UserField7').AsString := Resource.UserField7; + Qry.FieldByName('UserField8').AsString := Resource.UserField8; + Qry.FieldByName('UserField9').AsString := Resource.UserField9; + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.SQL.Clear; + Qry.SQL.Text := 'INSERT INTO Resources ' + + '(ResourceID, Description, Notes, ResourceActive, UserField0, ' + + 'UserField1, UserField2, UserField3, UserField4, UserField5, ' + + 'UserField6, UserField7, UserField8, UserField9) ' + + 'VALUES(:ResID, :Descr, :Notes, :ResActive, :UserField0, ' + + ':UserField1, :UserField2, :UserField3, :UserField4, ' + + ':UserField5, :UserField6, :UserField7, :UserField8, ' + + ':UserField9)'; + + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ParamByName('Descr').Asstring := Resource.Description; + Qry.ParamByName('Notes').AsString := Resource.Notes; + Qry.ParamByName('ResActive').AsBoolean := Resource.Active; + Qry.ParamByName('UserField0').AsString := Resource.UserField0; + Qry.ParamByName('UserField1').AsString := Resource.UserField1; + Qry.ParamByName('UserField2').AsString := Resource.UserField2; + Qry.ParamByName('UserField3').AsString := Resource.UserField3; + Qry.ParamByName('UserField4').AsString := Resource.UserField4; + Qry.ParamByName('UserField5').AsString := Resource.UserField5; + Qry.ParamByName('UserField6').AsString := Resource.UserField6; + Qry.ParamByName('UserField7').AsString := Resource.UserField7; + Qry.ParamByName('UserField8').AsString := Resource.UserField8; + Qry.ParamByName('UserField9').AsString := Resource.UserField9; + + Qry.ExecSQL; + end; + Resource.Changed := false; + end; + { if this is the active resource, then update all of its stuff } + if Resource.ResourceID = ResourceID then begin + PostEvents; + PostContacts; + PostTasks; + end; + end; + Resources.Sort; + NotifyDependents; + finally + Qry.Close; + Qry.Free; + end; + end; +end; +{=====} + +procedure TVpBDEDataStore.PostEvents; +var + I: Integer; + Event: TVpEvent; + Qry: TQuery; +begin + if (Resource <> nil) and Resource.EventsDirty then begin + Qry := TQuery.Create(self); + try + Qry.DatabaseName := AliasName; + Qry.RequestLive := true; + + for I := pred(Resource.Schedule.EventCount) downto 0 do begin + Event := Resource.Schedule.GetEvent(I); + if Event.Deleted then begin + Qry.SQL.Text := 'DELETE FROM Events ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Event.RecordID; + Qry.ExecSQL; + Event.Free; + Continue; + end + + else if Event.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Events ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Event.RecordID; + Qry.Open; + + if Qry.Locate('RecordID', Event.RecordID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('RecordID').AsInteger := Event.RecordID; + Qry.FieldByName('StartTime').AsDateTime := Event.StartTime; + Qry.FieldByName('EndTime').AsDateTime := Event.EndTime; + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('Description').AsString := Event.Description; + Qry.FieldByName('Notes').AsString := Event.Note; + Qry.FieldByName('Category').AsInteger := Event.Category; + Qry.FieldByName('DingPath').AsString := Event.AlarmWavPath; + Qry.FieldByName('AllDayEvent').AsBoolean := Event.AllDayEvent; + Qry.FieldByName('AlarmSet').AsBoolean := Event.AlarmSet; + Qry.FieldByName('AlarmAdvance').AsInteger := Event.AlarmAdv; + Qry.FieldByName('AlarmAdvanceType').AsInteger := Ord(Event.AlarmAdvType); + Qry.FieldByName('SnoozeTime').AsDateTime := Event.SnoozeTime; + Qry.FieldByName('RepeatCode').AsInteger := Ord(Event.RepeatCode); + Qry.FieldByName('RepeatRangeEnd').AsDateTime := Event.RepeatRangeEnd; + Qry.FieldByName('CustomInterval').AsInteger := Event.CustInterval; + Qry.FieldByName('UserField0').AsString := Event.UserField0; + Qry.FieldByName('UserField1').AsString := Event.UserField1; + Qry.FieldByName('UserField2').AsString := Event.UserField2; + Qry.FieldByName('UserField3').AsString := Event.UserField3; + Qry.FieldByName('UserField4').AsString := Event.UserField4; + Qry.FieldByName('UserField5').AsString := Event.UserField5; + Qry.FieldByName('UserField6').AsString := Event.UserField6; + Qry.FieldByName('UserField7').AsString := Event.UserField7; + Qry.FieldByName('UserField8').AsString := Event.UserField8; + Qry.FieldByName('UserField9').AsString := Event.UserField9; + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.Close; + Qry.SQL.Text := 'INSERT INTO Events ' + + '(RecordID, StartTime, EndTime, ResourceID, Description, Notes, ' + + 'SnoozeTime, Category, DingPath, AllDayEvent, AlarmSet, ' + + 'AlarmAdvance, AlarmAdvanceType, RepeatCode, ' + + 'RepeatRangeEnd, CustomInterval, ' + + 'UserField0, UserField1, UserField2, UserField3, UserField4, ' + + 'UserField5, UserField6, UserField7, UserField8, UserField9) ' + + 'VALUES(:RecID, :STime, :ETime, :ResID, :Desc, :Notes, :SnTime, ' + + ':Cat, :DPath, :ADEvent, :ASet, :AAdvance, :AAdvanceType, ' + + ':RCode, :RRangeEnd, :CInterval, :UserField0, ' + + ':UserField1, :UserField2, :UserField3, :UserField4, ' + + ':UserField5, :UserField6, :UserField7, :UserField8, ' + + ':UserField9)'; + + Qry.ParamByName('RecID').AsInteger := Event.RecordID; + Qry.ParamByName('STime').AsDateTime := Event.StartTime; + Qry.ParamByName('ETime').AsDateTime := Event.EndTime; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ParamByName('Desc').AsString := Event.Description; + Qry.ParamByName('Notes').AsString := Event.Note; + Qry.ParamByName('SnTime').AsDateTime := Event.SnoozeTime; + Qry.ParamByName('Cat').AsInteger := Event.Category; + Qry.ParamByName('DPath').AsString := Event.AlarmWavPath; + Qry.ParamByName('ADEvent').AsBoolean := Event.AllDayEvent; + Qry.ParamByName('ASet').AsBoolean := Event.AlarmSet; + Qry.ParamByName('AAdvance').AsInteger := Event.AlarmAdv; + Qry.ParamByName('AAdvanceType').AsInteger := Ord(Event.AlarmAdvType); + Qry.ParamByName('RCode').AsInteger := Ord(Event.RepeatCode); + Qry.ParamByName('RRangeEnd').AsDateTime := Event.RepeatRangeEnd; + Qry.ParamByName('CInterval').AsInteger := Event.CustInterval; + Qry.ParamByName('UserField0').AsString := Event.UserField0; + Qry.ParamByName('UserField1').AsString := Event.UserField1; + Qry.ParamByName('UserField2').AsString := Event.UserField2; + Qry.ParamByName('UserField3').AsString := Event.UserField3; + Qry.ParamByName('UserField4').AsString := Event.UserField4; + Qry.ParamByName('UserField5').AsString := Event.UserField5; + Qry.ParamByName('UserField6').AsString := Event.UserField6; + Qry.ParamByName('UserField7').AsString := Event.UserField7; + Qry.ParamByName('UserField8').AsString := Event.UserField8; + Qry.ParamByName('UserField9').AsString := Event.UserField9; + + Qry.ExecSQL; + end; + Event.Changed := false; + end; + end; + Resource.Schedule.Sort; + NotifyDependents; + finally + Qry.Close; + Qry.Free; + end; + Resource.EventsDirty := false; + end; +end; +{=====} + +procedure TVpBDEDataStore.PostContacts; +var + I: Integer; + Contact: TVpContact; + Qry: TQuery; +begin + if (Resource <> nil) and Resource.ContactsDirty then begin + { Dump this resource's dirty contacts to the DB } + Qry := TQuery.Create(self); + try + Qry.DatabaseName := AliasName; + Qry.RequestLive := true; + + for I := pred(Resource.Contacts.Count) downto 0 do begin + Contact := Resource.Contacts.GetContact(I); + + if Contact.Deleted then begin + Qry.SQL.Text := 'DELETE FROM Contacts ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Contact.RecordID; + Qry.ExecSQL; + Contact.Free; + Continue; + end + + else if Contact.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Contacts ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Contact.RecordID; + Qry.Open; + + if Qry.Locate('RecordID', Contact.RecordID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('RecordID').AsInteger := Contact.RecordID; + Qry.FieldByName('FirstName').AsString := Contact.FirstName; + Qry.FieldByName('LastName').AsString := Contact.LastName; + { - begin} + Qry.FieldByName('Birthdate').AsDateTime := Contact.BirthDate; + Qry.FieldByName('Anniversary').AsDateTime := Contact.Anniversary; + { - end} + Qry.FieldByName('Title').AsString := Contact.Title; + Qry.FieldByName('Company').AsString := Contact.Company; + Qry.FieldByName('Job_Position').AsString := Contact.Position; + Qry.FieldByName('EMail').AsString := Contact.EMail; + Qry.FieldByName('Address').AsString := Contact.Address; + Qry.FieldByName('City').AsString := Contact.City; + Qry.FieldByName('State').AsString := Contact.State; + Qry.FieldByName('Zip').AsString := Contact.Zip; + Qry.FieldByName('Country').AsString := Contact.Country; + Qry.FieldByName('Note').AsString := Contact.Note; + Qry.FieldByName('Phone1').AsString := Contact.Phone1; + Qry.FieldByName('Phone2').AsString := Contact.Phone2; + Qry.FieldByName('Phone3').AsString := Contact.Phone3; + Qry.FieldByName('Phone4').AsString := Contact.Phone4; + Qry.FieldByName('Phone5').AsString := Contact.Phone5; + Qry.FieldByName('PhoneType1').AsInteger := Contact.PhoneType1; + Qry.FieldByName('PhoneType2').AsInteger := Contact.PhoneType2; + Qry.FieldByName('PhoneType3').AsInteger := Contact.PhoneType3; + Qry.FieldByName('PhoneType4').AsInteger := Contact.PhoneType4; + Qry.FieldByName('PhoneType5').AsInteger := Contact.PhoneType5; + Qry.FieldByName('Category').AsInteger := Contact.Category; + Qry.FieldByName('Custom1').AsString := Contact.Custom1; + Qry.FieldByName('Custom2').AsString := Contact.Custom2; + Qry.FieldByName('Custom3').AsString := Contact.Custom3; + Qry.FieldByName('Custom4').AsString := Contact.Custom4; + Qry.FieldByName('UserField0').AsString := Contact.UserField0; + Qry.FieldByName('UserField1').AsString := Contact.UserField1; + Qry.FieldByName('UserField2').AsString := Contact.UserField2; + Qry.FieldByName('UserField3').AsString := Contact.UserField3; + Qry.FieldByName('UserField4').AsString := Contact.UserField4; + Qry.FieldByName('UserField5').AsString := Contact.UserField5; + Qry.FieldByName('UserField6').AsString := Contact.UserField6; + Qry.FieldByName('UserField7').AsString := Contact.UserField7; + Qry.FieldByName('UserField8').AsString := Contact.UserField8; + Qry.FieldByName('UserField9').AsString := Contact.UserField9; + + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.Close; + + { - Modified} + Qry.SQL.Text := 'INSERT INTO Contacts ' + + '(ResourceID, RecordID, FirstName, LastName, Birthdate, ' + + 'Anniversary, Title, Company, Job_Position, EMail, Address, ' + + 'City, State, Zip, Country, Note, Phone1, Phone2, Phone3, ' + + 'Phone4, Phone5, PhoneType1, PhoneType2, PhoneType3, PhoneType4, ' + + 'PhoneType5, Category, Custom1, Custom2, Custom3, Custom4, ' + + 'UserField0, UserField1, UserField2, UserField3, UserField4, ' + + 'UserField5, UserField6, UserField7, UserField8, UserField9 ) ' + + + 'VALUES(:ResourceID, :RecordID, :FirstName, :LastName, ' + + ':Birthdate, :Anniversary, :Title, :Company, :Job_Position, ' + + ':EMail, :Address, :City, :State, :Zip, :Country, :Note, ' + + ':Phone1, :Phone2, :Phone3, :Phone4, :Phone5, :PhoneType1, ' + + ':PhoneType2, :PhoneType3, :PhoneType4, :PhoneType5, :Category, ' + + ':Custom1, :Custom2, :Custom3, :Custom4, :UserField0, ' + + ':UserField1, :UserField2, :UserField3, :UserField4, :UserField5, ' + + ':UserField6, :UserField7, :UserField8, :UserField9)'; + + Qry.ParamByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.ParamByName('RecordID').AsInteger := Contact.RecordID; + Qry.ParamByName('FirstName').AsString := Contact.FirstName; + Qry.ParamByName('LastName').AsString := Contact.LastName; + { - begin} + Qry.ParamByName('Birthdate').AsDateTime := Contact.Birthdate; + Qry.ParamByName('Anniversary').AsDateTime := Contact.Anniversary; + { - end} + Qry.ParamByName('Title').AsString := Contact.Title; + Qry.ParamByName('Company').AsString := Contact.Company; + Qry.ParamByName('Job_Position').AsString := Contact.Position; + Qry.ParamByName('EMail').AsString := Contact.EMail; + Qry.ParamByName('Address').AsString := Contact.Address; + Qry.ParamByName('City').AsString := Contact.City; + Qry.ParamByName('State').AsString := Contact.State; + Qry.ParamByName('Zip').AsString := Contact.Zip; + Qry.ParamByName('Country').AsString := Contact.Country; + Qry.ParamByName('Note').AsString := Contact.Note; + Qry.ParamByName('Phone1').AsString := Contact.Phone1; + Qry.ParamByName('Phone2').AsString := Contact.Phone2; + Qry.ParamByName('Phone3').AsString := Contact.Phone3; + Qry.ParamByName('Phone4').AsString := Contact.Phone4; + Qry.ParamByName('Phone5').AsString := Contact.Phone5; + Qry.ParamByName('PhoneType1').AsInteger := Contact.PhoneType1; + Qry.ParamByName('PhoneType2').AsInteger := Contact.PhoneType2; + Qry.ParamByName('PhoneType3').AsInteger := Contact.PhoneType3; + Qry.ParamByName('PhoneType4').AsInteger := Contact.PhoneType4; + Qry.ParamByName('PhoneType5').AsInteger := Contact.PhoneType5; + Qry.ParamByName('Category').AsInteger := Contact.Category; + Qry.ParamByName('Custom1').AsString := Contact.Custom1; + Qry.ParamByName('Custom2').AsString := Contact.Custom2; + Qry.ParamByName('Custom3').AsString := Contact.Custom3; + Qry.ParamByName('Custom4').AsString := Contact.Custom4; + Qry.ParamByName('UserField0').AsString := Contact.UserField0; + Qry.ParamByName('UserField1').AsString := Contact.UserField1; + Qry.ParamByName('UserField2').AsString := Contact.UserField2; + Qry.ParamByName('UserField3').AsString := Contact.UserField3; + Qry.ParamByName('UserField4').AsString := Contact.UserField4; + Qry.ParamByName('UserField5').AsString := Contact.UserField5; + Qry.ParamByName('UserField6').AsString := Contact.UserField6; + Qry.ParamByName('UserField7').AsString := Contact.UserField7; + Qry.ParamByName('UserField8').AsString := Contact.UserField8; + Qry.ParamByName('UserField9').AsString := Contact.UserField9; + + Qry.ExecSQL; + end; + Contact.Changed := false; + end; + end; + + finally + Qry.Free; + end; + Resource.ContactsDirty := false; + end; +end; +{=====} + +procedure TVpBDEDataStore.PostTasks; +var + I: Integer; + Task: TVpTask; + Qry : TQuery; +begin + if (Resource <> nil) and Resource.TasksDirty then begin + { Dump this resource's dirty contacts to the DB } + Qry := TQuery.Create(self); + try + Qry.DatabaseName := AliasName; + Qry.RequestLive := true; + + for I := pred(Resource.Tasks.Count) downto 0 do begin + Task := Resource.Tasks.GetTask(I); + if Task.Deleted then begin + Qry.SQL.Text := 'DELETE FROM Tasks ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Task.RecordID; + Qry.ExecSQL; + Task.Free; + Continue; + end + + else if Task.Changed then begin + Qry.SQL.Text := 'SELECT * FROM Tasks ' + + 'WHERE RecordID = :ID'; + Qry.ParamByName('ID').AsInteger := Task.RecordID; + Qry.Open; + + if Qry.Locate('RecordID', Task.RecordID, []) + then begin + { existing record found } + Qry.Edit; + try + Qry.FieldByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.FieldByName('Description').AsString := Task.Description; + Qry.FieldByName('Details').AsString := Task.Details; + Qry.FieldByName('Complete').AsBoolean := Task.Complete; + Qry.FieldByName('DueDate').AsDateTime := Task.DueDate; + Qry.FieldByName('CreatedOn').AsDateTime := Task.CreatedOn; + Qry.FieldByName('CompletedOn').AsDateTime := Task.CompletedOn; + Qry.FieldByName('Priority').AsInteger := Task.Priority; + Qry.FieldByName('Category').AsInteger := Task.Category; + Qry.FieldByName('UserField0').AsString := Task.UserField0; + Qry.FieldByName('UserField1').AsString := Task.UserField1; + Qry.FieldByName('UserField2').AsString := Task.UserField2; + Qry.FieldByName('UserField3').AsString := Task.UserField3; + Qry.FieldByName('UserField4').AsString := Task.UserField4; + Qry.FieldByName('UserField5').AsString := Task.UserField5; + Qry.FieldByName('UserField6').AsString := Task.UserField6; + Qry.FieldByName('UserField7').AsString := Task.UserField7; + Qry.FieldByName('UserField8').AsString := Task.UserField8; + Qry.FieldByName('UserField9').AsString := Task.UserField9; + Qry.Post; + except + Qry.Cancel; + raise EDBPostError.Create; + end; + end else begin + Qry.Close; + Qry.SQL.Text := 'INSERT INTO Tasks ' + + '(RecordID, ResourceID, Description, Details, ' + + 'Complete, DueDate, CreatedOn, CompletedOn, Priority, Category, ' + + 'UserField0, UserField1, UserField2, UserField3, UserField4, ' + + 'UserField5, UserField6, UserField7, UserField8, UserField9) ' + + + 'VALUES(:RecordID, :ResourceID, :Description, :Details, ' + + ':Complete, :DueDate, :CreatedOn, :CompletedOn, :Priority, ' + + ':Category, :UserField0, :UserField1, :UserField2, :UserField3, ' + + ':UserField4, :UserField5, :UserField6, :UserField7, ' + + ':UserField8, :UserField9)'; + + Qry.ParamByName('RecordID').AsInteger := Task.RecordID; + Qry.ParamByName('ResourceID').AsInteger := Resource.ResourceID; + Qry.ParamByName('Description').AsString := Task.Description; + Qry.ParamByName('Details').AsString := Task.Details; + Qry.ParamByName('Complete').AsBoolean := Task.Complete; + Qry.ParamByName('DueDate').AsDateTime := Task.DueDate; + Qry.ParamByName('CreatedOn').AsDateTime := Task.CreatedOn; + Qry.ParamByName('CompletedOn').AsDateTime := Task.CompletedOn; + Qry.ParamByName('Priority').AsInteger := Task.Priority; + Qry.ParamByName('Category').AsInteger := Task.Category; + Qry.ParamByName('UserField0').AsString := Task.UserField0; + Qry.ParamByName('UserField1').AsString := Task.UserField1; + Qry.ParamByName('UserField2').AsString := Task.UserField2; + Qry.ParamByName('UserField3').AsString := Task.UserField3; + Qry.ParamByName('UserField4').AsString := Task.UserField4; + Qry.ParamByName('UserField5').AsString := Task.UserField5; + Qry.ParamByName('UserField6').AsString := Task.UserField6; + Qry.ParamByName('UserField7').AsString := Task.UserField7; + Qry.ParamByName('UserField8').AsString := Task.UserField8; + Qry.ParamByName('UserField9').AsString := Task.UserField9; + Qry.ExecSQL; + end; + Task.Changed := false; + end + end; + + finally + Qry.Free; + end; + + Resource.TasksDirty := false; + end; +end; +{=====} + +procedure TVpBDEDataStore.PurgeResource(Res: TVpResource); +begin + Resource.Deleted := true; + PostResources; + Load; +end; +{=====} + +procedure TVpBDEDataStore.PurgeEvents(Res: TVpResource); +var + Qry: TQuery; +begin + Qry := TQuery.Create(self); + try + Qry.DatabaseName := FDataBase.DatabaseName; + + Qry.SQL.Text := 'delete from Events where ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + finally + Qry.Free; + end; + Resource.Schedule.ClearEvents; +end; +{=====} + +procedure TVpBDEDataStore.PurgeContacts(Res: TVpResource); +var + Qry: TQuery; +begin + Qry := TQuery.Create(self); + try + Qry.DatabaseName := FDataBase.DatabaseName; + + Qry.SQL.Text := 'delete from Contacts where ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + finally + Qry.Free; + end; + Resource.Contacts.ClearContacts; +end; +{=====} + +procedure TVpBDEDataStore.PurgeTasks(Res: TVpResource); +var + Qry: TQuery; +begin + Qry := TQuery.Create(self); + try + Qry.DatabaseName := FDataBase.DatabaseName; + + Qry.SQL.Text := 'delete from Tasks where ResourceID = :ResID'; + Qry.ParamByName('ResID').AsInteger := Resource.ResourceID; + Qry.ExecSQL; + finally + Qry.Free; + end; + Resource.Tasks.ClearTasks; +end; +{=====} + +procedure TVpBDEDataStore.SetConnected(const Value: boolean); +var + Tmp, AliasPath: string; + Qry: TQuery; + StringList: TStringList; +begin + { disconnect if destroying } + if csDestroying in ComponentState then begin + FDataBase.Connected := false; + Exit; + end; + + { Don't connect at designtime } + if csDesigning in ComponentState then Exit; + + { Don't try to connect until we're all loaded up } + if csLoading in ComponentState then Exit; + + if FAutoCreateAlias then begin + { if there is no defined alias name then create one based on the } + { application executable file's name and assign it to FDatabase } + if FAliasName = '' then begin + Tmp := ExtractFileName(ParamStr(0)); + FAliasName := Tmp; + FAliasName := Copy(FAliasName, 1, Pos('.', FAliasName) - 1); + FDatabase.AliasName := FAliasName; + end; + { if the alias doesn't exist, then create it } + if not Session.IsAlias(FDatabase.AliasName) then begin + AliasPath := ExtractFilePath(ParamStr(0)) + 'Data'; + if not DirectoryExists(AliasPath) then + ForceDirectories(AliasPath); + Session.AddStandardAlias(FDatabase.AliasName, AliasPath, 'PARADOX'); + { Make sure the alias is saved to the BDE config file. } + Session.SaveConfigFile; + end; + end else + if not Session.IsAlias(FDatabase.AliasName) then Exit; + + if FDatabase.DatabaseName = '' then + FDatabase.DatabaseName := 'VpDatabase' + Name[Length(Name)]; + + FDataBase.Connected := Value; + if FDataBase.Connected then begin + Qry := TQuery.Create(self); + Qry.DatabaseName := FAliasName; + try + + StringList := TStringList.Create; + try + Session.GetAliasParams(FAliasName, StringList); + AliasPath := Copy(StringList[0], Pos('=', StringList[0]) + 1, Length(StringList[0])); + finally + StringList.Free; + end; + + { Create / Open Resources Table} + FResourceTable.DatabaseName := FDatabase.DatabaseName; + if (AliasPath <> '') + and (not FileExists(AliasPath + '\' + ResourceTableName + '.*')) + then CreateTable(ResourceTableName); + try + FResourceTable.Open; + except + if AutoCreate then begin + CreateTable(ResourceTableName); + FResourceTable.Open; + end; + end; + + { Create / Open Events Table } + FEventsTable.DatabaseName := FDatabase.DatabaseName; + if (AliasPath <> '') + and (not FileExists(AliasPath + '\' + EventsTableName + '.*')) + then CreateTable(EventsTableName); + SetFilterCriteria(FEventsTable, + True, + ResourceTable.FieldByName('ResourceID').AsInteger, + TimeRange.StartTime, + TimeRange.EndTime); + try + FEventsTable.Open; + except + if AutoCreate then begin + CreateTable(EventsTableName); + FEventsTable.Open; + end; + end; + + { Create / Open Contacts Table } + FContactsTable.DatabaseName := FDatabase.DatabaseName; + if (AliasPath <> '') + and (not FileExists(AliasPath + '\' + ContactsTableName + '.*')) + then CreateTable(ContactsTableName); + SetFilterCriteria(FContactsTable, False, + ResourceTable.FieldByName('ResourceID').AsInteger, + 0, 0); + try + FContactsTable.Open; + except + if AutoCreate then begin + CreateTable(ContactsTableName); + FContactsTable.Open; + end; + end; + + + { Create / Open Tasks Table } + FTasksTable.DatabaseName := FDatabase.DatabaseName; + if (AliasPath <> '') + and (not FileExists(AliasPath + '\' + TasksTableName + '.*')) + then CreateTable(TasksTableName); + SetFilterCriteria(FTasksTable, False, + ResourceTable.FieldByName('ResourceID').AsInteger, + 0, 0); + try + FTasksTable.Open; + except + if AutoCreate then begin + CreateTable(TasksTableName); + FTasksTable.Open; + end; + end; + + { Create / Open RecordID Table } + FRecordIDTable.DatabaseName := FDatabase.DatabaseName; + if (AliasPath <> '') + and (not FileExists(AliasPath + '\' + RecordIDTableName + '.*')) + then CreateTable(RecordIDTableName); + + finally + Qry.Free; + end; + + Load; + end + else begin + FTasksTable.Close; + FContactsTable.Close; + FResourceTable.Close; + FEventsTable.Close; + end; + + inherited SetConnected(Database.Connected); +end; +{=====} + +procedure TVpBDEDataStore.SetDriverName(const Value: string); +begin + FDriverName := Value; +end; +{=====} + +procedure TVpBDEDataStore.SetLoginPrompt(const Value: boolean); +begin + FLoginPrompt := Value; +end; +{=====} + +procedure TVpBDEDataStore.SetParams(const Value: TStrings); +begin + FParams.Assign(Value); +end; +{=====} + +{ Called by the ancestor to properly filter the data for each table, } +{ based on the ResourceID, Date and DayBuffer values. } +{ Each TVpCustomDBDataStore descendant should define their own } +{ SetFilterCriteria procedure. } +procedure TVpBDEDataStore.SetFilterCriteria(aTable : TDataset; + aUseDateTime : Boolean; aResourceID : Integer; aStartDateTime : TDateTime; + aEndDateTime : TDateTime); +var + Qry: TQuery; +begin + Qry := (aTable as TQuery); + + Qry.Close; + + Qry.ParamByName('ResID').AsInteger := aResourceID; + + if Qry = EventsTable then begin + Qry.ParamByName('STime').AsDateTime := aStartDateTime; + Qry.ParamByName('ETime').AsDateTime := aEndDateTime; + end; + + Qry.Open; +end; +{=====} + +procedure TVpBDEDataStore.CreateIndexDefs(const TableName: string; + IndexDefs: TIndexDefs); +begin + if TableName = ResourceTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'ResourceID'; + Options := [ixPrimary]; + end; + end; + end else if TableName = EventsTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'RecordID'; + Options := [ixUnique, ixPrimary]; + end; + end; + end else if TableName = ContactsTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'RecordID'; + Options := [ixPrimary]; + end; + end; + end else if TableName = TasksTableName then begin + with IndexDefs do begin + Clear; + { Paradox primary keys have no name } + with AddIndexDef do begin + Name := ''; + Fields := 'RecordID'; + Options := [ixPrimary]; + end; + end; + end; + + inherited CreateIndexDefs(TableName, IndexDefs); +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpcalendar.pas b/components/tvplanit/source/vpcalendar.pas new file mode 100644 index 000000000..fa5a71453 --- /dev/null +++ b/components/tvplanit/source/vpcalendar.pas @@ -0,0 +1,2105 @@ +{*********************************************************} +{* VPCALENDAR.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpCalendar; + {-Calendar component} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Buttons, Classes, Controls, Forms, Graphics, Menus, Messages, + SysUtils, VpBase, VpSR, VpConst, VpMisc, VpBaseDS, VpCanvasUtils, + VpException; + +type + TVpCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive, + cdoShowRevert, cdoShowToday, cdoShowNavBtns, + cdoHideActive, cdoHighlightSat, cdoHighlightSun); + + TVpCalDisplayOptions = set of TVpCalDisplayOption; + + TVpCalColorArray = array[0..6] of TColor; + + TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows, + cscalGold, cscalOcean, cscalRose); + + TVpCalSchemeArray = array[TVpCalColorScheme] of TVpCalColorArray; + + TRowArray = array[0..8] of Integer; + TColArray = array[0..6] of Integer; + +const + {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend} + CalScheme : TVpCalSchemeArray = + ((0, 0, 0, 0, 0, 0, 0), + (clHighlight, clWindow, clWindow, clWindow, clWindow, clWindow, clBlack), + (clRed, clMaroon, clBlack, clGray, clBlue, clRed, clBlack), + (clBlack, clBlack, clYellow, clGray, clBlack, clTeal, clBlack), + (clBlack, clBlack, clAqua, clGray, clBlack, clNavy, clBlack), + (clRed, clRed, clFuchsia, clGray, clBlue, clTeal, clBlack) + ); + calDefWeekStarts = dtSunday;{ default start of the week } + +type + TVpCalColors = class(TPersistent) + protected {private} + {property variables} + FUpdating : Boolean; + FOnChange : TNotifyEvent; + + {internal variables} + SettingScheme : Boolean; + + {property methods} + function GetColor(Index : Integer) : TColor; + procedure SetColor(Index : Integer; Value : TColor); + procedure SetColorScheme(Value : TVpCalColorScheme); + + {internal methods} + procedure DoOnChange; + + public + {public property variables} + FCalColors : TVpCalColorArray; + FColorScheme : TVpCalColorScheme; + + procedure Assign(Source : TPersistent); override; + procedure BeginUpdate; + procedure EndUpdate; + + property OnChange : TNotifyEvent read FOnChange write FOnChange; + + published + property ActiveDay : TColor index 0 read GetColor write SetColor; + property ColorScheme : TVpCalColorScheme read FColorScheme + write SetColorScheme; + property DayNames : TColor index 1 read GetColor write SetColor; + property Days : TColor index 2 read GetColor write SetColor; + property InactiveDays : TColor index 3 read GetColor write SetColor; + property MonthAndYear : TColor index 4 read GetColor write SetColor; + property Weekend : TColor index 5 read GetColor write SetColor; + property EventDays: TColor index 6 read GetColor write SetColor; + end; + +type + TDateChangeEvent = + procedure(Sender : TObject; Date : TDateTime) of object; + TCalendarDateEvent = + procedure(Sender : TObject; ADate : TDateTime; + const Rect : TRect) of object; + TGetHighlightEvent = + procedure(Sender : TObject; ADate : TDateTime; + var Color : TColor) of object; + TGetDateEnabledEvent = + procedure(Sender : TObject; ADate : TDateTime; + var Enabled : Boolean) of object; + + TVpCustomCalendar = class(TVpLinkableControl) + protected {private} + {property variables} + FBorderStyle : TBorderStyle; + FBrowsing : Boolean; + FColors : TVpCalColors; + FOptions : TVpCalDisplayOptions; + FDate : TDateTime; + FDay : Integer; {calendar day} + FDateFormat : TVpDateFormat; + FDayNameWidth : TVpDayNameWidth; + FDrawHeader : Boolean; {true to draw day name header} + FMonth : Integer; {calendar month} + FReadOnly : Boolean; {true if in read only mode} + FWantDblClicks : Boolean; {true to include cs_dblclks style} + FWeekStarts : TVpDayType; {the day that begins the week} + FYear : Integer; {calendar year} + FLastRenderX : Integer; + FLastRenderY : Integer; + FDefaultPopup : TPopupMenu; + + {event variables} + FOnChange : TDateChangeEvent; + FOnDrawDate : TCalendarDateEvent; + FOnDrawItem : TCalendarDateEvent; + FOnGetDateEnabled: TGetDateEnabledEvent; + FOnGetHighlight : TGetHighlightEvent; + + {internal variables} + clInLinkHandler : Boolean; + clBtnLeft : TSpeedButton; + clBtnRevert : TSpeedButton; + clBtnRight : TSpeedButton; + clBtnToday : TSpeedButton; + clInPopup : Boolean; + clBtnNextYear : TSpeedButton; + clBtnPrevYear : TSpeedButton; + clCalendar : array[1..49] of Byte; {current month grid} + clDay : Word; + clFirst : Byte; {index for first day in current month} + clLast : Byte; {index for last day in current month} + clMonth : Word; + clRowCol : array[0..8, 0..6] of TRect; {cell TRect info} + cSettingScheme : Boolean; + clYear : Word; + clWidth : Integer; {client width - margins} + clMask : array[0..MaxDateLen] of AnsiChar; {default date mask} + clPopup : Boolean; {true if being created as a popup} + clRevertDate : TDateTime; {date on entry} + clRowCount : Integer; {7 if no header, otherwise 8} + clStartRow : Integer; {first row number} + + {property methods} + function GetDay : Integer; + function GetMonth : Integer; + function GetYear : Integer; + procedure SetBorderStyle(Value : TBorderStyle); + procedure SetDate(Value : TDateTime); + procedure SetDateFormat(Value : TVpDateFormat); + procedure SetDayNameWidth(Value : TVpDayNameWidth); + procedure SetDisplayOptions(Value : TVpCalDisplayOptions); + procedure SetDrawHeader(Value : Boolean); + procedure SetWantDblClicks(Value : Boolean); + procedure SetWeekStarts(Value : TVpDayType); + + {internal methods} + procedure PopupToday (Sender : TObject); + procedure PopupNextMonth (Sender : TObject); + procedure PopupPrevMonth(Sender : TObject); + procedure PopupNextYear (Sender : TObject); + procedure PopupPrevYear (Sender : TObject); + procedure InitializeDefaultPopup; + procedure calChangeMonth(Sender : TObject); + procedure calColorChange(Sender : TObject); + function calGetCurrentRectangle : TRect; + {-get bounding rectangle for the current calendar day} + function calGetValidDate(ADate : TDateTime; Delta : Integer) : TDateTime; + procedure calRebuildCalArray (ADate : TDateTime); + {-recalculate the contents of the calendar array} + procedure CalculateSizes (WorkCanvas : TCanvas; + Angle : TVpRotationAngle; + Rect : TRect; + var Row : TRowArray; + var Col : TColArray; + DisplayOnly : Boolean); + procedure calRecalcSize (DisplayOnly : Boolean); + {-calcualte new sizes for rows and columns} + + {VCL control methods} + procedure CMCtl3DChanged(var Msg : TMessage); message CM_CTL3DCHANGED; + procedure CMEnter(var Msg : TMessage); message CM_ENTER; + procedure CMExit(var Msg : TMessage); message CM_EXIT; + procedure CMFontChanged(var Msg : TMessage); message CM_FONTCHANGED; + + {windows message methods} + procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE; + procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS; + + procedure calBtnClick(Sender : TObject); + procedure CreateParams(var Params : TCreateParams); override; + procedure CreateWnd; override; + procedure DoOnChange(Value : TDateTime); dynamic; + function DoOnGetDateEnabled(ADate : TDateTime) : Boolean; dynamic; + procedure DoOnMouseWheel(Shift : TShiftState; + Delta, XPos, YPos : SmallInt); override; + function IsReadOnly : Boolean; dynamic; + {-return true if the calendar is in read-only mode} + procedure KeyDown(var Key : Word; Shift : TShiftState); override; + procedure KeyPress(var Key : Char); override; + procedure MouseDown(Button : TMouseButton; + Shift : TShiftState; + X, Y : Integer); override; + procedure MouseUp(Button : TMouseButton; + Shift : TShiftState; X, Y : Integer); override; + procedure Paint; override; + + public + constructor Create(AOwner : TComponent); override; + constructor CreateEx(AOwner : TComponent; AsPopup : Boolean); virtual; + destructor Destroy; override; + procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); override; + + function GetControlType : TVpItemType; override; + + procedure IncDay(Delta : Integer); + procedure IncMonth(Delta : Integer); + procedure IncYear(Delta : Integer); + + procedure PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + ADate : TDateTime); + procedure RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); override; + procedure SetToday; + + { LinkHandler is the method which is called by the ControlLink component, } + { it is used to synchronize the calendar's date with other Visual PlanIt } + { controls do not call the LinkHandler procedure programatically. } + procedure LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; + const Value: Variant); override; + + property Browsing : Boolean + read FBrowsing; + property Canvas; + property Day : Integer + read GetDay; + property Month : Integer + read GetMonth; + property Year : Integer + read GetYear; + + {properties} + property BorderStyle : TBorderStyle + read FBorderStyle write SetBorderStyle; + property Color; + property Colors : TVpCalColors + read FColors write FColors; + property Date : TDateTime + read FDate write SetDate; + property DateFormat : TVpDateFormat + read FDateFormat write SetDateFormat; + property DayNameWidth : TVpDayNameWidth + read FDayNameWidth write SetDayNameWidth; + property Options : TVpCalDisplayOptions + read FOptions write SetDisplayOptions; + property ReadOnly : Boolean + read FReadOnly write FReadOnly; + property WantDblClicks : Boolean + read FWantDblClicks write SetWantDblClicks; + property WeekStarts : TVpDayType + read FWeekStarts write SetWeekStarts; + + {events} + property OnChange : TDateChangeEvent + read FOnChange write FOnChange; + property OnDrawDate : TCalendarDateEvent + read FOnDrawDate write FOnDrawDate; + property OnDrawItem : TCalendarDateEvent + read FOnDrawItem write FOnDrawItem; + property OnGetDateEnabled : TGetDateEnabledEvent + read FOnGetDateEnabled write FOnGetDateEnabled; + property OnGetHighlight : TGetHighlightEvent + read FOnGetHighlight write FOnGetHighlight; + end; + + TVpCalendar = class(TVpCustomCalendar) + published + {properties} + {$IFDEF VERSION4} + property Anchors; + property Constraints; + property DragKind; + {$ENDIF} + property Align; + property BorderStyle; + property Color; + property Colors; + property Ctl3D; + property Cursor; + property DateFormat; + property DayNameWidth; + property DragCursor; + property DragMode; + property Enabled; + property Font; + property Options; + property ParentCtl3D; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ReadOnly; + property ShowHint; + property TabOrder; + property TabStop; + property Visible; + property WantDblClicks; + property WeekStarts; + {events} + property AfterEnter; + property AfterExit; + property OnChange; + property OnClick; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnDrawDate; + property OnDrawItem; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnGetDateEnabled; + property OnGetHighlight; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + end; + +implementation + +uses + VpData; + +const + calMargin = 4; {left, right, and top margin} + + +{*** TVpCalColors ***} +procedure TVpCalColors.Assign(Source : TPersistent); +begin + if Source is TVpCalColors then begin + FCalColors := TVpCalColors(Source).FCalColors; + FColorScheme := TVpCalColors(Source).FColorScheme; + FOnChange := TVpCalColors(Source).FOnChange; + end else + inherited Assign(Source); +end; +{=====} + +procedure TVpCalColors.BeginUpdate; +begin + FUpdating := True; +end; + +procedure TVpCalColors.EndUpdate; +begin + FUpdating := False; + DoOnChange; +end; +{=====} + +procedure TVpCalColors.DoOnChange; +begin + if not FUpdating and Assigned(FOnChange) then + FOnChange(Self); + + if not SettingScheme then + FColorScheme := cscalCustom; +end; +{=====} + +function TVpCalColors.GetColor(Index : Integer) : TColor; +begin + Result := FCalColors[Index]; +end; +{=====} + +procedure TVpCalColors.SetColor(Index : Integer; Value : TColor); +begin + if Value <> FCalColors[Index] then begin + FCalColors[Index] := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpCalColors.SetColorScheme(Value : TVpCalColorScheme); +begin + if Value <> FColorScheme then begin + SettingScheme := True; + try + FColorScheme := Value; + if Value <> cscalCustom then begin + FCalColors := CalScheme[Value]; + DoOnChange; + end; + finally + SettingScheme := False; + end; + end; +end; +{=====} + + + + +{*** TVpCustomCalendar ***} +procedure TVpCustomCalendar.calBtnClick(Sender : TObject); +var + Key : Word; +begin + SetFocus; + Key := 0; + + if Sender = clBtnLeft then begin + Key := VK_PRIOR; + KeyDown(Key, []); + end else if Sender = clBtnRevert then begin + Key := VK_ESCAPE; + KeyDown(Key, []); + end else if Sender = clBtnRight then begin + Key := VK_NEXT; + KeyDown(Key, []); + end else if Sender = clBtnToday then begin + Key := VK_BACK; + KeyDown(Key, [ssAlt]); + end else if Sender = clBtnNextYear then begin + Key := VK_NEXT; + KeyDown(Key, [ssCtrl]); + end else if Sender = clBtnPrevYear then begin + Key := VK_PRIOR; + KeyDown(Key, [ssCtrl]); + end; +end; +{=====} + +procedure TVpCustomCalendar.calChangeMonth(Sender : TObject); +var + Y, M, D : Word; + MO : Integer; + MI : TMenuItem; +begin + MI := (Sender as TMenuItem); + DecodeDate(FDate, Y, M, D); + MO := MI.Tag; + {set month and year} + if (MO > M) and (MI.HelpContext < 3) then + Dec(Y) + else if (MO < M) and (MI.HelpContext > 3) then + Inc(Y); + M := M + MO; + {set day} + if D > DaysInMonth(Y, MO) then + D := DaysInMonth(Y, MO); + SetDate(calGetValidDate(EncodeDate(Y, MO, D)-1, +1)); + if (Assigned(FOnChange)) then + FOnChange(Self, FDate); +end; +{=====} + +procedure TVpCustomCalendar.calColorChange(Sender : TObject); +begin + Invalidate; +end; +{=====} + +function TVpCustomCalendar.calGetCurrentRectangle : TRect; + {-get bounding rectangle for the current date} +var + Idx : Integer; + R, C : Integer; +begin + {index into the month grid} + Idx := clFirst + Pred(clDay) + 13; + R := (Idx div 7); + C := (Idx mod 7); + Result := clRowCol[R,C]; +end; +{=====} + +function TVpCustomCalendar.calGetValidDate(ADate : TDateTime; + Delta : Integer) : TDateTime; +var + I, X : Integer; + Valid: Boolean; + Fwd: Boolean; +begin + Valid := false; + Fwd := false; + X := Delta; + I := 1; + while not Valid and (I < 1000) do begin + {If the date is valid then yay!} + if (DoOnGetDateEnabled(ADate + (X * I))) then begin + Valid := true; + Fwd := True; + end + {otherwise check the other direction} + else if (DoOnGetDateEnabled(ADate - (X * I))) then begin + valid := true; + end + else Inc(I); + end; + if Valid then + if Fwd then Result := ADate + (X * I) + else Result := ADate - (X * I) + else + raise(EVpCalendarError.Create(RSInvalidDate)); +end; +{=====} + +procedure TVpCustomCalendar.calRebuildCalArray (ADate : TDateTime); +var + Day1 : TVpDayType; + I, J : Integer; +begin + HandleNeeded; + DecodeDate(ADate, clYear, clMonth, clDay); + + {get the first day of the current month and year} + Day1 := TVpDayType(SysUtils.DayOfWeek(EncodeDate(clYear, clMonth, 1)) -1); + + {find its index} + I := Byte(Day1) - Byte(WeekStarts) + 1; + if I < 1 then + Inc(I, 7); + clFirst := I; + + {find the index of the last day in the month} + clLast := clFirst + DaysInMonth(clYear, clMonth) - 1; + + {initialize the first part of the calendar} + if clMonth = 1 then + J := DaysInMonth(clYear - 1, 12) + else + J := DaysInMonth(clYear, clMonth-1); + for I := clFirst-1 downto 1 do begin + clCalendar[I] := J; + Dec(J); + end; + + {initialize the rest of the calendar} + J := 1; + for I := clFirst to 49 do begin + clCalendar[I] := J; + if I = clLast then + J := 1 + else + Inc(J); + end; +end; +{=====} + +procedure TVpCustomCalendar.CalculateSizes (WorkCanvas : TCanvas; + Angle : TVpRotationAngle; + Rect : TRect; + var Row : TRowArray; + var Col : TColArray; + DisplayOnly : Boolean); + + {-calcualte new sizes for rows and columns} +var + R : Integer; + C : Integer; + D1 : Integer; + D2 : Integer; + CH : Integer; + RH : Integer; + LR : Integer; + + function SumOf(const A : array of Integer; First, Last : Integer) : Integer; + var + I : Integer; + begin + Result := 0; + for I := First to Last do + Result := Result + A[I]; + end; + +begin + if (Angle = ra90) or (Angle = ra270) then + clWidth := Rect.Bottom - Rect.Top - 2*calMargin + else + clWidth := Rect.Right - Rect.Left - 2*calMargin; + {store row and column sizes} + for C := 0 to 6 do + Col[C] := clWidth div 7; + + if (FDrawHeader) then begin + {button and date row} + Row[0] := Round(1.4 * WorkCanvas.TextHeight('Yy')); + {day name row} + Row[1] := Round(1.5 * WorkCanvas.TextHeight('Yy')) + end else begin + {button and date row} + Row[0] := Round(1.3 * WorkCanvas.TextHeight('Yy')); + {day name row} + Row[1] := 0; + end; + + if (Angle = ra90) or (Angle = ra270) then + CH := Rect.Right - Rect.Left - 2*calMargin - Row[0] - Row[1] + else + CH := Rect.Bottom - Rect.Top - 2*calMargin - Row[0] - Row[1]; + if ((not (cdoShowRevert in Options)) and + (not (cdoShowToday in Options))) or + DisplayOnly then + LR := 7 + else + LR := 8; + + RH := CH div (LR - 1); + + for R := 2 to 8 do + Row[R] := RH; + + {distribute any odd horizontal space equally among the columns} + for C := 0 to clWidth mod 7 do + Inc(Col[C]); + + {distribute odd vertical space to top 2 rows} + D1 := 0; + for R := 0 to LR do + D1 := D1 + Row[R]; + if (Angle = ra90) or (Angle = ra270) then + D1 := Rect.Right - Rect.Left - D1 - 2*calMargin + else + D1 := Rect.Bottom - Rect.Top - D1 - 2*calMargin; + D2 := D1 div 2; + D1 := D1 - D2; + Row[0] := Row[0] + D1; + if (FDrawHeader) then + Row[1] := Row[1] + D2; + + {initialize each cells TRect structure using} + {the row heights from the Row[] array and the} + {column widths from the Col[] array} + for R := clStartRow to 7 do begin + for C := 0 to 6 do begin + clRowCol[R, C].Left := SumOf(Col, 0, C-1) + calMargin; + clRowCol[R, C].Right := SumOf(Col, 0, C) + calMargin; + clRowCol[R, C].Top := SumOf(Row, 0, R-1) + calMargin; + clRowCol[R, C].Bottom := SumOf(Row, 0, R) + calMargin; + end; + end; +end; + +procedure TVpCustomCalendar.calRecalcSize (DisplayOnly : Boolean); + {-calcualte new sizes for rows and columns} +var + Row : TRowArray; + Col : TColArray; + + function SumOf(const A : array of Integer; First, Last : Integer) : Integer; + var + I : Integer; + begin + Result := 0; + for I := First to Last do + Result := Result + A[I]; + end; + +begin + if not HandleAllocated then + Exit; + + {clear row/col position structure} + FillChar(clRowCol, SizeOf(clRowCol), #0); + + {set the way the buttons should look} + clBtnLeft.Flat := not Ctl3D and not clPopup; + clBtnRevert.Flat := not Ctl3D and not clPopup; + clBtnRight.Flat := not Ctl3D and not clPopup; + clBtnToday.Flat := not Ctl3D and not clPopup; + clBtnNextYear.Flat := not Ctl3D and not clPopup; + clBtnPrevYear.Flat := not Ctl3D and not clPopup; + + clBtnRevert.Visible := cdoShowRevert in FOptions; + clBtnToday.Visible := cdoShowToday in FOptions; + clBtnLeft.Visible := (cdoShowNavBtns in FOptions); + clBtnRight.Visible := (cdoShowNavBtns in FOptions); + clBtnNextYear.Visible := (cdoShowNavBtns in FOptions); + clBtnPrevYear.Visible := (cdoShowNavBtns in FOptions); + + CalculateSizes (Canvas, ra0, Rect (0, 0, Width, Height), Row, Col, + DisplayOnly); + + {position and size the left and right month buttons} + {position and size the next and prev year buttons} + clBtnNextYear.Height := Row[0] - calMargin; + clBtnNextYear.Width := Col[1] - calMargin; + if clBtnNextYear.Width < clBtnNextYear.Glyph.Width + 3 then + clBtnNextYear.Width := clBtnNextYear.Glyph.Width + 3; + clBtnNextYear.Top := calMargin; + clBtnNextYear.Left := ClientWidth - calMargin - clBtnNextYear.Width; + + clBtnPrevYear.Height := Row[0] - calMargin; + clBtnPrevYear.Width := Col[5] - calMargin; + if clBtnPrevYear.Width < clBtnPrevYear.Glyph.Width + 3 then + clBtnPrevYear.Width := clBtnPrevYear.Glyph.Width + 3; + clBtnPrevYear.Top := calMargin; + clBtnPrevYear.Left := calMargin; + + clBtnLeft.Height := Row[0] - calMargin; + clBtnLeft.Width := Col[0] - calMargin; + if clBtnLeft.Width < clBtnLeft.Glyph.Width + 3 then + clBtnLeft.Width := clBtnLeft.Glyph.Width + 3; + clBtnLeft.Top := calMargin; + clBtnLeft.Left := clBtnPrevYear.Left + clBtnPrevYear.Width; + + clBtnRight.Height := Row[0] - calMargin; + clBtnRight.Width := Col[6] - calMargin; + if clBtnRight.Width < clBtnRight.Glyph.Width + 3 then + clBtnRight.Width := clBtnRight.Glyph.Width + 3; + clBtnRight.Top := calMargin; + clBtnRight.Left := clBtnNextYear.Left - clBtnRight.Width; + + {position and size "today" button} + clBtnToday.Height := Row[8]; + clBtnToday.Width := Col[5] + Col[6] - calMargin; + clBtnToday.Top := ClientHeight - calMargin - clBtnToday.Height + 1; + clBtnToday.Left := ClientWidth - calMargin - clBtnToday.Width; + + + {position and size "revert" button} + clBtnRevert.Height := Row[8]; + clBtnRevert.Width := Col[5] + Col[6] - calMargin; + clBtnRevert.Top := ClientHeight - calMargin - clBtnRevert.Height + 1; + clBtnRevert.Left := clBtnToday.Left - clBtnRevert.Width - calMargin; +end; +{=====} + +procedure TVpCustomCalendar.CMCtl3DChanged(var Msg : TMessage); +begin + inherited; + + if (csLoading in ComponentState) or not HandleAllocated then + Exit; + + if NewStyleControls and (FBorderStyle = bsSingle) then + RecreateWnd{$IFDEF LCL}(Self){$ENDIF}; + + calReCalcSize (False); + + Invalidate; +end; +{=====} + +procedure TVpCustomCalendar.CMEnter(var Msg : TMessage); +var + R : TRect; +begin + inherited; + + clRevertDate := FDate; + + {invalidate the active date to ensure that the focus rect is painted} + R := calGetCurrentRectangle; + InvalidateRect(Handle, @R, False); +end; +{=====} + +procedure TVpCustomCalendar.CMExit(var Msg : TMessage); +var + R : TRect; +begin + inherited; + + {invalidate the active date to ensure that the focus rect is painted} + R := calGetCurrentRectangle; + InvalidateRect(Handle, @R, False); +end; +{=====} + +procedure TVpCustomCalendar.CMFontChanged(var Msg : TMessage); +begin + inherited; + + if csLoading in ComponentState then + Exit; + + calRecalcSize (False); + Invalidate; +end; +{=====} + +constructor TVpCustomCalendar.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]; + + Height := 140; + TabStop := True; + Width := 200; + Font.Name := 'MS Sans Serif'; + Font.Size := 8; + + FBorderStyle := bsNone; + FDayNameWidth := 3; + FDateFormat := dfLong; + FOptions := [cdoShortNames, cdoShowYear, cdoShowRevert, cdoShowToday, + cdoShowNavBtns, cdoHighlightSun, cdoHighlightSat]; + FWantDblClicks := True; + FWeekStarts := dtSunday; + FLastRenderX := 0; + FLastRenderY := 0; + + clInLinkHandler := false; + + {create navigation buttons} + clBtnLeft := TSpeedButton.Create(Self); + clBtnLeft.Parent := Self; + clBtnLeft.Glyph.Handle := LoadBaseBitmap('VPLEFTARROW'); + clBtnLeft.OnClick := calBtnClick; + clBtnLeft.Hint := RSCalendarPrevMonth; + clBtnLeft.ShowHint := True; + + clBtnRight := TSpeedButton.Create(Self); + clBtnRight.Parent := Self; + clBtnRight.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROW'); + clBtnRight.OnClick := calBtnClick; + clBtnRight.Hint := RSCalendarNextMonth; + clBtnRight.ShowHint := True; + + clBtnNextYear := TSpeedButton.Create(Self); + clBtnNextYear.Parent := Self; + clBtnNextYear.Glyph.Handle := LoadBaseBitmap('VPRIGHTARROWS'); + clBtnNextYear.OnClick := calBtnClick; + clBtnNextYear.Hint := RSCalendarNextYear; + clBtnNextYear.ShowHint := True; + + clBtnPrevYear := TSpeedButton.Create(Self); + clBtnPrevYear.Parent := Self; + clBtnPrevYear.Glyph.Handle := LoadBaseBitmap('VPLEFTARROWS'); + clBtnPrevYear.OnClick := calBtnClick; + clBtnPrevYear.Hint := RSCalendarPrevYear; + clBtnPrevYear.ShowHint := True; + + {create "revert" button} + clBtnRevert := TSpeedButton.Create(Self); + clBtnRevert.Parent := Self; + clBtnRevert.Glyph.Handle := LoadBaseBitmap('VPREVERT'); + clBtnRevert.OnClick := calBtnClick; + clBtnRevert.Hint := RSCalendarRevert; + clBtnRevert.ShowHint := True; + + {create "today" button} + clBtnToday := TSpeedButton.Create(Self); + clBtnToday.Parent := Self; + clBtnToday.Glyph.Handle := LoadBaseBitmap('VPTODAY'); + clBtnToday.OnClick := calBtnClick; + clBtnToday.Hint := RSCalendarToday; + clBtnToday.ShowHint := True; + + {assign default color scheme} + FColors := TVpCalColors.Create; + FColors.OnChange := calColorChange; + FColors.FCalColors := CalScheme[cscalWindows]; + + {assign default international support object} + + FDrawHeader:= True; + clRowCount := 8; + clStartRow := 0; + + FDefaultPopup := TPopupMenu.Create (Self); + InitializeDefaultPopup; +end; +{=====} + +constructor TVpCustomCalendar.CreateEx(AOwner : TComponent; AsPopup : Boolean); +begin + clPopup := AsPopup; + Create(AOwner); +end; +{=====} + +procedure TVpCustomCalendar.CreateParams(var Params : TCreateParams); +const + BorderStyles : array[TBorderStyle] of LongInt = (0, WS_BORDER); +begin + inherited CreateParams(Params); +{$IFNDEF LCL} + with Params do begin + Style := LongInt(Style) or BorderStyles[FBorderStyle]; + if clPopup then begin + WindowClass.Style := WindowClass.Style or CS_SAVEBITS; + end; + end; +{$ENDIF} + if NewStyleControls and (Ctl3D or clPopup) and (FBorderStyle = bsSingle) then begin + if not clPopup then + Params.Style := Params.Style and not WS_BORDER; + Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; + end; + + {set style to reflect desire for double clicks} + if FWantDblClicks then + ControlStyle := ControlStyle + [csDoubleClicks] + else + ControlStyle := ControlStyle - [csDoubleClicks]; +end; +{=====} + +procedure TVpCustomCalendar.CreateWnd; +begin + inherited CreateWnd; + + calRecalcSize (False); + + {if not set, get current date} + if FDate = 0 then + SetDate(calGetValidDate(SysUtils.Date-1, +1)); +end; +{=====} + +destructor TVpCustomCalendar.Destroy; +begin + FColors.Free; + FColors := nil; + + FDefaultPopup.Free; + + inherited Destroy; +end; +{=====} + +procedure TVpCustomCalendar.DoOnChange(Value : TDateTime); +begin + if Assigned(FOnChange) then + FOnChange(Self, Value); +end; +{=====} + +function TVpCustomCalendar.DoOnGetDateEnabled(ADate : TDateTime) : Boolean; +begin + Result := True; + if Assigned(FOnGetDateEnabled) then + FOnGetDateEnabled(Self, ADate, Result); +end; +{=====} + +procedure TVpCustomCalendar.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt); +var + Key : Word; +begin + inherited DoOnMouseWheel(Shift, Delta, XPos, YPos); +{$IFNDEF LCL} + if Abs(Delta) = WHEEL_DELTA then begin + {inc/dec month} + if Delta < 0 then + Key := VK_NEXT + else + Key := VK_PRIOR; + KeyDown(Key, []); + end else if Abs(Delta) > WHEEL_DELTA then begin + {inc/dec year} + if Delta < 0 then + Key := VK_NEXT + else + Key := VK_PRIOR; + KeyDown(Key, [ssCtrl]); + end else if Abs(Delta) < WHEEL_DELTA then begin + {inc/dec Week} + if Delta < 0 then + Key := VK_DOWN + else + Key := VK_UP; + KeyDown(Key, []); + end; +{$ENDIF} +end; +{=====} + +function TVpCustomCalendar.IsReadOnly : Boolean; +begin + Result := ReadOnly; +end; +{=====} + +procedure TVpCustomCalendar.KeyDown(var Key : Word; Shift : TShiftState); +var + Y : Word; + M : Word; + D : Word; + HD : TDateTime; + PopupPoint : TPoint; + +begin + inherited KeyDown(Key, Shift); + + if IsReadOnly then + Exit; + + HD := FDate; + case Key of + VK_LEFT : if Shift = [] then + SetDate(calGetValidDate(FDate, -1)) + else if ssCtrl in Shift then + IncMonth (-1) + else if ssShift in Shift then + IncYear (-1); + + VK_RIGHT : if Shift = [] then + SetDate(calGetValidDate(FDate, +1)) + else if ssCtrl in Shift then + IncMonth (1) + else if ssShift in Shift then + IncYear (1); + VK_UP : if Shift = [] then + SetDate(calGetValidDate(FDate, -7)) + else if ssCtrl in Shift then + IncYear (-1) + else if ssShift in Shift then + IncMonth (-1); + VK_DOWN : if Shift = [] then + SetDate(calGetValidDate(FDate, +7)) + else if ssCtrl in Shift then + IncYear (1) + else if ssShift in Shift then + IncMonth (1); + VK_HOME : + begin + if ssCtrl in Shift then begin + DecodeDate(FDate, Y, M, D); + SetDate(calGetValidDate(EncodeDate(Y, 1, 1)-1, +1)); + end else if Shift = [] then begin + DecodeDate(FDate, Y, M, D); + SetDate(calGetValidDate(EncodeDate(Y, M, 1)-1, +1)); + end; + end; + VK_END : + begin + if ssCtrl in Shift then begin + DecodeDate(FDate, Y, M, D); + SetDate(calGetValidDate(EncodeDate(Y, 12, DaysInMonth(Y, 12))+1, -1)); + end else if Shift = [] then begin + DecodeDate(FDate, Y, M, D); + SetDate(calGetValidDate(EncodeDate(Y, M, DaysInMonth(Y, M))+1, -1)); + end; + end; + VK_PRIOR : + begin + if ssCtrl in Shift then begin + IncYear(-1); + end else if Shift = [] then begin + IncMonth(-1); + end; + end; + VK_NEXT : + begin + if ssCtrl in Shift then begin + IncYear(1); + end else if Shift = [] then begin + IncMonth(1); + end; + end; + VK_BACK : + begin + if ssAlt in Shift then + SetDate(calGetValidDate(SysUtils.Date-1, +1)); + end; + VK_ESCAPE: + begin + if Shift = [] then + SetDate(calGetValidDate(clRevertDate-1, +1)); + end; + VK_F10 : + if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + VK_APPS : + if not Assigned (PopupMenu) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + end; + + if HD <> FDate then begin + FBrowsing := True; + try + DoOnChange(FDate); + finally + FBrowsing := False; + end; + end; +end; +{=====} + +procedure TVpCustomCalendar.KeyPress(var Key : Char); +begin + inherited KeyPress(Key); + + if IsReadOnly then + Exit; + + case Key of + '+' : SetDate(calGetValidDate(FDate, +1)); + '-' : SetDate(calGetValidDate(FDate, -1)); + #13 : DoOnChange(FDate); {date selected} + #32 : DoOnChange(FDate); {date selected} + ^Z : SetDate(calGetValidDate(SysUtils.Date-1, +1)); + end; +end; +{=====} + +procedure TVpCustomCalendar.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer); +var + Yr : Word; + M : Word; + D : Word; + Yr2 : Word; + M2 : Word; + D2 : Word; + R, C : Integer; + OldIdx : Integer; + NewIdx : Integer; + Re : TRect; + Ignore : Boolean; + ClientOrigin : TPoint; + +begin + inherited; + + if (not Assigned (PopupMenu)) and (Button = mbRight) then begin + if not focused then + SetFocus; + ClientOrigin := GetClientOrigin; + + FDefaultPopup.Popup (X + ClientOrigin.x, + Y + ClientOrigin.y); + Exit; + end; + + {exit if this click happens when the popup menu is active} + if clInPopup or (not Visible) then + Exit; + + SetFocus; + + inherited MouseDown(Button, Shift, X, Y); + + if IsReadOnly then + Exit; + + {if we have the mouse captured, see if a button was clicked} + if GetCapture = Handle then begin + if (cdoShowNavBtns in Options) then begin + Re := clBtnLeft.ClientRect; + Re.TopLeft := ScreenToClient(clBtnLeft.ClientToScreen(Re.TopLeft)); + Re.BottomRight := ScreenToClient(clBtnLeft.ClientToScreen(Re.BottomRight)); + if PtInRect(Re, Point(X, Y)) then begin + clBtnLeft.Click; + Exit; + end; + + Re := clBtnRight.ClientRect; + Re.TopLeft := ScreenToClient(clBtnRight.ClientToScreen(Re.TopLeft)); + Re.BottomRight := ScreenToClient(clBtnRight.ClientToScreen(Re.BottomRight)); + if PtInRect(Re, Point(X, Y)) then begin + clBtnRight.Click; + Exit; + end; + + Re := clBtnNextYear.ClientRect; + Re.TopLeft := ScreenToClient(clBtnNextYear.ClientToScreen(Re.TopLeft)); + Re.BottomRight := ScreenToClient(clBtnNextYear.ClientToScreen(Re.BottomRight)); + if PtInRect(Re, Point(X, Y)) then begin + clBtnNextYear.Click; + Exit; + end; + + Re := clBtnPrevYear.ClientRect; + Re.TopLeft := ScreenToClient(clBtnPrevYear.ClientToScreen(Re.TopLeft)); + Re.BottomRight := ScreenToClient(clBtnPrevYear.ClientToScreen(Re.BottomRight)); + if PtInRect(Re, Point(X, Y)) then begin + clBtnPrevYear.Click; + Exit; + end; + end; + + if (cdoShowRevert in Options) then begin + Re := clBtnRevert.ClientRect; + Re.TopLeft := ScreenToClient(clBtnRevert.ClientToScreen(Re.TopLeft)); + Re.BottomRight := ScreenToClient(clBtnRevert.ClientToScreen(Re.BottomRight)); + if PtInRect(Re, Point(X, Y)) then begin + clBtnRevert.Click; + Exit; + end; + end; + + if (cdoShowToday in Options) then begin + Re := clBtnToday.ClientRect; + Re.TopLeft := ScreenToClient(clBtnToday.ClientToScreen(Re.TopLeft)); + Re.BottomRight := ScreenToClient(clBtnToday.ClientToScreen(Re.BottomRight)); + if PtInRect(Re, Point(X, Y)) then begin + clBtnToday.Click; + Exit; + end; + end; + end; + + {save current date} + DecodeDate(FDate, Yr, M, D); + M2 := M; + + {calculate the row and column clicked on} + for R := 2 to 8 do begin + for C := 0 to 6 do begin + if PtInRect(clRowCol[R,C], Point(X, Y)) then begin + {convert to an index} + NewIdx := ((R-2) * 7) + Succ(C); + OldIdx := clFirst + Pred(clDay); + Ignore := False; + if NewIdx <> OldIdx then begin + + {see if this date is disabled - selection not allowed} + if not DoOnGetDateEnabled(FDate+(NewIdx-OldIdx)) then + Break; + + DecodeDate(FDate+(NewIdx-OldIdx), Yr2, M2, D2); + if not (cdoShowInactive in FOptions) then begin + {will this change the month?} + if M2 <> M then + Ignore := True; + end; + {convert to a date and redraw} + if not Ignore then + SetDate(FDate+(NewIdx-OldIdx)); + end; + + if (not Ignore) and (Button = mbLeft) then begin + if M2 <> M then begin + FBrowsing := True; + try + DoOnChange(FDate); + finally + FBrowsing := False; + end; + end else + DoOnChange(FDate); + end; + + Break; + end; + end; + end; +end; +{=====} + +procedure TVpCustomCalendar.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer); +var + P : TPoint; + M : TPopUpMenu; + MI : TMenuItem; + I : Integer; + J : Integer; + K : Integer; + MO : Integer; + YR : Word; + MM : Word; + DA : Word; + HC : Boolean; +begin + inherited MouseUp(Button, Shift, X, Y); + + if (PopUpMenu = nil) and (Button = mbRight) and + (Y < clRowCol[1,0].Top) {above day names} and + (X > clBtnPrevYear.Left + clBtnNextYear.Width) and + (X < clBtnNextYear.Left) then begin + + if not Focused and CanFocus then + SetFocus; + + M := TPopupMenu.Create(Self); + try + DecodeDate(FDate, YR, MM, DA); + MO := MM; {convert to integer to avoid wrap-around errors with words} + + {determine the starting month} + I := MO - 3; + if I < 1 then + I := MO - 3 + 12; + + {determine the ending month + 1} + J := MO + 4; + if J > 12 then + J := MO + 4 - 12; + + K := 0; + {create the menu items} + repeat + MI := TMenuItem.Create(M); + MI.Caption := LongMonthNames[I]; + MI.Enabled := Enabled; + MI.OnClick := calChangeMonth; + MI.Tag := I; + MI.HelpContext := K; + M.Items.Add(MI); + Inc(I); + Inc(K); + if I > 12 then + I := 1; + until I = J; + + HC := GetCapture = Handle; + + P.X := X-20; + P.Y := Y - ((GetSystemMetrics(SM_CYMENU)*7) div 2); + P := ClientToScreen(P); + {move the mouse to cause the menu item to highlight} + PostMessage(Handle, WM_MOUSEMOVE, 0, MAKELONG(P.X,P.Y+1)); + + clInPopup := True; + try + M.PopUp(P.X, P.Y); + + Application.ProcessMessages; + + {capture the mouse again} + if clPopup and HC then + SetCapture(Handle); + finally + clInPopup := false; + end; + finally + M.Free; + end; + end; +end; +{=====} + +procedure TVpCustomCalendar.IncDay(Delta : Integer); + {-change the day by Delta (signed) days} +begin + if Delta > 0 then + SetDate(calGetValidDate(FDate+Delta-1, +1)) + else + SetDate(calGetValidDate(FDate+Delta+1, -1)); +end; +{=====} + +procedure TVpCustomCalendar.IncMonth(Delta : Integer); + {-change the month by Delta (signed) months} +var + Y, M, D : Word; + iY, iM, iD : Integer; +begin + DecodeDate(FDate, Y, M, D); + iY := Y; iM := M; iD := D; + Inc(iM, Delta); + if iM > 12 then begin + iM := iM - 12; + Inc(iY); + end else if iM < 1 then begin + iM := iM + 12; + Dec(iY); + end; + if iD > DaysInMonth(iY, iM) then + iD := DaysInMonth(iY, iM); + + SetDate(calGetValidDate(EncodeDate(iY, iM, iD)-1, +1)); +end; +{=====} + +procedure TVpCustomCalendar.IncYear(Delta : Integer); +var + Y, M, D : Word; + iY, iM, iD : Integer; +begin + DecodeDate(FDate, Y, M, D); + iY := Y; iM := M; iD := D; + Inc(iY, Delta); + if iD > DaysInMonth(iY, iM) then + iD := DaysInMonth(iY, iM); + SetDate(calGetValidDate(EncodeDate(iY, iM, iD)-1, +1)); +end; +{=====} + +procedure TVpCustomCalendar.Paint; +begin + RenderToCanvas (Canvas, // Paint Canvas + Rect (0, 0, Width, Height), // Paint Rectangle + ra0, + 1, // Scale + Date, // Date + -1, // Start At + -1, // End At + gr30Min, + False); // Display Only +end; +{=====} + +procedure TVpCustomCalendar.LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; const Value: Variant); +begin + clInLinkHandler := true; + try + if NotificationType = neDateChange then + Date := Value + else if NotificationType = neInvalidate then + Invalidate; + finally + clInLinkHandler := false; + end; +end; +{=====} + +function TVpCustomCalendar.GetDay : Integer; +begin + Result := clDay; +end; +{=====} + +function TVpCustomCalendar.GetMonth : Integer; +begin + Result := clMonth; +end; +{=====} + +function TVpCustomCalendar.GetYear : Integer; +begin + Result := clYear; +end; +{=====} + +function TVpCustomCalendar.GetControlType : TVpItemType; +begin + Result := itCalendar; +end; + +procedure TVpCustomCalendar.PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + ADate : TDateTime); +begin + RenderToCanvas (ACanvas, ARect, Angle, 1, ADate, -1, -1, gr30Min, True); +end; + +procedure TVpCustomCalendar.RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); +var + R, C : Integer; + I : Integer; + SatCol : Integer; + SunCol : Integer; + DOW : TVpDayType; + Y, M, D : Word; + lBadDate : Boolean; + lDate : TDateTime; + RealWidth : Integer; + RealHeight : Integer; + RealLeft : Integer; + RealRight : Integer; + RealTop : Integer; + RealBottom : Integer; + + BevelHighlight : TColor; + BevelShadow : TColor; + InactiveDayColor : TColor; + MonthYearColor : TColor; + DayNameColor : TColor; + LineColor : TColor; + EventDayColor : TColor; + DayColor : TColor; + RealColor : TColor; + WeekendColor : TColor; + + procedure SetMeasurements; + begin + RealWidth := TPSViewportWidth (Angle, RenderIn); + RealHeight := TPSViewportHeight (Angle, RenderIn); + RealLeft := TPSViewportLeft (Angle, RenderIn); + RealRight := TPSViewportRight (Angle, RenderIn); + RealTop := TPSViewportTop (Angle, RenderIn); + RealBottom := TPSViewportBottom (Angle, RenderIn); + + if RenderDate = 0 then + RenderDate := FDate; + end; + + procedure DrawDate; + var + R : TRect; + S : string; + begin + if FDateFormat = dfLong then + if cdoShowYear in FOptions then + S := FormatDateTime('mmmm yyyy', RenderDate) + else + S := FormatDateTime('mmmm', RenderDate) + else + if cdoShowYear in FOptions then + S := FormatDateTime('mmm yyyy', RenderDate) + else + S := FormatDateTime('mmm', RenderDate); + + R := Rect (clRowCol[0, 1].Left + RealLeft, + clRowCol[0, 1].Top + RealTop, + clRowCol[0, 1].Right + RealLeft, + clRowCol[0, 1].Bottom + RealTop); + R.Right := clRowCol[0, 6].Left + RealLeft; + + {switch to short date format if string won't fit} + if FDateFormat = dfLong then + if RenderCanvas.TextWidth(S) > R.Right-R.Left then + S := FormatDateTime('mmm yyyy', RenderDate); + + RenderCanvas.Font.Color := MonthYearColor; + if Assigned(FOnDrawDate) then + FOnDrawDate(Self, RenderDate, R) + else + TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, + R, S); + end; + + procedure DrawDayNames; + var + I : Integer; + S : string; + DrawRect : TRect; + + begin + {draw the day name column labels} + RenderCanvas.Font.Color := DayNameColor; + I := 0; + DOW := FWeekStarts; + repeat + {record columns for weekends} + if DOW = dtSaturday then + SatCol := I; + if DOW = dtSunday then + SunCol := I; + + {get the day name} + if cdoShortNames in Options then begin + if FDayNameWidth < 1 then + S := ShortDayNames[Ord(DOW)+1] + else + S := Copy(ShortDayNames[Ord(DOW)+1], 1, FDayNameWidth) + end else begin + if FDayNameWidth < 1 then + S := LongDayNames[Ord(DOW)+1] + else + S := Copy(LongDayNames[Ord(DOW)+1], 1, FDayNameWidth) + end; + + {draw the day name above each column} + DrawRect := Rect (clRowCol[1, I].Left + RealLeft, + clRowCol[1, I].Top + RealTop, + clRowCol[1, I].Right + RealLeft, + clRowCol[1, I].Bottom + RealTop); + TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, + DrawRect, S); + Inc(I); + if DOW < High(DOW) then + Inc(DOW) + else + DOW := Low(DOW); + until DOW = WeekStarts; + end; + + procedure DrawLine; + begin + if (not Ctl3D) then begin + RenderCanvas.Pen.Color := LineColor; + TPSMoveTo (RenderCanvas, Angle, RenderIn, + RealLeft, clRowCol[1,0].Bottom-3 + RealTop); + TPSLineTo (RenderCanvas, Angle, RenderIn, + RealRight, clRowCol[1,0].Bottom-3 + RealTop); + end else if Ctl3D then begin + RenderCanvas.Pen.Color := BevelHighlight; + TPSMoveTo (RenderCanvas, Angle, RenderIn, + RealLeft, clRowCol[1,0].Bottom-3 + RealTop); + TPSLineTo (RenderCanvas, Angle, RenderIn, + RealRight, clRowCol[1,0].Bottom-3 + RealTop); + RenderCanvas.Pen.Color := BevelShadow; + TPSMoveTo (RenderCanvas, Angle, RenderIn, + RealLeft, clRowCol[1,0].Bottom-2 + RealTop); + TPSLineTo (RenderCanvas, Angle, RenderIn, + RealRight, clRowCol[1,0].Bottom-2 + RealTop); + end; + end; + + procedure DrawDay(R, C, I : Integer; Grayed : Boolean); + var + Cl : TColor; + OldIdx : Integer; + NewIdx : Integer; + S : string[10]; + DrawRect : TRect; + TH : Integer; + + begin + {avoid painting day number under buttons} + if cdoShowRevert in FOptions then + if (R = 8) and (C >= 3) then + Exit; + if cdoShowToday in FOptions then + if (R = 8) and (C >= 5) then + Exit; + + {convert to a string and draw it centered in its rectangle} + S := IntToStr(clCalendar[I]); + + if Grayed then + RenderCanvas.Font.Color := InactiveDayColor; + + if not Grayed or (cdoShowInactive in FOptions) then begin + NewIdx := ((R-2) * 7) + Succ(C); + OldIdx := clFirst + Pred(clDay); + if Assigned(FOnGetHighlight) then begin + Cl := RenderCanvas.Font.Color; + FOnGetHighlight(Self, RenderDate+(NewIdx-OldIdx), Cl); + RenderCanvas.Font.Color := Cl; + end; + if Assigned(FOnDrawItem) then + FOnDrawItem(Self, RenderDate+(NewIdx-OldIdx), clRowCol[R,C]) + else if clRowCol[R, C].Top <> 0 then begin + DrawRect := Rect (clRowCol[R, C].Left + RealLeft, + clRowCol[R, C].Top + RealTop, + clRowCol[R, C].Right + RealLeft, + clRowCol[R, C].Bottom + RealTop); + TH := RenderCanvas.TextHeight (S); + if TH < DrawRect.Bottom - DrawRect.Top then + DrawRect.Top := DrawRect.Top + + ((DrawRect.Bottom - DrawRect.Top) - TH) div 2; + TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, + DrawRect, S); + end; + end; + end; + + procedure DrawFocusBox; + var + R : TRect; + S : string[10]; + begin + S := IntToStr(clDay); + + { set highlight color and font style for days with events } + RenderCanvas.Font.Style := + RenderCanvas.Font.Style - [fsBold]; + lBadDate := false; + + if (DataStore <> nil) and (DataStore.Resource <> nil) then begin + DecodeDate(RenderDate, Y, M, D); + try + {$IFDEF VERSION6} + if not TryEncodeDate (Y, M, clDay, lDate) then + lBadDate := true; + {$ELSE} + lDate := EncodeDate(Y, M, clDay); + {$ENDIF} + except + lBadDate := true; + end; + + if (not lBadDate) + and (DataStore.Resource.Schedule.EventCountByDay(lDate) > 0) + then begin + RenderCanvas.Font.Style := + RenderCanvas.Font.Style + [fsBold, fsUnderline]; + RenderCanvas.Font.Color := EventDayColor; + end else + RenderCanvas.Font.Style := + RenderCanvas.Font.Style - [fsBold, fsUnderline]; + end; + + R := calGetCurrentRectangle; + R.Left := R.Left + RealLeft; + R.Top := R.Top + RealTop; + R.Right := R.Right + RealLeft; + R.Bottom := R.Bottom + RealTop; + + R := TPSRotateRectangle (Angle, RenderIn, R); + if not DisplayOnly then begin + {$IFNDEF LCL} + if Focused then + DrawButtonFace (RenderCanvas, R, 1, bsNew, True, True, False) + else + DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False); + {$ENDIF} + R := calGetCurrentRectangle; + R.Left := R.Left + RealLeft; + R.Top := R.Top + RealTop; + R.Right := R.Right + RealLeft; + R.Bottom := R.Bottom + RealTop; + TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S); + end; + end; + +var + Row : TRowArray; + Col : TColArray; + +begin + if DisplayOnly then begin + BevelHighlight := clBlack; + BevelShadow := clBlack; + InactiveDayColor := clSilver; + MonthYearColor := clBlack; + DayNameColor := clBlack; + LineColor := clBlack; + EventDayColor := clBlack; + DayColor := clBlack; + RealColor := clWhite; + WeekendColor := $5f5f5f; + end else begin + BevelHighlight := clBtnHighlight; + BevelShadow := clBtnShadow; + InactiveDayColor := FColors.InactiveDays; + MonthYearColor := FColors.MonthAndYear; + DayNameColor := FColors.DayNames; + LineColor := Font.Color; + EventDayColor := FColors.EventDays; + DayColor := FColors.Days; + RealColor := Color; + WeekendColor := FColors.WeekEnd; + end; + + calRebuildCalArray (RenderDate); + + RenderCanvas.Pen.Style := psSolid; + RenderCanvas.Pen.Width := 1; + RenderCanvas.Pen.Mode := pmCopy; + RenderCanvas.Brush.Style := bsSolid; + + RenderCanvas.Lock; + try + SetMeasurements; + + RenderCanvas.Font.Assign (Font); + + if (RealRight - RealLeft <> FLastRenderX) or + (RealBottom - RealTop <> FLastRenderY) then begin + FLastRenderX := RealRight - RealLeft; + FLastRenderY := RealBottom - RealTop; + CalculateSizes (RenderCanvas, Angle, RenderIn, Row, Col, DisplayOnly); + end; + RenderCanvas.Brush.Color := RealColor; + RenderCanvas.FillRect(RenderIn); + + {draw the month and year at the top of the calendar} + DrawDate; + + {draw the days of the week} + DrawDayNames; + + {draw line under day names} + DrawLine; + + {draw each day} + I := 1; + for R := 2 to 8 do + for C := 0 to 6 do begin + if ((C = SatCol) and (cdoHighlightSat in Options)) or + ((C = SunCol) and (cdoHighlightSun in Options)) then + RenderCanvas.Font.Color := WeekendColor + else + RenderCanvas.Font.Color := DayColor; + + { set highlight color and font style for days with events } + RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold]; + lBadDate := false; + if (DataStore <> nil) + and (DataStore.Resource <> nil) then begin + DecodeDate(RenderDate, Y, M, D); + try begin + {$IFDEF VERSION6} + if not TryEncodeDate (Y, M, clCalendar[I], lDate) then + lBadDate := True; + {$ELSE} + if clCalendar[I] > DaysInMonth(Y, M) then + lDate := EncodeDate(Y, M, DaysInMonth(Y, M)) + else + lDate := EncodeDate(Y, M, clCalendar[I]); + {$ENDIF} + end; + except + lBadDate := true; + end; + + if (not lBadDate) + and (DataStore.Resource.Schedule.EventCountByDay(lDate) > 0) + then begin + RenderCanvas.Font.Style := + RenderCanvas.Font.Style + [fsBold, fsUnderline]; + RenderCanvas.Font.Color := EventDayColor; + end else + RenderCanvas.Font.Style := + RenderCanvas.Font.Style - [fsBold, fsUnderline]; + end; + DrawDay(R, C, I, (I < clFirst) or (I > clLast)); + Inc(I); + end; + + RenderCanvas.Font.Color := DayColor; + if not Assigned(FOnDrawItem) then + if not (cdoHideActive in FOptions) then + DrawFocusBox; + finally + RenderCanvas.Unlock; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetBorderStyle(Value : TBorderStyle); +begin + if Value <> FBorderStyle then begin + FBorderStyle := Value; + RecreateWnd{$IFDEF LCL}(self){$ENDIF}; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight : Integer); +begin + inherited Setbounds(ALeft, ATop, AWidth, AHeight); + + if csLoading in ComponentState then + Exit; + calRecalcSize (False); +end; +{=====} + +procedure TVpCustomCalendar.SetDate(Value : TDateTime); +var + R : TRect; + Y : Word; + M : Word; + D : Word; +begin + if Value <> FDate then begin + {determine if the new date is in the same month} + DecodeDate(Value, Y, M, D); + if (clYear = Y) and (clMonth = M) then begin + {invalidate the old date} + R := calGetCurrentRectangle; + InvalidateRect(Handle, @R, False); + end else + Invalidate; + + DecodeDate(Value, clYear, clMonth, clDay); + FDate := Value; + calRebuildCalArray (FDate); + + {invalidate the new date} + R := calGetCurrentRectangle; + InvalidateRect(Handle, @R, False); + + if (not clInLinkHandler) and (ControlLink <> nil) then + ControlLink.Notify(self, neDateChange, Date); + end; +end; +{=====} + +procedure TVpCustomCalendar.SetDateFormat(Value : TVpDateFormat); +begin + if Value <> FDateFormat then begin + FDateFormat := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetDayNameWidth(Value : TVpDayNameWidth); +begin + if Value <> FDayNameWidth then begin + FDayNameWidth := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetDisplayOptions(Value : TVpCalDisplayOptions); +begin + if Value <> FOptions then begin + FOptions := Value; + if csDesigning in ComponentState then begin + if cdoShowRevert in Options then + clBtnRevert.Parent := Self + else + clBtnRevert.Parent := nil; + if cdoShowToday in Options then + clBtnToday.Parent := Self + else + clBtnToday.Parent := nil; + if cdoShowNavBtns in Options then begin + clBtnLeft.Parent := Self; + clBtnRight.Parent := Self; + clBtnNextYear.Parent := Self; + clBtnPrevYear.Parent := Self; + end else begin + clBtnLeft.Parent := nil; + clBtnRight.Parent := nil; + clBtnNextYear.Parent := nil; + clBtnPrevYear.Parent := nil; + end; + end; + calRecalcSize (False); + Invalidate; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetDrawHeader(Value : Boolean); + {-set the DrawHeader property value} +begin + if Value <> FDrawHeader then begin + FDrawHeader := Value; + if FDrawHeader then begin + clStartRow := 0; + clRowCount := 8; + end else begin + clStartRow := 2; + clRowCount := 7; + end; + calRecalcSize (False); + Refresh; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetToday; + {-set the calendar to todays date} +begin + Date := Now; +end; +{=====} + +procedure TVpCustomCalendar.SetWantDblClicks(Value : Boolean); +begin + if Value <> FWantDblClicks then begin + FWantDblClicks := Value; + RecreateWnd{$IFDEF LCL}(Self){$ENDIF}; + end; +end; +{=====} + +procedure TVpCustomCalendar.SetWeekStarts(Value : TVpDayType); +begin + if Value <> FWeekStarts then begin + FWeekStarts := Value; + if csLoading in ComponentState then + Exit; + calRebuildCalArray (FDate); + Invalidate; + end; +end; +{=====} + +procedure TVpCustomCalendar.WMEraseBkgnd(var Msg : TWMEraseBkgnd); +begin + Msg.Result := 1; {don't erase background, just say we did. Shhhhhhh!} +end; +{=====} + +procedure TVpCustomCalendar.WMGetDlgCode(var Msg : TWMGetDlgCode); +begin + Msg.Result := DLGC_WANTARROWS; +end; +{=====} + +procedure TVpCustomCalendar.WMKillFocus(var Msg : TWMKillFocus); +begin + inherited; + Invalidate; +end; +{=====} +procedure TVpCustomCalendar.InitializeDefaultPopup; +var + NewItem : TMenuItem; + +begin + if RSCalendarPopupToday <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSCalendarPopupToday; + NewItem.OnClick := PopupToday; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSCalendarPopupNextMonth <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSCalendarPopupNextMonth; + NewItem.OnClick := PopupNextMonth; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSCalendarPopupPrevMonth <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSCalendarPopupPrevMonth; + NewItem.OnClick := PopupPrevMonth; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSCalendarPopupNextYear <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSCalendarPopupNextYear; + NewItem.OnClick := PopupNextYear; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSCalendarPopupPrevYear <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSCalendarPopupPrevYear; + NewItem.OnClick := PopupPrevYear; + FDefaultPopup.Items.Add (NewItem); + end; +end; +{=====} + +procedure TVpCustomCalendar.PopupToday (Sender : TObject); +begin + SetDate (Now); +end; +{=====} + +procedure TVpCustomCalendar.PopupNextMonth (Sender : TObject); +begin + IncMonth (1); +end; +{=====} + +procedure TVpCustomCalendar.PopupPrevMonth(Sender : TObject); +begin + IncMonth (-1); +end; +{=====} + +procedure TVpCustomCalendar.PopupNextYear (Sender : TObject); +begin + IncYear (1); +end; +{=====} + +procedure TVpCustomCalendar.PopupPrevYear (Sender : TObject); +begin + IncYear (-1); +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpcanvasutils.pas b/components/tvplanit/source/vpcanvasutils.pas new file mode 100644 index 000000000..6ad395688 --- /dev/null +++ b/components/tvplanit/source/vpcanvasutils.pas @@ -0,0 +1,2162 @@ +{*********************************************************} +{* VPCANVASUTILS.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{ + The drawing of Visual PlanIt controls supports rendering of the controls + to arbitrary rectangles in a Canvas. In addition, the controls can be + rendered rotated in 90 degree increments. + + Instead of rendering the VisualPlanIt control and then rotating it and + translating it, the control is drawn taking account the translation and + rotation. This unit contains a helper class, TVpExCanvas that is used as + a go-between for the component and the TCanvas that it needs to render + itself to. + + The component will use members of the TVpExCanvas class to draw to the + TCanvas. This class will take the rotation and viewport (the rectangle + in which the component should be rendered) into account and then draw + the correct shape (line, text or whatever) to the canvas. + + There are three parameters of the TVpExCanvas class that must be + initialized. These are Angle, ViewPort and Canvas. Angle specifies the + rotation angle to use when drawing to the Canvas. ViewPort specifies the + rectangle in which all the drawing should take place. Canvas is the + TCanvas class to draw on. + + For the most part, methods in TVpExCanvas are analagous to methods in + TCanvas. There are some additional convenience methods to make dealing + with the rotated canvas easier. + + In addition to the methods of the TVpExCanvas class, static methods are + provided to access the TVpExCanvas functionality without having create + and instance of the class. This will use a built global TVpExCanvas that + is created in the initialization section of this unit and destroyed in + its finalization. + + ----------------------------------------------------------------------------- + + VpCanvasUtils also contains an additional helper class, TVpLineWrapper. + This class is used to wrap text within rectangles and irregularily shaped + regions on a canvas. This is used primarily by the TVpDayView component + to draw multiline events (If icons are used in the TVpDayView, this is + the class that wraps the text around the icons). + + The TVpLineWrapper class supports the rotation and viewport capablilities + provided by the TVpExCanvas class. + + Like TVpExCanvas, static methods are provided to access the TVpLineWrapper + functionality without having to explicitly create and destroy an instance + of the class. + +} + +{$I Vp.INC} + +unit VpCanvasUtils; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Classes, + SysUtils, + Graphics, + Controls, + Messages, + VpException, + VpSR, + VpBase; + +type + TVpPaletteArray = array [0..255] of TPALETTEENTRY; + + { !!.01 Begin changes !!.01 } + + TVpExCanvas = class (TObject) + private + FAngle : TVpRotationAngle; + FCanvas : TCanvas; + FViewPort : TRect; + + protected + procedure DrawRotatedText (x, y : Integer; + Text : string; + Rotate : Boolean); + procedure Swap (var a, b : Integer); + + public + constructor Create; + + function NormalizeRectangle (const ARect : TRect) : TRect; + function RotatePoint (const APoint : TPoint) : TPoint; + function RotateRectangle (const ARect : TRect) : TRect; + function ViewportWidth : Integer; + function ViewportHeight : Integer; + function ViewportLeft : Integer; + function ViewportRight : Integer; + function ViewportTop : Integer; + function ViewportBottom : Integer; + procedure Arc (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); + procedure BrushCopy (const Dest : TRect; + Bitmap : TBitmap; + const Source : TRect; + AColor : TColor); + procedure Chord (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); + procedure CopyRect ( Dest : TRect; + Canvas : TCanvas; + const Source : TRect); + procedure Draw (X, Y : Integer; + Graphic : TGraphic); + procedure DrawFocusRect (const ARect : TRect); + procedure Ellipse (X1, Y1, X2, Y2 : Integer); overload; + procedure Ellipse (const ARect : TRect); overload; + procedure FillRect (const ARect : TRect); + procedure FloodFill (X, Y : Integer; + AColor : TColor; + FillStyle : TFillStyle); + procedure FrameRect (const ARect : TRect); + procedure LineTo (X, Y : Integer); + procedure MoveTo (X, Y : Integer); + procedure Pie (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); + procedure PolyBezier (const Points : array of TPoint); + procedure PolyBezierTo (const Points : array of TPoint); + procedure Polygon (Points : array of TPoint); + procedure Polyline (Points : array of TPoint); + procedure Rectangle (X1, Y1, X2, Y2 : Integer); overload; + procedure Rectangle (const ARect : TRect); overload; + procedure RoundRect (X1, Y1, X2, Y2, X3, Y3 : Integer); + procedure StretchDraw (const ARect : TRect; + Graphic : TGraphic); + procedure TextOut ( X, Y : Integer; + const Text : string); + procedure TextRect ( ARect : TRect; + X, Y : Integer; + const Text : string); + function GetPixel (const x : Integer; + const y : Integer) : TColor; + procedure SetPixel (x : Integer; + y : Integer; + AColor : TColor); + procedure CenteredTextOut ( ARect : TRect; + const Text : string); + procedure TextOutAtPoint ( X, Y : Integer; + const Text : string); + function RGBToTColor (Red, Green, Blue : Byte) : TColor; + procedure TColorToRGB ( Color : TColor; + var Red : Byte; + var Green : Byte; + var Blue : Byte); + procedure CachePalette ( ABitmap : TBitmap; + var PaletteEntries : TVpPaletteArray); + function GetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer) : TColor; + procedure SetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer; + AColor : TColor); + + property Viewport : TRect read FViewport write FViewport; + + published + property Angle : TVpRotationAngle read FAngle write FAngle + default ra0; + property Canvas : TCanvas read FCanvas write FCanvas; + end; + + TVpOnFindWordBreak = procedure ( Sender : TObject; + AString : string; + APosition : Integer; + var IsBreak : Boolean) of object; + + TVpLineWrapper = class (TObject) + private + FAngle : TVpRotationAngle; + FMinChars : Integer; + FTextMargin : Integer; + FOnFindWordBreak : TVpOnFindWordBreak; + FViewPort : TRect; + + protected + function FindEndingPos (ARegion : HRGN; + LineSize : Integer; + HPos : Integer; + YPos : Integer) : TPoint; + function FindNextStartingPoint ( ARegion : HRGN; + LineSize : Integer; + var HPos : Integer; + var YPos : Integer) : Boolean; + function FindWordBreaks (AString : string; + CharPos : Integer) : Integer; + function FitStringInRect ( ACanvas : TCanvas; + RectWidth : Integer; + AvgCharSize : Integer; + var AString : string; + var CharsOut : Integer) : string; + function GetAverageCharSize (ACanvas : TCanvas) : Integer; + function GetNextRectangle ( ARegion : HRGN; + LineSize : Integer; + AvgCharSize : Integer; + var HPos : Integer; + var LinePos : Integer) : TRect; + function IsWordBreak (AString : string; + CharPos : Integer) : Boolean; + function NextChar (AString : string; CharPos : Integer) : Char; + function PrevChar (AString : string; CharPos : Integer) : Char; + function ThisChar (AString : string; CharPos : Integer) : Char; + + public + constructor Create; + + function RenderTextToCanvas (ACanvas : TCanvas; + ARect : TRect; + AString : string) : Integer; + function RenderTextToCanvasRegion (ACanvas : TCanvas; + ARegion : HRGN; + AString : string) : Integer; + + property MinChars : Integer read FMinChars write FMinChars + default 5; + property TextMargin : Integer read FTextMargin write FTextMargin + default 3; + + property Viewport : TRect read FViewport write FViewport; + + published + property Angle : TVpRotationAngle read FAngle write FAngle + default ra0; + property OnFindWordBreak : TVpOnFindWordBreak + read FOnFindWordBreak write FOnFindWordBreak; + end; + +function TPSNormalizeRectangle (const ARect : TRect) : TRect; + +function TPSRotatePoint (const Angle : TVpRotationAngle; + const ViewPort : TRect; + const APoint : TPoint) : TPoint; + +function TPSRotateRectangle (const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect) : TRect; + +function TPSViewportWidth (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; + +function TPSViewportHeight (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; + +function TPSViewportLeft (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +function TPSViewportRight (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +function TPSViewportTop (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +function TPSViewportBottom (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; + + +procedure TPSArc ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); + +procedure TPSBrushCopy ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const Dest : TRect; + Bitmap : TBitmap; + const Source : TRect; + AColor : TColor); + +procedure TPSChord ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); + +procedure TPSCopyRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + Dest : TRect; + Canvas : TCanvas; + const Source : TRect); + +procedure TPSDraw ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + Graphic : TGraphic); + +procedure TPSDrawFocusRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); + +procedure TPSEllipse ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2 : Integer); overload; + +procedure TPSEllipse ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); overload; + +procedure TPSFillRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); + +procedure TPSFloodFill ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + AColor : TColor; + FillStyle : TFillStyle); + +procedure TPSFrameRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); + +procedure TPSLineTo ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer); + +procedure TPSMoveTo ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer); + +procedure TPSPie ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); + +procedure TPSPolyBezier ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const Points : array of TPoint); + +procedure TPSPolyBezierTo ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const Points : array of TPoint); + +procedure TPSPolygon ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + Points : array of TPoint); + +procedure TPSPolyline ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + Points : array of TPoint); + +procedure TPSRectangle ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2 : Integer); overload; + +procedure TPSRectangle ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); overload; + +procedure TPSRoundRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3 : Integer); + +procedure TPSStretchDraw ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect; + Graphic : TGraphic); + +procedure TPSTextOut ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + const Text : string); + +procedure TPSTextRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + ARect : TRect; + X, Y : Integer; + const Text : string); + +function TPSGetPixel ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const x : Integer; + const y : Integer) : TColor; + +procedure TPSSetPixel ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + x : Integer; + y : Integer; + AColor : TColor); + +procedure TPSCenteredTextOut ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + ARect : TRect; + const Text : string); + +procedure TPSTextOutAtPoint ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + const Text : string); + +function RGBToTColor (Red, Green, Blue : Byte) : TColor; + +procedure TColorToRGB ( Color : TColor; + var Red : Byte; + var Green : Byte; + var Blue : Byte); + +procedure TPSCachePalette (ABitmap : TBitmap; + var PaletteEntries : TVpPaletteArray); + +function TPSGetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer) : TColor; + +procedure TPSSetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer; + AColor : TColor); + +function RenderTextToRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const Viewport : TRect; + ARect : TRect; + AString : string) : Integer; + +function RenderTextToRegion ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const Viewport : TRect; + ARegion : HRGN; + AString : string) : Integer; + +implementation + +var + VpRotatedCanvas : TVpExCanvas; + VpTextRenderer : TVpLineWrapper; + +{ Function based TVpExCanvas Access ***************************************** } + +procedure SetTVpExCanvasAV (const Angle : TVpRotationAngle; + const Viewport : TRect); +begin + VpRotatedCanvas.Angle := Angle; + VpRotatedCanvas.Viewport := Viewport; +end; + +procedure SetTVpExCanvasAVC ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect); +begin + SetTVpExCanvasAV (Angle, ViewPort); + VpRotatedCanvas.Canvas := ACanvas; +end; + +function TPSNormalizeRectangle (const ARect : TRect) : TRect; +begin + Result := VpRotatedCanvas.NormalizeRectangle (ARect); +end; + +function TPSRotatePoint (const Angle : TVpRotationAngle; + const ViewPort : TRect; + const APoint : TPoint) : TPoint; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.RotatePoint (APoint); +end; + +function TPSRotateRectangle (const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect) : TRect; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.RotateRectangle (ARect); +end; + +function TPSViewportWidth (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.ViewportWidth; +end; + +function TPSViewportHeight (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.ViewportHeight; +end; + +function TPSViewportLeft (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.ViewportLeft; +end; + +function TPSViewportRight (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.ViewportRight; +end; + +function TPSViewportTop (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.ViewportTop; +end; + +function TPSViewportBottom (const Angle : TVpRotationAngle; + const ViewPort : TRect) : Integer; +begin + SetTVpExCanvasAV (Angle, ViewPort); + Result := VpRotatedCanvas.ViewportBottom; +end; + + +procedure TPSArc ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Arc (X1, Y1, X2, Y2, X3, Y3, X4, Y4); +end; + +procedure TPSBrushCopy ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const Dest : TRect; + Bitmap : TBitmap; + const Source : TRect; + AColor : TColor); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.BrushCopy (Dest, Bitmap, Source, AColor); +end; + +procedure TPSChord ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Chord (X1, Y1, X2, Y2, X3, Y3, X4, Y4); +end; + +procedure TPSCopyRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + Dest : TRect; + Canvas : TCanvas; + const Source : TRect); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.CopyRect (Dest, Canvas, Source); +end; + +procedure TPSDraw ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + Graphic : TGraphic); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Draw (X, Y, Graphic); +end; + +procedure TPSDrawFocusRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.DrawFocusRect (ARect); +end; + +procedure TPSEllipse ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2 : Integer); overload; +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Ellipse (X1, Y1, X2, Y2); +end; + +procedure TPSEllipse ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); overload; +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Ellipse (ARect); +end; + +procedure TPSFillRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.FillRect (ARect); +end; + +procedure TPSFloodFill ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + AColor : TColor; + FillStyle : TFillStyle); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.FloodFill (X, Y, AColor, FillStyle); +end; + +procedure TPSFrameRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.FrameRect (ARect); +end; + +procedure TPSLineTo ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.LineTo (X, Y); +end; + +procedure TPSMoveTo ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.MoveTo (X, Y); +end; + +procedure TPSPie ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Pie (X1, Y1, X2, Y2, X3, Y3, X4, Y4); +end; + +procedure TPSPolyBezier ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const Points : array of TPoint); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.PolyBezier (Points); +end; + +procedure TPSPolyBezierTo ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const Points : array of TPoint); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.PolyBezierTo (Points); +end; + +procedure TPSPolygon ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + Points : array of TPoint); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Polygon (Points); +end; + +procedure TPSPolyline ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + Points : array of TPoint); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Polyline (Points); +end; + +procedure TPSRectangle ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2 : Integer); overload; +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Rectangle (X1, Y1, X2, Y2); +end; + +procedure TPSRectangle ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect); overload; +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.Rectangle (ARect); +end; + +procedure TPSRoundRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X1, Y1, X2, Y2, X3, Y3 : Integer); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.RoundRect (X1, Y1, X2, Y2, X3, Y3); +end; + +procedure TPSStretchDraw ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const ARect : TRect; + Graphic : TGraphic); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.StretchDraw (ARect, Graphic); +end; + +procedure TPSTextOut ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + const Text : string); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.TextOut (X, Y, Text); +end; + +procedure TPSTextRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + ARect : TRect; + X, Y : Integer; + const Text : string); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.TextRect (ARect, X, Y, Text); +end; + +function TPSGetPixel ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + const x : Integer; + const y : Integer) : TColor; +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + Result := VpRotatedCanvas.GetPixel (x, y); +end; + +procedure TPSSetPixel ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + x : Integer; + y : Integer; + AColor : TColor); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.SetPixel (x, y, AColor); +end; + +procedure TPSCenteredTextOut ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + ARect : TRect; + const Text : string); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.CenteredTextOut (ARect, Text); +end; + +procedure TPSTextOutAtPoint ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const ViewPort : TRect; + X, Y : Integer; + const Text : string); +begin + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + VpRotatedCanvas.TextOutAtPoint (X, Y, Text); +end; + +function RGBToTColor (Red, Green, Blue : Byte) : TColor; +begin + Result := VpRotatedCanvas.RGBToTColor (Red, Green, Blue); +end; + +procedure TColorToRGB ( Color : TColor; + var Red : Byte; + var Green : Byte; + var Blue : Byte); +begin + VpRotatedCanvas.TColorToRGB (Color, Red, Green, Blue); +end; + +procedure TPSCachePalette ( ABitmap : TBitmap; + var PaletteEntries : TVpPaletteArray); +begin + VpRotatedCanvas.CachePalette (ABitmap, PaletteEntries); +end; + +function TPSGetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer) : TColor; +begin + Result := VpRotatedCanvas.GetBmpPixel (ABitmap, PaletteCache, x, y); +end; + +procedure TPSSetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer; + AColor : TColor); +begin + VpRotatedCanvas.SetBmpPixel (ABitmap, PaletteCache, x, y, AColor); +end; + +function RenderTextToRect ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const Viewport : TRect; + ARect : TRect; + AString : string) : Integer; +begin + VpTextRenderer.Angle := Angle; + VpTextRenderer.Viewport := Viewport; + Result := VpTextRenderer.RenderTextToCanvas (ACanvas, ARect, AString); +end; + +function RenderTextToRegion ( ACanvas : TCanvas; + const Angle : TVpRotationAngle; + const Viewport : TRect; + ARegion : HRGN; + AString : string) : Integer; +begin + VpTextRenderer.Angle := Angle; + VpTextRenderer.Viewport := Viewport; + Result := VpTextRenderer.RenderTextToCanvasRegion (ACanvas, ARegion, + AString); +end; + +{ TVpExCanvas *************************************************************** } + +constructor TVpExCanvas.Create; +begin + inherited Create; + + FAngle := ra0; + FViewPort := Rect (0, 0, 0, 0); + FCanvas := nil; +end; + +procedure TVpExCanvas.Swap (var a, b : Integer); +var + t : Integer; + +begin + t := a; + a := b; + b := t; +end; + +function TVpExCanvas.NormalizeRectangle (const ARect : TRect) : TRect; +begin + Result := ARect; + if Result.Left > Result.Right then + Swap (Result.Left, Result.Right); + + if Result .Top > Result.Bottom then + Swap (Result.Top, Result.Bottom); +end; + +function TVpExCanvas.RotatePoint (const APoint : TPoint) : TPoint; +begin + Result := APoint; + + case Angle of + ra0 : + Result := Point (APoint.X, + APoint.Y); + + ra90 : + Result := Point (ViewPort.Left + ViewPort.Right - APoint.Y, + APoint.X); + + ra180 : + Result := Point (ViewPort.Left + ViewPort.Right - APoint.X, + ViewPort.Top + ViewPort.Bottom - APoint.Y); + + ra270 : + Result := Point (APoint.Y, + ViewPort.Top + ViewPort.Bottom - APoint.X); + end; +end; + +function TVpExCanvas.RotateRectangle (const ARect : TRect) : TRect; +begin + Result := ARect; + + case Angle of + ra0 : + Result := TPSNormalizeRectangle (Rect (ARect.Left, + ARect.Top, + ARect.Right, + ARect.Bottom)); + + ra90 : + Result := TPSNormalizeRectangle (Rect (ViewPort.Left + ViewPort.Right - ARect.Top, + ARect.Left, + ViewPort.Left + ViewPort.Right - ARect.Bottom, + ARect.Right)); + + ra180 : + Result := TPSNormalizeRectangle (Rect (ViewPort.Left + ViewPort.Right - ARect.Left, + ViewPort.Top + ViewPort.Bottom - ARect.Top, + ViewPort.Left + ViewPort.Right - ARect.Right, + ViewPort.Top + ViewPort.Bottom - ARect.Bottom)); + + ra270 : + Result := TPSNormalizeRectangle (Rect (ARect.Top, + ViewPort.Top + ViewPort.Bottom - ARect.Left, + ARect.Bottom, + ViewPort.Top + ViewPort.Bottom - ARect.Right)); + end; +end; + +procedure TVpExCanvas.DrawRotatedText (x, y : Integer; + Text : string; + Rotate : Boolean); + +var + LF : TLogFont; + OldFont : TFont; + RealPoint : TPoint; + OldBrushStyle : TBrushStyle; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + FillChar (LF, SizeOf (LF), #0); + + LF.lfHeight := FCanvas.Font.Height; + LF.lfWidth := 0; + case Angle of + ra0 : LF.lfEscapement:= 0; + ra90 : LF.lfEscapement:= 2700; + ra180 : LF.lfEscapement:= 1800; + ra270 : LF.lfEscapement:= 900; + end; + LF.lfOrientation := 0; + if fsBold in FCanvas.Font.Style then + LF.lfWeight := FW_BOLD + else + LF.lfWeight := FW_NORMAL; + LF.lfItalic := Byte (fsItalic in FCanvas.Font.Style); + LF.lfUnderline := Byte (fsUnderline in FCanvas.Font.Style); + LF.lfStrikeOut := Byte (fsStrikeOut in FCanvas.Font.Style); + LF.lfCharSet := DEFAULT_CHARSET; + LF.lfQuality := DEFAULT_QUALITY; + if Length(FCanvas.Font.Name) <= 31 then + StrCopy(LF.lfFaceName, PChar(FCanvas.Font.Name)); + {everything else as default} + LF.lfOutPrecision := OUT_DEFAULT_PRECIS; + LF.lfClipPrecision := CLIP_DEFAULT_PRECIS; + case FCanvas.Font.Pitch of + fpVariable : LF.lfPitchAndFamily := VARIABLE_PITCH or FF_DONTCARE; + fpFixed : LF.lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE; + else + LF.lfPitchAndFamily := DEFAULT_PITCH; + end; + +// Create new font to use + OldFont := FCanvas.Font; + try + FCanvas.Font.Handle:= CreateFontIndirect (LF); + +// Output the text + if Rotate then + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (x, y)) + else + RealPoint := Point (x, y); + OldBrushStyle := FCanvas.Brush.Style; + try + FCanvas.Brush.Style := bsClear; + FCanvas.TextOut (RealPoint.X, RealPoint.Y, Text); + finally + FCanvas.Brush.Style := OldBrushStyle; + end; + finally + FCanvas.Font := OldFont; + end; +end; + +function TVpExCanvas.ViewportWidth : Integer; +var + FixRect : TRect; + +begin + FixRect := TPSNormalizeRectangle (ViewPort); + case Angle of + ra0, ra180 : Result := FixRect.Right - FixRect.Left; + ra90, ra270 : Result := FixRect.Bottom - FixRect.Top; + else + Result := FixRect.Right - FixRect.Left; + end; +end; + +function TVpExCanvas.ViewportHeight : Integer; +var + FixRect : TRect; + +begin + FixRect := TPSNormalizeRectangle (ViewPort); + case Angle of + ra0, ra180 : Result := FixRect.Bottom - FixRect.Top; + ra90, ra270 : Result := FixRect.Right - FixRect.Left; + else + Result := FixRect.Bottom - FixRect.Top; + end; +end; + +function TVpExCanvas.ViewportLeft : Integer; +var + FixRect : TRect; + +begin + FixRect := TPSNormalizeRectangle (ViewPort); + case Angle of + ra0, ra180 : Result := FixRect.Left; + ra90, ra270 : Result := FixRect.Top; + else + Result := FixRect.Left; + end; +end; + +function TVpExCanvas.ViewportRight : Integer; +var + FixRect : TRect; + +begin + FixRect := TPSNormalizeRectangle (ViewPort); + case Angle of + ra0, ra180 : Result := FixRect.Right; + ra90, ra270 : Result := FixRect.Bottom; + else + Result := FixRect.Right; + end; +end; + +function TVpExCanvas.ViewportTop : Integer; +var + FixRect : TRect; + +begin + FixRect := TPSNormalizeRectangle (ViewPort); + case Angle of + ra0, ra180 : Result := FixRect.Top; + ra90, ra270 : Result := FixRect.Left; + else + Result := FixRect.Top; + end; +end; + +function TVpExCanvas.ViewportBottom : Integer; +var + FixRect : TRect; + +begin + FixRect := TPSNormalizeRectangle (ViewPort); + case Angle of + ra0, ra180 : Result := FixRect.Bottom; + ra90, ra270 : Result := FixRect.Right; + else + Result := FixRect.Bottom; + end; +end; + +procedure TVpExCanvas.Arc (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +var + Point1 : TPoint; + Point2 : TPoint; + Point3 : TPoint; + Point4 : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); + Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); + Point4 := TPSRotatePoint (Angle, ViewPort, Point (X4, Y4)); + + FCanvas.Arc (Point1.X, Point1.Y, Point2.X, Point2.Y, Point3.X, Point3.Y, + Point4.X, Point4.Y); +end; + +procedure TVpExCanvas.BrushCopy (const Dest : TRect; + Bitmap : TBitmap; + const Source : TRect; + AColor : TColor); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + +//TODO: FCanvas.BrushCopy (TPSRotateRectangle (Angle, ViewPort, Dest), +// Bitmap, Source, AColor); +end; + +procedure TVpExCanvas.Chord (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +var + Point1 : TPoint; + Point2 : TPoint; + Point3 : TPoint; + Point4 : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); + Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); + Point4 := TPSRotatePoint (Angle, ViewPort, Point (X4, Y4)); + + FCanvas.Chord (Point1.X, Point1.Y, Point2.X, Point2.Y, Point3.X, Point3.Y, + Point4.X, Point4.Y); +end; + +procedure TVpExCanvas.CopyRect ( Dest : TRect; + Canvas : TCanvas; + const Source : TRect); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + FCanvas.CopyRect (TPSRotateRectangle (Angle, ViewPort, Dest), + Canvas, Source); +end; + +procedure TVpExCanvas.Draw (X, Y : Integer; + Graphic : TGraphic); +var + RealPoint : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); + FCanvas.Draw (RealPoint.X, RealPoint.Y, Graphic); +end; + +procedure TVpExCanvas.DrawFocusRect (const ARect : TRect); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + FCanvas.DrawFocusRect (TPSRotateRectangle (Angle, ViewPort, ARect)); +end; + +procedure TVpExCanvas.Ellipse (X1, Y1, X2, Y2 : Integer); +var + Point1 : TPoint; + Point2 : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); + Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + + FCanvas.Ellipse (Point1.X, Point1.Y, Point2.X, Point2.Y); +end; + +procedure TVpExCanvas.Ellipse (const ARect : TRect); +{$IFNDEF VERSION5} +var + R: TRect; +{$ENDIF} +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + {$IFDEF VERSION5} + FCanvas.Ellipse (TPSRotateRectangle (Angle, ViewPort, ARect)); + {$ELSE} + R := TPSRotateRectangle (Angle, ViewPort, ARect); + FCanvas.Ellipse (R.Left, R.Top, R.Right, R.Bottom); + {$ENDIF} +end; + +procedure TVpExCanvas.FillRect (const ARect : TRect); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + FCanvas.FillRect (TPSRotateRectangle (Angle, ViewPort, ARect)); +end; + +procedure TVpExCanvas.FloodFill (X, Y : Integer; + AColor : TColor; + FillStyle : TFillStyle); +var + RealPoint : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); + FCanvas.FloodFill (RealPoint.X, RealPoint.Y, AColor, FillStyle); +end; + +procedure TVpExCanvas.FrameRect (const ARect : TRect); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + FCanvas.FrameRect (TPSRotateRectangle (Angle, ViewPort, ARect)); +end; + +procedure TVpExCanvas.LineTo (X, Y : Integer); +var + RealPoint : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); + FCanvas.LineTo (RealPoint.X, RealPoint.Y); +end; + +procedure TVpExCanvas.MoveTo (X, Y : Integer); +var + RealPoint : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (X, Y)); + FCanvas.MoveTo (RealPoint.X, RealPoint.Y); +end; + +procedure TVpExCanvas.Pie (X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer); +var + Point1 : TPoint; + Point2 : TPoint; + Point3 : TPoint; + Point4 : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); + Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); + Point4 := TPSRotatePoint (Angle, ViewPort, Point (X4, Y4)); + + FCanvas.Pie (Point1.X, Point1.Y, Point2.X, Point2.Y, Point3.X, Point3.Y, + Point4.X, Point4.Y); +end; + +procedure TVpExCanvas.PolyBezier (const Points : array of TPoint); +var + i : Integer; + PointArray : array of TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + SetLength (PointArray, Length (Points)); + + for i := 0 to Length (Points) - 1 do + PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); + + FCanvas.PolyBezier (PointArray); +end; + +procedure TVpExCanvas.PolyBezierTo (const Points : array of TPoint); +var + i : Integer; + PointArray : array of TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + SetLength (PointArray, Length (Points)); + + for i := 0 to Length (Points) - 1 do + PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); + +//TODO: FCanvas.PolyBezierTo (PointArray); +end; + +procedure TVpExCanvas.Polygon (Points : array of TPoint); +var + i : Integer; + PointArray : array of TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + SetLength (PointArray, Length (Points)); + + for i := 0 to Length (Points) - 1 do + PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); + + FCanvas.Polygon (PointArray); +end; + +procedure TVpExCanvas.Polyline (Points : array of TPoint); +var + i : Integer; + PointArray : array of TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + SetLength (PointArray, Length (Points)); + + for i := 0 to Length (Points) - 1 do + PointArray[i] := TPSRotatePoint (Angle, ViewPort, Points[i]); + + FCanvas.Polyline (PointArray); +end; + +procedure TVpExCanvas.Rectangle (X1, Y1, X2, Y2 : Integer); +var + Point1 : TPoint; + Point2 : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); + Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + + FCanvas.Rectangle (Point1.X, Point1.Y, Point2.X, Point2.Y); +end; + +procedure TVpExCanvas.Rectangle (const ARect : TRect); +{$IFNDEF VERSION5} +var + R: TRect; +{$ENDIF} +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + {$IFDEF VERSION5} + FCanvas.Rectangle (TPSRotateRectangle (Angle, ViewPort, ARect)); + {$ELSE} + R := TPSRotateRectangle (Angle, ViewPort, ARect); + FCanvas.Rectangle (R.Left, R.Top, R.Right, R.Bottom); + {$ENDIF} +end; + +procedure TVpExCanvas.RoundRect (X1, Y1, X2, Y2, X3, Y3 : Integer); +var + Point1 : TPoint; + Point2 : TPoint; + Point3 : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + Point1 := TPSRotatePoint (Angle, ViewPort, Point (X1, Y1)); + Point2 := TPSRotatePoint (Angle, ViewPort, Point (X2, Y2)); + Point3 := TPSRotatePoint (Angle, ViewPort, Point (X3, Y3)); + + FCanvas.RoundRect (Point1.X, Point1.Y, Point2.X, Point2.Y, + Point3.X, Point3.Y); +end; + +procedure TVpExCanvas.StretchDraw (const ARect : TRect; + Graphic : TGraphic); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + FCanvas.StretchDraw (TPSRotateRectangle (Angle, ViewPort, ARect), Graphic); +end; + +procedure TVpExCanvas.TextOut ( X, Y : Integer; + const Text : string); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + DrawRotatedText (X, Y, Text, True); +end; + +procedure TVpExCanvas.TextRect ( ARect : TRect; + X, Y : Integer; + const Text : string); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); +end; + +function TVpExCanvas.GetPixel (const x : Integer; + const y : Integer) : TColor; +var + RealPoint : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (x, y)); + Result := FCanvas.Pixels [RealPoint.X, RealPoint.Y]; +end; + +procedure TVpExCanvas.SetPixel (x : Integer; + y : Integer; + AColor : TColor); +var + RealPoint : TPoint; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + RealPoint := TPSRotatePoint (Angle, ViewPort, Point (x, y)); + FCanvas.Pixels [RealPoint.X, RealPoint.Y] := AColor; +end; + +procedure TVpExCanvas.CenteredTextOut ( ARect : TRect; + const Text : string); +var + TW : Integer; + +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + TW := FCanvas.TextWidth (Text); + if TW < ARect.Right - ARect.Left then + ARect.Left := ARect.Left + ((ARect.Right - ARect.Left - TW) div 2); + + TPSTextOut (FCanvas, Angle, ViewPort, ARect.Left, ARect.Top, Text); +end; + +procedure TVpExCanvas.TextOutAtPoint ( X, Y : Integer; + const Text : string); +begin + if not Assigned (FCanvas) then + raise EVpCanvasError.Create (RSNoCanvas); + + DrawRotatedText (X, Y, Text, False); +end; + +function TVpExCanvas.RGBToTColor (Red, Green, Blue : Byte) : TColor; +var + RedPart, GreenPart, BluePart : Integer; + +begin + RedPart := Red; + GreenPart := Green shl 8; + BluePart := Blue shl 16; + Result := $02000000 or RedPart or GreenPart or BluePart; +end; + +procedure TVpExCanvas.TColorToRGB ( Color : TColor; + var Red : Byte; + var Green : Byte; + var Blue : Byte); +begin + Red := Color and $0000ff; + Green := (Color and $00ff00) shr 8; + Blue := (Color and $ff0000) shr 16; +end; + +procedure TVpExCanvas.CachePalette ( ABitmap : TBitmap; + var PaletteEntries : TVpPaletteArray); +var + PaletteSize : Integer; + +begin + case ABitmap.PixelFormat of + pfDevice : + PaletteSize := 0; + pf1bit : + PaletteSize := 2; + pf4bit : + PaletteSize := 16; + pf8bit : + PaletteSize := 256; + pf15bit : + PaletteSize := 0; + pf16bit : + PaletteSize := 0; + pf24bit : + PaletteSize := 0; + pf32bit : + PaletteSize := 0; + pfCustom : + PaletteSize := 0; + else + PaletteSize := 0; + end; + + if PaletteSize > 0 then + GetPaletteEntries (ABitmap.Palette, 0, PaletteSize, PaletteEntries); +end; + +function TVpExCanvas.GetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer) : TColor; +// Fast scanline based pixel access +var + ByteArray : PChar; + WorkByte : Byte; + WorkWord : Word; + Red : Byte; + Blue : Byte; + Green : Byte; + +begin +//TODO: +{ + if (x < 0) or (x >= ABitmap.Width) or + (y < 0) or (y >= ABitmap.Height) then + raise EVpCanvasError.Create (RSOutOfRange); + + case ABitmap.PixelFormat of + pfDevice : begin + raise EVpCanvasError.Create (RSNotSupported); + end; + + pf1bit : begin + ByteArray := ABitmap.ScanLine[y]; + WorkByte := (Byte (ByteArray[x div 8]) shr (7 - (x mod 8))) and $01; + Result := RGBToTColor (PaletteCache[WorkByte].peRed, + PaletteCache[WorkByte].peGreen, + PaletteCache[WorkByte].peBlue); + end; + + pf4bit : begin + ByteArray := ABitmap.ScanLine[y]; + WorkByte := (Byte (ByteArray[x div 2]) shr (((x + 1) mod 2) * 4)) and $0F; + Result := RGBToTColor (PaletteCache[WorkByte].peRed, + PaletteCache[WorkByte].peGreen, + PaletteCache[WorkByte].peBlue); + end; + + pf8bit : begin + ByteArray := ABitmap.ScanLine[y]; + WorkByte := Byte (ByteArray[x]); + Result := RGBToTColor (PaletteCache[WorkByte].peRed, + PaletteCache[WorkByte].peGreen, + PaletteCache[WorkByte].peBlue); + end; + + pf15bit : begin + ByteArray := ABitmap.ScanLine[y]; + WorkWord := Byte (ByteArray[x * 2]) + + 256 * Byte (ByteArray[(x * 2) + 1]); + Red := ((WorkWord shr 10) and $1f) shl 3; + Green := ((WorkWord shr 5) and $1f) shl 3; + Blue := (WorkWord and $1f) shl 3; + Result := RGBToTColor (Red, Green, Blue); + end; + + pf16bit : begin + ByteArray := ABitmap.ScanLine[y]; + WorkWord := Byte (ByteArray[x * 2]) + + 256 * Byte (ByteArray[(x * 2) + 1]); + Red := ((WorkWord shr 11) and $1f) shl 3; + Green := ((WorkWord shr 5) and $3f) shl 2; + Blue := (WorkWord and $1f) shl 3; + Result := RGBToTColor (Red, Green, Blue); + end; + + pf24bit : begin + ByteArray := ABitmap.ScanLine[y]; + Result := RGBToTColor (Byte (ByteArray[x * 3 + 2]), + Byte (ByteArray[x * 3 + 1]), + Byte (ByteArray[x * 3])); + end; + + pf32bit : begin + ByteArray := ABitmap.ScanLine[y]; + Result := RGBToTColor (Byte (ByteArray[x * 4 + 2]), + Byte (ByteArray[x * 4 + 1]), + Byte (ByteArray[x * 4])); + end; + pfCustom : begin + raise EVpCanvasError.Create (RSNotSupported); + end; + else + raise EVpCanvasError.Create (RSNotSupported); + end; +} +end; + +procedure TVpExCanvas.SetBmpPixel (ABitmap : TBitmap; + PaletteCache : TVpPaletteArray; + x : Integer; + y : Integer; + AColor : TColor); +// Fast scanline based pixel access +var + BytePos : Integer; + WorkByte : Byte; + WorkWord : Word; + ByteArray : PChar; + PaletteIndex : Byte; + Red : Byte; + Green : Byte; + Blue : Byte; + +begin +//TODO: +{ + if (x < 0) or (x >= ABitmap.Width) or + (y < 0) or (y >= ABitmap.Height) then + Exit; + + case ABitmap.PixelFormat of + pfDevice : begin + raise EVpCanvasError.Create (RSNotSupported); + end; + + pf1bit : begin + ByteArray := ABitmap.ScanLine[y]; + BytePos := x div 8; + WorkByte := Byte (ByteArray[BytePos]); + WorkByte := WorkByte and (not ($01 shl (7 - (x mod 8)))); + PaletteIndex := GetNearestPaletteIndex (ABitmap.Palette, AColor) and $01; + WorkByte := WorkByte or (PaletteIndex shl (7 - (x mod 8))); + ByteArray[BytePos] := Char (WorkByte); + end; + + pf4bit : begin + ByteArray := ABitmap.ScanLine[y]; + BytePos := x div 2; + WorkByte := Byte (ByteArray[BytePos]); + WorkByte := WorkByte and (not ($0f shl (((x + 1) mod 2) * 4))); + PaletteIndex := GetNearestPaletteIndex (ABitmap.Palette, AColor) and $0f; + WorkByte := WorkByte or (PaletteIndex shl (((x + 1) mod 2) * 4)); + ByteArray[BytePos] := Char (WorkByte); + end; + + pf8bit : begin + ByteArray := ABitmap.ScanLine[y]; + PaletteIndex := GetNearestPaletteIndex (ABitmap.Palette, AColor); + ByteArray[x] := Char (PaletteIndex); + end; + + pf15bit : begin + TColorToRGB (AColor, Red, Green, Blue); + ByteArray := ABitmap.ScanLine[y]; + WorkWord := ((Red and $f8) shl 7) or + ((Green and $f8) shl 3) or + ((Blue and $f8) shr 3); + ByteArray[x * 2] := Char (WorkWord and $ff); + ByteArray[(x * 2) + 1] := Char ((WorkWord shr 8) and $ff);; + end; + + pf16bit : begin + TColorToRGB (AColor, Red, Green, Blue); + ByteArray := ABitmap.ScanLine[y]; + WorkWord := ((Red and $f8) shl 8) or + ((Green and $fc) shl 3) or + ((Blue and $f8) shr 3); + ByteArray[x * 2] := Char (WorkWord and $ff); + ByteArray[(x * 2) + 1] := Char ((WorkWord shr 8) and $ff);; + end; + + pf24bit : begin + TColorToRGB (AColor, Red, Green, Blue); + ByteArray := ABitmap.ScanLine[y]; + ByteArray[(x * 3) + 2] := Char (Red); + ByteArray[(x * 3) + 1] := Char (Green); + ByteArray[x * 3] := Char (Blue); + end; + + pf32bit : begin + TColorToRGB (AColor, Red, Green, Blue); + ByteArray := ABitmap.ScanLine[y]; + ByteArray[(x * 4) + 2] := Char (Red); + ByteArray[(x * 4) + 1] := Char (Green); + ByteArray[x * 4] := Char (Blue); + end; + + pfCustom : begin + raise EVpCanvasError.Create (RSNotSupported); + end; + end; + } +end; + +{ TVpLineWrapper ************************************************************ } + +constructor TVpLineWrapper.Create; +begin + inherited Create; + + FTextMargin := 3; + FMinChars := 5; + FAngle := ra0; + FViewPort := Rect (0, 0, 0, 0); +end; + +function TVpLineWrapper.FindEndingPos (ARegion : HRGN; + LineSize : Integer; + HPos : Integer; + YPos : Integer) : TPoint; +var + WorkRect : TRect; + +begin + GetRgnBox (ARegion, @WorkRect); + + Result.x := HPos; + Result.y := YPos; + while (PtInRegion (ARegion, Result.x, Result.y)) and + (PtInRegion (ARegion, Result.x, Result.y + LineSize)) and + (Result.x < WorkRect.Right) do + Inc (Result.x); +end; + +function TVpLineWrapper.FindNextStartingPoint ( + ARegion : HRGN; + LineSize : Integer; + var HPos : Integer; + var YPos : Integer) : Boolean; + +var + WorkRect : TRect; + Done : Boolean; + +begin + Result := False; + Done := False; + while not Done do begin + if HPos > WorkRect.Right then begin + HPos := WorkRect.Left; + Inc (YPos, LineSize); + if YPos > WorkRect.Bottom then + Break; + end; + if (not PtInRegion (ARegion, HPos, YPos)) or + (not PtInRegion (ARegion, HPos, YPos + LineSize)) then begin + Inc (HPos); + if HPos > WorkRect.Right then begin + HPos := WorkRect.Left; + Inc (YPos, LineSize); + if YPos > WorkRect.Bottom then + Break; + end; + end else begin + Result := True; + Break; + end; + end; +end; + +function TVpLineWrapper.FindWordBreaks (AString : string; + CharPos : Integer) : Integer; +var + Done : Boolean; + WorkPos : Integer; + +begin + Done := False; + WorkPos := CharPos; + + while not Done do begin + if IsWordBreak (AString, WorkPos) then + Done := True + else + Dec (WorkPos); + + if WorkPos = 0 then + Done := True; + end; + + if WorkPos > 0 then + Result := WorkPos + else + Result := CharPos; +end; + +function TVpLineWrapper.FitStringInRect ( + ACanvas : TCanvas; + RectWidth : Integer; + AvgCharSize : Integer; + var AString : string; + var CharsOut : Integer) : string; + +var + CharsToRender : Integer; + L : Integer; + R : Integer; + M : Integer; + +begin + if AvgCharSize > 0 then begin + { Guess at the number of characters that can fit on a line } + CharsToRender := RectWidth div AvgCharSize; + + if CharsToRender > 0 then begin + Result := Copy (AString, 1, CharsToRender); + while (ACanvas.TextWidth (Result) < RectWidth) and + (CharsToRender < Length (Result)) do begin + Inc (CharsToRender); + Result := Copy (AString, 1, CharsToRender); + end; + while (ACanvas.TextWidth (Result) > RectWidth) and + (CharsToRender > 0) do begin + Dec (CharsToRender); + Result := Copy (AString, 1, CharsToRender); + end; + + if CharsToRender >= Length (AString) then begin + CharsOut := CharsToRender; + AString := Trim (Copy (AString, + CharsToRender + 1, + Length (AString) - 1)); + Exit; + end; + + CharsToRender := FindWordBreaks (AString, CharsToRender); + Result := Copy (AString, 1, CharsToRender); + end; + + if CharsToRender > 0 then begin + AString := Copy (AString, + CharsToRender + 1, + Length (AString) - CharsToRender + 1); + end else begin + Result := Copy (AString, 1, 1); + AString := Copy (AString, + 2, + Length (AString) - 1); + end; + end else begin + { Use binary search if the average character guess fails } + L := 1; + R := Length (AString); + M := 0; + while L <= R do begin + M := (L + R) div 2; + Result := Copy (AString, 1, M); + if (ACanvas.TextWidth (Result) < RectWidth) then + L := Succ (M) + else + R := Pred (M); + if M >= Length (AString) then begin + CharsOut := Length (AString); + AString := Trim (Copy (AString, M + 1, Length (AString) - 1)); + Exit; + end; + end; + CharsToRender := FindWordBreaks (AString, M); + Result := Copy (AString, 1, CharsToRender); + AString := Copy (AString, + CharsToRender + 1, + Length (AString) - 1); + end; + CharsOut := CharsToRender; + Result := Trim (Result); +end; + +function TVpLineWrapper.GetAverageCharSize ( + ACanvas : TCanvas) : Integer; + +var + Metrics : TTextMetric; + SavedFontHandle : THandle; + DC : HDC; + +begin + DC := GetDC (0); + SavedFontHandle := SelectObject (DC, ACanvas.Font.Handle); + try + GetTextMetrics (DC, Metrics); + Result := Metrics.tmAveCharWidth; + finally + SelectObject (DC, SavedFontHandle); + ReleaseDC (0, DC); + end; +end; + +function TVpLineWrapper.GetNextRectangle ( + ARegion : HRGN; + LineSize : Integer; + AvgCharSize : Integer; + var HPos : Integer; + var LinePos : Integer) : TRect; + +var + EndPoint : TPoint; + Done : Boolean; + +begin + Result := Rect (0, 0, 0, 0); + Done := False; + while not Done do + if FindNextStartingPoint (ARegion, LineSize, + HPos, LinePos) then begin + EndPoint := FindEndingPos (ARegion, LineSize, HPos, LinePos); + if EndPoint.x - HPos > FMinChars * AvgCharSize then begin + Result := Rect (HPos, LinePos, EndPoint.x, EndPoint.y); + Break; + end else + Inc (HPos); + end else + Break; +end; + +function TVpLineWrapper.IsWordBreak (AString : string; + CharPos : Integer) : Boolean; +var + NC : Char; + PC : Char; + C : Char; + +begin + C := ThisChar (AString, CharPos); + NC := NextChar (AString, CharPos); + PC := PrevChar (AString, CharPos); + Result := False; + + if C = '.' then begin + if not (NC in ['0'..'9']) then + Result := True; + end else if (C in [' ', #10, #13, #9]) then + Result := True + else if C = '-' then begin + if (PC in ['0'..'9', 'A'..'Z', 'a'..'z']) and + (NC in ['0'..'9', 'A'..'Z', 'a'..'z']) then + Result := True; + end; + if Assigned (FOnFindWordBreak) then + FOnFindWordBreak (Self, AString, CharPos, Result); +end; + +function TVpLineWrapper.NextChar (AString : string; + CharPos : Integer) : Char; +begin + if (CharPos >= 1) and (CharPos < Length (AString)) then + Result := AString[CharPos + 1] + else + Result := #0; +end; + +function TVpLineWrapper.PrevChar (AString : string; + CharPos : Integer) : Char; +begin + if (CharPos > 1) and (CharPos <= Length (AString)) then + Result := AString[CharPos - 1] + else + Result := #0; +end; + +function TVpLineWrapper.RenderTextToCanvas (ACanvas : TCanvas; + ARect : TRect; + AString : string) : Integer; + +var + LineHeight : Integer; + RectWidth : Integer; + RectHeight : Integer; + LinePos : Integer; + AvgCharSize : Integer; + Done : Boolean; + CharsWritten : Integer; + +begin + { Initialize stuff } + Result := 0; + CharsWritten := 0; + + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + + LineHeight := ACanvas.TextHeight ('yY0'); + if Angle = ra0 then + RectWidth := ARect.Right - ARect.Left - 2 * FTextMargin + else + RectWidth := VpRotatedCanvas.ViewportWidth; + if Angle = ra0 then + RectHeight := ARect.Bottom - ARect.Top + else + RectHeight := VpRotatedCanvas.ViewportHeight; + LinePos := ARect.Top + FTextMargin; + AvgCharSize := GetAverageCharSize (ACanvas); + Done := False; + + if LineHeight > RectHeight then + Exit; + + while not Done do begin + if LinePos + LineHeight > ARect.Bottom then + Break; + + if AString = '' then + Break; + + VpRotatedCanvas.TextOut (ARect.Left + FTextMargin, + LinePos, + FitStringInRect (ACanvas, + RectWidth, + AvgCharSize, + AString, + CharsWritten)); + Result := Result + CharsWritten; + + LinePos := LinePos + LineHeight + FTextMargin; + end; +end; + +function TVpLineWrapper.RenderTextToCanvasRegion (ACanvas : TCanvas; + ARegion : HRGN; + AString : string) : Integer; +var + LineHeight : Integer; + RectHeight : Integer; + LinePos : Integer; + AvgCharSize : Integer; + Done : Boolean; + HPos : Integer; + + RegionRect : TRect; + WorkRect : TRect; + CharsWritten : Integer; + +begin + Result := 0; + CharsWritten := 0; + + SetTVpExCanvasAVC (ACanvas, Angle, ViewPort); + GetRgnBox (ARegion, @RegionRect); + + LineHeight := ACanvas.TextHeight ('yY0'); + if Angle = ra0 then + RectHeight := RegionRect.Bottom - RegionRect.Top + else + RectHeight := VpRotatedCanvas.ViewportHeight; + LinePos := RegionRect.Top + FTextMargin; + HPos := RegionRect.Left + FTextMargin; + AvgCharSize := GetAverageCharSize (ACanvas); + Done := False; + + if LineHeight > RectHeight then + Exit; + + while not Done do begin + if LinePos + LineHeight > RegionRect.Bottom then + Break; + + if AString = '' then + Break; + + WorkRect := GetNextRectangle (ARegion, LineHeight, + AvgCharSize, HPos, linepos); + if WorkRect.Right - WorkRect.Left > 0 then begin + VpRotatedCanvas.TextOut (WorkRect.Left + FTextMargin, + WorkRect.Top, + FitStringInRect (ACanvas, + WorkRect.Right - + WorkRect.Left - + FTextMargin, + AvgCharSize, + AString, + CharsWritten)); + Result := Result + CharsWritten; + end else + Break; + HPos := WorkRect.Right + 1; + end; +end; + +function TVpLineWrapper.ThisChar (AString : string; + CharPos : Integer) : Char; +begin + if (CharPos >= 1) and (CharPos <= Length (AString)) then + Result := AString[CharPos] + else + Result := #0; +end; + +initialization + + VpRotatedCanvas := TVpExCanvas.Create; + VpTextRenderer := TVpLineWrapper.Create; + +finalization + + VpRotatedCanvas.Free; + VpTextRenderer.Free; + +{ !!.01 End changes !!.01 } + +end. diff --git a/components/tvplanit/source/vpclock.pas b/components/tvplanit/source/vpclock.pas new file mode 100644 index 000000000..05074c5a0 --- /dev/null +++ b/components/tvplanit/source/vpclock.pas @@ -0,0 +1,1379 @@ +{*********************************************************} +{* VPCLOCK.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +unit VpClock; + {-clock component} + +{$I vp.inc} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, Messages, + {$ENDIF} + Classes, Controls, Dialogs, Forms, Graphics, Menus,Math, + SysUtils, VpBase, VpMisc, VpLEDLabel, VpTimerPool; + +type + TVpPercent = 0..100; + TVpClockMode = (cmClock, cmTimer, cmCountdownTimer); + TVpClockDisplayMode = (dmAnalog, dmDigital); + + TVpLEDClockDisplay = class(TVpCustomLEDLabel) + public + procedure PaintSelf; + end; + + TVpDigitalOptions = class(TPersistent) + protected{private} + FOwner : TComponent; + FOnColor : TColor; + FOffColor : TColor; + FBgColor : TColor; + FSize : TSegmentSize; + FShowSeconds : Boolean; + FFlashColon : Boolean; + FOnChange : TNotifyEvent; + F24Hour : Boolean; + procedure Set24Hour(Value: Boolean); + procedure SetOnColor(Value: TColor); + procedure SetOffColor(Value: TColor); + procedure SetBgColor(Value: TColor); + procedure SetSize(Value: TSegmentSize); + procedure SetShowSeconds(Value: Boolean); + procedure DoOnChange; + public + constructor Create; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property MilitaryTime : Boolean read F24Hour write Set24Hour; + property OnColor: TColor read FOnColor write SetOnColor; + property OffColor: TColor read FOffColor write SetOffColor; + property BgColor: TColor read FBgColor write SetBgColor; + property Size: TSegmentSize read FSize write SetSize; + property ShowSeconds: Boolean read FShowSeconds write SetShowSeconds; + end; + + TVpHandOptions = class(TPersistent) + protected {private} + {property variables} + FClockFace : TBitmap; + FDrawMarks : Boolean; + FHourHandColor : TColor; + FHourHandLength : TVpPercent; + FHourHandWidth : Integer; + FMinuteHandColor : TColor; + FMinuteHandLength : TVpPercent; + FMinuteHandWidth : Integer; + FSecondHandColor : TColor; + FSecondHandLength : TVpPercent; + FSecondHandWidth : Integer; + FShowSecondHand : Boolean; + FSolidHands : Boolean; + {events variables} + FOnChange : TNotifyEvent; + {property methods} + procedure SetClockFace(Value : TBitMap); + procedure SetDrawMarks(Value : Boolean); + procedure SetHourHandColor(Value : TColor); + procedure SetHourHandLength(Value : TVpPercent); + procedure SetHourHandWidth(Value : Integer); + procedure SetMinuteHandColor(Value : TColor); + procedure SetMinuteHandLength(Value : TVpPercent); + procedure SetMinuteHandWidth(Value : Integer); + procedure SetSecondHandColor(Value : TColor); + procedure SetSecondHandLength(Value : TVpPercent); + procedure SetSecondHandWidth(Value : Integer); + procedure SetShowSecondHand(Value : Boolean); + procedure SetSolidHands(Value : Boolean); + {internal methods} + procedure DoOnChange; + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source : TPersistent); + override; + property OnChange : TNotifyEvent + read FOnChange write FOnChange; + published + property ClockFace : TBitMap + read FClockFace write SetClockFace; + property DrawMarks : Boolean + read FDrawMarks write SetDrawMarks; + property HourHandColor : TColor + read FHourHandColor write SetHourHandColor; + property HourHandLength : TVpPercent + read FHourHandLength write SetHourHandLength; + property HourHandWidth : Integer + read FHourHandWidth write SetHourHandWidth; + property MinuteHandColor : TColor + read FMinuteHandColor write SetMinuteHandColor; + property MinuteHandLength : TVpPercent + read FMinuteHandLength write SetMinuteHandLength; + property MinuteHandWidth : Integer + read FMinuteHandWidth write SetMinuteHandWidth; + property SecondHandColor : TColor + read FSecondHandColor write SetSecondHandColor; + property SecondHandLength : TVpPercent + read FSecondHandLength write SetSecondHandLength; + property SecondHandWidth : Integer + read FSecondHandWidth write SetSecondHandWidth; + property ShowSecondHand : Boolean + read FShowSecondHand write SetShowSecondHand; + property SolidHands : Boolean + read FSolidHands write SetSolidHands; + end; + + TVpCustomClock = class(TVpCustomControl) + protected {private} + FTimerPool : TVpTimerPool; + FActive : Boolean; + FClockMode : TVpClockMode; + FDigitalOptions : TVpDigitalOptions; + FDisplayMode : TVpClockDisplayMode; + FElapsedDays : Integer; + FElapsedHours : Integer; + FElapsedMinutes : LongInt; + FElapsedSeconds : LongInt; + FHandOptions : TVpHandOptions; + FTime : TDateTime; + FMilitaryTime : Boolean; + FStartTime : TDateTime; + FHourOffset : Integer; {Hours} + FMinuteOffset : Integer; {Minutes} + FSecondOffset : Integer; {Seconds} + {event variables} + FOnHourChange : TNotifyEvent; + FOnMinuteChange : TNotifyEvent; + FOnSecondChange : TNotifyEvent; + FOnCountdownDone: TNotifyEvent; + {internal variables} + ckAnalogHeight : Integer; + ckAnalogWidth : Integer; + ckLEDDisplay : TVpLEDClockDisplay; + ckDraw : TBitMap; + ckClockHandle : Integer; + ckOldHour : Integer; + ckOldMinute : Integer; + ckOldSecond : Integer; + ckTimerTime : TDateTime; + ckDays : Integer; + ckHours : Integer; + ckMinutes : Integer; + ckSeconds : Integer; + ckTotalSeconds : Integer; + {property methods} + function GetElapsedDays : Integer; + function GetElapsedHours : Integer; + function GetElapsedMinutes : LongInt; + function GetElapsedSeconds : LongInt; + function GetElapsedSecondsTotal : LongInt; + procedure SetActive(Value : Boolean); + procedure SetClockMode(Value : TVpClockMode); + procedure SetDisplayMode(Value: TVpClockDisplayMode); + procedure SetMinuteOffset(Value : Integer); + procedure SetHourOffset(Value : Integer); + procedure SetSecondOffset(Value : Integer); + {internal methods} + function ckConvertMsToDateTime(Value : LongInt) : TDateTime; + procedure ckHandOptionChange(Sender : TObject); + procedure ckDigitalOptionChange(Sender : TObject); + procedure SizeDigitalDisplay; + procedure ckTimerEvent(Sender : TObject; Handle : Integer; + Interval : Cardinal; ElapsedTime : LongInt); + procedure DoOnHourChange; + procedure DoOnMinuteChange; + procedure DoOnSecondChange; + procedure DoOnCountdownDone; + procedure PaintHands(ACanvas : TCanvas); + {windows message methods} + {$IFDEF LCL} + procedure WMResize (var Msg: TLMSize); message LM_SIZE; + procedure WMEraseBkgnd (var Msg : TLMEraseBkgnd); message LM_ERASEBKGND; + {$ELSE} + procedure WMResize (var Msg: TWMSize); message WM_SIZE; + procedure WMEraseBkgnd (var Msg : TWMEraseBkgnd); message WM_ERASEBKGND; + procedure WMGetDlgCode (var Msg : TWMGetDlgCode); message WM_GETDLGCODE; + {$ENDIF} + protected + procedure Loaded; override; + procedure Paint; override; + procedure PaintAnalog; + procedure PaintDigital; + {virtual property methods} + procedure SetTime(Value : TDateTime); virtual; + property Active : Boolean read FActive write SetActive; + property ClockMode : TVpClockMode read FClockMode write SetClockMode; + property DigitalOptions: TVpDigitalOptions + read FDigitalOptions write FDigitalOptions; + property AnalogOptions : TVpHandOptions + read FHandOptions write FHandOptions; + property MinuteOffset : Integer read FMinuteOffset write SetMinuteOffset; + property HourOffset : Integer read FHourOffset write SetHourOffset; + property SecondOffset: Integer read FSecondOffset write SetSecondOffset; + {events} + property OnHourChange : TNotifyEvent read FOnHourChange write FOnHourChange; + property OnMinuteChange : TNotifyEvent + read FOnMinuteChange write FOnMinuteChange; + property OnSecondChange : TNotifyEvent + read FOnSecondChange write FOnSecondChange; + property OnCountdownDone : TNotifyEvent + read FOnCountdownDone write FOnCountdownDone; + public + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); override; + property DisplayMode: TVpClockDisplayMode + read FDisplayMode write SetDisplayMode; + property ElapsedDays : Integer read GetElapsedDays; + property ElapsedHours : Integer read GetElapsedHours; + property ElapsedMinutes : LongInt read GetElapsedMinutes; + property ElapsedSeconds : LongInt read GetElapsedSeconds; + property ElapsedSecondsTotal : LongInt read GetElapsedSecondsTotal; + property Time : TDateTime read FTime write SetTime; + end; + + TVpClock = class(TVpCustomClock) + published + {properties} + {$IFDEF VERSION4} + property Anchors; + property Constraints; + {$ENDIF} + property Active; + property Align; + property Color; + property ClockMode; + property DigitalOptions; + property DisplayMode; + property Hint; + property AnalogOptions; + property MinuteOffset; + property ParentColor; + property ParentShowHint; + property PopupMenu; + property SecondOffset; + property ShowHint; + property HourOffset; + property Visible; + {events} + property OnClick; + property OnCountdownDone; + property OnDblClick; + property OnHourChange; + property OnMinuteChange; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnSecondChange; + end; + + +implementation + +uses + VpConst; + +const + ckDToR = (Pi / 180); + ckInterval = 500; + + +{===== TVpLEDClockDisplay ===========================================} +procedure TVpLEDClockDisplay.PaintSelf; +begin + Paint; +end; + +{===== TVpDigitalOptions ============================================} +constructor TVpDigitalOptions.Create; +begin + inherited Create; + FSize := 2; + FOnColor := clLime; + FOffColor := $000E3432; + FBgColor := clBlack; + FShowSeconds := True; + MilitaryTime := True; +end; +{=====} + +procedure TVpDigitalOptions.DoOnChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; +{=====} + +procedure TVpDigitalOptions.Set24Hour(Value: Boolean); +begin + if F24Hour <> Value then begin + F24Hour := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpDigitalOptions.SetOnColor(Value: TColor); +begin + if FOnColor <> Value then begin + FOnColor := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpDigitalOptions.SetOffColor(Value: TColor); +begin + if FOffColor <> Value then begin + FOffColor := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpDigitalOptions.SetBgColor(Value: TColor); +begin + if FBgColor <> Value then begin + FBgColor := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpDigitalOptions.SetSize(Value: TSegmentSize); +begin + if FSize <> Value then begin + FSize := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpDigitalOptions.SetShowSeconds(Value: Boolean); +begin + if FShowSeconds <> Value then begin + FShowSeconds := Value; + DoOnChange; + end; +end; +{=====} + + +{===== TVpHandOptions ===============================================} + +constructor TVpHandOptions.Create; +begin + inherited; + + FClockFace := TBitMap.Create; + FDrawMarks := True; +end; +{=====} + +destructor TVpHandOptions.Destroy; +begin + FClockFace.Free; + FClockFace := nil; + + inherited; +end; +{=====} + +procedure TVpHandOptions.Assign(Source : TPersistent); +begin + if Source is TVpHandOptions then begin + FHourHandColor := TVpHandOptions(Source).FHourHandColor; + FHourHandLength := TVpHandOptions(Source).FHourHandLength; + FHourHandWidth := TVpHandOptions(Source).FHourHandWidth; + FMinuteHandColor := TVpHandOptions(Source).FMinuteHandColor; + FMinuteHandLength := TVpHandOptions(Source).FMinuteHandLength; + FMinuteHandWidth := TVpHandOptions(Source).FMinuteHandWidth; + FSecondHandColor := TVpHandOptions(Source).FSecondHandColor; + FSecondHandLength := TVpHandOptions(Source).FSecondHandLength; + FSecondHandWidth := TVpHandOptions(Source).FSecondHandWidth; + FShowSecondHand := TVpHandOptions(Source).FShowSecondHand; + FSolidHands := TVpHandOptions(Source).FSolidHands; + FOnChange := TVpHandOptions(Source).FOnChange; + end else + inherited Assign(Source); +end; +{=====} + +procedure TVpHandOptions.SetClockFace(Value : TBitMap); +begin + if Assigned(Value) then + FClockFace.Assign(Value) + else begin + FClockFace.Free; + FClockFace := TBitmap.Create; + end; + FOnChange(self); +end; +{=====} + +procedure TVpHandOptions.SetDrawMarks(Value : Boolean); +begin + if Value <> FDrawMarks then begin + FDrawMarks := Value; + FOnChange(Self); + end; +end; +{=====} + +procedure TVpHandOptions.DoOnChange; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; +{=====} + +procedure TVpHandOptions.SetHourHandColor(Value : TColor); +begin + if Value <> FHourHandColor then begin + FHourHandColor := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetHourHandLength(Value : TVpPercent); +begin + if Value <> FHourHandLength then begin + FHourHandLength := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetHourHandWidth(Value : Integer); +begin + if (Value <> FHourHandWidth) and (Value > 0) then begin + FHourHandWidth := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetMinuteHandColor(Value : TColor); +begin + if Value <> FMinuteHandColor then begin + FMinuteHandColor := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetMinuteHandLength(Value : TVpPercent); +begin + if Value <> FMinuteHandLength then begin + FMinuteHandLength := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetMinuteHandWidth(Value : Integer); +begin + if (Value <> FMinuteHandWidth) and (Value > 0) then begin + FMinuteHandWidth := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetSecondHandColor(Value : TColor); +begin + if Value <> FSecondHandColor then begin + FSecondHandColor := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetSecondHandLength(Value : TVpPercent); +begin + if Value <> FSecondHandLength then begin + FSecondHandLength := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetSecondHandWidth(Value : Integer); +begin + if (Value <> FSecondHandWidth) and (Value > 0) then begin + FSecondHandWidth := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetShowSecondHand(Value : Boolean); +begin + if Value <> FShowSecondHand then begin + FShowSecondHand := Value; + DoOnChange; + end; +end; +{=====} + +procedure TVpHandOptions.SetSolidHands(Value : Boolean); +begin + if Value <> FSolidHands then begin + FSolidHands := Value; + DoOnChange; + end; +end; + +{===== TOvcCustomClock ===============================================} + +constructor TVpCustomClock.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + Width := 136; + Height := 136; + + FClockMode := cmClock; + + FTimerPool := TVpTimerPool.Create(self); + + FHandOptions := TVpHandOptions.Create; + FHandOptions.OnChange := ckHandOptionChange; + FHandOptions.HourHandColor := clBlack; + FHandOptions.HourHandLength := 60; + FHandOptions.HourHandWidth := 4; + FHandOptions.MinuteHandColor := clBlack; + FHandOptions.MinuteHandLength := 80; + FHandOptions.MinuteHandWidth := 3; + FHandOptions.SecondHandColor := clRed; + FHandOptions.SecondHandLength := 90; + FHandOptions.SecondHandWidth := 1; + FHandOptions.ShowSecondHand := True; + FHandOptions.FSolidHands := True; + + FDigitalOptions := TVpDigitalOptions.Create; + FDigitalOptions.FOnChange := ckDigitalOptionChange; + + ckDraw := TBitMap.Create; + ckDraw.Width := Width; + ckDraw.Height := Height; + + ckClockHandle := -1; +end; +{=====} + +destructor TVpCustomClock.Destroy; +begin + Active := False; + + FHandOptions.Free; + FHandOptions := nil; + FDigitalOptions.Free; + FDigitalOptions := nil; + + ckDraw.Free; + ckDraw := nil; + + inherited Destroy; +end; +{=====} + +function TVpCustomClock.ckConvertMsToDateTime(Value : LongInt) : TDateTime; +var + S, Days : LongInt; + Hour, Minute, Second : Word; +begin + S := Value div 1000; + Days := S div SecondsInDay; + S := S mod SecondsInDay; + Hour := S div SecondsInHour; + S := S mod SecondsInHour; + Minute := S div SecondsInMinute; + Second := S mod SecondsInMinute; + Result := EncodeTime(Hour, Minute, Second, 0) + Days; +end; +{=====} + +procedure TVpCustomClock.ckHandOptionChange(Sender : TObject); +begin + if FDisplayMode = dmAnalog then + Invalidate; +end; +{=====} + +procedure TVpCustomClock.ckDigitalOptionChange(Sender : TObject); +begin + if FDisplayMode = dmDigital then begin + ckLEDDisplay.Size := FDigitalOptions.Size; + ckLEDDisplay.BgColor := FDigitalOptions.BgColor; + ckLEDDisplay.OnColor := FDigitalOptions.OnColor ; + ckLEDDisplay.OffColor := FDigitalOptions.OffColor; + FMilitaryTime := FDigitalOptions.MilitaryTime; + if FDigitalOptions.ShowSeconds and FMilitaryTime then + ckLEDDisplay.Columns := 8 + else if FDigitalOptions.ShowSeconds and not FMilitaryTime then + ckLEDDisplay.Columns := 11 + else if not FDigitalOptions.ShowSeconds and FMilitaryTime then + ckLEDDisplay.Columns := 5 + else if not FDigitalOptions.ShowSeconds and not FMilitaryTime then + ckLEDDisplay.Columns := 8; + SizeDigitalDisplay; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SizeDigitalDisplay; +begin + Width := ckLEDDisplay.Width; + Height := ckLEDDisplay.Height; +end; +{=====} + +procedure TVpCustomClock.ckTimerEvent(Sender : TObject; Handle : Integer; + Interval : Cardinal; ElapsedTime : LongInt); +var + Hour, Minute, Second, MSecond : Word; + C, D : Integer; +begin + if FClockMode = cmClock then begin + {Clock} + DecodeTime(Now, Hour, Minute, Second, MSecond); + D := Minute + FMinuteOffset; + Minute := Abs(D mod 60); + C := Hour + FHourOffset + (D div 60); + if C > 23 then + Dec(C, 24); + if C < 0 then + Inc(C, 24); + Hour := C; + SetTime(EncodeTime(Hour, Minute, Second, MSecond)); + end else if FClockMode = cmTimer then begin + {Count Up Timer} + SetTime(ckConvertMsToDateTime(ElapsedTime)); + end else begin + {Countdown Timer} + if (FStartTime - ckConvertMsToDateTime(ElapsedTime) <= 0) then begin + SetTime(0); + Active := false; + DoOnCountdownDone; + end else + SetTime(FStartTime - ckConvertMsToDateTime(ElapsedTime)); + end; +end; +{=====} + +procedure TVpCustomClock.DoOnHourChange; +begin + if Assigned(FOnHourChange) then + FOnHourChange(Self); +end; +{=====} + +procedure TVpCustomClock.DoOnMinuteChange; +begin + if Assigned(FOnMinuteChange) then + FOnMinuteChange(Self); +end; +{=====} + +procedure TVpCustomClock.DoOnSecondChange; +begin + if Assigned(FOnSecondChange) then + FOnSecondChange(Self); +end; +{=====} + +procedure TVpCustomClock.DoOnCountdownDone; +begin + if Assigned (FOnCOuntdownDone) then + FOnCountdownDone(self); +end; +{=====} + +function TVpCustomClock.GetElapsedDays: Integer; +var + ClockDate : TDateTime; +begin + if ckClockHandle > -1 then begin + ClockDate := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]); + ckDays := Trunc(ClockDate); + end; + Result := ckDays; +end; +{=====} + +function TVpCustomClock.GetElapsedHours: Integer; +var + Hour : Word; + Min : Word; + Sec : Word; + MSec : Word; + TempTime : TDateTime; +begin + if ckClockHandle > -1 then begin + TempTime := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]); + DecodeTime(TempTime, Hour, Min, Sec, MSec); + ckHours := Hour + end; + Result := ckHours; +end; +{=====} + +function TVpCustomClock.GetElapsedMinutes: LongInt; +var + Hour : Word; + Min : Word; + Sec : Word; + MSec : Word; + TempTime : TDateTime; +begin + if ckClockHandle > -1 then begin + TempTime := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]); + DecodeTime(TempTime, Hour, Min, Sec, MSec); + ckMinutes := Min; + end; + Result := ckMinutes; +end; +{=====} + +function TVpCustomClock.GetElapsedSeconds : LongInt; +var + Hour : Word; + Min : Word; + Sec : Word; + MSec : Word; + TempTime : TDateTime; +begin + if ckClockHandle > -1 then begin + TempTime := ckConvertMsToDateTime(FTimerPool.ElapsedTime[ckClockHandle]); + DecodeTime(TempTime, Hour, Min, Sec, MSec); + ckSeconds := Sec; + end; + Result := ckSeconds; +end; +{=====} + +function TVpCustomClock.GetElapsedSecondsTotal : LongInt; +begin + if ckClockHandle > -1 then + ckTotalSeconds := FTimerPool.ElapsedTime[ckClockHandle] div 1000; + Result := ckTotalSeconds; +end; +{=====} + +procedure TVpCustomClock.Loaded; +var + HA : Boolean; +begin + inherited Loaded; + + ckHandOptionChange(self); + ckDigitalOptionChange(self); + + HA := FActive; + FActive := False; + SetActive(HA); +end; +{=====} + +procedure TVpCustomClock.Paint; +begin + case FDisplayMode of + dmDigital : PaintDigital; + dmAnalog : PaintAnalog; + end; +end; +{=====} + +procedure TVpCustomClock.PaintDigital; +begin + ckLEDDisplay.PaintSelf; +end; +{=====} + +procedure TVpCustomClock.PaintAnalog; +var + HalfWidth : Integer; + HalfHeight : Integer; + Lcv : Integer; + MarkX : Integer; + MarkY : Integer; + MarkAngle : Double; + ElRgn : HRgn; + R : TRect; + + procedure DrawTickMark(MarkX, MarkY : Integer; + LColor, MColor, RColor : TColor; + FiveMinute : Boolean); + begin + with ckDraw.Canvas do begin + Pixels[MarkX, MarkY] := MColor; + Pixels[MarkX-1, MarkY-1] := LColor; + Pixels[MarkX, MarkY-1] := LColor; + Pixels[MarkX-1, MarkY] := LColor; + + Pixels[MarkX+1, MarkY+1] := RColor; + Pixels[MarkX+1, MarkY] := RColor; + Pixels[MarkX, MarkY+1] := RColor; + + if (FiveMinute) then begin + Pixels[MarkX-1, MarkY+1] := LColor; + Pixels[MarkX+1, MarkY-1] := RColor; + end; + end; + end; + +begin + with ckDraw.Canvas do begin + Brush.Color := Color; + Pen.Color := FHandOptions.HourHandColor; + Pen.Width := 1; + FillRect(ClientRect); + + if not (FHandOptions. ClockFace.Empty) then begin + R := ClientRect; + if FHandOptions.DrawMarks then + InflateRect(R, -3, -3); + ElRgn := CreateEllipticRgn(R.Left, R.Top, R.Right, R.Bottom); + try + SelectClipRgn(ckDraw.Canvas.Handle, ElRgn); + StretchDraw(R, FHandOptions.ClockFace); + finally + DeleteObject(ElRgn); + end; + SelectClipRgn(ckDraw.Canvas.Handle, 0);{remove clipping region} + end; + + {draw marks} + if FHandOptions.DrawMarks then begin + with ClientRect do begin + HalfWidth := (Right - Left) shr 1; + HalfHeight := (Bottom - Top) shr 1; + end; + if HalfWidth < 1 then + HalfWidth := 1; + if HalfHeight < 1 then + HalfHeight := 1; + for Lcv := 0 to 59 do begin + MarkAngle := ckDToR * (((Round((Lcv / 60) * 360)) + 90) mod 360); + MarkX := Round(HalfWidth * (1 - (((100 - 2) / 100) * Cos(MarkAngle)))); + MarkY := Round(HalfHeight * (1 - (((100 - 2) / 100) * Sin(MarkAngle)))); + MoveTo(MarkX, MarkY); + + if Lcv mod 5 = 0 then + DrawTickMark(MarkX, MarkY, clBlue, clGray, clBlack, True) + else + DrawTickMark(MarkX, MarkY, clGray, clSilver, clWhite, False); + end; + end; + end; + + PaintHands(ckDraw.Canvas); + + Canvas.CopyMode := cmSrcCopy; + Canvas.CopyRect(ClientRect, ckDraw.Canvas, ClientRect); +end; +{=====} + +procedure TVpCustomClock.PaintHands(ACanvas : TCanvas); +type + HandType = (HourHand, MinuteHand, SecondHand); +var + X : Integer; + Hour : Word; + Minute : Word; + Second : Word; + MSecond : Word; + HalfWidth : Integer; + HalfHeight : Integer; + HandBase : Integer; + HandAngle : Double; + HourHandLen : Integer; + MinuteHandLen : Integer; + SecondHandLen : Integer; + + procedure RotatePoint(OldPoint : TPoint; var NewPoint : TPoint); + begin + OldPoint.X := OldPoint.X - HalfWidth; + OldPoint.Y := OldPoint.Y - HalfHeight; + NewPoint.X := Round(OldPoint.X * Cos(HandAngle-Pi/2) - OldPoint.Y * Sin(HandAngle-Pi/2)); + NewPoint.Y := Round(OldPoint.X * Sin(HandAngle-Pi/2) + OldPoint.Y * Cos(HandAngle-Pi/2)); + if (HalfHeight < HalfWidth) then + NewPoint.X := Round(NewPoint.X * (HalfWidth/HalfHeight)) + else + NewPoint.Y := Round(NewPoint.Y * (HalfHeight/HalfWidth)); + NewPoint.X := NewPoint.X + HalfWidth; + NewPoint.Y := NewPoint.Y + HalfHeight; + end; + + procedure DrawNewHand(PenColor : TColor; + Hand : HandType; + HandLength : Integer; + HipWidth : Integer); + const + MaxPoints = 7; + var + I : Integer; + Hip : Integer; + Points : array[1..MaxPoints] of TPoint; + HandPoints : array[1..MaxPoints] of TPoint; + + procedure ShadeHand; + Var + CPoints : array[1..3] of TPoint; + + procedure LoadPoints(Pt1, Pt2, Pt3 : Integer); + begin + CPoints[1] := HandPoints[Pt1]; + CPoints[2] := HandPoints[Pt2]; + CPoints[3] := HandPoints[Pt3]; + ACanvas.Polygon(CPoints); + end; + + begin + ACanvas.Brush.Color := clWhite; + case Hand of + HourHand : begin + case Hour of + 0..3, + 12..15 : begin + LoadPoints(2,3,4); + LoadPoints(1,2,4); + end; + 4..5, + 16..17 : begin + LoadPoints(1,2,4); + LoadPoints(1,2,6); + end; + 6..9, + 18..21 : begin + LoadPoints(1,2,6); + LoadPoints(2,3,6); + end; + 10..11, + 22..23 : begin + LoadPoints(2,3,4); + LoadPoints(2,3,6); + end; + end; + end; + MinuteHand: begin + case Minute of + 0..15 : begin + LoadPoints(2,3,4); + LoadPoints(1,2,4); + end; + 16..25: begin + LoadPoints(1,2,4); + LoadPoints(1,2,6); + end; + 26..50: begin + LoadPoints(1,2,6); + LoadPoints(2,3,6); + end; + 51..59: begin + LoadPoints(2,3,4); + LoadPoints(2,3,6); + end; + end; + end; + SecondHand: begin + case Second of + 0..15 : begin + LoadPoints(2,3,4); + LoadPoints(1,2,4); + end; + 16..25: begin + LoadPoints(1,2,4); + LoadPoints(1,2,6); + end; + 26..50: begin + LoadPoints(1,2,6); + LoadPoints(2,3,6); + end; + 51..59: begin + LoadPoints(2,3,4); + LoadPoints(2,3,6); + end; + end; + end; + end; + ACanvas.Brush.Color := Color; + end; + + begin + {where to put Crossbar} + if HipWidth > 1 then + Hip := Trunc(HandLength * 0.25) + else + Hip := 0; + + {start at Center Point} + Points[1].X := HalfWidth; + Points[1].Y := HalfHeight; + + {up Center to Hip} + Points[2].X := HalfWidth; + Points[2].Y := HalfHeight-Hip; + + {up Center to Top} + Points[3].X := HalfWidth; + Points[3].Y := HalfHeight-HandLength; + + {angle Left} + Points[4].X := HalfWidth-HipWidth; + Points[4].Y := HalfHeight - Hip; + + {start at Center Point} + Points[5].X := HalfWidth; + Points[5].Y := HalfHeight; + + {angle Left} + Points[6].X := HalfWidth+HipWidth; + Points[6].Y := HalfHeight - Hip; + + {up Center to Top} + Points[7].X := HalfWidth; + Points[7].Y := HalfHeight-HandLength; + + for I :=1 to 7 do + RotatePoint(Points[I], HandPoints[I]); + + ACanvas.Pen.Width := 1; + ACanvas.Pen.Color := PenColor; + if FHandOptions.SolidHands then + ACanvas.Brush.Color := PenColor + else + ACanvas.Brush.Color := Color; + + ACanvas.MoveTo(HalfWidth, HalfHeight); + ACanvas.Polygon(HandPoints); + + if not FHandOptions.SolidHands then + ShadeHand; + end; + +begin + DecodeTime(FTime, Hour, Minute, Second, MSecond); + + HalfWidth := (ClientRect.Right - ClientRect.Left) shr 1; + HalfHeight := (ClientRect.Bottom - ClientRect.Top) shr 1; + if HalfWidth < 1 then + HalfWidth := 1; + if HalfHeight < 1 then + HalfHeight := 1; + + {based on the Height or Width of the Clock, set the Hand Lengths} + HandBase := Min(HalfWidth, HalfHeight); + HourHandLen := Trunc(HandBase * FHandOptions.HourHandLength / 100); + MinuteHandLen := Trunc(HandBase * FHandOptions.MinuteHandLength / 100); + SecondHandLen := Trunc(HandBase * FHandOptions.SecondHandLength / 100); + + HandAngle := ckDToR * (((Round((((Hour * 5) + (Minute div 12)) / 60) * 360)) + 90) mod 360); + DrawNewHand(FHandOptions.HourHandColor, HourHand, HourHandLen, FHandOptions.HourHandWidth); + + HandAngle := ckDToR * (((Round((Minute / 60) * 360)) + 90) mod 360); + DrawNewHand(FHandOptions.MinuteHandColor, MinuteHand, MinuteHandLen, FHandOptions.MinuteHandWidth); + + if (FHandOptions.ShowSecondHand) then begin + HandAngle := ckDToR * (((Round((Second / 60) * 360)) + 90) mod 360); + DrawNewHand(FHandOptions.SecondHandColor, SecondHand, SecondHandLen, FHandOptions.SecondHandWidth); + end; + + if FHandOptions.ShowSecondHand then + ACanvas.Brush.Color := FHandOptions.SecondHandColor + else + ACanvas.Brush.Color := FHandOptions.MinuteHandColor; + ACanvas.Pen.Color := clBlack; + X := Round(HandBase * 0.04) + 1; + ACanvas.Ellipse(HalfWidth-X, HalfHeight-X, HalfWidth+X, HalfHeight+X); +end; +{=====} + +procedure TVpCustomClock.SetActive(Value : Boolean); +begin + if csLoading in ComponentState then begin + FActive := Value; + Exit; + end; + + if Value <> FActive then begin + FActive := Value; + if FActive then begin + if FDisplayMode = dmDigital then + FMilitaryTime := DigitalOptions.MilitaryTime; + if ckClockHandle = -1 then + ckClockHandle := FTimerPool.Add(ckTimerEvent, ckInterval); + if FClockMode = cmClock then + FTime := Now + else if FClockMode = cmCountdownTimer then + FStartTime := EncodeTime(FHourOffset, FMinuteOffset, + FSecondOffset, 0) + else + FTime := 0; + end else if ckClockHandle > -1 then begin + FTimerPool.Remove(ckClockHandle); + ckClockHandle := -1; + end; + + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SetBounds(ALeft, ATop, AWidth, AHeight : Integer); +begin + inherited SetBounds(ALeft, ATop, AWidth, AHeight); + + if Assigned(ckDraw) then begin + ckDraw.Width := AWidth; + ckDraw.Height := AHeight; + end; + + Invalidate; +end; +{=====} + +procedure TVpCustomClock.SetClockMode(Value : TVpClockMode); +begin + if Value <> FClockMode then begin + if FActive then Active := false; + FClockMode := Value; + if FClockMode = cmClock then + DigitalOptions.MilitaryTime := false + else + DigitalOptions.MilitaryTime := true; + + if FClockMode <> cmCountdownTimer then + FTime := 0 + else + SetTime(EncodeTime(FHourOffset, FMinuteOffset, 0, 0)); + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SetDisplayMode(Value: TVpClockDisplayMode); +begin + if Value <> FDisplayMode then begin + FDisplayMode := Value; + case FDisplayMode of + + dmDigital: begin + {Save the analog height and width} + ckAnalogHeight := Height; + ckAnalogWidth := Width; + + {Create and initialize the LED display} + ckLEDDisplay := TVpLEDClockDisplay.Create(self); + ckLEDDisplay.Parent := self; + ckLEDDisplay.OnColor := FDigitalOptions.OnColor; + ckLEDDisplay.OffColor := FDigitalOptions.OffColor; + ckLEDDisplay.BgColor := FDigitalOptions.BgColor; + ckLEDDisplay.Size := FDigitalOptions.Size; + if FDigitalOptions.ShowSeconds then begin + ckLEDDisplay.Columns := 8; + ckLEDDisplay.Caption := '00:00:00'; + end else begin + ckLEDDisplay.Columns := 5; + ckLEDDisplay.Caption := '00:00'; + end; + + {Set the height and width of the control} + SizeDigitalDisplay; + + {Blank the control} + Canvas.Brush.Color := FDigitalOptions.BgColor; + Canvas.FillRect(GetClientRect); + + {Initialize the LED display} + if FActive then begin + if FClockMode = cmClock then + {Clock} + SetTime(Now) + else if FClockMode = cmTimer then + {Timer} + SetTime(ckConvertMsToDateTime(FElapsedSeconds * 1000)) + else + {Countdown Timer} + if (FStartTime - ckConvertMsToDateTime( + FElapsedSeconds * 1000) <= 0) then + begin + SetTime(0); + Active := false; + DoOnCountdownDone; + end else + SetTime(FStartTime - ckConvertMsToDateTime(FElapsedSeconds * 1000)); + end; + + end; + + dmAnalog: begin + {Destroy the LED Display} + if ckLEDDisplay <> nil then begin + ckLEDDisplay.Free; + ckLEDDisplay := nil; + end; + + {Adjust the height and width} + if (ckAnalogHeight < ckAnalogWidth) then begin + {If the analog clock is shorted than it is wide then load default } + {height and width } + Height := 136; + Width := 136; + end else begin + {Otherwise reload saved values} + Height := ckAnalogHeight; + Width := ckAnalogWidth; + end; + + {Blank the canvas} + with ckDraw.Canvas do begin + Brush.Color := Color; + FillRect(ClientRect); + Canvas.CopyMode := cmSrcCopy; + Canvas.CopyRect(ClientRect, ckDraw.Canvas, ClientRect); + end; + end; + end; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SetTime(Value : TDateTime); +var + Hour1, Minute1, Second1 : Word; + Hour2, Minute2, Second2 : Word; + MSecond : Word; + TimeStr: string; +begin + DecodeTime(Value, Hour1, Minute1, Second1, MSecond); + DecodeTime(FTime, Hour2, Minute2, Second2, MSecond); + if (Hour1 <> Hour2) or (Minute1 <> Minute2) or (Second1 <> Second2) then begin + FTime := Value; + + if (Hour1 <> ckOldHour) then + DoOnHourChange; + ckOldHour := Hour1; + if (Minute1 <> ckOldMinute) then + DoOnMinuteChange; + ckOldMinute := Minute1; + if (Second1 <> ckOldSecond) then + DoOnSecondChange; + ckOldSecond := Second1; + + if DisplayMode = dmDigital then begin + if FDigitalOptions.ShowSeconds and FMilitaryTime then + TimeStr := FormatDateTime('hh:mm:ss', FTime) + else if FDigitalOptions.ShowSeconds and not FMilitaryTime then + TimeStr := FormatDateTime('hh:mm:ss am/pm', FTime) + else if not FDigitalOptions.ShowSeconds and FMilitaryTime then + TimeStr := FormatDateTime('hh:mm', FTime) + else if not FDigitalOptions.ShowSeconds and not FMilitaryTime then + TimeStr := FormatDateTime('hh:mm am/pm', FTime); + ckLEDDisplay.Caption := TimeStr; + end; + + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SetMinuteOffset(Value : Integer); +begin + if (Value <> FMinuteOffset) and (Abs(Value) <= 60) then begin + FMinuteOffset := Value; + if FClockMode = cmCountdownTimer then + SetTime(EncodeTime(FHourOffset, FMinuteOffset, FSecondOffset, 0)); + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SetHourOffset(Value : Integer); +begin + if (Value <> FHourOffset) and (Abs(Value) <= 24) then begin + FHourOffset := Value; + if FClockMode = cmCountdownTimer then + SetTime(EncodeTime(FHourOffset, FMinuteOffset, FSecondOffset, 0)); + Invalidate; + end; +end; +{=====} + +procedure TVpCustomClock.SetSecondOffset(Value : Integer); +begin + if (Value <> FSecondOffset) and (Abs(Value) <= 59) then begin + FSecondOffset := Value; + if FClockMode = cmCountdownTimer then + SetTime(EncodeTime(FHourOffset, FMinuteOffset, FSecondOffset, 0)); + Invalidate; + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpCustomClock.WMResize(var Msg: TWMSize); +{$ELSE} +procedure TVpCustomClock.WMResize(var Msg: TLMSize); +{$ENDIF} +begin + if DisplayMode = dmDigital then begin + Width := ckLEDDisplay.Width; + Height := ckLEDDisplay.Height; + Invalidate; + end; +end; + +{$IFNDEF LCL} +procedure TVpCustomClock.WMEraseBkgnd(var Msg : TWMEraseBkGnd); +{$ELSE} +procedure TVpCustomClock.WMEraseBkgnd(var Msg : TLMEraseBkGnd); +{$ENDIF} +begin + Msg.Result := 1; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpCustomClock.WMGetDlgCode(var Msg : TWMGetDlgCode); +begin + {tell windows we are a static control to avoid receiving the focus} + Msg.Result := DLGC_STATIC; +end; +{$ENDIF} +{=====} + +end. diff --git a/components/tvplanit/source/vpconst.pas b/components/tvplanit/source/vpconst.pas new file mode 100644 index 000000000..578272fcd --- /dev/null +++ b/components/tvplanit/source/vpconst.pas @@ -0,0 +1,256 @@ +{*********************************************************} +{* VPCONST.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpConst; + {-Versioning defines and methods} + +interface + +uses + {$IFDEF LCL} + Controls,LCLType,LCLProc, + {$ELSE} + Windows, + {$ENDIF} + Forms, StdCtrls; + +const + BuildTime = '09/13/2002 09:25 AM'; + VpVersionStr = 'v1.03'; {Visual PlanIt library version} + VpProductName = 'Visual PlanIt'; + + BorderStyles : array[TBorderStyle] of LongInt = + (0, WS_BORDER); + ScrollBarStyles : array [TScrollStyle] of LongInt = + (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL{$IFDEF LCL},0,0,0{$ENDIF}); + + SecondsInDay = 86400; { Number of seconds in a day } + SecondsInHour = 3600; { Number of seconds in an hour } + SecondsInMinute = 60; { Number of seconds in a minute } + HoursInDay = 24; { Number of hours in a day } + MinutesInHour = 60; { Number of minutes in an hour } + MinutesInDay = 1440; { Number of minutes in a day } + MaxDateLen = 40; { maximum length of date picture strings } + MaxMonthName = 15; { maximum length for month names } + MaxDayName = 15; { maximum length for day names } + TextMargin = 5; { amount of space around text } + MaxVisibleEvents = 1024; { maximum number of events that can be } + { visible at any one time } + MaxEventDepth = 50; { the maximum number of side by side } + { events, which can be displayed in the } + { DayView component. } + ClickDelay : Integer = 500; { the number of milliseconds of delay for } + { each event click in the TimeGrid } + calDefHeight = 140; { popup calendar default height } + calDefWidth = 200; { popup calendar default width } + ExtraBarWidth = 2; { The extra, draggable area on either side } + { of the Contact Grid's horizontal bars. } + + ResourceTableName = 'Resources'; + TasksTableName = 'Tasks'; + EventsTableName = 'Events'; + ContactsTableName = 'Contacts'; + RecordIDTableName = 'RecordIDS'; + + {virtual key constants not already defined} + VK_NONE = 0; + VK_ALT = VK_MENU; + VK_A = Ord('A'); VK_B = Ord('B'); VK_C = Ord('C'); VK_D = Ord('D'); + VK_E = Ord('E'); VK_F = Ord('F'); VK_G = Ord('G'); VK_H = Ord('H'); + VK_I = Ord('I'); VK_J = Ord('J'); VK_K = Ord('K'); VK_L = Ord('L'); + VK_M = Ord('M'); VK_N = Ord('N'); VK_O = Ord('O'); VK_P = Ord('P'); + VK_Q = Ord('Q'); VK_R = Ord('R'); VK_S = Ord('S'); VK_T = Ord('T'); + VK_U = Ord('U'); VK_V = Ord('V'); VK_W = Ord('W'); VK_X = Ord('X'); + VK_Y = Ord('Y'); VK_Z = Ord('Z'); VK_0 = Ord('0'); VK_1 = Ord('1'); + VK_2 = Ord('2'); VK_3 = Ord('3'); VK_4 = Ord('4'); VK_5 = Ord('5'); + VK_6 = Ord('6'); VK_7 = Ord('7'); VK_8 = Ord('8'); VK_9 = Ord('9'); + +{------------------- Windows messages -----------------------} + {Not a message code. Value of the first of the message codes used} + Vp_FIRST = $7F00; {***} + {sent to force a call to RecreateWnd} + Vp_RECREATEWND = Vp_FIRST + 1; + {sent to perform after-enter notification} + Vp_AFTERENTER = Vp_FIRST + 2; + {sent to perform after-exit notification} + Vp_AFTEREXIT = Vp_FIRST + 3; + {sent by a collection to its property editor when a property is changed} + Vp_PROPCHANGE = Vp_FIRST + 4; + + +{*** Error message codes ***} + oeFirst = 256; + +{ XML support } + + {The following constants are the tokens needed to parse an XML + document. The tokens are stored in UCS-4 format to reduce the + number of conversions needed by the filter.} + Xpc_BracketAngleLeft : array[0..0] of Longint = (60); {<} + Xpc_BracketAngleRight : array[0..0] of Longint = (62); {>} + Xpc_BracketSquareLeft : array[0..0] of Longint = (91); {[} + Xpc_BracketSquareRight : array[0..0] of Longint = (93); {]} + Xpc_CDATAStart : + array[0..5] of Longint = (67, 68, 65, 84, 65, 91); {CDATA[} + Xpc_CharacterRef : array[0..0] of Longint = (35); {#} + Xpc_CharacterRefHex : array[0..0] of Longint = (120); {x} + Xpc_CommentEnd : array[0..2] of Longint = (45, 45, 62); {-->} + Xpc_CommentStart : array[0..3] of Longint = (60, 33, 45, 45); { + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas new file mode 100644 index 000000000..fe3e662d5 --- /dev/null +++ b/components/tvplanit/source/vpmisc.pas @@ -0,0 +1,575 @@ +{*********************************************************} +{* VPMISC.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +unit VpMisc; + {-Miscellaneous functions and procedures} + +interface + +{$I vp.inc} + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, Consts, + {$ENDIF} + Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Messages, + SysUtils, VpBase, VpData, VpConst; + +type + TDayList = array[1..12] of Word; + + + TVpDayType = (dtSunday, dtMonday, dtTuesday, dtWednesday, dtThursday, + dtFriday, dtSaturday); + + TVpDateFormat = (dfShort, dfLong); + + TVpDayNameWidth = Integer; + +const + MonthDays: array [Boolean] of TDayList = + ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), + (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); + +function DaysInMonth(Year, Month : Integer) : Integer; + {-return the number of days in the specified month of a given year} +function DefaultEpoch : Integer; + {-return the current century} +function GetLeftButton : Byte; +procedure GetRGB(Clr : TColor; var IR, IG, IB : Byte); +function IsLeapYear(Year : Integer) : Boolean; +function GetStartOfWeek(Date: TDateTime; StartOn: TVpDayType): TDateTime; + +procedure StripString(var Str: string); + { strips non-alphanumeric characters from the beginning and end of the string} +function AssembleName(Contact: TVpContact): string; + { returns an assembled name string } +procedure ParseName(Contact: TVpContact; const Value: string); + { parses the name into it's elements and updates the contact } +procedure ParseCSZ(Str: string; var City, State, Zip: string); + { parses the string and returns the city, state and zip parameters } +function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP; + {-load and return the handle to bitmap resource} +function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR; + {-load and return the handle to cursor resource} +function HeightOf(const R : TRect) : Integer; + {- return the height of the TRect} +function WidthOf(const R : TRect) : Integer; + {- return the width of the TRect} +function GetDisplayString(Canvas : TCanvas; const S : string; + MinChars, MaxWidth : Integer) : string; + {-given a string, a minimum number of chars to display, and a max width, } + { find the string that can be displayed in that width - add ellipsis to } + { the end if necessary and possible } +procedure DrawBevelRect(const Canvas: TCanvas; R: TRect; + Shadow, Highlight: TColor); + {-draws a bevel in the specified TRect, using the specified colors } +function PointInRect(Point: TPoint; Rect: TRect): Boolean; + {-determines if the specified point resides inside the specified TRect } + +function GetAlarmAdvanceTime(Advance: Integer; + AdvanceType: TVpAlarmAdvType): TDateTime; + +{$IFNDEF Delphi6} + +function MonthOfTheYear (TheDate : TDateTime) : Word; + +procedure IncAMonth (var Year, Month, Day : Word; NumMonths : Integer); + +function IncMonth(const TheDate : TDateTime; + NumberOfMonths : Integer) : TDateTime; + +function IncYear (TheDate : TDateTime; NumYears : Integer) : TDateTime; +{$ENDIF} + +function GetJulianDate(Date: TDateTime): Word; + +function HourToLine (const Value : TVpHours; + const Granularity : TVpGranularity) : Integer; + +function GetStartLine (StartTime: TDateTime; + Granularity: TVpGranularity): Integer; + +function GetEndLine (EndTime: TDateTime; + Granularity: TVpGranularity): Integer; + +function TimeInRange(Time, StartTime, EndTime: TDateTime; + Inclusive: Boolean): Boolean; + +function LineToStartTime(Line: Integer; Granularity: TVpGranularity): TDateTime; + +function GetLineDuration(Granularity: TVpGranularity): Double; + +implementation + +uses + VpException, VpSR; + +procedure StripString(var Str: string); +begin + if Length (Str) < 1 then + Exit; + while not (Str[1] in ['A'..'Z', 'a'..'z', '0'..'9']) do + delete(Str, 1, 1); + while not (Str[Length(Str)] in ['A'..'Z', 'a'..'z', '0'..'9']) do + delete(Str, Length(Str), 1); +end; +{=====} + +function AssembleName(Contact: TVpContact): string; +begin + result := Contact.LastName; + if Assigned (Contact.Owner) then begin + if Contact.Owner.ContactSort = csFirstLast then begin + if Contact.FirstName <> '' then + result := Contact.FirstName + ' ' + Result; + end else begin + if Contact.FirstName <> '' then + result := result + ', ' + Contact.FirstName; + end; + end else begin + if Contact.FirstName <> '' then + result := result + ', ' + Contact.FirstName; + end; +end; +{=====} + +procedure ParseName(Contact: TVpContact; const Value: string); +var + name, ln, fn: string; +begin + name := Value; + + { strip spaces from the beginning and end of the name string } + StripString(name); + + { parse string } + if pos(',', name) > 0 then begin + { lastname, firstname } + ln := copy(name, 1, pos(',', name) -1); + fn := copy(name, pos(',', name), length(name)); + end else begin + { firstname lastname } + ln := copy(name, LastDelimiter(' ', name), length(name)); + fn := copy(name, 1, LastDelimiter(' ', name) - 1); + end; + + { strip fn and ln strings } + StripString(fn); + StripString(ln); + + { assign the strings to the proper contact fields } + Contact.LastName := ln; + Contact.FirstName := fn; +end; +{=====} + +procedure ParseCSZ(Str: string; var City, State, Zip: string); +var + num: integer; +begin + StripString(Str); + + if Pos(',', Str) > 0 then begin + City := copy (Str, 1, pos(',', str) - 1); + delete(str, 1, pos(',', str)); + end; + + num := LastDelimiter(' ', Str); + + if (num > 0) + and (num < Length(Str)) + and (Str[num + 1] in ['0'..'9']) then begin + Zip := copy(Str, num, length(Str)); + Delete(Str, num, length(str)); + end; + + State := Str; + + StripString(City); + StripString(State); + StripString(Zip); +end; +{=====} + +function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP; +begin +//TODO: Result := LoadBitmap(FindClassHInstance(TVpCustomControl), lpBitmapName); +end; +{=====} + +function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR; +begin +//TODO: Result := LoadCursor(FindClassHInstance(TVpCustomControl), lpCursorName); +end; + +function WidthOf(const R : TRect) : Integer; +begin + Result := R.Right - R.Left; +end; +{=====} + +function HeightOf(const R : TRect) : Integer; +begin + Result := R.Bottom - R.Top; +end; +{=====} + +function GetDisplayString(Canvas : TCanvas; const S : string; + MinChars, MaxWidth : Integer) : string; +var + iDots, EllipsisWidth, Extent, Len, Width : Integer; + ShowEllipsis : Boolean; +begin + {be sure that the Canvas Font is set before entering this routine} + EllipsisWidth := Canvas.TextWidth('...'); + Len := Length(S); + Result := S; + Extent := Canvas.TextWidth(Result); + ShowEllipsis := False; + Width := MaxWidth; + while (Extent > Width) do begin + ShowEllipsis := True; + Width := MaxWidth - EllipsisWidth; + if Len > MinChars then begin + Delete(Result, Len, 1); + dec(Len); + end else + break; + Extent := Canvas.TextWidth(Result); + end; + if ShowEllipsis then begin + Result := Result + '...'; + inc(Len, 3); + Extent := Canvas.TextWidth(Result); + iDots := 3; + while (iDots > 0) and (Extent > MaxWidth) do begin + Delete(Result, Len, 1); + Dec(Len); + Extent := Canvas.TextWidth(Result); + Dec(iDots); + end; + end; +end; +{=====} + +procedure DrawBevelRect(const Canvas: TCanvas; R: TRect; + Shadow, Highlight: TColor); +begin + with Canvas do + begin + Pen.Color := Shadow; + PolyLine([Point(R.Left, R.Bottom), Point(R.Left, R.Top), + Point(R.Right, R.Top)]); + Pen.Color := Highlight; + PolyLine([Point(R.Right, R.Top), Point(R.Right, R.Bottom), + Point(R.Left, R.Bottom)]); + end; +end; +{=====} + +function PointInRect(Point: TPoint; Rect: TRect): Boolean; +begin + result := (Point.X >= Rect.Left) and (Point.X <= Rect.Right) + and (Point.Y >= Rect.Top) and (Point.Y <= Rect.Bottom); +end; +{=====} + +function DaysInMonth(Year, Month : Integer) : Integer; +begin + if (Year < 100) then + raise EVpDateException.Create(RSInvalidYear + ' "' + IntToStr(Year) + '"'); + case Month of + 1, 3, 5, 7, 8, 10, 12 : Result := 31; + 4, 6, 9, 11 : Result := 30; + 2 : Result := 28+Ord(IsLeapYear(Year)); + else + Result := 0; + end; +end; +{=====} + +function DefaultEpoch : Integer; +var + ThisYear : Word; + ThisMonth : Word; + ThisDay : Word; +begin + DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay); + Result := (ThisYear div 100) * 100; +end; +{=====} + +function GetLeftButton : Byte; +const + RLButton : array[Boolean] of Word = (VK_LBUTTON, VK_RBUTTON); +begin +//TODO: Result := RLButton[GetSystemMetrics(SM_SWAPBUTTON) <> 0]; +end; +{=====} + +procedure GetRGB(Clr : TColor; var IR, IG, IB : Byte); +begin + IR := GetRValue(Clr); + IG := GetGValue(Clr); + IB := GetBValue(Clr); +end; +{=====} + +function IsLeapYear(Year : Integer) : Boolean; +begin + Result := (Year mod 4 = 0) and (Year mod 4000 <> 0) and + ((Year mod 100 <> 0) or (Year mod 400 = 0)); +end; +{=====} + +function GetStartOfWeek(Date: TDateTime; StartOn: TVpDayType): TDateTime; +begin + result := Date; + case StartOn of + dtSunday: result := Date - (DayOfWeek(Date) - 1); + dtMonday: result := Date - (DayOfWeek(Date) - 2); + dtTuesday: result := Date - (DayOfWeek(Date) - 3); + dtWednesday: result := Date - (DayOfWeek(Date) - 4); + dtThursday: result := Date - (DayOfWeek(Date) - 5); + dtFriday: result := Date - (DayOfWeek(Date) - 6); + dtSaturday: result := Date - (DayOfWeek(Date) - 7); + end; +end; +{=====} + + + +{$IFNDEF Delphi6} +{=====} + +function MonthOfTheYear (TheDate : TDateTime) : Word; +var + Year, Day: Word; +begin + DecodeDate (TheDate, Year, Result, Day); +end; +{=====} + +procedure IncAMonth (var Year, Month, Day : Word; NumMonths : Integer); +type + PMonthDayTable = ^TMonthDayTable; + TMonthDayTable = array[1..12] of Word; + +const + MonthDays: array [Boolean] of TMonthDayTable = + ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), + (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); +var + DayTable: PDayTable; + Sign: Integer; + +begin + if NumMonths >= 0 then + Sign := 1 + else + Sign := -1; + Year := Year + (NumMonths div 12); + NumMonths := NumMonths mod 12; + Inc (Month, NumMonths); + if Word (Month-1) > 11 then + begin + Inc (Year, Sign); + Inc (Month, -12 * Sign); + end; + DayTable := @MonthDays[IsLeapYear (Year)]; + if Day > DayTable^[Month] then + Day := DayTable^[Month]; +end; +{=====} + +function IncMonth(const TheDate : TDateTime; NumberOfMonths : Integer) : TDateTime; +var + Year, Month, Day : Word; +begin + DecodeDate (TheDate, Year, Month, Day); + IncAMonth (Year, Month, Day, NumberOfMonths); + Result := EncodeDate (Year, Month, Day); +end; +{=====} + +function IncYear (TheDate : TDateTime; NumYears : Integer) : TDateTime; +begin + Result := IncMonth (TheDate, NumYears * 12); +end; +{=====} +{$ENDIF} + +function GetJulianDate(Date: TDateTime): Word; +var + y, m, d, I: word; + Julian: Word; +begin + Julian := 0; + DecodeDate(Date, y, m, d); + + { Inc Julian by the number of days in each of the elapsed months } + for I := 1 to M do + Inc(Julian, DaysInMonth(Y, I)); + + { add in the elapsed days from this month } + Julian := Julian + D; + + { return the value } + result := Julian; +end; +{=====} + +function HourToLine (const Value : TVpHours; + const Granularity : TVpGranularity) : Integer; +begin + case Granularity of + gr60Min : Result := Ord (Value); + gr30Min : Result := Ord (Value) * 2; + gr20Min : Result := Ord (Value) * 3; + gr15Min : Result := Ord (Value) * 4; + gr10Min : Result := Ord (Value) * 6; + gr06Min : Result := Ord (Value) * 10; + gr05Min : Result := Ord (Value) * 12; + else + Result := Ord (Value) * 2; { Default to 30 minutes } + end; +end; +{=====} + +function GetStartLine (StartTime: TDateTime; + Granularity: TVpGranularity): Integer; +var + LineDuration : Double; { the percentage of a day covered by each line } + Time : Double; +begin + { remove the date part, and add one minute to the time } + Time := StartTime - trunc(StartTime) + (1 / MinutesInDay); + + case Granularity of + gr60Min : LineDuration := 60 / MinutesInDay; + gr30Min : LineDuration := 30 / MinutesInDay; + gr20Min : LineDuration := 20 / MinutesInDay; + gr15Min : LineDuration := 15 / MinutesInDay; + gr10Min : LineDuration := 10 / MinutesInDay; + gr06Min : LineDuration := 6 / MinutesInDay; + gr05Min : LineDuration := 5 / MinutesInDay; + else + LineDuration := 30 / MinutesInDay; + end; + + result := trunc(Time / LineDuration); +end; +{=====} + +function GetEndLine (EndTime: TDateTime; + Granularity: TVpGranularity): Integer; +var + LineDuration : Double; { the percentage of a day covered by each line } + Time : Double; +begin + { remove the date part, and subtract one minute from the time } + Time := EndTime - trunc(EndTime) - (1 / MinutesInDay); + + case Granularity of + gr60Min : LineDuration := 60 / MinutesInDay; + gr30Min : LineDuration := 30 / MinutesInDay; + gr20Min : LineDuration := 20 / MinutesInDay; + gr15Min : LineDuration := 15 / MinutesInDay; + gr10Min : LineDuration := 10 / MinutesInDay; + gr06Min : LineDuration := 6 / MinutesInDay; + gr05Min : LineDuration := 5 / MinutesInDay; + else + LineDuration := 30 / MinutesInDay; + end; + + result := trunc(Time / LineDuration); +end; +{=====} + +function GetAlarmAdvanceTime(Advance: Integer; + AdvanceType: TVpAlarmAdvType): TDateTime; +begin + result := 0.0; + case AdvanceType of + atMinutes : result := Advance / MinutesInDay; + atHours : result := (Advance * 60) / MinutesInDay; + atDays : result := Advance; + end; +end; +{=====} + +function TimeInRange(Time, StartTime, EndTime: TDateTime; + Inclusive: Boolean): Boolean; +begin + if Inclusive then + result := (Time >= StartTime) and (Time <= EndTime) + else + result := (Time > StartTime) and (Time < EndTime); +end; +{=====} + +function LineToStartTime(Line: Integer; Granularity: TVpGranularity): TDateTime; +begin + case Granularity of + gr60Min : result := (Line * 24) / MinutesInDay; + gr30Min : result := (Line * 30) / MinutesInDay; + gr20Min : result := (Line * 20) / MinutesInDay; + gr15Min : result := (Line * 15) / MinutesInDay; + gr10Min : result := (Line * 10) / MinutesInDay; + gr06Min : result := (Line * 6) / MinutesInDay; + gr05Min : result := (Line * 5) / MinutesInDay; + else + result := (Line * 30) / MinutesInDay; + end; + {chop off the date portion} + result := result - trunc(Result); +end; +{=====} + +function GetLineDuration(Granularity: TVpGranularity): Double; +begin + case Granularity of + gr60Min : result := 24 / MinutesInDay; + gr30Min : result := 30 / MinutesInDay; + gr20Min : result := 20 / MinutesInDay; + gr15Min : result := 15 / MinutesInDay; + gr10Min : result := 10 / MinutesInDay; + gr06Min : result := 6 / MinutesInDay; + gr05Min : result := 5 / MinutesInDay; + else + result := 30 / MinutesInDay; + end; + { chop off the date portion } + result := result - trunc(result); +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpmonthview.pas b/components/tvplanit/source/vpmonthview.pas new file mode 100644 index 000000000..d27a30fb1 --- /dev/null +++ b/components/tvplanit/source/vpmonthview.pas @@ -0,0 +1,1695 @@ +{*********************************************************} +{* VPMONTHVIEW.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpMonthView; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, + VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus; + +type + TVpMonthdayRec = packed record + Rec : TRect; + Date : TDateTime; + OffDay : Boolean; + end; + +type + TVpMonthdayArray = array of TVpMonthdayRec; + + { Forward Declarations } + TVpMonthView = class; + + TVpMVDayNameStyle = (dsLong, dsShort, dsLetter); + + TVpOnEventClick = + procedure(Sender: TObject; Event: TVpEvent) of object; + + TVpDayHeadAttr = class(TPersistent) + protected{private} + FMonthView: TVpMonthView; + FFont: TFont; + FColor: TColor; + procedure SetColor (Value: TColor); + procedure SetFont (Value: TFont); + public + constructor Create(AOwner: TVpMonthView); + destructor Destroy; override; + property MonthView: TVpMonthView read FMonthView; + published + property Color: TColor read FColor write SetColor; + property Font: TFont read FFont write SetFont; + end; + + TVpMonthView = class(TVpLinkableControl) + protected{ private } + FKBNavigate : Boolean; + FColumnWidth : Integer; + FColor : TColor; + FLineColor : TColor; + FLineCount : Integer; + FVisibleLines : Integer; + FDayNameStyle : TVpMVDayNameStyle; + FOffDayColor : TColor; + FSelectedDayColor : TColor; + FWeekStartsOn : TVpDayType; + FShowEvents : Boolean; + FEventDayStyle : TFontStyles; + FDateLabelFormat : string; + FShowEventTime : Boolean; + FTopLine : Integer; + FDayHeadAttributes : TVpDayHeadAttr; + FDayNumberFont : TFont; + FEventFont : TFont; + FTimeFormat : TVpTimeFormat; + FDrawingStyle : TVpDrawingStyle; + FDate : TDateTime; + FDefaultPopup : TPopupMenu; + FRightClickChangeDate : Boolean; + { event variables } + FOwnerDrawCells : TVpOwnerDrawDayEvent; + FOnEventClick : TVpOnEventClick; + FOnEventDblClick : TVpOnEventClick; + { internal variables } + mvDayNumberHeight : Integer; + mvEventTextHeight : Integer; + mvLoaded : Boolean; + mvInLinkHandler : Boolean; + mvRowHeight : Integer; + mvLineHeight : Integer; + mvColWidth : Integer; + mvDayHeadHeight : Integer; + mvSpinButtons : TUpDown; + mvEventArray : TVpEventArray; + mvMonthDayArray : TVpMonthdayArray; + mvActiveEvent : TVpEvent; + mvActiveEventRec : TRect; + mvEventList : TList; + mvCreatingEditor : Boolean; + mvPainting : Boolean; + mvVScrollDelta : Integer; + mvHotPoint : TPoint; + mvVisibleEvents : Integer; + + { property methods } + procedure SetDrawingStyle(Value: TVpDrawingStyle); + procedure SetColor(Value: TColor); + procedure SetLineColor(Value: TColor); + procedure SetOffDayColor(Value: TColor); + procedure SetDateLabelFormat(Value: string); + procedure SetShowEvents(Value: Boolean); + procedure SetEventDayStyle(Value: TFontStyles); + procedure SetDayNameStyle(Value: TVpMVDayNameStyle); + procedure SetDayNumberFont(Value: TFont); + procedure SetEventFont(Value: TFont); + procedure SetSelectedDayColor(Value: TColor); + procedure SetShowEventTime(Value: Boolean); + procedure SetTimeFormat(Value: TVpTimeFormat); + procedure SetDate(Value: TDateTime); + procedure SetRightClickChangeDate (const v : Boolean); + procedure SetWeekStartsOn(Value: TVpDayType); + { internal methods } + procedure mvHookUp; + procedure mvFontChanged(Sender: TObject); + + procedure Paint; override; + procedure Loaded; override; + procedure InitializeDefaultPopup; + procedure mvPopulate; + procedure mvSpinButtonClick(Sender: TObject; Button: TUDBtnType); + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + {$IFNDEF LCL} + procedure WMLButtonDown(var Msg : TWMLButtonDown); + message WM_LBUTTONDOWN; + procedure WMLButtonDblClick(var Msg: TWMLButtonDblClk); + message WM_LBUTTONDBLCLK; + {$ELSE} + procedure WMLButtonDown(var Msg : TLMLButtonDown); + message LM_LBUTTONDOWN; + procedure WMLButtonDblClick(var Msg: TLMLButtonDblClk); + message LM_LBUTTONDBLCLK; + {$ENDIF} + { - renamed from EditEventAtCoord and re-written} + function SelectEventAtCoord(Point: TPoint): Boolean; + procedure mvSetDateByCoord(Point: TPoint); + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + { message handlers } + {$IFNDEF LCL} + procedure WMSize(var Msg: TWMSize); message WM_SIZE; + procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS; + procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN; + procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); + message CM_WANTSPECIALKEY; + {$ELSE} + procedure WMSize(var Msg: TLMSize); message LM_SIZE; + procedure WMSetFocus(var Msg : TLMSetFocus); message LM_SETFOCUS; + procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; + {$ENDIF} + procedure PopupToday (Sender : TObject); + procedure PopupNextMonth (Sender : TObject); + procedure PopupPrevMonth (Sender : TObject); + procedure PopupNextYear (Sender : TObject); + procedure PopupPrevYear (Sender : TObject); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Invalidate; override; + procedure LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; + const Value: Variant); override; + function GetControlType : TVpItemType; override; + procedure PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + ADate : TDateTime); + procedure RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); override; + + property Date: TDateTime read FDate write SetDate; + published + { inherited properties } + property Align; + property Anchors; + property TabStop; + property TabOrder; + property KBNavigation: Boolean + read FKBNavigate write FKBNavigate; + property Color: TColor + read FColor write SetColor; + property DateLabelFormat: + string read FDateLabelFormat write SetDateLabelFormat; + property DayHeadAttributes: TVpDayHeadAttr + read FDayHeadAttributes write FDayHeadAttributes; + property DayNameStyle: TVpMVDayNameStyle + read FDayNameStyle write SetDayNameStyle; + property DayNumberFont: TFont + read FDayNumberFont write SetDayNumberFont; + property DrawingStyle: TVpDrawingStyle + read FDrawingStyle write SetDrawingStyle; + property EventDayStyle: TFontStyles + read FEventDayStyle write SetEventDayStyle; + property EventFont: TFont + read FEventFont write SetEventFont; + property LineColor: TColor + read FLineColor write SetLineColor; + property TimeFormat: TVpTimeFormat + read FTimeFormat write SetTimeFormat; + property OffDayColor: TColor + read FOffDayColor write SetOffDayColor; + property OwnerDrawCells: TVpOwnerDrawDayEvent + read FOwnerDrawCells write FOwnerDrawCells; + property RightClickChangeDate : Boolean + read FRightClickChangeDate write SetRightClickChangeDate + default vpDefWVRClickChangeDate; + property SelectedDayColor: TColor + read FSelectedDayColor write SetSelectedDayColor; + property ShowEvents: Boolean + read FShowEvents write SetShowEvents; + property ShowEventTime: Boolean + read FShowEventTime write SetShowEventTime; + property WeekStartsOn : TVpDayType + read FWeekStartsOn write SetWeekStartsOn; + {events} + property OnEventClick: TVpOnEventClick + read FOnEventClick write FOnEventClick; + property OnEventDblClick: TVpOnEventClick + read FOnEventDblClick write FOnEventDblClick; + end; + +implementation + +uses + SysUtils, Math, Forms, Dialogs, VpEvntEditDlg; + +(*****************************************************************************) +{ TVpContactHeadAttr } +constructor TVpDayHeadAttr.Create(AOwner: TVpMonthView); +begin + inherited Create; + FMonthView := AOwner; + FFont := TFont.Create; + FFont.Assign(FMonthView.Font); + FFont.Size := 8; + FColor := clSilver; +end; +{=====} + +destructor TVpDayHeadAttr.Destroy; +begin + FFont.Free; +end; +{=====} + +procedure TVpDayHeadAttr.SetColor(Value: TColor); +begin + if Value <> FColor then begin + FColor := Value; + MonthView.Invalidate; + end; +end; +{=====} + +procedure TVpDayHeadAttr.SetFont(Value: TFont); +begin + if Value <> FFont then begin + FFont.Assign(Value); + MonthView.Invalidate; + end; +end; +{=====} + +(*****************************************************************************) +{ TVpMonthView } + +constructor TVpMonthView.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; + + { Create internal classes and stuff } + FDayHeadAttributes := TVpDayHeadAttr.Create(self); + mvEventList := TList.Create; + mvSpinButtons := TUpDown.Create(self); + + { Set styles and initialize internal variables } + {$IFDEF VERSION4} + DoubleBuffered := true; + {$ENDIF} + FShowEvents := true; + FEventDayStyle := []; + FShowEventTime := false; + FDayNameStyle :=dsShort; + FKBNavigate := true; + mvInLinkHandler := false; + mvSpinButtons.OnClick := mvSpinButtonClick; + mvSpinButtons.Orientation := udHorizontal; + mvSpinButtons.Min := -32768; + mvSpinButtons.Max := 32767; + mvCreatingEditor := false; + FSelectedDayColor := clRed; + FDrawingStyle := ds3d; + mvPainting := false; + FColor := clWindow; + FOffDayColor := clSilver; + FLineColor := clGray; + FDate := Trunc(Now); + FTimeFormat := tf12Hour; + FDateLabelFormat := 'mmmm yyyy'; + FColumnWidth := 200; + FRightClickChangeDate := vpDefWVRClickChangeDate; + mvVisibleEvents := 0; + + { set up fonts and colors } + FDayHeadAttributes.Font.Name := 'Tahoma'; + FDayHeadAttributes.Font.Size := 10; + FDayHeadAttributes.Font.Style := []; + FDayHeadAttributes.Color := clBtnFace; + + { Assign default font to DayNumberFont and EventFont } + FDayNumberFont := TFont.Create; + FDayNumberFont.Assign(Font); + FDayNumberFont.OnChange := mvFontChanged; + FEventFont := TFont.Create; + FEventFont.Assign(Font); + FEventFont.OnChange := mvFontChanged; + + SetLength(mvEventArray, MaxVisibleEvents); + SetLength(mvMonthdayArray, 45); + + { size } + Height := 225; + Width := 300; + + FDefaultPopup := TPopupMenu.Create (Self); + InitializeDefaultPopup; + + mvHookUp; +end; +{=====} + +destructor TVpMonthView.Destroy; +begin + FDayHeadAttributes.Free; + FDayNumberFont.Free; + FEventFont.Free; + mvSpinButtons.Free; + mvEventList.Free; + FDefaultPopup.Free; + inherited; +end; +{=====} + +procedure TVpMonthView.Invalidate; +begin + inherited; +end; +{=====} + +procedure TVpMonthView.LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; const Value: Variant); +begin + mvInLinkHandler := true; + try + case NotificationType of + neDateChange: Date := Value; + neDataStoreChange: Invalidate; + neInvalidate: Invalidate; + end; + finally + mvInLinkHandler := false; + end; +end; +{=====} + +procedure TVpMonthView.mvHookUp; +var + I: Integer; +begin + { If the component is being dropped on a form at designtime, then } + { automatically hook up to the first datastore component found } + if csDesigning in ComponentState then + for I := 0 to pred(Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpCustomDataStore) then begin + DataStore := TVpCustomDataStore(Owner.Components[I]); + Exit; + end; + end; +end; +{=====} + +procedure TVpMonthView.mvFontChanged(Sender: TObject); +begin + Invalidate; +end; +{=====} + +procedure TVpMonthView.Loaded; +begin + inherited; + mvLoaded := true; + mvPopulate; +end; +{=====} + +function TVpMonthView.GetControlType : TVpItemType; +begin + Result := itMonthView; +end; + +procedure TVpMonthView.Paint; +begin + RenderToCanvas (Canvas, + Rect (0, 0, Width, Height), + ra0, + 1, + Self.Date, + -1, + -1, + gr30Min, + False); +end; +{=====} +procedure TVpMonthView.PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + ADate : TDateTime); +begin + RenderToCanvas (ACanvas, ARect, Angle, 1, ADate, + -1, -1, gr30Min, True); +end; +{=====} +procedure TVpMonthView.RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); +var + HeadRect : TRect; + SaveBrushColor : TColor; + SavePenStyle : TPenStyle; + SavePenColor : TColor; + DisplayDate : TDateTime; + + RealWidth : Integer; + RealHeight : Integer; + RealLeft : Integer; + RealRight : Integer; + RealTop : Integer; + RealBottom : Integer; + Rgn : HRGN; + + RealColor : TColor; + BevelHighlight : TColor; + BevelShadow : TColor; + BevelDarkShadow : TColor; + BevelFace : TColor; + DayHeadAttrColor : TColor; + RealLineColor : TColor; + RealOffDayColor : TColor; + RealSelDayColor : TColor; + EventFontColor : TColor; + DotDotDotColor : TColor; + + procedure Clear; + begin + RenderCanvas.Brush.Color := RealColor; + RenderCanvas.FillRect(RenderIn); + end; + {-} + + procedure SetMeasurements; + begin + RealWidth := TPSViewportWidth (Angle, RenderIn); + RealHeight := TPSViewportHeight (Angle, RenderIn); + RealLeft := TPSViewportLeft (Angle, RenderIn); + RealRight := TPSViewportRight (Angle, RenderIn); + RealTop := TPSViewportTop (Angle, RenderIn); + RealBottom := TPSViewportBottom (Angle, RenderIn); + + if RenderDate = 0 then + DisplayDate := Date + else + DisplayDate := RenderDate; + + { we use the VpProductName because is is a good representation of some } + { generic text } + RenderCanvas.Font.Assign(FDayHeadAttributes.Font); + mvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2; + RenderCanvas.Font.Assign(FDayNumberFont); + mvDayNumberHeight := RenderCanvas.TextHeight('00'); + RenderCanvas.Font.Assign(FEventFont); + mvEventTextHeight := RenderCanvas.TextHeight(VpProductName); + RenderCanvas.Font.Assign(Font); + mvLineHeight := RenderCanvas.TextHeight(VpProductName) + 2; + mvColWidth := (RealWidth - 4) div 7; + end; + {-} + + procedure DrawHeader; + var + HeadTextRect: TRect; + HeadStr: string; + HeadStrLen : Integer; + begin + RenderCanvas.Brush.Color := DayHeadAttrColor; + { draw the header cell and borders } + + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + HeadRect.Left := RealLeft + 1; + HeadRect.Top := RealTop + 1; + HeadRect.Right := RealRight - 1; + HeadRect.Bottom := RealTop + mvDayHeadHeight; + TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, HeadRect), + BevelHighlight, BevelShadow); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + HeadRect.Left := RealLeft + 2; + HeadRect.Top := RealTop + 2; + HeadRect.Right := RealRight - 3; + HeadRect.Bottom := RealTop + mvDayHeadHeight; + TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, HeadRect), + BevelHighlight, BevelDarkShadow); + end; + + { Acquire startdate and end date } + HeadStr := FormatDateTime(DateLabelFormat, DisplayDate); + + { draw the text } + if (DisplayOnly) and + (RenderCanvas.TextWidth (HeadStr) >= RealWidth) then + HeadTextRect.TopLeft:= Point (RealLeft + TextMargin * 2, + HeadRect.Top) + else if DisplayOnly then + HeadTextRect.TopLeft := Point (RealLeft + + (RealWidth - + RenderCanvas.TextWidth (HeadStr)) div 2, + HeadRect.Top) + else + HeadTextRect.TopLeft := Point (RealLeft + 30 + TextMargin * 2, + HeadRect.Top); + HeadTextRect.BottomRight := HeadRect.BottomRight; + + { Fix Header String } + HeadStrLen := RenderCanvas.TextWidth(HeadStr); + + if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left then begin + HeadStr := GetDisplayString(RenderCanvas, HeadStr, 0, + HeadTextRect.Right - HeadTextRect.Left - TextMargin); + end; + + { position the spinner } + mvSpinButtons.Height := Trunc(mvDayHeadHeight * 0.8); + mvSpinButtons.Width := mvSpinButtons.Height * 2; + mvSpinButtons.Left := TextMargin; + mvSpinButtons.Top := (mvDayHeadHeight - mvSpinButtons.Height) div 2 + 2; + + RenderCanvas.Font.Assign (FDayHeadAttributes.Font); + TPSTextOut (RenderCanvas, Angle, RenderIn, + RealLeft + mvSpinButtons.Width + TextMargin * 2, + HeadTextRect.Top + TextMargin, HeadStr); + end; + {-} + + procedure DrawDayHead; + var + dhRect : TRect; + I : Integer; + DayTag : Integer; + Str : string; + StrL : Integer; + begin + { clear day head area } + RenderCanvas.Font.Assign(DayHeadAttributes.Font); + RenderCanvas.Brush.Color := DayHeadAttrColor; + + { build rect } + if DrawingStyle = ds3D then begin + dhRect.Left := RealLeft + 1; + dhRect.Top := RealTop + mvDayHeadHeight + 3; + dhRect.Right := RealRight - 3; + dhRect.Bottom := dhRect.Top + mvDayHeadHeight; + TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, dhRect), + BevelHighlight, BevelDarkShadow); + end else begin + dhRect.Left := RealLeft + 1; + dhRect.Top := RealTop + mvDayHeadHeight + 2; + dhRect.Right := RealRight - 1; + dhRect.Bottom := dhRect.Top + mvDayHeadHeight; + TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, dhRect), + BevelHighlight, BevelShadow); + end; + + DayTag := Ord(WeekStartsOn); + dhRect.Right := dhRect.Left + mvColWidth; + for I := 0 to 6 do begin + { draw the little vertical lines between each day } + if I < 6 then + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, + Rect (dhRect.Right, + dhRect.Top + 3, + dhRect.Right + 1, + dhRect.Bottom - 3)), + BevelShadow, BevelHighlight); + + if FDayNameStyle = dsLong then + { Draw each day's full caption... } + case DayTag of + 0: str := RSSunday; + 1: str := RSMonday; + 2: str := RSTuesday; + 3: str := RSWednesday; + 4: str := RSThursday; + 5: str := RSFriday; + 6: str := RSSaturday; + end + else if FDayNameStyle = dsShort then + { Draw each day's abbreviated caption... } + case DayTag of + 0: str := RSASunday; + 1: str := RSAMonday; + 2: str := RSATuesday; + 3: str := RSAWednesday; + 4: str := RSAThursday; + 5: str := RSAFriday; + 6: str := RSASaturday; + end + else if FDayNameStyle = dsLetter then + { Draw each day's first letter only } + case DayTag of + 0: str := RSLSunday; + 1: str := RSLMonday; + 2: str := RSLTuesday; + 3: str := RSLWednesday; + 4: str := RSLThursday; + 5: str := RSLFriday; + 6: str := RSLSaturday; + end; + + { Fix Header String } + StrL := RenderCanvas.TextWidth(Str); + if (StrL > mvColWidth - (TextMargin * 2)) then begin + Str := GetDisplayString (RenderCanvas, Str, 0, + mvColWidth - (TextMargin * 2)); + end; + StrL := RenderCanvas.TextWidth(Str); + + TPSTextOut (RenderCanvas, Angle, RenderIn, + dhRect.Left + (dhRect.Right - dhRect.Left) div 2 - + (Strl div 2), dhRect.Top + TextMargin - 1, Str); + + if DayTag = 6 then + DayTag := 0 + else + Inc(DayTag); + dhRect.Left := dhRect.Right; + dhRect.Right := dhRect.Left + mvColWidth; + end; + + end; + {-} + + procedure DrawDays; + var + TextRect : TRect; + Col, Row : Integer; + DayNumber : Integer; + M, D, Y, Tmp : Word; + MonthStartsOn : Integer; + DayTag : Integer; + DayOffset : Integer; + StartingDate : TDateTime; + ThisDate : TDateTime; + Str : string; + StrLn : Integer; + I, J : Integer; + EventList : TList; + Drawn : Boolean; + TextAdjust : Integer; + FontStyle : TFontStyles; + OldBrush : TBrush; + OldPen : TPen; + OldFont : TFont; + begin + { initialize the MonthDayArray } + for I := 0 to Pred(Length(mvMonthDayArray)) do begin + mvMonthDayArray[I].Rec := Rect(-1, -1, -1, -1); + mvMonthDayArray[I].Date := 0.0; + end; + + RenderCanvas.Pen.Color := RealLineColor; + RenderCanvas.Brush.Color := RealColor; + mvRowHeight := (RealHeight - (mvDayHeadHeight * 2) - 4) div 6; + TextRect.TopLeft := Point (RealLeft + 1, + RealTop + (mvDayHeadHeight * 2) + 4); + TextRect.BottomRight := Point (TextRect.Left + mvColWidth, + TextRect.Top + mvRowHeight); + + { Determine the starting date and offset } + DecodeDate(DisplayDate, Y, M, D); + StartingDate := EncodeDate(Y, M, 1); + MonthStartsOn := DayOfWeek(StartingDate); + DayTag := Ord(WeekStartsOn); + DayOffset := DayTag - MonthStartsOn; + + I := 0; + DayNumber := DayOffset + 1; + + { iterate through each column, row by row, drawing each day in numerical } + { order. } + + OldBrush := TBrush.Create; + try + OldPen := TPen.Create; + try + OldFont := TFont.Create; + try + for Row := 0 to 5 do begin + for Col := 0 to 6 do begin + if (Col = 6) then begin + { draws the far right day for this week } + ThisDate := trunc(StartingDate + DayNumber); + DecodeDate(ThisDate, Y, Tmp, D); + + { Allow the user to draw the day } + Drawn := false; + if Assigned(FOwnerDrawCells) then begin + OldBrush.Assign (Canvas.Brush); + OldPen.Assign (Canvas.Pen); + OldFont.Assign (Canvas.Font); + try + FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); + if Drawn then continue; + finally + Canvas.Brush.Assign (OldBrush); + Canvas.Pen.Assign (OldPen); + Canvas.Font.Assign (OldFont); + end; + end; + + TextRect.Right := TextRect.Right + 8; + if Tmp <> M then begin + RenderCanvas.Brush.Color := RealOffDayColor; + if TextRect.Bottom > RealBottom then + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (TextRect.Left, TextRect.Top, + RealRight, RealBottom)) + else + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (TextRect.Left, TextRect.Top, + RealRight, TextRect.Bottom)); + end else + RenderCanvas.Brush.Color := RealColor; + { draw bottom line } + TPSMoveTo (RenderCanvas, Angle, RenderIn, + TextRect.Left, TextRect.Bottom); + TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2, + TextRect.Bottom); + { Paint the day number } + Str := FormatDateTime('d', ThisDate); + + { set the proper font and style } + RenderCanvas.Font.Assign(FDayNumberFont); + if (DisplayDate = ThisDate) then begin + if Focused then begin + TPSDrawFocusRect (RenderCanvas, Angle, RenderIn, + Rect (TextRect.Left - 2, + TextRect.Top - 2, + TextRect.Right + 2, + TextRect.Bottom + 2)); + TPSDrawFocusRect (RenderCanvas, Angle, RenderIn, + Rect (TextRect.Left + 2, + TextRect.Top + 2, + TextRect.Right - 2, + TextRect.Bottom - 2)); + end; + RenderCanvas.Font.Color := RealSelDayColor; + RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold]; + if (FEventDayStyle <> []) and (DataStore.Resource <> nil) + and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) + then + RenderCanvas.Font.Style := RenderCanvas.Font.Style + + FEventDayStyle; + end else begin + { Set the font style for days which have events. } + if (FEventDayStyle <> []) and (DataStore.Resource <> nil) + and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) + then + RenderCanvas.Font.Style := RenderCanvas.Font.Style + + FEventDayStyle + else begin + RenderCanvas.Font.Color := EventFontColor; + RenderCanvas.Font.Style := FDayNumberFont.Style; + end; + end; + + FontStyle := RenderCanvas.Font.Style; + RenderCanvas.Font.Style := [fsBold, fsItalic]; + TextAdjust := RenderCanvas.TextWidth (Str); + RenderCanvas.Font.Style := FontStyle; + + { write the day number at the top of the square. } + if fsItalic in RenderCanvas.Font.Style then + TPSTextOut (RenderCanvas, Angle, RenderIn, + TextRect.Left + mvColWidth - TextAdjust - + TextMargin - 2, + TextRect.Top + (TextMargin div 2), Str) + else + TPSTextOut (RenderCanvas, Angle, RenderIn, + TextRect.Left + mvColWidth - TextAdjust + - TextMargin, TextRect.Top + (TextMargin div 2), + Str); + + + { Update MonthDayArray } + mvMonthDayArray[I].Rec := TextRect; + mvMonthDayArray[I].Date := ThisDate; + mvMonthDayArray[I].OffDay := Tmp <> M; + Inc(DayNumber); + Inc(I); + + { drop rect down one row and all the way to the left } + TextRect.TopLeft := Point(RealLeft + 1, TextRect.Bottom + 1); + TextRect.BottomRight := Point(TextRect.Left + mvColWidth, + TextRect.Top + mvRowHeight); + end else begin + { draws all days for the week, except the far right one } + ThisDate := Trunc(StartingDate + DayNumber); + DecodeDate(ThisDate, Y, Tmp, D); + + { Allow the user to draw the day } + Drawn := false; + if Assigned(FOwnerDrawCells) then begin + OldBrush.Assign (Canvas.Brush); + OldPen.Assign (Canvas.Pen); + OldFont.Assign (Canvas.Font); + try + FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn); + if Drawn then continue; + finally + Canvas.Brush.Assign (OldBrush); + Canvas.Pen.Assign (OldPen); + Canvas.Font.Assign (OldFont); + end; + end; + + if Tmp <> M then begin + RenderCanvas.Brush.Color := RealOffDayColor; + TPSFillRect (RenderCanvas, Angle, RenderIn, TextRect); + end else + RenderCanvas.Brush.Color := RealColor; + { draw right side and bottom lines } + TPSMoveTo (RenderCanvas, Angle, RenderIn, TextRect.Right, + TextRect.top); + if TextRect.Bottom > RealBottom then begin + TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right, + RealBottom); + TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1, + RealBottom); + end else begin + TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right, + TextRect.Bottom); + TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1, + TextRect.Bottom); + end; + { paint the day number } + Str := FormatDateTime('d', ThisDate); + + { set the proper font and style } + RenderCanvas.Font.Assign(FDayNumberFont); + if (DisplayDate = ThisDate) then begin + if Focused then begin + TPSDrawFocusRect (RenderCanvas, Angle, RenderIn, + Rect (TextRect.Left - 2, + TextRect.Top - 2, + TextRect.Right + 2, + TextRect.Bottom + 2)); + TPSDrawFocusRect (RenderCanvas, Angle, RenderIn, + Rect (TextRect.Left + 2, + TextRect.Top + 2, + TextRect.Right - 2, + TextRect.Bottom - 2)); + end; + RenderCanvas.Font.Color := RealSelDayColor; + RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold]; + if (FEventDayStyle <> []) and (DataStore.Resource <> nil) + and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) + then + RenderCanvas.Font.Style := RenderCanvas.Font.Style + + FEventDayStyle; + end else begin + { Set the font style for days which have events. } + if (FEventDayStyle <> []) and (DataStore.Resource <> nil) + and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0) + then + RenderCanvas.Font.Style := RenderCanvas.Font.Style + + FEventDayStyle + else begin + RenderCanvas.Font.Color := EventFontColor; + RenderCanvas.Font.Style := FDayNumberFont.Style; + end; + end; + + FontStyle := RenderCanvas.Font.Style; + RenderCanvas.Font.Style := [fsBold, fsItalic]; + TextAdjust := RenderCanvas.TextWidth (Str); + RenderCanvas.Font.Style := FontStyle; + + if fsItalic in RenderCanvas.Font.Style then + TPSTextOut (RenderCanvas, Angle, RenderIn, + TextRect.Right - TextAdjust - TextMargin - 2, + TextRect.Top + (TextMargin div 2), Str) + else + TPSTextOut (RenderCanvas, Angle, RenderIn, + TextRect.Right - TextAdjust - TextMargin, + TextRect.Top + (TextMargin div 2), Str); + + { Update Array } + mvMonthDayArray[I].Rec := TextRect; + mvMonthDayArray[I].Date := ThisDate; + mvMonthDayArray[I].OffDay := Tmp <> M; + Inc(DayNumber); + Inc(I); + { slide rect one column to the right } + TextRect.Left := TextRect.Right + 1; + TextRect.Right := TextRect.Right + mvColWidth; + end; + end; + end; + + finally + OldFont.Free; + end; + finally + OldPen.Free; + end; + finally + OldBrush.Free; + end; + + RenderCanvas.Pen.Color := RealLineColor; + RenderCanvas.Pen.Style := psSolid; + RenderCanvas.Brush.Color := RealColor; + + { write the events } + if (DataStore <> nil) and FShowEvents and (DataStore.Resource <> nil) + and (DataStore.Resource.Schedule.EventCount <> 0) then begin + EventList := TList.Create; + try + for I := 0 to 43 do begin + EventList.Clear; + DataStore.Resource.Schedule.EventsByDate(mvMonthDayArray[I].Date, EventList); + if EventList.Count > 0 then begin + { there are events scheduled for this day } + + { initialize TextRect for this day } + TextRect.TopLeft := Point(mvMonthDayArray[I].Rec.Left, + mvMonthDayArray[I].Rec.Top); + TextRect.BottomRight := Point(TextRect.Left + mvColWidth, + TextRect.Top + mvEventTextHeight + (TextMargin div 2)); + + { set canvas color } + if mvMonthDayArray[I].OffDay + then RenderCanvas.Brush.Color := RealOffDayColor + else RenderCanvas.Brush.Color := RealColor; + + { spin through the events and paint them } + for J := 0 to Pred(EventList.Count) do begin + + if (TextRect.Bottom > mvMonthDayArray[I].Rec.Bottom) + and (J <= Pred(EventList.Count)) + then begin + { draw a little red square with a (...) at the bottom right } + { corner of the day to indicate that there are more events } + { than can be listed in the available space. } + RenderCanvas.Brush.Color := DotDotDotColor; + { draw dot dot dot } + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect(mvMonthDayArray[I].Rec.Right - 20, + mvMonthDayArray[I].Rec.Bottom - 7, + mvMonthDayArray[I].Rec.Right - 17, + mvMonthDayArray[I].Rec.Bottom - 4)); + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect(mvMonthDayArray[I].Rec.Right - 13, + mvMonthDayArray[I].Rec.Bottom - 7, + mvMonthDayArray[I].Rec.Right - 10, + mvMonthDayArray[I].Rec.Bottom - 4)); + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect(mvMonthDayArray[I].Rec.Right - 6, + mvMonthDayArray[I].Rec.Bottom - 7, + mvMonthDayArray[I].Rec.Right - 3, + mvMonthDayArray[I].Rec.Bottom - 4)); + Break; + end; + + { shorten events that are next to the day number, in order } + { to give the day number enough room } + if (TextRect.Top < mvMonthDayArray[I].Rec.Top + + mvDayNumberHeight + (TextMargin div 2)) + then + TextRect.Right := TextRect.Left + mvColWidth + - mvDayNumberHeight - TextMargin + else + TextRect.Right := TextRect.Left + mvColWidth; + + { format the display text } + if ShowEventTime then begin + if (TimeFormat = tf24Hour) then + Str := FormatDateTime('hh:mm', + TVpEvent(EventList.List^[j]).StartTime) + else + Str := FormatDateTime('hh:mm AM/PM', + TVpEvent(EventList.List^[j]).StartTime); + Str := Str + ' - ' + TVpEvent(EventList.List^[j]).Description; + end else + Str := TVpEvent(EventList.List^[j]).Description; + + { set the event font } + RenderCanvas.Font.Assign(FEventFont); + + StrLn := RenderCanvas.TextWidth(Str); + if (StrLn > TextRect.Right - TextRect.Left - (TextMargin * 2)) then + begin + Str := GetDisplayString(RenderCanvas, Str, 0, TextRect.Right - + TextRect.Left - (TextMargin * 2)); + end; + + { write the event text } + TPSTextOut (RenderCanvas, Angle, RenderIn, TextRect.Left + (TextMargin div 2), + TextRect.Top + (TextMargin div 2), Str); + + { - begin block} + Inc(mvVisibleEvents); + mvEventArray[mvVisibleEvents - 1].Rec := TextRect; + mvEventArray[mvVisibleEvents - 1].Event := TVpEvent(EventList.List^[j]); + { - end block} + + { Move TextRect down one line for the next item... } + TextRect.Top := TextRect.Bottom + 1; + TextRect.Bottom := TextRect.Top + mvLineHeight; + end; + end; + end; + finally + EventList.Free; + end; + end; + end; + {-} + + + procedure DrawBorders; + begin + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, + RenderIn, + Rect (RealLeft, + RealTop, + RealRight - 1, + RealBottom - 1)), + BevelShadow, + BevelShadow); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, + RenderIn, + Rect (RealLeft, + RealTop, + RealRight - 1, + RealBottom - 1)), + BevelShadow, + BevelHighlight); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, + RenderIn, + Rect (RealLeft + 1, + RealTop + 1, + RealRight - 2, + RealBottom - 2)), + BevelDarkShadow, + BevelFace); + end; + end; + {-} +begin + if DisplayOnly then begin + BevelHighlight := clBlack; + BevelShadow := clBlack; + BevelDarkShadow := clBlack; + BevelFace := clBlack; + RealColor := clWhite; + DayHeadAttrColor := clSilver; + RealLineColor := clBlack; + RealOffDayColor := clSilver; + RealSelDayColor := clWhite; + EventFontColor := clBlack; + end else begin + BevelHighlight := clBtnHighlight; + BevelShadow := clBtnShadow; + BevelDarkShadow := cl3DDkShadow; + BevelFace := clBtnFace; + RealColor := Color; + DayHeadAttrColor := DayHeadAttributes.Color; + RealLineColor := LineColor; + RealOffDayColor := OffDayColor; + RealSelDayColor := FSelectedDayColor; + EventFontColor := FDayNumberFont.Color; + end; + DotDotDotColor := clBlack; + + mvPainting := true; + SavePenStyle := RenderCanvas.Pen.Style; + SaveBrushColor := RenderCanvas.Brush.Color; + SavePenColor := RenderCanvas.Pen.Color; + + RenderCanvas.Pen.Style := psSolid; + RenderCanvas.Pen.Width := 1; + RenderCanvas.Pen.Mode := pmCopy; + RenderCanvas.Brush.Style := bsSolid; + + Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top, + RenderIn.Right, RenderIn.Bottom); + try + SelectClipRgn (RenderCanvas.Handle, Rgn); + + { clear client area } + Clear; + + { measure the row heights } + SetMeasurements; + + { draw headers } + DrawHeader; + DrawDayHead; + + { draw days } + mvVisibleEvents := 0; + DrawDays; + + { draw the borders } + DrawBorders; + + finally + SelectClipRgn (RenderCanvas.Handle, 0); + DeleteObject (Rgn); + end; + + { reinstate canvas settings} + RenderCanvas.Pen.Style := SavePenStyle; + RenderCanvas.Brush.Color := SaveBrushColor; + RenderCanvas.Pen.Color := SavePenColor; + mvPainting := false; +end; + +procedure TVpMonthView.mvPopulate; +begin + if DataStore <> nil then + DataStore.Date := FDate; +end; +{=====} + +procedure TVpMonthView.mvSpinButtonClick(Sender: TObject; Button: TUDBtnType); +var + M, D, Y : Word; +begin + DecodeDate(Date, Y, M, D); + if Button = btNext then begin + if M = 12 then begin + M := 1; + Y := Y + 1; + end else + M := M + 1; + end else begin + if M = 1 then begin + M := 12; + Y := Y - 1; + end else + M := M - 1; + end; + if (D > DaysInMonth(Y, M)) then + D := DaysInMonth(Y, M); + + Date := EncodeDate(Y, M, D); +end; +{=====} + +procedure TVpMonthView.SetColor(Value: TColor); +begin + if FColor <> Value then begin + FColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetDrawingStyle(Value: TVpDrawingStyle); +begin + if FDrawingStyle <> Value then begin + FDrawingStyle := Value; + Repaint; + end; +end; +{=====} + +procedure TVpMonthView.SetLineColor(Value: TColor); +begin + if FLineColor <> Value then begin + FLineColor := Value; + Repaint; + end; +end; +{=====} + +procedure TVpMonthView.SetOffDayColor(Value: TColor); +begin + if Value <> FOffDayColor then begin + FOffDayColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetDateLabelFormat(Value: string); +begin + if Value <> FDateLabelFormat then begin + FDateLabelFormat := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetShowEvents(Value: Boolean); +begin + if FShowEvents <> Value then begin + FShowEvents := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetEventDayStyle(Value: TFontStyles); +begin + if FEventDayStyle <> Value then begin + FEventDayStyle := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetDayNameStyle(Value: TVpMVDayNameStyle); +begin + if FDayNameStyle <> Value then begin + FDayNameStyle := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetDayNumberFont(Value: TFont); +begin + FDayNumberFont.Assign(Value); + Invalidate; +end; +{=====} + +procedure TVpMonthView.SetEventFont(Value: TFont); +begin + FEventFont.Assign(Value); + Invalidate; +end; +{=====} + +procedure TVpMonthView.SetSelectedDayColor(Value: TColor); +begin + if Value <> FSelectedDayColor then begin + FSelectedDayColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetShowEventTime(Value: Boolean); +begin + if Value <> FShowEventTime then begin + FShowEventTime := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetTimeFormat(Value: TVpTimeFormat); +begin + if Value <> FTimeFormat then begin + FTimeFormat := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpMonthView.SetDate(Value: TDateTime); +begin + if FDate <> Trunc(Value) then begin + FDate := Trunc(Value); + + if DataStore <> nil then + DataStore.Date := FDate; + + if mvLoaded then + mvPopulate; + Invalidate; + + if ControlLink <> nil then + ControlLink.Notify(self, neDateChange, FDate); + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpMonthView.WMSize(var Msg: TWMSize); +{$ELSE} +procedure TVpMonthView.WMSize(var Msg: TLMSize); +{$ENDIF} +begin + inherited; + { force a repaint on resize } + Invalidate; +end; +{=====} + +procedure TVpMonthView.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + Style := Style or WS_TABSTOP; +{$IFNDEF LCL} + WindowClass.style := CS_DBLCLKS; +{$ENDIF} + end; +end; +{=====} + +procedure TVpMonthView.CreateWnd; +begin + inherited; + mvSpinButtons.Parent := self; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpMonthView.WMLButtonDown(var Msg : TWMLButtonDown); +{$ELSE} +procedure TVpMonthView.WMLButtonDown(var Msg : TLMLButtonDown); +{$ENDIF} +begin + inherited; + // if the mouse was pressed down in the client area, then select the cell. + if not focused then SetFocus; + + if (Msg.YPos > mvDayHeadHeight) then + begin + { The mouse click landed inside the client area } + MvSetDateByCoord(Point(Msg.XPos, Msg.YPos)); + { Did the mouse click land on an event? } + if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos)) + and (Assigned(FOnEventClick)) then + FOnEventClick(self, mvActiveEvent); + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpMonthView.WMLButtonDblClick(var Msg: TWMLButtonDblClk); +{$ELSE} +procedure TVpMonthView.WMLButtonDblClick(var Msg: TLMLButtonDblClk); +{$ENDIF} +begin + inherited; + // if the mouse was pressed down in the client area, then select the + // cell. + if not focused then SetFocus; + + if (Msg.YPos > mvDayHeadHeight) then + begin + { The mouse click landed inside the client area } + MvSetDateByCoord(Point(Msg.XPos, Msg.YPos)); + { Did the mouse click land on an event? } + if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos)) + and (Assigned(FOnEventDblClick)) then + FOnEventDblClick(self, mvActiveEvent); + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpMonthView.WMSetFocus(var Msg : TWMSetFocus); +{$ELSE} +procedure TVpMonthView.WMSetFocus(var Msg : TLMSetFocus); +{$ENDIF} +begin + // if active event is nil then set active event to the first diaplsyed one. +end; +{=====} + +{$IFNDEF LCL} +procedure TVpMonthView.CMWantSpecialKey(var Msg: TCMWantSpecialKey); +begin + inherited; + Msg.Result := 1; +end; +{$ENDIF} +{=====} + +{$IFNDEF LCL} +procedure TVpMonthView.WMRButtonDown(var Msg : TWMRButtonDown); +{$ELSE} +procedure TVpMonthView.WMRButtonDown(var Msg : TLMRButtonDown); +{$ENDIF} +var + ClientOrigin : TPoint; +begin + inherited; + + if not Assigned (PopupMenu) then begin + if not focused then + SetFocus; + if FRightClickChangeDate then + mvSetDateByCoord (Point (Msg.XPos, Msg.YPos)); + ClientOrigin := GetClientOrigin; + + FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x, + Msg.YPos + ClientOrigin.y); + end; +end; +{=====} + +procedure TVpMonthView.InitializeDefaultPopup; +var + NewItem : TMenuItem; + +begin + if RSMonthPopupToday <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSMonthPopupToday; + NewItem.OnClick := PopupToday; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSMonthPopupNextMonth <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSMonthPopupNextMonth; + NewItem.OnClick := PopupNextMonth; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSMonthPopupPrevMonth <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSMonthPopupPrevMonth; + NewItem.OnClick := PopupPrevMonth; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSMonthPopupNextYear <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSMonthPopupNextYear; + NewItem.OnClick := PopupNextYear; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSMonthPopupPrevYear <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSMonthPopupPrevYear; + NewItem.OnClick := PopupPrevYear; + FDefaultPopup.Items.Add (NewItem); + end; +end; +{=====} + +procedure TVpMonthView.PopupToday (Sender : TObject); +begin + Date := Now; +end; +{=====} + +procedure TVpMonthView.PopupNextMonth (Sender : TObject); +begin + mvSpinButtonClick (self, btNext); +end; +{=====} + +procedure TVpMonthView.PopupPrevMonth (Sender : TObject); +begin + mvSpinButtonClick (self, btPrev); +end; +{=====} + +procedure TVpMonthView.PopupNextYear (Sender : TObject); +var + M, D, Y : Word; + +begin + DecodeDate (Date, Y, M, D); + Date := EncodeDate (Y + 1, M, 1); +end; +{=====} + +procedure TVpMonthView.PopupPrevYear (Sender : TObject); +var + M, D, Y : Word; + +begin + DecodeDate (Date, Y, M, D); + Date := EncodeDate (Y - 1, M, 1); +end; +{=====} + +{ - renamed from EditEventAtCoord and re-written} +function TVpMonthView.SelectEventAtCoord(Point: TPoint): Boolean; +var + I: Integer; +begin + result := false; + I := 0; + while I < Length(mvEventArray) do begin + if mvEventArray[I].Event = nil then begin + Inc(I); + Break; + end else begin + if (Point.X > mvEventArray[I].Rec.Left) + and (Point.X < mvEventArray[I].Rec.Right) + and (Point.Y > mvEventArray[I].Rec.Top) + and (Point.Y < mvEventArray[I].Rec.Bottom) then begin + result := true; + Break; + end else + Inc(I); + end; + end; + + if result then begin + mvActiveEvent := TVpEvent(mvEventArray[I].Event); + mvActiveEventRec := mvEventArray[I].Rec; + end; +end; +{=====} + +procedure TVpMonthView.mvSetDateByCoord(Point: TPoint); +var + I: Integer; +begin + for I := 0 to pred(Length(mvMonthdayArray)) do begin + if (Point.X >= mvMonthdayArray[I].Rec.Left) + and (Point.X <= mvMonthdayArray[I].Rec.Right) + and (Point.Y >= mvMonthdayArray[I].Rec.Top) + and (Point.Y <= mvMonthdayArray[I].Rec.Bottom) then + Date := mvMonthdayArray[I].Date; + end; +end; +{=====} + +procedure TVpMonthView.KeyDown(var Key: Word; Shift: TShiftState); +var + M, D, Y : Word; + PopupPoint : TPoint; + +begin + if FKBNavigate then + case Key of + VK_UP : + if ssCtrl in Shift then begin + DecodeDate(Date, Y, M, D); + Date := EncodeDate(Y - 1, M, 1); + end else + Date := Date - 7; + VK_DOWN : + if ssCtrl in Shift then begin + DecodeDate(Date, Y, M, D); + Date := EncodeDate(Y + 1, M, 1); + end else + Date := Date + 7; + VK_NEXT : mvSpinButtonClick(self, btNext); + VK_PRIOR : mvSpinButtonClick(self, btPrev); + VK_LEFT : + if ssCtrl in Shift then + mvSpinButtonClick(self, btPrev) + else + Date := Date - 1; + VK_RIGHT : + if ssCtrl in Shift then + mvSpinButtonClick(self, btNext) + else + Date := Date + 1; + VK_HOME : begin + DecodeDate(Date, Y, M, D); + if D = 1 then + mvSpinButtonClick(self, btPrev) + else + Date := EncodeDate(Y, M, 1); + end; + VK_END : begin + DecodeDate(Date, Y, M, D); + if D = DaysInMonth(Y, M) then begin + if M = 12 then begin + M := 1; + Inc(Y); + end else + Inc(M); + end; + Date := EncodeDate(Y, M, DaysInMonth(Y, M)); + end; +{$IFNDEF LCL} + VK_TAB : + if ssShift in Shift then + Windows.SetFocus (GetNextDlgTabItem (GetParent (Handle), Handle, False)) + else + Windows.SetFocus (GetNextDlgTabItem (GetParent (Handle), Handle, True)); +{$ENDIF} + VK_F10 : + if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + VK_APPS : + if not Assigned (PopupMenu) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + end; +end; +{=====} +procedure TVpMonthView.SetRightClickChangeDate (const v : Boolean); +begin + if v <> FRightClickChangeDate then + FRightClickChangeDate := v; +end; +{=====} +procedure TVpMonthView.SetWeekStartsOn(Value: TVpDayType); +begin + if Value <> FWeekStartsOn then begin + FWeekStartsOn := Value; + Invalidate; + end; +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpnabed.lfm b/components/tvplanit/source/vpnabed.lfm new file mode 100644 index 000000000..b78d90163 --- /dev/null +++ b/components/tvplanit/source/vpnabed.lfm @@ -0,0 +1,347 @@ +object frmNavBarEd: TfrmNavBarEd + Left = 374 + Height = 323 + Top = 236 + Width = 426 + HorzScrollBar.Page = 425 + VertScrollBar.Page = 322 + Caption = 'Nav Bar Layout Tool' + ClientHeight = 323 + ClientWidth = 426 + Font.Height = -11 + Font.Name = 'MS Sans Serif' + FormStyle = fsStayOnTop + OnClose = FormClose + OnCreate = FormCreate + OnResize = FormResize + Position = poScreenCenter + object pnlItems: TPanel + Left = 217 + Height = 223 + Width = 209 + Align = alClient + ClientHeight = 223 + ClientWidth = 209 + TabOrder = 1 + object lbItems: TListBox + Left = 1 + Height = 200 + Top = 22 + Width = 175 + Align = alClient + ItemHeight = 13 + OnClick = lbItemsClick + OnDrawItem = lbItemsDrawItem + Style = lbOwnerDrawVariable + TabOrder = 0 + end + object Panel1: TPanel + Left = 176 + Height = 200 + Top = 22 + Width = 32 + Align = alRight + ClientHeight = 200 + ClientWidth = 32 + TabOrder = 1 + object btnItemAdd: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Add Item' + Top = 7 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333300000333300033330AAA0333300033330AAA0333300030000AAA0000 + 300030AAAAAAAAA0300030AAAAAAAAA0300030AAAAAAAAA0300030000AAA0000 + 300033330AAA0333300033330AAA033330003333000003333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnItemAddClick + ShowHint = True + ParentShowHint = False + end + object btnItemDelete: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Remove item' + Top = 39 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333333333333300033333333333330003333333333333000300000000000 + 3000309999999990300030999999999030003099999999903000300000000000 + 3000333333333333300033333333333330003333333333333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnItemDeleteClick + ShowHint = True + ParentShowHint = False + end + object btnItemUp: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Move item up' + Top = 72 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333333333333300033330000033330003333066603333000333306660333 + 3000333306660333300030000666000030003306666666033000333066666033 + 3000333306660333300033333060333330003333330333333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnItemUpClick + ShowHint = True + ParentShowHint = False + end + object btnItemDown: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Move item down' + Top = 104 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333333333333300033333303333330003333306033333000333306660333 + 3000333066666033300033066666660330003000066600003000333306660333 + 3000333306660333300033330666033330003333000003333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnItemDownClick + ShowHint = True + ParentShowHint = False + end + end + object Panel4: TPanel + Left = 1 + Height = 21 + Top = 1 + Width = 207 + Align = alTop + ClientHeight = 21 + ClientWidth = 207 + TabOrder = 2 + object Label2: TLabel + Left = 4 + Height = 14 + Top = 4 + Width = 58 + Caption = '&Items/Icons' + FocusControl = lbItems + ParentColor = False + end + end + end + object pnlFolders: TPanel + Height = 223 + Width = 217 + Align = alLeft + ClientHeight = 223 + ClientWidth = 217 + TabOrder = 0 + object lbFolders: TListBox + Left = 1 + Height = 200 + Top = 22 + Width = 183 + Align = alClient + ItemHeight = 13 + OnClick = lbFoldersClick + TabOrder = 0 + end + object Panel6: TPanel + Left = 1 + Height = 21 + Top = 1 + Width = 215 + Align = alTop + ClientHeight = 21 + ClientWidth = 215 + TabOrder = 2 + object Label1: TLabel + Left = 4 + Height = 13 + Top = 4 + Width = 34 + Caption = '&Folders' + FocusControl = lbFolders + ParentColor = False + end + end + object Panel5: TPanel + Left = 184 + Height = 200 + Top = 22 + Width = 32 + Align = alRight + ClientHeight = 200 + ClientWidth = 32 + TabOrder = 1 + object btnFolderAdd: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Add Item' + Top = 7 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333300000333300033330AAA0333300033330AAA0333300030000AAA0000 + 300030AAAAAAAAA0300030AAAAAAAAA0300030AAAAAAAAA0300030000AAA0000 + 300033330AAA0333300033330AAA033330003333000003333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnFolderAddClick + ShowHint = True + ParentShowHint = False + end + object btnFolderDelete: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Remove item' + Top = 39 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333333333333300033333333333330003333333333333000300000000000 + 3000309999999990300030999999999030003099999999903000300000000000 + 3000333333333333300033333333333330003333333333333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnFolderDeleteClick + ShowHint = True + ParentShowHint = False + end + object btnFolderUp: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Move item up' + Top = 72 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333333333333300033330000033330003333066603333000333306660333 + 3000333306660333300030000666000030003306666666033000333066666033 + 3000333306660333300033333060333330003333330333333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnFolderUpClick + ShowHint = True + ParentShowHint = False + end + object btnFolderDown: TSpeedButton + Left = 4 + Height = 25 + Hint = 'Move item down' + Top = 104 + Width = 25 + Color = clBtnFace + Glyph.Data = { + DE000000424DDE0000000000000076000000280000000D0000000D0000000100 + 0400000000006800000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 + 3000333333333333300033333303333330003333306033333000333306660333 + 3000333066666033300033066666660330003000066600003000333306660333 + 3000333306660333300033330666033330003333000003333000333333333333 + 3000 + } + Layout = blGlyphTop + NumGlyphs = 0 + Spacing = 1 + OnClick = btnFolderDownClick + ShowHint = True + ParentShowHint = False + end + end + end + object pnlImages: TPanel + Height = 100 + Top = 223 + Width = 426 + Align = alBottom + ClientHeight = 100 + ClientWidth = 426 + TabOrder = 2 + object Panel8: TPanel + Left = 1 + Height = 25 + Top = 1 + Width = 424 + Align = alTop + ClientHeight = 25 + ClientWidth = 424 + TabOrder = 0 + object Label3: TLabel + Left = 8 + Height = 14 + Top = 8 + Width = 82 + Caption = 'Available I&mages' + ParentColor = False + end + end + object lbImages: TListBox + Left = 1 + Height = 73 + Top = 26 + Width = 424 + Align = alClient + Columns = 10 + ItemHeight = 16 + OnClick = lbImagesClick + OnDrawItem = lbImagesDrawItem + Style = lbOwnerDrawFixed + TabOrder = 1 + end + end +end diff --git a/components/tvplanit/source/vpnabed.pas b/components/tvplanit/source/vpnabed.pas new file mode 100644 index 000000000..9168092b0 --- /dev/null +++ b/components/tvplanit/source/vpnabed.pas @@ -0,0 +1,611 @@ +{*********************************************************} +{* VPNABED.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpNabEd; + {-property editor for the NavBar} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + {$IFDEF VERSION6} + {$IFNDEF LCL} + DesignIntf, DesignEditors, + {$ELSE} + PropEdits, + LazarusPackageIntf, + FieldsEditor, + ComponentEditors, + {$ENDIF} + {$ELSE} + DsgnIntf, + {$ENDIF} + StdCtrls, ExtCtrls, Buttons, + VpBase, VpNavBar; + +type +{$IFNDEF LCL} +{$IFDEF VERSION6} + TProtectedSelList = class(TDesignerSelections); +{$ENDIF} +{$ENDIF} + + TVpNavBarEditor = class(TComponentEditor) + procedure ExecuteVerb(Index : Integer); override; + function GetVerb(Index : Integer) : string; override; + function GetVerbCount : Integer; override; + end; + + TfrmNavBarEd = class(TForm) + pnlItems: TPanel; + pnlFolders: TPanel; + lbItems: TListBox; + lbFolders: TListBox; + Panel1: TPanel; + btnItemAdd: TSpeedButton; + btnItemDelete: TSpeedButton; + btnItemUp: TSpeedButton; + btnItemDown: TSpeedButton; + Panel4: TPanel; + Label2: TLabel; + Panel5: TPanel; + btnFolderAdd: TSpeedButton; + btnFolderDelete: TSpeedButton; + btnFolderUp: TSpeedButton; + btnFolderDown: TSpeedButton; + Panel6: TPanel; + Label1: TLabel; + pnlImages: TPanel; + Panel8: TPanel; + Label3: TLabel; + lbImages: TListBox; + procedure FormCreate(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure lbFoldersClick(Sender: TObject); + procedure lbItemsMeasureItem(Control: TWinControl; Index: Integer; + var Height: Integer); + procedure lbItemsDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure lbImagesDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure lbImagesClick(Sender: TObject); + procedure btnItemUpClick(Sender: TObject); + procedure btnItemDownClick(Sender: TObject); + procedure btnFolderUpClick(Sender: TObject); + procedure btnFolderDownClick(Sender: TObject); + procedure btnItemDeleteClick(Sender: TObject); + procedure btnFolderDeleteClick(Sender: TObject); + procedure btnFolderAddClick(Sender: TObject); + procedure btnItemAddClick(Sender: TObject); + procedure lbItemsClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + private + RefreshTimer: TTimer; + {$IFDEF VERSION5} + {$IFDEF VERSION6} + {$IFNDEF LCL} + procedure SelectList(SelList : TDesignerSelections); + {$ENDIF} + {$ELSE} + procedure SelectList(SelList : TDesignerSelectionList); + {$ENDIF} + {$ELSE} + procedure SelectList(SelList : TComponentList); + {$ENDIF} + procedure OnTimer(Sender: TObject); + public + { Public declarations } + Bar : TVpNavBar; + Designer : TIDesigner; + procedure PopulateFolderList; + procedure PopulateItemList; + end; + +var + frmNavEd: TfrmNavBarEd; + +implementation + +{$IFNDEF LCL} +{$R *.DFM} +{$ENDIF} + +{$IFDEF VERSION6} + procedure EditNavBar(Designer : TIDesigner; Bar : TVpNavBar); +{$ELSE} + procedure EditNavBar(Designer : TIFormDesigner; Bar : TVpNavBar); +{$ENDIF} +var + i : Integer; +begin + frmNavEd := TfrmNavBarEd.Create(Application); + frmNavEd.Bar := Bar; + frmNavEd.PopulateFolderList; + frmNavEd.Designer := Designer; + if Bar.Images <> nil then begin + frmNavEd.lbImages.ItemHeight := Bar.Images.Height + 4; + for i := 0 to pred(Bar.Images.Count) do + frmNavEd.lbImages.Items.Add(IntToStr(i)); + end; + frmNavEd.Show; +end; + +{*** TVpNavBarEditor ***} + +procedure TVpNavBarEditor.ExecuteVerb(Index : Integer); +begin + if Index = 0 then + EditNavBar(Designer, (Component as TVpNavBar)); +end; + +function TVpNavBarEditor.GetVerb(Index : Integer) : string; +begin + if Index = 0 then + Result := 'Layout Tool...'; +end; + +function TVpNavBarEditor.GetVerbCount : Integer; +begin + Result := 1; +end; + +{*** TfrmNavBarEd ***} + +procedure TfrmNavBarEd.FormCreate(Sender: TObject); +begin + Top := (Screen.Height - Height) div 3; + Left := (Screen.Width - Width) div 2; + RefreshTimer := TTimer.Create(Self); + RefreshTimer.Interval := 1000; + RefreshTimer.OnTimer := OnTimer; + RefreshTimer.Enabled := true; +end; +{=====} + +procedure TfrmNavBarEd.FormClose(Sender: TObject; + var Action: TCloseAction); +begin + RefreshTimer.Free; + Release; +end; +{=====} + +{ Changed} +{ Could not find a way to get notification from the IDE that a change had } +{ been made to the component outside of the component editor, so I used a } +{ timer } +procedure TfrmNavBarEd.OnTimer(Sender: TObject); +var + S : string; +begin + if Bar.ActiveFolder < 0 then + exit; + + { update folder } + S := Bar.Folders[Bar.ActiveFolder].Caption; + if S = '' then + S := Bar.Folders[Bar.ActiveFolder].Name; + lbFolders.Items[Bar.ActiveFolder] := S; + + if (lbItems.ItemIndex > -1) then begin + S := lbItems.Items.Strings[lbItems.ItemIndex]; + PopulateItemList; + if S <> '' then + lbItems.ItemIndex := lbItems.Items.IndexOf(S); + end; +end; +{=====} + +procedure TfrmNavBarEd.FormResize(Sender: TObject); +begin + pnlFolders.Width := (pnlItems.Width + pnlFolders.Width) div 2; + if Bar.Images <> nil then begin + pnlImages.Height := 25 + (5 * (Bar.Images.Height div 3)); + lbImages.Columns := lbImages.Width div Bar.Images.Width; + {Allow for scrollbar if excessive number of images} + if (lbImages.Width >= Bar.Images.Width) then + pnlImages.Height := pnlImages.Height + 20; + end; +end; +{=====} + +procedure TfrmNavBarEd.PopulateFolderList; +var + I : Integer; + S : string; +begin + lbFolders.Clear; + for I := 0 to Pred(Bar.FolderCount) do begin + S := Bar.Folders[I].Caption; + if S = '' then + S := Bar.Folders[I].Name; + lbFolders.Items.AddObject(S, Bar.Folders[I]); + end; +end; +{=====} + +procedure TfrmNavBarEd.PopulateItemList; +var + I : Integer; + S : string; +begin + lbItems.Clear; + if lbFolders.ItemIndex = -1 then exit; + with Bar.Folders[lbFolders.ItemIndex] do + for I := 0 to pred(ItemCount) do begin + S := Items[I].Caption; + if S = '' then + S := Items[I].Name; + lbItems.Items.AddObject(S,Items[i]); + end; +end; +{=====} + +procedure TfrmNavBarEd.lbFoldersClick(Sender: TObject); +var +{$IFDEF VERSION5} + {$IFDEF VERSION6} + {$IFNDEF LCL} + SelList : TDesignerSelections; + {$ENDIF} + {$ELSE} + SelList : TDesignerSelectionList; + {$ENDIF} +{$ELSE} + SelList : TComponentList; +{$ENDIF} + i : Integer; +begin +{$IFNDEF LCL} + PopulateItemList; + Bar.ActiveFolder := lbFolders.ItemIndex; + +{$IFDEF VERSION5} + {$IFDEF VERSION6} + SelList := TDesignerSelections.Create; + {$ELSE} + SelList := TDesignerSelectionList.Create; + {$ENDIF} +{$ELSE} + SelList := TComponentList.Create; +{$ENDIF} + for i := 0 to pred(lbFolders.Items.Count) do + if lbFolders.Selected[i] then begin + {$IFDEF VERSION6} + TProtectedSelList(SelList).Add(TComponent(lbFolders.Items.Objects[i])); + {$ELSE} + SelList.Add(TComponent(lbFolders.Items.Objects[i])); + {$ENDIF} + Bar.FolderCollection.DoOnItemSelected(I); + end; + if not Bar.FolderCollection.ReadOnly + then begin + {$IFDEF VERSION6} + btnFolderUp.Enabled := TProtectedSelList(SelList).Count = 1; + {$ELSE} + btnFolderUp.Enabled := SelList.Count = 1; + {$ENDIF} + btnFolderDown.Enabled := btnFolderUp.Enabled; + btnFolderDelete.Enabled := btnFolderUp.Enabled; + end; + {$IFDEF VERSION6} + if TProtectedSelList(SelList).Count > 0 then + {$ELSE} + if SelList.Count > 0 then + {$ENDIF} + SelectList(SelList); +{$ENDIF} +end; +{=====} + +procedure TfrmNavBarEd.lbItemsMeasureItem(Control: TWinControl; + Index: Integer; var Height: Integer); +begin + if (Bar.Images <> nil) then + Height := Bar.Images.Height + 4; +end; +{=====} + +procedure TfrmNavBarEd.lbItemsDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + with TListBox(Control).Canvas do + FillRect(Rect); + if (Bar.Images <> nil) + and (TVpNavBtnItem(lbItems.Items.Objects[Index]).IconIndex > -1) + and (TVpNavBtnItem(lbItems.Items.Objects[Index]).IconIndex < + Bar.Images.Count) + then begin + Bar.Images.Draw(TListBox(Control).Canvas, Rect.Right - Bar.Images.Width, + Rect.Top, TVpNavBtnItem(lbItems.Items.Objects[Index]).IconIndex); + with TListBox(Control).Canvas do + TextOut(Rect.Left + 2, Rect.Top + (Rect.Bottom - Rect.Top) div 3, + TListBox(Control).Items[Index]); + end else + with TListBox(Control).Canvas do + TextOut(Rect.Left + 2, Rect.Top, TListBox(Control).Items[Index]); +end; +{=====} + +procedure TfrmNavBarEd.lbImagesDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + with TListBox(Control).Canvas do + FillRect(Rect); + if (Bar.Images <> nil) then + Bar.Images.Draw(TListBox(Control).Canvas, Rect.Left + 1, Rect.Top + 1, + Index); +end; +{=====} + +procedure TfrmNavBarEd.lbItemsClick(Sender: TObject); +var +{$IFDEF VERSION5} + {$IFDEF VERSION6} + {$IFNDEF LCL} + SelList : TDesignerSelections; + {$ENDIF} + {$ELSE} + SelList : TDesignerSelectionList; + {$ENDIF} +{$ELSE} + SelList : TComponentList; +{$ENDIF} + i : Integer; +begin +{$IFNDEF LCL} + if (lbItems.ItemIndex <> -1) then begin + lbImages.ItemIndex := + TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]).IconIndex; + + {$IFDEF VERSION5} + {$IFDEF VERSION6} + SelList := TDesignerSelections.Create; + {$ELSE} + SelList := TDesignerSelectionList.Create; + {$ENDIF} + {$ELSE} + SelList := TComponentList.Create; + {$ENDIF} + for i := 0 to pred(lbItems.Items.Count) do + if lbItems.Selected[i] then begin + {$IFDEF VERSION6} + TProtectedSelList(SelList).Add(TComponent(lbItems.Items.Objects[i])); + {$ELSE} + SelList.Add(TComponent(lbItems.Items.Objects[i])); + {$ENDIF} + Bar.Folders[Bar.ActiveFolder].ItemCollection.DoOnItemSelected(I); + end; + if not Bar.Folders[Bar.ActiveFolder].ItemCollection.ReadOnly + then begin + {$IFDEF VERSION6} + btnItemUp.Enabled := TProtectedSelList(SelList).Count = 1; + {$ELSE} + btnItemUp.Enabled := SelList.Count = 1; + {$ENDIF} + btnItemDown.Enabled := btnItemUp.Enabled; + btnItemDelete.Enabled := btnItemUp.Enabled; + end; + {$IFDEF VERSION6} + if TProtectedSelList(SelList).Count > 0 then + {$ELSE} + if SelList.Count > 0 then + {$ENDIF} + SelectList(SelList); + end; +{$ENDIF} +end; +{=====} + +procedure TfrmNavBarEd.lbImagesClick(Sender: TObject); +begin + if (lbImages.ItemIndex <> -1) and (lbItems.ItemIndex <> -1) then begin + TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]).IconIndex := + lbImages.ItemIndex; + lbItems.Invalidate; + if assigned(Designer) then + Designer.Modified; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnItemUpClick(Sender: TObject); +var + SaveItemIndex : Integer; + Item: TVpNavBtnItem; +begin + if (lbItems.ItemIndex > 0) then begin + SaveItemIndex := lbItems.ItemIndex; + Item := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]); + + if Item.Index > 0 then + Item.Index := Item.Index - 1; + + if Assigned(Designer) then + Designer.Modified; + + PopulateItemList; + + lbItems.ItemIndex := SaveItemIndex - 1; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnItemDownClick(Sender: TObject); +var + Item: TVpNavBtnItem; +begin + if (lbItems.ItemIndex > -1) then begin + Item := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]); + + if Item.Index < Pred(lbItems.Items.Count) then + Item.Index := Item.Index + 1; + + if Assigned(Designer) then + Designer.Modified; + + PopulateItemList; + + lbItems.ItemIndex := Item.Index; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnFolderUpClick(Sender: TObject); +var + SaveItemIndex : Integer; + Folder: TVpNavFolder; +begin + if (lbFolders.ItemIndex > 0) then begin + SaveItemIndex := lbFolders.ItemIndex; + Folder := TVpNavFolder(lbFolders.Items.Objects[lbFolders.ItemIndex]); + + if Folder.Index > 0 then + Folder.Index := Folder.Index - 1; + + if assigned(Designer) then + Designer.Modified; + + PopulateFolderList; + + lbFolders.ItemIndex := SaveItemIndex - 1; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnFolderDownClick(Sender: TObject); +var + Folder: TVpNavFolder; +begin + if (lbFolders.ItemIndex > -1) then begin + Folder := TVpNavFolder(lbFolders.Items.Objects[lbFolders.ItemIndex]); + + if Folder.Index < pred(lbFolders.Items.Count) then + Folder.Index := Folder.Index + 1; + + if assigned(Designer) then + Designer.Modified; + + PopulateFolderList; + + lbFolders.ItemIndex := Folder.Index; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnItemDeleteClick(Sender: TObject); +begin + if (lbItems.ItemIndex <> -1) then begin + TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]).Free; + lbItems.ItemIndex := -1; + PopulateItemList; + if assigned(Designer) then + Designer.Modified; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnFolderDeleteClick(Sender: TObject); +begin + if (lbFolders.ItemIndex <> -1) then begin + TVpNavFolder(lbFolders.Items.Objects[lbFolders.ItemIndex]).Free; + lbFolders.ItemIndex := -1; + PopulateFolderList; + PopulateItemList; + if assigned(Designer) then + Designer.Modified; + end; +end; +{=====} + +procedure TfrmNavBarEd.btnFolderAddClick(Sender: TObject); +begin + Bar.FolderCollection.Add; + PopulateFolderList; + lbFolders.ItemIndex := lbFolders.Items.Count - 1; + if assigned(Designer) then + Designer.Modified; + lbFoldersClick(Self); +end; +{=====} + +procedure TfrmNavBarEd.btnItemAddClick(Sender: TObject); +begin + if (lbFolders.ItemIndex <> -1) then begin + TVpNavFolder( + lbFolders.Items.Objects[lbFolders.ItemIndex]).ItemCollection.Add; + lbItems.ItemIndex := -1; + PopulateItemList; + if assigned(Designer) then + Designer.Modified; + end; +end; +{=====} + +{$IFDEF VERSION5} + {$IFDEF VERSION6} + {$IFNDEF LCL} + procedure TfrmNavBarEd.SelectList(SelList : TDesignerSelections); + {$ENDIF} + {$ELSE} + procedure TfrmNavBarEd.SelectList(SelList : TDesignerSelectionList); + {$ENDIF} +{$ELSE} +procedure TfrmNavBarEd.SelectList(SelList : TComponentList); +{$ENDIF} +begin +{$IFNDEF LCL} + {$IFNDEF Ver80} + {$IFDEF VERSION4} + if Designer <> nil then + {$IFDEF VERSION6} + (Designer as IDesigner).SetSelections(SelList); + {$ELSE} + (Designer as IFormDesigner).SetSelections(SelList); + {$ENDIF} + {$ELSE} + if Designer <> nil then + (Designer as TFormDesigner).SetSelections(SelList); + {$ENDIF} + SelList.Free; + {$ELSE} + CompLib.SetSelection(Designer, Designer.Form, SelList); + {$ENDIF} +end; +{$ENDIF} +{=====} + +end. + diff --git a/components/tvplanit/source/vpnavbar.pas b/components/tvplanit/source/vpnavbar.pas new file mode 100644 index 000000000..789d186d3 --- /dev/null +++ b/components/tvplanit/source/vpnavbar.pas @@ -0,0 +1,3097 @@ +{*********************************************************} +{* VPNAVBAR.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpNavBar; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,MMSystem, + {$ENDIF} + Messages,Controls, Graphics, Forms, Buttons, SysUtils, + StdCtrls, Classes, ExtCtrls, VpBase, VpConst, VpMisc, VpSR, Math; + +type + {Forward Declaration} + TVpNavFolder = class; + TVpCustomNavBar = class; + + TVpIconSize = (isLarge, isSmall); + TVpBackgroundMethod = (bmNone, bmNormal, bmStretch, bmTile); + TVpFolderDrawingStyle = (dsDefButton, dsEtchedButton, dsCoolTab, + dsStandardTab); + TVpFolderType = (ftDefault, ftContainer); + + TVpFolderContainer = class(TPanel) + protected{Private} + FNavBar : TVpCustomNavBar; + FIndex : Integer; + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + function GetChildOwner: TComponent; override; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Index: Integer Read FIndex; + property NavBar: TVpCustomNavBar read FNavBar; + end; + + TVpNavBtnItem = class(TVpCollectionItem) + protected {private} + {property variables} + FFolder : TVpNavFolder; + FCaption : string; + FDescription : String; + FIconIndex : Integer; + FIconRect : TRect; + FLabelRect : TRect; + FTag : Integer; + {internal variables} + liDisplayName : string; + {property methods} + procedure SetCaption(const Value : string); + procedure SetIconIndex(Value : Integer); + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + property Folder: TVpNavFolder read FFolder; + procedure Assign(Source: TPersistent); override; + property IconRect : TRect read FIconRect; + property LabelRect : TRect read FLabelRect; + published + property Caption : string + read FCaption write SetCaption; + property Description : string + read FDescription write FDescription; + property IconIndex : Integer + read FIconIndex write SetIconIndex; + property Name; + property Tag: Integer + read FTag write FTag; + end; + + TVpNavFolder = class(TVpCollectionItem) + protected {private} + {property variables} + FNavBar : TVpCustomNavBar; + FCaption : string; + FEnabled : Boolean; + FIconSize : TVpIconSize; + FFolderType : TVpFolderType; + FContainerIndex : Integer; + FItems : TVpCollection; + {internal variables} + lfDisplayName : string; + lfRect : TRect; + FTag : Integer; + {property methods} + function GetItem(Index : Integer) : TVpNavBtnItem; + function GetItemCount : Integer; + procedure SetCaption(const Value : string); + procedure SetEnabled(Value : Boolean); + procedure SetFolderType(Value: TVpFolderType); + function CreateContainer: Integer; + procedure SetIconSize(Value : TVpIconSize); + procedure SetItem(Index : Integer; Value : TVpNavBtnItem); + procedure lfGetEditorCaption(var Caption : string); + procedure lfItemChange(Sender : TObject); + procedure DefineProperties(Filer: TFiler); override; + procedure ReadIndex(Reader: TReader); + procedure WriteIndex(Writer: TWriter); + public + constructor Create(Collection : TCollection); override; + destructor Destroy; override; + + function GetContainer: TVpFolderContainer; + + property Items[Index : Integer] : TVpNavBtnItem + read GetItem; + property ItemCount : Integer + read GetItemCount; + property ContainerIndex: Integer + read FContainerIndex write FContainerIndex; + published + property Caption : string + read FCaption write SetCaption; + property Enabled : Boolean + read FEnabled write SetEnabled; + property FolderType: TVpFolderType + read FFolderType write SetFolderType; + property ItemCollection : TVpCollection + read FItems write FItems; + property IconSize : TVpIconSize + read FIconSize write SetIconSize; + property Name; + property Tag: Integer + read FTag write FTag; + end; + + TVpRenameEdit = class(TCustomMemo) + private + protected + procedure KeyPress(var Key: Char); override; + public + FolderIndex : Integer; + ItemIndex : Integer; + constructor Create(AOwner : TComponent); override; + end; + + {NavBar Events} + TVpFolderClickEvent = + procedure(Sender : TObject; Button : TMouseButton; Shift : TShiftState; + Index : Integer) of object; + TVpItemClickEvent = + procedure(Sender : TObject; Button : TMouseButton; Shift : TShiftState; + Index : Integer) of object; + TVpFolderChangeEvent = + procedure(Sender : TObject; Index : Integer; var AllowChange : Boolean; + Dragging : Boolean) of object; + TVpFolderChangedEvent = + procedure(Sender : TObject; Index : Integer) of object; + TVpNABDragOverEvent = + procedure(Sender, Source: TObject; X, Y: Integer; State: TDragState; + var AcceptFolder, AcceptItem: Boolean) of object; + TVpNABDragDropEvent = + procedure(Sender, Source: TObject; X, Y: Integer; + FolderIndex, ItemIndex : Integer) of object; + TVpMouseOverItemEvent = + procedure(Sender : TObject; Item : TVpNavBtnItem) of object; + + + TVpCustomNavBar = class(TVpCustomControl) + protected {private} + {property variables} + FActiveFolder : Integer; + FActiveItem : Integer; + FAllowRearrange : Boolean; + FBackgroundColor : TColor; + FBackgroundImage : TBitmap; + FBackgroundMethod : TVpBackgroundMethod; + FBorderStyle : TBorderStyle; + FButtonHeight : Integer; + FContainers : TVpContainerList; + FDrawingStyle : TVpFolderDrawingStyle; + FFolders : TVpCollection; + FHotFolder : Integer; + FImages : TImageList; + FItemFont : TFont; + FItemSpacing : Word; + FPreviousFolder : Integer; + FPreviousItem : Integer; + FPlaySounds : Boolean; + FSelectedItem : Integer; + FSelectedItemFont : TFont; + FScrollDelta : Integer; + FShowButtons : Boolean; + FSoundAlias : string; + FLoadingFolder : Integer; + + {event variables} + FOnArrange : TNotifyEvent; + FOnDragDrop : TVpNABDragDropEvent; + FOnDragOver : TVpNABDragOverEvent; + FOnFolderChange : TVpFolderChangeEvent; + FOnFolderChanged : TVpFolderChangedEvent; + FOnFolderClick : TVpFolderClickEvent; + FOnItemClick : TVpItemClickEvent; + FOnMouseOverItem : TVpMouseOverItemEvent; + + {internal variables} + nabChanging : Boolean; + nabEdit : TVpRenameEdit; + nabTopItem : Integer; + nabExternalDrag : Boolean; + nabDragFromItem : Integer; + nabDragFromFolder : Integer; + nabDragToItem : Integer; + nabDragToFolder : Integer; + nabDropY : Integer; + nabHitTest : TPoint; {location of mouse cursor} + nabItemsRect : TRect; + nabMouseDown : Boolean; + nabOverButton : Boolean; + nabScrollDownBtn : TSpeedButton; + nabScrollUpBtn : TSpeedButton; + nabTimer : Integer; {timer-pool handle} + nabExternalDragItem : Integer; + nabFolderAccept : Boolean; + nabItemAccept : Boolean; + nabCursorOverItem : Boolean; + nabAcceptAny : Boolean; + nabLastMouseOverItem: Integer; + + {property methods} + function GetFolder(Index : Integer) : TVpNavFolder; + function GetFolderCount : Integer; + function GetContainer(Index: Integer):TVpFolderContainer; + procedure SetActiveFolder(Value : Integer); + procedure SetBackgroundColor(Value : TColor); + procedure SetBackgroundImage(Value : TBitmap); + procedure SetBackgroundMethod(Value : TVpBackgroundMethod); + procedure SetDrawingStyle(Value : TVpFolderDrawingStyle); + procedure SetBorderStyle(const Value : TBorderStyle); + procedure SetButtonHeight(Value : Integer); + procedure SetImages(Value : TImageList); + procedure SetItemFont(Value : TFont); + procedure SetItemSpacing(Value : Word); + procedure SetSelectedItemFont(Value : TFont); + procedure SetScrollDelta(Value : Integer); + + {internal methods} + function nabButtonRect(Index : Integer) : TRect; + procedure nabCommitEdit(Sender : TObject); + procedure DragOver(Source: TObject; + X, Y: Integer; + State: TDragState; + var Accept: Boolean); override; + function nabDropHitTest(X, Y : Integer) : Boolean; + procedure nabFolderChange(Sender : TObject); + procedure nabFolderSelected(Sender : TObject; Index : Integer); + procedure nabFontChanged(Sender : TObject); + procedure nabGetEditorCaption(var Caption : string); + function nabGetFolderArea(Index : Integer) : TRect; + procedure nabGetHitTest(X, Y : Integer; + var FolderIndex : Integer; + var ItemIndex : Integer); + procedure nabImagesChanged(Sender : TObject); + procedure nabRecalcDisplayNames; + procedure nabScrollDownBtnClick(Sender : TObject); + procedure nabScrollUpBtnClick(Sender : TObject); + function nabShowScrollUp : Boolean; + function nabShowScrollDown : Boolean; + procedure nabTimerEvent(Sender : TObject; + Handle : Integer; + Interval : Cardinal; + ElapsedTime : LongInt); + + {VCL message methods} + {$IFNDEF LCL} + procedure CMCtl3DChanged(var Msg : TMessage); message CM_CTL3DCHANGED; + procedure CMDesignHitTest(var Msg : TCMDesignHitTest); message CM_DESIGNHITTEST; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED; + {windows message response methods} + procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd); message WM_ERASEBKGND; + procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE; + procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST; + procedure WMSetCursor(var Msg : TWMSetCursor); message WM_SETCURSOR; + {$ELSE} + procedure CMCtl3DChanged(var Msg : TLMessage); message CM_CTL3DCHANGED; + procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED; + procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; + {windows message response methods} + procedure WMEraseBkGnd(var Msg : TLMEraseBkGnd); message LM_ERASEBKGND; + procedure WMNCHitTest(var Msg : TLMNCHitTest); message LM_NCHITTEST; + {$ENDIF} + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + + {Compound component streaming methods} + procedure Loaded; override; + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + function GetChildOwner: TComponent; override; + function AddContainer(Container: TVpFOlderContainer): Integer; + procedure RemoveContainer(Container: TVpFolderContainer); + + 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 Notification(AComponent : TComponent; + Operation : TOperation); override; + procedure Paint; override; + procedure DoArrange; + procedure DoFolderChange(Index : Integer; var AllowChange : Boolean); + procedure DoFolderChanged(Index : Integer); + procedure DoFolderClick(Button : TMouseButton; + Shift : TShiftState; + Index : Integer); + procedure DoItemClick(Button : TMouseButton; + Shift : TShiftState; + Index : Integer); + procedure DoMouseOverItem(X, Y, ItemIndex : Integer); + + {properties} + property ActiveFolder : Integer + read FActiveFolder write SetActiveFolder; + property AllowRearrange : Boolean + read FAllowRearrange write FAllowRearrange; + property BackgroundColor : TColor + read FBackgroundColor write SetBackgroundColor; + property BackgroundImage : TBitmap + read FBackgroundImage write SetBackgroundImage; + property BackgroundMethod : TVpBackgroundMethod + read FBackgroundMethod write SetBackgroundMethod; + property BorderStyle : TBorderStyle + read FBorderStyle write SetBorderStyle; + property ButtonHeight : Integer + read FButtonHeight write SetButtonHeight; + property DrawingStyle : TVpFolderDrawingStyle + read FDrawingStyle write SetDrawingStyle; + property FolderCollection : TVpCollection + read FFolders write FFolders; + property Images : TImageList + read FImages write SetImages; + property ItemFont : TFont + read FItemFont write SetItemFont; + property ItemSpacing : Word + read FItemSpacing write SetItemSpacing; + property PlaySounds : Boolean + read FPlaySounds write FPlaySounds; + property ScrollDelta : Integer + read FScrollDelta write SetScrollDelta default 2; + property SelectedItem : Integer + read FSelectedItem write FSelectedItem; + property SelectedItemFont : TFont + read FSelectedItemFont write SetSelectedItemFont; + property ShowButtons : Boolean + read FShowButtons write FShowButtons; + property SoundAlias : string + read FSoundAlias write FSoundAlias; +{ property Storage : TOvcAbstractStore + read FStorage write SetStorage;} + + {inherited Events} + property AfterEnter; + property AfterExit; + property OnMouseWheel; + + {events} + property OnArrange : TNotifyEvent + read FOnArrange write FOnArrange; + property OnDragDrop : TVpNABDragDropEvent + read FOnDragDrop write FOnDragDrop; + property OnDragOver : TVpNABDragOverEvent + read FOnDragOver write FOnDragOver; + property OnFolderClick : TVpFolderClickEvent + read FOnFolderClick write FOnFolderClick; + property OnItemClick : TVpItemClickEvent + read FOnItemClick write FOnItemClick; + property OnFolderChange : TVpFolderChangeEvent + read FOnFolderChange write FOnFolderChange; + property OnFolderChanged : TVpFolderChangedEvent + read FOnFolderChanged write FOnFolderChanged; + property OnMouseOverItem : TVpMouseOverItemEvent + read FOnMouseOverItem write FOnMouseOverItem; + + public + constructor Create(AOwner : TComponent); override; + destructor Destroy; override; + procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer); override; + { Declared public because TControl's DragDrop is public. } + procedure DragDrop(Source: TObject; X, Y: Integer); override; + + procedure BeginUpdate; + procedure ItemChanged(FolderIndex, ItemIndex: Integer); + procedure FolderChanged(FolderIndex: Integer); + procedure EndUpdate; + function GetFolderAt(X, Y : Integer) : Integer; + function GetItemAt(X, Y : Integer) : Integer; + function Container: TVpFolderContainer; + procedure InsertFolder(const ACaption : string; AFolderIndex : Integer); + procedure AddFolder(const ACaption : string); + procedure RemoveFolder(AFolderIndex : Integer); + procedure RenameFolder(AFolderIndex : Integer); + procedure InsertItem(const ACaption : string; AFolderIndex, AItemIndex, + AIconIndex : Integer); + procedure AddItem(const ACaption : string; AFolderIndex, + AIconIndex : Integer); + procedure RemoveItem(AFolderIndex, AItemIndex : Integer); + procedure InvalidateItem(FolderIndex, ItemIndex : Integer); + procedure RenameItem(AFolderIndex, AItemIndex : Integer); + property ActiveItem : Integer + read FActiveItem; + property Containers[Index: Integer]: TVpFolderContainer + read GetContainer; + property Folders[Index : Integer] : TVpNavFolder + read GetFolder; + property FolderCount : Integer + read GetFolderCount; + property PreviousFolder : Integer + read FPreviousFolder; + property PreviousItem : Integer + read FPreviousItem; + end; + + + TVpNavBar = class(TVpCustomNavBar) + published + property ActiveFolder; + property AllowRearrange; + property BackgroundColor; + property BackgroundImage; + property BackgroundMethod; + property BorderStyle; + property ButtonHeight; + property DrawingStyle; + property FolderCollection; + property Images; + property ItemFont; + property ItemSpacing; + property PlaySounds; + property ScrollDelta; + property SelectedItem; + property SelectedItemFont; + property ShowButtons; + property SoundAlias; +// property Storage; + + {inherited Events} + property AfterEnter; + property AfterExit; + property OnMouseWheel; + + {events} + property OnArrange; + property OnDragDrop; + property OnDragOver; + property OnFolderClick; + property OnItemClick; + property OnFolderChange; + property OnFolderChanged; + property OnMouseOverItem; + + {inherited properties} + {$IFDEF VERSION4} + property Anchors; + property Constraints; + property DragKind; + {$ENDIF} + property Align; + property Ctl3D; + property DragCursor; + property Enabled; + property Font; +(* + The following properties are not published to avoid conflicts with + OnFolderClick and OnItemClick. + property OnClick; + property OnDblClick; +*) + property OnEndDrag; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + property ParentColor; + property ParentCtl3D; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property Visible; + end; + + +implementation + +const + nabTimerInterval = 200; + +{DrawNavTab - returns the usable text area inside the tab rect.} +function DrawNavTab(Canvas: TCanvas; + const Client: TRect; + BevelWidth: Integer; + TabColor: TColor; + TabNumber: Integer; + CoolTab, + IsFocused, + IsMouseOver: Boolean): TRect; +var + R: TRect; + {$IFNDEF VERSION4} + Points: array[1..5] of TPoint; + {$ENDIF} +begin + R := Client; + + with Canvas do begin + Brush.Color := clBtnFace; + Brush.Style := bsSolid; + Pen.Color := TabColor; + + {fill the tab area} + Polygon([Point(R.Left, R.Bottom), + Point(R.Left, R.Top), + Point(R.Right, R.Top), + Point(R.Right, R.Bottom)]); + + if CoolTab then + {Draw Cool Tabs} + begin + + Pen.Color := clBlack; + + {Draw the bottom, left line} + MoveTo(R.Left, R.Bottom - 1); + LineTo(R.Left + 5, R.Bottom - 1); + + {Draw the bottom, left curve} + {$IFNDEF VERSION4} + Points[1] := Point(R.Left + 5, R.Bottom - 1); + Points[2] := Point(R.Left + 11, R.Bottom - 2); + Points[3] := Point(R.Left + 12, R.Bottom - 7); + Points[4] := Point(R.Left + 13, R.Bottom - 9); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); + {$ELSE} + Canvas.Polyline(Points); + {$ENDIF} + {$ELSE} + PolyBezier([Point(R.Left + 5, R.Bottom - 1), {StartPoint} + Point(R.Left + 11, R.Bottom - 2), {ControlPoint} + Point(R.Left + 12, R.Bottom - 7), {ControlPoint} + Point(R.Left + 13, R.Bottom - 9)]); {EndPoint} + {$ENDIF} + + {Draw the left side of the tab} + MoveTo(R.Left + 13, R.Bottom - 9); + LineTo(R.Left + 13, R.Top + 9); + + {Draw the top, left corner of the tab} + {$IFNDEF VERSION4} + Points[1] := Point(R.Left + 13, R.Top + 9); + Points[2] := Point(R.Left + 14, R.Top + 7); + Points[3] := Point(R.Left + 15, R.Top + 2); + Points[4] := Point(R.Left + 21, R.Top + 1); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); + {$ELSE} + Canvas.Polyline(Points); + {$ENDIF} + {$ELSE} + PolyBezier([Point(R.Left + 13, R.Top + 9), {StartPoint} + Point(R.Left + 14, R.Top + 7), {ControlPoint} + Point(R.Left + 15, R.Top + 2), {ControlPoint} + Point(R.Left + 21, R.Top + 1)]); {EndPoint} + {$ENDIF} + + {Draw the top of the tab} + MoveTo(R.Left + 21, R.Top + 1); + LineTo(R.Right - 16, R.Top + 1); + + {Draw the Top, Right corner of the tab} + {$IFNDEF VERSION4} + Points[1] := Point(R.Right - 16, R.Top + 1); + Points[2] := Point(R.Right - 10, R.Top + 2); + Points[3] := Point(R.Right - 9, R.Top + 7); + Points[4] := Point(R.Right - 8, R.Top + 9); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); + {$ELSE} + Canvas.Polyline(Points); + {$ENDIF} + {$ELSE} + PolyBezier([Point(R.Right - 16, R.Top + 1), {StartPoint} + Point(R.Right - 10, R.Top + 2), {ControlPoint} + Point(R.Right - 9, R.Top + 7), {ControlPoint} + Point(R.Right - 8, R.Top + 9)]); {EndPoint} + {$ENDIF} + + {Draw the right side of the tab} + MoveTo(R.Right - 8, R.Top + 9); + LineTo(R.Right - 8, R.Bottom - 9); + + {Draw the bottom, Right curve of the tab which should finish against the + right side.} + {$IFNDEF VERSION4} + Points[1] := Point(R.Right - 8, R.Bottom - 9); + Points[2] := Point(R.Right - 7, R.Bottom - 7); + Points[3] := Point(R.Right - 6, R.Bottom - 2); + Points[4] := Point(R.Right, R.Bottom - 1); + {$IFDEF CBuilder} + Canvas.PolyBezier(Points); + {$ELSE} + Canvas.Polyline(Points); + {$ENDIF} + {$ELSE} + PolyBezier([Point(R.Right - 8, R.Bottom - 9), {StartPoint} + Point(R.Right - 7, R.Bottom - 7), {ControlPoint} + Point(R.Right - 6, R.Bottom - 2), {ControlPoint} + Point(R.Right, R.Bottom - 1)]); {EndPoint} + {$ENDIF} + + end else begin + {Draw Standard Tabs} + + if TabNumber > 0 then begin + Brush.Color := TabColor; + Brush.Style := bsSolid; + Pen.Color := TabColor; + + {fill the tab area} + Polygon([Point(R.Left, R.Bottom), + Point(R.Left, R.Top), + Point(R.Right, R.Top), + Point(R.Right, R.Bottom)]); + end; + + Brush.Color := TabColor; + Brush.Style := bsSolid; + + {Draw Tab} + Pen.Color := TabColor; + Polygon([Point(R.Left + 10, R.Bottom - 1), + Point(R.Left + 10, R.Top + 3), + Point(R.Left + 12, R.Top + 1), + Point(R.Right-4, R.Top+1), + Point(R.Right-2, R.Top+3), + Point(R.Right-2, R.Bottom-1)]); + + {highlight tab} + Pen.Color := clBtnHighlight; + PolyLine([Point(R.Left, R.Bottom - 2), + Point(R.Left + 8, R.Bottom - 2), + Point(R.Left + 9, R.Bottom - 3), + Point(R.Left + 9, R.Top + 3), + Point(R.Left + 11, R.Top + 1), + Point(R.Right - 1, R.Top + 1)]); + + {draw border} + Pen.Color := clBlack; + PolyLine([Point(R.Left, R.Bottom - 1), + Point(R.Left + 9, R.Bottom - 1), + Point(R.Left + 10, R.Bottom - 2), + Point(R.Left + 10, R.Top + 4), + Point(R.Left + 11, R.Top + 3), + Point(R.Left + 12, R.Top + 2), + Point(R.Right-2, R.Top + 2), + Point(R.Right-1, R.Top + 3), + Point(R.Right-1, R.Bottom-1)]); + + {draw shadow} + end; + end; + + Result := Rect(Client.Left + 1, Client.Top + 1, + Client.Right - 2, Client.Bottom - 2); + if IsFocused then OffsetRect(Result, 1, 1); +end; + +{===== TVpFolderContainer ===========================================} +constructor TVpFolderContainer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FNavBar := TVpCustomNavBar(AOwner); + Width := 0; + Height := 0; + Visible := false; + {Add self to container list} + FIndex := FNavBar.AddContainer(Self); +end; +{=====} + +destructor TVpFolderContainer.Destroy; +begin + {FComponentList.Free;} + inherited; +end; +{=====} + +function TVpFolderContainer.GetChildOwner: TComponent; +begin + Result := Owner.Owner; +end; +{=====} + +procedure TVpFolderContainer.GetChildren(Proc: TGetChildProc; Root: TComponent); +var + I: Integer; + C: TControl; +begin + inherited GetChildren(Proc, Self); + for I := 0 to ControlCount - 1 do begin + C := Controls[I]; + C.Parent := Self; + Proc(C); + end; +end; + +{===== TRenameEdit ===================================================} + +constructor TVpRenameEdit.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + + Ctl3D := False; + Visible := False; + WantReturns := False; + FolderIndex := -1; + ItemIndex := -1; +end; +{=====} + +procedure TVpRenameEdit.KeyPress(var Key: Char); +begin + if Key = #13 then begin + Key := #0; + DoExit; + end else if Key = #27 then begin + FolderIndex := -1; + ItemIndex := -1; + Key := #0; + DoExit; + end; +end; + +{===== Miscellaneous routines ========================================} + +function RectWidth(Rect : TRect) : Integer; +begin + Result := Rect.Right - Rect.Left; +end; +{=====} + +function RectHeight(Rect : TRect) : Integer; +begin + Result := Rect.Bottom - Rect.Top; +end; + + +{===== TVpNavBtnItem ===============================================} + +constructor TVpNavBtnItem.Create(Collection : TCollection); +begin + inherited Create(Collection); + FFolder := TVpNavFolder((TVpCollection(Collection)).GetOwner); + FIconIndex := -1; + Name := 'Item' + IntToStr(FFolder.Index) + '-' + IntToStr(Index); + FFolder.FNavBar.Invalidate; +end; +{=====} + +destructor TVpNavBtnItem.Destroy; +var + NaBar: TVpCustomNavBar; + FolderIndex: Integer; +begin + NaBar := FFolder.FNavBar; + FolderIndex := FFolder.Index; + inherited Destroy; + NaBar.FolderChanged(FolderIndex); +end; +{=====} + +procedure TVpNavBtnItem.Assign(Source: TPersistent); +begin + if Source is TVpNavBtnItem then begin + Caption := TVpNavBtnItem(Source).Caption; + Description := TVpNavBtnItem(Source).Description; + IconIndex := TVpNavBtnItem(Source).IconIndex; + Tag := TVpNavBtnItem(Source).Tag; + end else + inherited Assign(Source); +end; +{=====} + +procedure TVpNavBtnItem.SetCaption(const Value : string); +begin + if Value <> FCaption then begin + FCaption := Value; + Changed(false); + FFolder.FNavBar.ItemChanged(FFolder.Index, Index); + end; +end; +{=====} + +procedure TVpNavBtnItem.SetIconIndex(Value : Integer); +begin + if Value <> FIconIndex then begin + FIconIndex := Value; + Changed(false); + FFolder.FNavBar.ItemChanged(FFolder.Index, Index); + end; +end; + +{===== TVpNavBtnFolder =============================================} + +constructor TVpNavFolder.Create(Collection : TCollection); +begin + inherited Create(Collection); + RegisterClass(TVpFolderContainer); + FNavBar := TVpCustomNavBar(TVpCollection(Collection).GetOwner); + FNavBar.ActiveFolder := Index; + FItems := TVpCollection.Create(Self, TVpNavBtnItem); + Name := 'NavFolder' + IntToStr(Index); + FEnabled := True; + FIconSize := isLarge; +end; +{=====} + +destructor TVpNavFolder.Destroy; +begin + {Change the Active Folder to one that will still exist} + if not(csDestroying in FNavBar.ComponentState) then begin + if Index > 0 then + FNavBar.ActiveFolder := Index - 1 + else if Collection.Count > 1 then + FNavBar.ActiveFolder := 0 + else + FNavBar.ActiveFolder := -1; + + FNavBar.FolderChanged(Index); + end; + + FItems.Free; + FItems := nil; + inherited Destroy; +end; +{=====} + +function TVpNavFolder.GetItem(Index : Integer) : TVpNavBtnItem; +begin + Result := TVpNavBtnItem(FItems[Index]); +end; +{=====} + +function TVpNavFolder.GetItemCount : Integer; +begin + Result := FItems.Count; +end; +{=====} + +function TVpNavFolder.GetContainer: TVpFolderContainer; +begin + if FolderType = ftContainer then + result := FNavBar.FContainers[FContainerIndex] + else + result := nil; +end; +{=====} + +procedure TVpNavFolder.lfGetEditorCaption(var Caption : string); +begin + Caption := RSEditingItems; +end; +{=====} + +procedure TVpNavFolder.lfItemChange(Sender : TObject); +begin + if (TVpCollection(Collection).GetOwner is TComponent) then + if not (csDestroying in + TComponent(TVpCollection(Collection).GetOwner).ComponentState) + then begin + TVpNavBar(TVpCollection(Collection).GetOwner).nabRecalcDisplayNames; + TVpNavBar(TVpCollection(Collection).GetOwner).Invalidate; + end; +end; +{=====} + +procedure TVpNavFolder.DefineProperties(Filer: TFiler); +begin + Filer.DefineProperty('ContainerIndex', ReadIndex, WriteIndex, + FFolderType = ftContainer); +end; +{=====} + +procedure TVpNavFolder.ReadIndex(Reader: TReader); +begin + ContainerIndex := trunc(Reader.ReadFloat); +end; +{=====} + +procedure TVpNavFolder.WriteIndex(Writer: TWriter); +begin + Writer.WriteFloat(ContainerIndex); +end; +{=====} + +procedure TVpNavFolder.SetCaption(const Value : string); +begin + if FCaption <> Value then begin + FCaption := Value; + Changed(false); + FNavBar.FolderChanged(Index); + end; +end; +{=====} + +procedure TVpNavFolder.SetEnabled(Value : Boolean); +begin + if Value <> FEnabled then begin + FEnabled := Value; + Changed(false); + FNavBar.FolderChanged(Index); + end; +end; +{=====} + +procedure TVpNavFolder.SetFolderType(Value: TVpFolderType); +begin + if Value <> FFolderType then begin + FFolderType := Value; + + if not (csLoading in FNavBar.ComponentState) then begin + if FFolderType = ftContainer then + ContainerIndex := CreateContainer + else begin + FNavBar.FContainers.Delete(FContainerIndex); + FContainerIndex := -1; + end; + FNavBar.FolderChanged(Index); + end; + end; +end; +{=====} + +function TVpNavFolder.CreateContainer: Integer; +var + New: TVpFolderContainer; +begin + New := TVpFolderContainer.Create(FNavBar); + New.Parent := FNavBar; + result := New.Index; + New.Name := 'Container' + IntToStr(Result); + New.Caption := ''; + New.BevelOuter := bvNone; + New.BevelInner := bvNone; + New.Color := FNavBar.FBackgroundColor; +end; +{=====} + +procedure TVpNavFolder.SetIconSize(Value : TVpIconSize); +begin + if FIconSize <> Value then begin + FIconSize := Value; + Changed(false); + FNavBar.FolderChanged(Index); + end; +end; +{=====} + +procedure TVpNavFolder.SetItem(Index : Integer; Value : TVpNavBtnItem); +begin + SetItem(Index, Value); +end; + +{===== TVpNavBar ================================================} +constructor TVpCustomNavBar.Create(AOwner : TComponent); +var + HSnd : THandle; +begin + inherited Create(AOwner); + + FContainers := TVpContainerList.Create(Self); + + FLoadingFolder := -1; + FShowButtons := True; + + if Classes.GetClass(TVpNavFolder.ClassName) = nil then + Classes.RegisterClass(TVpNavFolder); + if Classes.GetClass(TVpNavBtnItem.ClassName) = nil then + Classes.RegisterClass(TVpNavBtnItem); + + FFolders := TVpCollection.Create(Self, TVpNavFolder); + FFolders.OnChanged := nabFolderChange; + FFolders.OnGetEditorCaption := nabGetEditorCaption; + FFolders.OnItemSelected := nabFolderSelected; + + FItemFont := TFont.Create; + FItemFont.Name := Font.Name; + FItemFont.OnChange := nabFontChanged; + FItemFont.Color := clWhite; + FItemSpacing := abs(FItemFont.Height) + 3; + + FSelectedItemFont := TFont.Create; + FSelectedItemFont.Name := Font.Name; + FSelectedItemFont.OnChange := nabFontChanged; + FSelectedItemFont.Color := FItemFont.Color; + FSelectedItemFont.Style := FItemFont.Style; + FSelectedItemFont.Size := FItemFont.Size; + + {force drivers to load by playing empty wave data} +{ HSnd := FindResource(HInstance, 'VPEMPTYWAVE', RT_RCDATA); + if HSnd > 0 then begin + HSnd := LoadResource(HInstance, HSnd); + if HSnd > 0 then begin + sndPlaySound(LockResource(HSnd), SND_ASYNC or SND_MEMORY); + FreeResource(HSnd); + end; + end;} + + nabScrollUpBtn := TSpeedButton.Create(Self); + with nabScrollUpBtn do begin + Visible := False; + Parent := Self; + OnClick := nabScrollUpBtnClick; + Glyph.Handle := LoadBaseBitmap('VPUPARROW'); + NumGlyphs := 1; + Left := -20; + Height := 15; + Width := 17; + end; + + nabScrollDownBtn := TSpeedButton.Create(Self); + with nabScrollDownBtn do begin + Visible := False; + Parent := Self; + OnClick := nabScrollDownBtnClick; + Glyph.Handle := LoadBaseBitmap('VPDOWNARROW'); + NumGlyphs := 1; + Left := -20; + Height := 15; + Width := 17; + end; + + {create edit control} + if not (csDesigning in ComponentState) then begin + nabEdit := TVpRenameEdit.Create(Self); + nabEdit.Parent := Self; + nabEdit.OnExit := nabCommitEdit; + end; + + Height := 240; + Width := 120; + ParentColor := False; + + FAllowRearrange := True; + FBackgroundColor := clInactiveCaption; + FBackgroundImage := TBitmap.Create; + FBackgroundMethod := bmNormal; + FBorderStyle := bsSingle; + FButtonHeight := 20; + FActiveFolder := -1; + FActiveItem := -1; + FSelectedItem := -1; + FHotFolder := -1; + FPreviousFolder := -1; + FPreviousItem := -1; + FPlaySounds := False; + FScrollDelta := 2; + FSoundAlias := 'MenuCommand'; + + nabMouseDown := False; + nabChanging := False; + nabTopItem := 0; + nabDragFromItem := -1; + nabDragFromFolder := -1; + nabDropY := -1; + nabTimer := -1; + nabLastMouseOverItem := -1; +end; +{=====} + +destructor TVpCustomNavBar.Destroy; +begin + Images := nil; {unregister any image list notification} + nabChanging := True; + + nabEdit.Free; + + FContainers.Free; + + FFolders.Free; + FFolders := nil; + + FItemFont.Free; + FItemFont := nil; + + FSelectedItemFont.Free; + FSelectedItemFont := nil; + + FBackgroundImage.Free; + FBackgroundImage := nil; + + inherited Destroy; +end; +{=====} + +procedure TVpCustomNavBar.BeginUpdate; +begin + nabChanging := True; +end; +{=====} + +procedure TVpCustomNavBar.ItemChanged(FolderIndex, ItemIndex: Integer); +begin + InvalidateItem(FolderIndex, ItemIndex); + if not (csDestroying in ComponentState) then + RecreateWnd{$IFDEF LCL}(self){$ENDIF}; +end; +{=====} + +procedure TVpCustomNavBar.FolderChanged(FolderIndex: Integer); +begin + Invalidate; + if not (csDestroying in ComponentState) then + RecreateWnd{$IFDEF LCL}(self){$ENDIF}; +end; +{=====} + +procedure TVpCustomNavBar.CMCtl3DChanged(var Msg : {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); +begin + if (csLoading in ComponentState) or not HandleAllocated then + Exit; + + if NewStyleControls and (FBorderStyle = bsSingle) then + RecreateWnd{$IFDEF LCL}(self){$ENDIF}; + + inherited; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpCustomNavBar.CMDesignHitTest(var Msg : TCMDesignHitTest); +begin + Msg.Result := LongInt(nabOverButton); +end; +{$ENDIF} +{=====} + +procedure TVpCustomNavBar.CMFontChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); +begin + nabRecalcDisplayNames; +end; +{=====} + +procedure TVpCustomNavBar.CMParentColorChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); +begin + inherited; + + if ParentColor then + SetBackgroundColor(Color); +end; +{=====} + +procedure TVpCustomNavBar.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + with Params do + Style := LongInt(Style) or BorderStyles[FBorderStyle]; + + if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin + Params.Style := Params.Style and not WS_BORDER; + Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; + end; +end; +{=====} + +procedure TVpCustomNavBar.CreateWnd; +begin + if (csDestroying in ComponentState) then exit; + inherited CreateWnd; + + nabRecalcDisplayNames; +end; +{=====} + +procedure TVpCustomNavBar.Loaded; +begin + inherited Loaded; + if DrawingStyle = dsEtchedButton then + BorderStyle := bsNone; + if FolderCollection.Count > 0 then + FActiveFolder := 0 + else + FActiveFolder := -1; +end; +{=====} + +procedure TVpCustomNavBar.GetChildren(Proc: TGetChildProc; Root: TComponent); +var + I: Integer; +begin + for I := 0 to FContainers.Count - 1 do + Proc(TComponent(FContainers[I])); +end; +{=====} + +function TVpCustomNavBar.AddContainer( + Container: TVpFolderContainer): Integer; +begin + result := FContainers.Add(Container); +end; +{=====} + +procedure TVpCustomNavBar.RemoveContainer(Container: TVpFolderContainer); +begin + FContainers.Remove(Container); + Container.Free; +end; +{=====} + +procedure TVpCustomNavBar.DoArrange; +begin + if Assigned(FOnArrange) then + FOnArrange(Self); +end; +{=====} + +procedure TVpCustomNavBar.DoFolderChange(Index : Integer; + var AllowChange: Boolean); +begin + if Assigned(FOnFolderChange) then + FOnFolderChange(Self, Index, AllowChange, nabDragFromItem <> -1); +end; +{=====} + +procedure TVpCustomNavBar.DoFolderChanged(Index : Integer); +begin + if Assigned(FOnFolderChanged) then + FOnFolderChanged(Self, Index); +end; +{=====} + +procedure TVpCustomNavBar.DoFolderClick(Button : TMouseButton; + Shift : TShiftState; + Index : Integer); +begin + if Assigned(FOnFolderClick) then + FOnFolderClick(Self, Button, Shift, Index); +end; +{=====} + +procedure TVpCustomNavBar.DoItemClick(Button : TMouseButton; + Shift : TShiftState; + Index : Integer); +begin + if Assigned(FOnItemClick) then + FOnItemClick(Self, Button, Shift, Index); +end; +{=====} + +procedure TVpCustomNavBar.DoMouseOverItem(X, Y, ItemIndex : Integer); +begin + if Assigned(FOnMouseOverItem) then + FOnMouseOverItem(Self, + Folders[ActiveFolder].Items[GetItemAt(X, Y)]); +end; +{=====} + +procedure TVpCustomNavBar.EndUpdate; +begin + nabChanging := False; + nabRecalcDisplayNames; +end; +{=====} + +function TVpCustomNavBar.GetFolderCount : Integer; +begin + Result := FFolders.Count; +end; +{=====} + +function TVpCustomNavBar.GetFolder(Index : Integer) : TVpNavFolder; +begin + Result := TVpNavFolder(FFolders.GetItem(Index)); +end; +{=====} + +function TVpCustomNavBar.GetFolderAt(X, Y : Integer) : Integer; +var + Dummy : Integer; +begin + nabGetHitTest(X, Y, Result, Dummy); +end; +{=====} + +function TVpCustomNavBar.GetContainer(Index: Integer):TVpFolderContainer; +begin + try + result := FContainers[Index]; + except + result := nil; + end; +end; +{=====} + +function TVpCustomNavBar.GetItemAt(X, Y : Integer) : Integer; +var + Dummy : Integer; +begin + nabGetHitTest(X, Y, Dummy, Result); +end; +{=====} + +function TVpCustomNavBar.Container: TVpFolderContainer; +begin + if Folders[FActiveFolder].FolderType = ftContainer then + result := FContainers[Folders[FActiveFolder].ContainerIndex] + else + result := nil; +end; +{=====} + +procedure TVpCustomNavBar.InsertFolder(const ACaption : string; + AFolderIndex : Integer); +{$IFNDEF VERSION4} +var + I : Integer; +{$ENDIF} +begin +{$IFNDEF VERSION4} + FFolders.Add; + for I := AFolderIndex to FFolders.Count - 2 do begin + Folders[I].Index := I + 1; + end; + Folders[FFolders.Count - 1].Index := AFolderIndex; +{$ELSE} + FFolders.Insert(AFolderIndex); +{$ENDIF} + Folders[AFolderIndex].Caption := ACaption; + if FolderCount = 1 then begin + FActiveFolder := 0; + FActiveItem := -1; + FSelectedItem := -1; + end; + nabRecalcDisplayNames; +end; +{=====} + +procedure TVpCustomNavBar.AddFolder(const ACaption : string); +var + NewFolder: TVpNavFolder; +begin + NewFolder := TVpNavFolder(FFolders.Add); + NewFolder.Caption := ACaption; + if FolderCount = 1 then begin + FActiveFolder := 0; + FActiveItem := -1; + FSelectedItem := -1; + end; + nabRecalcDisplayNames; +end; +{=====} + +procedure TVpCustomNavBar.RemoveFolder(AFolderIndex : Integer); +var + Folder: TVpNavFolder; +begin + Folder := TVpNavFolder(FolderCollection.Items[AFolderIndex]); + Folder.Free; + {$IFDEF VERSION5} + FolderCollection.Delete(AFolderIndex); + {$ENDIF} +end; +{=====} + +procedure TVpCustomNavBar.RenameFolder(AFolderIndex: Integer); +var + Folder : TVpNavFolder; +begin + Folder := Folders[AFolderIndex]; + nabEdit.FolderIndex := AFolderIndex; + nabEdit.ItemIndex := -1; + nabEdit.Font.Size := Font.Size; + nabEdit.BorderStyle := bsNone; + nabEdit.Top := Folder.lfRect.Top+2; + nabEdit.Left := Folder.lfRect.Left+2; + nabEdit.Height := HeightOf(Folder.lfRect)-5; + nabEdit.Width := Folder.lfRect.Right - Folder.lfRect.Left-5; + nabEdit.Visible := True; + nabEdit.Text := Folder.Caption; + nabEdit.SelectAll; + nabEdit.SetFocus; +end; +{=====} + +procedure TVpCustomNavBar.InsertItem(const ACaption : string; + AFolderIndex, AItemIndex, + AIconIndex : Integer); +var + AFolder : TVpNavFolder; +{$IFNDEF VERSION4} + I : Integer; +{$ENDIF} +begin + AFolder := Folders[AFolderIndex]; +{$IFNDEF VERSION4} + AFolder.FItems.Add; + for I := AFolderIndex to AFolder.FItems.Count - 2 do + AFolder.Items[I].Index := I + 1; + AFolder.Items[AFolder.FItems.Count-1].Index := AFolderIndex; +{$ELSE} + AFolder.FItems.Insert(AItemIndex); +{$ENDIF} + AFolder.Items[AItemIndex].Caption := ACaption; + AFolder.Items[AItemIndex].IconIndex := AIconIndex; + Invalidate; +end; +{=====} + +procedure TVpCustomNavBar.AddItem(const ACaption : string; + AFolderIndex, + AIconIndex : Integer); +var + AFolder : TVpNavFolder; + AItem: TVpNavBtnItem; +begin + AFolder := Folders[AFolderIndex]; + AItem := TVpNavBtnItem(AFolder.FItems.Add); + AItem.Caption := ACaption; + AItem.IconIndex := AIconIndex; + Invalidate; +end; +{=====} + +procedure TVpCustomNavBar.RemoveItem(AFolderIndex, AItemIndex : Integer); +var + Folder : TVpNavFolder; +begin + Folder := TVpNavFolder(FolderCollection.GetItem(AFolderIndex)); + Folder.Items[AItemIndex].Free; + {$IFDEF VERSION5} + FolderCollection.Delete(AItemIndex); + {$ENDIF} +end; +{=====} + +procedure TVpCustomNavBar.InvalidateItem(FolderIndex, ItemIndex : Integer); +var + F : TRect; + R : TRect; +begin + R := TVpNavBtnItem(Folders[FolderIndex].Items[ItemIndex]).FIconRect; + {expand rect} + Dec(R.Top); + Dec(R.Left); + Inc(R.Bottom, 2); + Inc(R.Right, 2); + { Might be a hidden folder. } + if (not ((FolderCount = 1) and (Folders[0].Caption = ''))) + or (csDesigning in ComponentState) then + F := nabGetFolderArea(FolderIndex) + else + F := R; + R.Top := Max(R.Top, F.Top); + R.Bottom := Min(R.Bottom, F.Bottom); + if RectHeight(R) > 0 then + InvalidateRect(Handle, @R, False); +end; +{=====} + +procedure TVpCustomNavBar.RenameItem(AFolderIndex, AItemIndex : Integer); +var + Item : TVpNavBtnItem; +begin + Item := Folders[AFolderIndex].Items[AItemIndex]; + nabEdit.FolderIndex := AFolderIndex; + nabEdit.ItemIndex := AItemIndex; + nabEdit.Font.Size := ItemFont.Size; + nabEdit.Font.Size := ItemFont.Size; + nabEdit.BorderStyle := bsSingle; + nabEdit.Top := Item.LabelRect.Top-1; + nabEdit.Left := 10; + nabEdit.Height := HeightOf(Item.LabelRect) + 2; + nabEdit.Width := Width - 24; + nabEdit.Visible := True; + nabEdit.Text := Item.Caption; + nabEdit.SelectAll; + nabEdit.SetFocus; +end; +{=====} + +function GetLargeIconDisplayName(Canvas : TCanvas; + Rect : TRect; + const Name : string) : string; + {-given a string, and a rectangle, find the string that can be displayed + using two lines. Add ellipsis to the end of each line if necessary and + possible} +var + TestRect : TRect; + SH, DH : Integer; + Buf : array[0..255] of Char; + I : Integer; + TempName : string; + Temp2 : string; +begin + TempName := Trim(Name); + {get single line height} + with TestRect do begin + Left := 0; + Top := 0; + Right := 1; + Bottom := 1; + end; + SH := DrawText(Canvas.Handle, 'W W', 3, TestRect, + DT_SINGLELINE or DT_CALCRECT); + + {get double line height} + with TestRect do begin + Left := 0; + Top := 0; + Right := 1; + Bottom := 1; + end; + DH := DrawText(Canvas.Handle, 'W W', 3, TestRect, + DT_WORDBREAK or DT_CALCRECT); + + {see if the text can fit within the existing rect without growing} + TestRect := Rect; + StrPLCopy(Buf, TempName, 255); + DrawText(Canvas.Handle, Buf, Length(TempName), TestRect, + DT_WORDBREAK or DT_CALCRECT); + I := Pos(' ', TempName); + if (RectHeight(TestRect) = SH) or (I < 2) then + Result := GetDisplayString(Canvas, TempName, 1, RectWidth(Rect)) + else begin + {the first line only has ellipsis if there's only one word on it and + that word won't fit} + Temp2 := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, + RectWidth(Rect)); + if CompareStr(Temp2, Copy(TempName, 1, I-1)) <> 0 then begin + Result := GetDisplayString(Canvas, Copy(TempName, 1, I-1), 1, + RectWidth(Rect)) + + ' ' + + GetDisplayString(Canvas, Copy(TempName, I+1, + Length(TempName) - I), 1, RectWidth(Rect)); + end else begin + {2 or more lines, and the first line isn't getting an ellipsis} + if (RectHeight(TestRect) = DH) and + (RectWidth(TestRect) <= RectWidth(Rect)) then + {it will fit} + Result := TempName + else begin + {it won't fit, but the first line wraps OK - 2nd line needs an ellipsis} + TestRect.Right := Rect.Right + 1; + while (RectWidth(TestRect) > RectWidth(Rect)) or + (RectHeight(TestRect) > DH) do begin + if Length(TempName) > 1 then begin + TestRect := Rect; + Delete(TempName, Length(TempName), 1); + TempName := Trim(TempName); + StrPLCopy(Buf, TempName + '...', 255); + DrawText(Canvas.Handle, Buf, Length(TempName) + 3, TestRect, + DT_WORDBREAK or DT_CALCRECT); + Result := TempName + '...'; + end else begin + Result := TempName + '..'; + TestRect := Rect; + StrPLCopy(Buf, Result, 255); + DrawText(Canvas.Handle, Buf, Length(Result), TestRect, + DT_WORDBREAK or DT_CALCRECT); + if (RectWidth(TestRect) <= RectWidth(Rect)) and + (RectHeight(TestRect) > DH) then + Break; + Result := TempName + '.'; + TestRect := Rect; + StrPLCopy(Buf, Result, 255); + DrawText(Canvas.Handle, Buf, Length(Result), TestRect, + DT_WORDBREAK or DT_CALCRECT); + if (RectWidth(TestRect) <= RectWidth(Rect)) and + (RectHeight(TestRect) > DH) then + Break; + Result := TempName; + end; + end; + end; + end; + end; +end; +{=====} + +function TVpCustomNavBar.nabButtonRect(Index : Integer) : TRect; +begin + Result := Folders[Index].lfRect; +end; +{=====} + +procedure TVpCustomNavBar.nabCommitEdit(Sender : TObject); +var + Folder : TVpNavFolder; + Item : TVpNavBtnItem; +begin + if not Assigned(nabEdit) then + Exit; + + if (nabEdit.FolderIndex > -1) then begin + if nabEdit.ItemIndex = -1 then begin + {rename the folder} + Folder := Folders[nabEdit.FolderIndex]; + Folder.Caption := nabEdit.Text; + end else begin + Item := Folders[nabEdit.FolderIndex].Items[nabEdit.ItemIndex]; + Item.Caption := nabEdit.Text; + end; + end; + nabEdit.FolderIndex := -1; + nabEdit.ItemIndex := -1; + nabEdit.Visible := False; + Update; +end; +{=====} + +function TVpCustomNavBar.nabDropHitTest(X, Y : Integer) : Boolean; + {given an X, Y, is this a legal spot to drop a folder?} +var + I : Integer; + SpaceTop : Integer; + SpaceBottom : Integer; + OldDrop : Integer; + Folder : TVpNavFolder; +begin + Result := False; + {assume that X,Y aren't on a folder or item} + OldDrop := nabDropY; + try + nabDragToFolder := -1; + nabDragToItem := -1; + if FolderCount = 0 then + Exit; + + Folder := Folders[FActiveFolder]; + if Y <= Folder.lfRect.Bottom then + Exit; + + if FolderCount > FActiveFolder+1 then + if Y >= Folders[FActiveFolder+1].lfRect.Top then + Exit; + + if (X < 0) or (X > ClientWidth) then + Exit; + + {we're somewhere in the active folder} + if Folder.ItemCount = 0 then begin + {the active folder is empty} + nabDropY := Folders[FActiveFolder].lfRect.Bottom + 3; + nabDragToFolder := FActiveFolder; + nabDragToItem := 0; + Result := True; + Exit; + end; + + for I := nabTopItem to Folder.ItemCount-1 do begin + {is there space above this item?} + if I = nabTopItem then + SpaceTop := Folder.lfRect.Bottom+1 + else + SpaceTop := TVpNavBtnItem(Folder.Items[I - 1]).FLabelRect.Bottom + 1; + SpaceBottom := TVpNavBtnItem(Folder.Items[I]).FIconRect.Top - 1; + if (Y >= SpaceTop) and (Y <= SpaceBottom) then begin + if SpaceTop - SpaceBottom < 6 then + nabDropY := SpaceTop + (SpaceBottom - SpaceTop) div 2 + else + nabDropY := SpaceTop + 3; + Result := True; + nabDragToFolder := FActiveFolder; + nabDragToItem := I; + nabExternalDragItem := I; + Exit; + end; + end; + + {check below the last item...} + SpaceTop := + TVpNavBtnItem(Folder.Items[Folder.ItemCount - 1]).FLabelRect.Bottom+1; + SpaceBottom := nabItemsRect.Bottom - 1; + if (Y >= SpaceTop) and (Y <= SpaceBottom) then begin + nabDropY := SpaceTop + 3; + nabDragToFolder := FActiveFolder; + nabDragToItem := Folder.ItemCount; + if nabFolderAccept then + nabExternalDragItem := nabDragToItem + else + nabExternalDragItem := Folder.ItemCount - 1; + Result := True; + end; + + finally + if (nabDropY <> OldDrop) then + Repaint; + end; +end; +{=====} + +procedure TVpCustomNavBar.nabFolderChange(Sender : TObject); +var + ParentForm: TCustomForm; +begin + if not (csDestroying in ComponentState) then begin + + if FolderCount = 0 then + FActiveFolder := -1 + else begin + if Folders[FActiveFolder].FolderType = ftContainer then begin + ParentForm := GetParentForm(Self); + if ParentForm <> nil then + if ContainsControl(ParentForm.ActiveControl) then + ParentForm.ActiveControl := Self; + end; + if FActiveFolder = -1 then + FActiveFolder := 0; + if FActiveFolder >= FolderCount then + FActiveFolder := 0; + end; + nabTopItem := 0; + nabRecalcDisplayNames; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.nabFolderSelected(Sender : TObject; Index : Integer); +begin + if not (csDestroying in ComponentState) then + ActiveFolder := Index; +end; +{=====} + +procedure TVpCustomNavBar.nabFontChanged(Sender : TObject); +begin + Perform(CM_FONTCHANGED, 0, 0); +end; +{=====} + +procedure TVpCustomNavBar.nabGetEditorCaption(var Caption : string); +begin + Caption := RSEditingFolders; +end; +{=====} + +procedure TVpCustomNavBar.nabGetHitTest(X, Y : Integer; + var FolderIndex : Integer; + var ItemIndex : Integer); +var + I : Integer; + Item : TVpNavBtnItem; + Folder : TVpNavFolder; +begin + FolderIndex := -1; + ItemIndex := -1; + + if FolderCount > 0 then begin + {see if we've hit a folder} + for I := 0 to FolderCount-1 do begin + Folder := Folders[I]; + if PtInRect(Folder.lfRect, Point(X, Y)) then begin + nabCursorOverItem := False; + FolderIndex := I; + Exit; + end; + end; + + {nope, check the active folder to see if we've hit an item} + Folder := Folders[FActiveFolder]; + for I := nabTopItem to Folder.ItemCount-1 do begin + Item := Folder.Items[I]; + if PtInRect(Item.FIconRect, Point(X,Y)) or + (PtInRect(Item.FLabelRect, Point(X,Y)) and + (Item.Caption <> '')) then begin + if nabExternalDrag then begin + nabCursorOverItem := True; + nabExternalDragItem := I; + end; + ItemIndex := I; + Exit; + end else + if nabExternalDrag then + nabCursorOverItem := False; + end; + end; +end; +{=====} + +function TVpCustomNavBar.nabGetFolderArea(Index : Integer) : TRect; +var + I : Integer; +begin + Result := ClientRect; + for I := 0 to ActiveFolder do + Inc(Result.Top, FButtonHeight); + for I := FolderCount-1 downto ActiveFolder+1 do + Dec(Result.Bottom, FButtonHeight); +end; +{=====} + +procedure TVpCustomNavBar.nabImagesChanged(Sender : TObject); +begin + Invalidate; +end; +{=====} + +procedure TVpCustomNavBar.nabRecalcDisplayNames; +var + I : Integer; +begin + if not HandleAllocated then + exit; + Canvas.Font := Self.Font; + {figure out display names for each folder...} + for I := 0 to FolderCount-1 do + Folders[I].lfDisplayName := GetDisplayString(Canvas, Folders[I].Caption, 1, + ClientWidth); + Invalidate; +end; +{=====} + +function TVpCustomNavBar.nabShowScrollDown : Boolean; +var + Folder : TVpNavFolder; + Item : TVpNavBtnItem; +begin + Result := False; + if (FolderCount > 0) then begin + Folder := Folders[FActiveFolder]; + if Folder.ItemCount > 0 then begin + Item := Folder.Items[Folder.ItemCount-1]; + Result := Item.FLabelRect.Bottom > nabItemsRect.Bottom; + end; + end; +end; +{=====} + +procedure TVpCustomNavBar.nabScrollDownBtnClick(Sender : TObject); +begin + if nabShowScrollDown then begin + Inc(nabTopItem); + InvalidateRect(Handle, @nabItemsRect, False); + end; +end; +{=====} + +function TVpCustomNavBar.nabShowScrollUp : Boolean; +begin + Result := nabTopItem > 0; +end; +{=====} + +procedure TVpCustomNavBar.nabScrollUpBtnClick(Sender : TObject); +begin + if nabTopItem > 0 then begin + Dec(nabTopItem); + InvalidateRect(Handle, @nabItemsRect, False); + end; +end; +{=====} + +procedure TVpCustomNavBar.nabTimerEvent(Sender : TObject; Handle : Integer; + Interval : Cardinal; ElapsedTime : LongInt); +var + Pt : TPoint; + Form : TCustomForm; +begin + GetCursorPos(Pt); + Pt := ScreenToClient(Pt); + if not PtInRect(ClientRect, Pt) then begin + if not nabMouseDown then begin + {we're not doing internal dragging anymore} + nabMouseDown := False; + nabDragFromFolder := -1; + nabDragFromItem := -1; + if nabDropY <> -1 then begin + nabDropY := -1; + Repaint; + end; + if FActiveItem <> -1 then begin + InvalidateItem(FActiveFolder, FActiveItem); + FActiveItem := -1; + end; + end else if FAllowRearrange then begin + Form := GetParentForm(Self); + if (Form <> nil) then + if Form.Active then begin + SetCursor(Screen.Cursors[crNoDrop]); + nabDropY := -1; + Repaint; + end; + end; + end else begin + if nabDragFromItem <> -1 then begin + {we're still doing internal dragging - update the cursor} + if nabDropHitTest(Pt.X, Pt.Y) then + SetCursor(Screen.Cursors[DragCursor]) + else begin + SetCursor(Screen.Cursors[crNoDrop]); + nabDropY := -1; + Repaint; + end; + end; + end; +end; +{=====} + +procedure TVpCustomNavBar.MouseDown(Button : TMouseButton; + Shift : TShiftState; + X, Y : Integer); +begin + {complete any editing} + nabCommitEdit(nil); + + {get folder/item clicked} + nabGetHitTest(X, Y, FPreviousFolder, FPreviousItem); + + {was it a click on a folder button?} + if FPreviousFolder <> -1 then begin + if Folders[FPreviousFolder].Enabled or + (csDesigning in ComponentState) then begin + if (Button = mbLeft) then begin + nabMouseDown := True; + Invalidate; + end; + Exit; + end; + end; + + if FPreviousItem <> -1 then begin + if Folders[FActiveFolder].Enabled or + (csDesigning in ComponentState) then begin + if (Button = mbLeft) then begin + InvalidateItem(FActiveFolder, FPreviousItem); + nabMouseDown := True; + end; + end; + end; + + inherited MouseDown(Button, Shift, X, Y); +end; +{=====} + +procedure TVpCustomNavBar.MouseMove(Shift : TShiftState; X, Y : Integer); +var + ItemIndex : Integer; + FolderIndex : Integer; +begin + nabGetHitTest(X, Y, FolderIndex, ItemIndex); + + {if FActiveItem is valid, and mouse is down, we're starting dragging} + if nabMouseDown or nabExternalDrag then begin + if nabScrollDownBtn.Visible then begin + if Y > nabScrollDownBtn.Top then begin + Inc(nabTopItem); + InvalidateRect(Handle, @nabItemsRect, False); + inherited MouseMove(Shift, X, Y); + Exit; + end; + end; + if nabScrollUpBtn.Visible then begin + if Y < (nabScrollUpBtn.Top + nabScrollUpBtn.Height)then begin + Dec(nabTopItem); + InvalidateRect(Handle, @nabItemsRect, False); + inherited MouseMove(Shift, X, Y); + Exit; + end; + end; + if (FActiveItem <> -1) and (ItemIndex = -1) and FAllowRearrange then begin + nabDragFromFolder := FActiveFolder; + nabDragFromItem := FActiveItem; + if (FolderIndex = -1) then begin + if nabDropHitTest(X, Y) then + SetCursor(Screen.Cursors[DragCursor]) + else begin + SetCursor(Screen.Cursors[crNoDrop]); + nabDropY := -1; + Repaint; + end; + end; + end; + if (FolderIndex <> -1) and FAllowRearrange then begin + ActiveFolder := FolderIndex; + nabDropY := -1; + FActiveItem := -1; + Repaint; + end; + end else begin + if ItemIndex <> -1 then begin + if (ItemIndex <> FActiveItem) then begin + if FActiveItem <> -1 then + {invalidate the old activeItem} + InvalidateItem(FActiveFolder, FActiveItem); + FActiveItem := ItemIndex; + if FActiveItem <> -1 then begin + {invalidate the new active item} + InvalidateItem(FActiveFolder, FActiveItem); + end; + end; + end else if FActiveItem <> -1 then begin + InvalidateItem(FActiveFolder, FActiveItem); + FActiveItem := -1; + end; + if FolderIndex <> -1 then begin + if (FolderIndex <> FHotFolder) then begin + if FHotFolder <> -1 then + {invalidate the old activeItem} + Invalidate; + FHotFolder := FolderIndex; + if FHotFolder <> -1 then begin + {invalidate the new active item} + Invalidate; + end; + end; + end else if FHotFolder <> -1 then begin + Invalidate; + FHotFolder := -1; + end; + end; + + if ItemIndex <> - 1 then begin + if nabLastMouseOverItem <> ItemIndex then + DoMouseOverItem(X, Y, ItemIndex); + nabLastMouseOverItem := ItemIndex; + end else + nabLastMouseOverItem := -1; + + inherited MouseMove(Shift, X, Y); +end; +{=====} + +procedure TVpCustomNavBar.MouseUp(Button : TMouseButton; Shift : TShiftState; + X, Y : Integer); +var + FolderIndex : Integer; + ItemIndex : Integer; + Folder : TVpNavFolder; + Item : TVpNavBtnItem; + FromItem : TVpNavBtnItem; + SourceName : string; +begin + + if nabMouseDown then begin + try + nabGetHitTest(X, Y, FolderIndex, ItemIndex); + + if (FActiveItem <> -1) and (ItemIndex <> -1) then begin + FSelectedItem := ItemIndex; + InvalidateItem(FActiveFolder, ItemIndex); + if FActiveItem = ItemIndex then + DoItemClick(Button, Shift, ItemIndex); + end; + + if nabDragFromItem <> -1 then begin + if nabDropHitTest(X, Y) then begin + {get the old item} + Folder := Folders[nabDragFromFolder]; + FromItem := TVpNavBtnItem(Folder.Items[nabDragFromItem]); + {create the new item} + Folder := Folders[nabDragToFolder]; + + + Item := TVpNavBtnItem(Folder.FItems.Insert(nabDragToItem)); + Item.Assign(FromItem); + SourceName := FromItem.Name; + FromItem.Free; + Item.Name := SourceName; + nabRecalcDisplayNames; + DoArrange; + end; + nabDragFromFolder := -1; + nabDragFromItem := -1; + end; + + if (ItemIndex = -1) then begin + { Fire the OnFolderClick event. } + DoFolderClick(Button, Shift, FolderIndex); + ActiveFolder := FolderIndex; + end; + finally + Invalidate; + nabMouseDown := False; + end; + end; + + inherited MouseUp(Button, Shift, X, Y); +end; +{=====} + +procedure TVpCustomNavBar.Notification(AComponent : TComponent; + Operation : TOperation); +begin + inherited Notification(AComponent, Operation); + + if Operation = opRemove then begin + if AComponent = FImages then + Images := nil; + end; +end; +{=====} + +procedure TVpCustomNavBar.Paint; +var + I : Integer; + J : Integer; + X : Integer; + W : Integer; + H : Integer; + CurPos : Integer; + Offset : Integer; + BkMode : Integer; + LabelWidth : Integer; + Flags : Integer; + MyRect : TRect; + TR : TRect; + ContainerRect : TRect; + FolderType : TVpFolderType; + BkColor : TColor; + Folder : TVpNavFolder; + Item : TVpNavBtnItem; + DrawBmp : TBitmap; + Text : string; + Buf : array[0..255] of Char; + DrawFolder : Boolean; + BM : TBitmap; + RowStart : Integer; + ILeft : Integer; + IHeight : Integer; + IWidth : integer; + +begin + if nabChanging then + Exit; + + DrawBmp := TBitMap.Create; + try + DrawBmp.Width := ClientWidth; + DrawBmp.Height := ClientHeight; + + DrawBmp.Canvas.Font := Self.Font; + with DrawBmp.Canvas do begin + Pen.Color := FBackgroundColor; + Brush.Color := FBackgroundColor; + + MyRect := ClientRect; + + DrawFolder := (FolderCount > 0); + + if DrawFolder then + TR := nabGetFolderArea(FActiveFolder) + else + TR := ClientRect; + + if FBackgroundImage.Empty or (FBackgroundMethod = bmNone) then + Rectangle(TR.Left, TR.Top, TR.Right, TR.Bottom) + + else begin + case FBackgroundMethod of + bmNormal : + Draw(TR.Left, TR.Top, FBackgroundImage); + + bmStretch : + StretchDraw(TR, FBackgroundImage); + + bmTile : + begin + {Tile the background in the default folder} + RowStart := 0; + IHeight := FBackgroundImage.Height; + IWidth := FBackgroundImage.Width; + ILeft := 0; + while (RowStart < ClientRect.Bottom) do begin + while (ILeft < ClientRect.Right) do begin + Draw(TR.Left + ILeft, RowStart, FBackgroundImage); + Inc(ILeft, IWidth); + end; + ILeft := 0; + Inc(RowStart, IHeight) + end; + end; + end; + end; + + CurPos := 0; + if FolderCount = 0 then begin + nabScrollUpBtn.Visible := False; + nabScrollDownBtn.Visible := False; + Exit; + end; + + {draw the folder buttons at the top} + if DrawFolder then begin + for I := 0 to FActiveFolder do begin + MyRect.Top := CurPos; + MyRect.Bottom := CurPos + FButtonHeight; + Folders[I].lfRect := MyRect; + + {Draw the top tabs based on the selected style...} + case FDrawingStyle of + + dsDefButton : begin + {Draw regular buttons} +//TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, +// (I = FHotFolder) and nabMouseDown, False); + end; + + dsEtchedButton : begin + {Draw regular etched (Win98 style) buttons} + Brush.Color := clBtnFace; + FillRect(MyRect); + Pen.Color := clBtnShadow; + Brush.Style := bsClear; + Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, + MyRect.Bottom); + Pen.Color := clBtnHighlight; + MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); + LineTo(MyRect.Left + 1, MyRect.Top + 1); + LineTo(MyRect.Right - 2, MyRect.Top + 1); + { Draw border around control. } + MoveTo(Width - 1, Top); + LineTo(Width - 1, Height - 1); + LineTo(0, Height - 1); + Pen.Color := clWindowFrame; + MoveTo(Width - 1, MyRect.Bottom); + LineTo(1, MyRect.Bottom); + LineTo(1, Height - 1); + TR := MyRect; + end; + + dsCoolTab: begin + {Draw cool (Netscape Sidebar style) tabs} + TR := DrawNavTab(DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + true, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem)); {MouseOverItem} + end; + + dsStandardTab: begin + {Draw regular old tabs} + TR := DrawNavTab(DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + false, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem)); {MouseOverItem} + end; + + end; + StrPLCopy(Buf, Folders[I].lfDisplayName, 255); + Inc(TR.Top); + Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; + if Folders[I].Enabled then begin + DrawText(DrawBmp.Canvas.Handle, Buf, StrLen(Buf), TR, Flags); + if (I = FHotFolder) and not nabMouseDown then begin + + case FDrawingStyle of + + dsDefButton : begin + { Regular button style. } + InflateRect(TR,1,1); + inc(TR.Left); + DrawBmp.Canvas.Frame3D(TR, 1,bvRaised); + end; + + dsEtchedButton : begin + { Etched style (Outlook98). } + Pen.Color := clWindowFrame; + MoveTo(TR.Right - 2, TR.Top); + LineTo(TR.Right - 2, TR.Bottom - 1); + LineTo(0, TR.Bottom - 1); + Pen.Color := clBtnShadow; + if I = ActiveFolder then + Offset := 1 + else + Offset := 2; + MoveTo(TR.Right - 3, TR.Top - 2); + LineTo(TR.Right - 3, TR.Bottom - Offset); + LineTo(1, TR.Bottom - Offset); + if I = ActiveFolder then + Pixels[1, TR.Bottom - Offset] := clBtnHighlight; + end; + end; + end; + end else begin + {use shadow text for inactive folder text} + DrawBmp.Canvas.Font.Color := clHighlightText; + SetBkMode(Canvas.Handle, OPAQUE); + DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); + SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); + DrawBmp.Canvas.Font.Color := clBtnShadow; + OffsetRect(TR, -2, -1); + DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); + DrawBmp.Canvas.Font.Color := Self.Font.Color; + end; + Inc(CurPos, FButtonHeight); + end; + end else begin + if FDrawingStyle = dsEtchedButton then begin + { Draw border around control. } + Pen.Color := clBtnHighlight; + MoveTo(Width - 1, Top); + LineTo(Width - 1, Height - 1); + LineTo(0, Height - 1); + Pen.Color := clWindowFrame; + MoveTo(0, Height - 1); + LineTo(0, 1); + LineTo(Width - 2, 1); + end; + CurPos := 0; + end; + +//TODO: +{ BkMode := GetBkMode(Handle); + BkColor := GetBkColor(Handle); + SetBkColor(Handle, DWord(FBackgroundColor)); + SetBkMode(Handle, TRANSPARENT); +} + { draw the items for the active folder } + Folder := Folders[FActiveFolder]; + + if Folder.FolderType = ftDefault then + if Folder.ItemCount > 0 then begin + Inc(CurPos, 8); + with nabItemsRect do begin + Top := CurPos; + Left := 0; + Right := ClientWidth; + Bottom := ClientHeight + - (FolderCount - FActiveFolder - 1) * FButtonHeight + 1; + end; + + for J := 0 to Folder.ItemCount-1 do + TVpNavBtnItem(Folder.Items[J]).FLabelRect.Bottom := + nabItemsRect.Bottom + 1; + + for J := nabTopItem to Folder.ItemCount-1 do begin + if (FSelectedItem = J) then + DrawBmp.Canvas.Font := FSelectedItemFont + else + DrawBmp.Canvas.Font := FItemFont; + + Item := Folder.Items[J]; + { If the caption is empty at designtime then display the item's } + { name instead } + if (csDesigning in ComponentState) and (Item.Caption = '') then + Text := Item.Name + else + Text := Item.Caption; + + if Folder.IconSize = isLarge then begin {large icons} + { glyph is at the top } + with Item.FIconRect do begin + { If an image list is assigned then use the image } + { size. If no image list is assinged then assume } + { a 32 x 32 image size. } + if Assigned(FImages) then begin + W := FImages.Width + 2; + H := FImages.Height + 2; + end else begin + W := 32; + H := 32; + end; + Top := CurPos; + Bottom := CurPos + H; + Left := (ClientWidth - W) shr 1; + Right := Left + W; + if Top > nabItemsRect.Bottom then + Break; + + if FShowButtons then begin + if FActiveItem = J then begin + if nabMouseDown then + Pen.Color := clBlack + else + Pen.Color := clWhite; + MoveTo(Left-1, Bottom+1); + LineTo(Left-1, Top-1); + LineTo(Right+1, Top-1); + if nabMouseDown then + Pen.Color := clWhite + else + Pen.Color := clBlack; + LineTo(Right+1, Bottom+1); + LineTo(Left-1, Bottom+1); + end else begin + Pen.Color := FBackgroundColor; + Brush.Color := FBackgroundColor; + end; + if Assigned(FImages) and + (Item.IconIndex >= 0) and + (Item.IconIndex < FImages.Count) then + FImages.Draw(DrawBmp.Canvas, Item.FIconRect.Left + 2, + Item.FIconRect.Top + 2, Item.IconIndex); + {make the icon's bottom blend into the label's top} + Item.FIconRect.Bottom := Item.FIconRect.Bottom + 4; + end; + end; + Inc(CurPos, H + 4); + + {now, draw the text} + with Item.FLabelRect do begin + Top := CurPos; + Bottom := CurPos + (FButtonHeight shl 1) - 7; + + Left := 0; + Right := ClientWidth - 1; + Item.liDisplayName := GetLargeIconDisplayName(DrawBmp.Canvas, + Item.FLabelRect, Text); + X := DrawBmp.Canvas.TextWidth(Item.liDisplayName); + Left := (ClientWidth - X) div 2; + if Left < 5 then + Left := 5; + Right := Left + X; + if Right > ClientWidth-5 then + Right := ClientWidth-5; + if Top > nabItemsRect.Bottom then + Break; + end; + + StrPLCopy(Buf, Item.liDisplayName, 255); + DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), + Item.FLabelRect, DT_CENTER or DT_VCENTER or + DT_WORDBREAK or DT_CALCRECT); + LabelWidth := RectWidth(Item.FLabelRect); + with Item.FLabelRect do begin + Left := (ClientWidth - LabelWidth) div 2; + Right := Left + LabelWidth + 1; + end; + BkMode := SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); + Inc(CurPos, DrawText(DrawBmp.Canvas.Handle, Buf, + Length(Item.liDisplayName), + Item.FLabelRect, + DT_CENTER or DT_VCENTER or DT_WORDBREAK)); + SetBkMode(DrawBmp.Canvas.Handle, BkMode); + + Inc(CurPos, FItemSpacing); + end else begin {small icons} + {glyph is at the left} + with Item.FIconRect do begin + Top := CurPos; + Offset := (Abs(DrawBmp.Canvas.Font.Height)) div 2; + if Offset > 8 then + Top := Top + Offset - 8; + Bottom := Top + 16; + Left := 8; + Right := Left + 16; + if Top > nabItemsRect.Bottom then + Break; + + if FShowButtons then begin + if FActiveItem = J then begin + if nabMouseDown then + Pen.Color := clBlack + else + Pen.Color := clWhite; + MoveTo(Left-1, Bottom+1); + LineTo(Left-1, Top-1); + LineTo(Right+1, Top-1); + if nabMouseDown then + Pen.Color := clWhite + else + Pen.Color := clBlack; + LineTo(Right+1, Bottom+1); + LineTo(Left-1, Bottom+1); + Brush.Color := FBackgroundColor; + end else begin + Pen.Color := FBackgroundColor; + Brush.Color := FBackgroundColor; + Rectangle(Item.FIconRect.Left - 1, + Item.FIconRect.Top - 1, + Item.FIconRect.Right + 1, + Item.FIconRect.Bottom + 1); + end; + if Assigned(FImages) then begin + BM := TBitmap.Create; + try + BM.Width := FImages.Width; + BM.Height := FImages.Height; + FImages.Draw(BM.Canvas, 0, 0, Item.IconIndex); +//TODO: DrawBmp.Canvas.BrushCopy(Item.FIconRect, BM, +// Rect(0, 0, BM.Width, BM.Height), BM.Canvas.Pixels[0, +// BM.Height-1]); + finally + BM.Free; + end; + end; + end; + {make the icon's right blend into the label's left} + Item.FIconRect.Right := Item.FIconRect.Right + 3; + end; + + {now, draw the text} + with Item.FLabelRect do begin + Top := CurPos; + Bottom := CurPos + (FButtonHeight shl 1) -7; + Left := Item.FIconRect.Right; + X := Self.ClientWidth - Left - 7; + Right := Left + X; + if Top > nabItemsRect.Bottom then + Break; + end; + Item.liDisplayName := + GetDisplayString(DrawBmp.Canvas, Text, 1, + RectWidth(Item.FLabelRect)); + StrPLCopy(Buf, Item.liDisplayName, 255); + DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), + Item.FLabelRect, DT_LEFT or DT_VCENTER or DT_CALCRECT); + LabelWidth := RectWidth(Item.FLabelRect); + with Item.FLabelRect do + Right := Left + LabelWidth + 1; + DrawText(DrawBmp.Canvas.Handle, Buf, Length(Item.liDisplayName), + Item.FLabelRect, DT_LEFT or DT_VCENTER); + + Inc(CurPos, FItemSpacing); + end; + end; + end; + + + {now, draw the folder buttons at the bottom} + DrawBmp.Canvas.Font := Self.Font; + SetBkMode(Handle, BkMode); + SetBkColor(Handle, BkColor); + + case FDrawingStyle of + { Regular button style. } + dsDefButton : + CurPos := ClientHeight - FButtonHeight; + { Etched style (Outlook98). } + dsEtchedButton : + CurPos := ClientHeight - FButtonHeight - 1; + { Cool Tab } + dsCoolTab: + CurPos := ClientHeight - FButtonHeight; + { Regular Tab } + dsStandardTab: + CurPos := ClientHeight - FButtonHeight; + end; + + for I := FolderCount-1 downto FActiveFolder+1 do begin + MyRect.Top := CurPos; + MyRect.Bottom := CurPos + FButtonHeight; + Folders[I].lfRect := MyRect; + case FDrawingStyle of + + dsDefButton : begin + {Regular Old Buttons} +//TODO: TR := DrawButtonFace(DrawBmp.Canvas, MyRect, 1, bsNew, False, +// (I = FHotFolder) and nabMouseDown, False); + end; + + dsEtchedButton : begin + {Etched (Outlook98 style) buttons} + Brush.Color := clBtnFace; + FillRect(MyRect); + Pen.Color := clBtnShadow; + Brush.Style := bsClear; + Rectangle(MyRect.Left, MyRect.Top, MyRect.Right - 1, + MyRect.Bottom); + Pen.Color := clBtnHighlight; + MoveTo(MyRect.Left + 1, MyRect.Bottom - 2); + LineTo(MyRect.Left + 1, MyRect.Top + 1); + LineTo(MyRect.Right - 2, MyRect.Top + 1); + Pen.Color := clBtnHighlight; + MoveTo(Width - 1, 0); + LineTo(Width - 1, Height); + TR := MyRect; + end; + + dsCoolTab: begin + {Draw cool (Netscape Sidebar style) tabs} + TR := DrawNavTab(DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + true, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem)); {MouseOverItem} + end; + + dsStandardTab: begin + {Draw regular old tabs} + TR := DrawNavTab(DrawBmp.Canvas, {Canvas} + MyRect, {Client Rect} + 1, {Bevel Width} + FBackgroundColor, {Tab Color} + I, {Tab Number} + false, {Cool Tabs?} + (I = FHotFolder), {Is Focused} + (I = nabLastMouseOverItem)); {MouseOverItem} + end; + + end; + Inc(TR.Top); + StrPLCopy(Buf, Folders[I].lfDisplayName, 255); + Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX; + if Folders[I].Enabled then begin + DrawText(DrawBmp.Canvas.Handle, Buf, StrLen(Buf), TR, Flags); + if (I = FHotFolder) and not nabMouseDown then begin + case FDrawingStyle of + + dsDefButton : begin + { Regular button style. } + InflateRect(TR,1,1); + inc(TR.Left); + DrawBmp.Canvas.Frame3D(TR,1,bvRaised); + end; + + dsEtchedButton : begin + { Etched (Outlook98 style). } + Pen.Color := clWindowFrame; + MoveTo(TR.Right - 2, TR.Top); + LineTo(TR.Right - 2, TR.Bottom - 1); + LineTo(0, TR.Bottom - 1); + Pen.Color := clBtnShadow; + MoveTo(TR.Right - 3, TR.Top - 2); + LineTo(TR.Right - 3, TR.Bottom - 2); + LineTo(1, TR.Bottom - 2); + end; + end; + end; + end else begin + {use shadow text for inactive folder text} + DrawBmp.Canvas.Font.Color := clHighlightText; + SetBkMode(Canvas.Handle, OPAQUE); + DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); + SetBkMode(DrawBmp.Canvas.Handle, TRANSPARENT); + DrawBmp.Canvas.Font.Color := clBtnShadow; + OffsetRect(TR, -2, -1); + DrawText(DrawBmp.Canvas.Handle, Buf, -1, TR, Flags); + DrawBmp.Canvas.Font.Color := Self.Font.Color; + end; + Dec(CurPos, FButtonHeight); + end; + + if not (csDesigning in ComponentState) then begin + {show the top scroll button} + if nabShowScrollUp then begin + nabScrollUpBtn.Top := Folders[FActiveFolder].lfRect.Bottom + 5; + nabScrollUpBtn.Left := ClientWidth - 20; + nabScrollUpBtn.Visible := True; + end else + nabScrollUpBtn.Visible := False; + + {show the bottom scroll button} + if nabShowScrollDown then begin + if FActiveFolder = FolderCount-1 then + {there are no folders beyond the active one} + nabScrollDownBtn.Top := ClientHeight -20 + else + nabScrollDownBtn.Top := Folders[FActiveFolder+1].lfRect.Top - 20; + nabScrollDownBtn.Left := ClientWidth - 20; + nabScrollDownBtn.Visible := True; + end else + nabScrollDownBtn.Visible := False; + end; + {if we're dragging, show the drag marker} + if (nabDragFromItem <> -1) or nabExternalDrag then begin + if (nabDropY <> -1) then begin + { Don't draw the drag marker if we're doing external } + { dragging and the cursor is over an item. } + if nabExternalDrag then + if not nabFolderAccept or nabCursorOverItem then + Exit; + Pen.Color := clBlack; + Brush.Color := clBlack; + MoveTo(5, nabDropY); + LineTo(ClientWidth - 5, nabDropY); + DrawBmp.Canvas.Polygon([ Point(3,nabDropY+4), + Point(7,nabDropY), + Point(3, nabDropY-4)]); + DrawBmp.Canvas.FloodFill(5, nabDropY, clBlack, fsBorder); + DrawBmp.Canvas.Polygon([ Point(ClientWidth-3,nabDropY+4), + Point(ClientWidth-7,nabDropY), + Point(ClientWidth-3,nabDropY-4)]); + DrawBmp.Canvas.FloodFill(ClientWidth-5, nabDropY, clBlack, fsBorder); + end; + end; + end; + finally + Canvas.CopyMode := cmSrcCopy; + Canvas.CopyRect(ClientRect, DrawBmp.Canvas, ClientRect); + DrawBmp.Free; + end; + + {For container style folders...} + + {Hide the containers for all inactive folders} + for I := 0 to FFolders.Count - 1 do begin + if I <> FActiveFolder then begin + if Folders[i].FolderType = ftContainer then + with Containers[Folders[i].ContainerIndex] do begin + Width := 0; + Height := 0; + Visible := false; + end; + end; + end; + + Folder := Folders[FActiveFolder]; + TR := nabGetFolderArea(FActiveFolder); + + if Folder.FolderType = ftContainer then + with Containers[Folder.ContainerIndex] do begin + {Position and show the folder's container} + Height := TR.Bottom - TR.Top; + Top := TR.Top; + Left := TR.Left; + Width := TR.Right - TR.Left; + Visible := true; + BringToFront; + + for I := 0 to ControlCount - 1 do + Controls[i].Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetActiveFolder(Value : Integer); +var + Y : Integer; + YDelta : Integer; + R : TRect; + R2 : TRect; + Buf : array[0..1023] of Char; + AllowChange : Boolean; +begin + if Value <> FActiveFolder then begin + + if FolderCount = 0 then + FActiveFolder := -1 + else if (Value > -1) and (Value < FolderCount) then begin + + { Fire DoFolderChange only if not dragging. } + if nabDragFromItem = -1 then begin + { Default for AllowChange is True. } + AllowChange := True; + { Fire the OnFolderChange event. } + DoFolderChange(Value, AllowChange); + { If AllowChange is False then bail out. } + if not AllowChange then + Exit; + end; + {animated scroll} + if FActiveFolder > -1 then begin + {play sound} + if FPlaySounds and (FSoundAlias > '') then begin + StrPLCopy(Buf, FSoundAlias, SizeOf(Buf)-1); + {$IFNDEF LCL} + FPlaySounds := PlaySound(@Buf, 0, SND_ASYNC); + {$ENDIF} + end; + + if Parent <> nil then begin + {scroll selection} + Canvas.Brush.Color := FBackgroundColor; + R := nabGetFolderArea(FActiveFolder); + R2 := R; + if Value > FActiveFolder then begin + {up} + YDelta := -FScrollDelta; + Inc(R.Bottom, Abs(Value-FActiveFolder)*FButtonHeight); + R2.Top := R2.Bottom+Abs(Value-FActiveFolder)*FButtonHeight; + R2.Bottom := R2.Top; + end else begin + {down} + YDelta := +FScrollDelta; + Dec(R.Top, Abs(Value-FActiveFolder)*FButtonHeight); + R2.Bottom := R2.Top-Abs(Value-FActiveFolder)*FButtonHeight; + R2.Top := R2.Bottom; + end; + Y := RectHeight(R)-FScrollDelta; + while Y > 0 do begin + ScrollWindow(Handle, 0, YDelta, @R, @R); + Dec(Y, FScrollDelta); + {fill scrolled area} + if YDelta > 0 then + Inc(R2.Bottom, FScrollDelta) + else + Dec(R2.Top, FScrollDelta); + Canvas.FillRect(R2); + end; + end; + end; + + FActiveFolder := Value; + nabTopItem := 0; + FActiveItem := -1; + FSelectedItem := -1; + Invalidate; + + end; + { Fire the OnFolderChanged event. } + DoFolderChanged(FActiveFolder) + end; +end; +{=====} + +procedure TVpCustomNavBar.SetBackgroundColor(Value : TColor); +begin + if Value <> FBackgroundColor then begin + FBackgroundColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetBackgroundImage(Value : TBitmap); +begin + if Assigned(Value) then + FBackgroundImage.Assign(Value) + else begin + FBackgroundImage.Free; + FBackgroundImage := TBitmap.Create; + end; + Invalidate; +end; +{=====} + +procedure TVpCustomNavBar.SetBackgroundMethod(Value : TVpBackgroundMethod); +begin + if Value <> FBackgroundMethod then begin + FBackgroundMethod := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetBorderStyle(const Value : TBorderStyle); +begin + if Value <> FBorderStyle then begin + FBorderStyle := Value; + RecreateWnd{$IFDEF LCL}(self){$ENDIF}; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetButtonHeight(Value : Integer); +begin + if Value <> FButtonHeight then begin + {Minimum ButtonHeight for CoolTabs is 17} + if FDrawingStyle = dsCoolTab then begin + if Value < 17 then FButtonHeight := 17 + else FButtonHeight := Value; + end else + FButtonHeight := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetDrawingStyle(Value: TVpFolderDrawingStyle); +begin + if Value <> FDrawingStyle then begin + FDrawingStyle := Value; + if FDrawingStyle = dsEtchedButton then + BorderStyle := bsNone + else + BorderStyle := bsSingle; + + {Minimum ButtonHeight for CoolTabs is 17} + if (FDrawingStyle = dsCoolTab) and (FButtonHeight < 17) then + FButtonHeight := 17; + + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetBounds(ALeft, ATop, AWidth, AHeight : Integer); +begin + inherited SetBounds(ALeft, ATop, AWidth, AHeight); + nabRecalcDisplayNames; +end; +{=====} + +procedure TVpCustomNavBar.SetImages(Value : TImageList); +begin + if FImages <> nil then + FImages.OnChange := nil; + FImages := Value; + if FImages <> nil then begin + Images.OnChange := nabImagesChanged; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetItemFont(Value : TFont); +begin + if Assigned(Value) then + FItemFont.Assign(Value); +end; +{=====} + +procedure TVpCustomNavBar.SetItemSpacing(Value : Word); +begin + if (Value > 0) then begin + FItemSpacing := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.SetSelectedItemFont(Value : TFont); +begin + if Assigned(Value) then + FSelectedItemFont.Assign(Value); +end; +{=====} + +procedure TVpCustomNavBar.SetScrollDelta(Value: Integer); +begin + if Value <= 0 then + FScrollDelta := 1 + else + FScrollDelta := Value; +end; +{=====} + +{$IFDEF LCL} +procedure TVpCustomNavBar.WMEraseBkGnd(var Msg : TLMEraseBkGnd); +{$ELSE} +procedure TVpCustomNavBar.WMEraseBkGnd(var Msg : TWMEraseBkGnd); +{$ENDIF} +begin + Msg.Result := 1; {don't erase background} +end; +{=====} + +{$IFNDEF LCL} +procedure TVpCustomNavBar.WMGetDlgCode(var Msg : TWMGetDlgCode); +begin + {tell windows we are a static control to avoid receiving the focus} + Msg.Result := DLGC_STATIC; +end; +{$ENDIF} +{=====} + +{$IFDEF LCL} +procedure TVpCustomNavBar.WMNCHitTest(var Msg : TLMNCHitTest); +{$ELSE} +procedure TVpCustomNavBar.WMNCHitTest(var Msg : TWMNCHitTest); +{$ENDIF} +begin + inherited; + nabHitTest.X := Msg.Pos.X; + nabHitTest.Y := Msg.Pos.Y; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpCustomNavBar.WMSetCursor(var Msg : TWMSetCursor); +var + I : Integer; + R : TRect; +begin + if csDesigning in ComponentState then begin + if (Msg.HitTest = HTCLIENT) then begin + nabOverButton := False; + nabHitTest := ScreenToClient(nabHitTest); + {check if mouse is over a button} + for I := 0 to FolderCount-1 do begin + R := nabButtonRect(I); + if PtInRect(R, nabHitTest) then begin + nabOverButton := True; + Break; + end; + end; + end; + end; + inherited; +end; +{$ENDIF} +{=====} + +{ Overridden DragOver method. } +procedure TVpCustomNavBar.DragOver(Source: TObject; + X, Y: Integer; + State: TDragState; + var Accept: Boolean); +var + ItemIndex : Integer; + FolderIndex : Integer; +begin + { If State is dsDragLeave then the user has dragged } + { outside us. Invalidate the component to get rid } + { of any left-over drawing and exit. } + if State = dsDragLeave then begin + nabExternalDrag := False; + nabFolderAccept := False; + nabItemAccept := False; + nabMouseDown := False; + nabChanging := False; + nabTopItem := 0; + nabDragFromItem := -1; + nabDragFromFolder := -1; + Invalidate; + nabAcceptAny := False; + inherited DragOver(Source, X, Y, State, nabAcceptAny); + Exit; + end; + + nabFolderAccept := True; + nabItemAccept := True; + { Call the user's OnDragOver. } + if Assigned(FOnDragOver) then + FOnDragOver(Self, Source, + X, Y, State, nabFolderAccept, nabItemAccept); + + { Might have to scroll the items in the folder. } + if nabScrollDownBtn.Visible then begin + if Y > nabScrollDownBtn.Top then begin + Inc(nabTopItem); + InvalidateRect(Handle, @nabItemsRect, False); + end; + end; + if nabScrollUpBtn.Visible then begin + if Y < (nabScrollUpBtn.Top + nabScrollUpBtn.Height)then begin + Dec(nabTopItem); + InvalidateRect(Handle, @nabItemsRect, False); + end; + end; + + Accept := nabFolderAccept or nabItemAccept; + if nabFolderAccept or nabItemAccept then begin + nabGetHitTest(X, Y, FolderIndex, ItemIndex); + nabDropHitTest(X, Y); + nabExternalDrag := True; + { Change folder if necessary. } + if (FolderIndex <> -1) and (FolderIndex <> FActiveFolder) then + ActiveFolder := FolderIndex; + if nabItemAccept then + FActiveItem := ItemIndex; + Invalidate; + end; +end; +{=====} + +procedure TVpCustomNavBar.DragDrop(Source: TObject; X, Y : Integer); +begin + if Assigned(FOnDragDrop) then + FOnDragDrop(Self, Source, X, Y, FActiveFolder, nabExternalDragItem); + nabExternalDrag := False; + nabFolderAccept := False; + nabItemAccept := False; + nabMouseDown := False; + nabChanging := False; + nabTopItem := 0; + nabDragFromFolder := -1; + Invalidate; + inherited DragDrop(Source, X, Y); +end; +{=====} + +function TVpCustomNavBar.GetChildOwner: TComponent; +begin + Result := Self; +end; + +end. diff --git a/components/tvplanit/source/vpprtfmt.pas b/components/tvplanit/source/vpprtfmt.pas new file mode 100644 index 000000000..533a5aa42 --- /dev/null +++ b/components/tvplanit/source/vpprtfmt.pas @@ -0,0 +1,2935 @@ +{*********************************************************} +{* VPPRTFMT.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{ + This unit contains everything there is to define Visual PlanIt print + formats. Print formats are bit complicated. Before looking in this unit, + read the documentation on the print formats. It will help things make + sense here. + + The print formats are built as nested TCollections. + + The TVpPrinter class contains a TCollection descendent (TVpPrintFormat) that + contains all the print formats. Each item in this collection + (TVpPrintFormatItem) contains a TCollection descendent + (TVpPrintFormatElement) that contains all of the elements (DayViews, + WeekViews, static text and the like) that make up the specific print format. + The print element is defined in the TVpPrintFormatElementItem class. + + Shape and Caption elements are special - They do not use a Visual PlanIt + control to handle their rendering. The TVpPrintShape and TVpPrintCaption + are used to store captions and elements as well as render them. Each + print element has a shape and caption class defined, even if that class + is not used. + + When printing, appropriate components are found on the form to handle the + rendering (this allows the user to print what they see). However, if the + components cannot be found, or UseFormComponents if false), internally + cached copies of all the components are used. + + When printing the component, the print formats use the RenderToCanvas + method of the Visual PlanIt visual controls. It is important that + RenderToCanvas properly handles rotation and rendering to arbitrary + rectangles. + + ----------------------------------------------------------------------------- + + Enabling printing for a new component is fairly complex. These steps should + handle it: + 1) Add the new component to the TVpItemType enumeration + 2) Add an internal cached version of the component in the TVpPrinter's + private section. Expose this as a published property. Create the + component in CreateWorkControls and free it in DestroyWorkControls. + 3) Modify RenderItem inside of TVpPrinter.PaintToCanvasRect to + set the LinkableControl to the cached component for the appropriate + value of the TVpItemType enumeration. + 4) If the component is date base (calendar, dayview, weekview and the + like), set HaveDate to true at the end of RenderItem in + TVpPrinter.PaintToCanvasRect. Other changes may be required in + RenderItem. + 5) Modify TVpPrinter.SaveToFile to save the definition of this element + in XML. + 6) Modify TVpPrinter.xmlPrintFormatStartElement to handle loading this + element from an XML configuration file. + Examine how the other components are integrated into the printing system. + + Of course, the print format editor should be updated to contain the new + element. +} + +{$I Vp.INC} + +unit VpPrtFmt; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Classes, + Dialogs, + SysUtils, + Graphics, + StdCtrls, + VpBase, + VpMisc, + VpData, + VpXParsr, + VpCanvasUtils, + VpSR, + VpException, + Forms, + Printers; + +type + TVpChangeVar = (cvRemove, cvIgnore, cvChange); + TVpDayUnits = (duDay, duWeek, duMonth, duYear); + TVpShapeType = (ustRectangle, ustTopLine, ustBottomLine, + ustLeftLine, ustRightLine, ustTLToBRLine, + ustBLToTRLine, ustEllipse); + + TVpWatcher = record + Handle : THandle; + end; + PVpWatcher = ^TVpWatcher; + + { TVpAttributes and TVpAttributeItem + a collection of attributes collected when parsing the xml file. + This is also used to store variables } + + TVpAttributes = class; + + TVpAttributeItem = class (TVpCollectionItem) + private + FCollection : TVpAttributes; + FName : string; + FValue : string; + + protected + + public + constructor Create (Collection : TCollection); override; + destructor Destroy; override; + + published + property Collection : TVpAttributes read FCollection write FCollection; + property Name : string read FName write FName; + property Value : string read FValue write FValue; + end; + + TVpAttributes = class (TCollection) + private + FOwner : TPersistent; + + protected + function GetItem (Index : Integer) : TVpAttributeItem; + function GetOwner : TPersistent; override; + procedure SetItem (Index : Integer; Value : TVpAttributeItem); + + public + constructor Create (AOwner : TPersistent); + {$IFNDEF VERSION5} + procedure Delete (Item : integer); + {$ENDIF} + property Items[Index : Integer] : TVpAttributeItem + read GetItem write SetItem; + + end; + + { Print Formats } + + TVpPrintShape = class (TPersistent) + private + FOwner : TPersistent; + FShape : TVpShapeType; + FBrush : TBrush; + FPen : TPen; + + protected + function GetOwner : TPersistent; override; + procedure SetBrush (const v : TBrush); + procedure SetPen (const v : TPen); + + public + constructor Create (AOwner : TPersistent); + destructor Destroy; override; + + procedure PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + Viewport : TRect); + + published + property Brush : TBrush read FBrush write SetBrush; + property Pen : TPen read FPen write SetPen; + property Shape : TVpShapeType read FShape write FShape; + end; + + TVpPrintCaption = class (TPersistent) + private + FOwner : TPersistent; + FCaption : string; + FFont : TFont; + + protected + function GetOwner : TPersistent; override; + procedure SetFont (const v : TFont); + + public + constructor Create (AOwner : TPersistent); + destructor Destroy; override; + + procedure PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + Viewport : TRect; + RealString : string); + + published + property Caption : string read FCaption write FCaption; + property Font : TFont read FFont write SetFont; + end; + + TVpPrintFormatElement = class; + + TVpPrintFormatElementItem = class (TVpCollectionItem) + private + FCollection : TVpPrintFormatElement; + + FRotation : TVpRotationAngle; + FItemType : TVpItemType; + FMeasurement : TVpItemMeasurement; + FHeight : Extended; + FLeft : Extended; + FTop : Extended; + FWidth : Extended; + FDayOffset : Integer; + FDayOffsetUnits : TVpDayUnits; + FElementName : string; + FShape : TVpPrintShape; + FCaption : TVpPrintCaption; + FVisible : Boolean; + + protected + function GetDisplayName : string; override; + procedure SetCaption (const v : TVpPrintCaption); + procedure SetDayOffset (const v : Integer); + procedure SetDayOffsetUnits (const v : TVpDayUnits); + procedure SetElementName (const v : string); + procedure SetHeight (const v : Extended); + procedure SetItemType (const v : TVpItemType); + procedure SetLeft (const v : Extended); + procedure SetMeasurement (const v : TVpItemMeasurement); + procedure SetRotation (const v : TVpRotationAngle); + procedure SetShape (const v : TVpPrintShape); + procedure SetTop (const v : Extended); + procedure SetWidth (const v : Extended); + procedure SetVisible (const v : Boolean); + + public + constructor Create (Collection : TCollection); override; + destructor Destroy; override; + + property Collection : TVpPrintFormatElement + read FCollection write FCollection; + published + property Caption : TVpPrintCaption read FCaption write SetCaption; + property DayOffset : Integer read FDayOffset write SetDayOffset; + property DayOffsetUnits : TVpDayUnits + read FDayOffsetUnits write SetDayOffsetUnits; + property ElementName : string read FElementName write SetElementName; + property Height : Extended read FHeight write SetHeight nodefault; + property ItemType : TVpItemType read FItemType write SetItemType + default itDayView; + property Left : Extended read FLeft write SetLeft nodefault; + property Measurement : TVpItemMeasurement + read FMeasurement write SetMeasurement default imPercent; + property Rotation : TVpRotationAngle read FRotation write SetRotation + default ra0; + property Shape : TVpPrintShape read FShape write SetShape; + property Top : Extended read FTop write SetTop nodefault; + property Width : Extended read FWidth write SetWidth nodefault; + property Visible : Boolean read FVisible write SetVisible default True; + + end; + + TVpPrintFormatElement = class (TCollection) + private + FOwner : TPersistent; + + protected + function GetItem (Index : Integer) : TVpPrintFormatElementItem; + function GetOwner : TPersistent; override; + procedure NotifyAll (Item : TCollectionItem); + {$IFDEF VERSION6} + procedure Notify (Item : TCollectionItem; + Action : TCollectionNotification); override; + {$ENDIF} + procedure SetItem (Index : Integer; Value : TVpPrintFormatElementItem); + procedure Update (Item : TCollectionItem); override; + + public + constructor Create (AOwner : TPersistent); + + property Items[Index : Integer] : TVpPrintFormatElementItem + read GetItem write SetItem; + end; + + TVpPrintFormat = class; + + TVpPrintFormatItem = class (TVpCollectionItem) + private + FCollection : TVpPrintFormat; + FElements : TVpPrintFormatElement; + + FFormatName : string; + FDescription : string; + + FDayInc : Integer; + FDayIncUnits : TVpDayUnits; + FVisible : Boolean; + + protected + function GetDisplayName : string; override; + procedure SetDayInc (const v : Integer); + procedure SetDayIncUnits (const v : TVpDayUnits); + procedure SetDescription (const v : string); + procedure SetElements (const v : TVpPrintFormatElement); + procedure SetFormatName (const v : string); + procedure SetVisible (const v : Boolean); + + public + constructor Create (Collection : TCollection); override; + destructor Destroy; override; + + property Collection : TVpPrintFormat + read FCollection write FCollection; + published + property DayInc : Integer read FDayInc write SetDayInc; + property DayIncUnits : TVpDayUnits read FDayIncUnits write SetDayIncUnits; + property Description : string read FDescription write SetDescription; + property Elements : TVpPrintFormatElement + read FElements write SetElements; + property FormatName : string read FFormatName write SetFormatName; + property Visible : Boolean read FVisible write SetVisible default True; + + end; + + TVpPrintFormat = class (TCollection) + private + FOwner : TPersistent; + + protected + function GetItem (Index : Integer) : TVpPrintFormatItem; + function GetOwner : TPersistent; override; + procedure NotifyAll (Item : TCollectionItem); + {$IFDEF VERSION6} + procedure Notify (Item : TCollectionItem; + Action : TCollectionNotification); override; + {$ENDIF} + procedure SetItem (Index : Integer; Value : TVpPrintFormatItem); + procedure Update (Item : TCollectionItem); override; + + public + constructor Create (AOwner : TPersistent); + + property Items[Index : Integer] : TVpPrintFormatItem + read GetItem write SetItem; + end; + + TVpPrinter = class (TPersistent) + private + FOwner : TPersistent; + FPrintFormats : TVpPrintFormat; + FCurFormat : Integer; + FAttributes : TVpAttributes; + FLoadingIndex : Integer; + FElementIndex : Integer; + FVariables : TVpAttributes; + FDayStart : TVpHours; + FDayEnd : TVpHours; + FGranularity : TVpGranularity; + FPrintJob : Boolean; + FHaveDate : Boolean; + FHaveTaskList : Boolean; + FLastTask : Integer; + FHaveContactGrid : Boolean; + FLastContact : Integer; + FLeftMargin : Extended; + FRightMargin : Extended; + FTopMargin : Extended; + FBottomMargin : Extended; + FMarginUnits : TVpItemMeasurement; + FUseFormComponents : Boolean; + { Work copies of all the components - used if the components cannot + be located when printing } + FParentHandle : THandle; + FDayView : TComponent; + FWeekView : TComponent; + FMonthView : TComponent; + FCalendar : TComponent; + FContactGrid : TComponent; + FTaskList : TComponent; + { Notification Handles } + FNotifiers : TList; + FDefaultXMLFileName: string; + + protected + procedure CreateWorkControls; + procedure DestroyWorkControls; + function GetOwner : TPersistent; override; + function ReplaceVariables (const s : string) : string; + procedure SetBottomMargin (const v : Extended); + procedure SetCurFormat (const v : Integer); + procedure SetDefaultXMLFileName (const v : string); + procedure SetLeftMargin (const v : Extended); + procedure SetMarginUnits (const v : TVpItemMeasurement); + procedure SetPrintFormats (const v : TVpPrintFormat); + procedure SetRightMargin (const v : Extended); + procedure SetTopMargin (const v : Extended); + procedure SetUseFormComponents (const v : Boolean); + procedure xmlPrintFormatAttribute (oOwner : TObject; + sName, + sValue : DOMString; + bSpecified : Boolean); + procedure xmlPrintFormatEndElement (oOwner : TObject; + sValue : DOMString); + procedure xmlPrintFormatStartElement (oOwner : TObject; + sValue : DOMString); + + + public + constructor Create (AOwner : TComponent); + destructor Destroy; override; + + procedure AddDefaultVariables (Date : TDateTime); + procedure AddVariable (VarName : string; Value : string); + procedure ChangeVariable (VarName : string; NewValue : string); + procedure CheckPrintFormat; + procedure ClearVariables; + function DeleteVariable (VarName : string) : Boolean; + procedure DeregisterAllWatchers; + procedure DeregisterWatcher (Watcher : THandle); + function Find (const v : string) : Integer; + function HaveVariable (VarName : string) : Boolean; + procedure LoadFromFile (FileName : string; Append : Boolean); + function LookupVariable (VarName : string) : string; + procedure NotifyLinked; + procedure PaintToCanvasRect (ACanvas : TCanvas; + ARect : TRect; + ADate : TDateTime); + procedure Print (APrinter : TPrinter; + StartDate : TDateTime; + EndDate : TDateTime); + procedure RegisterWatcher (Watcher : THandle); + procedure RenderPage ( ACanvas : TCanvas; + ARect : TRect; + PageNum : Integer; + var ADate : TDateTime; + EndDate : TDateTime; + var StartContact : Integer; + var StartTask : Integer; + var LastPage : Boolean); + procedure SaveToFile (FileName : string); + procedure UpdateDateVariables (Date : TDateTime); + function ValidFormat (const v : Integer) : Boolean; + + + property Calendar : TComponent read FCalendar write FCalendar; + property ContactGrid : TComponent read FContactGrid write FContactGrid; + property CurFormat : Integer read FCurFormat write SetCurFormat; + property DayView : TComponent read FDayView write FDayView; + property DefaultXMLFileName : string + read FDefaultXMLFileName write SetDefaultXMLFileName; + property HaveDate : Boolean read FHaveDate; + property HaveTaskList : Boolean read FHaveTaskList; + property LastTask : Integer read FLastTask; + property HaveContactGrid : Boolean read FHaveContactGrid; + property LastContact : Integer read FLastContact; + property MonthView : TComponent read FMonthView write FMonthView; + property Printing : Boolean read FPrintJob; + property TaskList : TComponent read FTaskList write FTaskList; + property UseFormComponents : Boolean + read FUseFormComponents write SetUseFormComponents default True; + property WeekView : TComponent read FWeekView write FWeekView; + + published + property BottomMargin : Extended + read FBottomMargin write SetBottomMargin; + property DayStart : TVpHours read FDayStart Write FDayStart; + property DayEnd : TVpHours read FDayEnd write FDayEnd; + property Granularity : TVpGranularity + read FGranularity write FGranularity; + property LeftMargin : Extended + read FLeftMargin write SetLeftMargin; + property MarginUnits : TVpItemMeasurement + read FMarginUnits write SetMarginUnits default imInches; + property PrintFormats : TVpPrintFormat + read FPrintFormats write SetPrintFormats; + property RightMargin : Extended + read FRightMargin write SetRightMargin; + property TopMargin : Extended + read FTopMargin write SetTopMargin; + end; + +implementation + +uses + VpBaseDS, + VpPrtFmtCBox, + VpPrtPrv, + VpDayView, + VpWeekView, + VpMonthView, + VpCalendar, + VpTaskList, + VpContactGrid; + +function XMLizeString (const s : string) : string; +var + i : integer; +begin + result := ''; + for i := 1 to Length (s) do + case s[i] of + '<' : result := result + '<'; + '>' : result := result + '>'; + {' ' : result := result + ' ';} + '&' : result := result + '&'; + '"' : result := result + '"'; + else + result := result + copy (s, i, 1); + end; +end; + +// TVpAttributeItem ********************************************************** + +constructor TVpAttributeItem.Create (Collection : TCollection); +begin + inherited Create (Collection); + FCollection := TVpAttributes.Create (TVpAttributes (Collection).FOwner); + + FName := ''; + FValue := ''; +end; +{=====} + +destructor TVpAttributeItem.Destroy; +begin + FCollection.Free; + FCollection := nil; + + inherited Destroy; +end; +{=====} + + + +// TVpAttributes ************************************************************* + +constructor TVpAttributes.Create(AOwner : TPersistent); +begin + inherited Create (TVpAttributeItem); + FOwner := AOwner; +end; +{=====} + +{$IFNDEF VERSION5} +procedure TVpAttributes.Delete(Item: integer); +begin + GetItem(Item).Free; +end; +{=====} +{$ENDIF} + +function TVpAttributes.GetItem (Index : Integer) : TVpAttributeItem; +begin + Result := TVpAttributeItem (inherited GetItem (Index)); +end; +{=====} + +function TVpAttributes.GetOwner : TPersistent; +begin + Result := FOwner; +end; +{=====} + +procedure TVpAttributes.SetItem (Index : Integer; Value : TVpAttributeItem); +begin + inherited SetItem (Index, Value); +end; +{=====} + + + +// TVpPrintShape ************************************************************* + +constructor TVpPrintShape.Create (AOwner : TPersistent); +begin + inherited Create; + + FOwner := AOwner; + FPen := TPen.Create; + FBrush := TBrush.Create; + FShape := ustRectangle; +end; +{=====} + +destructor TVpPrintShape.Destroy; +begin + FPen.Free; + FPen := nil; + FBrush.Free; + FBrush := nil; + + inherited Destroy; +end; +{=====} + +function TVpPrintShape.GetOwner : TPersistent; +begin + Result := FOwner; +end; +{=====} + +procedure TVpPrintShape.PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + Viewport : TRect); +var + OldPen : TPen; + OldBrush : TBrush; + +begin + + OldPen := TPen.Create; + try + OldBrush := TBrush.Create; + try + OldPen.Assign (ACanvas.Pen); + OldBrush.Assign (ACanvas.Brush); + case FShape of + ustRectangle : + {$IFDEF VERSION5} + ACanvas.Rectangle (ARect); + {$ELSE} + ACanvas.Rectangle (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); + {$ENDIF} + ustTopLine : begin + ACanvas.MoveTo (ARect.Left, ARect.Top); + ACanvas.LineTo (ARect.Right, ARect.Top); + end; + ustBottomLine : begin + ACanvas.MoveTo (ARect.Left, ARect.Bottom); + ACanvas.LineTo (ARect.Right, ARect.Bottom); + end; + ustLeftLine : begin + ACanvas.MoveTo (ARect.Left, ARect.Top); + ACanvas.LineTo (ARect.Left, ARect.Bottom); + end; + ustRightLine : begin + ACanvas.MoveTo (ARect.Right, ARect.Top); + ACanvas.LineTo (ARect.Right, ARect.Bottom); + end; + ustTLToBRLine : begin + ACanvas.MoveTo (ARect.Left, ARect.Top); + ACanvas.LineTo (ARect.Right, ARect.Bottom); + end; + ustBLToTRLine : begin + ACanvas.MoveTo (ARect.Left, ARect.Bottom); + ACanvas.LineTo (ARect.Right, ARect.Top); + end; + ustEllipse : + ACanvas.Ellipse (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); + end; + ACanvas.Pen.Assign (OldPen); + ACanvas.Brush.Assign (OldBrush); + finally + OldBrush.Free; + end; + finally + OldPen.Free; + end; +end; +{=====} + +procedure TVpPrintShape.SetBrush (const v : TBrush); +begin + FBrush.Assign (v); +end; +{=====} + +procedure TVpPrintShape.SetPen (const v : TPen); +begin + FPen.Assign (v); +end; +{=====} + + + +// TVpPrintCaption *********************************************************** + +constructor TVpPrintCaption.Create (AOwner : TPersistent); +begin + inherited Create; + + FOwner := AOwner; + FFont := TFont.Create; + FCaption := ''; +end; +{=====} + +destructor TVpPrintCaption.Destroy; +begin + FFont.Free; + FFont := nil; + + inherited Destroy; +end; +{=====} + +function TVpPrintCaption.GetOwner : TPersistent; +begin + Result := FOwner; +end; +{=====} + +procedure TVpPrintCaption.PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + Viewport : TRect; + RealString : string); +var + OldFont : TFont; + +begin + OldFont := ACanvas.Font; + ACanvas.Font := FFont; + try + TPSTextOutAtPoint (ACanvas, Angle, Viewport, ARect.Left, ARect.Top, RealString); + finally + ACanvas.Font := OldFont; + end; +end; +{=====} + +procedure TVpPrintCaption.SetFont (const v : TFont); +begin + FFont.Assign (v); +end; +{=====} + + + +// TVpPrintFormatElementItem ************************************************* + +constructor TVpPrintFormatElementItem.Create (Collection : TCollection); +begin + inherited Create (Collection); + FCollection := TVpPrintFormatElement.Create (TVpPrintFormatElement (Collection).FOwner); + + FShape := TVpPrintShape.Create (Self); + FCaption := TVpPrintCaption.Create (Self); + + FRotation := ra0; + FElementName := ''; + FItemType := itDayView; + FMeasurement := imPercent; + FHeight := 100; + FLeft := 0; + FTop := 0; + FWidth := 100; + FDayOffset := 0; + FDayOffsetUnits := duDay; + FVisible := True; +end; +{=====} + +destructor TVpPrintFormatElementItem.Destroy; +begin + FCollection.Free; + FCollection := nil; + + FShape.Free; + FShape := nil; + FCaption.Free; + FCaption := nil; + + inherited Destroy; +end; +{=====} + +function TVpPrintFormatElementItem.GetDisplayName : string; +begin + if FElementName <> '' then + Result := '(' + FElementName + ') ' + inherited GetDisplayName + else + Result := inherited GetDisplayName; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetCaption (const v : TVpPrintCaption); +begin + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + try + FCaption.Assign (v); + finally + FCollection.EndUpdate; + end; + end else + FCaption.Assign (v); +end; +{=====} + +procedure TVpPrintFormatElementItem.SetDayOffset (const v : Integer); +begin + if v = FDayOffset then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FDayOffset := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FDayOffset := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetDayOffsetUnits (const v : TVpDayUnits); +begin + if v = FDayOffsetUnits then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FDayOffsetUnits := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FDayOffsetUnits := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetElementName (const v : string); +begin + if v = FElementName then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FElementName := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FElementName := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetHeight (const v : Extended); +begin + if v = FHeight then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FHeight := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FHeight := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetItemType (const v : TVpItemType); +begin + if v = FItemType then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FItemType := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FItemType := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetLeft (const v : Extended); +begin + if v = FLeft then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FLeft := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FLeft := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetMeasurement (const v : TVpItemMeasurement); +begin + if v = FMeasurement then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FMeasurement := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FMeasurement := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetRotation (const v : TVpRotationAngle); +begin + if v = FRotation then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FRotation := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FRotation := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetShape (const v : TVpPrintShape); +begin + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + try + FShape.Assign (v); + finally + FCollection.EndUpdate; + end; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FShape.Assign (v); +end; +{=====} + +procedure TVpPrintFormatElementItem.SetTop (const v : Extended); +begin + if v = FTop then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FTop := v; + FCollection.EndUpdate; + if Assigned (Collection) then begin + Collection.NotifyAll (Self); + end; + end else + FTop := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetWidth (const v : Extended); +begin + if v = FWidth then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FWidth := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FWidth := v; +end; +{=====} + +procedure TVpPrintFormatElementItem.SetVisible (const v : Boolean); +begin + if v = FVisible then + Exit; + + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FVisible := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FVisible := v; +end; +{=====} + +// TVpPrintFormatElement ***************************************************** + +constructor TVpPrintFormatElement.Create(AOwner : TPersistent); +begin + inherited Create (TVpPrintFormatElementItem); + FOwner := AOwner; +end; +{=====} + +function TVpPrintFormatElement.GetItem (Index : Integer) : TVpPrintFormatElementItem; +begin + Result := TVpPrintFormatElementItem (inherited GetItem (Index)); +end; + +function TVpPrintFormatElement.GetOwner : TPersistent; +begin + Result := FOwner; +end; +{=====} + +procedure TVpPrintFormatElement.NotifyAll (Item : TCollectionItem); +var + Notifier : TPersistent; + +begin + if not Assigned (FOwner) then + Exit; + + if FOwner is TVpPrintFormatItem then begin + if Assigned (TVpPrintFormatItem (FOwner).FCollection) then + TVpPrintFormatItem (FOwner).FCollection.NotifyAll ((TVpPrintFormatItem (FOwner))); + end; + + if FOwner is TVpPrintFormatItem then + Notifier := (FOwner as TVpPrintFormatItem).GetOwner + else if FOwner is TVpPrintFormat then + Notifier := (FOwner as TVpPrintFormat).GetOwner + else + Notifier := nil; + + if not Assigned (Notifier) then + Exit; + + if Notifier is TVpPrintFormat then + Notifier := (Notifier as TVpPrintFormat).GetOwner; + + if Notifier is TVpPrinter then + (Notifier as TVpPrinter).NotifyLinked + else if Notifier is TVpControlLink then begin + if not Assigned ((Notifier as TVpControlLink).Printer) then + Exit; + (Notifier as TVpControlLink).Printer.NotifyLinked; + end; +end; +{=====} + +{$IFDEF VERSION6} +procedure TVpPrintFormatElement.Notify (Item : TCollectionItem; + Action : TCollectionNotification); + +begin + inherited Notify (Item, Action); + + NotifyAll (Item); +end; +{$ENDIF} +{=====} + +procedure TVpPrintFormatElement.SetItem (Index : Integer; + Value : TVpPrintFormatElementItem); +begin + inherited SetItem (Index, Value); +end; +{=====} + +procedure TVpPrintFormatElement.Update (Item : TCollectionItem); +var + Notifier : TPersistent; + +begin + inherited Update (Item); + + if not Assigned (FOwner) then + Exit; + + if FOwner is TVpPrintFormatItem then + Notifier := (FOwner as TVpPrintFormatItem).GetOwner + else if FOwner is TVpPrintFormat then + Notifier := (FOwner as TVpPrintFormat).GetOwner + else + Notifier := nil; + + if not Assigned (Notifier) then + Exit; + + if Notifier is TVpPrintFormat then + Notifier := (Notifier as TVpPrintFormat).GetOwner; + + if Notifier is TVpPrinter then + (Notifier as TVpPrinter).NotifyLinked + else if Notifier is TVpControlLink then begin + if not Assigned ((Notifier as TVpControlLink).Printer) then + Exit; + (Notifier as TVpControlLink).Printer.NotifyLinked; + end; +end; +{=====} + +// TVpPrintFormatItem ************************************************* + +constructor TVpPrintFormatItem.Create (Collection : TCollection); +begin + inherited Create (Collection); + + FCollection := TVpPrintFormat.Create (TVpPrintFormat (Collection).FOwner); + + FElements := TVpPrintFormatElement.Create (Self); + + FFormatName := 'Unknown'; + FDescription := ''; + FDayInc := 0; + FDayIncUnits := duDay; + FVisible := True; +end; +{=====} + +destructor TVpPrintFormatItem.Destroy; +begin + FElements.Free; + FElements := nil; + + FCollection.Free; + FCollection := nil; + + inherited Destroy; +end; +{=====} + +function TVpPrintFormatItem.GetDisplayName : string; +begin + if FFormatName <> '' then + Result := '(' + FFormatName + ') ' + inherited GetDisplayName + else + Result := inherited GetDisplayName; +end; +{=====} + +procedure TVpPrintFormatItem.SetDayInc (const v : Integer); +begin + if v = FDayInc then + Exit; + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FDayInc := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FDayInc := v; +end; +{=====} + +procedure TVpPrintFormatItem.SetDayIncUnits (const v : TVpDayUnits); +begin + if v = FDayIncUnits then + Exit; + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FDayIncUnits := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FDayIncUnits := v; +end; +{=====} + +procedure TVpPrintFormatItem.SetDescription (const v : string); +begin + if v = FDescription then + Exit; + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FDescription := v; + FCollection.EndUpdate; + end else + FDescription := v; +end; +{=====} + +procedure TVpPrintFormatItem.SetElements (const v : TVpPrintFormatElement); +begin + FElements.Assign (v); + if Assigned (Collection) then + Collection.NotifyAll (Self); +end; +{=====} + +procedure TVpPrintFormatItem.SetFormatName (const v : string); +begin + if v = '' then + raise EVpPrintFormatError.Create (RSNeedFormatName); + if v = FFormatName then + Exit; + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FFormatName := v; + FCollection.EndUpdate; + end else + FFormatName := v; +end; +{=====} + +procedure TVpPrintFormatItem.SetVisible (const v : Boolean); +begin + if v = FVisible then + Exit; + if Assigned (FCollection) then begin + FCollection.BeginUpdate; + FVisible := v; + FCollection.EndUpdate; + if Assigned (Collection) then + Collection.NotifyAll (Self); + end else + FVisible := v; +end; +{=====} + + + +// TVpPrintFormat ************************************************************ + +constructor TVpPrintFormat.Create (AOwner : TPersistent); +begin + inherited Create (TVpPrintFormatItem); + + FOwner := AOwner; +end; +{=====} + +function TVpPrintFormat.GetItem (Index : Integer) : TVpPrintFormatItem; +begin + Result := TVpPrintFormatItem (inherited GetItem (Index)); +end; +{=====} + +function TVpPrintFormat.GetOwner : TPersistent; +begin + Result := FOwner; +end; +{=====} + +procedure TVpPrintFormat.NotifyAll (Item : TCollectionItem); +begin + if not Assigned (FOwner) then + Exit; + + if FOwner is TVpPrinter then + (FOwner as TVpPrinter).NotifyLinked + else if FOwner is TVpControlLink then begin + if not Assigned ((FOwner as TVpControlLink).Printer) then + Exit; + (FOwner as TVpControlLink).Printer.NotifyLinked; + end; +end; +{=====} + +{$IFDEF VERSION6} +procedure TVpPrintFormat.Notify (Item : TCollectionItem; + Action : TCollectionNotification); +begin + inherited Notify (Item, Action); + + NotifyAll (Item); +end; +{$ENDIF} +{=====} + +procedure TVpPrintFormat.SetItem (Index : Integer; + Value : TVpPrintFormatItem); +begin + inherited SetItem (Index, Value); +end; +{=====} + +procedure TVpPrintFormat.Update (Item : TCollectionItem); +begin + inherited Update (Item); + + if not Assigned (FOwner) then + Exit; + + if FOwner is TVpPrinter then + (FOwner as TVpPrinter).NotifyLinked + else if FOwner is TVpControlLink then begin + if not Assigned ((FOwner as TVpControlLink).Printer) then + Exit; + (FOwner as TVpControlLink).Printer.NotifyLinked; + end; +end; +{=====} + +// TVpPrinter **************************************************************** + +constructor TVpPrinter.Create (AOwner : TComponent); +begin + inherited Create; + + FPrintJob := False; + + FPrintFormats := TVpPrintFormat.Create (AOwner); + FAttributes := TVpAttributes.Create (Self); + FVariables := TVpAttributes.Create (Self); + FNotifiers := TList.Create; + + FOwner := AOwner; + + FLoadingIndex := -1; + FElementIndex := -1; + FDayStart := h_08; + FDayEnd := h_05; + FGranularity := gr30Min; + FUseFormComponents := True; + + CreateWorkControls; +end; +{=====} + +destructor TVpPrinter.Destroy; +begin + DeregisterAllWatchers; + FPrintFormats.Free; + FAttributes.Free; + FVariables.Free; + FNotifiers.Free; + DestroyWorkControls; + inherited; +end; +{=====} + +procedure TVpPrinter.AddDefaultVariables (Date : TDateTime); + function HourToStr (Hour : TVpHours; Mil : Boolean) : string; + begin + if Mil then + Result := IntToStr(ord(Hour)) + else + case Hour of + h_00 : Result := '12'; + h_01 : Result := '1'; + h_02 : Result := '2'; + h_03 : Result := '3'; + h_04 : Result := '4'; + h_05 : Result := '5'; + h_06 : Result := '6'; + h_07 : Result := '7'; + h_08 : Result := '8'; + h_09 : Result := '9'; + h_10 : Result := '10'; + h_11 : Result := '11'; + h_12 : Result := '12'; + h_13 : Result := '1'; + h_14 : Result := '2'; + h_15 : Result := '3'; + h_16 : Result := '4'; + h_17 : Result := '5'; + h_18 : Result := '6'; + h_19 : Result := '7'; + h_20 : Result := '8'; + h_21 : Result := '9'; + h_22 : Result := '10'; + h_23 : Result := '11'; + end; + end; + + function GranularityToStr (Gran : TVpGranularity) : string; + begin + Result := ''; + case Gran of + gr60Min : Result := '60'; + gr30Min : Result := '30'; + gr20Min : Result := '20'; + gr15Min : Result := '15'; + gr10Min : Result := '10'; + gr06Min : Result := '6'; + gr05Min : Result := '5'; + end; + end; + + function HourToAMPM (Hour : TVpHours) : string; + begin + if (Hour >= H_00) and (Hour <= h_11) then + Result := 'AM' + else + Result := 'PM'; + end; + + procedure AddDataStoreVars; + var + DataStore : TVpCustomDataStore; + i : Integer; + TopLevel : TComponent; + + begin + if not Assigned (FOwner) then + Exit; + if not (FOwner is TVpControlLink) then + Exit; + TopLevel := (FOwner as TVpControlLink).Owner; + if not Assigned (TopLevel) then + Exit; + + DataStore := nil; + + for i := 0 to pred (TopLevel.ComponentCount) do + if (TopLevel.Components[i] is TVpCustomDataStore) then begin + DataStore := TVpCustomDataStore (TopLevel.Components[i]); + end; + + if Assigned (DataStore) then begin + AddVariable ('ResourceID', IntToStr (DataStore.ResourceID)); + if Assigned (DataStore.Resource) then begin + AddVariable ('Resource', DataStore.Resource.Description); + AddVariable ('ResourceNotes', DataStore.Resource.Notes); + end; + end; + end; + +begin + { Variables for the date } + UpdateDateVariables (Date); + + { Variables for the starting name } + AddVariable ('StartHour12', HourToStr (FDayStart, False)); + AddVariable ('StartHour24', HourToStr (FDayStart, True)); + AddVariable ('StartHourAMPM', HourToAMPM (FDayStart)); + + { Variables for the ending time } + AddVariable ('StopHour12', HourToStr (FDayEnd, False)); + AddVariable ('StopHour24', HourToStr (FDayEnd, False)); + AddVariable ('StopHourAMPM', HourToAMPM (FDayEnd)); + + { Variables for granularity } + AddVariable ('Granularity', GranularityToStr (Granularity)); + + AddDataStoreVars; +end; +{=====} + +procedure TVpPrinter.AddVariable (VarName : string; Value : string); +var + i : Integer; + NewVar : TVpAttributeItem; + +begin + for i := 0 to FVariables.Count - 1 do + if FVariables.Items[i].Name = VarName then begin + FVariables.Items[i].Value := Value; + Exit; + end; + NewVar := TVpAttributeItem (FVariables.Add); + NewVar.Name := VarName; + NewVar.Value := Value; +end; +{=====} + +procedure TVpPrinter.ChangeVariable (VarName : string; NewValue : string); +begin + AddVariable (VarName, NewValue); +end; +{=====} + +procedure TVpPrinter.CheckPrintFormat; +begin + if PrintFormats.Count = 0 then + raise EVpPrintFormatError.Create (RSNoPrintFormats) + else if (CurFormat < 0) or + (CurFormat >= PrintFormats.Count) then + raise EVpPrintFormatError.Create (RSBadPrintFormat); +end; +{=====} + +procedure TVpPrinter.ClearVariables; +begin + FVariables.Clear; +end; +{=====} + +procedure TVpPrinter.CreateWorkControls; +begin +{$IFNDEF LCL} + FParentHandle := AllocateHWnd (nil); + FDayView := TVpDayView.CreateParented (FParentHandle); + FWeekView := TVpWeekView.CreateParented (FParentHandle); + FMonthView := TVpMonthView.CreateParented (FParentHandle); + FCalendar := TVpCalendar.CreateParented (FParentHandle); + FContactGrid := TVpContactGrid.CreateParented (FParentHandle); + FTaskList := TVpTaskList.CreateParented (FParentHandle); +{$ENDIF} +end; +{=====} + +procedure TVpPrinter.DestroyWorkControls; + +begin +{$IFNDEF LCL} + DeallocateHWnd (FParentHandle); + + FDayView.Free; + FWeekView.Free; + FMonthView.Free; + FCalendar.Free; + FContactGrid.Free; + FTaskList.Free; +{$ENDIF} +end; +{=====} + +function TVpPrinter.DeleteVariable (VarName : string) : Boolean; +var + i : Integer; + +begin + Result := True; + for i := 0 to FVariables.Count - 1 do + if FVariables.Items[i].Name = VarName then begin + FVariables.Delete(i); + Exit; + end; + Result := False; +end; +{=====} + +procedure TVpPrinter.DeregisterAllWatchers; +var + i : Integer; + +begin + for i := FNotifiers.Count - 1 downto 0 do + if Assigned (FNotifiers[i]) then begin + FreeMem (FNotifiers[i]); + FNotifiers.Delete (i); + end; +end; +{=====} + +procedure TVpPrinter.DeregisterWatcher (Watcher : THandle); +var + i : Integer; + +begin + for i := FNotifiers.Count - 1 downto 0 do + if Assigned (FNotifiers[i]) then + if PVpWatcher (FNotifiers[i]).Handle = Watcher then begin + FreeMem (FNotifiers[i]); + FNotifiers.Delete (i); + Exit; + end; +end; +{=====} + +function TVpPrinter.HaveVariable (VarName : string) : Boolean; +var + i : Integer; + +begin + Result := True; + for i := 0 to FVariables.Count - 1 do + if FVariables.Items[i].Name = VarName then + Exit; + Result := False; +end; +{=====} + +function TVpPrinter.Find (const v : string) : Integer; +var + i : Integer; + +begin + Result := -1; + for i := 0 to FPrintFormats.Count - 1 do + if v = FPrintFormats.Items[i].FormatName then begin + Result := i; + Exit; + end; +end; +{=====} + +function TVpPrinter.GetOwner: TPersistent; +begin + Result := FOwner; +end; +{=====} + +procedure TVpPrinter.LoadFromFile (FileName : string; + Append : Boolean); +var + Parser : TVpParser; + +begin + if FileName = '' then + FileName := DefaultXMLFileName; + + if not Append then + FPrintFormats.Clear; + + FLoadingIndex := -1; + FElementIndex := -1; + Parser := TVpParser.Create (nil); + Parser.OnAttribute := xmlPrintFormatAttribute; + Parser.OnStartElement := xmlPrintFormatStartElement; + Parser.OnEndElement := xmlPrintFormatEndElement; + try + Parser.ParseDataSource (FileName); + finally + Parser.Free; + end; + FLoadingIndex := -1; + FElementIndex := -1; + NotifyLinked; +end; +{=====} + +function TVpPrinter.LookupVariable (VarName : string) : string; +var + i : Integer; + +begin + Result := ''; + for i := 0 to FVariables.Count - 1 do + if FVariables.Items[i].Name = VarName then begin + Result := FVariables.Items[i].Value; + Break; + end; +end; +{=====} + +procedure TVpPrinter.NotifyLinked; +var + i : Integer; +begin + for i := 0 to FNotifiers.Count - 1 do + if Assigned (FNotifiers[i]) then + PostMessage (PVpWatcher (FNotifiers[i]).Handle, + Vp_PrintFormatChanged, 0, 0); +end; +{=====} + +procedure TVpPrinter.PaintToCanvasRect (ACanvas : TCanvas; + ARect : TRect; + ADate : TDateTime); + +var + WidthInPixels : Integer; + HeightInPixels : Integer; + PixelsPerInchX : Integer; + PixelsPerInchY : Integer; + StartX : Integer; + StartY : Integer; + StopX : Integer; + StopY : Integer; + Scale : Extended; + StartLine : Integer; + EndLine : Integer; + + procedure GetMeasurements; + begin + WidthInPixels := ARect.Right - ARect.Left; + HeightInPixels := ARect.Bottom - ARect.Top; + + PixelsPerInchX := GetDeviceCaps (ACanvas.Handle, LOGPIXELSX); + PixelsPerInchY := GetDeviceCaps (ACanvas.Handle, LOGPIXELSY); + + Scale := PixelsPerInchY / Screen.PixelsPerInch; + + StartLine := HourToLine (DayStart, Granularity); + EndLine := HourToLine (DayEnd, Granularity); + end; + + procedure GetPrintRectangle (Element : TVpPrintFormatElementItem); + begin + case Element.Measurement of + imAbsolutePixel : begin + StartX := Round (Element.Left); + StartY := Round (Element.Top); + StopX := Round (Element.Left + Element.Width); + StopY := Round (Element.Top + Element.Height); + end; + + imPercent : begin + StartX := Round (Element.Left * WidthInPixels / 100); + StartY := Round (Element.Top * HeightInPixels / 100); + StopX := Round ((Element.Left + Element.Width) * WidthInPixels / 100); + StopY := Round ((Element.Top + Element.Height) * HeightInPixels / 100); + end; + + imInches : begin + StartX := Round (Element.Left * PixelsPerInchX); + StartY := Round (Element.Top * PixelsPerInchX); + StopX := Round ((Element.Left + Element.Width) * PixelsPerInchX); + StopY := Round ((Element.Top + Element.Height) * PixelsPerInchX); + end; + end; + + Inc (StartX, ARect.Left); + Inc (StartY, ARect.Top); + Inc (StopX, ARect.Left); + Inc (StopY, ARect.Top); + end; + + function GetDate (Element : TVpPrintFormatElementItem) : TDateTime; + begin + Result := ADate; + if Element.DayOffset <> 0 then begin + case Element.DayOffsetUnits of + duDay : Result := Result + Element.DayOffset; + duWeek : Result := Result + Element.DayOffset * 7; + duMonth : Result := IncMonth (Result, Element.DayOffset); + duYear : Result := IncYear (Result, Element.DayOffset); + end; + end; + end; + + procedure RenderItem (Element : TVpPrintFormatElementItem); + var + i : Integer; + DI : TVpDependentInfo; + DependentList : TList; + RenderControl : TVpLinkableControl; + + begin + if not Element.Visible then + Exit; + + RenderControl := nil; + DependentList := (FOwner as TVpControlLink).GetDependentList; + if FUseFormComponents then + for i := 0 to DependentList.Count - 1 do begin + DI := TVpDependentInfo (DependentList.List^[I]); + if TVpLinkableControl (DI.Component).GetControlType = Element.ItemType then begin + RenderControl := TVpLinkableControl (DI.Component); + Break; + end; + end; + + if not Assigned (RenderControl) then begin + case Element.ItemType of + itDayView : RenderControl := TVpLinkableControl (FDayView); + itWeekView : RenderControl := TVpLinkableControl (FWeekView); + itMonthView : RenderControl := TVpLinkableControl (FMonthView); + itCalendar : RenderControl := TVpLinkableControl (FCalendar); + itContacts : RenderControl := TVpLinkableControl (FContactGrid); + itTasks : RenderControl := TVpLinkableControl (FTaskList); + end; + if FOwner is TVpControlLink then + RenderControl.DataStore := (FOwner as TVPControlLink).DataStore; + end; + + if Assigned (RenderControl) then + case Element.ItemType of + itTasks : begin + FHaveTaskList := True; + RenderControl.RenderToCanvas (ACanvas, + Rect (StartX, StartY, StopX, StopY), + Element.Rotation, + Scale, + GetDate (Element), + FLastTask, + EndLine, + Granularity, + True); + FLastTask := RenderControl.GetLastPrintLine; + end; + + itContacts : begin + FHaveContactGrid := True; + RenderControl.RenderToCanvas (ACanvas, + Rect (StartX, StartY, StopX, StopY), + Element.Rotation, + Scale, + GetDate (Element), + FLastContact, + EndLine, + Granularity, + True); + FLastContact := RenderControl.GetLastPrintLine; + end; + + else + RenderControl.RenderToCanvas (ACanvas, + Rect (StartX, StartY, StopX, StopY), + Element.Rotation, + Scale, + GetDate (Element), + StartLine, + EndLine, + Granularity, + True); + end; + + case Element.ItemType of + itDayView, + itMonthView, + itWeekView, + itCalendar : FHaveDate := True; + end; + end; + +var + i : Integer; + +begin + CheckPrintFormat; + + if not (FPrintJob) then begin + FLastTask := 0; + FLastContact := 0; + end; + + AddDefaultVariables (ADate); + + if not (FOwner is TVpControlLink) then + raise EVpPrintFormatError.Create (RSPrtControlOwner); + + GetMeasurements; + + if not ValidFormat (CurFormat) then + raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (CurFormat)); + + for i := 0 to FPrintFormats.Items[CurFormat].Elements.Count - 1 do begin + GetPrintRectangle (FPrintFormats.Items[CurFormat].Elements.Items[i]); + + if FPrintFormats.Items[CurFormat].Elements.Items[i].ItemType = itCaption then begin + if FPrintFormats.Items[CurFormat].Elements.Items[i].Visible then begin + UpdateDateVariables (GetDate (FPrintFormats.Items[CurFormat].Elements.Items[i])); + ACanvas.Font.Assign (FPrintFormats.Items[CurFormat].Elements.Items[i].FCaption.Font); + FPrintFormats.Items[CurFormat].Elements.Items[i].FCaption.PaintToCanvas (ACanvas, + Rect (StartX, StartY, StopX, StopY), + FPrintFormats.Items[CurFormat].Elements.Items[i].Rotation, + ARect, + ReplaceVariables (FPrintFormats.Items[CurFormat].Elements.Items[i].FCaption.Caption)); + end; + + end else if FPrintFormats.Items[CurFormat].Elements.Items[i].ItemType = itShape then begin + if FPrintFormats.Items[CurFormat].Elements.Items[i].Visible then begin + ACanvas.Pen.Assign (FPrintFormats.Items[CurFormat].Elements.Items[i].FShape.Pen); + ACanvas.Brush.Assign (FPrintFormats.Items[CurFormat].Elements.Items[i].FShape.Brush); + FPrintFormats.Items[CurFormat].Elements.Items[i].FShape.PaintToCanvas (ACanvas, + Rect (StartX, StartY, StopX, StopY), + FPrintFormats.Items[CurFormat].Elements.Items[i].Rotation, + ARect) + end; + + end else + RenderItem (FPrintFormats.Items[CurFormat].Elements.Items[i]); + end; +end; +{=====} + +procedure TVpPrinter.Print (APrinter : TPrinter; + StartDate : TDateTime; + EndDate : TDateTime); +var + ARect : TRect; + WidthInPixels : Integer; + HeightInPixels : Integer; + PixelsPerInchX : Integer; + PixelsPerInchY : Integer; + Scale : Extended; + + procedure GetMeasurements; + begin + ARect.Left := 0; + ARect.Top := 0; + ARect.Right := APrinter.PageWidth; + ARect.Bottom := APrinter.PageHeight; + + WidthInPixels := ARect.Right - ARect.Left; + HeightInPixels := ARect.Bottom - ARect.Top; + + PixelsPerInchX := GetDeviceCaps (APrinter.Canvas.Handle, LOGPIXELSX); + PixelsPerInchY := GetDeviceCaps (APrinter.Canvas.Handle, LOGPIXELSY); + + Scale := PixelsPerInchY / Screen.PixelsPerInch; + end; + + procedure CalculateMargins; + begin + + case MarginUnits of + imAbsolutePixel : begin + ARect.Left := Round (LeftMargin); + ARect.Top := Round (TopMargin); + ARect.Right := ARect.Right - Round (RightMargin); + ARect.Bottom := ARect.Bottom - Round (BottomMargin); + end; + + imPercent : begin + ARect.Left := Round (LeftMargin * WidthInPixels / 100); + ARect.Top := Round (TopMargin * HeightInPixels / 100); + ARect.Right := ARect.Right - Round (RightMargin * WidthInPixels / 100); + ARect.Bottom := ARect.Bottom - Round (BottomMargin * HeightInPixels / 100); + end; + + imInches : begin + ARect.Left := Round (LeftMargin * PixelsPerInchX); + ARect.Top := Round (TopMargin * PixelsPerInchX); + ARect.Right := ARect.Right - Round (RightMargin * PixelsPerInchX); + ARect.Bottom := ARect.Bottom - Round (BottomMargin * PixelsPerInchX); + end; + end; + end; + + function GetNextDate (ADate : TDateTime) : TDateTime; + begin + Result := ADate; + if PrintFormats.Items[CurFormat].DayInc <> 0 then begin + case PrintFormats.Items[CurFormat].DayIncUnits of + duDay : Result := Result + PrintFormats.Items[CurFormat].DayInc; + duWeek : Result := Result + PrintFormats.Items[CurFormat].DayInc * 7; + duMonth : Result := IncMonth (Result, PrintFormats.Items[CurFormat].DayInc); + duYear : Result := IncYear (Result, PrintFormats.Items[CurFormat].DayInc); + end; + end else + Result := Result + 1; + end; + +var + CurDate : TDateTime; + RealStartDate : TDateTime; + RealEndDate : TDateTime; + PageNum : Integer; + Done : Boolean; + +begin + CheckPrintFormat; + + FHaveDate := False; + FHaveContactGrid := False; + FHaveTaskList := False; + + FPrintJob := True; + try + AddDefaultVariables (StartDate); + PageNum := 1; + + if not (FOwner is TVpControlLink) then + raise EVpPrintFormatError.Create (RSPrtControlOwner); + + if not ValidFormat (CurFormat) then + raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (CurFormat)); + + GetMeasurements; + CalculateMargins; + + CurDate := GetNextDate (StartDate); + RealStartDate := StartDate; + RealEndDate := EndDate; + if CurDate < StartDate then begin + if StartDate < EndDate then begin + RealStartDate := EndDate; + RealEndDate := StartDate; + end; + end else begin + if StartDate > EndDate then begin + RealStartDate := EndDate; + RealEndDate := StartDate; + end; + end; + CurDate := RealStartDate; + + Done := False; + while not Done do begin + { Update variables to reflect the current date } + UpdateDateVariables (CurDate); + ChangeVariable ('Page', IntToStr (PageNum)); + + { Paint the page } + if FOwner is TVpControlLink then + with FOwner as TVpControlLink do + TriggerOnPageStart (Self, PageNum, CurDate); + + PaintToCanvasRect (Printer.Canvas, ARect, CurDate); + + { Get the next date } + + CurDate := GetNextDate (CurDate); + + { Determine if the printing is done or not. + This is a bit involved. If only dates, captions and shapes are in the + print format, doneness is determined when the date passes the end date. + If task lists or contact grids are on the format, then doneness occurs + when the date has bumped pass the last date and all the tasks and + contacts have been printed. + } + Done := True; + if (FHaveDate) and (CurDate <= RealEndDate) then + Done := False; + if (FHaveTaskList) and (FLastTask >= 0) then + Done := False; + if (FHaveContactGrid) and (FLastContact >= 0) then + Done := False; + + if FOwner is TVpControlLink then + with FOwner as TVpControlLink do + TriggerOnPageEnd (Self, PageNum, CurDate, Done); + + { Go to the next page if not done } + if not Done then begin + Printer.NewPage; + Inc (PageNum); + end; + end; + finally + FPrintJob := False; + end; +end; +{=====} + +procedure TVpPrinter.RegisterWatcher (Watcher : THandle); +var + i : Integer; + NewHandle : PVpWatcher; + +begin + for i := 0 to FNotifiers.Count - 1 do + if Assigned (FNotifiers[i]) then + if PVpWatcher (FNotifiers[i]).Handle = Watcher then + Exit; + GetMem (NewHandle, SizeOf (TVpWatcher)); + NewHandle.Handle := Watcher; + FNotifiers.Add (NewHandle); +end; +{=====} + +procedure TVpPrinter.RenderPage ( ACanvas : TCanvas; + ARect : TRect; + PageNum : Integer; + var ADate : TDateTime; + EndDate : TDateTime; + var StartContact : Integer; + var StartTask : Integer; + var LastPage : Boolean); +var + WidthInPixels : Integer; + HeightInPixels : Integer; + PixelsPerInchX : Integer; + PixelsPerInchY : Integer; + Scale : Extended; + + procedure GetMeasurements; + begin + WidthInPixels := ARect.Right - ARect.Left; + HeightInPixels := ARect.Bottom - ARect.Top; + + PixelsPerInchX := GetDeviceCaps (ACanvas.Handle, LOGPIXELSX); + PixelsPerInchY := GetDeviceCaps (ACanvas.Handle, LOGPIXELSY); + + Scale := PixelsPerInchY / Screen.PixelsPerInch; + end; + + procedure CalculateMargins; + begin + + case MarginUnits of + imAbsolutePixel : begin + ARect.Left := Round (LeftMargin); + ARect.Top := Round (TopMargin); + ARect.Right := ARect.Right - Round (RightMargin); + ARect.Bottom := ARect.Bottom - Round (BottomMargin); + end; + + imPercent : begin + ARect.Left := Round (LeftMargin * WidthInPixels / 100); + ARect.Top := Round (TopMargin * HeightInPixels / 100); + ARect.Right := ARect.Right - Round (RightMargin * WidthInPixels / 100); + ARect.Bottom := ARect.Bottom - Round (BottomMargin * HeightInPixels / 100); + end; + + imInches : begin + ARect.Left := Round (LeftMargin * PixelsPerInchX); + ARect.Top := Round (TopMargin * PixelsPerInchX); + ARect.Right := ARect.Right - Round (RightMargin * PixelsPerInchX); + ARect.Bottom := ARect.Bottom - Round (BottomMargin * PixelsPerInchX); + end; + end; + end; + + function GetNextDate (ADate : TDateTime) : TDateTime; + begin + Result := ADate; + if PrintFormats.Items[CurFormat].DayInc <> 0 then begin + case PrintFormats.Items[CurFormat].DayIncUnits of + duDay : Result := Result + PrintFormats.Items[CurFormat].DayInc; + duWeek : Result := Result + PrintFormats.Items[CurFormat].DayInc * 7; + duMonth : Result := IncMonth (Result, PrintFormats.Items[CurFormat].DayInc); + duYear : Result := IncYear (Result, PrintFormats.Items[CurFormat].DayInc); + end; + end else + Result := Result + 1; + end; + +var + OldTask : Integer; + OldContact : Integer; + +begin + CheckPrintFormat; + FHaveDate := False; + FHaveContactGrid := False; + FHaveTaskList := False; + + OldTask := FLastTask; + OldContact := FLastContact; + + FPrintJob := True; + try + AddDefaultVariables (ADate); + + if not (FOwner is TVpControlLink) then + raise EVpPrintFormatError.Create (RSPrtControlOwner); + + if FPrintFormats.Count = 0 then + raise EVpPrintFormatError.Create (RSNeedFormatName) + else if not ValidFormat (CurFormat) then + raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (CurFormat)); + + GetMeasurements; + CalculateMargins; + + ChangeVariable ('Page', IntToStr (PageNum)); + + FLastTask := StartTask; + FLastContact := StartContact; + PaintToCanvasRect (ACanvas, ARect, ADate); + ADate := GetNextDate (ADate); + + LastPage := True; + if (FHaveDate) and (ADate < EndDate) then + LastPage := False; + if (FHaveTaskList) and (FLastTask >= 0) then + LastPage := False; + if (FHaveContactGrid) and (FLastContact >= 0) then + LastPage := False; + finally + FLastTask := OldTask; + FLastContact := OldContact; + end; +end; +{=====} + +function TVpPrinter.ReplaceVariables (const s : string) : string; +type + TVpVariableState = (vsPlainText, vsCollectVarName, vsHaveVarName); + +var + State : TVpVariableState; + SLen : Integer; + i : Integer; + VarName : string; + ForceTerm : Boolean; + VarsOk : Boolean; + Value : string; + Found : Boolean; + Change : TVpChangeVar; + +begin + State := vsPlainText; + SLen := Length (s); + i := 1; + Result := ''; + VarsOk := True; + ForceTerm := False; + + while (i <= SLen) do begin + case State of + vsCollectVarName : + case s[i] of + 'A'..'Z', 'a'..'z', '0'..'9', '_' : + VarName := VarName + s[i]; + ';' : begin + State := vsHaveVarName; + ForceTerm := True; + end; + else begin + State := vsHaveVarName; + ForceTerm := False; + end; + end; + + vsHaveVarName : begin + State := vsPlainText; + VarsOk := True; + Found := HaveVariable (VarName); + if Found then begin + Change := cvChange; + Value := LookupVariable (VarName); + end else + Change := cvRemove; + + if FOwner is TVpControlLink then + with FOwner as TVpControlLink do + TriggerOnGetVariable (Self, VarName, Found, Value, Change); + + case Change of + cvChange : + if ForceTerm then + Result := Result + Value + s[i] + else + Result := Result + Value + s[i - 1] + s[i]; + cvIgnore : + Result := Result + '$' + VarName + s[i - 1] + s[i]; + cvRemove : begin + end; + end; + end; + + vsPlainText : + case s[i] of + '$' : begin + VarsOk := False; + State := vsCollectVarName; + VarName := ''; + end; + else + Result := Result + s[i]; + end; + + end; + Inc (i); + end; + + if not VarsOk then begin + Found := HaveVariable (VarName); + if Found then begin + Change := cvChange; + Value := LookupVariable (VarName); + end else + Change := cvRemove; + + if FOwner is TVpControlLink then + with FOwner as TVpControlLink do + TriggerOnGetVariable (Self, VarName, Found, Value, Change); + + case Change of + cvChange : + Result := Result + LookupVariable (VarName); + cvIgnore : + Result := Result + '$' + VarName + s[i - 1]; + cvRemove : begin + end; + end; + end; +end; +{=====} + +procedure TVpPrinter.SaveToFile (FileName : string); +var + fpOut : TextFile; + i : Integer; + j : Integer; + +begin + if FileName = '' then + FileName := DefaultXMLFileName; + + AssignFile (fpOut, FileName); + Rewrite (fpOut); + try + Writeln (fpOut, ''); + Writeln (fpOut, ''); + for i := 0 to FPrintFormats.Count - 1 do begin + Writeln (fpOut, ' '); + duWeek : Writeln (fpOut, ' DayIncrementUnits="Week">'); + duMonth : Writeln (fpOut, ' DayIncrementUnits="Month">'); + duYear : Writeln (fpOut, ' DayIncrementUnits="Year">'); + end; + for j := 0 to FPrintFormats.Items[i].Elements.Count - 1 do begin + Writeln (fpOut, ' '); + duWeek : Writeln (fpOut, ' DayOffsetUnits="Week">'); + duMonth : Writeln (fpOut, ' DayOffsetUnits="Month">'); + duYear : Writeln (fpOut, ' DayOffsetUnits="Year">'); + end; + + if FPrintFormats.Items[i].Elements.Items[j].ItemType = itShape then begin + Writeln (fpOut, ' '); + ustTopLine : Writeln (fpOut, ' Type="TopLine">'); + ustBottomLine : Writeln (fpOut, ' Type="BottomLine">'); + ustLeftLine : Writeln (fpOut, ' Type="LeftLine">'); + ustRightLine : Writeln (fpOut, ' Type="RightLine">'); + ustTLToBRLine : Writeln (fpOut, ' Type="TLToBRLine">'); + ustBLToTRLine : Writeln (fpOut, ' Type="BLToTRLine">'); + ustEllipse : Writeln (fpOut, ' Type="Ellipse">'); + end; + + Writeln (fpOut, ' '); + bsClear : Writeln (fpOut, ' Style="Clear"/>'); + bsHorizontal : Writeln (fpOut, ' Style="Horizontal"/>'); + bsVertical : Writeln (fpOut, ' Style="Vertical"/>'); + bsFDiagonal : Writeln (fpOut, ' Style="FDiagonal"/>'); + bsBDiagonal : Writeln (fpOut, ' Style="BDiagonal"/>'); + bsCross : Writeln (fpOut, ' Style="Cross"/>'); + bsDiagCross : Writeln (fpOut, ' Style="DiagCross"/>'); + end; + Writeln (fpOut, ' '); + Writeln (fpOut, ' '); + end; + + if FPrintFormats.Items[i].Elements.Items[j].ItemType = itCaption then begin + Writeln (fpOut, ' '); + + Writeln (fpOut, ' ') + else + Writeln (fpOut, ' Strikeout="False"/>'); + Writeln (fpOut, ' '); + end; + Writeln (fpOut, ' '); + + end; + Writeln (fpOut, ' '); + end; + Writeln (fpOut, ''); + finally + CloseFile (fpOut); + end; +end; +{=====} + +procedure TVpPrinter.SetBottomMargin (const v : Extended); +begin + if v <> FBottomMargin then begin + FBottomMargin := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.SetCurFormat (const v : Integer); +begin + if FPrintFormats.Count = 0 then + raise EVpPrintFormatError.Create (RSNoPrintFormats); + + if v <> FCurFormat then begin + if (v < 0) or (v >= FPrintFormats.Count) then + raise EVpPrintFormatError.Create (RSBadPrintFormat + IntToStr (v)); + FCurFormat := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.SetDefaultXMLFileName (const v : string); +begin + if v <> FDefaultXMLFileName then + FDefaultXMLFileName := v; +end; +{=====} + +procedure TVpPrinter.SetLeftMargin (const v : Extended); +begin + if v <> FLeftMargin then begin + FLeftMargin := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.SetMarginUnits (const v : TVpItemMeasurement); +begin + if v <> FMarginUnits then begin + FMarginUnits := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.SetPrintFormats (const v : TVpPrintFormat); +begin + FPrintFormats.Assign (v); + NotifyLinked; +end; +{=====} + +procedure TVpPrinter.SetRightMargin (const v : Extended); +begin + if v <> FRightMargin then begin + FRightMargin := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.SetTopMargin (const v : Extended); +begin + if v <> FTopMargin then begin + FTopMargin := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.SetUseFormComponents (const v : Boolean); +begin + if v <> FUseFormComponents then begin + FUseFormComponents := v; + NotifyLinked; + end; +end; +{=====} + +procedure TVpPrinter.UpdateDateVariables (Date : TDateTime); +begin + AddVariable ('DayNumber', FormatDateTime ('d', Date)); + AddVariable ('DayNumber0', FormatDateTime ('dd', Date)); + AddVariable ('DayAbbrev', FormatDateTime ('ddd', Date)); + AddVariable ('DayName', FormatDateTime ('dddd', Date)); + AddVariable ('ShortDate', FormatDateTime ('ddddd', Date)); + AddVariable ('LongDate', FormatDateTime ('dddddd', Date)); + AddVariable ('Era', FormatDateTime ('e', Date)); + AddVariable ('Era0', FormatDateTime ('ee', Date)); + AddVariable ('EraAbbrev', FormatDateTime ('g', Date)); + AddVariable ('EraName', FormatDateTime ('gg', Date)); + AddVariable ('Month', FormatDateTime ('m', Date)); + AddVariable ('Month0', FormatDateTime ('mm', Date)); + AddVariable ('MonthAbbv', FormatDateTime ('mmm', Date)); + AddVariable ('MonthName', FormatDateTime ('mmmm', Date)); + AddVariable ('ShortYear', FormatDateTime ('yy', Date)); + AddVariable ('LongYear', FormatDateTime ('yyyy', Date)); + AddVariable ('DateSep', FormatDateTime ('/', Date)); + AddVariable ('d', FormatDateTime ('d', Date)); + AddVariable ('dd', FormatDateTime ('dd', Date)); + AddVariable ('ddd', FormatDateTime ('ddd', Date)); + AddVariable ('dddd', FormatDateTime ('dddd', Date)); + AddVariable ('ddddd', FormatDateTime ('ddddd', Date)); + AddVariable ('dddddd', FormatDateTime ('dddddd', Date)); + AddVariable ('e', FormatDateTime ('e', Date)); + AddVariable ('ee', FormatDateTime ('ee', Date)); + AddVariable ('g', FormatDateTime ('g', Date)); + AddVariable ('gg', FormatDateTime ('gg', Date)); + AddVariable ('m', FormatDateTime ('m', Date)); + AddVariable ('mm', FormatDateTime ('mm', Date)); + AddVariable ('mmm', FormatDateTime ('mmm', Date)); + AddVariable ('mmmm', FormatDateTime ('mmmm', Date)); + AddVariable ('yy', FormatDateTime ('yy', Date)); + AddVariable ('yyyy', FormatDateTime ('yyyy', Date)); + AddVariable ('/', FormatDateTime ('/', Date)); +end; +{=====} + +function TVpPrinter.ValidFormat (const v : Integer) : Boolean; +begin + Result := (v >= 0) and (v < FPrintFormats.Count); +end; +{=====} + +procedure TVpPrinter.xmlPrintFormatAttribute (oOwner : TObject; + sName, + sValue : DOMString; + bSpecified : Boolean); +var + Item : TVpAttributeItem; +begin + Item := TVpAttributeItem (FAttributes.Add); + Item.Name := sName; + Item.Value := sValue; +end; +{=====} + +procedure TVpPrinter.xmlPrintFormatEndElement (oOwner : TObject; + sValue : DOMString); +begin + if (sValue = 'PrintFormat') or (sValue = 'VpPrintFormats') then begin + FLoadingIndex := -1; + FElementIndex := -1; + end else if sValue = 'Element' then + FElementIndex := -1; + FAttributes.Clear; +end; +{=====} + +procedure TVpPrinter.xmlPrintFormatStartElement (oOwner : TObject; + sValue : DOMString); +var + i : Integer; + NewItem : TVpPrintFormatItem; + NewElement : TVpPrintFormatElementItem; + +begin + if sValue = 'VpPrintFormats' then begin + FLoadingIndex := -1; + FElementIndex := -1; + + end else if sValue = 'PrintFormat' then begin + { Search for either missing names or duplicate names } + { Missing names will be replaced with Unknown. Duplicate names + are not allowed. } + for i := 0 to FAttributes.Count - 1 do + if FAttributes.Items[i].Name = 'Name' then begin + if FAttributes.Items[i].Value = '' then + FAttributes.Items[i].Value := 'Unknown' + else if Find (FAttributes.Items[i].Value) >= 0 then + Exit; + end; + { If we've gotten this far, the name is good. Add the element } + NewItem := TVpPrintFormatItem (FPrintFormats.Add); + for i := 0 to FAttributes.Count - 1 do begin + if (FAttributes.Items[i].Name = 'Name') and + (Fattributes.Items[i].Value <> '') then + NewItem.FormatName := FAttributes.Items[i].Value + else if FAttributes.Items[i].Name = 'Description' then + NewItem.Description := FAttributes.Items[i].Value + else if FAttributes.Items[i].Name = 'Visible' then begin + if FAttributes.Items[i].Value = 'True' then + NewItem.Visible := True + else if FAttributes.Items[i].Value = 'False' then + NewItem.Visible := False; + end else if FAttributes.Items[i].Name = 'DayIncrementUnits' then begin + if FAttributes.Items[i].Value = 'Day' then + NewItem.DayIncUnits := duDay + else if FAttributes.Items[i].Value = 'Week' then + NewItem.DayIncUnits := duWeek + else if FAttributes.Items[i].Value = 'Month' then + NewItem.DayIncUnits := duMonth + else if FAttributes.Items[i].Value = 'Year' then + NewItem.DayIncUnits := duYear; + end; + end; + FLoadingIndex := NewItem.Index; + + end else if sValue = 'Element' then begin + if FLoadingIndex < 0 then + Exit; + NewElement := TVpPrintFormatElementItem (FPrintFormats.Items[FLoadingIndex].Elements.Add); + try + FElementIndex := NewElement.Index; + for i := 0 to FAttributes.Count - 1 do begin + if FAttributes.Items[i].Name = 'Name' then + NewElement.ElementName := FAttributes.Items[i].Value + else if FAttributes.Items[i].Name = 'Visible' then begin + if FAttributes.Items[i].Value = 'False' then + NewElement.Visible := False + else if FAttributes.Items[i].Value = 'True' then + NewElement.Visible := True; + end else if FAttributes.Items[i].Name = 'Rotation' then begin + if FAttributes.Items[i].Value = '90' then + NewElement.Rotation := ra90 + else if FAttributes.Items[i].Value = '180' then + NewElement.Rotation := ra180 + else if FAttributes.Items[i].Value = '270' then + NewElement.Rotation := ra270 + else + NewElement.Rotation := ra0; + end else if FAttributes.Items[i].Name = 'Item' then begin + if FAttributes.Items[i].Value = 'DayView' then + NewElement.ItemType := itDayView + else if FAttributes.Items[i].Value = 'WeekView' then + NewElement.ItemType := itWeekView + else if FAttributes.Items[i].Value = 'MonthView' then + NewElement.ItemType := itMonthView + else if FAttributes.Items[i].Value = 'Shape' then + NewElement.ItemType := itShape + else if FAttributes.Items[i].Value = 'Caption' then + NewElement.ItemType := itCaption + else if FAttributes.Items[i].Value = 'Calendar' then + NewElement.ItemType := itCalendar + else if FAttributes.Items[i].Value = 'Tasks' then + NewElement.ItemType := itTasks + else if FAttributes.Items[i].Value = 'Contacts' then + NewElement.ItemType := itContacts + else + raise EVpPrintFormatError.Create (RSBadItemType + FAttributes.Items[i].Value); + end else if FAttributes.Items[i].Name = 'Measurement' then begin + if FAttributes.Items[i].Value = 'AbsolutePixel' then + NewElement.Measurement := imAbsolutePixel + else if FAttributes.Items[i].Value = 'Percent' then + NewElement.Measurement := imPercent + else if FAttributes.Items[i].Value = 'Inches' then + NewElement.Measurement := imInches + else + raise EVpPrintFormatError.Create (RSBadMeasurement + FAttributes.Items[i].Value); + end else if FAttributes.Items[i].Name = 'Left' then + NewElement.Left := StrToFloat (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Top' then + NewElement.Top := StrToFloat (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Width' then + NewElement.Width := StrToFloat (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Height' then + NewElement.Height := StrToFloat (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'DayOffset' then + NewElement.DayOffset:= StrToInt (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'DayOffsetUnits' then begin + if FAttributes.Items[i].Value = 'Day' then + NewElement.DayOffsetUnits := duDay + else if FAttributes.Items[i].Value = 'Week' then + NewElement.DayOffsetUnits := duWeek + else if FAttributes.Items[i].Value = 'Month' then + NewElement.DayOffsetUnits := duMonth + else if FAttributes.Items[i].Value = 'Year' then + NewElement.DayOffsetUnits := duYear; + end; + end; + except + on EConvertError do begin + end; + end; + + end else if sValue = 'Shape' then begin + if (FLoadingIndex < 0) or (FElementIndex < 0) then + Exit; + for i := 0 to FAttributes.Count - 1 do + if FAttributes.Items[i].Name = 'Type' then begin + if FAttributes.Items[i].Value = 'Rectangle' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustRectangle + else if FAttributes.Items[i].Value = 'TopLine' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustTopLine + else if FAttributes.Items[i].Value = 'BottomLine' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustBottomLine + else if FAttributes.Items[i].Value = 'LeftLine' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustLeftLine + else if FAttributes.Items[i].Value = 'RightLine' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustRightLine + else if FAttributes.Items[i].Value = 'TLToBRLine' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustTLToBRLine + else if FAttributes.Items[i].Value = 'BLToTRLine' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustBLToTRLine + else if FAttributes.Items[i].Value = 'Ellipse' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Shape := ustEllipse; + end; + + end else if sValue = 'Caption' then begin + if (FLoadingIndex < 0) or (FElementIndex < 0) then + Exit; + for i := 0 to FAttributes.Count - 1 do + if FAttributes.Items[i].Name = 'Caption' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Caption := + FAttributes.Items[i].Value; + + end else if sValue = 'Pen' then begin + if (FLoadingIndex < 0) or (FElementIndex < 0) then + Exit; + try + for i := 0 to FAttributes.Count - 1 do + if FAttributes.Items[i].Name = 'Color' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Color := + StrToInt (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Style' then begin + if FAttributes.Items[i].Value = 'Solid' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psSolid + else if FAttributes.Items[i].Value = 'Dash' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDash + else if FAttributes.Items[i].Value = 'Dot' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDot + else if FAttributes.Items[i].Value = 'DashDot' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDashDot + else if FAttributes.Items[i].Value = 'DashDotDot' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psDashDotDot + else if FAttributes.Items[i].Value = 'Clear' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psClear + else if FAttributes.Items[i].Value = 'InsideFrame' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Style := psInsideFrame; + end else if FAttributes.Items[i].Name = 'Width' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Pen.Width := + StrToInt (FAttributes.Items[i].Value); + except + on EConvertError do begin + end; + end; + + end else if sValue = 'Brush' then begin + if (FLoadingIndex < 0) or (FElementIndex < 0) then + Exit; + try + for i := 0 to FAttributes.Count - 1 do + if FAttributes.Items[i].Name = 'Color' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Color := + StrToInt (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Style' then begin + if FAttributes.Items[i].Value = 'Solid' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsSolid + else if FAttributes.Items[i].Value = 'Clear' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsClear + else if FAttributes.Items[i].Value = 'Horizontal' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsHorizontal + else if FAttributes.Items[i].Value = 'Vertical' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsVertical + else if FAttributes.Items[i].Value = 'FDiagonal' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsFDiagonal + else if FAttributes.Items[i].Value = 'BDiagonal' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsBDiagonal + else if FAttributes.Items[i].Value = 'Cross' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsCross + else if FAttributes.Items[i].Value = 'DiagCross' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Shape.Brush.Style := bsDiagCross; + end; + except + on EConvertError do begin + end; + end; + + end else if sValue = 'Font' then begin + if (FLoadingIndex < 0) or (FElementIndex < 0) then + Exit; + try + for i := 0 to FAttributes.Count - 1 do + if FAttributes.Items[i].Name = 'CharSet' then begin + if FAttributes.Items[i].Value = 'ANSI' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := ANSI_CHARSET + else if FAttributes.Items[i].Value = 'Default' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := DEFAULT_CHARSET + else if FAttributes.Items[i].Value = 'Symbol' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := SYMBOL_CHARSET +{$IFNDEF LCL} + else if FAttributes.Items[i].Value = 'Mac' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := MAC_CHARSET +{$ENDIF} + else if FAttributes.Items[i].Value = 'ShiftJIS' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := SHIFTJIS_CHARSET + else if FAttributes.Items[i].Value = 'Hangeul' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := HANGEUL_CHARSET +{$IFNDEF LCL} + else if FAttributes.Items[i].Value = 'Johab' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := JOHAB_CHARSET +{$ENDIF} + else if FAttributes.Items[i].Value = 'GB2313' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := GB2312_CHARSET + else if FAttributes.Items[i].Value = 'ChineseBig5' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := CHINESEBIG5_CHARSET + else if FAttributes.Items[i].Value = 'Greek' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := GREEK_CHARSET + else if FAttributes.Items[i].Value = 'Turkish' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := TURKISH_CHARSET +{$IFNDEF LCL} + else if FAttributes.Items[i].Value = 'Vietnamese' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := VIETNAMESE_CHARSET +{$ENDIF} + else if FAttributes.Items[i].Value = 'Hebrew' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := HEBREW_CHARSET + else if FAttributes.Items[i].Value = 'Arabic' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := ARABIC_CHARSET + else if FAttributes.Items[i].Value = 'Baltic' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := BALTIC_CHARSET + else if FAttributes.Items[i].Value = 'Russian' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := RUSSIAN_CHARSET + else if FAttributes.Items[i].Value = 'Thai' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := THAI_CHARSET + else if FAttributes.Items[i].Value = 'EastEurope' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := EASTEUROPE_CHARSET + else if FAttributes.Items[i].Value = 'OEM' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.CharSet := OEM_CHARSET + end else if FAttributes.Items[i].Name = 'Color' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Color := + StrToInt (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Height' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Height:= + StrToInt (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Name' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Name := + FAttributes.Items[i].Value + else if FAttributes.Items[i].Name = 'Color' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Color := + StrToInt (FAttributes.Items[i].Value) + else if FAttributes.Items[i].Name = 'Pitch' then begin + if FAttributes.Items[i].Value = 'Default' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Pitch := fpDefault + else if FAttributes.Items[i].Value = 'Variable' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Pitch := fpVariable + else if FAttributes.Items[i].Value = 'Fixed' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Pitch := fpFixed; + end else if FAttributes.Items[i].Name = 'Bold' then begin + if FAttributes.Items[i].Value = 'True' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsBold] + else + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsBold]; + end else if FAttributes.Items[i].Name = 'Italic' then begin + if FAttributes.Items[i].Value = 'True' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsItalic] + else + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsItalic]; + end else if FAttributes.Items[i].Name = 'Underline' then begin + if FAttributes.Items[i].Value = 'True' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsUnderline] + else + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsUnderline]; + end else if FAttributes.Items[i].Name = 'Strikeout' then begin + if FAttributes.Items[i].Value = 'True' then + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style + [fsStrikeout] + else + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style := + FPrintFormats.Items[FLoadingIndex].Elements.Items[FElementIndex].Caption.Font.Style - [fsStrikeout]; + end; + except + on EConvertError do begin + end; + end; + end; + FAttributes.Clear; +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpprtfmtcbox.pas b/components/tvplanit/source/vpprtfmtcbox.pas new file mode 100644 index 000000000..25b9445d0 --- /dev/null +++ b/components/tvplanit/source/vpprtfmtcbox.pas @@ -0,0 +1,284 @@ +{*********************************************************} +{* VPPRTFMTCBOX.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpPrtFmtCBox; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + Messages, + SysUtils, + Classes, + Controls, + StdCtrls, + VpBase, + VpBaseDS, + VpConst; + +type + TVpPrintFormatComboBox = class (TCustomComboBox) + private + FControlLink : TVpControlLink; + + protected + procedure Change; override; + function GetAbout : string; + procedure Loaded; override; + procedure Notification (AComponent : TComponent; + Operation : TOperation); override; + procedure SetAbout (const Value : string); + procedure SetControlLink (const v : TVpControlLink); + procedure VpPrintFormatChanged (var Msg : TMessage); message Vp_PrintFormatChanged; + + public + constructor Create (AOwner : TComponent); override; + destructor Destroy; override; + + procedure UpdateItems; + + property Style; + + published + property Version : string read GetAbout write SetAbout stored False; + property ControlLink : TVpControlLink + read FControlLink write SetControlLink; + + property Cursor; + property DragCursor; + property DragMode; + property DropDownCount; + property Enabled; + property Font; + property HelpContext; + property Hint; + {$IFNDEF LCL} + property ImeMode; + property ImeName; + {$ENDIF} + property ItemHeight; + property Items; + property MaxLength; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property Sorted; + property TabStop; + property TabOrder; + property Text; + property Visible; + + property OnChange; + property OnClick; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnKeyDown; + property OnKeyPress; + property OnKeyUp; + property OnMeasureItem; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnStartDrag; + end; + +function SearchControlLink (const C : TComponent) : TVpControlLink; + +implementation + +function SearchControlLink (const C : TComponent) : TVpControlLink; + + function FindControlLink (const C : TComponent) : TVpControlLink; + var + I : Integer; + begin + Result := nil; + if not Assigned (C) then + Exit; + + {Look through all of the owned components} + for I := 0 to C.ComponentCount - 1 do begin + if C.Components[I] is TVpControlLink then begin + Result := TVpControlLink (C.Components[I]); + Exit; + end; + + {If this isn't one, see if it owns other components} + Result := FindControlLink (C.Components[I]); + end; + end; + +begin + {Search the entire form} + Result := FindControlLink (C); +end; + +constructor TVpPrintFormatComboBox.Create (AOwner : TComponent); +begin + inherited Create (AOwner); + + Style := csDropDownList; + Sorted := True; + + FControlLink := SearchControlLink (Owner); + UpdateItems; +end; + +destructor TVpPrintFormatComboBox.Destroy; +begin + if (HandleAllocated) and (Assigned (FControlLink)) then + FControlLink.Printer.DeregisterWatcher (Handle); + + inherited Destroy; +end; + +procedure TVpPrintFormatComboBox.Change; +var + NewFormat : Integer; + +begin + if not Assigned (FControlLink) then + Exit; + + NewFormat := FControlLink.Printer.Find (Text); + if NewFormat >= 0 then + FControlLink.Printer.CurFormat := NewFormat; +end; + +function TVpPrintFormatComboBox.GetAbout: string; +begin + Result := VpVersionStr; +end; + +procedure TVpPrintFormatComboBox.Loaded; +begin + inherited Loaded; + + UpdateItems; +end; + +procedure TVpPrintFormatComboBox.Notification (AComponent : TComponent; + Operation : TOperation); +{ Handle new/deleted components } +begin + inherited Notification (AComponent, Operation); + + if Operation = opRemove then begin + { Owned components going away } + if AComponent = FControlLink then begin + FControlLink := nil; + UpdateItems; + end; + end else if Operation = opInsert then begin + { Check for new TVpControlLink } + if AComponent is TVpControlLink then begin + if not Assigned (FControlLink) then begin + FControlLink := TVpControlLink (AComponent); + UpdateItems; + end; + end; + end; +end; + +procedure TVpPrintFormatComboBox.SetAbout(const Value: string); +begin + //Empty on purpose +end; + +procedure TVpPrintFormatComboBox.SetControlLink (const v : TVpControlLink); +begin + if v <> FControlLink then begin + if Assigned (FControlLink) then + FControlLink.Printer.DeregisterWatcher (Handle); + FControlLink := v; + if Assigned (FControlLink) then + FControlLink.Printer.RegisterWatcher (Handle); + UpdateItems; + end; +end; + +procedure TVpPrintFormatComboBox.VpPrintFormatChanged (var Msg : TMessage); +begin + UpdateItems; +end; + +procedure TVpPrintFormatComboBox.UpdateItems; +var + i : Integer; + Ctr : Integer; + +begin + if not Assigned (FControlLink) then + Exit; + if not Assigned (FControlLink.Printer) then + Exit; + if csDesigning in ComponentState then + Exit; + + Items.Clear; + + Ctr := 0; + + for i := 0 to FControlLink.Printer.PrintFormats.Count - 1 do begin + if (FControlLink.Printer.PrintFormats.Items[i].FormatName <> '') and + (FControlLink.Printer.PrintFormats.Items[i].Visible) then + Items.Add (FControlLink.Printer.PrintFormats.Items[i].FormatName) + else if FControlLink.Printer.PrintFormats.Items[i].Visible then begin + Items.Add ('Unknown ' + IntToStr (Ctr)); + Inc (Ctr); + end; + end; + i := 0; + while i < Items.Count do + if FControlLink.Printer.PrintFormats.Items[FControlLink.Printer.CurFormat].FormatName = + Items[i] then begin + ItemIndex := i; + Break; + end else + Inc (i); + if i >= Items.Count then + ItemIndex := -1; +end; + +initialization + + RegisterClass (TVpPrintFormatComboBox); + +end. diff --git a/components/tvplanit/source/vpprtfmtdlg.pas b/components/tvplanit/source/vpprtfmtdlg.pas new file mode 100644 index 000000000..f5694dbfa --- /dev/null +++ b/components/tvplanit/source/vpprtfmtdlg.pas @@ -0,0 +1,130 @@ +{*********************************************************} +{* VPPRTFMTDLG.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpPrtFmtDlg; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, TypInfo, ExtCtrls, + + VpPrtFmt, VpBase, VpBaseDS, VpDlg, VpDBDS,{ VpBDEDS,} VpPrtPrv, VpPrtFmtCBox, + VpEdFmtLst; + +type + + TVpPrintFormatEditDialog = class (TVpBaseDialog) + private + FControlLink: TVpControlLink; + FWindowState: TWindowState; + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure SetControlLink(const Value: TVpControlLink); + public + constructor Create (AOwner : TComponent); override; + function Execute : Boolean; override; + + published + property ControlLink : TVpControlLink + read FControlLink write SetControlLink; + + property WindowState : TWindowState + read FWindowState write FWindowState default wsNormal; + + property Options; + property Placement; + end; + + +implementation + + +{ TVpPrintFormatEditDialog } + +constructor TVpPrintFormatEditDialog.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FControlLink := SearchControlLink (Owner); + + FPlacement.Height := 480; + FPlacement.Width := 640; +end; + +function TVpPrintFormatEditDialog.Execute: Boolean; +var + PrtFmtDlg : TfrmPrnFormat; +begin + Application.CreateForm (TfrmPrnFormat, PrtFmtDlg); + try + DoFormPlacement(PrtFmtDlg); + PrtFmtDlg.WindowState := WindowState; + PrtFmtDlg.ControlLink := ControlLink; + Result := PrtFmtDlg.Execute; + + finally + PrtFmtDlg.Release; + end; +end; + +procedure TVpPrintFormatEditDialog.Notification (AComponent : TComponent; + Operation : TOperation); + {-Handle new/deleted components} +begin + inherited Notification (AComponent, Operation); + + if Operation = opRemove then begin + {Owned components going away} + if AComponent = FControlLink then begin + FControlLink := nil; + end; + end else if Operation = opInsert then begin + if AComponent is TVpControlLink then begin + if not Assigned (FControlLink) then begin + FControlLink := TVpControlLink (AComponent); + end; + end; + end; +end; + + +procedure TVpPrintFormatEditDialog.SetControlLink( + const Value: TVpControlLink); +begin + if FControlLink <> Value then + FControlLink := Value; +end; + +end. diff --git a/components/tvplanit/source/vpprtfmted.pas b/components/tvplanit/source/vpprtfmted.pas new file mode 100644 index 000000000..f4eef98f3 --- /dev/null +++ b/components/tvplanit/source/vpprtfmted.pas @@ -0,0 +1,112 @@ +{*********************************************************} +{* VPPRTFMTED.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpPrtFmtEd; + {- property editor for TVpControlLink.Printer.PrintFormats property} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + {$IFDEF VERSION6} + {$IFNDEF LCL} + DesignIntf, DesignEditors, + {$ELSE} + PropEdits, + LazarusPackageIntf, + FieldsEditor, + ComponentEditors, + {$ENDIF} + {$ELSE} + DsgnIntf, + {$ENDIF} + StdCtrls, ExtCtrls, Buttons, VpSR, + + VpBase, VpBaseDS, VpEdFmtLst; + +type + TVpPrtFmtPropertyEditor = class(TComponentEditor) + procedure ExecuteVerb(Index : Integer); override; + function GetVerb(Index : Integer) : string; override; + function GetVerbCount : Integer; override; + end; + + TVpPrtFmtEditor = class(TfrmPrnFormat) + public + Designer : TIDesigner; + end; + + +implementation + +var + frmPrtFmtEd : TVpPrtFmtEditor; + +{$IFDEF VERSION6} + procedure EditPrtFmts(Designer : TIDesigner; Link : TVpControlLink); +{$ELSE} + procedure EditPrtFmts(Designer : TIFormDesigner; Link : TVpControlLink); +{$ENDIF} +begin + frmPrtFmtEd := TVpPrtFmtEditor.Create(Application); + frmPrtFmtEd.Designer := Designer; + frmPrtFmtEd.ControlLink := Link; + frmPrtFmtEd.Execute; + if Assigned(Designer) then + Designer.Modified; + frmPrtFmtEd.Free; +end; + + +{ TVpPrtFmtEditor } + +procedure TVpPrtFmtPropertyEditor.ExecuteVerb(Index: Integer); +begin + if Index = 0 then + EditPrtFmts(Designer, (Component as TVpControlLink)); +end; + +function TVpPrtFmtPropertyEditor.GetVerb(Index: Integer): string; +begin + if Index = 0 then + Result := RSEditPrintFormat; +end; + +function TVpPrtFmtPropertyEditor.GetVerbCount: Integer; +begin + Result := 1; +end; + +end. diff --git a/components/tvplanit/source/vpprtprv.pas b/components/tvplanit/source/vpprtprv.pas new file mode 100644 index 000000000..d57b59024 --- /dev/null +++ b/components/tvplanit/source/vpprtprv.pas @@ -0,0 +1,1354 @@ +{*********************************************************} +{* VPPRTPRV.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{ + This unit contains the visual print preview component. The display of + the print preview as well as the navigation is controlled in this component. + The PrintPreview depends on the print formats (in VpPrtFmt) to generate + the image that will be displayed to the user. + + VisualPlanIt has a loose definition for starting and stopping reports. + Basically, the report ends when all the contacts, tasks and dates have + been displayed. The print formats know which of these types of elements + that it is displaying and uses that information in calculating the last + page. + + It is possible to create print formats that do not have last page (the + easiest way is to create a print format with a day view and have it + increment zero days for each page). This scenario is not yet trapped + in the printing or in the print preview. + + Scaling is handled simply. The size of the rectangle in which the print + format can render is changed to reflect the size. + + The print preview cannot be used as an element of a print format. +} + +unit VpPrtPrv; + +{$I vp.inc} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + SysUtils,Classes,Controls,Forms,Graphics, Printers, VpBase, + VpMisc,VpBaseDS, VpSR, VpException, Menus; + +type + TVpPageChange = procedure (Sender : TObject; NewPage : Integer) of object; + + TVpPPZoomFactor = (zfFitToControl, zfActualSize, + zf25Percent, zf33Percent, zf50Percent, + zf67Percent, zf75Percent); + + TVpPageInfo = record + Date : TDateTime; + Task : Integer; + Contact : Integer; + LastPage : Boolean; + end; + PVpPageInfo = ^TVpPageInfo; + + TVpPrintPreview = class (TVpCustomControl) + private + FBorderStyle : TBorderStyle; + FControlLink : TVpControlLink; + FDrawingStyle : TVpDrawingStyle; + FCurPage : Integer; + FPrinter : TPrinter; + RenderBmp : TBitmap; + WorkBmp : TBitmap; + FZoomFactor : TVpPPZoomFactor; + FBorderColor : TColor; + FOffPageColor : TColor; + FPageColor : TColor; + FPageInfo : TList; + FStartDate : TDateTime; + FEndDate : TDateTime; + FCurrentFormat : Integer; + FNeedHScroll : Boolean; + FNeedVScroll : Boolean; + FScrollX : Integer; + FScrollY : Integer; + FOnPageChange : TVpPageChange; + FDefaultPopup : TPopupMenu; + + protected + function CalculatePageHeight (Printer : TPrinter) : Integer; + function CalculatePageWidth (Printer : TPrinter) : Integer; + procedure ClearPageData; + {$IFNDEF LCL} + procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); + message CM_WANTSPECIALKEY; + {$ENDIF} + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + procedure DoScroll (var Msg : {$IFNDEF LCL}TWMSCROLL{$ELSE}TLMScroll{$ENDIF}; BarDirection : Integer); + procedure GeneratePageImage; + procedure GetLastPage; + procedure InitHScrollBar (PageSize : Integer; + TotalSize : Integer); + procedure InitializeDefaultPopup; + procedure InitVScrollBar (PageSize : Integer; + TotalSize : Integer); + function IsPageLoaded (PageNum : Integer) : Boolean; + procedure KeyDown (var Key: Word; Shift: TShiftState); override; + procedure Loaded; override; + function LoadPage (PageNum : Integer; + StartDate : TDateTime; + EndDate : TDateTime) : Integer; + procedure Paint; override; + procedure PopupFirstPage (Sender : TObject); + procedure PopupLastPage (Sender : TObject); + procedure PopupNextPage (Sender : TObject); + procedure PopupPrevPage (Sender : TObject); + procedure RemoveHScrollbar; + procedure RemoveVScrollbar; + procedure SetBorderColor (const v : TColor); + procedure SetBorderStyle (const v : TBorderStyle); + procedure SetControlLink (const v : TVpControlLink); + procedure SetCurPage (const v : Integer); + procedure SetDrawingStyle (const v : TVpDrawingStyle); + procedure SetEndDate (const v : TDateTime); + procedure SetOffPageColor (const v : TColor); + procedure SetPageColor (const v : TColor); + procedure SetPrinter (const v : TPrinter); + procedure SetStartDate (const v : TDateTime); + procedure SetScrollBars; + procedure SetZoomFactor (const v : TVpPPZoomFactor); + +// procedure VpPrintFormatChanged (var Msg : {$IFNDEF LCL}TMessage{$ELSE}TLMessage{$ENDIF}; message Vp_PrintFormatChanged; + {$IFNDEF LCL} + procedure WMEraseBackground (var Msg : TWMERASEBKGND); message WM_ERASEBKGND; + procedure WMHScroll (var Msg : TWMSCROLL ); message WM_HSCROLL; + procedure WMVScroll (var Msg : TWMSCROLL ); message WM_VSCROLL; + procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN; + {$ELSE} + procedure WMEraseBackground (var Msg : TLMERASEBKGND); message LM_ERASEBKGND; + procedure WMHScroll (var Msg : TLMSCROLL ); message LM_HSCROLL; + procedure WMVScroll (var Msg : TLMSCROLL ); message LM_VSCROLL; + procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; + {$ENDIF} + public + constructor Create (AOwner : TComponent); override; + destructor Destroy; override; + + procedure FirstPage; + function IsFirstPage : Boolean; + function IsLastPage : Boolean; + procedure LastPage; + procedure NextPage; + procedure PrevPage; + procedure ForceUpdate; + procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override; + + property Printer : TPrinter read FPrinter write SetPrinter; + property DestPrinter : TPrinter read FPrinter write SetPrinter; + published + property BorderColor : TColor read FBorderColor write SetBorderColor + default clBlack; + property BorderStyle : TBorderStyle + read FBorderStyle write SetBorderStyle default bsSingle; + property ControlLink : TVpControlLink + read FControlLink write SetControlLink; + property CurPage : Integer read FCurPage write SetCurPage; +// property DestPrinter : TPrinter read FPrinter write SetPrinter; + property DrawingStyle : TVpDrawingStyle + read FDrawingStyle write SetDrawingStyle default ds3d; + property EndDate : TDateTime read FEndDate write SetEndDate; + property OffPageColor : TColor read FOffPageColor write SetOffPageColor + default clSilver; + property PageColor : TColor read FPageColor write SetPageColor + default clWhite; + property StartDate : TDateTime read FStartDate write SetStartDate; + property ZoomFactor : TVpPPZoomFactor + read FZoomFactor write SetZoomFactor default zfFitToControl; + + property OnPageChange : TVpPageChange + read FOnPageChange write FOnPageChange; + + property Anchors; + property Align; + property Constraints; + property Cursor; + property DragCursor; + property DragMode; + property Enabled; + property HelpContext; + property Hint; + property Parent; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabStop; + property TabOrder; + 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 OnStartDrag; + end; + +implementation + +constructor TVpPrintPreview.Create (AOwner : TComponent); +begin + inherited Create (AOwner); + + if not (AOwner is TWinControl) then + raise EVpPrintPreviewError.Create (RSOwnerNotWinCtrl); + + Parent := TWinControl (AOwner); + + RenderBmp := TBitmap.Create; + WorkBmp := TBitmap.Create; + FPageInfo := TList.Create; + + FDefaultPopup := TPopupMenu.Create (Self); + InitializeDefaultPopup; + + FNeedHScroll := False; + FNeedVScroll := False; + + FCurrentFormat := -1; + FBorderStyle := bsSingle; + FDrawingStyle := ds3d; + FZoomFactor := zfFitToControl; + FOffPageColor := clSilver; + FPageColor := clWhite; + FBorderColor := clBlack; + FCurPage := 0; + FStartDate := Now; + FEndDate := Now + 7; + FScrollX := 0; + FScrollY := 0; + Height := 225; + Width := 169; + FPrinter := Printer; +end; + +destructor TVpPrintPreview.Destroy; +begin + if (HandleAllocated) and Assigned (FControlLink) then + FControlLink.Printer.DeregisterWatcher (Handle); + + ClearPageData; + + RenderBmp.Free; + WorkBmp.Free; + + FPageInfo.Free; + + FDefaultPopup.Free; + + inherited Destroy; +end; + +function TVpPrintPreview.CalculatePageHeight (Printer : TPrinter) : Integer; +var + ScreenPPI : Integer; + PrinterPPI : Integer; + +begin + {$IFNDEF LCL} + ScreenPPI := GetDeviceCaps (Canvas.Handle, LOGPIXELSY); + PrinterPPI := GetDeviceCaps (Printer.Handle, LOGPIXELSY); + + if PrinterPPI <> 0 then + Result := Round (ScreenPPI / PrinterPPI * Printer.PageHeight) + else + Result := ScreenPPI * Printer.PageHeight; + {$ENDIF} +end; + +function TVpPrintPreview.CalculatePageWidth (Printer : TPrinter) : Integer; +var + ScreenPPI : Integer; + PrinterPPI : Integer; + +begin + {$IFNDEF LCL} + ScreenPPI := GetDeviceCaps (Canvas.Handle, LOGPIXELSX); + PrinterPPI := GetDeviceCaps (Printer.Handle, LOGPIXELSX); + + if PrinterPPI <> 0 then + Result := Round (ScreenPPI / PrinterPPI * Printer.PageWidth) + else + Result := ScreenPPI * Printer.PageHeight; + {$ENDIF} +end; + +procedure TVpPrintPreview.ClearPageData; +var + i : Integer; + +begin + for i := FPageInfo.Count - 1 downto 0 do begin + if Assigned (FPageInfo[i]) then + FreeMem (FPageInfo[i]); + FPageInfo.Delete (i); + end; + CurPage := 0; +end; + +{$IFNDEF LCL} +procedure TVpPrintPreview.CMWantSpecialKey(var Msg: TCMWantSpecialKey); +begin + inherited; + Msg.Result := 1; +end; +{$ENDIF} + +procedure TVpPrintPreview.CreateParams (var Params : TCreateParams); +begin + inherited CreateParams (Params); + + with Params do begin + Style := Style or WS_TABSTOP; + if FNeedHScroll then + Style := Longint (Style) or WS_HSCROLL; + if FNeedVScroll then + Style := Longint (Style) or WS_VSCROLL; + end; +end; + +procedure TVpPrintPreview.CreateWnd; +begin + if (HandleAllocated) and (Assigned (FControlLink)) then + FControlLink.Printer.DeregisterWatcher (Handle); + + inherited CreateWnd; + + if Assigned (FControlLink) then + FControlLink.Printer.RegisterWatcher (Handle); +end; + +{$IFNDEF LCL} +procedure TVpPrintPreview.DoScroll (var Msg : TWMSCROLL; + BarDirection : Integer); +{$ELSE} +procedure TVpPrintPreview.DoScroll (var Msg : TLMSCROLL; + BarDirection : Integer); +{$ENDIF} +var + ScrollBarInfo : TScrollInfo; + +begin + Msg.Result := 0; + ScrollBarInfo.cbSize := SizeOf (TscrollInfo); + ScrollBarInfo.fMask := SIF_ALL; + GetScrollInfo (Handle, BarDirection, ScrollBarInfo); + ScrollBarInfo.fMask := SIF_POS; + case Msg.ScrollCode of + SB_TOP : ScrollBarInfo.nPos := ScrollBarInfo.nMin; + SB_BOTTOM : ScrollBarInfo.nPos := ScrollBarInfo.nMax; + SB_LINEUP : Dec (ScrollBarInfo.nPos, 1); + SB_LINEDOWN : Inc (ScrollBarInfo.nPos, 1); + SB_PAGEUP : Dec (ScrollBarInfo.nPos, ScrollBarInfo.nPage ); + SB_PAGEDOWN : Inc (ScrollBarInfo.nPos, ScrollBarInfo.nPage); + SB_THUMBTRACK, + SB_THUMBPOSITION : ScrollBarInfo.nPos := Msg.Pos; + SB_ENDSCROLL : Exit; + end; + + ScrollBarInfo.fMask := SIF_POS; + if ScrollBarInfo.nPos < ScrollBarInfo.nMin Then + ScrollBarInfo.nPos := ScrollBarInfo.nMin; + if ScrollBarInfo.nPos + Integer (ScrollBarInfo.nPage) > + ScrollBarInfo.nMax Then + ScrollBarInfo.nPos := ScrollBarInfo.nMax - Integer (ScrollBarInfo.nPage); + + case BarDirection of + SB_HORZ : FScrollX := ScrollBarInfo.nPos; + SB_VERT : FScrollY := ScrollBarInfo.nPos; + end; + + SetScrollInfo (Handle, BarDirection, ScrollBarInfo, True); + Invalidate; +end; + +procedure TVpPrintPreview.FirstPage; +begin + CurPage := 0; +end; + +procedure TVpPrintPreview.ForceUpdate; +begin + if not Assigned (FControlLink) then + Exit; + + if not Assigned (FControlLink.Printer) then + Exit; + +// if FCurrentFormat <> FControlLink.Printer.CurFormat then begin + ClearPageData; + GeneratePageImage; + Invalidate; +// end; +end; + +procedure TVpPrintPreview.GeneratePageImage; +var + LastPage : Boolean; + UseDate : TDateTime; + UseContact : Integer; + UseTask : Integer; + +begin + if not Assigned (FControlLink) then + Exit; + + if not Assigned (FControlLink.Printer) then + Exit; + + if (FControlLink.Printer.PrintFormats.Count = 0) or + (FControlLink.Printer.CurFormat < 0) then + Exit; + + FCurrentFormat := FControlLink.Printer.CurFormat; + + if (FPrinter <> nil) and + ((RenderBmp.Width = 0) or (RenderBmp.Height = 0)) then begin + RenderBmp.Width := CalculatePageWidth (FPrinter); + RenderBmp.Height := CalculatePageHeight (FPrinter); + end else if (FPrinter = nil) and + ((RenderBmp.Width = 0) or (RenderBmp.Height = 0)) then begin + RenderBmp.Width := ClientWidth; + RenderBmp.Height := ClientHeight; + end; + + if not IsPageLoaded (CurPage) then + LoadPage (CurPage, FStartDate, FEndDate); + + RenderBmp.Canvas.Brush.Color := FPageColor; + RenderBmp.Canvas.Pen.Color := FBorderColor; + RenderBmp.Canvas.FillRect (Rect (0, 0, RenderBmp.Width, RenderBmp.Height)); + + if not IsPageLoaded (CurPage) then + FControlLink.Printer.PaintToCanvasRect (RenderBmp.Canvas, + Rect (0, 0, + RenderBmp.Width, + RenderBmp.Height), + StartDate) + else begin + UseDate := PVpPageInfo (FPageInfo[CurPage]).Date; + UseContact := PVpPageInfo (FPageInfo[CurPage]).Contact; + UseTask := PVpPageInfo (FPageInfo[CurPage]).Task; + FControlLink.Printer.RenderPage (RenderBmp.Canvas, + Rect (0, 0, RenderBmp.Width, + RenderBmp.Height), + CurPage, + UseDate, + EndDate, + UseContact, + UseTask, + LastPage); + end; + SetScrollBars; +end; + +procedure TVpPrintPreview.GetLastPage; +var + i : Integer; + +begin + i := FPageInfo.Count - 1; + while (not PVpPageInfo (FPageInfo[i]).LastPage) and + (i < FPageInfo.Count) do begin + Inc (i); + LoadPage (i, StartDate, EndDate); + end; +end; + +procedure TVpPrintPreview.InitHScrollBar (PageSize : Integer; + TotalSize : Integer); +var + ScrollBarInfo : TScrollInfo; + +begin + FNeedHScroll := True; + + ScrollBarInfo.cbSize := SizeOf (TScrollInfo); + ScrollBarInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; + ScrollBarInfo.nMin := 0; + + ScrollBarInfo.nMax := TotalSize; + ScrollBarInfo.nPage := PageSize; + ScrollBarInfo.nPos := 0; + ScrollBarInfo.nTrackPos := 0; + SetScrollInfo (Handle, SB_HORZ, ScrollBarInfo, True); +end; + +procedure TVpPrintPreview.InitializeDefaultPopup; +var + NewItem : TMenuItem; + +begin + if RSPrintPrvPrevPage <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSPrintPrvPrevPage; + NewItem.OnClick := PopupPrevPage; + NewItem.Tag := 1; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSPrintPrvNextPage <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSPrintPrvNextPage; + NewItem.OnClick := PopupNextPage; + NewItem.Tag := 2; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSPrintPrvFirstPage <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSPrintPrvFirstPage; + NewItem.OnClick := PopupFirstPage; + NewItem.Tag := 1; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSPrintPrvLastPage <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSPrintPrvLastPage; + NewItem.OnClick := PopupLastPage; + NewItem.Tag := 2; + FDefaultPopup.Items.Add (NewItem); + end; +end; + +procedure TVpPrintPreview.InitVScrollBar (PageSize : Integer; + TotalSize : Integer); +var + ScrollBarInfo : TScrollInfo; + +begin + FNeedVScroll := True; + + ScrollBarInfo.cbSize := SizeOf (TScrollInfo); + ScrollBarInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; + ScrollBarInfo.nMin := 0; + ScrollBarInfo.nMax := TotalSize; + ScrollBarInfo.nPage := PageSize; + ScrollBarInfo.nTrackPos := 0; + ScrollBarInfo.nPos := 0; + SetScrollInfo (Handle, SB_VERT, ScrollBarInfo, True); +end; + +function TVpPrintPreview.IsFirstPage : Boolean; +begin + Result := CurPage = 0; +end; + +function TVpPrintPreview.IsLastPage : Boolean; +begin + if FPageInfo.Count = 0 then + Result := True + else if CurPage < FPageInfo.Count then + Result := PVpPageInfo (FPageInfo[CurPage]).LastPage + else begin + GetLastPage; + Result := PVpPageInfo (FPageInfo[CurPage]).LastPage; + end; +end; + +function TVpPrintPreview.IsPageLoaded (PageNum : Integer) : Boolean; +begin + Result := PageNum < FPageInfo.Count; +end; + + +procedure TVpPrintPreview.KeyDown (var Key: Word; Shift: TShiftState); +var + PopupPoint : TPoint; + +begin + case Key of + VK_LEFT, VK_PRIOR : + if ssCtrl in Shift then + FirstPage + else + PrevPage; + VK_RIGHT, VK_NEXT : + if ssCtrl in Shift then + LastPage + else + NextPage; + $5A : {z} + if ssCtrl in Shift then begin + if ZoomFactor = High (FZoomFactor) then + ZOomFactor := Low (FZoomFactor) + else + ZoomFactor := Succ (FZoomFactor); + end else if ssShift in Shift then begin + if ZoomFactor = Low (FZoomFactor) then + ZOomFactor := High (FZoomFactor) + else + ZoomFactor := Pred (FZoomFactor); + end; + $46 : {f} + if (ssCtrl in Shift) and Assigned (ControlLink) then begin + if ControlLink.Printer.CurFormat < ControlLink.Printer.PrintFormats.Count - 1 then + ControlLink.Printer.CurFormat := ControlLink.Printer.CurFormat + 1 + else + ControlLink.Printer.CurFormat := 0; + end else if (ssShift in Shift) and Assigned (ControlLink) then begin + if ControlLink.Printer.CurFormat > 0 then + ControlLink.Printer.CurFormat := ControlLink.Printer.CurFormat - 1 + else + ControlLink.Printer.CurFormat := ControlLink.Printer.PrintFormats.Count - 1; + end; + VK_TAB : + {$IFNDEF LCL} + if ssShift in Shift then + Windows.SetFocus (GetNextDlgTabItem (GetParent(Handle), Handle, False)) + else + Windows.SetFocus (GetNextDlgTabItem (GetParent(Handle), Handle, True)); + {$ELSE} + ; + {$ENDIF} + VK_F10 : + if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + VK_APPS : + if not Assigned (PopupMenu) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + else + inherited; + end; +end; + +procedure TVpPrintPreview.LastPage; +var + i : Integer; + +begin + if CurPage < FPageInfo.Count then begin + i := CurPage; + if (not PVpPageInfo (FPageInfo[i]).LastPage) and + (i < FPageInfo.Count) then + Inc (i); + if (not PVpPageInfo (FPageInfo[i]).LastPage) then + GetLastPage; + end else + GetLastPage; + CurPage := FPageInfo.Count - 1; +end; + +procedure TVpPrintPreview.Loaded; +begin + inherited Loaded; + + DestPrinter := Printer; + GeneratePageImage; +end; + +function TVpPrintPreview.LoadPage (PageNum : Integer; + StartDate : TDateTime; + EndDate : TDateTime) : Integer; +{ Loads the requested page. Returns the last page loaded. If the + return value is less than the requested page, the requested page + is past the last page } +var + i : Integer; + LastPage : Boolean; + PPageInfo : PVpPageInfo; + ADate : TDateTime; + ATask : Integer; + AContact : Integer; + +begin + Result := PageNum; + if PageNum < FPageInfo.Count then + Exit; + + if not Assigned (FControlLink) then + Exit; + + if not Assigned (FControlLink.Printer) then + Exit; + + i := FPageInfo.Count - 1; + LastPage := False; + + if FPageInfo.Count = 0 then begin + GetMem (PPageInfo, SizeOf (TVpPageInfo)); + PPageInfo.Date := StartDate; + PPageInfo.Contact := 0; + PPageInfo.Task := 0; + PPageInfo.LastPage := False; + FPageInfo.Add (PPageInfo); + i := 0; + end; + + PPageInfo := PVpPageInfo (FPageInfo[i]); + ADate := PPageInfo.Date; + AContact := PPageInfo.Contact; + ATask := PPageInfo.Task; + + { The only way to see how the pages are going to increment is to render + them and get the return information } + + while (i <= PageNum) and (not LastPage) do begin + + FControlLink.Printer.RenderPage (RenderBmp.Canvas, + Rect (0, 0, RenderBmp.Width, + RenderBmp.Height), + i + 1, + ADate, + FEndDate, + AContact, + ATask, + LastPage); + Result := i; + GetMem (PPageInfo, SizeOf (TVpPageInfo)); + PPageInfo.Date := ADate; + PPageInfo.Task := ATask; + PPageInfo.Contact := AContact; + PPageInfo.LastPage := LastPage; + FPageInfo.Add (PPageInfo); + Inc (i); + end; +end; + +procedure TVpPrintPreview.NextPage; +begin + if CurPage < FPageInfo.Count then begin + if not PVpPageInfo (FPageInfo[CurPage]).LastPage then + CurPage := CurPage + 1; + end else + CurPage := CurPage + 1; +end; + +procedure TVpPrintPreview.Paint; +var + RealWidth : Integer; + RealHeight : Integer; + + procedure Clear; + begin + if RenderBmp.Width > ClientWidth then + WorkBmp.Width := RenderBmp.Width + else + WorkBmp.Width := ClientWidth; + if RenderBmp.Height > ClientHeight then + WorkBmp.Height := RenderBmp.Height + else + WorkBmp.Height := ClientHeight; + RealWidth := ClientWidth; + RealHeight := ClientHeight; + + WorkBmp.Canvas.Brush.Color := FOffPageColor; + WorkBmp.Canvas.FillRect (ClientRect); + WorkBmp.Canvas.Brush.Color := FPageColor; + WorkBmp.Canvas.Pen.Color := FBorderColor; + end; + + procedure DrawBorders; + begin + if FBorderStyle = bsSingle then begin + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + DrawBevelRect (WorkBmp.Canvas, + Rect (ClientRect.Left, + ClientRect.Top, + ClientRect.Right - 1, + ClientRect.Bottom - 1), + clBtnShadow, + clBtnHighlight); + DrawBevelRect (WorkBmp.Canvas, + Rect (ClientRect.Left + 1, + ClientRect.Top + 1, + ClientRect.Right - 2, + ClientRect.Bottom - 2), + clBtnHighlight, + clBtnShadow); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + DrawBevelRect (WorkBmp.Canvas, + Rect (ClientRect.Left, + ClientRect.Top, + ClientRect.Right - 1, + ClientRect.Bottom - 1), + clBtnShadow, + clBtnHighlight); + DrawBevelRect (WorkBmp.Canvas, + Rect (ClientRect.Left + 1, + ClientRect.Top + 1, + ClientRect.Right - 2, + ClientRect.Bottom - 2), + cl3DDkShadow, + clBtnFace); + end; + end; + end; + + procedure AddPageBorder; + var + w : Integer; + h : Integer; + begin + if RealWidth > ClientWidth - 2 then + w := ClientWidth - 2 + else + w := RealWidth; + if RealHeight > ClientHeight - 2 then + h := ClientHeight - 2 + else + h := RealHeight; + WorkBmp.Canvas.Pen.Color := FBorderColor; + WorkBmp.Canvas.MoveTo (2, 2); + WorkBmp.Canvas.LineTo (2, h); + WorkBmp.Canvas.MoveTo (2, 2); + WorkBmp.Canvas.LineTo (w, 2); + + if (RealWidth < ClientWidth - 2) then begin + WorkBmp.Canvas.MoveTo (RealWidth, 2); + WorkBmp.Canvas.LineTo (RealWidth, h + 1); + end; + + if (RealHeight < ClientHeight - 2) then begin + WorkBmp.Canvas.MoveTo (2, RealHeight); + WorkBmp.Canvas.LineTo (w + 1, RealHeight); + end; + end; + + function GetAspectRectangle : TRect; + var + ScaleX : Extended; + ScaleY : Extended; + Offset1 : Integer; + Offset2 : Integer; + + begin + Offset1 := 3; + Offset2 := 3; + + if Assigned (FPrinter) then begin + if ClientWidth - (Offset1 + Offset2) <> 0 then + ScaleX := FPrinter.PageWidth / (ClientWidth - (Offset1 + Offset2)) + else + ScaleX := 1; + if ClientHeight - (Offset1 + Offset2) <> 0 then + ScaleY := FPrinter.PageHeight / (ClientHeight - (Offset1 + Offset2)) + else + ScaleY := 1; + if ScaleX > ScaleY then + Result := Rect (Offset1, Offset1, ClientWidth - Offset2, + Round (FPrinter.PageHeight / ScaleX)) + else + Result := Rect (Offset1, Offset1, + Round (FPrinter.PageWidth / ScaleY), + ClientHeight - Offset2); + end else + Result := Rect (3, 3, ClientWidth, ClientHeight); + end; + + procedure DrawPreview; + var + AspectRect : TRect; + WorkHeight : Integer; + WorkWidth : Integer; + + begin + if FControlLink.Printer.PrintFormats.Count <= 0 then + Exit; + + if CurPage > FPageInfo.Count then + GeneratePageImage; + + case FZoomFactor of + zfFitToControl : begin + AspectRect := GetAspectRectangle; + WorkBmp.Canvas.CopyRect (AspectRect, RenderBmp.Canvas, + Rect (0, 0, + RenderBmp.Width, RenderBmp.Height)); + RealWidth := AspectRect.Right - AspectRect.Left + 3; + RealHeight := AspectRect.Bottom - AspectRect.Top + 3; + end; + + zf25Percent : begin + WorkWidth := Round (RenderBmp.Width div 4); + WorkHeight := Round (RenderBmp.Height div 4); + if WorkHeight > ClientHeight - 3 then + WorkHeight := ClientHeight - 3; + if WorkWidth > ClientWidth - 3 then + WorkWidth := ClientWidth - 3; + WorkBmp.Canvas.CopyRect (Rect (3, 3, + WorkWidth, + WorkHeight), + RenderBmp.Canvas, + Rect (Round (FScrollX * 4), + Round (FScrollY * 4), + Round ((WorkWidth + FScrollX) * 4), + Round ((WorkHeight + FScrollY) * 4))); + RealWidth := RenderBmp.Width div 4; + RealHeight := RenderBmp.Height div 4; + end; + + zf33Percent : begin + WorkWidth := Round (RenderBmp.Width div 3); + WorkHeight := Round (RenderBmp.Height div 3); + if WorkHeight > ClientHeight - 3 then + WorkHeight := ClientHeight - 3; + if WorkWidth > ClientWidth - 3 then + WorkWidth := ClientWidth - 3; + WorkBmp.Canvas.CopyRect (Rect (3, 3, + WorkWidth, + WorkHeight), + RenderBmp.Canvas, + Rect (Round (FScrollX * 3), + Round (FScrollY * 3), + Round ((WorkWidth + FScrollX) * 3), + Round ((WorkHeight + FScrollY) * 3))); + RealWidth := RenderBmp.Width div 3; + RealHeight := RenderBmp.Height div 3; + end; + + zf50Percent : begin + WorkWidth := Round (RenderBmp.Width div 2); + WorkHeight := Round (RenderBmp.Height div 2); + if WorkHeight > ClientHeight - 3 then + WorkHeight := ClientHeight - 3; + if WorkWidth > ClientWidth - 3 then + WorkWidth := ClientWidth - 3; + WorkBmp.Canvas.CopyRect (Rect (3, 3, + WorkWidth, + WorkHeight), + RenderBmp.Canvas, + Rect (Round (FScrollX * 2), + Round (FScrollY * 2), + Round ((WorkWidth + FScrollX) * 2), + Round ((WorkHeight + FScrollY) * 2))); + RealWidth := RenderBmp.Width div 2; + RealHeight := RenderBmp.Height div 2; + end; + + zf67Percent : begin + WorkWidth := Round (RenderBmp.Width * 0.67); + WorkHeight := Round (RenderBmp.Height * 0.67); + if WorkHeight > ClientHeight - 3 then + WorkHeight := ClientHeight - 3; + if WorkWidth > ClientWidth - 3 then + WorkWidth := ClientWidth - 3; + WorkBmp.Canvas.CopyRect (Rect (3, 3, + WorkWidth, + WorkHeight), + RenderBmp.Canvas, + Rect (Round (FScrollX * 1.5), + Round (FScrollY * 1.5), + Round ((WorkWidth + FScrollX) * 1.5), + Round ((WorkHeight + FScrollY) * 1.5))); + + RealWidth := Round (RenderBmp.Width * 0.67); + RealHeight := Round (RenderBmp.Height * 0.67); + end; + + zf75Percent : begin + WorkWidth := Round (RenderBmp.Width * 0.75); + WorkHeight := Round (RenderBmp.Height * 0.75); + if WorkHeight > ClientHeight - 3 then + WorkHeight := ClientHeight - 3; + if WorkWidth > ClientWidth - 3 then + WorkWidth := ClientWidth - 3; + WorkBmp.Canvas.CopyRect (Rect (3, 3, + WorkWidth, + WorkHeight), + RenderBmp.Canvas, + Rect (Round (FScrollX * 1.33333), + Round (FScrollY * 1.33333), + Round ((WorkWidth + FScrollX) * 1.33333), + Round ((WorkHeight + FScrollY) * 1.33333))); + RealWidth := Round (RenderBmp.Width * 0.75); + RealHeight := Round (RenderBmp.Height * 0.75); + end; + + zfActualSize : begin + WorkBmp.Canvas.CopyRect (Rect (3, 3, + ClientWidth - 3, ClientHeight - 3), + RenderBmp.Canvas, + Rect (FScrollX, + FScrollY, + FScrollX + ClientWidth - 3, + FScrollY + ClientHeight - 3)); + RealWidth := RenderBmp.Width; + RealHeight := RenderBmp.Height; + end; + end; + end; + + procedure RenderImage; + begin + Canvas.CopyRect (ClientRect, WorkBmp.Canvas, ClientRect); + end; + +begin + try + Clear; + DrawBorders; + if FControlLink = nil then + Exit; + DrawPreview; + AddPageBorder; + finally + RenderImage; + end; +end; + +procedure TVpPrintPreview.PrevPage; +begin + if FCurPage > 0 then + CurPage := CurPage - 1; +end; + +procedure TVpPrintPreview.PopupFirstPage (Sender : TObject); +begin + FirstPage; +end; + +procedure TVpPrintPreview.PopupLastPage (Sender : TObject); +begin + LastPage; +end; + +procedure TVpPrintPreview.PopupNextPage (Sender : TObject); +begin + NextPage; +end; + +procedure TVpPrintPreview.PopupPrevPage (Sender : TObject); +begin + PrevPage; +end; + +procedure TVpPrintPreview.RemoveHScrollbar; +var + Style : Integer; + +begin + FNeedHScroll := False; + Style := GetWindowLong (Handle, GWL_STYLE); + if ((Style and WS_HSCROLL) <> 0) then begin + SetWindowLong (Handle, GWL_STYLE, Style and not WS_HSCROLL); + RecreateWnd{$IFDEF LCL}(Self){$ENDIF}; + end; +end; + +procedure TVpPrintPreview.RemoveVScrollbar; +var + Style : Integer; + +begin + FNeedVScroll := False; + Style := GetWindowLong (Handle, GWL_STYLE); + if ((Style and WS_VSCROLL) <> 0) then begin + SetWindowLong (Handle, GWL_STYLE, Style and not WS_VSCROLL); + RecreateWnd{$IFDEF LCL}(Self){$ENDIF}; + end; +end; + +procedure TVpPrintPreview.SetBorderColor (const v : TColor); +begin + if v <> FBorderColor then begin + FBorderColor := v; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetBorderStyle (const v : TBorderStyle); +begin + if v <> FBorderStyle then begin + FBorderStyle := v; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetBounds (ALeft, ATop, AWidth, AHeight: Integer); +begin + inherited SetBounds (aLeft, ATop, AWidth, AHeight); + SetScrollBars; +end; + +procedure TVpPrintPreview.SetControlLink (const v : TVpControlLink); +begin + if FControlLink <> v then begin + if Assigned (FControlLink) then + FControlLink.Printer.DeregisterWatcher (Handle); + FControlLink := v; + if Assigned (FControlLink) then + FControlLink.Printer.RegisterWatcher (Handle); + ClearPageData; + GeneratePageImage; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetCurPage (const v : Integer); +begin + if (v >= 0) and (v <> FCurPage) then begin + FCurPage := v; + if not (csDestroying in ComponentState) then begin + GeneratePageImage; + Invalidate; + if Assigned (FOnPageChange) then + FOnPageChange (Self, FCurPage); + end; + end; +end; + +procedure TVpPrintPreview.SetDrawingStyle (const v : TVpDrawingStyle); +begin + if v <> FDrawingStyle then begin + FDrawingStyle := v; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetEndDate (const v : TDateTime); +begin + if v <> FEndDate then begin + FEndDate := v; + ClearPageData; + GeneratePageImage; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetOffPageColor (const v : TColor); +begin + if v <> FOffPageColor then begin + FOffPageColor := v; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetPageColor (const v : TColor); +begin + if v <> FPageColor then begin + FPageColor := v; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetPrinter (const v : TPrinter); +begin + if FPrinter <> v then begin + FPrinter := v; + RenderBmp.Width := CalculatePageWidth (v); + RenderBmp.Height := CalculatePageHeight (v); + ClearPageData; + GeneratePageImage; + end; +end; + +procedure TVpPrintPreview.SetScrollBars; +var + RealWidth : Integer; + RealHeight : Integer; + Style : Integer; + NeedRecreate : Boolean; + +begin + if csDesigning in ComponentState then + Exit; + + FScrollX := 0; + FScrollY := 0; + RealHeight := ClientHeight; + RealWidth := ClientWidth; + case ZoomFactor of + zfActualSize : begin + RealHeight := RenderBmp.Height; + RealWidth := RenderBmp.Width; + end; + zfFitToControl : begin + RealHeight := ClientHeight - 4; + RealWidth := ClientWidth - 4; + end; + zf25Percent : begin + RealHeight := RenderBmp.Height div 4; + RealWidth := RenderBmp.Width div 4; + end; + zf33Percent : begin + RealHeight := RenderBmp.Height div 3; + RealWidth := RenderBmp.Width div 3; + end; + zf50Percent : begin + RealHeight := RenderBmp.Height div 2; + RealWidth := RenderBmp.Width div 2; + end; + zf67Percent : begin + RealHeight := Round (RenderBmp.Height * 0.67); + RealWidth := Round (RenderBmp.Width * 0.67); + end; + zf75Percent : begin + RealHeight := Round (RenderBmp.Height * 0.75); + RealWidth := Round (RenderBmp.Width * 0.75); + end; + end; + + if (RealWidth > ClientWidth) or (RealHeight > ClientHeight) then begin + NeedRecreate := False; + Style := GetWindowLong (Handle, GWL_STYLE); + if ((Style and WS_HSCROLL) = 0) and (RealWidth > ClientWidth) then begin + Style := Style or WS_HSCROLL; + FNeedHScroll := True; + NeedRecreate := True; + end; + if ((Style and WS_VSCROLL) = 0) and (RealHeight > ClientHeight) then begin + Style := Style or WS_VSCROLL; + FNeedVScroll := True; + NeedRecreate := True; + end; + if NeedRecreate then begin + SetWindowLong (Handle, GWL_STYLE, Style); + RecreateWnd{$IFDEF LCL}(Self){$ENDIF}; + end; + end; + + if (RealWidth > ClientWidth) then + InitHScrollBar (ClientWidth, RealWidth) + else + RemoveHScrollbar; + + if (RealHeight > ClientHeight) then + InitVScrollBar (ClientHeight, RealHeight) + else + RemoveVScrollbar; +end; + +procedure TVpPrintPreview.SetStartDate (const v : TDateTime); +begin + if v <> FStartDate then begin + FStartDate := v; + ClearPageData; + GeneratePageImage; + Invalidate; + end; +end; + +procedure TVpPrintPreview.SetZoomFactor (const v : TVpPPZoomFactor); +begin + if v <> FZoomFactor then begin + FZoomFactor := v; + SetScrollBars; + Invalidate; + end; +end; + +{$IFNDEF LCL} +procedure TVpPrintPreview.VpPrintFormatChanged (var Msg : {$IFNDEF LCL}TMessage{$ELSE}TLMessage{$ENDIF}); +begin + ForceUpdate; +end; +{$ENDIF} + +{$IFNDEF LCL} +procedure TVpPrintPreview.WMEraseBackground (var Msg : TWMERASEBKGND); +{$ELSE} +procedure TVpPrintPreview.WMEraseBackground (var Msg : TLMERASEBKGND); +{$ENDIF} +begin + Msg.Result := 1; +end; + +{$IFNDEF LCL} +procedure TVpPrintPreview.WMVScroll (var Msg : TWMSCROLL); +{$ELSE} +procedure TVpPrintPreview.WMVScroll (var Msg : TLMSCROLL); +{$ENDIF} +begin + DoScroll (Msg, SB_VERT); +end; + +{$IFNDEF LCL} +procedure TVpPrintPreview.WMHScroll (var Msg : TWMSCROLL); +{$ELSE} +procedure TVpPrintPreview.WMHScroll (var Msg : TLMSCROLL); +{$ENDIF} +begin + DoScroll (Msg, SB_HORZ); +end; + +{$IFNDEF LCL} +procedure TVpPrintPreview.WMRButtonDown(var Msg : TWMRButtonDown); +{$ELSE} +procedure TVpPrintPreview.WMRButtonDown(var Msg : TLMRButtonDown); +{$ENDIF} +var + ClientOrigin : TPoint; + i : Integer; + +begin + inherited; + + if not Assigned (PopupMenu) then begin + if not focused then + SetFocus; + ClientOrigin := GetClientOrigin; + + for i := 0 to FDefaultPopup.Items.Count - 1 do begin + FDefaultPopup.Items[i].Enabled := True; + if (FDefaultPopup.Items[i].Tag = 1) and (IsFirstPage) then + FDefaultPopup.Items[i].Enabled := False; + if (FDefaultPopup.Items[i].Tag = 2) and (IsLastPage) then + FDefaultPopup.Items[i].Enabled := False; + end; + + FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x, + Msg.YPos + ClientOrigin.y); + end; +end; + + +end. + diff --git a/components/tvplanit/source/vpprtprvdlg.lfm b/components/tvplanit/source/vpprtprvdlg.lfm new file mode 100644 index 000000000..0f2305c51 --- /dev/null +++ b/components/tvplanit/source/vpprtprvdlg.lfm @@ -0,0 +1,378 @@ +object frmPrintPreview: TfrmPrintPreview + Left = 285 + Height = 518 + Top = 142 + Width = 480 + HorzScrollBar.Page = 479 + VertScrollBar.Page = 517 + Caption = 'Print Preview' + ClientHeight = 518 + ClientWidth = 480 + Constraints.MinHeight = 200 + Constraints.MinWidth = 395 + Font.Height = -11 + Font.Name = 'MS Sans Serif' + KeyPreview = True + OnCreate = FormCreate + OnKeyDown = FormKeyDown + object Panel1: TPanel + Height = 73 + Width = 480 + Align = alTop + ClientHeight = 73 + ClientWidth = 480 + TabOrder = 0 + object cboxZoom: TComboBox + Left = 217 + Height = 21 + Top = 40 + Width = 145 + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + ItemHeight = 13 + Items.Strings = ( + 'Fit to Control' + 'Actual Size' + '25%' + '33%' + '50%' + '67%' + '75%' + ) + OnChange = cboxZoomChange + Style = csDropDownList + TabOrder = 2 + end + object VpPrintFormatComboBox1: TVpPrintFormatComboBox + Left = 8 + Height = 21 + Top = 40 + Width = 201 + ItemHeight = 13 + Sorted = True + TabOrder = 1 + end + object ToolBar1: TToolBar + Left = 1 + Height = 29 + Top = 1 + Width = 478 + ButtonHeight = 25 + Caption = 'ToolBar1' + Flat = True + Images = imMain + ParentShowHint = False + ShowHint = True + TabOrder = 0 + object btnCancel: TSpeedButton + Left = 132 + Height = 25 + Hint = 'Cancel preview' + Top = 2 + Width = 77 + Action = actCancel + Color = clBtnFace + Flat = True + NumGlyphs = 0 + Transparent = False + end + object btnPrint: TToolButton + Left = 1 + Hint = 'Print' + Top = 2 + Action = actPrint + end + object ToolButton3: TToolButton + Left = 24 + Top = 2 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 2 + Style = tbsSeparator + end + object btnFirstPage: TToolButton + Left = 32 + Hint = 'First page' + Top = 2 + Action = actFirstPage + end + object btnPrevPage: TToolButton + Left = 55 + Hint = 'Previous page' + Top = 2 + Action = actPrevPage + end + object btnNextPage: TToolButton + Left = 78 + Hint = 'Next page' + Top = 2 + Action = actNextPage + end + object btnLastPage: TToolButton + Left = 101 + Hint = 'Last page' + Top = 2 + Action = actLastPage + end + object ToolButton8: TToolButton + Left = 124 + Top = 2 + Width = 8 + Caption = 'ToolButton8' + ImageIndex = 6 + Style = tbsSeparator + end + end + end + object VpPrintPreview1: TVpPrintPreview + Height = 445 + Top = 73 + Width = 480 + EndDate = 37355.4526088079 + StartDate = 37348.4526088079 + Align = alClient + Parent = Owner + TabStop = True + TabOrder = 1 + end + object imMain: TImageList + BkColor = clForeground + Height = 18 + left = 357 + top = 195 + Bitmap = { + 4C69050000001000000012000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000808080FF808080FF8080 + 80FF000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFF + FFFF808080FF808080FF00000000000000000000000000000000000000000000 + 0000000000000000000000000000808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFF000000FF000000000000000000000000000000000000 + 000000000000808080FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF000000FF00000000000000000000000000000000000000008080 + 80FF808080FFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFF000000FF00000000000000000000000000000000808080FF808080FFFFFF + FFFFC0C0C0FFC0C0C0FFC0C0C0FF808080FF808080FFFFFFFFFFFFFFFFFF0000 + 00FFC0C0C0FF000000FF000000FF00000000808080FFFFFFFFFFC0C0C0FFC0C0 + C0FF00FF00FF00FF00FFC0C0C0FFC0C0C0FFC0C0C0FF808080FF808080FF0000 + 00FFC0C0C0FF808080FF808080FF00000000808080FFFFFFFFFFFFFFFFFFFFFF + FFFFC0C0C0FFC0C0C0FF0000FFFF0000FFFFC0C0C0FFC0C0C0FFC0C0C0FF8080 + 80FF808080FF808080FF808080FF00000000808080FFFFFFFFFFC0C0C0FFC0C0 + C0FFFFFFFFFFFFFFFFFFC0C0C0FFC0C0C0FFC0C0C0FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF00000000808080FFFFFFFFFFC0C0C0FFC0C0 + C0FFC0C0C0FFC0C0C0FFFFFFFFFF808080FF808080FF808080FF808080FF8080 + 80FF808080FF808080FF808080FF00000000808080FF808080FFC0C0C0FFC0C0 + C0FFC0C0C0FFC0C0C0FFC0C0C0FF808080FF808080FF808080FF808080FF8080 + 80FF808080FF000000FF000000FF0000000000000000808080FF808080FF8080 + 80FFC0C0C0FFC0C0C0FFC0C0C0FF808080FF808080FF808080FF808080FF0000 + 00FF000000FF808080FF000000FF0000000000000000000000FFC0C0C0FFC0C0 + C0FF808080FF808080FFC0C0C0FF808080FF808080FF000000FF000000FF8080 + 80FF808080FF000000FF000000FF000000000000000000000000000000FF0000 + 00FFC0C0C0FFC0C0C0FF808080FF000000FF000000FF808080FF808080FF0000 + 00FF000000FF0000000000000000000000000000000000000000000000000000 + 0000000000FF000000FFC0C0C0FF808080FF808080FF000000FF000000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000FF000000FF000000FF00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 000000000000000000000000000000000000800000FF800000FF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 00000000000000000000800000FF800000FF800000FF800000FF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 0000800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 0000800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 000000000000FFFFFFFF800000FF800000FF800000FF800000FF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 0000000000000000000000000000FFFFFFFF800000FF800000FF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 00000000000000000000000000000000000000000000FFFFFFFF800000FF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000FFFFFFFFFFFFFFFF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000800000FF800000FF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000800000FF8000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF0000 + 00000000000000000000000000000000000000000000FFFFFFFF800000FF8000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFFF800000FF800000FF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFFFF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFFFF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFFFF0000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF0000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000 + 00FF000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FF8000 + 00FFFFFFFFFF0000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF800000FFFFFF + FFFFFFFFFFFF0000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FF800000FF800000FFFFFFFFFFFFFFFFFF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FF800000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFF000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFFFFFFFFFFFFFFFFFF0000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000800000FF800000FF0000 + 0000000000000000000000000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF000000000000000000000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF800000FF800000FF00000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF800000FF800000FF800000FF800000FF0000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FF000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF800000FF800000FF800000FF800000FF800000FF800000FFFFFFFFFF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF800000FF800000FF800000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFF8000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FF800000FF800000FFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FF8000 + 00FFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000800000FF800000FFFFFF + FFFFFFFFFFFF0000000000000000000000000000000000000000000000008000 + 00FF800000FFFFFFFFFF000000000000000000000000FFFFFFFFFFFFFFFF0000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000 + } + end + object actMain: TActionList + Images = imMain + OnUpdate = actMainUpdate + left = 272 + top = 152 + object actPrint: TAction + Caption = '&Print' + DisableIfNoHandler = True + Hint = 'Print' + ImageIndex = 0 + OnExecute = actPrintExecute + ShortCut = 16464 + end + object actFirstPage: TAction + Caption = '&First page' + DisableIfNoHandler = True + Hint = 'First page' + ImageIndex = 1 + OnExecute = actFirstPageExecute + ShortCut = 16454 + end + object actPrevPage: TAction + Caption = 'Pre&vious page' + DisableIfNoHandler = True + Hint = 'Previous page' + ImageIndex = 2 + OnExecute = actPrevPageExecute + ShortCut = 16470 + end + object actNextPage: TAction + Caption = '&Next page' + DisableIfNoHandler = True + Hint = 'Next page' + ImageIndex = 3 + OnExecute = actNextPageExecute + ShortCut = 16462 + end + object actLastPage: TAction + Caption = '&Last page' + DisableIfNoHandler = True + Hint = 'Last page' + ImageIndex = 4 + OnExecute = actLastPageExecute + ShortCut = 16460 + end + object actCancel: TAction + DisableIfNoHandler = True + Hint = 'Cancel preview' + OnExecute = actCancelExecute + ShortCut = 32835 + end + end +end diff --git a/components/tvplanit/source/vpprtprvdlg.pas b/components/tvplanit/source/vpprtprvdlg.pas new file mode 100644 index 000000000..d39e9a4ca --- /dev/null +++ b/components/tvplanit/source/vpprtprvdlg.pas @@ -0,0 +1,420 @@ +{*********************************************************} +{* VPPRTPRVDLG.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +unit VpPrtPrvDlg; + +{$I vp.inc} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + SysUtils, + Classes, + Graphics, + Controls, + Forms, + Dialogs, + StdCtrls, + ExtCtrls, + {$IFDEF VERSION6} Variants, {$ENDIF} + VpMisc, + VpBase, + VpException, + VpData, + VpPrtPrv, + VpSR, + VpBaseDS, + VpDlg, + Buttons, + VpPrtFmtCBox, + Printers, ImgList, ComCtrls, ToolWin, ActnList; + +type + TVpPrintPreviewDialog = class; + + TfrmPrintPreview = class (TForm) + Panel1 : TPanel; + cboxZoom : TComboBox; + VpPrintPreview1 : TVpPrintPreview; + VpPrintFormatComboBox1 : TVpPrintFormatComboBox; + ToolBar1: TToolBar; + btnPrint: TToolButton; + ToolButton3: TToolButton; + btnFirstPage: TToolButton; + btnPrevPage: TToolButton; + btnNextPage: TToolButton; + btnLastPage: TToolButton; + imMain: TImageList; + ToolButton8: TToolButton; + actMain: TActionList; + actPrint: TAction; + actFirstPage: TAction; + actPrevPage: TAction; + actNextPage: TAction; + actLastPage: TAction; + actCancel: TAction; + btnCancel: TSpeedButton; + + procedure FormCreate (Sender : TObject); + procedure OKBtnClick (Sender : TObject); + procedure btnFirstPageClick(Sender: TObject); + procedure btnPrevPageClick(Sender: TObject); + procedure btnNextPageClick(Sender: TObject); + procedure btnLastPageClick(Sender: TObject); + procedure cboxZoomChange(Sender: TObject); + procedure actPrintExecute(Sender: TObject); + procedure actFirstPageExecute(Sender: TObject); + procedure actPrevPageExecute(Sender: TObject); + procedure actNextPageExecute(Sender: TObject); + procedure actLastPageExecute(Sender: TObject); + procedure actMainUpdate(Action: TBasicAction; var Handled: Boolean); + procedure actCancelExecute(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + + private + procedure SetCaptions; + + public + Resource : TVpResource; + Contact : TVpContact; + ReturnCode : TVpEditorReturnCode; + end; + + TVpPrintPreviewDialog = class (TVpBaseDialog) + private + FControlLink : TVpControlLink; + FAutoPrint : Boolean; + FBottomMargin : Extended; + FEndDate : TDateTime; + FLeftMargin : Extended; + FMarginUnits : TVpItemMeasurement; + FRightMargin : Extended; + FStartDate : TDateTime; + FTopMargin : Extended; + FZoomFactor : TVpPPZoomFactor; + FWindowState : TWindowState; + FPrinter : TPrinter; + + protected + procedure Notification (AComponent : TComponent; + Operation : TOperation); override; + procedure SetAutoPrint (const v : Boolean); + procedure SetBottomMargin (const v : Extended); + procedure SetControlLink (const v : TVpControlLink); + procedure SetEndDate (const v : TDateTime); + procedure SetLeftMargin (const v : Extended); + procedure SetMarginUnits (const v : TVpItemMeasurement); + procedure SetRightMargin (const v : Extended); + procedure SetStartDate (const v : TDateTime); + procedure SetTopMargin (const v : Extended); + procedure SetZoomFactor (const v : TVpPPZoomFactor); + + public + constructor Create (AOwner : TComponent); override; + function Execute : Boolean; override; + + property Printer : TPrinter read FPrinter write FPrinter; + + published + property AutoPrint : Boolean read FAutoPrint write SetAutoPrint + default False; + property BottomMargin : Extended + read FBottomMargin write SetBottomMargin; + property ControlLink : TVpControlLink + read FControlLink write SetControlLink; + property EndDate : TDateTime read FEndDate write SetEndDate; + property LeftMargin : Extended read FLeftMargin write SetLeftMargin; + property MarginUnits : TVpItemMeasurement + read FMarginUnits write SetMarginUnits default imInches; + property RightMargin : Extended read FRightMargin write SetRightMargin; + property StartDate : TDateTime read FStartDate write SetStartDate; + property TopMargin : Extended read FTopMargin write SetTopMargin; + property WindowState : TWindowState read FWindowState write FWindowState + default wsNormal; + property ZoomFactor : TVpPPZoomFactor + read FZoomFactor write SetZoomFactor default zfFitToControl; + + property DataStore; + property Options; + property Placement; + end; + +implementation + +{$IFNDEF LCL} +{$R *.dfm} +{$ENDIF} + +procedure TfrmPrintPreview.FormCreate(Sender: TObject); +begin + ReturnCode := rtAbandon; + SetCaptions; +end; + +procedure TfrmPrintPreview.SetCaptions; +begin + Self.Caption := RSDlgPrintPreview; + actCancel.Caption := RSCancelBtn; +end; + + +procedure TfrmPrintPreview.OKBtnClick(Sender: TObject); +begin + ReturnCode := rtCommit; + Close; +end; + +constructor TVpPrintPreviewDialog.Create (AOwner : TComponent); +begin + inherited Create (AOwner); + FPlacement.Height := 480; + FPlacement.Width := 640; + StartDate := Now; + EndDate := Now + 7; + FZoomFactor := zfFitToControl; + FWindowState := wsNormal; + FAutoPrint := False; + FControlLink := SearchControlLink (Owner); + FPrinter := Printer; +end; + +function TVpPrintPreviewDialog.Execute : Boolean; +var + EditForm : TfrmPrintPreview; +begin + Result := False; + Application.CreateForm (TfrmPrintPreview, EditForm); + try + DoFormPlacement(EditForm); + EditForm.WindowState := WindowState; + EditForm.VpPrintPreview1.ControlLink := ControlLink; + EditForm.VpPrintFormatComboBox1.ControlLink := ControlLink; + EditForm.VpPrintPreview1.StartDate := StartDate; + EditForm.VpPrintPreview1.EndDate := EndDate; + EditForm.VpPrintPreview1.ZoomFactor := ZoomFactor; + EditForm.cboxZoom.ItemIndex := Integer (ZoomFactor); + EditForm.VpPrintPreview1.Printer := Printer; + EditForm.VpPrintPreview1.FirstPage; + EditForm.ShowModal; + if EditForm.ReturnCode = rtCommit then begin + Result := True; + end; + if AutoPrint and Assigned (FControlLink) and Result then begin + Printer.BeginDoc; + try + FControlLink.Printer.Print (Printer, StartDate, EndDate); + finally + Printer.EndDoc; + end; + end; + finally + EditForm.Release; + end; +end; + +procedure TVpPrintPreviewDialog.Notification (AComponent : TComponent; + Operation : TOperation); + {-Handle new/deleted components} +begin + inherited Notification (AComponent, Operation); + + if Operation = opRemove then begin + {Owned components going away} + if AComponent = FControlLink then begin + FControlLink := nil; + end; + end else if Operation = opInsert then begin + if AComponent is TVpControlLink then begin + if not Assigned (FControlLink) then begin + FControlLink := TVpControlLink (AComponent); + end; + end; + end; +end; + +procedure TVpPrintPreviewDialog.SetAutoPrint (const v : Boolean); +begin + if v <> FAutoPrint then + FAutoPrint := v; +end; + +procedure TVpPrintPreviewDialog.SetBottomMargin (const v : Extended); +begin + if v <> FBottomMargin then + FBottomMargin := v; +end; + +procedure TVpPrintPreviewDialog.SetControlLink (const v : TVpControlLink); +begin + if FControlLink <> v then + FControlLink := v; +end; + +procedure TVpPrintPreviewDialog.SetEndDate (const v : TDateTime); +begin + if v <> FEndDate then + FEndDate := v; +end; + +procedure TVpPrintPreviewDialog.SetLeftMargin (const v : Extended); +begin + if v <> FLeftMargin then + FLeftMargin := v; +end; + +procedure TVpPrintPreviewDialog.SetMarginUnits (const v : TVpItemMeasurement); +begin + if v <> FMarginUnits then + FMarginUnits := v; +end; + +procedure TVpPrintPreviewDialog.SetRightMargin (const v : Extended); +begin + if v <> FRightMargin then + FRightMargin := v; +end; + +procedure TVpPrintPreviewDialog.SetStartDate (const v : TDateTime); +begin + if v <> FStartDate then + FStartDate := v; +end; + +procedure TVpPrintPreviewDialog.SetTopMargin (const v : Extended); +begin + if v <> FTopMargin then + FTopMargin := v; +end; + +procedure TVpPrintPreviewDialog.SetZoomFactor (const v : TVpPPZoomFactor); +begin + if v <> FZoomFactor then + FZoomFactor := v; +end; + +{ TfrmPrintPreview } +procedure TfrmPrintPreview.btnFirstPageClick(Sender: TObject); +begin + VpPrintPreview1.FirstPage; +end; + +procedure TfrmPrintPreview.btnPrevPageClick(Sender: TObject); +begin + VpPrintPreview1.PrevPage; +end; + +procedure TfrmPrintPreview.btnNextPageClick(Sender: TObject); +begin + VpPrintPreview1.NextPage; +end; + +procedure TfrmPrintPreview.btnLastPageClick(Sender: TObject); +begin + VpPrintPreview1.LastPage; +end; + +procedure TfrmPrintPreview.cboxZoomChange(Sender: TObject); +begin + case cboxZoom.ItemIndex of + 0 : VpPrintPreview1.ZoomFactor := zfFitToControl; + 1 : VpPrintPreview1.ZoomFactor := zfActualSize; + 2 : VpPrintPreview1.ZoomFactor := zf25Percent; + 3 : VpPrintPreview1.ZoomFactor := zf33Percent; + 4 : VpPrintPreview1.ZoomFactor := zf50Percent; + 5 : VpPrintPreview1.ZoomFactor := zf67Percent; + 6 : VpPrintPreview1.ZoomFactor := zf75Percent; + end; +end; + +procedure TfrmPrintPreview.actPrintExecute(Sender: TObject); +begin + ReturnCode := rtCommit; + Close; +end; + +procedure TfrmPrintPreview.actFirstPageExecute(Sender: TObject); +begin + VpPrintPreview1.FirstPage; +end; + +procedure TfrmPrintPreview.actPrevPageExecute(Sender: TObject); +begin + VpPrintPreview1.PrevPage; +end; + +procedure TfrmPrintPreview.actNextPageExecute(Sender: TObject); +begin + VpPrintPreview1.NextPage; +end; + +procedure TfrmPrintPreview.actLastPageExecute(Sender: TObject); +begin + VpPrintPreview1.LastPage; +end; + +procedure TfrmPrintPreview.actMainUpdate(Action: TBasicAction; + var Handled: Boolean); +begin + if VpPrintPreview1.IsFirstPage then begin + actFirstPage.Enabled := False; + actPrevPage.Enabled := False; + end else begin + actFirstPage.Enabled := True; + actPrevPage.Enabled := True; + end; + + if VpPrintPreview1.IsLastPage then begin + actLastPage.Enabled := False; + actNextPage.Enabled := False; + end else begin + actLastPage.Enabled := True; + actNextPage.Enabled := True; + end; +end; + +procedure TfrmPrintPreview.actCancelExecute(Sender: TObject); +begin + ReturnCode := rtAbandon; + Close; +end; + +procedure TfrmPrintPreview.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then + actCancel.Execute; +end; + +end. + diff --git a/components/tvplanit/source/vpreg.pas b/components/tvplanit/source/vpreg.pas new file mode 100644 index 000000000..2347e08c5 --- /dev/null +++ b/components/tvplanit/source/vpreg.pas @@ -0,0 +1,414 @@ +{*********************************************************} +{* VPREG.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} { Compiler Version Defines } +{$IFNDEF LCL} +{$R VpREG.RES} { Palette Glyphs } +{$ENDIF} + +unit VpReg; + {Registration unit for the Visual PlanIt design-time interface} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Dialogs, + {$IFDEF VERSION6} + {$IFNDEF LCL} + DesignIntf, + DesignEditors, + VCLEditors, + {$ELSE} + PropEdits, + LazarusPackageIntf, + FieldsEditor, + ComponentEditors, + {$ENDIF} + {$ELSE} + DsgnIntf, + {$ENDIF} + Classes, + Controls, + TypInfo, + Forms, + SysUtils, + VpDatePropEdit; + +type + {TDBStringProperty} + TDBStringProperty = class(TStringProperty) + public + function GetAttributes: TPropertyAttributes; override; + procedure GetValueList(List: TStrings); virtual; + procedure GetValues(Proc: TGetStrProc); override; + end; + + {TAliasNameProperty} + TAliasNameProperty = class(TDBStringProperty) + public + procedure GetValueList(List: TStrings); override; + end; + + {TDriverNameProperty} + TDriverNameProperty = class(TDBStringProperty) + public + procedure GetValueList(List: TStrings); override; + end; + + { TDataStoreProperty } + TDataStoreProperty = class(TComponentProperty) + private + FCheckProc: TGetStrProc; + procedure CheckComponent(const Value: string); + public + procedure GetValues(Proc: TGetStrProc); override; + end; + + TVpDateProperty = class (TFloatProperty) + public + procedure Edit; override; + function GetAttributes : TPropertyAttributes; override; + function GetValue : string; override; + procedure SetValue (const Value : string); override; + end; + + TVpGenericFileNameProperty = class (TStringProperty) + protected + public + function GetAttributes: TPropertyAttributes; override; + procedure Edit; override; + end; + + TVpLocalizeFileNameProperty = class (TVpGenericFileNameProperty) + end; + +procedure Register; + +implementation + +uses +// DbTables, { VCL - BDE runtime unit } + VpWavPE, { Wav File Finder - Property Editor } + + { Component Units } + VpBase, { Base classes for Vp } + VpClock, { Clock Component } + VpDlg, { Dialog components ancestor } + VpLEDLabel, { LEDLabel Component } + VpCalendar, { Calendar Component } + VpNavBar, { Navigation Bar Component } + VpBaseDS, { Base DataStore Classes } +// VpBDEDS, { DataStore Component } + VpDayView, { Day View Component } + VpWeekView, { Week View Component } + VpMonthView, { Month View Component } + VpContactGrid, { ContactGrid Component } + VpDateEdit, { DateEdit Component } + VpTaskList, { Task List Component } +// VpFlxDS, { Flexible DataStore } + VpContactEditDlg, { Contact Edit Dialog Component } + VpTaskEditDlg, { Task Edit Dialog Component } + VpEvntEditDlg, { Event Edit Dialog Component } + VpAlarmDlg, { Alarm Notification Dialog } + VpResEditDlg, { Resource Edit Dialog } + VpPrtPrv, { Print Preview Component } + VpPrtFmtCBox, { Print Format Combo Box Component } + VpPrtPrvDlg, { Print Preview Dialog } + VpPrtFmtDlg, { Print Format Dialog } + VpPrtFmtEd, { Print Format Property editor } + VpContactButtons, { - New contact grid button bar component } + { Designtime Interfaces (Property and Component Editors) } + VpAbout, { About form for the About property editor } + VpNabEd; { component editor for the VpNavBar } +// VpFlxDSEd1; { Field mapper component editor for the FlexDS } + + +(*****************************************************************************) +{ TAliasNameProperty } + +procedure TAliasNameProperty.GetValueList(List: TStrings); +begin +{$IFNDEF LCL} + (GetComponent(0) as TVpBDEDataStore).Database.Session.GetAliasNames(List); +{$ENDIF} +end; + +(*****************************************************************************) +{ TDBStringProperty } + +function TDBStringProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paValueList, paSortList, paMultiSelect]; +end; +{=====} + +procedure TDBStringProperty.GetValueList(List: TStrings); +begin +end; +{=====} + +procedure TDBStringProperty.GetValues(Proc: TGetStrProc); +var + I: Integer; + Values: TStringList; +begin + Values := TStringList.Create; + try + GetValueList(Values); + for I := 0 to Values.Count - 1 do Proc(Values[I]); + finally + Values.Free; + end; +end; +{=====} + +(*****************************************************************************) +{ TDriverNameProperty } + +procedure TDriverNameProperty.GetValueList(List: TStrings); +begin + {$IFNDEF LCL} + (GetComponent(0) as TVpBDEDataStore).Database.Session.GetDriverNames(List); + {$ENDIF} +end; +{=====} + +(*****************************************************************************) +{ TDataStoreProperty } +procedure TDataStoreProperty.CheckComponent(const Value: string); +var + J: Integer; + DataStore: TVpCustomDataStore; +begin + {$IFNDEF LCL} + DataStore := TVpCustomDataStore(Designer.GetComponent(Value)); + for J := 0 to PropCount - 1 do + if TVpDayView(GetComponent(J)).DataStore = DataStore then + Exit; + FCheckProc(Value); + {$ENDIF} +end; + +procedure TDataStoreProperty.GetValues(Proc: TGetStrProc); +begin + FCheckProc := Proc; + inherited GetValues(CheckComponent); +end; +{=====} + +(*****************************************************************************) +{ TDataStoreProperty } +procedure TVpDateProperty.Edit; + +var + frmDatePropertyEditor : TfrmDatePropertyEditor; + +begin + frmDatePropertyEditor := TfrmDatePropertyEditor.Create (Application); + try + frmDatePropertyEditor.VpCalendar1.Date := GetFloatValue; + if frmDatePropertyEditor.Execute then + SetFloatValue (Trunc (frmDatePropertyEditor.VpCalendar1.Date)); + finally + frmDatePropertyEditor.Free; + end; +end; +{=====} + +(*****************************************************************************) +{ TVpDateProperty } +function TVpDateProperty.GetAttributes : TPropertyAttributes; +begin + Result := [paDialog, paMultiSelect]; +end; +{=====} + +function TVpDateProperty.GetValue : string; +begin + Result := FormatDateTime ('ddddd', GetFloatValue); +end; +{=====} + +procedure TVpDateProperty.SetValue (const Value : string); +begin + SetFloatValue (StrToDate (Value)); +end; +{=====} + +(*****************************************************************************) +{ TVpGenericFileNameProperty } +function TVpGenericFileNameProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paDialog]; +end; + +procedure TVpGenericFileNameProperty.Edit; +const + VpRegLocalizeFilter = 'Localization Files (*.XML)|*.XML'; + VpRegDefFilter = 'All Files (*.*)|*.*'; + +var + Dlg : TOpenDialog; + Filter : string; + +begin + Filter := ''; + if Self is TVpLocalizeFileNameProperty then + Filter := VpRegLocalizeFilter; + + if Filter = '' then + Filter := VpRegDefFilter + else + Filter := Filter + '|' + VpRegDefFilter; + + Dlg := TOpenDialog.Create (Application); + try + Dlg.DefaultExt := '*.*'; + Dlg.Filter := Filter; + Dlg.FilterIndex := 0; + Dlg.Options := [ofHideReadOnly]; +{ Dlg.FileName := Value; + if Dlg.Execute then + Value := Dlg.FileName; } + finally + Dlg.Free; + end; +end; + +{*** component registration ***} + procedure Register; + begin + { register component editors } + RegisterComponentEditor(TVpNavBar, TVpNavBarEditor); + RegisterComponentEditor(TVpControlLink, TVpPrtFmtPropertyEditor); + {$IFNDEF LCL} + RegisterComponentEditor(TVpFlexDataStore, TVpFlexDSEditor); + {$ENDIF} + + { register the About Box property editor for the Version properties } + RegisterPropertyEditor(TypeInfo(string), TVpCollectionItem, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpComponent, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpNavBar, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpCalendar, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpLEDLabel, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpClock, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpResourceCombo, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpCustomControl, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpControlLink, + 'Version', TVpAboutProperty); + {$IFNDEF LCL} + RegisterPropertyEditor(TypeInfo(string), TVpBDEDataStore, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpFlexDataStore, + 'Version', TVpAboutProperty); + {$ENDIF} + RegisterPropertyEditor(TypeInfo(string), TVpDateEdit, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpBaseDialog, + 'Version', TVpAboutProperty); + RegisterPropertyEditor(TypeInfo(string), TVpPrintFormatComboBox, + 'Version', TVpAboutProperty); + + {register the BDE Alias and Driver properties } + {$IFNDEF LCL} + RegisterPropertyEditor(TypeInfo(string), TVpBDEDataStore, + 'AliasName', TAliasNameProperty); + RegisterPropertyEditor(TypeInfo(string), TVpBDEDataStore, + 'DriverName', TDriverNameProperty); + {$ENDIF} + {register the DayView properties } + RegisterPropertyEditor(TypeInfo(TVpCustomDataStore), TVpDayView, + 'DataStore', TDataStoreProperty); + + {register the property editor for the DataStore's DefaultAlarmWav } + RegisterPropertyEditor(TypeInfo(string), TVpCustomDataStore, + 'DefaultEventSound', TWavFileProperty); + + RegisterPropertyEditor (TypeInfo (TDateTime), + TVpPrintPreview, + 'StartDate', + TVpDateProperty); + RegisterPropertyEditor (TypeInfo (TDateTime), + TVpPrintPreview, + 'EndDate', + TVpDateProperty); + RegisterPropertyEditor (TypeInfo (TDateTime), + TVpPrintPreviewDialog, + 'StartDate', + TVpDateProperty); + RegisterPropertyEditor (TypeInfo (TDateTime), + TVpPrintPreviewDialog, + 'EndDate', + TVpDateProperty); + + RegisterPropertyEditor (TypeInfo (string), TVpControlLink, + 'LocalizationFile', TVpLocalizeFileNameProperty); + + {register Visual PlanIt components with the IDE} + RegisterComponents('Visual PlanIt', [ + TVpLEDLabel, + TVpClock, + TVpCalendar, + TVpNavBar, + {$IFNDEF LCL} + TVpFlexDataStore, + TVpBDEDataStore, + {$ENDIF} + TVpControlLink, + TVpPrintPreview, + TVpPrintFormatComboBox, + TVpDateEdit, + TVpResourceCombo, + TVpDayView, + TVpWeekView, + TVpMonthView, + TVpContactGrid, + TVpContactButtonBar, + TVpTaskList, + TVpNotificationDialog, + TVpResourceEditDialog, + TVpEventEditDialog, + TVpContactEditDialog, + TVpTaskEditDialog, + TVpPrintFormatEditDialog, + TVpPrintPreviewDialog]); + end; +end. diff --git a/components/tvplanit/source/vpreg.res b/components/tvplanit/source/vpreg.res new file mode 100644 index 0000000000000000000000000000000000000000..16692482b3c635c81e595bb164cae419f7b846f0 GIT binary patch literal 14484 zcmeHO&1)RV6@OAMOj~l&HVGuR9dyX%I7u63Ap`!<$ZNCy!t345o|0Rx13HWjhUrZX zngzqKxAgj;(RZlmE;0c)70;XieV5XRWDLL>ke~?K`9i9V$ zHfTCr)xLC1Zm1q_lNn(ix?}l5uu}MY0?W(w#)5n7gcPIWp64zR$@3(^FAlWUA`zChU!U<|^*&L9gOj^=raA z=A%#FX`%wfD9CX=P2()mS}E>ZH%lyiOCWB<%MZy!oC^BbfYE_6LFwtTCK$E^!IqlX~3s<`-YLWckj_zr6Val{b`9CXU}S0($lj) zP??H<=HI1}s2Ljm1%6EMMMEE2)o1W+f~fiE@D=oBnxn6v=T<8nrs>`FyVNrxX*yb0 zJsU=x-#`mI)IUSuv6$rzm@*Fu2Ys1U^rW=O+jw5X-&Mp;K)=emA+$!UFD`%<>fM4# zkU*^UCuX~mKLBEo7|c`+FGu#|y`iQG0KSHrY75PaxY}@Q2uD7ZWr<*dBho$3P~{pA z#eiQkD+GV>x@9$aCDT#zZ*CDkwBkZ2425OZx+tr!SAkg|1Z@O^ydU&s%oANJdQ`K( z`Pg4s&f}mSeHkA*mp3Jb*%CnuDee#tGEj7eO$a{KDv8V`p(b+vSs&SZ!$`+;1T-} zhIQ}MysJk{aRQfY*%mlAu{&x{;F|%fa^O;jLBK+~!NO6@9pa}EB zhA1&4M56rYEs?G0!>SDce<;$aA!b}~VbFVW^3_fsiY$l8oTqCxrQ7t(_|MsV@F2gv z#pIW7M4T_w&{$bnQH)7of${EuIoAxB^UDL6(^$M-Wh%BlbXu2dutClS-}t3ANO^zt zFu&A{iJq+bpBOp!9zVY4@i2Y-=#kZ~fr&<8y~WIcbRd52ujTs8v^}oMhkj-4 zr1h;{bu%B-r4Oo0kG;+`7U-|7E~nSpuBm6ry^2df*U&%=^RUC9nBzXJr2dYz8u1s_ zYU=*NO3h;3F0R@f17phv>ovT#xKm|lY#7qhIWiHVto&1qcD5pBP%Bg|xYd500jot?)!HIJ8f zc1I5lle~)r@^nDn33Tuj{2d|L%j_;g3~(qh*UHAASg4c@>vBbzf%liw^Y7Q&^jhf+ z*xen>E-vHZUIj5%Y7VZJ&Rd^TIxH(Sy}o!9-NsAuV>a=SG2n<}BsQvu8#af4rv#pe z^9=Y;#C|S9EJnu^hIC}6uSDE{RQg-QQ3|IDcVJM6Ren)8&Ff>caaI3E?D=w>EA8-> z?)-9oaT$8NjTs|#%GI~)u+E!${j!ieZ=Dt`as=p=-?e+u+70ZtSaVU#wHPeSlsI<> zvE+hntG=z>;BDaH+6}0D^#Pf_JO}7StA6{nn_I`w=~4R{6x+C^ldI0(~aFyQJOD8vXtm;s$a@asRC1r|m0I1A83&Hkm>9HGnB7{VwK@rL7Wi zWuUq`H(%TA)L3l|%~PKTn0D^}J>cf42R{lJYd z!~?fU%r=dk(y8WdHW*~<&-#iPJRyz^R-K>+>7o#GpB{#IceSz#&9E##o6hN*)gwajfK~DE5qXtkg*& z@;t&=sgqE?9Ajm`94l=T6$vjlR$jnIQQD=QfO{VnIqNjX8$D9*s>sK?yYzXW3@n=K zSq{<>IsJ$}k1A=@x<@|;bc9w+KgVO9 z)H+fV>1A$n(Ca5z&0(=-+?PoViTNbPB%~9=SB&6rmcWVPT>FC@; z1#e6?2PomdxlJu7a{I8M>9q~~e*)?~*`O2@yDQy+)OrxoWd_#+MS7Ua3|7ql0j^zLI8{{ipFy8 z&)+!r&v%^r(>w0jr$6aUzI^NE^94v*kn?!Oc@*Z37n5{{qhzrjzhQQSGr=&wQ37h8=++^NWFeWErb@eAnX&T&y`+< z#1nR&CT!lLFTj}^xbGGko{pLZIy`zTTO0lVYR|WgMkwb6;asVm^}dAfb#%x^3n5~H+b}V7=U~L&M+Ef68HN7lR^wT%sd7M;>M%6?{OA`qk=i_o|a#hp?5?X pq%ZiznwKK6wt5K0n= nil then begin + Res := DataStore.Resources.AddResource(DataStore.GetNextID(ResourceTableName)); + if Res <> nil then begin + Res.Changed := true; + reResource := Res; + result := Show; + + if Result then begin + ResName := Res.Description; + DataStore.PostResources; + DataStore.Load; + DataStore.SetResourceByName(ResName); + end else + Res.Free; + end; + end; +end; +{=====} + +function TVpResourceEditDialog.Show: Boolean; +var + EditForm: TResEditForm; +begin + result := false; + Application.CreateForm(TResEditForm, EditForm); + try + DoFormPlacement(EditForm); + EditForm.Resource := reResource; + EditForm.PopulateSelf; + EditForm.ShowModal; + if EditForm.ReturnCode = rtCommit then begin + EditForm.DePopulateSelf; + result := true; + end; + finally + EditForm.Release; + end; +end; +{=====} + +function TVpResourceEditDialog.Execute: Boolean; +begin + result := false; + if (DataStore <> nil) and (DataStore.Resource <> nil) then begin + reResource := DataStore.Resource; + + result := Show; + + if result then begin + reResource.Changed := true; + DataStore.PostResources; + end; + end; +end; +{=====} + +{ TResEditForm } + +procedure TResEditForm.DePopulateSelf; +begin + Resource.Description := DescriptionEdit.Text; + Resource.Notes := NotesMemo.Text; +end; +{=====} + +procedure TResEditForm.PopulateSelf; +begin + DescriptionEdit.Text := Resource.Description; + NotesMemo.Text := Resource.Notes; +end; +{=====} + +procedure TResEditForm.OKBtnClick(Sender: TObject); +begin + if ResourceChanged then + ReturnCode := rtCommit; + Close; +end; +{=====} + +procedure TResEditForm.FormCreate(Sender: TObject); +begin + ReturnCode := rtAbandon; + ResourceChanged := false; +end; +{=====} + +procedure TResEditForm.CancelBtnClick(Sender: TObject); +begin + Close; +end; +{=====} + +procedure TResEditForm.Change(Sender: TObject); +begin + ResourceChanged := true; + SetControls; +end; +{=====} + +{=====} + +procedure TResEditForm.FormShow(Sender: TObject); +begin + DescriptionEdit.SetFocus; + SetControls; +end; +{=====} + +procedure TResEditForm.SetControls; +begin + OKBtn.Enabled := (DescriptionEdit.Text <> ''); +end; + +end. + diff --git a/components/tvplanit/source/vpruntime.dpk b/components/tvplanit/source/vpruntime.dpk new file mode 100644 index 000000000..fa7f61b7f --- /dev/null +++ b/components/tvplanit/source/vpruntime.dpk @@ -0,0 +1,96 @@ +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (c) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +package VpRuntime; + +{$R *.RES} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESCRIPTION 'TurboPower Visual-PlanIt Runtime Package'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl40; + +contains + VpAlarmDlg in 'VpAlarmDlg.pas' {AlarmNotifyForm}, + VpBase in 'VpBase.pas', + VpBaseDS in 'VpBaseDS.pas', + VpBDEDS in 'VpBDEDS.pas', + VpCalendar in 'VpCalendar.pas', + VpCanvasUtils in 'VpCanvasUtils.pas', + VpClock in 'VpClock.pas', + VpConst in 'VpConst.pas', + VpContactEditDlg in 'VpContactEditDlg.pas' {ContactEditForm}, + VpContactGrid in 'VpContactGrid.pas', + VpData in 'VpData.pas', + VpDateEdit in 'VpDateEdit.pas', + VpDayView in 'VpDayView.pas', + VpDBDS in 'VpDBDS.pas', + VpDlg in 'VpDlg.pas', + VpEdPop in 'VpEdPop.pas', + VpEvntEditDlg in 'VpEvntEditDlg.pas' {DlgEventEdit}, + VpException in 'VpException.pas', + VpFlxDS in 'VpFlxDS.pas', + VpLEDLabel in 'VpLEDLabel.pas', + VpMisc in 'VpMisc.pas', + VpMonthView in 'VpMonthView.pas', + VpNavBar in 'VpNavBar.pas', + VpPrtFmt in 'VpPrtFmt.pas', + VpPrtFmtCBox in 'VpPrtFmtCBox.pas', + VpPrtPrv in 'VpPrtPrv.pas', + VpPrtPrvDlg in 'VpPrtPrvDlg.pas' {frmPrintPreview}, + VpResEditDlg in 'VpResEditDlg.pas' {ResEditForm}, + VpSR in 'VpSR.pas', + VpTaskEditDlg in 'VpTaskEditDlg.pas' {TaskEditForm}, + VpTaskList in 'VpTaskList.pas', + VpTimerPool in 'VpTimerPool.pas', + VpWavDlg in 'VpWavDlg.pas' {FrmSoundDialog}, + VpWavPE in 'VpWavPE.pas', + VpWeekView in 'VpWeekView.pas', + VpXBase in 'VpXBase.pas', + VpXChrFlt in 'VpXChrFlt.pas', + VpXParsr in 'VpXParsr.pas'; + +end. diff --git a/components/tvplanit/source/vpruntime.res b/components/tvplanit/source/vpruntime.res new file mode 100644 index 0000000000000000000000000000000000000000..df60c6a90db7710eeaba11bb36397c13850e74dc GIT binary patch literal 1788 zcmbVL&ubG=5dLBowgqW=@FZgQ;6cPnEx8CnE3Gw!Xp1euTZ!7n(wZ)5%Wml*D+JeD zuU&HR?tc)1WWhi$#lOLW2XFS4l$NgFyxq+&Y6T~moi{Vz{CM-;0|0{@1R- z3hjE?b(9(zbhm9^KhCP3AoMl?0w?)mC<`DPlIZ^g9Q9<7fNW2OX+Uc#KvR(qFn8H) zSy2h`6JT2=6hQe2aCKlPlg%oB^QdK;Hk?YO8TzxfrMp9WpE8lZ>AGdpt$7{)GpkkJ zKdT*f{I=a{)VxE+W0sV$4))K^YTgNTsavsI^+uzrbWQyBUZY<3ywCKr!Dgl9)laKT zAOYgfc+{%O4+*H8dR5|;KLU7OE%d91N}GttFNW!b)IrrdV7d;q!}=XP6^BQbQ`KI_ zjg&-x3xeRoNh)ysWZ>|Ikjp+W^#d4Vv#E%6>cYvZm{?u7O&mFKPI*DeTb2xb%9Bho z2+s8&xJXfsQBK_eFhLH25j@8e%;N=l1`Cui^}Y*v4G9>Are1}-q6Ew&qPI4B>02_B zX{O3y2`l_Q#Y?W{RfQE*Z;orBui9^ESFL+LQ<0)k4tl?3YeqZ#40lv zv4$sdsWXfp;f0B>=ddE-82iP^>*)t||@b;cJ}{v6latdVEGKA#LG-}6t<|Uc6a;tUVx8y$k;673Mxt_ zW^z_C@dDm4Bh(D~Z3ZUU!31N+qtzttb0_~hRp1`G=f9ppLfRnADxVuKTiDa0;B zJ<83HDaU6bT71g!Y!->#Vzyn*d8h9lTs51tI*0z)!PDrTgPaF&Q|%+XchZHNN!Fi_*9euR literal 0 HcmV?d00001 diff --git a/components/tvplanit/source/vpselresdlg.lfm b/components/tvplanit/source/vpselresdlg.lfm new file mode 100644 index 000000000..e45326638 --- /dev/null +++ b/components/tvplanit/source/vpselresdlg.lfm @@ -0,0 +1,86 @@ +object frmSelectResource: TfrmSelectResource + Left = 253 + Top = 149 + Width = 284 + Height = 190 + Caption = 'Select a Resource' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDesktopCenter + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 8 + Top = 8 + Width = 257 + Height = 105 + end + object lblSelectResource: TLabel + Left = 16 + Top = 16 + Width = 88 + Height = 13 + Caption = 'Select a Resource' + end + object VpResourceCombo1: TVpResourceCombo + Left = 16 + Top = 40 + Width = 217 + Height = 21 + Style = csDropDownList + end + object btnOK: TButton + Left = 112 + Top = 128 + Width = 75 + Height = 25 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 1 + end + object btnCancel: TButton + Left = 192 + Top = 128 + Width = 75 + Height = 25 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 2 + end + object btnAddNew: TButton + Left = 16 + Top = 72 + Width = 113 + Height = 25 + Caption = 'Add New Resource' + TabOrder = 3 + OnClick = btnAddNewClick + end + object btnEdit: TButton + Left = 136 + Top = 72 + Width = 113 + Height = 25 + Caption = 'Edit This Resource' + TabOrder = 4 + OnClick = btnEditClick + end + object VpResourceEditDialog1: TVpResourceEditDialog + Version = 'v1.03' + Options = [] + Placement.Position = mpCenter + Placement.Top = 10 + Placement.Left = 10 + Placement.Height = 250 + Placement.Width = 400 + Left = 232 + Top = 24 + end +end diff --git a/components/tvplanit/source/vpselresdlg.pas b/components/tvplanit/source/vpselresdlg.pas new file mode 100644 index 000000000..e6ce5ab81 --- /dev/null +++ b/components/tvplanit/source/vpselresdlg.pas @@ -0,0 +1,80 @@ +{*********************************************************} +{* VpSelResDlg.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +unit VpSelResDlg; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, VpBaseDS, VpBase, VpDlg, VpResEditDlg, ExtCtrls; + +type + TfrmSelectResource = class(TForm) + VpResourceCombo1: TVpResourceCombo; + lblSelectResource: TLabel; + btnOK: TButton; + btnCancel: TButton; + VpResourceEditDialog1: TVpResourceEditDialog; + btnAddNew: TButton; + btnEdit: TButton; + Bevel1: TBevel; + procedure btnAddNewClick(Sender: TObject); + procedure btnEditClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + frmSelectResource: TfrmSelectResource; + +implementation + +{$IFNDEF LCL} +{$R *.DFM} +{$ENDIF} + +procedure TfrmSelectResource.btnAddNewClick(Sender: TObject); +begin + VpResourceEditDialog1.AddNewResource; +end; + +procedure TfrmSelectResource.btnEditClick(Sender: TObject); +begin + VpResourceEditDialog1.Execute; +end; + +end. + diff --git a/components/tvplanit/source/vpsqlbde.pas b/components/tvplanit/source/vpsqlbde.pas new file mode 100644 index 000000000..aa7c576d2 --- /dev/null +++ b/components/tvplanit/source/vpsqlbde.pas @@ -0,0 +1,112 @@ +{*********************************************************} +{* VPSQLBDE.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* Hannes Danzl *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{This unit was provided by Hannes Danzl and is used here with permission } + +unit VPSQLBDE; + +interface + +uses + classes, VPDbIntf, dbtables, db, sysutils; + +type + // implements the ISQLDataSet interface for TQuery + TshwBDEDataset = class(TQuery, ISQLDataSet) + protected + // see ISQLDataset.iConnectionParams + fConnectionParams: TStringlist; + // see ISQLDataset.iSQL + procedure SetiSQL(const value: String); virtual; + // see ISQLDataset.iSQL + function GetiSQL:String; virtual; + // see ISQLDataset.iExecSQL + procedure IExecSQL; virtual; + // see ISQLDataset.iConnectionParams + procedure SetiConnectionParams(const value: String); virtual; + // see ISQLDataset.iConnectionParams + function GetiConnectionParams:String; virtual; + public + // constructor + constructor Create(aOwner: TComponent); override; + // destructor + destructor Destroy; override; + end; + +implementation + +constructor TshwBDEDataset.Create(aOwner: TComponent); +begin + inherited; + fConnectionParams:=TStringlist.Create; + RequestLive:=true; +end; + +destructor TshwBDEDataset.Destroy; +begin + fConnectionParams.free; + inherited; +end; + +function TshwBDEDataset.GetiConnectionParams: String; +begin + result:=fConnectionParams.Text; +end; + +function TshwBDEDataset.GetiSQL: String; +begin + result:=sql.text; +end; + +procedure TshwBDEDataset.IExecSQL; +begin + ExecSQL; +end; + +procedure TshwBDEDataset.SetiConnectionParams(const value: String); +begin + fConnectionParams.Text:=value; + Close; + DatabaseName:=fConnectionParams.Values['DatabaseName']; +end; + +procedure TshwBDEDataset.SetiSQL(const value: String); +begin + sql.text:=value; +end; + +function CreateBDESQLDataset(InterfaceClass: String): TDataset; +begin + result:=TshwBDEDataset.Create(nil); +end; + +initialization + // IMPORTANT: register it + sSQLDatasetFactory.RegisterInterfaceType('BDE', @CreateBDESQLDataset); +end. diff --git a/components/tvplanit/source/vpsqldialect.pas b/components/tvplanit/source/vpsqldialect.pas new file mode 100644 index 000000000..130954e98 --- /dev/null +++ b/components/tvplanit/source/vpsqldialect.pas @@ -0,0 +1,301 @@ +{*********************************************************} +{* VPSQLDIALECT.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* Hannes Danzl *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{This unit was provided by Hannes Danzl and is used here with permission } + +// implements a base class for abstracting different SQL dialects
+// currently only some basic commands are supported, could be extended in +// future +unit VPSQLDialect; + +interface + +uses + db, VPDbIntf, classes, sysutils; + +type + // the base class for all sql dialects + TVPBaseSQLDialect = class(TComponent) + protected + // see Dataset + fDataset: TDataset; + // see DBEngine + fDBEngine: String; + // see ConnectionParams + fConnectionParams: TStrings; + // see SQL + fSQL: String; + // see TableName + fTableName: String; + // see Session + fSession: TComponent; + // see ConnectionParams + procedure SetConnectionParams(const Value: TStrings); + // see Session + procedure SetSession(const Value: TComponent); + // see SQL + procedure SetSQL(const Value: String); + // see DBEngine + procedure SetDBEngine(const Value: String); virtual; + + // creates the an interface dataset according to the given DBEngine class + // see swhDatabaseIntf.pas for more info + function CreateSQLDataSet(DBEngine: String): TDataset; virtual; + + // should return the SQL string for definition of the given field + // e.g. "Field1 Number" for oracle
+ // override + function SQLGetColumnDef(const aFieldDef: TFieldDef): String; virtual; abstract; + // should return the syntax for the create command
+ // default is: create table %TableName% (%Fields%)
+ // %tablename% will be substituted by according name, %Fields% is a commadelimited + // list of fielddefinitions created by calls to SQLGetColumnDef + // override + function GetCreateSyntax: String; virtual; + // should return the syntax for the select command
+ // default is: select * from %tablename%
+ // %tablename% will be substituted by according name; + // the result set should be read/write so in oracle e.g. use + // select %tableName%.rowid, %tablename%.* from %tablename% + // override + function GetSelectSyntax: String; virtual; + // should return the syntax for the select command
+ // default is: delete from %tablename%
+ // override + function GetDeleteSyntax: String; virtual; + // should return the syntax for checking that a database exists + // returns blank here because it is very engine dependant + // + function GetEnsureDatabaseExistsSyntax: String; virtual; + public + // calls Dataset.Open + procedure Open; virtual; + // calls Dataset.iExecSQL + procedure ExecSQL; virtual; + // calls Dataset.Close + procedure Close; virtual; + // calls GetCreateSyntax and then passes the result to SQL and calls ExecSQL + procedure CreateTable(const aTableName: String; const aFieldDefs: TFieldDefs; const aIndexDefs: TIndexDefs); virtual; + // there is no standard syntax/method for checking. + // requires that the ConnectionParams property has the required params set. + procedure EnsureDatabaseExists; virtual; abstract; + + // constructor + constructor Create(aOwner: TComponent); override; + // destructor + destructor Destroy; override; + + // should return the syntax for the select command
+ // default is: select * from %tablename%
+ // %tablename% will be substituted by according name; + // the result set should be read/write so in oracle e.g. use + // select %tableName%.rowid, %tablename%.* from %tablename% + property SelectSQL: string read GetSelectSyntax; + // should return the syntax for the select command
+ // default is: delete from %tablename%
+ property DeleteSQL: string read GetDeleteSyntax; + // the name of the (main)table we are querying + property TableName: String read fTableName write fTableName; + // the dataset that is used + property Dataset: TDataset read fDataset; + // the database engine to use + property DBEngine: String read fDBEngine write SetDBEngine; + // the sql statement + property SQL: String read fSQL write SetSQL; + // optional connection parameters for the dataset; alternatively use the session + // proprty to pass in an external session + property ConnectionParams: TStrings read fConnectionParams write SetConnectionParams; + // passed through to the Dataset.ISession before it is opened; can be everything + // and it's the responsibility of the dataset implementation to check it + property Session: TComponent read fSession write SetSession; + end; + +// factory that can register and create instances of registered TVPBaseSQLDialect +function sSQLDialectFactory: TDBFactory; + +implementation + +{ TVPBaseSQLDialect } + +procedure TVPBaseSQLDialect.Close; +begin + fDataset.Close; +end; +{=====} + +constructor TVPBaseSQLDialect.Create(aOwner: TComponent); +begin + inherited; + fConnectionParams:=TStringList.Create; +end; +{=====} + +function TVPBaseSQLDialect.CreateSQLDataSet(DBEngine: String): TDataset; +begin + result:=TDataset(sSQLDatasetFactory.CreateInstance(DBEngine)); +end; +{=====} + +procedure TVPBaseSQLDialect.CreateTable(const aTableName: String; + const aFieldDefs: TFieldDefs; const aIndexDefs: TIndexDefs); +var + j: Integer; + Fields: String; + SQL: String; + IDS: ISQLDataSet; +begin + for j := 0 to aFieldDefs.Count-1 do // Iterate + Fields:=Fields+SQLGetColumnDef(aFieldDefs[j])+', '; + + SQL:=GetCreateSyntax; + SQL:=StringReplace(SQL, '%TableName%', aTableName, [rfIgnoreCase]); + SQL:=StringReplace(SQL, '%Fields%', copy(Fields,1,length(Fields)-2), [rfIgnoreCase]); + fDataset.GetInterface(ISQLDataSet, ids); + try + ids.iSQL:=SQL; + ids.IExecSQL; + finally + ids:=nil; + end; +end; +{=====} + +destructor TVPBaseSQLDialect.Destroy; +begin + fConnectionParams.free; + fDataset.Free; + inherited; +end; +{=====} + +procedure TVPBaseSQLDialect.ExecSQL; +var + iDS: ISQLDataSet; +begin + fDataset.GetInterface(ISQLDataSet, iDS); + try + iDS.iExecSQL; + finally + iDS:=nil; + end; +end; +{=====} + +function TVPBaseSQLDialect.GetCreateSyntax: String; +begin + result:='create table %TableName% (%Fields%)'; +end; +{=====} + +function TVPBaseSQLDialect.GetDeleteSyntax: String; +begin + result:='delete from %tablename%'; +end; +{=====} + +function TVPBaseSQLDialect.GetSelectSyntax: String; +begin + result:='select * from %tablename%'; +end; +{=====} + +procedure TVPBaseSQLDialect.Open; +begin + fDataset.Open; +end; +{=====} + +procedure TVPBaseSQLDialect.SetDBEngine(const Value: String); +begin + fDBEngine := Value; + if fDataset<>nil then + FreeAndNil(fDataset); + fDataset:=CreateSQLDataSet(fDBEngine); +end; +{=====} + +var + fSQLDialectFactory: TDBFactory; + +function sSQLDialectFactory: TDBFactory; +begin + if fSQLDialectFactory=nil then + fSQLDialectFactory:=TDBFactory.Create; + result:=fSQLDialectFactory; +end; +{=====} + +procedure TVPBaseSQLDialect.SetConnectionParams(const Value: TStrings); +var + iDS: ISQLDataset; +begin + Close; + fConnectionParams.Assign(Value); + Dataset.GetInterface(ISQLDataset, iDS); + try + iDS.iConnectionParams:=value.Text; + finally + ids:=nil; + end; +end; +{=====} + +procedure TVPBaseSQLDialect.SetSession(const Value: TComponent); +begin + Close; + fSession := Value; +end; +{=====} + +procedure TVPBaseSQLDialect.SetSQL(const Value: String); +var + iDS: ISQLDataSet; +begin + fSQL := Value; + fDataset.Close; + fDataset.GetInterface(ISQLDataSet, iDS); + try + iDS.iSQL:=fSQL; + finally + iDS:=nil; + end; +end; +{=====} + +function TVPBaseSQLDialect.GetEnsureDatabaseExistsSyntax: String; +begin + Result := ''; +end; +{=====} + +initialization + fSQLDialectFactory:=nil; + +end. + diff --git a/components/tvplanit/source/vpsqlds.pas b/components/tvplanit/source/vpsqlds.pas new file mode 100644 index 000000000..5292470f0 --- /dev/null +++ b/components/tvplanit/source/vpsqlds.pas @@ -0,0 +1,445 @@ +{*********************************************************} +{* VPSQLDS.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* Hannes Danzl *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{This unit was provided by Hannes Danzl and is used here with permission } + + +// implements a Visual PlanIt datastore for SQL databases. uses interfaced +// tdataset descendants to create datasets of different dbengines and +// descendants of TBaseSQLDialect for being as independent from the sql +// dialect as possible +unit VPSQLDS; + +interface + +uses + classes, VPSQLDialect, db, sysutils, vpDBDs, VPDbIntf, dialogs, + vpConst, vpBase, vpData, vpBaseDS, vpException; + +type + + // the datastore class; for easier extension and flexibilitiy, the datastore + // handles every VPI table as an internal store; these stores are created + // in the CreateStores method and linked into the fStores Stringlist. The + // objects are TBaseSQLDialect descendants. Access from an app to this stores + // is over the Stores property + TVPSQLDataStore = class(TVpCustomDBDataStore) + protected + // internal list of stores and the according objects; + // for every "dataset" an internal store of type TBaseSQLDialect is + // created, it's DBEngine is assigned the correct value + fStores: TStringlist; + // see ConnectionParams + fConnectionParams: TStrings; + // see Session + fSession: TComponent; + // see SQLDialect + fSQLDialect: String; + // see DBEngine + fDBEngine: String; + // see Stores + function GetStore(StoreName: String): TVpBaseSQLDialect; + // see ConnectionParams + procedure SetConnectionParams(const Value: TStrings); virtual; + // see Session + procedure SetSession(const Value: TComponent); virtual; + // see SQLDialect + procedure SetSQLDialect(const Value: String); virtual; + // see DBEngine + procedure SetDBEngine(const Value: String); virtual; + // creates one store (internal use) + function CreateStore(DBEngine: String): TVpBaseSQLDialect; virtual; + // (should) create all stores + procedure CreateStores; virtual; + // frees all stores + procedure FreeStores; virtual; + // calls the TVpBaseSQLDialect.CreateTable method for the correct store + procedure CreateTable(aTableName: String); virtual; + // sets ConnectionParams and Session for all stores; typically called before + // Connected is set to true + procedure SetSessionAndParams; virtual; + + // returns the Dataset of the Resource store + function GetResourceTable : TDataset; override; + // returns the Dataset of the Events store + function GetEventsTable : TDataset; override; + // returns the Dataset of the Contacts store + function GetContactsTable : TDataset; override; + // returns the Dataset of the Tasks store + function GetTasksTable : TDataset; override; + + // handles AutoConnect and AutoCreate properties + procedure Loaded; override; + // connects the datastore to the database + procedure SetConnected(const Value: boolean);override; + public + // constructor + constructor Create(aOwner:TComponent); override; + // destructor + destructor Destroy; override; + + // returns the next id for a store by doing an equivalent of select max(id) from table + // and increasing the number by one + function GetNextID(TableName: string): Integer; override; + + // post changes to the store + procedure PostResources; override; + // post changes to the store + procedure PostEvents; override; + // post changes to the store + procedure PostContacts; override; + // post changes to the store + procedure PostTasks; override; + + // purge the given resource + procedure PurgeResource(Res: TVpResource); override; + // purge all items of the store belonging to the given resource + procedure PurgeContacts(Res: TVpResource); override; + // purge all items of the store belonging to the given resource + procedure PurgeEvents(Res: TVpResource); override; + // purge all items of the store belonging to the given resource + procedure PurgeTasks(Res: TVpResource); override; + + // returns the named store + property Stores[StoreName: String]: TVpBaseSQLDialect read GetStore; + published + // DBEninge to use; see swhDatabaseIntf.pas for more info + property DBEngine: String read fDBEngine write SetDBEngine; + // SQL Dialect to use; see swhSQLDialect.pas for more info + property SQLDialect: String read fSQLDialect write SetSQLDialect; + // optional connection parameters for creating the dataset or alternatively + // use the Session property + property ConnectionParams: TStrings read fConnectionParams write SetConnectionParams; + // an untyped session that is passed through to the ISQLDataset; it's the + // responsisbility of the dataset to handle it + property Session: TComponent read fSession write SetSession; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('Visual PlanIt', [TVPSQLDataStore]); +end; + +{ TVPSQLDataStore } + +procedure TVPSQLDataStore.CreateTable(aTableName: String); +var + aDs: TDataset; + aTable: TVpBaseSQLDialect; + fDefs: TFieldDefs; +begin + aDs:=TDataset.Create(nil); + fDefs:=TFieldDefs.Create(ads); + try + CreateFieldDefs(aTableName, fDefs); + assert(FDefs.Count>0); + aTable:=Stores[aTableName]; + if aTable<>nil then + aTable.CreateTable(aTableName, FDefs, nil); + finally + fDefs.Free; + aDs.free; + end; +end; + +function TVPSQLDataStore.GetStore(StoreName: String): TVpBaseSQLDialect; +begin + result := nil; + if fStores.IndexOf(StoreName) > -1 then + result := TVpBaseSQLDialect(fStores.Objects[fStores.IndexOf(StoreName)]); +end; + +function TVPSQLDataStore.CreateStore(DBEngine: String): TVpBaseSQLDialect; +begin + result:=TVpBaseSQLDialect(sSQLDialectFactory.CreateInstance(SQLDialect)); + Result.DBEngine:=DBEngine; +end; + +procedure TVPSQLDataStore.SetDBEngine(const Value: String); +begin + fDBEngine := Value; +end; + +procedure TVPSQLDataStore.CreateStores; +var + aStore: TVpBaseSQLDialect; +begin + aStore := CreateStore(fDbEngine); + fStores.AddObject(ResourceTableName, aStore); + + aStore := CreateStore(fDbEngine); + fStores.AddObject(EventsTableName, aStore); + + aStore := CreateStore(fDbEngine); + fStores.AddObject(ContactsTableName, aStore); + + aStore := CreateStore(fDbEngine); + fStores.AddObject(TasksTableName, aStore); + + aStore := CreateStore(fDbEngine); +// CreateFieldDefs('_Temp', aStore.Fields); + fStores.AddObject('_Temp', aStore); +end; + +constructor TVPSQLDataStore.Create(aOwner: TComponent); +begin + inherited; + fStores := TStringlist.Create; + fConnectionParams := TStringlist.Create; +end; + +destructor TVPSQLDataStore.Destroy; +begin + FreeStores; + fStores.free; + fConnectionParams.free; + inherited; +end; + +procedure TVPSQLDataStore.FreeStores; +begin + while fStores.Count > 0 do // Iterate + begin + if fStores.Objects[0] <> nil then + fStores.Objects[0].free; + fStores.Delete(0); + end; +end; + +procedure TVPSQLDataStore.SetConnectionParams(const Value: TStrings); +begin + fConnectionParams.Assign(Value); + SetSessionAndParams; +end; + +procedure TVPSQLDataStore.SetSessionAndParams; +var + j: Integer; +begin + for j:=0 to fStores.Count-1 do + begin + TVpBaseSQLDialect(fStores.Objects[j]).Session:=fSession; + TVpBaseSQLDialect(fStores.Objects[j]).ConnectionParams:=fConnectionParams; + end; +end; + +procedure TVPSQLDataStore.SetSession(const Value: TComponent); +begin + fSession := Value; + SetSessionAndParams; +end; + +procedure TVPSQLDataStore.SetSQLDialect(const Value: String); +begin + fSQLDialect := Value; +end; + +procedure TVPSQLDataStore.SetConnected(const Value: boolean); +var + j: Integer; + aStore: TVpBaseSQLDialect; +begin + { Don't connect at designtime } + if csDesigning in ComponentState then Exit; + + { Don't try to connect until we're all loaded up } + if csLoading in ComponentState then Exit; + + FreeStores; + CreateStores; + SetSessionAndParams; + + try + for j := 0 to fStores.Count-1 do // Iterate + begin + if (fStores[j]<>'') and (fStores[j][1]<>'_') then + try + aStore:=Stores[fStores[j]]; + aStore.Close; + aStore.SQL:=StringReplace(aStore.SelectSQL, '%TableName%', fStores[j], [rfIgnoreCase]); + aStore.Open; + except + if AutoCreate then + begin + TVpBaseSQLDialect(fStores.Objects[j]).EnsureDatabaseExists; + CreateTable(fStores[j]); + aStore.SQL:=StringReplace(aStore.SelectSQL, '%TableName%', fStores[j], [rfIgnoreCase]); + aStore.Open; + end; + end; + end; // for + inherited; + Load; + except + on e: exception do + showmessage(e.message); + end; +end; + +procedure TVPSQLDataStore.Loaded; +begin + inherited; + if not (csDesigning in ComponentState) then + Connected := AutoConnect; +end; + +function TVPSQLDataStore.GetContactsTable: TDataset; +begin + result:=Stores[ContactsTableName].Dataset; +end; + +function TVPSQLDataStore.GetEventsTable: TDataset; +begin + result:=Stores[EventsTableName].Dataset; +end; + +function TVPSQLDataStore.GetResourceTable: TDataset; +begin + result:=Stores[ResourceTableName].Dataset; +end; + +function TVPSQLDataStore.GetTasksTable: TDataset; +begin + result:=Stores[TasksTableName].Dataset; +end; + +function TVPSQLDataStore.GetNextID(TableName: string): Integer; +var + FldName : string; +begin + try + if TableName = ResourceTableName then + FldName := 'ResourceID' + else + FldName := 'RecordID'; + + Stores['_Temp'].Close; + Stores['_Temp'].SQL := 'Select Max(' + FldName + ') as LastID from ' + TableName; + + Stores['_Temp'].Open; + result := Stores['_Temp'].Dataset.FieldByName('LastID').AsInteger + 1; + + if result < 0 then + result := 0; + + finally + Stores['_Temp'].Close; + end; +end; + +{=====} + +procedure TVPSQLDataStore.PostResources; +var + TableName: String; +begin + TableName:=ResourceTableName; + Stores[TableName].SQL := StringReplace( + Stores[TableName].SelectSQL, '%TableName%', TableName, [rfIgnoreCase]); + Stores[TableName].Open; + inherited; +end; +{=====} + +procedure TVPSQLDataStore.PostEvents; +var + TableName: String; +begin + TableName:=EventsTableName; + Stores[TableName].SQL := StringReplace( + Stores[TableName].SelectSQL, '%TableName%', TableName, [rfIgnoreCase]); + Stores[TableName].Open; + inherited; +end; +{=====} + +procedure TVPSQLDataStore.PostContacts; +var + TableName: String; +begin + TableName:=ContactsTableName; + Stores[TableName].SQL := StringReplace( + Stores[TableName].SelectSQL, '%TableName%', TableName, [rfIgnoreCase]); + Stores[TableName].Open; + inherited; +end; +{=====} + +procedure TVPSQLDataStore.PostTasks; +var + TableName: String; +begin + TableName:=TasksTableName; + Stores[TableName].SQL := StringReplace( + Stores[TableName].SelectSQL, '%TableName%', TableName, [rfIgnoreCase]); + Stores[TableName].Open; + inherited; +end; +{=====} + +procedure TVPSQLDataStore.PurgeResource(Res: TVpResource); +begin + Res.Deleted := true; + PostResources; + Load; +end; +{=====} + +procedure TVPSQLDataStore.PurgeEvents(Res: TVpResource); +begin + Stores[EventsTableName].sql := 'delete from ' + EventsTableName + + ' where ResourceID = ' + IntToStr(Res.ResourceID); + Stores[EventsTableName].ExecSQL; + Res.Schedule.ClearEvents; +end; +{=====} + +procedure TVPSQLDataStore.PurgeContacts(Res: TVpResource); +begin + Stores[ContactsTableName].sql := 'delete from ' + ContactsTableName + + ' where ResourceID = ' + IntToStr(Res.ResourceID); + Stores[ContactsTableName].ExecSQL; + Res.Contacts.ClearContacts; +end; +{=====} + +procedure TVPSQLDataStore.PurgeTasks(Res: TVpResource); +begin + Stores[TasksTableName].sql := 'delete from ' + TasksTableName + + ' where ResourceID = ' + IntToStr(Res.ResourceID); + Stores[TasksTableName].ExecSQL; + Res.Tasks.ClearTasks; +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpsqlparadoxdialect.pas b/components/tvplanit/source/vpsqlparadoxdialect.pas new file mode 100644 index 000000000..7cf2dde45 --- /dev/null +++ b/components/tvplanit/source/vpsqlparadoxdialect.pas @@ -0,0 +1,95 @@ +{*********************************************************} +{* VPSQLPARADOXDIALECT.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* Hannes Danzl *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{This unit was provided by Hannes Danzl and is used here with permission } + + +// a sql dialect class for paradox +unit VPSQLParadoxDialect; + +interface + +uses + VPSQLDialect, VPDbIntf, dbtables, db, sysutils; + +type + // a sql dialect class for paradox + TVPParadoxSQLDialect = class(TBaseSQLDialect) + protected + // override to use 'create table "%TableName%" (%Fields%)' since paradox + // can have the fileextension in the tablename + function GetCreateSyntax: String; override; + // return the right strings + function SQLGetColumnDef(const aFieldDef: TFieldDef): String; override; + // override to avoid abstract error + procedure EnsureDatabaseExists; virtual; + end; + +implementation + +procedure TVPParadoxSQLDialect.EnsureDatabaseExists; +begin + // do nothing +end; + +function TVPParadoxSQLDialect.GetCreateSyntax: String; +begin + result:='create table "%TableName%" (%Fields%)'; +end; + +function TVPParadoxSQLDialect.SQLGetColumnDef( + const aFieldDef: TFieldDef): String; +var + aTypeName: String; +begin + case aFieldDef.DataType of + ftInteger: aTypeName:='INTEGER'; + ftFloat: aTypeName:='NUMERIC'; + ftString: + if aFieldDef.Size<256 then + aTypeName:='VARCHAR('+inttostr(aFieldDef.Size)+')' + else + aTypeName:='BLOB(1,1)'; + ftBoolean: aTypeName:='BOOLEAN'; + ftDate: aTypeName:='DATE'; + ftTime: aTypeName:='TIME'; + ftDateTime: aTypeName:='TIMESTAMP'; + end; // case + result:=aFieldDef.Name+' '+aTypeName; +end; + +function CreateParadoxDialect(InterfaceClass: String): TObject; +begin + result:=TVPParadoxSQLDialect.Create(nil); +end; + +initialization + // IMPORTANT: register it + sSQLDialectFactory.RegisterInterfaceType('Paradox', @CreateParadoxDialect); +end. diff --git a/components/tvplanit/source/vpsr.inc b/components/tvplanit/source/vpsr.inc new file mode 100644 index 000000000..e813ae63e --- /dev/null +++ b/components/tvplanit/source/vpsr.inc @@ -0,0 +1,417 @@ +{*********************************************************} +{* VPSR.INC 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (c) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{Visual PlanIt String Resources - To create language specific versions of + Visual PlanIt controls, translate these strings to the desired language + and re-compile your application.} + +resourcestring + RSNoneStr = '(None)'; + RSYes = 'Y'; + RSNo = 'N'; + RSTrue = 'T'; + RSFalse = 'F'; + RSTallShortChars = 'Wy'; + RSDelete = 'Delete'; + RSNotDoneYet = 'This feature is not implemented at this time.'; + RSNoTimersAvail = 'No Window''s timers are available.'; + RSBadTriggerHandle = 'Invalid trigger handle.'; + RSEditingItems = 'Folder Items Editor.'; + RSEditingFolders = 'Folder Editor.'; + RSExclusiveEventConflict = 'Conflicts with another exclusive event.'; + RSBackwardTimesError = 'The end time cannot precede the start time.'; + RSDBPostError = 'Error posting data to the database.'; + RSMonthConvertError = 'Error converting the month number.'; + RSInvalidDay = 'Error: Invalid Day.'; + RSInvalidDate = 'Error: Invalid Date.'; + RSInvalidMonth = 'Error: Invalid Month.'; + RSInvalidMonthName = 'Error: Invalid Month Name.'; + RSInvalidYear = 'Error: Invalid Year.'; + RSDayIsRequired = 'Error: Day is required.'; + RSMonthIsRequired = 'Error: Month Is Required.'; + RSYearIsRequired = 'Error: Year is required.'; + RSNameIsRequired = 'Error: Name cannot be empty.'; + RSFailToCreateTask = 'Error: Failure while creating Task.'; + RSFailToCreateEvent = 'Error: Failure while creating Event.'; + RSFailToCreateContact = 'Error: Failure while creating Contact.'; + RSFailToCreateResource = 'Error: Failure while creating Resource.'; + RSDuplicateResource = 'Error: Duplicate Resource.'; + RSInvalidTableSpecified = 'Error: Invalid table specified.'; + RSUnableToOpen = 'Error: Unable to open '; + RSSQLUpdateError = 'Error: Unable to update '; {!!.01} + + RSPhoneTypeLabel1 = 'Assistant'; + RSPhoneTypeLabel2 = 'Callback'; + RSPhoneTypeLabel3 = 'Car'; + RSPhoneTypeLabel4 = 'Company'; + RSPhoneTypeLabel5 = 'Home'; + RSPhoneTypeLabel6 = 'Home Fax'; + RSPhoneTypeLabel7 = 'ISDN'; + RSPhoneTypeLabel8 = 'Mobile'; + RSPhoneTypeLabel9 = 'Other'; + RSPhoneTypeLabel10 = 'Other Fax'; + RSPhoneTypeLabel11 = 'Pager'; + RSPhoneTypeLabel12 = 'Primary'; + RSPhoneTypeLabel13 = 'Radio'; + RSPhoneTypeLabel14 = 'Telex'; + RSPhoneTypeLabel15 = 'TTY/TDD'; + RSPhoneTypeLabel16 = 'Work'; + RSPhoneTypeLabel17 = 'Work Fax'; + + RSCategoryLabel1 = 'Business'; + RSCategoryLabel2 = 'Clients'; + RSCategoryLabel3 = 'Family'; + RSCategoryLabel4 = 'Personal'; + RSCategoryLabel5 = 'Other'; + + RSWeekOf = 'Week of'; + RSThrough = 'Through'; + RSSunday = 'Sunday'; + RSMonday = 'Monday'; + RSTuesday = 'Tuesday'; + RSWednesday = 'Wednesday'; + RSThursday = 'Thursday'; + RSFriday = 'Friday'; + RSSaturday = 'Saturday'; + RSASunday = 'Sun'; + RSAMonday = 'Mon'; + RSATuesday = 'Tue'; + RSAWednesday = 'Wed'; + RSAThursday = 'Thu'; + RSAFriday = 'Fri'; + RSASaturday = 'Sat'; + RSLSunday = 'S'; + RSLMonday = 'M'; + RSLTuesday = 'T'; + RSLWednesday = 'W'; + RSLThursday = 'T'; + RSLFriday = 'F'; + RSLSaturday = 'S'; + RSNone = 'None'; + RSDaily = 'Daily'; + RSWeekly = 'Weekly'; + RSMonthlyByDay = 'Monthly By Day'; + RSMonthlyByDate = 'Monthly By Date'; + RSYearlyByDay = 'Yearly By Day'; + RSYearlyByDate = 'Yearly By Date'; + RSCustom = 'Custom'; + RSMinutes = 'Minutes'; + RSHours = 'Hours'; + RSDays = 'Days'; + + {WARNINGS} + RSPermanent = 'This operation cannot be undone!'; + + {Contact Specific} + RSFromContactList = 'from your list of contacts?'; + RSContactPopupAdd = 'Add Contact...'; + RSContactPopupEdit = 'Edit Contact...'; + RSContactPopupDelete = 'Delete Contact...'; + + {Event Specific} + RSFromSchedule = 'from your schedule?'; + + {Task Specific} + RSFromTaskList = 'from your task list?'; + RSTaskPopupAdd = 'Add Task...'; + RSTaskPopupEdit = 'Edit Task...'; + RSTaskPopupDelete = 'Delete Task...'; + RSTaskTitleResource = 'Task List - '; {!!.01} + RSTaskTitleNoResource = 'Task List'; {!!.01} + + {Month Specific} + RSMonthPopupToday = 'Today'; + RSMonthPopupNextMonth = 'Next Month'; + RSMonthPopupPrevMonth = 'Previous Month'; + RSMonthPopupNextYear = 'Next Year'; + RSMonthPopupPrevYear = 'Previous Year'; + + {Week Specific} + RSWeekPopupAdd = 'Add Event...'; + RSWeekPopupEdit = 'Edit Event...'; + RSWeekPopupDelete = '&Delete Event...'; + RSWeekPopupNav = 'Change Date'; + RSWeekPopupNavToday = 'Today'; + RSWeekPopupNavNextWeek = 'Next Week'; + RSWeekPopupNavPrevWeek = 'Previous Week'; + RSWeekPopupNavNextMonth = 'Next Month'; + RSWeekPopupNavPrevMonth = 'Previous Month'; + RSWeekPopupNavNextYear = 'Next Year'; + RSWeekPopupNavPrevYear = 'Previous Year'; + + { Print Preview Specific } + RSPrintPrvPrevPage = 'Previous Page'; + RSPrintPrvNextPage = 'Next Page'; + RSPrintPrvFirstPage = 'First Page'; + RSPrintPrvLastPage = 'Last Page'; + + { DayView Specific } + RSDayPopupAdd = 'Add Event...'; + RSDayPopupEdit = 'Edit Event...'; + RSDayPopupDelete = 'Delete Event...'; + RSDayPopupNav = 'Change Date'; + RSDayPopupNavToday = 'Today'; + RSDayPopupNavTomorrow = 'Tomorrow'; + RSDayPopupNavYesterday = 'Yesterday'; + RSDayPopupNavNextDay = 'Next Day'; + RSDayPopupNavPrevDay = 'Previous Day'; + RSDayPopupNavNextWeek = 'Next Week'; + RSDayPopupNavPrevWeek = 'Previous Week'; + RSDayPopupNavNextMonth = 'Next Month'; + RSDayPopupNavPrevMonth = 'Previous Month'; + RSDayPopupNavNextYear = 'Next Year'; + RSDayPopupNavPrevYear = 'Previous Year'; + RSHintToday = 'Today'; {!!.01} + RSHintTomorrow = 'Tomorrow'; {!!.01} + RSHintYesterday = 'Yesterday'; {!!.01} + RSHintNextWeek = 'Next Week'; {!!.01} + RSHintPrevWeek = 'Previous Week'; {!!.01} + + { field names } + RSPosition = 'Position'; + RSCompany = 'Company'; + RSTitle = 'Title'; + RSEMail = 'E-Mail'; + RSCountry = 'Country'; + RSCategory = 'Category'; + RSNotes = 'Notes'; + + RSCustom1 = 'Custom 1'; + RSCustom2 = 'Custom 2'; + RSCustom3 = 'Custom 3'; + RSCustom4 = 'Custom 4'; + + { Generic Dialog Captions } + RSOKBtn = 'OK'; + RSCancelBtn = 'Cancel'; + RSCloseBtn = '&Close'; + RSPrintBtn = '&Print'; + RSUntitled = 'Untitled'; + + {Sound Selection Dialog} + RSSelectASound = 'Select A Sound'; + RSSoundFinder = 'Sound Finder'; + RSDefaultSound = 'Use the default sound'; + + { Event Edit Dialog Captions } + RSDlgEventEdit = 'Event'; + RSAppointmentGroupBox = 'Appointment'; + RSDescriptionLbl = 'Subject:'; + RSCategoryLbl = 'Category:'; + RSStartTimeLbl = 'Start Time:'; + RSEndTimeLbl = 'End Time:'; + RSAlarmSet = '&Reminder'; + RSRecurringLbl = 'Appointment Recurrence:'; + RSIntervalLbl = 'Interval (days):'; + RSRecurrenceEndsLbl = 'Repeat Until:'; + RSAllDayEvent = '&All Day Event'; + RSNotesLbl = 'Notes:'; + + { Contact Edit Dialog Captions } + RSDlgContactEdit = 'Contact'; + RSNameLbl = 'Name:'; + RSTitleLbl = 'Title:'; + RSAddressLbl = 'Address:'; + RSCityLbl = 'City:'; + RSStateLbl = 'State:'; + RSCountryLbl = 'Country:'; + RSZipCodeLbl = 'Zip Code:'; + RSCompanyLbl = 'Company:'; + RSPositionLbl = 'Position:'; + + { Print Preview dialog captions } + RSDlgPrintPreview = 'Print Preview'; + + { Task Edit Dialog Captions } + RSDlgTaskEdit = 'Task'; + RSDueDate = 'Due Date:'; + RSDetails = 'Details:'; + RSComplete = 'Task complete'; + RSDaysOverdue = ' Days overdue'; + RSCreatedOn = 'Created on'; + RSCompletedOn = 'Completed on'; + + { Reminder Dialog Captions} + RSReminder = 'Reminder'; + RSOverdue = 'OVERDUE!'; + RSSnoozeCaption = 'Click &Snooze to be reminded again in:'; + RSSubjectCaption = 'Subject:'; + RSNotesCaption = 'Notes:'; + RSDismissBtn = '&Dismiss'; + RSSnoozeBtn = '&Snooze'; + RSOpenItemBtn = '&Open Item'; + RS5Minutes = '5 Minutes'; + RS10Minutes = '10 Minutes'; + RS15Minutes = '15 Minutes'; + RS30Minutes = '30 Minutes'; + RS45Minutes = '45 Minutes'; + RS1Hour = '1 Hour'; + RS2Hours = '2 Hours'; + RS3Hours = '3 Hours'; + RS4Hours = '4 Hours'; + RS5Hours = '5 Hours'; + RS6Hours = '6 Hours'; + RS7Hours = '7 Hours'; + RS8Hours = '8 Hours'; + RS1Days = '1 Day'; + RS2Days = '2 Days'; + RS3Days = '3 Days'; + RS4Days = '4 Days'; + RS5Days = '5 Days'; + RS6Days = '6 Days'; + RS1Week = '1 Week'; + + { Calendar } + RSCalendarPrevMonth = 'Previous Month'; + RSCalendarNextMonth = 'Next Month'; + RSCalendarPrevYear = 'Previous Year'; + RSCalendarNextYear = 'Next Year'; + RSCalendarToday = 'Today'; + RSCalendarRevert = 'Revert'; + + RSCalendarPopupToday = 'Today'; + RSCalendarPopupNextMonth = 'Next Month'; + RSCalendarPopupPrevMonth = 'Previous Month'; + RSCalendarPopupNextYear = 'Next Year'; + RSCalendarPopupPrevYear = 'Previous Year'; + RSCalendarPopupRevert = 'Revert'; + + { XML } + sIENotInstalled = 'Cannot open WININET, Microsoft IE required'; + sOpenFileFailed = 'Unable to open file '; + sFileNotFound = 'File %s could not be found'; + sAllocSrcMemFailed = 'Unable to allocate memory for XML source'; + sHttpReadReqFailed = 'Http read request failed'; + sHttpDataNotAvail = 'Http data not available'; + sHttpReqSendFailed = 'Unable to send http request'; + sHttpReqOpenFailed = 'Unable to open http request'; + sInetConnectFailed = 'Unable to make Internet connection'; + sInetOpenFailed = 'Unable to open Internet'; + sInvalidFtpLoc = 'Invalid ftp location'; + sInvalidFtpDir = 'Invalid ftp directory'; + sFtpReadReqFailed = 'Ftp read request failed'; + sFtpDataNotAvail = 'Ftp data not available'; + sFtpOpenFileFailed = 'Unable to open ftp file'; + sFtpPutFileFailed = 'Could not save file via ftp to %s'; + sSrcLoadFailed = 'Unable to load source '; + sInvalidMemPtr = 'Invalid memory Pointer'; + sFmtErrorMsg = 'Line: %d Col: %d Error: %s'; + sIndexOutOfBounds = 'ERROR INDEX OUT OF BOUNDS'; + sExpMarkupDecl = 'Expected markup declaration, but found: '; + sIllAttrType = 'Illegal attribute type: '; + sIllAttrDefKeyw = 'Illegal keyword for attribute default value: '; + sSysIdMissing = 'System identifier missing '; + sExtModifMissing = 'External modifier missing: '; + sIllCondSectStart = 'Conditional section must begin with INCLUDE or IGNORE'; + sBadSepInModel = 'Bad separator in content model: '; + sExpCommentOrCDATA = 'Expected comment or CDATA section '; + sUnexpectedEof = 'Unexpected end of file '; + sMismatchEndTag = 'Mismatched end tag: '; + sIllCharInRef = 'Illegal character in reference'; + sUndeclaredEntity = 'Reference to undeclared entity: '; + sExpectedString = 'Expected String: '; + sSpaceExpectedAt = 'Whitespace expected at byte '; + sUnexpEndOfInput = 'End of input while looking for delimiter: '; + sQuoteExpected = 'Expected " or ' + Chr (39); + sInvalidXMLVersion = 'XMLPartner does not support XML specification greater than %s'; + sUnableCreateStr = 'Unable to create stream for input.'; + sInvalidName = 'Invalid XML name: '; + sInvalidCommentText= 'Invalid comment text'; + sCommentBeforeXMLDecl = 'Document cannot start with a comment if it also contains an XML declaration'; + sInvalidCDataSection = 'Invalid characters in CDATA section'; + sRedefinedAttr = 'Attributes cannot be redefined in a start tag'; + sCircularEntRef = 'Circular reference to: '; + sInvAttrChar = 'Invalid character in attribute value: '; + sInvPCData = 'Invalid characters in element''s character data: '; + sDataAfterValDoc = 'There is invalid data after valid XML document'; + sNoIntConditional = 'Conditional sections not allowed in internal subset of document type declaration'; + sNotationNotDeclared = 'Notation not declared: '; + sInvPubIDChar = 'Invalid PublicID character: '; + sNoNDATAInPeDecl = 'NDATA not allowed in parameter entity declaration'; + sInvStandAloneVal = 'Standalone value must equal ''yes'' or ''no'''; + sInvEncName = 'Invalid encoding declaration: '; + sInvVerNum = 'Invalid XML version number: '; + sInvEntityValue = 'Invalid character in entity value: '; + sNoCommentInMarkup = 'Comments can not be placed within other markup'; + sNoPEInIntDTD = 'Parameter entities not allowed in DTD internal subset'; + sXMLDecNotAtBeg = 'The XML declaration must appear before the first element'; + sInvalidElementName = 'Invalid element name: '; + sBadParamEntNesting = 'Parameter-entity text must be properly nested: '; + sInvalidCharEncoding = 'Invalid character encoding specified.'; + sAttrNotNum = 'Attribute %s of element %s does not have an integer value.'; + sUnknownAxis = 'Unknown axis specifier: %s'; + + {xpchrstm related errors} + sInvalidXMLChar = 'Invalid XML Character found'; + sInvalidBEChar = 'Invalid (big-endian) UTF-16 character encoding'; + sInvalidLEChar = 'Invalid (little-endian) UTF-16 character encoding'; + sBadUTF8Char = 'Badly formed UTF-8 character in stream'; + sErrEndOfDocument = 'Unexpected end of document stream'; + sUCS_ISOConvertErr = 'Cannot convert UCS-4 character to ISO-8859-1'; + sUCS_U16ConvertErr = 'Cannot convert UCS-4 character to UTF-16'; + sUCS_U8ConverErr = 'Cannot convert UCS-4 character to UTF-8'; + + { Misc Exceptions and Errors } + + RSOutOfRange = 'Out of range'; + RSNotSupported = 'not supported'; + RSNeedElementName = 'Please supply an Element Name'; + RSNeedFormatName = 'FormatName cannot be blank'; + RSPrtControlOwner = 'Print controller is not owned by a TVpControlLink!'; + RSBadPrintFormat = 'Invalid print format '; + RSBadItemType = 'Invalid item type '; + RSBadMeasurement = 'Invalid measurement'; + RSOwnerNotWinCtrl = 'Owner must be a TWinControl descendent'; + RSNoControlLink = 'Component must be linked to a TVpControlLink'; + RSNoPrintFormats = 'No print formats have been defined'; {!!.01} + RSNoCanvas = 'TCanvas not assigned'; {!!.01} + RSNoLocalizationFile = 'Localization file not found.'; {!!.02} + + { Misc strings } + + RSCategoryDesc0 = 'Category 0'; {!!.01} + RSCategoryDesc1 = 'Category 1'; {!!.01} + RSCategoryDesc2 = 'Category 2'; {!!.01} + RSCategoryDesc3 = 'Category 3'; {!!.01} + RSCategoryDesc4 = 'Category 4'; {!!.01} + RSCategoryDesc5 = 'Category 5'; {!!.01} + RSCategoryDesc6 = 'Category 6'; {!!.01} + RSCategoryDesc7 = 'Category 7'; {!!.01} + RSCategoryDesc8 = 'Category 8'; {!!.01} + RSCategoryDesc9 = 'Category 9'; {!!.01} + + { Print Format Editor } + + RSEditPrintFormat = 'Edit Print Formats...'; + + { Automatic resource adding/selection} {!!.01} + + RSAddNewResource = 'No resources have been defined. Would you ' + {!!.01} + 'like to add one now?'; {!!.01} + RSSelectResource = 'No resource has been selected. Would you ' + {!!.01} + 'like to select one now?'; diff --git a/components/tvplanit/source/vpsr.pas b/components/tvplanit/source/vpsr.pas new file mode 100644 index 000000000..26cfaa59c --- /dev/null +++ b/components/tvplanit/source/vpsr.pas @@ -0,0 +1,92 @@ +{*********************************************************} +{* VPSR.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{Visual PlanIt String Resources - To create language specific versions of + Visual PlanIt controls, translate the strings in VpSR.INC to the desired + language and re-compile your application package.} + +unit VpSR; + {- Visual PlanIt String Resources} + +interface + +{$I VpSR.INC} + +type + { For acquiring the labels that go with each telephone field } + { ie. Home, work, fax etc... } + TVpPhoneType = (ptAssistant, ptCallback, ptCar, ptCompany, ptHome, ptHomeFax, + ptISDN, ptMobile, ptOther, ptOtherFax, ptPager, ptPrimary, + ptRadio, ptTelex, ptTTYTDD, ptWork, ptWorkFax); + + TVpCategoryType = (ctBusiness, ctClients, ctFamily, ctOther, ctPersonal); + +function PhoneLabel (PhoneType : TVpPhoneType) : string; + +function CategoryLabel (CategoryType : TVpCategoryType) : string; + +implementation + +function PhoneLabel(PhoneType: TVpPhoneType): string; +begin + Result := ''; + case PhoneType of + ptAssistant : Result := RSPhoneTypeLabel1; + ptCallback : Result := RSPhoneTypeLabel2; + ptCar : Result := RSPhoneTypeLabel3; + ptCompany : Result := RSPhoneTypeLabel4; + ptHome : Result := RSPhoneTypeLabel5; + ptHomeFax : Result := RSPhoneTypeLabel6; + ptISDn : Result := RSPhoneTypeLabel7; + ptMobile : Result := RSPhoneTypeLabel8; + ptOther : Result := RSPhoneTypeLabel9; + ptOtherFax : Result := RSPhoneTypeLabel10; + ptPager : Result := RSPhoneTypeLabel11; + ptPrimary : Result := RSPhoneTypeLabel12; + ptRadio : Result := RSPhoneTypeLabel13; + ptTelex : Result := RSPhoneTypeLabel14; + ptTTYTDD : Result := RSPhoneTypeLabel15; + ptWork : Result := RSPhoneTypeLabel16; + ptWorkFax : Result := RSPhoneTypeLabel17; + end; +end; + +function CategoryLabel (CategoryType : TVpCategoryType) : string; +begin + Result := ''; + case CategoryType of + ctBusiness : Result := RSCategoryLabel1; + ctClients : Result := RSCategoryLabel2; + ctFamily : Result := RSCategoryLabel3; + ctOther : Result := RSCategoryLabel5; + ctPersonal : Result := RSCategoryLabel4; + end; +end; + +end. + diff --git a/components/tvplanit/source/vpsr.rst b/components/tvplanit/source/vpsr.rst new file mode 100644 index 000000000..e43b365d6 --- /dev/null +++ b/components/tvplanit/source/vpsr.rst @@ -0,0 +1,1316 @@ + +# hash value = 47539321 +vpsr.rsnonestr='(None)' + + +# hash value = 89 +vpsr.rsyes='Y' + + +# hash value = 78 +vpsr.rsno='N' + + +# hash value = 84 +vpsr.rstrue='T' + + +# hash value = 70 +vpsr.rsfalse='F' + + +# hash value = 1513 +vpsr.rstallshortchars='Wy' + + +# hash value = 78392485 +vpsr.rsdelete='Delete' + + +# hash value = 101276734 +vpsr.rsnotdoneyet='This feature is not implemented at this time.' + + +# hash value = 161288734 +vpsr.rsnotimersavail='No Window'#39's timers are available.' + + +# hash value = 52384030 +vpsr.rsbadtriggerhandle='Invalid trigger handle.' + + +# hash value = 221393838 +vpsr.rseditingitems='Folder Items Editor.' + + +# hash value = 228226782 +vpsr.rseditingfolders='Folder Editor.' + + +# hash value = 244823822 +vpsr.rsexclusiveeventconflict='Conflicts with another exclusive event.' + + +# hash value = 115041950 +vpsr.rsbackwardtimeserror='The end time cannot precede the start time.' + + +# hash value = 114994126 +vpsr.rsdbposterror='Error posting data to the database.' + + +# hash value = 68616942 +vpsr.rsmonthconverterror='Error converting the month number.' + + +# hash value = 119016222 +vpsr.rsinvalidday='Error: Invalid Day.' + + +# hash value = 25210894 +vpsr.rsinvaliddate='Error: Invalid Date.' + + +# hash value = 162004414 +vpsr.rsinvalidmonth='Error: Invalid Month.' + + +# hash value = 200154286 +vpsr.rsinvalidmonthname='Error: Invalid Month Name.' + + +# hash value = 26575422 +vpsr.rsinvalidyear='Error: Invalid Year.' + + +# hash value = 206422654 +vpsr.rsdayisrequired='Error: Day is required.' + + +# hash value = 102296718 +vpsr.rsmonthisrequired='Error: Month Is Required.' + + +# hash value = 120839614 +vpsr.rsyearisrequired='Error: Year is required.' + + +# hash value = 84678670 +vpsr.rsnameisrequired='Error: Name cannot be empty.' + + +# hash value = 153122894 +vpsr.rsfailtocreatetask='Error: Failure while creating Task.' + + +# hash value = 56868094 +vpsr.rsfailtocreateevent='Error: Failure while creating Event.' + + +# hash value = 188999982 +vpsr.rsfailtocreatecontact='Error: Failure while creating Contact.' + + +# hash value = 167095118 +vpsr.rsfailtocreateresource='Error: Failure while creating Resource.' + + +# hash value = 77244078 +vpsr.rsduplicateresource='Error: Duplicate Resource.' + + +# hash value = 210786798 +vpsr.rsinvalidtablespecified='Error: Invalid table specified.' + + +# hash value = 10260608 +vpsr.rsunabletoopen='Error: Unable to open ' + + +# hash value = 109972192 +vpsr.rssqlupdateerror='Error: Unable to update ' + + +# hash value = 168489204 +vpsr.rsphonetypelabel1='Assistant' + + +# hash value = 137528075 +vpsr.rsphonetypelabel2='Callback' + + +# hash value = 18818 +vpsr.rsphonetypelabel3='Car' + + +# hash value = 174352409 +vpsr.rsphonetypelabel4='Company' + + +# hash value = 325173 +vpsr.rsphonetypelabel5='Home' + + +# hash value = 104286328 +vpsr.rsphonetypelabel6='Home Fax' + + +# hash value = 321422 +vpsr.rsphonetypelabel7='ISDN' + + +# hash value = 88444965 +vpsr.rsphonetypelabel8='Mobile' + + +# hash value = 5680834 +vpsr.rsphonetypelabel9='Other' + + +# hash value = 247732776 +vpsr.rsphonetypelabel10='Other Fax' + + +# hash value = 5668290 +vpsr.rsphonetypelabel11='Pager' + + +# hash value = 126892233 +vpsr.rsphonetypelabel12='Primary' + + +# hash value = 5798655 +vpsr.rsphonetypelabel13='Radio' + + +# hash value = 5948104 +vpsr.rsphonetypelabel14='Telex' + + +# hash value = 161237204 +vpsr.rsphonetypelabel15='TTY/TDD' + + +# hash value = 386699 +vpsr.rsphonetypelabel16='Work' + + +# hash value = 109922664 +vpsr.rsphonetypelabel17='Work Fax' + + +# hash value = 211830835 +vpsr.rscategorylabel1='Business' + + +# hash value = 170903027 +vpsr.rscategorylabel2='Clients' + + +# hash value = 80232505 +vpsr.rscategorylabel3='Family' + + +# hash value = 211443996 +vpsr.rscategorylabel4='Personal' + + +# hash value = 5680834 +vpsr.rscategorylabel5='Other' + + +# hash value = 230414086 +vpsr.rsweekof='Week of' + + +# hash value = 184118152 +vpsr.rsthrough='Through' + + +# hash value = 95177353 +vpsr.rssunday='Sunday' + + +# hash value = 88492681 +vpsr.rsmonday='Monday' + + +# hash value = 196909785 +vpsr.rstuesday='Tuesday' + + +# hash value = 189581113 +vpsr.rswednesday='Wednesday' + + +# hash value = 264871721 +vpsr.rsthursday='Thursday' + + +# hash value = 81328777 +vpsr.rsfriday='Friday' + + +# hash value = 146575129 +vpsr.rssaturday='Saturday' + + +# hash value = 23230 +vpsr.rsasunday='Sun' + + +# hash value = 21598 +vpsr.rsamonday='Mon' + + +# hash value = 23477 +vpsr.rsatuesday='Tue' + + +# hash value = 23988 +vpsr.rsawednesday='Wed' + + +# hash value = 23285 +vpsr.rsathursday='Thu' + + +# hash value = 19849 +vpsr.rsafriday='Fri' + + +# hash value = 22916 +vpsr.rsasaturday='Sat' + + +# hash value = 83 +vpsr.rslsunday='S' + + +# hash value = 77 +vpsr.rslmonday='M' + + +# hash value = 84 +vpsr.rsltuesday='T' + + +# hash value = 87 +vpsr.rslwednesday='W' + + +# hash value = 84 +vpsr.rslthursday='T' + + +# hash value = 70 +vpsr.rslfriday='F' + + +# hash value = 83 +vpsr.rslsaturday='S' + + +# hash value = 349765 +vpsr.rsnone='None' + + +# hash value = 4882489 +vpsr.rsdaily='Daily' + + +# hash value = 98288185 +vpsr.rsweekly='Weekly' + + +# hash value = 46251129 +vpsr.rsmonthlybyday='Monthly By Day' + + +# hash value = 203147141 +vpsr.rsmonthlybydate='Monthly By Date' + + +# hash value = 186898793 +vpsr.rsyearlybyday='Yearly By Day' + + +# hash value = 37590549 +vpsr.rsyearlybydate='Yearly By Date' + + +# hash value = 78424925 +vpsr.rscustom='Custom' + + +# hash value = 67488403 +vpsr.rsminutes='Minutes' + + +# hash value = 5205139 +vpsr.rshours='Hours' + + +# hash value = 305411 +vpsr.rsdays='Days' + + +# hash value = 264862193 +vpsr.rspermanent='This operation cannot be undone!' + + +# hash value = 223961631 +vpsr.rsfromcontactlist='from your list of contacts?' + + +# hash value = 2020142 +vpsr.rscontactpopupadd='Add Contact...' + + +# hash value = 169779438 +vpsr.rscontactpopupedit='Edit Contact...' + + +# hash value = 4463006 +vpsr.rscontactpopupdelete='Delete Contact...' + + +# hash value = 99241151 +vpsr.rsfromschedule='from your schedule?' + + +# hash value = 143382623 +vpsr.rsfromtasklist='from your task list?' + + +# hash value = 181307230 +vpsr.rstaskpopupadd='Add Task...' + + +# hash value = 238217054 +vpsr.rstaskpopupedit='Edit Task...' + + +# hash value = 111510782 +vpsr.rstaskpopupdelete='Delete Task...' + + +# hash value = 144900000 +vpsr.rstasktitleresource='Task List - ' + + +# hash value = 164989476 +vpsr.rstasktitlenoresource='Task List' + + +# hash value = 5986953 +vpsr.rsmonthpopuptoday='Today' + + +# hash value = 106375512 +vpsr.rsmonthpopupnextmonth='Next Month' + + +# hash value = 228550168 +vpsr.rsmonthpopupprevmonth='Previous Month' + + +# hash value = 258322242 +vpsr.rsmonthpopupnextyear='Next Year' + + +# hash value = 198781874 +vpsr.rsmonthpopupprevyear='Previous Year' + + +# hash value = 148837838 +vpsr.rsweekpopupadd='Add Event...' + + +# hash value = 118822286 +vpsr.rsweekpopupedit='Edit Event...' + + +# hash value = 244174606 +vpsr.rsweekpopupdelete='&Delete Event...' + + +# hash value = 222118117 +vpsr.rsweekpopupnav='Change Date' + + +# hash value = 5986953 +vpsr.rsweekpopupnavtoday='Today' + + +# hash value = 258314107 +vpsr.rsweekpopupnavnextweek='Next Week' + + +# hash value = 198773643 +vpsr.rsweekpopupnavprevweek='Previous Week' + + +# hash value = 106375512 +vpsr.rsweekpopupnavnextmonth='Next Month' + + +# hash value = 228550168 +vpsr.rsweekpopupnavprevmonth='Previous Month' + + +# hash value = 258322242 +vpsr.rsweekpopupnavnextyear='Next Year' + + +# hash value = 198781874 +vpsr.rsweekpopupnavprevyear='Previous Year' + + +# hash value = 198817765 +vpsr.rsprintprvprevpage='Previous Page' + + +# hash value = 258290453 +vpsr.rsprintprvnextpage='Next Page' + + +# hash value = 174176069 +vpsr.rsprintprvfirstpage='First Page' + + +# hash value = 174404949 +vpsr.rsprintprvlastpage='Last Page' + + +# hash value = 148837838 +vpsr.rsdaypopupadd='Add Event...' + + +# hash value = 118822286 +vpsr.rsdaypopupedit='Edit Event...' + + +# hash value = 244281102 +vpsr.rsdaypopupdelete='Delete Event...' + + +# hash value = 222118117 +vpsr.rsdaypopupnav='Change Date' + + +# hash value = 5986953 +vpsr.rsdaypopupnavtoday='Today' + + +# hash value = 105291479 +vpsr.rsdaypopupnavtomorrow='Tomorrow' + + +# hash value = 179098953 +vpsr.rsdaypopupnavyesterday='Yesterday' + + +# hash value = 217468873 +vpsr.rsdaypopupnavnextday='Next Day' + + +# hash value = 62752649 +vpsr.rsdaypopupnavprevday='Previous Day' + + +# hash value = 258314107 +vpsr.rsdaypopupnavnextweek='Next Week' + + +# hash value = 198773643 +vpsr.rsdaypopupnavprevweek='Previous Week' + + +# hash value = 106375512 +vpsr.rsdaypopupnavnextmonth='Next Month' + + +# hash value = 228550168 +vpsr.rsdaypopupnavprevmonth='Previous Month' + + +# hash value = 258322242 +vpsr.rsdaypopupnavnextyear='Next Year' + + +# hash value = 198781874 +vpsr.rsdaypopupnavprevyear='Previous Year' + + +# hash value = 5986953 +vpsr.rshinttoday='Today' + + +# hash value = 105291479 +vpsr.rshinttomorrow='Tomorrow' + + +# hash value = 179098953 +vpsr.rshintyesterday='Yesterday' + + +# hash value = 258314107 +vpsr.rshintnextweek='Next Week' + + +# hash value = 198773643 +vpsr.rshintprevweek='Previous Week' + + +# hash value = 111192878 +vpsr.rsposition='Position' + + +# hash value = 174352409 +vpsr.rscompany='Company' + + +# hash value = 5966629 +vpsr.rstitle='Title' + + +# hash value = 75642876 +vpsr.rsemail='E-Mail' + + +# hash value = 174873561 +vpsr.rscountry='Country' + + +# hash value = 145482249 +vpsr.rscategory='Category' + + +# hash value = 5597891 +vpsr.rsnotes='Notes' + + +# hash value = 212556689 +vpsr.rscustom1='Custom 1' + + +# hash value = 212556690 +vpsr.rscustom2='Custom 2' + + +# hash value = 212556691 +vpsr.rscustom3='Custom 3' + + +# hash value = 212556692 +vpsr.rscustom4='Custom 4' + + +# hash value = 1339 +vpsr.rsokbtn='OK' + + +# hash value = 77089212 +vpsr.rscancelbtn='Cancel' + + +# hash value = 44709525 +vpsr.rsclosebtn='&Close' + + +# hash value = 45584468 +vpsr.rsprintbtn='&Print' + + +# hash value = 95467380 +vpsr.rsuntitled='Untitled' + + +# hash value = 259246484 +vpsr.rsselectasound='Select A Sound' + + +# hash value = 23760546 +vpsr.rssoundfinder='Sound Finder' + + +# hash value = 197155716 +vpsr.rsdefaultsound='Use the default sound' + + +# hash value = 5033044 +vpsr.rsdlgeventedit='Event' + + +# hash value = 1264948 +vpsr.rsappointmentgroupbox='Appointment' + + +# hash value = 194035674 +vpsr.rsdescriptionlbl='Subject:' + + +# hash value = 180232266 +vpsr.rscategorylbl='Category:' + + +# hash value = 100690714 +vpsr.rsstarttimelbl='Start Time:' + + +# hash value = 106614730 +vpsr.rsendtimelbl='End Time:' + + +# hash value = 205545794 +vpsr.rsalarmset='&Reminder' + + +# hash value = 264355450 +vpsr.rsrecurringlbl='Appointment Recurrence:' + + +# hash value = 36863562 +vpsr.rsintervallbl='Interval (days):' + + +# hash value = 226695114 +vpsr.rsrecurrenceendslbl='Repeat Until:' + + +# hash value = 56788084 +vpsr.rsalldayevent='&All Day Event' + + +# hash value = 89566314 +vpsr.rsnoteslbl='Notes:' + + +# hash value = 174434276 +vpsr.rsdlgcontactedit='Contact' + + +# hash value = 5538698 +vpsr.rsnamelbl='Name:' + + +# hash value = 95466122 +vpsr.rstitlelbl='Title:' + + +# hash value = 179883546 +vpsr.rsaddresslbl='Address:' + + +# hash value = 4852682 +vpsr.rscitylbl='City:' + + +# hash value = 95062666 +vpsr.rsstatelbl='State:' + + +# hash value = 113622378 +vpsr.rscountrylbl='Country:' + + +# hash value = 38419338 +vpsr.rszipcodelbl='Zip Code:' + + +# hash value = 105283946 +vpsr.rscompanylbl='Company:' + + +# hash value = 168473466 +vpsr.rspositionlbl='Position:' + + +# hash value = 1874375 +vpsr.rsdlgprintpreview='Print Preview' + + +# hash value = 370843 +vpsr.rsdlgtaskedit='Task' + + +# hash value = 122339642 +vpsr.rsduedate='Due Date:' + + +# hash value = 212338634 +vpsr.rsdetails='Details:' + + +# hash value = 13695557 +vpsr.rscomplete='Task complete' + + +# hash value = 40210149 +vpsr.rsdaysoverdue=' Days overdue' + + +# hash value = 145739758 +vpsr.rscreatedon='Created on' + + +# hash value = 135078526 +vpsr.rscompletedon='Completed on' + + +# hash value = 205541186 +vpsr.rsreminder='Reminder' + + +# hash value = 178691121 +vpsr.rsoverdue='OVERDUE!' + + +# hash value = 30317466 +vpsr.rssnoozecaption='Click &Snooze to be reminded again in:' + + +# hash value = 194035674 +vpsr.rssubjectcaption='Subject:' + + +# hash value = 89566314 +vpsr.rsnotescaption='Notes:' + + +# hash value = 185221635 +vpsr.rsdismissbtn='&Dismiss' + + +# hash value = 195389221 +vpsr.rssnoozebtn='&Snooze' + + +# hash value = 201833693 +vpsr.rsopenitembtn='&Open Item' + + +# hash value = 67501459 +vpsr.rs5minutes='5 Minutes' + + +# hash value = 67537043 +vpsr.rs10minutes='10 Minutes' + + +# hash value = 67538323 +vpsr.rs15minutes='15 Minutes' + + +# hash value = 67545235 +vpsr.rs30minutes='30 Minutes' + + +# hash value = 67550611 +vpsr.rs45minutes='45 Minutes' + + +# hash value = 53802690 +vpsr.rs1hour='1 Hour' + + +# hash value = 72314019 +vpsr.rs2hours='2 Hours' + + +# hash value = 89091235 +vpsr.rs3hours='3 Hours' + + +# hash value = 105868451 +vpsr.rs4hours='4 Hours' + + +# hash value = 122645667 +vpsr.rs5hours='5 Hours' + + +# hash value = 139422883 +vpsr.rs6hours='6 Hours' + + +# hash value = 156200099 +vpsr.rs7hours='7 Hours' + + +# hash value = 172977315 +vpsr.rs8hours='8 Hours' + + +# hash value = 3361417 +vpsr.rs1days='1 Day' + + +# hash value = 54831363 +vpsr.rs2days='2 Days' + + +# hash value = 55879939 +vpsr.rs3days='3 Days' + + +# hash value = 56928515 +vpsr.rs4days='4 Days' + + +# hash value = 57977091 +vpsr.rs5days='5 Days' + + +# hash value = 59025667 +vpsr.rs6days='6 Days' + + +# hash value = 53861307 +vpsr.rs1week='1 Week' + + +# hash value = 228550168 +vpsr.rscalendarprevmonth='Previous Month' + + +# hash value = 106375512 +vpsr.rscalendarnextmonth='Next Month' + + +# hash value = 198781874 +vpsr.rscalendarprevyear='Previous Year' + + +# hash value = 258322242 +vpsr.rscalendarnextyear='Next Year' + + +# hash value = 5986953 +vpsr.rscalendartoday='Today' + + +# hash value = 93113492 +vpsr.rscalendarrevert='Revert' + + +# hash value = 5986953 +vpsr.rscalendarpopuptoday='Today' + + +# hash value = 106375512 +vpsr.rscalendarpopupnextmonth='Next Month' + + +# hash value = 228550168 +vpsr.rscalendarpopupprevmonth='Previous Month' + + +# hash value = 258322242 +vpsr.rscalendarpopupnextyear='Next Year' + + +# hash value = 198781874 +vpsr.rscalendarpopupprevyear='Previous Year' + + +# hash value = 93113492 +vpsr.rscalendarpopuprevert='Revert' + + +# hash value = 212630100 +vpsr.sienotinstalled='Cannot open WININET, Microsoft IE required' + + +# hash value = 253544032 +vpsr.sopenfilefailed='Unable to open file ' + + +# hash value = 117221412 +vpsr.sfilenotfound='File %s could not be found' + + +# hash value = 76314325 +vpsr.sallocsrcmemfailed='Unable to allocate memory for XML source' + + +# hash value = 100728100 +vpsr.shttpreadreqfailed='Http read request failed' + + +# hash value = 75696565 +vpsr.shttpdatanotavail='Http data not available' + + +# hash value = 148414788 +vpsr.shttpreqsendfailed='Unable to send http request' + + +# hash value = 154619684 +vpsr.shttpreqopenfailed='Unable to open http request' + + +# hash value = 143764238 +vpsr.sinetconnectfailed='Unable to make Internet connection' + + +# hash value = 32342212 +vpsr.sinetopenfailed='Unable to open Internet' + + +# hash value = 109814542 +vpsr.sinvalidftploc='Invalid ftp location' + + +# hash value = 160070569 +vpsr.sinvalidftpdir='Invalid ftp directory' + + +# hash value = 45546788 +vpsr.sftpreadreqfailed='Ftp read request failed' + + +# hash value = 71854517 +vpsr.sftpdatanotavail='Ftp data not available' + + +# hash value = 258424821 +vpsr.sftpopenfilefailed='Unable to open ftp file' + + +# hash value = 35253107 +vpsr.sftpputfilefailed='Could not save file via ftp to %s' + + +# hash value = 175849584 +vpsr.ssrcloadfailed='Unable to load source ' + + +# hash value = 57976162 +vpsr.sinvalidmemptr='Invalid memory Pointer' + + +# hash value = 231806483 +vpsr.sfmterrormsg='Line: %d Col: %d Error: %s' + + +# hash value = 145571651 +vpsr.sindexoutofbounds='ERROR INDEX OUT OF BOUNDS' + + +# hash value = 84259344 +vpsr.sexpmarkupdecl='Expected markup declaration, but found: ' + + +# hash value = 230425296 +vpsr.sillattrtype='Illegal attribute type: ' + + +# hash value = 18220816 +vpsr.sillattrdefkeyw='Illegal keyword for attribute default value: ' + + +# hash value = 56058800 +vpsr.ssysidmissing='System identifier missing ' + + +# hash value = 190353936 +vpsr.sextmodifmissing='External modifier missing: ' + + +# hash value = 263225829 +vpsr.sillcondsectstart='Conditional section must begin with INCLUDE or IG'+ +'NORE' + + +# hash value = 14663744 +vpsr.sbadsepinmodel='Bad separator in content model: ' + + +# hash value = 29021872 +vpsr.sexpcommentorcdata='Expected comment or CDATA section ' + + +# hash value = 135168176 +vpsr.sunexpectedeof='Unexpected end of file ' + + +# hash value = 141533008 +vpsr.smismatchendtag='Mismatched end tag: ' + + +# hash value = 12051765 +vpsr.sillcharinref='Illegal character in reference' + + +# hash value = 132797168 +vpsr.sundeclaredentity='Reference to undeclared entity: ' + + +# hash value = 23714256 +vpsr.sexpectedstring='Expected String: ' + + +# hash value = 23208656 +vpsr.sspaceexpectedat='Whitespace expected at byte ' + + +# hash value = 99478656 +vpsr.sunexpendofinput='End of input while looking for delimiter: ' + + +# hash value = 83723191 +vpsr.squoteexpected='Expected " or '#39 + +# hash value = 98409107 +vpsr.sinvalidxmlversion='XMLPartner does not support XML specification gr'+ +'eater than %s' + + +# hash value = 168031582 +vpsr.sunablecreatestr='Unable to create stream for input.' + + +# hash value = 220733696 +vpsr.sinvalidname='Invalid XML name: ' + + +# hash value = 101287188 +vpsr.sinvalidcommenttext='Invalid comment text' + + +# hash value = 120830862 +vpsr.scommentbeforexmldecl='Document cannot start with a comment if it al'+ +'so contains an XML declaration' + + +# hash value = 223040718 +vpsr.sinvalidcdatasection='Invalid characters in CDATA section' + + +# hash value = 92987879 +vpsr.sredefinedattr='Attributes cannot be redefined in a start tag' + + +# hash value = 249132960 +vpsr.scircularentref='Circular reference to: ' + + +# hash value = 177029312 +vpsr.sinvattrchar='Invalid character in attribute value: ' + + +# hash value = 89182192 +vpsr.sinvpcdata='Invalid characters in element'#39's character data: ' + + +# hash value = 266616484 +vpsr.sdataaftervaldoc='There is invalid data after valid XML document' + + +# hash value = 251682990 +vpsr.snointconditional='Conditional sections not allowed in internal subs'+ +'et of document type declaration' + + +# hash value = 241136016 +vpsr.snotationnotdeclared='Notation not declared: ' + + +# hash value = 41663008 +vpsr.sinvpubidchar='Invalid PublicID character: ' + + +# hash value = 200364318 +vpsr.snondatainpedecl='NDATA not allowed in parameter entity declaration' + + +# hash value = 143094631 +vpsr.sinvstandaloneval='Standalone value must equal '#39'yes'#39' or '#39+ +'no'#39 + +# hash value = 232508640 +vpsr.sinvencname='Invalid encoding declaration: ' + + +# hash value = 208760336 +vpsr.sinvvernum='Invalid XML version number: ' + + +# hash value = 127703696 +vpsr.sinventityvalue='Invalid character in entity value: ' + + +# hash value = 109631936 +vpsr.snocommentinmarkup='Comments can not be placed within other markup' + + +# hash value = 208762004 +vpsr.snopeinintdtd='Parameter entities not allowed in DTD internal subset'+ + + +# hash value = 163448628 +vpsr.sxmldecnotatbeg='The XML declaration must appear before the first el'+ +'ement' + + +# hash value = 233823776 +vpsr.sinvalidelementname='Invalid element name: ' + + +# hash value = 231694352 +vpsr.sbadparamentnesting='Parameter-entity text must be properly nested: '+ + + +# hash value = 113027358 +vpsr.sinvalidcharencoding='Invalid character encoding specified.' + + +# hash value = 130745646 +vpsr.sattrnotnum='Attribute %s of element %s does not have an integer val'+ +'ue.' + + +# hash value = 100807091 +vpsr.sunknownaxis='Unknown axis specifier: %s' + + +# hash value = 225980260 +vpsr.sinvalidxmlchar='Invalid XML Character found' + + +# hash value = 135935175 +vpsr.sinvalidbechar='Invalid (big-endian) UTF-16 character encoding' + + +# hash value = 94102807 +vpsr.sinvalidlechar='Invalid (little-endian) UTF-16 character encoding' + + +# hash value = 256797885 +vpsr.sbadutf8char='Badly formed UTF-8 character in stream' + + +# hash value = 253773773 +vpsr.serrendofdocument='Unexpected end of document stream' + + +# hash value = 2450625 +vpsr.sucs_isoconverterr='Cannot convert UCS-4 character to ISO-8859-1' + + +# hash value = 262680790 +vpsr.sucs_u16converterr='Cannot convert UCS-4 character to UTF-16' + + +# hash value = 167412488 +vpsr.sucs_u8convererr='Cannot convert UCS-4 character to UTF-8' + + +# hash value = 219423621 +vpsr.rsoutofrange='Out of range' + + +# hash value = 34660356 +vpsr.rsnotsupported='not supported' + + +# hash value = 31331829 +vpsr.rsneedelementname='Please supply an Element Name' + + +# hash value = 10200635 +vpsr.rsneedformatname='FormatName cannot be blank' + + +# hash value = 57697009 +vpsr.rsprtcontrolowner='Print controller is not owned by a TVpControlLink'+ +'!' + + +# hash value = 141019168 +vpsr.rsbadprintformat='Invalid print format ' + + +# hash value = 86033632 +vpsr.rsbaditemtype='Invalid item type ' + + +# hash value = 180683348 +vpsr.rsbadmeasurement='Invalid measurement' + + +# hash value = 169471620 +vpsr.rsownernotwinctrl='Owner must be a TWinControl descendent' + + +# hash value = 136754107 +vpsr.rsnocontrollink='Component must be linked to a TVpControlLink' + + +# hash value = 96335620 +vpsr.rsnoprintformats='No print formats have been defined' + + +# hash value = 172789716 +vpsr.rsnocanvas='TCanvas not assigned' + + +# hash value = 215458782 +vpsr.rsnolocalizationfile='Localization file not found.' + + +# hash value = 199361424 +vpsr.rscategorydesc0='Category 0' + + +# hash value = 199361425 +vpsr.rscategorydesc1='Category 1' + + +# hash value = 199361426 +vpsr.rscategorydesc2='Category 2' + + +# hash value = 199361427 +vpsr.rscategorydesc3='Category 3' + + +# hash value = 199361428 +vpsr.rscategorydesc4='Category 4' + + +# hash value = 199361429 +vpsr.rscategorydesc5='Category 5' + + +# hash value = 199361430 +vpsr.rscategorydesc6='Category 6' + + +# hash value = 199361431 +vpsr.rscategorydesc7='Category 7' + + +# hash value = 199361432 +vpsr.rscategorydesc8='Category 8' + + +# hash value = 199361433 +vpsr.rscategorydesc9='Category 9' + + +# hash value = 109668078 +vpsr.rseditprintformat='Edit Print Formats...' + + +# hash value = 134418655 +vpsr.rsaddnewresource='No resources have been defined. Would you like to '+ +'add one now?' + + +# hash value = 164397583 +vpsr.rsselectresource='No resource has been selected. Would you like to s'+ +'elect one now?' + diff --git a/components/tvplanit/source/vptaskeditdlg.lfm b/components/tvplanit/source/vptaskeditdlg.lfm new file mode 100644 index 000000000..a58cecc0f --- /dev/null +++ b/components/tvplanit/source/vptaskeditdlg.lfm @@ -0,0 +1,316 @@ +object TaskEditForm: TTaskEditForm + Left = 278 + Top = 218 + AutoScroll = False + Caption = 'TaskEditForm' + ClientHeight = 313 + ClientWidth = 537 + Color = clBtnFace + Constraints.MinHeight = 340 + Constraints.MinWidth = 545 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + Scaled = False + OnCreate = FormCreate + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Panel2: TPanel + Left = 0 + Top = 276 + Width = 537 + Height = 37 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + DesignSize = ( + 537 + 37) + object ResourceNameLbl: TLabel + Left = 8 + Top = 12 + Width = 100 + Height = 16 + AutoSize = False + Caption = 'Resource Name' + Font.Charset = ANSI_CHARSET + Font.Color = clMaroon + Font.Height = -13 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object OKBtn: TButton + Left = 380 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'OK' + Default = True + TabOrder = 0 + OnClick = OKBtnClick + end + object CancelBtn: TButton + Left = 458 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Cancel' + TabOrder = 1 + OnClick = CancelBtnClick + end + end + object PageControl1: TPageControl + Left = 0 + Top = 0 + Width = 537 + Height = 276 + ActivePage = tabTask + Align = alClient + TabOrder = 1 + TabStop = False + object tabTask: TTabSheet + Caption = 'Task' + DesignSize = ( + 529 + 248) + object DueDateLbl: TLabel + Left = 52 + Top = 44 + Width = 47 + Height = 13 + Caption = 'Due date:' + end + object CreatedOnLbl: TLabel + Left = 52 + Top = 69 + Width = 55 + Height = 13 + Caption = 'Created on:' + end + object CompletedOnLbl: TLabel + Left = 313 + Top = 69 + Width = 68 + Height = 13 + Caption = 'Completed on:' + end + object Bevel1: TBevel + Left = 4 + Top = 32 + Width = 522 + Height = 2 + Anchors = [akLeft, akTop, akRight] + end + object Bevel2: TBevel + Left = 4 + Top = 88 + Width = 522 + Height = 2 + Anchors = [akLeft, akTop, akRight] + end + object imgCalendar: TImage + Left = 8 + Top = 38 + Width = 32 + Height = 32 + AutoSize = True + Picture.Data = { + 07544269746D6170360C0000424D360C00000000000036000000280000002000 + 0000200000000100180000000000000C00000000000000000000000000000000 + 0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4 + C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0 + D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080000000C8D0D4C8 + D0D4808080808080808080808080808080808080808080808080808080808080 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080808080808080808080808080C0C0C0808080000000C8 + D0D4808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080808080000000C8 + D0D4808080808080808080808080808080808080808080808080808080808080 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080808080808080808080C0C0C0808080808080000000C8 + D0D4C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080C0C0C0C0C0C0808080000000C8 + D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFF + FFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0 + C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFC0C0C0808080C0C0C0808080000000C8 + D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFF + FFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0 + C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080C0C0C0808080000000C8 + D0D4808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080C0C0C0808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFC0C0C0808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000C0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0000000808080808080808080808080 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080808080000000C0C0C0C0C0C0808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFF000000808080FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFF808080000000FFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFF000000808080FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFF808080000000FFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFF000000808080FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFF808080000000FFFFFF808080808080000000C8 + D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0000000808080808080808080808080 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080808080000000C0C0C0C0C0C0808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000C0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0 + FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFFFFFF + FFC0C0C0FFFFFFFFFFFFFFFFFFC0C0C0FFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080808080808080808080808080808080808080808080808080 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080808080808080808080808080808080808080000000C8 + D0D4C8D0D4808080C0C0C0808080C0C0C0808080C0C0C0808080C0C0C0808080 + C0C0C0808080C0C0C0808080C0C0C0808080C0C0C0808080C0C0C0808080C0C0 + C0808080C0C0C0808080C0C0C0808080C0C0C0808080808080808080000000C8 + D0D4C8D0D4808080808080C0C0C0808080C0C0C0808080C0C0C0808080C0C0C0 + 808080C0C0C0808080C0C0C0808080C0C0C0808080C0C0C0808080C0C0C08080 + 80C0C0C0808080C0C0C0808080C0C0C0808080C0C0C0808080808080000000C8 + D0D4C8D0D4808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080000000C8 + D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0 + C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080000000C8 + D0D4C8D0D4C8D0D4808080808080808080808080808080808080808080808080 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080808080808080808080808080808080808080000000C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4 + C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0 + D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4} + Transparent = True + end + object imgCompleted: TImage + Left = 272 + Top = 38 + Width = 32 + Height = 32 + AutoSize = True + Picture.Data = { + 07544269746D617076020000424D760200000000000076000000280000002000 + 0000200000000100040000000000000200000000000000000000100000001000 + 0000000000000000800000800000008080008000000080008000808000008080 + 8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF + FF00333333333333333333333333333333333333333333334404333333333333 + 3333333333333334088004333333333333333333333333448008800033333333 + 33333333333334080FF00880003333333333333333334480FFFFF008F0043333 + 333333333334080FFFFFFFF00880003333333333334480FFF77FFFFFF0088033 + 3333333334080FFFFFF77FFFFFF00033333333334480FF77FFFFF77FFFFFF033 + 33333334080FFFFF76FFFFF67FFF033333333340F0FFFFFFFF67FFFFFFF03333 + 333334080FFFFFFFFFFF77FFFF033300003340807FFFFF08FFFF888880333004 + 0403080F877FFFFFFFF8800000033000444400FFFF877FFFFFF008888FF00770 + 44440FF707FF877FFF888FFFFFFFFFF74444300F0FFFFF87700000088FFFFFFF + 444430F00FFFFFFF80070F0888FFFFFF044433FF000FF707F080700888FFFFFF + 0444330033300F0FF0F807088FFFFFF0000333333330F00FF00F8070FFFFF003 + 333333333333FF000330F8070FFF0333333333333333003333330FF070003333 + 3333333333333333333330000703333333333333333333333333333330703333 + 3333333333333333333333333307033333333333333333333333333333307033 + 3333333333333333333333333333070333333333333333333333333333333070 + 3333333333333333333333333333330033333333333333333333333333333333 + 3333} + Transparent = True + end + object DescriptionEdit: TEdit + Left = 4 + Top = 5 + Width = 522 + Height = 21 + Anchors = [akLeft, akTop, akRight] + MaxLength = 255 + TabOrder = 0 + Text = 'DescriptionEdit' + OnChange = OnChange + end + object DueDateEdit: TVpDateEdit + Left = 120 + Top = 40 + Width = 137 + Height = 21 + Epoch = 2000 + PopupCalColors.ActiveDay = clRed + PopupCalColors.ColorScheme = cscalWindows + PopupCalColors.DayNames = clMaroon + PopupCalColors.Days = clBlack + PopupCalColors.InactiveDays = clGray + PopupCalColors.MonthAndYear = clBlue + PopupCalColors.Weekend = clRed + PopupCalColors.EventDays = clBlack + PopupCalFont.Charset = DEFAULT_CHARSET + PopupCalFont.Color = clWindowText + PopupCalFont.Height = -11 + PopupCalFont.Name = 'MS Sans Serif' + PopupCalFont.Style = [] + ReadOnly = False + RequiredFields = [rfMonth, rfDay] + TabOrder = 1 + TodayString = '/' + end + object CompleteCB: TCheckBox + Left = 313 + Top = 41 + Width = 136 + Height = 17 + Caption = 'Complete' + TabOrder = 2 + end + object DetailsMemo: TMemo + Left = 4 + Top = 96 + Width = 522 + Height = 147 + Anchors = [akLeft, akTop, akRight, akBottom] + Lines.Strings = ( + 'DetailsMemo') + MaxLength = 1024 + ScrollBars = ssVertical + TabOrder = 3 + OnChange = OnChange + end + end + end +end diff --git a/components/tvplanit/source/vptaskeditdlg.pas b/components/tvplanit/source/vptaskeditdlg.pas new file mode 100644 index 000000000..1dd45e489 --- /dev/null +++ b/components/tvplanit/source/vptaskeditdlg.pas @@ -0,0 +1,229 @@ +{*********************************************************} +{* VPTASKEDITDLG.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpTaskEditDlg; + { default task editing dialog } + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Messages, SysUtils, + {$IFDEF VERSION6} Variants, {$ENDIF} + Classes, Graphics, Controls, Forms, Dialogs, VpData, StdCtrls, ExtCtrls, + VpEdPop, VpDateEdit, VpBase, VpSR, VpDlg, ComCtrls; + +type + { forward declarations } + TVpTaskEditDialog = class; + + TTaskEditForm = class(TForm) + Panel2: TPanel; + OKBtn: TButton; + CancelBtn: TButton; + PageControl1: TPageControl; + tabTask: TTabSheet; + DescriptionEdit: TEdit; + DueDateLbl: TLabel; + DueDateEdit: TVpDateEdit; + CompleteCB: TCheckBox; + CreatedOnLbl: TLabel; + CompletedOnLbl: TLabel; + DetailsMemo: TMemo; + ResourceNameLbl: TLabel; + Bevel1: TBevel; + Bevel2: TBevel; + imgCalendar: TImage; + imgCompleted: TImage; + procedure FormCreate(Sender: TObject); + procedure OnChange(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + private + FReturnCode: TVpEditorReturnCode; + FTask: TVpTask; + FResource: TVpResource; + public + procedure PopulateSelf; + procedure DePopulateSelf; + property Task: TVpTask + read FTask write FTask; + property Resource: TVpResource + read FResource write FResource; + property ReturnCode: TVpEditorReturnCode + read FReturnCode; + end; + + TVpTaskEditDialog = class(TVpBaseDialog) + protected {private} + teEditDlg : TTaskEditForm; + teTask : TVpTask; + public + constructor Create(AOwner : TComponent); override; + function Execute(Task: TVpTask): Boolean; reintroduce; + function AddNewTask: Boolean; + published + {properties} + property DataStore; + property Options; + property Placement; + end; + +implementation + +{$IFNDEF LCL} +{$R *.dfm} +{$ENDIF} + +{ TTaskEditForm } + +procedure TTaskEditForm.FormCreate(Sender: TObject); +begin + FReturnCode := rtAbandon; +end; +{=====} + +procedure TTaskEditForm.DePopulateSelf; +begin + Task.Description := DescriptionEdit.Text; + Task.DueDate := DueDateEdit.Date; + Task.Details := DetailsMemo.Text; + Task.Complete := CompleteCB.Checked; + DueDateLbl.Caption := RSDueDate; +end; +{=====} + +procedure TTaskEditForm.PopulateSelf; +begin + ResourceNameLbl.Caption := Resource.Description; + DueDateLbl.Caption := RSDueDate; + OKBtn.Caption := RSOKBtn; + CancelBtn.Caption := RSCancelBtn; + + DescriptionEdit.Text := Task.Description; + DueDateEdit.Date := Task.DueDate; + DetailsMemo.Text := Task.Details; + CompleteCB.Checked := Task.Complete; + if Task.CompletedOn <> 0 then + CompletedOnLbl.Caption := RSCompletedOn + ' ' + + FormatDateTime(ShortDateFormat, Task.CompletedOn) + else + CompletedOnLbl.Visible := False; + CompletedOnLbl.Visible := CompleteCB.Checked; + CreatedOnLbl.Caption := RSCreatedOn + ' ' + + FormatDateTime(ShortDateFormat, Task.CreatedOn); +end; +{=====} + +procedure TTaskEditForm.OnChange(Sender: TObject); +begin + Task.Changed := true; +end; +{=====} + +procedure TTaskEditForm.OKBtnClick(Sender: TObject); +begin + FReturnCode := rtCommit; + Close; +end; +{=====} + +procedure TTaskEditForm.CancelBtnClick(Sender: TObject); +begin + Close; +end; +{=====} + +procedure TTaskEditForm.FormShow(Sender: TObject); +begin + DescriptionEdit.SetFocus; +end; +{=====} + +{ TVpTaskEditDialog } + +constructor TVpTaskEditDialog.Create(AOwner : TComponent); +begin + inherited Create(AOwner); + FPlacement.Height := 340; + FPlacement.Width := 545; +end; + +function TVpTaskEditDialog.Execute(Task: TVpTask): Boolean; +var + TaskEditForm: TTaskEditForm; +begin + Result := false; + teTask := Task; + if (teTask <> nil) and (DataStore <> nil) and + (DataStore.Resource <> nil) then begin + Application.CreateForm(TTaskEditForm, TaskEditForm); + try + DoFormPlacement(TaskEditForm); + SetFormCaption(TaskEditForm, Task.Description, RSDlgTaskEdit); + TaskEditForm.Task := Task; + TaskEditForm.Resource := DataStore.Resource; + TaskEditForm.PopulateSelf; + TaskEditForm.ShowModal; + Result := (TaskEditForm.ReturnCode = rtCommit); + Task.Changed := Result; + if Result then begin + TaskEditForm.DePopulateSelf; + DataStore.PostTasks; + DataStore.NotifyDependents; + end; + finally + TaskEditForm.Release; + end; + end; +end; +{=====} + +function TVpTaskEditDialog.AddNewTask: Boolean; +begin + result := false; + if DataStore <> nil then begin + teTask := DataStore.Resource.Tasks.AddTask(DataStore.GetNextID('Tasks')); + if teTask <> nil then begin + Result := Execute(teTask); + if not Result then + teTask.Free; + end; + end; +end; +{=====} + +end. + diff --git a/components/tvplanit/source/vptasklist.pas b/components/tvplanit/source/vptasklist.pas new file mode 100644 index 000000000..acd6f6a5e --- /dev/null +++ b/components/tvplanit/source/vptasklist.pas @@ -0,0 +1,1758 @@ +{*********************************************************} +{* VPTASKLIST.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpTaskList; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, + VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus; + +type + TVpTaskRec = packed record + Task : Pointer; + LineRect : TRect; + CheckRect: TRect; + end; + +type + TVpTaskArray = array of TVpTaskRec; + + { forward declarations } + TVpTaskList = class; + + TVpTaskDisplayOptions = class(TPersistent) + protected{private} + FTaskList : TVpTaskList; + FShowAll : Boolean; + FShowCompleted : Boolean; + FShowDueDate : Boolean; + FDueDateFormat : string; + FCheckColor : TColor; + FCheckBGColor : TColor; + FCheckStyle : TVpCheckStyle; + FOverdueColor : TColor; + FNormalColor : TColor; + FCompletedColor : TColor; + procedure SetCheckColor(Value: TColor); + procedure SetCheckBGColor(Value: TColor); + procedure SetCheckStyle(Value: TVpCheckStyle); + procedure SetDueDateFormat(Value: string); + procedure SetShowCompleted(Value: Boolean); + procedure SetShowDueDate(Value: Boolean); + procedure SetShowAll(Value: Boolean); + procedure SetOverdueColor(Value: TColor); + procedure SetNormalColor(Value: TColor); + procedure SetCompletedColor(Value: TColor); + public + constructor Create(Owner : TVpTaskList); + destructor Destroy; override; + published + property CheckBGColor: TColor + read FCheckBGColor write SetCheckBGColor; + property CheckColor: TColor + read FCheckColor write SetCheckColor; + property CheckStyle: TVpCheckStyle + read FCheckStyle write SetCheckStyle; + property DueDateFormat: string + read FDueDateFormat write SetDueDateFormat; + property ShowCompletedTasks : Boolean + read FShowCompleted write SetShowCompleted; + property ShowAll : Boolean + read FShowAll write SetShowAll; + property ShowDueDate: Boolean + read FShowDueDate write SetShowDueDate; + property OverdueColor : TColor + read FOverdueColor write SetOverdueColor; + property NormalColor : TColor + read FNormalColor write SetNormalColor; + property CompletedColor : TColor + read FCompletedColor write SetCompletedColor; + end; + + { InPlace Editor } + TVpTLInPlaceEdit = class(TCustomEdit) + protected{private} + procedure CreateParams(var Params: TCreateParams); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + procedure Move(const Loc: TRect; Redraw: Boolean); + end; + + TVpTaskHeadAttr = class(TVpPersistent) + protected{private} + FTaskList: TVpTaskList; + FFont: TFont; + FColor: TColor; + procedure SetColor (Value: TColor); + procedure SetFont (Value: TFont); + public + constructor Create(AOwner: TVpTaskList); + destructor Destroy; override; + procedure Invalidate; override; + { The Invalidate method is used as a bridge between FFont & FTaskList. } + property TaskList: TVpTaskList read FTaskList; + published + property Color: TColor + read FColor write SetColor; + property Font: TFont + read FFont write SetFont; + end; + + { Task List } + TVpTaskList = class(TVpLinkableControl) + protected{ private } + FColor : TColor; + FCaption : string; + FDisplayOptions : TVpTaskDisplayOptions; + FLineColor : TColor; + FActiveTask : TVpTask; + FShowResourceName : Boolean; + FTaskIndex : Integer; + FScrollBars : TScrollStyle; + FTaskHeadAttr : TVpTaskHeadAttr; + FMaxVisibleTasks : Word; + FDrawingStyle : TVpDrawingStyle; + FTaskID : Integer; + FDefaultPopup : TPopupMenu; + FShowIcon : Boolean; + { task variables } + FOwnerDrawTask : TVpOwnerDrawTask; + FBeforeEdit : TVpBeforeEditTask; + FAfterEdit : TVpAfterEditTask; + FOwnerEditTask : TVpEditTask; + { internal variables } + tlVisibleTaskArray : TVpTaskArray; + tlAllTaskList : TList; + tlItemsBefore : Integer; + tlItemsAfter : Integer; + tlVisibleItems : Integer; + tlHitPoint : TPoint; + tlClickTimer : TTimer; + tlLoaded : Boolean; + tlRowHeight : Integer; + tlInPlaceEditor : TVpTLInPlaceEdit; + tlCreatingEditor : Boolean; + tlPainting : Boolean; + tlVScrollDelta : Integer; + tlHotPoint : TPoint; + + { property methods } + function GetTaskIndex: Integer; + procedure SetLineColor(Value: TColor); + procedure SetMaxVisibleTasks(Value: Word); + procedure SetTaskIndex(Value: Integer); + procedure SetDrawingStyle(const Value: TVpDrawingStyle); + procedure SetColor(const Value: TColor); + procedure SetShowIcon (const v : Boolean); + procedure SetShowResourceName(Value: Boolean); + { internal methods } + procedure InitializeDefaultPopup; + procedure PopupAddTask (Sender : TObject); + procedure PopupDeleteTask (Sender : TObject); + procedure PopupEditTask (Sender : TObject); + procedure tlSetVScrollPos; + procedure tlCalcRowHeight; + procedure tlEditInPlace(Sender: TObject); + procedure tlHookUp; + procedure Paint; override; + procedure Loaded; override; + procedure tlSpawnTaskEditDialog(NewTask: Boolean); + procedure tlSetActiveTaskByCoord(Pnt: TPoint); + function tlVisibleTaskToTaskIndex (const VisTaskIndex : Integer) : Integer; + function tlTaskIndexToVisibleTask (const ATaskIndex : Integer) : Integer; + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + {$IFNDEF LCL} + procedure WMLButtonDown(var Msg : TWMLButtonDown); message WM_LBUTTONDOWN; + procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; + procedure WMRButtonDown (var Msg : TWMRButtonDown); message WM_RBUTTONDOWN; + {$ELSE} + procedure WMLButtonDown(var Msg : TLMLButtonDown); message LM_LBUTTONDOWN; + procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; + procedure WMRButtonDown (var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; + {$ENDIF} + procedure EditTask; + procedure EndEdit(Sender: TObject); + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + { message handlers } + {$IFNDEF LCL} + procedure WMSize(var Msg: TWMSize); message WM_SIZE; + procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; + procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); + message CM_WANTSPECIALKEY; + {$ELSE} + procedure WMSize(var Msg: TLMSize); message LM_SIZE; + procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; + {$ENDIF} + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure DeleteActiveTask(Verify: Boolean); + procedure LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; + const Value: Variant); override; + function GetControlType : TVpItemType; override; + procedure PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle); + procedure RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); override; + property ActiveTask: TVpTask read FActiveTask; + property TaskIndex: Integer read GetTaskIndex write SetTaskIndex; + published + {inherited properties} + property Align; + property Anchors; + property Font; + property TabStop; + property TabOrder; + property ReadOnly; + + property DisplayOptions: TVpTaskDisplayOptions + read FDisplayOptions write FDisplayOptions; + property LineColor: TColor + read FLineColor write SetLineColor; + property MaxVisibleTasks: Word + read FMaxVisibleTasks write SetMaxVisibleTasks; + property TaskHeadAttributes: TVpTaskHeadAttr + read FTaskHeadAttr write FTaskHeadAttr; + property DrawingStyle: TVpDrawingStyle + read FDrawingStyle write SetDrawingStyle; + property Color: TColor + read FColor write SetColor; + property ShowIcon : Boolean read FShowIcon write SetShowIcon + default True; + property ShowResourceName: Boolean + read FShowResourceName write SetShowResourceName; + { events } + property BeforeEdit: TVpBeforeEditTask + read FBeforeEdit write FBeforeEdit; + property AfterEdit : TVpAfterEditTask + read FAfterEdit write FAfterEdit; + property OnOwnerEditTask: TVpEditTask + read FOwnerEditTask write FOwnerEditTask; + end; + +implementation + +uses + SysUtils, Math, Forms, Dialogs, VpTaskEditDlg, VpDlg; + + +(*****************************************************************************) + + +{ TVpTaskDisplayOptions } +constructor TVpTaskDisplayOptions.Create(Owner: TVpTaskList); +begin + inherited Create; + FTaskList := Owner; + FDueDateFormat := ShortDateFormat; + FShowDueDate := true; + FCheckColor := cl3DDkShadow; + FCheckBGColor := clWindow; + FCheckStyle := csCheck; + FOverdueColor := clRed; + FCompletedColor := clGray; + FNormalColor := clBlack; +end; +{=====} + +destructor TVpTaskDisplayOptions.Destroy; +begin + inherited; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetOverdueColor(Value : TColor); +begin + if FOverdueColor <> Value then begin + FOverdueColor := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetNormalColor(Value: TColor); +begin + if FNormalColor <> Value then begin + FNormalColor := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetCompletedColor(Value: TColor); +begin + if FCompletedColor <> Value then begin + FCompletedColor := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetCheckColor(Value: TColor); +begin + if FCheckColor <> Value then begin + FCheckColor := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetCheckBGColor(Value: TColor); +begin + if FCheckBGColor <> Value then begin + FCheckBGColor := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetCheckStyle(Value: TVpCheckStyle); +begin + if Value <> FCheckStyle then begin + FCheckStyle := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetDueDateFormat(Value: string); +begin + if FDueDateFormat <> Value then begin + FDueDateFormat := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetShowCompleted(Value : Boolean); +begin + if FShowCompleted <> Value then begin + FShowCompleted := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetShowDueDate(Value: Boolean); +begin + if FShowDueDate <> Value then begin + FShowDueDate := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskDisplayOptions.SetShowAll(Value: Boolean); +begin + if FShowAll <> Value then begin + FShowAll := Value; + FTaskList.Invalidate; + end; +end; +{=====} + +{ TVpTaskHeadAttr } +constructor TVpTaskHeadAttr.Create(AOwner: TVpTaskList); +begin + inherited Create; + FTaskList := AOwner; + FFont := TVpFont.Create(self); + FFont.Assign(FTaskList.Font); + FColor := clSilver; +end; +{=====} + +destructor TVpTaskHeadAttr.Destroy; +begin + FFont.Free; +end; +{=====} + +procedure TVpTaskHeadAttr.Invalidate; +begin + if Assigned(FTaskList) then + FTaskList.Invalidate; +end; +{=====} + +procedure TVpTaskHeadAttr.SetColor(Value: TColor); +begin + if Value <> FColor then begin + FColor := Value; + TaskList.Invalidate; + end; +end; +{=====} + +procedure TVpTaskHeadAttr.SetFont(Value: TFont); +begin + if Value <> FFont then begin + FFont.Assign(Value); + TaskList.Invalidate; + end; +end; +{=====} + + +{ TVpCGInPlaceEdit } + +constructor TVpTLInPlaceEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ParentCtl3D := False; + Ctl3D := False; + TabStop := False; + BorderStyle := bsNone; + {$IFDEF VERSION4} + DoubleBuffered := False; + {$ENDIF} +end; +{=====} + +procedure TVpTLInPlaceEdit.Move(const Loc: TRect; Redraw: Boolean); +begin + CreateHandle; + Redraw := Redraw or not IsWindowVisible(Handle); + Invalidate; + with Loc do + SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top, + {SWP_SHOWWINDOW or} SWP_NOREDRAW); + if Redraw then Invalidate; + SetFocus; +end; +{=====} + +procedure TVpTLInPlaceEdit.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + Params.Style := Params.Style{ or ES_MULTILINE}; +end; +{=====} + +procedure TVpTLInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState); +var + TaskList : TVpTaskList; +begin + TaskList := TVpTaskList(Owner); + + case Key of + VK_RETURN: begin + Key := 0; + TaskList.EndEdit(Self); + end; + + VK_UP: begin + Key := 0; + TaskList.TaskIndex := TaskList.TaskIndex - 1; + end; + + VK_DOWN: begin + Key := 0; + TaskList.TaskIndex := TaskList.TaskIndex + 1; + end; + + VK_ESCAPE: begin + Key := 0; + TaskList.EndEdit(Self); + end; + + else + inherited; + end; +end; +{=====} + +(*****************************************************************************) +{ TVpTaskList } + +constructor TVpTaskList.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; + { Create internal classes and stuff } + tlClickTimer := TTimer.Create(self); + FTaskHeadAttr := TVpTaskHeadAttr.Create(Self); + FDisplayOptions := TVpTaskDisplayOptions.Create(self); + tlAllTaskList := TList.Create; + + { Set styles and initialize internal variables } + {$IFDEF VERSION4} + DoubleBuffered := true; + {$ENDIF} + tlItemsBefore := 0; + tlItemsAfter := 0; + tlVisibleItems := 0; + tlClickTimer.Enabled := false; + FMaxVisibleTasks := 250; + tlClickTimer.Interval := ClickDelay; + tlClickTimer.OnTimer := tlEditInPlace; + tlCreatingEditor := false; + FDrawingStyle := ds3d; + tlPainting := false; + FShowResourceName := true; + FColor := clWindow; + FLineColor := clGray; + FScrollBars := ssVertical; + FTaskIndex := -1; + FShowIcon := True; + + SetLength(tlVisibleTaskArray, MaxVisibleTasks); + + { size } + Height := 225; + Width := 169; + + FDefaultPopup := TPopupMenu.Create (Self); + InitializeDefaultPopup; + + tlHookUp; +end; +{=====} + +destructor TVpTaskList.Destroy; +begin + tlClickTimer.Free; + FDisplayOptions.Free; + tlAllTaskList.Free; + FTaskHeadAttr.Free; + FDefaultPopup.Free; + + inherited; +end; +{=====} + +procedure TVpTaskList.DeleteActiveTask(Verify: Boolean); +var + Str: string; + DoIt: Boolean; +begin + DoIt := not Verify; + if FActiveTask <> nil then begin + Str := FActiveTask.Description; + + if Verify then + DoIt := (MessageDlg(RSDelete + ' ' + Str + ' ' + RSFromTaskList + + #13#10#10 + RSPermanent, mtconfirmation, + [mbYes, mbNo], 0) = mrYes); + + if DoIt then begin + FActiveTask.Deleted := true; + if Assigned (DataStore) then + if Assigned (DataStore.Resource) then + DataStore.Resource.TasksDirty := True; + DataStore.PostTasks; + DataStore.RefreshTasks; + Invalidate; + end; + end; +end; +{=====} + +procedure TVpTaskList.LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; const Value: Variant); +begin + case NotificationType of + neDataStoreChange: Invalidate; + neInvalidate: Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.tlHookUp; +var + I: Integer; +begin + { If the component is being dropped on a form at designtime, then } + { automatically hook up to the first datastore component found } + if csDesigning in ComponentState then + for I := 0 to pred(Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpCustomDataStore) then begin + DataStore := TVpCustomDataStore(Owner.Components[I]); + Exit; + end; + end; +end; +{=====} + +procedure TVpTaskList.Loaded; +begin + inherited; + tlLoaded := true; +end; +{=====} + +function TVpTaskList.GetControlType : TVpItemType; +begin + Result := itTasks; +end; +{=====} + +procedure TVpTaskList.Paint; +begin + { paint simply calls RenderToCanvas and passes in the screen canvas. } + RenderToCanvas (Canvas, {Screen Canvas} + Rect (0, 0, Width, Height), { Clipping Rectangle } + ra0, { Rotation Angle } + 1, { Scale } + Now, { Render Date } + tlItemsBefore, { Starting Line } + -1, { Stop Line } + gr30Min, { Granularity - Not used int the task list } + False); { Display Only - True for a printed version, } + { False for an interactive version } +end; +{=====} + +procedure TVpTaskList.PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle); +begin + RenderToCanvas (ACanvas, ARect, Angle, 1, Now, + -1, -1, gr30Min, True); +end; +{=====} + +procedure TVpTaskList.RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); +var + HeadRect : TRect; + Bmp : Graphics.TBitmap; + SaveBrushColor : TColor; + SavePenStyle : TPenStyle; + SavePenColor : TColor; + RowHeight : Integer; + + RealWidth : Integer; + RealHeight : Integer; + RealLeft : Integer; + RealRight : Integer; + RealTop : Integer; + RealBottom : Integer; + Rgn : HRGN; + + RealColor : TColor; + BackgroundSelHighlight : TColor; + ForegroundSelHighlight : TColor; + BevelShadow : TColor; + BevelHighlight : TColor; + BevelDarkShadow : TColor; + BevelFace : TColor; + RealLineColor : TColor; + RealCheckBgColor : TColor; + RealCheckBoxColor : TColor; + RealCheckColor : TColor; + RealCompleteColor : TColor; + RealOverdueColor : TColor; + RealNormalColor : TColor; + TaskHeadAttrColor : TColor; + + procedure DrawLines; + var + LinePos: Integer; + begin + RenderCanvas.Pen.Color := RealLineColor; + RenderCanvas.Pen.Style := psSolid; + LinePos := HeadRect.Bottom + RowHeight; + while LinePos < RealBottom do begin + TPSMoveTo (RenderCanvas, Angle, RenderIn, RealLeft, LinePos); + TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2, LinePos); + Inc (LinePos, RowHeight); + end; + end; + {-} + + procedure Clear; + var + I: Integer; + begin + RenderCanvas.Brush.Color := RealColor; + RenderCanvas.FillRect (RenderIn); + + { Clear the LineRect } + for I := 0 to pred(Length(tlVisibleTaskArray)) do begin + tlVisibleTaskArray[I].Task := nil; + tlVisibleTaskArray[I].LineRect := Rect(0, 0, 0, 0); + end; + end; + {-} + + procedure SetMeasurements; + begin + RealWidth := TPSViewportWidth (Angle, RenderIn); + RealHeight := TPSViewportHeight (Angle, RenderIn); + RealLeft := TPSViewportLeft (Angle, RenderIn); + RealRight := TPSViewportRight (Angle, RenderIn); + RealTop := TPSViewportTop (Angle, RenderIn); + RealBottom := TPSViewportBottom (Angle, RenderIn); + end; + + procedure MeasureRowHeight; + begin + RenderCanvas.Font.Assign(Font); + RowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2; + end; + {-} + + function DrawCheck (Rec : TRect; Checked : Boolean) : TRect; + { draws the check box and returns it's rectangle } + var + CR: TRect; { checbox rectangle } + W: Integer; { width of the checkbox } + X, Y: Integer; { Coordinates } + begin + X := Rec.Left + TextMargin; + Y := Rec.Top + TextMargin; + W := RowHeight - TextMargin * 2; + + { draw check box } + RenderCanvas.Pen.Color := RGB (192, 204, 216); + RenderCanvas.Brush.Color := RealCheckBgColor; + TPSRectangle (RenderCanvas, Angle, RenderIn, + Rect (X, Y, X + W, Y + W)); + RenderCanvas.Pen.Color := RGB (80, 100, 128); + TPSPolyLine (RenderCanvas, Angle, RenderIn, + [Point(X, Y + W - 2), Point(X, Y), Point(X + W - 1, Y)]); + RenderCanvas.Pen.Color := RealCheckBoxColor; + TPSPolyLine (RenderCanvas, Angle, RenderIn, + [Point(X + 1, Y + W - 3), Point(X + 1, Y + 1), + Point(X + W - 2, Y + 1)]); + RenderCanvas.Pen.Color := RGB(128,152,176); + TPSPolyLine (RenderCanvas, Angle, RenderIn, + [Point(X + 1, Y + W - 2), Point(X + W - 2, Y + W - 2), + Point(X+W-2, Y)]); + + { build check rect } + CR := Rect(X + 3, Y + 3, X + W - 3, Y + W - 3); + if Checked then begin + RenderCanvas.Pen.Color := RealCheckColor; + case FDisplayOptions.CheckStyle of + csX : {X} + begin + with RenderCanvas do begin + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Top); + TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom); + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1); + TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom); + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top); + TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1); + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-1); + TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-2); + TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1); + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1); + TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); + end; + end; + csCheck : {check} + begin + with RenderCanvas do begin + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, + CR.Bottom - ((CR.Bottom - cr.Top) div 4)); + TPSLineTo (RenderCanvas, Angle, RenderIn, + CR.Left + ((CR.Right - CR.Left) div 4), + CR.Bottom); + TPSLineTo (RenderCanvas, Angle, RenderIn, + CR.Right, CR.Top + 2); + + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, + CR.Bottom - ((CR.Bottom - cr.Top) div 4) - 1); + TPSLineTo (RenderCanvas, Angle, RenderIn, + CR.Left + ((CR.Right - CR.Left) div 4), + CR.Bottom - 1); + TPSLineTo (RenderCanvas, Angle, RenderIn, + CR.Right, CR.Top + 1); + + TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, + CR.Bottom - ((CR.Bottom - cr.Top) div 4) - 2); + TPSLineTo (RenderCanvas, Angle, RenderIn, + CR.Left + ((CR.Right - CR.Left) div 4), + CR.Bottom - 2); + TPSLineTo (RenderCanvas, Angle, RenderIn, + CR.Right, CR.Top); + + {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-5); } + {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom-2); } + {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-4); } + {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom-1); } + {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-3); } + {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom); } + {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-3); } + {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); } + {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-2); } + {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); } + {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-1); } + {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top+1); } + end; + end; + end; + end; {if checked} + result := cr; + end; + + procedure DrawTasks; + var + I : Integer; + Task : TVpTask; + LineRect : TRect; + CheckRect : TRect; + DisplayStr : string; + begin + if (DataStore = nil) or + (DataStore.Resource = nil) or + (DataStore.Resource.Tasks.Count = 0) then begin + if Focused then begin + LineRect.TopLeft := Point (RealLeft + 2, + HeadRect.Bottom); + LineRect.BottomRight := Point (LineRect.Left + RealWidth - 4, + LineRect.Top + RowHeight); + RenderCanvas.Brush.Color := BackgroundSelHighlight; + RenderCanvas.FillRect(LineRect); + RenderCanvas.Brush.Color := RealColor; + end; + Exit; + end; + + LineRect.TopLeft := Point (RealLeft + 2, + HeadRect.Bottom); + LineRect.BottomRight := Point (LineRect.Left + RealWidth - 4, + LineRect.Top + RowHeight); + + tlVisibleItems := 0; + RenderCanvas.Brush.Color := RealColor; + + tlAllTaskList.Clear; + + { Make sure the tasks are properly sorted } + DataStore.Resource.Tasks.Sort; + + for I := 0 to pred(DataStore.Resource.Tasks.Count) do begin + if DisplayOptions.ShowAll then + { Get all tasks regardless of their status and due date } + tlAllTaskList.Add(DataStore.Resource.Tasks.GetTask(I)) + else begin + { get all tasks which are incomplete, or were just completed today.} + Task := DataStore.Resource.Tasks.GetTask(I); + if not Task.Complete then + tlAllTaskList.Add(Task) + else if FDisplayOptions.ShowCompletedTasks + and (trunc(Task.CompletedOn) = trunc(now)) then + tlAllTaskList.Add(Task); + end; + end; + + for I := StartLine to pred(tlAllTaskList.Count) do begin + Task := tlAllTaskList[I]; + if (LineRect.Top + Trunc(RowHeight * 0.5) <= RealBottom) then begin + { if this is the selected task and we are not in edit mode, } + { then set background selection } + if (Task = FActiveTask) and (tlInPlaceEditor = nil) + and (not DisplayOnly) and Focused then begin + RenderCanvas.Brush.Color := BackgroundSelHighlight; + RenderCanvas.FillRect(LineRect); + RenderCanvas.Brush.Color := RealColor; + end; + + { draw the checkbox } + CheckRect := DrawCheck (LineRect, Task.Complete); + + if Task.Complete then begin + { complete task } + RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsStrikeout]; + RenderCanvas.Font.Color := RealCompleteColor; + end else begin + { incomplete task } + RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsStrikeout]; + if (Trunc (Task.DueDate) < Trunc (Now)) and + (Trunc (Task.DueDate) <> 0) then + { overdue task } + RenderCanvas.Font.Color := RealOverdueColor + else + RenderCanvas.Font.Color := RealNormalColor; + end; + + { if this is the selected task, set highlight text color } + if (Task = FActiveTask) and (tlInPlaceEditor = nil) + and (not DisplayOnly) and Focused then + RenderCanvas.Font.Color := ForegroundSelHighlight; + + { build display string } + DisplayStr := ''; + if (FDisplayOptions.ShowDueDate) and + (Trunc (Task.DueDate) <> 0) then + DisplayStr := FormatDateTime(FDisplayOptions.DueDateFormat, + Task.DueDate) + ' - '; + DisplayStr := DisplayStr + Task.description; + + { Adjust display string - If the string is too long for the available } + { space, Chop the end off and replace it with an ellipses. } + DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3, + LineRect.Right - LineRect.Left - CheckRect.Right - TextMargin); + + { paint the text } + TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right + + TextMargin * 2, LineRect.Top + TextMargin, DisplayStr); + + { store the tasks drawing details } + tlVisibleTaskArray[tlVisibleItems].Task := Task; + tlVisibleTaskArray[tlVisibleItems].LineRect := Rect(CheckRect.Right + + TextMargin, LineRect.Top, LineRect.Right, LineRect.Bottom); + tlVisibleTaskArray[tlVisibleItems].CheckRect := CheckRect; + LineRect.Top := LineRect.Bottom; + LineRect.Bottom := LineRect.Top + RowHeight; + Inc(tlVisibleItems); + end else if (LineRect.Bottom - TextMargin > RealBottom) then begin + FLastPrintLine := I; + Break; + end; + end; + if tlVisibleItems + tlItemsBefore = tlAllTaskList.Count then begin + FLastPrintLine := -2; + tlItemsAfter := 0; + end else begin + tlItemsAfter := tlAllTaskList.Count - tlItemsBefore - tlVisibleItems; + end; + + { these are for the syncing the scrollbar } + if StartLine < 0 then + tlItemsBefore := 0 + else + tlItemsBefore := StartLine; + end; + {-} + + procedure DrawHeader; + var + GlyphRect: TRect; + HeadStr: string; + begin + RenderCanvas.Brush.Color := TaskHeadAttrColor; + HeadRect.Left := RealLeft + 2; + HeadRect.Top := RealTop + 2; + HeadRect.Right := RealRight - 2; + + RenderCanvas.Font.Assign (FTaskHeadAttr.Font); + HeadRect.Bottom := RealTop + RenderCanvas.TextHeight ('YyGg0') + + TextMargin * 2; + TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); + { draw the header cell borders } + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + HeadRect.Left := HeadRect.Left - 1; + HeadRect.Top := HeadRect.Top - 1; + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, HeadRect), + BevelShadow, + BevelShadow); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + HeadRect.Right := HeadRect.Right - 1; + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, HeadRect), + BevelHighlight, + BevelDarkShadow); + end; + + if ShowIcon then begin + { Draw the glyph } + Bmp := Graphics.TBitmap.Create; + try + Bmp.Handle := LoadBaseBitmap('VPCHECKPAD'); + { load and return the handle to bitmap resource} + if Bmp.Height > 0 then begin + GlyphRect.TopLeft := Point (HeadRect.Left + TextMargin, + HeadRect.Top + TextMargin); + GlyphRect.BottomRight := Point (GlyphRect.Left + Bmp.Width, + GlyphRect.Top + Bmp.Height); +//TODO: RenderCanvas.BrushCopy (TPSRotateRectangle (Angle, RenderIn, GlyphRect), +// Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), +// Bmp.Canvas.Pixels[0, Bmp.Height - 1]); + HeadRect.Left := HeadRect.Left + Bmp.Width + TextMargin; + end; + finally + Bmp.Free; + end; + end; + { draw the text } + if ShowResourceName + and (DataStore <> nil) + and (DataStore.Resource <> nil) then + HeadStr := RSTaskTitleResource + DataStore.Resource.Description + else + HeadStr := RSTaskTitleNoResource; + RenderCanvas.Font.Assign(FTaskHeadAttr.Font); + TPSTextOut (RenderCanvas, Angle, RenderIn, HeadRect. + Left + TextMargin, HeadRect.Top + TextMargin, + HeadStr); + end; + {-} + + procedure DrawBorders; + begin + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + DrawBevelRect (RenderCanvas, + Rect (RenderIn.Left, + RenderIn.Top, + RenderIn.Right - 1, + RenderIn.Bottom - 1), + BevelShadow, + BevelHighlight); + DrawBevelRect (RenderCanvas, + Rect (RenderIn.Left + 1, + RenderIn.Top + 1, + RenderIn.Right - 2, + RenderIn.Bottom - 2), + BevelHighlight, + BevelShadow); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + DrawBevelRect (RenderCanvas, + Rect (RenderIn.Left, RenderIn.Top, + RenderIn.Right - 1, RenderIn.Bottom - 1), + BevelShadow, + BevelHighlight); + DrawBevelRect (RenderCanvas, + Rect (RenderIn.Left + 1, + RenderIn.Top + 1, + RenderIn.Right - 2, + RenderIn.Bottom - 2), + BevelDarkShadow, + BevelFace); + end; + end; + {-} +begin + if DisplayOnly then begin + RealColor := clWhite; + BackgroundSelHighlight := clBlack; + ForegroundSelHighlight := clWhite; + BevelShadow := clBlack; + BevelHighlight := clBlack; + BevelDarkShadow := clBlack; + BevelFace := clBlack; + RealLineColor := clBlack; + RealCheckBgColor := clWhite; + RealCheckBoxColor := clBlack; + RealCheckColor := clBlack; + RealCompleteColor := clBlack; + RealOverdueColor := clBlack; + RealNormalColor := clBlack; + TaskHeadAttrColor := clSilver; + end else begin + RealColor := Color; + BackgroundSelHighlight := clHighlight; + ForegroundSelHighlight := clHighlightText; + BevelShadow := clBtnShadow; + BevelHighlight := clBtnHighlight; + BevelDarkShadow := cl3DDkShadow; + BevelFace := clBtnFace; + RealLineColor := LineColor; + RealCheckBgColor := FDisplayOptions.CheckBGColor; + RealCheckBoxColor := FDisplayOptions.CheckColor; + RealCheckColor := FDisplayOptions.CheckColor; + RealCompleteColor := FDisplayOptions.FCompletedColor; + RealOverdueColor := FDisplayOptions.FOverdueColor; + RealNormalColor := FDisplayOptions.FNormalColor; + TaskHeadAttrColor := FTaskHeadAttr.Color; + end; + + tlPainting := true; + SavePenStyle := RenderCanvas.Pen.Style; + SaveBrushColor := RenderCanvas.Brush.Color; + SavePenColor := RenderCanvas.Pen.Color; + + RenderCanvas.Pen.Style := psSolid; + RenderCanvas.Pen.Width := 1; + RenderCanvas.Pen.Mode := pmCopy; + RenderCanvas.Brush.Style := bsSolid; + + Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top, + RenderIn.Right, RenderIn.Bottom); + try + SelectClipRgn (RenderCanvas.Handle, Rgn); + + if StartLine < 0 then + StartLine := 0; + + { clear client area } + Clear; + + SetMeasurements; + + { measure the row height } + MeasureRowHeight; + + { draw header } + DrawHeader; + + { draw lines } + DrawLines; + + { draw the tasks } + DrawTasks; + + { draw the borders } + DrawBorders; + + tlSetVScrollPos; + + finally + SelectClipRgn (RenderCanvas.Handle, 0); + DeleteObject (Rgn); + end; + + { reinstate canvas settings} + RenderCanvas.Pen.Style := SavePenStyle; + RenderCanvas.Brush.Color := SaveBrushColor; + RenderCanvas.Pen.Color := SavePenColor; + tlPainting := false; +end; +{=====} + +procedure TVpTaskList.SetColor(const Value: TColor); +begin + if FColor <> Value then begin + FColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.tlCalcRowHeight; +var + SaveFont: TFont; + Temp: Integer; +begin + { Calculates row height based on the largest of the RowHead's Minute } + { font, the standard client font, and a sample character string. } + SaveFont := Canvas.Font; + Canvas.Font := FTaskHeadAttr.Font; + tlRowHeight := Canvas.TextHeight(RSTallShortChars); + Canvas.Font.Assign(SaveFont); + Temp := Canvas.TextHeight(RSTallShortChars); + if Temp > tlRowHeight then + tlRowHeight := Temp; + tlRowHeight := tlRowHeight + TextMargin * 2; + Canvas.Font := SaveFont; +end; +{=====} + +procedure TVpTaskList.SetDrawingStyle(const Value: TVpDrawingStyle); +begin + if FDrawingStyle <> Value then begin + FDrawingStyle := Value; + Repaint; + end; +end; +{=====} + +procedure TVpTaskList.SetTaskIndex(Value: Integer); +begin + if (tlInPlaceEditor <> nil) then + EndEdit(self); + + if (Value < DataStore.Resource.Tasks.Count) + and (FTaskIndex <> Value) then begin + FTaskIndex := Value; + if FTaskIndex > -1 then + FActiveTask := DataStore.Resource.Tasks.GetTask(Value) + else + FActiveTask := nil; + + Invalidate; + end; +end; +{=====} + +function TVpTaskList.GetTaskIndex: Integer; +begin + if FActiveTask = nil then + result := -1 + else + result := FActiveTask.ItemIndex; +end; +{=====} + +procedure TVpTaskList.SetLineColor(Value: TColor); +begin + if Value <> FLineColor then begin + FLineColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.SetMaxVisibleTasks(Value: Word); +begin + if Value <> FMaxVisibleTasks then begin + FMaxVisibleTasks := Value; + SetLength(tlVisibleTaskArray, FMaxVisibleTasks); + Invalidate; + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpTaskList.WMSize(var Msg: TWMSize); +{$ELSE} +procedure TVpTaskList.WMSize(var Msg: TLMSize); +{$ENDIF} +begin + inherited; + { force a repaint on resize } + Invalidate; +end; +{=====} + +procedure TVpTaskList.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + Style := Style or WS_TABSTOP; + Style := Style or WS_VSCROLL; +{$IFNDEF LCL} + WindowClass.style := CS_DBLCLKS; +{$ENDIF} + end; +end; +{=====} + +procedure TVpTaskList.CreateWnd; +begin + inherited; + tlCalcRowHeight; + tlSetVScrollPos; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpTaskList.WMLButtonDown(var Msg : TWMLButtonDown); +{$ELSE} +procedure TVpTaskList.WMLButtonDown(var Msg : TLMLButtonDown); +{$ENDIF} +begin + inherited; + + if not Focused then SetFocus; + + if not (csDesigning in ComponentState) then begin + {See if the user clicked on a checkbox} + tlSetActiveTaskByCoord (Point(Msg.XPos, Msg.YPos)); + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpTaskList.WMRButtonDown (var Msg : TWMRButtonDown); +{$ELSE} +procedure TVpTaskList.WMRButtonDown (var Msg : TLMRButtonDown); +{$ENDIF} +var + ClientOrigin : TPoint; + i : Integer; + +begin + inherited; + + if not Assigned (PopupMenu) then begin + if not Focused then + SetFocus; + tlSetActiveTaskByCoord(Point(Msg.XPos, Msg.YPos)); + tlClickTimer.Enabled := False; + ClientOrigin := GetClientOrigin; + + if not Assigned (FActiveTask) then + for i := 0 to FDefaultPopup.Items.Count - 1 do begin + if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then + FDefaultPopup.Items[i].Enabled := False; + end + else + for i := 0 to FDefaultPopup.Items.Count - 1 do + FDefaultPopup.Items[i].Enabled := True; + + FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x, + Msg.YPos + ClientOrigin.y); + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpTaskList.WMLButtonDblClk(var Msg : TWMLButtonDblClk); +{$ELSE} +procedure TVpTaskList.WMLButtonDblClk(var Msg : TLMLButtonDblClk); +{$ENDIF} +begin + inherited; + tlClickTimer.Enabled := false; + { if the mouse was pressed down in the client area, then select the cell. } + if not Focused then + SetFocus; + { The mouse click landed inside the client area } + tlSetActiveTaskByCoord (Point (Msg.XPos, Msg.YPos)); + { Spawn the TaskList editor } + if not ReadOnly then + tlSpawnTaskEditDialog (FActiveTask = nil); +end; +{=====} + +procedure TVpTaskList.InitializeDefaultPopup; +var + NewItem : TMenuItem; + +begin + if RSTaskPopupAdd <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSTaskPopupAdd; + NewItem.OnClick := PopupAddTask; + NewItem.Tag := 0; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSTaskPopupEdit <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSTaskPopupEdit; + NewItem.OnClick := PopupEditTask; + NewItem.Tag := 1; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSTaskPopupDelete <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSTaskPopupDelete; + NewItem.OnClick := PopupDeleteTask; + NewItem.Tag := 1; + FDefaultPopup.Items.Add (NewItem); + end; +end; +{=====} + +procedure TVpTaskList.PopupAddTask (Sender : TObject); +begin + if ReadOnly then + Exit; + if not CheckCreateResource then + Exit; + { Allow the user to fill in all the new information } + Repaint; + tlSpawnTaskEditDialog (True); +end; +{=====} + +procedure TVpTaskList.PopupDeleteTask (Sender : TObject); +begin + if ReadOnly then + Exit; + if FActiveTask <> nil then begin + Repaint; + DeleteActiveTask (True); + end; +end; +{=====} + +procedure TVpTaskList.PopupEditTask (Sender : TObject); +begin + if ReadOnly then + Exit; + if FActiveTask <> nil then begin + Repaint; + { edit this Task } + tlSpawnTaskEditDialog (False); + end; +end; +{=====} + +procedure TVpTaskList.tlSpawnTaskEditDialog(NewTask: Boolean); +var + AllowIt : Boolean; + Task : TVpTask; + TaskDlg : TVpTaskEditDialog; +begin + tlClickTimer.Enabled := false; + if not CheckCreateResource then + Exit; + if (DataStore = nil) or (DataStore.Resource = nil) then + Exit; + + AllowIt := false; + if NewTask then begin + Task := DataStore.Resource.Tasks.AddTask(DataStore.GetNextID('Tasks')); + Task.CreatedOn := now; + Task.DueDate := Now + 7; + end else + Task := FActiveTask; + + if Assigned(FOwnerEditTask) then + FOwnerEditTask(self, Task, DataStore.Resource, AllowIt) + else begin + TaskDlg := TVpTaskEditDialog.Create(nil); + try + TaskDlg.Options := TaskDlg.Options + [doSizeable]; + TaskDlg.DataStore := DataStore; + AllowIt := TaskDlg.Execute(Task); + finally + TaskDlg.Free; + end; + end; + if AllowIt then begin + DataStore.PostTasks(); + Invalidate; + end else begin + if NewTask then begin + DataStore.Resource.Tasks.DeleteTask(Task); + end; + DataStore.PostTasks; + Invalidate; + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpTaskList.CMWantSpecialKey(var Msg: TCMWantSpecialKey); +begin + inherited; + Msg.Result := 1; +end; +{$ENDIF} +{=====} + +procedure TVpTaskList.tlEditInPlace(Sender: TObject); +begin + { this is the timer Task which spawns an in-place editor } + { if the task is doublecliked before this timer fires, then the } + { task is edited in a dialog based editor. } + tlClickTimer.Enabled := false; + EditTask; +end; +{=====} + +procedure TVpTaskList.EditTask; +var + AllowIt : Boolean; + R : TRect; + VisTask : Integer; + +begin + {don't allow a user to edit a completed task in place.} + if FActiveTask.Complete then + Exit; + + AllowIt := true; + + VisTask := tlTaskIndexToVisibleTask (TaskIndex); + if VisTask < 0 then + Exit; + + { call the user defined BeforeEdit task } + if Assigned(FBeforeEdit) then + FBeforeEdit(Self, FActiveTask, AllowIt); + + if AllowIt then begin + { build the editor's rectangle } + R := tlVisibleTaskArray[VisTask].LineRect; + R.Top := R.Top + TextMargin; + R.Left := R.Left + TextMargin - 1; + { create and spawn the in-place editor } + tlInPlaceEditor := TVpTLInPlaceEdit.Create(Self); + tlInPlaceEditor.Parent := self; + tlInPlaceEditor.OnExit := EndEdit; + tlInPlaceEditor.Move(R , true); + tlInPlaceEditor.Text := FActiveTask.Description; + tlInPlaceEditor.Font.Assign(Font); + tlInPlaceEditor.SelectAll; + Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.EndEdit(Sender: TObject); +begin + if tlInPlaceEditor <> nil then begin + if tlInPlaceEditor.Text <> FActiveTask.Description then begin + FActiveTask.Description := tlInPlaceEditor.Text; + FActiveTask.Changed := true; + DataStore.Resource.TasksDirty := true; + DataStore.PostTasks; + if Assigned(FAfterEdit) then + FAfterEdit(self, FActiveTask); + end; + + tlInPlaceEditor.Free; + tlInPlaceEditor := nil; + SetFocus; + Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.KeyDown(var Key: Word; Shift: TShiftState); +var + PopupPoint : TPoint; + +begin + case Key of + VK_UP : + if TaskIndex > 0 then + TaskIndex := TaskIndex - 1 + else + TaskIndex := Pred(DataStore.Resource.Tasks.Count); + VK_DOWN : + if TaskIndex < Pred(DataStore.Resource.Tasks.Count) then + TaskIndex := TaskIndex + 1 + else + TaskIndex := 0; + VK_NEXT : + if TaskIndex < Pred (DataStore.Resource.Tasks.Count) - + tlVisibleItems then + TaskIndex := TaskIndex + tlVisibleItems + else + TaskIndex := Pred(DataStore.Resource.Tasks.Count); + VK_PRIOR : + if TaskIndex > tlVisibleItems then + TaskIndex := TaskIndex - tlVisibleItems + else + TaskIndex := 0; + VK_HOME : TaskIndex := 0; + VK_END : TaskIndex := Pred(DataStore.Resource.Tasks.Count); + VK_DELETE : DeleteActiveTask(true); + VK_RETURN : tlSpawnTaskEditDialog (False); + VK_INSERT : tlSpawnTaskEditDialog (True); + VK_F2 : if Assigned (DataStore) then begin + if Assigned (DataStore.Resource) then + tlEditInPlace (Self); + end; + VK_SPACE : + if Assigned (FActiveTask) then begin + FActiveTask.Complete := not FActiveTask.Complete; + Invalidate; + end; +{$IFNDEF LCL} + VK_TAB : + if ssShift in Shift then + Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) + else + Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); +{$ENDIF} + VK_F10 : + if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + VK_APPS : + if not Assigned (PopupMenu) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + end; + + if TaskIndex < tlItemsBefore then + tlItemsBefore := TaskIndex; + if TaskIndex >= tlItemsBefore + tlVisibleItems then + tlItemsBefore := TaskIndex - tlVisibleItems + 1; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpTaskList.WMVScroll(var Msg: TWMVScroll); +{$ELSE} +procedure TVpTaskList.WMVScroll(var Msg: TLMVScroll); +{$ENDIF} +begin + { for simplicity, bail out of editing while scrolling. } + EndEdit(Self); + if tlInPlaceEditor <> nil then Exit; + + case Msg.ScrollCode of + SB_LINEUP : + if tlItemsBefore > 0 then + tlItemsBefore := tlItemsBefore - 1; + SB_LINEDOWN : + if tlItemsAfter > 0 then + tlItemsBefore := tlItemsBefore + 1; + SB_PAGEUP : + if tlItemsBefore >= tlVisibleItems then + tlItemsBefore := tlItemsBefore - tlVisibleItems + else + tlItemsBefore := 0; + SB_PAGEDOWN : + if tlItemsAfter >= tlVisibleItems then + tlItemsBefore := tlItemsBefore + tlVisibleItems + else + tlItemsBefore := tlAllTaskList.Count - tlVisibleItems; + SB_THUMBPOSITION, SB_THUMBTRACK : tlItemsBefore := Msg.Pos; + end; + Invalidate; +end; +{=====} + +procedure TVpTaskList.tlSetVScrollPos; +var + SI : TScrollInfo; +begin + if (not HandleAllocated) + or (DataStore = nil) + or (DataStore.Resource = nil) + or (csDesigning in ComponentState) + then Exit; + + with SI do begin + cbSize := SizeOf(SI); + fMask := SIF_RANGE or SIF_PAGE or SIF_POS; + nMin := 1; + nMax := tlAllTaskList.Count; + nPage := tlVisibleItems; + if tlItemsAfter = 0 then + nPos := tlAllTaskList.Count + else + nPos := tlItemsBefore; + nTrackPos := nPos; + end; + SetScrollInfo(Handle, SB_VERT, SI, True); +end; +{=====} +procedure TVpTaskList.SetShowIcon (const v : Boolean); +begin + if v <> FShowIcon then begin + FShowIcon := v; + Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.SetShowResourceName(Value: Boolean); +begin + if Value <> FShowResourceName then begin + FShowResourceName := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpTaskList.tlSetActiveTaskByCoord(Pnt: TPoint); +var + I: integer; +begin + if (DataStore = nil) or (DataStore.Resource = nil) then + Exit; + + if not ReadOnly and tlClickTimer.Enabled then + tlClickTimer.Enabled := false; + + TaskIndex := -1; + + for I := 0 to pred(Length(tlVisibleTaskArray)) do begin + { we've hit the end of active tasks, so bail } + if tlVisibleTaskArray[I].Task = nil then + Exit; + + { if the point is in an active task's check box... } + + if PointInRect(Pnt, tlVisibleTaskArray[I].CheckRect) then begin + { set the active task index } + TaskIndex := tlVisibleTaskToTaskIndex (I); + if not ReadOnly then begin + { toggle the complete flag. } + FActiveTask.Complete := not FActiveTask.Complete; + FActiveTask.Changed := true; + DataStore.Resource.TasksDirty := true; + DataStore.PostTasks; + Invalidate; + end; + Exit; + end; + + { if the point is in an active task..} + if PointInRect(Pnt, tlVisibleTaskArray[I].LineRect) then begin + { Set ActiveTask to the selected one } + TaskIndex := tlVisibleTaskToTaskIndex (I); + if not ReadOnly then + tlClickTimer.Enabled := true; + Exit; + end; + end; +end; +{=====} + +function TVpTaskList.tlVisibleTaskToTaskIndex (const VisTaskIndex : Integer) : Integer; +var + RealTask : TVpTask; + +begin + Result := -1; + if (VisTaskIndex < 0) or (VisTaskIndex >= Length (tlVisibleTaskArray)) then + Exit; + RealTask := TVpTask (tlVisibleTaskArray[VisTaskIndex].Task); + Result := RealTask.ItemIndex; +end; + +function TVpTaskList.tlTaskIndexToVisibleTask (const ATaskIndex : Integer) : Integer; +var + i : Integer; + +begin + Result := -1; + for i := 0 to Length (tlVisibleTaskArray) - 1 do + if ATaskIndex = TVpTask (tlVisibleTaskArray[i].Task).ItemIndex then begin + Result := i; + Break; + end; +end; + +{=====} + +end. + diff --git a/components/tvplanit/source/vptimerpool.pas b/components/tvplanit/source/vptimerpool.pas new file mode 100644 index 000000000..dbcfa475e --- /dev/null +++ b/components/tvplanit/source/vptimerpool.pas @@ -0,0 +1,640 @@ +{*********************************************************} +{* VPTIMERPOOL.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpTimerPool; + {-Timer Pool Class} + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Classes, Messages, SysUtils, Forms, VpException; + +type + TVpTimerTriggerEvent = + procedure(Sender : TObject; Handle : Integer; + Interval : Cardinal; ElapsedTime : LongInt) of object; + +type + PEventRec = ^TEventRec; + TEventRec = packed record + erHandle : Integer; {handle of this event record} + erInitTime : LongInt; {time when trigger was created} + erElapsed : LongInt; {total elapsed time (ms)} + erInterval : Cardinal; {trigger interval} + erLastTrigger : LongInt; {time last trigger was fired} + erOnTrigger : TVpTimerTriggerEvent; {method to call when fired} + erEnabled : Boolean; {true if trigger is active} + erRecurring : Boolean; {false for one time trigger} + end; + +type + TVpTimerPool = class(TComponent) + protected {private} + {property variables} + FOnAllTriggers : TVpTimerTriggerEvent; + + {internal variables} + tpList : TList; {list of event TEventRec records} + tpHandle : hWnd; {our window handle} + tpInterval : Cardinal; {the actual Window's timer interval} + tpEnabledCount : Integer; {count of active triggers} + + {property methods} + function GetElapsedTriggerTime(Handle : Integer) : LongInt; + function GetElapsedTriggerTimeSec(Handle : Integer) : LongInt; + function GetOnTrigger(Handle : Integer) : TVpTimerTriggerEvent; + function GetTriggerCount : Integer; + function GetTriggerEnabled(Handle : Integer) : Boolean; + function GetTriggerInterval(Handle : Integer) : Cardinal; + procedure SetOnTrigger(Handle : Integer; Value: TVpTimerTriggerEvent); + procedure SetTriggerEnabled(Handle : Integer; Value: Boolean); + procedure SetTriggerInterval(Handle : Integer; Value: Cardinal); + + {internal methods} + procedure tpCalcNewInterval; + {-calculates the needed interval for the window's timer} + function tpCountEnabledTriggers : Integer; + {-returns the number of enabled/active timer triggers} + function tpCreateTriggerHandle : Integer; + {-returns a unique timer trigger handle} + function tpEventIndex(Handle : Integer) : Integer; + {-returns the internal list index corresponding to the trigger handle} + procedure tpSortTriggers; + {-sorts the internal list of timer trigger event records} + procedure tpTimerWndProc(var Msg : TMessage); + {-window procedure to catch timer messages} + procedure tpUpdateTimer; + {-re-create the windows timer with a new timer interval} + + protected + procedure DoTriggerNotification; virtual; + {-conditionally sends notification of all events} + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function AddOneShot(OnTrigger : TVpTimerTriggerEvent; Interval : Cardinal) : Integer; + {-adds or updates one timer trigger. removed automatically after one firing} + function AddOneTime(OnTrigger : TVpTimerTriggerEvent; Interval : Cardinal) : Integer; + {-adds a new timer trigger. removed automatically after one firing} + function Add(OnTrigger : TVpTimerTriggerEvent; Interval : Cardinal) : Integer; + {-adds a new timer trigger and returns a handle} + procedure Remove(Handle : Integer); + {-removes the timer trigger} + procedure RemoveAll; + {-disable and destroy all timer triggers} + procedure ResetElapsedTime(Handle : Integer); + {-resets ElapsedTime for a given Trigger to 0} + + {public properties} + property Count : Integer read GetTriggerCount; + + property ElapsedTime[Handle : Integer] : LongInt read GetElapsedTriggerTime; + property ElapsedTimeSec[Handle : Integer] : LongInt + read GetElapsedTriggerTimeSec; + property Enabled[Handle : Integer] : Boolean read GetTriggerEnabled + write SetTriggerEnabled; + property Interval[Handle : Integer] : Cardinal read GetTriggerInterval + write SetTriggerInterval; + + {events} + property OnTrigger[Handle : Integer] : TVpTimerTriggerEvent read GetOnTrigger + write SetOnTrigger; + property OnAllTriggers : TVpTimerTriggerEvent read FOnAllTriggers + write FOnAllTriggers; + end; + +implementation +{$R-,Q-} + +const + tpDefMinInterval = 55; {smallest timer interval allowed} + tpDefHalfMinInterval = tpDefMinInterval div 2; + +{*** internal routines ***} + +function NewEventRec : PEventRec; +begin + GetMem(Result, SizeOf(TEventRec)); + FillChar(Result^, SizeOf(TEventRec), #0); +end; + +procedure FreeEventRec(ER : PEventRec); +begin + if (ER <> nil) then + FreeMem(ER, SizeOf(TEventRec)); +end; + + +{*** TVpTimerPool ***} + +constructor TVpTimerPool.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + {create internal list for trigger event records} + tpList := TList.Create; + + {allocate a window handle for the timer} +//TODO: tpHandle := {$IFDEF VERSION6}Classes.{$ENDIF}AllocateHWnd(tpTimerWndProc); +end; + +destructor TVpTimerPool.Destroy; +var + I : Integer; +begin + {force windows timer to be destroyed} + tpInterval := 0; + tpUpdateTimer; + + {free contents of list} + for I := 0 to tpList.Count-1 do + FreeEventRec(tpList[I]); + + {destroy the internal list} + tpList.Free; + tpList := nil; + + {deallocate our window handle} +//TODO: {$IFDEF VERSION6}Classes.{$ENDIF}DeallocateHWnd(tpHandle); + + inherited Destroy; +end; + +function TVpTimerPool.AddOneShot(OnTrigger : TVpTimerTriggerEvent; Interval : Cardinal) : Integer; + {-adds or updates one timer trigger. removed automatically after one firing} +var + I : Integer; +begin + {if this OnTrigger handler is already installed, remove it} + if Assigned(OnTrigger) then begin + for I := 0 to tpList.Count-1 do + with PEventRec(tpList[I])^ do + if @erOnTrigger = @OnTrigger then begin + Remove(erHandle); + Break; + end; + end; + {add the one-time trigger} + Result := AddOneTime(OnTrigger, Interval); +end; + +function TVpTimerPool.AddOneTime(OnTrigger : TVpTimerTriggerEvent; Interval : Cardinal) : Integer; + {-adds a new timer trigger. removed automatically after one firing} +var + I : Integer; +begin + {add trigger} + Result := Add(OnTrigger, Interval); + + {if added, set to non-recurring} + if (Result > -1) then begin + I := tpEventIndex(Result); + if I > -1 then + PEventRec(tpList[I])^.erRecurring := False + else + Result := -1; + end; +end; + +function TVpTimerPool.Add(OnTrigger : TVpTimerTriggerEvent; Interval : Cardinal) : Integer; + {-adds a new timer trigger and returns a handle} +var + ER : PEventRec; +begin + Result := -1; {assume error} + {create new event record} + ER := NewEventRec; + if (ER = nil) then + Exit; + + {force interval to be at least the minimum} + if Interval < tpDefMinInterval then + Interval := tpDefMinInterval; + + {fill event record} + with ER^ do begin + erEnabled := True; + erHandle := tpCreateTriggerHandle; + erInitTime := GetTickCount; + erElapsed := 0; + erInterval := Interval; + erLastTrigger := erInitTime; + erOnTrigger := OnTrigger; + erRecurring := True; + end; + + {add trigger record to the list} + tpList.Add(ER); + + {return the trigger event handle} + Result := ER^.erHandle; + + {re-calculate the number of active triggers} + tpEnabledCount := tpCountEnabledTriggers; + + {calculate new interval for the windows timer} + tpCalcNewInterval; + tpSortTriggers; + tpUpdateTimer; +end; + +procedure TVpTimerPool.DoTriggerNotification; + {-conditionally sends notification for all events} +var + ER : PEventRec; + TC : LongInt; + I : Integer; + ET : longint; +begin + TC := GetTickCount; + + {cycle through all triggers} + I := 0; + while I < tpList.Count do begin + ER := PEventRec(tpList[I]); + if ER^.erEnabled then begin + {is it time to fire this trigger} + if (TC < ER^.erLastTrigger) then + ET := (High(LongInt) - ER^.erLastTrigger) + (TC - Low(LongInt)) + else + ET := TC - ER^.erLastTrigger; + + if (ET >= LongInt(ER^.erInterval)-tpDefHalfMinInterval) then begin + {update event record with this trigger time} + ER^.erLastTrigger := TC; + + {check if total elapsed time for trigger >= MaxLongInt} + if ((MaxLongInt - ER^.erElapsed) < ET) then + ER^.erElapsed := MaxLongInt + else + ER^.erElapsed := ER^.erElapsed + ET; + + {call user event handler, if assigned} + if Assigned(ER^.erOnTrigger) then + ER^.erOnTrigger(Self, ER^.erHandle, ER^.erInterval, ER^.erElapsed); + + {call general event handler, if assigned} + if Assigned(FOnAllTriggers) then + FOnAllTriggers(Self, ER^.erHandle, ER^.erInterval, ER^.erElapsed); + + if not ER^.erRecurring then begin + Remove(ER^.erHandle); + Dec(I); {adjust loop index for this deletion} + end; + end; + end; + Inc(I); + end; +end; + +function TVpTimerPool.GetElapsedTriggerTime(Handle : Integer) : LongInt; + {-return the number of miliseconds since the timer trigger was created} +var + I : Integer; + ET : longint; + ER : PEventRec; + TC : LongInt; +begin + I := tpEventIndex(Handle); + if (I > -1) then begin + ER := PEventRec(tpList[I]); + if ER^.erElapsed = High(LongInt) then + Result := High(LongInt) + else begin + TC := GetTickCount; + if (TC < ER^.erInitTime) then begin + ET := (High(LongInt) - ER^.erInitTime) + (TC - Low(LongInt)); + if (ET < ER^.erElapsed) then + ER^.erElapsed := High(LongInt) + else + ER^.erElapsed := ET; + end else + ER^.erElapsed := TC - ER^.erInitTime; + Result := ER^.erElapsed; + end; + end else + raise EInvalidTriggerHandle.Create; +end; + +function TVpTimerPool.GetElapsedTriggerTimeSec(Handle : Integer) : LongInt; + {-return the number of seconds since the timer trigger was created} +begin + Result := GetElapsedTriggerTime(Handle) div 1000; +end; + +function TVpTimerPool.GetOnTrigger(Handle : Integer) : TVpTimerTriggerEvent; + {-returns the timer trigger's event method address} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then + Result := PEventRec(tpList[I])^.erOnTrigger + else + raise EInvalidTriggerHandle.Create; +end; + +function TVpTimerPool.GetTriggerCount : Integer; + {-returns the number of maintained timer triggers} +begin + Result := tpList.Count; +end; + +function TVpTimerPool.GetTriggerEnabled(Handle : Integer) : Boolean; + {-returns the timer trigger's enabled status} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then + Result := PEventRec(tpList[I])^.erEnabled + else + raise EInvalidTriggerHandle.Create; +end; + +function TVpTimerPool.GetTriggerInterval(Handle : Integer) : Cardinal; + {-returns the interval for the timer trigger with Handle} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then + Result := PEventRec(tpList[I])^.erInterval + else + raise EInvalidTriggerHandle.Create; +end; + +procedure TVpTimerPool.Remove(Handle : Integer); + {-removes the timer trigger} +var + ER : PEventRec; + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then begin + ER := PEventRec(tpList[I]); + tpList.Delete(I); + FreeEventRec(ER); + tpEnabledCount := tpCountEnabledTriggers; + tpCalcNewInterval; + tpUpdateTimer; + end; +end; + +procedure TVpTimerPool.RemoveAll; + {-disable and destroy all timer triggers} +var + ER : PEventRec; + I : Integer; +begin + for I := tpList.Count-1 downto 0 do begin + ER := PEventRec(tpList[I]); + tpList.Delete(I); + FreeEventRec(ER); + end; + tpEnabledCount := 0; + tpInterval := 0; + tpUpdateTimer; +end; + +procedure TVpTimerPool.ResetElapsedTime(Handle : Integer); + {-resets ElapsedTime for a given Trigger to 0} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then + PEventRec(tpList[I])^.erInitTime := LongInt(GetTickCount) + else + raise EInvalidTriggerHandle.Create; +end; + +procedure TVpTimerPool.SetOnTrigger(Handle : Integer; Value: TVpTimerTriggerEvent); + {-sets the method to call when the timer trigger fires} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then + PEventRec(tpList[I])^.erOnTrigger := Value + else + raise EInvalidTriggerHandle.Create; +end; + +procedure TVpTimerPool.SetTriggerEnabled(Handle : Integer; Value: Boolean); + {-sets the timer trigger's enabled status} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then begin + if (Value <> PEventRec(tpList[I])^.erEnabled) then begin + PEventRec(tpList[I])^.erEnabled := Value; + {If the timer is being activated, then initialize LastTrigger} + if PEventRec(tpList[I])^.erEnabled then + PEventRec(tpList[I])^.erLastTrigger := GetTickCount; + tpEnabledCount := tpCountEnabledTriggers; + tpCalcNewInterval; + tpUpdateTimer; + end; + end else + raise EInvalidTriggerHandle.Create; +end; + +procedure TVpTimerPool.SetTriggerInterval(Handle : Integer; Value : Cardinal); + {-sets the timer trigger's interval} +var + I : Integer; +begin + I := tpEventIndex(Handle); + if (I > -1) then begin + if Value <> PEventRec(tpList[I])^.erInterval then begin + PEventRec(tpList[I])^.erInterval := Value; + tpCalcNewInterval; + tpUpdateTimer; + end; + end else + raise EInvalidTriggerHandle.Create; +end; + +procedure TVpTimerPool.tpCalcNewInterval; + {-calculates the needed interval for the window's timer} +var + I : Integer; + N, V : LongInt; + TR : LongInt; + ER : PEventRec; + TC : LongInt; + Done : Boolean; +begin + {find shortest trigger interval} + TC := GetTickCount; + tpInterval := High(Cardinal); + for I := 0 to tpList.Count-1 do begin + ER := PEventRec(tpList[I]); + if ER^.erEnabled then begin + if (ER^.erInterval < tpInterval) then + tpInterval := ER^.erInterval; + + {is this interval greater than the remaining time on any existing triggers} + TR := 0; + if (TC < ER^.erLastTrigger) then + TR := TR + MaxLongInt + else + TR := TC - ER^.erLastTrigger; + if LongInt(tpInterval) > (LongInt(ER^.erInterval) - TR) then + tpInterval := (LongInt(ER^.erInterval) - TR); + end; + end; + + {limit to smallest allowable interval} + if tpInterval < tpDefMinInterval then + tpInterval := tpDefMinInterval; + + if tpInterval = High(Cardinal) then + tpInterval := 0 + else begin + {find interval that evenly divides into all trigger intervals} + V := tpInterval; {use LongInt so it is possible for it to become (-)} + repeat + Done := True; + for I := 0 to tpList.Count-1 do begin + N := PEventRec(tpList[I])^.erInterval; + if (N mod V) <> 0 then begin + Dec(V, N mod V); + Done := False; + Break; + end; + end; + until Done or (V <= tpDefMinInterval); + + {limit to smallest allowable interval} + if V < tpDefMinInterval then + V := tpDefMinInterval; + + tpInterval := V; + end; +end; + +function TVpTimerPool.tpCountEnabledTriggers : Integer; + {-returns the number of enabled/active timer triggers} +var + I : Integer; +begin + Result := 0; + for I := 0 to tpList.Count-1 do + if PEventRec(tpList[I])^.erEnabled then + Inc(Result); +end; + +function TVpTimerPool.tpCreateTriggerHandle : Integer; + {-returns a unique timer trigger handle} +var + I : Integer; + H : Integer; +begin + Result := 0; + for I := 0 to tpList.Count-1 do begin + H := PEventRec(tpList[I])^.erHandle; + if H >= Result then + Result := H + 1; + end; +end; + +function TVpTimerPool.tpEventIndex(Handle : Integer) : Integer; + {-returns the internal list index corresponding to Handle} +var + I : Integer; +begin + Result := -1; + for I := 0 to tpList.Count-1 do + if PEventRec(tpList[I])^.erHandle = Handle then begin + Result := I; + Break; + end; +end; + +procedure TVpTimerPool.tpSortTriggers; + {-sorts the internal list of timer trigger event records} +var + I : Integer; + Done : Boolean; +begin + repeat + Done := True; + for I := 0 to tpList.Count-2 do begin + if (PEventRec(tpList[I])^.erInterval > + PEventRec(tpList[I+1])^.erInterval) then begin + tpList.Exchange(I, I+1); + Done := False; + end; + end; + until Done; +end; + +procedure TVpTimerPool.tpTimerWndProc(var Msg : TMessage); + {-window procedure to catch timer messages} +begin + with Msg do + if Msg = {$IFDEF LCL}LM_TIMER{$ELSE}WM_TIMER{$ENDIF} then + try + DoTriggerNotification; + except + Application.HandleException(Self); + end + {$IFNDEF LCL} + else + Result := DefWindowProc(tpHandle, Msg, wParam, lParam); + {$ENDIF} +end; + +procedure TVpTimerPool.tpUpdateTimer; + {-re-create the windows timer with a new timer interval} +begin + {remove existing timer, if any} + //TODO: + {$IFNDEF LCL} + if KillTimer(tpHandle, 1) then {ignore return value}; + + if (tpInterval <> 0) and (tpEnabledCount > 0) then + if SetTimer(tpHandle, 1, tpInterval, nil) = 0 then + raise ENoTimersAvailable.Create; + {$ENDIF} +end; + + +end. diff --git a/components/tvplanit/source/vpwavdlg.lfm b/components/tvplanit/source/vpwavdlg.lfm new file mode 100644 index 000000000..f753dfe6e --- /dev/null +++ b/components/tvplanit/source/vpwavdlg.lfm @@ -0,0 +1,99 @@ +object FrmSoundDialog: TFrmSoundDialog + Left = 328 + Height = 262 + Top = 242 + Width = 402 + HorzScrollBar.Page = 401 + VertScrollBar.Page = 261 + BorderStyle = bsDialog + Caption = 'FrmSoundDialog' + ClientHeight = 262 + ClientWidth = 402 + Font.Height = -11 + Font.Name = 'MS Sans Serif' + KeyPreview = True + OnCreate = FormCreate + OnKeyDown = FormKeyDown + Position = poScreenCenter + object PageControl1: TPageControl + Height = 262 + Width = 402 + TabStop = False + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 0 + object TabSheet1: TTabSheet + Caption = 'Select A Sound' + ClientHeight = 229 + ClientWidth = 398 + object PlayButton: TSpeedButton + Left = 204 + Height = 22 + Top = 163 + Width = 26 + Color = clBtnFace + Glyph.Data = { + DE010000424DDE01000000000000760000002800000024000000120000000100 + 0400000000006801000000000000000000001000000010000000000000000000 + 80000080000000808000800000008000800080800000C0C0C000808080000000 + FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00666666666666 + 6666666666666666666666660000666666660066666666666666668866666666 + 0000666666603086666666666666688886666666000066666603077866686666 + 66668887786668660000666660388FF866866666666888877866866600006666 + 03B07FF8686666666688787778686666000066003BF07FF8666666668887F877 + 7866666600006038BFB00FF866666668887F788778666666000063B7FBF080F8 + 6888866877F7F88878688886000063B7BFB070F866666668777F787878666666 + 000063F7FBF00FF866666668F7F7F8877866666600006633BFB07FF868666666 + 887F787778686666000066663BF07FF8668666666687F8777866866600006666 + 63B887F866686666666878877866686600006666663B07766666666666668787 + 7866666600006666666380866666666666666888866666660000666666660066 + 6666666666666688666666660000666666666666666666666666666666666666 + 0000 + } + NumGlyphs = 2 + OnClick = PlayButtonClick + end + object FileListBox1: TFileListBox + Left = 204 + Height = 121 + Top = 29 + Width = 185 + Directory = 'D:\lazarus' + ItemHeight = 13 + Mask = '*.wav' + OnChange = FileListBox1Change + TabOrder = 1 + TopIndex = -1 + end + object CBDefault: TCheckBox + Left = 204 + Height = 23 + Top = 5 + Width = 88 + Caption = 'CBDefault' + OnClick = CBDefaultClick + TabOrder = 0 + end + object OkBtn: TButton + Left = 220 + Height = 25 + Top = 205 + Width = 75 + Caption = 'OkBtn' + Default = True + OnClick = OkBtnClick + TabOrder = 3 + end + object CancelBtn: TButton + Left = 308 + Height = 25 + Top = 205 + Width = 75 + Caption = 'CancelBtn' + OnClick = CancelBtnClick + TabOrder = 2 + end + end + end +end diff --git a/components/tvplanit/source/vpwavdlg.lrs b/components/tvplanit/source/vpwavdlg.lrs new file mode 100644 index 000000000..0b756ca2e --- /dev/null +++ b/components/tvplanit/source/vpwavdlg.lrs @@ -0,0 +1,40 @@ +{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei } + +LazarusResources.Add('TFrmSoundDialog','FORMDATA',[ + 'TPF0'#15'TFrmSoundDialog'#14'FrmSoundDialog'#4'Left'#3'H'#1#6'Height'#3#6#1#3 + +'Top'#3#242#0#5'Width'#3#146#1#18'HorzScrollBar.Page'#3#145#1#18'VertScrollB' + +'ar.Page'#3#5#1#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#14'FrmSoundDialog' + +#12'ClientHeight'#3#6#1#11'ClientWidth'#3#146#1#11'Font.Height'#2#245#9'Font' + +'.Name'#6#13'MS Sans Serif'#10'KeyPreview'#9#8'OnCreate'#7#10'FormCreate'#9 + +'OnKeyDown'#7#11'FormKeyDown'#8'Position'#7#14'poScreenCenter'#0#12'TPageCon' + +'trol'#12'PageControl1'#6'Height'#3#6#1#5'Width'#3#146#1#7'TabStop'#8#10'Act' + +'ivePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2 + +#0#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#14'Select A Sound'#12'ClientHeig' + +'ht'#3#229#0#11'ClientWidth'#3#142#1#0#12'TSpeedButton'#10'PlayButton'#4'Lef' + +'t'#3#204#0#6'Height'#2#22#3'Top'#3#163#0#5'Width'#2#26#5'Color'#7#9'clBtnFa' + +'ce'#10'Glyph.Data'#10#226#1#0#0#222#1#0#0'BM'#222#1#0#0#0#0#0#0'v'#0#0#0'(' + +#0#0#0'$'#0#0#0#18#0#0#0#1#0#4#0#0#0#0#0'h'#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16 + +#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128 + +#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0 + +#255#0#255#0#255#255#0#0#255#255#255#0'ffffffffffffffffff'#0#0'ffff'#0'fffff' + +'fff'#136'ffff'#0#0'fff`0'#134'ffffffh'#136#134'fff'#0#0'fff'#3#7'xfhffff' + +#136#135'xfhf'#0#0'ff`8'#143#248'f'#134'fffh'#136#135'xf'#134'f'#0#0'ff'#3 + +#176''#248'hffff'#136'xwxhff'#0#0'f'#0';'#240''#248'ffff'#136#135#248'wxff' + +'f'#0#0'`8'#191#176#15#248'fffh'#136'x'#135'xfff'#0#0'c'#183#251#240#128#248 + +'h'#136#134'hw'#247#248#136'xh'#136#134#0#0'c'#183#191#176'p'#248'fffhwxxxf' + +'ff'#0#0'c'#247#251#240#15#248'fffh'#247#247#248#135'xfff'#0#0'f3'#191#176'' + +#248'hfff'#136'xwxhff'#0#0'ff;'#240''#248'f'#134'fff'#135#248'wxf'#134'f'#0 + +#0'ffc'#184#135#248'fhfffhx'#135'xfhf'#0#0'fff;'#7'vffffff'#135#135'xfff'#0#0 + +'fffc'#128#134'ffffffh'#136#134'fff'#0#0'ffff'#0'ffffffff'#136'ffff'#0#0'fff' + +'fffffffffffffff'#0#0#9'NumGlyphs'#2#2#7'OnClick'#7#15'PlayButtonClick'#0#0 + +#12'TFileListBox'#12'FileListBox1'#4'Left'#3#204#0#6'Height'#2'y'#3'Top'#2#29 + +#5'Width'#3#185#0#9'Directory'#6#10'D:\lazarus'#10'ItemHeight'#2#13#4'Mask'#6 + +#5'*.wav'#8'OnChange'#7#18'FileListBox1Change'#8'TabOrder'#2#1#8'TopIndex'#2 + +#255#0#0#9'TCheckBox'#9'CBDefault'#4'Left'#3#204#0#6'Height'#2#23#3'Top'#2#5 + +#5'Width'#2'X'#7'Caption'#6#9'CBDefault'#7'OnClick'#7#14'CBDefaultClick'#8'T' + +'abOrder'#2#0#0#0#7'TButton'#5'OkBtn'#4'Left'#3#220#0#6'Height'#2#25#3'Top'#3 + +#205#0#5'Width'#2'K'#7'Caption'#6#5'OkBtn'#7'Default'#9#7'OnClick'#7#10'OkBt' + +'nClick'#8'TabOrder'#2#3#0#0#7'TButton'#9'CancelBtn'#4'Left'#3'4'#1#6'Height' + +#2#25#3'Top'#3#205#0#5'Width'#2'K'#7'Caption'#6#9'CancelBtn'#7'OnClick'#7#14 + +'CancelBtnClick'#8'TabOrder'#2#2#0#0#0#0#0 +]); diff --git a/components/tvplanit/source/vpwavdlg.pas b/components/tvplanit/source/vpwavdlg.pas new file mode 100644 index 000000000..074381d44 --- /dev/null +++ b/components/tvplanit/source/vpwavdlg.pas @@ -0,0 +1,192 @@ +{*********************************************************} +{* VPWAVDLG.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +unit VpWavDlg; + +{$I vp.inc} + +interface + +{$WARNINGS OFF} {Some of this stuff in here isn't platform friendly} + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows, + {$ENDIF} + Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + FileCtrl, StdCtrls, ExtCtrls, Buttons, VpBase, ComCtrls; + +type + TFrmSoundDialog = class(TForm) + PageControl1: TPageControl; + TabSheet1: TTabSheet; + PlayButton: TSpeedButton; +// DriveComboBox1: TDriveComboBox; +// DirectoryListBox1: TDirectoryListBox; + FileListBox1: TFileListBox; + CBDefault: TCheckBox; + OkBtn: TButton; + CancelBtn: TButton; + procedure FileListBox1Change(Sender: TObject); + procedure PlayButtonClick(Sender: TObject); + procedure CBDefaultClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure OkBtnClick(Sender: TObject); + procedure CancelBtnClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + private + public + DingPath: string; + ReturnCode : TVpEditorReturnCode; + procedure Populate; + end; + +function ExecuteSoundFinder(var DingPath: string): Boolean; + +implementation + +uses +{$IFNDEF LCL} + mmSystem, +{$ENDIF} + VpSR; + +{$IFNDEF LCL} +{$R *.DFM} +{$ENDIF} + +function ExecuteSoundFinder(var DingPath: string): Boolean; +var + SoundFinder: TfrmSoundDialog; +begin + Result := false; + Application.CreateForm(TfrmSoundDialog, SoundFinder); + try + SoundFinder.DingPath := DingPath; + SoundFinder.Populate; + SoundFinder.ShowModal; + if SoundFinder.ReturnCode = rtCommit then begin + if SoundFinder.CBDefault.Checked then + DingPath := '' + else + DingPath := SoundFinder.FileListBox1.FileName; + Result := true; + end; + finally + SoundFinder.Release; + end; +end; +{=====} + +procedure TFrmSoundDialog.FileListBox1Change(Sender: TObject); +begin + if FileListBox1.Items.Count > 0 then begin + PlayButton.Enabled := true; + DingPath := FileListBox1.FileName; + end else begin + PlayButton.Enabled := false; + DingPath := ''; + end; +end; +{=====} + +procedure TFrmSoundDialog.PlayButtonClick(Sender: TObject); +begin + PlayButton.Enabled := false; +{$IFNDEF LCL} + SndPlaySound(PChar(FileListBox1.FileName), snd_Sync); +{$ENDIF} + PlayButton.Enabled := true; +end; +{=====} + +procedure TFrmSoundDialog.Populate; +var + Drive: char; +begin + TabSheet1.Caption := RSSelectASound; + Self.Caption := RSSoundFinder; + CBDefault.Caption := RSDefaultSound; + OkBtn.Caption := RSOkBtn; + CancelBtn.Caption := RSCancelBtn; + if DingPath = '' then begin + CBDefault.Checked := true; +// DirectoryListBox1.Directory := ExtractFileDir(ParamStr(0)); + end else begin + Drive := UpCase(ExtractFileDrive(DingPath)[1]); + if FileExists(DingPath) and (Drive in ['A'..'Z']) then begin +// DriveComboBox1.Drive := Drive; +// DirectoryListBox1.Directory := ExtractFileDir(DingPath); + FileListBox1.FileName := DingPath; + end else begin +// DirectoryListBox1.Directory := ExtractFileDir(ParamStr(0)); + end; + end; +end; +{=====} + +procedure TFrmSoundDialog.CBDefaultClick(Sender: TObject); +begin +// DriveComboBox1.Enabled := not CBDefault.Checked; +// DirectoryListBox1.Enabled := not CBDefault.Checked; + FileListBox1.Enabled := not CBDefault.Checked; + PlayButton.Enabled := not CBDefault.Checked; +end; +{=====} + +procedure TFrmSoundDialog.FormCreate(Sender: TObject); +begin + ReturnCode := rtAbandon; +end; +{=====} + +procedure TFrmSoundDialog.OkBtnClick(Sender: TObject); +begin + ReturnCode := rtCommit; + Close; +end; +{=====} + +procedure TFrmSoundDialog.CancelBtnClick(Sender: TObject); +begin + Close; +end; +{=====} + +procedure TFrmSoundDialog.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_ESCAPE then + Close; +end; + +end. + diff --git a/components/tvplanit/source/vpwavpe.pas b/components/tvplanit/source/vpwavpe.pas new file mode 100644 index 000000000..bce31a070 --- /dev/null +++ b/components/tvplanit/source/vpwavpe.pas @@ -0,0 +1,98 @@ +{*********************************************************} +{* VPWAVPE.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpWavPE; + {Wav File Property Editor } + +interface + +uses + {$IFDEF VERSION6} + {$IFNDEF LCL} + DesignIntf, DesignEditors,VCLEditors, + {$ELSE} + PropEdits, + LazarusPackageIntf, + FieldsEditor, + ComponentEditors, + {$ENDIF} + {$ELSE} + DsgnIntf, + {$ENDIF} + VpBase, VpWavDlg, Forms; + +type + {TWavFileProperty} + TWavFileProperty = class(TStringProperty) + public + function GetAttributes: TPropertyAttributes; override; + function GetValue : string; override; + procedure Edit; override; + end; + +implementation + +(*****************************************************************************) +{ TWavFileProperty } + +function TWavFileProperty.GetAttributes: TPropertyAttributes; +begin + Result := [paDialog]; +end; +{=====} + +function TWavFileProperty.GetValue : string; +begin + Result := inherited GetValue; +end; +{=====} + +procedure TWavFileProperty.Edit; +var + SoundFinder : TFrmSoundDialog; +begin + SoundFinder := TFrmSoundDialog.Create(Application); + try +// SoundFinder.DingPath := Value; + SoundFinder.Populate; + SoundFinder.ShowModal; +{ if SoundFinder.ReturnCode = rtCommit then begin + if SoundFinder.CBDefault.Checked then + Value := '' + else + Value := SoundFinder.FileListBox1.FileName; + end;} + finally + SoundFinder.Free; + end; +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpweekview.pas b/components/tvplanit/source/vpweekview.pas new file mode 100644 index 000000000..111d09419 --- /dev/null +++ b/components/tvplanit/source/vpweekview.pas @@ -0,0 +1,1956 @@ +{*********************************************************} +{* VPWEEKVIEW.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{ + This unit handles the TVpWeekView component as well as it's inline editor + and navigation. + + The rendering of Visual PlanIt components is a bit involved. The component's + Paint method calls RenderToCanvas. The RenderToCanvas method of each of + the visual VisualPlanIt controls is repsonsible both for drawing to the + screen (both design and run time) as well as printing. In the case of + printing, the component needs to render itself to an arbitrary rectangle + and possibly rotated (for the screen the rectangle is the ClientRect + and the rotation angle is always zero). To achieve that goal, the + functions in VpCanvasUtils are used to go between the rendering of the + control and the TCanvas that it needs to render to. +} +{$I Vp.INC} + +unit VpWeekView; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType,LCLIntf, + {$ELSE} + Windows,Messages, + {$ENDIF} + Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, + VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus, + VpDayView; + +type + TVpWeekdayRec = packed record + Rec : TRect; + Day : TDateTime; + end; + +type + TVpWeekdayArray = array of TVpWeekdayRec; + + { Forward Declarations } + TVpWeekView = class; + + TVpWvInPlaceEdit = class(TCustomEdit) + protected{private} + procedure CreateParams(var Params: TCreateParams); override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + public + constructor Create(AOwner: TComponent); override; + procedure Move(const Loc: TRect; Redraw: Boolean); + end; + + TVpWvHeadAttributes = class(TPersistent) + protected{ private } + FOwner: TVpWeekView; + FColor: TColor; + FFont: TVpFont; + procedure SetColor(const Value: TColor); + procedure SetFont(Value: TVpFont); + public + constructor Create(AOwner: TVpWeekView); + destructor Destroy; override; + property Owner: TVpWeekView read FOwner; + published + property Font: TVpFont read FFont write SetFont; + property Color: TColor read FColor write SetColor; + end; + + TVpDayHeadAttr = class(TPersistent) + protected{private} + FWeekView: TVpWeekView; + FFont: TFont; + FDateFormat: string; + FColor: TColor; + FBordered: Boolean; + procedure SetColor (Value: TColor); + procedure SetFont (Value: TFont); + procedure SetBordered (Value: Boolean); + procedure SetDateFormat(Value: string); + public + constructor Create(AOwner: TVpWeekView); + destructor Destroy; override; + property WeekView: TVpWeekView read FWeekView; + published + property Color: TColor read FColor write SetColor; + property DateFormat: string read FDateFormat write SetDateFormat; + property Font: TFont read FFont write SetFont; + property Bordered: Boolean read FBordered write SetBordered; + end; + + TVpWeekView = class(TVpLinkableControl) + protected{ private } + FActiveDate : TDateTime; + FColumnWidth : Integer; + FColor : TColor; + FDateLabelFormat : string; + FDayHeadAttributes : TVpDayHeadAttr; + FDrawingStyle : TVpDrawingStyle; + FActiveEvent : TVpEvent; + FHeadAttr : TVpWvHeadAttributes; + FEventFont : TFont; + FLineColor : TColor; + FLineCount : Integer; + FTimeFormat : TVpTimeFormat; + FShowEventTime : Boolean; + FVisibleLines : Integer; + FWeekStartsOn : TVpDayType; + FDefaultPopup : TPopupMenu; + FAllDayEventAttr : TVpAllDayEventAttributes; + { event variables } + FBeforeEdit : TVpBeforeEditEvent; + FAfterEdit : TVpAfterEditEvent; + FOwnerEditEvent : TVpEditEvent; + FOnAddEvent : TVpOnAddNewEvent; + { internal variables } + wvInLinkHandler : Boolean; + wvClickTimer : TTimer; + wvLoaded : Boolean; + wvRowHeight : Integer; + wvDayHeadHeight : Integer; + wvHeaderHeight : Integer; + wvStartDate : TDateTime; + wvSpinButtons : TUpDown; + wvEventList : TList; + wvEventArray : TVpEventArray; + wvWeekdayArray : TVpWeekdayArray; + wvActiveEventRec : TRect; + wvInPlaceEditor : TVpWvInPlaceEdit; + wvCreatingEditor : Boolean; + wvPainting : Boolean; + wvHotPoint : TPoint; + + { property methods } + procedure SetDrawingStyle(Value: TVpDrawingStyle); + procedure SetColor(Value: TColor); + procedure SetLineColor(Value: TColor); + procedure SetDateLabelFormat(Value: string); + procedure SetEventFont(Value: TFont); + procedure SetShowEventTime(Value: Boolean); + procedure SetTimeFormat(Value: TVpTimeFormat); + procedure SetActiveDate(Value: TDateTime); + procedure SetWeekStartsOn(Value: TVpDayType); + { internal methods } + procedure wvEditInPlace(Sender: TObject); + procedure wvHookUp; + procedure PopupAddEvent (Sender : TObject); + procedure PopupDeleteEvent (Sender : TObject); + procedure PopupEditEvent (Sender : TObject); + procedure PopupToday (Sender : TObject); + procedure PopupNextWeek (Sender : TObject); + procedure PopupPrevWeek (Sender : TObject); + procedure PopupNextMonth (Sender : TObject); + procedure PopupPrevMonth(Sender : TObject); + procedure PopupNextYear (Sender : TObject); + procedure PopupPrevYear (Sender : TObject); + procedure InitializeDefaultPopup; + procedure Paint; override; + procedure Loaded; override; + procedure wvSpawnEventEditDialog(NewEvent: Boolean); + procedure wvPopulate; + procedure wvSpinButtonClick(Sender: TObject; Button: TUDBtnType); + procedure CreateParams(var Params: TCreateParams); override; + procedure CreateWnd; override; + function EventAtCoord(Pt: TPoint): Boolean; + procedure wvSetDateByCoord(Point: TPoint); + procedure EditEvent; + procedure EndEdit(Sender: TObject); + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + { message handlers } + {$IFNDEF LCL} + procedure WMSize(var Msg: TWMSize); message WM_SIZE; + procedure WMLButtonDown(var Msg : TWMLButtonDown); message WM_LBUTTONDOWN; + procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; + procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN; + procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); + message CM_WANTSPECIALKEY; + {$ELSE} + procedure WMSize(var Msg: TLMSize); message LM_SIZE; + procedure WMLButtonDown(var Msg : TLMLButtonDown); message LM_LBUTTONDOWN; + procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; + procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; + {$ENDIF} + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure DeleteActiveEvent(Verify: Boolean); + procedure Invalidate; override; + procedure LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; + const Value: Variant); override; + function GetControlType : TVpItemType; override; + procedure EditSelectedEvent; + procedure PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + ADate : TDateTime); + procedure RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); override; + property ActiveEvent: TVpEvent read FActiveEvent; + property Date: TDateTime read FActiveDate write SetActiveDate; + property VisibleLines: Integer read FVisibleLines; + published + property AllDayEventAttributes: TVpAllDayEventAttributes + read FAllDayEventAttr write FAllDayEventAttr; + {inherited properties} + property Align; + property Anchors; + property TabStop; + property TabOrder; + + property Color: TColor + read FColor write SetColor; + + property DateLabelFormat: string + read FDateLabelFormat write SetDateLabelFormat; + + property DayHeadAttributes: TVpDayHeadAttr + read FDayHeadAttributes write FDayHeadAttributes; + + property DrawingStyle: TVpDrawingStyle + read FDrawingStyle write SetDrawingStyle; + + property EventFont: TFont + read FEventFont write SetEventFont; + + property HeadAttributes: TVpWvHeadAttributes + read FHeadAttr write FHeadAttr; + + property LineColor: TColor + read FLineColor write SetLineColor; + + property TimeFormat: TVpTimeFormat + read FTimeFormat write SetTimeFormat; + + property ShowEventTime: Boolean + read FShowEventTime write SetShowEventTime; + + property WeekStartsOn: TVpDayType + read FWeekStartsOn write SetWeekStartsOn; + + {events} + property AfterEdit : TVpAfterEditEvent + read FAfterEdit write FAfterEdit; + + property BeforeEdit: TVpBeforeEditEvent + read FBeforeEdit write FBeforeEdit; + + property OnAddEvent: TVpOnAddNewEvent + read FOnAddEvent write FOnAddEvent; + + property OnOwnerEditEvent: TVpEditEvent + read FOwnerEditEvent write FOwnerEditEvent; + + end; + +implementation + +uses + SysUtils, Math, Forms, Dialogs, VpEvntEditDlg; + +(*****************************************************************************) +{ TVpTGInPlaceEdit } + +constructor TVpWvInPlaceEdit.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + ParentCtl3D := False; + Ctl3D := False; + TabStop := False; + BorderStyle := bsNone; + {$IFDEF VERSION4} + DoubleBuffered := False; + {$ENDIF} +end; +{=====} + +procedure TVpWvInPlaceEdit.Move(const Loc: TRect; Redraw: Boolean); +begin + CreateHandle; + Redraw := Redraw or not IsWindowVisible(Handle); + with Loc do + SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top, + {SWP_SHOWWINDOW or }SWP_NOREDRAW); + if Redraw then Invalidate; + SetFocus; +end; +{=====} + +procedure TVpWvInPlaceEdit.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + Params.Style := Params.Style{ or ES_MULTILINE}; +end; +{=====} + +procedure TVpWvInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState); +var + Grid : TVpWeekView; +begin + Grid := TVpWeekView(Owner); + + case Key of + VK_RETURN: begin + Key := 0; + Grid.EndEdit(Self); + end; + + VK_UP: begin + Key := 0; + Grid.EndEdit(Self); + end; + + VK_DOWN: begin + Key := 0; + Grid.EndEdit(Self); + end; + + VK_ESCAPE: begin + Key := 0; + Grid.EndEdit(self); + end; + + else + inherited; + end; +end; +{=====} + +(*****************************************************************************) +{ TVpContactHeadAttr } +constructor TVpDayHeadAttr.Create(AOwner: TVpWeekView); +begin + inherited Create; + FWeekView := AOwner; + FDateFormat := 'dddd mmmm, dd'; + FFont := TFont.Create; + FFont.Assign(FWeekView.Font); + FFont.Size := 8; + FColor := clSilver; + FBordered := true; +end; +{=====} + +destructor TVpDayHeadAttr.Destroy; +begin + FFont.Free; +end; +{=====} + +procedure TVpDayHeadAttr.SetBordered(Value: Boolean); +begin + if Value <> FBordered then begin + FBordered := Value; + WeekView.Invalidate; + end; +end; +{=====} + +procedure TVpDayHeadAttr.SetDateFormat(Value: string); +begin + if Value <> FDateFormat then begin + FDateFormat := Value; + WeekView.Invalidate; + end; +end; +{=====} + +procedure TVpDayHeadAttr.SetColor(Value: TColor); +begin + if Value <> FColor then begin + FColor := Value; + WeekView.Invalidate; + end; +end; +{=====} + +procedure TVpDayHeadAttr.SetFont(Value: TFont); +begin + if Value <> FFont then begin + FFont.Assign(Value); + WeekView.Invalidate; + end; +end; +{=====} + +(*****************************************************************************) +{ TVpWeekView } + +constructor TVpWeekView.Create(AOwner: TComponent); +begin + inherited; + ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks]; + + { Create internal classes and stuff } + FDayHeadAttributes := TVpDayHeadAttr.Create(self); + FHeadAttr := TVpWvHeadAttributes.Create(self); + FAllDayEventAttr := TVpAllDayEventAttributes.Create (self); + + FEventFont := TFont.Create; + FEventFont.Assign(Font); + FShowEventTime := true; + wvInLinkHandler := false; + wvEventList := TList.Create; + wvClickTimer := TTimer.Create(self); + wvSpinButtons := TUpDown.Create(self); + wvSpinButtons.OnClick := wvSpinButtonClick; + wvSpinButtons.Orientation := udHorizontal; + wvSpinButtons.Min := -32768; + wvSpinButtons.Max := 32767; + wvHotPoint := Point(0, 0); + + { Set styles and initialize internal variables } + {$IFDEF VERSION4} + DoubleBuffered := true; + {$ENDIF} + + FWeekStartsOn := dtMonday; + wvClickTimer.Enabled := false; + wvClickTimer.Interval := ClickDelay; + wvClickTimer.OnTimer := wvEditInPlace; + wvCreatingEditor := false; + FDrawingStyle := ds3d; + wvPainting := false; + FColor := clWindow; + FLineColor := clGray; + FActiveDate := Now; + wvStartDate := trunc(GetStartOfWeek(Now, FWeekStartsOn)); + FTimeFormat := tf12Hour; + FDateLabelFormat := 'dddd, mmmm dd, yyyy'; + FColumnWidth := 200; + + { set up fonts and colors } + FDayHeadAttributes.Font.Name := 'Tahoma'; + FDayHeadAttributes.Font.Size := 10; + FDayHeadAttributes.Font.Style := []; + FDayHeadAttributes.Color := clBtnFace; + FDayHeadAttributes.Bordered := true; + + SetLength(wvEventArray, MaxVisibleEvents); + SetLength(wvWeekdayArray, 7); + + { size } + Height := 225; + Width := 300; + + FDefaultPopup := TPopupMenu.Create (Self); + InitializeDefaultPopup; + + FAllDayEventAttr.BackgroundColor := Color; + FAllDayEventAttr.EventBackgroundColor := clBtnFace; + FAllDayEventAttr.EventBorderColor := LineColor; + FAllDayEventAttr.Font.Assign (Font); + + wvHookUp; +end; +{=====} + +destructor TVpWeekView.Destroy; +begin + FDayHeadAttributes.Free; + FAllDayEventAttr.Free; + FHeadAttr.Free; + wvClickTimer.Free; + FEventFont.Free; + wvSpinButtons.Free; + wvEventList.Free; + FDefaultPopup.Free; + inherited; +end; +{=====} + +procedure TVpWeekView.Invalidate; +begin + inherited; +end; +{=====} + +procedure TVpWeekView.LinkHandler(Sender: TComponent; + NotificationType: TVpNotificationType; const Value: Variant); +begin + wvInLinkHandler := true; + try + case NotificationType of + neDateChange: begin + Date := Value; + end; + neDataStoreChange: Invalidate; + neInvalidate: Invalidate; + end; + finally + wvInLinkHandler := false; + end; +end; +{=====} + +procedure TVpWeekView.wvHookUp; +var + I: Integer; +begin + { If the component is being dropped on a form at designtime, then } + { automatically hook up to the first datastore component found } + if csDesigning in ComponentState then + for I := 0 to pred(Owner.ComponentCount) do begin + if (Owner.Components[I] is TVpCustomDataStore) then begin + DataStore := TVpCustomDataStore(Owner.Components[I]); + Exit; + end; + end; +end; +{=====} + +procedure TVpWeekView.Loaded; +begin + inherited; + wvLoaded := true; + wvPopulate; +end; +{=====} + +function TVpWeekView.GetControlType : TVpItemType; +begin + Result := itWeekView; +end; + +procedure TVpWeekView.Paint; +begin + RenderToCanvas (Canvas, // Paint Canvas + Rect (0, 0, Width, Height), // Paint Rectangle + ra0, + 1, // Scale + wvStartDate, // Date + -1, // Start At + -1, // End At + gr30Min, + False); // Display Only +end; +{=====} +procedure TVpWeekView.PaintToCanvas (ACanvas : TCanvas; + ARect : TRect; + Angle : TVpRotationAngle; + ADate : TDateTime); +begin + RenderToCanvas (ACanvas, ARect, Angle, 1, ADate, + -1, -1, gr30Min, True); +end; +{=====} + +procedure TVpWeekView.RenderToCanvas (RenderCanvas : TCanvas; + RenderIn : TRect; + Angle : TVpRotationAngle; + Scale : Extended; + RenderDate : TDateTime; + StartLine : Integer; + StopLine : Integer; + UseGran : TVpGranularity; + DisplayOnly : Boolean); +var + HeadRect : TRect; + SaveBrushColor : TColor; + SavePenStyle : TPenStyle; + SavePenColor : TColor; + DayRectHeight : Integer; + StrLn : Integer; + StartDate : TDateTime; + RealWidth : Integer; + RealHeight : Integer; + RealLeft : Integer; + RealRight : Integer; + RealTop : Integer; + RealBottom : Integer; + ADEventsRect : TRect; + Rgn : HRGN; + + DotDotDotColor : TColor; + BevelHighlightColor : TColor; + BevelShadowColor : TColor; + BevelDarkShadow : TColor; + BevelButtonFace : TColor; + RealLineColor : TColor; + RealDayHeadAttrColor : TColor; + RealColor : TColor; + RealHeadAttrColor : TColor; + ADBackgroundColor : TColor; + ADEventBackgroundColor : TColor; + ADEventBorderColor : TColor; + + function DrawAllDayEvents ( ADate : TDateTime; + DayRect : TRect; + var EAIndex : Integer) : Boolean; + var + ADEventsList : TList; + TempList : TList; + I, J, K : Integer; + Event : TVpEvent; + ADEventRect : TRect; + StartsBeforeRange : Boolean; + MaxADEvents : Integer; + Skip : Boolean; + ADTextHeight : Integer; + EventStr : string; + + begin + Result := False; + { initialize the All Day Events area... } + ADEventsRect := DayRect; + + if (DataStore = nil) or (DataStore.Resource = nil) then + Exit; + + { Collect all of the events for this range and determine the maximum } + { number of all day events for the range of days covered by the control. } + MaxADEvents := 0; + + ADEventsList := TList.Create; + try + TempList := TList.Create; + try + { get the all day events for the day specified by ADate + I } + DataStore.Resource.Schedule.AllDayEventsByDate(ADate, TempList); + + { Iterate through these events and place them in ADEventsList } + Skip := false; + for J := 0 to pred(TempList.Count) do begin + if AdEventsList.Count > 0 then begin + for K := 0 to pred(AdEventsList.Count) do begin + if TVpEvent(AdEventsList[K]) = TVpEvent(TempList[J]) then begin + Skip := true; + Break; + end; + end; + if not Skip then + AdEventsList.Add(TempList[J]); + end else + AdEventsList.Add(TempList[J]); + end; + + if TempList.Count > MaxADEvents then + MaxADEvents := TempList.Count; + finally + TempList.Free; + end; + + if MaxADEvents > 0 then begin + { Set attributes } + RenderCanvas.Brush.Color := ADBackgroundColor; + RenderCanvas.Font.Assign (AllDayEventAttributes.Font); + + { Measure the AllDayEvent TextHeight } + ADTextHeight := RenderCanvas.TextHeight(VpProductName) + + TextMargin + TextMargin div 2; + + { Build the AllDayEvent rect based on the value of MaxADEvents } + if AdEventsRect.Top + (MaxADEvents * ADTextHeight) + + TextMargin * 2 > DayRect.Bottom then + ADeventsrect.Bottom := DayRect.Bottom + else + ADEventsRect.Bottom := AdEventsRect.Top + + (MaxADEvents * ADTextHeight) + TextMargin * 2; + + { Clear the AllDayEvents area } + TpsFillRect(RenderCanvas, Angle, RenderIn, ADEventsRect); + + StartsBeforeRange := false; + { Cycle through the all day events and draw them appropriately } + for I := 0 to pred(ADEventsList.Count) do begin + + Event := ADEventsList[I]; + + { set the top of the event's rect } + AdEventRect.Top := ADEventsRect.Top + TextMargin + + (I * ADTextHeight); + + if ADEventsRect.Top + TextMargin + ((I + 1) * ADTextHeight) - + TextMargin > DayRect.Bottom then begin + RenderCanvas.Brush.Color := DotDotDotColor; + { draw dot dot dot } + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Right - 20, DayRect.Bottom - 7, + DayRect.Right - 17, DayRect.Bottom - 4)); + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Right - 13, DayRect.Bottom - 7, + DayRect.Right - 10, DayRect.Bottom - 4)); + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Right - 6, DayRect.Bottom - 7, + DayRect.Right - 3, DayRect.Bottom - 4)); + break; + end; + + { see if the event began before the start of the range } + if (Event.StartTime < trunc(RenderDate)) then + StartsBeforeRange := true; + + AdEventRect.Bottom := ADEventRect.Top + ADTextHeight; + AdEventRect.Left := AdEventsRect.Left + (TextMargin div 2); + AdEventRect.Right := DayRect.Right; + + if (StartsBeforeRange) then + EventStr := '>> ' + else + EventStr := ''; + + EventStr := EventStr + Event.Description; + + RenderCanvas.Brush.Color := ADEventBackgroundColor; + RenderCanvas.Pen.Color := ADEventBorderColor; + TPSRectangle (RenderCanvas, Angle, RenderIn, + ADEventRect.Left + TextMargin, + ADEventRect.Top + TextMargin div 2, + ADEventRect.Right - TextMargin, + ADEventRect.Top + ADTextHeight + TextMargin div 2); + TPSTextOut (RenderCanvas,Angle, RenderIn, + AdEventRect.Left + TextMargin * 2 + TextMargin div 2, + AdEventRect.Top + TextMargin, + EventStr); + Result := True; + wvEventArray[EAIndex].Rec := Rect (ADEventRect.Left + TextMargin, + ADEventRect.Top + TextMargin, + ADEventRect.Right - TextMargin, + ADEventRect.Bottom); + wvEventArray[EAIndex].Event := Event; + Inc (EAIndex); + end; { for I := 0 to pred(ADEventsList.Count) do ... } + + end; { if MaxADEvents > 0 } + + finally + ADEventsList.Free; + end; + end; + + procedure DrawDays; + var + DayRect : TRect; + TextRect : TRect; + I, J, SL : Integer; + EAIndex : Integer; + DayStr : string; + EventList: TList; + begin + RenderCanvas.Pen.Color := RealLineColor; + RenderCanvas.Pen.Style := psSolid; + { initialize WeekdayArray } + for I := 0 to pred(Length(wvWeekdayArray)) do begin + wvWeekdayArray[I].Rec.TopLeft := Point(-1, -1); + wvWeekdayArray[I].Rec.BottomRight := Point(-1, -1); + wvWeekdayArray[I].Day := 0; + end; + + { initialize Event Array } + EAIndex := 0; + for I := 0 to pred(Length(wvEventArray)) do begin + wvEventArray[I].Rec.TopLeft := Point(-1, -1); + wvEventArray[I].Rec.BottomRight := Point(-1, -1); + wvEventArray[I].Event := nil; + end; + + RenderCanvas.Pen.Color := RealLineColor; + { build the first dayrect } + DayRectHeight := (RealBottom - RealTop - wvHeaderHeight) div 3; + if DrawingStyle = ds3D then + DayRect.TopLeft := Point (RealLeft + 1, + RealTop + wvHeaderHeight + 3) + else + DayRect.TopLeft := Point (RealLeft + 1, + RealTop + wvHeaderHeight + 2); + DayRect.BottomRight := Point ((RealLeft + (RealRight - RealLeft) div 2) + 1, + RealTop + wvHeaderHeight + DayRectHeight); + { draw the day frames } + for I := 0 to 6 do begin + { draw day head} + RenderCanvas.Font.Assign(FDayHeadAttributes.Font); + RenderCanvas.Brush.Color := RealDayHeadAttrColor; + TextRect := Rect(DayRect.Left, DayRect.Top, DayRect.Right, DayRect.Top + + wvDayHeadHeight); + TPSFillRect (RenderCanvas, Angle, RenderIn, TextRect); + if FDayHeadAttributes.Bordered then + TPSRectangle (RenderCanvas, Angle, RenderIn, TextRect); + { Fix Header String } + DayStr := FormatDateTime(FDayHeadAttributes.DateFormat, StartDate + I); + SL := RenderCanvas.TextWidth(DayStr); + if SL > TextRect.Right - TextRect.Left then begin + DayStr := GetDisplayString(RenderCanvas, DayStr, 0, TextRect.Right - + TextRect.Left - TextMargin); + end; + SL := RenderCanvas.TextWidth(DayStr); + TextRect.Left := TextRect.Right - SL - TextMargin; + TPSTextOut (RenderCanvas, Angle, RenderIn, + TextRect.Left, TextRect.Top + TextMargin - 1, DayStr); + + if (DataStore <> nil) and (DataStore.Resource <> nil) + and (DataStore.Resource.Schedule.EventCountByDay(StartDate + I) > 0) + and (DayRect.Bottom - DayRect.Top >= (TextMargin * 2) + wvDayHeadHeight) then + begin + { events exist for this day } + EventList := TList.Create; + try + { populate the eventlist with events for this day } + DataStore.Resource.Schedule.EventsByDate(StartDate + I, EventList); + { initialize TextRect for this day } + TextRect.TopLeft := Point (DayRect.Left, + DayRect.Top + wvDayHeadHeight); + TextRect.BottomRight := Point (DayRect.Right, + TextRect.Top + wvRowHeight); + + { Handle All Day Events } + if DrawAllDayEvents (StartDate + I, + Rect (TextRect.Left, + TextRect.Top, + TextRect.Right, + DayRect.Bottom), + EAIndex) then begin + TextRect.Bottom := TextRect.Bottom + (ADEventsRect.Bottom - TextRect.Top); + TextRect.Top := ADEventsRect.Bottom; + end; + + { Discard AllDayEvents, because they are drawn above. } + for J := pred(EventList.Count) downto 0 do + if TVpEvent (EventList[J]).AllDayEvent then + EventList.Delete(J); + + { iterate the events, painting them one by one } + for J := 0 to pred(EventList.Count) do begin + { if the TextRect extends below the available space then draw a } + { dot dot dot to indicate there are more events than can be drawn } + { in the available space } + if TextRect.Bottom - TextMargin > DayRect.Bottom then begin + RenderCanvas.Brush.Color := DotDotDotColor; + { draw dot dot dot } + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Right - 20, DayRect.Bottom - 7, + DayRect.Right - 17, DayRect.Bottom - 4)); + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Right - 13, DayRect.Bottom - 7, + DayRect.Right - 10, DayRect.Bottom - 4)); + TPSFillRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Right - 6, DayRect.Bottom - 7, + DayRect.Right - 3, DayRect.Bottom - 4)); + break; + end; + + { format the display text } + DayStr := ''; + if ShowEventTime then begin + if TimeFormat = tf24Hour then + DayStr := FormatDateTime('hh:mm', + TVpEvent(EventList.List^[j]).StartTime) + + ' - ' + FormatDateTime('hh:mm', + TVpEvent(EventList.List^[j]).EndTime) + ': ' + else + DayStr := FormatDateTime('hh:mm AM/PM', + TVpEvent(EventList.List^[j]).StartTime) + + ' - ' + FormatDateTime('hh:mm AM/PM', + TVpEvent(EventList.List^[j]).EndTime) + ': '; + end; + + if DayStr = '' then + DayStr := TVpEvent(EventList.List^[j]).Description + else + DayStr := DayStr + ' ' + + TVpEvent(EventList.List^[j]).Description; + + { set the event font } + RenderCanvas.Font.Assign(FEventFont); + RenderCanvas.Brush.Color := RealColor; + + StrLn := RenderCanvas.TextWidth(DayStr); + if (StrLn > TextRect.Right - TextRect.Left - TextMargin) then + begin + DayStr := GetDisplayString(RenderCanvas, DayStr, 0, TextRect.Right - + TextRect.Left - (TextMargin * 2)); + end; + + { write the event text } + TPSTextOut (RenderCanvas, Angle, RenderIn, + TextRect.Left + TextMargin, + TextRect.Top + (TextMargin div 2), DayStr); + + { update the EventArray } + wvEventArray[EAIndex].Rec := TextRect; + wvEventArray[EAIndex].Event := TVpEvent(EventList.List^[j]); + Inc(EAIndex); + + TextRect.Top := TextRect.Bottom; + TextRect.Bottom := TextRect.Top + wvRowHeight; + end; { for loop } + finally + EventList.Free; + end; + end; + + { Draw focus rect if this is the current day } + + if (not DisplayOnly) and + (StartDate + I = Trunc (FActiveDate)) and + (Focused) then + TPSDrawFocusRect (RenderCanvas, Angle, RenderIn, + Rect (DayRect.Left + 2, + DayRect.Top + wvDayHeadHeight + 2, + DayRect.Right - 2, + DayRect.Bottom - 2)); + + { update WeekdayArray } + wvWeekdayArray[I].Rec := DayRect; + wvWeekdayArray[I].Day := StartDate + I; + { adjust the DayRect for the next day } + if (I = 2) then begin + { move the dayrect to the top of the next column } + if DrawingStyle = ds3D then begin + DayRect.TopLeft := Point (RealLeft + (RealRight - RealLeft) div 2, + RealTop + wvHeaderHeight + 3); + DayRect.BottomRight := Point (RealRight - 2, + RealTop + wvHeaderHeight + DayRectHeight); + end + else begin + DayRect.TopLeft := Point (RealLeft + (RealRight - RealLeft) div 2, + RealTop + wvHeaderHeight + 2); + DayRect.BottomRight := Point (RealRight - 1, + RealTop + wvHeaderHeight + DayRectHeight); + end; + end + + else if (I = 4 {Friday}) then begin + { shrink DayRect for weekend days } + DayRectHeight := DayRectHeight div 2; + DayRect.Top := DayRect.Bottom; + DayRect.Bottom := DayRect.Top + DayRectHeight; + end + else begin + DayRect.Top := DayRect.Bottom; + DayRect.Bottom := DayRect.Top + DayRectHeight; + end; + + end; + + { Draw the center vertical line } + RenderCanvas.Pen.Color := RealLineColor; + TPSMoveTo (RenderCanvas, Angle, RenderIn, + RealLeft + (RealRight - RealLeft) div 2, + RealTop + wvHeaderHeight + 2); + TPSLineTo (RenderCanvas, Angle, RenderIn, + RealLeft + (RealRight - RealLeft) div 2, + RealBottom - 1); + + if (DataStore = nil) + or (DataStore.Resource = nil) + or (DataStore.Resource.Tasks.Count = 0) + then Exit; + end; + {-} + + procedure Clear; + begin + RenderCanvas.Brush.Color := RealColor; + RenderCanvas.FillRect (RenderIn); + end; + {-} + + procedure SetMeasurements; + begin + RealWidth := TPSViewportWidth (Angle, RenderIn); + RealHeight := TPSViewportHeight (Angle, RenderIn); + RealLeft := TPSViewportLeft (Angle, RenderIn); + RealRight := TPSViewportRight (Angle, RenderIn); + RealTop := TPSViewportTop (Angle, RenderIn); + RealBottom := TPSViewportBottom (Angle, RenderIn); + + if RenderDate = 0 then + StartDate := GetStartOfWeek (wvStartDate, FWeekStartsOn) + else + StartDate := GetStartOfWeek (RenderDate, FWeekStartsOn); + + RenderCanvas.Font.Assign(FDayHeadAttributes.Font); + wvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2 ; + RenderCanvas.Font.Assign(FEventFont); + wvRowHeight := RenderCanvas.TextHeight(VpProductName) + (TextMargin div 2); + RenderCanvas.Font.Assign(TFont(FHeadAttr.Font)); + wvHeaderHeight := RenderCanvas.TextHeight(VpProductName) + (TextMargin * 2); + end; + {-} + + procedure DrawHeader; + var + HeadTextRect: TRect; + HeadStr: string; + HeadStrLen : Integer; + begin + RenderCanvas.Brush.Color := RealHeadAttrColor; + RenderCanvas.Font.Assign(TFont(FHeadAttr.Font)); + { draw the header cell and borders } + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + HeadRect.Left := RealLeft + 1; + HeadRect.Top := RealTop + 1; + HeadRect.Right := RealRight - 1; + HeadRect.Bottom := HeadRect.Top + wvHeaderHeight; + TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, HeadRect), + BevelHighlightColor, BevelShadowColor); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + HeadRect.Left := RealLeft + 2; + HeadRect.Top := RealTop + 2; + HeadRect.Right := RealRight - 3; + HeadRect.Bottom := RealTop + wvHeaderHeight; + TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, HeadRect), + BevelHighlightColor, BevelDarkShadow); + end; + { build header caption } + HeadStr := HeadStr + RSWeekof + ' ' + + FormatDateTime(DateLabelFormat, StartDate); + { draw the text } + if (DisplayOnly) and + (RenderCanvas.TextWidth (HeadStr) >= RenderIn.Right - RenderIn.Left) then + HeadTextRect.TopLeft:= Point (RealLeft + TextMargin * 2, + HeadRect.Top) + else if DisplayOnly then + HeadTextRect.TopLeft := Point (RealLeft + (RealRight - RealLeft - + RenderCanvas.TextWidth (HeadStr)) div 2, + HeadRect.Top) + else + HeadTextRect.TopLeft := Point (RealLeft + 30 + TextMargin * 2, + HeadRect.Top); + HeadTextRect.BottomRight := HeadRect.BottomRight; + { Fix Header String } + HeadStrLen := RenderCanvas.TextWidth(HeadStr); + if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left - TextMargin then + begin + HeadStr := GetDisplayString(RenderCanvas, HeadStr, 0, + HeadTextRect.Right - HeadTextRect.Left - TextMargin ); + end; + { position the spinner } + wvSpinButtons.Height := Trunc(wvHeaderHeight * 0.8); + wvSpinButtons.Width := wvSpinButtons.Height * 2; + wvSpinButtons.Left := TextMargin; + wvSpinButtons.Top := (wvHeaderHeight - wvSpinButtons.Height) div 2 + 2; + TPSTextOut (RenderCanvas, Angle, RenderIn, HeadTextRect.Left + TextMargin, + HeadTextRect.Top + TextMargin, HeadStr); + end; + {-} + + procedure DrawBorders; + begin + if FDrawingStyle = dsFlat then begin + { draw an outer and inner bevel } + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, + Rect (RealLeft, RealTop, + RealRight - 1, RealBottom - 1)), + BevelShadowColor, + BevelHighlightColor); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, + Rect (RealLeft + 1, RealTop + 1, + RealRight - 2, RealBottom - 2)), + BevelShadowColor, + BevelHighlightColor); + end else if FDrawingStyle = ds3d then begin + { draw a 3d bevel } + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, + Rect (RealLeft, RealTop, + RealRight - 1, RealBottom - 1)), + BevelShadowColor, + BevelShadowColor); + DrawBevelRect (RenderCanvas, + TPSRotateRectangle (Angle, RenderIn, + Rect (RealLeft + 1, RealTop + 1, + RealRight - 2, RealBottom - 2)), + BevelDarkShadow, + BevelButtonFace); + end; + end; + {-} +begin + + if DisplayOnly then begin + BevelHighlightColor := clBlack; + BevelShadowColor := clBlack; + BevelDarkShadow := clBlack; + BevelButtonFace := clBlack; + RealLineColor := clBlack; + RealColor := clWhite; + RealDayHeadAttrColor := clSilver; + RealHeadAttrColor := clSilver; + ADBackgroundColor := clWhite; + ADEventBackgroundColor := clWhite; + ADEventBorderColor := clSilver; + end else begin + BevelHighlightColor := clBtnHighlight; + BevelShadowColor := clBtnShadow; + BevelDarkShadow := cl3DDkShadow; + BevelButtonFace := clBtnFace; + RealLineColor := LineColor; + RealColor := Color; + RealDayHeadAttrColor := FDayHeadAttributes.Color; + RealHeadAttrColor := FHeadAttr.Color; + ADBackgroundColor := AllDayEventAttributes.BackgroundColor; + ADEventBackgroundColor := AllDayEventAttributes.EventBackgroundColor; + ADEventBorderColor := AllDayEventAttributes.EventBorderColor; + end; + DotDotDotColor := clBlack; + + wvPainting := true; + SavePenStyle := RenderCanvas.Pen.Style; + SaveBrushColor := RenderCanvas.Brush.Color; + SavePenColor := RenderCanvas.Pen.Color; + + RenderCanvas.Pen.Style := psSolid; + RenderCanvas.Pen.Width := 1; + RenderCanvas.Pen.Mode := pmCopy; + RenderCanvas.Brush.Style := bsSolid; + + Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top, + RenderIn.Right, RenderIn.Bottom); + try + SelectClipRgn (RenderCanvas.Handle, Rgn); + + { clear client area } + Clear; + + { measure the row heights } + SetMeasurements; + + { draw header } + DrawHeader; + + { draw days } + DrawDays; + + { draw the borders } + DrawBorders; + + { reinstate canvas settings} + + finally + SelectClipRgn (RenderCanvas.Handle, 0); + DeleteObject (Rgn); + end; + + RenderCanvas.Pen.Style := SavePenStyle; + RenderCanvas.Brush.Color := SaveBrushColor; + RenderCanvas.Pen.Color := SavePenColor; + wvPainting := false; +end; + +{=====} + +procedure TVpWeekView.wvPopulate; +begin + if DataStore <> nil then + DataStore.Date := FActiveDate; +end; +{=====} + +procedure TVpWeekView.DeleteActiveEvent(Verify: Boolean); +var + Str: string; + DoIt: Boolean; +begin + DoIt := not Verify; + + if FActiveEvent <> nil then begin + Str := '"' + FActiveEvent.Description + '"'; + + if Verify then + DoIt := (MessageDlg(RSDelete + ' ' + Str + ' ' + RSFromSchedule + + #13#10#10 + RSPermanent, mtconfirmation, + [mbYes, mbNo], 0) = mrYes); + + if DoIt then begin + FActiveEvent.Deleted := true; + FActiveEvent := nil; + DataStore.PostEvents; + Invalidate; + end; + end; +end; +{=====} + + +procedure TVpWeekView.wvSpinButtonClick(Sender: TObject; Button: TUDBtnType); +begin + if Button = btNext then + Date := Date + 7 + else + Date := Date - 7; +end; +{=====} + +procedure TVpWeekView.SetColor(Value: TColor); +begin + if FColor <> Value then begin + FColor := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpWeekView.SetDrawingStyle(Value: TVpDrawingStyle); +begin + if FDrawingStyle <> Value then begin + FDrawingStyle := Value; + Repaint; + end; +end; +{=====} + +procedure TVpWeekView.SetLineColor(Value: TColor); +begin + if FLineColor <> Value then begin + FLineColor := Value; + Repaint; + end; +end; +{=====} + +procedure TVpWeekView.SetDateLabelFormat(Value: string); +begin + if Value <> FDateLabelFormat then begin + FDateLabelFormat := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpWeekView.SetEventFont(Value: TFont); +begin + FEventFont.Assign(Value); + Invalidate; +end; +{=====} + +procedure TVpWeekView.SetShowEventTime(Value: Boolean); +begin + if Value <> FShowEventTIme then begin + FShowEventTime := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpWeekView.SetTimeFormat(Value: TVpTimeFormat); +begin + if Value <> FTimeFormat then begin + FTimeFormat := Value; + Invalidate; + end; +end; +{=====} + +procedure TVpWeekView.SetActiveDate(Value: TDateTime); +begin + if FActiveDate <> Value then begin + FActiveDate := Value; + + if (Value < wvStartDate) or (Value >= wvStartDate + 7) then + wvStartDate := Trunc(GetStartOfWeek(Value, FWeekStartsOn)); + + if wvStartDate > Value then + wvStartDate := wvStartDate - 7; + + if wvLoaded then + wvPopulate; + + Invalidate; + + if (not wvInLinkHandler) and (ControlLink <> nil) then + ControlLink.Notify(self, neDateChange, FActiveDate); + end; +end; +{=====} + +procedure TVpWeekView.SetWeekStartsOn(Value: TVpDayType); +begin + if FWeekStartsOn <> Value then begin + FWeekStartsOn := Value; + Invalidate; + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpWeekView.WMSize(var Msg: TWMSize); +{$ELSE} +procedure TVpWeekView.WMSize(var Msg: TLMSize); +{$ENDIF} +begin + inherited; + { force a repaint on resize } + Invalidate; +end; +{=====} + +procedure TVpWeekView.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + Style := Style or WS_TABSTOP; +{$IFNDEF LCL} + WindowClass.style := CS_DBLCLKS; +{$ENDIF} + end; +end; +{=====} + +procedure TVpWeekView.CreateWnd; +begin + inherited; + wvSpinButtons.Parent := self; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpWeekView.WMLButtonDown(var Msg : TWMLButtonDown); +{$ELSE} +procedure TVpWeekView.WMLButtonDown(var Msg : TLMLButtonDown); +{$ENDIF} +begin + inherited; + + if not Focused then SetFocus; + + if wvInPlaceEditor <> nil then + EndEdit(Self); + + if (Msg.YPos > wvHeaderHeight) then + begin + { If an active event was clicked, then enable the click timer. If the } + { item is double clicked before the click timer fires, then the edit } + { dialog will appear, otherwise the in-place editor will appear. } + if EventAtCoord(Point(Msg.XPos, Msg.YPos)) then + wvClickTimer.Enabled := true; + + { The mouse click landed inside the client area } + wvSetDateByCoord(Point(Msg.XPos, Msg.YPos)); + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpWeekView.WMLButtonDblClk(var Msg : TWMLButtonDblClk); +{$ELSE} +procedure TVpWeekView.WMLButtonDblClk(var Msg : TLMLButtonDblClk); +{$ENDIF} +var + StartTime, EndTime: TDateTime; +begin + inherited; + wvClickTimer.Enabled := false; + + if not CheckCreateResource then + Exit; + + if DataStore = nil then + Exit; + + // if the mouse was pressed down in the client area, then select the cell. + if not focused then SetFocus; + + if (Msg.YPos > wvHeaderHeight) then + begin + { The mouse click landed inside the client area } + { If we have hit an active event then we must want to edit it } + if FActiveEvent <> nil then begin + { edit this event } + wvSpawnEventEditDialog(False); + end + else if (DataStore.Resource <> nil) then begin + { otherwise, we must want to create a new event } + StartTime := trunc(Date) + 1 / 2; { default to 12:00 noon } + EndTime := StartTime + (30 / MinutesInDay); { StartTime + 30 minutes } + FActiveEvent := DataStore.Resource.Schedule.AddEvent( + DataStore.GetNextID('Events'), StartTime, EndTime); + { edit this new event } + wvSpawnEventEditDialog(True); + end; + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpWeekView.WMRButtonDown(var Msg : TWMRButtonDown); +{$ELSE} +procedure TVpWeekView.WMRButtonDown(var Msg : TLMRButtonDown); +{$ENDIF} +var + ClientOrigin : TPoint; + i : Integer; + +begin + inherited; + + if not Assigned (PopupMenu) then begin + if not focused then + SetFocus; + { The mouse click landed inside the client area } + wvSetDateByCoord(Point(Msg.XPos, Msg.YPos)); + EventAtCoord (Point (Msg.XPos, Msg.YPos)); + wvClickTimer.Enabled := false; + ClientOrigin := GetClientOrigin; + + if not Assigned (FActiveEvent) then + for i := 0 to FDefaultPopup.Items.Count - 1 do begin + if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then + FDefaultPopup.Items[i].Enabled := False; + end + else + for i := 0 to FDefaultPopup.Items.Count - 1 do + FDefaultPopup.Items[i].Enabled := True; + + FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x, + Msg.YPos + ClientOrigin.y); + end; +end; +{=====} + +procedure TVpWeekView.InitializeDefaultPopup; +var + NewItem : TMenuItem; + NewSubItem : TMenuItem; + +begin + if RSWeekPopupAdd <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSWeekPopupAdd; + NewItem.OnClick := PopupAddEvent; + NewItem.Tag := 0; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSWeekPopupEdit <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSWeekPopupEdit; + NewItem.OnClick := PopupEditEvent; + NewItem.Tag := 1; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSWeekPopupDelete <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSWeekPopupDelete; + NewItem.OnClick := PopupDeleteEvent; + NewItem.Tag := 1; + FDefaultPopup.Items.Add (NewItem); + end; + + if RSWeekPopupNav <> '' then begin + NewItem := TMenuItem.Create (Self); + NewItem.Caption := RSWeekPopupNav; + NewItem.Tag := 0; + FDefaultPopup.Items.Add (NewItem); + + if RSWeekPopupNavToday <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavToday; + NewSubItem.OnClick := PopupToday; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + + if RSWeekPopupNavNextWeek <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavNextWeek; + NewSubItem.OnClick := PopupNextWeek; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + + if RSWeekPopupNavPrevWeek <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavPrevWeek; + NewSubItem.OnClick := PopupPrevWeek; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + + if RSWeekPopupNavNextMonth <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavNextMonth; + NewSubItem.OnClick := PopupNextMonth; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + + if RSWeekPopupNavPrevMonth <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavPrevMonth; + NewSubItem.OnClick := PopupPrevMonth; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + + if RSWeekPopupNavNextYear <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavNextYear; + NewSubItem.OnClick := PopupNextYear; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + + if RSWeekPopupNavPrevYear <> '' then begin + NewSubItem := TMenuItem.Create (Self); + NewSubItem.Caption := RSWeekPopupNavPrevYear; + NewSubItem.OnClick := PopupPrevYear; + NewSubItem.Tag := 0; + NewItem.Add (NewSubItem); + end; + end; +end; +{=====} + +procedure TVpWeekView.PopupAddEvent (Sender : TObject); +var + StartTime : TDateTime; + EndTime : TDateTime; + +begin + if ReadOnly then + Exit; + if not CheckCreateResource then + Exit; + if not Assigned (DataStore) then + Exit; + if not Assigned (DataStore.Resource) then + Exit; + StartTime := trunc(Date) + 1 / 2; { default to 12:00 noon } + EndTime := StartTime + (30 / MinutesInDay); { StartTime + 30 minutes } + FActiveEvent := DataStore.Resource.Schedule.AddEvent ( + DataStore.GetNextID ('Events'), StartTime, EndTime); + { edit this new event } + wvSpawnEventEditDialog (True); +end; +{=====} + +procedure TVpWeekView.PopupDeleteEvent (Sender : TObject); +begin + if ReadOnly then + Exit; + if FActiveEvent <> nil then + DeleteActiveEvent (True); +end; +{=====} + +procedure TVpWeekView.PopupEditEvent (Sender : TObject); +begin + if ReadOnly then + Exit; + if FActiveEvent <> nil then + { edit this Event } + wvSpawnEventEditDialog(False); +end; +{=====} + +procedure TVpWeekView.EditSelectedEvent; +begin + if FActiveEvent <> nil then + wvSpawnEventEditDialog(false); +end; +{=====} + +procedure TVpWeekView.PopupToday (Sender : TObject); +begin + Date := Now; +end; +{=====} + +procedure TVpWeekView.PopupNextWeek (Sender : TObject); +begin + Date := Date + 7; +end; +{=====} + +procedure TVpWeekView.PopupPrevWeek (Sender : TObject); +begin + Date := Date - 7; +end; +{=====} + +procedure TVpWeekView.PopupNextMonth (Sender : TObject); +var + M, D, Y : Word; + +begin + DecodeDate(Date, Y, M, D); + if M = 12 then begin + M := 1; + Y := Y + 1; + end else + M := M + 1; + if (D > DaysInMonth(Y, M)) then + D := DaysInMonth(Y, M); + + Date := EncodeDate(Y, M, D); +end; +{=====} + +procedure TVpWeekView.PopupPrevMonth(Sender : TObject); +var + M, D, Y : Word; +begin + DecodeDate(Date, Y, M, D); + if M = 1 then begin + M := 12; + Y := Y - 1; + end else + M := M - 1; + if (D > DaysInMonth(Y, M)) then + D := DaysInMonth(Y, M); + + Date := EncodeDate(Y, M, D); +end; +{=====} + +procedure TVpWeekView.PopupNextYear (Sender : TObject); +var + M, D, Y : Word; + +begin + DecodeDate (Date, Y, M, D); + Date := EncodeDate (Y + 1, M, 1); +end; +{=====} + +procedure TVpWeekView.PopupPrevYear (Sender : TObject); +var + M, D, Y : Word; + +begin + DecodeDate (Date, Y, M, D); + Date := EncodeDate (Y - 1, M, 1); +end; +{=====} + +procedure TVpWeekView.wvSpawnEventEditDialog(NewEvent: Boolean); +var + AllowIt: Boolean; + EventDlg : TVpEventEditDialog; +begin + if DataStore = nil then Exit; + + AllowIt := false; + if Assigned(FOwnerEditEvent) then + FOwnerEditEvent(self, FActiveEvent, DataStore.Resource, AllowIt) + else begin + EventDlg := TVpEventEditDialog.Create(nil); + try + EventDlg.DataStore := DataStore; + AllowIt := EventDlg.Execute(FActiveEvent, FTimeFormat); + finally + EventDlg.Free; + end; + end; + + if AllowIt then begin + FActiveEvent.Changed := true; + DataStore.PostEvents; + if Assigned(FOnAddEvent) then + FOnAddEvent(self, FActiveEvent); + Invalidate; + end else begin + if NewEvent then begin + DataStore.Resource.Schedule.DeleteEvent(FActiveEvent); + FActiveEvent := nil; + end; + DataStore.PostEvents; + Invalidate; + end; +end; +{=====} + +{$IFNDEF LCL} +procedure TVpWeekView.CMWantSpecialKey(var Msg: TCMWantSpecialKey); +begin + inherited; + Msg.Result := 1; +end; +{$ENDIF} +{=====} + +procedure TVpWeekView.wvSetDateByCoord(Point: TPoint); +var + I: Integer; +begin + for I := 0 to pred(Length(wvWeekdayArray)) do begin + if (Point.X >= wvWeekdayArray[I].Rec.Left) + and (Point.X <= wvWeekdayArray[I].Rec.Right) + and (Point.Y >= wvWeekdayArray[I].Rec.Top) + and (Point.Y <= wvWeekdayArray[I].Rec.Bottom) then begin + Date := wvWeekdayArray[I].Day; + Invalidate; + Exit; + end; + end; +end; +{=====} + +function TVpWeekView.EventAtCoord(Pt: TPoint): Boolean; +var + I: Integer; +begin + result := false; + for I := 0 to pred(Length(wvEventArray)) do begin + if wvEventArray[I].Event = nil then begin + { we've hit the end of visible events without finding a match } + FActiveEvent := nil; + wvActiveEventRec.Top := 0; + wvActiveEventRec.Bottom := 0; + wvActiveEventRec.Right := 0; + wvActiveEventRec.Left := 0; + result := false; + Exit; + end; + + if (Pt.X > wvEventArray[I].Rec.Left) + and (Pt.X < wvEventArray[I].Rec.Right) + and (Pt.Y > wvEventArray[I].Rec.Top) + and (Pt.Y < wvEventArray[I].Rec.Bottom) then begin + { point falls inside this event's rectangle } + wvHotPoint := Pt; + FActiveEvent := TVpEvent(wvEventArray[I].Event); + wvActiveEventRec := wvEventArray[I].Rec; + result := true; + Exit; + end + + else begin + { point is not within the boundaries of this event's rectangle. } + FActiveEvent := nil; + wvActiveEventRec.Top := 0; + wvActiveEventRec.Bottom := 0; + wvActiveEventRec.Right := 0; + wvActiveEventRec.Left := 0; + result := false; + end; + end; +end; +{=====} + +procedure TVpWeekView.wvEditInPlace(Sender: TObject); +begin + { this is the timer event which spawns an in-place editor } + { if the event is doublecliked before this timer fires, then the } + { event is edited in a dialog based editor. } + wvClickTimer.Enabled := false; + EditEvent; +end; +{=====} + +procedure TVpWeekView.EditEvent; +var + AllowIt: Boolean; +begin + if FActiveEvent <> nil then begin + AllowIt := true; + { call the user defined BeforeEdit event } + if Assigned(FBeforeEdit) then + FBeforeEdit(Self, FActiveEvent, AllowIt); + + if AllowIt then begin + { create and spawn the in-place editor } + wvInPlaceEditor := TVpWvInPlaceEdit.Create(Self); + wvInPlaceEditor.Parent := self; + wvInPlaceEditor.OnExit := EndEdit; + wvInPlaceEditor.Move(Rect(wvActiveEventRec.Left + TextMargin, + wvActiveEventRec.Top, wvActiveEventRec.Right - TextMargin, + wvActiveEventRec.Bottom), true); + wvInPlaceEditor.Text := FActiveEvent.Description; + Invalidate; + end; + end; +end; +{=====} + +procedure TVpWeekView.KeyDown(var Key: Word; Shift: TShiftState); +var + PopupPoint : TPoint; + +begin + case Key of + VK_DELETE : DeleteActiveEvent(true); + VK_RIGHT : if Shift = [ssShift] then + PopupNextWeek (Self) + else if (Shift = [ssCtrl]) then + PopupNextMonth (Self) + else if (Shift = [ssShift, ssCtrl]) then + PopupNextYear (Self) + else if Shift = [] then begin + case DayOfWeek (FActiveDate) of + 1 : FActiveDate := FActiveDate - 4; + 2 : FActiveDate := FActiveDate + 3; + 3 : FActiveDate := FActiveDate + 3; + 4 : FActiveDate := FActiveDate + 3; + 5 : FActiveDate := FActiveDate - 3; + 6 : FActiveDate := FActiveDate - 3; + 7 : FActiveDate := FActiveDate - 3; + end; + Invalidate; + end; + VK_LEFT : if Shift = [ssShift] then + PopupPrevWeek (Self) + else if (Shift = [ssCtrl]) then + PopupPrevMonth (Self) + else if (Shift = [ssShift, ssCtrl]) then + PopupPrevYear (Self) + else if Shift = [] then begin + case DayOfWeek (FActiveDate) of + 1 : FActiveDate := FActiveDate - 4; + 2 : FActiveDate := FActiveDate + 3; + 3 : FActiveDate := FActiveDate + 3; + 4 : FActiveDate := FActiveDate + 3; + 5 : FActiveDate := FActiveDate - 3; + 6 : FActiveDate := FActiveDate - 3; + 7 : FActiveDate := FActiveDate - 3; + end; + Invalidate; + end; + VK_UP : begin + if Shift = [] then + case DayOfWeek (FActiveDate) of + 1 : FActiveDate := FActiveDate - 1; + 2 : FActiveDate := FActiveDate + 2; + 3 : FActiveDate := FActiveDate - 1; + 4 : FActiveDate := FActiveDate - 1; + 5 : FActiveDate := FActiveDate + 3; + 6 : FActiveDate := FActiveDate - 1; + 7 : FActiveDate := FActiveDate - 1; + end; + Invalidate; + end; + VK_DOWN : begin + if Shift = [] then + case DayOfWeek (FActiveDate) of + 1 : FActiveDate := FActiveDate - 3; + 2 : FActiveDate := FActiveDate + 1; + 3 : FActiveDate := FActiveDate + 1; + 4 : FActiveDate := FActiveDate - 2; + 5 : FActiveDate := FActiveDate + 1; + 6 : FActiveDate := FActiveDate + 1; + 7 : FActiveDate := FActiveDate + 1; + end; + Invalidate; + end; + VK_INSERT : PopupAddEvent (Self); +{$IFNDEF LCL} + VK_TAB : + if ssShift in Shift then + Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) + else + Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); +{$ENDIF} + VK_F10 : + if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + VK_APPS : + if not Assigned (PopupMenu) then begin + PopupPoint := GetClientOrigin; + FDefaultPopup.Popup (PopupPoint.x + 10, + PopupPoint.y + 10); + end; + end; +end; +{=====} + +procedure TVpWeekView.EndEdit(Sender: TObject); +begin + if wvInPlaceEditor <> nil then begin + if wvInPlaceEditor.Text <> FActiveEvent.Description then begin + FActiveEvent.Description := wvInPlaceEditor.Text; + FActiveEvent.Changed := true; + if Assigned(FAfterEdit) then + FAfterEdit(self, FActiveEvent); + DataStore.PostEvents; + end; + wvInPlaceEditor.Free; + wvInPlaceEditor := nil; + Invalidate; + SetFocus; + end; +end; +{=====} + +{ TVpWvHeadAttributes } + +constructor TVpWvHeadAttributes.Create(AOwner: TVpWeekView); +begin + inherited Create; + FOwner := AOwner; + FColor := clBtnFace; + FFont := TVpFont.Create(AOwner); +end; +{=====} + +destructor TVpWvHeadAttributes.Destroy; +begin + FFont.Free; + inherited; +end; +{=====} + +procedure TVpWvHeadAttributes.SetColor(const Value: TColor); +begin + if FColor <> Value then begin + FColor := Value; + FOwner.Invalidate; + end; +end; +{=====} + +procedure TVpWvHeadAttributes.SetFont(Value: TVpFont); +begin + FFont.Assign(Value); +end; +{=====} + +end. diff --git a/components/tvplanit/source/vpxbase.pas b/components/tvplanit/source/vpxbase.pas new file mode 100644 index 000000000..13d23da8f --- /dev/null +++ b/components/tvplanit/source/vpxbase.pas @@ -0,0 +1,682 @@ +{*********************************************************} +{* VPXBASE.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpXBase; + +interface + +uses + Classes, + VpBase; + + +{===System functions=================================================} + +type + TVpUcs4Char = Longint; + TVpUtf8Char = string[6]; + DOMChar = WideChar; + PDOMChar = PWideChar; + + { Character encoding types} + TVpCharEncoding = (ceUnknown, ceUTF8); + + {The TVpMemoryStream class is used to expose TMemoryStream's SetPointer + method.} + TVpMemoryStream = class(TMemoryStream) + public + procedure SetPointer(Ptr : Pointer; Size : Longint); + end; + + TVpFileStream = class(TFileStream) + FFileName : string; + public + constructor CreateEx(Mode : Word; const FileName : string); + + property Filename : string read FFileName; + end; + +{ Utility methods } +function VpPos(const aSubStr, aString : DOMString) : Integer; +function VpRPos(const sSubStr, sTerm : DOMString) : Integer; +{ character conversion routines } +function VpIso88591ToUcs4(aInCh : AnsiChar; + var aOutCh : TVpUcs4Char) : Boolean; +function VpUcs4ToIso88591(aInCh : TVpUcs4Char; + var aOutCh : AnsiChar) : Boolean; +function VpUcs4ToWideChar(const aInChar : TVpUcs4Char; + var aOutWS : DOMChar) : Boolean; +function VpUtf16ToUcs4(aInChI, + aInChII : DOMChar; + var aOutCh : TVpUcs4Char; + var aBothUsed : Boolean) : Boolean; +function VpUcs4ToUtf8(aInCh : TVpUcs4Char; + var aOutCh : TVpUtf8Char) : Boolean; +function VpUtf8ToUcs4(const aInCh : TVpUtf8Char; + aBytes : Integer; + var aOutCh : TVpUcs4Char) : Boolean; + +{ UTF specials } +function VpGetLengthUtf8(const aCh : AnsiChar) : byte; + +{ character classes } +function VpIsBaseChar(aCh : TVpUcs4Char) : Boolean; +function VpIsChar(const aCh : TVpUcs4Char) : Boolean; +function VpIsCombiningChar(aCh : TVpUcs4Char) : Boolean; +function VpIsDigit(aCh : TVpUcs4Char) : Boolean; +function VpIsExtender(aCh : TVpUcs4Char) : Boolean; +function VpIsIdeographic(aCh : TVpUcs4Char) : Boolean; +function VpIsLetter(aCh : TVpUcs4Char) : Boolean; +function VpIsNameChar(aCh : TVpUcs4Char) : Boolean; +function VpIsNameCharFirst(aCh : TVpUcs4Char) : Boolean; +function VpIsPubidChar(aCh : TVpUcs4Char) : Boolean; +function VpIsSpace(aCh : TVpUcs4Char) : Boolean; + +implementation + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType, + {$ELSE} + Windows, + {$ENDIF} + SysUtils; + + +{== Utility methods ==================================================} +function VpPos(const aSubStr, aString : DOMString) : Integer; +begin + Result := AnsiPos(aSubStr, aString); +end; +{--------} +function VpRPos(const sSubStr, sTerm : DOMString) : Integer; +var + cLast : DOMChar; + i, j : Integer; +begin + j := Length(sSubStr); + cLast := sSubStr[j]; + for i := Length(sTerm) downto j do begin + if (sTerm[i] = cLast) and + (Copy(sTerm, i - j + 1, j) = sSubStr) then begin + Result := i - j + 1; + Exit; + end; + end; + Result := 0; +end; +{===character conversion routines====================================} +function VpIso88591ToUcs4(aInCh : AnsiChar; + var aOutCh : TVpUcs4Char) : boolean; +begin + {Note: the conversion from ISO-8859-1 to UCS-4 is very simple: the + result is the original character} + aOutCh := ord(aInCh); + Result := true; {cannot fail} +end; +{--------} +function VpUcs4ToIso88591(aInCh : TVpUcs4Char; + var aOutCh : AnsiChar) : Boolean; +begin + {Note: the conversion from UCS-4 to ISO-8859-1 is very simple: if + the character is contained in a byte, the result is the + original character; otherwise the conversion cannot be done} + aInCh := abs(aInCh); + if (($00 <= aInCh) and (aInCh <= $FF)) then begin + aOutCh := AnsiChar(aInCh and $FF); + Result := true; + end + else begin + Result := false; + aOutCh := #0; + end; +end; +{--------} +function VpUcs4ToWideChar(const aInChar : TVpUcs4Char; + var aOutWS : DOMChar) : Boolean; +var + Temp : Longint; +begin + Temp := abs(aInChar); + if (Temp < $10000) then begin + aOutWS := DOMChar(Temp); + Result := True; + end else if (Temp <= $10FFFF) then begin + dec(Temp, $10000); + Temp := $DC00 or (Temp and $3FF); + Temp := $D800 or (Temp shr 10); + aOutWS := DOMChar(Temp); + Result := True; + end else begin + aOutWS := #0; + Result := False; + end; +end; +{--------} +function VpUtf16ToUcs4(aInChI, + aInChII : DOMChar; + var aOutCh : TVpUcs4Char; + var aBothUsed : Boolean) : Boolean; +begin + aBothUsed := False; + if (aInChI < #$D800) or (aInChI > #$DFFF) then begin + aOutCh := Integer(aInChI); + Result := True; + end + else if (aInChI < #$DC00) and + ((#$DC00 <= aInChII) and (aInChII <= #$DFFF)) then begin + aOutCh := ((integer(aInChI) and $3FF) shl 10) or + (integer(aInChII) and $3FF); + aBothUsed := True; + Result := True; + end + else begin + Result := False; + aOUtCh := 0; + end; +end; +{--------} +function VpUcs4ToUtf8(aInCh : TVpUcs4Char; + var aOutCh : TVpUtf8Char) : Boolean; +begin + aInCh := abs(aInCh); + {if the UCS-4 value is $00 to $7f, no conversion is required} + if (aInCh < $80) then begin + aOutCh[0] := #1; + aOutCh[1] := AnsiChar(aInCh); + end + {if the UCS-4 value is $80 to $7ff, a two character string is + produced} + else if (aInCh < $800) then begin + aOutCh[0] := #2; + aOutCh[1] := AnsiChar($C0 or (aInCh shr 6)); + aOutCh[2] := AnsiChar($80 or (aInCh and $3F)); + end + {if the UCS-4 value is $800 to $ffff, a three character string is + produced} + else if (aInCh < $10000) then begin + aOutCh[0] := #3; + aOutCh[1] := AnsiChar($E0 or (aInCh shr 12)); + aOutCh[2] := AnsiChar($80 or ((aInCh shr 6) and $3F)); + aOutCh[3] := AnsiChar($80 or (aInCh and $3F)); + end + {NOTE: the following if clauses will be very rarely used since the + majority of characters will be unicode characters: $0000 to + $FFFF} + {if the UCS-4 value is $10000 to $1fffff, a four character string + is produced} + else if (aInCh < $200000) then begin + aOutCh[0] := #4; + aOutCh[1] := AnsiChar($F0 or (aInCh shr 18)); + aOutCh[2] := AnsiChar($80 or ((aInCh shr 12) and $3F)); + aOutCh[3] := AnsiChar($80 or ((aInCh shr 6) and $3F)); + aOutCh[4] := AnsiChar($80 or (aInCh and $3F)); + end + {if the UCS-4 value is $200000 to $3ffffff, a five character + string is produced} + else if (aInCh < $4000000) then begin + aOutCh[0] := #5; + aOutCh[1] := AnsiChar($F8 or (aInCh shr 24)); + aOutCh[2] := AnsiChar($80 or ((aInCh shr 18) and $3F)); + aOutCh[3] := AnsiChar($80 or ((aInCh shr 12) and $3F)); + aOutCh[4] := AnsiChar($80 or ((aInCh shr 6) and $3F)); + aOutCh[5] := AnsiChar($80 or (aInCh and $3F)); + end + {for all other UCS-4 values, a six character string is produced} + else begin + aOutCh[0] := #6; + aOutCh[1] := AnsiChar($FC or (aInCh shr 30)); + aOutCh[2] := AnsiChar($80 or ((aInCh shr 24) and $3F)); + aOutCh[3] := AnsiChar($80 or ((aInCh shr 18) and $3F)); + aOutCh[4] := AnsiChar($80 or ((aInCh shr 12) and $3F)); + aOutCh[5] := AnsiChar($80 or ((aInCh shr 6) and $3F)); + aOutCh[6] := AnsiChar($80 or (aInCh and $3F)); + end; + Result := True; {cannot fail} +end; +{--------} +function VpUtf8ToUcs4(const aInCh : TVpUtf8Char; + aBytes : Integer; + var aOutCh : TVpUcs4Char) : Boolean; +var + InFirstByte : AnsiChar; + InCharLen : Integer; + i : Integer; +begin + InFirstByte := aInCh[1]; + InCharLen := Length(aInCh); + {the length of the UTF-8 character cannot be zero and must match + that of the first ASCII character in the string} + if ((InCharLen = 0) or + (InCharLen <> aBytes)) then begin + Result := False; + aOutCh := 0; + Exit; + end; + {all subsequent characters must have the most significant bit set + and the next to most significant digit clear; we'll test for this + as we go along} + {get the bits from the first ASCII character} + if (InFirstByte <= #$7F) then + aOutCh := Ord(InFirstByte) + else if (InFirstByte <= #$DF) then + aOutCh := Ord(InFirstByte) and $1F + else if (InFirstByte <= #$EF) then + aOutCh := Ord(InFirstByte) and $0F + else if (InFirstByte <= #$F7) then + aOutCh := Ord(InFirstByte) and $07 + else if (InFirstByte <= #$FB) then + aOutCh := Ord(InFirstByte) and $03 + else + aOutCh := Ord(InFirstByte) and $01; + {get the bits from the remaining ASCII characters} + for i := 2 to InCharLen do begin + if ((Byte(aInCh[i]) and $C0) <> $80) then begin + Result := False; + aOutCh := 0; + Exit; + end; + aOutCh := (aOutCh shl 6) or (Byte(aInCh[i]) and $3F); + end; + {success} + Result := True; +end; +{====================================================================} + + +{===UTF specials=====================================================} +function VpGetLengthUtf8(const aCh : AnsiChar) : Byte; +begin + if (aCh <= #$7F) then + Result := 1 + else if (aCh <= #$BF) then + Result := 0 { $80--$BF is an error } + else if (aCh <= #$DF) then + Result := 2 + else if (aCh <= #$EF) then + Result := 3 + else if (aCh <= #$F7) then + Result := 4 + else if (aCh <= #$FB) then + Result := 5 + else if (aCh <= #$FD) then + Result := 6 + else + Result := 0; { $FE, $FF is an error } +end; +{====================================================================} + + +{===character classes================================================} +function VpIsBaseChar(aCh : TVpUcs4Char) : boolean; +begin + Result := (($0041 <= aCh) and (aCh <= $005A)) or + (($0061 <= aCh) and (aCh <= $007A)) or + (($00C0 <= aCh) and (aCh <= $00D6)) or + (($00D8 <= aCh) and (aCh <= $00F6)) or + (($00F8 <= aCh) and (aCh <= $00FF)) or + (($0100 <= aCh) and (aCh <= $0131)) or + (($0134 <= aCh) and (aCh <= $013E)) or + (($0141 <= aCh) and (aCh <= $0148)) or + (($014A <= aCh) and (aCh <= $017E)) or + (($0180 <= aCh) and (aCh <= $01C3)) or + (($01CD <= aCh) and (aCh <= $01F0)) or + (($01F4 <= aCh) and (aCh <= $01F5)) or + (($01FA <= aCh) and (aCh <= $0217)) or + (($0250 <= aCh) and (aCh <= $02A8)) or + (($02BB <= aCh) and (aCh <= $02C1)) or (aCh = $0386) or + (($0388 <= aCh) and (aCh <= $038A)) or (aCh = $038C) or + (($038E <= aCh) and (aCh <= $03A1)) or + (($03A3 <= aCh) and (aCh <= $03CE)) or + (($03D0 <= aCh) and (aCh <= $03D6)) or + (aCh = $03DA) or (aCh = $03DC) or + (aCh = $03DE) or (aCh = $03E0) or + (($03E2 <= aCh) and (aCh <= $03F3)) or + (($0401 <= aCh) and (aCh <= $040C)) or + (($040E <= aCh) and (aCh <= $044F)) or + (($0451 <= aCh) and (aCh <= $045C)) or + (($045E <= aCh) and (aCh <= $0481)) or + (($0490 <= aCh) and (aCh <= $04C4)) or + (($04C7 <= aCh) and (aCh <= $04C8)) or + (($04CB <= aCh) and (aCh <= $04CC)) or + (($04D0 <= aCh) and (aCh <= $04EB)) or + (($04EE <= aCh) and (aCh <= $04F5)) or + (($04F8 <= aCh) and (aCh <= $04F9)) or + (($0531 <= aCh) and (aCh <= $0556)) or (aCh = $0559) or + (($0561 <= aCh) and (aCh <= $0586)) or + (($05D0 <= aCh) and (aCh <= $05EA)) or + (($05F0 <= aCh) and (aCh <= $05F2)) or + (($0621 <= aCh) and (aCh <= $063A)) or + (($0641 <= aCh) and (aCh <= $064A)) or + (($0671 <= aCh) and (aCh <= $06B7)) or + (($06BA <= aCh) and (aCh <= $06BE)) or + (($06C0 <= aCh) and (aCh <= $06CE)) or + (($06D0 <= aCh) and (aCh <= $06D3)) or (aCh = $06D5) or + (($06E5 <= aCh) and (aCh <= $06E6)) or + (($0905 <= aCh) and (aCh <= $0939)) or (aCh = $093D) or + (($0958 <= aCh) and (aCh <= $0961)) or + (($0985 <= aCh) and (aCh <= $098C)) or + (($098F <= aCh) and (aCh <= $0990)) or + (($0993 <= aCh) and (aCh <= $09A8)) or + (($09AA <= aCh) and (aCh <= $09B0)) or (aCh = $09B2) or + (($09B6 <= aCh) and (aCh <= $09B9)) or + (($09DC <= aCh) and (aCh <= $09DD)) or + (($09DF <= aCh) and (aCh <= $09E1)) or + (($09F0 <= aCh) and (aCh <= $09F1)) or + (($0A05 <= aCh) and (aCh <= $0A0A)) or + (($0A0F <= aCh) and (aCh <= $0A10)) or + (($0A13 <= aCh) and (aCh <= $0A28)) or + (($0A2A <= aCh) and (aCh <= $0A30)) or + (($0A32 <= aCh) and (aCh <= $0A33)) or + (($0A35 <= aCh) and (aCh <= $0A36)) or + (($0A38 <= aCh) and (aCh <= $0A39)) or + (($0A59 <= aCh) and (aCh <= $0A5C)) or (aCh = $0A5E) or + (($0A72 <= aCh) and (aCh <= $0A74)) or + (($0A85 <= aCh) and (aCh <= $0A8B)) or (aCh = $0A8D) or + (($0A8F <= aCh) and (aCh <= $0A91)) or + (($0A93 <= aCh) and (aCh <= $0AA8)) or + (($0AAA <= aCh) and (aCh <= $0AB0)) or + (($0AB2 <= aCh) and (aCh <= $0AB3)) or + (($0AB5 <= aCh) and (aCh <= $0AB9)) or + (aCh = $0ABD) or (aCh = $0AE0) or + (($0B05 <= aCh) and (aCh <= $0B0C)) or + (($0B0F <= aCh) and (aCh <= $0B10)) or + (($0B13 <= aCh) and (aCh <= $0B28)) or + (($0B2A <= aCh) and (aCh <= $0B30)) or + (($0B32 <= aCh) and (aCh <= $0B33)) or + (($0B36 <= aCh) and (aCh <= $0B39)) or (aCh = $0B3D) or + (($0B5C <= aCh) and (aCh <= $0B5D)) or + (($0B5F <= aCh) and (aCh <= $0B61)) or + (($0B85 <= aCh) and (aCh <= $0B8A)) or + (($0B8E <= aCh) and (aCh <= $0B90)) or + (($0B92 <= aCh) and (aCh <= $0B95)) or + (($0B99 <= aCh) and (aCh <= $0B9A)) or (aCh = $0B9C) or + (($0B9E <= aCh) and (aCh <= $0B9F)) or + (($0BA3 <= aCh) and (aCh <= $0BA4)) or + (($0BA8 <= aCh) and (aCh <= $0BAA)) or + (($0BAE <= aCh) and (aCh <= $0BB5)) or + (($0BB7 <= aCh) and (aCh <= $0BB9)) or + (($0C05 <= aCh) and (aCh <= $0C0C)) or + (($0C0E <= aCh) and (aCh <= $0C10)) or + (($0C12 <= aCh) and (aCh <= $0C28)) or + (($0C2A <= aCh) and (aCh <= $0C33)) or + (($0C35 <= aCh) and (aCh <= $0C39)) or + (($0C60 <= aCh) and (aCh <= $0C61)) or + (($0C85 <= aCh) and (aCh <= $0C8C)) or + (($0C8E <= aCh) and (aCh <= $0C90)) or + (($0C92 <= aCh) and (aCh <= $0CA8)) or + (($0CAA <= aCh) and (aCh <= $0CB3)) or + (($0CB5 <= aCh) and (aCh <= $0CB9)) or (aCh = $0CDE) or + (($0CE0 <= aCh) and (aCh <= $0CE1)) or + (($0D05 <= aCh) and (aCh <= $0D0C)) or + (($0D0E <= aCh) and (aCh <= $0D10)) or + (($0D12 <= aCh) and (aCh <= $0D28)) or + (($0D2A <= aCh) and (aCh <= $0D39)) or + (($0D60 <= aCh) and (aCh <= $0D61)) or + (($0E01 <= aCh) and (aCh <= $0E2E)) or (aCh = $0E30) or + (($0E32 <= aCh) and (aCh <= $0E33)) or + (($0E40 <= aCh) and (aCh <= $0E45)) or + (($0E81 <= aCh) and (aCh <= $0E82)) or (aCh = $0E84) or + (($0E87 <= aCh) and (aCh <= $0E88)) or + (aCh = $0E8A) or (aCh = $0E8D) or + (($0E94 <= aCh) and (aCh <= $0E97)) or + (($0E99 <= aCh) and (aCh <= $0E9F)) or + (($0EA1 <= aCh) and (aCh <= $0EA3)) or + (aCh = $0EA5) or (aCh = $0EA7) or + (($0EAA <= aCh) and (aCh <= $0EAB)) or + (($0EAD <= aCh) and (aCh <= $0EAE)) or (aCh = $0EB0) or + (($0EB2 <= aCh) and (aCh <= $0EB3)) or (aCh = $0EBD) or + (($0EC0 <= aCh) and (aCh <= $0EC4)) or + (($0F40 <= aCh) and (aCh <= $0F47)) or + (($0F49 <= aCh) and (aCh <= $0F69)) or + (($10A0 <= aCh) and (aCh <= $10C5)) or + (($10D0 <= aCh) and (aCh <= $10F6)) or (aCh = $1100) or + (($1102 <= aCh) and (aCh <= $1103)) or + (($1105 <= aCh) and (aCh <= $1107)) or (aCh = $1109) or + (($110B <= aCh) and (aCh <= $110C)) or + (($110E <= aCh) and (aCh <= $1112)) or + (aCh = $113C) or (aCh = $113E) or (aCh = $1140) or + (aCh = $114C) or (aCh = $114E) or (aCh = $1150) or + (($1154 <= aCh) and (aCh <= $1155)) or (aCh = $1159) or + (($115F <= aCh) and (aCh <= $1161)) or + (aCh = $1163) or (aCh = $1165) or + (aCh = $1167) or (aCh = $1169) or + (($116D <= aCh) and (aCh <= $116E)) or + (($1172 <= aCh) and (aCh <= $1173)) or + (aCh = $1175) or (aCh = $119E) or + (aCh = $11A8) or (aCh = $11AB) or + (($11AE <= aCh) and (aCh <= $11AF)) or + (($11B7 <= aCh) and (aCh <= $11B8)) or (aCh = $11BA) or + (($11BC <= aCh) and (aCh <= $11C2)) or + (aCh = $11EB) or (aCh = $11F0) or (aCh = $11F9) or + (($1E00 <= aCh) and (aCh <= $1E9B)) or + (($1EA0 <= aCh) and (aCh <= $1EF9)) or + (($1F00 <= aCh) and (aCh <= $1F15)) or + (($1F18 <= aCh) and (aCh <= $1F1D)) or + (($1F20 <= aCh) and (aCh <= $1F45)) or + (($1F48 <= aCh) and (aCh <= $1F4D)) or + (($1F50 <= aCh) and (aCh <= $1F57)) or + (aCh = $1F59) or (aCh = $1F5B) or (aCh = $1F5D) or + (($1F5F <= aCh) and (aCh <= $1F7D)) or + (($1F80 <= aCh) and (aCh <= $1FB4)) or + (($1FB6 <= aCh) and (aCh <= $1FBC)) or (aCh = $1FBE) or + (($1FC2 <= aCh) and (aCh <= $1FC4)) or + (($1FC6 <= aCh) and (aCh <= $1FCC)) or + (($1FD0 <= aCh) and (aCh <= $1FD3)) or + (($1FD6 <= aCh) and (aCh <= $1FDB)) or + (($1FE0 <= aCh) and (aCh <= $1FEC)) or + (($1FF2 <= aCh) and (aCh <= $1FF4)) or + (($1FF6 <= aCh) and (aCh <= $1FFC)) or (aCh = $2126) or + (($212A <= aCh) and (aCh <= $212B)) or (aCh = $212E) or + (($2180 <= aCh) and (aCh <= $2182)) or + (($3041 <= aCh) and (aCh <= $3094)) or + (($30A1 <= aCh) and (aCh <= $30FA)) or + (($3105 <= aCh) and (aCh <= $312C)) or + (($AC00 <= aCh) and (aCh <= $D7A3)); +end; +{--------} +function VpIsChar(const aCh : TVpUcs4Char) : boolean; +begin + Result := (aCh = 9) or (aCh = 10) or (aCh = 13) or + (($20 <= aCh) and (aCh <= $D7FF)) or + (($E000 <= aCh) and (aCh <= $FFFD)) or + (($10000 <= aCh) and (aCh <= $10FFFF)); +end; +{--------} +function VpIsCombiningChar(aCh : TVpUcs4Char) : boolean; +begin + Result := (($0300 <= aCh) and (aCh <= $0345)) or + (($0360 <= aCh) and (aCh <= $0361)) or + (($0483 <= aCh) and (aCh <= $0486)) or + (($0591 <= aCh) and (aCh <= $05A1)) or + (($05A3 <= aCh) and (aCh <= $05B9)) or + (($05BB <= aCh) and (aCh <= $05BD)) or (aCh = $05BF) or + (($05C1 <= aCh) and (aCh <= $05C2)) or (aCh = $05C4) or + (($064B <= aCh) and (aCh <= $0652)) or (aCh = $0670) or + (($06D6 <= aCh) and (aCh <= $06DC)) or + (($06DD <= aCh) and (aCh <= $06DF)) or + (($06E0 <= aCh) and (aCh <= $06E4)) or + (($06E7 <= aCh) and (aCh <= $06E8)) or + (($06EA <= aCh) and (aCh <= $06ED)) or + (($0901 <= aCh) and (aCh <= $0903)) or (aCh = $093C) or + (($093E <= aCh) and (aCh <= $094C)) or (aCh = $094D) or + (($0951 <= aCh) and (aCh <= $0954)) or + (($0962 <= aCh) and (aCh <= $0963)) or + (($0981 <= aCh) and (aCh <= $0983)) or + (aCh = $09BC) or (aCh = $09BE) or (aCh = $09BF) or + (($09C0 <= aCh) and (aCh <= $09C4)) or + (($09C7 <= aCh) and (aCh <= $09C8)) or + (($09CB <= aCh) and (aCh <= $09CD)) or (aCh = $09D7) or + (($09E2 <= aCh) and (aCh <= $09E3)) or + (aCh = $0A02) or (aCh = $0A3C) or + (aCh = $0A3E) or (aCh = $0A3F) or + (($0A40 <= aCh) and (aCh <= $0A42)) or + (($0A47 <= aCh) and (aCh <= $0A48)) or + (($0A4B <= aCh) and (aCh <= $0A4D)) or + (($0A70 <= aCh) and (aCh <= $0A71)) or + (($0A81 <= aCh) and (aCh <= $0A83)) or + (aCh = $0ABC) or (($0ABE <= aCh) and (aCh <= $0AC5)) or + (($0AC7 <= aCh) and (aCh <= $0AC9)) or + (($0ACB <= aCh) and (aCh <= $0ACD)) or + (($0B01 <= aCh) and (aCh <= $0B03)) or (aCh = $0B3C) or + (($0B3E <= aCh) and (aCh <= $0B43)) or + (($0B47 <= aCh) and (aCh <= $0B48)) or + (($0B4B <= aCh) and (aCh <= $0B4D)) or + (($0B56 <= aCh) and (aCh <= $0B57)) or + (($0B82 <= aCh) and (aCh <= $0B83)) or + (($0BBE <= aCh) and (aCh <= $0BC2)) or + (($0BC6 <= aCh) and (aCh <= $0BC8)) or + (($0BCA <= aCh) and (aCh <= $0BCD)) or (aCh = $0BD7) or + (($0C01 <= aCh) and (aCh <= $0C03)) or + (($0C3E <= aCh) and (aCh <= $0C44)) or + (($0C46 <= aCh) and (aCh <= $0C48)) or + (($0C4A <= aCh) and (aCh <= $0C4D)) or + (($0C55 <= aCh) and (aCh <= $0C56)) or + (($0C82 <= aCh) and (aCh <= $0C83)) or + (($0CBE <= aCh) and (aCh <= $0CC4)) or + (($0CC6 <= aCh) and (aCh <= $0CC8)) or + (($0CCA <= aCh) and (aCh <= $0CCD)) or + (($0CD5 <= aCh) and (aCh <= $0CD6)) or + (($0D02 <= aCh) and (aCh <= $0D03)) or + (($0D3E <= aCh) and (aCh <= $0D43)) or + (($0D46 <= aCh) and (aCh <= $0D48)) or + (($0D4A <= aCh) and (aCh <= $0D4D)) or + (aCh = $0D57) or (aCh = $0E31) or + (($0E34 <= aCh) and (aCh <= $0E3A)) or + (($0E47 <= aCh) and (aCh <= $0E4E)) or (aCh = $0EB1) or + (($0EB4 <= aCh) and (aCh <= $0EB9)) or + (($0EBB <= aCh) and (aCh <= $0EBC)) or + (($0EC8 <= aCh) and (aCh <= $0ECD)) or + (($0F18 <= aCh) and (aCh <= $0F19)) or + (aCh = $0F35) or (aCh = $0F37) or (aCh = $0F39) or + (aCh = $0F3E) or (aCh = $0F3F) or + (($0F71 <= aCh) and (aCh <= $0F84)) or + (($0F86 <= aCh) and (aCh <= $0F8B)) or + (($0F90 <= aCh) and (aCh <= $0F95)) or (aCh = $0F97) or + (($0F99 <= aCh) and (aCh <= $0FAD)) or + (($0FB1 <= aCh) and (aCh <= $0FB7)) or (aCh = $0FB9) or + (($20D0 <= aCh) and (aCh <= $20DC)) or (aCh = $20E1) or + (($302A <= aCh) and (aCh <= $302F)) or + (aCh = $3099) or (aCh = $309A); +end; +{--------} +function VpIsDigit(aCh : TVpUcs4Char) : boolean; +begin + Result := (($30 <= aCh) and (aCh <= $39)) or + (($660 <= aCh) and (aCh <= $669)) or + (($6F0 <= aCh) and (aCh <= $6F9)) or + (($966 <= aCh) and (aCh <= $96F)) or + (($9E6 <= aCh) and (aCh <= $9EF)) or + (($A66 <= aCh) and (aCh <= $A6F)) or + (($AE6 <= aCh) and (aCh <= $AEF)) or + (($B66 <= aCh) and (aCh <= $B6F)) or + (($BE7 <= aCh) and (aCh <= $BEF)) or + (($C66 <= aCh) and (aCh <= $C6F)) or + (($CE6 <= aCh) and (aCh <= $CEF)) or + (($D66 <= aCh) and (aCh <= $D6F)) or + (($E50 <= aCh) and (aCh <= $E59)) or + (($ED0 <= aCh) and (aCh <= $ED9)) or + (($F20 <= aCh) and (aCh <= $F29)); +end; +{--------} +function VpIsExtender(aCh : TVpUcs4Char) : boolean; +begin + Result := (aCh = $00B7) or (aCh = $02D0) or + (aCh = $02D1) or (aCh = $0387) or + (aCh = $0640) or (aCh = $0E46) or + (aCh = $0EC6) or (aCh = $3005) or + (($3031 <= aCh) and (aCh <= $3035)) or + (($309D <= aCh) and (aCh <= $309E)) or + (($30FC <= aCh) and (aCh <= $30FE)); +end; +{--------} +function VpIsIdeographic(aCh : TVpUcs4Char) : boolean; +begin + Result := (($4E00 <= aCh) and (aCh <= $9FA5)) or + (aCh = $3007) or + (($3021 <= aCh) and (aCh <= $3029)); +end; +{--------} +function VpIsLetter(aCh : TVpUcs4Char) : boolean; +begin + Result := VpIsBaseChar(aCh) or VpIsIdeographic(aCh); +end; +{--------} +function VpIsNameChar(aCh : TVpUcs4Char) : boolean; +begin + Result := VpIsLetter(aCh) or VpIsDigit(aCh) or + (aCh = ord('.')) or (aCh = ord('-')) or + (aCh = ord('_')) or (aCh = ord(':')) or + VpIsCombiningChar(aCh) or VpIsExtender(aCh); +end; +{--------} +function VpIsNameCharFirst(aCh : TVpUcs4Char) : boolean; +begin + Result := VpIsLetter(aCh) or (aCh = ord('_')) or (aCh = ord(':')); +end; +{--------} +function VpIsPubidChar(aCh : TVpUcs4Char) : boolean; +begin + Result := (aCh = $20) or (aCh = 13) or (aCh = 10) or + ((ord('a') <= aCh) and (aCh <= ord('z'))) or + ((ord('A') <= aCh) and (aCh <= ord('Z'))) or + ((ord('0') <= aCh) and (aCh <= ord('9'))) or + (aCh = ord('-')) or (aCh = ord('''')) or + (aCh = ord('(')) or (aCh = ord(')')) or + (aCh = ord('+')) or (aCh = ord(',')) or + (aCh = ord('.')) or (aCh = ord('/')) or + (aCh = ord(':')) or (aCh = ord('=')) or + (aCh = ord('?')) or (aCh = ord(';')) or + (aCh = ord('!')) or (aCh = ord('*')) or + (aCh = ord('#')) or (aCh = ord('@')) or + (aCh = ord('$')) or (aCh = ord('_')) or + (aCh = ord('%')); +end; +{--------} +function VpIsSpace(aCh : TVpUcs4Char) : Boolean; +begin + Result := (aCh <= $20) and (AnsiChar(aCh) in [' ', #9, #13, #10]); +end; + +{==TVpMemoryStream===================================================} +procedure TVpMemoryStream.SetPointer(Ptr : Pointer; Size : Integer); +begin + Assert(not Assigned(Memory)); + inherited; +end; + +{===TVpFileStream====================================================} +constructor TVpFileStream.CreateEx(Mode : Word; const FileName : string); +begin + inherited Create(FileName, Mode); + FFileName := FileName; +end; + +end. diff --git a/components/tvplanit/source/vpxchrflt.pas b/components/tvplanit/source/vpxchrflt.pas new file mode 100644 index 000000000..21ed320a1 --- /dev/null +++ b/components/tvplanit/source/vpxchrflt.pas @@ -0,0 +1,648 @@ +{*********************************************************} +{* VPXCHRFLT.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpXChrFlt; + +interface + +uses + SysUtils, + Classes, + VpSR, + VpBase, + VpXBase; + +const + VpEndOfStream = #1; + VpEndOfReplaceText = #2; + VpNullChar = #3; + +type + TVpStreamFormat = {character formats of stream...} + (sfUTF8, {..UTF8 -- the default} + sfUTF16LE, {..UTF16, little endian (eg, Intel)} + sfUTF16BE, {..UTF16, big endian} + sfISO88591); {..ISO-8859-1, or Latin 1} + + TVpBaseCharFilter = class(TObject) + protected + FBufSize : Longint; + FBuffer : PAnsiChar; + FBufPos : Longint; + FFormat : TVpStreamFormat; {The format of the incoming stream} + FFreeStream : Boolean; + FStream : TStream; + FStreamPos : Longint; + FStreamSize : Longint; + protected + function csGetSize : Longint; virtual; + procedure csSetFormat(const aValue : TVpStreamFormat); virtual; abstract; + public + constructor Create(aStream : TStream; const aBufSize : Longint); virtual; + destructor Destroy; override; + + property BufSize : Longint + read FBufSize; + + property FreeStream : Boolean + read FFreeStream write FFreeStream; + + property Stream : TStream + read FStream; + + end; + + TVpInCharFilter = class(TVpBaseCharFilter) + private + FBufEnd : Longint; + FUCS4Char : TVpUcs4Char; + FLine : Longint; + FLinePos : Longint; + FLastChar : DOMChar; + FEOF : Boolean; + FBufDMZ : Longint; + FInTryRead : Boolean; + protected + procedure csAdvanceLine; + procedure csAdvanceLinePos; + procedure csGetCharPrim(var aCh : TVpUcs4Char; + var aIsLiteral : Boolean); + function csGetNextBuffer : Boolean; + function csGetTwoAnsiChars(var Buffer) : Boolean; + function csGetUtf8Char : TVpUcs4Char; + procedure csIdentifyFormat; + procedure csPushCharPrim(aCh : TVpUcs4Char); + procedure csSetFormat(const aValue : TVpStreamFormat); override; + + procedure csGetChar(var aCh : TVpUcs4Char; + var aIsLiteral : Boolean); + + public + constructor Create(aStream : TStream; const aBufSize : Longint); override; + + property Format : TVpStreamFormat + read FFormat + write csSetFormat; + property EOF : Boolean + read FEOF; + public + procedure SkipChar; + function TryRead(const S : array of Longint) : Boolean; + function ReadChar : DOMChar; + function ReadAndSkipChar : DOMChar; + property Line : LongInt + read FLine; + property LinePos : LongInt + read FLinePos; + end; + + TVpOutCharFilter = class(TVpBaseCharFilter) + protected + FFormat : TVpStreamFormat; + FSetUTF8Sig : Boolean; + protected + function csGetSize : LongInt; override; + procedure csPutUtf8Char(const aCh : TVpUcs4Char); + procedure csSetFormat(const aValue : TVpStreamFormat); override; + procedure csWriteBuffer; + public + constructor Create(aStream : TStream; const aBufSize : Longint); override; + destructor Destroy; override; + + procedure PutUCS4Char(aCh : TVpUcs4Char); + function PutChar(aCh1, aCh2 : DOMChar; + var aBothUsed : Boolean) : Boolean; + function PutString(const aText : DOMString) : Boolean; + function Position : integer; + + property Format : TVpStreamFormat + read FFormat + write csSetFormat; + property WriteUTF8Signature : Boolean + read FSetUTF8Sig + write FSetUTF8Sig; + property Size : LongInt + read csGetSize; + + end; + + +implementation + +const + CR = 13; {Carriage return} + LF = 10; {Line feed} + +{====================================================================} +constructor TVpBaseCharFilter.Create(aStream : TStream; + const aBufSize : Longint); +begin + inherited Create; + Assert(Assigned(aStream)); + FBufSize := aBufSize; + FBufPos := 0; + FFormat := sfUTF8; + FFreeStream := False; + FStream := aStream; + FStreamPos := aStream.Position; + FStreamSize := aStream.Size; + GetMem(FBuffer, FBufSize); +end; +{--------} +destructor TVpBaseCharFilter.Destroy; +begin + if Assigned(FBuffer) then begin + FreeMem(FBuffer, FBufSize); + FBuffer := nil; + end; + + if FFreeStream then + FStream.Free; + + inherited Destroy; +end; +{--------} +function TVpBaseCharFilter.csGetSize : LongInt; +begin + Result := FStreamSize; +end; +{====================================================================} +constructor TVpInCharFilter.Create(aStream : TStream; + const aBufSize : Longint); +begin + inherited Create(aStream, aBufSize); + if FStreamSize <= aBufSize then + FBufDMZ := 0 + else + FBufDMZ := 64; + FBufEnd := 0; + FLine := 1; + FLinePos := 1; + csIdentifyFormat; + if aStream.Size > 0 then + FEOF := False + else + FEOF := True; + FUCS4Char := TVpUCS4Char(VpNullChar); + FInTryRead := False; +end; +{--------} +procedure TVpInCharFilter.csAdvanceLine; +begin + Inc(FLine); + FLinePos := 1; +end; +{--------} +procedure TVpInCharFilter.csAdvanceLinePos; +begin + Inc(FLinePos); +end; +{--------} +procedure TVpInCharFilter.csGetCharPrim(var aCh : TVpUcs4Char; + var aIsLiteral : Boolean); +begin + {Note: as described in the XML spec (2.11) all end-of-lines are + passed as LF characters no matter what the original document + had. This routine converts a CR/LF pair to a single LF, a + single CR to an LF, and passes LFs as they are.} + + {get the first (test) character} + {first check the UCS4Char buffer to see if we have a character there; + if so get it} + if (FUCS4Char <> TVpUCS4Char(VpNullChar)) then begin + aCh := FUCS4Char; + FUCS4Char := TVpUCS4Char(VpNullChar); + end + {otherwise get a character from the buffer; this depends on the + format of the stream of course} + else begin + case Format of + sfUTF8 : aCh := csGetUtf8Char; + else + {it is next to impossible that this else clause is reached; if + it is we're in deep doggy doo-doo, so pretending that it's the + end of the stream is the least of our worries} + aCh := TVpUCS4Char(VpEndOfStream); + end; + end; + + {if we got a CR, then we need to see what the next character is; if + it is an LF, return LF; otherwise put the second character back + and still return an LF} + if (aCh = CR) then begin + if (FUCS4Char <> TVpUCS4Char(VpNullChar)) then begin + aCh := FUCS4Char; + FUCS4Char := TVpUCS4Char(VpNullChar); + end + else begin + case Format of + sfUTF8 : aCh := csGetUtf8Char; + else + aCh := TVpUCS4Char(VpEndOfStream); + end; + end; + if (aCh <> LF) then + csPushCharPrim(aCh); + aCh := LF; + end; + + {check to see that the character is valid according to XML} + if (aCh <> TVpUCS4Char(VpEndOfStream)) and (not VpIsChar(aCh)) then + raise EVpFilterError.CreateError (FStream.Position, + Line, + LinePos, + sInvalidXMLChar); +end; +{--------} +function TVpInCharFilter.csGetNextBuffer : Boolean; +begin + if FStream.Position > FBufDMZ then + {Account for necessary buffer overlap} + FStream.Position := FStream.Position - (FBufEnd - FBufPos); + FBufEnd := FStream.Read(FBuffer^, FBufSize); + FStreamPos := FStream.Position; + FBufPos := 0; + Result := FBufEnd <> 0; +end; +{--------} +function TVpInCharFilter.csGetTwoAnsiChars(var Buffer) : Boolean; +type + TTwoChars = array [0..1] of AnsiChar; +var + i : integer; +begin + {get two byte characters from the stream} + for i := 0 to 1 do begin + {if the buffer is empty, fill it} + if (FBufPos >= FBufEnd - FBufDMZ) and + (not FInTryRead) then begin + {if we exhaust the stream, we couldn't satisfy the request} + if not csGetNextBuffer then begin + Result := false; + Exit; + end; + end; + {get the first byte character from the buffer} + TTwoChars(Buffer)[i] := FBuffer[FBufPos]; + inc(FBufPos); + end; + Result := true; +end; +{--------} +function TVpInCharFilter.csGetUtf8Char : TVpUcs4Char; +var + Utf8Char : TVpUtf8Char; + {Ch : AnsiChar;} + Len : Integer; + i : Integer; +begin + {if the buffer is empty, fill it} + if (not FInTryRead) and + (FBufPos >= FBufEnd - FBufDMZ) then begin + {if we exhaust the stream, there are no more characters} + if not csGetNextBuffer then begin + Result := TVpUCS4Char(VpEndOfStream); + Exit; + end; + end; + {get the first byte character from the buffer} + Utf8Char[1] := FBuffer[FBufPos]; + FBufPos := FBufPos + 1; + {determine the length of the Utf8 character from this} + Len := VpGetLengthUtf8(Utf8Char[1]); + if (Len < 1) then + raise EVpFilterError.CreateError (FStream.Position, + Line, + LinePos, + sBadUTF8Char); + Move(Len, Utf8Char[0], 1); + {get the remaining characters from the stream} + for i := 2 to Len do begin + {if the buffer is empty, fill it} + if (FBufPos >= FBufEnd - FBufDMZ) and + (not FInTryRead) then begin + {if we exhaust the stream now, it's a badly formed UTF8 + character--true--but we'll just pretend that the last character + does not exist} + if not csGetNextBuffer then begin + Result := TVpUCS4Char(VpEndOfStream); + Exit; + end; + end; + {get the next byte character from the buffer} + Utf8Char[i] := FBuffer[FBufPos]; + FBufPos := FBufPos + 1; + end; + {convert the UTF8 character into a UCS4 character} + if (not VpUtf8ToUcs4(Utf8Char, Len, Result)) then + raise EVpFilterError.CreateError (FStream.Position, + Line, + LinePos, + sBadUTF8Char); +end; +{--------} +procedure TVpInCharFilter.csIdentifyFormat; +begin + {Note: a stream in either of the UTF16 formats will start with a + byte-order-mark (BOM). This is the unicode value $FEFF. Hence + if the first two bytes of the stream are read as ($FE, $FF), + we have a UTF16BE stream. If they are read as ($FF, $FE), we + have a UTF16LE stream. Otherwise we assume a UTF8 stream (at + least for now, it can be changed later).} + csGetNextBuffer; + if FBufSize > 2 then + if (FBuffer[0] = #$FE) and (FBuffer[1] = #$FF) then begin + FFormat := sfUTF16BE; + FBufPos := 2; + end else if (FBuffer[0] = #$FF) and (FBuffer[1] = #$FE) then begin + FFormat := sfUTF16LE; + FBufPos := 2; + end else if (FBuffer[0] = #$EF) and + (FBuffer[1] = #$BB) and + (FBuffer[2] = #$BF) then begin + FFormat := sfUTF8; + FBufPos := 3; + end else + FFormat := sfUTF8 + else + FFormat := sfUTF8; +end; +{--------} +procedure TVpInCharFilter.csPushCharPrim(aCh : TVpUcs4Char); +begin + Assert(FUCS4Char = TVpUCS4Char(VpNullChar)); + {put the char into the buffer} + FUCS4Char := aCh; +end; +{--------} +procedure TVpInCharFilter.csSetFormat(const aValue : TVpStreamFormat); +begin + {we do not allow the UTF16 formats to be changed since they were + well defined by the BOM at the start of the stream but all other + changes are allowed (caveat user); this means that an input stream + that defaulted to UTF8 can be changed at a later stage to + ISO-8859-1 or whatever if required} + if (Format <> sfUTF16LE) and (Format <> sfUTF16BE) then + FFormat := aValue; +end; +{--------} +procedure TVpInCharFilter.csGetChar(var aCh : TVpUcs4Char; + var aIsLiteral : Boolean); +begin + {get the next character; for an EOF raise an exception} + csGetCharPrim(aCh, aIsLiteral); + if (aCh = TVpUCS4Char(VpEndOfStream)) then + FEOF := True + else + {maintain the line/character counts} + if (aCh = LF) then + csAdvanceLine + else + csAdvanceLinePos; +end; +{--------} +function TVpInCharFilter.TryRead(const S : array of Longint) : Boolean; +var + Idx : Longint; + Ch : TVpUcs4Char; + IL : Boolean; + OldBufPos : Longint; + OldChar : DOMChar; + OldUCS4Char : TVpUcs4Char; + OldLinePos : Longint; + OldLine : Longint; +begin + OldBufPos := FBufPos; + OldChar := FLastChar; + OldUCS4Char := FUCS4Char; + OldLinePos := LinePos; + OldLine := Line; + Result := True; + FInTryRead := True; + try + for Idx := Low(s) to High(S) do begin + csGetChar(Ch, IL); + if Ch <> TVpUcs4Char(S[Idx]) then begin + Result := False; + Break; + end; + end; + finally + if not Result then begin + FBufPos := OldBufPos; + FLastChar := OldChar; + FUCS4Char := OldUCS4Char; + FLinePos := OldLinePos; + FLine := OldLine; + end else begin + FLastChar := #0; + FUCS4Char := TVpUCS4Char(VpNullChar); + if (FStreamSize = FStreamPos) and + (FBufPos = FBufEnd) then + FEOF := True; + end; + FInTryRead := False; + end; +end; +{--------} +procedure TVpInCharFilter.SkipChar; +begin + FLastChar := #0; + FUCS4Char := TVpUCS4Char(VpNullChar); + Inc(FLinePos); +end; +{--------} +function TVpInCharFilter.ReadandSkipChar : DOMChar; +var + Ch : TVpUCS4Char; + IL : Boolean; +begin + if FLastChar = '' then begin + csGetChar(Ch, IL); + VpUcs4ToWideChar(Ch, Result); + end else begin + Result := FLastChar; + Inc(FLinePos); + end; + FLastChar := #0; + FUCS4Char := TVpUCS4Char(VpNullChar); + if (FStreamSize = FStreamPos) and + (FBufPos = FBufEnd) then + FEOF := True; +end; +{--------} +function TVpInCharFilter.ReadChar : DOMChar; +var + Ch : TVpUCS4Char; + IL : Boolean; +begin + if FLastChar = '' then begin + csGetChar(Ch, IL); + VpUcs4ToWideChar(Ch, Result); + Dec(FLinePos); + FLastChar := Result; + if (FUCS4Char <> TVpUCS4Char(VpNullChar)) then + if (Format = sfUTF16LE) or + (Format = sfUTF16BE) then + Dec(FBufPos, 2) + else if FBufPos > 0 then + Dec(FBufPos, 1); + FUCS4Char := Ch; + end else + Result := FLastChar; +end; + +{===TVpOutCharFilter=================================================} +constructor TVpOutCharFilter.Create(aStream : TStream; const aBufSize : Longint); +begin + inherited Create(aStream, aBufSize); + FSetUTF8Sig := True; +end; +{--------} +destructor TVpOutCharFilter.Destroy; +begin + if Assigned(FBuffer) then + if (FBufPos > 0) then + csWriteBuffer; + + inherited Destroy; +end; +{--------} +function TVpOutCharFilter.csGetSize : LongInt; +begin + Result := FStream.Size + FBufPos; +end; +{--------} +procedure TVpOutCharFilter.csPutUtf8Char(const aCh : TVpUcs4Char); +var + UTF8 : TVpUtf8Char; + i : integer; +begin + if not VpUcs4ToUtf8(aCh, UTF8) then + raise EVpStreamError.CreateError (FStream.Position, sUCS_U8ConverErr); + for i := 1 to length(UTF8) do begin + if (FBufPos = FBufSize) then + csWriteBuffer; + FBuffer[FBufPos] := UTF8[i]; + inc(FBufPos); + end; +end; +{--------} +procedure TVpOutCharFilter.csSetFormat(const aValue : TVpStreamFormat); +var + TooLate : Boolean; +begin + case Format of + sfUTF8 : TooLate := (FSetUTF8Sig and (Position > 3)) or + ((not FSetUTF8Sig) and (Position > 0)); + sfUTF16LE : TooLate := (Position > 2); + sfUTF16BE : TooLate := (Position > 2); + sfISO88591 : TooLate := (Position > 0); + else + TooLate := true; + end; + if not TooLate then begin + FBufPos := 0; + FFormat := aValue; + case Format of + sfUTF8: + if FSetUTF8Sig then begin + FBuffer[0] := #$EF; + FBuffer[1] := #$BB; + FBuffer[2] := #$BF; + FBufPos := 3; + end; + sfUTF16LE : begin + FBuffer[0] := #$FF; + FBuffer[1] := #$FE; + FBufPos := 2; + end; + sfUTF16BE : begin + FBuffer[0] := #$FE; + FBuffer[1] := #$FF; + FBufPos := 2; + end; + else + FBufPos := 0; + end; + end; +end; +{--------} +procedure TVpOutCharFilter.csWriteBuffer; +begin + FStream.WriteBuffer(FBuffer^, FBufPos); + FBufPos := 0; +end; +{--------} +procedure TVpOutCharFilter.PutUCS4Char(aCh : TVpUcs4Char); +begin + case Format of + sfUTF8 : csPutUTF8Char(aCh); + end; +end; +{--------} +function TVpOutCharFilter.PutChar(aCh1, aCh2 : DOMChar; + var aBothUsed : Boolean) : Boolean; +var + OutCh : TVpUCS4Char; +begin + Result := VpUTF16toUCS4(aCh1, aCh2, OutCh, aBothUsed); + if Result then + PutUCS4Char(OutCh); +end; +{--------} +function TVpOutCharFilter.PutString(const aText : DOMString) : Boolean; +var + aBothUsed : Boolean; + aLen, aPos : Integer; +begin + aLen := Length(aText); + aPos := 1; + Result := True; + while Result and (aPos <= aLen) do begin + if aPos = aLen then + Result := PutChar(aText[aPos], aText[aPos], aBothUsed) + else + Result := PutChar(aText[aPos], aText[aPos + 1], aBothUsed); + if Result then + if aBothUsed then + inc(aPos, 2) + else + inc(aPos, 1); + end; +end; +{--------} +function TVpOutCharFilter.Position : integer; +begin + Result := FStreamPos + FBufPos; +end; + +end. + diff --git a/components/tvplanit/source/vpxparsr.pas b/components/tvplanit/source/vpxparsr.pas new file mode 100644 index 000000000..88d64deae --- /dev/null +++ b/components/tvplanit/source/vpxparsr.pas @@ -0,0 +1,2296 @@ +{*********************************************************} +{* VPXPARSR.PAS 1.03 *} +{*********************************************************} + +{* ***** BEGIN LICENSE BLOCK ***** *} +{* Version: MPL 1.1 *} +{* *} +{* 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/ *} +{* *} +{* 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. *} +{* *} +{* The Original Code is TurboPower Visual PlanIt *} +{* *} +{* The Initial Developer of the Original Code is TurboPower Software *} +{* *} +{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} +{* TurboPower Software Inc. All Rights Reserved. *} +{* *} +{* Contributor(s): *} +{* *} +{* ***** END LICENSE BLOCK ***** *} + +{$I Vp.INC} + +unit VpXParsr; + +interface + +uses + {$IFDEF LCL} + LMessages,LCLProc,LCLType, + {$ELSE} + Windows, + {$ENDIF} + Graphics, + Controls, + SysUtils, + Classes, + VpConst, + VpSR, + VpBase, + VpXBase, + VpXChrFlt; + +type + StringIds = array[0..1] of DOMString; + +{== Event types ======================================================} + TVpDocTypeDeclEvent = procedure(oOwner : TObject; + sDecl, + sId0, + sId1 : DOMString) of object; + TVpValueEvent = procedure(oOwner : TObject; + sValue : DOMString) of object; + TVpAttributeEvent = procedure(oOwner : TObject; + sName, + sValue : DOMString; + bSpecified : Boolean) of object; + TVpProcessInstrEvent = procedure(oOwner : TObject; + sName, + sValue : DOMString) of object; + TVpResolveEvent = procedure(oOwner : TObject; + const sName, + sPublicId, + sSystemId : DOMString; + var sValue : DOMString) of object; + TVpNonXMLEntityEvent = procedure(oOwner : TObject; + sEntityName, + sPublicId, + sSystemId, + sNotationName : DOMString) of object; + TVpPreserveSpaceEvent = procedure(oOwner : TObject; + sElementName : DOMString; + var bPreserve : Boolean) of object; +{== Class types ======================================================} + TVpParser = class(TVpComponent) + protected + { Private declarations } + FAttrEnum : TStringList; + FAttributeType : TStringList; + FBufferSize : Integer; + FCDATA : Boolean; + FContext : Integer; + FCurrentElement : DOMString; + FCurrentElementContent : Integer; + FCurrentPath : string; + FDataBuffer : DOMString; + FDocStack : TList; + FElementInfo : TStringList; + FEntityInfo : TStringList; + FErrors : TStringList; + FFilter : TVpInCharFilter; + FInCharSet : TVpCharEncoding; + FNormalizeData : Boolean; + FNotationInfo : TStringList; + FOnAttribute : TVpAttributeEvent; + FOnCDATASection : TVpValueEvent; + FOnCharData : TVpValueEvent; + FOnComment : TVpValueEvent; + FOnDocTypeDecl : TVpDocTypeDeclEvent; + FOnEndDocument : TNotifyEvent; + FOnEndElement : TVpValueEvent; + FOnIgnorableWhitespace : TVpValueEvent; + FOnNonXMLEntity : TVpNonXMLEntityEvent; + FOnPreserveSpace : TVpPreserveSpaceEvent; + FOnProcessingInstruction : TVpProcessInstrEvent; + FOnResolveEntity : TVpResolveEvent; + FOnStartDocument : TNotifyEvent; + FOnStartElement : TVpValueEvent; + FOnBeginElement : TVpValueEvent; + FPreserve : Boolean; + FRaiseErrors : Boolean; + FTagAttributes : TStringList; + FTempFiles : TStringList; + FUrl : DOMString; + FIsStandAlone : Boolean; + FHasExternals : Boolean; + FXMLDecParsed : Boolean; + + procedure Cleanup; + procedure CheckParamEntityNesting(const aString : DOMString); + procedure DataBufferAppend(const sVal : DOMString); + procedure DataBufferFlush; + procedure DataBufferNormalize; + function DataBufferToString : DOMString; + function DeclaredAttributes(const sName : DOMString; + aIdx : Integer) : TStringList; + function GetAttributeDefaultValueType(const sElemName, + sAttrName : DOMString) + : Integer; + function GetAttributeExpandedValue(const sElemName, + sAttrName : DOMString; + aIdx : Integer) + : DOMString; + function GetElementContentType(const sName : DOMString; + aIdx : Integer) : Integer; + function GetElementIndexOf(const sElemName : DOMString) : Integer; + function GetEntityIndexOf(const sEntityName : DOMString; + aPEAllowed : Boolean) : Integer; + function GetEntityNotationName(const sEntityName : DOMString) + : DOMString; + function GetEntityPublicId(const sEntityName : DOMString) + : DOMString; + function GetEntitySystemId(const sEntityName : DOMString) + : DOMString; + function GetEntityType(const sEntityName : DOMString; + aPEAllowed : Boolean) : Integer; + function GetEntityValue(const sEntityName : DOMString; + aPEAllowed : Boolean) : DOMString; + function GetErrorCount : Integer; + function GetExternalTextEntityValue(const sName, + sPublicId : DOMString; + sSystemId : DOMString) + : DOMString; + function GetInCharSet : TVpCharEncoding; + procedure Initialize; + function IsEndDocument : Boolean; + function IsWhitespace(const cVal : DOMChar) : Boolean; + function LoadDataSource(sSrcName : string; + oErrors : TStringList) : Boolean; + function ParseAttribute(const sName : DOMString) : DOMString; + function ParseEntityRef(bPEAllowed : Boolean) : DOMString; + procedure ParseCDSect; + function ParseCharRef : DOMChar; + procedure ParseComment; + procedure ParseContent; + procedure ParseDocTypeDecl; + procedure ParseDocument; + procedure ParseEndTag; + procedure ParseEq; + procedure ParseElement; + procedure ParseMisc; + function ParseParameterEntityRef(aPEAllowed : Boolean; + bSkip : Boolean) : DOMString; + procedure ParsePCData(aInEntityRef : Boolean); + procedure ParsePI; + function ParsePIEx : Boolean; + { Returns true if an XML declaration was found } + procedure ParsePrim; + procedure ParseProlog; + procedure ParseUntil(const S : array of Longint); + procedure ParseWhitespace; + procedure ParseXMLDeclaration; + procedure PopDocument; + procedure PushDocument; + procedure PushString(const sVal : DOMString); + function ReadChar(const UpdatePos : Boolean) : DOMChar; + procedure ReadExternalIds(bInNotation : Boolean; + var sIds : StringIds); + function ReadLiteral(wFlags : Integer; + var HasEntRef : Boolean) : DOMString; + function ReadNameToken(aValFirst : Boolean) : DOMString; + procedure Require(const S : array of Longint); + procedure RequireWhitespace; + procedure SetAttribute(const sElemName, + sName : DOMString; + wType : Integer; + const sEnum, + sValue : DOMString; + wValueType : Integer); + procedure SetElement(const sName : DOMString; + wType : Integer; + const sContentModel : DOMString); + procedure SetEntity(const sEntityName : DOMString; + wClass : Integer; + const sPublicId, + sSystemId, + sValue, + sNotationName : DOMString; + aIsPE : Boolean); + procedure SetInternalEntity(const sName, sValue : DOMString; + aIsPE : Boolean); + procedure SetNotation(const sNotationName, sPublicId, sSystemId + : DOMString); + procedure SkipChar; + procedure SkipWhitespace(aNextDoc : Boolean); + function TryRead(const S : array of Longint) : Boolean; + procedure ValidateAttribute(const aValue : DOMString; + HasEntRef : Boolean); + procedure ValidateCData(const CDATA : DOMString); + procedure ValidateElementName(const aName : DOMString); + procedure ValidateEncName(const aValue : string); + procedure ValidateEntityValue(const aValue : DOMString; + aQuoteCh : DOMChar); + function ValidateNameChar(const First : Boolean; + const Char : DOMChar) : Boolean; + procedure ValidatePCData(const aString : DOMString; + aInEntityRef : Boolean); + procedure ValidatePublicID(const aString : DOMString); + procedure ValidateVersNum(const aString : string); + + protected + { Protected declarations } + property OnIgnorableWhitespace : TVpValueEvent + read FOnIgnorableWhitespace + write FOnIgnorableWhitespace; + + public + { Public declarations } + constructor Create(oOwner : TComponent); override; + destructor Destroy; override; + + function GetErrorMsg(wIdx : Integer) : DOMString; + function ParseDataSource(const sSource : string) : Boolean; + + property ErrorCount : Integer + read GetErrorCount; + + property Errors : TStringList + read FErrors; + + property InCharSet : TVpCharEncoding + read GetInCharSet; + + property IsStandAlone : Boolean + read FIsStandAlone; + + property HasExternals : Boolean + read FHasExternals; + + { Published declarations } + property BufferSize : Integer + read FBufferSize + write FBufferSize + default 8192; + + property NormalizeData : Boolean + read FNormalizeData + write FNormalizeData + default True; + + property RaiseErrors : Boolean + read FRaiseErrors + write FRaiseErrors + default False; + + property OnAttribute : TVpAttributeEvent + read FOnAttribute + write FOnAttribute; + + property OnCDATASection : TVpValueEvent + read FOnCDATASection + write FOnCDATASection; + + property OnCharData : TVpValueEvent + read FOnCharData + write FOnCharData; + + property OnComment : TVpValueEvent + read FOnComment + write FOnComment; + + property OnDocTypeDecl : TVpDocTypeDeclEvent + read FOnDocTypeDecl + write FOnDocTypeDecl; + + + property OnEndDocument : TNotifyEvent + read FOnEndDocument + write FOnEndDocument; + + property OnEndElement : TVpValueEvent + read FOnEndElement + write FOnEndElement; + + property OnNonXMLEntity : TVpNonXMLEntityEvent + read FOnNonXMLEntity + write FOnNonXMLEntity; + + property OnPreserveSpace : TVpPreserveSpaceEvent + read FOnPreserveSpace + write FOnPreserveSpace; + + property OnProcessingInstruction : TVpProcessInstrEvent + read FOnProcessingInstruction + write FOnProcessingInstruction; + + property OnResolveEntity : TVpResolveEvent + read FOnResolveEntity + write FOnResolveEntity; + + property OnStartDocument : TNotifyEvent + read FOnStartDocument + write FOnStartDocument; + + property OnStartElement : TVpValueEvent + read FOnStartElement + write FOnStartElement; + + property OnBeginElement : TVpValueEvent + read FOnBeginElement + write FOnBeginElement; + end; + +implementation + +{.$R *.RES} + +{== TVpEntityInfo ====================================================} +type + TVpEntityInfo = class(TObject) + private + FEntityClass : Integer; + FIsPE : Boolean; + FPublicId : DOMString; + FSystemId : DOMString; + FValue : DOMString; + FNotationName : DOMString; + public + property EntityClass : Integer + read FEntityClass + write FEntityClass; + + property IsParameterEntity : Boolean + read FIsPE + write FIsPE; + + property NotationName : DOMString + read FNotationName + write FNotationName; + + property PublicId : DOMString + read FPublicId + write FPublicId; + + property SystemId : DOMString + read FSystemId + write FSystemId; + + property Value : DOMString + read FValue + write FValue; + end; +{== TVpNotationInfo ==================================================} + TVpNotationInfo = class(TObject) + private + FPublicId : DOMString; + FSystemId : DOMString; + public + property PublicId : DOMString + read FPublicId + write FPublicId; + + property SystemId : DOMString + read FSystemId + write FSystemId; + end; +{== TVpAttributeInfo =================================================} + TVpAttributeInfo = class(TObject) + private + FType : Integer; + FValue : DOMString; + FValueType : Integer; + FEnum : DOMString; + FLookup : DOMString; + public + property AttrType : Integer + read FType + write FType; + + property Enum : DOMString + read FEnum + write FEnum; + + property Lookup : DOMString + read FLookup + write FLookup; + + property Value : DOMString + read FValue + write FValue; + + property ValueType : Integer + read FValueType + write FValueType; + end; +{== TVpElementInfo ===================================================} + TVpElementInfo = class(TObject) + private + FAttributeList : TStringList; + FContentType : Integer; + FContentModel : DOMString; + public + constructor Create; + destructor Destroy; override; + + procedure SetAttribute(const sName : DOMString; + oAttrInfo : TVpAttributeInfo); + + property AttributeList : TStringList + read FAttributeList; + + property ContentModel : DOMString + read FContentModel + write FContentModel; + + property ContentType : Integer + read FContentType + write FContentType; + end; +{=== TVpElementInfo ==================================================} +constructor TVpElementInfo.Create; +begin + inherited Create; + FAttributeList := nil; + FContentModel := ''; + FContentType := 0; +end; +{--------} +destructor TVpElementInfo.Destroy; +var + i : Integer; +begin + if FAttributeList <> nil then begin + for i := 0 to FAttributeList.Count - 1 do + TVpAttributeInfo(FAttributeList.Objects[i]).Free; + FAttributeList.Free; + end; + inherited Destroy; +end; +{--------} +procedure TVpElementInfo.SetAttribute(const sName : DOMString; + oAttrInfo : TVpAttributeInfo); +var + wIdx : Integer; +begin + if FAttributeList = nil then begin + FAttributeList := TStringList.Create; + FAttributeList.Sorted := True; + wIdx := -1 + end else + wIdx := FAttributeList.IndexOf(sName); + + if wIdx < 0 then + FAttributeList.AddObject(sName, oAttrInfo) + else begin + TVpAttributeInfo(FAttributeList.Objects[wIdx]).Free; + FAttributeList.Objects[wIdx] := oAttrInfo; + end; +end; + +{=== TVpParser =======================================================} +constructor TVpParser.Create(oOwner : TComponent); +begin + inherited Create(oOwner); + + FErrors := TStringList.Create; + FAttributeType := TStringList.Create; + FAttributeType.AddObject('CDATA', Pointer(ATTRIBUTE_CDATA)); + FAttributeType.AddObject('ID', Pointer(ATTRIBUTE_ID)); + FAttributeType.AddObject('IDREF', Pointer(ATTRIBUTE_IDREF)); + FAttributeType.AddObject('IDREFS', Pointer(ATTRIBUTE_IDREFS)); + FAttributeType.AddObject('ENTITY', Pointer(ATTRIBUTE_ENTITY)); + FAttributeType.AddObject('ENTITIES', Pointer(ATTRIBUTE_ENTITIES)); + FAttributeType.AddObject('NMTOKEN', Pointer(ATTRIBUTE_NMTOKEN)); + FAttributeType.AddObject('NMTOKENS', Pointer(ATTRIBUTE_NMTOKENS)); + FAttributeType.AddObject('NOTATION', Pointer(ATTRIBUTE_NOTATION)); + FElementInfo := TStringList.Create; + FElementInfo.Sorted := True; + FEntityInfo := TStringList.Create; + FInCharSet := ceUnknown; + FNotationInfo := TStringList.Create; + FNotationInfo.Sorted := true; + FNotationInfo.Duplicates := dupIgnore; + FTagAttributes := TStringList.Create; + FAttrEnum := TStringList.Create; + FDocStack := TList.Create; + FNormalizeData := True; + FCDATA := False; + FPreserve := False; + FUrl := ''; + FRaiseErrors := False; + FFilter := nil; + FBufferSize := 8192; + FCurrentPath := ''; + FTempFiles := TStringList.Create; + FIsStandAlone := False; + FHasExternals := False; + FXMLDecParsed := False; +end; +{--------} +destructor TVpParser.Destroy; +var + TempFilter : TVpInCharFilter; + i : Integer; +begin + Cleanup; + FTagAttributes.Free; + FNotationInfo.Free; + FEntityInfo.Free; + FElementInfo.Free; + FAttributeType.Free; + FErrors.Free; + if Assigned(FTempFiles) then begin + for i := 0 to Pred(FTempFiles.Count) do + DeleteFile(FTempFiles[i]); + FTempFiles.Free; + end; + FAttrEnum.Free; + if FDocStack.Count > 0 then begin + for i := Pred(FDocStack.Count) to 0 do begin + TempFilter := FDocStack[i]; + TempFilter.Free; + FDocStack.Delete(i); + end; + end; + FDocStack.Free; + inherited Destroy; +end; +{--------} +procedure TVpParser.CheckParamEntityNesting(const aString : DOMString); +var + OpenPos : Integer; + ClosePos : Integer; +begin + OpenPos := VpPos('(', aString); + ClosePos := VpPos(')', aString); + if (((OpenPos <> 0) and + (ClosePos = 0)) or + ((ClosePos <> 0) and + (OpenPos = 0))) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sBadParamEntNesting + + aString); +end; +{--------} +procedure TVpParser.Cleanup; +var + i : Integer; +begin + if FElementInfo <> nil then begin + for i := 0 to FElementInfo.Count - 1 do + TVpElementInfo(FElementInfo.Objects[i]).Free; + FElementInfo.Clear; + end; + + if FEntityInfo <> nil then begin + for i := 0 to FEntityInfo.Count - 1 do + TVpEntityInfo(FEntityInfo.Objects[i]).Free; + FEntityInfo.Clear; + end; + + if FNotationInfo <> nil then begin + for i := 0 to FNotationInfo.Count - 1 do + TVpNotationInfo(FNotationInfo.Objects[i]).Free; + FNotationInfo.Clear; + end; +end; +{--------} +procedure TVpParser.DataBufferAppend(const sVal : DOMString); +begin + FDataBuffer := FDataBuffer + sVal; +end; +{--------} +procedure TVpParser.DataBufferFlush; +begin + if FNormalizeData and + not FCDATA and + not FPreserve then + DataBufferNormalize; + if FDataBuffer <> '' then begin + case FCurrentElementContent of + CONTENT_MIXED, CONTENT_ANY : + if FCDATA then begin + ValidateCData(FDataBuffer); + if Assigned(FOnCDATASection) then + FOnCDATASection(self, FDataBuffer); + end else begin + if Assigned(FOnCharData) then + FOnCharData(self, FDataBuffer); + end; + CONTENT_ELEMENTS : + if Assigned(FOnIgnorableWhitespace) then + FOnIgnorableWhitespace(self, FDataBuffer); + end; + FDataBuffer := ''; + end; +end; +{--------} +procedure TVpParser.DataBufferNormalize; +var + BuffLen : Integer; + j : Integer; + CharDeleted : Boolean; +begin + while (Length(FDataBuffer) > 0) and + IsWhiteSpace(FDataBuffer[1]) do + Delete(FDataBuffer, 1, 1); + while (Length(FDataBuffer) > 0) and + IsWhiteSpace(FDataBuffer[Length(FDataBuffer)]) do + Delete(FDataBuffer, Length(FDataBuffer), 1); + + j := 1; + BuffLen := Length(FDataBuffer); + CharDeleted := False; + while j < BuffLen do begin + if IsWhiteSpace(FDataBuffer[j]) then begin + { Force whitespace to a single space } + FDataBuffer[j] := ' '; + + { Remove additional whitespace } + j := j + 1; + while (j <= Length(FDataBuffer)) and + IsWhiteSpace(FDataBuffer[j]) do begin + Delete(FDataBuffer, j, 1); + CharDeleted := True; + end; + if (CharDeleted) then begin + BuffLen := Length(FDataBuffer); + CharDeleted := False; + end; + end; + j := j + 1; + end; +end; +{--------} +function TVpParser.DataBufferToString : DOMString; +begin + Result := FDataBuffer; + FDataBuffer := ''; +end; +{--------} +function TVpParser.GetErrorCount : Integer; +begin + Result := FErrors.Count; +end; +{--------} +function TVpParser.GetErrorMsg(wIdx : Integer) : DOMString; +begin + Result := sIndexOutOfBounds; + if (wIdx >= 0) and + (wIdx < FErrors.Count) then + Result := FErrors[wIdx]; +end; +{--------} +function TVpParser.DeclaredAttributes(const sName : DOMString; + aIdx : Integer) + : TStringList; +begin + if aIdx < 0 then + Result := nil + else + Result := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList; +end; +{--------} +function TVpParser.GetAttributeDefaultValueType(const sElemName, + sAttrName : DOMString) + : Integer; +var + wIdx : Integer; + oAttrList : TStringList; + oAttr : TVpAttributeInfo; +begin + Result := ATTRIBUTE_DEFAULT_UNDECLARED; + wIdx := GetElementIndexOf(sElemName); + if wIdx >= 0 then begin + oAttrList := TVpElementInfo(FElementInfo.Objects[wIdx]).AttributeList; + if oAttrList <> nil then begin + wIdx := oAttrList.IndexOf(sAttrName); + if wIdx >= 0 then begin + oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]); + Result := oAttr.AttrType; + end; + end; + end; +end; +{--------} +function TVpParser.GetAttributeExpandedValue(const sElemName, + sAttrName : DOMString; + aIdx : Integer) + : DOMString; +var + wIdx : Integer; + oAttrList : TStringList; + oAttr : TVpAttributeInfo; + HasEntRef : Boolean; +begin + SetLength(Result, 0); + HasEntRef := False; + if aIdx >= 0 then begin + oAttrList := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList; + if oAttrList <> nil then begin + wIdx := oAttrList.IndexOf(sAttrName); + if wIdx >= 0 then begin + oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]); + if (oAttr.Lookup = '') and + (oAttr.Value <> '') then begin + PushString('"' + oAttr.Value + '"'); + oAttr.Lookup := ReadLiteral(LIT_NORMALIZE or + LIT_CHAR_REF or + LIT_ENTITY_REF, + HasEntRef); + SkipWhitespace(True); + end; + Result := oAttr.Lookup; + end; + end; + end; +end; +{--------} +function TVpParser.GetElementContentType(const sName : DOMString; + aIdx : Integer) + : Integer; +begin + if aIdx < 0 then + Result := CONTENT_UNDECLARED + else + Result := TVpElementInfo(FElementInfo.Objects[aIdx]).ContentType; +end; +{--------} +function TVpParser.GetElementIndexOf(const sElemName : DOMString) + : Integer; +begin + Result := FElementInfo.IndexOf(sElemName); +end; +{--------} +function TVpParser.GetEntityIndexOf(const sEntityName : DOMString; + aPEAllowed : Boolean) + : Integer; +begin + for Result := 0 to FEntityInfo.Count - 1 do + if FEntityInfo[Result] = sEntityName then begin + if (not aPEAllowed) then begin + if (not TVpEntityInfo(FEntityInfo.Objects[Result]).IsParameterEntity) then + Exit; + end else + Exit; + end; + Result := -1; +end; +{--------} +function TVpParser.GetEntityNotationName(const sEntityName : DOMString) + : DOMString; +var + wIdx : Integer; + oEntity : TVpEntityInfo; +begin + Result := ''; + wIdx := GetEntityIndexOf(sEntityName, False); + if wIdx >= 0 then begin + oEntity := TVpEntityInfo(FEntityInfo.Objects[wIdx]); + Result := oEntity.NotationName; + end; +end; +{--------} +function TVpParser.GetEntityPublicId(const sEntityName : DOMString) + : DOMString; +var + wIdx : Integer; + oEntity : TVpEntityInfo; +begin + Result := ''; + wIdx := GetEntityIndexOf(sEntityName, False); + if wIdx >= 0 then begin + oEntity := TVpEntityInfo(FEntityInfo.Objects[wIdx]); + Result := oEntity.PublicId; + end; +end; +{--------} +function TVpParser.GetEntitySystemId(const sEntityName : DOMString) + : DOMString; +var + wIdx : Integer; + oEntity : TVpEntityInfo; +begin + Result := ''; + wIdx := GetEntityIndexOf(sEntityName, False); + if wIdx >= 0 then begin + oEntity := TVpEntityInfo(FEntityInfo.Objects[wIdx]); + Result := oEntity.SystemId; + end; +end; +{--------} +function TVpParser.GetEntityType(const sEntityName : DOMString; + aPEAllowed : Boolean) + : Integer; +var + wIdx : Integer; + oEntity : TVpEntityInfo; +begin + Result := ENTITY_UNDECLARED; + wIdx := GetEntityIndexOf(sEntityName, aPEAllowed); + if wIdx >= 0 then begin + oEntity := TVpEntityInfo(FEntityInfo.Objects[wIdx]); + Result := oEntity.EntityClass; + end; +end; +{--------} +function TVpParser.GetEntityValue(const sEntityName : DOMString; + aPEAllowed : Boolean) + : DOMString; +var + wIdx : Integer; + oEntity : TVpEntityInfo; +begin + Result := ''; + wIdx := GetEntityIndexOf(sEntityName, aPEAllowed); + if wIdx >= 0 then begin + oEntity := TVpEntityInfo(FEntityInfo.Objects[wIdx]); + Result := oEntity.Value; + end; +end; +{--------} +function TVpParser.GetExternalTextEntityValue(const sName, + sPublicId : DOMString; + sSystemId : DOMString) + : DOMString; +var + CompletePath : string; +begin + DataBufferFlush; + Result := ''; + + FHasExternals := True; + + if Assigned(FOnResolveEntity) then + FOnResolveEntity(self, sName, sPublicId, sSystemId, sSystemId); + + if sSystemId = '' then + exit; + + PushDocument; + if (VpPos('/', sSystemID) = 0) and + (VpPos('\', sSystemID) = 0) then + CompletePath := FCurrentPath + sSystemID + else + CompletePath := sSystemID; + {TODO:: Need to check return value of LoadDataSource? } + try + LoadDataSource(CompletePath, FErrors); + except + PopDocument; + raise; + end; +end; +{--------} +function TVpParser.GetInCharSet : TVpCharEncoding; +begin + if FFilter <> nil then + Result := ceUTF8 + else + { If no current filter then return last known value. } + Result := FInCharSet; +end; +{--------} +procedure TVpParser.Initialize; +begin + FDataBuffer := ''; + + SetInternalEntity('amp', '&', False); + SetInternalEntity('lt', '<', False); + SetInternalEntity('gt', '>', False); + SetInternalEntity('apos', ''', False); + SetInternalEntity('quot', '"', False); +end; +{--------} +function TVpParser.IsEndDocument : Boolean; +var + TheStream : TStream; + DocCount : Integer; +begin + DocCount := FDocStack.Count; + if (DocCount = 0) then + Result := FFilter.Eof + else begin + Result := False; + while FFilter.EOF do begin + if (DocCount > 0) then begin + TheStream := FFilter.Stream; + FFilter.Free; + TheStream.Free; + end; + PopDocument; + DocCount := FDocStack.Count; + end; + end; +end; +{--------} +function TVpParser.IsWhitespace(const cVal : DOMChar) : Boolean; +begin + Result := (cVal = #$20) or (cVal = #$09) or + (cVal = #$0D) or (cVal = #$0A); +end; +{--------} +function TVpParser.LoadDataSource(sSrcName : string; + oErrors : TStringList) : Boolean; +var + aFileStream : TVpFileStream; +begin + begin + { Must be a local or network file. Eliminate file:// prefix. } + if StrLIComp(PChar(sSrcName), 'file://', 7) = 0 then + Delete(sSrcName, 1, 7); + + if FileExists(sSrcName) then begin + FCurrentPath := ExtractFilePath(sSrcName); + {the stream and filter are destroyed after the document is parsed} + aFileStream := TVpFileStream.CreateEx(fmOpenRead, sSrcName); + aFileStream.Position := 0; + Result := True; + end else begin + oErrors.Add(format(sFileNotFound, [sSrcName])); + raise EVpParserError.CreateError (0, + 0, + format(sFileNotFound, [sSrcName])); + end; + end; + + if Result then + try + aFileStream.Position := 0; + FFilter := TVpInCharFilter.Create(aFileStream, FBufferSize); + except + aFileStream.Free; + raise; + end; +end; +{--------} +function TVpParser.ParseAttribute(const sName : DOMString) : DOMString; +var + sAttrName, + sValue : DOMString; + wType : Integer; + HasEntRef : Boolean; +begin + Result := ''; + HasEntRef := False; + sAttrName := ReadNameToken(True); + wType := GetAttributeDefaultValueType(sName, sAttrName); + + ParseEq; + + {we need to validate production 10 - 1st letter in quotes} + + if (wType = ATTRIBUTE_CDATA) or (wType = ATTRIBUTE_UNDECLARED) then + sValue := ReadLiteral(LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef) + else + sValue := ReadLiteral(LIT_CHAR_REF or + LIT_ENTITY_REF or + LIT_NORMALIZE, + HasEntRef); + if not HasEntRef then + ValidateAttribute(sValue, HasEntRef); + + if Assigned(FOnAttribute) then + FOnAttribute(self, sAttrName, sValue, True); + FDataBuffer := ''; + + FTagAttributes.Add(sAttrName); + if sAttrName = 'xml:space' then + Result := sValue; +end; +{--------} +procedure TVpParser.ParseCDSect; +{conditional section} +begin + ParseUntil(Xpc_ConditionalEnd); +end; +{--------} +function TVpParser.ParseCharRef : DOMChar; +var + TempChar : DOMChar; + Ucs4Chr : TVpUcs4Char; +begin + Ucs4Chr := 0; + if TryRead(Xpc_CharacterRefHex) then begin + Ucs4Chr := 0; + while True do begin + TempChar := ReadChar(True); + if (TempChar = '0') or (TempChar = '1') or (TempChar = '2') or + (TempChar = '3') or (TempChar = '4') or (TempChar = '5') or + (TempChar = '6') or (TempChar = '7') or (TempChar = '8') or + (TempChar = '9') or (TempChar = 'A') or (TempChar = 'B') or + (TempChar = 'C') or (TempChar = 'D') or (TempChar = 'E') or + (TempChar = 'F') or (TempChar = 'a') or (TempChar = 'b') or + (TempChar = 'c') or (TempChar = 'd') or (TempChar = 'e') or + (TempChar = 'f') then begin + Ucs4Chr := Ucs4Chr shl 4; + Ucs4Chr := Ucs4Chr + StrToIntDef(TempChar, 0); + end else if (TempChar = ';') then + Break + else + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sIllCharInRef + + QuotedStr(TempChar)); + end; + end else begin + while True do begin + TempChar := ReadChar(True); + if (TempChar = '0') or (TempChar = '1') or (TempChar = '2') or + (TempChar = '3') or (TempChar = '4') or (TempChar = '5') or + (TempChar = '6') or (TempChar = '7') or (TempChar = '8') or + (TempChar = '9') then begin + Ucs4Chr := Ucs4Chr * 10; + Ucs4Chr := Ucs4Chr + StrToIntDef(TempChar, 0); + end else if (TempChar = ';') then + Break + else + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sIllCharInRef + + QuotedStr(TempChar)); + end; + end; + VpUcs4ToWideChar(Ucs4Chr, Result); + DataBufferAppend(Result); +end; +{--------} +procedure TVpParser.ParseComment; +var + TempComment : DOMString; +begin + ParseUntil(Xpc_CommentEnd); + TempComment := DataBufferToString; + { Did we find '--' within the comment? } + if (TempComment <> '') and + ((VpPos('--', TempComment) <> 0) or + (TempComment[Length(TempComment)] = '-')) then + { Yes. Raise an error. } + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvalidCommentText); + if Assigned(FOnComment) then + FOnComment(self, TempComment); +end; +{--------} +procedure TVpParser.ParseContent; +var + TempChar : DOMChar; + TempStr : DOMString; + EntRefs : TStringList; + OldLine : Integer; + OldPos : Integer; + TempInt : Integer; + StackLevel : Integer; + LastCharAmp : Boolean; +begin + LastCharAmp := False; + StackLevel := 0; + TempChar := #0; + EntRefs := nil; + while True do begin + OldLine := FFilter.Line; + OldPos := FFilter.LinePos; + case FCurrentElementContent of + CONTENT_ANY, CONTENT_MIXED : + begin + if Assigned(EntRefs) then begin + if (FDataBuffer <> '&') or + (LastCharAmp) then begin + ParsePCData(True); + LastCharAmp := False; + end; + { Reset the last ent ref if we parsed something.} + if (FFilter.Line <> OldLine) and + (FFilter.LinePos <> OldPos) then begin + EntRefs.Free; + EntRefs := nil; + end; + end else + ParsePCData(TempChar <> ''); + end; + CONTENT_ELEMENTS : ParseWhitespace; + end; + TempChar := ReadChar(False); + if IsEndDocument then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sUnexpectedEof); + if (TempChar = '&') then begin + SkipChar; + TempChar := ReadChar(False); + if TempChar = '#' then begin + SkipChar; + TempChar := ParseCharRef; + if TempChar = '&' then + LastCharAmp := True; + if (FCurrentElementContent <> CONTENT_ANY) and + (FCurrentElementContent <> CONTENT_MIXED) then + PushString(TempChar); + end else begin + if (not Assigned(EntRefs)) then begin + StackLevel := Succ(FDocStack.Count); + EntRefs := TStringList.Create; + TempStr := ParseEntityRef(False); + end else begin + {Check for circular references} + TempStr := ParseEntityRef(False); + StackLevel := FDocStack.Count; + TempInt := EntRefs.IndexOf(TempStr); + if TempInt <> -1 then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sCircularEntRef + + TempStr); + end; + EntRefs.Add(TempStr); + end; + if (FCurrentElementContent <> CONTENT_ANY) and + (FCurrentElementContent <> CONTENT_MIXED) and + (TempChar = '<') then begin + DataBufferFlush; + ParseElement; + end else + TempChar := ReadChar(False); + end else if (TempChar = '<') then begin + EntRefs.Free; + EntRefs := nil; + SkipChar; + TempChar := ReadChar(False); + if (TempChar = '!') then begin + SkipChar; + DataBufferFlush; + TempChar := ReadChar(True); + if (TempChar = '-') then begin + Require(Xpc_Dash); + ParseComment; + end else if (TempChar = '[') then begin + Require(Xpc_CDATAStart); + FCDATA := True; + ParseCDSect; + ValidateCData(FDataBuffer); + DataBufferFlush; + FCDATA := False; + end else + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sExpCommentOrCDATA + + '(' + TempChar + ')'); + end else if (TempChar = '?') then begin + EntRefs.Free; + EntRefs := nil; + SkipChar; + DataBufferFlush; + ParsePI; + end else if (TempChar = '/') then begin + SkipChar; + DataBufferFlush; + ParseEndTag; + Exit; + end else begin + EntRefs.Free; + EntRefs := nil; + DataBufferFlush; + ParseElement; + end; + end; {if..else} + if (Assigned(EntRefs)) and + (FDocStack.Count < StackLevel) then begin + EntRefs.Clear; + StackLevel := FDocStack.Count; + end; + end; + EntRefs.Free; +end; +{--------} +function TVpParser.ParseDataSource(const sSource : string) : Boolean; +begin + FErrors.Clear; + FIsStandAlone := False; + FHasExternals := False; + FUrl := sSource; + Result := LoadDataSource(sSource, FErrors); + if Result then begin + FFilter.FreeStream := True; + ParsePrim; + end + else + FErrors.Add(sSrcLoadFailed + sSource); + FUrl := ''; + Result := FErrors.Count = 0; +end; +{--------} +procedure TVpParser.ParseDocTypeDecl; +var + sDocTypeName : DOMString; + sIds : StringIds; +begin + RequireWhitespace; + sDocTypeName := ReadNameToken(True); + SkipWhitespace(True); + ReadExternalIds(False, sIds); + SkipWhitespace(True); + + // Parse external DTD + if sIds[1] <> '' then begin + end; + + if sIds[1] <> '' then begin + while True do begin + FContext := CONTEXT_DTD; + SkipWhitespace(True); + FContext := CONTEXT_NONE; + if TryRead(Xpc_BracketAngleRight) then + Break + else begin + FContext := CONTEXT_DTD; + FContext := CONTEXT_NONE; + end; + end; + end else begin + SkipWhitespace(True); + Require(Xpc_BracketAngleRight); + end; + + if Assigned(FOnDocTypeDecl) then + FOnDocTypeDecl(self, sDocTypeName, sIds[0], sIds[1]); +end; +{--------} +procedure TVpParser.ParseDocument; +begin + FXMLDecParsed := False; + ParseProlog; + Require(Xpc_BracketAngleLeft); + ParseElement; + try + ParseMisc; + except + end; + SkipWhiteSpace(True); + if (not IsEndDocument) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sDataAfterValDoc); + + if Assigned(FOnEndDocument) then + FOnEndDocument(self); +end; +{--------} +procedure TVpParser.ParseElement; +var + wOldElementContent, + i : Integer; + sOldElement : DOMString; + sGi, sTmp, sTmp2 : DOMString; + oTmpAttrs : TStringList; + bOldPreserve : Boolean; + TempChar : DOMChar; + aList : TStringList; + ElemIdx : Integer; +begin + wOldElementContent := FCurrentElementContent; + sOldElement := FCurrentElement; + bOldPreserve := FPreserve; + + FTagAttributes.Clear; + sGi := ReadNameToken(True); + + ValidateElementName(sGi); + + if Assigned(FOnBeginElement) then + FOnBeginElement(self, sGi); + + FCurrentElement := sGi; + ElemIdx := GetElementIndexOf(sGi); + FCurrentElementContent := GetElementContentType(sGi, ElemIdx); + if FCurrentElementContent = CONTENT_UNDECLARED then + FCurrentElementContent := CONTENT_ANY; + + SkipWhitespace(True); + sTmp := ''; + TempChar := ReadChar(False); + while (TempChar <> '/') and + (TempChar <> '>') do begin + sTmp2 := ParseAttribute(sGi); + if sTmp2 <> '' then + sTmp := sTmp2; + SkipWhitespace(True); + TempChar := ReadChar(False); + { check for duplicate attributes } + if FTagAttributes.Count > 1 then begin + aList := TStringList.Create; + try + aList.Sorted := True; + aList.Duplicates := dupIgnore; + aList.Assign(FTagAttributes); + if (aList.Count <> FTagAttributes.Count) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sRedefinedAttr); + finally + aList.Free; + end; + end; + end; + + oTmpAttrs := DeclaredAttributes(sGi, ElemIdx); + if oTmpAttrs <> nil then begin + for i := 0 to oTmpAttrs.Count - 1 do begin + if FTagAttributes.IndexOf(oTmpAttrs[i]) <> - 1 then + Continue; + + if Assigned(FOnAttribute) then begin + sTmp2 := GetAttributeExpandedValue(sGi, oTmpAttrs[i], ElemIdx); + if sTmp2 <> '' then + FOnAttribute(self, oTmpAttrs[i], sTmp2, False); + end; + end; + end; + + if sTmp = '' then + sTmp := GetAttributeExpandedValue(sGi, 'xml:space', ElemIdx); + if sTmp = 'preserve' then + FPreserve := True + else if sTmp = 'default' then + FPreserve := not FNormalizeData; + + if Assigned(FOnPreserveSpace) then + FOnPreserveSpace(self, sGi, FPreserve); + + TempChar := ReadChar(True); + if (TempChar = '>') then begin + if Assigned(FOnStartElement) then + FOnStartElement(self, sGi); + ParseContent; + end else if (TempChar = '/') then begin + Require(Xpc_BracketAngleRight); + if Assigned(FOnStartElement) then + FOnStartElement(self, sGi); + if Assigned(FOnEndElement) then + FOnEndElement(self, sGi); + end; + + FPreserve := bOldPreserve; + FCurrentElement := sOldElement; + FCurrentElementContent := wOldElementContent; +end; +{--------} +procedure TVpParser.ParseEndTag; +var + sName : DOMString; +begin + sName := ReadNameToken(True); + if sName <> FCurrentElement then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sMismatchEndTag + + 'Start tag = "' + FCurrentElement + + '" End tag = "' + sName + '"'); + SkipWhitespace(True); + Require(Xpc_BracketAngleRight); + if Assigned(FOnEndElement) then + FOnEndElement(self, FCurrentElement); +end; +{--------} +function TVpParser.ParseEntityRef(bPEAllowed : Boolean) : DOMString; +begin + Result := ReadNameToken(True); + Require(Xpc_GenParsedEntityEnd); + case GetEntityType(Result, bPEAllowed) of + ENTITY_UNDECLARED : + begin + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sUndeclaredEntity + + QuotedStr(Result)); + end; + ENTITY_INTERNAL : + PushString(GetEntityValue(Result, False)); + ENTITY_TEXT : + begin + (GetExternalTextEntityValue(Result, + GetEntityPublicId(Result), + GetEntitySystemId(Result))); + end; + ENTITY_NDATA : + begin + FHasExternals := True; + if Assigned(FOnNonXMLEntity) then + FOnNonXMLEntity(self, + Result, + GetEntityPublicId(Result), + GetEntitySystemId(Result), + GetEntityNotationName(Result)); + end; + end; +end; +{--------} +procedure TVpParser.ParseEq; +begin + SkipWhitespace(True); + Require(Xpc_Equation); + SkipWhitespace(True); +end; +{--------} +procedure TVpParser.ParseMisc; +var + ParsedComment : Boolean; +begin + ParsedComment := False; + while True do begin + SkipWhitespace(True); + if TryRead(Xpc_ProcessInstrStart) then begin + if ParsePIEx and ParsedComment then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sCommentBeforeXMLDecl) + else + FXMLDecParsed := True; + end else if TryRead(Xpc_CommentStart) then begin + FXMLDecParsed := True; + ParsedComment := True; + ParseComment; + end else + Exit; + end; +end; +{--------} +function TVpParser.ParseParameterEntityRef(aPEAllowed : Boolean; + bSkip : Boolean) + : DOMString; +var + sName, + sValue : DOMString; +begin + sName := ReadNameToken(True); + Require(Xpc_GenParsedEntityEnd); + case GetEntityType(sName, aPEAllowed) of + ENTITY_UNDECLARED : + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos - 3, + sUndeclaredEntity + sName); + ENTITY_INTERNAL : + begin + sValue := GetEntityValue(sName, aPEAllowed); + if bSkip then + DataBufferAppend(sValue) + else + PushString(sValue); + Result := sValue; + end; + ENTITY_TEXT : + begin + sValue := GetExternalTextEntityValue(sName, + GetEntityPublicId(sName), + GetEntitySystemId(sName)); + if bSkip then + DataBufferAppend(sValue); + Result := sValue; + end; + ENTITY_NDATA : + begin + FHasExternals := True; + if Assigned(FOnNonXMLEntity) then + FOnNonXMLEntity(self, + sName, + GetEntityPublicId(sName), + GetEntitySystemId(sName), + GetEntityNotationName(sName)); + end; + end; +end; +{--------} +procedure TVpParser.ParsePCData(aInEntityRef : Boolean); +var + TempBuff : DOMString; + TempChar : DOMChar; + CurrLength : Longint; + BuffLength : Longint; + Added : Boolean; +begin + Added := False; + CurrLength := 0; + BuffLength := 50; + SetLength(TempBuff, BuffLength); + while True do begin + TempChar := ReadChar(False); + if (TempChar = '<') or + (TempChar = '&') or + (FFilter.EOF) then + Break + else begin + if ((CurrLength + 2) > BuffLength) then begin + BuffLength := BuffLength * 2; + SetLength(TempBuff, BuffLength); + end; + Move(TempChar, + PByteArray(Pointer(TempBuff))[CurrLength], + 2); + Inc(CurrLength, 2); + SkipChar; + Added := True; + end; + end; + if Added then begin + SetLength(TempBuff, CurrLength div 2); + ValidatePCData(TempBuff, aInEntityRef); + DataBufferAppend(TempBuff); + end; +end; +{--------} +procedure TVpParser.ParsePI; +begin + ParsePIEx; +end; +{--------} +function TVpParser.ParsePIEx : Boolean; +var + sName : DOMString; +begin + Result := False; + sName := ReadNameToken(True); + if sName <> 'xml' then begin + FXMLDecParsed := True; + if not TryRead(Xpc_ProcessInstrEnd) then begin + RequireWhitespace; + ParseUntil(Xpc_ProcessInstrEnd); + end; + end else begin + Result := True; + ParseXMLDeclaration; + end; + if Assigned(FOnProcessingInstruction) then + FOnProcessingInstruction(self, sName, DataBufferToString) + else + DataBufferToString; +end; +{--------} +procedure TVpParser.ParsePrim; +begin + try + Initialize; + + if Assigned(FOnStartDocument) then + FOnStartDocument(self); + + try + ParseDocument; + except + on E: EVpFilterError do begin + FErrors.Add(Format(sFmtErrorMsg, + [E.Line, E.LinePos, E.Message])); + if FRaiseErrors then begin + if Assigned(FOnEndDocument) then + FOnEndDocument(self); + Cleanup; + raise; + end; + end; + end; + + if Assigned(FOnEndDocument) then + FOnEndDocument(self); + + Cleanup; + finally + FInCharSet := ceUTF8; + FFilter.Free; + FFilter := nil; + end; +end; +{--------} +procedure TVpParser.ParseProlog; +begin + ParseMisc; + if TryRead(Xpc_DTDDocType) then begin + FXMLDecParsed := True; + ParseDocTypeDecl; + ParseMisc; + end; +end; +{--------} +procedure TVpParser.ParseUntil(const S : array of Longint); +var + TempStr : AnsiString; + TempChar : AnsiChar; + i : Integer; + Found : Boolean; +begin + Found := TryRead(s); + while (not Found) and + (not FFilter.EOF) do begin + DataBufferAppend(ReadChar(True)); + Found := TryRead(s); + end; + if (not Found) then begin + {$IFDEF DCC4OrLater} + SetLength(TempStr, Length(S)); + {$ENDIF} + for i := 0 to High(S) do begin + VpUcs4ToIso88591(s[i], TempChar); + TempStr[Succ(i)] := TempChar; + end; + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sUnexpEndOfInput + + QuotedStr(TempStr)); + end; +end; +{--------} +procedure TVpParser.ParseWhitespace; +var + TempChar : DOMChar; +begin + TempChar := ReadChar(False); + while IsWhitespace(TempChar) do begin + SkipChar; + DataBufferAppend(TempChar); + TempChar := ReadChar(False); + end; +end; +{--------} +procedure TVpParser.ParseXMLDeclaration; +var + sValue : DOMString; + Buffer : DOMString; + HasEntRef : Boolean; +begin + if FXMLDecParsed then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sXMLDecNotAtBeg); + HasEntRef := False; + SkipWhitespace(True); + Require(Xpc_Version); + DatabufferAppend('version'); + ParseEq; + DatabufferAppend('="'); + Buffer := DatabufferToString; + sValue := ReadLiteral(0, HasEntRef); + ValidateVersNum(sValue); + Buffer := Buffer + sValue + '"'; + if (sValue <> VpXMLSpecification) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + Format(sInvalidXMLVersion, + [VpXMLSpecification])); + SkipWhitespace(True); + if TryRead(Xpc_Encoding) then begin + DatabufferAppend('encoding'); + ParseEq; + DataBufferAppend('="'); + Buffer := Buffer + ' ' + DataBufferToString; + sValue := ReadLiteral(LIT_CHAR_REF or + LIT_ENTITY_REF, + HasEntRef); + ValidateEncName(sValue); + Buffer := Buffer + sValue + '"'; + if CompareText(sValue, 'ISO-8859-1') = 0 then + FFilter.Format := sfISO88591; + SkipWhitespace(True); + end; + + if TryRead(Xpc_Standalone) then begin + DatabufferAppend('standalone'); + ParseEq; + DatabufferAppend('="'); + Buffer := Buffer + ' ' + DataBufferToString; + sValue := ReadLiteral(LIT_CHAR_REF or + LIT_ENTITY_REF, + HasEntRef); + if (not ((sValue = 'yes') or + (sValue = 'no'))) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvStandAloneVal); + Buffer := Buffer + sValue + '"'; + FIsStandalone := sValue = 'yes'; + SkipWhitespace(True) + end; + + Require(Xpc_ProcessInstrEnd); + DatabufferToString; + DatabufferAppend(Buffer); +end; +{--------} +procedure TVpParser.PopDocument; +begin + Assert(FDocStack.Count > 0); + + if FDocStack.Count > 0 then begin + FFilter := FDocStack[Pred(FDocStack.Count)]; + FDocStack.Delete(Pred(FDocStack.Count)); + end; +end; +{--------} +procedure TVpParser.PushDocument; +begin + Assert(Assigned(FFilter)); + + FDocStack.Add(Pointer(FFilter)); + FFilter := nil; +end; +{--------} +procedure TVpParser.PushString(const sVal : DOMString); +var + MemStream : TVpMemoryStream; + TempString : string; +begin + if Length(sVal) > 0 then begin + PushDocument; + MemStream := TVpMemoryStream.Create; + TempString := WideCharLenToString(Pointer(sVal), Length(sVal)); + MemStream.Write(TempString[1], Length(TempString)); + MemStream.Position := 0; + FFilter := TVpInCharFilter.Create(MemStream, BufferSize); + end; +end; +{--------} +function TVpParser.ReadChar(const UpdatePos : Boolean) : DOMChar; +begin + Result := FFilter.ReadChar; + if ((Result = VpEndOfStream) and + (not IsEndDocument)) then + Result := FFilter.ReadChar; + if (UpdatePos) then + FFilter.SkipChar; +end; +{--------} +procedure TVpParser.ReadExternalIds(bInNotation : Boolean; + var sIds : StringIds); +var + HasEntRef : Boolean; + TempChar : DOMChar; +begin + HasEntRef := False; + if TryRead(Xpc_ExternalPublic) then begin + RequireWhitespace; + sIds[0] := ReadLiteral(LIT_NORMALIZE, HasEntRef); + ValidatePublicID(sIds[0]); + if bInNotation then begin + SkipWhitespace(True); + TempChar := ReadChar(False); + if (TempChar = '''') or + (TempChar = '"') then + sIds[1] := ReadLiteral(0, HasEntRef); + end else begin + RequireWhitespace; + sIds[1] := ReadLiteral(0, HasEntRef); + end; + end else if TryRead(Xpc_ExternalSystem) then begin + RequireWhitespace; + sIds[1] := ReadLiteral(0, HasEntRef); + end; +end; +{--------} +function TVpParser.ReadLiteral(wFlags : Integer; + var HasEntRef : Boolean) : DOMString; +var + TempStr : DOMString; + cDelim, + TempChar : DOMChar; + EntRefs : TStringList; + StackLevel : Integer; + CurrCharRef : Boolean; +begin + StackLevel := 0; + CurrCharRef := False; + Result := ''; + EntRefs := nil; + cDelim := ReadChar(True); + if (cDelim <> '"') and + (cDelim <> #39) and + (cDelim <> #126) and + (cDelim <> #0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sQuoteExpected); + TempChar := ReadChar(False); + while (not IsEndDocument) and + ((CurrCharRef) or + (TempChar <> cDelim)) do begin + if (TempChar = #$0A) then begin + TempChar := ' '; + end else if (TempChar = #$0D) then + TempChar := ' ' + else if (TempChar = '&') then begin + if wFlags and LIT_CHAR_REF <> 0 then begin + if wFlags and LIT_ENTITY_REF <> 0 then + CurrCharRef := True; + HasEntRef := True; + SkipChar; + TempChar := ReadChar(False); + if TempChar = '#' then begin + SkipChar; + ParseCharRef; + TempChar := ReadChar(False); + CurrCharRef := False; + Continue; + end else if wFlags and LIT_ENTITY_REF <> 0 then begin + TempStr := ParseEntityRef(False); + if (TempStr <> 'lt') and + (TempStr <> 'gt') and + (TempStr <> 'amp') and + (TempStr <> 'apos') and + (TempStr <> 'quot') then begin + if (not Assigned(EntRefs)) then begin + EntRefs := TStringList.Create; + EntRefs.Sorted := True; + EntRefs.Duplicates := dupError; + StackLevel := FDocStack.Count; + end else + StackLevel := Succ(FDocStack.Count); + try + if FDocStack.Count = StackLevel then begin + EntRefs.Clear; + StackLevel := FDocStack.Count; + end; + EntRefs.Add(TempStr); + except + on E:EStringListError do begin + EntRefs.Free; + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sCircularEntRef + + TempChar); + end; + on E:EVpParserError do + raise; + end; + end else + HasEntRef := False; + TempChar := ReadChar(False); + Continue; + end else if wFlags and LIT_PE_REF <> 0 then begin + ParseParameterEntityRef(False, True); + Continue; + end else + DataBufferAppend('&'); + if (not Assigned(EntRefs)) then begin + StackLevel := FDocStack.Count; + EntRefs := TStringList.Create; + EntRefs.Sorted := True; + EntRefs.Duplicates := dupError; + end; + try + if StackLevel = FDocStack.Count then begin + EntRefs.Clear; + StackLevel := FDocStack.Count; + end; + EntRefs.Add('&' + DOMString(TempChar)); + except + on E:EStringListError do begin + EntRefs.Free; + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sCircularEntRef + + TempChar); + end; + on E:EVpParserError do + raise; + end; + end; + end; + DataBufferAppend(TempChar); + SkipChar; + TempChar := ReadChar(False); + CurrCharRef := False; + end; + if TempChar <> cDelim then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + 'Expected: ' + cDelim); + + SkipChar; + + if wFlags and LIT_NORMALIZE <> 0 then + DataBufferNormalize; + + Result := DataBufferToString; + + EntRefs.Free; +end; +{--------} +function TVpParser.ReadNameToken(aValFirst : Boolean) : DOMString; +var + TempChar : DOMChar; + First : Boolean; + ResultLen : Integer; + CurrLen : Integer; +begin + if TryRead(Xpc_ParamEntity) then begin + ParseParameterEntityRef(True, False); + SkipWhiteSpace(True); + end; + First := aValFirst; + Result := ''; + CurrLen := 0; + ResultLen := 20; + SetLength(Result, ResultLen); + while True do begin + TempChar := ReadChar(False); + if (TempChar = '%') or (TempChar = '<') or (TempChar = '>') or + (TempChar = '&') or (TempChar = ',') or (TempChar = '|') or + (TempChar = '*') or (TempChar = '+') or (TempChar = '?') or + (TempChar = ')') or (TempChar = '=') or (TempChar = #39) or + (TempChar = '"') or (TempChar = '[') or (TempChar = ' ') or + (TempChar = #9) or (TempChar = #$0A) or (TempChar = #$0D) or + (TempChar = ';') or (TempChar = '/') or (TempChar = '') or + (TempChar = #1) then + Break + else + if ValidateNameChar(First, TempChar) then begin + if (CurrLen + 2 > ResultLen) then begin + ResultLen := ResultLen * 2; + SetLength(Result, ResultLen); + end; + SkipChar; + Move(TempChar, + PByteArray(Pointer(Result))^[CurrLen], + 2); + Inc(CurrLen, 2); + end else + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvalidName + + QuotedStr(TempChar)); + First := False; + end; + SetLength(Result, CurrLen div 2); +end; +{--------} +procedure TVpParser.Require(const S : array of Longint); +var + TempStr : AnsiString; + TempChar : AnsiChar; + i : Integer; +begin + if not TryRead(S) then begin + SetLength(TempStr, High(S) + 1); + for i := 0 to High(S) do begin + VpUcs4ToIso88591(s[i], TempChar); + TempStr[i + 1] := TempChar; + end; + if ReadChar(False) = '&' then begin + SkipChar; + if ReadChar(False) = '#' then begin + SkipChar; + if ParseCharRef = TempStr then + Exit; + end; + end; + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sExpectedString + + QuotedStr(TempStr)); + end; +end; +{--------} +procedure TVpParser.RequireWhitespace; +begin + if IsWhitespace(ReadChar(False)) then + SkipWhitespace(True) + else + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sSpaceExpectedAt + + 'Line: ' + IntToStr(FFilter.Line) + + ' Position: ' + IntToStr(FFilter.LinePos)); +end; +{--------} +procedure TVpParser.SetAttribute(const sElemName, sName : DOMString; + wType : Integer; + const sEnum, sValue : DOMString; + wValueType : Integer); +var + wIdx : Integer; + oElemInfo : TVpElementInfo; + oAttrInfo : TVpAttributeInfo; +begin + wIdx := GetElementIndexOf(sElemName); + if wIdx < 0 then begin + SetElement(sElemName, CONTENT_UNDECLARED, ''); + wIdx := GetElementIndexOf(sElemName); + end; + + oElemInfo := TVpElementInfo(FElementInfo.Objects[wIdx]); + oAttrInfo := TVpAttributeInfo.Create; + oAttrInfo.AttrType := wType; + oAttrInfo.Value := sValue; + oAttrInfo.ValueType := wValueType; + oAttrInfo.Enum := sEnum; + oElemInfo.SetAttribute(sName, oAttrInfo); +end; +{--------} +procedure TVpParser.SetElement(const sName : DOMString; + wType : Integer; + const sContentModel : DOMString); +var + oElem : TVpElementInfo; + wIdx : Integer; +begin + wIdx := GetElementIndexOf(sName); + if wIdx < 0 then begin + oElem := TVpElementInfo.Create; + FElementInfo.AddObject(sName, oElem); + end else + oElem := TVpElementInfo(FElementInfo.Objects[wIdx]); + + if wType <> CONTENT_UNDECLARED then + oElem.ContentType := wType; + + if sContentModel <> '' then + oElem.ContentModel := sContentModel; +end; +{--------} +procedure TVpParser.SetEntity(const sEntityName : DOMString; + wClass : Integer; + const sPublicId, + sSystemId, + sValue, + sNotationName : DOMString; + aIsPE : Boolean); +var + wIdx : Integer; + oEntity : TVpEntityInfo; +begin + wIdx := GetEntityIndexOf(sEntityName, aIsPE); + if wIdx < 0 then begin + oEntity := TVpEntityInfo.Create; + oEntity.EntityClass := wClass; + oEntity.PublicId := sPublicId; + oEntity.SystemId := sSystemId; + oEntity.Value := sValue; + oEntity.NotationName := sNotationName; + oEntity.IsParameterEntity := aIsPE; + + FEntityInfo.AddObject(sEntityName, oEntity); + end; +end; +{--------} +procedure TVpParser.SetInternalEntity(const sName, sValue : DOMString; + aIsPE : Boolean); +begin + SetEntity(sName, ENTITY_INTERNAL, '', '', sValue, '', aIsPE); +end; +{--------} +procedure TVpParser.SetNotation(const sNotationName, + sPublicId, + sSystemId : DOMString); +var + oNot : TVpNotationInfo; + wIdx : Integer; +begin + if not FNotationInfo.Find(sNotationName, wIdx) then begin + oNot := TVpNotationInfo.Create; + oNot.PublicId := sPublicId; + oNot.SystemId := sSystemId; + FNotationInfo.AddObject(sNotationName, oNot); + end; +end; +{--------} +procedure TVpParser.SkipChar; +begin + FFilter.SkipChar; +end; +{--------} +procedure TVpParser.SkipWhitespace(aNextDoc : Boolean); +begin + while (not FFilter.Eof) and + (IsWhitespace(ReadChar(False))) do + SkipChar; + if aNextDoc then begin + IsEndDocument; + while (not FFilter.Eof) and + (IsWhitespace(ReadChar(False))) do + SkipChar; + end; +end; +{--------} +function TVpParser.TryRead(const S : array of Longint) : Boolean; +begin + Result := False; + if (not IsEndDocument) then begin + Result := FFilter.TryRead(S); + IsEndDocument; + end; +end; +{--------} +procedure TVpParser.ValidateAttribute(const aValue : DOMString; + HasEntRef : Boolean); +begin + + if (not HasEntRef) then + if (VpPos('<', aValue) <> 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvAttrChar + '''<''') + else if (VpPos('&', aValue) <> 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvAttrChar + '''&''') + else if (VpPos('"', aValue) <> 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvAttrChar + '''"'''); +end; +{--------} +procedure TVpParser.ValidateCData(const CDATA : DOMString); +begin + if (VpPos(']]>', CDATA) <> 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvalidCDataSection); +end; +{--------} +procedure TVpParser.ValidateElementName(const aName : DOMString); +begin + if (aName = '') or + (aName = ' ') then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvalidElementName + + QuotedStr(aName)); +end; +{--------} +procedure TVpParser.ValidateEncName(const aValue : string); +var + i : Integer; + Good : Boolean; +begin + { Production [81]} + for i := 1 to Length(aValue) do begin + Good := False; + if ((aValue[i] >= 'A') and + (aValue[i] <= 'z')) then + Good := True + else if i > 1 then + if (aValue[i] >= '0') and + (aValue[i] <= '9') then + Good := True + else if aValue[i] = '.' then + Good := True + else if aValue[i] = '_' then + Good := True + else if aValue[i] = '-' then + Good := True + else if aValue[i] = '=' then + Good := True; + if not Good then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvEncName + + QuotedStr(aValue)); + end; +end; +{--------} +procedure TVpParser.ValidateEntityValue(const aValue : DOMString; + aQuoteCh : DOMChar); +var + TempChr : DOMChar; + i : Integer; +begin + for i := 1 to Length(aValue) do begin + TempChr := aValue[i]; + if (TempChr = '%') or + (TempChr = '&') or + (TempChr = aQuoteCh) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvEntityValue + + QuotedStr(TempChr)); + end; +end; +{--------} +function TVpParser.ValidateNameChar(const First : Boolean; + const Char : DOMChar) : Boolean; +var + BothUsed : Boolean; + UCS4 : TVpUCS4Char; +begin + { Naming rules - from sect 2.3 of spec} + { Names cannot be an empty string } + { Names must begin with 1 letter or one of the following + punctuation characters ['_',':']} + { Names should not begin with 'XML' or any case derivitive} + { Except for the first character, names can contain + [letters, digits,'.', '-', '_', ':'} + + VpUtf16ToUcs4(DOMChar(PByteArray(@Char)^[0]), + DOMChar(PByteArray(@Char)^[1]), + UCS4, + BothUsed); + if not First then + Result := VpIsNameChar(UCS4) + else + Result := VpIsNameCharFirst(UCS4); +end; +{--------} +procedure TVpParser.ValidatePCData(const aString : DOMString; + aInEntityRef : Boolean); +begin + if (not aInEntityRef) then + if (VpRPos('<', aString) <> 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvPCData + '''<''') + else if (VpRPos('&', aString) <> 0) and + (VpRPos(';', aString) = 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvPCData + '''&''') + else if (VpRPos(']]>', aString) <> 0) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvPCData + ''']]>'''); +end; +{--------} +procedure TVpParser.ValidatePublicID(const aString : DOMString); +var + Ucs4Char : TVpUcs4Char; + i : Integer; +begin + for i := 1 to Length(aString) do begin + VpIso88591ToUcs4(AnsiChar(aString[i]), Ucs4Char); + if (not VpIsPubidChar(Ucs4Char)) then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvPubIDChar + + QuotedStr(aString[i])); + end; +end; +{--------} +procedure TVpParser.ValidateVersNum(const aString : string); +var + i : Integer; + TempChr : char; + Good : Boolean; +begin + for i := 1 to Length(aString) do begin + Good := False; + TempChr := aString[i]; + if (TempChr >= 'A') and + (TempChr <= 'z') then + Good := True + else if (TempChr >= '0') and + (TempChr <= '9') then + Good := True + else if (TempChr = '.') then + Good := True + else if (TempChr = '_') then + Good := True + else if (TempChr = ':') then + Good := True + else if (TempChr = '-') then + Good := True; + if not Good then + raise EVpParserError.CreateError (FFilter.Line, + FFilter.LinePos, + sInvVerNum + + QuotedStr(aString)); + end; +end; + +end. + + +