XProfan

 $H Windows.ph
declarar x1!,y1!,dx!,dy!,winkel!,y&,z%,adresse%,adresse1%,adresse2%,texid%,ende%
declarar hWin&,hwin1&,hwin2&,hwin3&
declarar width%,height%,groesse%
declarar bild_auto_h&,bild_umw_h&,bild_hin_h&
declarar bmi#,bildxy# ,ogl_rgb#,bild_hin#
groesse%=128*128*4
dim bildxy#,groesse%
dim ogl_rgb#,groesse%
dim bild_hin#,groesse%
ende%=1
adresse2%=addr(z%)
Ventana 20,20-800,600
Cls @RGB(220,220,220)
hWin& = @Crear(texto, %hWnd, Test1, 10, 10, 128,128)
hWin1& = @Crear(texto, %hWnd, Test2, 250, 20, 500,500)
hWin2& = @Crear(texto, %hWnd, Test3, 10, 150, 128,128)
var hDCWin& = ~GetDC(hWin&)
var hDCWin1& = ~GetDC(hWin1&)
var hDCWin2& = ~GetDC(hWin2&)
ShowWindow(hWin&,1)
oGL(Init, hwin&, 0,0, 0, 0)
oGL(PosMode, 1)
ogl(glReadBuffer,~GL_Back)
bild_auto_h& = Crear(hnewPic,128,128,0 )
var bild_2& = Crear(hnewPic,500,500,0 )
var tex.auto%=erzeugetex(auto.bmp)
var bild_back_h& = Crear(hPic, -1,back.bmp)
startpaint bild_back_h&
drawpic hin.bmp,200,200,0
endpaint
var iDC&=~CreateCompatibleDC(hDCWin1&)
var iBitmap& = ~CreateDIBSection(idc&, bmi#, ~DIB_RGB_COLORS, 0,0,0)
~Seleccionar objeto(iDC&, iBitmap&)
setTimer 20
drawglscene
drawglscene
oglzubmp

WHILE ende%

    WaitInput

    if isKey(87)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!-x1!
        dy!=dy!-y1!
        drawglscene
        oglzubmp()

    endif

    if isKey(83)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!+x1!
        dy!=dy!+y1!
        drawglscene
        oglzubmp()

    endif

    if isKey(81)

        winkel!=winkel!+1.0
        drawglscene
        oglzubmp()

    endif

    if isKey(69)

        winkel!=winkel!-1.0
        drawglscene
        oglzubmp()

    endif

    startpaint bild_2&
    drawpic bild_back_h&,0,0,0
    drawpic bild_auto_h&,100+dx!,100+dy!,-1
    endpaint
    startpaint hwin1&
    drawpic bild_2&,0,0,0
    endpaint
    startpaint hwin2&
    copypic bild_2&,200,200 - 128,128 > 0,0,0
    endpaint
    ~Bitblt(idc&,0,0,128,128,hDCWin1&,200,200,~SRCCOPY)
    ~GetDIBits(hDCWin1&,iBitmap&,0,128,bild_hin#,bmi#,~DIB_RGB_COLORS)
    rgb_farbe()
    StartPaint %hwnd
    DrawText 10,300,(Formato$(######0      ,z%))
    EndPaint

ENDWHILE

killTimer
end

proc oglzubmp

    ogl(glReadPixels,0,0,128,128,~GL_BGRA,~GL_UNSIGNED_BYTE,ogl_rgb#)
    ~setDIBits(%hdc,bild_auto_h&,0,128,ogl_rgb#,bmi#,0)

ENDPROC

proc drawglscene

    OGL(Claro)
    OGL(origin,0,0,-1.11)
    OGL(texture,tex.auto%,1)
    OGL(rotate,0,0,winkel!)
    OGL(quad,0.5,0.5)
    OGL(show)

ENDPROC

proc bitmap_header

    def &BI_RGB 0
    def &DIB_RGB_COLORS 0
    struct BITMAPINFOHEADER =
    biSize&, biWidth&, biHeight&, biPlanes%, biBitCount%, biCompression&,
    biSizeImage&, biXPelsPerMeter&, biYPelsPerMeter&, biClrUsed&, biClrImportant&
    dim bmi#,BITMAPINFOHEADER
    clear bmi#

    with bmi#

        .biSize&        = sizeof(bmi#)
        .biWidth&       = width%
        .biHeight&      = height%
        .biPlanes%      = 1
        .biBitCount%    = 32
        .biCompression& = &BI_RGB
        .biSizeImage&   = ((.biWidth& * .biBitCount%  8 - 1) | 3 + 1) * abs(.biHeight&)

    endwith

ENDPROC

proc erzeugetex

    parámetros namebild$
    texid%=0
    height%=128
    width%=128
    disponer bmi#
    bitmap_header()
    bild_umw_h& = Crear(hPic, -1, namebild$)
    ~GetDIBits(%hdc,bild_umw_h&,0,bmi#.biHeight&,bildxy#,bmi#,0)
    bmptex()
    OGL(glGenTextures,1,ADDR(texid%))
    OGL(glBindTexture,~GL_TEXTURE_2D,texid%)
    OGL(glEnable,~GL_ALPHA_TEST)
    OGL(glAlphaFunc,~GL_GREATER, 0.1)
    OGL(glTexParameteri,~GL_TEXTURE_2D, ~GL_TEXTURE_MAG_FILTER, ~GL_LINEAR)
    OGL(glTexParameteri,~GL_TEXTURE_2D, ~GL_TEXTURE_MIN_FILTER, ~GL_LINEAR)
    OGL(gluBuild2DMipmaps,~GL_TEXTURE_2D, ~GL_RGBA, height%, width%, ~GL_RGBA, ~GL_UNSIGNED_BYTE, bildxy#)
    disponer bildxy#
    RETORNO texid%

ENDPROC

proc bmptex

    adresse%=bildxy#
    P2CPP: <INLINE_CPP>
    long zaehler;
    long wert;
    unsigned char b;
    unsigned char g;
    unsigned char r;
    long adrr;
    wert=PVAR(groesse%);
    adrr=PVAR(adresse%);
    char* bereich = reinterpret_cast<char*>(adrr);
    for(zaehler = 0; zaehler <= wert; zaehler = zaehler + 4)

    {

        b=bereich[zaehler] & 255;
        g=bereich[zaehler+1] & 255;
        r=bereich[zaehler+2] & 255;

        if ((r==0) & (b==0) & (g==0))

            bereich[zaehler+3]=0;

        más

            {

                bereich[zaehler+3]=255;

            }

            bereich[zaehler+2]=b;
            bereich[zaehler]=r;

        }

        P2CPP: </INLINE_CPP>

    ENDPROC

    proc rgb_farbe

        adresse1%=bild_hin#
        adresse2%=addr(z%)
        P2CPP: <INLINE_CPP>
        long zaehler;
        long wert;
        unsigned char b;
        unsigned char g;
        unsigned char r;
        long adrr;
        long adrr1;
        wert=PVAR(groesse%);
        adrr=PVAR(adresse1%);
        char* bereich1 = reinterpret_cast<char*>(adrr);
        adrr1=PVAR(adresse2%);
        long* zz = reinterpret_cast<long*>(adrr1);
        zz[0]=0;
        for(zaehler = 0; zaehler <= wert; zaehler = zaehler + 4)

        {

            b=bereich1[zaehler];
            g=bereich1[zaehler+1];
            r=bereich1[zaehler+2];

            if ((b > 250)|| (g > 250) || (r > 250))

                {

                    zz[0]=255;
                    romper;

                }

            }

            P2CPP: </INLINE_CPP>

        ENDPROC