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

Initial import

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@338 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
christian_u
2008-02-03 12:05:55 +00:00
parent 9056129a0b
commit c1641e380d
97 changed files with 77767 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

283
components/tvplanit/packages/v103_lazarus.lpk Normal file
View File

@ -0,0 +1,283 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Name Value="v103_lazarus"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<IncludeFiles Value="../source/"/>
<OtherUnitFiles Value="../source/"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="60">
<Item1>
<Filename Value="../source/vpabout.pas"/>
<UnitName Value="VpAbout"/>
</Item1>
<Item2>
<Filename Value="../source/vpalarmdlg.lfm"/>
<Type Value="LFM"/>
</Item2>
<Item3>
<Filename Value="../source/vpalarmdlg.pas"/>
<UnitName Value="VpAlarmDlg"/>
</Item3>
<Item4>
<Filename Value="../source/vpbase.pas"/>
<UnitName Value="VpBase"/>
</Item4>
<Item5>
<Filename Value="../source/vpbaseds.pas"/>
<UnitName Value="VpBaseDS"/>
</Item5>
<Item6>
<Filename Value="../source/vpcalendar.pas"/>
<UnitName Value="VpCalendar"/>
</Item6>
<Item7>
<Filename Value="../source/vpcanvasutils.pas"/>
<UnitName Value="VpCanvasUtils"/>
</Item7>
<Item8>
<Filename Value="../source/vpconst.pas"/>
<UnitName Value="VpConst"/>
</Item8>
<Item9>
<Filename Value="../source/vpcontactbuttons.pas"/>
<UnitName Value="VpContactButtons"/>
</Item9>
<Item10>
<Filename Value="../source/vpcontacteditdlg.lfm"/>
<Type Value="LFM"/>
</Item10>
<Item11>
<Filename Value="../source/vpcontacteditdlg.pas"/>
<UnitName Value="VpContactEditDlg"/>
</Item11>
<Item12>
<Filename Value="../source/vpcontactgrid.pas"/>
<UnitName Value="VpContactGrid"/>
</Item12>
<Item13>
<Filename Value="../source/vpdata.pas"/>
<UnitName Value="VpData"/>
</Item13>
<Item14>
<Filename Value="../source/vpdateedit.pas"/>
<UnitName Value="VpDateEdit"/>
</Item14>
<Item15>
<Filename Value="../source/vpdatepropedit.lfm"/>
<Type Value="LFM"/>
</Item15>
<Item16>
<Filename Value="../source/vpdatepropedit.pas"/>
<UnitName Value="VpDatePropEdit"/>
</Item16>
<Item17>
<Filename Value="../source/vpdayview.pas"/>
<UnitName Value="VpDayView"/>
</Item17>
<Item18>
<Filename Value="../source/vpdbds.pas"/>
<UnitName Value="VpDBDS"/>
</Item18>
<Item19>
<Filename Value="../source/vpdlg.pas"/>
<UnitName Value="VpDlg"/>
</Item19>
<Item20>
<Filename Value="../source/vpedelem.lfm"/>
<Type Value="LFM"/>
</Item20>
<Item21>
<Filename Value="../source/vpedelem.pas"/>
<UnitName Value="VpEdElem"/>
</Item21>
<Item22>
<Filename Value="../source/vpedfmt.lfm"/>
<Type Value="LFM"/>
</Item22>
<Item23>
<Filename Value="../source/vpedfmt.pas"/>
<UnitName Value="VpEdFmt"/>
</Item23>
<Item24>
<Filename Value="../source/vpedpop.pas"/>
<UnitName Value="VpEdPop"/>
</Item24>
<Item25>
<Filename Value="../source/vpedshape.lfm"/>
<Type Value="LFM"/>
</Item25>
<Item26>
<Filename Value="../source/vpedshape.pas"/>
<UnitName Value="VpEdShape"/>
</Item26>
<Item27>
<Filename Value="../source/vpevnteditdlg.lfm"/>
<Type Value="LFM"/>
</Item27>
<Item28>
<Filename Value="../source/vpevnteditdlg.pas"/>
<UnitName Value="VpEvntEditDlg"/>
</Item28>
<Item29>
<Filename Value="../source/vpexception.pas"/>
<UnitName Value="VpException"/>
</Item29>
<Item30>
<Filename Value="../source/vpledlabel.pas"/>
<UnitName Value="VpLEDLabel"/>
</Item30>
<Item31>
<Filename Value="../source/vplocalize.pas"/>
<UnitName Value="VpLocalize"/>
</Item31>
<Item32>
<Filename Value="../source/vpmisc.pas"/>
<UnitName Value="VpMisc"/>
</Item32>
<Item33>
<Filename Value="../source/vpmonthview.pas"/>
<UnitName Value="VpMonthView"/>
</Item33>
<Item34>
<Filename Value="../source/vpnabed.lfm"/>
<Type Value="LFM"/>
</Item34>
<Item35>
<Filename Value="../source/vpnabed.pas"/>
<UnitName Value="VpNabEd"/>
</Item35>
<Item36>
<Filename Value="../source/vpnavbar.pas"/>
<UnitName Value="VpNavBar"/>
</Item36>
<Item37>
<Filename Value="../source/vpprtfmt.pas"/>
<UnitName Value="VpPrtFmt"/>
</Item37>
<Item38>
<Filename Value="../source/vpprtfmtcbox.pas"/>
<UnitName Value="VpPrtFmtCBox"/>
</Item38>
<Item39>
<Filename Value="../source/vpprtfmtdlg.pas"/>
<UnitName Value="VpPrtFmtDlg"/>
</Item39>
<Item40>
<Filename Value="../source/vpprtfmted.pas"/>
<UnitName Value="VpPrtFmtEd"/>
</Item40>
<Item41>
<Filename Value="../source/vpprtprv.pas"/>
<UnitName Value="VpPrtPrv"/>
</Item41>
<Item42>
<Filename Value="../source/vpprtprvdlg.lfm"/>
<Type Value="LFM"/>
</Item42>
<Item43>
<Filename Value="../source/vpprtprvdlg.pas"/>
<UnitName Value="VpPrtPrvDlg"/>
</Item43>
<Item44>
<Filename Value="../source/vpreg.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="VpReg"/>
</Item44>
<Item45>
<Filename Value="../source/vpreseditdlg.lfm"/>
<Type Value="LFM"/>
</Item45>
<Item46>
<Filename Value="../source/vpreseditdlg.pas"/>
<UnitName Value="VpResEditDlg"/>
</Item46>
<Item47>
<Filename Value="../source/vpselresdlg.lfm"/>
<Type Value="LFM"/>
</Item47>
<Item48>
<Filename Value="../source/vpselresdlg.pas"/>
<UnitName Value="VpSelResDlg"/>
</Item48>
<Item49>
<Filename Value="../source/vpsr.pas"/>
<UnitName Value="VpSR"/>
</Item49>
<Item50>
<Filename Value="../source/vptaskeditdlg.lfm"/>
<Type Value="LFM"/>
</Item50>
<Item51>
<Filename Value="../source/vptaskeditdlg.pas"/>
<UnitName Value="VpTaskEditDlg"/>
</Item51>
<Item52>
<Filename Value="../source/vptasklist.pas"/>
<UnitName Value="VpTaskList"/>
</Item52>
<Item53>
<Filename Value="../source/vptimerpool.pas"/>
<UnitName Value="VpTimerPool"/>
</Item53>
<Item54>
<Filename Value="../source/vpwavdlg.lfm"/>
<Type Value="LFM"/>
</Item54>
<Item55>
<Filename Value="../source/vpwavdlg.pas"/>
<UnitName Value="VpWavDlg"/>
</Item55>
<Item56>
<Filename Value="../source/vpwavpe.pas"/>
<UnitName Value="VpWavPE"/>
</Item56>
<Item57>
<Filename Value="../source/vpweekview.pas"/>
<UnitName Value="VpWeekView"/>
</Item57>
<Item58>
<Filename Value="../source/vpxbase.pas"/>
<UnitName Value="VpXBase"/>
</Item58>
<Item59>
<Filename Value="../source/vpxchrflt.pas"/>
<UnitName Value="VpXChrFlt"/>
</Item59>
<Item60>
<Filename Value="../source/vpxparsr.pas"/>
<UnitName Value="VpXParsr"/>
</Item60>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="IDEIntf"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

89
components/tvplanit/readme.txt Normal file
View File

@ -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.

119
components/tvplanit/source/vp.inc Normal file
View File

@ -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}

1299
components/tvplanit/source/vpabout.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

1730
components/tvplanit/source/vpabout.lrs Normal file
View File

File diff suppressed because it is too large Load Diff

227
components/tvplanit/source/vpabout.pas Normal file
View File

@ -0,0 +1,227 @@
{*********************************************************}
{* VPABOUT.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 VpAbout;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,Messages,
{$ENDIF}
Forms, Graphics, Controls, Dialogs, StdCtrls, ExtCtrls,
{$IFDEF VERSION6}
{$IFNDEF LCL}
DesignIntf, DesignEditors,
{$ELSE}
PropEdits,
LazarusPackageIntf,
{$ENDIF}
{$ELSE}
DsgnIntf,
{$ENDIF}
Classes, SysUtils;
type
TfrmAbout = class(TForm)
Bevel2: TBevel;
Panel1: TPanel;
Image1: TImage;
ProgramName: TLabel;
VisitUsLabel: TLabel;
GeneralNewsgroupsLabel: TLabel;
lblTurboLink: TLabel;
lblHelp: TLabel;
CopyrightLabel: TLabel;
RightsReservedLabel: TLabel;
OKButton: TButton;
Bevel3: TBevel;
lblGeneralDiscussion: TLabel;
Label2: TLabel;
Label3: TLabel;
Label1: TLabel;
procedure OKButtonClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure lblTurboLinkClick(Sender: TObject);
procedure lblFreeUpdateCenterClick(Sender: TObject);
procedure lblTurboPowerLiveClick(Sender: TObject);
procedure lblTurboLinkMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lblHelpClick(Sender: TObject);
procedure lblNewsSpecificClick(Sender: TObject);
procedure lblGeneralDiscussionClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
IsServer : boolean;
end;
TVpAboutProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes;
override;
procedure Edit;
override;
end;
implementation
{$IFNDEF LCL}
{$R *.dfm}
{$ENDIF}
uses
{$IFNDEF LCL}
ShellAPI,
{$ENDIF}
VpConst;
resourcestring
cBrowserError = 'Unable to start web browser. Make sure you have it properly setup on your system.';
{*** TVpAboutProperty ***}
function TVpAboutProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
{=====}
procedure TVpAboutProperty.Edit;
begin
with TfrmAbout.Create(Application) do begin
try
ShowModal;
finally
Free;
end;
end;
end;
{=====}
{====================================================================}
procedure TfrmAbout.OKButtonClick(Sender : TObject);
begin
Close;
end;
{=====}
procedure TfrmAbout.FormActivate(Sender: TObject);
var
Year, Junk: Word;
begin
ProgramName.Caption := VpProductName + ' ' + VpVersionStr;
DecodeDate(Now, Year, junk, junk);
CopyrightLabel.Caption := #169 + ' Copyright 2000 - ' + IntToStr(Year)
+ ', TurboPower Software Company.';
lblTurboLink.Cursor := crHandPoint;
lblHelp.Cursor := crHandPoint;
lblGeneralDiscussion.Cursor := crHandPoint;
end;
{=====}
procedure TfrmAbout.lblTurboLinkClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open', 'http://sourceforge.net/projects/tpvplanit/',
'', '', SW_SHOWNORMAL) <= 32
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
{=====}
procedure TfrmAbout.lblFreeUpdateCenterClick(Sender : TObject);
begin
end;
{=====}
procedure TfrmAbout.lblTurboPowerLiveClick(Sender : TObject);
begin
end;
{=====}
procedure TfrmAbout.lblTurboLinkMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
TLabel(Sender).Font.Style := [fsUnderline];
end;
{=====}
procedure TfrmAbout.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
lblTurboLink.Font.Style := [];
end;
{=====}
procedure TfrmAbout.lblHelpClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open',
'http://sourceforge.net/forum/forum.php?forum_id=241880', '', '',
SW_SHOWNORMAL) <= 32
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
{=====}
procedure TfrmAbout.lblNewsSpecificClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open',
'news://news.turbopower.com/turbopower.public.support.visualplanit',
'', '', SW_SHOWNORMAL) <= 32
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
{=====}
procedure TfrmAbout.lblGeneralDiscussionClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open',
'http://sourceforge.net/forum/forum.php?forum_id=241879', '', '',
SW_SHOWNORMAL) <= 32
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
end.

5
components/tvplanit/source/vpabout.rst Normal file
View File

@ -0,0 +1,5 @@
# hash value = 219750574
vpabout.cbrowsererror='Unable to start web browser. Make sure you have it'+
' properly setup on your system.'

1227
components/tvplanit/source/vpadvds.pas Normal file
View File

File diff suppressed because it is too large Load Diff

154
components/tvplanit/source/vpalarmdlg.lfm Normal file
View File

@ -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

267
components/tvplanit/source/vpalarmdlg.pas Normal file
View File

@ -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.

967
components/tvplanit/source/vpbase.pas Normal file
View File

@ -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.

BIN
components/tvplanit/source/vpbase.res Normal file
View File

Binary file not shown.

1380
components/tvplanit/source/vpbaseds.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1282
components/tvplanit/source/vpbdeds.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2105
components/tvplanit/source/vpcalendar.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2162
components/tvplanit/source/vpcanvasutils.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1379
components/tvplanit/source/vpclock.pas Normal file
View File

File diff suppressed because it is too large Load Diff

256
components/tvplanit/source/vpconst.pas Normal file
View File

