Screenshot von Fenster hat falschen Titel ( mit Beispielcode )

[stalkingwolf]

Hallo zusammen,

danke für die Antworten, ich schaue mir das nachher einmal an.

[himitsu]

Wenn das nicht für Windows kompiliert wird, dann meckert wirklich nicht der Compiler?

Kann man kaum glauben. Allein schon beim Anblick des GetWindowTitle.

[KodeZwerg]

Nun gibt es auch noch den Prozessnamen in der Ausgabe.

Delphi-Quellcode:

{$IFDEF MSWINDOWS}function GetProcessImageFileName(hProcess: THandle; lpImageFileName: LPTSTR; nSize: DWORD): DWORD; stdcall; external 'PSAPI.dll' name 'GetProcessImageFileNameW';{$ENDIF}
procedure ScreenShot(var ADestBitmap: TBitmap; var AWindowTitle, AProcessName: string; const AActiveWindow: Boolean = True; const ARemoveBorder: Boolean = False);
  function GetWindowPath({$IFDEF MSWINDOWS}const AHWND: HWND{$ENDIF}): string;
    function GetPIDbyHWND({$IFDEF MSWINDOWS}const AHWND: HWND{$ENDIF}): DWORD;
    var
      PID: DWORD;
    begin
      if (AHWND <> 0) then
        begin
          {$IFDEF MSWINDOWS}GetWindowThreadProcessID(AHWND, @PID);{$ENDIF}
          Result := PID;
        end
        else
          Result := 0;
    end;
    {$IFDEF MSWINDOWS}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;{$ENDIF}
  var
    {$IFDEF MSWINDOWS}AHandle: THandle;{$ENDIF}
    ALength    : Cardinal;
    AImagePath : String;
  const
    PROCESS_QUERY_LIMITED_INFORMATION = $00001000;
  begin
    Result := '';
    {$IFDEF MSWINDOWS}AHandle := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, GetPIDbyHWND(AHWND));{$ENDIF}
    if (AHandle = 0) then
      Exit;
    try
      SetLength(AImagePath, MAX_PATH);
      {$IFDEF MSWINDOWS}ALength := GetProcessImageFileName(AHandle, @AImagePath[1], MAX_PATH);{$ENDIF}
      if (ALength > 0) then
        begin
          SetLength(AImagePath, ALength);
          Result := {$IFDEF MSWINDOWS}PhysicalToVirtualPath(AImagePath){$ENDIF};
        end;
    finally
      {$IFDEF MSWINDOWS}CloseHandle(AHandle);{$ENDIF}
    end;
  end;
  function GetWindowTitle({$IFDEF MSWINDOWS}const AHWND: HWND{$ENDIF}): string;
  var
    LTitle: string;
    LLen: Integer;
  begin
    Result := '';
    LLen := {$IFDEF MSWINDOWS}GetWindowTextLength(AHWND){$ENDIF} + 1;
    SetLength(LTitle, LLen);
    {$IFDEF MSWINDOWS}GetWindowText(AHWND, PChar(LTitle), LLen);{$ENDIF}
    Result := Trim(LTitle);
  end;
var
  {$IFDEF MSWINDOWS}ShotWindow: HWND;{$ENDIF}
  {$IFDEF MSWINDOWS}ShotRect:   TRect;{$ENDIF}
  {$IFDEF MSWINDOWS}ShotDC:     HDC;{$ENDIF}
  ShotCanvas:   TCanvas;
  ShotBitmap:   TBitmap;
  ImageHeight,
  ImageWidth,
  BorderHeight,
  BorderWidth:  Integer;
