PostMessage and SendMessage implementation for carbon

git-svn-id: trunk@13397 -

lcl/interfaces/carbon/carbondef.pp

@@ -147,6 +147,7 @@ const
   LCLCarbonEventClass    = 'Laz ';
   LCLCarbonEventKindWake = 'Wake';
   LCLCarbonEventKindMain = 'Main';
+  LCLCarbonEventKindUser = 'User';
 
 function CheckHandle(const AWinControl: TWinControl; const AClass: TClass; const DbgText: String): Boolean;
 function CheckWidget(const Handle: HWND; const AMethodName: String; AParamName: String = ''): Boolean;

lcl/interfaces/carbon/carbonint.pas

@@ -105,6 +105,8 @@ type
     function CreateComponent(Sender : TObject): THandle; override;
     function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc) : THandle; override;
     function DestroyTimer(TimerHandle: THandle) : boolean; override;
+    function PrepareUserEvent(Handle: HWND; Msg: Cardinal; wParam: WParam;
+      lParam: LParam; out Target: EventTargetRef): EventRef;
 
     // the winapi compatibility methods
     {$I carbonwinapih.inc}

lcl/interfaces/carbon/carbonobject.inc

@@ -459,9 +459,10 @@ begin
     DebugLn('EventClass: "',CurEventClass.Chars,'" EventKind: ',IntToStr(CurEventKind.Int));
     {$ENDIF}
 
-    if CurEventClass.Chars=LCLCarbonEventClass then begin
+    if CurEventClass.Chars = LCLCarbonEventClass then
+    begin
       // internal carbon intf message
-      if (CurEventKind.Chars=LCLCarbonEventKindWake) and IsMultiThread then
+      if (CurEventKind.Chars = LCLCarbonEventKindWake) and IsMultiThread then
       begin
         // a thread is waiting -> synchronize
         CheckSynchronize;
@@ -1066,3 +1067,38 @@ begin
     OSError(RemoveEventLoopTimer(EventLoopTimerRef(TimerHandle)), Self,
       'DestroyTimer', 'RemoveEventLoopTimer');
 end;
+
+function TCarbonWidgetSet.PrepareUserEvent(Handle: HWND; Msg: Cardinal;
+  wParam: WParam; lParam: LParam; out Target: EventTargetRef): EventRef;
+var
+  EventSpec: EventTypeSpec;
+  AMessage: TLMessage;
+  Widget: TCarbonWidget;
+begin
+  Result := nil;
+  if FMainEventQueue = nil then exit;
+
+  Widget := TCarbonWidget(Handle);
+
+  if Widget is TCarbonControl then
+    Target := GetControlEventTarget(Widget.Widget)
+  else
+  if Widget is TCarbonWindow then
+    Target := GetWindowEventTarget(Widget.Widget)
+  else
+    Exit;
+
+  EventSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindUser);
+  if CreateEvent(nil, EventSpec.eventClass, EventSpec.eventKind,
+    0, kEventAttributeUserEvent, Result) <> noErr then
+    Exit;
+
+  AMessage.Msg := Msg;
+  AMessage.LParam := lParam;
+  AMessage.WParam := wParam;
+  AMessage.Result := 0;
+  SetEventParameter(Result, MakeFourCC('wmsg'),
+                            MakeFourCC('wmsg'), SizeOf(TLMessage),
+                            @AMessage);
+end;
+

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -458,3 +458,19 @@ begin
   
   Result := noErr; // cursor was setted
 end;
+
+function CarbonCommon_User(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+var
+  AMessage: TLMessage;
+begin
+  Result := GetEventParameter(AEvent, MakeFourCC('wmsg'), MakeFourCC('wmsg'), nil,
+     SizeOf(TLMessage), nil, @AMessage);
+  if Result = noErr then
+  begin
+    AMessage.Result := DeliverMessage(AWidget.LCLObject, AMessage);
+    SetEventParameter(AEvent, MakeFourCC('wmsg'), MakeFourCC('wmsg'),
+      SizeOf(TLMessage), @AMessage);
+  end;
+end;

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -255,12 +255,18 @@ begin
     RegisterEventHandler(@CarbonControl_CommandProcess),
     1, @TmpSpec, Pointer(Self), nil);
     
