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

tvplanit: Cometic changes in print preview units. Activate some commented Delphi-only code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4792 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-21 15:12:38 +00:00
parent 1ae439b458
commit 60140bfdc5
2 changed files with 459 additions and 485 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -61,8 +61,8 @@ uses
{$ELSE} {$ELSE}
Windows, Messages, Windows, Messages,
{$ENDIF} {$ENDIF}
SysUtils,Classes,Controls,Forms,Graphics, Printers, VpBase, SysUtils, Classes, Controls, Forms, Graphics, Printers,
VpMisc,VpBaseDS, VpSR, VpException, Menus; VpBase, VpMisc, VpBaseDS, VpSR, VpException, Menus;
type type
TVpPageChange = procedure(Sender: TObject; NewPage: Integer) of object; TVpPageChange = procedure(Sender: TObject; NewPage: Integer) of object;
@ -71,6 +71,11 @@ type
zf25Percent, zf33Percent, zf50Percent, zf25Percent, zf33Percent, zf50Percent,
zf67Percent, zf75Percent); zf67Percent, zf75Percent);
const
ZOOM_FACTOR_VALUES: array[TVpPPZoomFactor] of Double = (
-1, 1.0, 0.25, 1.0/3, 0.5, 2.0/3, 0.75);
type
TVpPageInfo = record TVpPageInfo = record
Date: TDateTime; Date: TDateTime;
Task: Integer; Task: Integer;
@ -107,7 +112,7 @@ type
function CalculatePageHeight(Printer: TPrinter): Integer; function CalculatePageHeight(Printer: TPrinter): Integer;
function CalculatePageWidth(Printer: TPrinter): Integer; function CalculatePageWidth(Printer: TPrinter): Integer;
procedure ClearPageData; procedure ClearPageData;
{$IFNDEF LCL} {$IFDEF DELPHI}
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
message CM_WANTSPECIALKEY; message CM_WANTSPECIALKEY;
{$ENDIF} {$ENDIF}
@ -116,17 +121,13 @@ type
procedure DoScroll(var Msg: {$IFNDEF LCL}TWMSCROLL{$ELSE}TLMScroll{$ENDIF}; BarDirection: Integer); procedure DoScroll(var Msg: {$IFNDEF LCL}TWMSCROLL{$ELSE}TLMScroll{$ENDIF}; BarDirection: Integer);
procedure GeneratePageImage; procedure GeneratePageImage;
procedure GetLastPage; procedure GetLastPage;
procedure InitHScrollBar (PageSize : Integer; procedure InitHScrollBar(PageSize, TotalSize: Integer);
TotalSize : Integer);
procedure InitializeDefaultPopup; procedure InitializeDefaultPopup;
procedure InitVScrollBar (PageSize : Integer; procedure InitVScrollBar(PageSize, TotalSize: Integer);
TotalSize : Integer);
function IsPageLoaded(PageNum: Integer): Boolean; function IsPageLoaded(PageNum: Integer): Boolean;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Loaded; override; procedure Loaded; override;
function LoadPage (PageNum : Integer; function LoadPage(PageNum: Integer; StartDate, EndDate: TDateTime): Integer;
StartDate : TDateTime;
EndDate : TDateTime) : Integer;
procedure Paint; override; procedure Paint; override;
procedure PopupFirstPage(Sender: TObject); procedure PopupFirstPage(Sender: TObject);
procedure PopupLastPage(Sender: TObject); procedure PopupLastPage(Sender: TObject);
@ -148,7 +149,7 @@ type
procedure SetZoomFactor(const v: TVpPPZoomFactor); procedure SetZoomFactor(const v: TVpPPZoomFactor);
// procedure VpPrintFormatChanged (var Msg : {$IFNDEF LCL}TMessage{$ELSE}TLMessage{$ENDIF}; message Vp_PrintFormatChanged; // procedure VpPrintFormatChanged (var Msg : {$IFNDEF LCL}TMessage{$ELSE}TLMessage{$ENDIF}; message Vp_PrintFormatChanged;
{$IFNDEF LCL} {$IFDEF DELPHI}
procedure WMEraseBackground(var Msg: TWMERASEBKGND); message WM_ERASEBKGND; procedure WMEraseBackground(var Msg: TWMERASEBKGND); message WM_ERASEBKGND;
procedure WMHScroll(var Msg: TWMSCROLL); message WM_HSCROLL; procedure WMHScroll(var Msg: TWMSCROLL); message WM_HSCROLL;
procedure WMVScroll(var Msg: TWMSCROLL); message WM_VSCROLL; procedure WMVScroll(var Msg: TWMSCROLL); message WM_VSCROLL;
@ -159,6 +160,7 @@ type
procedure WMVScroll(var Msg: TLMSCROLL); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMSCROLL); message LM_VSCROLL;
procedure WMRButtonDown(var Msg: TLMRButtonDown); message LM_RBUTTONDOWN; procedure WMRButtonDown(var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
{$ENDIF} {$ENDIF}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@ -174,28 +176,20 @@ type
property Printer: TPrinter read FPrinter write SetPrinter; property Printer: TPrinter read FPrinter write SetPrinter;
property DestPrinter: TPrinter read FPrinter write SetPrinter; property DestPrinter: TPrinter read FPrinter write SetPrinter;
published published
property BorderColor : TColor read FBorderColor write SetBorderColor property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
default clBlack; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property BorderStyle : TBorderStyle property ControlLink: TVpControlLink read FControlLink write SetControlLink;
read FBorderStyle write SetBorderStyle default bsSingle;
property ControlLink : TVpControlLink
read FControlLink write SetControlLink;
property CurPage: Integer read FCurPage write SetCurPage; property CurPage: Integer read FCurPage write SetCurPage;
// property DestPrinter: TPrinter read FPrinter write SetPrinter; // property DestPrinter: TPrinter read FPrinter write SetPrinter;
property DrawingStyle : TVpDrawingStyle property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle default ds3d;
read FDrawingStyle write SetDrawingStyle default ds3d;
property EndDate: TDateTime read FEndDate write SetEndDate; property EndDate: TDateTime read FEndDate write SetEndDate;
property OffPageColor : TColor read FOffPageColor write SetOffPageColor property OffPageColor: TColor read FOffPageColor write SetOffPageColor default clSilver;
default clSilver; property PageColor: TColor read FPageColor write SetPageColor default clWhite;
property PageColor : TColor read FPageColor write SetPageColor
default clWhite;
property StartDate: TDateTime read FStartDate write SetStartDate; property StartDate: TDateTime read FStartDate write SetStartDate;
property ZoomFactor : TVpPPZoomFactor property ZoomFactor: TVpPPZoomFactor read FZoomFactor write SetZoomFactor default zfFitToControl;
read FZoomFactor write SetZoomFactor default zfFitToControl; property OnPageChange: TVpPageChange read FOnPageChange write FOnPageChange;
property OnPageChange : TVpPageChange
read FOnPageChange write FOnPageChange;
property Anchors; property Anchors;
property Align; property Align;
@ -232,6 +226,7 @@ type
property OnStartDrag; property OnStartDrag;
end; end;
implementation implementation
constructor TVpPrintPreview.Create(AOwner: TComponent); constructor TVpPrintPreview.Create(AOwner: TComponent);
@ -279,9 +274,7 @@ begin
RenderBmp.Free; RenderBmp.Free;
WorkBmp.Free; WorkBmp.Free;
FPageInfo.Free; FPageInfo.Free;
FDefaultPopup.Free; FDefaultPopup.Free;
inherited Destroy; inherited Destroy;
@ -291,28 +284,30 @@ function TVpPrintPreview.CalculatePageHeight (Printer : TPrinter) : Integer;
var var
ScreenPPI: Integer; ScreenPPI: Integer;
PrinterPPI: Integer; PrinterPPI: Integer;
begin begin
{$IFNDEF LCL}
ScreenPPI := GetDeviceCaps (Canvas.Handle, LOGPIXELSY); ScreenPPI := GetDeviceCaps (Canvas.Handle, LOGPIXELSY);
{$IFDEF DELPHI}
PrinterPPI := GetDeviceCaps (Printer.Handle, LOGPIXELSY); PrinterPPI := GetDeviceCaps (Printer.Handle, LOGPIXELSY);
{$ELSE}
PrinterPPI := Printer.XDpi;
{$ENDIF}
if PrinterPPI <> 0 then if PrinterPPI <> 0 then
Result := Round (ScreenPPI / PrinterPPI * Printer.PageHeight) Result := Round (ScreenPPI / PrinterPPI * Printer.PageHeight)
else else
Result := ScreenPPI * Printer.PageHeight; Result := ScreenPPI * Printer.PageHeight;
{$ENDIF}
end; end;
function TVpPrintPreview.CalculatePageWidth (Printer : TPrinter) : Integer; function TVpPrintPreview.CalculatePageWidth (Printer : TPrinter) : Integer;
var var
ScreenPPI: Integer; ScreenPPI: Integer;
PrinterPPI: Integer; PrinterPPI: Integer;
begin begin
{$IFNDEF LCL}
ScreenPPI := GetDeviceCaps (Canvas.Handle, LOGPIXELSX); ScreenPPI := GetDeviceCaps (Canvas.Handle, LOGPIXELSX);
{$IFDEF DELPHI}
PrinterPPI := GetDeviceCaps (Printer.Handle, LOGPIXELSX); PrinterPPI := GetDeviceCaps (Printer.Handle, LOGPIXELSX);
{$ELSE}
PrinterPPI := Printer.XDpi;
if PrinterPPI <> 0 then if PrinterPPI <> 0 then
Result := Round (ScreenPPI / PrinterPPI * Printer.PageWidth) Result := Round (ScreenPPI / PrinterPPI * Printer.PageWidth)
@ -324,7 +319,6 @@ end;
procedure TVpPrintPreview.ClearPageData; procedure TVpPrintPreview.ClearPageData;
var var
i: Integer; i: Integer;
begin begin
for i := FPageInfo.Count - 1 downto 0 do begin for i := FPageInfo.Count - 1 downto 0 do begin
if Assigned (FPageInfo[i]) then if Assigned (FPageInfo[i]) then
@ -334,7 +328,7 @@ begin
CurPage := 0; CurPage := 0;
end; end;
{$IFNDEF LCL} {$IFDEF DELPHI}
procedure TVpPrintPreview.CMWantSpecialKey(var Msg: TCMWantSpecialKey); procedure TVpPrintPreview.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin begin
inherited; inherited;
@ -357,7 +351,7 @@ end;
procedure TVpPrintPreview.CreateWnd; procedure TVpPrintPreview.CreateWnd;
begin begin
if (HandleAllocated) and (Assigned (FControlLink)) then if HandleAllocated and Assigned(FControlLink) then
FControlLink.Printer.DeregisterWatcher(Handle); FControlLink.Printer.DeregisterWatcher(Handle);
inherited CreateWnd; inherited CreateWnd;
@ -366,19 +360,13 @@ begin
FControlLink.Printer.RegisterWatcher(Handle); FControlLink.Printer.RegisterWatcher(Handle);
end; end;
{$IFNDEF LCL} procedure TVpPrintPreview.DoScroll(var Msg: {$IFNDEF LCL}TWMSCROLL{$ELSE}TLMScroll{$ENDIF};
procedure TVpPrintPreview.DoScroll (var Msg : TWMSCROLL;
BarDirection: Integer); BarDirection: Integer);
{$ELSE}
procedure TVpPrintPreview.DoScroll (var Msg : TLMSCROLL;
BarDirection : Integer);
{$ENDIF}
var var
ScrollBarInfo: TScrollInfo; ScrollBarInfo: TScrollInfo;
begin begin
Msg.Result := 0; Msg.Result := 0;
ScrollBarInfo.cbSize := SizeOf (TscrollInfo); ScrollBarInfo.cbSize := SizeOf(TScrollInfo);
ScrollBarInfo.fMask := SIF_ALL; ScrollBarInfo.fMask := SIF_ALL;
GetScrollInfo (Handle, BarDirection, ScrollBarInfo); GetScrollInfo (Handle, BarDirection, ScrollBarInfo);
ScrollBarInfo.fMask := SIF_POS; ScrollBarInfo.fMask := SIF_POS;
@ -395,7 +383,7 @@ begin
end; end;
ScrollBarInfo.fMask := SIF_POS; ScrollBarInfo.fMask := SIF_POS;
if ScrollBarInfo.nPos < ScrollBarInfo.nMin Then if ScrollBarInfo.nPos < ScrollBarInfo.nMin then
ScrollBarInfo.nPos := ScrollBarInfo.nMin; ScrollBarInfo.nPos := ScrollBarInfo.nMin;
if ScrollBarInfo.nPos + Integer(ScrollBarInfo.nPage) > if ScrollBarInfo.nPos + Integer(ScrollBarInfo.nPage) >
ScrollBarInfo.nMax Then ScrollBarInfo.nMax Then
@ -436,7 +424,6 @@ var
UseDate: TDateTime; UseDate: TDateTime;
UseContact: Integer; UseContact: Integer;
UseTask: Integer; UseTask: Integer;
begin begin
if not Assigned(FControlLink) then if not Assigned(FControlLink) then
Exit; Exit;
@ -445,17 +432,22 @@ begin
Exit; Exit;
if (FControlLink.Printer.PrintFormats.Count = 0) or if (FControlLink.Printer.PrintFormats.Count = 0) or
(FControlLink.Printer.CurFormat < 0) then (FControlLink.Printer.CurFormat < 0)
then
Exit; Exit;
FCurrentFormat := FControlLink.Printer.CurFormat; FCurrentFormat := FControlLink.Printer.CurFormat;
if (FPrinter <> nil) and if (FPrinter <> nil) and
((RenderBmp.Width = 0) or (RenderBmp.Height = 0)) then begin ((RenderBmp.Width = 0) or (RenderBmp.Height = 0)) then
begin
RenderBmp.Width := CalculatePageWidth(FPrinter); RenderBmp.Width := CalculatePageWidth(FPrinter);
RenderBmp.Height := CalculatePageHeight(FPrinter); RenderBmp.Height := CalculatePageHeight(FPrinter);
end else if (FPrinter = nil) and end
((RenderBmp.Width = 0) or (RenderBmp.Height = 0)) then begin else
if (FPrinter = nil) and
((RenderBmp.Width = 0) or (RenderBmp.Height = 0)) then
begin
RenderBmp.Width := ClientWidth; RenderBmp.Width := ClientWidth;
RenderBmp.Height := ClientHeight; RenderBmp.Height := ClientHeight;
end; end;
@ -468,24 +460,25 @@ begin
RenderBmp.Canvas.FillRect(Rect(0, 0, RenderBmp.Width, RenderBmp.Height)); RenderBmp.Canvas.FillRect(Rect(0, 0, RenderBmp.Width, RenderBmp.Height));
if not IsPageLoaded(CurPage) then if not IsPageLoaded(CurPage) then
FControlLink.Printer.PaintToCanvasRect (RenderBmp.Canvas, FControlLink.Printer.PaintToCanvasRect(
Rect (0, 0, RenderBmp.Canvas,
RenderBmp.Width, Rect(0, 0, RenderBmp.Width, RenderBmp.Height),
RenderBmp.Height), StartDate
StartDate) )
else begin else begin
UseDate := PVpPageInfo(FPageInfo[CurPage]).Date; UseDate := PVpPageInfo(FPageInfo[CurPage]).Date;
UseContact := PVpPageInfo(FPageInfo[CurPage]).Contact; UseContact := PVpPageInfo(FPageInfo[CurPage]).Contact;
UseTask := PVpPageInfo(FPageInfo[CurPage]).Task; UseTask := PVpPageInfo(FPageInfo[CurPage]).Task;
FControlLink.Printer.RenderPage (RenderBmp.Canvas, FControlLink.Printer.RenderPage(
Rect (0, 0, RenderBmp.Width, RenderBmp.Canvas,
RenderBmp.Height), Rect(0, 0, RenderBmp.Width, RenderBmp.Height),
CurPage, CurPage,
UseDate, UseDate,
EndDate, EndDate,
UseContact, UseContact,
UseTask, UseTask,
LastPage); LastPage
);
end; end;
SetScrollBars; SetScrollBars;
end; end;
@ -493,39 +486,35 @@ end;
procedure TVpPrintPreview.GetLastPage; procedure TVpPrintPreview.GetLastPage;
var var
i: Integer; i: Integer;
begin begin
i := FPageInfo.Count - 1; i := FPageInfo.Count - 1;
while (not PVpPageInfo (FPageInfo[i]).LastPage) and while (not PVpPageInfo(FPageInfo[i]).LastPage) and (i < FPageInfo.Count) do
(i < FPageInfo.Count) do begin begin
Inc (i); inc(i);
LoadPage(i, StartDate, EndDate); LoadPage(i, StartDate, EndDate);
end; end;
end; end;
procedure TVpPrintPreview.InitHScrollBar (PageSize : Integer; procedure TVpPrintPreview.InitHScrollBar(PageSize, TotalSize: Integer);
TotalSize : Integer);
var var
ScrollBarInfo: TScrollInfo; ScrollBarInfo: TScrollInfo;
begin begin
FNeedHScroll := True; FNeedHScroll := True;
ScrollBarInfo.cbSize := SizeOf (TScrollInfo); ScrollBarInfo.cbSize := SizeOf (TScrollInfo);
ScrollBarInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL; ScrollBarInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
ScrollBarInfo.nMin := 0; ScrollBarInfo.nMin := 0;
ScrollBarInfo.nMax := TotalSize; ScrollBarInfo.nMax := TotalSize;
ScrollBarInfo.nPage := PageSize; ScrollBarInfo.nPage := PageSize;
ScrollBarInfo.nPos := 0; ScrollBarInfo.nPos := 0;
ScrollBarInfo.nTrackPos := 0; ScrollBarInfo.nTrackPos := 0;
SetScrollInfo(Handle, SB_HORZ, ScrollBarInfo, True); SetScrollInfo(Handle, SB_HORZ, ScrollBarInfo, True);
end; end;
procedure TVpPrintPreview.InitializeDefaultPopup; procedure TVpPrintPreview.InitializeDefaultPopup;
var var
NewItem: TMenuItem; NewItem: TMenuItem;
begin begin
if RSPrintPrvPrevPage <> '' then begin if RSPrintPrvPrevPage <> '' then begin
NewItem := TMenuItem.Create (Self); NewItem := TMenuItem.Create (Self);
@ -560,11 +549,9 @@ begin
end; end;
end; end;
procedure TVpPrintPreview.InitVScrollBar (PageSize : Integer; procedure TVpPrintPreview.InitVScrollBar(PageSize, TotalSize: Integer);
TotalSize : Integer);
var var
ScrollBarInfo: TScrollInfo; ScrollBarInfo: TScrollInfo;
begin begin
FNeedVScroll := True; FNeedVScroll := True;
@ -575,6 +562,7 @@ begin
ScrollBarInfo.nPage := PageSize; ScrollBarInfo.nPage := PageSize;
ScrollBarInfo.nTrackPos := 0; ScrollBarInfo.nTrackPos := 0;
ScrollBarInfo.nPos := 0; ScrollBarInfo.nPos := 0;
SetScrollInfo (Handle, SB_VERT, ScrollBarInfo, True); SetScrollInfo (Handle, SB_VERT, ScrollBarInfo, True);
end; end;
@ -587,7 +575,8 @@ function TVpPrintPreview.IsLastPage : Boolean;
begin begin
if FPageInfo.Count = 0 then if FPageInfo.Count = 0 then
Result := True Result := True
else if CurPage < FPageInfo.Count then else
if CurPage < FPageInfo.Count then
Result := PVpPageInfo(FPageInfo[CurPage]).LastPage Result := PVpPageInfo(FPageInfo[CurPage]).LastPage
else begin else begin
GetLastPage; GetLastPage;
@ -600,11 +589,9 @@ begin
Result := PageNum < FPageInfo.Count; Result := PageNum < FPageInfo.Count;
end; end;
procedure TVpPrintPreview.KeyDown(var Key: Word; Shift: TShiftState); procedure TVpPrintPreview.KeyDown(var Key: Word; Shift: TShiftState);
var var
PopupPoint: TPoint; PopupPoint: TPoint;
begin begin
case Key of case Key of
VK_LEFT, VK_PRIOR : VK_LEFT, VK_PRIOR :
@ -612,18 +599,21 @@ begin
FirstPage FirstPage
else else
PrevPage; PrevPage;
VK_RIGHT, VK_NEXT: VK_RIGHT, VK_NEXT:
if ssCtrl in Shift then if ssCtrl in Shift then
LastPage LastPage
else else
NextPage; NextPage;
$5A: {z} $5A: {z}
if ssCtrl in Shift then begin if ssCtrl in Shift then begin
if ZoomFactor = High(FZoomFactor) then if ZoomFactor = High(FZoomFactor) then
ZOomFactor := Low(FZoomFactor) ZOomFactor := Low(FZoomFactor)
else else
ZoomFactor := Succ(FZoomFactor); ZoomFactor := Succ(FZoomFactor);
end else if ssShift in Shift then begin end else
if ssShift in Shift then begin
if ZoomFactor = Low(FZoomFactor) then if ZoomFactor = Low(FZoomFactor) then
ZOomFactor := High(FZoomFactor) ZOomFactor := High(FZoomFactor)
else else
@ -635,32 +625,29 @@ begin
ControlLink.Printer.CurFormat := ControlLink.Printer.CurFormat + 1 ControlLink.Printer.CurFormat := ControlLink.Printer.CurFormat + 1
else else
ControlLink.Printer.CurFormat := 0; ControlLink.Printer.CurFormat := 0;
end else if (ssShift in Shift) and Assigned (ControlLink) then begin end else
if (ssShift in Shift) and Assigned(ControlLink) then begin
if ControlLink.Printer.CurFormat > 0 then if ControlLink.Printer.CurFormat > 0 then
ControlLink.Printer.CurFormat := ControlLink.Printer.CurFormat - 1 ControlLink.Printer.CurFormat := ControlLink.Printer.CurFormat - 1
else else
ControlLink.Printer.CurFormat := ControlLink.Printer.PrintFormats.Count - 1; ControlLink.Printer.CurFormat := ControlLink.Printer.PrintFormats.Count - 1;
end; end;
{$IFDEF DELPHI}
VK_TAB: VK_TAB:
{$IFNDEF LCL}
if ssShift in Shift then if ssShift in Shift then
Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False)) Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False))
else else
Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True)); Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True));
{$ELSE}
;
{$ENDIF} {$ENDIF}
VK_F10: VK_F10:
if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin if (ssShift in Shift) and not Assigned(PopupMenu) then begin
PopupPoint := GetClientOrigin; PopupPoint := GetClientOrigin;
FDefaultPopup.Popup (PopupPoint.x + 10, FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
PopupPoint.y + 10);
end; end;
VK_APPS: VK_APPS:
if not Assigned (PopupMenu) then begin if not Assigned (PopupMenu) then begin
PopupPoint := GetClientOrigin; PopupPoint := GetClientOrigin;
FDefaultPopup.Popup (PopupPoint.x + 10, FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10);
PopupPoint.y + 10);
end; end;
else else
inherited; inherited;
@ -670,13 +657,11 @@ end;
procedure TVpPrintPreview.LastPage; procedure TVpPrintPreview.LastPage;
var var
i: Integer; i: Integer;
begin begin
if CurPage < FPageInfo.Count then begin if CurPage < FPageInfo.Count then begin
i := CurPage; i := CurPage;
if (not PVpPageInfo (FPageInfo[i]).LastPage) and if (not PVpPageInfo(FPageInfo[i]).LastPage) and (i < FPageInfo.Count) then
(i < FPageInfo.Count) then inc(i);
Inc (i);
if (not PVpPageInfo(FPageInfo[i]).LastPage) then if (not PVpPageInfo(FPageInfo[i]).LastPage) then
GetLastPage; GetLastPage;
end else end else
@ -687,17 +672,15 @@ end;
procedure TVpPrintPreview.Loaded; procedure TVpPrintPreview.Loaded;
begin begin
inherited Loaded; inherited Loaded;
DestPrinter := Printer; DestPrinter := Printer;
GeneratePageImage; GeneratePageImage;
end; end;
function TVpPrintPreview.LoadPage (PageNum : Integer;
StartDate : TDateTime;
EndDate : TDateTime) : Integer;
{ Loads the requested page. Returns the last page loaded. If the { Loads the requested page. Returns the last page loaded. If the
return value is less than the requested page, the requested page return value is less than the requested page, the requested page
is past the last page } is past the last page }
function TVpPrintPreview.LoadPage(PageNum: Integer;
StartDate, EndDate: TDateTime): Integer;
var var
i: Integer; i: Integer;
LastPage: Boolean; LastPage: Boolean;
@ -705,7 +688,6 @@ var
ADate: TDateTime; ADate: TDateTime;
ATask: Integer; ATask: Integer;
AContact: Integer; AContact: Integer;
begin begin
Result := PageNum; Result := PageNum;
if PageNum < FPageInfo.Count then if PageNum < FPageInfo.Count then
@ -737,18 +719,17 @@ begin
{ The only way to see how the pages are going to increment is to render { The only way to see how the pages are going to increment is to render
them and get the return information } them and get the return information }
while (i <= PageNum) and (not LastPage) do begin while (i <= PageNum) and (not LastPage) do begin
FControlLink.Printer.RenderPage(
FControlLink.Printer.RenderPage (RenderBmp.Canvas, RenderBmp.Canvas,
Rect (0, 0, RenderBmp.Width, Rect(0, 0, RenderBmp.Width, RenderBmp.Height),
RenderBmp.Height),
i + 1, i + 1,
ADate, ADate,
FEndDate, FEndDate,
AContact, AContact,
ATask, ATask,
LastPage); LastPage
);
Result := i; Result := i;
GetMem(PPageInfo, SizeOf(TVpPageInfo)); GetMem(PPageInfo, SizeOf(TVpPageInfo));
PPageInfo.Date := ADate; PPageInfo.Date := ADate;
@ -756,7 +737,7 @@ begin
PPageInfo.Contact := AContact; PPageInfo.Contact := AContact;
PPageInfo.LastPage := LastPage; PPageInfo.LastPage := LastPage;
FPageInfo.Add(PPageInfo); FPageInfo.Add(PPageInfo);
Inc (i); inc(i);
end; end;
end; end;
@ -798,36 +779,33 @@ var
if FBorderStyle = bsSingle then begin if FBorderStyle = bsSingle then begin
if FDrawingStyle = dsFlat then begin if FDrawingStyle = dsFlat then begin
{ draw an outer and inner bevel } { draw an outer and inner bevel }
DrawBevelRect (WorkBmp.Canvas, DrawBevelRect(
Rect (ClientRect.Left, WorkBmp.Canvas,
ClientRect.Top, Rect(ClientRect.Left, ClientRect.Top, ClientRect.Right - 1, ClientRect.Bottom - 1),
ClientRect.Right - 1,
ClientRect.Bottom - 1),
clBtnShadow, clBtnShadow,
clBtnHighlight); clBtnHighlight
DrawBevelRect (WorkBmp.Canvas, );
Rect (ClientRect.Left + 1, DrawBevelRect(
ClientRect.Top + 1, WorkBmp.Canvas,
ClientRect.Right - 2, Rect(ClientRect.Left + 1, ClientRect.Top + 1, ClientRect.Right - 2, ClientRect.Bottom - 2),
ClientRect.Bottom - 2),
clBtnHighlight, clBtnHighlight,
clBtnShadow); clBtnShadow
end else if FDrawingStyle = ds3d then begin );
end else
if FDrawingStyle = ds3d then begin
{ draw a 3d bevel } { draw a 3d bevel }
DrawBevelRect (WorkBmp.Canvas, DrawBevelRect(
Rect (ClientRect.Left, WorkBmp.Canvas,
ClientRect.Top, Rect(ClientRect.Left, ClientRect.Top, ClientRect.Right - 1, ClientRect.Bottom - 1),
ClientRect.Right - 1,
ClientRect.Bottom - 1),
clBtnShadow, clBtnShadow,
clBtnHighlight); clBtnHighlight
DrawBevelRect (WorkBmp.Canvas, );
Rect (ClientRect.Left + 1, DrawBevelRect(
ClientRect.Top + 1, WorkBmp.Canvas,
ClientRect.Right - 2, Rect(ClientRect.Left + 1, ClientRect.Top + 1, ClientRect.Right - 2, ClientRect.Bottom - 2),
ClientRect.Bottom - 2),
cl3DDkShadow, cl3DDkShadow,
clBtnFace); clBtnFace
);
end; end;
end; end;
end; end;
@ -868,7 +846,6 @@ var
ScaleY: Extended; ScaleY: Extended;
Offset1: Integer; Offset1: Integer;
Offset2: Integer; Offset2: Integer;
begin begin
Offset1 := 3; Offset1 := 3;
Offset2 := 3; Offset2 := 3;
@ -883,12 +860,19 @@ var
else else
ScaleY := 1; ScaleY := 1;
if ScaleX > ScaleY then if ScaleX > ScaleY then
Result := Rect (Offset1, Offset1, ClientWidth - Offset2, Result := Rect(
Round (FPrinter.PageHeight / ScaleX)) Offset1,
Offset1,
ClientWidth - Offset2,
Round(FPrinter.PageHeight / ScaleX)
)
else else
Result := Rect (Offset1, Offset1, Result := Rect(
Offset1,
Offset1,
Round(FPrinter.PageWidth / ScaleY), Round(FPrinter.PageWidth / ScaleY),
ClientHeight - Offset2); ClientHeight - Offset2
);
end else end else
Result := Rect(3, 3, ClientWidth, ClientHeight); Result := Rect(3, 3, ClientWidth, ClientHeight);
end; end;
@ -898,7 +882,6 @@ var
AspectRect: TRect; AspectRect: TRect;
WorkHeight: Integer; WorkHeight: Integer;
WorkWidth: Integer; WorkWidth: Integer;
begin begin
if FControlLink.Printer.PrintFormats.Count <= 0 then if FControlLink.Printer.PrintFormats.Count <= 0 then
Exit; Exit;
@ -906,12 +889,46 @@ var
if CurPage > FPageInfo.Count then if CurPage > FPageInfo.Count then
GeneratePageImage; GeneratePageImage;
case FZoomFactor of if FZoomFactor = zfFitToControl then
zfFitToControl : begin begin
AspectRect := GetAspectRectangle; AspectRect := GetAspectRectangle;
WorkBmp.Canvas.CopyRect (AspectRect, RenderBmp.Canvas, WorkBmp.Canvas.CopyRect(
Rect (0, 0, AspectRect,
RenderBmp.Width, RenderBmp.Height)); RenderBmp.Canvas,
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;
(*
case FZoomFactor of
zfFitToControl:
begin
AspectRect := GetAspectRectangle;
WorkBmp.Canvas.CopyRect(
AspectRect,
RenderBmp.Canvas,
Rect (0, 0, RenderBmp.Width, RenderBmp.Height)
);
RealWidth := AspectRect.Right - AspectRect.Left + 3; RealWidth := AspectRect.Right - AspectRect.Left + 3;
RealHeight := AspectRect.Bottom - AspectRect.Top + 3; RealHeight := AspectRect.Bottom - AspectRect.Top + 3;
end; end;
@ -1024,6 +1041,7 @@ var
RealHeight := RenderBmp.Height; RealHeight := RenderBmp.Height;
end; end;
end; end;
*)
end; end;
procedure RenderImage; procedure RenderImage;
@ -1073,7 +1091,6 @@ end;
procedure TVpPrintPreview.RemoveHScrollbar; procedure TVpPrintPreview.RemoveHScrollbar;
var var
Style: Integer; Style: Integer;
begin begin
FNeedHScroll := False; FNeedHScroll := False;
Style := GetWindowLong(Handle, GWL_STYLE); Style := GetWindowLong(Handle, GWL_STYLE);
@ -1086,7 +1103,6 @@ end;
procedure TVpPrintPreview.RemoveVScrollbar; procedure TVpPrintPreview.RemoveVScrollbar;
var var
Style: Integer; Style: Integer;
begin begin
FNeedVScroll := False; FNeedVScroll := False;
Style := GetWindowLong (Handle, GWL_STYLE); Style := GetWindowLong (Handle, GWL_STYLE);
@ -1114,7 +1130,7 @@ end;
procedure TVpPrintPreview.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); procedure TVpPrintPreview.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin begin
inherited SetBounds (aLeft, ATop, AWidth, AHeight); inherited SetBounds(ALeft, ATop, AWidth, AHeight);
SetScrollBars; SetScrollBars;
end; end;
@ -1196,7 +1212,6 @@ var
RealHeight: Integer; RealHeight: Integer;
Style: Integer; Style: Integer;
NeedRecreate: Boolean; NeedRecreate: Boolean;
begin begin
if csDesigning in ComponentState then if csDesigning in ComponentState then
Exit; Exit;
@ -1205,46 +1220,23 @@ begin
FScrollY := 0; FScrollY := 0;
RealHeight := ClientHeight; RealHeight := ClientHeight;
RealWidth := ClientWidth; RealWidth := ClientWidth;
case ZoomFactor of if ZoomFactor = zfFitToControl then begin
zfActualSize : begin
RealHeight := RenderBmp.Height;
RealWidth := RenderBmp.Width;
end;
zfFitToControl : begin
RealHeight := ClientHeight - 4; RealHeight := ClientHeight - 4;
RealWidth := ClientWidth - 4; RealWidth := ClientWidth - 4;
end; end else begin
zf25Percent : begin RealHeight := Round(RenderBmp.Height * ZOOM_FACTOR_VALUES[ZoomFactor]);
RealHeight := RenderBmp.Height div 4; RealWidth := Round(RenderBmp.Width * ZOOM_FACTOR_VALUES[ZoomFactor]);
RealWidth := RenderBmp.Width div 4;
end;
zf33Percent : begin
RealHeight := RenderBmp.Height div 3;
RealWidth := RenderBmp.Width div 3;
end;
zf50Percent : begin
RealHeight := RenderBmp.Height div 2;
RealWidth := RenderBmp.Width div 2;
end;
zf67Percent : begin
RealHeight := Round (RenderBmp.Height * 0.67);
RealWidth := Round (RenderBmp.Width * 0.67);
end;
zf75Percent : begin
RealHeight := Round (RenderBmp.Height * 0.75);
RealWidth := Round (RenderBmp.Width * 0.75);
end;
end; end;
if (RealWidth > ClientWidth) or (RealHeight > ClientHeight) then begin if (RealWidth > ClientWidth) or (RealHeight > ClientHeight) then begin
NeedRecreate := False; NeedRecreate := False;
Style := GetWindowLong(Handle, GWL_STYLE); Style := GetWindowLong(Handle, GWL_STYLE);
if ((Style and WS_HSCROLL) = 0) and (RealWidth > ClientWidth) then begin if (Style and WS_HSCROLL = 0) and (RealWidth > ClientWidth) then begin
Style := Style or WS_HSCROLL; Style := Style or WS_HSCROLL;
FNeedHScroll := True; FNeedHScroll := True;
NeedRecreate := True; NeedRecreate := True;
end; end;
if ((Style and WS_VSCROLL) = 0) and (RealHeight > ClientHeight) then begin if (Style and WS_VSCROLL = 0) and (RealHeight > ClientHeight) then begin
Style := Style or WS_VSCROLL; Style := Style or WS_VSCROLL;
FNeedVScroll := True; FNeedVScroll := True;
NeedRecreate := True; NeedRecreate := True;
@ -1292,47 +1284,30 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF LCL} procedure TVpPrintPreview.WMEraseBackground(var Msg: {$IFDEF DELPHI}TWMERASEBKGND){$ELSE}TLMERASEBKGND){$ENDIF};
procedure TVpPrintPreview.WMEraseBackground (var Msg : TWMERASEBKGND);
{$ELSE}
procedure TVpPrintPreview.WMEraseBackground (var Msg : TLMERASEBKGND);
{$ENDIF}
begin begin
Msg.Result := 1; Msg.Result := 1;
end; end;
{$IFNDEF LCL} procedure TVpPrintPreview.WMVScroll(var Msg: {$IFDEF DELPHI}TWMSCROLL){$ELSE}TLMSCROLL{$ENDIF});
procedure TVpPrintPreview.WMVScroll (var Msg : TWMSCROLL);
{$ELSE}
procedure TVpPrintPreview.WMVScroll (var Msg : TLMSCROLL);
{$ENDIF}
begin begin
DoScroll(Msg, SB_VERT); DoScroll(Msg, SB_VERT);
end; end;
{$IFNDEF LCL} procedure TVpPrintPreview.WMHScroll(var Msg: {$IFDEF DELPHI}TWMSCROLL){$ELSE}TLMSCROLL){$ENDIF};
procedure TVpPrintPreview.WMHScroll (var Msg : TWMSCROLL);
{$ELSE}
procedure TVpPrintPreview.WMHScroll (var Msg : TLMSCROLL);
{$ENDIF}
begin begin
DoScroll(Msg, SB_HORZ); DoScroll(Msg, SB_HORZ);
end; end;
{$IFNDEF LCL} procedure TVpPrintPreview.WMRButtonDown(var Msg: {$IFDEF DELPHI}TWMRButtonDown{$ELSE}TLMRButtonDown{$ENDIF});
procedure TVpPrintPreview.WMRButtonDown(var Msg : TWMRButtonDown);
{$ELSE}
procedure TVpPrintPreview.WMRButtonDown(var Msg : TLMRButtonDown);
{$ENDIF}
var var
ClientOrigin: TPoint; ClientOrigin: TPoint;
i: Integer; i: Integer;
begin begin
inherited; inherited;
if not Assigned (PopupMenu) then begin if not Assigned (PopupMenu) then begin
if not focused then if not Focused then
SetFocus; SetFocus;
ClientOrigin := GetClientOrigin; ClientOrigin := GetClientOrigin;
@ -1344,8 +1319,7 @@ begin
FDefaultPopup.Items[i].Enabled := False; FDefaultPopup.Items[i].Enabled := False;
end; end;
FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x, FDefaultPopup.Popup(Msg.XPos + ClientOrigin.x, Msg.YPos + ClientOrigin.y);
Msg.YPos + ClientOrigin.y);
end; end;
end; end;

