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

tvplanit: Fix page-breaks when printing contact grid to printer or preview.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8526 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-08 17:54:44 +00:00
parent 03cc304f83
commit 736c3abb6c
3 changed files with 63 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/tvplanit/source/vpconst.pas
View File

@ -75,7 +75,7 @@ const
MaxDateLen = 40; { maximum length of date picture strings }
MaxMonthName = 15; { maximum length for month names }
MaxDayName = 15; { maximum length for day names }
TEXT_MARGIN = 5; { amount of space around text }
TEXT_MARGIN = 5; { amount of space around text (pixels) }
MaxVisibleEvents = 1024; { maximum number of events that can be }
{ visible at any one time }
MaxEventDepth = 50; { the maximum number of side by side }
@ -85,8 +85,8 @@ const
{ each event click in the TimeGrid }
calDefHeight = 140; { popup calendar default height }
calDefWidth = 200; { popup calendar default width }
ExtraBarWidth = 2; { The extra, draggable area on either side }
{ of the Contact Grid's horizontal bars. }
ExtraBarWidth = 2; { The extra, draggable area on each side }
{ of the Contact Grid's vertical bars. }
CompareTimeEPS = 0.1 * OneSecond; { Epsilon for time comparison, 0.1 sec }
cmPerInch = 2.54; { 1 inch is 2.54 cm }

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

@ -36,7 +36,7 @@ type
function CalcLabelWidth(ABitmap: TBitmap): Integer;
procedure CalcNextColumnAnchor(ABitmap: TBitmap; const AWholeRect: TRect;
var Anchor: TPoint);
function CalcTextColWidth(ABitmap: TBitmap): Integer;
function GetTextColWidth(ABitmap: TBitmap): Integer;
function NewColumnNeeded(AWholeRect: TRect; Anchor: TPoint): Boolean;
function NewPageNeeded(Anchor: TPoint): Boolean;
@ -161,14 +161,6 @@ begin
end;
end;
function TVpContactGridPainter.CalcTextColWidth(ABitmap: TBitmap): Integer;
begin
case Angle of
ra0, ra180: Result := ABitmap.Width;
ra90, ra270: Result := ABitmap.Height;
end;
end;
procedure TVpContactGridPainter.Clear;
var
I: Integer;
@ -394,7 +386,8 @@ end;
{ Draws selected data for the specified contact on the auxiliary bitmap.
Anchor ...... position at which the data will appear on the rendering canvas.
AWholeRect .. rectangle covered by the data rows (header included). It is
relative to the auxiliary bitmap.
relative to the auxiliary bitmap and expanded at exit by the
height of the row.
ACol ........ Column counter, advances when a new column is started
ARecsInCol .. Counter for the records in the first column
AContactRec . Record storing mostly the rectangles of the data elements to
@ -407,7 +400,6 @@ function TVpContactGridPainter.DrawContactRows(ABitmap: TBitmap;
var
s: String;
spacing: Integer;
textColWidth: Integer;
newCol: Boolean;
begin
Result := true;
@ -457,12 +449,14 @@ begin
// If this record is too big to fit in the remaining area of this column,
// then slide over to the top of the next column }
newCol := (ARecsInCol > 0) and NewColumnNeeded(AWholeRect, Anchor);
if newCol then
begin
CalcNextColumnAnchor(ABitmap, AWholeRect, Anchor);
if DisplayOnly and NewPageNeeded(Anchor) then
begin
Result := false; // to do: fix creating a new page
// Return value FALSE signals that a new page must be created.
Result := false;
exit;
end;
@ -532,6 +526,7 @@ begin
TVpContactGridOpener(FContactGrid).FVisibleContacts := 0;
TVpContactGridOpener(FContactGrid).cgCol1RecCount := 0;
px4 := Round(4 * Scale);
CR := Default(TVpContactRec);
// Create a temporary bitmap for painting the contact items
TmpBmp := TBitmap.Create;
@ -544,8 +539,8 @@ begin
TmpBmp.Width := RealHeight - FScaledTextMargin * 2;
end;
// Calculate the width of each contact column (without spacers)
FTextColWidth := CalcTextColWidth(TmpBmp);
// Get the net width of each contact column (without spacers)
FTextColWidth := GetTextColWidth(TmpBmp);
// Calculate max label width
FLabelWidth := CalcLabelWidth(TmpBmp);
@ -562,6 +557,7 @@ begin
// Iterate over all contacts
Col := 1;
RecsInCol := 0;
for I := StartContact to pred(contactCount) do begin
contact := FContactGrid.DataStore.Resource.Contacts.GetContact(I);
if contact = nil then
@ -582,85 +578,48 @@ begin
begin
CR.Index := I;
CR.Contact := contact;
// 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);
CR.HeaderRect := MoveRect(HeadRect, Anchor);
TVpContactGridOpener(FContactGrid).cgContactArray[I] := CR;
end else
exit; // to do: begin a new page here!
// Draw the contact bitmap on the rendering canvas
PaintContactBitmap(TmpBmp, contact, Anchor, WholeRect);
// Draw the contact bitmap on the rendering canvas
PaintContactBitmap(TmpBmp, contact, Anchor, WholeRect);
// Slide anchor down for the next record
case Angle of
ra0 : Anchor.Y := Anchor.Y + WholeRect.Bottom;
ra90 : Anchor.X := Anchor.X + WidthOf(WholeRect);
ra180 : Anchor.Y := Anchor.Y - HeightOf(WholeRect);
ra270 : Anchor.X := Anchor.X + WholeRect.Right;
end;
if not DisplayOnly then
// Slide anchor down for the next record
case Angle of
ra0 :
with TVpContactGridOpener(FContactGrid) do
if (Anchor.X > RenderIn.Right) and (I < DataStore.Resource.Contacts.Count)
then begin
// We have filled in the visible area
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else begin
FContactsAfter := 0;
FVisibleContacts := contactCount - StartContact;
end;
ra90 :
with TVpContactGridOpener(FContactGrid) do
if (Anchor.Y > RenderIn.Bottom) and (I < contactCount)
then begin
// We have filled in the visible area
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else begin
FContactsAfter := 0;
FVisibleContacts := contactCount - StartContact;
end;
ra180 :
with TVpContactGridOpener(FContactGrid) do begin
if (Anchor.X < RenderIn.Left) and (I < contactCount)
then begin
// We have filled in the visible area
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else
FContactsAfter := 0;
FVisibleContacts := contactCount - StartContact;
end;
ra270 :
with TVpContactGridOpener(FContactGrid) do begin
if (Anchor.Y < RenderIn.Top) and (I < contactCount)
then begin
// We have filled in the visible area
FContactsAfter := contactCount - I;
FVisibleContacts := contactCount - StartContact - FContactsAfter;
Break;
end else
FContactsAfter := 0;
FVisibleContacts := contactCount - StartContact;
end;
ra0 : Anchor.Y := Anchor.Y + WholeRect.Bottom;
ra90 : Anchor.X := Anchor.X + WidthOf(WholeRect);
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;
break;
end;
end; // for I := StartCont to ...
finally
TmpBmp.Free;
end;
with TVpContactGridOpener(FContactGrid) do begin
if FContactsAfter = 0 then
FLastPrintLine := -2
else
FLastPrintLine := FContactsAfter;
if (FContactsAfter = 0) or (FLastPrintLine >= contactCount) then
FLastPrintLine := -2;
if (oldCol1RecCount > 0) and (cgCol1RecCount = 0) then
cgCol1RecCount := oldCol1RecCount;
end;
@ -760,6 +719,14 @@ begin
end;
end;
function TVpContactGridPainter.GetTextColWidth(ABitmap: TBitmap): Integer;
begin
case Angle of
ra0, ra180: Result := ABitmap.Width;
ra90, ra270: Result := ABitmap.Height;
end;
end;
procedure TVpContactGridPainter.InitColors;
begin
if DisplayOnly then begin
@ -897,17 +864,17 @@ begin
SetMeasurements;
{ clear the control }
// Clear the control
Clear;
{ draw the contacts }
// Draw the contacts
if StartLine <> -2 then
DrawContacts;
{ draw the vertical bars }
// Draw the vertical bars
DrawVerticalBars;
{ draw the borders }
// Draw the borders
DrawBorders;
TVpContactGridOpener(FContactGrid).SetHScrollPos;
@ -917,7 +884,7 @@ begin
DeleteObject(Rgn);
end;
{ reinstate canvas settings }
// Restore canvas settings
RestorePenBrush;
end;

11
components/tvplanit/source/vpprtprv.pas
View File

@ -329,7 +329,7 @@ begin
FreeMem(FPageInfo[i]);
end;
FPageInfo.Clear;
CurPage := 0;
FCurPage := 0;
end;
{$IFDEF DELPHI}
@ -694,8 +694,6 @@ end;
procedure TVpPrintPreview.LoadPage(PageNum: Integer;
StartDate, EndDate: TDateTime);
var
i: Integer;
LastPage: Boolean;
pageInfo: PVpPageInfo;
lDate: TDateTime;
lTask: Integer;
@ -703,6 +701,13 @@ var
lLastPage: Boolean;
begin
Unused(EndDate);
if FPageInfo.Count = 0 then
raise Exception.Create('No pages to print');
if (PageNum < 0) then
PageNum := 0;
if (PageNum >= FPageInfo.Count) then
PageNum := FPageInfo.Count - 1;
pageInfo := PVpPageInfo(FPageInfo[PageNum]);
lDate := pageInfo.Date;