XProfan

 {$cleq}
 $H Windows.ph
declare regionsmem#,regionscnt&
declare oreg&,msg&
decimals 0
dim regionsmem#,(4*256)// 256 regions handle mem
regionscnt&:=0
windowstyle ( 512 | 8 )
cls
loadbmp "tisch.bmp",0,0;0
setinnerhwndsize %bmpx,%bmpy
/* DemoRegions für Tisch.Bmp mit der prozedur clickregion2clipboard erstellt (aufwand 2 minuten) */
pushregion declareregion(211,107,300,104,310,198,220,211,196,151,203,121)
pushregion declareregion(231,210,329,199,346,217,243,227)
pushregion declareregion(68,224,167,225,158,243,165,300,65,303)
pushregion declareregion(104,177,159,176,157,221,102,222)
pushregion declareregion(429,72,451,72,451,169,429,169)
pushregion declareregion(452,71,475,73,478,170,457,168)
pushregion declareregion(479,112,487,112,496,169,478,169)
pushregion declareregion(517,146,581,145,590,169,526,168)
pushregion declareregion(622,105,697,106,754,117,727,131,652,132)
pushregion declareregion(365,209,379,214,375,222,364,224,358,220,357,213)
/* EO:DemoRegions Ende */
//displayregions 	 aktiviere dies um die regionen sichtbar zu machen
//clickregion2clipboard  aktiviere dies um per "einfaches klicken auf das bild" die regionserstellung in die zwischenablage zu kopieren.

Whilenot (msg&==16)

    dispcheckedregion
    getmessage
    msg&:=%message

wend

clearregions
dispose regionsmem#
end

proc dispcheckedregion

    declare h&,mk&
    mk&:=if(msg&=513,1,0)// is leftmousekeydown?
    h&:=checkregions()
    //settext %hwnd,str$(h&)

    if h&

        if (oreg&<>h&)

            loadbmp "tisch.bmp",0,0;0
            ~SelectObject(%hdc,long(regionsmem#,(h&-1)*4))
            cls rgb(255,0,0)
            oreg&:=h&

        endif

        case mk& : messagebox "Region: "+str$(h&)+" angeklickt.","",0

    else

        case oreg& : loadbmp "tisch.bmp",0,0;0
        oreg&:=0

    endif

endproc

proc checkregions

    declare i&,rn&,mx&,my&
    casenot regionscnt& : return 0
    rn&:=0
    mx&:=%mousex
    my&:=%mousey
    for i&:=1 to regionscnt& do begin

    if (~PtInRegion(long(regionsmem#,(i&-1)*4),mx&,my&))

        rn&:=i&
        break

    endif

    end
    return rn&

endproc

proc displayregions

    declare i&
    casenot regionscnt& : return
    for i&:=1 to regionscnt& do begin
    ~SelectObject(%hdc,long(regionsmem#,(i&-1)*4))
    cls rgb(255,0,0)
    end

endproc

proc pushregion

    parameters rhdl&
    long regionsmem#,regionscnt&*4=rhdl&
    regionscnt&+

endproc

proc clearregions

    declare i&
    casenot regionscnt& : return
    for i&:=1 to regionscnt& do begin
    ~deleteobject(long(regionsmem#,(i&-1)*4))
    end
    clear regionsmem#
    regionscnt&:=0

endproc

proc declareregion

    parameters 	x1&,y1&,
    x2&,y2&,
    x3&,y3&,
    x4&,y4&,
    x5&,y5&,
    x6&,y6&
    declare ptcnt&,ptmem#,rhdl&

    proc setpt

        parameters x&,y&,n&
        n&:=(n&-1)*8
        long ptmem#,n&=x&
        n&:=n&+4
        long ptmem#,n&=y&

    endproc

    ptcnt&:=(%pcount/2)
    dim ptmem#,(ptcnt&*8)
    case (ptcnt&>0) : setpt x1&,y1&,1
    case (ptcnt&>1) : setpt x2&,y2&,2
    case (ptcnt&>2) : setpt x3&,y3&,3
    case (ptcnt&>3) : setpt x4&,y4&,4
    case (ptcnt&>4) : setpt x5&,y5&,5
    case (ptcnt&>5) : setpt x6&,y6&,6
    rhdl& = ~CreatePolygonRgn(ptmem#,ptcnt&,1)
    dispose ptmem#
    return rhdl&

endproc

proc setinnerhwndsize

    parameters x%,y%
    setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-y%));0

endproc

proc clickregion2clipboard

    declare s$,mx&,my&,cred&,c&
    c&:=0
    cred&:=rgb(255,0,0)

    whilenot (%key==2)

        waitinput

        if (%mousepressed==1)

            c&+
            mx&:=%mousex
            my&:=%mousey
            s$:=s$+if(len(s$),",","")+str$(mx&)+","+str$(my&)
            setpixel mx&,my&,cred&
            setpixel mx&+1,my&,cred&
            setpixel mx&,my&+1,cred&
            setpixel mx&+1,my&+1,cred&
            clearclip
            putclip "pushregion declareregion("+s$+")"
            case (c&==6) : end

        endif

    wend

    end

endproc