Klassenmethode in einem Event aufrufen.

[KodeZwerg]

Hallo liebe Gemeinde, ich versuche gerade eine nicht visuelle Klasse zu erstellen mit der man wild Knipsen kann.
Es klappt soweit alles ganz gut.
Als ich mir einen Hotkey-Handler eingebaut habe, funktioniert kein Aufruf dieser Klassenmethode.
Kann mir jemand bitte etwas Hilfestellung geben?

Die betroffene Quelltext-Stelle:

Delphi-Quellcode:

  function MsgWndProc(fWnd: HWND; fMsg: UINT; fWParam: WPARAM; fLParam: LPARAM): LRESULT; stdcall;
  begin
    Result := 0;
    if (fWParam = kzHotkeyID) then
    begin
      MessageBox(0, 'Hotkey', 'Hotkey', MB_OK); // nur um zu sehen ob ich im Hotkey bin
      Shot; // hier knallt es
      Result := 1;
    end
    else
      Result := DefWindowProc(fWnd, fMsg, fWParam, fLParam);
  end;

Der Komplette Quelltext:

Delphi-Quellcode:

unit kz.Windows.ScreenShot;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Classes,
  Vcl.Clipbrd, Vcl.Graphics;

function GetProcessImageFileName(hProcess: THandle; lpImageFileName: LPTSTR; nSize: DWORD): DWORD; stdcall; external 'PSAPI.dll' name 'GetProcessImageFileNameW';

const
  kzHotkeyID = WM_APP + 1234;

type
  TkzMessageEvent = procedure(ASender: TObject) of object;
  TkzScreenShot = class(TObject)
    const
      CMsgWindowClassName : string = 'KZMsgWndCls';
      CWindowName         : string = 'KZHidden';
    strict private
      FOnMessage:      TkzMessageEvent;
      FImageHeight:    Integer;
      FImageWidth:     Integer;
      FBorderHeight:   Integer;
      FBorderWidth:    Integer;
      FImage:          TBitmap;
      FCanvas:         TCanvas;
      FClientRect:     TRect;
      FRect:           TRect;
      FCaption:        string;
      FFilename:       string;
      FPID:            DWORD;
      FHWND:           HWND;
      FGetFocused:     Boolean;
      FCutAllBorders:  Boolean;
      FCutLeft:        Boolean;
      FCutRight:       Boolean;
      FCutTop:         Boolean;
      FCutBottom:      Boolean;
      FSuccess:        Boolean;
      FHotkey:         Cardinal;
      FModAlt:         Boolean;
      FModCtrl:        Boolean;
      FModShift:       Boolean;
      FModWin:         Boolean;
      FModNR:          Boolean;
      FModifier:       UINT;
      FAutoClipboard:  Boolean;
      FMsgWindowClass: TWndClass;
      FMessageHandle:  THandle;
    private
      function GetBorderHeight: Integer;
      function GetBorderWidth: Integer;
      procedure SetCutAllBorders(const AValue: Boolean);
      procedure SetCutLeft(const AValue: Boolean);
      procedure SetCutRight(const AValue: Boolean);
      procedure SetCutTop(const AValue: Boolean);
      procedure SetCutBottom(const AValue: Boolean);
      procedure SetHotkey(const AValue: Cardinal);
      procedure SetModAlt(const AValue: Boolean);
      procedure SetModCtrl(const AValue: Boolean);
      procedure SetModShift(const AValue: Boolean);
      procedure SetModWin(const AValue: Boolean);
      procedure SetModNR(const AValue: Boolean);
    protected
      function AllocateHWND: THandle;
    public
      constructor Create(const AFormHWND: HWND);
      destructor Destroy; Override;
      procedure Reset;
      procedure Shot;
      procedure CopyToClipboard;
    public
      property OnMessage: TkzMessageEvent read FOnMessage write FOnMessage;
      property Success: Boolean read FSuccess;
      property Image: TBitmap read FImage;
      property AutoToClipboard: Boolean read FAutoClipboard write FAutoClipboard;
      property ImageHeight: Integer read FImageHeight;
      property ImageWidth: Integer read FImageWidth;
      property BorderHeight: Integer read GetBorderHeight write FBorderHeight;
      property BorderWidth: Integer read GetBorderWidth write FBorderWidth;
      property GetFocused: Boolean read FGetFocused write FGetFocused;
      property Caption: string read FCaption;
      property Filename: string read FFilename;
      property ProcessID: DWORD read FPID;
      property ProcessHWND: HWND read FHWND;
      property CutAllBorders: Boolean read FCutAllBorders write SetCutAllBorders;
      property CutLeftBorder: Boolean read FCutLeft write SetCutLeft;
      property CutRightBorder: Boolean read FCutRight write SetCutRight;
      property CutTopBorder: Boolean read FCutTop write SetCutTop;
      property CutBottomBorder: Boolean read FCutBottom write SetCutBottom;
      property Hotkey: Cardinal read FHotkey write SetHotkey;
      property HotkeyModifierAlt: Boolean read FModAlt write SetModAlt;
      property HotkeyModifierControl: Boolean read FModCtrl write SetModCtrl;
      property HotkeyModifierShift: Boolean read FModShift write SetModShift;
      property HotkeyModifierWin: Boolean read FModWin write SetModWin;
      property HotkeyModifierNoRepeat: Boolean read FModNR write SetModNR;
  end;

