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

tvplanit: Fix white stripe appearing at the right of dayview print preview. Some refactoring and clean-up.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4905 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-03 20:30:06 +00:00
parent 5bc136ef28
commit 32e02ae41e
7 changed files with 62 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
components/tvplanit/examples/demo/demomain.lfm
View File

@ -1985,14 +1985,14 @@ object MainForm: TMainForm
object VpPrintPreviewDialog1: TVpPrintPreviewDialog
Version = 'v1.04'
DataStore = VpBufDSDataStore1
BottomMargin = 5
BottomMargin = 0
ControlLink = VpControlLink1
EndDate = 42561.5151169907
LeftMargin = 5
LeftMargin = 0
MarginUnits = imPercent
RightMargin = 5
RightMargin = 0
StartDate = 42554.5151169907
TopMargin = 5
TopMargin = 0
Options = [doSizeable]
Placement.Position = mpCenter
Placement.Top = 10

12
components/tvplanit/source/vpbase.pas
View File

@ -231,18 +231,6 @@ type
property Category7: TVpCategoryInfo index 7 read GetCategory write SetCat;
property Category8: TVpCategoryInfo index 8 read GetCategory write SetCat;
property Category9: TVpCategoryInfo index 9 read GetCategory write SetCat;
{
property Category0: TVpCategoryInfo read FCat0 write FCat0;
property Category1: TVpCategoryInfo read FCat1 write FCat1;
property Category2: TVpCategoryInfo read FCat2 write FCat2;
property Category3: TVpCategoryInfo read FCat3 write FCat3;
property Category4: TVpCategoryInfo read FCat4 write FCat4;
property Category5: TVpCategoryInfo read FCat5 write FCat5;
property Category6: TVpCategoryInfo read FCat6 write FCat6;
property Category7: TVpCategoryInfo read FCat7 write FCat7;
property Category8: TVpCategoryInfo read FCat8 write FCat8;
property Category9: TVpCategoryInfo read FCat9 write FCat9;
}
end;
{ TVpFont }

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

@ -359,6 +359,7 @@ type
FLocalizationFile : string;
FDefaultCountry : string;
FCityStateZipFormat: String;
FScreenOutput : Boolean;
protected{private}
DependentList: TList;
procedure Attach (Sender : TComponent);
@ -370,7 +371,7 @@ type
procedure SetLocalizationFile (const v : string);
procedure SetPrinter (const v : TVpPrinter);
public
constructor Create (AOwner : TComponent); override;
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
function GetDependentList : TList;
procedure LoadLocalizationInfo (const FileName : string);
@ -379,6 +380,7 @@ type
procedure TriggerOnPageEnd (Sender: TObject; PageNum: Integer; ADate: TDateTime; LastPage: Boolean);
procedure TriggerOnPageStart (Sender: TObject; PageNum: Integer; ADate: TDateTime);
property Localization : TVpLocalization read FLocalization write FLocalization;
property ScreenOutput: Boolean read FScreenOutput write FScreenOutput;
published
property CityStateZipFormat: String read FCityStateZipFormat write SetCityStateZipFormat;
// Use symbols @CITY, @STATE, @ZIP to define the order of these strings
@ -1199,6 +1201,8 @@ var
I: Integer;
begin
inherited;
FScreenOutput := true;
DependentList := TList.Create;
{ If the ControlLink is being dropped onto a form for the first time ... }

2
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -1576,7 +1576,7 @@ begin
}
if FDayView.VisibleLines < FDayView.LineCount then
if (FDayView.VisibleLines < FDayView.LineCount) and FDayView.ControlLink.ScreenOutput then
ScrollbarOffset := 14 else
ScrollbarOffset := 0;

5
components/tvplanit/source/vpprtfmt.pas
View File

@ -2427,6 +2427,11 @@ end;
procedure TVpPrinter.SetUseFormComponents(const v: Boolean);
begin
if v <> FUseFormComponents then begin
{$IFDEF LCL}
if not v then
raise Exception.Create('UseFormComponents = false currently not supported by Lazarus.');
// wp: This restriction can be dropped once CreateWorkControls does not crash any more.
{$ENDIF}
FUseFormComponents := v;
NotifyLinked;
end;

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

