View Issue Details

IDProjectCategoryView StatusLast Update
0006409JEDI VCL00 JVCL Componentspublic2018-07-18 16:08
ReportercacofonyAssigned To 
PrioritynormalSeveritycrashReproducibilityalways
Status acknowledgedResolutionopen 
Product VersionDaily / GIT 
Target VersionFixed in Version 
Summary0006409: TJvTFDays - Map column not found for appointment on refresh if mouse if hovered over controls
DescriptionUnder certain conditions TJvFDays will raise EJvTFDaysError.CreateRes(@RsEMapColNotFoundForAppointment) within
procedure TJvTFDays.WMSetCursor(var Msg: TWMSetCursor) during a slower refresh and if the mouse is moved over appointments because appointment might be in the process of being removed.
Additional InformationPerhaps not an ideal resolution but this try / except fixes it.

procedure TJvTFDays.WMSetCursor(var Msg: TWMSetCursor);
var
  Cur: HCURSOR;
  Coord: TJvTFDaysCoord;
begin
  Cur := 0;
  try
    with Msg do
      if HitTest = HTCLIENT then
      begin
        // Exception happens here during a refresh of appointments and mouse movement
        Coord := PtToCell(FHitTest.X, FHitTest.Y);
        case CanDragWhat(Coord) of
          agsSizeCol, agsSizeRowHdr:
            Cur := Screen.Cursors[crHSplit];
          agsSizeRow, agsSizeColHdr:
            Cur := Screen.Cursors[crVSplit];
          agsSizeAppt:
            Cur := Screen.Cursors[crSizeNS];
          agsMoveAppt:
            Cur := Screen.Cursors[crDrag];
        end;
      end;
  except
    Cur := 0;
  end;

  if Cur <> 0 then
    SetCursor(Cur)
  else
    inherited;
end;
TagsNo tags attached.

Activities

2015-06-12 09:05

 

0006409 - JvFTDays.patch (1,359 bytes)
diff --git a/jvcl/run/JvTFDays.pas b/jvcl/run/JvTFDays.pas
index 9fe4e32..d8e56f0 100644
--- a/jvcl/run/JvTFDays.pas
+++ b/jvcl/run/JvTFDays.pas
@@ -6833,21 +6833,26 @@ var
   Coord: TJvTFDaysCoord;
 begin
   Cur := 0;
-  with Msg do
-    if HitTest = HTCLIENT then
-    begin
-      Coord := PtToCell(FHitTest.X, FHitTest.Y);
-      case CanDragWhat(Coord) of
-        agsSizeCol, agsSizeRowHdr:
-          Cur := Screen.Cursors[crHSplit];
-        agsSizeRow, agsSizeColHdr:
-          Cur := Screen.Cursors[crVSplit];
-        agsSizeAppt:
-          Cur := Screen.Cursors[crSizeNS];
-        agsMoveAppt:
-          Cur := Screen.Cursors[crDrag];
+  try
+    with Msg do
+      if HitTest = HTCLIENT then
+      begin
+        // Exception happens here during a refresh of appointments and mouse movement
+        Coord := PtToCell(FHitTest.X, FHitTest.Y);
+        case CanDragWhat(Coord) of
+          agsSizeCol, agsSizeRowHdr:
+            Cur := Screen.Cursors[crHSplit];
+          agsSizeRow, agsSizeColHdr:
+            Cur := Screen.Cursors[crVSplit];
+          agsSizeAppt:
+            Cur := Screen.Cursors[crSizeNS];
+          agsMoveAppt:
+            Cur := Screen.Cursors[crDrag];
+        end;
       end;
-    end;
+  except
+    Cur := 0;
+  end;
 
   if Cur <> 0 then
     SetCursor(Cur)
0006409 - JvFTDays.patch (1,359 bytes)

cacofony

2015-06-12 09:05

reporter   ~0021169

Uploaded batch for latest GIT version of JvTFDays

obones

2015-09-14 11:25

administrator   ~0021192

Please provide the zipped sources of a sample application showing this

cacofony

2018-07-06 05:54

reporter   ~0021473

While still a slight hack this probably has a better overall effect.

function TJvTFDays.PtToCell(X, Y: Integer): TJvTFDaysCoord;
var
  ColNum, RowNum, AdjX, AdjY, Temp, TotalWidth, SegCount, MapCol: Integer;
  Done: Boolean;
  ApptRect: TRect;
