Pixelpeeker - Bildschirmlupe für Windows 7
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.