Bonjour,

Je cherche a convertir cette unité FreePascal vers Delphi, pensez-vous que cela soit faisable ou bien c'est peine perdue ?

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
unit uWindowSubclass;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Windows, LCLIntf;
 
function SubclassWindow(const Window: THandle; const NewProc: TWndMethod): WNDPROC;
function UnsubclassWindow(const Window: THandle; const Oldproc: WNDPROC): TWndMethod;
 
implementation
 
type
  PCallbackInfo = ^TCallbackInfo;
 
  TCallbackInfo = record
    Proc: TWndMethod;
    Previous: WNDPROC;
  end;
 
 
var
  CallbackInfo: ATOM;
 
procedure CallbackSubclass(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
  lParam: LParam); stdcall;
var
  Msg: TMessage;
  Method: PCallbackInfo;
begin
  FillChar(Msg{%H-}, SizeOf(Msg), #0);
 
  Msg.msg := uMsg;
  Msg.wParam := wParam;
  Msg.lParam := lParam;
 
  Method := LCLIntf.GetProp(Ahwnd, PChar(CallbackInfo));
 
  if Assigned(Method) then
    Method^.Proc(Msg);
 
  if Msg.Result = 0 then
    Msg.Result := LCLIntf.CallWindowProc(Method^.Previous, Ahwnd, uMsg, wparam, lparam);
end;
 
function SubclassWindow(const Window: THandle; const NewProc: TWndMethod): WNDPROC;
var
  method: PCallbackInfo;
begin
  new(method);
  method^.Proc := NewProc;
  LCLIntf.SetProp(Window, PChar(CallbackInfo), method);
  method^.Previous := WNDPROC(LCLIntf.SetWindowLong(Window, GWL_WNDPROC,
    LONG_PTR(@CallbackSubclass)));
  Result := method^.Previous;
end;
 
function UnsubclassWindow(const Window: THandle; const Oldproc: WNDPROC): TWndMethod;
var
  method: PCallbackInfo;
begin
  method := LCLIntf.GetProp(Window, PChar(CallbackInfo));
  if Assigned(method) then
  begin
    LCLIntf.RemoveProp(Window, PChar(CallbackInfo));
    LCLIntf.SetWindowLong(Window, GWL_WNDPROC, LONG_PTR(method^.Previous));
    Result := method^.Proc;
    Dispose(method);
  end;
end;
 
initialization
  CallbackInfo := Windows.GlobalAddAtom('CallbackMethodInfo');
 
finalization
  Windows.GlobalDeleteAtom(CallbackInfo);
 
end.