Files
lazarus-ccr/components/tvplanit/source/vpbaseds.pas

1608 lines
46 KiB
ObjectPascal
Raw Normal View History

{*********************************************************}
{* VPBASEDS.PAS 1.03 *}
{*********************************************************}
{* ***** BEGIN LICENSE BLOCK ***** *}
{* Version: MPL 1.1 *}
{* *}
{* The contents of this file are subject to the Mozilla Public License *}
{* Version 1.1 (the "License"); you may not use this file except in *}
{* compliance with the License. You may obtain a copy of the License at *}
{* http://www.mozilla.org/MPL/ *}
{* *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
{* for the specific language governing rights and limitations under the *}
{* License. *}
{* *}
{* The Original Code is TurboPower Visual PlanIt *}
{* *}
{* The Initial Developer of the Original Code is TurboPower Software *}
{* *}
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *}
{* TurboPower Software Inc. All Rights Reserved. *}
{* *}
{* Contributor(s): *}
{* *}
{* ***** END LICENSE BLOCK ***** *}
{$I vp.inc}
unit VpBaseDS;
{ Base DataStore classes }
interface
uses
{$IFDEF LCL}
LMessages, LCLProc, LCLIntf, LCLVersion, LazFileUtils,
{$ELSE}
Windows, Messages,
{$ENDIF}
Classes, Dialogs, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls, ImgList,
VpBase, VpData, Forms, VpPrtFmt, VpLocalize;
type
TVpResourceUpdate = (ruOnChange, ruOnExit, ruOnDropDownClose);
{ Forward Declarations }
TVpCustomDataStore = class;
TVpLinkableControl = class;
TVpControlLink = class;
{ enumerated types }
TVpNotificationType = (neDateChange, neResourceChange, neDataStoreChange,
neInvalidate);
{ Printing events }
TVpOnGetVariableEvent = procedure (Sender: TObject; VarName: string;
Found: Boolean; var Value: string; var Change: TVpChangeVar)
of object;
TVpOnPageStartEvent = procedure (Sender: TObject; PageNum: Integer;
ADate: TDateTime) of object;
TVpOnPageEndEvent = procedure (Sender: TObject; PageNum: Integer;
ADate: TDateTime; LastPage: Boolean) of object;
{ generic events }
TVpControlNotifyEvent = procedure(Sender: TComponent;
NotificationEvent: TVpNotificationType; const Value: Variant) of object;
TVpNoResources = procedure(Sender: TObject;
Resource: TVpResource) of object;
TVpNoLocalizationFile = procedure (Sender: TObject;
FileName: string) of object;
TVpDateChangedEvent = procedure (Sender: TObject;
Date: TDateTime) of object;
{ contact events }
TVpContactEvent = procedure(Sender: TObject; Contact: TVpContact) of object;
TVpEditContactEvent = procedure(Sender: TObject; AContact: TVpContact;
IsNewContact: Boolean; AResource: TVpResource; var AllowIt: Boolean) of object;
TVpOwnerDrawContactEvent = procedure(Sender: TObject; const Canvas: TCanvas;
R: TRect; Contact: TVpContact; var Drawn: Boolean) of object;
TVpCGColWidthChangeEvent = procedure(Sender: TObject;
NewColWidth: Integer) of object;
{ task events }
TVpBeforeEditTask = procedure(Sender: TObject; Task: TVpTask;
var AllowIt: Boolean) of object;
TVpAfterEditTask = procedure(Sender: TObject; Task: TVpTask) of object;
TVpEditTask = procedure(Sender: TObject; ATask: TVpTask; IsNewTask: Boolean;
AResource: TVpResource; var AllowIt: Boolean) of object;
TVpOwnerDrawTask = procedure(Sender: TObject; const Canvas: TCanvas;
R: TRect; Task: TVpTask; var Drawn: Boolean) of object;
{ event events }
TVpBeforeEditEvent = procedure(Sender: TObject; Event: TVpEvent;
var AllowIt: Boolean) of object;
TVpEventEvent = procedure(Sender: TObject; Event: TVpEvent) of object;
TVpAfterEditEvent = procedure(Sender: TObject; Event: TVpEvent) of object;
TVpEditEvent = procedure(Sender: TObject; AEvent: TVpEvent;
IsNewEvent: Boolean; AResource:TVpResource; var AllowIt: Boolean) of object;
TVpOnAddNewEvent = procedure (Sender: TObject;
Event: TVpEvent) of object;
{ resource events }
TVpResourceEvent = procedure(Sender: TObject;
Resource: TVpResource) of object;
{ Is created by the control where dragging starts. The Event property }
{ holds a reference to the event being dragged, and the Sender contains }
{ a reference to the control where dragging started. }
TVpEventDragObject = class({$IFDEF LCL}TDragObjectEx{$ELSE}TDragObject{$ENDIF})
protected {private}
FEvent: TVpEvent;
FSender: TObject;
{$IFDEF LCL}
FDragTitle: string;
FDragImages: TDragImageList;
function GetDragImages: TDragImageList; override;
{$ENDIF}
public
{$IFDEF LCL}
constructor CreateWithDragImages(AControl: TControl; AHotspot: TPoint;
ACellRect: TRect; const ADragTitle: string; const ATransparent: boolean);
destructor Destroy; override;
property DragTitle: string read FDragTitle;
{$ENDIF}
property Event: TVpEvent read FEvent write FEvent;
property Sender: TObject read FSender write FSender;
end;
TVpResourceCombo = class(TCustomComboBox)
protected {private}
FDataStore: TVpCustomDataStore;
{internal variables}
rcLoading: Boolean;
OldItemIndex: Integer;
FResourceUpdateStyle: TVpResourceUpdate;
procedure VpDataStoreChanged(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DataStoreChanged;
procedure SetDataStore(const Value: TVpCustomDataStore);
function GetAbout: string;
procedure SetAbout(const Value: string);
procedure SetResourceUpdateStyle(const v: TVpResourceUpdate);
procedure ResourceChanged(Sender: TObject);
procedure LoadItems;
{$IFNDEF LCL}
procedure CNCommand (var Msg: TWMCommand); message CN_COMMAND;
{$ENDIF}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{$IFDEF LCL}
property ChildSizing;
{$ENDIF}
published
property DataStore: TVpCustomDataStore
read FDataStore write SetDataStore;
property ResourceUpdateStyle: TVpResourceUpdate
read FResourceUpdateStyle write SetResourceUpdateStyle default ruOnChange;
property Version: string
read GetAbout write SetAbout stored False;
property Align;
property Anchors;
property Constraints;
property Style;
{$IFDEF LCL}
property Borderspacing;
{$ENDIF}
end;
TVpDependentInfo = class { Used by the ControlLink component }
protected{private}
FComponent: Pointer;
FEventHandler: TVpControlNotifyEvent;
public
property Component: Pointer read FComponent write FComponent;
property EventHandler: TVpControlNotifyEvent
read FEventHandler write FEventHandler;
end;
TVpCustomDataStore = class(TVpComponent)
private
FMediaFolder : String;
FImages : TCustomImageList;
function IsStoredMediaFolder: Boolean;
procedure SetImages(AValue: TCustomImageList);
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
private
FImagesWidth: Integer;
procedure SetImagesWidth(AValue: Integer);
{$IFEND}
{$ENDIF}
protected{private}
FAutoCreate : Boolean;
FAutoConnect : Boolean;
FLoading : Boolean;
FCategoryColorMap : TVpCategoryColorMap;
FHiddenCategories : TVpCategoryInfo;
FResources : TVpResources;
FTimeRange : TVpTimeRange;
FActiveDate : TDateTime;
FConnected : Boolean;
FEventTimerEnabled : Boolean;
FPlayEventSounds : Boolean;
FDefaultEventSound : string;
FDayBuffer : Integer;
FResourceID : Integer;
FResource : TVpResource;
dsAlertTimer : TTimer; { fires the alerts }
FNotifiers : TList;
FLinkedOwner : TComponent;
{events}
FOnConnect : TNotifyEvent;
FOnDisconnect : TNotifyEvent;
FOnAlert : TVpEventEvent;
FOnResourceChange : TVpResourceEvent;
FOnDateChanged : TVpDateChangedEvent;
FOnPlaySound : TVpPlaySoundEvent;
procedure dsOnTimer(Sender: TObject);
procedure dsDoOnAlert(Event: TVpEvent);
procedure SetActiveDate(Value: TDateTime);
procedure SetAutoConnect(Value: Boolean);
procedure SetConnected(const Value: boolean); virtual;
procedure SetResourceID(Value: Integer);
procedure SetResource(Value: TVpResource);
procedure SetEventTimerEnabled(Value: Boolean);
procedure SetDayBuffer(Value: Integer);
procedure SetRange(StartTime, EndTime: TDateTime);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure NotifyLinked;
procedure LinkToControls(AOwner: TComponent);
procedure UnlinkFromControls(AOwner: TComponent);
property AutoConnect: Boolean read FAutoConnect write SetAutoConnect;
property AutoCreate: Boolean read FAutoCreate write FAutoCreate;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DeregisterAllWatchers;
procedure DeregisterWatcher(Watcher: THandle);
function GetNextID(TableName: string): Integer; virtual; abstract;
procedure NotifyDependents;
procedure RegisterWatcher(Watcher: THandle);
procedure PlaySound(const AWavFile: String; APlaySoundMode: TVpPlaySoundMode);
procedure SetResourceByName(Value: string); virtual; abstract;
procedure Load; virtual;
procedure LoadEvents; virtual;
procedure LoadEventsOfResource(AResID: Integer); virtual; abstract;
procedure LoadContacts; virtual; abstract;
procedure LoadTasks; virtual; abstract;
procedure RefreshEvents; virtual;
procedure RefreshContacts; virtual;
procedure RefreshTasks; virtual;
procedure RefreshResource; virtual;
procedure PurgeResource(Res: TVpResource); virtual; {abstract;}
procedure PurgeEvents(Res: TVpResource); virtual; {abstract;}
procedure PurgeContacts(Res: TVpResource); virtual; {abstract;}
procedure PurgeTasks(Res: TVpResource); virtual; {abstract;}
procedure PostEvents; virtual; abstract;
procedure PostContacts; virtual; abstract;
procedure PostTasks; virtual; abstract;
procedure PostResources; virtual; abstract;
procedure UpdateGroupEvents; virtual;
property Connected : boolean read FConnected write SetConnected;
property Loading : Boolean read FLoading write FLoading;
property Resource: TVpResource read FResource write SetResource;
property ResourceID: Integer read FResourceID write SetResourceID;
property Resources: TVpResources read FResources;
property DayBuffer: Integer read FDayBuffer write SetDayBuffer;
property Date: TDateTime read FActiveDate write SetActiveDate;
property TimeRange: TVpTimeRange read FTimeRange;
published
property CategoryColorMap: TVpCategoryColorMap
read FCategoryColorMap write FCategoryColorMap;
property HiddenCategories: TVpCategoryInfo
read FHiddenCategories write FHiddenCategories;
property Images: TCustomImageList
read FImages write SetImages;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
property ImagesWidth: Integer
read FImagesWidth write SetImagesWidth default 0;
{$IFEND}
{$ENDIF}
property DefaultEventSound: string
read FDefaultEventSound write FDefaultEventSound;
property EnableEventTimer: Boolean
read FEventTimerEnabled write SetEventTimerEnabled;
property PlayEventSounds: Boolean
read FPlayEventSounds write FPlayEventSounds;
property MediaFolder: String
read FMediaFolder write FMediaFolder stored IsStoredMediaFolder;
{events}
property OnAlert: TVpEventEvent
read FOnAlert write FOnAlert;
property OnConnect: TNotifyEvent
read FOnConnect write FOnConnect;
property OnDateChanged: TVpDateChangedEvent
read FOnDateChanged write FOnDateChanged;
property OnDisconnect: TNotifyEvent
read FOnDisconnect write FOnDisconnect;
property OnResourceChange: TVpResourceEvent
read FOnResourceChange write FOnResourceChange;
property OnPlaySound: TVpPlaySoundEvent
read FOnPlaySound write FOnPlaySound;
end;
{TVpLinkableControl}
TVpLinkableControl = class(TVpCustomControl)
protected{private}
FDataStore: TVpCustomDataStore;
FReadOnly: Boolean;
FControlLink: TVpControlLink;
FLastPrintLine: Integer;
function CheckCreateResource : Boolean;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetDataStore (const Value : TVpCustomDataStore); virtual;
procedure SetControlLink (const Value : TVpControlLink);
procedure CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message CM_ENTER;
procedure CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message CM_EXIT;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetLastPrintLine: Integer;
function GetControlType: TVpItemType; virtual; abstract;
procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect;
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity;
DisplayOnly: Boolean); virtual; abstract;
procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType;
const Value: Variant); virtual; abstract;
property ReadOnly: Boolean read FReadOnly write FReadOnly;
published
property PopupMenu;
property DataStore: TVpCustomDataStore read FDataStore write SetDataStore;
property ControlLink: TVpControlLink read FControlLink write SetControlLink;
property Color;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property AfterEnter;
property AfterExit;
property OnMouseWheel;
end;
{TVpControlLink}
TVpControlLink = class(TVpComponent)
private
FPrinter : TVpPrinter;
FDataStore : TVpCustomDataStore;
FOnGetVariable : TVpOnGetVariableEvent;
FOnNoLocalizationFile : TVpNoLocalizationFile;
FOnPageStart : TVpOnPageStartEvent;
FOnPageEnd : TVpOnPageEndEvent;
FLocalization : TVpLocalization;
FLocalizationFile : string;
FDefaultCountry : string;
FCityStateZipFormat: String;
protected{private}
DependentList: TList;
procedure Attach (Sender : TComponent);
procedure Detach (Sender : TComponent);
procedure ReleaseDependents;
procedure SetCityStateZipFormat(const Value: String);
procedure SetDataStore (const Value : TVpCustomDataStore);
procedure SetDefaultCountry (const v : string);
procedure SetLocalizationFile (const v : string);
procedure SetPrinter (const v : TVpPrinter);
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
function GetDependentList : TList;
procedure LoadLocalizationInfo (const FileName : string);
procedure Notify (Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant);
procedure TriggerOnGetVariable (Sender : TObject; VarName: string; Found: Boolean; var Value: string; var Change: TVpChangeVar);
procedure TriggerOnPageEnd (Sender: TObject; PageNum: Integer; ADate: TDateTime; LastPage: Boolean);
procedure TriggerOnPageStart (Sender: TObject; PageNum: Integer; ADate: TDateTime);
property Localization : TVpLocalization read FLocalization write FLocalization;
published
property CityStateZipFormat: String read FCityStateZipFormat write SetCityStateZipFormat;
// Use symbols @CITY, @STATE, @ZIP to define the order of these strings
property DataStore: TVpCustomDataStore read FDataStore write SetDataStore;
property DefaultCountry : string read FDefaultCountry write SetDefaultCountry;
property LocalizationFile : string read FLocalizationFile write SetLocalizationFile;
property Printer : TVpPrinter read FPrinter write SetPrinter;
property OnGetVariable : TVpOnGetVariableEvent read FOnGetVariable write FOnGetVariable;
property OnNoLocalizationFile : TVpNoLocalizationFile read FOnNoLocalizationFile write FOnNoLocalizationFile;
property OnPageStart : TVpOnPageStartEvent read FOnPageStart write FOnPageStart;
property OnPageEnd : TVpOnPageEndEvent read FOnPageEnd write FOnPageEnd;
end;
implementation
uses
VpSR, VpConst, VpMisc, VpResEditDlg, VpAlarmDlg,
{$IFDEF WINDOWS}
mmSystem,
{$ENDIF}
VpDlg, VpSelResDlg;
(*****************************************************************************)
{ TVpCustomDataStore }
constructor TVpCustomDataStore.Create(AOwner: TComponent);
begin
inherited;
FNotifiers := TList.Create;
FAutoCreate := true;
FResources := TVpResources.Create(Self);
FTimeRange := TVpTimeRange.Create(Self);
FCategoryColorMap := TVpCategoryColorMap.Create(Self);
FHiddenCategories := TVpCategoryInfo.Create(Self);
with FHiddenCategories do begin
BackgroundColor := clSilver;
Color := clGray;
end;
FActiveDate := Now;
FDayBuffer := 31; {One full month before and after the current date. }
FTimeRange.StartTime := Now - FDayBuffer;
FTimeRange.EndTime := Now + FDayBuffer;
FPlayEventSounds := true;
FEventTimerEnabled := true;
{ Set Alert Timer }
if not (csDesigning in ComponentState) then begin
dsAlertTimer := TTimer.Create(self);
dsAlertTimer.Enabled := false;
{ Create the event timer and allow it to fire within the next half second }
dsAlertTimer.OnTimer := dsOnTimer;
dsAlertTimer.Interval := 500;
end;
{ If the DataStore is being dropped onto a form for the first time... }
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
LinkToControls(Owner);
{ enable the event timer }
if not (csDesigning in ComponentState) then
dsAlertTimer.Enabled := true;
end;
{=====}
destructor TVpCustomDataStore.Destroy;
begin
DeregisterAllWatchers;
FNotifiers.Free;
FNotifiers := nil;
{ Remove self from all dependent controls }
UnlinkFromControls(FLinkedOwner);
FResources.Free;
FTimeRange.Free;
FCategoryColorMap.Free;
FHiddenCategories.Free;
if dsAlertTimer <> nil then
dsAlertTimer.Free;
inherited;
end;
{=====}
procedure TVpCustomDataStore.DeregisterAllWatchers;
var
i: Integer;
begin
if FNotifiers <> nil then
for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then begin
FreeMem(FNotifiers[i]);
FNotifiers.Delete (i);
end;
end;
{=====}
procedure TVpCustomDataStore.DeregisterWatcher(Watcher: THandle);
var
i: Integer;
begin
if FNotifiers <> nil then
for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then
if PVpWatcher(FNotifiers[i]).Handle = Watcher then begin
FreeMem(FNotifiers[i]);
FNotifiers.Delete(i);
Exit;
end;
end;
{=====}
procedure TVpCustomDataStore.dsOnTimer(Sender: TObject);
var
// Hour, Min, Sec, MSec: Word;
NHour, NMin, NSec, NMSec: Word;
Event: TVpEvent;
I: integer;
AdvanceTime: TDateTime;
AlarmTime: TDateTime;
begin
{ don't fire the timer at designtime }
if csDesigning in ComponentState then begin
dsAlertTimer.Enabled := false;
Exit;
end;
if Resource <> nil then begin
for I := 0 to pred(Resource.Schedule.EventCount) do begin
Event := Resource.Schedule.GetEvent(I);
if (Event <> nil) and Event.AlarmSet then begin
AdvanceTime := GetAlarmAdvanceTime(Event.AlarmAdvance, Event.AlarmAdvanceType);
AlarmTime := Event.StartTime - AdvanceTime;
{ if the AlarmTime has already passed, then show the alarm notification }
if (AlarmTime < Now) then begin
if Event.SnoozeTime < now then
dsDoOnAlert(Event);
end;
(* Simplified
else begin
{ Check to see if the event comes due today before going further }
if (Trunc(AlarmTime) = Trunc(Now)) then begin
DecodeTime(AlarmTime, Hour, Min, Sec, MSec);
DecodeTime(Now, NHour, NMin, NSec, NMsec);
if (Hour = NHour) and (Min = NMin) then begin
{ this event has come due so spawn the alert dialog }
dsDoOnAlert(Event);
end;
end; {if (Trunc(AlarmTime) = Trunc(Now))}
end; {if (AlarmTime < Now)}
*)
end; {if Event.AlarmSet}
end; {for}
end;
{ Set next interval }
DecodeTime(Now, NHour, NMin, NSec, NMSec);
dsAlertTimer.Interval := (60 - NSec) * 1000;
end;
{=====}
procedure TVpCustomDataStore.dsDoOnAlert(Event: TVpEvent);
begin
if Event.AlertDisplayed then
Exit;
if Assigned(FOnAlert) then
FOnAlert(Self, Event)
else begin
{Ding!}
if FPlayEventSounds then begin
if FileExists(Event.DingPath) then
{ if the event has a sound of its own, then play that one. }
PlaySound(Event.DingPath, psmASync)
else if FileExists(FDefaultEventSound) then
{ otherwise, if there is a default sound assigned, then play that one }
PlaySound(FDefaultEventSound, psmASync)
else
{ otherwise just ding }
Beep;
end;
with TVpNotificationDialog.Create(nil) do
try
DataStore := Self;
Execute(Event);
finally
Free;
end; { with }
end; { if }
end;
{=====}
function TVpCustomDatastore.IsStoredMediaFolder: Boolean;
begin
Result := FMediaFolder <> '';
end;
procedure TVpCustomDatastore.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FLinkedOwner) then
FLinkedOwner := nil;
end;
procedure TVpCustomDataStore.NotifyLinked;
var
i: Integer;
begin
for i := 0 to FNotifiers.Count - 1 do
if Assigned(FNotifiers[i]) then
PostMessage(PVpWatcher(FNotifiers[i]).Handle, Vp_DataStoreChanged, 0, 0);
end;
procedure TVpCustomDataStore.SetActiveDate(Value: TDateTime);
var
OY, OM, Day, NY, NM: Word;
OldDate: TDateTime;
begin
OldDate := FActiveDate;
FActiveDate := Value;
DecodeDate(OldDate, oy, om, Day);
DecodeDate(FActiveDate, ny, nm, Day);
{ If the date has reached the end of the data buffer }
if (FActiveDate >= FTimeRange.EndTime)
or (FActiveDate <= FTimeRange.StartTime)
{ or the month or year has changed... }
or (nm <> om) or (ny <> oy) then begin
{ then load the data that falls into the current time range }
SetRange(FActiveDate - FDayBuffer, FActiveDate + FDayBuffer);
RefreshEvents;
end;
if Assigned(FOnDateChanged) then
FOnDateChanged(Self, FActiveDate);
end;
{=====}
procedure TVpCustomDataStore.SetAutoConnect(Value: Boolean);
begin
if Value <> FAutoConnect then
FAutoConnect := value;
end;
{=====}
procedure TVpCustomDataStore.SetConnected(const Value: boolean);
var
WasConnected: Boolean;
begin
WasConnected := FConnected;
if Value <> FConnected then begin
FConnected := Value;
if not FConnected then begin
FResources.ClearResources;
FResource := nil;
if WasConnected and Assigned(OnDisconnect) then
FOnDisconnect(self);
end
else begin
if not WasConnected and Assigned(OnConnect) then
FOnConnect(self);
end;
if not (csDestroying in ComponentState) then
NotifyDependents;
end;
end;
procedure TVpCustomDataStore.SetImages(AValue: TCustomImageList);
begin
if FImages <> AValue then begin
FImages := AValue;
end;
end;
{$IFDEF LCL}
{$IF LCL_FullVersion >= 1090000}
procedure TVpCustomDataStore.SetImagesWidth(AValue: Integer);
begin
if FImagesWidth <> AValue then begin
FImagesWidth := AValue;
end;
end;
{$IFEND}
{$ENDIF}
procedure TVpCustomDataStore.SetResourceID(Value: Integer);
begin
if (Value <> FResourceID) or (Value = 0) then begin
FResource := FResources.GetResource(Value);
if FResource = nil then
Exit;
FResourceID := Value;
RefreshEvents;
RefreshContacts;
RefreshTasks;
if Assigned(FOnResourceChange) then
FOnResourceChange(Self, FResource);
if not Loading then
NotifyDependents;
end;
end;
procedure TVpCustomDataStore.SetResource(Value: TVpResource);
begin
if Value <> FResource then begin
FResource := Value;
if FResource <> nil then begin
FResourceID := FResource.ResourceID;
RefreshEvents;
RefreshContacts;
RefreshTasks;
end else
FResourceID := -1;
if not Loading then
NotifyDependents;
end;
end;
{=====}
procedure TVpCustomDataStore.SetEventTimerEnabled(Value: Boolean);
begin
if Value <> FEventTimerEnabled then begin
FEventTimerEnabled := Value;
if not (csDesigning in ComponentState) then begin
if FEventTimerEnabled and (dsAlertTimer = nil) then
dsAlertTimer := TTimer.Create(self);
dsAlertTimer.Enabled := FEventTimerEnabled;
dsAlertTimer.Interval := 500; { Make it fire within a half second }
end;
end;
end;
{=====}
procedure TVpCustomDataStore.SetDayBuffer(Value: Integer);
begin
FDayBuffer := Value;
SetRange(FActiveDate - FDayBuffer, FActiveDate + FDayBuffer);
end;
{=====}
procedure TVpCustomDataStore.Load;
begin
FResources.Sort;
NotifyDependents;
end;
{ Load this resource's events into memory }
procedure TVpCustomDataStore.LoadEvents;
begin
if Resource <> nil then begin
// Load regular events ...
LoadEventsOfResource(Resource.ResourceID);
// ... and overlayed events
UpdateGroupEvents;
end;
end;
procedure TVpCustomDataStore.RefreshEvents;
begin
if not Loading then
NotifyDependents;
end;
{=====}
procedure TVpCustomDataStore.RefreshContacts;
begin
if not Loading then
NotifyDependents;
end;
{=====}
procedure TVpCustomDataStore.RefreshTasks;
begin
if not Loading then
NotifyDependents;
end;
{=====}
procedure TVpCustomDataStore.RefreshResource;
begin
if not Loading then
NotifyDependents;
end;
{=====}
procedure TVpCustomDataStore.PurgeResource(Res: TVpResource);
begin
Unused(Res);
if not Loading then
NotifyDependents;
end;
procedure TVpCustomDataStore.PurgeEvents(Res: TVpResource);
begin
Res.Schedule.ClearEvents;
if not Loading then
NotifyDependents;
end;
procedure TVpCustomDataStore.PurgeContacts(Res: TVpResource);
begin
Res.Contacts.ClearContacts;
if not Loading then
NotifyDependents;
end;
procedure TVpCustomDataStore.PurgeTasks(Res: TVpResource);
begin
Res.Tasks.ClearTasks;
if not Loading then
NotifyDependents;
end;
procedure TVpCustomDatastore.UpdateGroupEvents;
var
i: Integer;
id: Integer;
res: TVpResource;
begin
Resource.Schedule.ClearGroupEvents;
if Resource.Group = nil then begin
NotifyDependents;
exit;
end;
for i:=0 to Resource.Group.Count-1 do begin
// current resource of group
res := Resource.Group[i];
if res = nil then
Continue;
id := res.ResourceID;
// Ignore active resource in resource group (it shouldn't be there anyway)
if id = ResourceID then
Continue;
// load events of current group
LoadEventsOfResource(id);
end;
NotifyDependents;
end;
procedure TVpCustomDataStore.RegisterWatcher(Watcher: THandle);
var
i: Integer;
NewHandle: PVpWatcher;
begin
for i := 0 to FNotifiers.Count - 1 do
if Assigned (FNotifiers[i]) then
if PVpWatcher(FNotifiers[i]).Handle = Watcher then
Exit;
GetMem(NewHandle, SizeOf(TVpWatcher));
NewHandle.Handle := Watcher;
FNotifiers.Add(NewHandle);
end;
{=====}
procedure TVpCustomDataStore.NotifyDependents;
var
I: Integer;
begin
if (FLinkedOwner = nil) or Loading then
Exit;
for I := 0 to pred(FLinkedOwner.ComponentCount) do begin
if (FLinkedOwner.Components[I] is TVpLinkableControl) then begin
if (TVpLinkableControl(FLinkedOwner.Components[I]).DataStore = self) then
TVpLinkableControl(FLinkedOwner.Components[I]).Invalidate;
end
end;
NotifyLinked;
end;
{=====}
procedure TVpCustomDataStore.SetRange(StartTime, EndTime: TDateTime);
begin
if EndTime > StartTime then begin
{ Force the startdate's time to 12:00 am }
FTimeRange.StartTime := trunc(StartTime);
{ Force the enddate's time to midnight }
FTimeRange.EndTime := trunc(EndTime) + 1;
end;
end;
{=====}
procedure TVpCustomDatastore.PlaySound(const AWavFile: String;
APlaySoundMode: TVpPlaySoundMode);
begin
if Assigned(FOnPlaySound) then
FOnPlaySound(Self, AWavFile, APlaySoundMode)
else begin
{$IFDEF WINDOWS}
case APlaySoundMode of
psmSync : SndPlaySound(PChar(AWavFile), SND_SYNC);
psmAsync : SndPlaySound(PChar(AWavFile), SND_ASYNC);
psmStop : SndPlaySound(nil, 0);
end;
{$ENDIF}
end;
end;
{ This code links the datastore to the Datastore property of all dependent
components.
AOwner is normally a TForm and is stored in FLinkedOwner to be unlinked by
destructor.
The method is useful if datastores are created at runtime. }
procedure TVpCustomDatastore.LinkToControls(AOwner: TComponent);
var
i: Integer;
begin
UnlinkFromControls(FLinkedOwner);
if (AOwner = nil) then
exit;
{ Auto connect to the first available ControlLink component found }
for i := 0 to AOwner.ComponentCount - 1 do begin
if (AOwner.Components[I] is TVpControlLink) and
(TVpControlLink(AOwner.Components[I]).DataStore = nil) then
begin
TVpControlLink(AOwner.Components[I]).DataStore := Self;
Break;
end;
end;
{ Then Auto connect to all available LinkableControl components found }
for i := 0 to AOwner.ComponentCount - 1 do begin
if (AOwner.Components[I] is TVpLinkableControl) then begin
if TVpLinkableControl(AOwner.Components[I]).DataStore = nil then
TVpLinkableControl(AOwner.Components[I]).DataStore := Self;
end
else if (AOwner.Components[I] is TVpResourceCombo) then begin
if TVpResourceCombo(AOwner.Components[I]).DataStore = nil then
TVpResourceCombo(AOwner.Components[I]).DataStore := Self;
end
else if (AOwner.Components[I] is TVpBaseDialog) then begin
if TVpBaseDialog(AOwner.Components[I]).DataStore = nil then
TVpBaseDialog(AOwner.Components[I]).DataStore := Self;
end;
{
else if (AOwner.Components[I] is TVpControlLink) then begin
if TVpControlLink(AOwner.Components[I]).DataStore = nil then
TVpControlLink(AOwner.Components[I]).DataStore := Self;
end;
}
end;
FLinkedOwner := AOwner;
end;
{ Removes the "Datastore" links from dependent controls.
Is called automatically by destructor. }
procedure TVpCustomDatastore.UnlinkFromControls(AOwner: TComponent);
var
i: Integer;
begin
if AOwner = nil then
exit;
{ Remove self from dependent Control Links first }
for i:= 0 to AOwner.ComponentCount-1 do begin
if (AOwner.Components[I] is TVpControlLink) then begin
if TVpControlLink(AOwner.Components[I]).DataStore = self then
TVpControlLink(AOwner.Components[I]).DataStore := nil;
end;
end;
{ Then remove self from dependent controls }
for i := 0 to AOwner.ComponentCount-1 do begin
if (AOwner.Components[I] is TVpLinkableControl) then begin
if TVpLinkableControl(AOwner.Components[I]).DataStore = self then
TVpLinkableControl(AOwner.Components[I]).DataStore := nil;
end
else if (AOwner.Components[I] is TVpResourceCombo) then begin
if TVpResourceCombo(AOwner.Components[I]).DataStore = self then
TVpResourceCombo(AOwner.Components[I]).DataStore := nil;
end
else if (AOwner.Components[I] is TVpBaseDialog) then begin
if TVpBaseDialog(AOwner.Components[I]).DataStore = self then
TVpBaseDialog(AOwner.Components[I]).DataStore := nil;
end;
end;
FLinkedOwner := nil;
end;
{ TVpEventDragObject }
function TVpEventDragObject.GetDragImages: TDragImageList;
begin
Result := FDragImages;
end;
constructor TVpEventDragObject.CreateWithDragImages(AControl: TControl;
AHotspot: TPoint; ACellRect: TRect; const ADragTitle: string;
const ATransparent: boolean);
const
OffsX = 0;
OffsY = 0;
var
bmp: TBitmap;
bmpIdx: Integer;
R: TRect;
begin
Create(AControl);
FDragTitle := ADragTitle;
bmp := TBitmap.Create;
try
// bmp.Canvas.Font.Name := 'Arial';
bmp.Canvas.Font.Style := Bmp.Canvas.Font.Style + [fsItalic];
bmp.Height := ACellRect.Bottom - ACellRect.Top;
bmp.Width := ACellRect.Right - ACellRect.Left;
R := bmp.Canvas.ClipRect;
if ATransparent
then bmp.Canvas.Brush.Color := clOlive
else bmp.Canvas.Brush.Color := clSilver;
bmp.Canvas.FillRect(R);
bmp.Canvas.TextOut(OffsX, OffsY, FDragTitle);
// if a real picture is needed ...
//if AControl is TWinControl then
// (AControl as TWinControl).PaintTo(Bmp.Canvas, 0, 0);
FDragImages := TDragImageList.Create(AControl);
AlwaysShowDragImages := True;
FDragImages.Width := bmp.Width;
FDragImages.Height := bmp.Height;
if ATransparent
then bmpIdx := FDragImages.AddMasked(bmp, clOlive)
else bmpIdx := FDragImages.Add(bmp, nil);
FDragImages.SetDragImage(bmpIdx, AHotspot.X, AHotspot.Y);
finally
Bmp.Free;
end;
end;
destructor TVpEventDragObject.Destroy;
begin
if (Assigned(FDragImages)) then FDragImages.Free;
inherited Destroy;
end;
{ TVpResourceCombo }
constructor TVpResourceCombo.Create(AOwner: TComponent);
var
I: Integer;
begin
inherited;
OnChange := ResourceChanged;
FResourceUpdateStyle := ruOnChange;
Style := csDropDownList;
DoubleBuffered := true;
{ If the ResourceCombo is being dropped onto a form for the first }
{ time then connect to the first DataStore component found. }
I := 0;
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
while (I < Owner.ComponentCount) and (DataStore = nil) do
if (Owner.Components[I] is TVpCustomDataStore) then
DataStore := TVpCustomDataStore(Owner.Components[I])
else
Inc(I);
end;
destructor TVpResourceCombo.Destroy;
begin
inherited;
end;
{=====}
{$IFNDEF LCL}
procedure TVpResourceCombo.CNCommand (var Msg: TWMCommand);
begin
if Msg.NotifyCode = CBN_CLOSEUP then begin
if (FResourceUpdateStyle = ruOnDropDownClose) then
ResourceChanged(Self)
else
inherited;
end else
inherited;
end;
{$ENDIF}
{=====}
procedure TVpResourceCombo.VpDataStoreChanged(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
begin
Unused(Msg);
LoadItems;
end;
{=====}
function TVpResourceCombo.GetAbout: string;
begin
Result := VpVersionStr;
end;
{=====}
procedure TVpResourceCombo.LoadItems;
var
I: Integer;
Res: TVpResource;
begin
if DataStore = nil then
Exit;
rcLoading := true;
try
Items.Clear;
for I := 0 to pred(DataStore.Resources.Count) do begin
Res := DataStore.Resources.Items[I];
if Res = nil then
Continue;
if Res.Description <> '' then
Items.Add(Res.Description);
end;
if DataStore.Resource = nil then
ItemIndex := -1
else
ItemIndex := Items.IndexOf(DataStore.Resource.Description);
finally
rcLoading := false;
end;
end;
{=====}
procedure TVpResourceCombo.ResourceChanged(Sender: TObject);
begin
if (OldItemIndex <> ItemIndex) or (ItemIndex = 0) then begin
if (DataStore <> nil) and not rcLoading then
DataStore.SetResourceByName(Text);
OldItemIndex := ItemIndex;
end;
end;
{=====}
procedure TVpResourceCombo.SetAbout(const Value: string);
begin
Unused(Value);
//Empty on purpose
end;
{=====}
procedure TVpResourceCombo.SetResourceUpdateStyle(const v: TVpResourceUpdate);
begin
if v <> FResourceUpdateStyle then begin
FResourceUpdateStyle := v;
case FResourceUpdateStyle of
ruOnChange:
begin
OnChange := ResourceChanged;
OnExit := nil;
end;
ruOnExit:
begin
OnChange := nil;
OnExit := ResourceChanged;
end;
ruOnDropDownClose:
begin
OnChange := nil;
OnExit := nil;
end;
end;
end;
end;
{=====}
procedure TVpResourceCombo.SetDataStore(const Value: TVpCustomDataStore);
begin
if FDataStore <> Value then begin
if (Assigned (FDataStore)) and
(not (csDesigning in ComponentState)) then
FDataStore.DeregisterWatcher (Handle);
FDataStore := Value;
if (Assigned (FDataStore)) and
(not (csDesigning in ComponentState)) then
FDataStore.RegisterWatcher (Handle);
if not (csDesigning in ComponentState) then
LoadItems;
Invalidate;
end;
end;
{=====}
{ TVpLinkableControl }
constructor TVpLinkableControl.Create(AOwner: TComponent);
var
I: Integer;
begin
inherited;
{ If the control is being dropped onto a form for the first time then
auto-connect to the first ControlLink component found }
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
begin
I := 0;
while (I < Owner.ComponentCount) and (ControlLink = nil) do begin
if (Owner.Components[I] is TVpControlLink) then
ControlLink := TVpControlLink(Owner.Components[I]);
Inc(I);
end;
end;
FLastPrintLine := -1;
end;
{=====}
destructor TVpLinkableControl.Destroy;
begin
if ControlLink <> nil then
ControlLink.Detach(Self);
inherited;
end;
{=====}
function TVpLinkableControl.CheckCreateResource : Boolean;
var
ResEdit: TVpResourceEditDialog;
frmSelectResource: TfrmSelectResource;
begin
Result := False;
if not Assigned(DataStore) then
Exit;
if not Assigned(DataStore.Resource) then begin
if DataStore.Resources.Count > 0 then begin
{ No resource is selected, select one }
if MessageDlg(RSSelectResource, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
frmSelectResource := TfrmSelectResource.Create(Self);
try
frmSelectResource.VpResourceCombo1.DataStore := DataStore;
frmSelectResource.VpResourceEditDialog1.DataStore := DataStore;
if frmSelectResource.ShowModal = mrOk then begin
Result := True;
end else
Exit;
finally
frmSelectResource.Free;
end;
end else
Exit;
end else
begin
{ There are no resources at all, add one }
if MessageDlg(RSAddNewResource, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
ResEdit := TVpResourceEditDialog.Create(Self);
try
ResEdit.DataStore := DataStore;
Result := ResEdit.AddNewResource;
Exit;
finally
ResEdit.Free;
end;
end else
Exit;
end;
end else
Result := True;
end;
function TVpLinkableControl.GetLastPrintLine: Integer;
begin
Result := FLastPrintLine;
end;
procedure TVpLinkableControl.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) then begin
if (AComponent = FDatastore) then
FDatastore := nil;
if (AComponent = FControlLink) then
FControlLink := nil;
end;
end;
procedure TVpLinkableControl.SetDataStore(const Value: TVpCustomDataStore);
begin
if Value = nil then begin
FDataStore := nil;
Invalidate;
end else if FDataStore <> Value then begin
FDataStore := Value;
Invalidate;
end;
end;
{=====}
procedure TVpLinkableControl.SetControlLink(const Value: TVpControlLink);
var
CL: TVpControlLink;
begin
if (FControlLink <> Value) then begin
if (FControlLink <> nil) then begin
{ FControlLink is currently set to a ControlLink component }
{ save old control link value }
CL := FControlLink;
if (Value = nil) then begin
{ We are detaching ourself from the control link and not replacing }
{ it with another one. }
FControlLink := nil;
CL.Detach(Self);
end;
if (Value <> nil) then begin
{ We are replacing the current ControlLink with another one }
FControlLink := nil;
CL.Detach(Self);
FControlLink := Value;
FControlLink.Attach(Self);
end;
end else begin
{ FControlLink was nil and is now being set }
FControlLink := Value;
FControlLink.Attach(Self);
end;
end;
end;
{=====}
procedure TVpLinkableControl.CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
begin
Unused(Msg);
invalidate;
end;
{=====}
procedure TVpLinkableControl.CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
begin
Unused(Msg);
invalidate;
end;
{=====}
{ TVpControlLink }
constructor TVpControlLink.Create(AOwner: TComponent);
var
I: Integer;
begin
inherited;
DependentList := TList.Create;
{ If the ControlLink is being dropped onto a form for the first time ... }
if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
begin
{ Auto connect to the first DataStore found }
I := 0;
while (I < Owner.ComponentCount) and (DataStore = nil) do begin
if (Owner.Components[I] is TVpCustomDataStore) then
DataStore := TVpCustomDataStore(Owner.Components[I]);
Inc(I);
end;
{ Then auto connect to all available LinkableControl components found.}
I := 0;
while (I < Owner.ComponentCount) do begin
if (Owner.Components[I] is TVpLinkableControl) then begin
if (TVpLinkableControl(Owner.Components[I]).ControlLink = nil)
and (TVpLinkableControl(Owner.Components[I]).DataStore = DataStore)
then
TVpLinkableControl(Owner.Components[I]).ControlLink := self;
end;
Inc(I);
end;
end;
FPrinter := TVpPrinter.Create (Self);
FLocalization := TVpLocalization.Create;
end;
{=====}
destructor TVpControlLink.Destroy;
var
I: Integer;
begin
FPrinter.Free;
FPrinter := nil;
FLocalization.Free;
FLocalization := nil;
{ Detach self from any dependent controls }
if Owner <> nil then begin
I := 0;
while (I < Owner.ComponentCount) do begin
if (Owner.Components[I] is TVpLinkableControl)
and (TVpLinkableControl(Owner.Components[I]).ControlLink = self) then
Detach(TVpLinkableControl(Owner.Components[I]));
Inc(I);
end;
end;
ReleaseDependents;
DependentList.Free;
inherited;
end;
{=====}
procedure TVpControlLink.ReleaseDependents;
var
I : Integer;
begin
for I := pred(DependentList.Count) downto 0 do
Detach(TVpDependentInfo(DependentList[i]).Component);
// for I := 0 to pred(DependentList.Count) do
// Detach(TVpDependentInfo(DependentList.List^[I]).Component);
end;
{=====}
procedure TVpControlLink.Detach(Sender: TComponent);
var
I: Integer;
begin
try
for I := 0 to pred(DependentList.Count) do
// if TVpDependentInfo(DependentList.List^[I]).Component = Sender then
if TVpDependentInfo(DependentList[I]).Component = Sender then
begin
// TVpDependentInfo(DependentList.List^[I]).Free;
TVpDependentInfo(DependentList[I]).Free;
DependentList.Delete(I);
if Sender is TVpLinkableControl then
TVpLinkableControl(Sender).ControlLink := nil;
Exit;
end;
except
// swallow exceptions
end;
end;
{=====}
procedure TVpControlLink.Attach(Sender: TComponent);
var
I : Integer;
Exists: Boolean;
Link: TVpDependentInfo;
begin
Exists := false;
for I := 0 to pred(DependentList.Count) do
// if TVpDependentInfo(DependentList.List^[I]).Component = Sender then begin
if TVpDependentInfo(DependentList[I]).Component = Sender then begin
Exists := true;
Break;
end;
if not Exists then begin
Link := TVpDependentInfo.Create;
Link.Component := Sender;
if Sender is TVpLinkableCOntrol then
Link.EventHandler := TVpLinkableControl(Sender).LinkHandler;
DependentList.Add(Link);
end;
end;
{=====}
function TVpControlLink.GetDependentList : TList;
begin
Result := DependentList;
end;
{=====}
procedure TVpControlLink.LoadLocalizationInfo (const FileName : string);
begin
LocalizationFile := FileName;
end;
{=====}
procedure TVpControlLink.Notify(Sender: TComponent;
NotificationType: TVpNotificationType; const Value: Variant);
var
I : Integer;
begin
for I := 0 to pred(DependentList.Count) do begin
// with TVpDependentInfo(DependentList.List^[I]) do begin
with TVpDependentInfo(DependentList[I]) do begin
if Component <> Sender then
EventHandler(Sender, NotificationType, Value);
end;
end;
end;
{=====}
procedure TVpControlLink.SetCityStateZipFormat(const Value: String);
begin
if FCityStateZipFormat <> Value then begin
FCityStateZipFormat := Value;
Notify(self, neInvalidate, 0);
end;
end;
procedure TVpControlLink.SetDataStore(const Value: TVpCustomDataStore);
begin
if FDataStore <> Value then begin
FDataStore := Value;
if FDatastore <> nil then FDatastore.LinkToControls(Owner);
end;
end;
{=====}
procedure TVpControlLink.SetDefaultCountry (const v : string);
begin
if v <> FDefaultCountry then begin
FDefaultCountry := v;
end;
end;
{=====}
procedure TVpControlLink.SetLocalizationFile (const v : string);
var
fn: String;
begin
if v <> FLocalizationFile then begin
FLocalizationFile := v;
if (FLocalizationFile <> '') and not (csDesigning in ComponentState) then
begin
fn := ExpandFilename(v);
if not FileExists(fn) then begin
if Assigned(FOnNoLocalizationFile) then
FOnNoLocalizationFile(Self, fn);
end else
FLocalization.LoadFromFile(fn, False);
end;
end;
end;
{=====}
procedure TVpControlLink.SetPrinter (const v : TVpPrinter);
begin
FPrinter.Assign (v);
end;
{=====}
procedure TVpControlLink.TriggerOnGetVariable(Sender : TObject;
VarName: string; Found: Boolean; var Value: string;
var Change: TVpChangeVar);
begin
if Assigned (FOnGetVariable) then
FOnGetVariable (Sender, VarName, Found, Value, Change);
end;
{=====}
procedure TVpControlLink.TriggerOnPageEnd(Sender: TObject; PageNum: Integer;
ADate: TDateTime; LastPage: Boolean);
begin
if Assigned (FOnPageEnd) then
FOnPageEnd (Sender, PageNum, ADate, LastPage);
end;
{=====}
procedure TVpControlLink.TriggerOnPageStart(Sender: TObject; PageNum : Integer;
ADate : TDateTime);
begin
if Assigned (FOnPageStart) then
FOnPageStart (Sender, PageNum, ADate);
end;
{=====}
end.