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

TvPlanIt: Avoid windows-like messages in printing routines (fixes crashes in cocoa related to PrintPreview).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8888 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-07-21 20:18:22 +00:00
parent d5965cb872
commit d9d497757b
6 changed files with 111 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -42,26 +42,23 @@ uses
Controls, Dialogs, Forms, ExtCtrls, SysUtils, ImgList, Menus, Controls, Dialogs, Forms, ExtCtrls, SysUtils, ImgList, Menus,
VpConst, VpSR; VpConst, VpSR;
const {$IFDEF LCL}
{Message base}
Vp_First = WM_USER; // $7DF0; {Sets base for all Vp messages}
const
{Custom message types}
Vp_PrintFormatChanged = Vp_First + 1; {Print formats have changed}
{$IFDEF DELPHI}
Vp_DataStoreChanged = Vp_First + 2; {Data Store has changed}
Vp_DayViewInit = Vp_First + 3; {Initialize the DayView}
{$ENDIF}
const const
GUID_VpWatcher = '{F4199DB4-7051-40E9-8EC1-731B083D723E}'; GUID_VpWatcher = '{F4199DB4-7051-40E9-8EC1-731B083D723E}';
type type
IVpWatcher = interface [GUID_VpWatcher] IVpWatcher = interface [GUID_VpWatcher]
procedure VpDatastoreChanged; procedure VpDatastoreChanged;
procedure VpPrintFormatChanged; procedure VpPrintFormatChanged;
end; end;
{$ELSE}
const
{Message base}
Vp_First = WM_USER; // $7DF0; {Sets base for all Vp messages}
{Custom message types}
Vp_PrintFormatChanged = Vp_First + 1; {Print formats have changed}
Vp_DataStoreChanged = Vp_First + 2; {Data Store has changed}
Vp_DayViewInit = Vp_First + 3; {Initialize the DayView}
{$ENDIF}
type type
{$IF FPC_FullVersion < 30000} {$IF FPC_FullVersion < 30000}

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

@ -1014,7 +1014,7 @@ var
begin begin
if FNotifiers <> nil then if FNotifiers <> nil then
begin begin
{$IFDEF LCl} {$IFDEF LCL}
i := FNotifiers.IndexOf(Watcher); i := FNotifiers.IndexOf(Watcher);
if i = -1 then if i = -1 then
FNotifiers.Add(Watcher); FNotifiers.Add(Watcher);
@ -1375,10 +1375,10 @@ procedure TVpResourceCombo.InternalSetDatastore(const Value: TVpCustomDatastore)
begin begin
if FDataStore <> Value then begin if FDataStore <> Value then begin
if Assigned (FDataStore) and not (csDesigning in ComponentState) then if Assigned (FDataStore) and not (csDesigning in ComponentState) then
FDataStore.DeregisterWatcher(Self); //Handle); FDataStore.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
FDataStore := Value; FDataStore := Value;
if Assigned (FDataStore) and not (csDesigning in ComponentState) then if Assigned (FDataStore) and not (csDesigning in ComponentState) then
FDataStore.RegisterWatcher(Self); //Handle); FDataStore.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
if not (csDesigning in ComponentState) then if not (csDesigning in ComponentState) then
LoadItems; LoadItems;
Invalidate; Invalidate;

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

@ -562,7 +562,7 @@ end;
destructor TVpContactGrid.Destroy; destructor TVpContactGrid.Destroy;
begin begin
if HandleAllocated and Assigned(DataStore) and (not (csDesigning in ComponentState)) then if HandleAllocated and Assigned(DataStore) and (not (csDesigning in ComponentState)) then
DataStore.DeregisterWatcher(Self); //Handle); DataStore.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
cgClickTimer.Free; cgClickTimer.Free;
FContactHeadAttr.Free; FContactHeadAttr.Free;
@ -2027,12 +2027,12 @@ end;
procedure TVpContactGrid.InternalSetDatastore(const Value: TVpCustomDatastore); procedure TVpContactGrid.InternalSetDatastore(const Value: TVpCustomDatastore);
begin begin
if Assigned (DataStore) and not (csDesigning in ComponentState) then if Assigned (DataStore) and not (csDesigning in ComponentState) then
DataStore.DeregisterWatcher(Self); //Handle); DataStore.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
inherited SetDataStore(Value); inherited SetDataStore(Value);
if Assigned (DataStore) and not (csDesigning in ComponentState) then if Assigned (DataStore) and not (csDesigning in ComponentState) then
DataStore.RegisterWatcher(Self); //Handle); DataStore.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
if not Assigned(DataStore) then if not Assigned(DataStore) then
Exit; Exit;

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

