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

TvPlanIt: Fix cocoa crashing due to windows-like message VP_DatastoreChanged.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8887 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-07-20 22:43:28 +00:00
parent 319c3452e0
commit d5965cb872
4 changed files with 118 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -49,8 +49,19 @@ const
const const
{Custom message types} {Custom message types}
Vp_PrintFormatChanged = Vp_First + 1; {Print formats have changed} Vp_PrintFormatChanged = Vp_First + 1; {Print formats have changed}
{$IFDEF DELPHI}
Vp_DataStoreChanged = Vp_First + 2; {Data Store has changed} Vp_DataStoreChanged = Vp_First + 2; {Data Store has changed}
Vp_DayViewInit = Vp_First + 3; {Initialize the DayView} Vp_DayViewInit = Vp_First + 3; {Initialize the DayView}
{$ENDIF}
const
GUID_VpWatcher = '{F4199DB4-7051-40E9-8EC1-731B083D723E}';
type
IVpWatcher = interface [GUID_VpWatcher]
procedure VpDatastoreChanged;
procedure VpPrintFormatChanged;
end;
type type
{$IF FPC_FullVersion < 30000} {$IF FPC_FullVersion < 30000}

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

@ -153,7 +153,7 @@ type
property Sender: TObject read FSender write FSender; property Sender: TObject read FSender write FSender;
end; end;
TVpResourceCombo = class(TCustomComboBox) TVpResourceCombo = class(TCustomComboBox, IVpWatcher)
private private
FDataStore: TVpCustomDataStore; FDataStore: TVpCustomDataStore;
FPendingDatastore: TVpCustomDatastore; FPendingDatastore: TVpCustomDatastore;
@ -165,15 +165,19 @@ type
FResourceUpdateStyle: TVpResourceUpdate; FResourceUpdateStyle: TVpResourceUpdate;
procedure CreateHandle; override; procedure CreateHandle; override;
procedure VpDataStoreChanged(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DataStoreChanged;
procedure SetDataStore(const Value: TVpCustomDataStore); procedure SetDataStore(const Value: TVpCustomDataStore);
function GetAbout: string; function GetAbout: string;
procedure SetAbout(const Value: string); procedure SetAbout(const Value: string);
procedure SetResourceUpdateStyle(const v: TVpResourceUpdate); procedure SetResourceUpdateStyle(const v: TVpResourceUpdate);
procedure ResourceChanged(Sender: TObject); procedure ResourceChanged(Sender: TObject);
procedure LoadItems; procedure LoadItems;
{$IFNDEF LCL}
{$IFDEF LCL}
procedure VpDataStoreChanged;
procedure VpPrintFormatChanged;
{$ELSE}
procedure CNCommand (var Msg: TWMCommand); message CN_COMMAND; procedure CNCommand (var Msg: TWMCommand); message CN_COMMAND;
procedure VpDataStoreChanged(var Msg: TMessage); message Vp_DataStoreChanged;
{$ENDIF} {$ENDIF}
public public
@ -281,13 +285,13 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure DeregisterAllWatchers; procedure DeregisterAllWatchers;
procedure DeregisterWatcher(Watcher: THandle); procedure DeregisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
{$IFDEF DEBUG_RESOURCE_GROUPS} {$IFDEF DEBUG_RESOURCE_GROUPS}
procedure DumpResources; procedure DumpResources;
{$ENDIF} {$ENDIF}
function GetNextID(TableName: string): Integer; virtual; abstract; function GetNextID(TableName: string): Integer; virtual; abstract;
procedure NotifyDependents; procedure NotifyDependents;
procedure RegisterWatcher(Watcher: THandle); procedure RegisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
procedure PlaySound(const AWavFile: String; APlaySoundMode: TVpPlaySoundMode); procedure PlaySound(const AWavFile: String; APlaySoundMode: TVpPlaySoundMode);
procedure SetResourceByName(Value: string); virtual; abstract; procedure SetResourceByName(Value: string); virtual; abstract;
@ -602,17 +606,26 @@ var
begin begin
if FNotifiers <> nil then if FNotifiers <> nil then
for i := FNotifiers.Count - 1 downto 0 do for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then begin if Assigned(FNotifiers[i]) then
begin
{$IFDEF DELPHI}
FreeMem(FNotifiers[i]); FreeMem(FNotifiers[i]);
FNotifiers.Delete (i); {$ENDIF}
FNotifiers.Delete(i);
end; end;
end; end;
procedure TVpCustomDataStore.DeregisterWatcher(Watcher: THandle); procedure TVpCustomDataStore.DeregisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
var var
i: Integer; i: Integer;
begin begin
if FNotifiers <> nil then 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 for i := FNotifiers.Count - 1 downto 0 do
if Assigned(FNotifiers[i]) then if Assigned(FNotifiers[i]) then
if PVpWatcher(FNotifiers[i]).Handle = Watcher then begin if PVpWatcher(FNotifiers[i]).Handle = Watcher then begin
@ -620,6 +633,8 @@ begin
FNotifiers.Delete(i); FNotifiers.Delete(i);
Exit; Exit;
end; end;
{$ENDIF}
end;
end; end;
procedure TVpCustomDataStore.dsOnTimer(Sender: TObject); procedure TVpCustomDataStore.dsOnTimer(Sender: TObject);
@ -750,10 +765,22 @@ end;
procedure TVpCustomDataStore.NotifyLinked; procedure TVpCustomDataStore.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_DataStoreChanged, 0, 0); PostMessage(PVpWatcher(FNotifiers[i]).Handle, Vp_DataStoreChanged, 0, 0);
{$ENDIF}
end;
end; end;
procedure TVpCustomDataStore.SetActiveDate(Value: TDateTime); procedure TVpCustomDataStore.SetActiveDate(Value: TDateTime);
@ -978,11 +1005,20 @@ begin
NotifyDependents; NotifyDependents;
end; end;
procedure TVpCustomDataStore.RegisterWatcher(Watcher: THandle); procedure TVpCustomDataStore.RegisterWatcher(Watcher: {$IFDEF LCL}TControl{$ELSE}THandle{$ENDIF});
var var
i: Integer; i: Integer;
{$IFDEF DELPHI}
NewHandle: PVpWatcher; NewHandle: PVpWatcher;
{$ENDIF}
begin begin
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 for i := 0 to FNotifiers.Count - 1 do
if Assigned (FNotifiers[i]) then if Assigned (FNotifiers[i]) then
if PVpWatcher(FNotifiers[i]).Handle = Watcher then if PVpWatcher(FNotifiers[i]).Handle = Watcher then
@ -990,6 +1026,8 @@ begin
GetMem(NewHandle, SizeOf(TVpWatcher)); GetMem(NewHandle, SizeOf(TVpWatcher));
NewHandle.Handle := Watcher; NewHandle.Handle := Watcher;
FNotifiers.Add(NewHandle); FNotifiers.Add(NewHandle);
{$ENDIF}
end;
end; end;
procedure TVpCustomDataStore.NotifyDependents; procedure TVpCustomDataStore.NotifyDependents;
@ -1228,12 +1266,18 @@ begin
end; end;
{$ENDIF} {$ENDIF}
procedure TVpResourceCombo.VpDataStoreChanged(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); procedure TVpResourceCombo.VpDataStoreChanged({$IFDEF DELPHI}var Msg: TMessage{$ENDIF});
begin begin
Unused(Msg);
LoadItems; LoadItems;
end; end;
{$IFDEF LCL}
procedure TVpResourceCombo.VpPrintFormatChanged;
begin
//
end;
{$ENDIF}
function TVpResourceCombo.GetAbout: string; function TVpResourceCombo.GetAbout: string;
begin begin
Result := VpVersionStr; Result := VpVersionStr;
@ -1331,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(Handle); FDataStore.DeregisterWatcher(Self); //Handle);
FDataStore := Value; FDataStore := Value;
if Assigned (FDataStore) and not (csDesigning in ComponentState) then if Assigned (FDataStore) and not (csDesigning in ComponentState) then
FDataStore.RegisterWatcher(Handle); FDataStore.RegisterWatcher(Self); //Handle);
if not (csDesigning in ComponentState) then if not (csDesigning in ComponentState) then
LoadItems; LoadItems;
Invalidate; Invalidate;

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

