tvplanit: Trying to improve behaviour of arrow keys (not fully successful).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8529 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/source/vpcontactgrid.pas

@@ -58,6 +58,7 @@ type
   TVpContactRec = packed record
     Index       : Integer;
     Contact     : Pointer;
+    ColIndex    : Integer;
     CompanyRect : TRect;
     EMailRect   : TRect;
     WholeRect   : TRect;
@@ -136,6 +137,7 @@ type
     FScrollBars        : TScrollStyle;
     FContactHeadAttr   : TVpContactHeadAttr;
     FDrawingStyle      : TVpDrawingStyle;
+    FColCount          : Integer;
     FContactIndex      : Integer;
     FPrintNumColumns   : Integer;
     FActiveContact     : TVpContact;
@@ -165,7 +167,6 @@ type
     cgInPlaceEditor    : TVpCGInPlaceEdit;
     cgCreatingEditor   : Boolean;
     cgPainting         : Boolean;
-    cgColCount         : Integer;
     cgVScrollDelta     : Integer;
     FOldCursor : TCursor;
     FMouseContactIndex: Integer;
@@ -188,6 +189,8 @@ type
     procedure cgEditInPlace(Sender: TObject);
     procedure cgHookUp;
     function ContactIsVisible(AIndex: Integer): Boolean;
+    function ContactOfPositionInCol(AContact: TVpContact;
+      APosition, ANeighbor: Integer): Integer;
     procedure CreateHandle; override;
     procedure Paint; override;
     procedure Loaded; override;
@@ -286,6 +289,7 @@ type
     property DisplayEMailValue[AContact: TVpContact]: String read GetDisplayEMailValue write SetDisplayEMailValue;
 
     // Properties needed by painter
+    property ColCount: Integer read FColCount write FColCount;
     property Col1RecCount: Integer read FCol1RecCount write FCol1RecCount;
     property ContactsAfter: Integer read FContactsAfter write FContactsAfter;
     property ContactsBefore: Integer read FContactsBefore;
@@ -1730,6 +1734,119 @@ begin
   end;
 end;
 
+{ Returns the contact index of the contact in the same or a neighbord column
+  as AContact which is at the given positon (= row index).
+  APosition = -1 means: last contact in the considered column
+  APosition = -2 means: same position as AContact.
+  The column which is considered is the same (ANeighbor = 0),
+  previous (ANeighbor=-1) or next column (ANeighbor = +1). }
+function TVpContactGrid.ContactOfPositionInCol(AContact: TVpContact;
+  APosition, ANeighbor: Integer): Integer;
+var
+  i: Integer;
+  idx: Integer;
+  firstIdx, lastIdx, colIdx, pos: Integer;
+  CR: TVpContactRec;
+begin
+  if AContact = nil then
+  begin
+    Result := -1;
+    exit;
+  end;
+
+  // Find the ColumnRec associated with AContact
+  for i := 0 to High(cgContactArray) do
+    if cgContactArray[i].Contact = AContact then
+    begin
+      CR := cgContactArray[i];
+      idx := i;
+      break;
+    end;
+
+  // Get position of AContact in its own column
+  if CR.ColIndex = 0 then
+    pos := CR.Index
+  else
+  begin
+    pos := 0;
+    for i := idx-1 downto 0 do
+      if cgContactArray[i].ColIndex <> CR.ColIndex then
+      begin
+        pos := idx - i - 1;
+        break;
+      end;
+  end;
+
+  // Get index of the column to be searched
+  colIdx := CR.ColIndex + ANeighbor;
+  if colIdx < 0 then colIdx := 0;
+//  if colIdx >= FColCount then colIdx := FColCount-1;
+
+  // Find the first and last contacts in the column to be searched
+  firstIdx := 0;
+  lastIdx := Datastore.Resource.Contacts.Count-1;
+  if colIdx = CR.ColIndex then
+  begin
+    // Case (1): Searching in same column
+    for i := idx+1 to High(cgContactArray) do
+      if cgContactArray[i].ColIndex <> colIdx then
+      begin
+        lastIdx := i-1;
+        break;
+      end;
+    for i := idx-1 downto 0 do
+      if cgContactArray[i].ColIndex <> colIdx then
+      begin
+        firstIdx := i+1;
+        break;
+      end;
+  end else
+  if colIdx = CR.ColIndex + 1 then
+  begin
+    // Case (2): Searching in next column
+    for i := idx+1 to High(cgContactArray) do
+      if cgContactArray[i].ColIndex <> CR.ColIndex then
+      begin
+        firstIdx := i;
+        break;
+      end;
+    for i := firstIdx+1 to High(cgContactArray) do
+      if cgContactArray[i].ColIndex <> colIdx then
+      begin
+        lastIdx := i-1;
+        break;
+      end;
+  end else
+  if colIdx = CR.ColIndex - 1 then
+  begin
+    // Case (3): Searching in previous column
+    for i := idx-1 downto 0 do
+      if cgContactArray[i].ColIndex <> CR.ColIndex then
+      begin
+        lastIdx := i;
+        break;
+      end;
+    for i := lastIdx-1 downto 0 do
+      if cgContactArray[i].ColIndex <> colIdx then
+      begin
+        firstIdx := i+1;
+        break;
+      end;
+  end;
+
+  if APosition = -2 then
+    APosition := pos;
+
+  if APosition = -1 then
+    Result := lastIdx
+  else
+  begin
+    Result := firstIdx + APosition;
+    if Result > lastIdx then
+      Result := lastIdx;
+  end;
+end;
+
 procedure TVpContactGrid.KeyDown(var Key: Word; Shift: TShiftState);
 var
   PopupPoint: TPoint;
