paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tvplanit: add TVpResource.OverlayResources as alternate method to add overlay groups. Update FullDemo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8168 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2021-12-04 19:01:07 +00:00
parent 2757d26671
commit bb91c39431
8 changed files with 219 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
components/tvplanit/examples/fulldemo/demomain.lfm
View File

@ -9,7 +9,7 @@ object MainForm: TMainForm
Menu = MainMenu1
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
LCLVersion = '2.1.0.0'
LCLVersion = '2.3.0.0'
object Panel1: TPanel
Left = 125
Height = 576
@ -49,7 +49,6 @@ object MainForm: TMainForm
Font.Color = clWhite
Font.Height = -24
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
end
@ -58,7 +57,7 @@ object MainForm: TMainForm
Height = 528
Top = 48
Width = 834
PageIndex = 0
PageIndex = 3
Align = alClient
TabOrder = 1
TabStop = True
@ -224,7 +223,6 @@ object MainForm: TMainForm
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Visible days'
ParentColor = False
end
object DaysTrackBar: TTrackBar
AnchorSideLeft.Control = LblVisibleDays
@ -286,7 +284,6 @@ object MainForm: TMainForm
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
Caption = 'Granularity'
ParentColor = False
end
end
end
@ -349,7 +346,7 @@ object MainForm: TMainForm
Left = 4
Height = 19
Top = 4
Width = 63
Width = 61
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
@ -362,10 +359,10 @@ object MainForm: TMainForm
object RbHideCompletedTasks: TRadioButton
AnchorSideLeft.Control = RbAllTasks
AnchorSideLeft.Side = asrBottom
Left = 99
Left = 97
Height = 19
Top = 4
Width = 134
Width = 132
BorderSpacing.Left = 32
BorderSpacing.Top = 4
BorderSpacing.Bottom = 4
@ -442,9 +439,10 @@ object MainForm: TMainForm
object BtnDeleteRes: TButton
AnchorSideLeft.Control = BtnEditRes
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnNewRes
Left = 128
Height = 25
Top = 64
Top = 82
Width = 59
AutoSize = True
BorderSpacing.Left = 8
@ -455,9 +453,10 @@ object MainForm: TMainForm
object BtnEditRes: TButton
AnchorSideLeft.Control = BtnNewRes
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnNewRes
Left = 74
Height = 25
Top = 64
Top = 82
Width = 46
AutoSize = True
BorderSpacing.Left = 8
@ -466,21 +465,68 @@ object MainForm: TMainForm
TabOrder = 1
end
object BtnNewRes: TButton
AnchorSideLeft.Control = VpResourceCombo
AnchorSideTop.Control = VpResourceCombo
AnchorSideTop.Side = asrBottom
Left = 16
Height = 25
Top = 64
Top = 82
Width = 50
AutoSize = True
BorderSpacing.Top = 16
Caption = 'New'
OnClick = BtnNewResClick
TabOrder = 2
end
object VpResourceCombo1: TVpResourceCombo
object VpResourceCombo: TVpResourceCombo
AnchorSideLeft.Control = Resources
AnchorSideTop.Control = lblResources
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 16
Height = 23
Top = 24
Top = 43
Width = 323
Anchors = [akTop, akLeft, akRight]
Style = csDropDownList
Borderspacing.Left = 16
Borderspacing.Top = 4
end
object lbOtherResources: TCheckListBox
AnchorSideLeft.Control = BtnNewRes
AnchorSideTop.Control = lblOtherResources
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = VpResourceCombo
Left = 16
Height = 186
Top = 150
Width = 323
BorderSpacing.Top = 4
ItemHeight = 0
OnClickCheck = lbOtherResourcesClickCheck
TabOrder = 4
end
object lblOtherResources: TLabel
AnchorSideLeft.Control = VpResourceCombo
AnchorSideTop.Control = BtnNewRes
AnchorSideTop.Side = asrBottom
Left = 16
Height = 15
Top = 131
Width = 299
BorderSpacing.Top = 24
Caption = 'Check the resource to be overlaid to the current resource'
end
object lblResources: TLabel
AnchorSideLeft.Control = Resources
AnchorSideTop.Control = Resources
Left = 16
Height = 15
Top = 24
Width = 265
BorderSpacing.Left = 16
BorderSpacing.Top = 24
Caption = 'Resources (the selected resource will be displayed)'
end
end
object Settings: TPage
@ -495,7 +541,6 @@ object MainForm: TMainForm
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Language'
ParentColor = False
end
object CbLanguages: TComboBox
AnchorSideTop.Control = Settings
@ -535,7 +580,6 @@ object MainForm: TMainForm
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Drawing style:'
ParentColor = False
end
object CbAddressBuilder: TComboBox
AnchorSideLeft.Control = CbLanguages
@ -570,7 +614,6 @@ object MainForm: TMainForm
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Address builder'
ParentColor = False
end
object CbAllowInplaceEditing: TCheckBox
AnchorSideLeft.Control = CbLanguages
@ -580,7 +623,7 @@ object MainForm: TMainForm
Left = 316
Height = 19
Top = 26
Width = 131
Width = 129
BorderSpacing.Left = 32
Caption = 'Allow inplace editing'
Checked = True
@ -613,7 +656,6 @@ object MainForm: TMainForm
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'First day of week'
ParentColor = False
end
object CbTimeFormat: TComboBox
AnchorSideLeft.Control = CbLanguages
@ -633,14 +675,13 @@ object MainForm: TMainForm
AnchorSideTop.Control = CbTimeFormat
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = CbTimeFormat
Left = 38
Left = 39
Height = 15
Top = 63
Width = 66
Width = 65
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Time format'
ParentColor = False
end
object CbAllowDragAndDrop: TCheckBox
AnchorSideLeft.Control = CbAllowInplaceEditing
@ -649,7 +690,7 @@ object MainForm: TMainForm
Left = 316
Height = 19
Top = 61
Width = 179
Width = 177
Caption = 'Allow drag and drop of events'
OnChange = CbAllowDragAndDropChange
TabOrder = 6
@ -661,7 +702,7 @@ object MainForm: TMainForm
Left = 316
Height = 19
Top = 100
Width = 161
Width = 158
Caption = 'Transparent drag and drop'
OnChange = CbDragDropTransparentChange
TabOrder = 7
@ -673,7 +714,7 @@ object MainForm: TMainForm
Left = 316
Height = 19
Top = 139
Width = 176
Width = 174
Caption = 'Show event and contact hints'
Checked = True
OnChange = CbShowEventHintsChange