32
components/tvplanit/source/vpprtprvdlg.lfm
View File

@ -16,17 +16,17 @@ object frmPrintPreview: TfrmPrintPreview
LCLVersion = '1.7' LCLVersion = '1.7'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 73 Height = 62
Top = 0 Top = 0
Width = 477 Width = 477
Align = alTop Align = alTop
ClientHeight = 73 ClientHeight = 62
ClientWidth = 477 ClientWidth = 477
TabOrder = 0 TabOrder = 0
object cboxZoom: TComboBox object cboxZoom: TComboBox
Left = 217 Left = 216
Height = 23 Height = 23
Top = 40 Top = 32
Width = 145 Width = 145
ItemHeight = 15 ItemHeight = 15
Items.Strings = ( Items.Strings = (
@ -45,7 +45,7 @@ object frmPrintPreview: TfrmPrintPreview
object VpPrintFormatComboBox1: TVpPrintFormatComboBox object VpPrintFormatComboBox1: TVpPrintFormatComboBox
Left = 8 Left = 8
Height = 23 Height = 23
Top = 40 Top = 32
Width = 201 Width = 201
ItemHeight = 15 ItemHeight = 15
Sorted = True Sorted = True
@ -69,13 +69,13 @@ object frmPrintPreview: TfrmPrintPreview
TabOrder = 0 TabOrder = 0
object btnPrint: TToolButton object btnPrint: TToolButton
Left = 1 Left = 1
Top = 2 Top = 0
Action = actPrint Action = actPrint
end end
object ToolButton3: TToolButton object ToolButton3: TToolButton
Left = 52 Left = 52
Height = 25 Height = 25
Top = 2 Top = 0
Width = 8 Width = 8
Caption = 'ToolButton3' Caption = 'ToolButton3'
ImageIndex = 2 ImageIndex = 2
@ -83,32 +83,32 @@ object frmPrintPreview: TfrmPrintPreview
end end
object btnFirstPage: TToolButton object btnFirstPage: TToolButton
Left = 60 Left = 60
Top = 2 Top = 0
Action = actFirstPage Action = actFirstPage
ShowCaption = False ShowCaption = False
end end
object btnPrevPage: TToolButton object btnPrevPage: TToolButton
Left = 85 Left = 85
Top = 2 Top = 0
Action = actPrevPage Action = actPrevPage
ShowCaption = False ShowCaption = False
end end
object btnNextPage: TToolButton object btnNextPage: TToolButton
Left = 110 Left = 110
Top = 2 Top = 0
Action = actPrevPage Action = actNextPage
ShowCaption = False ShowCaption = False
end end
object btnLastPage: TToolButton object btnLastPage: TToolButton
Left = 135 Left = 135
Top = 2 Top = 0
Action = actLastPage Action = actLastPage
ShowCaption = False ShowCaption = False
end end
object ToolButton8: TToolButton object ToolButton8: TToolButton
Left = 160 Left = 160
Height = 25 Height = 25
Top = 2 Top = 0
Width = 8 Width = 8
Caption = 'ToolButton8' Caption = 'ToolButton8'
ImageIndex = 6 ImageIndex = 6
@ -116,15 +116,15 @@ object frmPrintPreview: TfrmPrintPreview
end end
object btnCancel: TToolButton object btnCancel: TToolButton
Left = 168 Left = 168
Top = 2 Top = 0
Action = actCancel Action = actCancel
end end
end end
end end
object VpPrintPreview1: TVpPrintPreview object VpPrintPreview1: TVpPrintPreview
Left = 0 Left = 0
Height = 445 Height = 456
Top = 73 Top = 62
Width = 477 Width = 477
CurPage = 0 CurPage = 0
EndDate = 37355.4526088079 EndDate = 37355.4526088079