XProfan

Français

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bildschirmlupe programmieren
Lauffähig ab Profan-Version 5.0
PRFellow-Vorlage
Bildschirm-Lupe
Autoren: Thomas Hölzer in Erweiterung eines Programms von Richard Maurukas,
von dem die eigentliche Lupenfunktion stammt.
Von mir stammt die Auswertung der Koordinaten auf dem Desktop,
das Clipping,die Verschiebbarkeit des Fensters bei Linksklick
und die Verringerung der Prozessorauslastung durch den Sleep-Befehl
Def GetCursorPos(1) !USER32,GetCursorPos
Def ScreenToClient(2) !USER32,ScreenToClient
Def CreateEllipticRgn(4) !GDI32,CreateEllipticRgn
Def DeleteObject(1) !GDI32,DeleteObject
Def SetWindowRgn(3) !USER32,SetWindowRgn
Def ReleaseCapture(0) !USER32,ReleaseCapture
Def Sleep(1) !KERNEL32,Sleep
Declare ende%,ausschnitt%,vergroesserung%
Declare pos#,rgn&
Dim pos#,8
Let ausschnitt%=40         der zu vergrößernde Bereich
Let vergroesserung%=5      die Vergrößerung
Windowstyle 120
WindowTitle Bildschirmlupe
Window 200,200 - 200,200
SetTrueColor 1
Let rgn&=CreateEllipticRgn(0,20,200,200)
SetWindowRgn(%hwnd,rgn&,1)
MCLS ausschnitt%,ausschnitt%

WhileNot ende%

    Sleep(20)

    If Equ(%message,$204)

        CreateMenu
        AppendMenu 1,Lupe &beenden
        TrackMenu %mouseX,%mouseY
        Case Menuitem(1): Let ende%=1

    ElseIf Equ(%message,$201)

        Hier wird das Fenster ohne Titelleiste verschoben
        UseCursor 5
        SendMessage(%hwnd,$112,$F012,0)
         $112: WM_SYSCOMMAND
         $F012: Undokumentierter Wert: ist besser als $0F010 (SC_MOVE)
        ReleaseCapture()     funktioniert auch ohne, ist aber besser so
        UseCursor 0

    Else

        GetCursorPos(pos#)
        ScreenToClient(%hwnd,pos#)
        Hier die eigetliche Lupenfunktion von Richard
        CopyBmpToMem Sub(Long(pos#,0),Div(ausschnitt%,2)),
        Sub(Long(pos#,4),Div(Ausschnitt%,2))-ausschnitt%,ausschnitt%>0,0
        MCopySizedBmp 0,0-ausschnitt%,ausschnitt% > 0,0-
        Mul(ausschnitt%,vergroesserung%),
        Mul(ausschnitt%,vergroesserung%);0

    EndIf

Wend

End
SetWindowRgn(%hwnd,0,0)
DeleteObject(rgn&)
'./../../function-references/XProfan/dispose/'>Dispose pos#