74
components/tvplanit/examples/fulldemo/demomain.pas
View File

@ -10,9 +10,9 @@ uses
{$ENDIF}
Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, LCLTranslator, Menus, Types, LCLVersion,
VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid,
VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData,
VpPrtPrvDlg, VpPrtFmtDlg, VpBase;
CheckLst, VpBaseDS, VpDayView, VpWeekView, VpTaskList, VpAbout, VpContactGrid,
VpMonthView, VpResEditDlg, VpContactButtons, VpNavBar, VpData, VpPrtPrvDlg,
VpPrtFmtDlg, VpBase;
type
@ -32,6 +32,9 @@ type
CbAllowDragAndDrop: TCheckBox;
CbDragDropTransparent: TCheckBox;
CbShowEventHints: TCheckBox;
lblOtherResources: TLabel;
lblResources: TLabel;
lbOtherResources: TCheckListBox;
Img: TImage;
ImageList1: TImageList;
LblDrawingStyle: TLabel;
@ -83,7 +86,7 @@ type
VpNavBar1: TVpNavBar;
VpPrintFormatEditDialog1: TVpPrintFormatEditDialog;
VpPrintPreviewDialog1: TVpPrintPreviewDialog;
VpResourceCombo1: TVpResourceCombo;
VpResourceCombo: TVpResourceCombo;
VpResourceEditDialog1: TVpResourceEditDialog;
VpTaskList1: TVpTaskList;
VpWeekView1: TVpWeekView;
@ -104,6 +107,7 @@ type
procedure DaysTrackBarChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure lbOtherResourcesClickCheck(Sender: TObject);
procedure MnuAboutClick(Sender: TObject);
procedure MnuEditPrintFormatsClick(Sender: TObject);
procedure MnuLoadPrintFormatsClick(Sender: TObject);
@ -128,10 +132,12 @@ type
FVisibleDays: Integer;
FResID: Integer;
FLanguageDir: String;
procedure ConnectHandler(Sender: TObject);
procedure CreateResourceGroup;
function GetlanguageDir: String;
procedure PopulateLanguages;
procedure PositionControls;
procedure ResourceChangeHandler(Sender: TObject; AResource: TVpResource);
procedure SetActiveView(AValue: Integer);
procedure SetLanguage(ALang: String); overload;
procedure SetLanguage(AIndex: Integer); overload;
@ -144,6 +150,7 @@ type
procedure ShowResources;
procedure ShowSettings;
procedure ShowTasks;
procedure UpdateOtherResourcesList;
procedure ReadIni;
procedure WriteIni;
@ -353,8 +360,10 @@ begin
exit;
if MessageDlg(Format(RSConfirmDeleteRes, [res.Description]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
VpControlLink1.Datastore.PurgeResource(res);
// VpControlLink1.Datastore.Resources.RemoveResource(res);
UpdateOtherResourcesList;
end;
end;
// Edits the currently selected resource
@ -368,6 +377,7 @@ end;
procedure TMainForm.BtnNewResClick(Sender: TObject);
begin
VpResourceEditDialog1.AddNewResource;
UpdateOtherResourcesList;
end;
procedure TMainForm.Cb3DChange(Sender: TObject);
@ -458,6 +468,11 @@ begin
VpMonthView1.TimeFormat := TVpTimeFormat(CbTimeFormat.ItemIndex);
end;
procedure TMainForm.ConnectHandler(Sender: TObject);
begin
UpdateOtherResourcesList;
end;
// Creates a resource group at runtime
procedure TMainForm.CreateResourceGroup;
const
@ -532,19 +547,40 @@ begin
MediaFolder := AppendPathDelim(SysUtils.GetEnvironmentVariable('SYSTEMROOT')) + 'media';
{$ENDIF}
OnConnect := @ConnectHandler;
OnResourceChange := @ResourceChangeHandler;
if (Resources.Count > 0) then begin
if FResID = -1 then
Resource := Resources.Items[0]
else
ResourceID := FResID;
CreateResourceGroup;
end;
end;
Caption := Application.Title;
end;
procedure TMainForm.lbOtherResourcesClickCheck(Sender: TObject);
var
i, n: Integer;
resArray: TVpResourceArray;
begin
// Collect resources checked for overlaying in an array
SetLength(resArray, lbOtherResources.Items.Count);
n := 0;
for i := 0 to lbOtherResources.Items.Count-1 do
if lbOtherResources.Checked[i] then
begin
resArray[n] := TVpResource(lbOtherResources.Items.Objects[i]);
inc(n);
end;
SetLength(resArray, n);
// Overlay the checked resources to the currently active resource
VpControlLink1.DataStore.Resource.OverlayResources(resArray);
end;
function TMainForm.GetLanguageDir: String;
begin
if FLanguageDir = '' then
@ -850,6 +886,24 @@ begin
end;
end;
procedure TMainForm.ResourceChangeHandler(Sender: TObject; AResource: TVpResource);
var
res: TVpResource;
i, j: Integer;
begin
lbOtherResources.Clear;
for i := 0 to VpControlLink1.DataStore.Resources.Count-1 do
begin
res := VpControlLink1.Datastore.Resources.Items[i];
if res <> AResource then
begin
j := lbOtherResources.Items.AddObject(res.Description, res);
if AResource.Group <> nil then
lbOtherResources.Checked[j] := AResource.Group.IndexOfID(AResource.ResourceID) <> -1;
end;
end;
end;
procedure TMainForm.WriteIni;
var
ini: TCustomIniFile;
@ -1110,6 +1164,12 @@ begin
ImageList1.GetBitmap(1, Img.Picture.Bitmap);
end;
procedure TMainForm.UpdateOtherResourcesList;
begin
lblOtherResources.Visible := VpControlLink1.Datastore.Resources.Count > 0;
lbOtherResources.Visible := VpControlLink1.Datastore.Resources.Count > 0;
end;
procedure TMainForm.VpBufDSDataStore1PlaySound(Sender: TObject;
const AWavFile: String; AMode: TVpPlaySoundMode);
begin

10
components/tvplanit/languages/demo.de.po
View File

@ -206,6 +206,16 @@ msgstr ""
msgid "Language"
msgstr ""
#: tmainform.lblotherresources.caption
msgctxt "tmainform.lblotherresources.caption"
msgid "Check the resource to be overlaid to the current resource"
msgstr ""
#: tmainform.lblresources.caption
msgctxt "tmainform.lblresources.caption"
msgid "Resources (the selected resource will be displayed)"
msgstr ""
#: tmainform.lbltimeformat.caption
msgid "Time format"
msgstr ""

10
components/tvplanit/languages/demo.fi.po
View File

@ -196,6 +196,16 @@ msgstr ""
msgid "Language"
msgstr ""
#: tmainform.lblotherresources.caption
msgctxt "tmainform.lblotherresources.caption"
msgid "Check the resource to be overlaid to the current resource"
msgstr ""
#: tmainform.lblresources.caption
msgctxt "tmainform.lblresources.caption"
msgid "Resources (the selected resource will be displayed)"
msgstr ""
#: tmainform.lbltimeformat.caption
msgid "Time format"
msgstr ""

10
components/tvplanit/languages/demo.nl.po
View File

@ -195,6 +195,16 @@ msgstr ""
msgid "Language"
msgstr ""
#: tmainform.lblotherresources.caption
msgctxt "tmainform.lblotherresources.caption"
msgid "Check the resource to be overlaid to the current resource"
msgstr ""
#: tmainform.lblresources.caption
msgctxt "tmainform.lblresources.caption"
msgid "Resources (the selected resource will be displayed)"
msgstr ""
#: tmainform.lbltimeformat.caption
msgid "Time format"
msgstr ""

10
components/tvplanit/languages/demo.ru.po
View File

@ -205,6 +205,16 @@ msgstr ""
msgid "Language"
msgstr ""
#: tmainform.lblotherresources.caption
msgctxt "tmainform.lblotherresources.caption"
msgid "Check the resource to be overlaid to the current resource"
msgstr ""
#: tmainform.lblresources.caption
msgctxt "tmainform.lblresources.caption"
msgid "Resources (the selected resource will be displayed)"
msgstr ""
#: tmainform.lbltimeformat.caption
msgid "Time format"
msgstr ""

47
components/tvplanit/source/vpdata.pas
View File

@ -68,6 +68,7 @@ type
{ forward declarations }
TVpResource = class;
TVpResourceGroup = class;
TVpResourceArray = array of TVpResource;
TVpTasks = class;
TVpSchedule = class;
TVpEvent = class;
@ -150,6 +151,8 @@ type
constructor Create(Owner: TVpResources);
destructor Destroy; override;
procedure GetResourceGroups(AList: TList);
function OverlayResources(const AResources: TVpResourceArray;
ACaption: String = ''): TVpResourceGroup;
property Loading: Boolean read FLoading write FLoading;
property Changed: Boolean read FChanged write SetChanged;
property Deleted: Boolean read FDeleted write SetDeleted;
@ -1012,6 +1015,48 @@ begin
end;
end;
{ Overlays the resources listed in the array AResources and creates a
resource group named according to ACaption (or, if ACaption is empty, the
comma-separated list of the individual resource names).
If a resource group if this name already exists its contained resources are
replaced by the new ones.
When the array is empty, the overlay group with this caption is cleared. }
function TVpResource.OverlayResources(const AResources: TVpResourceArray;
ACaption: String = ''): TVpResourceGroup;
var
grp: TVpResourceGroup;
i: Integer;
begin
// Use resource descriptions if ACaption is not specified or empty.
if ACaption = '' then
begin
ACaption := FDescription;
for i := Low(AResources) to High(AResources) do
if AResources[i] <> nil then
ACaption := ACaption + ', ' + AResources[i].Description;
end;
// Enforce unique group name
grp := FOwner.FindResourceGroupByName(ACaption);
if grp = nil then
begin
grp := TVpResourceGroup.Create(FOwner, FResourceID, ACaption);
FOwner.FResourceGroups.Add(grp);
end else
grp.Clear; // Make sure that the group is empty before overlaying resources
// Add resources to group
for i := Low(AResources) to High(AResources) do
grp.AddID(AResources[i].ResourceID);
FGroup := grp;
Result := grp;
// Repaint the events
TVpCustomDatastore(FOwner.FOwner).RefreshEvents;
end;
procedure TVpResource.SetContacts(const Value: TVpContacts);
begin
FContacts := Value;
@ -1093,7 +1138,7 @@ begin
FCaption := ACaption;
FPattern := opBDiagonal;
FReadOnly := true;
FShowDetails := [odResource];
FShowDetails := [odResource, odEventDescription];
Clear;
end;

2
components/tvplanit/source/vpdayview.pas
View File

@ -927,7 +927,7 @@ begin
exit;
grp := Datastore.Resource.Group;
showDetails := (grp <> nil) and (odEventDescription in grp.ShowDetails);
showDetails := (grp <> nil) and (grp.ShowDetails <> []);
isOverlayed := AEvent.IsOverlayed;
timefmt := GetTimeFormatStr(TimeFormat);