-// cursor set
+  // cursor set
   TmpSpec := MakeEventSpec(kEventClassControl, kEventControlSetCursor);
   InstallControlEventHandler(Content,
     RegisterEventHandler(@CarbonCommon_SetCursor),
     1, @TmpSpec, Pointer(Self), nil);
 
+  // user messages
+  TmpSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindUser);
+  InstallControlEventHandler(Widget,
+    RegisterEventHandler(@CarbonCommon_User),
+    1, @TmpSpec, Pointer(Self), nil);
+    
   if cceHit in Events then
   begin
     TmpSpec := MakeEventSpec(kEventClassControl, kEventControlHit);

lcl/interfaces/carbon/carbonprivatewindow.inc

@@ -955,6 +955,11 @@ begin
     RegisterEventHandler(@CarbonCommon_CursorChange),
     1, @TmpSpec, Pointer(Self), nil);	
 
+  // user messages
+  TmpSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindUser);
+  InstallWindowEventHandler(Widget,
+    RegisterEventHandler(@CarbonCommon_User),
+    1, @TmpSpec, Pointer(Self), nil);
   {$IFDEF VerboseWindowEvent}
     DebugLn('TCarbonWindow.RegisterEvents ', ClassName, ' ',
       LCLObject.Name, ': ', LCLObject.ClassName);

lcl/interfaces/carbon/carbonwinapi.inc

@@ -2256,8 +2256,29 @@ end;
 
 function TCarbonWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal;
   wParam: WParam; lParam: LParam): Boolean;
+var
+  UserEvent: EventRef;
+  EventTarget: EventTargetRef;
 begin
-  Result:=inherited PostMessage(Handle, Msg, wParam, lParam);
+  Result := False;
+  if not CheckWidget(Handle, 'PostMessage') then Exit;
+
+  UserEvent := nil;
+  try
+    UserEvent := PrepareUserEvent(Handle, Msg, wParam, lParam, EventTarget);
+    if UserEvent = nil then
+      Exit;
+
+    SetEventParameter(UserEvent, kEventParamPostTarget, typeEventTargetRef,
+      SizeOf(EventTarget), @EventTarget);
+      
+    if PostEventToQueue(FMainEventQueue, UserEvent, kEventPriorityStandard) <> noErr then
+      Exit;
+  finally
+    if UserEvent <> nil then 
+      ReleaseEvent(UserEvent);
+  end;
+  Result := True;
 end;
 
 {------------------------------------------------------------------------------
@@ -2596,8 +2617,28 @@ end;
  ------------------------------------------------------------------------------}
 function TCarbonWidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal;
   wParam: WParam; lParam: LParam): LResult;
+var
+  UserEvent: EventRef;
+  EventTarget: EventTargetRef;
+  AMessage: TLMessage;
 begin
-  Result := inherited SendMessage(HandleWnd, Msg, wParam, lParam);
+  Result := 0;
+  if not CheckWidget(HandleWnd, 'SendMessage') then Exit;
+
+  UserEvent := nil;
+  try
+    UserEvent := PrepareUserEvent(HandleWnd, Msg, wParam, lParam, EventTarget);
+    if UserEvent = nil then
+      Exit;
+
+    SendEventToEventTarget(UserEvent, EventTarget);
+    if GetEventParameter(UserEvent, MakeFourCC('wmsg'), MakeFourCC('wmsg'), nil,
+       SizeOf(TLMessage), nil, @AMessage) = noErr then
+      Result := AMessage.Result;
+  finally
+    if UserEvent <> nil then
+      ReleaseEvent(UserEvent);
+  end;
 end;
 
 {------------------------------------------------------------------------------