implementation

resourcestring
  SFailedToRegisterWindowClass = 'Failed to register message window class';
  SFailedToCreateWindow        = 'Failed to create message window %s';
const
  MSG_WND_CLASSNAME : PChar = 'KZMsgWindowCls';

constructor TkzScreenShot.Create;
begin
  inherited Create;
  Reset;
  FImage             := TBitmap.Create;
  FImage.PixelFormat := TPixelFormat.pfDevice;
  FCanvas            := TCanvas.Create;
  FOnMessage         := nil;
  FHotkey            := 0;
  FModifier          := 0;
  FModAlt            := False;
  FModCtrl           := False;
  FModShift          := False;
  FModWin            := False;
  FModNR             := False;
  FMessageHandle     := AllocateHWND;
  GetBorderHeight;
  GetBorderWidth;
end;

destructor TkzScreenShot.Destroy;
begin
  UnregisterHotKey(FMessageHandle, kzHotkeyID);
  Reset;
  FOnMessage := nil;
  FImage.Free;
  FCanvas.Free;
  DestroyWindow(FMessageHandle);
  inherited Destroy;
end;

procedure TkzScreenShot.Reset;
begin
  FImageHeight   := 0;
  FImageWidth    := 0;
  FBorderHeight  := 0;
  FBorderWidth   := 0;
  FPID           := 0;
  FHWND          := 0;
  FCaption       := '';
  FFilename      := '';
  FGetFocused    := True;
  FSuccess       := False;
  FAutoClipboard := False;
  FCutAllBorders := False;
  FCutLeft       := False;
  FCutRight      := False;
  FCutTop        := False;
  FCutBottom     := False;
  FClientRect.Empty;
  FRect.Empty;
end;

function TkzScreenShot.GetBorderHeight: Integer;
begin
  FBorderHeight := GetSystemMetrics(SM_CXDLGFRAME) + GetSystemMetrics(SM_CXSIZEFRAME) + GetSystemMetrics(SM_CXEDGE);
  Result := FBorderHeight;
end;

function TkzScreenShot.GetBorderWidth: Integer;
begin
  FBorderWidth := GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYEDGE);
  Result := FBorderWidth;
end;

procedure TkzScreenShot.SetCutAllBorders(const AValue: Boolean);
begin
  FCutAllBorders := AValue;
  if AValue then
    begin
      FCutLeft       := False;
      FCutRight      := False;
      FCutTop        := False;
      FCutBottom     := False;
    end;
end;

procedure TkzScreenShot.SetCutLeft(const AValue: Boolean);
begin
  FCutLeft := AValue;
  if AValue then
    FCutAllBorders := False;
end;

