XProfan

Declare hWin&,hDlg&,hDCWin&
Declare xy&
dim xy&,16
Long xy&,0 = 30
Long xy&,4 = 30
Long xy&,8 = 100
Long xy&,12 = 100
hWin& = Create("Window", %hWnd, "Test", 10, 10, 500, 500)
Window 510, 10 - 200, 200
grafik_api(hwin&,xy&)
WaitKey
End

nProc grafik_api(Long hwin,xy)

    Long hdcWin,brush,mypen
    hDCWin=GetDC(hWin)
    brush = CreateSolidBrush($00ffff)
    FillRect(hdcwin, xy, brush)
    mypen=CreatePen(PS_SOLID, 1,$0000ff)
    SelectObject( hdcwin, MyPen )
    MoveToEx(hDCWin, 10,10, 0)
    LineTo(hDCWin, 200,200)
    DeleteObject(MyPen)

ENDPROC

declare vordergrpic&
Window 20,20-800,600
Cls RGB(220,220,220)
vordergrpic& = create("hNewPic", 500,500,rgb(255,255,0))
erzeugestern(vordergrpic&)
drawpic vordergrpic&,20,20;0
WaitKey
end

nProc getCircP(long r,w)

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

endproc

nProc erzeugestern(long hPic)

    Long x,y,r,mypen
    long hDCBits=createCompatibleDC(hDC)
    selectObject(hDCBits, hPic)
    mypen=CreatePen(PS_SOLID, 1,$0000ff)
    SelectObject( hDCBits, MyPen )
    r=250

    whileloop 0,360000,1000

        x=getcircp(r,&loop)
        y=getcircp(r,&loop+90000)
        MoveToEx(hDCBits,250,250,0)
        LineTo(hDCBits,250+x,250+y)

    EndWhile

    deleteDC(hDCBits)

endproc

Declare Test% SharedInFbProcs
 {$FBSYNTAX on}
declare dib&,array&,groesse&,hoehe&,ende&,bild&
DEF CreateDIB(2) !"dib","CreateDIB"
DEF FreeDIB(1) !"dib","FreeDIB"
DEF DrawDIB(4) !"dib","DrawDIB"
DEF CloneDIB(1) !"dib","CloneDIB"
dib&=usedll("dib.dll")
fbProc go(ByVal b As Integer, ByVal g as integer)
FOR Test% = 0 TO g-735000 step 3
poke byte,Test%+g,&hFF0000
next Test%

endproc

array&=CreateDIB(700,700)
groesse&=700*700*3
hoehe&=700
Window 20,20-750,800
Cls RGB(255,255,0)
bild&= Long(array&,40)
go(bild&,groesse&)
DrawDIB(%hdc,10,10,array&)
WaitKey
FreeDIB(dib&)
End

fbProc go(ByVal b As Integer, ByVal g As Integer) As Integer export
  Dim Test As Integer
  FOR Test = 0 TO (g-735000) step 3
    poke byte,Test+g,&hFF0000
  next Test
  return 0
endproc