XProfan

 {$cleq}
 {$runtime C:\xprofan11\}
 {$compiler C:\xprofan11\}
 {$notmp}
cls
long hPic=create("hNewPic",196,64,$FF)
long hPic2=create("hNewPic",196,64,$FF)
startpaint hPic
usefont "Arial",30,0,1,0,0
textcolor $FFFFFF,-1
drawtext 5,0,"XProfan.Com"
textcolor $AA,-1
drawtext 5,0,"XProfan"
endpaint
startpaint hPic2
usefont "Arial",30,0,1,0,0
textcolor 0,-1
drawtext 5,0,"XProfan.Com"
textcolor $AA,-1
drawtext 5,0,"XProfan"
endpaint
long w,mx,my
mcls 640,480

while 1

    waitinput 10
    startpaint -1
    cls $FF0000
    usepen 0,0,0
    mx=nMouseX()
    my=nMouseY()
    line 320,200,mx,my
    w=angleByLine(320,200,mx,my)
    drawhPicRotated(hpic,hdc,320,200,196,64,w,100+sin(getTickCount/500)*50)
    drawhPicRotated(hpic,hdc,200,100,196,64,w,100+sin(getTickCount/500)*50)
    drawhPicRotatedTransparent(hpic2,hdc,100,100,196,64,w,100+sin(getTickCount/500)*50,0)'
    endpaint
    mcopybmp 0,0 - 640,480 > 0,0;0

wend

end

nProc nMouseX(){ return mouseX }

nProc nMouseY(){ return mouseY }

nProc drawhPicRotated(long hPic,dc,x,y,xx,yy,w,r){

    long hDCBits=createCompatibleDC(hDC)
    selectObject(hDCBits, hPic)
    long pts=dim(24)
    long 	w1=angleByLine(xx,yy,0,0),\
    w2=abs(w1-360000),\
    w3=abs(w1-540000)
    casenot r : r=long(sqrt(float(xx*xx+yy*yy)))\2
    long pts&,0=	x+getcircp(r,w1+w),y+getcircp(r,w1-90000+w),\
    x+getcircp(r,w2+w),y+getcircp(r,w2-90000+w),\
    x+getcircp(r,w3+w),y+getcircp(r,w3-90000+w)
    plgBlt(dc,pts,hDCBits,0,0,xx,yy,0,0,0)
    deleteDC(hDCBits)
    dispose(pts)

}

nProc drawhPicRotatedTransparent(long hPic,dc,x,y,xx,yy,w,r,col){

    long hDCBits=createCompatibleDC(hDC)
    selectObject(hDCBits, hPic)
    long pts=dim(24)
    long 	w1=angleByLine(xx,yy,0,0),\
    w2=abs(w1-360000),\
    w3=abs(w1-540000)
    casenot r : r=long(sqrt(float(xx*xx+yy*yy)))\2
    long r2=r*2
    long pts&,0=	r+getcircp(r,w1+w),r+getcircp(r,w1-90000+w),\
    r+getcircp(r,w2+w),r+getcircp(r,w2-90000+w),\
    r+getcircp(r,w3+w),r+getcircp(r,w3-90000+w)
    long mDC=CreateCompatibleDC(hDC)
    long memBM=CreateCompatibleBitmap(hDC,r2,r2)
    long oldSel=SelectObject(mDC,memBM)
    plgBlt(mDC,pts,hDCBits,0,0,xx,yy,0,0,0)
    selectobject(dc,memBM)
    transparentBlt(dc,x-r,y-r,r2,r2,mDC,0,0,r2,r2,col)
    selectObject(mDC,oldSel)
    deleteObject(memBM)
    deleteDC(mDC)
    deleteDC(hDCBits)
    dispose(pts)

}

nProc getCircP(long r,w){

    return long(sin(0.0174532925199433*float(w)/1000.0)*float(r))

}

nProc angleByLine(long x,y,xx,yy)

    sub y,yy
    sub x,xx

    if x

        xx=int(57295.77951 * arctan(float(y)/float(x)))
        case x>0 : return 270000 + xx
        return 90000 + xx

    endif

    case y<0 : return 180000
    volver 0

ENDPROC