@ -95,7 +95,7 @@ uses
{$ELSE} {$ELSE}
Windows, Windows,
{$ENDIF} {$ENDIF}
Classes, Dialogs, SysUtils, Graphics, Forms, Printers, Classes, Controls, Dialogs, SysUtils, Graphics, Forms, Printers,
VpBase, VpData, VpXParsr, VpCanvasUtils, VpSR, VpException; VpBase, VpData, VpXParsr, VpCanvasUtils, VpSR, VpException;
type type
@ -108,10 +108,12 @@ type
ustTLToBRLine, ustBLToTRLine, ustEllipse ustTLToBRLine, ustBLToTRLine, ustEllipse
); );
{
TVpWatcher = record TVpWatcher = record
Handle: THandle; Handle: THandle;
end; end;
PVpWatcher = ^TVpWatcher; PVpWatcher = ^TVpWatcher;
}
{ TVpAttributes and TVpAttributeItem { TVpAttributes and TVpAttributeItem
a collection of attributes collected when parsing the xml file. a collection of attributes collected when parsing the xml file.
@ -406,7 +408,7 @@ type
procedure ClearVariables; procedure ClearVariables;
function DeleteVariable(VarName: string): Boolean; function DeleteVariable(VarName: string): Boolean;
procedure DeregisterAllWatchers; procedure DeregisterAllWatchers;
procedure DeregisterWatcher(Watcher: THandle); procedure DeregisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
function Find(const v: string): Integer; function Find(const v: string): Integer;
function HaveVariable(VarName: string): Boolean; function HaveVariable(VarName: string): Boolean;
procedure LoadFromFile(FileName: string; Append: Boolean); procedure LoadFromFile(FileName: string; Append: Boolean);
@ -414,7 +416,7 @@ type
procedure NotifyLinked; procedure NotifyLinked;
procedure PaintToCanvasRect(ACanvas: TCanvas; ARect: TRect; ADate: TDateTime); procedure PaintToCanvasRect(ACanvas: TCanvas; ARect: TRect; ADate: TDateTime);
procedure Print(APrinter: TPrinter; StartDate: TDateTime; EndDate: TDateTime); procedure Print(APrinter: TPrinter; StartDate: TDateTime; EndDate: TDateTime);
procedure RegisterWatcher(Watcher: THandle); procedure RegisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
procedure RenderPage(ACanvas: TCanvas; ARect: TRect; PageNum: Integer; procedure RenderPage(ACanvas: TCanvas; ARect: TRect; PageNum: Integer;
var ADate: TDateTime; EndDate: TDateTime; var StartContact: Integer; var ADate: TDateTime; EndDate: TDateTime; var StartContact: Integer;
var StartTask: Integer; var LastPage: Boolean); var StartTask: Integer; var LastPage: Boolean);
@ -1374,24 +1376,37 @@ procedure TVpPrinter.DeregisterAllWatchers;
var var
i: Integer; i: Integer;
begin begin
for i := FNotifiers.Count - 1 downto 0 do if FNotifiers <> nil then
if Assigned(FNotifiers[i]) then begin for i := FNotifiers.Count - 1 downto 0 do
FreeMem(FNotifiers[i]); if Assigned(FNotifiers[i]) then
FNotifiers.Delete (i); begin
end; {$IFDEF DELPHI}
FreeMem(FNotifiers[i]);
{$ENDIF}
FNotifiers.Delete(i);
end;
end; end;
procedure TVpPrinter.DeregisterWatcher(Watcher: THandle); procedure TVpPrinter.DeregisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
var var
i: Integer; i: Integer;
begin begin
for i := FNotifiers.Count - 1 downto 0 do if FNotifiers <> nil then
if Assigned(FNotifiers[i]) then begin
if PVpWatcher (FNotifiers[i]).Handle = Watcher then begin {$IFDEF LCL}
FreeMem(FNotifiers[i]); i := FNotifiers.IndexOf(Watcher);
FNotifiers.Delete (i); if i <> -1 then
Exit; FNotifiers.Delete(i);
end; {$ELSE}
for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then
if PVpWatcher(FNotifiers[i]).Handle = Watcher then begin
FreeMem(FNotifiers[i]);
FNotifiers.Delete(i);
Exit;
end;
{$ENDIF}
end;
end; end;
function TVpPrinter.HaveVariable(VarName: string): Boolean; function TVpPrinter.HaveVariable(VarName: string): Boolean;
@ -1463,10 +1478,22 @@ end;
procedure TVpPrinter.NotifyLinked; procedure TVpPrinter.NotifyLinked;
var var
i: Integer; i: Integer;
{$IFDEF LCL}
intf: IVpWatcher;
C: TControl;
{$ENDIF}
begin begin
for i := 0 to FNotifiers.Count - 1 do for i := 0 to FNotifiers.Count - 1 do
begin
{$IFDEF LCL}
C := TControl(FNotifiers[i]);
if Assigned(C) and C.GetInterface(GUID_VpWatcher, intf) then
intf.VpDatastoreChanged;
{$ELSE}
if Assigned(FNotifiers[i]) then if Assigned(FNotifiers[i]) then
PostMessage(PVpWatcher(FNotifiers[i]).Handle, Vp_PrintFormatChanged, 0, 0); PostMessage(PVpWatcher(FNotifiers[i]).Handle, Vp_DataStoreChanged, 0, 0);
{$ENDIF}
end;
end; end;
procedure TVpPrinter.PaintToCanvasRect(ACanvas: TCanvas; ARect: TRect; procedure TVpPrinter.PaintToCanvasRect(ACanvas: TCanvas; ARect: TRect;
@ -1927,18 +1954,29 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure TVpPrinter.RegisterWatcher(Watcher: THandle); procedure TVpPrinter.RegisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
var var
i: Integer; i: Integer;
{$IFDEF DELPHI}
NewHandle: PVpWatcher; NewHandle: PVpWatcher;
{$ENDIF}
begin begin
for i := 0 to FNotifiers.Count - 1 do if FNotifiers <> nil then
if Assigned(FNotifiers[i]) then begin
if PVpWatcher(FNotifiers[i]).Handle = Watcher then {$IFDEF LCL}
Exit; i := FNotifiers.IndexOf(Watcher);
GetMem(NewHandle, SizeOf(TVpWatcher)); if i = -1 then
NewHandle.Handle := Watcher; FNotifiers.Add(Watcher);
FNotifiers.Add(NewHandle); {$ELSE}
for i := 0 to FNotifiers.Count - 1 do
if Assigned (FNotifiers[i]) then
if PVpWatcher(FNotifiers[i]).Handle = Watcher then
Exit;
GetMem(NewHandle, SizeOf(TVpWatcher));
NewHandle.Handle := Watcher;
FNotifiers.Add(NewHandle);
{$ENDIF}
end;
end; end;
procedure TVpPrinter.RenderPage(ACanvas: TCanvas; ARect: TRect; PageNum: Integer; procedure TVpPrinter.RenderPage(ACanvas: TCanvas; ARect: TRect; PageNum: Integer;

25
components/tvplanit/source/vpprtfmtcbox.pas
View File

@ -42,7 +42,7 @@ uses
VpBase, VpBaseDS, VpConst; VpBase, VpBaseDS, VpConst;
type type
TVpPrintFormatComboBox = class (TCustomComboBox) TVpPrintFormatComboBox = class (TCustomComboBox, IVpWatcher)
private private
FControlLink : TVpControlLink; FControlLink : TVpControlLink;
@ -53,7 +53,12 @@ type
procedure Notification (AComponent: TComponent; Operation: TOperation); override; procedure Notification (AComponent: TComponent; Operation: TOperation); override;
procedure SetAbout(const Value: string); procedure SetAbout(const Value: string);
procedure SetControlLink(const v: TVpControlLink); procedure SetControlLink(const v: TVpControlLink);
procedure VpPrintFormatChanged(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_PrintFormatChanged; {$IFDEF LCL}
procedure VpDatastoreChanged;
procedure VpPrintFormatChanged;
{$ELSE}
procedure VpPrintFormatChanged(var Msg: TMessage); message Vp_PrintFormatChanged;
{$ENDIF}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -167,7 +172,7 @@ end;
destructor TVpPrintFormatComboBox.Destroy; destructor TVpPrintFormatComboBox.Destroy;
begin begin
if HandleAllocated and Assigned(FControlLink) then if HandleAllocated and Assigned(FControlLink) then
FControlLink.Printer.DeregisterWatcher(Handle); FControlLink.Printer.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
inherited Destroy; inherited Destroy;
end; end;
@ -214,7 +219,7 @@ begin
{ Check for new TVpControlLink } { Check for new TVpControlLink }
if AComponent is TVpControlLink then begin if AComponent is TVpControlLink then begin
if not Assigned (FControlLink) then begin if not Assigned (FControlLink) then begin
FControlLink := TVpControlLink (AComponent); FControlLink := TVpControlLink(AComponent);
UpdateItems; UpdateItems;
end; end;
end; end;
@ -231,17 +236,21 @@ procedure TVpPrintFormatComboBox.SetControlLink (const v : TVpControlLink);
begin begin
if v <> FControlLink then begin if v <> FControlLink then begin
if Assigned (FControlLink) then if Assigned (FControlLink) then
FControlLink.Printer.DeregisterWatcher (Handle); FControlLink.Printer.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
FControlLink := v; FControlLink := v;
if Assigned (FControlLink) then if Assigned (FControlLink) then
FControlLink.Printer.RegisterWatcher (Handle); FControlLink.Printer.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
UpdateItems; UpdateItems;
end; end;
end; end;
procedure TVpPrintFormatComboBox.VpPrintFormatChanged(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); procedure TVpPrintFormatComboBox.VpDatastoreChanged;
begin
//
end;
procedure TVpPrintFormatComboBox.VpPrintFormatChanged({$IFNDEF LCL}var Msg: TMessage{$ENDIF});
begin begin
Unused(Msg);
UpdateItems; UpdateItems;
end; end;

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

@ -84,7 +84,7 @@ type
end; end;
PVpPageInfo = ^TVpPageInfo; PVpPageInfo = ^TVpPageInfo;
TVpPrintPreview = class(TVpCustomControl) TVpPrintPreview = class(TVpCustomControl, IVpWatcher)
private private
FBorderStyle: TBorderStyle; FBorderStyle: TBorderStyle;
FControlLink: TVpControlLink; FControlLink: TVpControlLink;
@ -148,13 +148,15 @@ type
procedure SetScrollBars; procedure SetScrollBars;
procedure SetZoomFactor(const v: TVpPPZoomFactor); procedure SetZoomFactor(const v: TVpPPZoomFactor);
// procedure VpPrintFormatChanged (var Msg : {$IFNDEF LCL}TMessage{$ELSE}TLMessage{$ENDIF}; message Vp_PrintFormatChanged;
{$IFDEF DELPHI} {$IFDEF DELPHI}
procedure VpPrintFormatChanged (var Msg: TMessage); message Vp_PrintFormatChanged;
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;
procedure WMRButtonDown(var Msg: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMRButtonDown(var Msg: TWMRButtonDown); message WM_RBUTTONDOWN;
{$ELSE} {$ELSE}
procedure VpDatastoreChanged;
procedure VpPrintFormatChanged;
procedure WMEraseBackground(var Msg: TLMERASEBKGND); message LM_ERASEBKGND; procedure WMEraseBackground(var Msg: TLMERASEBKGND); message LM_ERASEBKGND;
procedure WMHScroll(var Msg: TLMSCROLL); message LM_HSCROLL; procedure WMHScroll(var Msg: TLMSCROLL); message LM_HSCROLL;
procedure WMVScroll(var Msg: TLMSCROLL); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMSCROLL); message LM_VSCROLL;
@ -275,7 +277,7 @@ end;
destructor TVpPrintPreview.Destroy; destructor TVpPrintPreview.Destroy;
begin begin
if (HandleAllocated) and Assigned (FControlLink) then if (HandleAllocated) and Assigned (FControlLink) then
FControlLink.Printer.DeregisterWatcher(Handle); FControlLink.Printer.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
ClearPageData; ClearPageData;
@ -359,12 +361,12 @@ 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({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
inherited CreateWnd; inherited CreateWnd;
if Assigned(FControlLink) then if Assigned(FControlLink) then
FControlLink.Printer.RegisterWatcher(Handle); FControlLink.Printer.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
end; end;
procedure TVpPrintPreview.DoScroll(var Msg: {$IFNDEF LCL}TWMSCROLL{$ELSE}TLMScroll{$ENDIF}; procedure TVpPrintPreview.DoScroll(var Msg: {$IFNDEF LCL}TWMSCROLL{$ELSE}TLMScroll{$ENDIF};
@ -980,10 +982,10 @@ procedure TVpPrintPreview.SetControlLink(const v: TVpControlLink);
begin begin
if FControlLink <> v then begin if FControlLink <> v then begin
if Assigned (FControlLink) then if Assigned (FControlLink) then
FControlLink.Printer.DeregisterWatcher(Handle); FControlLink.Printer.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
FControlLink := v; FControlLink := v;
if Assigned(FControlLink) then if Assigned(FControlLink) then
FControlLink.Printer.RegisterWatcher(Handle); FControlLink.Printer.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
ClearPageData; ClearPageData;
GeneratePageImage; GeneratePageImage;
Invalidate; Invalidate;
@ -1123,12 +1125,15 @@ begin
end; end;
end; end;
{$IFNDEF LCL} procedure TVpPrintPreview.VpDatastoreChanged;
procedure TVpPrintPreview.VpPrintFormatChanged(var Msg: {$IFNDEF LCL}TMessage{$ELSE}TLMessage{$ENDIF}); begin
//
end;
procedure TVpPrintPreview.VpPrintFormatChanged({$IFNDEF LCL}var Msg: TMessage{$ENDIF});
begin begin
ForceUpdate; ForceUpdate;
end; end;
{$ENDIF}
procedure TVpPrintPreview.WMEraseBackground(var Msg: {$IFDEF DELPHI}TWMERASEBKGND){$ELSE}TLMERASEBKGND){$ENDIF}; procedure TVpPrintPreview.WMEraseBackground(var Msg: {$IFDEF DELPHI}TWMERASEBKGND){$ELSE}TLMERASEBKGND){$ENDIF};
begin begin