From 66154224a4bc46f7abfc7f87c4a6030fd30c3e4b Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 8 Oct 2022 21:11:33 +0000 Subject: [PATCH] tvplanit: Fix scrolling in VpContactGrid. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8528 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpcontactgrid.pas | 53 +++++++++++++------ .../tvplanit/source/vpcontactgridpainter.pas | 53 +++++++++---------- 2 files changed, 63 insertions(+), 43 deletions(-) diff --git a/components/tvplanit/source/vpcontactgrid.pas b/components/tvplanit/source/vpcontactgrid.pas index 024b79624..fb3856851 100644 --- a/components/tvplanit/source/vpcontactgrid.pas +++ b/components/tvplanit/source/vpcontactgrid.pas @@ -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; diff --git a/components/tvplanit/source/vpcontactgridpainter.pas b/components/tvplanit/source/vpcontactgridpainter.pas index 5f3ae4a47..6035b7847 100644 --- a/components/tvplanit/source/vpcontactgridpainter.pas +++ b/components/tvplanit/source/vpcontactgridpainter.pas @@ -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);