Convertir un Message Windows de la VCL vers FMX

Version imprimable

Bonjour,

J'ai cette ligne la dans un composant VCL, et je voudrais la convertir sous Firemonkey:

Code:

procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;

Voici le contenue de la procédure appelé par le message:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 procedure TShowImages.CMHintShow(var Message: TCMHintShow); var mp : TPoint; begin inherited; if assigned(FOnHint) then begin mp := Mouse.CursorPos; mp := ScreenToClient(mp); FOnHint(Self, mp.X, mp.y, Message.HintInfo.HintStr); end; end;
Avez-vous une idée sur comment je pourrait migrer ce bout de code pour que cela fonctionne pas que sous Windows (genre le Mac) ?

salut

un simple code comme ci-dessous aurais peut être suffit non ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
procedure TMAFORME.MONOBJETMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);        
...
Begin
  If MesCondition then 
  begin
    (Sender as TMONOBJET).Hint := 'Je fait ce que je veut ';
    Application.HintPause := 1;
    Application.ActivateHint(Mouse.CursorPos);
  end 
  else 
  begin
     Application.HintPause := 500;
     Application.CancelHint;
  end; 
...
end;

autre solution
dans le formCreate

Code:

1
2
3
 
  OldShowHint :=  Application.OnShowHint;
  Application.OnShowHint := DoShowHint;

dans le FormClose

Code:

Application.OnShowHint := OldShowHint ;

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
procedure TMaForm.DoShowHint(var HintStr: String ; var CanShow: Boolean; var HintInfo: THintInfo);
Var
  ...
  st : String;
begin
  with HintInfo do
  begin
    if HintControl is TMONCONTROL then
    begin
      if HintControl.Name = 'NOMDEMONCONTROLE' Then
      begin
          Application.HideHint;
          HideTimeout     := 5000;
          HintColor     := clWhite;
            if MesConditionS then
                HintStr := 'C est bien mon Hint '   //Fields[x-1].AsString
              else
                HintStr := '';
           CanShow := MesConditionS
      end;  
    end;
  end;
end;

22/03/2017, 09h30
der§en

Merci Anapurna,

Ma question est plus comment en Firemonkey on peut convertir les messages Windows pour que cela fonctionne sous tout les OS ;)

salut

pour pallier aux messages si il n'existe pas dans le système est de passer par des callback

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
unit MessageHandler
  interface
     TOSMessage = procedure(aMessageID, aData1, aData2: integer) of object;
     TOSMessageHandler = class
     private
        fOnMessage : TOSMessage;
     public
        constructor Create(aMessageCallBack: TOSMessage);
        procedure PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread = nil);
    end;
 
var
   OSMessageHandler : TOSMessageHandler;
 
implementation
 
constructor TOSMessageHandler.Create(aMessageCallBack: TOSMessage);
begin
  fOnMessage := aMessageCallBack;
end;
 
procedure TOSMessageHandler.PostMessage(aMessageID, aData1, aData2: integer; aSourceThread: TThread);
begin
  if aSourceThread=nil then
    aSourceThread  := TThread.CurrentThread;
  aSourceThread.Queue(nil, procedure
                           begin
                             if Assigned(fOnMessage) then
                                fOnMessage(aMessageID, aData1, aData2);
                           end  );
end;
end.
 
//Ajout dans la form principal:
TMainForm = class(TForm)
...
procedure MessageCallBack(aMessageID, aData1, aData2: integer);
...
end;
///
Implementation
//Ajout dans le create de la main Form 
  OSMessageHandler := TOSMessageHandler.Create(MessageCallBack);
 
//AJout dans le destroye de la main Form
  FreeAndNil(OSMessageHandler)
 
// Ici la gestion des messages 
procedure TMainForm.MessageCallBack(aMessageID, aData1, aData2: integer);
begin
  case aMessageID of
    MyMessage1 :  MyFunction1(aData1,aData2);
    ...
  end;
end;

ou de réécrire le système de message comme
a fait françois Piette sur son blog

22/03/2017, 16h33
der§en

Merci anapurna ;)
17/04/2017, 21h18
der§en

Je vais creuser du côté de :
http://docwiki.embarcadero.com/Libra...MessageManager