procedure TkzScreenShot.SetCutRight(const AValue: Boolean);
begin
  FCutRight := AValue;
  if AValue then
    FCutAllBorders := False;
end;

procedure TkzScreenShot.SetCutTop(const AValue: Boolean);
begin
  FCutTop := AValue;
  if AValue then
    FCutAllBorders := False;
end;

procedure TkzScreenShot.SetCutBottom(const AValue: Boolean);
begin
  FCutBottom := AValue;
  if AValue then
    FCutAllBorders := False;
end;

procedure TkzScreenShot.Shot;
  function GetWindowPath(const AHWND: HWND): string;
    function GetPIDbyHWND(const AHWND: HWND): DWORD;
    var
      PID: DWORD;
    begin
      if (AHWND <> 0) then
        begin
          GetWindowThreadProcessID(AHWND, @PID);
          Result := PID;
        end
        else
          Result := 0;
      FPID := Result;
    end;
    function PhysicalToVirtualPath(APath: string): string;
    var
      i          : integer;
      ADrive     : string;
      ABuffer    : array[0..MAX_PATH - 1] of Char;
      ACandidate : string;
    begin
      {$I-}
      for I := 0 to 25 do
        begin
          ADrive := Format('%s:', [Chr(Ord('A') + i)]);
          if (QueryDosDevice(PWideChar(ADrive), ABuffer, MAX_PATH) = 0) then
            Continue;
          ACandidate := string(ABuffer).ToLower();
          if (string(Copy(APath, 1, Length(ACandidate))).ToLower() = ACandidate) then
            begin
              Delete(APath, 1, Length(ACandidate));
              Result := Format('%s%s', [ADrive, APath]);
            end;
        end;
      {$I+}
    end;
  var
    AHandle: THandle;
    ALength    : Cardinal;
    AImagePath : String;
  const
    PROCESS_QUERY_LIMITED_INFORMATION = $00001000;
  begin
    Result := '';
    AHandle := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, GetPIDbyHWND(AHWND));
    if (AHandle = 0) then
      Exit;
    try
      SetLength(AImagePath, MAX_PATH);
      ALength := GetProcessImageFileName(AHandle, @AImagePath[1], MAX_PATH);
      if (ALength > 0) then
        begin
          SetLength(AImagePath, ALength);
          Result := PhysicalToVirtualPath(AImagePath);
        end;
    finally
      CloseHandle(AHandle);
    end;
  end;
  function GetWindowTitle(const AHWND: HWND): string;
  var
    LTitle: string;
    LLen: Integer;
  begin
    Result := '';
    LLen := GetWindowTextLength(AHWND) + 1;
    SetLength(LTitle, LLen);
    GetWindowText(AHWND, PChar(LTitle), LLen);
    Result := Trim(LTitle);
  end;
var
  ShotDC: HDC;
begin
  FSuccess := False;
  if FGetFocused then
    FHWND := GetForegroundWindow
    else
    FHWND := GetDesktopWindow;
  try
    FCaption := GetWindowTitle(FHWND);
    FFilename := GetWindowPath(FHWND);
    GetWindowRect(FHWND, FRect);
    GetClientRect(FHWND, FClientRect);
    if (FCutAllBorders or FCutLeft or FCutRight or FCutTop or FCutBottom) then
      if FCutAllBorders then
        begin
          FRect.Left   := FRect.Left + BorderWidth;
          FRect.Right  := FRect.Right - BorderWidth;
          FRect.Top    := FRect.Top + BorderHeight;
          FRect.Bottom := FRect.Bottom - BorderHeight;
        end
        else
        begin
          if FCutLeft then
            FRect.Left   := FRect.Left + BorderWidth;
          if FCutRight then
            FRect.Right  := FRect.Right - BorderWidth;
          if FCutTop then
            FRect.Top    := FRect.Top + BorderHeight;
          if FCutBottom then
            FRect.Bottom := FRect.Bottom - BorderHeight;
        end;
    FImageWidth  := FRect.Right - FRect.Left;
    FImageHeight := FRect.Bottom - FRect.Top;
    ShotDC := GetDCEx(0, 0, DCX_WINDOW or DCX_PARENTCLIP or DCX_CLIPSIBLINGS or DCX_CLIPCHILDREN);
    try
      FImage.Width := FImageWidth;
      FImage.Height := FImageHeight;
      FCanvas.Handle := ShotDC;
      FImage.Canvas.CopyMode := cmSrcCopy;
      FImage.Canvas.CopyRect(
            Rect(0, 0, FImageWidth, FImageHeight),
            FCanvas,
            Rect(FRect.Left,
                 FRect.Top,
                 FRect.Right,
                 FRect.Bottom));
      if FAutoClipboard then
        CopyToClipboard;
      FImage.Dormant;
      FImage.FreeImage;
    finally
      ReleaseDC(0, ShotDC);
    end;
  finally
    if Assigned(FOnMessage) then
      FOnMessage(Self);
    FSuccess := True;
  end;