begin
  try
    with Result do
    begin
      Col := gcUndef;
      Row := gcUndef;
      CellX := -100;
      CellY := -100;
      AbsX := X;
      AbsY := Y;
      Schedule := nil;
      Appt := nil;
    end;

    if X < CalcBlockHdrWidth then
    begin
      // POSSIBLE BUG!!
      // Result.Row := gcGroupHdr; // WRONG CODE
      Result.Col := gcGroupHdr; // UNTESTED - CORRECT CODE
      Result.CellX := X;
    end
    // block if X < RowHdrWidth then
    else if X < CalcBlockRowHdrsWidth then
    begin
      Result.Col := gcHdr;
      Result.CellX := X - CalcBlockHdrWidth;
    end
    else if LeftCol > -1 then
    begin
      // Find the col that PtX falls in
      ColNum := LeftCol;
      // block AdjX := X - RowHdrWidth;
      AdjX := X - CalcBlockRowHdrsWidth;
      Done := False;
      Temp := 0;

      while (ColNum < Cols.Count) and not Done do
      begin
        Inc(Temp, Cols[ColNum].Width);
        if AdjX < Temp then
        begin
          Done := True;
          Result.Col := ColNum;
          Result.CellX := AdjX - (Temp - Cols[ColNum].Width);
        end
        else
          Inc(ColNum);
      end;
      if not Done then
      begin
        Result.Col := Cols.Count - 1;
        Result.CellX := AdjX - (Temp - Cols[Cols.Count - 1].Width);
      end;
    end;

    if Y < CalcGroupHdrHeight then
    begin
      Result.Row := gcGroupHdr;
      Result.CellY := Y;
    end
    // else if Y < ColHdrHeight then
    else if Y < CalcGroupColHdrsHeight then
    begin
      Result.Row := gcHdr;
      Result.CellY := Y - CalcGroupHdrHeight;
    end
    else if TopRow > -1 then
    begin
      RowNum := TopRow;
      // group AdjY := Y - ColHdrHeight;
      AdjY := Y - CalcGroupColHdrsHeight;
      Done := False;
      Temp := 0;

      while (RowNum < RowCount) and not Done do
      begin
        Inc(Temp, RowHeight);
        if AdjY < Temp then
        begin
          Done := True;
          Result.Row := RowNum;
          Result.CellY := AdjY - (Temp - RowHeight);
        end
        else
          Inc(RowNum);
      end;
      if not Done then
      begin
        Result.Row := RowCount - 1;
        Result.CellY := AdjY - (Temp - RowHeight);
      end;
    end;

    if Result.Col > gcHdr then
    begin
      Result.Schedule := Cols[Result.Col].Schedule;

      // move grab handles
      if PtInTopHandle(Point(X, Y), Result.Col, SelAppt) then
        Result.Appt := SelAppt
      else if PtInBottomHandle(Point(X, Y), Result.Col, SelAppt) then
        Result.Appt := SelAppt
      else if (Result.Row > gcHdr) and Assigned(Result.Schedule) then
      begin
        TotalWidth := Cols[Result.Col].Width;
        SegCount := Cols[Result.Col].MapColCount(Result.Row);
        if SegCount > 0 then
        begin
          MapCol := LocateDivCol(Result.CellX, TotalWidth, SegCount);
          Result.Appt := Cols[Result.Col].MapLocation(MapCol, Result.Row);

          ApptRect := GetApptRect(Result.Col, Result.Appt);
          if not Windows.PtInRect(ApptRect, Point(X, Y)) then
            Result.Appt := nil;
        end;
      end;
    end;

    Result.DragAccept := (Result.Row > gcHdr) and (Result.Col > gcHdr);
  except
    with Result do
    begin
      Col := gcUndef;
      Row := gcUndef;
      CellX := -100;
      CellY := -100;
      AbsX := X;
      AbsY := Y;
      Schedule := nil;
      Appt := nil;
      DragAccept := False;
    end;
  end;
end;

2018-07-06 05:54

 

PhotoOp.zip (73,276 bytes)

2018-07-06 05:55

 

PhotoOp-Exe.zip (1,383,088 bytes)

cacofony

2018-07-06 05:59

reporter   ~0021474

I have uploaded a modified version of the PhotoOp example in both source and exe version

1.) The example could replace the current version that relies on DBX as it now uses the JVCL CSV dataset

2.) To force a simulation of the issue in PtToCell; click the new "refresh" button this will load the data slow. Now you can either keep moving the mouse around Appt and hope to get it (can take a while) or just move an appt during a refresh.

I know it's not a perfect real world example but it's the easiest way to demonstrate the issue

Issue History

Date Modified Username Field Change
2015-05-23 07:37 cacofony New Issue
2015-06-12 09:05 cacofony File Added: 0006409 - JvFTDays.patch
2015-06-12 09:05 cacofony Note Added: 0021169
2015-09-14 11:25 obones Note Added: 0021192
2015-09-14 11:25 obones Status new => feedback
2018-07-06 05:54 cacofony Note Added: 0021473
2018-07-06 05:54 cacofony File Added: PhotoOp.zip
2018-07-06 05:55 cacofony File Added: PhotoOp-Exe.zip
2018-07-06 05:59 cacofony Note Added: 0021474
2018-07-18 16:08 obones Status feedback => acknowledged