Atomek
Jan Schirrmachers Web

Pixelpeeker - Bildschirmlupe für Windows 7

Beispiel

Manchmal benötige ich eine pixelgenaue Vergrößerung des Bildschirmes. Die mit Windows 7 mitgelieferte ist für pixelgenaues Arbeiten schlecht geeignet, weil sie die Pixel weichzeichnet. Habe jedenfalls keine Einstellung zum abstellen dieses Verhaltens gefunden.

PixelPeeker ist eine einfache Bildschirmlupe für Windows, die ich schnell geschrieben habe, um Komponenten und Anwendung pixelgenau entwickeln zu können.

Solange die Anwendung PixelPeeker den Fokus hat, kannst du mit dem Mausrad zoomen.

Copyright

PixelPeeker ist frei in der Benutzung und in der Verbreitung, solange damit nicht direkte Gewinne erzielt werden (Verkauf) und der Hinweis auf meine Urheberschaft erhalten bleibt.

Download

InstallPixelPeeker.exe 962kB
InstallPixelPeeker.zip 936kB

Source code

Die Anwendung ist mit Embarcadero Delphi XE4 entwickelt für Windows 32-Bit. Die Hauptform hat die Eigenschaften DoubleBuffered = true, FormStyle=fsStayOnTop.

unit MainDlg;

////////////////////////////////////////////////////////////////////////////////
//
//  PixelPeeker (c) 2016 Jan Schirrmacher, www.atomek.de
//
//  Magnifies screen pixels. Use mouse wheel to zoom-in and -out.
//
//  Its free to  use and copy PixelPeeker. You can do anything with PixelPeeker
//  without the following exceptions:
//  - sale. But you can bundle it to any work of your own.
//  - disclaim it as your work
//
////////////////////////////////////////////////////////////////////////////////

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus;

type
  TMainDialog = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FhHook :HHOOK;
    FZoom :integer;
    FMousePos :TPoint;
    procedure CaptureScreen;
    procedure ToggleMouseHook;
  end;

var
  MainDialog: TMainDialog;

implementation

{$R *.dfm}

function MouseHook(nCode :Integer; wParam :WPARAM; lParam :LPARAM) :LRESULT; stdcall;
var
  pt :TPoint;
begin
  with MainDialog do begin
    result := CallNextHookEx(FhHook, nCode, wParam, lParam);
    if wParam = WM_MOUSEMOVE then begin
      pt := PPOINT(lParam)^;
      if WindowFromPoint(pt) <> Handle then begin
        FMousePos := pt;
        CaptureScreen;
      end;
    end;
  end;
end;

procedure TMainDialog.FormCreate(Sender: TObject);
begin
  FZoom := 8;
end;

procedure TMainDialog.FormDestroy(Sender: TObject);
begin
  if FhHook<>0 then
    ToggleMouseHook;
end;

procedure TMainDialog.FormShow(Sender: TObject);
begin
  ToggleMouseHook;
end;

procedure TMainDialog.CaptureScreen;
var
  hScreenDC :THandle;
  sr, dr :TRect;
begin
  dr := ClientRect;
  hScreenDC := GetWindowDC(0);
  try
    with sr do begin
      TopLeft := FMousePos;
      Right := Left + dr.Width div FZoom + 1;
      Bottom := Top + dr.Height div FZoom + 1;
      Offset(-(Width div 2), -(Height div 2));
    end;
    StretchBlt(Canvas.Handle, 0, 0, dr.Width, dr.Height,
      hScreenDC, sr.left, sr.Top, sr.Width, sr.Height, SRCCOPY);
  finally
    ReleaseDC(0, hScreenDC);
  end;
end;

procedure TMainDialog.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Handled := true;
  if FZoom>2 then begin
    FZoom := FZoom div 2;
    if FZoom<2 then FZoom := 2;
    CaptureScreen;
  end;
end;

procedure TMainDialog.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  Handled := true;
  FZoom := FZoom * 2;
  CaptureScreen;
end;

procedure TMainDialog.ToggleMouseHook;
begin
  if FhHook=0 then
    FhHook := SetWindowsHookEx(WH_MOUSE_LL, @MouseHook, hInstance, 0)
  else begin
    UnhookWindowsHookEx(FhHook);
    FhHook := 0;
  end;
end;

end.