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,
VpConst, VpSR;
const
{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}
{$IFDEF LCL}
const
GUID_VpWatcher = '{F4199DB4-7051-40E9-8EC1-731B083D723E}';
type
IVpWatcher = interface [GUID_VpWatcher]
procedure VpDatastoreChanged;
procedure VpPrintFormatChanged;
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
{$IF FPC_FullVersion < 30000}

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

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

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

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

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

@ -95,7 +95,7 @@ uses
{$ELSE}
Windows,
{$ENDIF}
Classes, Dialogs, SysUtils, Graphics, Forms, Printers,
Classes, Controls, Dialogs, SysUtils, Graphics, Forms, Printers,
VpBase, VpData, VpXParsr, VpCanvasUtils, VpSR, VpException;
type
@ -108,10 +108,12 @@ type
ustTLToBRLine, ustBLToTRLine, ustEllipse
);
{
TVpWatcher = record
Handle: THandle;
end;
PVpWatcher = ^TVpWatcher;
}
{ TVpAttributes and TVpAttributeItem
a collection of attributes collected when parsing the xml file.
@ -406,7 +408,7 @@ type
procedure ClearVariables;
function DeleteVariable(VarName: string): Boolean;
procedure DeregisterAllWatchers;
procedure DeregisterWatcher(Watcher: THandle);
procedure DeregisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
function Find(const v: string): Integer;
function HaveVariable(VarName: string): Boolean;
procedure LoadFromFile(FileName: string; Append: Boolean);
@ -414,7 +416,7 @@ type
procedure NotifyLinked;
procedure PaintToCanvasRect(ACanvas: TCanvas; ARect: TRect; ADate: 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;
var ADate: TDateTime; EndDate: TDateTime; var StartContact: Integer;
var StartTask: Integer; var LastPage: Boolean);
@ -1374,24 +1376,37 @@ procedure TVpPrinter.DeregisterAllWatchers;
var
i: Integer;
begin
for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then begin
FreeMem(FNotifiers[i]);
FNotifiers.Delete (i);
end;
if FNotifiers <> nil then
for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then
begin
{$IFDEF DELPHI}
FreeMem(FNotifiers[i]);
{$ENDIF}
FNotifiers.Delete(i);
end;
end;
procedure TVpPrinter.DeregisterWatcher(Watcher: THandle);
procedure TVpPrinter.DeregisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
var
i: Integer;
begin
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;
if FNotifiers <> nil then
begin
{$IFDEF LCL}
i := FNotifiers.IndexOf(Watcher);
if i <> -1 then
FNotifiers.Delete(i);
{$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;
function TVpPrinter.HaveVariable(VarName: string): Boolean;
@ -1463,10 +1478,22 @@ end;
procedure TVpPrinter.NotifyLinked;
var
i: Integer;
{$IFDEF LCL}
intf: IVpWatcher;
C: TControl;
{$ENDIF}
begin
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
PostMessage(PVpWatcher(FNotifiers[i]).Handle, Vp_PrintFormatChanged, 0, 0);
PostMessage(PVpWatcher(FNotifiers[i]).Handle, Vp_DataStoreChanged, 0, 0);
{$ENDIF}
end;
end;
procedure TVpPrinter.PaintToCanvasRect(ACanvas: TCanvas; ARect: TRect;
@ -1927,18 +1954,29 @@ begin
{$ENDIF}
end;
procedure TVpPrinter.RegisterWatcher(Watcher: THandle);
procedure TVpPrinter.RegisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
var
i: Integer;
{$IFDEF DELPHI}
NewHandle: PVpWatcher;
{$ENDIF}
begin
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);
if FNotifiers <> nil then
begin
{$IFDEF LCL}
i := FNotifiers.IndexOf(Watcher);
if i = -1 then
FNotifiers.Add(Watcher);
{$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;
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;
type
TVpPrintFormatComboBox = class (TCustomComboBox)
TVpPrintFormatComboBox = class (TCustomComboBox, IVpWatcher)
private
FControlLink : TVpControlLink;
@ -53,7 +53,12 @@ type
procedure Notification (AComponent: TComponent; Operation: TOperation); override;
procedure SetAbout(const Value: string);
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
constructor Create(AOwner: TComponent); override;
@ -167,7 +172,7 @@ end;
destructor TVpPrintFormatComboBox.Destroy;
begin
if HandleAllocated and Assigned(FControlLink) then
FControlLink.Printer.DeregisterWatcher(Handle);
FControlLink.Printer.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
inherited Destroy;
end;
@ -214,7 +219,7 @@ begin
{ Check for new TVpControlLink }
if AComponent is TVpControlLink then begin
if not Assigned (FControlLink) then begin
FControlLink := TVpControlLink (AComponent);
FControlLink := TVpControlLink(AComponent);
UpdateItems;
end;
end;
@ -231,17 +236,21 @@ procedure TVpPrintFormatComboBox.SetControlLink (const v : TVpControlLink);
begin
if v <> FControlLink then begin
if Assigned (FControlLink) then
FControlLink.Printer.DeregisterWatcher (Handle);
FControlLink.Printer.DeregisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
FControlLink := v;
if Assigned (FControlLink) then
FControlLink.Printer.RegisterWatcher (Handle);
FControlLink.Printer.RegisterWatcher({$IFDEF LCL}Self{$ELSE}Handle{$ENDIF});
UpdateItems;
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
Unused(Msg);
UpdateItems;
end;

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

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