@ -111,7 +111,7 @@ type
end; end;
{ Contact Grid } { Contact Grid }
TVpContactGrid = class(TVpLinkableControl) TVpContactGrid = class(TVpLinkableControl, IVpWatcher)
private private
FCol1RecCount: Integer; FCol1RecCount: Integer;
FComponentHint: TTranslateString; FComponentHint: TTranslateString;
@ -211,6 +211,13 @@ type
procedure EditContact; procedure EditContact;
procedure EndEdit(Sender: TObject); procedure EndEdit(Sender: TObject);
{$IFDEF LCL}
procedure VpDataStoreChanged;
procedure VpPrintFormatChanged;
{$ELSE}
procedure VpDataStoreChanged(var Msg: TMessage); message VP_DatastoreChanged;
{$ENDIF}
{ popup menu } { popup menu }
function GetPopupMenu: TPopupMenu; override; function GetPopupMenu: TPopupMenu; override;
procedure InitializeDefaultPopup; procedure InitializeDefaultPopup;
@ -228,7 +235,6 @@ type
procedure WMSetCursor(var Msg: TWMSetCursor); procedure WMSetCursor(var Msg: TWMSetCursor);
procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS; procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
procedure VpDataStoreChanged (var Msg : TMessage); message Vp_DataStoreChanged;
{$ELSE} {$ELSE}
procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMSize(var Msg: TLMSize); message LM_SIZE;
procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL; procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
@ -556,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(Handle); DataStore.DeregisterWatcher(Self); //Handle);
cgClickTimer.Free; cgClickTimer.Free;
FContactHeadAttr.Free; FContactHeadAttr.Free;
@ -1945,16 +1951,20 @@ begin
Invalidate; Invalidate;
end; end;
{$IFNDEF LCL} { The DataStore's Resource may not have been properly set (that is:
procedure TVpContactGrid.VpDataStoreChanged (var Msg : TMessage);
begin
{ The DataStore's Resource may not have been property set (that is
the DataStore existed, but there was no resource. Force the sortby the DataStore existed, but there was no resource. Force the sortby
on the contacts here } on the contacts here }
if Assigned (DataStore) then procedure TVpContactGrid.VpDataStoreChanged({$IFDEF DELPHI}var Msg: TMessage{$ENDIF});
if Assigned (DataStore.Resource) then begin
if Assigned(DataStore) and Assigned(DataStore.Resource) then
DataStore.Resource.Contacts.ContactSort := SortBy; DataStore.Resource.Contacts.ContactSort := SortBy;
end; end;
{$IFDEF LCL}
procedure TVpContactGrid.VpPrintFormatChanged;
begin
//
end;
{$ENDIF} {$ENDIF}
procedure TVpContactGrid.cgScrollHorizontal(Rows: Integer); procedure TVpContactGrid.cgScrollHorizontal(Rows: Integer);
@ -2017,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(Handle); DataStore.DeregisterWatcher(Self); //Handle);
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(Handle); DataStore.RegisterWatcher(Self); //Handle);
if not Assigned(DataStore) then if not Assigned(DataStore) then
Exit; Exit;

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

