pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8529 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-08 23:06:29 +00:00
parent 66154224a4
commit 2c1fbdc6a6
2 changed files with 143 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

156
components/tvplanit/source/vpcontactgrid.pas
View File

@ -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 := ContactIndex + FCol1RecCount
else
ContactIndex := contactCount - 1;
ContactIndex := ContactOfPositionInCol(FActiveContact, -2, +1);
VK_LEFT:
if ContactIndex - FCol1RecCount <= 0 then
ContactIndex := 0
else
ContactIndex := ContactIndex - FCol1RecCount;
ContactIndex := ContactOfPositionInCol(FActiveContact, -2, -1);
}
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
cbSize := SizeOf(SI);
with scrollInfo do begin
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);

5
components/tvplanit/source/vpcontactgridpainter.pas
View File

@ -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;