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

tvplanit: Fix scrolling in VpContactGrid.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8528 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-08 21:11:33 +00:00
parent 07a9b508b9
commit 66154224a4
2 changed files with 63 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,6 +27,7 @@
{* ***** END LICENSE BLOCK ***** *}
{$I vp.inc}
{$DEFINE DEBUG_CONTACTGRID}
unit VpContactGrid;
@ -35,6 +36,7 @@ interface
uses
{$IFDEF LCL}
LMessages, LCLProc, LCLType, LCLIntf,
{$IFDEF DEBUG_CONTACTGRID}LazLogger,{$ENDIF}
{$ELSE}
Windows, Messages,
{$ENDIF}
@ -112,6 +114,7 @@ type
{ Contact Grid }
TVpContactGrid = class(TVpLinkableControl)
private
FCol1RecCount: Integer;
FComponentHint: TTranslateString;
FDefaultPopup: TPopupMenu;
FExternalPopup: TPopupMenu;
@ -149,7 +152,6 @@ type
FContactsAfter : Integer;
{ internal variables }
cgLastXPos : Integer;
cgCol1RecCount : Word;
cgDragBarNumber : Integer;
cgNewColWidth : Integer;
cgBarArray : TVpBarArray;
@ -257,6 +259,9 @@ type
Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime;
StartLine, StopLine: Integer; UseGran: TVpGranularity;
DisplayOnly: Boolean); override;
procedure UpdateScrollbar;
{ VCard support }
procedure ExportVCardFile(const AFileName: String; const AContacts: TVpContactArr);
function ImportVCardFile(const AFileName: String;
APreview: Boolean = false; ADefaultCategory: Integer = -1): TVpContactArr;
@ -280,8 +285,11 @@ type
property ContactIndex: Integer read FContactIndex write SetContactIndex;
property DisplayEMailValue[AContact: TVpContact]: String read GetDisplayEMailValue write SetDisplayEMailValue;
// Unscaled some dimensions
// property RowHeight: Integer read FRowHeight;
// Properties needed by painter
property Col1RecCount: Integer read FCol1RecCount write FCol1RecCount;
property ContactsAfter: Integer read FContactsAfter write FContactsAfter;
property ContactsBefore: Integer read FContactsBefore;
property VisibleContacts: Integer read FVisibleContacts write FVisibleContacts;
published
property Align;
@ -496,7 +504,7 @@ begin
FAllowInPlaceEdit := true;
FContactsBefore := 0;
FContactsAfter := 0;
cgCol1RecCount := 0;
FCol1RecCount := 0;
cgClickPoint := Point (0, 0);
cgClickTimer.Enabled := false;
cgClickTimer.Interval := ClickDelay;
@ -972,7 +980,7 @@ end;
procedure TVpContactGrid.SetContactIndex(Value: Integer);
begin
FContactIndex := Value;
if (DataStore <> nil) and (DataStore.Resource <> nil) then
if (DataStore <> nil) and (DataStore.Resource <> nil) and (FContactIndex > -1) then
FActiveContact := DataStore.Resource.Contacts.GetContact(FContactIndex)
else
FContactIndex := -1;
@ -988,6 +996,11 @@ begin
end;
end;
procedure TVpContactGrid.UpdateScrollbar;
begin
SetHScrollPos;
end;
{$IFNDEF LCL}
procedure TVpContactGrid.WMSize(var Msg: TWMSize);
{$ELSE}
@ -1019,7 +1032,7 @@ procedure TVpContactGrid.CreateWnd;
begin
inherited;
// cgCalcRowHeight;
SetHScrollPos;
// SetHScrollPos;
end;
procedure TVpContactGrid.ShowHintWindow(APoint: TPoint; AContactIndex: Integer);
@ -1735,15 +1748,15 @@ begin
VK_END:
ContactIndex := contactCount - 1;
VK_RIGHT:
if ContactIndex + cgCol1RecCount <= contactCount - 1 then
ContactIndex := ContactIndex + cgCol1RecCount
if ContactIndex + FCol1RecCount <= contactCount - 1 then
ContactIndex := ContactIndex + FCol1RecCount
else
ContactIndex := contactCount - 1;
VK_LEFT:
if ContactIndex - cgCol1RecCount <= 0 then
if ContactIndex - FCol1RecCount <= 0 then
ContactIndex := 0
else
ContactIndex := ContactIndex - cgCol1RecCount;
ContactIndex := ContactIndex - FCol1RecCount;
VK_DELETE:
DeleteActiveContact (true);
{$IFNDEF LCL}
@ -1801,10 +1814,10 @@ begin
begin
if (Msg.Pos > FContactsBefore) and (FContactsAfter = 0) then Exit;
FContactsBefore := Msg.Pos;
if (FContactsBefore = 1) and (cgCol1RecCount = 1) then
if (FContactsBefore = 1) and (FCol1RecCount = 1) then
FContactsBefore := 0;
if FContactsBefore >= DataStore.Resource.Contacts.Count then
FContactsBefore := DataStore.Resource.Contacts.Count - cgCol1RecCount;
FContactsBefore := DataStore.Resource.Contacts.Count - FCol1RecCount;
end;
end;
Invalidate;
@ -1828,12 +1841,12 @@ begin
Exit;
if (Rows < 0) and (FContactsBefore > 0) then
FContactsBefore := FContactsBefore - cgCol1RecCount
FContactsBefore := FContactsBefore - FCol1RecCount
else if (Rows > 0) and (FContactsAfter > 0) then
FContactsBefore := FContactsBefore + cgCol1RecCount;
FContactsBefore := FContactsBefore + FCol1RecCount;
if FContactsBefore >= DataStore.Resource.Contacts.Count then
FContactsBefore := DataStore.Resource.Contacts.Count - cgCol1RecCount;
FContactsBefore := DataStore.Resource.Contacts.Count - FCol1RecCount;
if FContactsBefore < 0 then FContactsBefore := 0;
end;
@ -1849,14 +1862,22 @@ begin
with SI do begin
cbSize := SizeOf(SI);
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
nPos := DataStore.Resource.Contacts.Count - 1
else
nPos := FContactsBefore;
nTrackPos := nPos;
{$IFDEF DEBUG_CONTACTGRID}
DebugLn(['[TVpContactGrid.SetHScrollPos] VisibleContacts=', FVisibleContacts, ' ContactsBefore=', FContactsBefore]);
{$ENDIF}
end;
SetScrollInfo(Handle, SB_HORZ, SI, True);
end;