@@ -1747,16 +1864,25 @@ begin
       ContactIndex := 0;
     VK_END:
       ContactIndex := contactCount - 1;
+    VK_PRIOR:   // PgUp
+      ContactIndex := ContactOfPositionInCol(FActiveContact, 0, 0);
+    VK_NEXT:    // PgDn
+      ContactIndex := ContactOfPositionInCol(FActiveContact, -1, 0);
+
+    VK_RIGHT, VK_LEFT:
+      begin
+        Key := 0;
+        inherited;
+        exit;
+      end;
+    { wp: Removed the horizontal keys because of not logical scrolling (because
+      the painter renders only the visible part of the contact grid and the
+      complete layout of contacts is not known.
     VK_RIGHT:
-      if ContactIndex + FCol1RecCount <= contactCount - 1 then
+      ContactIndex := ContactOfPositionInCol(FActiveContact, -2, +1);
-        ContactIndex := ContactIndex + FCol1RecCount
-      else
-        ContactIndex := contactCount - 1;
     VK_LEFT:
-      if ContactIndex - FCol1RecCount <= 0 then
+      ContactIndex := ContactOfPositionInCol(FActiveContact, -2, -1);
-        ContactIndex := 0
+    }
-      else
-        ContactIndex := ContactIndex - FCol1RecCount;
     VK_DELETE:
       DeleteActiveContact (true);
 {$IFNDEF LCL}
@@ -1853,21 +1979,17 @@ end;
 
 procedure TVpContactGrid.SetHScrollPos;
 var
-  SI: TScrollInfo;
+  scrollInfo: TScrollInfo;
 begin
   if (not HandleAllocated) or (DataStore = nil) or (DataStore.Resource = nil)
     or (csDesigning in ComponentState)
   then Exit;
 
-  with SI do begin
+  with scrollInfo do begin
-    cbSize := SizeOf(SI);
+    cbSize := SizeOf(scrollInfo);
     fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
     nMin := 0;
     nMax := Datastore.Resource.Contacts.Count - 1;
-    {
-    nMin := 1;
-    nMax := DataStore.Resource.Contacts.Count;
-    }
     nPage := FVisibleContacts;
     if FContactsAfter = 0 then
       nPos := DataStore.Resource.Contacts.Count - 1
@@ -1879,7 +2001,7 @@ begin
     DebugLn(['[TVpContactGrid.SetHScrollPos] VisibleContacts=', FVisibleContacts, ' ContactsBefore=', FContactsBefore]);
     {$ENDIF}
   end;
-  SetScrollInfo(Handle, SB_HORZ, SI, True);
+  SetScrollInfo(Handle, SB_HORZ, scrollInfo, True);
 end;
 
 procedure TVpContactGrid.SetPrintNumColumns (const v : Integer);

components/tvplanit/source/vpcontactgridpainter.pas

@@ -455,7 +455,8 @@ begin
     CalcNextColumnAnchor(ABitmap, AWholeRect, Anchor);
     if NewPageNeeded(Anchor) then
     begin
-      // Return value FALSE signals that a new page must be created.
+      // Return value FALSE signals that a new page must be started in the
+      // next rendering iteration.
       Result := false;
       exit;
     end;
@@ -581,6 +582,7 @@ begin
         newPage := false;
         CR.Index := I;
         CR.Contact := contact;
+        CR.ColIndex := Col - 1;
         // Move rectangles in ContactGridRec to final position on rendering canvas.
         // Note:  The other rects already have been moved in DrawContactRows().
         CR.WholeRect := MoveRect(WholeRect, Anchor);
@@ -619,6 +621,7 @@ begin
     TVpContactGridOpener(FContactGrid).FLastPrintLine := -2;  // -2 = no more data available
   end;
   FContactGrid.VisibleContacts := contactCount - StartContact - FContactGrid.ContactsAfter;
+  FContactGrid.ColCount := Col;
 
   if (oldCol1RecCount > 0) and (FContactGrid.Col1RecCount = 0) then
     FContactGrid.Col1RecCount := oldCol1RecCount;