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;

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

@ -4,7 +4,7 @@ unit VpContactGridPainter;
interface
uses
uses lazlogger,
LCLType, LCLIntf, SysUtils,
Types, Classes, Graphics,
VpConst, VPBase, VpData, VpBasePainter, VpContactGrid;
@ -453,7 +453,7 @@ begin
if newCol then
begin
CalcNextColumnAnchor(ABitmap, AWholeRect, Anchor);
if DisplayOnly and NewPageNeeded(Anchor) then
if NewPageNeeded(Anchor) then
begin
// Return value FALSE signals that a new page must be created.
Result := false;
@ -463,7 +463,7 @@ begin
// New columns Increment the column counter. Store the counter of records
// in the 1st column and reset it for the new column.
if ACol = 1 then
TVpContactGridOpener(FContactGrid).cgCol1RecCount := ARecsInCol;
FContactGrid.Col1RecCount := ARecsInCol;
Inc(ACol);
ARecsInCol := 0;
end else
@ -498,7 +498,7 @@ end;
procedure TVpContactGridPainter.DrawContacts;
var
Anchor: TPoint;
I: Integer;
I, J: Integer;
TmpBmp: TBitmap;
contact: TVpContact;
Col, RecsInCol: Integer;
@ -507,6 +507,7 @@ var
CR: TVpContactRec;
HeadRect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
contactCount: Integer;
newPage: Boolean;
px4: Integer; // Scaled 4 pixels
begin
// If the component is sufficiently small then no sense in painting it
@ -522,9 +523,9 @@ begin
// Some initializations
contactCount := FContactGrid.DataStore.Resource.Contacts.Count;
oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount;
TVpContactGridOpener(FContactGrid).FVisibleContacts := 0;
TVpContactGridOpener(FContactGrid).cgCol1RecCount := 0;
oldCol1RecCount := FContactGrid.Col1RecCount;
FContactGrid.VisibleContacts := 0;
FContactGrid.Col1RecCount := 0;
px4 := Round(4 * Scale);
CR := Default(TVpContactRec);
@ -559,6 +560,7 @@ begin
RecsInCol := 0;
for I := StartContact to pred(contactCount) do begin
J := I; // Do not use the loop index outside a for loop!
contact := FContactGrid.DataStore.Resource.Contacts.GetContact(I);
if contact = nil then
Continue;
@ -576,6 +578,7 @@ begin
WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height);
if DrawContactRows(TmpBmp, contact, Anchor, WholeRect, Col, RecsInCol, CR) then
begin
newPage := false;
CR.Index := I;
CR.Contact := contact;
// Move rectangles in ContactGridRec to final position on rendering canvas.
@ -594,22 +597,10 @@ begin
ra180 : Anchor.Y := Anchor.Y - HeightOf(WholeRect);
ra270 : Anchor.X := Anchor.X + WholeRect.Right;
end;
with TVpContactGridOpener(FContactGrid) do
begin
FVisibleContacts := contactCount - StartContact;
FContactsAfter := contactCount - 1;
if I = contactCount-1 then
FLastPrintLine := -2;
end;
end else
begin
// New page required.
with TVpContactGridOpener(FContactGrid) do
begin
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
FLastPrintLine := I; // Strangely named, but this is the contact index beginning the next page
end;
newPage := true;
break;
end;
end; // for I := StartCont to ...
@ -617,12 +608,20 @@ begin
TmpBmp.Free;
end;
with TVpContactGridOpener(FContactGrid) do begin
if (FContactsAfter = 0) or (FLastPrintLine >= contactCount) then
FLastPrintLine := -2;
if (oldCol1RecCount > 0) and (cgCol1RecCount = 0) then
cgCol1RecCount := oldCol1RecCount;
if newPage then
begin
FContactGrid.ContactsAfter := contactCount - J;
TVpContactGridOpener(FContactGrid).FLastPrintLine := J;
end else
begin
// All contacts printed
FContactGrid.ContactsAfter := 0;
TVpContactGridOpener(FContactGrid).FLastPrintLine := -2; // -2 = no more data available
end;
FContactGrid.VisibleContacts := contactCount - StartContact - FContactGrid.ContactsAfter;
if (oldCol1RecCount > 0) and (FContactGrid.Col1RecCount = 0) then
FContactGrid.Col1RecCount := oldCol1RecCount;
end;
procedure TVpContactGridPainter.DrawVerticalBars;
@ -858,7 +857,7 @@ begin
SelectClipRgn(RenderCanvas.Handle, Rgn);
if StartLine = -1 then
StartContact := TVpContactGridOpener(FContactGrid).FContactsBefore
StartContact := FContactGrid.ContactsBefore
else
StartContact := StartLine;
@ -877,7 +876,7 @@ begin
// Draw the borders
DrawBorders;
TVpContactGridOpener(FContactGrid).SetHScrollPos;
FContactGrid.UpdateScrollbar;
finally
SelectClipRgn(RenderCanvas.Handle, 0);