2012년 10월 30일 화요일

서브클래싱

http://code.p-ark.co.kr/trackback/59 에서 갖어왔습니다.
1. 일반적으로 메세지 가로채기를 하려면 WinProc에 콜백을 걸어서 하는데
var
  Form1: TForm1; OldWindProc: Integer;
implementation
{$R *.dfm}
function NewWinProc(hWnd:HWND;Msg:Integer;wParam:Integer;lParam:Integer):LONGINT; StdCall;
var rect: TRect;
begin
  case Msg of
    WM_SIZE : begin
      GetClientRect(hWnd, rect); with rect do Form1.lst1.Items.Add('left:'
        +IntToStr(Left)+'top:' +IntToStr(Top)+'right:'+IntToStr(rect)
        +'bottom:'+IntToStr(rect));
      Form1.lst1.ItemIndex := Form1.lst1.Items.Count + 1; end; end;
  Result:=CallWindowProc(Pointer(OldWindProc),hWnd,Msg,wParam,lParam)
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  OldWindProc:=SetWindowLong(Form1.handle,GWL_WNDPROC,LongInt(@NewWinProc));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(Form1.handle, GWL_WNDPROC, OldWindProc);
end;
2. 클래스 내부에 포함 할때는 다른 방법으로 합니다. 아래와 같이 글로벌 영역에서는
unit Unit1;
interface
uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls;
type
  TForm1 = class(TForm)
    lst1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FTargetWnd: THandle; //서브클래싱 할 핸들 보관
    FOldProc: Pointer; //원본 윈도우프로시져 보관
    FNewProc: Pointer; //재구성 윈도우프로시져
  public
    procedure SubClassCreate(hWnd: THandle);
    procedure SubClassWndproc(var Message: TMessage);
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
// 서브 클래싱 걸기
procedure TForm1.SubClassCreate(hWnd: THandle);
begin
  if FTargetWnd <> 0 then Exit;
  FTargetWnd := hWnd;
  FOldProc := Pointer(GetWindowLong(FTargetWnd, GWL_WNDPROC));
  FNewProc := MakeObjectInstance(SubClassWndproc);
  SetWindowLong(FTargetWnd, GWL_WNDPROC, LongInt(FNewProc));
end;
// 서브클래싱 윈도우프로시져 재구성
procedure TForm1.SubClassWndproc(var Message: TMessage);
begin
  with Message do begin //Message 객체의 내부 메서드들로 윈도우 프로시져 원본을 돌려줌
    Result:=CallWindowProc(FOldProc,FTargetWnd,Msg,WParam,LParam);
    Case Msg of // Message 객체의 WM_SIZE 메세지를 받아옴
      WM_SIZE : begin
        lst1.Items.Add(Format('%d,%d',[LOWORD(Message.LParam),HiWord(Message.LParam)]));
        lst1.ItemIndex := lst1.Items.Count - 1;
    end;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  //서브클래싱을 걸어 준다.예제 이므로 현재 윈도우의 핸들에
  SubClassCreate(Self.Handle);
end;
//서브클래싱 해제
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetWindowLong(FTargetWnd, GWL_WNDPROC, LongInt(FOldProc));
end;
end. 

댓글 없음:

tensorflow gpu 사용하기에서

 tensorflow 설치시 주의해야 한다. # Anything above 2.10 is not supported on the GPU on Windows Native python - m pip install "tensorflow<2.11...