@ -857,6 +857,12 @@ var
ScaleY := FPrinter.PageHeight / (ClientHeight - (Offset1 + Offset2))
else
ScaleY := 1;
Result.TopLeft := Point(Offset1, Offset1);
if ScaleX > ScaleY then
Result.BottomRight := Point(ClientWidth - Offset2, round(FPrinter.PageHeight / ScaleX))
else
Result.BottomRight := Point(Round(FPrinter.PageWidth / ScaleY), ClientHeight - Offset2);
{
if ScaleX > ScaleY then
Result := Rect(
Offset1,
@ -871,6 +877,7 @@ var
Round(FPrinter.PageWidth / ScaleY),
ClientHeight - Offset2
);
}
end else
Result := Rect(3, 3, ClientWidth, ClientHeight);
end;
@ -880,6 +887,7 @@ var
AspectRect: TRect;
WorkHeight: Integer;
WorkWidth: Integer;
srcRect, dstRect: TRect;
begin
if FControlLink.Printer.PrintFormats.Count <= 0 then
Exit;
@ -890,32 +898,45 @@ var
if FZoomFactor = zfFitToControl then
begin
AspectRect := GetAspectRectangle;
WorkBmp.Canvas.CopyRect(
srcRect := Rect(0, 0, RenderBmp.Width, RenderBmp.Height);
WorkBmp.Canvas.CopyRect(AspectRect, RenderBmp.Canvas, srcRect);
(*
AspectRect,
RenderBmp.Canvas,
Rect (0, 0, RenderBmp.Width, RenderBmp.Height)
Rect(0, 0, RenderBmp.Width, RenderBmp.Height)
);
*)
RealWidth := AspectRect.Right - AspectRect.Left + 3;
RealHeight := AspectRect.Bottom - AspectRect.Top + 3;
end else
begin
WorkWidth := Round(RenderBmp.Width * ZOOM_FACTOR_VALUES[FZoomFactor]);
WorkHeight := Round(RenderBmp.Height * ZOOM_FACTOR_VALUES[FZoomFactor]);
if WorkHeight > ClientHeight - 3 then WorkHeight := ClientHeight - 3;
if WorkWidth > ClientWidth - 3 then WorkWidth := ClientWidth - 3;
WorkBmp.Canvas.CopyRect(
Rect(3, 3, WorkWidth, WorkHeight),
RenderBmp.Canvas,
Rect(
Round(FScrollX / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round(FScrollY / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round((WorkWidth + FScrollX) / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round((WorkHeight + FScrollY) / ZOOM_FACTOR_VALUES[FZoomFactor])
)
);
RealWidth := round(RenderBmp.Width / ZOOM_FACTOR_VALUES[FZoomFactor]);
RealHeight := round(RenderBmp.Height / ZOOM_FACTOR_VALUES[FZoomFactor]);
end;
end else
begin
WorkWidth := Round(RenderBmp.Width * ZOOM_FACTOR_VALUES[FZoomFactor]);
WorkHeight := Round(RenderBmp.Height * ZOOM_FACTOR_VALUES[FZoomFactor]);
if WorkHeight > ClientHeight - 3 then
WorkHeight := ClientHeight - 3;
if WorkWidth > ClientWidth - 3 then
WorkWidth := ClientWidth - 3;
srcRect := Rect(
Round(FScrollX / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round(FScrollY / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round((WorkWidth + FScrollX) / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round((WorkHeight + FScrollY) / ZOOM_FACTOR_VALUES[FZoomFactor])
);
dstRect := Rect(3, 3, WorkWidth, WorkHeight);
WorkBmp.Canvas.CopyRect(dstRect, RenderBmp.Canvas, srcRect);
(*
Rect(3, 3, WorkWidth, WorkHeight),
RenderBmp.Canvas,
Rect(
Round(FScrollX / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round(FScrollY / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round((WorkWidth + FScrollX) / ZOOM_FACTOR_VALUES[FZoomFactor]),
Round((WorkHeight + FScrollY) / ZOOM_FACTOR_VALUES[FZoomFactor])
)
);*)
RealWidth := round(RenderBmp.Width / ZOOM_FACTOR_VALUES[FZoomFactor]);
RealHeight := round(RenderBmp.Height / ZOOM_FACTOR_VALUES[FZoomFactor]);
end;
(*
case FZoomFactor of
@ -1044,7 +1065,7 @@ var
procedure RenderImage;
begin
Canvas.CopyRect (ClientRect, WorkBmp.Canvas, ClientRect);
Canvas.CopyRect(ClientRect, WorkBmp.Canvas, ClientRect);
end;
begin

4
components/tvplanit/source/vpprtprvdlg.pas
View File

@ -222,10 +222,13 @@ end;
function TVpPrintPreviewDialog.Execute: Boolean;
var
EditForm: TfrmPrintPreview;
scr: Boolean;
begin
Result := False;
scr := ControlLink.ScreenOutput;
Application.CreateForm(TfrmPrintPreview, EditForm);
try
ControlLink.ScreenOutput := false;
DoFormPlacement(EditForm);
EditForm.WindowState := WindowState;
EditForm.VpPrintPreview1.ControlLink := ControlLink;
@ -250,6 +253,7 @@ begin
end;
end;
finally
ControlLink.ScreenOutput := scr;
EditForm.Release;
end;
end;