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

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

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

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

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

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

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