end;

procedure TkzScreenShot.SetHotkey(const AValue: Cardinal);
begin
  UnregisterHotKey(FMessageHandle, kzHotkeyID);
  FHotkey := AValue;
  RegisterHotkey(FMessageHandle, kzHotkeyID, FModifier, FHotkey);
end;

procedure TkzScreenShot.SetModAlt(const AValue: Boolean);
begin
  FModAlt := AValue;
  if FModAlt then
    FModifier := FModifier + MOD_ALT
    else
    FModifier := FModifier - MOD_ALT;
  SetHotkey(FHotkey);
end;

procedure TkzScreenShot.SetModCtrl(const AValue: Boolean);
begin
  FModCtrl := AValue;
  if FModCtrl then
    FModifier := FModifier + MOD_CONTROL
    else
    FModifier := FModifier - MOD_CONTROL;
  SetHotkey(FHotkey);
end;

procedure TkzScreenShot.SetModShift(const AValue: Boolean);
begin
  FModShift := AValue;
  if FModShift then
    FModifier := FModifier + MOD_SHIFT
    else
    FModifier := FModifier - MOD_SHIFT;
  SetHotkey(FHotkey);
end;

procedure TkzScreenShot.SetModWin(const AValue: Boolean);
begin
  FModWin := AValue;
  if FModWin then
    FModifier := FModifier + MOD_WIN
    else
    FModifier := FModifier - MOD_WIN;
  SetHotkey(FHotkey);
end;

procedure TkzScreenShot.SetModNR(const AValue: Boolean);
begin
  FModNR := AValue;
  if FModNR then
    FModifier := FModifier or MOD_NOREPEAT
    else
    FModifier := FModifier and not MOD_NOREPEAT;
  SetHotkey(FHotkey);
end;

procedure TkzScreenShot.CopyToClipboard;
var
  Clipboard: TClipboard;
begin
  if (not FSuccess) then
    Exit;
  Clipboard := TClipBoard.Create;
  try
    Clipboard.Assign(FImage);
  finally
    ClipBoard.Free;
  end;
end;

function TkzScreenShot.AllocateHWND: THandle;
  function MsgWndProc(fWnd: HWND; fMsg: UINT; fWParam: WPARAM; fLParam: LPARAM): LRESULT; stdcall;
  begin
    Result := 0;
    if (fWParam = kzHotkeyID) then
    begin
      MessageBox(0, 'Hotkey', 'Hotkey', MB_OK); // nur um zu sehen ob ich im Hotkey bin
      Shot; // hier knallt es
      Result := 1;
    end
    else
      Result := DefWindowProc(fWnd, fMsg, fWParam, fLParam);
  end;
var
  WC : TWndClass;
  msg: TMsg;
