for testing:
unit uMultiResource;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, Menus, ImgList, DBPlanner, ADODB, Planner, Grids, DBGrids,
ComCtrls, ToolWin, XPMan, bsSkinCtrls, bsSkinBoxCtrls, Vcl.ExtCtrls,
Vcl.Imaging.jpeg, System.ImageList, IBODataset, Vcl.StdCtrls, Vcl.Mask,
Datasnap.DBClient;
type
TForm1 = class(TForm)
ToolBar1: TToolBar;
dbpRaum1: TDBPlanner;
DBDaySource1: TDBDaySource;
bsSkinDateEditTherapies1: TbsSkinDateEdit;
ClientDataSetTherapies: TClientDataSet;
ClientDataSetTherapiesStarttime: TDateTimeField;
ClientDataSetTherapiesEndtime: TDateTimeField;
ClientDataSetTherapiesKeyfield: TStringField;
ClientDataSetTherapiesWP_LocationID: TIntegerField;
ClientDataSetLocations: TClientDataSet;
IntegerField1: TIntegerField;
ClientDataSetLocationsShortDescription: TStringField;
ClientDataSetTherapiesNote: TStringField;
ClientDataSetTherapiesDescription: TStringField;
ClientDataSetTherapiesID: TIntegerField;
ClientDataSetLocationsInaktiv: TBooleanField;
ClientDataSetTherapiesAutoID: TAutoIncField;
ClientDataSetLocationsAutoID: TAutoIncField;
DataSourceTherapies1: TDataSource;
ButtonFilterOn1: TButton;
ButtonFilterOff1: TButton;
procedure FormCreate(Sender: TObject);
procedure bsSkinDateEditTherapies1Change(Sender: TObject);
procedure DBDaySource1FieldsToItem(Sender: TObject; Fields: TFields;
Item: TPlannerItem);
procedure ClientDataSetTherapiesBeforeOpen(DataSet: TDataSet);
procedure ButtonFilterOn1Click(Sender: TObject);
procedure ButtonFilterOff1Click(Sender: TObject);
private
{ Private declarations }
procedure SetViewRooms1;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
ClientDataSetLocations.CreateDataSet;
try
ClientDataSetTherapies.BeforeOpen := nil;
ClientDataSetTherapies.CreateDataSet;
finally
ClientDataSetTherapies.BeforeOpen := ClientDataSetTherapiesBeforeOpen;
end;
with ClientDataSetLocations do
begin
for i := 1 to 10 do
begin
Append;
FieldByName('WP_LocationID').AsInteger := 214312200 + i;
FieldByName('ShortDescription').AsString := 'Loc' + inttostr(i);
FieldByName('Inaktiv').AsBoolean := (i <= 3);
Post;
end;
end;
with ClientDataSetTherapies do
begin
for i := 10 to 20 do
begin
Append;
FieldByName('ID').AsInteger := 200 + i;
FieldByName('Keyfield').AsString := '38XP6KK6218Z2TWTRJ63KU6B' + inttostr(i);
FieldByName('Starttime').AsDateTime := strtodatetime('19.02.2019 0' + inttostr(i-4) + ':00');
FieldByName('Endtime').AsDateTime := FieldByName('Starttime').AsDateTime + 1/24;
FieldByName('Note').AsString := 'Massage' + inttostr(i);
FieldByName('Description').AsString := 'Massage' + inttostr(i);
FieldByName('WP_LocationID').AsInteger := 214312200 + i - 10 + 1;
Post;
end;
end;
bsSkinDateEditTherapies1.Date := date;
end;
procedure TForm1.ClientDataSetTherapiesBeforeOpen(DataSet: TDataSet);
begin
SetViewRooms1;
end;
procedure TForm1.SetViewRooms1;
var
i:Integer;
aRooms:Integer;
begin
try
try
aRooms := 0;
dbpRaum1.Items.BeginUpdate;
dbpRaum1.ItemSource := DBDaySource1;
dbpRaum1.Items.Clear;
with ClientDataSetLocations do
begin
Close;
Open;
First;
while not eof do
begin
if not FieldByName('InAktiv').AsBoolean then
aRooms := aRooms + 1;
Next;
end;
First;
i := 0;
DBDaySource1.ResourceMap.Clear;
DBDaySource1.NumberOfResources := aRooms;
while not EOF do
begin
if not FieldByName('InAktiv').AsBoolean then
begin
DBDaySource1.ResourceMap.Add;
DBDaySource1.ResourceMap.Items.DisplayName := FieldByName('ShortDescription').AsString;
DBDaySource1.ResourceMap.Items.ResourceIndex := FieldByName('WP_LocationID').AsInteger;
DBDaySource1.ResourceMap.Items.PositionIndex := i;
inc(i);
end;
Next;
end;
Close;
end;
except
on E:Exception do
ShowMessage('Error in Raum-View on SetViewRooms' + #13#10 + E.Message);
end;
finally
dbpRaum1.Items.EndUpdate;
dbpRaum1.Refresh;;
end;
end;
procedure TForm1.DBDaySource1FieldsToItem(Sender: TObject; Fields: TFields;
Item: TPlannerItem);
begin
try
item.tag:=0;
except
on E:Exception do
ShowMessage('Error in Raum-View on DBDaySource1FieldsToItem' + #13#10 + E.Message);
end;
end;
procedure TForm1.bsSkinDateEditTherapies1Change(Sender: TObject);
begin
DBDaysource1.Day := bsSkinDateEditTherapies1.Date;
with ClientDataSetTherapies do
begin
Close;
Filter := 'Starttime >= ''' + formatdatetime('dd.mm.yyyy', bsSkinDateEditTherapies1.Date) + ''' and Starttime < ''' + formatdatetime('dd.mm.yyyy', bsSkinDateEditTherapies1.Date+1) + '''';
Filtered := TRUE;
try
Open;
except
on E:Exception do
ShowMessage('Error on bsSkinDateEditTherapies1Change' + #13#10 + E.Message);
end;
end;
end;
procedure TForm1.ButtonFilterOff1Click(Sender: TObject);
begin
try
with ClientDataSetLocations do
begin
Close;
Filter := '';
Filtered := FALSE;
end;
SetViewRooms1;
except
on E:Exception do
ShowMessage('Error on ButtonFilterOff1Click' + #13#10 + E.Message);
end;
end;
procedure TForm1.ButtonFilterOn1Click(Sender: TObject);
begin
try
with ClientDataSetLocations do
begin
Close;
Filter := 'WP_LocationID > ' + inttostr(105);
Filtered := TRUE;
end;
SetViewRooms1;
except
on E:Exception do
ShowMessage('Error on ButtonFilterOn1Click' + #13#10 + E.Message);
end;
end;
end.