@ -412,7 +412,6 @@ type
{$IFEND} {$IFEND}
{ message handlers } { message handlers }
procedure VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message Vp_DayViewInit;
{$IFNDEF LCL} {$IFNDEF LCL}
procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMSize(var Msg: TWMSize); message WM_SIZE; procedure WMSize(var Msg: TWMSize); message WM_SIZE;
@ -420,10 +419,12 @@ type
procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS; procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
procedure WMEraseBackground (var Msg : TWMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGND"? procedure WMEraseBackground (var Msg : TWMERASEBKGND); // ??? wp: missing "message WM_ERASEBKGND"?
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY; procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure VpDayViewInit(var Msg: TMessage); message Vp_DayViewInit;
{$ELSE} {$ELSE}
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure VpDayViewInit(Data: PtrInt);
procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMSize(var Msg: TLMSize); message LM_SIZE;
procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
@ -1884,16 +1885,20 @@ begin
Style := Style or WS_TABSTOP; Style := Style or WS_TABSTOP;
if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL; if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL; if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
{$IFNDEF LCL} {$IFNDEF LCL}
WindowClass.style := CS_DBLCLKS; WindowClass.style := CS_DBLCLKS;
{$ENDIF} {$ENDIF}
end; end;
end; end;
procedure TVpDayView.CreateWnd; procedure TVpDayView.CreateWnd;
begin begin
inherited; inherited;
{$IFDEF LCL}
Application.QueueAsyncCall(VpDayViewInit, 0);
{$ELSE}
PostMessage(Handle, Vp_DayViewInit, 0, 0); PostMessage(Handle, Vp_DayViewInit, 0, 0);
{$ENDIF}
end; end;
procedure TVpDayView.MouseEnter; procedure TVpDayView.MouseEnter;
@ -2722,12 +2727,22 @@ begin
end; end;
end; end;
procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); {$IFDEF LCL}
procedure TVpDayView.VpDayViewInit(Data: PtrInt);
{$ELSE}
procedure TVpDayView.VpDayViewInit(var Msg: TMessage);
{$ENDIF}
begin begin
{$IFNDEF LCL}
Unused(Msg); Unused(Msg);
{$ENDIF}
if csLoading in ComponentState then begin if csLoading in ComponentState then begin
{$IFDEF LCL}
Application.QueueAsyncCall(VpDayViewInit, 0);
{$ELSE}
PostMessage(Handle, Vp_DayViewInit, 0, 0); PostMessage(Handle, Vp_DayViewInit, 0, 0);
{$ENDIF}
Exit; Exit;
end; end;