begin
  Pointer(FMsgWindowClass.lpfnWndProc) := @MsgWndProc;
  FMsgWindowClass.hInstance            := HInstance; // Handle of this instance
  FMsgWindowClass.lpszClassName        := PChar(CMsgWindowClassName);
  if not GetClassInfo(HInstance, MSG_WND_CLASSNAME, WC)
    and (Winapi.Windows.RegisterClass(FMsgWindowClass) = 0) then
      raise Exception.Create(SFailedToRegisterWindowClass);
  Result := CreateWindowEx(
    WS_EX_TOOLWINDOW,
    PChar(CMsgWindowClassName),
    PChar(CWindowName),
    WS_POPUP,
    0,
    0,
    0,
    0,
    0,
    0,
    HInstance,
    nil
  );
  if Result <> 0 then
    SetWindowLongPtr(Result, 0, NativeInt(Self))
  else
    raise Exception.CreateFmt(SFailedToCreateWindow, [CWindowName]);
end;

end.

[peterbelow]

Delphi-Quellcode:

function TkzScreenShot.AllocateHWND: THandle;
  function MsgWndProc(fWnd: HWND; fMsg: UINT; fWParam: WPARAM; fLParam: LPARAM): LRESULT; stdcall;
  begin

Du kannst keine nested function als window proc verwenden, da stimmt das stack layout nicht.

[KodeZwerg]

Zitat von peterbelow:

[DELPHI]
Du kannst keine nested function als window proc verwenden, da stimmt das stack layout nicht.

Okay, dann steh ich aber vor dem Problem das "Shot" nun das macht [dcc32 Error] kz.Windows.ScreenShot.pas(425): E2076 This form of method call only allowed for class methods or constructor
Einen Tipp wie ich aus der Klasseninstanz nun Shot aufrufen kann, bitte

[Uwe Raabe]

Du musst irgendwie an die TkzScreenShot-Instanz ran kommen. Da du diese aber ja mit SetWindowLongPtr beim Fensterhandle ablegst, sollte das lösbar sein.

[KodeZwerg]

Zitat von Uwe Raabe:

Du musst irgendwie an die TkzScreenShot-Instanz ran kommen. Da du diese aber ja mit SetWindowLongPtr beim Fensterhandle ablegst, sollte das lösbar sein.

Ich werde daraus gerade nicht schlau aber vielleicht bin ja nicht total auf dem Holzweg, ich versuche gleich mal PostMessage() und hab ein Event in der Klasse, so hoffe ich jedenfalls

[Uwe Raabe]

Na ja, mit SetWindowLongPtr(Result, 0, NativeInt(Self)) speicherst du die Instanz im Windows-Handle. Dann kannst du sie auch über GetWindowLongPtr(fWnd, 0) wieder herausholen:

Delphi-Quellcode:

function MsgWndProc(fWnd: HWND; fMsg: UINT; fWParam: WPARAM; fLParam: LPARAM): LRESULT; stdcall;
begin
  Result := 0;
  if (fWParam = kzHotkeyID) then
  begin
    MessageBox(0, 'Hotkey', 'Hotkey', MB_OK); // nur um zu sehen ob ich im Hotkey bin
    TkzScreenShot(GetWindowLongPtr(fWnd, 0)).Shot;
    Result := 1;
  end
  else
    Result := DefWindowProc(fWnd, fMsg, fWParam, fLParam);
end;

[KodeZwerg]

Vielen Dank Uwe, mit einer 0 hatte es nicht geklappt aber bei "GWL_USERDATA" klappt alles wie es sollte.

Danke danke!

[KodeZwerg]

Ps: so sieht es nun in meiner Klasse aus: SetWindowLongPtr(fHiddenWnd, GWL_USERDATA, NativeInt(Self));

Delphi-Quellcode:

function HiddenProc(AWnd: HWND; AMsg: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
var
  Shot: TkzScreenShot;
begin
  Result := 0;
  case AMsg of
    WM_HOTKEY: case AWParam of
                 kzHotkeyID: begin
                               Shot := TkzScreenShot(GetWindowLongPtr(AWnd, GWL_USERDATA));
                               if Assigned(Shot) then
                                 Shot.Shot;
                               Result := 1;
                             end;
               end;
  end;
  if (Result = 0) then
    Result := DefWindowProc(AWnd, AMsg, AWParam, ALParam);
end;

Vielen Dank Peter und Uwe!