XProfan

DEF SetCursorPos(2)!"User32","SetCursorPos"
DEF CreateCompatibleBitmap(3) !"GDI32","CreateCompatibleBitmap"
Var Area&=150
Var Zoom&=5
Windowstyle 80
Window 15,15-Area&+4,Area&+18
CLS 0
Declare Area_Pic&,farbe&,Lupe_Pos&

WhileNot iskey(27)

    Waitinput 30
    Area_Pic&=CaptureArea(CursorPos("X1",1)-((Area&/Zoom&)/2),CursorPos("Y1",1)-((Area&/Zoom&)/2),(Area&/Zoom&),(Area&/Zoom&))
    StartPaint Area_Pic&
    Line 0,((Area&/Zoom&)/2) - ((Area&/Zoom&)/2),((Area&/Zoom&)/2)
    Line ((Area&/Zoom&)/2)+1,((Area&/Zoom&)/2) - (Area&/Zoom&),((Area&/Zoom&)/2)
    Line ((Area&/Zoom&)/2),0 - ((Area&/Zoom&)/2),((Area&/Zoom&)/2)
    Line ((Area&/Zoom&)/2),((Area&/Zoom&)/2)+1 - ((Area&/Zoom&)/2),(Area&/Zoom&)
    EndPaint
    DrawSizedPic Area_Pic&, 2, 2 - Area&, Area&; 0
    StartPaint 0
    farbe&=GetPixel(CursorPos("X1",1),CursorPos("Y1",1))
    EndPaint
    Text Color RGB(255,255,255),0
    DrawText 0, Area&+2, Area&, Area&+18, Space$(100),0
    DrawText 0, Area&+2, Area&, Area&+18, "px: "+Str $(CursorPos("X1",1))+", "+Str $(CursorPos("Y1",1)), 0
    DrawText 0, Area&+2, Area&, Area&+18, "#"+Hex$(GetRValue(farbe&))+Hex$(GetGValue(farbe&))+Hex$(GetBValue(farbe&)), 2
    deleteobject Area_Pic&

    If HandleHover()=%hwnd

        Lupe_Pos&=Lupe_Pos&+1
        Case Lupe_Pos&=4 : Lupe_Pos&=0
        Case Lupe_Pos&=0 : SetWindowPos %hwnd=15,15 - Area&+4,Area&+18;-1
        Case Lupe_Pos&=1 : SetWindowPos %hwnd=15,(%MaxY-(Area&+15+18)) - Area&+4,Area&+18;-1
        Case Lupe_Pos&=2 : SetWindowPos %hwnd=(%MaxX-(Area&+15+4)),(%MaxY-(Area&+15+18)) - Area&+4,Area&+18;-1
        Case Lupe_Pos&=3 : SetWindowPos %hwnd=(%MaxX-(Area&+15+4)),15 - Area&+4,Area&+18;-1

    EndIf

    Case (Iskey(37) or Iskey(38) or Iskey(39) or Iskey(40)) : SetCursorPos(CursorPos("X1",1)+IF(Iskey(37),-1,If(Iskey(39),1,0)),CursorPos("Y1",1)+IF(Iskey(38),-1,If(Iskey(40),1,0)))

EndWhile

Proc CaptureArea

    Parameters xpos%,ypos%,maxX!,maxY!
    Var hdc& = External("USER32","GetDC",0)
    Var hmdc& = External("GDI32","CreateCompatibleDC",hdc&)
    Var hbitmap& = CreateCompatibleBitmap(hdc&,maxX!,maxY!)
    External("GDI32","SelectObject",hmdc&, hbitmap&)
    External("GDI32","BitBlt",hmdc&, 0, 0, maxX!, maxY!, hdc&, xpos%, ypos%, $0CC0020)
    hbitmap& = External("GDI32","GetCurrentObject",hmdc&, 7)
    External("GDI32","DeleteDC",hmdc&)
    External("USER32","ReleaseDC","USER32","ReleaseDC")
    Return hbitmap&

ENDPROC

Proc CursorPos

    Parameters mode$, global&, hdl&
    Declare mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Case global&<>1 : External("USER32","ScreenToClient",hdl&,mpos#)
    Case mode$="X1" : Return long(mpos#,0)
    Case mode$="Y1" : Return long(mpos#,4)
    Case mode$="X2" : Return IF(global&=1,%maxx,width(hdl&))-long(mpos#,0)
    Case mode$="Y2" : Return IF(global&=1,%maxy,height(hdl&))-long(mpos#,4)
    Dispose mpos#
    Return 1

ENDPROC

Proc HandleHover

    Declare mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Return External("USER32","WindowFromPoint",long(mpos#,0),long(mpos#,4))
    Dispose mpos#

ENDPROC