Bug in Planner.pas SetConflictsGen

VCL TMS VCL UI Pack
1
I am using
- Delphi Tokyo (10.2 Update 3)
- DBPlanner version 3.4.5.3 (Feb. 2019 for Delphi 10.2)

On calling MyDbPlanner.Items.EndUpdate the program "hangs".
The reason is that in SetConflictsGen the value Items.ItemPos
contains not the PositionIndex but the ID of the Resource.
I think that?s a bug, it should contain the Index not the Database-Table-ID
So cntpos contains then the value 214312200 (thats the location_id not the position)
and the line for i := 0 to cntpos do lasts very long ... for i:=0 to 214312200 :-)
what doesn?t make any sense.

procedure TPlannerItems.SetConflictsGen;
var
...
begin
  ...
  for I := 0 to Count - 1 do
  begin
    if Items.ItemEnd > cntitems then
      cntitems := Items.ItemEnd;
    if Items.ItemPos > cntpos then
      cntpos := Items.ItemPos;
    Items.FConflicts := 0;
    Items.FConflictPos := 0;
  end;
  ...
  for i := 0 to cntpos do
  begin
    ...
  end;
2

ItemPos should not contain the resource ID. Did you do an incorrect mapping of the resource ID to position in your dataset mapping?

3
That?s the code:

dbpRaum.Items.BeginUpdate;
dbpRaum.ItemSource := DBDaySource1;
dbpRaum.Items.Clear;
DBDaySource1.ResourceMap.Clear;
with IboQueryRooms do
begin
  Close;
  Open;
  DBDaySource1.NumberOfResources := RecordCount;
  while not EOF do
  begin
    DBDaySource1.ResourceMap.Add;
    DBDaySource1.ResourceMap.Items.DisplayName := FieldByName('SHORT_DESCRIPTION').AsString;
    DBDaySource1.ResourceMap.Items.ResourceIndex := FieldByName('WP_LOCATIONID').AsLargeInt;
    DBDaySource1.ResourceMap.Items.PositionIndex := RecNo-1;
    Next;  
  end;
end;
dbpRaum.Items.EndUpdate; // it "hangs" here if the WP_Location_ID is very high

4

I'd suggest to set a breakpoint in DBDaySource.OnFieldsToItem and check the Item.ItemPos there and verify if an incorrect value gets set there and trace where it comes from.


5

did that already:
- ItemPos already in FieldsToItem contains the id and not the position-index

6

That means that something is not correct in your mapping.

It could be an incorrect event handler for OnResourceToPosition(), it could be you did not load all resource IDs in the ResourceMap. Without further details, it is very hard to tell.
Planner sample 26 shows the resource mapping functionality, so, if you follow this as a guideline, it will work.

7

Could it be that the ResourceIndex is not allowed to be Int64?

(the problem is only occuring if there is a high ID like 214312200)

8

Yes ... it seems to be a bug (as far as I see):
if I set a resourceindex to 100 everything is ok (ItemPos is the position index)

if I set a resourceindex to 214312200 ItemPos is not the position index but 214312200
9

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;
        //dbpRaum1.Positions := 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.
10

if you replace the two 214312200 with 100 itempos is ok, if it is 214312200 itempos is not correct

11

Please check all values you set to the resource map items.

I also don't understand how you fill the resource map. I'd rather expect:


var
  rmi: TResourceMapItem;

  rmi := DBDaySource1.ResourceMap.Add;
  rmi.DisplayName := FieldByName('ShortDescription').AsString;
  rmi.ResourceIndex := FieldByName('WP_LocationID').AsInteger;
  rmi.ResourceMap.Items.PositionIndex := i;
12

The solution was to add

dbpRaum1/2.Items.BeginUpdate;
...
dbpRaum1/2.Items.EndUpdate;

everytime when I change/open/close the datasource of the ResourceMap or change the date
- in ButtonFilterOn1/2Click, ButtonFilterOff1/2Click
- and also in bsSkinDateEditTherapies1/2Change

Strange.