begin
  if AActiveWindow then
    // get handle of the focused window
    {$IFDEF MSWINDOWS}ShotWindow := GetForegroundWindow{$ENDIF}
    else
    // get handle of the desktop
    {$IFDEF MSWINDOWS}ShotWindow := GetDesktopWindow{$ENDIF};
  try
    AWindowTitle := GetWindowTitle(ShotWindow);
    AProcessName := GetWindowPath(ShotWindow);
    // get size of handle
    {$IFDEF MSWINDOWS}GetWindowRect(ShotWindow, ShotRect){$ENDIF};
    // remove "invisible" area around a window frame
    if (AActiveWindow and ARemoveBorder) then
      begin
        {$IFDEF MSWINDOWS}
        BorderHeight    := GetSystemMetrics(SM_CXDLGFRAME) + GetSystemMetrics(SM_CXSIZEFRAME) + GetSystemMetrics(SM_CXEDGE);
        BorderWidth     := GetSystemMetrics(SM_CYDLGFRAME) + GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYEDGE);
        ShotRect.Right  := ShotRect.Right - BorderWidth;
        ShotRect.Left   := ShotRect.Left + BorderWidth;
        ShotRect.Top    := ShotRect.Top + BorderHeight;
        ShotRect.Bottom := ShotRect.Bottom - BorderHeight;
        {$ENDIF}
      end;
    // calculate image size
    {$IFDEF MSWINDOWS}
    ImageWidth  := ShotRect.Right - ShotRect.Left;
    ImageHeight := ShotRect.Bottom - ShotRect.Top;
    {$ENDIF}
    // open a canvas
    ShotCanvas  := TCanvas.Create;
    try
      // get handle to device context
      {$IFDEF MSWINDOWS}ShotDC := GetDCEx(0, 0, DCX_WINDOW or DCX_PARENTCLIP or DCX_CLIPSIBLINGS or DCX_CLIPCHILDREN){GetDC(0)};{$ENDIF} // (0) = what you see is what you get :-)
      try
        ShotBitmap := TBitmap.Create;
        try
          ShotBitmap.PixelFormat     := TPixelFormat.pfDevice;
          ShotBitmap.Width           := ImageWidth;
          ShotBitmap.Height          := ImageHeight;
          // connect canvas to device context
          {$IFDEF MSWINDOWS}ShotCanvas.Handle := ShotDC;{$ENDIF}
          ShotBitmap.Canvas.CopyMode := cmSrcCopy;
          // copy to image whatever content is in that moment on the screen at given location
          ShotBitmap.Canvas.CopyRect(
            Rect(0, 0, ImageWidth, ImageHeight), // dimension of target
            {$IFDEF MSWINDOWS}ShotCanvas{$ENDIF}, // source to use
            Rect({$IFDEF MSWINDOWS}ShotRect.Left{$ENDIF},
                 {$IFDEF MSWINDOWS}ShotRect.Top{$ENDIF},
                 {$IFDEF MSWINDOWS}ShotRect.Right{$ENDIF},
                 {$IFDEF MSWINDOWS}ShotRect.Bottom{$ENDIF})); // location of source
        finally
          ADestBitmap.Assign(ShotBitmap);
          ShotBitmap.Free;
        end;
      finally
        {$IFDEF MSWINDOWS}ReleaseDC(0, ShotDC){$ENDIF};
      end;
    finally
      ShotCanvas.Free;
    end;
  finally
  end;
end;

procedure Tfmain.WMHotKey(Var Msg: TMessage);
var
  MyBitmap:           TBitmap;
  MyClipboard:        TClipboard;
  MyTitle, MyProcess: string;
begin
    case Msg. WParam of
        id3: begin
               MyBitmap := TBitmap.Create;
               Screenshot(MyBitmap, MyTitle, MyProcess, True, CheckBox1.Checked);
               Image1.Picture.Bitmap.Assign(MyBitmap);
               MyClipboard := TClipBoard.Create;
               MyClipboard.Assign(MyBitmap);
               MyClipBoard.Free;
               MyBitmap.Free;
               lbStatus.Caption := 'Bild in Zwischenablage kopiert : ' + FormatDateTime('hh:nn:ss', Now) + ' (' + MyProcess + ' - ' + MyTitle + ')';
             end;
    end;
end;

[KodeZwerg]

Zitat von himitsu:

Wenn das nicht für Windows kompiliert wird, dann meckert wirklich nicht der Compiler?

Kann man kaum glauben. Allein schon beim Anblick des GetWindowTitle.

Ich habe nicht behauptet es sei im jetzt-Zustand kompatibel zu irgendetwas anderem als Windows.
Ich habe lediglich die reinen Windows Methoden bereits aussortiert damit ein fähiger Linux oder MaxOS Kundiger gleich weiß wo es klemmt.

[himitsu]

Die vielen IFDEF haben aber schon ein bissl impliziert, dass es so sein könnte.


An manchen Stellen zu viel und wo anders zu wenig.
z.B. LLen, ImageHeight und ImageWidth wären nicht initialisiert.

Und das eine Rect(,,,) ohne Parameter wird auch weinen.


Nja, da hier eh praktisch fast alles Windows ist, dann doch einfach die IFDEF weglassen, anstatt es komplet falsch zu lassen,
dazumal eh ein Alternativcode fehlt und selbst bei halbwegs richtigem ausgeifdeffe keine Funktion übrig bleibt.

[stalkingwolf]

Funktion funktioniert einwandfrei. Evtl etwas Overkill für das was wir brauchen, aber besser haben als brauchen

[KodeZwerg]

Zitat von stalkingwolf:

Funktion funktioniert einwandfrei. Evtl etwas Overkill für das was wir brauchen, aber besser haben als brauchen

Freut mich wenn's einen Sinn und Zweck erfüllt , ja bin da wohl etwas tiefer vorgedrungen als es eigentlich nötig war