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

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

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