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.