@ -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); {<!--}
Xpc_ConditionalEnd : array[0..2] of Longint = (93, 93, 62); {]]>}
Xpc_ConditionalIgnore :
array[0..5] of Longint = (73, 71, 78, 79, 82, 69); {IGNORE}
Xpc_ConditionalInclude :
array[0..6] of Longint = (73, 78, 67, 76, 85, 68, 69); {INCLUDE}
Xpc_ConditionalStart :
array[0..2] of Longint = (60, 33, 91); {<![}
Xpc_Dash : array[0..0] of Longint = (45); {-}
Xpc_DTDAttFixed :
array[0..4] of Longint = (70, 73, 88, 69, 68); {FIXED}
Xpc_DTDAttImplied :
array[0..6] of Longint = (73, 77, 80, 76, 73, 69, 68); {IMPLIED}
Xpc_DTDAttlist :
array[0..8] of Longint =
(60, 33, 65, 84, 84, 76, 73, 83, 84); {<!ATTLIST}
Xpc_DTDAttRequired :
array[0..7] of Longint =
(82, 69, 81, 85, 73, 82, 69, 68); {REQUIRED}
Xpc_DTDDocType :
array[0..8] of Longint =
(60, 33, 68, 79, 67, 84, 89, 80, 69); {<!DOCTYPE}
Xpc_DTDElement :
array[0..8] of Longint =
(60, 33, 69, 76, 69, 77, 69, 78, 84); {<!ELEMENT}
Xpc_DTDElementAny : array[0..2] of Longint = (65, 78, 89); {ANY}
Xpc_DTDElementCharData :
array[0..6] of Longint = (35, 80, 67, 68, 65, 84, 65); {#PCDATA}
Xpc_DTDElementEmpty :
array[0..4] of Longint = (69, 77, 80, 84, 89); {EMPTY}
Xpc_DTDEntity :
array[0..7] of Longint =
(60, 33, 69, 78, 84, 73, 84, 89); {<!ENTITY}
Xpc_DTDNotation :
array[0..9] of Longint =
(60, 33, 78, 79, 84, 65, 84, 73, 79, 78); {<!NOTATION}
Xpc_Encoding : array[0..7] of Longint =
(101, 110, 99, 111, 100, 105, 110, 103); {encoding}
Xpc_Equation : array[0..0] of Longint = (61); {=}
Xpc_ExternalPublic :
array[0..5] of Longint = (80, 85, 66, 76, 73, 67); {PUBLIC}
Xpc_ExternalSystem :
array[0..5] of Longint = (83, 89, 83, 84, 69, 77); {SYSTEM}
Xpc_GenParsedEntityEnd : array[0..0] of Longint = (59); {;}
Xpc_ListOperator : array[0..0] of Longint = (124); {|}
Xpc_MixedEnd : array[0..1] of Longint = (41, 42); {)*}
Xpc_OneOrMoreOpr : array[0..0] of Longint = (42); {*}
Xpc_ParamEntity : array[0..0] of Longint = (37); {%}
Xpc_ParenLeft : array[0..0] of Longint = (40); {(}
Xpc_ParenRight : array[0..0] of Longint = (41); {)}
Xpc_ProcessInstrEnd : array[0..1] of Longint = (63, 62); {?>}
Xpc_ProcessInstrStart : array[0..1] of Longint = (60, 63); {<?}
Xpc_QuoteDouble : array[0..0] of Longint = (34); {"}
Xpc_QuoteSingle : array[0..0] of Longint = (39); {'}
Xpc_Standalone :
array[0..9] of Longint =
(115, 116, 97, 110, 100, 97, 108, 111, 110, 101); {standalone}
Xpc_UnparsedEntity :
array[0..4] of Longint = (78, 68, 65, 84, 65); {NDATA}
Xpc_Version :
array[0..6] of Longint =
(118, 101, 114, 115, 105, 111, 110); {version}
LIT_CHAR_REF = 1;
LIT_ENTITY_REF = 2;
LIT_PE_REF = 4;
LIT_NORMALIZE = 8;
CONTEXT_NONE = 0;
CONTEXT_DTD = 1;
CONTEXT_ENTITYVALUE = 2;
CONTEXT_ATTRIBUTEVALUE = 3;
CONTENT_UNDECLARED = 0;
CONTENT_ANY = 1;
CONTENT_EMPTY = 2;
CONTENT_MIXED = 3;
CONTENT_ELEMENTS = 4;
OCCURS_REQ_NOREPEAT = 0;
OCCURS_OPT_NOREPEAT = 1;
OCCURS_OPT_REPEAT = 2;
OCCURS_REQ_REPEAT = 3;
REL_OR = 0;
REL_AND = 1;
REL_NONE = 2;
ATTRIBUTE_UNDECLARED = 0;
ATTRIBUTE_CDATA = 1;
ATTRIBUTE_ID = 2;
ATTRIBUTE_IDREF = 3;
ATTRIBUTE_IDREFS = 4;
ATTRIBUTE_ENTITY = 5;
ATTRIBUTE_ENTITIES = 6;
ATTRIBUTE_NMTOKEN = 7;
ATTRIBUTE_NMTOKENS = 8;
ATTRIBUTE_ENUMERATED = 9;
ATTRIBUTE_NOTATION = 10;
ATTRIBUTE_DEFAULT_UNDECLARED = 0;
ATTRIBUTE_DEFAULT_SPECIFIED = 1;
ATTRIBUTE_DEFAULT_IMPLIED = 2;
ATTRIBUTE_DEFAULT_REQUIRED = 3;
ATTRIBUTE_DEFAULT_FIXED = 4;
ENTITY_UNDECLARED = 0;
ENTITY_INTERNAL = 1;
ENTITY_NDATA = 2;
ENTITY_TEXT = 3;
CONDITIONAL_INCLUDE = 0;
CONDITIONAL_IGNORE = 1;
{ Version numbers }
VpXSLImplementation = 0.0;
VpXMLSpecification = '1.0';
{ Defaults }
{ MonthView }
vpDefWVRClickChangeDate = True;
implementation
initialization
{$IFNDEF LCL}
ClickDelay := GetDoubleClickTime;
{$ENDIF}
end.

538
components/tvplanit/source/vpcontactbuttons.pas Normal file
View File

@ -0,0 +1,538 @@
{*********************************************************}
{* VPCONTACTBUTTONS.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): *}
{* Steve Forbes *}
{* *}
{* ***** END LICENSE BLOCK ***** *}
{ TurboPower Software Company wishes to thank Steve Forbes for }
{ providing this component, and allowing us to include it. }
{ Thanks Steve! }
{$I Vp.INC}
unit VpContactButtons;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VpBase, VpContactGrid, VpMisc;
const
VP_MIN_BUTTONS = 2;
VP_LETTERS_IN_ALPHABET = 26;
VP_MAX_BUTTONS = VP_LETTERS_IN_ALPHABET + 1;
VP_LETTER_A = Ord('a');
type
TVpButtonRec = packed record
Rect: TRect;
Caption: String;
end;
TVpButtonArray = array[0..VP_MAX_BUTTONS - 1] of TVpButtonRec;
TVpButtonBarOrientation = (baHorizontal, baVertical);
TVpButtonBarClickEvent = procedure(Sender: TObject; ButtonIndex: Integer;
SearchString: String) of object;
TVpContactButtonBar = class(TVPCustomControl)
protected {private}
FBarOrientation: TVpButtonBarOrientation;
FBorderWidth: Integer;
FButtonPressed: Integer;
FButtonColor: TColor;
FButtonCount: Integer;
FButtonHeight: Integer;
FButtonsArray: TVpButtonArray;
FButtonWidth: Integer;
FContactGrid: TVpContactGrid;
FDrawingStyle: TVpDrawingStyle;
FOnButtonClick: TVpButtonBarClickEvent;
FShowNumberButton: Boolean;
FRadioStyle: Boolean;
{internal variables}
bbSearchString: string;
{internal methods}
procedure bbPopulateSearchString;
procedure CreateButtons;
procedure DrawButton(Index: Integer; Pressed: Boolean);
procedure SelectContact;
{ Property setter methods }
procedure SetBarOrientation(const Value: TVpButtonBarOrientation);
procedure SetBorderWidth(const Value: Integer);
procedure SetButtonColor(const Value: TColor);
procedure SetButtonHeight(const Value: Integer);
procedure SetButtonWidth(const Value: Integer);
procedure SetContactGrid(Value: TVpContactGrid);
procedure SetDrawingStyle(const Value: TVpDrawingStyle);
procedure SetShowNumberButton(const Value: Boolean);
{ Overridden methods }
procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; 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 Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BarOrientation: TVpButtonBarOrientation
read FBarOrientation write SetBarOrientation default baVertical;
property BorderWidth: Integer
read FBorderWidth write SetBorderWidth default 2;
property ButtonColor: TColor
read FButtonColor write SetButtonColor default clBtnFace;
property ButtonHeight: Integer
read FButtonHeight write SetButtonHeight default 18;
property ButtonWidth: Integer
read FButtonWidth write SetButtonWidth default 34;
property ContactGrid: TVpContactGrid
read FContactGrid write SetContactGrid;
property DrawingStyle: TVpDrawingStyle
read FDrawingStyle write SetDrawingStyle default ds3d;
property ShowNumberButton: Boolean
read FShowNumberButton write SetShowNumberButton default True;
property OnButtonClick: TVpButtonBarClickEvent
read FOnButtonClick write FOnButtonClick;
property RadioStyle: Boolean
read FRadioStyle write FRadioStyle;
property Align;
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property Cursor;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
{events}
{$IFNDEF LCL}
property OnCanResize;
{$ENDIF}
property OnClick;
property OnConstrainedResize;
property OnDblClick;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
implementation
{ TVpContactButtonBar }
constructor TVpContactButtonBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 40;
Height := 280;
{$IFDEF VERSION4}
DoubleBuffered := True;
{$ENDIF}
FBarOrientation := baVertical;
FBorderWidth := 2;
FButtonColor := clBtnFace;
FButtonHeight := 18;
FButtonWidth := 34;
FDrawingStyle := ds3d;
FShowNumberButton := True;
end;
{=====}
destructor TVpContactButtonBar.Destroy;
begin
inherited Destroy;
end;
{=====}
procedure TVpContactButtonBar.CreateButtons;
var
I: Integer;
TotalXY: Integer;
StartLetter, EndLetter: Char;
ButtonLetters: Single;
ButtonCaption: String;
Offset: Integer;
MaxButtons: Integer;
MinButtons: Integer;
begin
I := 0;
if FShowNumberButton then begin
MaxButtons := VP_MAX_BUTTONS;
MinButtons := VP_MIN_BUTTONS + 1;
end else begin
MaxButtons := VP_LETTERS_IN_ALPHABET;
MinButtons := VP_MIN_BUTTONS;
end;
if FBarOrientation = baVertical then begin
TotalXY := FBorderWidth;
while ((TotalXY + FButtonHeight + FBorderWidth < ClientHeight)
and (I < MaxButtons))
or (I < MinButtons)
do begin
FButtonsArray[I].Rect := Rect(FBorderWidth, TotalXY,
ClientWidth - FBorderWidth, TotalXY + FButtonHeight);
Inc(I);
TotalXY := TotalXY + FButtonHeight + FBorderWidth;
end;
FButtonCount := I;
end else begin
TotalXY := FBorderWidth;
while ((TotalXY + FButtonWidth + FBorderWidth < ClientWidth)
and (I < MaxButtons))
or (I < MinButtons)
do begin
FButtonsArray[i].Rect := Rect(TotalXY, FBorderWidth,
TotalXY + FButtonWidth, ClientHeight - FBorderWidth);
Inc(I);
TotalXY := TotalXY + FButtonWidth + FBorderWidth;
end;
FButtonCount := I;
end;
Offset := 0;
if FShowNumberButton then begin
ButtonLetters := VP_LETTERS_IN_ALPHABET / (FButtonCount - 1);
FButtonsArray[0].Caption := '123';
Offset := 1;
end else
ButtonLetters := VP_LETTERS_IN_ALPHABET / FButtonCount;
for i := 0 to FButtonCount - Offset - 1 do begin
StartLetter := Chr(Round(VP_LETTER_A + ButtonLetters * I));
EndLetter := Chr(Round(VP_LETTER_A + ButtonLetters * (I + 1)) - 1);
if Ord(EndLetter) = Ord(StartLetter) then
ButtonCaption := StartLetter
else begin
if Ord(EndLetter) = Ord(StartLetter) + 1 then
ButtonCaption := StartLetter + EndLetter
else begin
if Ord(EndLetter) = Ord(StartLetter) + 2 then
ButtonCaption := StartLetter + Succ(StartLetter) + EndLetter
else
ButtonCaption := StartLetter + '-' + EndLetter;
end;
end;
FButtonsArray[I + Offset].Caption := ButtonCaption;
end;
end;
{=====}
procedure TVpContactButtonBar.DrawButton(Index: Integer; Pressed: Boolean);
var
ButtonRect: TRect;
begin
with Canvas do begin
Font := Self.Font;
ButtonRect := FButtonsArray[Index].Rect;
Brush.Color := FButtonColor;
FillRect(ButtonRect);
if (FDrawingStyle = dsFlat) then begin
if Pressed then
Pen.Color := clBtnShadow
else
Pen.Color := clBtnHighlight;
PolyLine([Point(ButtonRect.Right - 1, ButtonRect.Top),
Point(ButtonRect.Left, ButtonRect.Top),
Point(ButtonRect.Left, ButtonRect.Bottom - 1)]);
if Pressed then
Pen.Color := clBtnHighlight
else
Pen.Color := clBtnShadow;
PolyLine([Point(ButtonRect.Left, ButtonRect.Bottom - 1),
Point(ButtonRect.Right - 1, ButtonRect.Bottom - 1),
Point(ButtonRect.Right - 1, ButtonRect.Top)]);
InflateRect(ButtonRect, -2, -2);
end else begin
if Pressed then
DrawFrameControl(Handle, ButtonRect,
DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_PUSHED)
else
DrawFrameControl(Handle, ButtonRect, DFC_BUTTON, DFCS_BUTTONPUSH);
InflateRect(ButtonRect, -2, -2);
FillRect(ButtonRect);
end;
if Pressed then begin
ButtonRect.Left := ButtonRect.Left + 2;
ButtonRect.Top := ButtonRect.Top + 2;
end;
DrawText(Handle, PChar(FButtonsArray[Index].Caption),
Length(FButtonsArray[Index].Caption), ButtonRect,
{DrawTextBiDiModeFlagsReadingOnly or }DT_SINGLELINE or DT_CENTER
or DT_VCENTER);
end;
end;
{=====}
procedure TVpContactButtonBar.SelectContact;
var
I: Integer;
begin
if FContactGrid <> nil then begin
FContactGrid.SetFocus;
for I := 1 to Length(bbSearchString) do
if FContactGrid.SelectContactByName(bbSearchString[I]) then
Break;
end;
end;
{=====}
procedure TVpContactButtonBar.Loaded;
begin
inherited Loaded;
CreateButtons;
end;
{=====}
procedure TVpContactButtonBar.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
I: Integer;
P: TPoint;
R: TRect;
begin
inherited MouseDown(Button, Shift, X, Y);
if Button = mbLeft then begin
P := Point(X, Y);
for I := 0 to pred(FButtonCount) do begin
R := FButtonsArray[I].Rect;
if PointInRect(P, R) then begin
{ if RadioStyle then un-press the last clicked button. }
if RadioStyle then
DrawButton(FButtonPressed, False);
FButtonPressed := I;
bbPopulateSearchString;
DrawButton(I, True);
Break;
end;
end;
if Assigned(FOnButtonClick) then
FOnButtonClick(Self, FButtonPressed, bbSearchString)
else
SelectContact;
end;
end;
{=====}
procedure TVpContactButtonBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if not RadioStyle then
DrawButton(FButtonPressed, False);
end;
{=====}
procedure TVpContactButtonBar.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FContactGrid) and (Operation = opRemove) then
FContactGrid := nil;
end;
{=====}
procedure TVpContactButtonBar.Paint;
var
I: Integer;
begin
for I := 0 to FButtonCount - 1 do begin
if RadioStyle and (FButtonPressed = I) then
DrawButton(I, True)
else
DrawButton(I, False);
end;
end;
{=====}
procedure TVpContactButtonBar.Resize;
begin
inherited Resize;
CreateButtons;
end;
{=====}
procedure TVpContactButtonBar.SetDrawingStyle(const Value: TVpDrawingStyle);
begin
if FDrawingStyle <> Value then begin
FDrawingStyle := Value;
Repaint;
end;
end;
{=====}
procedure TVpContactButtonBar.SetContactGrid(Value: TVpContactGrid);
begin
if (FContactGrid <> Value) then begin
FContactGrid := Value;
if FContactGrid <> nil then begin
Height := FContactGrid.Height;
Repaint;
end;
end;
end;
{=====}
procedure TVpContactButtonBar.bbPopulateSearchString;
var
BC: string; // button caption
I: integer;
begin
bc := FButtonsArray[FButtonPressed].Caption;
if FButtonPressed = 0 then
bbSearchString := '0123456789'
else if (pos('-', BC) > 0) then begin
bbSearchString := '';
for I := ord(BC[1]) to ord(BC[Length(BC)]) do
bbSearchString := bbSearchString + chr(I);
end else
bbSearchString := FButtonsArray[FButtonPressed].Caption;
end;
{=====}
procedure TVpContactButtonBar.SetBarOrientation(const Value: TVpButtonBarOrientation);
begin
if (FBarOrientation <> Value) then begin
FBarOrientation := Value;
CreateButtons;
Repaint;
end;
end;
{=====}
procedure TVpContactButtonBar.SetBorderWidth(const Value: Integer);
begin
if (FBorderWidth <> Value) then begin
FBorderWidth := Value;
if FBorderWidth < 0 then
FBorderWidth := 0;
CreateButtons;
Repaint;
end;
end;
{=====}
procedure TVpContactButtonBar.SetButtonColor(const Value: TColor);
begin
if (FButtonColor <> Value) then begin
FButtonColor := Value;
Repaint;
end;
end;
{=====}
procedure TVpContactButtonBar.SetButtonHeight(const Value: Integer);
begin
if (FButtonHeight <> Value) then begin
FButtonHeight := Value;
if FButtonHeight < 18 then
FButtonHeight := 18;
CreateButtons;
Repaint;
end;
end;
{=====}
procedure TVpContactButtonBar.SetButtonWidth(const Value: Integer);
begin
if (FButtonWidth <> Value) then begin
FButtonWidth := Value;
if FButtonWidth < 34 then
FButtonWidth := 34;
CreateButtons;
Repaint;
end;
end;
{=====}
procedure TVpContactButtonBar.SetShowNumberButton(const Value: Boolean);
begin
if (FShowNumberButton <> Value) then begin
FShowNumberButton := Value;
CreateButtons;
Repaint;
end;
end;
{=====}
end.

486
components/tvplanit/source/vpcontacteditdlg.lfm Normal file
View File

@ -0,0 +1,486 @@
object ContactEditForm: TContactEditForm
Left = 311
Height = 321
Top = 245
Width = 433
HorzScrollBar.Page = 432
VertScrollBar.Page = 320
ActiveControl = tsContacts
Caption = 'ContactEdit'
ClientHeight = 321
ClientWidth = 433
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
OnKeyDown = FormKeyDown
OnShow = FormShow
Position = poScreenCenter
object tsContacts: TPageControl
Height = 280
Width = 433
ActivePage = tabMain
Align = alClient
TabIndex = 0
TabOrder = 0
OnChange = tsContactsChange
object tabMain: TTabSheet
Caption = '&Main'
ClientHeight = 280
ClientWidth = 433
object NameLbl: TLabel
Left = 8
Height = 16
Top = 6
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Name'
FocusControl = NameEdit
ParentColor = False
end
object AddrLbl: TLabel
Left = 8
Height = 16
Top = 54
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Address'
FocusControl = AddressEdit
ParentColor = False
end
object CityLbl: TLabel
Left = 8
Height = 16
Top = 78
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'City'
FocusControl = CityEdit
ParentColor = False
end
object StateLbl: TLabel
Left = 8
Height = 16
Top = 102
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'State'
FocusControl = cboxState
ParentColor = False
end
object ZipLbl: TLabel
Left = 8
Height = 16
Top = 126
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Zip Code'
FocusControl = ZipCodeEdit
ParentColor = False
end
object CountryLbl: TLabel
Left = 8
Height = 16
Top = 150
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Country'
FocusControl = cboxCountry
ParentColor = False
end
object PositionLbl: TLabel
Left = 8
Height = 16
Top = 199
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Position'
FocusControl = PositionEdit
ParentColor = False
end
object TitleLbl: TLabel
Left = 8
Height = 16
Top = 31
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Title'
FocusControl = TitleEdit
ParentColor = False
end
object CompanyLbl: TLabel
Left = 91
Height = 14
Top = 175
Width = 46
Alignment = taRightJustify
Caption = 'Company'
FocusControl = CompanyEdit
ParentColor = False
end
object CategoryLbl: TLabel
Left = 8
Height = 16
Top = 226
Width = 127
Alignment = taRightJustify
AutoSize = False
Caption = 'Category'
FocusControl = cboxCategory
ParentColor = False
end
object NameEdit: TEdit
Left = 136
Height = 21
Top = 4
Width = 247
MaxLength = 100
OnChange = ItemChanged
TabOrder = 0
end
object AddressEdit: TEdit
Left = 136
Height = 21
Top = 52
Width = 247
MaxLength = 100
OnChange = ItemChanged
TabOrder = 2
end
object CityEdit: TEdit
Left = 136
Height = 21
Top = 76
Width = 247
MaxLength = 50
OnChange = ItemChanged
TabOrder = 3
end
object StateEdit: TEdit
Left = 168
Height = 21
Top = 100
Width = 247
MaxLength = 25
OnChange = ItemChanged
TabOrder = 5
end
object ZipCodeEdit: TEdit
Left = 136
Height = 21
Top = 124
Width = 121
MaxLength = 10
OnChange = ItemChanged
TabOrder = 6
end
object PositionEdit: TEdit
Left = 136
Height = 21
Top = 197
Width = 121
MaxLength = 50
OnChange = ItemChanged
TabOrder = 10
end
object TitleEdit: TEdit
Left = 136
Height = 21
Top = 29
Width = 121
MaxLength = 50
OnChange = ItemChanged
TabOrder = 1
end
object CompanyEdit: TEdit
Left = 136
Height = 21
Top = 173
Width = 121
MaxLength = 50
OnChange = ItemChanged
TabOrder = 9
end
object cboxCategory: TComboBox
Left = 136
Height = 21
Top = 224
Width = 121
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 11
end
object cboxState: TComboBox
Left = 136
Height = 21
Top = 100
Width = 249
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 4
Visible = False
end
object edtCountry: TEdit
Left = 152
Height = 21
Top = 148
Width = 249
TabOrder = 8
end
object cboxCountry: TComboBox
Left = 136
Height = 21
Top = 148
Width = 249
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 65535
OnChange = cboxCountryChange
TabOrder = 7
end
end
object tabContact: TTabSheet
Caption = 'Con&tact'
ClientHeight = 280
ClientWidth = 433
ImageIndex = 1
object EMailLbl: TLabel
Left = 91
Height = 14
Top = 136
Width = 38
Caption = 'EMailLbl'
ParentColor = False
end
object cboxPhoneLbl1: TComboBox
Left = 8
Height = 21
Top = 8
Width = 121
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 0
end
object cboxPhoneLbl2: TComboBox
Left = 8
Height = 21
Top = 32
Width = 121
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 2
end
object cboxPhoneLbl3: TComboBox
Left = 8
Height = 21
Top = 56
Width = 121
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 4
end
object cboxPhoneLbl4: TComboBox
Left = 8
Height = 21
Top = 80
Width = 121
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 6
end
object Phone4Edit: TEdit
Left = 136
Height = 21
Top = 80
Width = 121
MaxLength = 25
OnChange = ItemChanged
TabOrder = 7
end
object Phone3Edit: TEdit
Left = 136
Height = 21
Top = 56
Width = 121
MaxLength = 25
OnChange = ItemChanged
TabOrder = 5
end
object Phone2Edit: TEdit
Left = 136
Height = 21
Top = 32
Width = 121
MaxLength = 25
OnChange = ItemChanged
TabOrder = 3
end
object Phone1Edit: TEdit
Left = 136
Height = 21
Top = 8
Width = 121
MaxLength = 25
OnChange = ItemChanged
TabOrder = 1
end
object cboxPhoneLbl5: TComboBox
Left = 8
Height = 21
Top = 104
Width = 121
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
MaxLength = 65535
TabOrder = 8
end
object Phone5Edit: TEdit
Left = 136
Height = 21
Top = 104
Width = 121
MaxLength = 25
OnChange = ItemChanged
TabOrder = 9
end
object EMailEdit: TEdit
Left = 136
Height = 21
Top = 128
Width = 121
TabOrder = 10
end
end
object tabCustom: TTabSheet
Caption = 'C&ustom'
ClientHeight = 280
ClientWidth = 433
ImageIndex = 2
object CustomLbl1: TLabel
Left = 8
Height = 14
Top = 12
Width = 56
Caption = 'CustomLbl1'
ParentColor = False
end
object CustomLbl2: TLabel
Left = 8
Height = 14
Top = 36
Width = 56
Caption = 'CustomLbl2'
ParentColor = False
end
object CustomLbl3: TLabel
Left = 8
Height = 14
Top = 60
Width = 56
Caption = 'CustomLbl3'
ParentColor = False
end
object CustomLbl4: TLabel
Left = 8
Height = 14
Top = 84
Width = 56
Caption = 'CustomLbl4'
ParentColor = False
end
object Custom1Edit: TEdit
Left = 80
Height = 21
Top = 8
Width = 121
MaxLength = 100
OnChange = ItemChanged
TabOrder = 0
end
object Custom2Edit: TEdit
Left = 80
Height = 21
Top = 32
Width = 121
MaxLength = 100
OnChange = ItemChanged
TabOrder = 1
end
object Custom3Edit: TEdit
Left = 80
Height = 21
Top = 56
Width = 121
MaxLength = 100
OnChange = ItemChanged
TabOrder = 2
end
object Custom4Edit: TEdit
Left = 80
Height = 21
Top = 80
Width = 121
MaxLength = 100
OnChange = ItemChanged
TabOrder = 3
end
end
object tabNotes: TTabSheet
Caption = '&Notes'
ClientHeight = 280
ClientWidth = 433
ImageIndex = 3
object NoteEdit: TMemo
Left = 8
Height = 234
Top = 8
Width = 409
Anchors = [akTop, akLeft, akRight, akBottom]
MaxLength = 1024
ScrollBars = ssVertical
TabOrder = 0
end
end
end
object pnlBottom: TPanel
Height = 41
Top = 280
Width = 433
Align = alBottom
BevelOuter = bvNone
ClientHeight = 41
ClientWidth = 433
TabOrder = 1
object OKBtn: TButton
Left = 278
Height = 25
Top = 9
Width = 75
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
OnClick = OKBtnClick
TabOrder = 0
TabStop = False
end
object CancelBtn: TButton
Left = 357
Height = 25
Top = 9
Width = 75
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
OnClick = CancelBtnClick
TabOrder = 1
TabStop = False
end
end
end

125
components/tvplanit/source/vpcontacteditdlg.lrs Normal file
View File

@ -0,0 +1,125 @@
{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei }
LazarusResources.Add('TContactEditForm','FORMDATA',[
'TPF0'#16'TContactEditForm'#15'ContactEditForm'#4'Left'#3'7'#1#6'Height'#3'A'
+#1#3'Top'#3#245#0#5'Width'#3#177#1#18'HorzScrollBar.Page'#3#176#1#18'VertScr'
+'ollBar.Page'#3'@'#1#13'ActiveControl'#7#10'tsContacts'#7'Caption'#6#11'Cont'
+'actEdit'#12'ClientHeight'#3'A'#1#11'ClientWidth'#3#177#1#11'Font.Height'#2
+#245#9'Font.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#9'OnKeyDo'
+'wn'#7#11'FormKeyDown'#6'OnShow'#7#8'FormShow'#8'Position'#7#14'poScreenCent'
+'er'#0#12'TPageControl'#10'tsContacts'#6'Height'#3#24#1#5'Width'#3#177#1#10
+'ActivePage'#7#7'tabMain'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'
+#2#0#8'OnChange'#7#16'tsContactsChange'#0#9'TTabSheet'#7'tabMain'#7'Caption'
+#6#5'&Main'#12'ClientHeight'#3#24#1#11'ClientWidth'#3#177#1#0#6'TLabel'#7'Na'
+'meLbl'#4'Left'#2#8#6'Height'#2#16#3'Top'#2#6#5'Width'#2''#9'Alignment'#7#14
+'taRightJustify'#8'AutoSize'#8#7'Caption'#6#4'Name'#12'FocusControl'#7#8'Nam'
+'eEdit'#11'ParentColor'#8#0#0#6'TLabel'#7'AddrLbl'#4'Left'#2#8#6'Height'#2#16
+#3'Top'#2'6'#5'Width'#2''#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7
+'Caption'#6#7'Address'#12'FocusControl'#7#11'AddressEdit'#11'ParentColor'#8#0
+#0#6'TLabel'#7'CityLbl'#4'Left'#2#8#6'Height'#2#16#3'Top'#2'N'#5'Width'#2''
+#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#4'City'#12'Foc'
+'usControl'#7#8'CityEdit'#11'ParentColor'#8#0#0#6'TLabel'#8'StateLbl'#4'Left'
+#2#8#6'Height'#2#16#3'Top'#2'f'#5'Width'#2''#9'Alignment'#7#14'taRightJusti'
+'fy'#8'AutoSize'#8#7'Caption'#6#5'State'#12'FocusControl'#7#9'cboxState'#11
+'ParentColor'#8#0#0#6'TLabel'#6'ZipLbl'#4'Left'#2#8#6'Height'#2#16#3'Top'#2
+'~'#5'Width'#2''#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7'Caption'
+#6#8'Zip Code'#12'FocusControl'#7#11'ZipCodeEdit'#11'ParentColor'#8#0#0#6'TL'
+'abel'#10'CountryLbl'#4'Left'#2#8#6'Height'#2#16#3'Top'#3#150#0#5'Width'#2''
+#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#7'Country'#12
+'FocusControl'#7#11'cboxCountry'#11'ParentColor'#8#0#0#6'TLabel'#11'Position'
+'Lbl'#4'Left'#2#8#6'Height'#2#16#3'Top'#3#199#0#5'Width'#2''#9'Alignment'#7
+#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#8'Position'#12'FocusControl'#7
+#12'PositionEdit'#11'ParentColor'#8#0#0#6'TLabel'#8'TitleLbl'#4'Left'#2#8#6
+'Height'#2#16#3'Top'#2#31#5'Width'#2''#9'Alignment'#7#14'taRightJustify'#8
+'AutoSize'#8#7'Caption'#6#5'Title'#12'FocusControl'#7#9'TitleEdit'#11'Parent'
+'Color'#8#0#0#6'TLabel'#10'CompanyLbl'#4'Left'#2'['#6'Height'#2#14#3'Top'#3
+#175#0#5'Width'#2'.'#9'Alignment'#7#14'taRightJustify'#7'Caption'#6#7'Compan'
+'y'#12'FocusControl'#7#11'CompanyEdit'#11'ParentColor'#8#0#0#6'TLabel'#11'Ca'
+'tegoryLbl'#4'Left'#2#8#6'Height'#2#16#3'Top'#3#226#0#5'Width'#2''#9'Alignm'
+'ent'#7#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#8'Category'#12'FocusCo'
+'ntrol'#7#12'cboxCategory'#11'ParentColor'#8#0#0#5'TEdit'#8'NameEdit'#4'Left'
+#3#136#0#6'Height'#2#21#3'Top'#2#4#5'Width'#3#247#0#9'MaxLength'#2'd'#8'OnCh'
+'ange'#7#11'ItemChanged'#8'TabOrder'#2#0#0#0#5'TEdit'#11'AddressEdit'#4'Left'
+#3#136#0#6'Height'#2#21#3'Top'#2'4'#5'Width'#3#247#0#9'MaxLength'#2'd'#8'OnC'
+'hange'#7#11'ItemChanged'#8'TabOrder'#2#2#0#0#5'TEdit'#8'CityEdit'#4'Left'#3
+#136#0#6'Height'#2#21#3'Top'#2'L'#5'Width'#3#247#0#9'MaxLength'#2'2'#8'OnCha'
+'nge'#7#11'ItemChanged'#8'TabOrder'#2#3#0#0#5'TEdit'#9'StateEdit'#4'Left'#3
+#168#0#6'Height'#2#21#3'Top'#2'd'#5'Width'#3#247#0#9'MaxLength'#2#25#8'OnCha'
+'nge'#7#11'ItemChanged'#8'TabOrder'#2#5#0#0#5'TEdit'#11'ZipCodeEdit'#4'Left'
+#3#136#0#6'Height'#2#21#3'Top'#2'|'#5'Width'#2'y'#9'MaxLength'#2#10#8'OnChan'
+'ge'#7#11'ItemChanged'#8'TabOrder'#2#6#0#0#5'TEdit'#12'PositionEdit'#4'Left'
+#3#136#0#6'Height'#2#21#3'Top'#3#197#0#5'Width'#2'y'#9'MaxLength'#2'2'#8'OnC'
+'hange'#7#11'ItemChanged'#8'TabOrder'#2#10#0#0#5'TEdit'#9'TitleEdit'#4'Left'
+#3#136#0#6'Height'#2#21#3'Top'#2#29#5'Width'#2'y'#9'MaxLength'#2'2'#8'OnChan'
+'ge'#7#11'ItemChanged'#8'TabOrder'#2#1#0#0#5'TEdit'#11'CompanyEdit'#4'Left'#3
+#136#0#6'Height'#2#21#3'Top'#3#173#0#5'Width'#2'y'#9'MaxLength'#2'2'#8'OnCha'
+'nge'#7#11'ItemChanged'#8'TabOrder'#2#9#0#0#9'TComboBox'#12'cboxCategory'#4
+'Left'#3#136#0#6'Height'#2#21#3'Top'#3#224#0#5'Width'#2'y'#16'AutoCompleteTe'
+'xt'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#4
+#255#255#0#0#8'TabOrder'#2#11#0#0#9'TComboBox'#9'cboxState'#4'Left'#3#136#0#6
+'Height'#2#21#3'Top'#2'd'#5'Width'#3#249#0#16'AutoCompleteText'#11#22'cbactE'
+'ndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#4#255#255#0#0#8'T'
+'abOrder'#2#4#7'Visible'#8#0#0#5'TEdit'#10'edtCountry'#4'Left'#3#152#0#6'Hei'
+'ght'#2#21#3'Top'#3#148#0#5'Width'#3#249#0#8'TabOrder'#2#8#0#0#9'TComboBox'
+#11'cboxCountry'#4'Left'#3#136#0#6'Height'#2#21#3'Top'#3#148#0#5'Width'#3#249
+#0#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscendin'
+'g'#0#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#9'MaxLength'#4
+#255#255#0#0#8'OnChange'#7#17'cboxCountryChange'#8'TabOrder'#2#7#0#0#0#9'TTa'
,'bSheet'#10'tabContact'#7'Caption'#6#8'Con&tact'#12'ClientHeight'#3#24#1#11
+'ClientWidth'#3#177#1#10'ImageIndex'#2#1#0#6'TLabel'#8'EMailLbl'#4'Left'#2'['
+#6'Height'#2#14#3'Top'#3#136#0#5'Width'#2'&'#7'Caption'#6#8'EMailLbl'#11'Par'
+'entColor'#8#0#0#9'TComboBox'#13'cboxPhoneLbl1'#4'Left'#2#8#6'Height'#2#21#3
+'Top'#2#8#5'Width'#2'y'#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20
+'cbactSearchAscending'#0#9'MaxLength'#4#255#255#0#0#8'TabOrder'#2#0#0#0#9'TC'
+'omboBox'#13'cboxPhoneLbl2'#4'Left'#2#8#6'Height'#2#21#3'Top'#2' '#5'Width'#2
+'y'#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscendi'
+'ng'#0#9'MaxLength'#4#255#255#0#0#8'TabOrder'#2#2#0#0#9'TComboBox'#13'cboxPh'
+'oneLbl3'#4'Left'#2#8#6'Height'#2#21#3'Top'#2'8'#5'Width'#2'y'#16'AutoComple'
+'teText'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLengt'
+'h'#4#255#255#0#0#8'TabOrder'#2#4#0#0#9'TComboBox'#13'cboxPhoneLbl4'#4'Left'
+#2#8#6'Height'#2#21#3'Top'#2'P'#5'Width'#2'y'#16'AutoCompleteText'#11#22'cba'
+'ctEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#4#255#255#0#0#8
+'TabOrder'#2#6#0#0#5'TEdit'#10'Phone4Edit'#4'Left'#3#136#0#6'Height'#2#21#3
+'Top'#2'P'#5'Width'#2'y'#9'MaxLength'#2#25#8'OnChange'#7#11'ItemChanged'#8'T'
+'abOrder'#2#7#0#0#5'TEdit'#10'Phone3Edit'#4'Left'#3#136#0#6'Height'#2#21#3'T'
+'op'#2'8'#5'Width'#2'y'#9'MaxLength'#2#25#8'OnChange'#7#11'ItemChanged'#8'Ta'
+'bOrder'#2#5#0#0#5'TEdit'#10'Phone2Edit'#4'Left'#3#136#0#6'Height'#2#21#3'To'
+'p'#2' '#5'Width'#2'y'#9'MaxLength'#2#25#8'OnChange'#7#11'ItemChanged'#8'Tab'
+'Order'#2#3#0#0#5'TEdit'#10'Phone1Edit'#4'Left'#3#136#0#6'Height'#2#21#3'Top'
+#2#8#5'Width'#2'y'#9'MaxLength'#2#25#8'OnChange'#7#11'ItemChanged'#8'TabOrde'
+'r'#2#1#0#0#9'TComboBox'#13'cboxPhoneLbl5'#4'Left'#2#8#6'Height'#2#21#3'Top'
+#2'h'#5'Width'#2'y'#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cb'
+'actSearchAscending'#0#9'MaxLength'#4#255#255#0#0#8'TabOrder'#2#8#0#0#5'TEdi'
+'t'#10'Phone5Edit'#4'Left'#3#136#0#6'Height'#2#21#3'Top'#2'h'#5'Width'#2'y'#9
+'MaxLength'#2#25#8'OnChange'#7#11'ItemChanged'#8'TabOrder'#2#9#0#0#5'TEdit'#9
+'EMailEdit'#4'Left'#3#136#0#6'Height'#2#21#3'Top'#3#128#0#5'Width'#2'y'#8'Ta'
+'bOrder'#2#10#0#0#0#9'TTabSheet'#9'tabCustom'#7'Caption'#6#7'C&ustom'#12'Cli'
+'entHeight'#3#24#1#11'ClientWidth'#3#177#1#10'ImageIndex'#2#2#0#6'TLabel'#10
+'CustomLbl1'#4'Left'#2#8#6'Height'#2#14#3'Top'#2#12#5'Width'#2'8'#7'Caption'
+#6#10'CustomLbl1'#11'ParentColor'#8#0#0#6'TLabel'#10'CustomLbl2'#4'Left'#2#8
+#6'Height'#2#14#3'Top'#2'$'#5'Width'#2'8'#7'Caption'#6#10'CustomLbl2'#11'Par'
+'entColor'#8#0#0#6'TLabel'#10'CustomLbl3'#4'Left'#2#8#6'Height'#2#14#3'Top'#2
+'<'#5'Width'#2'8'#7'Caption'#6#10'CustomLbl3'#11'ParentColor'#8#0#0#6'TLabel'
+#10'CustomLbl4'#4'Left'#2#8#6'Height'#2#14#3'Top'#2'T'#5'Width'#2'8'#7'Capti'
+'on'#6#10'CustomLbl4'#11'ParentColor'#8#0#0#5'TEdit'#11'Custom1Edit'#4'Left'
+#2'P'#6'Height'#2#21#3'Top'#2#8#5'Width'#2'y'#9'MaxLength'#2'd'#8'OnChange'#7
+#11'ItemChanged'#8'TabOrder'#2#0#0#0#5'TEdit'#11'Custom2Edit'#4'Left'#2'P'#6
+'Height'#2#21#3'Top'#2' '#5'Width'#2'y'#9'MaxLength'#2'd'#8'OnChange'#7#11'I'
+'temChanged'#8'TabOrder'#2#1#0#0#5'TEdit'#11'Custom3Edit'#4'Left'#2'P'#6'Hei'
+'ght'#2#21#3'Top'#2'8'#5'Width'#2'y'#9'MaxLength'#2'd'#8'OnChange'#7#11'Item'
+'Changed'#8'TabOrder'#2#2#0#0#5'TEdit'#11'Custom4Edit'#4'Left'#2'P'#6'Height'
+#2#21#3'Top'#2'P'#5'Width'#2'y'#9'MaxLength'#2'd'#8'OnChange'#7#11'ItemChang'
+'ed'#8'TabOrder'#2#3#0#0#0#9'TTabSheet'#8'tabNotes'#7'Caption'#6#6'&Notes'#12
+'ClientHeight'#3#24#1#11'ClientWidth'#3#177#1#10'ImageIndex'#2#3#0#5'TMemo'#8
+'NoteEdit'#4'Left'#2#8#6'Height'#3#234#0#3'Top'#2#8#5'Width'#3#153#1#7'Ancho'
+'rs'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#9'MaxLength'#3#0#4#10'Sc'
+'rollBars'#7#10'ssVertical'#8'TabOrder'#2#0#0#0#0#0#6'TPanel'#9'pnlBottom'#6
+'Height'#2')'#3'Top'#3#24#1#5'Width'#3#177#1#5'Align'#7#8'alBottom'#10'Bevel'
+'Outer'#7#6'bvNone'#12'ClientHeight'#2')'#11'ClientWidth'#3#177#1#8'TabOrder'
+#2#1#0#7'TButton'#5'OKBtn'#4'Left'#3#22#1#6'Height'#2#25#3'Top'#2#9#5'Width'
+#2'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#2'OK'#7'Default'#9
+#7'OnClick'#7#10'OKBtnClick'#8'TabOrder'#2#0#7'TabStop'#8#0#0#7'TButton'#9'C'
+'ancelBtn'#4'Left'#3'e'#1#6'Height'#2#25#3'Top'#2#9#5'Width'#2'K'#7'Anchors'
+#11#7'akRight'#8'akBottom'#0#6'Cancel'#9#7'Caption'#6#6'Cancel'#7'OnClick'#7
+#14'CancelBtnClick'#8'TabOrder'#2#1#7'TabStop'#8#0#0#0#0
]);

673
components/tvplanit/source/vpcontacteditdlg.pas Normal file
View File

@ -0,0 +1,673 @@
{*********************************************************}
{* VPCONTACTEDITDLG.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 VpContactEditDlg;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils,
{$IFDEF VERSION6} Variants, {$ENDIF}
Classes, Graphics, Controls, Forms, Dialogs, VpData, ExtCtrls, StdCtrls,
VpException, VpMisc, VpBase, VpSR, VpDlg, VpBaseDS, ComCtrls;
type
{ forward declarations }
TVpContactEditDialog = class;
TContactEditForm = class(TForm)
tsContacts: TPageControl;
tabMain: TTabSheet;
NameLbl: TLabel;
AddrLbl: TLabel;
CityLbl: TLabel;
StateLbl: TLabel;
ZipLbl: TLabel;
CountryLbl: TLabel;
PositionLbl: TLabel;
TitleLbl: TLabel;
CompanyLbl: TLabel;
NameEdit: TEdit;
AddressEdit: TEdit;
CityEdit: TEdit;
StateEdit: TEdit;
ZipCodeEdit: TEdit;
PositionEdit: TEdit;
TitleEdit: TEdit;
CompanyEdit: TEdit;
cboxCategory: TComboBox;
cboxCountry: TComboBox;
cboxState: TComboBox;
edtCountry: TEdit;
tabContact: TTabSheet;
tabCustom: TTabSheet;
pnlBottom: TPanel;
OKBtn: TButton;
CancelBtn: TButton;
tabNotes: TTabSheet;
NoteEdit: TMemo;
CustomLbl1: TLabel;
CustomLbl2: TLabel;
CustomLbl3: TLabel;
CustomLbl4: TLabel;
Custom1Edit: TEdit;
Custom2Edit: TEdit;
Custom3Edit: TEdit;
Custom4Edit: TEdit;
cboxPhoneLbl1: TComboBox;
cboxPhoneLbl2: TComboBox;
cboxPhoneLbl3: TComboBox;
cboxPhoneLbl4: TComboBox;
Phone4Edit: TEdit;
Phone3Edit: TEdit;
Phone2Edit: TEdit;
Phone1Edit: TEdit;
cboxPhoneLbl5: TComboBox;
Phone5Edit: TEdit;
EMailLbl: TLabel;
EMailEdit: TEdit;
CategoryLbl: TLabel;
procedure OKBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ItemChanged(Sender: TObject);
procedure cboxCountryChange(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure tsContactsChange(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure SetCaptions;
procedure DisplayCurrentCountry;
procedure ResizeControls;
public
Resource : TVpResource;
Contact : TVpContact;
ReturnCode : TVpEditorReturnCode;
ControlLink : TVpControlLink;
procedure PopulateSelf;
procedure DePopulateSelf;
procedure ArrangeControls;
end;
TVpContactEditDialog = class(TVpBaseDialog)
protected {private}
ceEditDlg : TContactEditForm;
ceContact : TVpContact;
ceResource : TVpResource;
public
function Execute(Contact: TVpContact): Boolean; reintroduce;
function AddNewContact: Boolean;
published
{properties}
property ControlLink;
property DataStore;
property Placement;
end;
implementation
{$IFNDEF LCL}
{$R *.dfm}
{$ENDIF}
uses
VpConst;
{== Utility functions ===================================}
function Max(const a, b : Integer) : Integer;
begin
if a >= b then
Result := a
else
Result := b;
end;
{== TEditForm ===========================================}
procedure TContactEditForm.FormCreate(Sender: TObject);
begin
ReturnCode := rtAbandon;
SetCaptions;
end;
{=====}
procedure TContactEditForm.SetCaptions;
begin
OkBtn.Caption := RSOKBtn;
CancelBtn.Caption := RSCancelBtn;
NameLbl.Caption := RSNameLbl;
TitleLbl.Caption := RSTitleLbl;
AddrLbl.Caption := RSAddressLbl;
CityLbl.Caption := RSCityLbl;
StateLbl.Caption := RSStateLbl;
ZipLbl.Caption := RSZipCodeLbl;
CountryLbl.Caption := RSCountryLbl;
CompanyLbl.Caption := RSCompanyLbl;
PositionLbl.Caption := RSPositionLbl;
CategoryLbl.Caption := RSCategoryLbl;
EmailLbl.Caption := RSEmail;
CustomLbl1.Caption := RSCustom1;
CustomLbl2.Caption := RSCustom2;
CustomLbl3.Caption := RSCustom3;
CustomLbl4.Caption := RSCustom4;
end;
{=====}
procedure TContactEditForm.OKBtnClick(Sender: TObject);
begin
if NameEdit.Text = '' then begin
raise EVpContactEditError.Create(RSNameIsRequired);
exit;
end;
ReturnCode := rtCommit;
Close;
end;
{=====}
procedure TContactEditForm.CancelBtnClick(Sender: TObject);
begin
ReturnCode := rtAbandon;
Close;
end;
{=====}
procedure TContactEditForm.DePopulateSelf;
begin
ParseName(Contact, NameEdit.Text);
Contact.Address := AddressEdit.Text;
Contact.City := CityEdit.Text;
if cboxState.Visible then
Contact.State := cboxState.Text
else
Contact.State := StateEdit.Text;
Contact.Zip := ZipCodeEdit.Text;
Contact.Position := PositionEdit.Text;
Contact.Title := TitleEdit.Text;
Contact.EMail := EMailEdit.Text;
Contact.Company := CompanyEdit.Text;
Contact.Phone1 := Phone1Edit.Text;
Contact.Phone2 := Phone2Edit.Text;
Contact.Phone3 := Phone3Edit.Text;
Contact.Phone4 := Phone4Edit.Text;
Contact.Phone5 := Phone5Edit.Text;
if cboxCountry.Visible then
Contact.Country := cboxCountry.Text
else
Contact.Country := edtCountry.Text;
Contact.Note := NoteEdit.Text;
Contact.Category := cboxCategory.ItemIndex;
Contact.Custom1 := Custom1Edit.Text;
Contact.Custom2 := Custom2Edit.Text;
Contact.Custom3 := Custom3Edit.Text;
Contact.Custom4 := Custom4Edit.Text;
Contact.PhoneType1 := cboxPhoneLbl1.ItemIndex;
Contact.PhoneType2 := cboxPhoneLbl2.ItemIndex;
Contact.PhoneType3 := cboxPhoneLbl3.ItemIndex;
Contact.PhoneType4 := cboxPhoneLbl4.ItemIndex;
Contact.PhoneType5 := cboxPhoneLbl5.ItemIndex;
Contact.Category := cboxCategory.ItemIndex;
end;
{=====}
procedure TContactEditForm.PopulateSelf;
var
CurCountry : Integer;
i : TVpPhoneType;
j : TVpCategoryType;
begin
NameEdit.Text := AssembleName(Contact);
AddressEdit.Text := Contact.Address;
CityEdit.Text := Contact.City;
ZipCodeEdit.Text := Contact.Zip;
PositionEdit.Text := Contact.Position;
TitleEdit.Text := Contact.Title;
EMailEdit.Text := Contact.EMail;
CompanyEdit.Text := Contact.Company;
Phone1Edit.Text := Contact.Phone1;
Phone2Edit.Text := Contact.Phone2;
Phone3Edit.Text := Contact.Phone3;
Phone4Edit.Text := Contact.Phone4;
Phone5Edit.Text := Contact.Phone5;
NoteEdit.Text := Contact.Note;
cboxCategory.ItemIndex := Contact.Category;
Custom1Edit.Text := Contact.Custom1;
Custom2Edit.Text := Contact.Custom2;
Custom3Edit.Text := Contact.Custom3;
Custom4Edit.Text := Contact.Custom4;
cboxCountry.Text := Contact.Country;
edtCountry.Text := Contact.Country;
if (Contact.Country = '') and (Assigned (ControlLink)) then begin
if ControlLink.DefaultCountry <> '' then begin
cboxCountry.Text := ControlLink.DefaultCountry;
edtCountry.Text := ControlLink.DefaultCountry;
end else begin
CurCountry := ControlLink.Localization.GetCurrentCountry;
if CurCountry >= 0 then begin
cboxCountry.Text := ControlLink.Localization.Countries.Items[CurCountry].Name;
edtCountry.Text := ControlLink.Localization.Countries.Items[CurCountry].Name;
end;
end;
end;
StateEdit.Text := Contact.State;
cboxState.Text := Contact.State;
for i := Low (TVpPhoneType) to High (TVpPhoneType) do begin
cboxPhoneLbl1.Items.Add (PhoneLabel (i));
cboxPhoneLbl2.Items.Add (PhoneLabel (i));
cboxPhoneLbl3.Items.Add (PhoneLabel (i));
cboxPhoneLbl4.Items.Add (PhoneLabel (i));
cboxPhoneLbl5.Items.Add (PhoneLabel (i));
end;
cboxPhoneLbl1.ItemIndex := Contact.PhoneType1;
cboxPhoneLbl2.ItemIndex := Contact.PhoneType2;
cboxPhoneLbl3.ItemIndex := Contact.PhoneType3;
cboxPhoneLbl4.ItemIndex := Contact.PhoneType4;
cboxPhoneLbl5.ItemIndex := Contact.PhoneType5;
for j := Low (TVpCategoryType) to High (TVpCategoryType) do
cboxCategory.Items.Add (CategoryLabel (j));
cboxCategory.ItemIndex := Contact.Category;
DisplayCurrentCountry;
end;
{=====}
procedure TContactEditForm.ItemChanged(Sender: TObject);
begin
Contact.Changed := true;
{ if there is a comma in the nameedit, then it is assumed that the name is }
{ formatted as last, first. Since the comma & space aren't actually part of }
{ the name, we need to allow two extra characters in the namefield's width. }
if Pos(',', NameEdit.Text) > 0 then
NameEdit.MaxLength := 102
else
NameEdit.MaxLength := 100;
end;
{=====}
procedure TContactEditForm.ArrangeControls;
begin
edtCountry.Left := cboxCountry.Left;
StateEdit.Left := cboxState.Left;
if (not Assigned (ControlLink)) or
(ControlLink.Localization.Countries.Count = 0) then begin
edtCountry.Visible := True;
CountryLbl.FocusControl := edtCountry;
cboxCountry.Visible := False;
StateEdit.Visible := True;
StateLbl.FocusControl := StateEdit;
cboxState.Visible := False;
end
else begin
ControlLink.Localization.CountriesToTStrings (cboxCountry.Items);
CountryLbl.FocusControl := cboxCountry;
cboxCountry.Visible := True;
edtCountry.Visible := False;
StateLbl.FocusControl := cboxState;
cboxState.Visible := True;
StateEdit.Visible := False;
end;
tsContacts.ActivePage := tabMain;
end;
{=====}
procedure TContactEditForm.ResizeControls;
function GetLabelWidth (ALabel : TLabel) : Integer;
var
OldFont : TFont;
begin
OldFont := TFont.Create;
try
OldFont.Assign (Canvas.Font);
try
Canvas.Font.Assign (ALabel.Font);
Result := Canvas.TextWidth (ALabel.Caption);
finally
Canvas.Font.Assign (OldFont);
end;
finally
OldFont.Free;
end;
end;
const
ComboArrowWidth = 32;
FieldVertSep = 25;
FormRightBorder = 20;
MinFormWidth = 265;
FormHeightOffset = 103;
MinFormHeight = 250;
TopField = 4;
type
TLabelArray = array[0..9] of TLabel;
var
Labels : TLabelArray;
LargestLabel : Integer;
WidestField : Integer;
i : Integer;
j : Integer;
OldFont : TFont;
FieldTop : Integer;
begin
{ Note: The resizing algorithm is dependent upon the labels having their
FocusControl property set to the corresponding edit field or combobox. }
Labels[0] := NameLbl;
Labels[1] := TitleLbl;
Labels[2] := AddrLbl;
Labels[3] := CityLbl;
Labels[4] := StateLbl;
Labels[5] := ZipLbl;
Labels[6] := CountryLbl;
Labels[7] := CompanyLbl;
Labels[8] := PositionLbl;
Labels[9] := CategoryLbl;
LargestLabel := 0;
for i := Low(Labels) to High(Labels) do
LargestLabel := Max(LargestLabel, GetLabelWidth(Labels[i]));
{ Determine height of label based upon whether large or small fonts are
in effect. }
for i := Low(Labels) to High(Labels) do begin
Labels[i].Width := LargestLabel;
Labels[i].FocusControl.Left := NameLbl.Left + LargestLabel + 4;
end;
if cboxCountry.Visible then begin
WidestField := 0;
OldFont := TFont.Create;
try
Canvas.Font.Assign (cboxCountry.Font);
try
for j := 0 to cboxCountry.Items.Count - 1 do begin
i := Canvas.TextWidth (cboxCountry.Items[j]);
if i > WidestField then
WidestField := i;
end;
WidestField := WidestField + ComboArrowWidth;
cboxCountry.Width := WidestField;
finally
Canvas.Font.Assign (OldFont);
end;
finally
OldFont.Free;
end;
if (cboxCountry.Left + cboxCountry.Width + FormRightBorder > MinFormWidth) and
(not cboxState.Visible) then
Width := cboxCountry.Left + cboxCountry.Width + FormRightBorder
else
Width := MinFormWidth;
end;
if cboxState.Visible then begin
WidestField := 0;
OldFont := TFont.Create;
try
Canvas.Font.Assign (cboxCountry.Font);
try
for j := 0 to cboxState.Items.Count - 1 do begin
i := Canvas.TextWidth (cboxState.Items[j]);
if i > WidestField then
WidestField := i;
end;
WidestField := WidestField + ComboArrowWidth;
cboxState.Width := WidestField;
finally
Canvas.Font.Assign (OldFont);
end;
finally
OldFont.Free;
end;
if (cboxState.Left + cboxState.Width + FormRightBorder > MinFormWidth) and
(not cboxCountry.Visible) then
Width := cboxState.Left + cboxState.Width + FormRightBorder
else
Width := MinFormWidth;
end;
if (cboxState.Visible) and (cboxCountry.Visible) then begin
FieldTop := cboxCountry.Left + cboxCountry.Width + FormRightBorder;
if cboxState.Left + cboxState.Width + FormRightBorder > FieldTop then
FieldTop := cboxState.Left + cboxState.Width + FormRightBorder;
if (FieldTop > MinFormWidth) then
Width := FieldTop
else
Width := MinFormWidth;
end;
{ Vertically arrange the fields. }
FieldTop := TopField;
for i := Low(Labels) to High(Labels) do
if Labels[i].Visible then begin
Labels[i].FocusControl.Top := FieldTop;
Labels[i].Top := FieldTop + 2;
inc(FieldTop, FieldVertSep);
end;
if FieldTop + FormHeightOffset > MinFormHeight then
Height := FieldTop + FormHeightOffset
else
Height := MinFormHeight;
end;
{=====}
procedure TContactEditForm.DisplayCurrentCountry;
var
Idx : Integer;
begin
if not Assigned (ControlLink) then
Exit;
Idx := ControlLink.Localization.CountryNameToIndex (cboxCountry.Text);
if Idx > -1 then begin
ControlLink.Localization.StatesToTStrings (Idx, cboxState.Items);
if ControlLink.Localization.Countries.Items[Idx].Address1Visible then begin
AddrLbl.Visible := True;
AddressEdit.Visible := True;
if ControlLink.Localization.Countries.Items[Idx].Address1Caption <> '' then
AddrLbl.Caption := ControlLink.Localization.Countries.Items[Idx].Address1Caption
else
AddrLbl.Caption := 'Address: ';
end else begin
AddrLbl.Visible := False;
AddressEdit.Visible := False;
end;
if ControlLink.Localization.Countries.Items[Idx].CityVisible then begin
CityLbl.Visible := True;
CityEdit.Visible := True;
if ControlLink.Localization.Countries.Items[Idx].CityCaption <> '' then
CityLbl.Caption := ControlLink.Localization.Countries.Items[Idx].CityCaption
else
CityLbl.Caption := 'City: ';
end else begin
CityLbl.Visible := False;
CityEdit.Visible := False;
end;
if ControlLink.Localization.Countries.Items[Idx].StatesVisible then begin
StateLbl.Visible := True;
if ControlLink.Localization.Countries.Items[Idx].States.Count > 0 then begin
StateLbl.FocusControl := cboxState;
cboxState.Visible := True;
StateEdit.Visible := False;
end else begin
StateLbl.FocusControl := StateEdit;
StateEdit.Visible := True;
cboxState.Visible := False;
StateEdit.Left := cboxState.Left;
end;
if ControlLink.Localization.Countries.Items[Idx].StateCaption <> '' then
StateLbl.Caption := ControlLink.Localization.Countries.Items[Idx].StateCaption
else
StateLbl.Caption := 'State: ';
end else begin
StateLbl.Visible := False;
StateEdit.Visible := False;
cboxState.Visible := False;
end;
if ControlLink.Localization.Countries.Items[Idx].ZipVisible then begin
ZipLbl.Visible := True;
ZipCodeEdit.Visible := True;
if ControlLink.Localization.Countries.Items[Idx].ZipCaption <> '' then
ZipLbl.Caption := ControlLink.Localization.Countries.Items[Idx].ZipCaption
else
ZipLbl.Caption := 'Zip Code: ';
end else begin
ZipLbl.Visible := False;
ZipCodeEdit.Visible := False;
end;
end else begin
cboxState.Items.Clear;
end;
ResizeControls;
end;
{=====}
procedure TContactEditForm.cboxCountryChange(Sender: TObject);
begin
StateEdit.Text := '';
cboxState.Text := '';
DisplayCurrentCountry;
end;
{=====}
{ TVpContactEditDialog }
function TVpContactEditDialog.Execute(Contact: TVpContact): Boolean;
var
EditForm: TContactEditForm;
begin
ceContact := Contact;
Result := false;
Application.CreateForm(TContactEditForm, EditForm);
try
DoFormPlacement(EditForm);
SetFormCaption(EditForm, Contact.FullName, RSDlgContactEdit);
EditForm.Contact := ceContact;
EditForm.Resource := DataStore.Resource;
EditForm.ControlLink := ControlLink;
EditForm.ArrangeControls;
EditForm.PopulateSelf;
EditForm.ShowModal;
if EditForm.ReturnCode = rtCommit then begin
EditForm.DePopulateSelf;
Result := true;
end;
finally
EditForm.Release;
end;
if Result then begin
ceContact.Changed := true;
DataStore.PostContacts;
DataStore.NotifyDependents;
end;
end;
{=====}
function TVpContactEditDialog.AddNewContact: Boolean;
begin
result := false;
if DataStore <> nil then begin
if DataStore.Resource = nil then
Exit;
ceContact := DataStore.Resource.Contacts.AddContact(
DataStore.GetNextID(ContactsTableName));
if ceContact <> nil then begin
Result := Execute(ceContact);
if Result then
DataStore.PostContacts
else
ceContact.Free;
end;
end;
end;
{=====}
procedure TContactEditForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then begin
ReturnCode := rtAbandon;
Close;
end;
end;
{=====}
procedure TContactEditForm.tsContactsChange(Sender: TObject);
begin
if Visible then
if tsContacts.ActivePage = tabMain then
NameEdit.SetFocus
else if tsContacts.ActivePage = tabContact then
Phone1Edit.SetFocus
else if tsContacts.ActivePage = tabCustom then
Custom1Edit.SetFocus
else if tsContacts.ActivePage = tabNotes then
NoteEdit.SetFocus;
end;
{=====}
procedure TContactEditForm.FormShow(Sender: TObject);
begin
if tsContacts.ActivePage = tabMain then
NameEdit.SetFocus;
end;
{=====}
end.

2669
components/tvplanit/source/vpcontactgrid.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2310
components/tvplanit/source/vpdata.pas Normal file
View File

File diff suppressed because it is too large Load Diff

792
components/tvplanit/source/vpdateedit.pas Normal file
View File

@ -0,0 +1,792 @@
{*********************************************************}
{* VPDATEEDIT.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 VpDateEdit;
{-date edit field with popup calendar}
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Buttons, Classes, Controls, Forms, Graphics, Menus, Messages,
StdCtrls, SysUtils, VpBase, VpCalendar, VpConst, VpEdPop, VpMisc;
type
TVpDateOrder = (doMDY, doDMY, doYMD);
TVpRequiredField = (rfYear, rfMonth, rfDay);
TVpRequiredFields = set of TVpRequiredField;
TVpGetDateEvent = procedure(Sender : TObject; var Value : string)
of object;
TVpCustomDateEdit = class(TVpEdPopup)
protected {private}
{property variables}
FAllowIncDec : Boolean;
FDate : TDateTime;
FEpoch : Integer;
FForceCentury : Boolean;
FPopupCalColors : TVpCalColors;
FPopupCalFont : TFont;
FPopupCalHeight : Integer;
FPopupCalWidth : Integer;
FRequiredFields : TVpRequiredFields;
FTodayString : string;
FWeekStarts : TVpDayType; {the day that begins the week}
{event variables}
FOnGetDate : TVpGetDateEvent;
FOnSetDate : TNotifyEvent;
{internal variables}
Calendar : TVpCalendar;
DateOrder : TVpDateOrder;
GettingDate : Boolean;
HoldCursor : TCursor;
WasAutoScroll : Boolean;
{property methods}
function GetDate : TDateTime;
function GetReadOnly : Boolean;
procedure SetForceCentury(Value : Boolean);
procedure SetPopupCalFont(Value : TFont);
procedure SetReadOnly(Value : Boolean);
{internal methods}
procedure PopupDateChange(Sender : TObject; Date : TDateTime);
procedure PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
procedure PopupKeyPress(Sender : TObject; var Key : Char);
procedure PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
protected
procedure DoExit; override;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure KeyPress(var Key : Char); override;
procedure PopupClose(Sender : TObject); override;
procedure SetDate(Value : TDateTime);
procedure SetDateText(Value : string); dynamic;
{protected properties}
property AllowIncDec : Boolean
read FAllowIncDec write FAllowIncDec default True;
property Epoch : Integer read FEpoch write FEpoch;
property ForceCentury : Boolean
read FForceCentury write SetForceCentury default False;
property PopupCalColors : TVpCalColors
read FPopupCalColors write FPopupCalColors;
property PopupCalFont : TFont read FPopupCalFont write SetPopupCalFont;
property PopupCalHeight : Integer
read FPopupCalHeight write FPopupCalHeight default calDefHeight;
property PopupCalWidth : Integer
read FPopupCalWidth write FPopupCalWidth default calDefWidth;
property ReadOnly : Boolean read GetReadOnly write SetReadOnly;
property RequiredFields : TVpRequiredFields
read FRequiredFields write FRequiredFields;
property TodayString : string read FTodayString write FTodayString;
property WeekStarts : TVpDayType
read FWeekStarts write FWeekStarts default calDefWeekStarts;
{protected events}
property OnGetDate : TVpGetDateEvent read FOnGetDate write FOnGetDate;
property OnSetDate : TNotifyEvent read FOnSetDate write FOnSetDate;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure PopupOpen; override;
function FormatDate(Value : TDateTime) : string; dynamic;
{public properties}
property Date : TDateTime read GetDate write SetDate;
end;
TVpDateEdit = class(TVpCustomDateEdit)
published
{properties}
{$IFDEF VERSION4}
property Anchors;
property Constraints;
property DragKind;
{$ENDIF}
property AllowIncDec;
property AutoSelect;
property AutoSize;
property BorderStyle;
property CharCase;
property Color;
property Ctl3D;
property Cursor;
property DragCursor;
property DragMode;
property Enabled;
property Epoch;
property Font;
property ForceCentury;
{$IFNDEF LCL}
property HideSelection;
{$ENDIF}
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupCalColors;
property PopupCalFont;
property PopupCalHeight;
property PopupCalWidth;
property PopupMenu;
property ReadOnly;
property RequiredFields;
property ShowHint;
property ShowButton;
property TabOrder;
property TabStop;
property TodayString;
property Version;
property Visible;
property WeekStarts;
{events}
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetDate;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnSetDate;
property OnStartDrag;
end;
implementation
uses
VpSR, VpException;
{*** TVpCustomDateEdit ***}
constructor TVpCustomDateEdit.Create(AOwner : TComponent);
var
C : array[0..1] of Char;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csSetCaption];
FAllowIncDec := True;
FEpoch := DefaultEpoch;
FForceCentury := False;
FRequiredFields := [rfMonth, rfDay];
FTodayString := DateSeparator;
FPopupCalHeight := calDefHeight;
FPopupCalWidth := calDefWidth;
FPopupCalFont := TFont.Create;
FPopupCalFont.Assign(Font);
{get the date order from windows}
C[0] := '0'; {default}
//TODO:
{$IFNDEF LCL}
GetProfileString('intl', 'iDate', '0', C, 2);
{$ENDIF}
DateOrder := TVpDateOrder(Ord(C[0])-Ord('0'));
{load button glyph}
FButton.Glyph.Handle := LoadBaseBitmap('VPBTNCAL');
{create color class}
FPopupCalColors := TVpCalColors.Create;
{assign default color scheme}
FPopupCalColors.FCalColors := CalScheme[cscalWindows];
FPopupCalColors.FColorScheme := cscalWindows;
GettingDate := False;
end;
{=====}
destructor TVpCustomDateEdit.Destroy;
begin
FPopupCalColors.Free;
FPopupCalColors := nil;
FPopupCalFont.Free;
FPopupCalFont := nil;
inherited Destroy;
end;
{=====}
procedure TVpCustomDateEdit.DoExit;
begin
try
SetDateText(Text);
except
SetFocus;
raise;
end;
if not PopupActive then
inherited DoExit;
end;
{=====}
function TVpCustomDateEdit.GetDate : TDateTime;
begin
GettingDate := True;
try
SetDateText(Text);
finally
GettingDate := False;
end;
Result := FDate;
end;
{=====}
function TVpCustomDateEdit.GetReadOnly : Boolean;
begin
Result := inherited ReadOnly;
end;
{=====}
procedure TVpCustomDateEdit.KeyDown(var Key : Word; Shift : TShiftState);
begin
inherited KeyDown(Key, Shift);
if (Key = VK_DOWN) and (ssAlt in Shift) then
PopupOpen;
end;
{=====}
procedure TVpCustomDateEdit.KeyPress(var Key : Char);
var
D : Word;
M : Word;
Y : Word;
begin
inherited KeyPress(Key);
if FAllowIncDec and (Key in ['+', '-']) then begin
DoExit; {accept current date}
if FDate = 0 then
DecodeDate(SysUtils.Date, Y, M, D)
else
DecodeDate(FDate, Y, M, D);
if Key = '+' then begin
Inc(D);
if D > DaysInMonth(Y, M) then begin
D := 1;
Inc(M);
if M > 12 then begin
Inc(Y);
M := 1;
end;
end;
end else {'-'} begin
Dec(D);
if D < 1 then begin
Dec(M);
if M < 1 then begin
M := 12;
Dec(Y);
end;
D := DaysInMonth(Y, M);
end;
end;
SetDate(EncodeDate(Y, M, D));
Modified := True;
Key := #0; {clear}
end;
end;
{=====}
function TVpCustomDateEdit.FormatDate(Value : TDateTime) : string;
var
S : string;
begin
S := ShortDateFormat;
if FForceCentury then
if Pos('yyyy', S) = 0 then
Insert('yy', S, Pos('yy', S));
Result := FormatDateTime(S, Value)
end;
{=====}
procedure TVpCustomDateEdit.PopupClose(Sender : TObject);
begin
inherited PopupClose(Sender);
if GetCapture = Calendar.Handle then
ReleaseCapture;
SetFocus;
Calendar.Hide; {hide the Calendar}
if (Calendar.Parent <> nil) then
if (Calendar.Parent is TForm) then
TForm(Calendar.Parent).AutoScroll := WasAutoScroll
else if (Calendar.Parent is TScrollBox) then
TScrollBox(Calendar.Parent).AutoScroll := WasAutoScroll;
Cursor := HoldCursor;
{change parentage so that we control the window handle destruction}
Calendar.Parent := Self;
end;
{=====}
procedure TVpCustomDateEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
var
P : TPoint;
I : Integer;
begin
P := Point(X,Y);
if not PtInRect(Calendar.ClientRect, P) then
PopUpClose(Sender);
{convert to our coordinate system}
P := ScreenToClient(Calendar.ClientToScreen(P));
if PtInRect(ClientRect, P) then begin
I := SelStart;
SetFocus;
SelStart := I;
SelLength := 0;
end;
end;
{=====}
procedure TVpCustomDateEdit.PopupOpen;
var
P : TPoint;
MeasureFrom : TPoint;
begin
inherited PopupOpen;
DoExit; {force update of date}
if not Assigned(Calendar) then begin
Calendar := TVpCalendar.CreateEx (Self, True);
Calendar.OnChange := PopupDateChange;
Calendar.OnExit := PopupClose;
Calendar.OnKeyDown := PopupKeyDown;
Calendar.OnKeyPress := PopupKeyPress;
Calendar.OnMouseDown := PopupMouseDown;
Calendar.Visible := False; {to avoid flash at 0,0}
Calendar.BorderStyle := bsSingle;
Calendar.Height := FPopupCalHeight;
Calendar.Width := FPopupCalWidth;
Calendar.WeekStarts := FWeekStarts;
Calendar.ParentCtl3D := False;
Calendar.Ctl3D := Ctl3D;
Calendar.Font.Assign(FPopupCalFont);
end;
if (Parent.Parent <> nil) then
Calendar.Parent := Parent.Parent
else if Parent <> nil then
Calendar.Parent := Parent
else
Calendar.Parent := GetParentForm(Self);
if (Calendar.Parent <> nil) then
if (Calendar.Parent is TForm) then begin
WasAutoScroll := TForm(Calendar.Parent).AutoScroll;
TForm(Calendar.Parent).AutoScroll := False;
end else if (Calendar.Parent is TScrollBox) then begin
WasAutoScroll := TScrollBox(Calendar.Parent).AutoScroll;
TScrollBox(Calendar.Parent).AutoScroll := False;
end;
{set colors}
Calendar.Colors.Assign(FPopupCalColors);
{determine the proper position}
P := Point (Left, Top + Height + 2);
MeasureFrom := Point (0, 0);
if Assigned (Parent) and (not (Parent is TForm)) then begin
P.x := P.x + Parent.Left;
P.y := P.y + Parent.Top;
end;
//TODO:
{$IFNDEF LCL}
MoveWindow (Calendar.Handle,
MeasureFrom.x + P.X,
MeasureFrom.y + P.Y,
Calendar.Width,
Calendar.Height,
False);
{$ENDIF}
if Text = '' then
Calendar.Date := Now
else
Calendar.Date := FDate;
HoldCursor := Cursor;
Cursor := crArrow;
Calendar.Show;
Calendar.SetFocus;
SetCapture(Calendar.Handle);
end;
{=====}
procedure TVpCustomDateEdit.PopupDateChange(Sender : TObject; Date : TDateTime);
begin
{get the current value}
SetDate(Calendar.Date);
Modified := True;
if Calendar.Browsing then
Exit;
{hide the Calendar}
PopupClose(Sender);
SetFocus;
SelStart := Length(Text);
SelLength := 0;
end;
{=====}
procedure TVpCustomDateEdit.PopupKeyDown(Sender : TObject; var Key : Word;
Shift : TShiftState);
var
X : Integer;
begin
case Key of
VK_UP : if Shift = [ssAlt] then begin
PopupClose(Sender);
X := SelStart;
SetFocus;
SelStart := X;
SelLength := 0;
end;
end;
end;
{=====}
procedure TVpCustomDateEdit.PopupKeyPress(Sender : TObject; var Key : Char);
var
X : Integer;
begin
case Key of
#27 :
begin
PopupClose(Sender);
X := SelStart;
SetFocus;
SelStart := X;
SelLength := 0;
end;
end;
end;
{=====}
procedure TVpCustomDateEdit.SetDate(Value : TDateTime);
begin
FDate := Value;
Modified := True;
if FDate = 0 then
Text := ''
else
Text := FormatDate(FDate);
if Assigned(FOnSetDate) then
FOnSetDate(Self);
end;
{=====}
procedure TVpCustomDateEdit.SetDateText(Value : string);
var
Field : Integer;
I1 : Integer;
I2 : Integer;
Error : Integer;
ThisYear : Word;
ThisMonth : Word;
ThisDay : Word;
Year : Word;
Month : Word;
Day : Word;
EpochYear : Integer;
EpochCent : Integer;
StringList : TStringList;
FieldOrder : string[3];
S : string;
const
ErrorConvertingMonthNumber = 1;
ErrorConvertingMonthName = 2;
ErrorConvertingYear = 3;
ErrorConvertingDay = 4;
MonthIsRequired = 5;
DayIsRequired = 6;
YearIsRequired = 7;
begin
if Assigned(FOnGetDate) then
FOnGetDate(Self, Value);
if (Value = '') and (RequiredFields <> []) then begin
FDate := 0;
if not GettingDate then
Text := '';
Exit;
end;
if AnsiCompareText(Value, TodayString) = 0 then begin
FDate := SysUtils.Date;
if not GettingDate then begin
Text := FormatDate(FDate);
Modified := True;
end;
end else begin
DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
Value := UpperCase(Value);
StringList := TStringList.Create;
try
{parse the string into subfields using a string list to hold the parts}
I1 := 1;
while (I1 <= Length(Value)) and not (Value[I1] in ['0'..'9', 'A'..'Z']) do
Inc(I1);
while I1 <= Length(Value) do begin
I2 := I1;
while (I2 <= Length(Value)) and (Value[I2] in ['0'..'9', 'A'..'Z']) do
Inc(I2);
StringList.Add(Copy(Value, I1, I2-I1));
while (I2 <= Length(Value)) and not (Value[I2] in ['0'..'9', 'A'..'Z']) do
Inc(I2);
I1 := I2;
end;
case DateOrder of
doMDY : FieldOrder := 'MDY';
doDMY : FieldOrder := 'DMY';
doYMD : FieldOrder := 'YMD';
end;
Year := 0;
Month := 0;
Day := 0;
Error := 0;
for Field := 1 to Length(FieldOrder) do begin
if StringList.Count > 0 then
S := StringList[0]
else
S := '';
case FieldOrder[Field] of
'M' :
begin
{numeric month}
if (S = '') or (S[1] in ['0'..'9']) then begin
try
if S = '' then
Month := 0
else
Month := StrToInt(S);
except
Month := 0;
{error converting month number}
Error := ErrorConvertingMonthNumber;
end;
if not (Month in [1..12]) then
Month := 0;
end else begin
{one or more letters in month}
Month := 0;
I1 := 1;
S := Copy(S, 1, 3);
{error converting month name}
Error := ErrorConvertingMonthName;
repeat
if S = UpperCase(Copy(ShortMonthNames[I1], 1, Length(S))) then begin
Month := I1;
I1 := 13;
Error := 0;
end else
Inc(I1);
until I1 = 13;
end;
if Month = 0 then begin
if rfMonth in FRequiredFields then
{month required}
Error := MonthIsRequired
else
Month := ThisMonth;
end else if StringList.Count > 0 then
StringList.Delete(0);
if Error > 0 then
Break;
end;
'Y' :
begin
try
if S = '' then
Year := 0
else
Year := StrToInt(S);
except
Year := 0;
{error converting year}
Error := ErrorConvertingYear;
end;
if (FEpoch = 0) and (Year < 100) and (S <> '') then
{default to current century if Epoch is zero}
Year := Year + (ThisYear div 100 * 100)
else if (FEpoch > 0) and (Year < 100) and (S <> '') then begin
{use epoch}
EpochYear := FEpoch mod 100;
EpochCent := (FEpoch div 100) * 100;
if (Year < EpochYear) then
Inc(Year,EpochCent+100)
else
Inc(Year,EpochCent);
end;
if Year = 0 then begin
if rfYear in FRequiredFields then
{year is required}
Error := YearIsRequired
else
Year := ThisYear;
end else if StringList.Count > 0 then
StringList.Delete(0);
if Error > 0 then
Break;
end;
'D' :
begin
try
if S = '' then
Day := 0
else
Day := StrToInt(S);
except
Day := 0;
{error converting day}
Error := ErrorConvertingDay;
end;
if not (Day in [1..31]) then
Day := 0;
if Day = 0 then begin
if rfDay in FRequiredFields then
{day is required}
Error := DayIsRequired
else
Day := ThisDay;
end
else if StringList.Count > 0 then
StringList.Delete(0);
if Error > 0 then
Break;
end;
end;
end;
case Error of
ErrorConvertingDay :
if S = '' then
raise EVpDateEditError.Create(RSInvalidDay + ' "' + Value + '"')
else
raise EVpDateEditError.Create(RSInvalidDay + ' "' + S + '"');
ErrorConvertingMonthNumber :
if S = '' then
raise EVpDateEditError.Create(RSInvalidMonth + ' "' + Value + '"')
else
raise EVpDateEditError.Create(RSInvalidMonth + ' "' + S + '"');
ErrorConvertingMonthName :
if S = '' then
raise EVpDateEditError.Create(RSInvalidMonthName + ' "' + Value + '"')
else
raise EVpDateEditError.Create(RSInvalidMonthName + ' "' + S + '"');
ErrorConvertingYear :
if S = '' then
raise EVpDateEditError.Create(RSInvalidYear + ' "' + Value + '"')
else
raise EVpDateEditError.Create(RSInvalidYear + ' "' + S + '"');
DayIsRequired :
raise EVpDateEditError.Create(RSDayIsRequired);
MonthIsRequired :
raise EVpDateEditError.Create(RSMonthIsRequired);
YearIsRequired :
raise EVpDateEditError.Create(RSYearIsRequired);
end;
try
FDate := EncodeDate(Year, Month, Day);
if not GettingDate then
Text := FormatDate(FDate);
except
raise EVpDateEditError.Create(RSInvalidDate + ' "' + Value + '"');
end;
finally
StringList.Free;
end;
end;
end;
{=====}
procedure TVpCustomDateEdit.SetForceCentury(Value : Boolean);
begin
if Value <> FForceCentury then begin
FForceCentury := Value;
if Assigned(Calendar) then
SetDate(Calendar.Date);
end;
end;
{=====}
procedure TVpCustomDateEdit.SetPopupCalFont(Value : TFont);
begin
if Assigned(Value) then
FPopupCalFont.Assign(Value);
end;
{=====}
procedure TVpCustomDateEdit.SetReadOnly(Value : Boolean);
begin
inherited ReadOnly := Value;
FButton.Enabled := not ReadOnly;
end;
{=====}
end.

52
components/tvplanit/source/vpdatepropedit.lfm Normal file
View File

@ -0,0 +1,52 @@
object frmDatePropertyEditor: TfrmDatePropertyEditor
Left = 349
Height = 193
Top = 233
Width = 219
HorzScrollBar.Page = 218
VertScrollBar.Page = 192
BorderStyle = bsDialog
Caption = 'Select Date'
ClientHeight = 193
ClientWidth = 219
Font.Height = -11
Font.Name = 'MS Sans Serif'
Position = poDefaultPosOnly
object Button1: TButton
Left = 56
Height = 25
Top = 160
Width = 75
Caption = 'OK'
ModalResult = 1
TabOrder = 0
end
object Button2: TButton
Left = 136
Height = 25
Top = 160
Width = 75
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object VpCalendar1: TVpCalendar
Left = 8
Height = 140
Top = 8
Width = 200
Font.Height = -11
Font.Name = 'MS Sans Serif'
Colors.ActiveDay = clRed
Colors.DayNames = clMaroon
Colors.InactiveDays = clGray
Colors.MonthAndYear = clBlue
Colors.Weekend = clRed
DateFormat = dfLong
DayNameWidth = 3
Options = [cdoShortNames, cdoShowYear, cdoShowRevert, cdoShowToday, cdoShowNavBtns]
TabOrder = 2
TabStop = True
WantDblClicks = True
end
end

72
components/tvplanit/source/vpdatepropedit.pas Normal file
View File

@ -0,0 +1,72 @@
{*********************************************************}
{* VPDATEPROPEDIT.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 VpDatePropEdit;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VpEdPop, VpDateEdit, VpBase, VpBaseDS, VpCalendar;
type
TfrmDatePropertyEditor = class(TForm)
Button1: TButton;
Button2: TButton;
VpCalendar1: TVpCalendar;
private
{ Private declarations }
public
function Execute : Boolean;
{ Public declarations }
end;
var
frmDatePropertyEditor: TfrmDatePropertyEditor;
implementation
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
function TfrmDatePropertyEditor.Execute : Boolean;
begin
if ShowModal = mrOk then
Result := True
else
Result := False;
end;
end.

4618
components/tvplanit/source/vpdayview.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1812
components/tvplanit/source/vpdbds.pas Normal file
View File

File diff suppressed because it is too large Load Diff

140
components/tvplanit/source/vpdbintf.pas Normal file
View File

@ -0,0 +1,140 @@
{*********************************************************}
{* VPDBINTF.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 }
// base unit for all interfaced tdatasets<br>
// defines interfaces for connecting to db independent datasets
unit VPDbIntf;
interface
uses classes, db, sysutils;
type
// interface for sql capable datasets
ISQLDataSet = interface
['{5855A2B8-8568-4AA5-86BC-6DDB06833F8E}']
// see iSQL
procedure SetiSQL(const value: String);
// see iSQL
function GetiSQL:String;
// see iConnectionParams
procedure SetiConnectionParams(const value: String);
// see iConnectionParams
function GetiConnectionParams:String;
// interface to the ExecSQL method
procedure IExecSQL;
// interface for setting the SQL statement
property iSQL: String read GetiSQL write SetiSQL;
// interface for optional connection parameters for the dataset
property iConnectionParams: String read GetiConnectionParams write SetiConnectionParams;
end;
// interface for datasets capable of creating "tables"
ICreateTableDataSet = interface
['{83FC58AD-C245-4F03-A2B8-D1B737BC1955}']
// should create the given table
procedure iCreateTable(const aTableName: String; const aFieldDefs: TFieldDefs; const aIndexDefs: TIndexDefs);
end;
// internal storage type
TCreateInstance = function (InterfaceClass: String): TObject;
// factory for creating classes that implement ISQLDataset
TDBFactory = class(TObject)
protected
// list of registered creation methods; a method must be of type TCreateInstance
fStringlist: TStringlist;
public
// constructor
constructor Create; virtual;
// destructor
destructor Destroy; override;
// registers a class that implements ISQLDataSet. aproc is a function,
// that creates an instance of a TDataset descendant with ISQLDataSet
// implementation and returns it.
procedure RegisterInterfaceType(InterfaceClass: String; aProc: TCreateinstance);
// calls the appropriate creation method and returns the dataset; nil if the
// classtype is not known.
function CreateInstance(InterfaceClass: String): TObject;
end;
// the single instance of TSQLDatasetFactory for each application
// use it to register and create datasets
function sSQLDatasetFactory: TDBFactory;
implementation
{ TSQLDatasetFactory }
constructor TDBFactory.Create;
begin
inherited;
fStringlist:=TStringlist.Create;
end;
function TDBFactory.CreateInstance(InterfaceClass: String): TObject;
var
anindex: integer;
begin
result:=nil;
anindex:=fStringlist.IndexOf(InterfaceClass);
if anindex>-1 then
result:=TCreateinstance(fStringlist.Objects[anIndex])(InterfaceClass)
else
assert(false, 'DB type "'+InterfaceClass+'" not registered with factory.');
end;
destructor TDBFactory.Destroy;
begin
fStringlist.Free;
inherited;
end;
procedure TDBFactory.RegisterInterfaceType(InterfaceClass: String;
aProc: TCreateinstance);
begin
fStringlist.AddObject(InterfaceClass, TObject(@aProc))
end;
var
fSQLDatasetFactory: TDBFactory;
function sSQLDatasetFactory: TDBFactory;
begin
if fSQLDatasetFactory=nil then
fSQLDatasetFactory:=TDBFactory.Create;
result:=fSQLDatasetFactory;
end;
initialization
fSQLDatasetFactory:=nil;
end.

2016
components/tvplanit/source/vpdbisamds.pas Normal file
View File

File diff suppressed because it is too large Load Diff

207
components/tvplanit/source/vpdlg.pas Normal file
View File

@ -0,0 +1,207 @@
{*********************************************************}
{* VPDLG.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 VpDlg;
{dialog components base classes}
interface
uses
{$IFDEF LCL}
Controls,
{$ELSE}
{$ENDIF}
Classes, Forms, Graphics, VpBase, VpBaseDS, VpData, VpConst, VpSR;
type
TVpDialogPosition = (mpCenter, mpCenterTop, mpCustom);
TVpDialogOption = (doSizeable);
TVpDialogOptions = set of TVpDialogOption;
TVpDialogPlacement = class(TPersistent)
protected {private}
{property variables}
FPosition : TVpDialogPosition;
FHeight : Integer;
FLeft : Integer;
FTop : Integer;
FWidth : Integer;
published
{properties}
property Position : TVpDialogPosition read FPosition write FPosition;
property Top : Integer read FTop write FTop;
property Left : Integer read FLeft write FLeft;
property Height : Integer read FHeight write FHeight;
property Width : Integer read FWidth write FWidth;
end;
TVpBaseDialog = class(TVpComponent)
protected {private}
{property variables}
FDataStore : TVpCustomDataStore;
FOptions : TVpDialogOptions;
FPlacement : TVpDialogPlacement;
FOnHelpClick : TNotifyEvent;
FControlLink : TVpControlLink;
function GetVersion: String;
procedure SetVersion(const Value: string);
procedure SetControlLink (const v : TVpControlLink);
procedure SetDataStore(Value: TVpCustomDataStore);
procedure DoFormPlacement(Form : TForm);
procedure SetFormCaption(Form : TForm; const Title, SubTitle : string);
property Options : TVpDialogOptions read FOptions write FOptions;
property Placement : TVpDialogPlacement read FPlacement write FPlacement;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function Execute : Boolean; virtual;
property ControlLink : TVpControlLink
read FControlLink write SetControlLink;
published
property DataStore: TVpCustomDataStore read FDataStore write SetDataStore;
property Version: string read GetVersion write SetVersion;
end;
implementation
constructor TVpBaseDialog.Create(AOwner : TComponent);
var
I: integer;
begin
inherited Create(AOwner);
FOptions := [];
FPlacement := TVpDialogPlacement.Create;
FPlacement.Position := mpCenter;
FPlacement.Left := 10;
FPlacement.Height := 250;
FPlacement.Top := 10;
FPlacement.Width := 400;
{ connect to the first DataStore found on the parent form. }
I := 0;
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
while (I < Owner.ComponentCount) and (FDataStore = nil) do begin
if (Owner.Components[I] is TVpCustomDataStore) then
FDataStore := TVpCustomDataStore(Owner.Components[I])
else if (Owner.Components[I] is TVpControlLink) then
FControlLink := TVpControlLink (Owner.Components[I]);
Inc(I);
end;
end;
destructor TVpBaseDialog.Destroy;
begin
FDataStore := nil;
FControlLink := nil;
FPlacement.Free;
FPlacement := nil;
inherited Destroy;
end;
{=====}
function TVpBaseDialog.Execute : Boolean;
begin
{ Do nothing. }
Result := False;
end;
{=====}
function TVpBaseDialog.GetVersion: string;
begin
Result := VpVersionStr;
end;
{=====}
procedure TVpBaseDialog.SetFormCaption(Form : TForm; const Title, SubTitle : string);
begin
if Title = '' then
Form.Caption := RSUntitled + ' - ' + SubTitle
else
Form.Caption := Title + ' - ' + SubTitle;
end;
{=====}
procedure TVpBaseDialog.SetVersion(const Value: string);
begin
// This method left intentionally blank.
end;
{=====}
procedure TVpBaseDialog.SetControlLink (const v : TVpControlLink);
begin
if FControlLink <> v then
FControlLink := v;
end;
procedure TVpBaseDialog.SetDataStore(Value: TVpCustomDataStore);
begin
if FDataStore <> Value then begin
FDataStore := Value;
end;
end;
{=====}
procedure TVpBaseDialog.DoFormPlacement(Form : TForm);
begin
{set proper style for displayed form}
if doSizeable in FOptions then
Form.BorderStyle := bsSizeable
else
Form.BorderStyle:= bsDialog;
if (Screen.ActiveForm <> nil)
and(Screen.ActiveForm.FormStyle = fsStayOnTop) then
Form.FormStyle := fsStayOnTop;
Form.Height := FPlacement.Height;
Form.Width := FPlacement.Width;
{set position}
case FPlacement.Position of
mpCenter : begin
Form.Position := poScreenCenter;
end;
mpCenterTop : begin
Form.Top := (Screen.Height - Form.Height) div 3;
Form.Left := (Screen.Width - Form.Width) div 2;
end;
mpCustom : begin
Form.Top := FPlacement.Top;
Form.Left := FPlacement.Left;
end;
end;
end;
end.

361
components/tvplanit/source/vpedelem.lfm Normal file
View File

@ -0,0 +1,361 @@
object frmEditElement: TfrmEditElement
Left = 376
Height = 445
Top = 163
Width = 379
HorzScrollBar.Page = 378
VertScrollBar.Page = 444
BorderStyle = bsDialog
Caption = 'Edit Element'
ClientHeight = 445
ClientWidth = 379
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
object Label1: TLabel
Left = 8
Height = 15
Top = 136
Width = 72
Caption = 'Day Offset:'
ParentColor = False
end
object Label2: TLabel
Left = 12
Height = 15
Top = 16
Width = 48
Caption = 'Name: '
ParentColor = False
end
object rgItemType: TRadioGroup
Left = 12
Height = 81
Top = 44
Width = 349
AutoFill = True
Caption = 'Item Type '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 4
ClientHeight = 61
ClientWidth = 345
Columns = 4
ItemIndex = 0
Items.Strings = (
'DayView'
'WeekView'
'MonthView'
'Calendar'
'Shape'
'Caption'
'Tasks'
'Contacts'
)
OnClick = rgItemTypeClick
TabOrder = 1
end
object rgDayOffset: TRadioGroup
Left = 100
Height = 37
Top = 136
Width = 261
AutoFill = True
Caption = ' Day Offset Unit '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 4
ClientHeight = 17
ClientWidth = 257
Columns = 4
ItemIndex = 0
Items.Strings = (
'Day'
'Week'
'Month'
'Year'
)
TabOrder = 2
end
object btnOk: TButton
Left = 212
Height = 25
Top = 412
Width = 75
Caption = 'OK'
Default = True
OnClick = btnOkClick
TabOrder = 6
end
object btnCancel: TButton
Left = 292
Height = 25
Top = 412
Width = 75
Cancel = True
Caption = 'Cancel'
OnClick = btnCancelClick
TabOrder = 7
end
object edName: TEdit
Left = 56
Height = 21
Top = 12
Width = 241
TabOrder = 0
end
object btnShape: TButton
Left = 44
Height = 25
Top = 412
Width = 75
Caption = 'Shape...'
Enabled = False
OnClick = btnShapeClick
TabOrder = 5
end
object gbVisual: TGroupBox
Left = 12
Height = 121
Top = 184
Width = 357
Caption = ' Visual '
ClientHeight = 101
ClientWidth = 353
TabOrder = 3
object Label3: TLabel
Left = 172
Height = 15
Top = 20
Width = 28
Caption = 'Top:'
ParentColor = False
end
object Label4: TLabel
Left = 172
Height = 15
Top = 48
Width = 29
Caption = 'Left:'
ParentColor = False
end
object Label5: TLabel
Left = 259
Height = 15
Top = 20
Width = 47
Caption = 'Height:'
ParentColor = False
end
object Label6: TLabel
Left = 263
Height = 15
Top = 48
Width = 40
Caption = 'Width:'
ParentColor = False
end
object rgMeasurement: TRadioGroup
Left = 76
Height = 80
Top = 20
Width = 89
AutoFill = True
Caption = ' Measurement '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 60
ClientWidth = 85
ItemIndex = 1
Items.Strings = (
'Pixels'
'Percent'
'Inches'
)
OnClick = rgMeasurementClick
TabOrder = 1
end
object rgRotation: TRadioGroup
Left = 8
Height = 93
Top = 20
Width = 61
AutoFill = True
Caption = ' Rotation '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 73
ClientWidth = 57
ItemIndex = 0
Items.Strings = (
'0'
'90'
'180'
'270'
)
TabOrder = 0
end
object edTop: TEdit
Left = 197
Height = 21
Top = 16
Width = 40
OnEnter = PosEditEnter
OnExit = PosEditExit
TabOrder = 2
Text = '0.00'
end
object edLeft: TEdit
Left = 197
Height = 21
Top = 44
Width = 40
OnEnter = PosEditEnter
OnExit = PosEditExit
TabOrder = 3
Text = '0.00'
end
object edHeight: TEdit
Left = 296
Height = 21
Top = 16
Width = 40
OnEnter = PosEditEnter
OnExit = PosEditExit
TabOrder = 4
Text = '0.00'
end
object edWidth: TEdit
Left = 296
Height = 21
Top = 44
Width = 40
OnEnter = PosEditEnter
OnExit = PosEditExit
TabOrder = 5
Text = '0.00'
end
object chkVisible: TCheckBox
Left = 228
Height = 23
Top = 80
Width = 65
Caption = 'Visible'
TabOrder = 6
end
object udTop: TUpDown
Left = 237
Height = 21
Top = 16
Width = 12
TabOrder = 7
OnClick = UpDownClick
end
object udLeft: TUpDown
Left = 237
Height = 21
Top = 44
Width = 12
TabOrder = 8
OnClick = UpDownClick
end
object udHeight: TUpDown
Left = 336
Height = 21
Top = 16
Width = 12
TabOrder = 9
OnClick = UpDownClick
end
object udWidth: TUpDown
Left = 336
Height = 21
Top = 44
Width = 12
TabOrder = 10
OnClick = UpDownClick
end
end
object gbCaption: TGroupBox
Left = 12
Height = 93
Top = 316
Width = 357
Caption = ' Caption '
ClientHeight = 73
ClientWidth = 353
TabOrder = 4
object lbCaptionText: TLabel
Left = 16
Height = 15
Top = 24
Width = 36
Caption = 'Text: '
ParentColor = False
end
object btnCaptionFont: TButton
Left = 24
Height = 25
Top = 48
Width = 75
Caption = 'Font...'
OnClick = btnCaptionFontClick
TabOrder = 1
end
object edCaptionText: TEdit
Left = 52
Height = 21
Top = 20
Width = 293
OnChange = edCaptionTextChange
TabOrder = 0
end
end
object edOffset: TEdit
Left = 20
Height = 21
Top = 156
Width = 54
OnKeyDown = nil
TabOrder = 8
Text = '0'
end
object udOffset: TUpDown
Left = 74
Height = 21
Top = 156
Width = 11
Associate = edOffset
TabOrder = 9
end
object FontDialog1: TFontDialog
Font.Height = -11
Font.Name = 'MS Sans Serif'
left = 4
top = 308
end
end

98
components/tvplanit/source/vpedelem.lrs Normal file
View File

@ -0,0 +1,98 @@
{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei }
LazarusResources.Add('TfrmEditElement','FORMDATA',[
'TPF0'#15'TfrmEditElement'#14'frmEditElement'#4'Left'#3'x'#1#6'Height'#3#189#1
+#3'Top'#3#163#0#5'Width'#3'{'#1#18'HorzScrollBar.Page'#3'z'#1#18'VertScrollB'
+'ar.Page'#3#188#1#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#12'Edit Element'
+#12'ClientHeight'#3#189#1#11'ClientWidth'#3'{'#1#11'Font.Height'#2#245#9'Fon'
+'t.Name'#6#13'MS Sans Serif'#8'OnCreate'#7#10'FormCreate'#6'OnShow'#7#8'Form'
+'Show'#8'Position'#7#14'poScreenCenter'#0#6'TLabel'#6'Label1'#4'Left'#2#8#6
+'Height'#2#15#3'Top'#3#136#0#5'Width'#2'H'#7'Caption'#6#11'Day Offset:'#11'P'
+'arentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#12#6'Height'#2#15#3'Top'#2
+#16#5'Width'#2'0'#7'Caption'#6#6'Name: '#11'ParentColor'#8#0#0#11'TRadioGrou'
+'p'#10'rgItemType'#4'Left'#2#12#6'Height'#2'Q'#3'Top'#2','#5'Width'#3']'#1#8
+'AutoFill'#9#7'Caption'#6#10'Item Type '#28'ChildSizing.LeftRightSpacing'#2#6
+#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24
+'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenou'
+'sChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'Chil'
+'dSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cc'
+'lLeftToRightThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#4#12'ClientH'
+'eight'#2'='#11'ClientWidth'#3'Y'#1#7'Columns'#2#4#9'ItemIndex'#2#0#13'Items'
+'.Strings'#1#6#7'DayView'#6#8'WeekView'#6#9'MonthView'#6#8'Calendar'#6#5'Sha'
+'pe'#6#7'Caption'#6#5'Tasks'#6#8'Contacts'#0#7'OnClick'#7#15'rgItemTypeClick'
+#8'TabOrder'#2#1#0#0#11'TRadioGroup'#11'rgDayOffset'#4'Left'#2'd'#6'Height'#2
+'%'#3'Top'#3#136#0#5'Width'#3#5#1#8'AutoFill'#9#7'Caption'#6#17' Day Offset '
+'Unit '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'
+#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'Chi'
+'ldSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.Shr'
+'inkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crs'
+'ScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27
+'ChildSizing.ControlsPerLine'#2#4#12'ClientHeight'#2#17#11'ClientWidth'#3#1#1
+#7'Columns'#2#4#9'ItemIndex'#2#0#13'Items.Strings'#1#6#3'Day'#6#4'Week'#6#5
+'Month'#6#4'Year'#0#8'TabOrder'#2#2#0#0#7'TButton'#5'btnOk'#4'Left'#3#212#0#6
+'Height'#2#25#3'Top'#3#156#1#5'Width'#2'K'#7'Caption'#6#2'OK'#7'Default'#9#7
+'OnClick'#7#10'btnOkClick'#8'TabOrder'#2#6#0#0#7'TButton'#9'btnCancel'#4'Lef'
+'t'#3'$'#1#6'Height'#2#25#3'Top'#3#156#1#5'Width'#2'K'#6'Cancel'#9#7'Caption'
+#6#6'Cancel'#7'OnClick'#7#14'btnCancelClick'#8'TabOrder'#2#7#0#0#5'TEdit'#6
+'edName'#4'Left'#2'8'#6'Height'#2#21#3'Top'#2#12#5'Width'#3#241#0#8'TabOrder'
+#2#0#0#0#7'TButton'#8'btnShape'#4'Left'#2','#6'Height'#2#25#3'Top'#3#156#1#5
+'Width'#2'K'#7'Caption'#6#8'Shape...'#7'Enabled'#8#7'OnClick'#7#13'btnShapeC'
+'lick'#8'TabOrder'#2#5#0#0#9'TGroupBox'#8'gbVisual'#4'Left'#2#12#6'Height'#2
+'y'#3'Top'#3#184#0#5'Width'#3'e'#1#7'Caption'#6#8' Visual '#12'ClientHeight'
+#2'e'#11'ClientWidth'#3'a'#1#8'TabOrder'#2#3#0#6'TLabel'#6'Label3'#4'Left'#3
+#172#0#6'Height'#2#15#3'Top'#2#20#5'Width'#2#28#7'Caption'#6#4'Top:'#11'Pare'
+'ntColor'#8#0#0#6'TLabel'#6'Label4'#4'Left'#3#172#0#6'Height'#2#15#3'Top'#2
+'0'#5'Width'#2#29#7'Caption'#6#5'Left:'#11'ParentColor'#8#0#0#6'TLabel'#6'La'
+'bel5'#4'Left'#3#3#1#6'Height'#2#15#3'Top'#2#20#5'Width'#2'/'#7'Caption'#6#7
+'Height:'#11'ParentColor'#8#0#0#6'TLabel'#6'Label6'#4'Left'#3#7#1#6'Height'#2
+#15#3'Top'#2'0'#5'Width'#2'('#7'Caption'#6#6'Width:'#11'ParentColor'#8#0#0#11
+'TRadioGroup'#13'rgMeasurement'#4'Left'#2'L'#6'Height'#2'P'#3'Top'#2#20#5'Wi'
+'dth'#2'Y'#8'AutoFill'#9#7'Caption'#6#13' Measurement '#28'ChildSizing.LeftR'
+'ightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.Enlarg'
+'eHorizontal'#7#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'
+#7#24'crsHomogenousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsSca'
+'leChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizin'
+'g.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.ControlsPerLin'
+'e'#2#1#12'ClientHeight'#2'<'#11'ClientWidth'#2'U'#9'ItemIndex'#2#1#13'Items'
+'.Strings'#1#6#6'Pixels'#6#7'Percent'#6#6'Inches'#0#7'OnClick'#7#18'rgMeasur'
+'ementClick'#8'TabOrder'#2#1#0#0#11'TRadioGroup'#10'rgRotation'#4'Left'#2#8#6
+'Height'#2']'#3'Top'#2#20#5'Width'#2'='#8'AutoFill'#9#7'Caption'#6#10' Rotat'
+'ion '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'
+#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'Chi'
+'ldSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.Shr'
+'inkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crs'
+'ScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27
+'ChildSizing.ControlsPerLine'#2#1#12'ClientHeight'#2'I'#11'ClientWidth'#2'9'
+#9'ItemIndex'#2#0#13'Items.Strings'#1#6#1'0'#6#2'90'#6#3'180'#6#3'270'#0#8'T'
+'abOrder'#2#0#0#0#5'TEdit'#5'edTop'#4'Left'#3#197#0#6'Height'#2#21#3'Top'#2
,#16#5'Width'#2'('#7'OnEnter'#7#12'PosEditEnter'#6'OnExit'#7#11'PosEditExit'#8
+'TabOrder'#2#2#4'Text'#6#4'0.00'#0#0#5'TEdit'#6'edLeft'#4'Left'#3#197#0#6'He'
+'ight'#2#21#3'Top'#2','#5'Width'#2'('#7'OnEnter'#7#12'PosEditEnter'#6'OnExit'
+#7#11'PosEditExit'#8'TabOrder'#2#3#4'Text'#6#4'0.00'#0#0#5'TEdit'#8'edHeight'
+#4'Left'#3'('#1#6'Height'#2#21#3'Top'#2#16#5'Width'#2'('#7'OnEnter'#7#12'Pos'
+'EditEnter'#6'OnExit'#7#11'PosEditExit'#8'TabOrder'#2#4#4'Text'#6#4'0.00'#0#0
+#5'TEdit'#7'edWidth'#4'Left'#3'('#1#6'Height'#2#21#3'Top'#2','#5'Width'#2'('
+#7'OnEnter'#7#12'PosEditEnter'#6'OnExit'#7#11'PosEditExit'#8'TabOrder'#2#5#4
+'Text'#6#4'0.00'#0#0#9'TCheckBox'#10'chkVisible'#4'Left'#3#228#0#6'Height'#2
+#23#3'Top'#2'P'#5'Width'#2'A'#7'Caption'#6#7'Visible'#8'TabOrder'#2#6#0#0#7
+'TUpDown'#5'udTop'#4'Left'#3#237#0#6'Height'#2#21#3'Top'#2#16#5'Width'#2#12#8
+'TabOrder'#2#7#7'OnClick'#7#11'UpDownClick'#0#0#7'TUpDown'#6'udLeft'#4'Left'
+#3#237#0#6'Height'#2#21#3'Top'#2','#5'Width'#2#12#8'TabOrder'#2#8#7'OnClick'
+#7#11'UpDownClick'#0#0#7'TUpDown'#8'udHeight'#4'Left'#3'P'#1#6'Height'#2#21#3
+'Top'#2#16#5'Width'#2#12#8'TabOrder'#2#9#7'OnClick'#7#11'UpDownClick'#0#0#7
+'TUpDown'#7'udWidth'#4'Left'#3'P'#1#6'Height'#2#21#3'Top'#2','#5'Width'#2#12
+#8'TabOrder'#2#10#7'OnClick'#7#11'UpDownClick'#0#0#0#9'TGroupBox'#9'gbCaptio'
+'n'#4'Left'#2#12#6'Height'#2']'#3'Top'#3'<'#1#5'Width'#3'e'#1#7'Caption'#6#9
+' Caption '#12'ClientHeight'#2'I'#11'ClientWidth'#3'a'#1#8'TabOrder'#2#4#0#6
+'TLabel'#13'lbCaptionText'#4'Left'#2#16#6'Height'#2#15#3'Top'#2#24#5'Width'#2
+'$'#7'Caption'#6#6'Text: '#11'ParentColor'#8#0#0#7'TButton'#14'btnCaptionFon'
+'t'#4'Left'#2#24#6'Height'#2#25#3'Top'#2'0'#5'Width'#2'K'#7'Caption'#6#7'Fon'
+'t...'#7'OnClick'#7#19'btnCaptionFontClick'#8'TabOrder'#2#1#0#0#5'TEdit'#13
+'edCaptionText'#4'Left'#2'4'#6'Height'#2#21#3'Top'#2#20#5'Width'#3'%'#1#8'On'
+'Change'#7#19'edCaptionTextChange'#8'TabOrder'#2#0#0#0#0#5'TEdit'#8'edOffset'
+#4'Left'#2#20#6'Height'#2#21#3'Top'#3#156#0#5'Width'#2'6'#9'OnKeyDown'#13#8
+'TabOrder'#2#8#4'Text'#6#1'0'#0#0#7'TUpDown'#8'udOffset'#4'Left'#2'J'#6'Heig'
+'ht'#2#21#3'Top'#3#156#0#5'Width'#2#11#9'Associate'#7#8'edOffset'#8'TabOrder'
+#2#9#0#0#11'TFontDialog'#11'FontDialog1'#11'Font.Height'#2#245#9'Font.Name'#6
+#13'MS Sans Serif'#4'left'#2#4#3'top'#3'4'#1#0#0#0
]);

342
components/tvplanit/source/vpedelem.pas Normal file
View File

@ -0,0 +1,342 @@
{*********************************************************}
{* VPEDELEM.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 VpEdElem;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,
VpBase, VpSR, VpPrtFmt, ComCtrls;
type
TfrmEditElement = class(TForm)
btnCancel: TButton;
btnOk: TButton;
btnShape: TButton;
edName: TEdit;
Label1: TLabel;
Label2: TLabel;
rgDayOffset: TRadioGroup;
rgItemType: TRadioGroup;
gbVisual: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
rgMeasurement: TRadioGroup;
rgRotation: TRadioGroup;
edTop: TEdit;
edLeft: TEdit;
edHeight: TEdit;
edWidth: TEdit;
chkVisible: TCheckBox;
gbCaption: TGroupBox;
btnCaptionFont: TButton;
FontDialog1: TFontDialog;
edCaptionText: TEdit;
lbCaptionText: TLabel;
edOffset: TEdit;
udOffset: TUpDown;
udTop: TUpDown;
udLeft: TUpDown;
udHeight: TUpDown;
udWidth: TUpDown;
procedure btnCancelClick(Sender: TObject);
procedure btnOkClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rgItemTypeClick(Sender: TObject);
procedure btnShapeClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnCaptionFontClick(Sender: TObject);
procedure edCaptionTextChange(Sender: TObject);
procedure rgMeasurementClick(Sender: TObject);
procedure PosEditExit(Sender: TObject);
procedure PosEditEnter(Sender: TObject);
procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
private
procedure SetMaxSpin(Spin: Integer);
protected
TheShape : TVpPrintShape;
TheCaption : TVpPrintCaption;
CurEdit : TEdit;
MaxSpin : Integer;
procedure SaveData(AnElement: TVpPrintFormatElementItem);
procedure SetData(AnElement: TVpPrintFormatElementItem);
procedure SetItemType(Index: Integer);
function Validate: Boolean;
{ Private declarations }
public
function Execute(AnElement : TVpPrintFormatElementItem) : Boolean;
{ Public declarations }
end;
implementation
uses VpEdShape;
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
function EvalFmt(Val : Extended) : string;
begin
Result := FormatFloat('0.00', Val);
end;
{=====}
procedure TfrmEditElement.FormCreate(Sender: TObject);
begin
btnShape.Enabled := False;
gbCaption.Enabled := False;
edCaptionText.Enabled := False;
lbCaptionText.Enabled := False;
btnCaptionFont.Enabled := False;
end;
{=====}
procedure TfrmEditElement.FormShow(Sender: TObject);
begin
edName.SetFocus;
end;
{=====}
procedure TfrmEditElement.btnCaptionFontClick(Sender: TObject);
begin
if FontDialog1.Execute then
TheCaption.Font := FontDialog1.Font;
end;
{=====}
procedure TfrmEditElement.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
{=====}
procedure TfrmEditElement.btnOkClick(Sender: TObject);
begin
if Validate then
ModalResult := mrOk
else begin
ShowMessage(RSNeedElementName);
edName.SetFocus;
Exit;
end;
end;
{=====}
procedure TfrmEditElement.btnShapeClick(Sender: TObject);
var
frmEditShape: TfrmEditShape;
begin
Application.CreateForm(TfrmEditShape, frmEditShape);
frmEditShape.Execute(TheShape);
frmEditShape.Free;
end;
{=====}
procedure TfrmEditElement.edCaptionTextChange(Sender: TObject);
begin
TheCaption.Caption := edCaptionText.Text;
end;
{=====}
function TfrmEditElement.Execute(AnElement : TVpPrintFormatElementItem) : Boolean;
begin
SetData(AnElement);
Result := ShowModal = mrOk;
if Result then
SaveData(AnElement);
end;
{=====}
procedure TfrmEditElement.PosEditEnter(Sender: TObject);
begin
CurEdit := (Sender as TEdit);
end;
{=====}
procedure TfrmEditElement.PosEditExit(Sender: TObject);
var
ed : TEdit;
Val : Extended;
begin
ed := (Sender as TEdit);
try
Val := StrToFloat(ed.Text);
if Val > MaxSpin then begin
ed.Text := EvalFmt(MaxSpin);
end else
if Val < 0.0 then begin
ed.Text := EvalFmt(0);
end;
except
on EConvertError do begin
ShowMessage('Please Enter a Floating Point Value');
ed.SetFocus;
end;
end;
end;
{=====}
procedure TfrmEditElement.rgItemTypeClick(Sender: TObject);
begin
SetItemType(rgItemType.ItemIndex);
end;
{=====}
procedure TfrmEditElement.rgMeasurementClick(Sender: TObject);
begin
SetMaxSpin(rgMeasurement.ItemIndex);
end;
{=====}
procedure TfrmEditElement.SaveData(AnElement : TVpPrintFormatElementItem);
begin
AnElement.ElementName := edName.Text;
AnElement.DayOffset := udOffset.Position;
AnElement.Top := StrToFloat(edTop.Text);
AnElement.Left := StrToFloat(edLeft.Text);
AnElement.Height:= StrToFloat(edHeight.Text);
AnElement.Width := StrToFloat(edWidth.Text);
AnElement.ItemType := TVpItemType(rgItemType.ItemIndex);
AnElement.DayOffsetUnits := TVpDayUnits(rgDayOffset.ItemIndex);
AnElement.Rotation := TVpRotationAngle(rgRotation.ItemIndex);
AnElement.Measurement := TVpItemMeasurement(rgMeasurement.ItemIndex);
AnElement.Visible := chkVisible.Checked;
end;
{=====}
procedure TfrmEditElement.SetData(AnElement : TVpPrintFormatElementItem);
begin
edName.Text := AnElement.ElementName;
udOffset.Position := AnElement.DayOffset;
rgItemType.ItemIndex := Ord(AnElement.ItemType);
TheShape := AnElement.Shape;
TheCaption := AnElement.Caption;
rgDayOffset.ItemIndex := Ord(AnElement.DayOffsetUnits);
rgRotation.ItemIndex := Ord(AnElement.Rotation);
rgMeasurement.ItemIndex := Ord(AnElement.Measurement);
SetMaxSpin(rgMeasurement.ItemIndex);
edTop.Text := EvalFmt(AnElement.Top);
udTop.Position := Trunc(AnElement.Top);
edLeft.Text := EvalFmt(AnElement.Left);
udLeft.Position := Trunc(AnElement.Left);
edHeight.Text := EvalFmt(AnElement.Height);
udHeight.Position := Trunc(AnElement.Height);
edWidth.Text := EvalFmt(AnElement.Width);
udWidth.Position := Trunc(AnElement.Width);
edCaptionText.Text := AnElement.Caption.Caption;
FontDialog1.Font := AnElement.Caption.Font;
chkVisible.Checked := AnElement.Visible;
end;
{=====}
procedure TfrmEditElement.SetItemType(Index : Integer);
begin
rgItemType.ItemIndex := Index;
gbCaption.Enabled := False;
edCaptionText.Enabled := False;
lbCaptionText.Enabled := False;
btnCaptionFont.Enabled := False;
btnShape.Enabled := Index = 4;
if Index = 5 then begin
gbCaption.Enabled := True;
edCaptionText.Enabled := True;
lbCaptionText.Enabled := True;
btnCaptionFont.Enabled := True;
end;
end;
{=====}
procedure TfrmEditElement.SetMaxSpin(Spin : Integer);
begin
case Spin of
0: MaxSpin := 2000;
1: MaxSpin := 100;
2: MaxSpin := 50;
end;
udLeft.Max := MaxSpin;
udTop.Max := MaxSpin;
udHeight.Max := MaxSpin;
udWidth.Max := MaxSpin;
end;
{=====}
procedure TfrmEditElement.UpDownClick(Sender: TObject; Button: TUDBtnType);
var
Val, Inc : Extended;
begin
if Sender = udLeft then CurEdit := edLeft ;
if Sender = udTop then CurEdit := edTop ;
if Sender = udHeight then CurEdit := edHeight;
if Sender = udWidth then CurEdit := edWidth ;
Val := 0.0;
try
Val := StrToFloat(CurEdit.Text);
except
on EConvertError do begin
ShowMessage('Please Enter a Floating Point Value');
CurEdit.SetFocus;
end;
end;
Inc := udLeft.Increment / 100;
case Button of
btNext: begin
if Trunc(Val + Inc) > Trunc(Val) then
(Sender as TUpDown).Position := (Sender as TUpDown).Position + 1;
CurEdit.Text := FormatFloat('0.00 ', Val + Inc);
end;
btPrev: begin
if Trunc(Val - Inc) < Trunc(Val) then
(Sender as TUpDown).Position := (Sender as TUpDown).Position - 1;
CurEdit.Text := FormatFloat('0.00 ', Val - Inc);
end;
end;
end;
{=====}
function TfrmEditElement.Validate : Boolean;
begin
Result := edName.Text <> '';
end;
{=====}
end.

119
components/tvplanit/source/vpedfmt.lfm Normal file
View File

@ -0,0 +1,119 @@
object frmEditFormat: TfrmEditFormat
Left = 403
Height = 189
Top = 199
Width = 329
HorzScrollBar.Page = 328
VertScrollBar.Page = 188
BorderStyle = bsDialog
Caption = 'Edit Format'
ClientHeight = 189
ClientWidth = 329
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnShow = FormShow
Position = poScreenCenter
object Label1: TLabel
Left = 12
Height = 15
Top = 76
Width = 99
Caption = 'Day Increment:'
ParentColor = False
end
object Label2: TLabel
Left = 12
Height = 15
Top = 44
Width = 81
Caption = 'Description: '
ParentColor = False
end
object Label3: TLabel
Left = 12
Height = 15
Top = 16
Width = 48
Caption = 'Name: '
ParentColor = False
end
object btnOk: TButton
Left = 160
Height = 25
Top = 156
Width = 75
Caption = 'OK'
Default = True
OnClick = btnOkClick
TabOrder = 3
end
object btnCancel: TButton
Left = 240
Height = 25
Top = 156
Width = 75
Cancel = True
Caption = 'Cancel'
OnClick = btnCancelClick
TabOrder = 4
end
object rgDayIncrement: TRadioGroup
Left = 16
Height = 37
Top = 104
Width = 293
AutoFill = True
Caption = ' Day Increment Unit '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 4
ClientHeight = 17
ClientWidth = 289
Columns = 4
ItemIndex = 0
Items.Strings = (
'Day'
'Week'
'Month'
'Year'
)
TabOrder = 2
end
object edDescription: TEdit
Left = 80
Height = 21
Top = 40
Width = 241
TabOrder = 1
end
object edName: TEdit
Left = 56
Height = 21
Top = 12
Width = 265
TabOrder = 0
end
object udIncrement: TUpDown
Left = 150
Height = 21
Top = 72
Width = 16
Associate = edIncrement
Max = 365
TabOrder = 5
end
object edIncrement: TEdit
Left = 96
Height = 21
Top = 72
Width = 54
OnKeyDown = nil
TabOrder = 6
Text = '0'
end
end

35
components/tvplanit/source/vpedfmt.lrs Normal file
View File

@ -0,0 +1,35 @@
{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei }
LazarusResources.Add('TfrmEditFormat','FORMDATA',[
'TPF0'#14'TfrmEditFormat'#13'frmEditFormat'#4'Left'#3#147#1#6'Height'#3#189#0
+#3'Top'#3#199#0#5'Width'#3'I'#1#18'HorzScrollBar.Page'#3'H'#1#18'VertScrollB'
+'ar.Page'#3#188#0#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#11'Edit Format'
+#12'ClientHeight'#3#189#0#11'ClientWidth'#3'I'#1#11'Font.Height'#2#245#9'Fon'
+'t.Name'#6#13'MS Sans Serif'#6'OnShow'#7#8'FormShow'#8'Position'#7#14'poScre'
+'enCenter'#0#6'TLabel'#6'Label1'#4'Left'#2#12#6'Height'#2#15#3'Top'#2'L'#5'W'
+'idth'#2'c'#7'Caption'#6#14'Day Increment:'#11'ParentColor'#8#0#0#6'TLabel'#6
+'Label2'#4'Left'#2#12#6'Height'#2#15#3'Top'#2','#5'Width'#2'Q'#7'Caption'#6
+#13'Description: '#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#12#6
+'Height'#2#15#3'Top'#2#16#5'Width'#2'0'#7'Caption'#6#6'Name: '#11'ParentColo'
+'r'#8#0#0#7'TButton'#5'btnOk'#4'Left'#3#160#0#6'Height'#2#25#3'Top'#3#156#0#5
+'Width'#2'K'#7'Caption'#6#2'OK'#7'Default'#9#7'OnClick'#7#10'btnOkClick'#8'T'
+'abOrder'#2#3#0#0#7'TButton'#9'btnCancel'#4'Left'#3#240#0#6'Height'#2#25#3'T'
+'op'#3#156#0#5'Width'#2'K'#6'Cancel'#9#7'Caption'#6#6'Cancel'#7'OnClick'#7#14
+'btnCancelClick'#8'TabOrder'#2#4#0#0#11'TRadioGroup'#14'rgDayIncrement'#4'Le'
+'ft'#2#16#6'Height'#2'%'#3'Top'#2'h'#5'Width'#3'%'#1#8'AutoFill'#9#7'Caption'
+#6#20' Day Increment Unit '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSiz'
+'ing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogen'
+'ousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResi'
+'ze'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.Sh'
+'rinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRig'
+'htThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#4#12'ClientHeight'#2#17
+#11'ClientWidth'#3'!'#1#7'Columns'#2#4#9'ItemIndex'#2#0#13'Items.Strings'#1#6
+#3'Day'#6#4'Week'#6#5'Month'#6#4'Year'#0#8'TabOrder'#2#2#0#0#5'TEdit'#13'edD'
+'escription'#4'Left'#2'P'#6'Height'#2#21#3'Top'#2'('#5'Width'#3#241#0#8'TabO'
+'rder'#2#1#0#0#5'TEdit'#6'edName'#4'Left'#2'8'#6'Height'#2#21#3'Top'#2#12#5
+'Width'#3#9#1#8'TabOrder'#2#0#0#0#7'TUpDown'#11'udIncrement'#4'Left'#3#150#0
+#6'Height'#2#21#3'Top'#2'H'#5'Width'#2#16#9'Associate'#7#11'edIncrement'#3'M'
+'ax'#3'm'#1#8'TabOrder'#2#5#0#0#5'TEdit'#11'edIncrement'#4'Left'#2'`'#6'Heig'
+'ht'#2#21#3'Top'#2'H'#5'Width'#2'6'#9'OnKeyDown'#13#8'TabOrder'#2#6#4'Text'#6
+#1'0'#0#0#0
]);

148
components/tvplanit/source/vpedfmt.pas Normal file
View File

@ -0,0 +1,148 @@
{*********************************************************}
{* VPEDFMT.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 VpEdFmt;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, TypInfo, ComCtrls,
VpPrtFmt;
type
TfrmEditFormat = class(TForm)
btnCancel: TButton;
btnOk: TButton;
edDescription: TEdit;
edName: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
rgDayIncrement: TRadioGroup;
udIncrement: TUpDown;
edIncrement: TEdit;
procedure btnCancelClick(Sender: TObject);
procedure btnOkClick(Sender: TObject);
procedure FormShow(Sender: TObject);
protected
procedure SaveData(AFormat: TVpPrintFormatItem);
procedure SetData(AFormat: TVpPrintFormatItem);
function Validate: Boolean;
{ Private declarations }
public
function Execute(AFormat: TVpPrintFormatItem) : Boolean;
{ Public declarations }
end;
implementation
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{ TfrmEditLayout }
procedure TfrmEditFormat.FormShow(Sender: TObject);
begin
edName.SetFocus;
end;
{=====}
procedure TfrmEditFormat.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
{=====}
procedure TfrmEditFormat.btnOkClick(Sender: TObject);
begin
if Validate then
ModalResult := mrOk
else begin
ShowMessage('Please supply a Format Name');
edName.SetFocus;
Exit;
end;
end;
{=====}
function TfrmEditFormat.Execute(AFormat: TVpPrintFormatItem) : Boolean;
begin
SetData(AFormat);
Result := ShowModal = mrOk;
if Result then
SaveData(AFormat);
end;
{=====}
procedure TfrmEditFormat.SaveData(AFormat: TVpPrintFormatItem);
var
EnumVal : Integer;
begin
AFormat.FormatName := edName.Text;
AFormat.Description := edDescription.Text;
AFormat.DayInc := udIncrement.Position;
EnumVal := GetEnumValue(TypeInfo(TVpDayUnits), 'du' + rgDayIncrement.Items[rgDayIncrement.ItemIndex]);
if EnumVal > -1 then
AFormat.DayIncUnits := TVpDayUnits(EnumVal)
else
AFormat.DayIncUnits := duDay;
end;
{=====}
procedure TfrmEditFormat.SetData(AFormat: TVpPrintFormatItem);
var
IncName : string;
begin
edName.Text := AFormat.FormatName;
edDescription.Text := AFormat.Description;
udIncrement.Position := AFormat.DayInc;
IncName := GetEnumName(TypeInfo(TVpDayUnits), Ord(AFormat.DayIncUnits));
if IncName <> '' then begin
rgDayIncrement.ItemIndex := rgDayIncrement.Items.IndexOf(Copy(IncName, 3, Length(IncName) - 2));
end
else
rgDayIncrement.ItemIndex := 0;
end;
{=====}
function TfrmEditFormat.Validate : Boolean;
begin
Result := edName.Text <> '';
end;
{=====}
end.

258
components/tvplanit/source/vpedfmtlst.lfm Normal file
View File

@ -0,0 +1,258 @@
object frmPrnFormat: TfrmPrnFormat
Left = 250
Height = 480
Top = 165
Width = 640
HorzScrollBar.Page = 639
VertScrollBar.Page = 479
Caption = 'Print Format Designer'
ClientHeight = 480
ClientWidth = 640
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
object Label1: TLabel
Left = 8
Height = 14
Top = 4
Width = 44
Caption = '&Formats:'
FocusControl = lbFormats
ParentColor = False
end
object Label2: TLabel
Left = 8
Height = 14
Top = 205
Width = 48
Caption = 'Ele&ments:'
FocusControl = lbElements
ParentColor = False
end
object btnMoveElementUp: TSpeedButton
Left = 232
Height = 22
Top = 352
Width = 23
Color = clBtnFace
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333333333333333333333333333333333333333333333333333333333
333333333333333333333333337777733333333333FFFFF33333333334444473
33333333377777F3333333333CCCC47333333333377777F3333333333CCCC473
33333333377777F3333333333CCCC47333333333377777F3333333333CCCC473
33333333377777F3333333333CCCC47773333333377777FFF333333CCCCCCCCC
333333377777777733333333CCCCCCC33333333377777773333333333CCCCC33
33333333377777333333333333CCC333333333333377733333333333333C3333
3333333333373333333333333333333333333333333333333333
}
NumGlyphs = 2
OnClick = btnMoveElementUpClick
end
object btnMoveElementDn: TSpeedButton
Left = 232
Height = 22
Top = 380
Width = 23
Color = clBtnFace
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333333333333333333333333333333333333333333333333333337333
333333333333F3333333333333347733333333333337FF333333333333CC4773
3333333333777FF3333333333CCCC47733333333377777FF33333333CCCCCC47
733333337777777FF333333CCCCCC4443333333777777777333333333CCCC473
33333333377777F3333333333CCCC47333333333377777F3333333333CCCC473
33333333377777F3333333333CCCC47333333333377777F3333333333CCCC473
33333333377777F3333333333CCCC43333333333377777333333333333333333
3333333333333333333333333333333333333333333333333333
}
NumGlyphs = 2
OnClick = btnMoveElementDnClick
end
object Label3: TLabel
Left = 220
Height = 14
Top = 332
Width = 54
Caption = 'Print Order'
ParentColor = False
end
object btnNewFormat: TButton
Left = 223
Height = 25
Top = 27
Width = 75
Caption = '&New'
Enabled = False
OnClick = btnNewFormatClick
TabOrder = 1
end
object Panel1: TPanel
Left = 334
Height = 439
Width = 306
Align = alRight
Caption = 'Panel1'
ClientHeight = 439
ClientWidth = 306
TabOrder = 8
object PrintPreview: TVpPrintPreview
Left = 1
Height = 437
Top = 1
Width = 304
EndDate = 37377.6447728357
StartDate = 37370.6447728357
ZoomFactor = zfActualSize
Align = alClient
Parent = Panel1
TabStop = True
TabOrder = 0
end
end
object lbFormats: TListBox
Left = 8
Height = 170
Top = 28
Width = 201
ItemHeight = 13
OnClick = lbFormatsClick
Sorted = True
TabOrder = 0
end
object lbElements: TListBox
Left = 8
Height = 180
Top = 225
Width = 201
ItemHeight = 13
OnClick = lbElementsClick
OnDragDrop = lbElementsDragDrop
OnDragOver = lbElementsDragOver
OnMouseDown = lbElementsMouseDown
TabOrder = 4
end
object btnEditFormat: TButton
Left = 223
Height = 25
Top = 63
Width = 75
Caption = '&Edit'
Enabled = False
OnClick = btnEditFormatClick
TabOrder = 2
end
object btnDeleteFormat: TButton
Left = 223
Height = 25
Top = 99
Width = 75
Caption = '&Delete'
Enabled = False
OnClick = btnDeleteFormatClick
TabOrder = 3
end
object btnNewElement: TButton
Left = 223
Height = 25
Top = 223
Width = 75
Caption = 'Ne&w'
Enabled = False
OnClick = btnNewElementClick
TabOrder = 5
end
object btnEditElement: TButton
Left = 223
Height = 25
Top = 259
Width = 75
Caption = 'E&dit'
Enabled = False
OnClick = btnEditElementClick
TabOrder = 6
end
object btnDeleteElement: TButton
Left = 223
Height = 25
Top = 295
Width = 75
Caption = 'De&lete'
Enabled = False
OnClick = btnDeleteElementClick
TabOrder = 7
end
object Panel2: TPanel
Height = 41
Top = 439
Width = 640
Align = alBottom
ClientHeight = 41
ClientWidth = 640
TabOrder = 9
object btnLoadFile: TButton
Left = 92
Height = 25
Top = 8
Width = 75
Caption = 'L&oad File...'
OnClick = btnLoadFileClick
TabOrder = 1
end
object btnSaveFile: TButton
Left = 172
Height = 25
Top = 8
Width = 75
Caption = '&Save File...'
OnClick = btnSaveFileClick
TabOrder = 2
end
object btnNewFile: TButton
Left = 12
Height = 25
Top = 8
Width = 75
Caption = 'New &File'
OnClick = btnNewFileClick
TabOrder = 0
end
object btnOk: TButton
Left = 552
Height = 25
Top = 8
Width = 75
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
OnClick = btnOkClick
TabOrder = 3
end
end
object OpenDialog1: TOpenDialog
Title = 'Open filter file'
DefaultExt = '.xml'
FileName = '*.xml'
Filter = 'Filter Files (.xml)|*.xml|All Files (*.*)|*.*'
left = 215
top = 156
end
object SaveDialog1: TSaveDialog
Title = 'Save formats as'
DefaultExt = '.xml'
FileName = '*.xml'
Filter = 'Filter Files (.xml)|*.xml|All Files (*.*)|*.*'
Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
left = 247
top = 156
end
end

691
components/tvplanit/source/vpedfmtlst.pas Normal file
View File

@ -0,0 +1,691 @@
{*********************************************************}
{* VPEDFMTLST.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 VpEdFmtLst;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, TypInfo, ExtCtrls,
VpPrtFmt, VpBase, VpBaseDS, VpDBDS,{ VpBDEDS,} VpPrtPrv, Buttons,
VpException, VpSR;
const
BaseCaption = 'Print Format Designer';
FileCaption = BaseCaption + ' - %s';
UnnamedFile = '<Unnamed>';
type
TfrmPrnFormat = class(TForm)
btnDeleteElement: TButton;
btnDeleteFormat: TButton;
btnEditElement: TButton;
btnEditFormat: TButton;
btnLoadFile: TButton;
btnMoveElementDn: TSpeedButton;
btnMoveElementUp: TSpeedButton;
btnNewElement: TButton;
btnNewFile: TButton;
btnNewFormat: TButton;
btnSaveFile: TButton;
Label1: TLabel;
Label2: TLabel;
lbElements: TListBox;
lbFormats: TListBox;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
Panel2: TPanel;
PrintPreview: TVpPrintPreview;
SaveDialog1: TSaveDialog;
btnOk: TButton;
Label3: TLabel;
procedure btnDeleteElementClick(Sender: TObject);
procedure btnDeleteFormatClick(Sender: TObject);
procedure btnEditElementClick(Sender: TObject);
procedure btnEditFormatClick(Sender: TObject);
procedure btnLoadFileClick(Sender: TObject);
procedure btnMoveElementDnClick(Sender: TObject);
procedure btnMoveElementUpClick(Sender: TObject);
procedure btnNewElementClick(Sender: TObject);
procedure btnNewFileClick(Sender: TObject);
procedure btnNewFormatClick(Sender: TObject);
procedure btnSaveFileClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure lbElementsClick(Sender: TObject);
procedure lbFormatsClick(Sender: TObject);
procedure btnOkClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure lbElementsMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure lbElementsDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure lbElementsDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
private
FFormatFileName : string;
FControlLink : TVpControlLink;
IsDirty : Boolean;
LastX, LastY: Integer;
DragItem : Integer;
protected
function DirtyPrompt: Integer;
procedure DoEditElement;
procedure DoEditFormat;
procedure DoNewElement;
procedure DoNewFile;
function DoNewFormat : Integer;
procedure DoSave;
procedure EnableElementButtons(Enable: Boolean);
procedure EnableFormatButtons(Enable: Boolean);
procedure EnableMoveButtons;
procedure SetFormatFileName (const v : string);
procedure UpdateFormats;
procedure UpdateCaption;
procedure UpdatePreview;
function GetControlLink: TVpControlLink;
procedure SetControlLink(const Value: TVpControlLink);
{ Private declarations }
public
property ControlLink : TVpControlLink
read FControlLink write SetControlLink;
function Execute : Boolean;
{ Public declarations }
published
property FormatFileName : string
read FFormatFileName write SetFormatFileName;
end;
var
frmPrnFormat: TfrmPrnFormat;
implementation
uses
VpEdFmt, VpEdElem;
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{TfrmPrnFormat}
procedure TfrmPrnFormat.FormCreate(Sender: TObject);
begin
OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName);
SaveDialog1.InitialDir := ExtractFilePath(Application.ExeName);
IsDirty := False;
FormatFileName := UnnamedFile;
EnableFormatButtons(False);
EnableElementButtons(False);
end;
{=====}
procedure TfrmPrnFormat.EnableMoveButtons;
begin
btnMoveElementUp.Enabled := lbElements.ItemIndex > 0;
btnMoveElementDn.Enabled :=
lbElements.ItemIndex < lbElements.Items.Count - 1;
end;
{=====}
procedure TfrmPrnFormat.FormShow(Sender: TObject);
begin
PrintPreview.Parent := Panel1;
if ControlLink.Printer.PrintFormats.Count > 0 then begin
UpdateFormats;
end
else begin
DoNewFile;
UpdateCaption;
end;
btnNewFormat.Enabled := True;
lbFormats.SetFocus;
end;
{=====}
procedure TfrmPrnFormat.btnDeleteElementClick(Sender: TObject);
var
Format : TVpPrintFormatItem;
Idx : Integer;
Item : string;
begin
Format := TVpPrintFormatItem(lbFormats.Items.Objects[lbFormats.ItemIndex]);
Item := '';
if lbElements.ItemIndex > -1 then
Item := lbElements.Items[lbElements.ItemIndex];
if Item <> '' then begin
for Idx := Pred(Format.Elements.Count) downto 0 do begin
if Format.Elements.Items[Idx].ElementName = Item then begin
Format.Elements.Items[Idx].Free;
lbElements.Items.Delete(lbElements.ItemIndex);
IsDirty := True;
UpdatePreview;
end;
end;
end;
end;
{=====}
procedure TfrmPrnFormat.btnDeleteFormatClick(Sender: TObject);
var
Prn : TVpPrinter;
Idx : Integer;
begin
Prn := ControlLink.Printer;
Idx := Prn.Find(lbFormats.Items[lbFormats.ItemIndex]);
if (Idx < 0) or (Idx >= Prn.PrintFormats.Count) then
ShowMessage ('Invalid print format: ' +
lbFormats.Items[lbFormats.ItemIndex]);
Prn.PrintFormats.Items[Idx].Free;
lbFormats.Items.Delete(lbFormats.ItemIndex);
IsDirty := True;
UpdatePreview;
end;
{=====}
procedure TfrmPrnFormat.btnEditElementClick(Sender: TObject);
begin
DoEditElement;
end;
{=====}
procedure TfrmPrnFormat.btnEditFormatClick(Sender: TObject);
begin
DoEditFormat;
end;
{=====}
procedure TfrmPrnFormat.btnLoadFileClick(Sender: TObject);
var
Prn : TVpPrinter;
Rslt : Integer;
begin
if IsDirty then begin
Rslt := DirtyPrompt;
{ case Rslt of
ID_YES: begin
DoSave;
end;
ID_NO: begin
// nothing
end;
ID_CANCEL: Exit;
end;}
end;
if OpenDialog1.Execute then begin
FormatFileName := OpenDialog1.FileName;
lbFormats.Items.Clear;
Prn := ControlLink.Printer;
Prn.LoadFromFile(FormatFileName, False);
UpdateFormats;
UpdateCaption;
end;
end;
{=====}
procedure TfrmPrnFormat.btnMoveElementDnClick(Sender: TObject);
var
E : TVpPrintFormatElementItem;
begin
if lbElements.ItemIndex > -1 then begin
E := TVpPrintFormatElementItem(lbElements.Items.Objects[lbElements.ItemIndex]);
E.Index := E.Index + 1;
lbElements.Items.Move(lbElements.ItemIndex, lbElements.ItemIndex + 1);
end;
end;
{=====}
procedure TfrmPrnFormat.btnMoveElementUpClick(Sender: TObject);
var
E : TVpPrintFormatElementItem;
begin
if lbElements.ItemIndex > -1 then begin
E := TVpPrintFormatElementItem(lbElements.Items.Objects[lbElements.ItemIndex]);
E.Index := E.Index - 1;
lbElements.Items.Move(lbElements.ItemIndex, lbElements.ItemIndex - 1);
end;
end;
{=====}
procedure TfrmPrnFormat.btnNewElementClick(Sender: TObject);
begin
DoNewElement;
end;
{=====}
procedure TfrmPrnFormat.btnNewFormatClick(Sender: TObject);
var
NewFormatIdx : Integer;
i : Integer;
begin
NewFormatIdx := DoNewFormat;
if (NewFormatIdx > 0) and
(Assigned (ControlLink)) and
(NewFormatIdx < ControlLink.Printer.PrintFormats.Count) then
for i := 0 to lbFormats.Items.Count - 1 do
if lbFormats.Items[i] = ControlLink.Printer.PrintFormats.
Items[NewFormatIdx].FormatName then begin
lbFormats.ItemIndex := i;
lbFormatsClick (Self);
Break;
end;
end;
{=====}
procedure TfrmPrnFormat.btnNewFileClick(Sender: TObject);
var
Rslt : Integer;
begin
if IsDirty then begin
Rslt := DirtyPrompt;
{ case Rslt of
ID_YES: begin
DoSave;
DoNewFile;
end;
ID_NO: begin
DoNewFile;
end;
ID_CANCEL: Exit;
end;}
end
else
DoNewFile;
end;
{=====}
procedure TfrmPrnFormat.btnOkClick(Sender: TObject);
begin
ModalResult := mrOk;
end;
{=====}
procedure TfrmPrnFormat.btnSaveFileClick(Sender: TObject);
begin
DoSave;
end;
{=====}
function TfrmPrnFormat.DirtyPrompt : Integer;
begin
Result := Application.MessageBox(
PChar('Save changes to ' + FormatFileName + '?'),
PChar('Inquiry'),
MB_YESNOCANCEL or MB_ICONQUESTION);
end;
{=====}
procedure TfrmPrnFormat.DoEditElement;
var
E : TVpPrintFormatElementItem;
frmEditElement: TfrmEditElement;
begin
if lbElements.ItemIndex > -1 then begin
Application.CreateForm(TfrmEditElement, frmEditElement);
E := TVpPrintFormatElementItem(lbElements.Items.Objects[lbElements.ItemIndex]);
if frmEditElement.Execute(E) then begin
IsDirty := True;
end;
frmEditElement.Free;
UpdatePreview;
end
else begin
DoNewElement;
end;
end;
{=====}
procedure TfrmPrnFormat.DoEditFormat;
var
AFormat : TVpPrintFormatItem;
frmEditFormat: TfrmEditFormat;
begin
if lbFormats.ItemIndex > -1 then begin
Application.CreateForm(TfrmEditFormat, frmEditFormat);
AFormat := TVpPrintFormatItem(lbFormats.Items.Objects[lbFormats.ItemIndex]);
if frmEditFormat.Execute(AFormat) then begin
IsDirty := True;
end;
frmEditFormat.Free;
UpdatePreview;
end
else begin
DoNewFormat;
end;
end;
{=====}
procedure TfrmPrnFormat.DoNewElement;
var
Format : TVpPrintFormatItem;
E : TVpPrintFormatElementItem;
Unique, Cancelled : Boolean;
frmEditElement: TfrmEditElement;
begin
Format := TVpPrintFormatItem(lbFormats.Items.Objects[lbFormats.ItemIndex]);
Unique := False;
Application.CreateForm(TfrmEditElement, frmEditElement);
repeat
E := TVpPrintFormatElementItem.Create(Format.Elements);
{ edit Element }
Cancelled := not frmEditElement.Execute(E);
if not Cancelled then begin
if lbElements.Items.IndexOf(E.ElementName) > -1 then begin
ShowMessage('An Element named ' + E.ElementName + ' already exists.' +
#13#10 + 'Please use another name.');
{ dump empty element }
Format.Elements.Items[E.Index].Free;
Unique := False;
end
else begin
lbElements.Items.AddObject(E.ElementName, E);
lbElements.ItemIndex := E.Index;
IsDirty := True;
Unique := True;
UpdatePreview;
end;
end else
{ dump empty element }
Format.Elements.Items[E.Index].Free;
{ until element name is Unique or operation Cancelled }
until Unique or Cancelled;
frmEditElement.Free;
end;
{=====}
procedure TfrmPrnFormat.DoNewFile;
var
Prn : TVpPrinter;
begin
Prn := ControlLink.Printer;
Prn.PrintFormats.Clear;
lbFormats.Clear;
lbElements.Clear;
FormatFileName := UnnamedFile;
IsDirty := False;
PrintPreview.ControlLink := nil;
EnableFormatButtons(False);
btnNewFormat.Enabled := True;
EnableElementButtons(False);
end;
{=====}
function TfrmPrnFormat.DoNewFormat : Integer;
var
AFormat : TVpPrintFormatItem;
Prn : TVpPrinter;
Unique, Cancelled : Boolean;
frmEditFormat: TfrmEditFormat;
begin
Result := -1;
Application.CreateForm(TfrmEditFormat, frmEditFormat);
Prn := ControlLink.Printer;
Unique := False;
repeat
AFormat := TVpPrintFormatItem.Create(Prn.PrintFormats);
{ edit format }
Cancelled := not frmEditFormat.Execute(AFormat);
if not Cancelled then begin
if lbFormats.Items.IndexOf(AFormat.FormatName) > -1 then begin
ShowMessage('A format named ' + AFormat.FormatName + ' already exists.' +
#13#10 + 'Please use another name.');
{ dump empty format }
Prn.PrintFormats.Items[AFormat.Index].Free;
Unique := False;
end
else begin
lbFormats.Items.AddObject(AFormat.FormatName, AFormat);
lbFormats.ItemIndex := AFormat.Index;
UpdatePreview;
IsDirty := True;
Unique := True;
end;
end else
{ dump empty format }
Prn.PrintFormats.Items[AFormat.Index].Free;
{ until format name is Unique or operation Cancelled }
until Unique or Cancelled;
if not Cancelled then
Result := AFormat.Index;
frmEditFormat.Free;
end;
{=====}
procedure TfrmPrnFormat.DoSave;
begin
if FormatFileName <> UnnamedFile then
SaveDialog1.FileName := FormatFileName
else
SaveDialog1.FileName := 'Unnamed.xml';
if SaveDialog1.Execute then begin
FormatFileName := SaveDialog1.FileName;
ControlLink.Printer.SaveToFile(FormatFileName);
IsDirty := False;
UpdateCaption;
end;
end;
{=====}
procedure TfrmPrnFormat.EnableElementButtons(Enable : Boolean);
begin
btnNewElement.Enabled := Enable;
btnEditElement.Enabled := Enable;
btnDeleteElement.Enabled := Enable;
// btnMoveElementUp.Enabled := Enable;
// btnMoveElementDn.Enabled := Enable;
EnableMoveButtons;
end;
{=====}
procedure TfrmPrnFormat.EnableFormatButtons(Enable : Boolean);
begin
btnNewFormat.Enabled := Enable;
btnEditFormat.Enabled := Enable;
btnDeleteFormat.Enabled := Enable;
end;
{=====}
function TfrmPrnFormat.Execute : Boolean;
begin
if not Assigned (ControlLink) then
raise EVpPrintFormatEditorError.Create (RSNoControlLink);
Result := ShowModal = mrOk;
end;
{=====}
procedure TfrmPrnFormat.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
Rslt : Integer;
begin
if IsDirty then begin
Rslt := DirtyPrompt;
{ case Rslt of
ID_YES: begin
DoSave;
CanClose := True;
end;
ID_NO: begin
CanClose := True;
end;
ID_CANCEL: begin
CanClose := False;
Exit;
end;
end; }
end
else
CanClose := True;
end;
{=====}
function TfrmPrnFormat.GetControlLink: TVpControlLink;
begin
Result := FControlLink;
end;
{=====}
procedure TfrmPrnFormat.lbFormatsClick(Sender: TObject);
var
E : TVpPrintFormatElementItem;
Prn : TVpPrinter;
i, Idx : Integer;
begin
lbElements.Items.Clear;
Prn := ControlLink.Printer;
Idx := Prn.Find(lbFormats.Items[lbFormats.ItemIndex]);
Prn.CurFormat := Idx;
PrintPreview.ControlLink := ControlLink;
for i := 0 to Pred(Prn.PrintFormats.Items[Idx].Elements.Count) do begin
E := Prn.PrintFormats.Items[Idx].Elements.Items[i];
lbElements.Items.AddObject(E.ElementName, E);
end;
UpdatePreview;
EnableElementButtons(False);
btnNewElement.Enabled := True;
EnableFormatButtons(True);
EnableMoveButtons;
end;
{=====}
procedure TfrmPrnFormat.lbElementsClick(Sender: TObject);
begin
EnableElementButtons(True);
end;
{=====}
procedure TfrmPrnFormat.lbElementsMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
LastX:=X;
LastY:=Y;
DragItem := (Sender as TListBox).ItemAtPos(Point(LastX, LastY),True);
end;
{=====}
procedure TfrmPrnFormat.lbElementsDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
lb : TListBox;
Dest: Integer;
E : TVpPrintFormatElementItem;
begin
lb := Source as TListBox;
Dest:=lb.ItemAtPos(Point(X, Y),True);
lb.Items.Move(DragItem, Dest);
E := TVpPrintFormatElementItem(lbElements.Items.Objects[Dest]);
E.Index := Dest;
lb.ItemIndex := Dest;
EnableMoveButtons;
end;
{=====}
procedure TfrmPrnFormat.lbElementsDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
lb : TListBox;
begin
lb := (Source as TListBox);
lb.Canvas.DrawFocusRect(lb.ItemRect(lb.ItemAtPos(Point(LastX, LastY), True)));
lb.Canvas.DrawFocusRect(lb.ItemRect(lb.ItemAtPos(Point(X, Y), True)));
LastX := X;
LastY := Y;
Accept:=True;
end;
{=====}
procedure TfrmPrnFormat.SetControlLink(const Value: TVpControlLink);
begin
if FControlLink <> Value then begin
FControlLink := Value;
if Assigned (FControlLink) then
FFormatFileName := FControlLink.Printer.DefaultXMLFileName;
end;
end;
{=====}
procedure TfrmPrnFormat.SetFormatFileName (const v : string);
begin
if v <> FFormatFileName then begin
FFormatFileName := v;
if Assigned (FControlLink) then
FControlLink.Printer.DefaultXMLFileName := v;
end;
end;
{=====}
procedure TfrmPrnFormat.UpdateCaption;
begin
Caption := Format(FileCaption, [FormatFileName]);
end;
{=====}
procedure TfrmPrnFormat.UpdateFormats;
var
i : Integer;
Prn : TVpPrinter;
begin
Prn := ControlLink.Printer;
for i := 0 to Pred(Prn.PrintFormats.Count) do
lbFormats.Items.AddObject(Prn.PrintFormats.Items[i].FormatName, Prn.PrintFormats.Items[i]);
EnableMoveButtons;
end;
{=====}
procedure TfrmPrnFormat.UpdatePreview;
var
Prn : TVpPrinter;
Idx : Integer;
begin
Prn := ControlLink.Printer;
if lbFormats.ItemIndex > -1 then begin
Idx := Prn.Find (lbFormats.Items[lbFormats.ItemIndex]);
if Idx > - 1 then
Prn.CurFormat := Idx;
{Prn.CurFormat := lbFormats.ItemIndex; }
end;
Prn.NotifyLinked;
EnableMoveButtons;
end;
{=====}
end.

223
components/tvplanit/source/vpedpop.pas Normal file
View File

@ -0,0 +1,223 @@
{*********************************************************}
{* VPEDPOP.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 VpEdPop;
{-base popup edit field class}
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
Messages, StdCtrls, SysUtils, VpBase, VpConst;
type
TVpEdButton = class(TBitBtn)
public
procedure Click;
override;
end;
TVpEdPopup = class(TCustomEdit)
protected {private}
{property variables}
FButton : TVpEdButton;
FPopupActive : Boolean;
FShowButton : Boolean;
function GetVersion : string;
procedure SetShowButton(Value : Boolean);
procedure SetVersion(const Value : string);
{internal methods}
function GetButtonWidth : Integer;
protected
procedure CreateParams(var Params : TCreateParams); override;
procedure CreateWnd; override;
function GetButtonEnabled : Boolean; dynamic;
procedure PopupClose(Sender : TObject); dynamic;
property ShowButton : Boolean
read FShowButton write SetShowButton default True;
property Version : string read GetVersion write SetVersion stored False;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
override;
procedure PopupOpen; dynamic;
property PopupActive : Boolean read FPopupActive;
end;
implementation
{*** TVpEditBtn ***}
procedure TVpEdButton.Click;
begin
TVpEdPopup(Parent).PopupOpen;
end;
{*** TVpEdPopup ***}
constructor TVpEdPopup.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csSetCaption];
FShowButton := True;
FButton := TVpEdButton.Create(Self);
FButton.Visible := True;
FButton.Parent := Self;
FButton.Caption := '';
FButton.TabStop := False;
{$IFNDEF LCL}
FButton.Style := bsNew;
{$ENDIF}
end;
procedure TVpEdPopup.CreateParams(var Params : TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or WS_CLIPCHILDREN;
end;
procedure TVpEdPopup.CreateWnd;
begin
inherited CreateWnd;
{force button placement}
SetBounds(Left, Top, Width, Height);
FButton.Enabled := GetButtonEnabled;
end;
destructor TVpEdPopup.Destroy;
begin
FButton.Free;
FButton := nil;
inherited Destroy;
end;
function TVpEdPopup.GetButtonEnabled : Boolean;
begin
Result := not ReadOnly;
end;
function TVpEdPopup.GetButtonWidth : Integer;
begin
if Assigned(FButton) and FShowButton then
Result := FButton.Width
else
Result := 0;
end;
function TVpEdPopup.GetVersion : string;
begin
Result := VpVersionStr;
end;
procedure TVpEdPopup.PopupClose;
begin
FPopupActive := False;
end;
procedure TVpEdPopup.PopupOpen;
begin
FPopupActive := True;
end;
procedure TVpEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
var
H : Integer;
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if not HandleAllocated then
Exit;
if not FShowButton then begin
FButton.Height := 0;
FButton.Width := 0;
Exit;
end;
H := ClientHeight;
if BorderStyle = bsNone then begin
FButton.Height := H;
FButton.Width := (FButton.Height div 4) * 3;
if Assigned(Fbutton.Glyph) then
if FButton.Width < FButton.Glyph.Width + 6 then
FButton.Width := FButton.Glyph.Width + 6;
FButton.Left := Width - FButton.Width;
FButton.Top := 0;
end else if Ctl3D then begin
FButton.Height := H;
FButton.Width := (FButton.Height div 4) * 3;
if Assigned(FButton.Glyph) then
if FButton.Width < FButton.Glyph.Width + 6 then
FButton.Width := FButton.Glyph.Width + 6;
FButton.Left := Width - FButton.Width - 4;
FButton.Top := 0;
end else begin
FButton.Height := H - 2;
FButton.Width := (FButton.Height div 4) * 3;
if Assigned(Fbutton.Glyph) then
if FButton.Width < FButton.Glyph.Width + 6 then
FButton.Width := FButton.Glyph.Width + 6;
FButton.Left := Width - FButton.Width - 1;
FButton.Top := 1;
end;
end;
procedure TVpEdPopup.SetShowButton(Value : Boolean);
begin
if Value <> FShowButton then begin
FShowButton := Value;
{force resize and redisplay of button}
SetBounds(Left, Top, Width, Height);
end;
end;
procedure TVpEdPopup.SetVersion(const Value : string);
begin
// Leave empty
end;
{=====}
end.

167
components/tvplanit/source/vpedshape.lfm Normal file
View File

@ -0,0 +1,167 @@
object frmEditShape: TfrmEditShape
Left = 455
Height = 314
Top = 209
Width = 363
HorzScrollBar.Page = 362
VertScrollBar.Page = 313
BorderStyle = bsDialog
Caption = 'Edit Shape'
ClientHeight = 314
ClientWidth = 363
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
Position = poScreenCenter
object rgShapeType: TRadioGroup
Left = 8
Height = 84
Top = 8
Width = 345
AutoFill = True
Caption = ' Shape '
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3
ClientHeight = 66
ClientWidth = 341
Columns = 3
ItemIndex = 0
Items.Strings = (
'Rectangle'
'TopLine'
'BottomLine'
'LeftLine'
'RightLine'
'TLToBRLine'
'BLToTRLine'
'Ellipse'
)
TabOrder = 0
end
object btnOk: TButton
Left = 192
Height = 25
Top = 280
Width = 75
Caption = 'OK'
Default = True
OnClick = btnOkClick
TabOrder = 3
end
object btnCancel: TButton
Left = 272
Height = 25
Top = 280
Width = 75
Cancel = True
Caption = 'Cancel'
OnClick = btnCancelClick
TabOrder = 4
end
object gbBrush: TGroupBox
Left = 188
Height = 165
Top = 92
Width = 165
Caption = ' Brush '
ClientHeight = 147
ClientWidth = 161
TabOrder = 2
object Label1: TLabel
Left = 6
Height = 14
Top = 112
Width = 29
Caption = 'Style:'
ParentColor = False
end
object cbBrushStyle: TComboBox
Left = 42
Height = 22
Top = 108
Width = 97
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 16
OnDrawItem = cbBrushStyleDrawItem
Style = csOwnerDrawFixed
TabOrder = 0
end
end
object gbPen: TGroupBox
Left = 8
Height = 205
Top = 100
Width = 165
Caption = ' Pen '
ClientHeight = 187
ClientWidth = 161
TabOrder = 1
object Label2: TLabel
Left = 8
Height = 14
Top = 104
Width = 29
Caption = 'Style:'
ParentColor = False
end
object Label3: TLabel
Left = 8
Height = 14
Top = 132
Width = 33
Caption = 'Width:'
ParentColor = False
end
object Label4: TLabel
Left = 8
Height = 14
Top = 160
Width = 31
Caption = 'Mode:'
ParentColor = False
end
object cbPenStyle: TComboBox
Left = 44
Height = 19
Top = 100
Width = 105
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
OnDrawItem = cbPenStyleDrawItem
Style = csOwnerDrawFixed
TabOrder = 0
end
object cbPenMode: TComboBox
Left = 44
Height = 21
Top = 156
Width = 105
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
TabOrder = 1
end
object udPenWidth: TUpDown
Left = 98
Height = 21
Top = 128
Width = 11
Associate = edPenWidth
TabOrder = 3
end
object edPenWidth: TEdit
Left = 44
Height = 21
Top = 128
Width = 54
OnKeyDown = nil
TabOrder = 2
Text = '0'
end
end
end

278
components/tvplanit/source/vpedshape.pas Normal file
View File

@ -0,0 +1,278 @@
{*********************************************************}
{* VPEDSHAPE.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 VpEdShape;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,Messages,ColorGrd,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, TypInfo, ComCtrls,
VpPrtFmt;
type
TfrmEditShape = class(TForm)
btnCancel: TButton;
btnOk: TButton;
cbBrushStyle: TComboBox;
cbPenMode: TComboBox;
cbPenStyle: TComboBox;
gbBrush: TGroupBox;
gbPen: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
rgShapeType: TRadioGroup;
udPenWidth: TUpDown;
edPenWidth: TEdit;
procedure btnOkClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure cbBrushStyleDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure FormCreate(Sender: TObject);
procedure cbPenStyleDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
procedure FillBrushStyleList;
procedure FillPenStyleList;
procedure FillPenModeList;
protected
procedure SaveData(AShape: TVpPrintShape);
procedure SetData(AShape: TVpPrintShape);
{ Private declarations }
public
function Execute(AShape : TVpPrintShape) : Boolean;
{ Public declarations }
end;
implementation
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{ TfrmEditShape }
procedure TfrmEditShape.FormCreate(Sender: TObject);
begin
FillBrushStyleList;
FillPenStyleList;
FillPenModeList;
end;
{=====}
function TfrmEditShape.Execute(AShape: TVpPrintShape): Boolean;
begin
SetData(AShape);
Result := ShowModal = mrOk;
if Result then
SaveData(AShape);
end;
{=====}
procedure TfrmEditShape.btnOkClick(Sender: TObject);
begin
ModalResult := mrOk;
end;
{=====}
procedure TfrmEditShape.btnCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
end;
{=====}
procedure TfrmEditShape.FillBrushStyleList;
var
Style : TBrushStyle;
StyleName : string;
begin
for Style := Low(TBrushStyle) to High(TBrushStyle) do begin
StyleName := GetEnumName(TypeInfo(TBrushStyle), Ord(Style));
cbBrushStyle.Items.Add(StyleName);
end;
end;
{=====}
procedure TfrmEditShape.FillPenModeList;
var
Mode : TPenMode;
ModeName : string;
begin
for Mode := Low(TPenMode) to High(TPenMode) do begin
ModeName := GetEnumName(TypeInfo(TPenMode), Ord(Mode));
cbPenMode.Items.Add(ModeName);
end;
end;
{=====}
procedure TfrmEditShape.FillPenStyleList;
var
Style : TPenStyle;
StyleName : string;
begin
for Style := Low(TPenStyle) to High(TPenStyle) do begin
StyleName := GetEnumName(TypeInfo(TPenStyle), Ord(Style));
cbPenStyle.Items.Add(StyleName);
end;
end;
{=====}
procedure TfrmEditShape.SaveData(AShape: TVpPrintShape);
begin
AShape.Shape := TVpShapeType(rgShapeType.ItemIndex);
AShape.Pen.Width := udPenWidth.Position;
end;
{=====}
procedure TfrmEditShape.SetData(AShape: TVpPrintShape);
var
StyleStr : string;
begin
rgShapeType.ItemIndex := Ord(AShape.Shape);
{ pen settings }
udPenWidth.Position := AShape.Pen.Width;
// cgPenColor.ForegroundIndex := cgPenColor.ColorToIndex(AShape.Pen.Color);
StyleStr := GetEnumName(TypeInfo(TPenStyle), Ord(AShape.Pen.Style));
cbPenStyle.ItemIndex := cbPenStyle.Items.IndexOf(StyleStr);
StyleStr := GetEnumName(TypeInfo(TPenMode), Ord(AShape.Pen.Mode));
cbPenMode.ItemIndex := cbPenMode.Items.IndexOf(StyleStr);
{ brush settings }
// cgBrushColor.ForegroundIndex := cgBrushColor.ColorToIndex(AShape.Brush.Color);
StyleStr := GetEnumName(TypeInfo(TBrushStyle), Ord(AShape.Brush.Style));
cbBrushStyle.ItemIndex := cbBrushStyle.Items.IndexOf(StyleStr);
end;
{=====}
procedure TfrmEditShape.cbBrushStyleDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
SavePenColor, SaveBrushColor: TColor;
Rgt: Integer;
SaveBrushStyle: TBrushStyle;
Item : string;
TxtRect : TRect;
begin
Item := cbBrushStyle.Items[Index];
Rgt := (Rect.Bottom - Rect.Top) + Rect.Left;
with cbBrushStyle.Canvas do
try
{ keep old settings }
SavePenColor := Pen.Color;
SaveBrushColor := Brush.Color;
SaveBrushStyle := Brush.Style;
{ draw frame }
Pen.Color := Brush.Color;
Brush.Color := cbBrushStyle.Brush.Color;
Rectangle(Rect.Left, Rect.Top, Rgt, Rect.Bottom);
{ set up for drawing sample }
Brush.Style := TBrushStyle(GetEnumValue(TypeInfo(TBrushStyle), Item));
Pen.Color := cbBrushStyle.Font.Color;
{ special handling for bsClear }
if Brush.Style = bsClear then
begin
Brush.Color := cbBrushStyle.Brush.Color;
Brush.Style := bsSolid;
end
else
Brush.Color := cbBrushStyle.Font.Color;
{ Draw sample }
Rectangle(Rect.Left + 1, Rect.Top + 1, Rgt - 1, Rect.Bottom - 1);
{ restore settings }
Brush.Color := SaveBrushColor;
Brush.Style := SaveBrushStyle;
Pen.Color := SavePenColor;
finally
{ draw the item text }
TxtRect := Classes.Rect(Rgt, Rect.Top, Rect.Right, Rect.Bottom);
TextRect(TxtRect, TxtRect.Left + 1, TxtRect.Top + 1, Item);
end;
end;
{=====}
procedure TfrmEditShape.cbPenStyleDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
SavePenColor, SaveBrushColor: TColor;
Rgt, Top: Integer;
SavePenStyle: TPenStyle;
Item: string;
TxtRect : TRect;
begin
Item := cbPenStyle.Items[Index];
Rgt := (Rect.Bottom - Rect.Top) * 2 + Rect.Left;
Top := (Rect.Bottom - Rect.Top) div 2 + Rect.Top;
with cbPenStyle.Canvas do
try
{ keep old settings }
SavePenColor := Pen.Color;
SaveBrushColor := Brush.Color;
SavePenStyle := Pen.Style;
{ draw frame }
Pen.Color := Brush.Color;
Rectangle(Rect.Left, Rect.Top, Rgt, Rect.Bottom);
{ set up for drawing sample }
Brush.Color := cbPenStyle.Brush.Color;
Pen.Color := cbPenStyle.Font.Color;
Rectangle(Rect.Left + 1, Rect.Top + 1, Rgt - 1, Rect.Bottom - 1);
{ Draw sample }
Pen.Style := TPenStyle(GetEnumValue(TypeInfo(TPenStyle), Item));
Pen.Color := cbPenStyle.Font.Color;
{ Sample Line }
MoveTo(Rect.Left + 1, Top);
LineTo(Rgt - 1, Top);
MoveTo(Rect.Left + 1, Top + 1);
LineTo(Rgt - 1, Top + 1);
{ restore settings }
Brush.Color := SaveBrushColor;
Pen.Style := SavePenStyle;
Pen.Color := SavePenColor;
finally
{ draw the item text }
TxtRect := Classes.Rect(Rgt, Rect.Top, Rect.Right, Rect.Bottom);
TextRect(TxtRect, TxtRect.Left + 1, TxtRect.Top + 1, Item);
end;
end;
{=====}
end.

2022
components/tvplanit/source/vpeventrpt.pas Normal file
View File

File diff suppressed because it is too large Load Diff

478
components/tvplanit/source/vpevnteditdlg.lfm Normal file
View File

@ -0,0 +1,478 @@
object DlgEventEdit: TDlgEventEdit
Left = 224
Height = 385
Top = 188
Width = 697
HorzScrollBar.Page = 696
VertScrollBar.Page = 384
BorderStyle = bsToolWindow
Caption = 'Add / Edit Events'
ClientHeight = 385
ClientWidth = 697
Constraints.MinHeight = 378
Constraints.MinWidth = 594
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
object Panel1: TPanel
Height = 41
Top = 344
Width = 697
Align = alBottom
BevelOuter = bvNone
ClientHeight = 41
ClientWidth = 697
TabOrder = 0
object ResourceNameLbl: TLabel
Left = 8
Height = 16
Top = 12
Width = 385
AutoSize = False
Caption = 'Resource Name'
Font.CharSet = ANSI_CHARSET
Font.Color = clMaroon
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentColor = False
end
object OKBtn: TButton
Left = 518
Height = 25
Top = 8
Width = 85
Anchors = [akTop, akRight]
Caption = '&OK'
Default = True
OnClick = OKBtnClick
TabOrder = 0
TabStop = False
end
object CancelBtn: TButton
Left = 606
Height = 25
Top = 8
Width = 85
Anchors = [akTop, akRight]
Cancel = True
Caption = '&Cancel'
OnClick = CancelBtnClick
TabOrder = 1
TabStop = False
end
end
object pgEvent: TPageControl
Height = 344
Width = 697
TabStop = False
ActivePage = tabEvent
Align = alClient
TabIndex = 0
TabOrder = 1
object tabEvent: TTabSheet
Caption = 'Event'
ClientHeight = 318
ClientWidth = 689
object AppointmentGroupBox: TGroupBox
Height = 209
Top = 5
Width = 679
Anchors = [akTop, akLeft, akRight]
Caption = 'Appointment'
ClientHeight = 191
ClientWidth = 675
TabOrder = 0
object DescriptionLbl: TLabel
Left = 5
Height = 13
Top = 25
Width = 77
AutoSize = False
Caption = 'Description:'
ParentColor = False
end
object Bevel1: TBevel
Left = 8
Height = 2
Top = 70
Width = 659
Anchors = [akTop, akLeft, akRight]
end
object Bevel2: TBevel
Left = 8
Height = 2
Top = 160
Width = 659
Anchors = [akTop, akLeft, akRight]
end
object CategoryLbl: TLabel
Left = 5
Height = 13
Top = 49
Width = 77
AutoSize = False
Caption = 'Category:'
ParentColor = False
end
object StartTimeLbl: TLabel
Left = 47
Height = 13
Top = 106
Width = 59
Alignment = taRightJustify
AutoSize = False
Caption = 'StartTime:'
ParentColor = False
end
object EndTimeLbl: TLabel
Left = 48
Height = 13
Top = 130
Width = 57
Alignment = taRightJustify
AutoSize = False
Caption = 'EndTime:'
ParentColor = False
end
object Image2: TImage
Left = 352
Height = 18
Top = 82
Width = 18
Picture.Data = {
07544269746D6170F6000000424DF60000000000000076000000280000001000
0000100000000100040000000000800000000000000000000000100000001000
0000000000000000800000800000008080008000000080008000808000008080
8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
FF00888888888888888888888222228888888882222222228888282228888822
2888222288888882228822288888888822882222888888888228222228888888
8228888888888888888888888888888888882288888888222228822888888882
2228822288888888222888222888882222288882222222228828888882222288
8888
}
end
object RecurringLbl: TLabel
Left = 379
Height = 13
Top = 87
Width = 187
AutoSize = False
Caption = 'Appointment Recurrence:'
ParentColor = False
end
object Bevel3: TBevel
Left = 339
Height = 76
Top = 78
Width = 2
end
object IntervalLbl: TLabel
Left = 589
Height = 13
Top = 87
Width = 92
AutoSize = False
Caption = 'Interval (days):'
ParentColor = False
end
object Image1: TImage
Left = 11
Height = 25
Top = 166
Width = 23
Picture.Data = {
07544269746D61707E010000424D7E0100000000000076000000280000001600
0000160000000100040000000000080100000000000000000000100000001000
0000000000000000800000800000008080008000000080008000808000008080
8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
FF00878888888888888888887800887888888888888888878800888788888877
8888887888008888888880000888888888008888880008888000888888008888
708FF8F8F8880088880088887FFFFF8878787088880088888787F88887770888
880088888878FF8878708888880088888877F88887708888880087778878FF88
78708877780088888877F88887708888880088888878FF887870888888008888
8877F888877088888800888888878F887808888888008888888878F880888888
8800888887888788088878888800888878888877888887888800888788888870
8888887888008878888888888888888788008888888888888888888888007888
88888888888888888700
}
end
object SpeedButton1: TSpeedButton
Left = 325
Height = 22
Top = 167
Width = 23
Color = clBtnFace
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00888888888888
8888888888000888888888888080808888088888080880888088888080888808
0888880880888808888800888008880888880888808088080000088880808808
8888008880088808888888088088880808888880808888088088888808088088
8808888880808088888888888800088888888888888888888888
}
NumGlyphs = 0
OnClick = SpeedButton1Click
end
object imgClock: TImage
Left = 8
Height = 34
Top = 80
Width = 34
AutoSize = True
Picture.Data = {
07544269746D6170060E0000424D060E00000000000036000000280000002200
0000220000000100180000000000D00D00000000000000000000000000000000
0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0
D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8
D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8
D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0
D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0
D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D400000000000000
0000000000000000000000000000000000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4
C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000000000000000
00C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C000000000000000
0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4000000000000
C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0
C0C0C0C0C0C0C0C0C0C0000000000000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8
D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D400
0000C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0808080808080808080808080808080
808080808080808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0000000C8D0D4C8D0
D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0
D4C8D0D4808080C0C0C0C0C0C0C0C0C0C0C0C080808080808080808080808080
8080808080808080808080808080808080808080808080C0C0C0FFFFFFC0C0C0
C0C0C0000000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4
C8D0D4C8D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0C0C0C08080800000000000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080808080
8080808080FFFFFFC0C0C0C0C0C0000000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
0000C8D0D4C8D0D4C8D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0808080808080
000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFF808080808080808080FFFFFFC0C0C0C0C0C0000000C8D0D4C8
D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4808080C0C0C0C0C0C0C0C0C080
8080808080000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0000000
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080808080C0C0C0C0C0
C0C0C0C0000000C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4808080C0C0
C0C0C0C0808080808080000000FFFFFFFFFFFF000000000000FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFF808080
808080808080C0C0C0C0C0C0000000C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4
808080C0C0C0C0C0C0808080808080000000FFFFFFFFFFFFFFFFFFC0C0C00000
00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0000000FF
FFFFFFFFFFFFFFFF808080808080808080C0C0C0C0C0C0000000C8D0D4C8D0D4
0000C8D0D4C8D0D4808080C0C0C0C0C0C0808080000000FFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080C0C0C0C0C0C000
0000C8D0D4C8D0D40000C8D0D4C8D0D4808080C0C0C0808080808080000000FF
FFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFF8080808080
80808080C0C0C0000000C8D0D4C8D0D40000C8D0D4808080C0C0C0C0C0C08080
80000000FFFFFFFFFFFFC0C0C0000000FFFFFFFFFFFFFFFFFFFFFFFF000000FF
FFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0000000FFFFFF
FFFFFFFFFFFF808080808080C0C0C0C0C0C0000000C8D0D40000C8D0D4808080
C0C0C0C0C0C0808080000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFF000000FFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080C0C0C0C0C0C0000000C8D0D4
0000C8D0D4808080C0C0C0C0C0C0808080000000FFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080C0C0C0C0
C0C0000000C8D0D40000C8D0D4808080C0C0C0C0C0C0808080000000FFFFFF00
0000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000000000
000000000000000000000000000000FFFFFFFFFFFF000000000000FFFFFF8080
80808080C0C0C0C0C0C0000000C8D0D40000C8D0D4808080C0C0C0C0C0C08080
80000000FFFFFFC0C0C0000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0
000000FFFFFF808080808080C0C0C0C0C0C0000000C8D0D40000C8D0D4808080
C0C0C0C0C0C0808080000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFF000000FFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080C0C0C0C0C0C0000000C8D0D4
0000C8D0D4808080C0C0C0C0C0C0808080000000FFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080C0C0C0C0
C0C0000000C8D0D40000C8D0D4808080C0C0C0C0C0C0808080000000FFFFFFFF
FFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFFFFFF8080
80808080C0C0C0C0C0C0000000C8D0D40000C8D0D4C8D0D4808080C0C0C08080
80808080000000FFFFFFC0C0C0000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC0C0C0000000FFFFFF
FFFFFF808080808080808080C0C0C0000000C8D0D4C8D0D40000C8D0D4C8D0D4
808080C0C0C0C0C0C0808080000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFF808080808080C0C0C0C0C0C0000000C8D0D4C8D0D4
0000C8D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0808080000000FFFFFFFFFFFF
FFFFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FF000000000000FFFFFFFFFFFFFFFFFF808080808080C0C0C0C0C0C0C0C0C000
0000C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4808080C0C0C0C0C0C080808080
8080000000FFFFFFFFFFFFC0C0C0000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFC0C0C0000000FFFFFFFFFFFF808080808080808080C0C0
C0C0C0C0000000C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4808080C0C0
C0C0C0C0FFFFFF808080808080000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080
808080C0C0C0C0C0C0C0C0C0000000C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4
C8D0D4C8D0D4808080C0C0C0C0C0C0FFFFFF808080808080000000FFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFC0C0C0000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80
8080808080808080C0C0C0C0C0C0C0C0C0000000C8D0D4C8D0D4C8D0D4C8D0D4
0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4808080C0C0C0C0C0C0FFFFFF808080
808080000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FF808080808080808080808080C0C0C0C0C0C0C0C0C0808080C8D0D4C8D0D4C8
D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4808080C0
C0C0C0C0C0FFFFFFC0C0C0808080808080000000000000000000000000000000
000000000000000000808080808080C0C0C0C0C0C0C0C0C0C0C0C0808080C8D0
D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0
D4C8D0D4C8D0D4808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C080808080808080
8080808080808080808080808080808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0
808080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000C8D0D4C8D0D4
C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4808080808080C0C0C0C0C0C0C0C0
C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0
C0C0808080808080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4
808080808080808080C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0C0
C0808080808080808080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8
D0D4C8D0D4C8D0D40000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8
D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4808080808080808080808080808080
808080808080808080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0
D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000
}
end
object RecurrenceEndsLbl: TLabel
Left = 352
Height = 13
Top = 131
Width = 92
Alignment = taRightJustify
AutoSize = False
Caption = 'Until:'
ParentColor = False
end
object DescriptionEdit: TEdit
Left = 86
Height = 21
Top = 21
Width = 580
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
Text = 'DescriptionEdit'
end
object AlarmSet: TCheckBox
Left = 40
Height = 19
Top = 170
Width = 74
Caption = '&Reminder:'
OnClick = AlarmSetClick
TabOrder = 3
end
object StartTime: TComboBox
Left = 231
Height = 21
Top = 103
Width = 93
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
OnChange = StartTimeChange
OnExit = StartTimeExit
TabOrder = 4
end
object EndTime: TComboBox
Left = 231
Height = 21
Top = 127
Width = 93
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
OnChange = EndTimeChange
OnExit = EndTimeExit
TabOrder = 5
end
object Category: TComboBox
Left = 86
Height = 19
Top = 46
Width = 182
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
OnDrawItem = CategoryDrawItem
Style = csOwnerDrawFixed
TabOrder = 1
end
object RecurringType: TComboBox
Left = 379
Height = 21
Top = 103
Width = 183
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
OnChange = RecurringTypeChange
Style = csDropDownList
TabOrder = 6
end
object IntervalUpDown: TUpDown
Left = 654
Height = 23
Top = 102
Width = 19
Max = 32767
TabOrder = 9
OnClick = IntervalUpDownClick
end
object AlarmAdvType: TComboBox
Left = 230
Height = 21
Top = 168
Width = 88
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
Style = csDropDownList
TabOrder = 8
end
object AdvanceUpDown: TUpDown
Left = 196
Height = 23
Top = 167
Width = 19
Min = 1
Max = 120
Position = 1
TabOrder = 10
OnClick = AdvanceUpDownClick
end
object CBAllDay: TCheckBox
Left = 109
Height = 19
Top = 85
Width = 90
Caption = 'All Day Event'
OnClick = CBAllDayClick
TabOrder = 2
end
object edtUnusedPlaceholder: TEdit
Left = 587
Height = 21
Top = 103
Width = 65
TabOrder = 7
Text = 'Placeholder control'
Visible = False
end
end
object NotesMemo: TMemo
Height = 86
Top = 226
Width = 679
Anchors = [akTop, akLeft, akRight, akBottom]
ScrollBars = ssVertical
TabOrder = 1
end
end
end
object FileDialog: TOpenDialog
left = 356
top = 199
end
end

734
components/tvplanit/source/vpevnteditdlg.pas Normal file
View File

@ -0,0 +1,734 @@
{*********************************************************}
{* VPEVNTEDITDLG.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 VpEvntEditDlg;
{ The default event edit dialog }
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows, Messages, Mask,
{$ENDIF}
SysUtils, {$IFDEF VERSION6}Variants,{$ENDIF} Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, VpData, VpEdPop,
VpDateEdit, ComCtrls, VpBase, VpClock, VpBaseDS, VpDlg, VpConst,
Buttons;
type
{ forward declarations }
TVpEventEditDialog = class;
TEventEditDlgRtnType = (rtCommit, rtAbandon);
TVpRightAlignedEdit = class(TEdit)
public
procedure CreateParams(var Params : TCreateParams); override;
end;
TDlgEventEdit = class(TForm)
Panel1: TPanel;
OKBtn: TButton;
CancelBtn: TButton;
ResourceNameLbl: TLabel;
FileDialog: TOpenDialog;
pgEvent: TPageControl;
tabEvent: TTabSheet;
AppointmentGroupBox: TGroupBox;
DescriptionLbl: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
CategoryLbl: TLabel;
StartTimeLbl: TLabel;
EndTimeLbl: TLabel;
Image2: TImage;
RecurringLbl: TLabel;
Bevel3: TBevel;
IntervalLbl: TLabel;
Image1: TImage;
SpeedButton1: TSpeedButton;
DescriptionEdit: TEdit;
AlarmSet: TCheckBox;
StartTime: TComboBox;
EndTime: TComboBox;
Category: TComboBox;
RecurringType: TComboBox;
IntervalUpDown: TUpDown;
AlarmAdvType: TComboBox;
AdvanceUpDown: TUpDown;
AlarmAdvance: {$IFDEF LCL}TEdit{$ELSE}TMaskEdit{$ENDIF};
CBAllDay: TCheckBox;
StartDate: TVpDateEdit;
EndDate: TVpDateEdit;
NotesMemo: TMemo;
edtUnusedPlaceholder: TEdit;
imgClock: TImage;
RepeatUntil: TVpDateEdit;
RecurrenceEndsLbl: TLabel;
procedure OKBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StartDateChange(Sender: TObject);
procedure StartTimeChange(Sender: TObject);
procedure EndTimeChange(Sender: TObject);
procedure AlarmAdvanceChange(Sender: TObject);
procedure AdvanceUpDownClick(Sender: TObject; Button: TUDBtnType);
procedure CustomIntervalChange(Sender: TObject);
procedure IntervalUpDownClick(Sender: TObject; Button: TUDBtnType);
procedure RecurringTypeChange(Sender: TObject);
procedure AlarmSetClick(Sender: TObject);
procedure EndDateChange(Sender: TObject);
procedure CategoryDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure CBAllDayClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure StartTimeExit(Sender: TObject);
procedure EndTimeExit(Sender: TObject);
private { Private declarations }
AAVerifying: Boolean;
CIVerifying: Boolean;
FCustomInterval : TVpRightAlignedEdit;
procedure PopLists;
procedure LoadCaptions;
public { Public declarations }
Event: TVpEvent;
CatColorMap: TVpCategoryColorMap;
Resource: TVpResource;
ReturnCode: TEventEditDlgRtnType;
Conflicts : Integer;
TimeFormat: TVpTimeFormat;
AlarmWavPath: string;
FLastEndTime : TDateTime;
procedure PopulateDialog;
procedure DePopulateDialog;
end;
TVpEventEditDialog = class(TVpBaseDialog)
protected {private}
ceEditDlg : TDlgEventEdit;
FTimeFormat : TVpTimeFormat;
ceEvent : TVpEvent;
public
constructor Create(AOwner : TComponent); override;
function Execute(Event: TVpEvent;
TimeFormat: TVpTimeFormat = tf12Hour): Boolean; reintroduce;
function AddNewEvent(StartTime, EndTime: TDateTime): Boolean;
published
{properties}
property TimeFormat: TVpTimeFormat
read FTimeFormat write FTimeFormat default tf12Hour;
property DataStore;
property Options;
property Placement;
end;
implementation
uses
VpSR, VpWavDlg;
{$IFNDEF LCL}
{$R *.dfm}
{$ENDIF}
{ TVpRightAlignedEdit }
procedure TVpRightAlignedEdit.CreateParams(var Params: TCreateParams);
begin
inherited;
{$IFNDEF LCL}
Params.Style := Params.Style or ES_MULTILINE or ES_RIGHT;
{$ENDIF}
end;
{=====}
{ TDlgEventEdit }
procedure TDlgEventEdit.FormCreate(Sender: TObject);
begin
ReturnCode := rtAbandon;
PopLists;
LoadCaptions;
StartTime.ItemIndex := -1;
EndTime.ItemIndex := -1;
EndDate.Enabled := False;
FCustomInterval := TVpRightAlignedEdit.Create(Self);
with FCustomInterval do begin
Parent := AppointmentGroupbox;
Top := IntervalUpDown.Top + 1;
Left := IntervalUpDown.Left - 65;
Height := IntervalUpDown.Height - 1;
Width := 65;
MaxLength := 5;
OnChange := CustomIntervalChange;
TabOrder := edtUnusedPlaceholder.TabOrder;
end;
IntervalUpDown.Associate := FCustomInterval;
end;
{=====}
procedure TDlgEventEdit.OKBtnClick(Sender: TObject);
begin
ReturnCode := rtCommit;
Close;
end;
{=====}
procedure TDlgEventEdit.CancelBtnClick(Sender: TObject);
begin
Close;
end;
{=====}
procedure TDlgEventEdit.PopulateDialog;
var
I: Integer;
begin
{ Resource }
ResourceNameLbl.Caption := Resource.Description;
{ Events }
StartDate.Date := Event.StartTime;
EndDate.Date := Event.EndTime;
RepeatUntil.Date := Event.RepeatRangeEnd;
StartTime.Text := FormatDateTime('h:mm AM/PM', Event.StartTime);
EndTime.Text := FormatDateTime('h:mm AM/PM', Event.EndTime);
StartTimeChange(Self);
CBAllDay.Checked := Event.AllDayEvent;
AlarmWavPath := Event.AlarmWavPath;
StartDate.Enabled := not CBAllDay.Checked;
// EndDate.Enabled := not CBAllDay.Checked;
EndTime.Enabled := not CBAllDay.Checked;
StartTime.Enabled := not CBAllDay.Checked;
DescriptionEdit.Text := Event.Description;
NotesMemo.Text := Event.Note;
AlarmSet.Checked := Event.AlarmSet;
AlarmSetClick(Self);
if not Event.AlarmSet then
AlarmAdvance.Text := '15'
else
AlarmAdvance.Text := IntToStr(Event.AlarmAdv);
AlarmAdvType.ItemIndex := Ord(Event.AlarmAdvType);
RecurringType.ItemIndex := Ord(Event.RepeatCode);
RecurringTypeChange(Self);
FCustomInterval.Text := IntToStr(Event.CustInterval);
Category.Items.Clear;
for I := 0 to 9 do
if (CatColorMap.GetName(I) <> '') then
Category.Items.Add(CatColorMap.GetName(I));
Category.ItemIndex := Event.Category;
FLastEndTime := Event.EndTime;
end;
{=====}
procedure TDlgEventEdit.DePopulateDialog;
begin
{ Events }
Event.StartTime := StartDate.Date + StrToDateTime(StartTime.Text);
Event.EndTime := EndDate.Date + StrToDateTime(EndTime.Text);
Event.RepeatRangeEnd := RepeatUntil.Date;
Event.Description := DescriptionEdit.Text;
Event.Note := NotesMemo.Text;
Event.Category := Category.ItemIndex;
Event.AlarmSet := AlarmSet.Checked;
Event.AlarmAdv := StrToIntDef(AlarmAdvance.Text, 0);
Event.AlarmAdvType := TVpAlarmAdvType(AlarmAdvType.ItemIndex);
Event.RepeatCode := TVpRepeatType(RecurringType.ItemIndex);
Event.CustInterval := StrToIntDef(FCustomInterval.Text, 0);
Event.AllDayEvent := CBAllDay.Checked;
Event.AlarmWavPath := AlarmWavPath;
end;
{=====}
procedure TDlgEventEdit.StartDateChange(Sender: TObject);
begin
if StartDate.Date > EndDate.Date then
EndDate.Date := StartDate.Date;
end;
{=====}
procedure TDlgEventEdit.EndDateChange(Sender: TObject);
begin
if StartDate.Date > EndDate.Date then
StartDate.Date := EndDate.Date;
end;
{=====}
procedure TDlgEventEdit.StartTimeChange(Sender: TObject);
{var }
{ ST: TDateTime; }
begin
{ Verify the value is valid }
try
{ST :=} StrToDateTime(StartTime.Text);
except
StartTime.Color := clRed;
StartTime.SetFocus;
Exit;
end;
StartTime.Color := clWindow;
{ if the end time is less than the start time then change the end time to }
{ follow the start time by 30 minutes }
{if ST > StrToDateTime(EndTime.Text) then begin }
{ if TimeFormat = tf24Hour then }
{ EndTime.Text := FormatDateTime ('h:mm', }
{ ST + (30/MinutesInDay)) }
{ else }
{ EndTime.Text := FormatDateTime ('hh:mm AM/PM', }
{ ST + (30/MinutesInDay)); }
{end; }
end;
{=====}
procedure TDlgEventEdit.EndTimeChange(Sender: TObject);
function IsMidnight (ATime : TDateTime) : Boolean;
begin
Result := ATime = Trunc (ATime);
end;
var
ET: TDateTime;
begin
{ Verify the value is valid }
try
ET := StrToDateTime (EndTime.Text);
if (IsMidnight (ET)) and (not IsMidnight (FLastEndTime)) then
EndDate.Date := EndDate.Date + 1
else if (not IsMidnight (ET)) and (IsMidnight (FLastEndTime)) then
EndDate.Date := EndDate.Date - 1;
FLastEndTime := ET;
except
EndTime.Color := clRed;
EndTime.SetFocus;
Exit;
end;
EndTime.Color := clWindow;
{ if the end time is less than the start time then change the start time to }
{ precede the end time by 30 minutes }
{if ET < StrToDateTime(StartTime.Text) then begin }
{ if TimeFormat = tf24Hour then }
{ StartTime.Text := FormatDateTime ('h:mm', }
{ ET - (30/MinutesInDay)) }
{ else }
{ StartTime.Text := FormatDateTime ('h:mm AM/PM', }
{ ET - (30/MinutesInDay)); }
{end; }
end;
{=====}
procedure TDlgEventEdit.PopLists;
var
StringList: TStringList;
I, Hour, Minute: Integer;
MinStr, AMPMStr: string;
begin
{ Time Lists }
StringList := TStringList.Create;
try
Minute := 0;
AMPMStr := ' AM';
for I := 0 to 96 do begin
if I > 0 then Inc(Minute, 15);
if Minute > 719 then
AMPMStr := ' PM';
if Minute = MinutesInDay then
AMPMStr := ' AM';
Hour := (Minute div 15) div 4;
MinStr := IntToStr(Minute mod 60);
if MinStr = '0' then MinStr := '00';
if TimeFormat = tf24Hour then
StringList.Add(IntToStr(Hour) + ':' + MinStr)
else begin
if Hour > 12 then Hour := Hour - 12;
if Hour = 0 then Hour := 12;
StringList.Add(IntToStr(Hour) + ':' + MinStr + AMPMStr);
end;
end;
StartTime.Items.Assign(StringList);
StartTime.ItemIndex := 0;
EndTime.Items.Assign(StringList);
EndTime.ItemIndex := 0;
finally
StringList.Free;
end;
{ RecurringList }
RecurringType.Items.Add(RSNone);
RecurringType.Items.Add(RSDaily);
RecurringType.Items.Add(RSWeekly);
RecurringType.Items.Add(RSMonthlyByDay);
RecurringType.Items.Add(RSMonthlyByDate);
RecurringType.Items.Add(RSYearlyByDay);
RecurringType.Items.Add(RSYearlyByDate);
RecurringType.Items.Add(RSCustom);
RecurringType.ItemIndex := 0;
{ Alarm Advance Type }
AlarmAdvType.Items.Add(RSMinutes);
AlarmAdvType.Items.Add(RSHours);
AlarmAdvType.Items.Add(RSDays);
AlarmAdvType.ItemIndex := 0;
end;
{=====}
procedure TDlgEventEdit.LoadCaptions;
begin
OKBtn.Caption := RSOKBtn;
CancelBtn.Caption := RSCancelBtn;
AppointmentGroupBox.Caption := RSAppointmentGroupBox;
DescriptionLbl.Caption := RSDescriptionLbl;
CategoryLbl.Caption := RSCategoryLbl;
StartTimeLbl.Caption := RSStartTimeLbl;
EndTimeLbl.Caption := RSEndTimeLbl;
AlarmSet.Caption := RSAlarmSet;
RecurringLbl.Caption := RSRecurringLbl;
IntervalLbl.Caption := RSIntervalLbl;
RecurrenceEndsLbl.Caption := RSRecurrenceEndsLbl;
CBAllDay.Caption := RSAllDayEvent;
end;
{=====}
procedure TDlgEventEdit.AlarmAdvanceChange(Sender: TObject);
var
I: Integer;
Str: string;
begin
if AAVerifying then exit;
AAVerifying := true;
{ Don't allow non numeric values. }
Str := AlarmAdvance.Text;
I := Length(Str);
if (Str[I] > #57) or (Str[I] < #48) then
Delete(Str, I, 1);
AlarmAdvance.Text := Str;
AAVerifying := false;
if Str <> '' then
AdvanceUpDown.Position := StrToInt(Str);
end;
{=====}
procedure TDlgEventEdit.AdvanceUpDownClick(Sender: TObject; Button: TUDBtnType);
begin
{ Inc or Dec AlarmAdvance according to which button was pressed }
{ case Button of
btNext:
AlarmAdvance.Text := IntToStr(StrToIntDef(AlarmAdvance.Text, 0) + 1);
btPrev:
AlarmAdvance.Text := IntToStr(StrToIntDef(AlarmAdvance.Text, 0) - 1);
end;}
AlarmAdvance.Text := IntToStr(AdvanceUpDown.Position);
end;
{=====}
procedure TDlgEventEdit.CustomIntervalChange(Sender: TObject);
var
I: Integer;
Str: string;
begin
{ Don't allow non numeric values. }
if CIVerifying then Exit;
CIVerifying := true;
Str := FCustomInterval.Text;
for I := 1 to Length(Str) do
if (Ord(Str[I]) in [48..57]) then
Continue
else
Delete(Str, I, 1);
FCustomInterval.Text := Str;
if Str <> '' then
IntervalUpDown.Position := StrToInt(Str);
CIVerifying := false;
end;
{=====}
procedure TDlgEventEdit.IntervalUpDownClick(Sender: TObject; Button: TUDBtnType);
begin
FCustomInterval.Text := IntToStr(IntervalUpDown.Position);
end;
{=====}
procedure TDlgEventEdit.RecurringTypeChange(Sender: TObject);
begin
if (RecurringType.ItemIndex > 0)
and (RepeatUntil.Date <= StartDate.Date)
then
RepeatUntil.Date := StartDate.Date + 365;
RecurrenceEndsLbl.Enabled := (RecurringType.ItemIndex > 0);
RepeatUntil.Enabled := RecurrenceEndsLbl.Enabled;
FCustomInterval.Enabled := RecurringType.ItemIndex = 7;
IntervalLbl.Enabled := FCustomInterval.Enabled;
IntervalUpDown.Enabled := FCustomInterval.Enabled;
if FCustomInterval.Enabled then begin
FCustomInterval.Text := IntToStr(IntervalUpDown.Position);
if Visible then
FCustomInterval.SetFocus;
end;
end;
{=====}
procedure TDlgEventEdit.AlarmSetClick(Sender: TObject);
begin
AlarmAdvance.Enabled := AlarmSet.Checked;
AlarmAdvType.Enabled := AlarmSet.Checked;
AdvanceUpDown.Enabled := AlarmSet.Checked;
Event.SnoozeTime := 0.0;
end;
{=====}
procedure TDlgEventEdit.CategoryDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Color, SaveColor: TColor;
Name: string;
ColorRect: TRect;
begin
Category.Canvas.FillRect(Rect);
Color := clBlack;
case Index of
0: begin
Color := CatColorMap.Category0.Color;
Name := CatColorMap.Category0.Description;
end;
1: begin
Color := CatColorMap.Category1.Color;
Name := CatColorMap.Category1.Description;
end;
2: begin
Color := CatColorMap.Category2.Color;
Name := CatColorMap.Category2.Description;
end;
3: begin
Color := CatColorMap.Category3.Color;
Name := CatColorMap.Category3.Description;
end;
4: begin
Color := CatColorMap.Category4.Color;
Name := CatColorMap.Category4.Description;
end;
5: begin
Color := CatColorMap.Category5.Color;
Name := CatColorMap.Category5.Description;
end;
6: begin
Color := CatColorMap.Category6.Color;
Name := CatColorMap.Category6.Description;
end;
7: begin
Color := CatColorMap.Category7.Color;
Name := CatColorMap.Category7.Description;
end;
8: begin
Color := CatColorMap.Category8.Color;
Name := CatColorMap.Category8.Description;
end;
9: begin
Color := CatColorMap.Category9.Color;
Name := CatColorMap.Category9.Description;
end;
end; {Case}
SaveColor := Category.Canvas.Brush.Color;
Category.Canvas.Brush.Color := Color;
Category.Canvas.Pen.Color := clBlack;
ColorRect.Left := Rect.Left + 3;
ColorRect.Top := Rect.Top + 2;
ColorRect.Bottom := Rect.Bottom - 2;
ColorRect.Right := ColorRect.Left + 20;
Category.Canvas.FillRect(ColorRect);
{$IFDEF VERSION5}
Category.Canvas.Rectangle(ColorRect);
{$ELSE}
Category.Canvas.Rectangle(ColorRect.Left, ColorRect.Top, ColorRect.Right,
ColorRect.Bottom);
{$ENDIF}
Rect.Left := ColorRect.Right + 5;
Category.Canvas.Brush.Color := SaveColor;
Category.Canvas.TextOut(Rect.Left, Rect.Top, Name);
end;
{=====}
procedure TDlgEventEdit.CBAllDayClick(Sender: TObject);
begin
StartDate.Enabled := not CBAllDay.Checked;
{EndDate.Enabled := not CBAllDay.Checked; }
EndTime.Enabled := not CBAllDay.Checked;
StartTime.Enabled := not CBAllDay.Checked;
end;
{=====}
procedure TDlgEventEdit.SpeedButton1Click(Sender: TObject);
begin
ExecuteSoundFinder(AlarmWavPath);
end;
{=====}
procedure TDlgEventEdit.FormShow(Sender: TObject);
begin
DescriptionEdit.SetFocus;
end;
{=====}
{ TVpEventEditDialog }
constructor TVpEventEditDialog.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FPlacement.Position := mpCenterTop;
FPlacement.Height := 415;
FPlacement.Width := 710;
end;
{=====}
function TVpEventEditDialog.Execute(Event: TVpEvent;
TimeFormat: TVpTimeFormat = tf12Hour): Boolean;
var
DlgEventEdit: TDlgEventEdit;
begin
ceEvent := Event;
Application.CreateForm(TDlgEventEdit, DlgEventEdit);
try
DoFormPlacement(DlgEventEdit);
SetFormCaption(DlgEventEdit, Event.Description, RSDlgEventEdit);
DlgEventEdit.Event := Event;
DlgEventEdit.TimeFormat := FTimeFormat;
DlgEventEdit.Resource := DataStore.Resource;
DlgEventEdit.CatColorMap := DataStore.CategoryColorMap;
DlgEventEdit.PopulateDialog;
DlgEventEdit.ShowModal;
result := (DlgEventEdit.ReturnCode = rtCommit);
if Result then begin
DlgEventEdit.DePopulateDialog;
DataStore.PostEvents;
end;
finally
DlgEventEdit.Release;
end;
end;
{=====}
function TVpEventEditDialog.AddNewEvent(StartTime, EndTime: TDateTime): Boolean;
begin
Result := false;
if DataStore <> nil then begin
ceEvent := DataStore.Resource.Schedule.AddEvent(
DataStore.GetNextID(EventsTableName), StartTime, EndTime);
if ceEvent <> nil then begin
Result := Execute(ceEvent);
if (not Result) or (ceEvent = nil) then
ceEvent.Free;
end;
end;
end;
{=====}
procedure TDlgEventEdit.StartTimeExit(Sender: TObject);
var
ST : TDateTime;
begin
{ Verify the value is valid }
try
ST := StrToDateTime (StartDate.Text) +
StrToDateTime (StartTime.Text);
except
StartTime.Color := clRed;
StartTime.SetFocus;
Exit;
end;
StartTime.Color := clWindow;
{ if the end time is less than the start time then change the end }
{ time to follow the start time by 30 minutes }
if ST > StrToDateTime (EndDate.Text) +
StrToDateTime (EndTime.Text) then begin
if TimeFormat = tf24Hour then
EndTime.Text := FormatDateTime ('h:mm', ST + (30/MinutesInDay))
else
EndTime.Text := FormatDateTime ('hh:mm AM/PM',
ST + (30/MinutesInDay));
end;
end;
procedure TDlgEventEdit.EndTimeExit(Sender: TObject);
var
ET : TDateTime;
begin
{ Verify the value is valid }
try
ET := STrToDateTime (EndDate.Text) + StrToDateTime (EndTime.Text);
except
EndTime.Color := clRed;
EndTime.SetFocus;
Exit;
end;
EndTime.Color := clWindow;
{ if the end time is less than the start time then change the }
{ start time to precede the end time by 30 minutes }
if ET < StrToDateTime (StartDate.Text) +
StrToDateTime (StartTime.Text) then begin
if TimeFormat = tf24Hour then
StartTime.Text := FormatDateTime ('h:mm', ET - (30/MinutesInDay))
else
StartTime.Text := FormatDateTime ('h:mm AM/PM',
ET - (30/MinutesInDay));
end;
end;
end.

188
components/tvplanit/source/vpexception.pas Normal file
View File

@ -0,0 +1,188 @@
{*********************************************************}
{* VPEXCEPTION.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 VpException;
{Vp exceptions}
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,
{$ELSE}
Windows,
{$ENDIF}
Classes, SysUtils, VpConst, VpSR;
type
{*** Base Vp exeption class ***}
EVpException = class(Exception);
EVpCodedException = class(Exception)
public
ErrorCode : LongInt;
end;
{*** Data Classes ***}
EExclusiveEventConflict = class(EVpException)
public
constructor Create;
end;
EBackwardTimesError = class(EVpException)
public
constructor Create;
end;
EFailToCreateTask = class(EVpException)
public
constructor Create;
end;
EFailToCreateContact = class(EVpException)
public
constructor Create;
end;
EFailToCreateEvent = class(EVpException)
public
constructor Create;
end;
EFailToCreateResource = class(EVpException)
public
constructor Create;
end;
EDuplicateResource = class (EVpException)
public
constructor Create;
end;
EInvalidTable = class (EVpException)
public
constructor Create;
end;
{*** Timer Pool ***}
ENoTimersAvailable = class(EVpException)
public
constructor Create;
end;
{*** DB Errors ***}
EDBPostError = class(EVpException)
public
constructor Create;
end;
ETimerPoolError = class(EVpException);
EInvalidTriggerHandle = class(ETimerPoolError)
public
constructor Create;
end;
EVpCanvasError = class (EVpException);
EVpPrintFormatError = class (EVpException);
EVpPrintPreviewError = class (EVpException);
EVpDateException = class (EVpException);
EVpContactEditError = class (EVpException);
EVpDateEditError = class (EVpException);
EVpCalendarError = class (EVpException);
EVpPrintFormatEditorError = class (EVpException);
EVpNoLocalizationFile = class (EVpException);
implementation
constructor ENoTimersAvailable.Create;
begin
inherited Create(RSNoTimersAvail);
end;
constructor EDBPostError.Create;
begin
inherited Create(RSDBPostError);
end;
constructor EInvalidTriggerHandle.Create;
begin
inherited Create(RSBadTriggerHandle);
end;
constructor EExclusiveEventConflict.Create;
begin
inherited Create(RSExclusiveEventConflict);
end;
constructor EBackwardTimesError.Create;
begin
inherited Create(RSBackwardTimesError);
end;
constructor EFailToCreateTask.Create;
begin
inherited Create(RSFailToCreateTask);
end;
constructor EFailToCreateContact.Create;
begin
inherited Create(RSFailToCreateContact);
end;
constructor EFailToCreateEvent.Create;
begin
inherited Create(RSFailToCreateEvent);
end;
constructor EFailToCreateResource.Create;
begin
inherited Create(RSFailToCreateResource);
end;
constructor EDuplicateResource.Create;
begin
inherited Create (RSDuplicateResource);
end;
constructor EInvalidTable.Create;
begin
inherited Create (RSInvalidTableSpecified);
end;
end.

538
components/tvplanit/source/vpff2ds.pas Normal file
View File

@ -0,0 +1,538 @@
{*********************************************************}
{* VPFF2DS.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 VpFF2DS;
{ FlashFiler 2 DataStore component }
{ Supports FlashFiler 2.06 and above only. }
interface
uses
Windows, Classes, Dialogs, SysUtils, Db, VpBase, VpData,
VpBaseDS, VpDBDS, VpConst, ffdb;
type
TVpFF2DataStore = class(TVpCustomDBDataStore)
protected{private}
FDatabase : TffDatabase;
FAutoCreateAlias : Boolean;
FResourceTable : TffTable;
FEventsTable : TffTable;
FContactsTable : TffTable;
FTasksTable : TffTable;
FAliasName : string;
FSession : TffSession;
{ property getters }
function GetDatabaseName: string;
function GetConnected: Boolean;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
{ ancestor 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 SetAliasName(const Value: string);
procedure SetConnected(const Value: boolean); override;
procedure SetSession(Value : TffSession);
procedure Loaded; override;
procedure SetFilterCriteria(aTable : TDataset;
aUseDateTime : Boolean;
aResourceID : Integer;
aStartDateTime : TDateTime;
aEndDateTime : TDateTime); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetNextID(TableName: string): integer; override;
// procedure PurgeResource(Res: TVpResource); override;
procedure PurgeEvents(Res: TVpResource); override;
procedure PurgeContacts(Res: TVpResource); override;
procedure PurgeTasks(Res: TVpResource); override;
procedure Load; override;
procedure CreateTable(TableName: string);
property Database: TffDatabase read FDatabase;
published
property AutoCreate;
property AutoConnect;
{ properties }
property AutoCreateAlias: Boolean
read FAutoCreateAlias write SetAutoCreateAlias;
property DayBuffer;
property ResourceID;
property AliasName: string read FAliasName write SetAliasName;
property Session : TffSession read FSession write SetSession;
property ReadOnly;
{ events }
end;
implementation
uses
{$IFDEF VERSION6}
Variants;
{$ELSE}
FileCtrl;
{$ENDIF}
(*****************************************************************************)
{ TVpFFDataStore }
constructor TVpFF2DataStore.Create(AOwner: TComponent);
begin
inherited;
FAliasName := '';
FConnected := False;
FResourceID := 0;
end;
{=====}
destructor TVpFF2DataStore.Destroy;
begin
FResourceTable.Free;
FEventsTable.Free;
FContactsTable.Free;
FTasksTable.Free;
if Assigned(FDatabase) then
FDatabase.Close;
FDatabase.Free;
inherited;
end;
{=====}
function TVpFF2DataStore.GetNextID(TableName: string): integer;
begin
{ this is not used in the FlashFiler Datastore as the FlashFiler tables use }
{ autoincrement fields }
result := -1;
end;
{=====}
function TVpFF2DataStore.GetDatabaseName: string;
begin
result := FDataBase.DatabaseName;
end;
{=====}
function TVpFF2DataStore.GetConnected: Boolean;
begin
result := FDatabase.Connected;
end;
{=====}
function TVpFF2DataStore.GetResourceTable : TDataset;
begin
Result := FResourceTable;
end;
{=====}
function TVpFF2DataStore.GetEventsTable : TDataset;
begin
Result := FEventsTable;
end;
{=====}
function TVpFF2DataStore.GetContactsTable : TDataset;
begin
Result := FContactsTable;
end;
{=====}
function TVpFF2DataStore.GetTasksTable : TDataset;
begin
Result := FTasksTable;
end;
{=====}
procedure TVpFF2DataStore.Notification(AComponent: TComponent; Operation: TOperation);
begin
if Assigned(FSession) and (AComponent = FSession) then begin
SetConnected(False);
FSession := nil;
end;
inherited;
end;
{=====}
{ Functionality moved to the TVpCustomDBDataStore class }
(*
procedure TVpFF2DataStore.PurgeResource(Res: TVpResource);
begin
Resource.Deleted := true;
PostResources;
Load;
end;
{=====}
*)
procedure TVpFF2DataStore.PurgeEvents(Res: TVpResource);
var
OldIndex : string;
begin
with FEventsTable do begin
OldIndex := IndexName;
IndexName := VpcIndexNameResID;
SetRange([Res.ResourceID], [Res.ResourceID]);
DeleteRecords;
IndexName := OldIndex;
end;
inherited;
// Resource.Schedule.ClearEvents;
end;
{=====}
procedure TVpFF2DataStore.PurgeContacts(Res: TVpResource);
var
OldIndex : string;
begin
with FContactsTable do begin
OldIndex := IndexName;
IndexName := VpcIndexNameResID;
SetRange([Res.ResourceID], [Res.ResourceID]);
DeleteRecords;
IndexName := OldIndex;
end;
inherited;
// Resource.Contacts.ClearContacts;
end;
{=====}
procedure TVpFF2DataStore.PurgeTasks(Res: TVpResource);
var
OldIndex : string;
begin
with FTasksTable do begin
OldIndex := IndexName;
IndexName := VpcIndexNameResID;
SetRange([Res.ResourceID], [Res.ResourceID]);
DeleteRecords;
IndexName := OldIndex;
end;
inherited;
// Resource.Tasks.ClearTasks;
end;
{=====}
procedure TVpFF2DataStore.Load;
begin
if not FDatabase.Connected then exit;
inherited;
end;
{=====}
procedure TVpFF2DataStore.CreateTable(TableName: string);
var
Table: TffTable;
begin
Table := nil;
if TableName = ResourceTableName then begin
{ Create Resources Table }
Table := FResourceTable;
with Table do begin
Active := false;
Name := ResourceTableName;
DatabaseName := FDatabase.DatabaseName;
CreateFieldDefs(TableName, FieldDefs);
{ modify field 0 to be an autoinc field }
FieldDefs.Items[0].DataType := ftAutoInc;
CreateIndexDefs(TableName, IndexDefs);
end;
end
else if TableName = EventsTableName then begin
{ Create Events Table }
Table := FEventsTable;
with Table do begin
Active := false;
Name := EventsTableName;
DatabaseName := FDatabase.DatabaseName;
CreateFieldDefs(TableName, FieldDefs);
{ modify field 0 to be an autoinc field }
FieldDefs.Items[0].DataType := ftAutoInc;
CreateIndexDefs(TableName, IndexDefs);
end;
end
else if TableName = ContactsTableName then begin
{ Create Contacts Table }
Table := FContactsTable;
with Table do begin
Table.Active := false;
Table.Name := ContactsTableName;
Table.DatabaseName := FDatabase.DatabaseName;
CreateFieldDefs(TableName, FieldDefs);
{ modify field 0 to be an autoinc field }
FieldDefs.Items[0].DataType := ftAutoInc;
CreateIndexDefs(TableName, IndexDefs);
end;
end
else if TableName = TasksTableName then begin
{ Create Tasks Table }
Table := FTasksTable;
with Table do begin
Table.Active := false;
Table.Name := TasksTableName;
Table.DatabaseName := FDatabase.DatabaseName;
CreateFieldDefs(TableName, FieldDefs);
{ modify field 0 to be an autoinc field }
FieldDefs.Items[0].DataType := ftAutoInc;
CreateIndexDefs(TableName, IndexDefs);
end;
end;
if Table <> nil then
Table.CreateTable;
end;
{=====}
procedure TVpFF2DataStore.SetAliasName(const Value: string);
var
WasOpen: Boolean;
begin
if FAliasName <> Value then begin
WasOpen := Connected;
SetConnected(False);
FAliasName := Value;
SetConnected(WasOpen);
end;
end;
{=====}
procedure TVpFF2DataStore.SetAutoCreateAlias(Value: Boolean);
begin
if Value <> FAutoCreateAlias then
FAutoCreateAlias := Value;
end;
{=====}
procedure TVpFF2DataStore.Loaded;
begin
inherited;
if not (csDesigning in ComponentState) then
Connected := AutoConnect;
end;
{=====}
procedure TVpFF2DataStore.SetConnected(const Value: boolean);
var
AliasPath: string;
aSession : TffSession;
begin
{ Don't do anything with live data until run time. }
if (csDesigning in ComponentState) or
(csLoading in ComponentState) then
Exit;
{ Connecting or disconnecting? }
if Value then begin
{ Connecting. If a session was not explicitly specified then look for the
default FlashFiler session. }
if FSession = nil then
aSession := FFSession
else
aSession := FSession;
aSession.Open;
if FDatabase = nil then begin
FDatabase := TffDatabase.Create(nil);
end;
FDatabase.ReadOnly := ReadOnly;
FDatabase.DatabaseName := 'VpDatabase';
FDatabase.SessionName := aSession.SessionName;
FDatabase.AliasName := FAliasName;
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
FAliasName := ExtractFileName(ParamStr(0));
FAliasName := Copy(FAliasName, 1, Pos('.', FAliasName) - 1);
FDatabase.AliasName := FAliasName;
end;
{ if the alias doesn't exist, then create it }
if not aSession.IsAlias(FDatabase.AliasName) then begin
AliasPath := ExtractFilePath(ParamStr(0)) + 'Data';
if not DirectoryExists(AliasPath) then
ForceDirectories(AliasPath);
aSession.AddAliasEx(FDatabase.AliasName, AliasPath);
end;
end else
if not aSession.IsAlias(FDatabase.AliasName) then Exit;
FDataBase.Connected := Value;
if FDataBase.Connected then begin
{ Set up the tables. }
if FResourceTable = nil then
FResourceTable := TffTable.Create(nil);
FResourceTable.DatabaseName := FDatabase.DatabaseName;
FResourceTable.SessionName := aSession.SessionName;
FResourceTable.TableName := ResourceTableName;
if FEventsTable = nil then
FEventsTable := TffTable.Create(nil);
FEventsTable.DatabaseName := FDatabase.DatabaseName;
FEventsTable.SessionName := aSession.SessionName;
FEventsTable.TableName := EventsTableName;
if FContactsTable = nil then
FContactsTable := TffTable.Create(nil);
FContactsTable.DatabaseName := FDatabase.DatabaseName;
FContactsTable.SessionName := aSession.SessionName;
FContactsTable.TableName := ContactsTableName;
if FTasksTable = nil then
FTasksTable := TffTable.Create(nil);
FTasksTable.DatabaseName := FDatabase.DatabaseName;
FTasksTable.SessionName := aSession.SessionName;
FTasksTable.TableName := TasksTableName;
if FDatabase.TableExists(ResourceTableName) then
FResourceTable.Open
else
if AutoCreate then begin
CreateTable(ResourceTableName);
FResourceTable.Open;
end;
if FDatabase.TableExists(EventsTableName) then
FEventsTable.Open
else
if AutoCreate then begin
CreateTable(EventsTableName);
FEventsTable.Open;
end;
if FDatabase.TableExists(ContactsTableName) then
FContactsTable.Open
else
if AutoCreate then begin
CreateTable(ContactsTableName);
FContactsTable.Open;
end;
if FDatabase.TableExists(TasksTableName) then
FTasksTable.Open
else
if AutoCreate then begin
CreateTable(TasksTableName);
FTasksTable.Open;
end;
Load;
end
end
else if Assigned(FDatabase) then
FDatabase.Close;
if Assigned(FDatabase) then
inherited SetConnected(Database.Connected);
end;
{=====}
procedure TVpFF2DataStore.SetSession(Value : TffSession);
var
WasOpen : Boolean;
begin
if FSession <> Value then begin
WasOpen := Connected;
SetConnected(False);
FSession := Value;
if Assigned(FSession) then begin
FSession.FreeNotification(Self);
if Assigned(FDatabase) then begin
FDatabase.SessionName := FSession.SessionName;
FContactsTable.SessionName := FSession.SessionName;
FEventsTable.SessionName := FSession.SessionName;
FResourceTable.SessionName := FSession.SessionName;
FTasksTable.SessionName := FSession.SessionName;;
end;
end;
SetConnected(WasOpen);
end;
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 TVpFF2DataStore.SetFilterCriteria(aTable: TDataset;
aUseDateTime: Boolean; aResourceID: Integer; aStartDateTime,
aEndDateTime: TDateTime);
var
aIndexDef : TIndexDef;
aFFTable : TffTable;
begin
if aUseDateTime then begin
{ - Added the ability to use ranges instead of filters for tables }
{ which have a single index on ResourceID;StartTime }
{ tables which were created with versions 1.0 or 1.01 of Visual PlanIt }
{ will not have the new index, so they will continue to use filters. }
aIndexDef := TffTable(aTable).IndexDefs.GetIndexForFields(
'ResourceID;StartTime', True);
if aIndexDef = nil then
inherited SetFilterCriteria(aTable, aUseDateTime, aResourceID,
aStartDateTime, aEndDateTime)
else begin
aFFTable := TffTable(aTable);
aFFTable.IndexName := aIndexDef.Name;
aFFTable.SetRange([aResourceID, aStartDateTime],
[aResourceID, aEndDateTime]);
end;
end else begin
aIndexDef := TffTable(aTable).IndexDefs.GetIndexForFields('ResourceID', True);
if aIndexDef = nil then
inherited SetFilterCriteria(aTable, aUseDateTime, aResourceID,
aStartDateTime, aEndDateTime)
else begin
aFFTable := TffTable(aTable);
aFFTable.IndexName := aIndexDef.Name;
aFFTable.SetRange([aResourceID], [aResourceID]);
end;
end;
end;
end.

2105
components/tvplanit/source/vpflxds.pas Normal file
View File

File diff suppressed because it is too large Load Diff

158
components/tvplanit/source/vpflxdsed1.lfm Normal file
View File

@ -0,0 +1,158 @@
object frmFieldMapper: TfrmFieldMapper
Left = 281
Height = 537
Top = 112
Width = 409
HorzScrollBar.Page = 408
VertScrollBar.Page = 536
BorderStyle = bsToolWindow
Caption = 'FlexDataStore Field Mapping Designer'
ClientHeight = 537
ClientWidth = 409
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnClose = FormClose
OnShow = FormShow
Position = poScreenCenter
object Panel1: TPanel
Height = 57
Top = 480
Width = 409
Align = alBottom
ClientHeight = 57
ClientWidth = 409
TabOrder = 0
object Button2: TButton
Left = 325
Height = 25
Top = 16
Width = 75
Caption = 'Close'
OnClick = Button2Click
TabOrder = 0
end
end
object PageControl1: TPageControl
Height = 480
Width = 409
ActivePage = TabSheet1
Align = alClient
TabIndex = 0
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Field Mapping Designer'
ClientHeight = 454
ClientWidth = 401
object Bevel1: TBevel
Left = 5
Height = 315
Top = 4
Width = 390
end
object Label2: TLabel
Left = 10
Height = 13
Top = 36
Width = 116
Caption = 'Available Dataset Fields:'
ParentColor = False
end
object Label5: TLabel
Left = 35
Height = 13
Top = 329
Width = 74
Caption = 'Field Mappings:'
ParentColor = False
end
object Label6: TLabel
Left = 242
Height = 13
Top = 36
Width = 137
Caption = 'Available Visual PlanIt Fields:'
ParentColor = False
end
object Label1: TLabel
Left = 12
Height = 13
Top = 13
Width = 40
Caption = 'Dataset:'
ParentColor = False
end
object DatasetFieldLB: TListBox
Left = 11
Height = 255
Top = 56
Width = 145
ItemHeight = 13
OnClick = DBFieldSelected
OnKeyPress = DatasetFieldLBKeyPress
TabOrder = 0
end
object VPFieldLB: TListBox
Left = 243
Height = 255
Top = 56
Width = 145
ItemHeight = 13
OnClick = VpFieldSelected
OnKeyPress = VPFieldLBKeyPress
TabOrder = 1
end
object FieldMappingsLB: TListBox
Left = 35
Height = 100
Top = 349
Width = 217
ItemHeight = 13
OnClick = FieldMappingsLBClick
OnKeyPress = FieldMappingsLBKeyPress
TabOrder = 2
end
object btnDeleteMapping: TButton
Left = 259
Height = 25
Top = 349
Width = 97
Caption = 'Delete Mapping'
Enabled = False
OnClick = btnDeleteMappingClick
TabOrder = 3
end
object DatasetCombo: TComboBox
Left = 56
Height = 21
Top = 10
Width = 145
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
ItemHeight = 13
OnChange = DatasetComboChange
TabOrder = 4
Text = 'DatasetCombo'
end
object btnAddMapping: TBitBtn
Left = 166
Height = 49
Top = 136
Width = 69
Caption = 'Add Field Mapping'
Enabled = False
NumGlyphs = 0
OnClick = btnAddMappingClick
TabOrder = 5
end
object btnClearMappings: TButton
Left = 259
Height = 25
Top = 381
Width = 97
Caption = 'Clear All '
Enabled = False
OnClick = btnClearMappingsClick
TabOrder = 6
end
end
end
end

605
components/tvplanit/source/vpflxdsed1.pas Normal file
View File

@ -0,0 +1,605 @@
{*********************************************************}
{* VPFLXDSED1.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 ***** *}
{.$DEFINE RUNTIMETEST}
{$I Vp.INC}
unit VpFlxDsEd1;
{ Flexible DataStore ComponentEditor }
{ Introduced in version 1.01 }
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFNDEF RUNTIMETEST}
{$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF}
{$ENDIF} {RUNTIMETEST}
ExtCtrls, StdCtrls, Db, DBTables, VpData, VpFlxDS, ComCtrls, Buttons;
type
TfrmFieldMapper = class(TForm)
Panel1: TPanel;
Button2: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Bevel1: TBevel;
Label2: TLabel;
Label5: TLabel;
Label6: TLabel;
Label1: TLabel;
DatasetFieldLB: TListBox;
VPFieldLB: TListBox;
FieldMappingsLB: TListBox;
btnDeleteMapping: TButton;
DatasetCombo: TComboBox;
btnAddMapping: TBitBtn;
btnClearMappings: TButton;
procedure FormShow(Sender: TObject);
procedure DatasetComboChange(Sender: TObject);
procedure DBFieldSelected(Sender: TObject);
procedure DatasetFieldLBKeyPress(Sender: TObject; var Key: Char);
procedure VpFieldSelected(Sender: TObject);
procedure VPFieldLBKeyPress(Sender: TObject; var Key: Char);
procedure btnAddMappingClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure btnDeleteMappingClick(Sender: TObject);
procedure btnClearMappingsClick(Sender: TObject);
procedure FieldMappingsLBClick(Sender: TObject);
procedure FieldMappingsLBKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
DSResActive : Boolean;
DSEventActive : Boolean;
DSContactActive: Boolean;
DSTaskActive : Boolean;
procedure SyncObjects;
procedure OpenDatasets;
public
FlexDS: TVpFlexDataStore;
ResDS: TDataset;
EventsDS: TDataset;
ContactsDS: TDataset;
TasksDS: TDataset;
end;
{$IFDEF RUNTIMETEST}
procedure RuntimeTest(FlexDS: TVpFlexDataStore);
{$ELSE}
TVpFlexDSEditor = class(TComponentEditor)
procedure ExecuteVerb(Index : Integer); override;
function GetVerb(Index : Integer) : string; override;
function GetVerbCount : Integer; override;
end;
{$ENDIF}
implementation
{$R *.DFM}
uses
vpConst;
{$IFDEF RUNTIMETEST}
{ Runtime test }
procedure RuntimeTest(FlexDS: TVpFlexDataStore);
var
frmFieldMapper: TfrmFieldMapper;
begin
if FlexDS = nil then
Exit;
Application.CreateForm(TfrmFieldMapper, frmFieldMapper);
try
frmFieldMapper.FlexDS := FlexDS;
if FlexDS.ResourceDataSource <> nil then
frmFieldMapper.ResDS := FlexDS.ResourceDataSource.DataSet;
if FlexDS.EventsDataSource <> nil then
frmFieldMapper.EventsDS := FlexDS.EventsDataSource.DataSet;
if FlexDS.ContactsDataSource <> nil then
frmFieldMapper.ContactsDS := FlexDS.ContactsDataSource.DataSet;
if FlexDS.TasksDataSource <> nil then
frmFieldMapper.TasksDS := FlexDS.TasksDataSource.DataSet;
frmFieldMapper.ShowModal;
finally
frmFieldMapper.release;
end;
end;
{=====}
{$ELSE} {RUNTIMETEST}
{$IFDEF VERSION6}
procedure MapDatabaseFields(Designer : IDesigner;
FlexDS : TVpFlexDataStore);
{$ELSE}
procedure MapDatabaseFields(Designer : IFormDesigner;
FlexDS : TVpFlexDataStore);
{$ENDIF}
var
frmFieldMapper: TfrmFieldMapper;
begin
if FlexDS = nil then
Exit;
Application.CreateForm(TfrmFieldMapper, frmFieldMapper);
try
frmFieldMapper.FlexDS := FlexDS;
if FlexDS.ResourceDataSource <> nil then
frmFieldMapper.ResDS := FlexDS.ResourceDataSource.DataSet;
if FlexDS.EventsDataSource <> nil then
frmFieldMapper.EventsDS := FlexDS.EventsDataSource.DataSet;
if FlexDS.ContactsDataSource <> nil then
frmFieldMapper.ContactsDS := FlexDS.ContactsDataSource.DataSet;
if FlexDS.TasksDataSource <> nil then
frmFieldMapper.TasksDS := FlexDS.TasksDataSource.DataSet;
frmFieldMapper.ShowModal;
finally
frmFieldMapper.release;
end;
Designer.Modified;
end;
{=====}
{*** TVpNavBarEditor ***}
procedure TVpFlexDSEditor.ExecuteVerb(Index : Integer);
begin
if Index = 0 then
MapDatabaseFields(Designer, (Component as TVpFlexDataStore));
end;
function TVpFlexDSEditor.GetVerb(Index : Integer) : string;
begin
if Index = 0 then
Result := 'Map Database Fields...';
end;
function TVpFlexDSEditor.GetVerbCount : Integer;
begin
Result := 1;
end;
{$ENDIF} {RuntimeTest}
procedure TfrmFieldMapper.FormShow(Sender: TObject);
begin
DatasetCombo.Items.Clear;
DatasetCombo.Text := '';
try
OpenDatasets;
finally
{Load DatasetCombo}
if (ResDS <> nil) and (ResDS.Active) then
DatasetCombo.Items.Add(ResourceTableName)
else
FlexDS.ResourceMappings.Clear;
if (EventsDS <> nil) and (EventsDS.Active) then
DatasetCombo.Items.Add(EventsTableName)
else
FlexDS.EventMappings.Clear;
if (ContactsDS <> nil) and (ContactsDS.Active) then
DatasetCombo.Items.Add(ContactsTableName)
else
FlexDS.ContactMappings.Clear;
if (TasksDS <> nil) and (TasksDS.Active) then
DatasetCombo.Items.Add(TasksTableName)
else
FlexDS.TaskMappings.Clear;
end;
end;
{=====}
procedure TfrmFieldMapper.OpenDatasets;
var
ErrorStr: string;
begin
ErrorStr := '';
btnAddMapping.Caption := 'Add Field'#13#10'Mapping';
DSResActive := false;
DSEventActive := false;
{Open the Resources Dataset}
if ResDS <> nil then begin
DSResActive := ResDS.Active;
if not ResDS.Active then
try
ResDS.Open;
except
ErrorStr := ' Resources (Failed to open)'#13#10;
end;
end else
ErrorStr := ' Resources (Datasource not assigned)'#13#10;
{Open the Events Dataset}
if EventsDS <> nil then begin
DSEventActive := EventsDS.Active;
if not EventsDS.Active then
try
EventsDS.Open;
except
ErrorStr := ErrorStr + ' Events (Failed to open)'#13#10;
end;
end else
ErrorStr := ErrorStr + ' Events (Datasource not assigned)'#13#10;
{Open the Contacts Dataset}
if ContactsDS <> nil then begin
DSContactActive := ContactsDS.Active;
try
ContactsDS.Open;
except
ErrorStr := ErrorStr + ' Contacts (Failed to open)'#13#10;
end;
end else
ErrorStr := ErrorStr + ' Contacts (Datasource not assigned)'#13#10;
{Open the Tasks Dataset}
if TasksDS <> nil then begin
DSTaskActive := TasksDS.Active;
try
TasksDS.Open;
except
ErrorStr := ErrorStr + ' Tasks (Failed to open)'#13#10;
end;
end else
ErrorStr := ErrorStr + ' Tasks (Datasource not assigned)'#13#10;
{ let the user know if there was a prolen opening any of the datasets. }
if (ErrorStr <> '') then
Application.MessageBox(PChar('There was an error opening the following '
+ 'datasets'#13#10#10 + ErrorStr + #10
+ 'Field mapping for these tables will not be available until the '
+ 'errors are corrected.'), 'Error Opening Dataset(s)', 0);
end;
{=====}
procedure TfrmFieldMapper.DatasetComboChange(Sender: TObject);
begin
SyncObjects;
end;
{=====}
procedure TfrmFieldMapper.SyncObjects;
var
I: integer;
FM: TVpFieldMapping;
MC: TCollection;
begin
MC := nil;
FieldMappingsLB.Items.Clear;
DatasetFieldLB.Items.Clear;
VpFieldLB.Clear;
if DatasetCombo.Text = ResourceTableName then begin
MC := FlexDS.ResourceMappings;
if not ResDS.Active then
ResDS.Open;
ResDS.FieldDefs.GetItemNames(DataSetFieldLB.Items);
VpFieldLB.Items.Add('ResourceID');
VpFieldLB.Items.Add('Description');
VpFieldLB.Items.Add('Notes');
VpFieldLB.Items.Add('ImageIndex');
VpFieldLB.Items.Add('Active');
VpFieldLB.Items.Add('UserField0');
VpFieldLB.Items.Add('UserField1');
VpFieldLB.Items.Add('UserField2');
VpFieldLB.Items.Add('UserField3');
VpFieldLB.Items.Add('UserField4');
VpFieldLB.Items.Add('UserField5');
VpFieldLB.Items.Add('UserField6');
VpFieldLB.Items.Add('UserField7');
VpFieldLB.Items.Add('UserField8');
VpFieldLB.Items.Add('UserField9');
end
else if DatasetCombo.Text = EventsTableName then begin
MC := FlexDS.EventMappings;
EventsDS.FieldDefs.GetItemNames(DataSetFieldLB.Items);
VpFieldLB.Items.Add('RecordID');
VpFieldLB.Items.Add('StartTime');
VpFieldLB.Items.Add('EndTime');
VpFieldLB.Items.Add('ResourceID');
VpFieldLB.Items.Add('Description');
VpFieldLB.Items.Add('Note');
VpFieldLB.Items.Add('Category');
VpFieldLB.Items.Add('AllDayEvent');
VpFieldLB.Items.Add('AlarmWavPath');
VpFieldLB.Items.Add('AlarmSet');
VpFieldLB.Items.Add('AlarmAdv');
VpFieldLB.Items.Add('AlarmAdvType');
VpFieldLB.Items.Add('SnoozeTime');
VpFieldLB.Items.Add('RepeatCode');
VpFieldLB.Items.Add('RepeatRangeEnd');
VpFieldLB.Items.Add('CustInterval');
VpFieldLB.Items.Add('UserField0');
VpFieldLB.Items.Add('UserField1');
VpFieldLB.Items.Add('UserField2');
VpFieldLB.Items.Add('UserField3');
VpFieldLB.Items.Add('UserField4');
VpFieldLB.Items.Add('UserField5');
VpFieldLB.Items.Add('UserField6');
VpFieldLB.Items.Add('UserField7');
VpFieldLB.Items.Add('UserField8');
VpFieldLB.Items.Add('UserField9');
end
else if DatasetCombo.Text = ContactsTableName then begin
MC := FlexDS.ContactMappings;
ContactsDS.FieldDefs.GetItemNames(DataSetFieldLB.Items);
VpFieldLB.Items.Add('ResourceID');
VpFieldLB.Items.Add('RecordID');
VpFieldLB.Items.Add('FirstName');
VpFieldLB.Items.Add('LastName');
VpFieldLB.Items.Add('Birthdate');
VpFieldLB.Items.Add('Anniversary');
VpFieldLB.Items.Add('Title');
VpFieldLB.Items.Add('Company');
VpFieldLB.Items.Add('Position');
VpFieldLB.Items.Add('EMail');
VpFieldLB.Items.Add('Address');
VpFieldLB.Items.Add('City');
VpFieldLB.Items.Add('State');
VpFieldLB.Items.Add('Zip');
VpFieldLB.Items.Add('Country');
VpFieldLB.Items.Add('Note');
VpFieldLB.Items.Add('Phone1');
VpFieldLB.Items.Add('Phone2');
VpFieldLB.Items.Add('Phone3');
VpFieldLB.Items.Add('Phone4');
VpFieldLB.Items.Add('Phone5');
VpFieldLB.Items.Add('PhoneType1');
VpFieldLB.Items.Add('PhoneType2');
VpFieldLB.Items.Add('PhoneType3');
VpFieldLB.Items.Add('PhoneType4');
VpFieldLB.Items.Add('PhoneType5');
VpFieldLB.Items.Add('Category');
VpFieldLB.Items.Add('Custom1');
VpFieldLB.Items.Add('Custom2');
VpFieldLB.Items.Add('Custom3');
VpFieldLB.Items.Add('Custom4');
VpFieldLB.Items.Add('UserField0');
VpFieldLB.Items.Add('UserField1');
VpFieldLB.Items.Add('UserField2');
VpFieldLB.Items.Add('UserField3');
VpFieldLB.Items.Add('UserField4');
VpFieldLB.Items.Add('UserField5');
VpFieldLB.Items.Add('UserField6');
VpFieldLB.Items.Add('UserField7');
VpFieldLB.Items.Add('UserField8');
VpFieldLB.Items.Add('UserField9');
end
else if DatasetCombo.Text = TasksTableName then begin
MC := FlexDS.TaskMappings;
TasksDS.FieldDefs.GetItemNames(DataSetFieldLB.Items);
VpFieldLB.Items.Add('ResourceID');
VpFieldLB.Items.Add('RecordID');
VpFieldLB.Items.Add('Complete');
VpFieldLB.Items.Add('Description');
VpFieldLB.Items.Add('Details');
VpFieldLB.Items.Add('CreatedOn');
VpFieldLB.Items.Add('CompletedOn');
VpFieldLB.Items.Add('Priority');
VpFieldLB.Items.Add('Category');
VpFieldLB.Items.Add('DueDate');
VpFieldLB.Items.Add('UserField0');
VpFieldLB.Items.Add('UserField1');
VpFieldLB.Items.Add('UserField2');
VpFieldLB.Items.Add('UserField3');
VpFieldLB.Items.Add('UserField4');
VpFieldLB.Items.Add('UserField5');
VpFieldLB.Items.Add('UserField6');
VpFieldLB.Items.Add('UserField7');
VpFieldLB.Items.Add('UserField8');
VpFieldLB.Items.Add('UserField9');
end;
if MC <> nil then
for I := 0 to pred(MC.Count) do begin
FM := TVpFieldMapping(MC.Items[I]);
{Delete mapped selection from the DatabaseFields list}
if (DatasetFieldLB.Items.IndexOf(FM.DBField) > -1) then
DatasetFieldLB.Items.Delete(DatasetFieldLB.Items.IndexOf(FM.DBField));
{Delete mapped selection from the VPFields List}
if (VPFieldLB.Items.IndexOf(FM.VPField) > -1) then
VPFieldLB.Items.Delete(VPFieldLB.Items.IndexOf(FM.VPField));
{Add the field mapping to the Field Mappings Listbox}
FieldMappingsLB.Items.Add(FM.DBField + ' -> ' + FM.VPField);
end;
{enable/disable buttons}
btnDeleteMapping.Enabled := false;
btnClearMappings.Enabled := FieldMappingsLB.Items.Count > 0;
btnAddMapping.Enabled := false;
VpFieldLB.ItemIndex := -1;
DatasetFieldLB.ItemIndex := -1;
end;
{=====}
procedure TfrmFieldMapper.DBFieldSelected(Sender: TObject);
begin
btnAddMapping.Enabled := (VpFieldLB.ItemIndex > -1);
end;
{=====}
procedure TfrmFieldMapper.DatasetFieldLBKeyPress(Sender: TObject;
var Key: Char);
begin
DbFieldSelected(sender);
end;
{=====}
procedure TfrmFieldMapper.VpFieldSelected(Sender: TObject);
begin
btnAddMapping.Enabled := (DatasetFieldLB.ItemIndex > -1);
end;
{=====}
procedure TfrmFieldMapper.VPFieldLBKeyPress(Sender: TObject;
var Key: Char);
begin
VpFieldSelected(Sender);
end;
{=====}
procedure TfrmFieldMapper.btnAddMappingClick(Sender: TObject);
var
FM: TVpFieldMapping;
MC: TCollection;
begin
MC := nil;
if DataSetCombo.Text = ResourceTableName then
MC := FlexDS.ResourceMappings
else if DataSetCombo.Text = EventsTableName then
MC := FlexDS.EventMappings
else if DataSetCombo.Text = ContactsTableName then
MC := FlexDS.ContactMappings
else if DataSetCombo.Text = TasksTableName then
MC := FlexDS.TaskMappings;
if MC <> nil then begin
FM := TVpFieldMapping(MC.Add);
FM.DBField := DatasetFieldLB.Items[DatasetFieldLB.ItemIndex];
FM.VPField := VPFieldLB.Items[VPFieldLB.ItemIndex];
SyncObjects;
end;
end;
{=====}
procedure TfrmFieldMapper.Button2Click(Sender: TObject);
begin
Close;
end;
{=====}
procedure TfrmFieldMapper.Button5Click(Sender: TObject);
begin
// Help;
end;
{=====}
procedure TfrmFieldMapper.btnDeleteMappingClick(Sender: TObject);
begin
if FieldMappingsLB.ItemIndex > -1 then begin
if DataSetCombo.Text = ResourceTableName then
FlexDS.ResourceMappings.Items[FieldMappingsLB.ItemIndex].Free
else if DataSetCombo.Text = EventsTableName then
FlexDS.EventMappings.Items[FieldMappingsLB.ItemIndex].Free
else if DataSetCombo.Text = ContactsTableName then
FlexDS.ContactMappings.Items[FieldMappingsLB.ItemIndex].Free
else if DataSetCombo.Text = TasksTableName then
FlexDS.TaskMappings.Items[FieldMappingsLB.ItemIndex].Free;
SyncObjects;
end;
end;
{=====}
procedure TfrmFieldMapper.btnClearMappingsClick(Sender: TObject);
var
MC: TCollection;
begin
MC := nil;
if FieldMappingsLB.Items.Count > 0 then begin
if DataSetCombo.Text = ResourceTableName then
MC := FlexDS.ResourceMappings
else if DataSetCombo.Text = EventsTableName then
MC := FlexDS.EventMappings
else if DataSetCombo.Text = ContactsTableName then
MC := FlexDS.ContactMappings
else if DataSetCombo.Text = TasksTableName then
MC := FlexDS.TaskMappings;
if MC <> nil then begin
while (MC.Count > 0) do
MC.Items[0].Free;
SyncObjects;
end;
end;
end;
{=====}
procedure TfrmFieldMapper.FieldMappingsLBClick(Sender: TObject);
begin
btnDeleteMapping.Enabled := FieldMappingsLB.ItemIndex > -1;
end;
{=====}
procedure TfrmFieldMapper.FieldMappingsLBKeyPress(Sender: TObject;
var Key: Char);
begin
FieldMappingsLBClick(Sender);
end;
{=====}
procedure TfrmFieldMapper.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
{reset all datasets to their original active status}
if ResDS <> nil then
ResDS.Active := DSResActive;
if EventsDS <> nil then
EventsDS.Active := DSEventActive;
if ContactsDS <> nil then
ContactsDS.Active := DSContactActive;
if TasksDS <> nil then
TasksDS.Active := DSTaskActive;
end;
{=====}
end.

550
components/tvplanit/source/vpledlabel.pas Normal file
View File

@ -0,0 +1,550 @@
{*********************************************************}
{* VPLEDLABEL.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 VpLEDLabel;
{- The LED Label that is used in the VpClock for digital display }
interface
{$I vp.inc}
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows, Messages,
{$ENDIF}
Classes, Controls, Graphics, SysUtils, VpBase;
type
TSegmentSize = 2..10;
TVpCustomLEDLabel = class(TGraphicControl)
protected{private}
FBgColor : TColor;
FOffColor : TColor;
FOnColor : TColor;
FColumns : Integer;
FRows : Integer;
FSize : TSegmentSize;
lbDrawBmp : TBitmap;
procedure CMTextChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF}); message CM_TEXTCHANGED;
procedure Initialize(var Points: array of TPoint);
function NewOffset(xOry: char; OldOffset: Integer): Integer;
procedure ProcessCaption(Points: array of TPoint);
procedure PaintSegment(Segment: Integer; Color: TColor;
Points: array of TPoint;
OffsetX, OffsetY: Integer);
procedure ResizeControl(Row, Col, Size: Integer);
function GetAbout: string;
procedure SetAbout(const Value: string);
procedure SetSize(Value: TSegmentSize);
procedure SetOnColor(Value: TColor);
procedure SetOffColor(Value: TColor);
procedure SetRows(Value: Integer);
procedure SetColumns(Value: Integer);
procedure SetbgColor(Value: TColor);
procedure SelectSegments(Segment: Word;
Points: array of TPoint;
OffsetX, OffsetY: Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
{properties}
property Version: string
read GetAbout write SetAbout stored False;
property Columns: Integer
read FColumns write SetColumns default 10;
property Rows: Integer
read FRows write SetRows default 1;
property BgColor: TColor
read FbgColor write SetbgColor default clBlack;
property OffColor: TColor
read FOffColor write SetOffColor default $00104E4A;
property OnColor: TColor
read FOnColor write SetOnColor default clYellow;
property Size: TSegmentSize
read FSize write SetSize default 2;
{Inherited properties}
property Caption;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
end;
TVpLEDLabel = class(TVpCustomLEDLabel)
published
property Version;
property Caption;
property Columns;
property Rows;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property BgColor;
property OffColor;
property OnColor;
property ParentShowHint;
property PopupMenu;
property Size;
property ShowHint;
property Visible;
end;
implementation
uses
VpConst;
{ LED Segment Map }
{ }
{ ------------------------ }
{ | 1 | }
{ ------------------------ }
{ | | \ | | / | | }
{ | | \ | | / | | }
{ | | \ | | / | | }
{ |2 |\3 \ |4 | /5 /|6 | }
{ | | \ \| |/ / | | }
{ | | \ | | / | | }
{ ----------- ----------- }
{ | 7 \/ 8 | }
{ -----------/\----------- }
{ | | / | | \ | | }
{ | | / /| |\ \ | | }
{ |9 |/10 / |11| \12 \|13| }
{ | | / | | \ | | }
{ | | / | | \ | | }
{ | | / | | \ | | }
{ ------------------------ |-----| }
{ | 14 | | * | }
{ ------------------------ |-----| }
{ }
{ * Period and comma are drawn here }
{ Colon is drawn in the center of }
{ segments 4 and 11 }
{ Each segment is made up of 6 points. The segments that don't need 6 points, }
{ such as the period and colon dots, return to the coordinates of the initial }
{ point for the remaining unused points. }
const
{LED SEGMENT ARRAYS}
MAX_POINTS = 107;
DigitPoints: array[0..MAX_POINTS] of TPoint =
{Segment 1}
((X:2;Y:2),(X:3;Y:1),(X:11;Y:1),(X:12;Y:2),(X:11;Y:3),(X:3;Y:3),
{Segment 2}
(X:2;Y:3),(X:3;Y:4),(X:3;Y:12),(X:2;Y:13),(X:1;Y:12),(X:1;Y:4),
{Segment 3}
(X:3;Y:3),(X:6;Y:9),(X:6;Y:13),(X:3;Y:7),(X:3;Y:3),(X:3;Y:3),
{Segment 4}
(X:7;Y:3),(X:8;Y:4),(X:8;Y:12),(X:7;Y:13),(X:6;Y:12),(X:6;Y:4),
{Segment 5}
(X:11;Y:3),(X:11;Y:7),(X:8;Y:13),(X:8;Y:9),(X:11;Y:3),(X:11;Y:3),
{Segment 6}
(X:12;Y:3),(X:13;Y:4),(X:13;Y:12),(X:12;Y:13),(X:11;Y:12),(X:11;Y:4),
{Segment 7}
(X:2;Y:14),(X:3;Y:13),(X:6;Y:13),(X:7;Y:14),(X:6;Y:15),(X:3;Y:15),
{Segment 8}
(X:7;Y:14),(X:8;Y:13),(X:11;Y:13),(X:12;Y:14),(X:11;Y:15),(X:8;Y:15),
{Segment 9}
(X:2;Y:15),(X:3;Y:16),(X:3;Y:24),(X:2;Y:25),(X:1;Y:24),(X:1;Y:16),
{Segment 10}
(X:6;Y:15),(X:6;Y:19),(X:3;Y:25),(X:3;Y:21),(X:6;Y:15),(X:6;Y:15),
{Segment 11}
(X:7;Y:15),(X:8;Y:16),(X:8;Y:24),(X:7;Y:25),(X:6;Y:24),(X:6;Y:16),
{Segment 12}
(X:8;Y:15),(X:11;Y:21),(X:11;Y:25),(X:8;Y:19),(X:8;Y:15),(X:8;Y:15),
{Segment 13}
(X:12;Y:15),(X:13;Y:16),(X:13;Y:24),(X:12;Y:25),(X:11;Y:24),(X:11;Y:16),
{Segment 14}
(X:2;Y:26),(X:3;Y:25),(X:11;Y:25),(X:12;Y:26),(X:11;Y:27),(X:3;Y:27),
{Period }
(X:14;Y:25),(X:16;Y:25),(X:16;Y:27),(X:14;Y:27),(X:14;Y:25),(X:14;Y:25),
{Comma }
(X:14;Y:25),(X:16;Y:25),(X:16;Y:27),(X:13;Y:30),(X:14;Y:27),(X:14;Y:25),
{Colon Top }
(X:5;Y:7),(X:9;Y:7),(X:9;Y:10),(X:5;Y:10),(X:5;Y:7),(X:5;Y:7),
{Colon Btm }
(X:5;Y:20),(X:9;Y:20),(X:9;Y:23),(X:5;Y:23),(X:5;Y:20),(X:5;Y:20));
Characters: Array[0..72] of Word =
($0000,$3B70,$1320,$0001,$0300,$0002,$0840,$CCCC,$1020,$8784,
{ ' ' * + , - . / 0 1 2 }
$870C,$4708,$C30C,$C38C,$8408,$C78C,$C70C,$0810,$2040,$C788,
{ 3 4 5 6 7 8 9 < > A }
$952C,$C084,$942C,$C384,$C380,$C18C,$4788,$9024,$048C,$4A90,
{ B C D E F G H I J K }
$4084,$6C88,$6498,$C48C,$C780,$C49E,$C790,$C214,$9020,$448C,
{ L M N O P Q R S T U }
$48C0,$44D8,$2850,$2820,$8844,$2010,$C788,$952C,$C084,$942C,
{ V W X Y Z / a b c d }
$C384,$C380,$C18C,$4788,$9024,$048C,$4A90,$4084,$6C88,$6498,
{ e f g h i j k l m n }
$C48C,$C780,$C49E,$C790,$C214,$9020,$448C,$48C0,$44D8,$2850,
{ o p q r s t u v w x }
$2820,$8844,$FFFF);
{ y z : }
CharacterNDX: Array[1..122] of integer =
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 2, 3, 4, 5, 6, 7, 8, 9,
10, 11, 12, 13, 14, 15, 16, 72, 0, 17, 0, 18, 0, 0, 19, 20, 21, 22, 23, 24,
25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43,
44, 0, 45, 0, 0, 0, 0, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44);
{===== TVpCustomLEDLabel ============================================}
constructor TVpCustomLEDLabel.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse,
csOpaque,
csSetCaption,
csClickEvents,
csDoubleClicks];
lbDrawBmp := TBitmap.Create;
Width := 170;
Height := 30;
FOnColor := clLime;
FOffColor := $000E3432;
FBgColor := clBlack;
FSize := 2;
FRows := 1;
FColumns := 10;
Caption := 'LED-LABEL';
end;
{=====}
destructor TVpCustomLEDLabel.Destroy;
begin
lbDrawBmp.Free;
lbDrawBmp := nil;
inherited Destroy;
end;
{=====}
function TVpCustomLEDLabel.GetAbout : string;
begin
Result := VpVersionStr;
end;
{=====}
procedure TVpCustomLEDLabel.SetAbout(const Value : string);
begin
{Leave empty}
end;
{=====}
procedure TVpCustomLEDLabel.CMTextChanged(var Message: {$IFDEF LCL}TLMessage{$ELSE}TMessage{$ENDIF});
begin
inherited;
Invalidate;
end;
{=====}
procedure TVpCustomLEDLabel.Initialize(var Points: array of TPoint);
var
I : Integer;
begin
for I := 0 to MAX_POINTS do begin
Points[i].X := DigitPoints[i].X * (FSize - 1);
Points[i].Y := DigitPoints[i].Y * (FSize - 1);
end;
end;
{=====}
function TVpCustomLEDLabel.NewOffset(xOry:char;oldOffset:integer):integer;
begin
if (xOry = 'x')then
newOffset := oldOffset + 17 * (FSize - 1)
else
newOffset := oldOffset + 30 * (FSize -1)
end;
{=====}
procedure TVpCustomLEDLabel.Paint;
var
Points: array[0..MAX_POINTS] of TPoint;
begin
lbDrawBMP.Width := Width;
lbDrawBMP.Height := Height;
Initialize(Points);
lbDrawBMP.Canvas.Brush.Color := FBgColor;
lbDrawBMP.Canvas.FillRect(ClientRect);
ProcessCaption(Points);
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, lbDrawBMP);
end;
{=====}
procedure TVpCustomLEDLabel.PaintSegment(Segment: Integer; Color: TColor;
Points: array of TPoint;
OffsetX, OffsetY: Integer);
var
I: Integer;
DrawPts: array[0..5] of TPoint;
begin
Dec(Segment);
lbDrawBMP.Canvas.Pen.Style := psClear;
lbDrawBMP.Canvas.Brush.Color := Color;
for i := 0 to 5 do begin
DrawPts[i].X := offsetX + Points[Segment * 6 + i].X;
DrawPts[i].Y := offsetY + Points[Segment * 6 + i].Y;
end;
lbDrawBMP.Canvas.Polygon(DrawPts);
end;
{=====}
procedure TVpCustomLEDLabel.SelectSegments(Segment: word; Points: array of TPoint;
OffsetX, OffsetY: Integer);
var
I : integer;
Bit : word;
Color : TColor;
Skip : Boolean;
begin
if (Segment and $FFFF) = $FFFF then begin
Color := FOnColor;
PaintSegment(17, Color, Points, OffsetX, OffsetY);
PaintSegment(18, Color, Points, OffsetX, OffsetY);
end
else begin
Bit := $8000;
for I := 1 to 16 do begin
Skip := False;
if (Segment and Bit) = Bit then
Color := FOnColor
else begin
if (i = 15) or (i = 16) then
Skip := True;
Color := FOffColor;
end;
if (not Skip) and (Color <> FBgColor) then
PaintSegment(I, Color, Points, OffsetX, OffsetY);
Bit := Bit div 2;
end;
end;
end;
{=====}
procedure TVpCustomLEDLabel.ProcessCaption(Points: array of TPoint);
var
Next : Char;
Last : Char;
I, X : Integer;
Row, ColsPerRow: Integer;
Tmp : Integer;
OffsetX : Integer;
OffsetY : Integer;
DisplayStr : string;
begin
Last := #0;
OffsetX := FSize;
OffsetY := 0;
DisplayStr := Caption;
if Length(DisplayStr) > 0 then
if (DisplayStr[1] = ',') or (DisplayStr[1] = '.') then
DisplayStr := ' ' + DisplayStr;
Row := 1;
ColsPerRow := 0;
for I := 1 to Length(Caption) do begin
Next := Caption[I];
case Ord(Next) of
42..58,60,62,65..90,92,97..122: begin
if ColsPerRow = FColumns then begin
Row := Row + 1;
if Row > FRows then
exit;
offsetY := newOffset('y',offsetY);
offsetX := FSize;
ColsPerRow := 0
end;
if (Next = '.') or (Next = ',') then
if (Last = '.') or (Last = ',') then begin
SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points,
OffsetX, OffsetY);
OffsetX := NewOffset('x', OffsetX);
end
else begin
OffsetX := OffsetX - (17 * (FSize - 1));
Tmp := (Characters[CharacterNDX[Ord(Next)]]
or Characters[CharacterNDX[Ord(Last)]]);
SelectSegments(Tmp, Points, OffsetX, OffsetY);
OffsetX := NewOffset('x', OffsetX);
end
else begin
SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points, OffsetX,
OffsetY);
offsetX := NewOffset('x', OffsetX);
ColsPerRow := ColsPerRow + 1;
end;
end;
10: begin {eat linefeed}
end;
13: begin
if ColsPerRow < FColumns then
for x := 1 to (FColumns - ColsPerRow) do begin
SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
OffsetX := NewOffset('x', OffsetX);
end;
Row := Row + 1;
if Row > FRows then
exit;
OffsetY := NewOffset('y', OffsetY);
OffsetX := FSize;
ColsPerRow := 0;
end;
else begin
if ColsPerRow = FColumns then begin
Row := Row + 1;
if Row > FRows then
Exit;
OffsetY := NewOffset('y', OffsetY);
OffsetX := FSize;
ColsPerRow := 0;
end;
SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
OffsetX := newOffset('x', OffsetX);
ColsPerRow := ColsPerRow + 1;
end;
end;
Last := Next;
end;
for x := 1 to (FColumns - ColsPerRow) do begin
SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
OffsetX := NewOffset('x', OffsetX);
end;
if (FColumns * FRows) > Length(caption) then begin
for X := Row + 1 to FRows do begin
OffsetX := FSize;
OffsetY := NewOffset('y', OffsetY);
for I := 1 to FColumns do begin
SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
OffsetX := NewOffset('x', OffsetX);
end;
end;
end;
end;
{=====}
procedure TVpCustomLEDLabel.ResizeControl(Row, Col, Size: Integer);
begin
FRows := Row;
FColumns := Col;
FSize := Size;
SetBounds(Left, Top, FColumns * 17 * (FSize - 1), FRows * 30 * (FSize - 1));
Invalidate;
end;
{=====}
procedure TVpCustomLEDLabel.SetBgColor(Value:TColor);
begin
if FBgColor <> Value then begin
FBgColor := Value;
Invalidate;
end;
end;
{=====}
procedure TVpCustomLEDLabel.SetOnColor(Value:TColor);
begin
if FOnColor <> Value then begin
FOnColor := Value;
Invalidate;
end;
end;
{=====}
procedure TVpCustomLEDLabel.SetOffColor(Value:TColor);
begin
if FOffColor <> Value then begin
FOffColor := Value;
Invalidate;
end;
end;
{=====}
procedure TVpCustomLEDLabel.SetRows(Value : Integer);
begin
if FRows <> Value then begin
if Value < 1 then
Value := 1;
ResizeControl(Value, FColumns, FSize);
end;
end;
{=====}
procedure TVpCustomLEDLabel.SetColumns(Value : Integer);
begin
if FColumns <> Value then begin
if Value < 1 then
Value := 1;
ResizeControl(FRows, Value, FSize);
end;
end;
{=====}
procedure TVpCustomLEDLabel.SetSize(Value : TSegmentSize);
begin
if FSize <> Value then begin
if Value < 2 then
Value := 2;
if Value > 10 then
Value := 10;
ResizeControl(FRows, FColumns, Value);
end;
end;
{=====}
end.

827
components/tvplanit/source/vplocalize.pas Normal file
View File

@ -0,0 +1,827 @@
{*********************************************************}
{* VPLOCALIZE.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 VpLocalize;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Classes,
Dialogs,
SysUtils,
Graphics,
StdCtrls,
VpBase,
VpMisc,
VpData,
VpXParsr,
VpPrtFmt, { For TVpAttributes }
Forms;
type
TVpLocalizeLanguage = class;
TVpLocalizeLanguageItem = class (TVpCollectionItem)
private
FCollection : TVpLocalizeLanguage;
FLanguageID : Integer;
FSubLanguageID : Integer;
FName : string;
protected
public
constructor Create (Collection : TCollection); override;
destructor Destroy; override;
published
property Collection : TVpLocalizeLanguage read FCollection write FCollection;
property LanguageID : Integer read FLanguageID write FLanguageID;
property Name : string read FName write FName;
property SubLanguageID : Integer read FSubLanguageID write FSubLanguageID;
end;
TVpLocalizeLanguage = class (TCollection)
private
FOwner : TPersistent;
protected
function GetItem (Index : Integer) : TVpLocalizeLanguageItem;
function GetOwner : TPersistent; override;
procedure SetItem (Index : Integer; Value : TVpLocalizeLanguageItem);
public
constructor Create (AOwner : TPersistent);
{$IFNDEF VERSION5}
procedure Delete (Item : integer);
{$ENDIF}
function HasLanguage (ALanguage : Integer) : Integer;
function HasSubLanguage (ALanguage : Integer;
ASubLanguage : Integer) : Integer;
property Items[Index : Integer] : TVpLocalizeLanguageItem
read GetItem write SetItem;
end;
TVpLocalizeStates = class;
TVpLocalizeStatesItem = class (TVpCollectionItem)
private
FCollection : TVpLocalizeStates;
FName : string;
FAbbr : string;
protected
public
constructor Create (Collection : TCollection); override;
destructor Destroy; override;
published
property Collection : TVpLocalizeStates read FCollection write FCollection;
property Name : string read FName write FName;
property Abbr : string read FAbbr write FAbbr;
end;
TVpLocalizeStates = class (TCollection)
private
FOwner : TPersistent;
protected
function GetItem (Index : Integer) : TVpLocalizeStatesItem;
function GetOwner : TPersistent; override;
procedure SetItem (Index : Integer; Value : TVpLocalizeStatesItem);
public
constructor Create (AOwner : TPersistent);
{$IFNDEF VERSION5}
procedure Delete (Item : integer);
{$ENDIF}
property Items[Index : Integer] : TVpLocalizeStatesItem
read GetItem write SetItem;
end;
TVpLocalizeCountry = class;
TVpLocalizeCountryItem = class (TVpCollectionItem)
private
FCollection : TVpLocalizeCountry;
FStates : TVpLocalizeStates;
FLanguages : TVpLocalizeLanguage;
FName : string;
FAddress1Visible : Boolean;
FAddress1Caption : string;
FAddress2Visible : Boolean;
FAddress2Caption : string;
FAddress3Visible : Boolean;
FAddress3Caption : string;
FAddress4Visible : Boolean;
FAddress4Caption : string;
FCityVisible : Boolean;
FCityCaption : string;
FStatesVisible : Boolean;
FStateUseAbbr : Boolean;
FStateDupAbbr : Boolean;
FStateCaption : string;
FZipVisible : Boolean;
FZipCaption : string;
protected
public
constructor Create (Collection : TCollection); override;
destructor Destroy; override;
published
property Collection : TVpLocalizeCountry read FCollection write FCollection;
property Languages : TVpLocalizeLanguage read FLanguages write FLanguages;
property Name : string read FName write FName;
property Address1Visible : Boolean read FAddress1Visible write FAddress1Visible;
property Address1Caption : string read FAddress1Caption write FAddress1Caption;
property Address2Visible : Boolean read FAddress2Visible write FAddress2Visible;
property Address2Caption : string read FAddress2Caption write FAddress2Caption;
property Address3Visible : Boolean read FAddress3Visible write FAddress3Visible;
property Address3Caption : string read FAddress3Caption write FAddress3Caption;
property Address4Visible : Boolean read FAddress4Visible write FAddress4Visible;
property Address4Caption : string read FAddress4Caption write FAddress4Caption;
property CityVisible : Boolean read FCityVisible write FCityVisible;
property CityCaption : string read FCityCaption write FCityCaption;
property StatesVisible : Boolean read FStatesVisible write FStatesVisible;
property StateUseAbbr : Boolean read FStateUseAbbr write FStateUseAbbr;
property StateDupAbbr : Boolean read FStateDupAbbr write FStateDupAbbr;
property StateCaption : string read FStateCaption write FStateCaption;
property ZipVisible : Boolean read FZipVisible write FZipVisible;
property ZipCaption : string read FZipCaption write FZipCaption;
property States : TVpLocalizeStates read FStates write FStates;
end;
TVpLocalizeCountry = class (TCollection)
private
FOwner : TPersistent;
protected
function GetItem (Index : Integer) : TVpLocalizeCountryItem;
function GetOwner : TPersistent; override;
procedure SetItem (Index : Integer; Value : TVpLocalizeCountryItem);
public
constructor Create (AOwner : TPersistent);
{$IFNDEF VERSION5}
procedure Delete (Item : integer);
{$ENDIF}
property Items[Index : Integer] : TVpLocalizeCountryItem
read GetItem write SetItem;
end;
TVpLocalization = class (TObject)
private
FCountries : TVpLocalizeCountry;
FAttributes : TVpAttributes;
FLoadingIndex : Integer;
FElementIndex : Integer;
protected
procedure xmlLocalizeAttribute (oOwner : TObject;
sName,
sValue : DOMString;
bSpecified : Boolean);
procedure xmlLocalizeEndElement (oOwner : TObject;
sValue : DOMString);
procedure xmlLocalizeStartElement (oOwner : TObject;
sValue : DOMString);
public
constructor Create;
destructor Destroy; override;
procedure CountriesByLanguage (ALanguage : Integer;
AStrings : TStrings);
procedure CountriesBySubLanguage (ALanguage : Integer;
ASubLanguage : Integer;
AStrings : TStrings);
function CountryNameToIndex (ACountry : string) : Integer;
procedure CountriesToTStrings (AStrings : TStrings);
function GetCurrentCountry : Integer;
function GetCountryByLanguage (ALanguage : Integer) : Integer;
function GetCountryBySubLanguage (ALanguage : Integer;
ASubLanguage : Integer) : Integer;
procedure LoadFromFile (const FileName : string;
const Append : Boolean);
function StateNameToIndex (ACountry : Integer;
AState : string) : Integer;
procedure StatesToTStrings (ACountry : Integer;
AStrings : TStrings);
published
property Countries : TVpLocalizeCountry read FCountries write FCountries;
end;
implementation
constructor TVpLocalizeLanguageItem.Create (Collection : TCollection);
begin
inherited Create (Collection);
FCollection := TVpLocalizeLanguage.Create (TVpLocalizeLanguage (Collection).FOwner);
FLanguageID := -1;
FSubLanguageID := -1;
FName := '';
end;
destructor TVpLocalizeLanguageItem.Destroy;
begin
FCollection.Free;
FCollection := nil;
inherited Destroy;
end;
constructor TVpLocalizeLanguage.Create(AOwner : TPersistent);
begin
inherited Create (TVpLocalizeLanguageItem);
FOwner := AOwner;
end;
{=====}
{$IFNDEF VERSION5}
procedure TVpLocalizeLanguage.Delete(Item: integer);
begin
GetItem(Item).Free;
end;
{=====}
{$ENDIF}
function TVpLocalizeLanguage.GetItem (Index : Integer) : TVpLocalizeLanguageItem;
begin
Result := TVpLocalizeLanguageItem (inherited GetItem (Index));
end;
{=====}
function TVpLocalizeLanguage.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
function TVpLocalizeLanguage.HasLanguage (ALanguage : Integer) : Integer;
var
i : Integer;
begin
Result := -1;
for i := 0 to Count - 1 do
if Items[i].LanguageID = ALanguage then begin
Result := i;
Break;
end;
end;
function TVpLocalizeLanguage.HasSubLanguage (ALanguage : Integer;
ASubLanguage : Integer) : Integer;
var
i : Integer;
begin
Result := -1;
for i := 0 to Count - 1 do
if (Items[i].LanguageID = ALanguage) and
(Items[i].SubLanguageID = ASubLanguage) then begin
Result := i;
Break;
end;
end;
procedure TVpLocalizeLanguage.SetItem (Index : Integer; Value : TVpLocalizeLanguageItem);
begin
inherited SetItem (Index, Value);
end;
{=====}
constructor TVpLocalizeStatesItem.Create (Collection : TCollection);
begin
inherited Create (Collection);
FCollection := TVpLocalizeStates.Create (TVpLocalizeStates (Collection).FOwner);
FName := '';
FAbbr := '';
end;
destructor TVpLocalizeStatesItem.Destroy;
begin
FCollection.Free;
FCollection := nil;
inherited Destroy;
end;
constructor TVpLocalizeStates.Create(AOwner : TPersistent);
begin
inherited Create (TVpLocalizeStatesItem);
FOwner := AOwner;
end;
{=====}
{$IFNDEF VERSION5}
procedure TVpLocalizeStates.Delete(Item: integer);
begin
GetItem(Item).Free;
end;
{=====}
{$ENDIF}
function TVpLocalizeStates.GetItem (Index : Integer) : TVpLocalizeStatesItem;
begin
Result := TVpLocalizeStatesItem (inherited GetItem (Index));
end;
{=====}
function TVpLocalizeStates.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpLocalizeStates.SetItem (Index : Integer; Value : TVpLocalizeStatesItem);
begin
inherited SetItem (Index, Value);
end;
{=====}
constructor TVpLocalizeCountryItem.Create (Collection : TCollection);
begin
inherited Create (Collection);
FCollection := TVpLocalizeCountry.Create (TVpLocalizeCountry (Collection).FOwner);
FStates := TVpLocalizeStates.Create (Self);
FLanguages := TVpLocalizeLanguage.Create (nil);
FName := '';
FAddress1Visible := True;
FAddress1Caption := 'Address';
FAddress2Visible := True;
FAddress2Caption := '';
FAddress3Visible := True;
FAddress3Caption := '';
FAddress4Visible := False;
FAddress4Caption := '';
FCityVisible := True;
FCityCaption := 'City';
FStatesVisible := True;
FStateUseAbbr := False;
FStateDupAbbr := False;
FStateCaption := 'Province';
FZipVisible := True;
FZipCaption := 'Postal Code';
end;
destructor TVpLocalizeCountryItem.Destroy;
begin
FCollection.Free;
FCollection := nil;
FStates.Free;
FStates := nil;
FLanguages.Free;
FLanguages := nil;
inherited Destroy;
end;
constructor TVpLocalizeCountry.Create(AOwner : TPersistent);
begin
inherited Create (TVpLocalizeCountryItem);
FOwner := AOwner;
end;
{=====}
{$IFNDEF VERSION5}
procedure TVpLocalizeCountry.Delete(Item: integer);
begin
GetItem(Item).Free;
end;
{=====}
{$ENDIF}
function TVpLocalizeCountry.GetItem (Index : Integer) : TVpLocalizeCountryItem;
begin
Result := TVpLocalizeCountryItem (inherited GetItem (Index));
end;
{=====}
function TVpLocalizeCountry.GetOwner : TPersistent;
begin
Result := FOwner;
end;
{=====}
procedure TVpLocalizeCountry.SetItem (Index : Integer; Value : TVpLocalizeCountryItem);
begin
inherited SetItem (Index, Value);
end;
{=====}
constructor TVpLocalization.Create;
begin
inherited Create;
Countries := TVpLocalizeCountry.Create (nil);
FAttributes :=TVpAttributes.Create (nil);
end;
destructor TVpLocalization.Destroy;
begin
Countries.Free;
FAttributes.Free;
inherited Destroy;
end;
procedure TVpLocalization.CountriesByLanguage (ALanguage : Integer;
AStrings : TStrings);
var
i : Integer;
begin
AStrings.Clear;
for i := 0 to Countries.Count - 1 do
if Countries.Items[i].Languages.HasLanguage (ALanguage) >= 0 then
AStrings.Add (Countries.Items[i].Name);
end;
procedure TVpLocalization.CountriesBySubLanguage (ALanguage : Integer;
ASubLanguage : Integer;
AStrings : TStrings);
var
i : Integer;
begin
AStrings.Clear;
for i := 0 to Countries.Count - 1 do
if Countries.Items[i].Languages.HasSubLanguage (ALanguage, ASubLanguage) >= 0 then
AStrings.Add (Countries.Items[i].Name);
end;
function TVpLocalization.CountryNameToIndex (ACountry : string) : Integer;
var
i : Integer;
CLen : Integer;
begin
Result := -1;
if ACountry = '' then
Exit;
ACountry := LowerCase (ACountry);
CLen := Length (ACountry);
for i := 0 to FCountries.Count - 1 do
if ACountry = Copy (LowerCase (FCountries.Items[i].Name), 1, CLen) then begin
Result := i;
Exit;
end;
end;
procedure TVpLocalization.CountriesToTStrings (AStrings : TStrings);
var
i : Integer;
begin
AStrings.Clear;
for i := 0 to FCountries.Count - 1 do
AStrings.Add (FCountries.Items[i].Name);
end;
function TVpLocalization.GetCurrentCountry : Integer;
function SubLangID (LanguageID : Word) : Word;
begin
Result := LanguageID shr 10;
end;
function PrimaryLangID (LanguageID : Word) : Word;
begin
Result := LanguageID and $3FF;
end;
var
LangId : Word;
Primary : Word;
Secondary : Word;
begin
//TODO:
{
LangId := GetUserDefaultLangID;
Primary := PrimaryLangID (LangID);
Secondary := SubLangID (LangID);
if Secondary > 0 then
Result := Self.GetCountryBySubLanguage (Primary, Secondary)
else
Result := Self.GetCountryByLanguage (Primary);
}
end;
function TVpLocalization.GetCountryByLanguage (ALanguage : Integer) : Integer;
var
i : Integer;
begin
Result := -1;
for i := 0 to Countries.Count - 1 do
if Countries.Items[i].Languages.HasLanguage (ALanguage) >= 0 then begin
Result := i;
Break;
end;
end;
function TVpLocalization.GetCountryBySubLanguage (ALanguage : Integer;
ASubLanguage : Integer) : Integer;
var
i : Integer;
begin
Result := -1;
for i := 0 to Countries.Count - 1 do
if Countries.Items[i].Languages.HasSubLanguage (ALanguage,
ASubLanguage) >= 0 then begin
Result := i;
Break;
end;
end;
procedure TVpLocalization.LoadFromFile (const FileName : string;
const Append : Boolean);
var
Parser : TVpParser;
begin
if not Append then
FCountries.Clear;
FLoadingIndex := -1;
FElementIndex := -1;
Parser := TVpParser.Create (nil);
Parser.OnAttribute := xmlLocalizeAttribute;
Parser.OnStartElement := xmlLocalizeStartElement;
Parser.OnEndElement := xmlLocalizeEndElement;
try
Parser.ParseDataSource (FileName);
finally
Parser.Free;
end;
FLoadingIndex := -1;
FElementIndex := -1;
end;
function TVpLocalization.StateNameToIndex (ACountry : Integer;
AState : string) : Integer;
var
i : Integer;
begin
Result := -1;
if (ACountry < 0) or (ACountry >= FCountries.Count) then
Exit;
AState := LowerCase (AState);
for i := 0 to FCountries.Items[ACountry].States.Count - 1 do
if AState = LowerCase (FCountries.Items[ACountry].States.Items[i].Name) then begin
Result := i;
Exit;
end;
end;
procedure TVpLocalization.StatesToTStrings (ACountry : Integer;
AStrings : TStrings);
var
i : Integer;
begin
AStrings.Clear;
if (ACountry < 0) or (ACountry >= FCountries.Count) then
Exit;
for i := 0 to FCountries.Items[ACountry].States.Count - 1 do
AStrings.Add (FCountries.Items[ACountry].States.Items[i].Name);
end;
procedure TVpLocalization.xmlLocalizeAttribute (oOwner : TObject;
sName,
sValue : DOMString;
bSpecified : Boolean);
var
Item : TVpAttributeItem;
begin
Item := TVpAttributeItem (FAttributes.Add);
Item.Name := sName;
Item.Value := sValue;
end;
procedure TVpLocalization.xmlLocalizeEndElement (oOwner : TObject;
sValue : DOMString);
begin
if (sValue = 'Country') or (sValue = 'Countries') or
(sValue = 'AddressDefinition') then begin
FLoadingIndex := -1;
FElementIndex := -1;
end else if sValue = 'State' then
FElementIndex := -1;
FAttributes.Clear;
end;
procedure TVpLocalization.xmlLocalizeStartElement (oOwner : TObject;
sValue : DOMString);
function GetBooleanValue (AString : string;
ADefault : Boolean) : Boolean;
begin
Result := ADefault;
AString := LowerCase (AString);
if (AString = 't') or (AString = 'true') or (AString = '1') or
(AString = 'on') or (AString = 'yes') then
Result := True
else if (AString= 'f') or (AString = 'false') or (AString = '0') or
(AString = 'off') or (AString = 'no') then
Result := False;
end;
function GetIntegerValue (AString : string;
ADefault : Integer) : Integer;
begin
try
Result := StrToInt (AString);
except on EConvertError do
Result := ADefault;
end;
end;
var
i : Integer;
NewItem : TVpLocalizeCountryItem;
NewElement : TVpLocalizeStatesItem;
NewLanguage : TVpLocalizeLanguageItem;
begin
if sValue = 'Countries' then begin
FLoadingIndex := -1;
FElementIndex := -1;
end else if sValue = 'Country' then begin
NewItem := TVpLocalizeCountryItem (FCountries.Add);
FLoadingIndex := NewItem.Index;
for i := 0 to FAttributes.Count - 1 do begin
if (FAttributes.Items[i].Name = 'Name') and
(Fattributes.Items[i].Value <> '') then
NewItem.Name := FAttributes.Items[i].Value;
end
end else if sValue = 'State' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].StateCaption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'DupAbbr' then
FCountries.Items[FLoadingIndex].StateDupAbbr :=
GetBooleanValue (FAttributes.Items[i].Value, False)
else if FAttributes.Items[i].Name = 'UseAbbr' then
FCountries.Items[FLoadingIndex].StateUseAbbr :=
GetBooleanValue (FAttributes.Items[i].Value, False)
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].StatesVisible :=
GetBooleanValue (FAttributes.Items[i].Value, True);
end;
end else if sValue = 'Address1' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].Address1Caption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].Address1Visible :=
GetBooleanValue (FAttributes.Items[i].Value, True);
end;
end else if sValue = 'Address2' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].Address2Caption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].Address2Visible :=
GetBooleanValue (FAttributes.Items[i].Value, True);
end;
end else if sValue = 'Address3' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].Address3Caption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].Address3Visible :=
GetBooleanValue (FAttributes.Items[i].Value, True);
end;
end else if sValue = 'Address4' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].Address4Caption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].Address4Visible :=
GetBooleanValue (FAttributes.Items[i].Value, False);
end;
end else if sValue = 'City' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].CityCaption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].CityVisible :=
GetBooleanValue (FAttributes.Items[i].Value, True);
end;
end else if sValue = 'Zipcode' then begin
if FLoadingIndex < 0 then
Exit;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Caption' then
FCountries.Items[FLoadingIndex].ZipCaption := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Visible' then
FCountries.Items[FLoadingIndex].ZipVisible :=
GetBooleanValue (FAttributes.Items[i].Value, True);
end;
end else if sValue = 'LegalValue' then begin
if FLoadingIndex < 0 then
Exit;
NewElement := TVpLocalizeStatesItem (FCountries.Items[FLoadingIndex].States.Add);
FElementIndex := NewElement.Index;
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Name' then
NewElement.Name := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'Value' then
NewElement.Abbr := FAttributes.Items[i].Value;
end;
end else if sValue = 'Language' then begin
if FLoadingIndex < 0 then
Exit;
NewLanguage := TVpLocalizeLanguageItem (FCountries.Items[FLoadingIndex].Languages.Add);
for i := 0 to FAttributes.Count - 1 do begin
if FAttributes.Items[i].Name = 'Name' then
NewLanguage.Name := FAttributes.Items[i].Value
else if FAttributes.Items[i].Name = 'ID' then
NewLanguage.LanguageID := GetIntegerValue (FAttributes.Items[i].Value, -1)
else if FAttributes.Items[i].Name = 'SubID' then
NewLanguage.SubLanguageID := GetIntegerValue (FAttributes.Items[i].Value, -1);
end;
end;
FAttributes.Clear;
end;
end.

10456
components/tvplanit/source/vplocalize.xml Normal file
View File

File diff suppressed because it is too large Load Diff

575
components/tvplanit/source/vpmisc.pas Normal file
View File

@ -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.

1695
components/tvplanit/source/vpmonthview.pas Normal file
View File

File diff suppressed because it is too large Load Diff

347
components/tvplanit/source/vpnabed.lfm Normal file
View File

@ -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

611
components/tvplanit/source/vpnabed.pas Normal file
View File

@ -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.

3097
components/tvplanit/source/vpnavbar.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2935
components/tvplanit/source/vpprtfmt.pas Normal file
View File

File diff suppressed because it is too large Load Diff

284
components/tvplanit/source/vpprtfmtcbox.pas Normal file
View File

@ -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.

130
components/tvplanit/source/vpprtfmtdlg.pas Normal file
View File

@ -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.

112
components/tvplanit/source/vpprtfmted.pas Normal file
View File

@ -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.

1354
components/tvplanit/source/vpprtprv.pas Normal file
View File

File diff suppressed because it is too large Load Diff

378
components/tvplanit/source/vpprtprvdlg.lfm Normal file
View File

@ -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

420
components/tvplanit/source/vpprtprvdlg.pas Normal file
View File

@ -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.

414
components/tvplanit/source/vpreg.pas Normal file
View File

@ -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.

BIN
components/tvplanit/source/vpreg.res Normal file
View File

Binary file not shown.

57
components/tvplanit/source/vpregad.pas Normal file
View File

@ -0,0 +1,57 @@
{*********************************************************}
{* VPREGAD.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 }
{$R VpReg.RES} { Palette Glyphs }
unit VpRegAd;
{-Registration unit for the Advantage Database support}
interface
uses
Windows, Dialogs,
{$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF}
Classes, Controls, TypInfo;
procedure Register;
implementation
uses
SysUtils, Forms, Graphics, VpAdvDS;
{*** component registration ***}
procedure Register;
begin
RegisterComponents('Visual PlanIt', [TVpAdvDataStore]);
end;
end.

57
components/tvplanit/source/vpregf2.pas Normal file
View File

@ -0,0 +1,57 @@
{*********************************************************}
{* VPREGF2.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 }
{$R VpReg.RES} { Palette Glyphs }
unit VpRegF2;
{-Registration unit for FlashFiler 2.x support}
interface
uses
Windows,
{$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF}
Classes, Controls, TypInfo, VpFF2DS;
procedure Register;
implementation
uses
SysUtils, Forms, Graphics;
{*** component registration ***}
procedure Register;
begin
RegisterComponents('Visual PlanIt', [TVpFF2DataStore]);
end;
end.

56
components/tvplanit/source/vpregis.pas Normal file
View File

@ -0,0 +1,56 @@
{*********************************************************}
{* VPREGIS.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 }
{$R VpReg.RES} { Palette Glyphs }
unit VpRegIs;
{-Registration unit for the DBISAM support}
interface
uses
Windows,
{$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF}
Classes, Controls, TypInfo, VpDbIsamDS;
procedure Register;
implementation
uses
SysUtils, Forms, Graphics;
{*** component registration ***}
procedure Register;
begin
RegisterComponents('Visual PlanIt', [TVpDBISAMDataStore]);
end;
end.

133
components/tvplanit/source/vpreseditdlg.lfm Normal file
View File

@ -0,0 +1,133 @@
object ResEditForm: TResEditForm
Left = 280
Height = 250
Top = 234
Width = 400
HorzScrollBar.Page = 399
VertScrollBar.Page = 249
Caption = 'Resource Edit'
ClientHeight = 250
ClientWidth = 400
Constraints.MinHeight = 250
Constraints.MinWidth = 400
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
OnShow = FormShow
object pnlBottom: TPanel
Height = 41
Top = 209
Width = 400
Align = alBottom
BevelOuter = bvNone
ClientHeight = 41
ClientWidth = 400
TabOrder = 0
object OKBtn: TButton
Left = 245
Height = 25
Top = 9
Width = 75
Anchors = [akRight, akBottom]
Caption = 'OK'
Default = True
OnClick = OKBtnClick
TabOrder = 0
TabStop = False
end
object CancelBtn: TButton
Left = 324
Height = 25
Top = 9
Width = 75
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
OnClick = CancelBtnClick
TabOrder = 1
TabStop = False
end
end
object pgResource: TPageControl
Height = 209
Width = 400
TabStop = False
ActivePage = tabResource
Align = alClient
TabIndex = 0
TabOrder = 1
object tabResource: TTabSheet
Caption = 'Resource'
ClientHeight = 176
ClientWidth = 396
object lblDescription: TLabel
Left = 8
Height = 15
Top = 24
Width = 77
Caption = 'Description:'
ParentColor = False
end
object lblNotes: TLabel
Left = 8
Height = 15
Top = 47
Width = 43
Caption = 'Notes:'
ParentColor = False
end
object imgResources: TImage
Left = 348
Height = 32
Top = 16
Width = 32
Anchors = [akTop]
AutoSize = True
Picture.Data = {
07544269746D617076020000424D760200000000000076000000280000002000
0000200000000100040000000000000200000000000000000000100000001000
0000000000000000800000800000008080008000000080008000808000008080
8000C0C0C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
FF00333333333333333000033773333333333333333333333008B37077773333
33333333333333300B3BB337007777333333333333300000BB3BB33707077777
3333333330088000BB3BB393071077777733333008488450BB3BB39907110777
7733333088688450BB3BB399071107773333333088488440BB3BB39907110733
3333333088488540BB3BB399071103333333333088488440BB3BB39107110333
3333333088488410BB3BBB11171103333333333088488408BBBBBB3307110333
333333308848840BBBBBBB3930110333333333308848880BBBBBBB3971700333
333333078888870BBBBBBB3970710333333333088888880BBBBBBB3931711033
333333088888880BBBBBBB3931711033333333078888780BBBBBBB3931711033
333333088888880BBBBBB833317110333333330887888808BB888B8871711033
3333330788788808FF37373780715033333333088787FF00830000700F711033
3333330878FF88808077370F8888503333333308FF0044400388831011118033
3333333087000040088F877000100333333333308077770308FFF87077033333
33333333077877400FFF8760771033333333333308F8887030F8760887503333
3333333308FFF770330007FFF7703333333333330FFFF870333308FF88603333
3333333330F87703333330F87703333333333333330005333333330000333333
3333
}
end
object DescriptionEdit: TEdit
Left = 80
Height = 21
Top = 20
Width = 253
Anchors = [akTop, akLeft, akRight]
MaxLength = 255
OnChange = Change
TabOrder = 0
end
object NotesMemo: TMemo
Left = 8
Height = 77
Top = 67
Width = 373
Anchors = [akTop, akLeft, akRight, akBottom]
MaxLength = 1024
OnChange = Change
ScrollBars = ssVertical
TabOrder = 1
end
end
end
end

53
components/tvplanit/source/vpreseditdlg.lrs Normal file
View File

@ -0,0 +1,53 @@
{ Das ist eine automatisch erzeugte Lazarus-Ressourcendatei }
LazarusResources.Add('TResEditForm','FORMDATA',[
'TPF0'#12'TResEditForm'#11'ResEditForm'#4'Left'#3#24#1#6'Height'#3#250#0#3'To'
+'p'#3#234#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar'
+'.Page'#3#249#0#7'Caption'#6#13'Resource Edit'#12'ClientHeight'#3#250#0#11'C'
+'lientWidth'#3#144#1#21'Constraints.MinHeight'#3#250#0#20'Constraints.MinWid'
+'th'#3#144#1#11'Font.Height'#2#245#9'Font.Name'#6#13'MS Sans Serif'#8'OnCrea'
+'te'#7#10'FormCreate'#6'OnShow'#7#8'FormShow'#0#6'TPanel'#9'pnlBottom'#6'Hei'
+'ght'#2')'#3'Top'#3#209#0#5'Width'#3#144#1#5'Align'#7#8'alBottom'#10'BevelOu'
+'ter'#7#6'bvNone'#12'ClientHeight'#2')'#11'ClientWidth'#3#144#1#8'TabOrder'#2
+#0#0#7'TButton'#5'OKBtn'#4'Left'#3#245#0#6'Height'#2#25#3'Top'#2#9#5'Width'#2
+'K'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#2'OK'#7'Default'#9#7
+'OnClick'#7#10'OKBtnClick'#8'TabOrder'#2#0#7'TabStop'#8#0#0#7'TButton'#9'Can'
+'celBtn'#4'Left'#3'D'#1#6'Height'#2#25#3'Top'#2#9#5'Width'#2'K'#7'Anchors'#11
+#7'akRight'#8'akBottom'#0#6'Cancel'#9#7'Caption'#6#6'Cancel'#7'OnClick'#7#14
+'CancelBtnClick'#8'TabOrder'#2#1#7'TabStop'#8#0#0#0#12'TPageControl'#10'pgRe'
+'source'#6'Height'#3#209#0#5'Width'#3#144#1#7'TabStop'#8#10'ActivePage'#7#11
+'tabResource'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTa'
+'bSheet'#11'tabResource'#7'Caption'#6#8'Resource'#12'ClientHeight'#3#176#0#11
+'ClientWidth'#3#140#1#0#6'TLabel'#14'lblDescription'#4'Left'#2#8#6'Height'#2
+#15#3'Top'#2#24#5'Width'#2'M'#7'Caption'#6#12'Description:'#11'ParentColor'#8
+#0#0#6'TLabel'#8'lblNotes'#4'Left'#2#8#6'Height'#2#15#3'Top'#2'/'#5'Width'#2
+'+'#7'Caption'#6#6'Notes:'#11'ParentColor'#8#0#0#6'TImage'#12'imgResources'#4
+'Left'#3'\'#1#6'Height'#2' '#3'Top'#2#16#5'Width'#2' '#7'Anchors'#11#5'akTop'
+#0#8'AutoSize'#9#12'Picture.Data'#10#130#2#0#0#7'TBitmapv'#2#0#0'BMv'#2#0#0#0
+#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0' '#0#0#0#1#0#4#0#0#0#0#0#0#2#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#128#128#128#0#192#192#192#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'33333330'#0#3'7s3'
+'3333333330'#8#179'pww3333333330'#11';'#179'7'#0'ww3333330'#0#0#187';'#179'7'
+#7#7'ww33330'#8#128#0#187';'#179#147#7#16'www330'#8'H'#132'P'#187';'#179#153
+#7#17#7'ww330'#136'h'#132'P'#187';'#179#153#7#17#7'w3330'#136'H'#132'@'#187
+';'#179#153#7#17#7'33330'#136'H'#133'@'#187';'#179#153#7#17#3'33330'#136'H'
+#132'@'#187';'#179#145#7#17#3'33330'#136'H'#132#16#187';'#187#17#23#17#3'333'
+'30'#136'H'#132#8#187#187#187'3'#7#17#3'33330'#136'H'#132#11#187#187#187'90'
+#17#3'33330'#136'H'#136#11#187#187#187'9qp'#3'3333'#7#136#136#135#11#187#187
+#187'9pq'#3'3333'#8#136#136#136#11#187#187#187'91q'#16'3333'#8#136#136#136#11
+#187#187#187'91q'#16'3333'#7#136#136'x'#11#187#187#187'91q'#16'3333'#8#136
+#136#136#11#187#187#184'31q'#16'3333'#8#135#136#136#8#187#136#139#136'qq'#16
+'3333'#7#136'x'#136#8#255'777'#128'qP3333'#8#135#135#255#0#131#0#0'p'#15'q'
+#16'3333'#8'x'#255#136#128#128'w7'#15#136#136'P3333'#8#255#0'D@'#3#136#131#16
+#17#17#128'33330'#135#0#0'@'#8#143#135'p'#0#16#3'33330'#128'ww'#3#8#255#248
+'pw'#3'333333'#7'xw@'#15#255#135'`w'#16'333333'#8#248#136'p0'#248'v'#8#135'P'
+'333333'#8#255#247'p3'#0#7#255#247'p333333'#15#255#248'p33'#8#255#136'`33333'
+'30'#248'w'#3'330'#248'w'#3'3333333'#0#5'3333'#0#0'33333'#0#0#5'TEdit'#15'De'
+'scriptionEdit'#4'Left'#2'P'#6'Height'#2#21#3'Top'#2#20#5'Width'#3#253#0#7'A'
+'nchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#9'MaxLength'#3#255#0#8'OnChange'
+#7#6'Change'#8'TabOrder'#2#0#0#0#5'TMemo'#9'NotesMemo'#4'Left'#2#8#6'Height'
+#2'M'#3'Top'#2'C'#5'Width'#3'u'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'
+#8'akBottom'#0#9'MaxLength'#3#0#4#8'OnChange'#7#6'Change'#10'ScrollBars'#7#10
+'ssVertical'#8'TabOrder'#2#1#0#0#0#0#0
]);

243
components/tvplanit/source/vpreseditdlg.pas Normal file
View File

@ -0,0 +1,243 @@
{*********************************************************}
{* VPRESEDITDLG.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 VpResEditDlg;
interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils,
{$IFDEF VERSION6} Variants, {$ENDIF}
Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
VpDlg, VpBase, VpData, ComCtrls, VpConst;
type
{ forward declarations }
TVpResourceEditDialog = class;
TResEditForm = class(TForm)
pnlBottom: TPanel;
OKBtn: TButton;
CancelBtn: TButton;
pgResource: TPageControl;
tabResource: TTabSheet;
DescriptionEdit: TEdit;
lblDescription: TLabel;
lblNotes: TLabel;
NotesMemo: TMemo;
imgResources: TImage;
procedure OKBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
procedure Change(Sender: TObject);
procedure FormShow(Sender: TObject);
private
procedure SetControls;
public
ReturnCode: TVpEditorReturnCode;
ResourceChanged: Boolean;
Resource: TVpResource;
procedure PopulateSelf;
procedure DePopulateSelf;
end;
TVpResourceEditDialog = class(TVpBaseDialog)
protected {private}
reEditDlg : TResEditForm;
reResource : TVpResource;
function Show: Boolean;
public
function Execute: Boolean; reintroduce;
function AddNewResource: Boolean;
published
{properties}
property DataStore;
property Options;
property Placement;
end;
function ExecuteResourceDlg(Resource: TVpResource): Boolean;
implementation
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
function ExecuteResourceDlg(Resource: TVpResource): Boolean;
var
EditForm: TResEditForm;
begin
result := false;
if Resource = nil then
Exit;
Application.CreateForm(TResEditForm, EditForm);
EditForm.Resource := Resource;
EditForm.PopulateSelf;
EditForm.ShowModal;
if EditForm.ReturnCode = rtCommit then begin
EditForm.DePopulateSelf;
result := true;
end;
EditForm.Release;
end;
{=====}
{ TVpResourceEditDialog }
function TVpResourceEditDialog.AddNewResource: Boolean;
var
Res: TVpResource;
ResName: string;
begin
result := false;
if DataStore <> 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.

96
components/tvplanit/source/vpruntime.dpk Normal file
View File

@ -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.

BIN
components/tvplanit/source/vpruntime.res Normal file
View File

Binary file not shown.

86
components/tvplanit/source/vpselresdlg.lfm Normal file
View File

@ -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

80
components/tvplanit/source/vpselresdlg.pas Normal file
View File

@ -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.

112
components/tvplanit/source/vpsqlbde.pas Normal file
View File

@ -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.

301
components/tvplanit/source/vpsqldialect.pas Normal file
View File

@ -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<br>
// 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<br>
// <flag>override
function SQLGetColumnDef(const aFieldDef: TFieldDef): String; virtual; abstract;
// should return the syntax for the create command<br>
// default is: create table %TableName% (%Fields%)<br>
// %tablename% will be substituted by according name, %Fields% is a commadelimited
// list of fielddefinitions created by calls to SQLGetColumnDef
// <flag>override
function GetCreateSyntax: String; virtual;
// should return the syntax for the select command<br>
// default is: select * from %tablename%<br>
// %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%
// <flag>override
function GetSelectSyntax: String; virtual;
// should return the syntax for the select command<br>
// default is: delete from %tablename%<br>
// <flag>override
function GetDeleteSyntax: String; virtual;
// should return the syntax for checking that a database exists
// returns blank here because it is very engine dependant
// <flag override>
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<br>
// default is: select * from %tablename%<br>
// %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<br>
// default is: delete from %tablename%<br>
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.

445
components/tvplanit/source/vpsqlds.pas Normal file
View File

@ -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.

95
components/tvplanit/source/vpsqlparadoxdialect.pas Normal file
View File

@ -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.

417
components/tvplanit/source/vpsr.inc Normal file
View File

@ -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?';

92
components/tvplanit/source/vpsr.pas Normal file
View File

@ -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.

1316
components/tvplanit/source/vpsr.rst Normal file
View File

File diff suppressed because it is too large Load Diff

316
components/tvplanit/source/vptaskeditdlg.lfm Normal file
View File

@ -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

229
components/tvplanit/source/vptaskeditdlg.pas Normal file
View File

@ -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.

1758
components/tvplanit/source/vptasklist.pas Normal file
View File

File diff suppressed because it is too large Load Diff

640
components/tvplanit/source/vptimerpool.pas Normal file
View File

@ -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.

99
components/tvplanit/source/vpwavdlg.lfm Normal file
View File

@ -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

40
components/tvplanit/source/vpwavdlg.lrs Normal file
View File

@ -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
]);

192
components/tvplanit/source/vpwavdlg.pas Normal file
View File

@ -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.

98
components/tvplanit/source/vpwavpe.pas Normal file
View File

@ -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.

1956
components/tvplanit/source/vpweekview.pas Normal file
View File

File diff suppressed because it is too large Load Diff

682
components/tvplanit/source/vpxbase.pas Normal file
View File

@ -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.

648
components/tvplanit/source/vpxchrflt.pas Normal file
View File

@ -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.

2296
components/tvplanit/source/vpxparsr.pas Normal file
View File

File diff suppressed because it is too large Load Diff