Author Topic: 3D Object Editor: Start (Read 5850 times)

Petr · « **on:** July 10, 2019, 06:02:11 pm »

Hi. This is my first 3D object editor, this time from 2D to 3D editor. It is maximal easy, i will develop it in this days. As next step i will add next windows with next view (from left, from right, from bottom, from above, and from back). Thanks to today discussion with SierraKen finally, after a long time, it turned on in my head and finally I think I know how to do this object editor. This is the first version, the foundation. I'll add higher versions here as I develop them. Of course, I will also choose textures. If you want to make a cube easily in space, run the program. There is a yellow rectangle in the center of the grid. This is the center of rotation (currently immobile). Create three points and click to make a triangle. Then roll back to two vertices and click again to mark them. Click the fourth peak to draw a square created from two triangles. So. See how far apart the vertices in a square (described as OpenGL coordinates on the screen).
Press ESC. Because this is the first version, it does not offer a graphical environment of depth, but it will ask you. If you have vertices of a square that is 0.6, enter a depth of -5, -5.6, for example. This will result in a symmetrical body. Press enter. If you did everything right, a red cube rotates on your monitor. I think it might be interesting, so I'm releasing the early version. Look at the attachment I created :-D

Code: QB64: [Select]

 
SCREEN _NEWIMAGE(1024, 768, 32)
FOR x = 0 TO 1023 STEP 16
    FOR y = 0 TO 767 STEP 16
        LINE (x, y)-(x + 15, y + 15), &H88FFFFFF, B
NEXT y, x
'middle point
FOR x = 0 TO 1023 STEP 16
    LINE (x, 768 / 2)-(x + 15, (768 / 2) + 15), &H77FFFF00, B
NEXT
 
FOR y = 0 TO 767 STEP 16
    LINE (512, y)-(527, y + 15), &H77FFFF00, B
NEXT
LINE (512, 384)-(528, 398), &HFFFFFF00, BF
 
TYPE P2D
    X AS INTEGER
    Y AS INTEGER
    X3D AS SINGLE
    Y3D AS SINGLE
END TYPE
 
REDIM SHARED V(1) AS P2D, ua
 
 
DO
    WHILE _MOUSEINPUT: WEND
    'grid coordinates:
    Xg = -1 + _CEIL(_MOUSEX / 16)
    Yg = -1 + _CEIL(_MOUSEY / 16)
 
    PrvkuX = 1024 / 16
    PrvkuY = 768 / 16
 
    X3D = (-PrvkuX / 2 + Xg) / 10
    Y3D = (PrvkuY / 2 - Yg) / 10
 
    IF _MOUSEBUTTON(1) THEN
        u = UBOUND(V)
 
 
        LINE (Xg * 16, Yg * 16)-(Xg * 16 + 15, Yg * 16 + 15), &H55FF0000, BF
 
        V(u).X3D = X3D
        V(u).Y3D = Y3D
        V(u).X = Xg * 16
        V(u).Y = Yg * 16
        Reset_Mouse
        IF u MOD 3 = 0 THEN DrawContent
        u = u + 1
        REDIM _PRESERVE V(u) AS P2D
    END IF
 
 
    LOCATE 1
    PRINT "OpenGL coordinates: "; X3D, Y3D
    PRINT "Grid 2D coordinates:"; Xg, Yg
 
 
LOOP UNTIL INKEY$ = CHR$(27)
 
IF UBOUND(v) >= 3 THEN
    INPUT "Input Foreground Depth, Background Depth. Muss be both negative, otherwise is behind the monitor (unvisible):"; z0!, z1!
    PRINT "Ok. Wait, creating 3D..."
    SLEEP 1
    CLS , &H00000000
    '    _DISPLAYORDER _HARDWARE
    H& = DoTexture
    DO
        Do3D z0!, z1!, H&
        _DISPLAY
        in$ = INKEY$
        ua = ua + .1
        _LIMIT 20
    LOOP UNTIL in$ = CHR$(27)
 
ELSE
    PRINT "Not enought coordinates. 3D can not be created.": SLEEP 3: END
END IF
 
 
 
SUB Do3D (sZ1 AS SINGLE, sZ2 AS SINGLE, H&)
 
 
 
    FOR C = 1 TO UBOUND(v) - 1 STEP 3
        x1o = V(C).X3D
        y1 = V(C).Y3D
        z1o = sZ1
 
        x2o = V(C + 1).X3D
        y2 = V(C + 1).Y3D
        z2o = sZ1
 
        x3o = V(C + 2).X3D
        y3 = V(C + 2).Y3D
        z3o = sZ1
 
        x4o = V(C).X3D
        y4 = V(C).Y3D
        z4o = sZ2
 
        x5o = V(C + 1).X3D
        y5 = V(C + 1).Y3D
        z5o = sZ2
 
        x6o = V(C + 2).X3D
        y6 = V(C + 2).Y3D
        z6o = sZ2
 
 
 
 
        'pokus o otocku XZ
        CZ = (sZ1 + sZ2) / 2
 
 
        R1 = SQR(x1o ^ 2 + (CZ - z1o) ^ 2)
        R2 = SQR(x2o ^ 2 + (CZ - z2o) ^ 2)
        R3 = SQR(x3o ^ 2 + (CZ - z3o) ^ 2)
        R4 = SQR(x4o ^ 2 + (CZ - z4o) ^ 2)
        R5 = SQR(x5o ^ 2 + (CZ - z5o) ^ 2)
        R6 = SQR(x6o ^ 2 + (CZ - z6o) ^ 2)
 
        pi1 = JK(0.01, (sZ1 + sZ2) / 2, x1o, z1o, R1)
        pi2 = JK(0.01, (sZ1 + sZ2) / 2, x2o, z2o, R2)
        pi3 = JK(0.01, (sZ1 + sZ2) / 2, x3o, z3o, R3)
        pi4 = JK(0.01, (sZ1 + sZ2) / 2, x4o, z4o, R4)
        pi5 = JK(0.01, (sZ1 + sZ2) / 2, x5o, z5o, R5)
        pi6 = JK(0.01, (sZ1 + sZ2) / 2, x6o, z6o, R6)
 
        x1 = SIN(ua + pi1) * R1
        z1 = CZ + COS(ua + pi1) * R1
 
        x2 = SIN(ua + pi2) * R2
        z2 = CZ + COS(ua + pi2) * R2
 
        x3 = SIN(ua + pi3) * R3
        z3 = CZ + COS(ua + pi3) * R3
 
        x4 = SIN(ua + pi4) * R4
        z4 = CZ + COS(ua + pi4) * R4
 
        x5 = SIN(ua + pi5) * R5
        z5 = CZ + COS(ua + pi5) * R5
 
        x6 = SIN(ua + pi6) * R6
        z6 = CZ + COS(ua + pi6) * R6
 
        '  PRINT z1; z2, z3, z4; z5; z6: SLEEP
        'this is universal 3D draw SUB, in real programs muss be textured just what is really needed.                 6
        W = 99: H = 99 'texture width and height                                                                      / \
        '                                                                                                           / I   \
        'predek   foreground                                                                                      /   I     \
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3) '                        /     I      /3
        'zadek    back                                                                                    Z2  /       I    /  I
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x4, y4, z4)-(x5, y5, z5)-(x6, y6, z6) '                    /         I  /    I
        'levy bok    left side                                                                            /           I/      I
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x1, y1, z1)-(x4, y4, z4)-(x3, y3, z3) '                /            /I       I
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x4, y4, z4)-(x3, y3, z3)-(x6, y6, z6) '              /            /  I       I
        'dno         bottom                                                                         /            /    I       I
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x4, y4, z4)-(x5, y5, z5)-(x1, y1, z1) '            4\----------+------5      I
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x5, y5, z5)-(x1, y1, z1)-(x2, y2, z2) '               \     /           \    I
        'pravy bok   right side                                                                          \ /                \ I
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x5, y5, z5)-(x6, y6, z6)-(x2, y2, z2) '                  1-------------------2
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), H& TO(x5, y5, z5)-(x2, y2, z2)-(x3, y3, z3) '                           Z1
    NEXT C
END SUB
 
 
SUB DrawContent
    U = UBOUND(V) - 2
 
    LINE (V(U).X + 8, V(U).Y + 8)-(V(U + 1).X + 8, V(U + 1).Y + 8), &HFFFFFFFF
    LINE (V(U + 1).X + 8, V(U + 1).Y + 8)-(V(U + 2).X + 8, V(U + 2).Y + 8), &HFFFFFFFF
    LINE (V(U).X + 8, V(U).Y + 8)-(V(U + 2).X + 8, V(U + 2).Y + 8), &HFFFFFFFF
 
END SUB
 
SUB Reset_Mouse
    DO UNTIL _MOUSEBUTTON(1) = 0
        WHILE _MOUSEINPUT: WEND
    LOOP
END SUB
 
FUNCTION DoTexture&
    a = _DEST
    dt& = _NEWIMAGE(100, 100, 32)
    _DEST dt&
    CLS , &H99FF0000
    '    FOR f = 0 TO 4
    '    LINE (f, f)-(95 + f, 95 + f), &HFFFFFFFF, B
    '    LINE (95 + f, 95 + f)-(f, 99)
    '    NEXT f
    DoTexture& = _COPYIMAGE(dt&, 33)
    _DEST a
    _FREEIMAGE dt&
 
END FUNCTION
 
 
FUNCTION JK! (cx, cy, px, py, R!)
    '  podle definice jednotkove kruznice musim nejprve hodnoty prevest na rozsah od -1 do 1 pro x i pro y.
    '  R urcuje velikost kruznice, cili jR bude 1/R
    LenX! = cx - px
    LenY! = cy - py
    jR! = 1 / R!
 
    jX! = LenX! * jR!
    jY! = LenY! * jR!
 
    sinusAlfa! = jX!
    Alfa! = ABS(_ASIN(sinusAlfa!))
 
    Q = 1
    IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
    IF px >= cx AND py <= cy THEN Q = 2
    IF px <= cx AND py <= cy THEN Q = 3
    IF px <= cx AND py >= cy THEN Q = 4
    SELECT CASE Q
        CASE 1: alfaB! = Alfa!
        CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
        CASE 3: alfaB! = _PI + Alfa!
        CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
    END SELECT
    JK! = alfaB!
    IF JK! = 0 THEN BEEP
END FUNCTION
 

TempodiBasic · « **Reply #1 on:** July 10, 2019, 06:52:12 pm »

Cool!
Very very interesting!
Thanks to share it

Petr · « **Reply #2 on:** July 13, 2019, 05:35:03 am »

Hi. I'm do this hard, thank you Tempo. The windows are four. X / Z, X / Y, and Y / Z, and one with a 3D preview (although the program is intended for _MAPTRIANGLE 3D, the fourth window will be drawn using OpenGL using the OpenGL screen conversion function to the Software screen by Ashish).

To imagine - how do you paint something to 2 axis, when you have only a 2D monitor and X, Y coordinates on it? You simply move this X / Y at depth (in the array) to depth 2. Then draw a different shape at the same X / Y coordinates at another depth, lets say 5. You connect it and you have the front and back of the 3D body. The Same principle for left / right side (X / Z), where you move this style Y and for top / bottom where you move X in depth. So it will work. Upgrade 1 will be released right after the grid application. Here is preview, all window are full movable. I start program logic to do.

Petr · « **Reply #3 on:** July 13, 2019, 03:54:27 pm »

Hi guys. Today is really successful. Electronics in my monitor is before death, so I have the whole image in yellow and now waiting for a new monitor. And the following problem. This source code knows why it behaves differently every time you run it. I tried to find the cause, I didn't find it. The thing is that the top two windows and the bottom left window should have a grid when you start. 5 times I start it, 4 times the grid is there and then suddenly there is not. Or is in two windows, but the third window is blank. All windows and all grids do the same SUB. Every advice would really help me a lot. Thank you.

Code: QB64: [Select]

 
_TITLE "3D Object editor V 0.1 Alfa"
TYPE V '                informace v mrizce
    X AS SINGLE '      OpenGL souradnice obsazeneho bodu v X                                                      not used, will be used later
    Y AS SINGLE '      OpenGL souradnice obsazeneho bodu v Y
    Z AS SINGLE '      OpenGL souradnice obsazeneho bodu v Z
END TYPE
 
TYPE Triangle ' Souhrn o bodech z pole Grid - proste body ty a ty tvori tento trojuhelnik s touto texturou        not used, will be used later
    TriangleS AS LONG 'odkud v poli V jsou vrcholy tohoto trojuhelnika
    TriangleE AS LONG ' kam v poli V jsou vrcholy tohoto trojuhelnika
    Texture AS LONG 'cislo textury z pole textur pro tento trojuhelnik
END TYPE
 
TYPE texture
    name AS STRING '                                                                                               not used
END TYPE
 
 
TYPE W 'pro okna                                                                                                'used for program windows
    X1 AS INTEGER '
    Y1 AS INTEGER '
    X2 AS INTEGER '
    Y2 AS INTEGER '                                                                                              current window position X1,Y1,X2,Y2
    oX1 AS INTEGER
    oY1 AS INTEGER
    oX2 AS INTEGER
    oY2 AS INTEGER '                                                                                             previous window position oX1, oY1, oX2, oY2
    Status AS _BYTE '                                                                                            0 = standarnd, somewhere on the screen, -1 = closed, 1 = minimized, 2 = maximalized
    WName AS STRING '                                                                                            window name
    GActive AS INTEGER
    GXs AS INTEGER
    GXe AS INTEGER '
    GYs AS INTEGER '                                                                                             GXs, GYs, GXe, GYe = Grid X Start, Grid Y Start, Grid X end.... for grid
    GYe AS INTEGER '
    Gc AS _UNSIGNED LONG '                                                                                       Grid foreground color
    GBc AS _UNSIGNED LONG '                                                                                      Grid background color
    Gsize AS INTEGER '                                                                                           Grid size
    Draw_Pos AS _BYTE '                                                                            .
END TYPE
REDIM SHARED W(0) AS W '
REDIM SHARED W2(0) AS LONG '                                                                                     'Contains records number from array W (for windows) and set foreground window. Foreground window is always ubound W2.
DIM SHARED Arr3D(100, 100, 100) AS SINGLE, ScreenBackGroundColor AS _UNSIGNED LONG, IconBack AS LONG
DIM SHARED ICOLeft, ICORight, ICOUp, ICODn, ICOClose, ICOMaximize, ICOMinimize, ICOSetup
 
IconBack = IconBackground
 
 
ScreenBackGroundColor = &HFF55AA99
CONST GridSizeX = 100 'later this all constants will be optional
CONST GridSizeY = 100
CONST GridSizeZ = 100
CONST GridSize = 60
 
 
 
W = _DESKTOPWIDTH
H = _DESKTOPHEIGHT
SCREEN _NEWIMAGE(W, H, 32)
CLS , ScreenBackGroundColor~&
wdth = _DESKTOPWIDTH / 2
hght = _DESKTOPHEIGHT / 2
 
 
 
 
W1 = Init_Window("Front View XY", 1, 71, wdth - 1, hght - 1, &HFFFFFFFF, &HFF888888, GridSize, 0)
W2 = Init_Window("Side View XZ", wdth + 1, 71, wdth * 2 - 1, hght, &HFF00FFFF, &HFF999999, GridSize, 0)
W3 = Init_Window("Bottom View YZ", 1, hght + 1, wdth, hght * 2 - 1, &HFFFFFFFF, &HFF7A7A7A, GridSize, 0)
W4 = Init_Window("3D Preview window", wdth + 1, hght + 1, wdth * 2 - 1, hght * 2 - 1, &HFF00CCFF, &HFF808080, GridSize, 0)
 
 
LoadIcons 'my old program - editor.bm file
_DELAY .5
gte = 0
DO
    WHILE _MOUSEINPUT: WEND
    _MOUSESHOW "default"
    Draw_Window W1
    Draw_Window W2
    Draw_Window W3
    Draw_Window W4
 
 
    _DISPLAY
    _LIMIT 20
LOOP
 
 
 
 
SUB Grid (R AS INTEGER) 'i think, somewhere in this sub is bug, but i see it not.
 
    X1 = W(R).X1
    Y1 = W(R).Y1
    X2 = W(R).X2
    Y2 = W(R).Y2
 
    'vlozi ovladaci prvky okna
    _PUTIMAGE (X2 - 25, Y1 + 4), ICOClose
    _PUTIMAGE (X2 - 42, Y1 + 4), ICOMaximize
    _PUTIMAGE (X2 - 59, Y1 + 4), ICOMinimize
 
 
    _PUTIMAGE (X2 - 20, Y2 - 20), ICORight
    _PUTIMAGE (X1 + 5, Y2 - 20), ICOLeft
    _PUTIMAGE (X2 - 20, Y1 + 24), ICOUp
    _PUTIMAGE (X2 - 20, Y2 - 37), ICODn
 
    LINE (X1 + 20, Y2 - 19)-(X2 - 20, Y2 - 7), &HFF88F888, B 'X rectangle
    LINE (X2 - 19, Y1 + 40)-(X2 - 7, Y2 - 38), &HFF88F888, B 'Y rectangle
 
    MX = _MOUSEX: MY = _MOUSEY: MB1 = _MOUSEBUTTON(1)
 
 
 
    FOR U = LBOUND(w) TO UBOUND(w)
        IF MB1 THEN
            IF MX >= W(U).X1 AND MX <= W(U).X2 AND MY >= W(U).Y1 AND MY <= W(U).Y2 THEN 'if user is in some window area and click, set it as active. Window shift is possible by clicking and moving window header.
                IF UBOUND(w2) = U THEN EXIT FOR '
                Set_Active_Window U
                EXIT FOR
            END IF
        END IF
    NEXT U
 
    IF MX < X2 AND MX > X2 - 70 THEN
        IF MY >= Y1 AND MY <= Y1 + 19 THEN
            SELECT CASE MX
                CASE X2 - 25 TO X2 - 10
                    LINE (X2 - 10, Y1 + 4)-(X2 - 25, Y1 + 19), &H99FF0000, BF 'icon CLOSE
                    IF MB1 THEN
                        W(R).Status = -1 '                                     minimalize
                        LINE (X1, Y1)-(X2, Y2), ScreenBackGroundColor, BF
                    END IF
 
 
                CASE X2 - 59 TO X2 - 44
                    LINE (X2 - 59, Y1 + 4)-(X2 - 44, Y1 + 19), &H99FF0000, BF 'maximalize
                    IF MB1 THEN
                        IF W(R).Status = 0 THEN
                            W(R).oX1 = X1
                            W(R).oY1 = Y1
                            W(R).oX2 = X2
                            W(R).oY2 = Y2
 
                            W(R).X1 = R * 70
                            W(R).X2 = W(R).X1 + 70
                            W(R).Y2 = _DESKTOPHEIGHT
                            W(R).Y1 = _DESKTOPHEIGHT - 70
                            W(R).Status = 1
 
                            Set_Active_Window R
                            Reset_Mouse
                            GOTO eif
                        END IF
 
                        IF W(R).Status = 2 THEN 'return previous state
                            W(R).X1 = W(R).oX1
                            W(R).Y1 = W(R).oY1
                            W(R).X2 = W(R).oX2
                            W(R).Y2 = W(R).oY2
                            W(R).Status = 0
 
                            X1 = W(R).oX1
                            Y1 = W(R).oY1
                            X2 = W(R).oX2
                            Y2 = W(R).oY2
 
                            Set_Active_Window R
                        END IF
                        eif:
                        LINE (0, 71)-(_DESKTOPWIDTH, _DESKTOPHEIGHT), ScreenBackGroundColor, BF
                    END IF
 
 
                CASE X2 - 41 TO X2 - 27
                    LINE (X2 - 41, Y1 + 4)-(X2 - 27, Y1 + 19), &H99FF0000, BF 'icon minimalize
                    IF MB1 THEN
                        LINE (X1, Y1)-(X2, Y2), ScreenBackGroundColor, BF
                        IF W(R).Status = 1 THEN '        return previous state from minimalize
                            W(R).X1 = W(R).oX1
                            W(R).Y1 = W(R).oY1
                            W(R).X2 = W(R).oX2
                            W(R).Y2 = W(R).oY2
                            W(R).Status = 0
                            X1 = W(R).oX1
                            Y1 = W(R).oY1
                            X2 = W(R).oX2
                            Y2 = W(R).oY2
 
                            Set_Active_Window R
                            GOTO eif2
                        END IF
 
 
 
                        IF W(R).Status = 0 THEN 'Maximalize. First write current coordinates.
                            W(R).oX1 = X1
                            W(R).oY1 = Y1
                            W(R).oX2 = X2
                            W(R).oY2 = Y2
 
                            W(R).X1 = 3
                            W(R).X2 = _DESKTOPWIDTH - 3
                            W(R).Y2 = _DESKTOPHEIGHT - 5
                            W(R).Y1 = 71
                            W(R).Status = 2
                            Set_Active_Window R
                        END IF
                        eif2:
                    END IF
            END SELECT
        END IF
    END IF
 
    'DRAW GRID IN WINDOWS
 
    'Load previous grid coordinates (on grid positions)
 
    MrY1 = W(R).GYs
    MrY2 = W(R).GYe
    MrX1 = W(R).GXs '                                   Positions on grid
    MrX2 = W(R).GXe
 
    'arrow up in windows
    IF MX >= X2 - 19 AND MX <= X2 - 7 THEN
        IF MY >= Y1 + 26 AND MY <= Y1 + 38 THEN
            LINE (X2 - 19, Y1 + 26)-(X2 - 7, Y1 + 38), &H33FF0000, BF
            IF MB1 THEN MrY1 = MrY1 - 1
        END IF
    END IF
 
    'rrow down in windows
    IF MX >= X2 - 19 AND MX <= X2 - 7 THEN
        IF MY >= Y2 - 38 AND MY <= Y2 - 26 THEN
            LINE (X2 - 19, Y2 - 26)-(X2 - 7, Y2 - 38), &H33FF0000, BF
            IF MB1 THEN MrY1 = MrY1 + 1
        END IF
    END IF
 
    'arrow left
    IF MX >= X1 + 6 AND MX <= X1 + 18 THEN
        IF MY >= Y2 - 20 AND MY <= Y2 - 5 THEN
            LINE (X1 + 18, Y2 - 20)-(X1 + 6, Y2 - 5), &H33FF0000, BF
            IF MB1 THEN MrX1 = MrX1 - 1
        END IF
    END IF
 
    'arrow right
    IF MX >= X2 - 18 AND MX <= X2 - 6 THEN
        IF MY >= Y2 - 20 AND MY <= Y2 - 5 THEN
            LINE (X2 - 18, Y2 - 20)-(X2 - 6, Y2 - 5), &H33FF0000, BF
            IF MB1 THEN MrX1 = MrX1 + 1
        END IF
    END IF
    'if is here inserted: PRINT R: _DISPLAY: SLEEP, problem not occur. WHY?
 
 
 
    IF R <= 2 THEN '                                I need view grid in window nr. 0,1,2. Window 3 use none grid. It is window for future OpenGL view.
        rrr = rrr + 1
        IF W(R).Status = 0 OR W(R).Status = 2 THEN
 
 
            GX1 = X1 + 10 '                        reset start coordinates for grid. It is different, if is window minimized or use other width, height, or is maximalized.
            GY1 = Y1 + 28 '                        this are relative coordinates.
            GX2 = X2 - 25 '
            GY2 = Y2 - 23 '
            Gsize = W(R).Gsize
 
 
            DO UNTIL (GX2 - GX1) MOD Gsize = 0 'reset grid size to value best for use in window for full fill.
                Gsize = Gsize - 1
            LOOP
 
 
            'Every window show one piece in space (currently all show just X/Y)
            MinX = 0: MinY = 0: MinZ = 0
            SELECT CASE R
                CASE 0: MaxX = GridSizeX: MaxY = GridSizeY: Z = CurrentZ 'View XY
                CASE 1: MaxX = GridSizeX: MaxY = GridSizeZ: Z = CurrentY 'View YZ
                CASE 2: MaxX = GridSizeY: MaxY = GridSizeZ: Z = CurrentX 'View XZ
            END SELECT '               y                               x
 
 
            'MrX1 and MrY1 are field coordinates, not graphical!
 
 
            IF MrX1 < MinX THEN MrX1 = MinX 'LBOUND Overflow prevent
            IF MrY1 < MinY THEN MrY1 = MinY
 
            'claculate how much points can be viewed
            Xd = INT((GX2 - GX1 - Gsize) / Gsize)
            Yd = INT((GY2 - GY1 - Gsize) / Gsize)
 
            MrX2 = MrX1 + Xd
            MrY2 = MrY1 + Yd
 
 
            IF MrX2 > MaxX THEN MrX2 = MaxX 'UBOUND Overflow prevent
            IF MrY2 > MaxY THEN MrY2 = MaxY
 
 
            Z = 2 'Alpha test - set X, Y to Z = 2
            Arr3D(5, 7, 2) = 1
 
 
            FOR DrawGridY = MrY1 TO MrY2
                FOR DrawGridX = MrX1 TO MrX2
                    ArrayX = DrawGridX
                    ArrayY = DrawGridY
                    IF Arr3D(ArrayX, ArrayY, Z) = 0 THEN
                        LINE (GX1 + (Gsize * DrawGridX) - (Gsize * MrX1), GY1 + (Gsize * DrawGridY) - (Gsize * MrY1))-(GX1 + (DrawGridX * Gsize) + Gsize - 1 - (Gsize * MrX1), GY1 + (DrawGridY * Gsize) + Gsize - 1 - (Gsize * MrY1)), W(R).Gc, B
                    ELSE
                        LINE (GX1 + (Gsize * DrawGridX) - (Gsize * MrX1), GY1 + (Gsize * DrawGridY) - (Gsize * MrY1))-(GX1 + (DrawGridX * Gsize) + Gsize - 1 - (Gsize * MrX1), GY1 + (DrawGridY * Gsize) + Gsize - 1 - (Gsize * MrY1)), &HFFFF0000, BF
                    END IF
                NEXT
            NEXT
        END IF
 
 
 
 
    END IF
 
 
    'save grid positions to field
    W(R).GYs = MrY1
    W(R).GYe = MrY2
    W(R).GXs = MrX1
    W(R).GXe = MrX2
 
 
 
 
    PCOPY _DISPLAY, 10
 
    'pokracovat ovladanim a plnenim + kresbou mrizky
 
 
 
 
 
 
END SUB
 
SUB Set_Active_Window (window_nr AS INTEGER)
    ii = 0
    IF W2(UBOUND(w2) - 1) <> window_nr THEN
        DO UNTIL W2(ii) = window_nr
            ii = ii + 1
        LOOP
        SWAP W2(UBOUND(w2) - 1), W2(ii)
    END IF
END SUB
 
SUB Reset_Mouse
    DO UNTIL _MOUSEBUTTON(1) = 0
        WHILE _MOUSEINPUT: WEND
    LOOP
END SUB
 
FUNCTION Init_Window (Wname AS STRING, X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, GridColor AS _UNSIGNED LONG, BackgroundColor AS _UNSIGNED LONG, Size AS _BYTE, Status AS _BYTE) 'pri initu je mrizka na pocatku.
    I = UBOUND(W)
    W(I).X1 = X1: W(I).Y1 = Y1: W(I).X2 = X2: W(I).Y2 = Y2: W(I).Status = Status: W(I).Gc = GridColor: W(I).GBc = BackgroundColor: W(I).WName = Wname: W(I).Gsize = Size: W(I).GXe = GridSizeX: W(I).GYe = GridSizeY
    W2(I) = I
    REDIM _PRESERVE W(I + 1) AS W
    REDIM _PRESERVE W2(I + 1) AS LONG
    Init_Window = I
END FUNCTION
 
 
 
SUB Draw_Window (Window_NR AS LONG)
    X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2: BackGroundColor~& = W(Window_NR).GBc: Wname$ = W(Window_NR).WName
    Size = W(Window_NR).Gsize: GridColor~& = W(Window_NR).Gc
 
 
 
 
    IF _MOUSEX >= X1 AND _MOUSEX <= X2 - 70 AND W(Window_NR).Status > -1 THEN 'omezeni kvuli ikonam ovladani okna
        IF _MOUSEY >= Y1 AND _MOUSEY <= Y1 + 19 THEN
            ' IF UBOUND(w2) - 1 = Window_NR THEN
            IF Window_NR = W2(UBOUND(w2) - 1) THEN _MOUSESHOW "link"
            IF _MOUSEBUTTON(1) THEN
 
                IF Window_NR = W2(UBOUND(w2) - 1) THEN
                    ox1 = X1: ox2 = X2: oy1 = Y1: oy2 = Y2
 
 
 
                    PCOPY _DISPLAY, 10
                    DO UNTIL _MOUSEBUTTON(1) = 0
                        DO WHILE _MOUSEINPUT: LOOP
                        MMX = MOUSEMOVEMENTX * 3
                        MMY = MOUSEMOVEMENTY * 3
 
 
                        PCOPY 10, _DISPLAY
                        ooX1 = X1
                        X1 = X1 + MMX
                        ooy1 = Y1
                        Y1 = Y1 + MMY
                        X2 = X2 + MMX
                        ooy2 = Y2
                        Y2 = Y2 + MMY
 
 
                        IF Y1 < 70 THEN Y1 = 70: Y2 = ooy2
                        IF Y1 > _DESKTOPHEIGHT - 70 THEN Y1 = _DESKTOPHEIGHT - 70: Y2 = ooy2
                        IF X2 < 70 THEN X2 = 70
                        IF X1 > _DESKTOPWIDTH - 70 THEN X1 = _DESKTOPWIDTH - 70
                        '------------------------------------------
 
                        LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                        _DISPLAY
                    LOOP
 
                    PCOPY 10, _DISPLAY
                END IF
 
                FOR r = LBOUND(W) TO UBOUND(W)
                    W(r).Draw_Pos = 0
                NEXT r
                W(Window_NR).Draw_Pos = 1
 
                W(Window_NR).X1 = X1: W(Window_NR).X2 = X2
                W(Window_NR).Y1 = Y1: W(Window_NR).Y2 = Y2
 
                IF W2(UBOUND(w2) - 1) <> Window_NR THEN
                    DO UNTIL W2(ii) = Window_NR
                        ii = ii + 1
                    LOOP
                    SWAP W2(UBOUND(w2) - 1), W2(ii)
                END IF
 
 
                LINE (ox1, oy1)-(ox2, oy2), ScreenBackGroundColor~&, BF 'premaze cernou barvou puvodni pozici okna
            END IF
 
        END IF
        ' END IF
    END IF
    '----------------- PREDCHOZI BLOK RESI POSUN OKEN TAHEM ZA HORNI OKRAJ ----------------------------
 
    '----------------- NASLEDUJE BLOK PRO ROZTAHOVANI TAHEM ZA LEVY, PRAVY, NEBO SPODNI OKRAJ ---------
 
    IF W(Window_NR).Status > -1 THEN
        IF Window_NR = W2(UBOUND(w2) - 1) THEN 'omezeni manipulace s oknem pouze pro aktivni okno
            'levy okraj:
            IF _MOUSEX >= W(Window_NR).X1 AND _MOUSEX < W(Window_NR).X1 + 15 THEN
                IF _MOUSEY >= W(Window_NR).Y1 AND _MOUSEY <= W(Window_NR).Y2 - 25 THEN '   omezeni kvuli sipkam posunu mrizky
                    ShiftLeft = 1
                END IF
            END IF
 
            'pravy okraj:
            IF _MOUSEX >= W(Window_NR).X2 - 15 AND _MOUSEX < W(Window_NR).X2 THEN
                IF _MOUSEY >= W(Window_NR).Y1 + 40 AND _MOUSEY <= W(Window_NR).Y2 - 40 THEN '   omezeni kvuli sipkam posunu mrizky
                    ShiftRight = 1
                END IF
            END IF
 
            'spodni okraj
 
            IF _MOUSEX >= W(Window_NR).X1 + 20 AND _MOUSEX <= W(Window_NR).X2 - 20 THEN '   omezeni kvuli sipkam posunu mrizky
                IF _MOUSEY >= W(Window_NR).Y2 - 15 AND _MOUSEY <= W(Window_NR).Y2 THEN
                    ShiftDown = 1
                END IF
            END IF
 
            IF ShiftLeft OR ShiftRight THEN _MOUSESHOW "horizontal"
            IF ShiftDown THEN _MOUSESHOW "vertical"
            '------------- PREDCHOZI BLOK RESI ROZSVECENI SIPEK <-> ATD PRI NAJETI MYSI NA KRAJ OKNA -------------
 
            IF ShiftLeft AND _MOUSEBUTTON(1) THEN
                PCOPY _DISPLAY, 10
                IF _MOUSEX > 5 THEN
                    DO UNTIL _MOUSEBUTTON(1) = 0
                        IF W(Window_NR).X1 < W(Window_NR).X2 - 70 OR MMX = 1 THEN
                            WHILE _MOUSEINPUT: WEND
                            W(Window_NR).X1 = W(Window_NR).X1 + MOUSEMOVEMENTX * 3
                            X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2
                            PCOPY 10, _DISPLAY
                            LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                        ELSE
                            W(Window_NR).X1 = W(Window_NR).X2 - 71
                        END IF
                        _DISPLAY
                    LOOP
                    CLS , ScreenBackGroundColor~&
                END IF
            END IF
 
            IF ShiftRight AND _MOUSEBUTTON(1) THEN
                PCOPY _DISPLAY, 10
                IF _MOUSEX < _DESKTOPWIDTH - 5 THEN
                    DO UNTIL _MOUSEBUTTON(1) = 0
                        IF W(Window_NR).X2 > W(Window_NR).X1 + 70 OR MMX = -1 THEN
                            WHILE _MOUSEINPUT: WEND
                            W(Window_NR).X2 = W(Window_NR).X2 + MOUSEMOVEMENTX * 3
                            X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2
                            PCOPY 10, _DISPLAY
                            LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                        ELSE
                            W(Window_NR).X2 = W(Window_NR).X1 + 71
                        END IF
                        _DISPLAY
                    LOOP
                    CLS , ScreenBackGroundColor~&
                END IF
            END IF
 
            IF ShiftDown AND _MOUSEBUTTON(1) THEN
                PCOPY _DISPLAY, 10
                IF _MOUSEY < _DESKTOPHEIGHT THEN
 
                    DO UNTIL _MOUSEBUTTON(1) = 0
                        IF W(Window_NR).Y2 > W(Window_NR).Y1 + 70 THEN
                            WHILE _MOUSEINPUT: WEND
                            W(Window_NR).Y2 = W(Window_NR).Y2 + MOUSEMOVEMENTY * 3
                            X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2
                            PCOPY 10, _DISPLAY
                            LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                        ELSE
                            W(Window_NR).Y2 = W(Window_NR).Y1 + 71
                        END IF
 
                        _DISPLAY
                    LOOP
                    CLS , ScreenBackGroundColor~&
                END IF
            END IF
 
 
        END IF 'konec kotroly STATUS > -1
 
 
    END IF 'konec omezeni pohybu podle toho, jestli jde o aktivni okno.
    '---------------------------------- next day -------------------------------------------------------------- 12-07-2019 ---------------------------------------------
    'pridam tomu trochu na vzhledu. Jemny barevny prechod pro cast pod ikonami poresim funkci, aby se to stale nekreslilo.
    'pozadi vlozim pred kresleni oken - radek 61, provedeny upravy a otestovani v Draw_Window
 
    _PUTIMAGE (0, 0), IconBack 'vklad pozadi pod hornim pasem pro ikony
 
 
    'Pridan EDITOR.BM pro loadovani ICO souboru (sipky pro okna)
    'Pro vyssi prehlednost necham vzdy mrizku vcetne posunu na subu GRID.
    'Grid bude kreslit na hotove okenni pozadi, cili az na konci tohoto SUBu.
 
 
 
    'vykresleni oken v poradi tak, aby posledni aktivni okno bylo na vrchu.
    FOR WW = LBOUND(w2) TO UBOUND(w2) - 1
        Window_NR = (W2(WW))
        IF W(Window_NR).Status = -1 THEN _CONTINUE 'VYPNE OKNO
 
        COLOR &HFFFFFFFF
        '  PRINT Window_NR: _DISPLAY
        X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2: BackGroundColor~& = W(Window_NR).GBc: Wname$ = W(Window_NR).WName
        Size = W(Window_NR).Gsize: GridColor~& = W(Window_NR).Gc
 
 
        LINE (X1, Y1)-(X2, Y2), BackGroundColor~&, BF
        LINE (X1, Y1 + 20)-(X2, Y2), &HFFFFFFFF, B
        LINE (X1 + 2, Y1 + 22)-(X2 - 2, Y2 - 2), &HFFFFFFFF, B
 
        LINE (X1 + 3, Y1)-(X2 - 3, Y1 + 19), _RGB32(183, 194, 200), BF
 
        LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B
        LINE (X1 + 2, Y1 + 2)-(X2 - 2, Y2 - 2), &HFFFFFFFF, B
 
 
        COLOR &HFF000000
        _PRINTMODE _KEEPBACKGROUND
 
        IF X2 - X1 >= LEN(Wname$) * 16 + 50 THEN
            _PRINTSTRING (X1 + 40, Y1 + 4), "[" + Wname$ + "]" + STR$(Window_NR)
        ELSE
            chrs = _CEIL(X2 - X1 - 90) / 16
            IF chrs < 0 THEN chrs = 0
            nWname$ = LEFT$("[" + Wname$ + "]", chrs)
            _PRINTSTRING (X1 + 40, Y1 + 4), nWname$
        END IF
 
 
        Grid Window_NR
 
    NEXT
END SUB
 
 
 
 
FUNCTION MOUSEMOVEMENTX
    SHARED memory_mousemovementx
    MOUSEMOVEMENTX = 0
    IF _MOUSEX > memory_mousemovementx THEN memory_mousemovementx = _MOUSEX: MOUSEMOVEMENTX = 1: EXIT FUNCTION
    IF _MOUSEX < memory_mousemovementx THEN memory_mousemovementx = _MOUSEX: MOUSEMOVEMENTX = -1
END FUNCTION
 
FUNCTION MOUSEMOVEMENTY
    SHARED memory_mousemovementy
    MOUSEMOVEMENTY = 0
    IF _MOUSEY > memory_mousemovementy THEN memory_mousemovementy = _MOUSEY: MOUSEMOVEMENTY = 1: EXIT FUNCTION
    IF _MOUSEY < memory_mousemovementy THEN memory_mousemovementy = _MOUSEY: MOUSEMOVEMENTY = -1
END FUNCTION
 
FUNCTION IconBackground&
    a = _DEST
    IconBackground& = _NEWIMAGE(_DESKTOPWIDTH, 70, 32)
    _DEST IconBackground&
    D = 85 / 70
    DRA = 255
    FOR Dr = 0 TO 70
        LINE (0, Dr)-(_DESKTOPWIDTH, Dr), _RGB32(DRA)
        DRA = DRA - D
    NEXT
    c = 70 / _DESKTOPWIDTH
    CC = 127
    FOR r = 0 TO _DESKTOPWIDTH
        PSET (r, 67), _RGB32(CC)
        PSET (r, 69), _RGB32(CC)
        CC = CC - c
    NEXT
 
    _DEST a
END FUNCTION
 
SUB LoadIcons
    ICOLeft = LOADICO("ico/left.ico", 9)
    ICORight = LOADICO("ico/right.ico", 9)
    ICOUp = LOADICO("ico/up.ico", 9)
    ICODn = LOADICO("ico/down.ico", 9)
    ICOClose = LOADICO("ico/close.ico", 9)
    ICOMaximize = LOADICO("ico/maximize.ico", 9)
    ICOMinimize = LOADICO("ico/minimize.ico", 9)
    ICOSetup = LOADICO("ico/setup.ico", 7)
END SUB
'$include:'editor.bm'
 

After compiling just press F5 more times, after you close previous compiled program. This source need included files.

Pete · « **Reply #4 on:** July 13, 2019, 06:16:40 pm »

Could this be a problem of not using _FREEIMAGE?

Pete

Petr · « **Reply #5 on:** July 14, 2019, 03:50:29 am »

Hi Pete. No, because is used just one undeleted virtual screen and is loaded just 1x before program loop, for icon background on row 46 and next undeleted newimages are from LOADICO, but this are also loaded before program loop - it call row 73 extra SUB for loading it. Because it use frame icon parameter (icon number), so it load just one concrete ico image. I think, here is not problem.

Petr · « **Reply #6 on:** July 14, 2019, 04:23:09 am »

Oh my god. Bug indetified. I know not why, but again error on my place. So, please, if you are interrested, see to row 309 - 319. This block draw grid to window and sometimes are parameters for draw illegal, because sometimes is MrX2 < MrX1 or MrY2 < MrY1. I muss find now why.

piece of code

FOR DrawGridY = MrY1 TO MrY2
FOR DrawGridX = MrX1 TO MrX2
ArrayX = DrawGridX
ArrayY = DrawGridY
IF Arr3D ( ArrayX , ArrayY , Z ) = 0 THEN

Thank you for your interrest.

Petr · « **Reply #7 on:** July 14, 2019, 05:27:30 am »

So. Again i test it. I Found this:

If the program is compiled in IDE version 1.1, ie 20170120/51, then there is no error! In IDE 1.3, sometimes absurd values occur in the memory field for unknown reasons. I tried to redefine the INTEGER type to LONG without a positive effect. I'm sure I came across a critical QB64 error. To make it easier for developers when the program encounters nonsensical values read from the array (which did not happen once in version 1.1), it whistles and prints out incoming values from memory. So - program development will continue with version 1.1, due to unreliability of version 1.3.

Developers, see row 335. This row find illegal values from memory and write it to screen.

Degraded version for use in IDE 1.1 (but full functional). Need the same attached files above.

Code: QB64: [Select]

 
'   Tato verze je na foru s dotazem na obcasne chybejici mrizku po startu.
'
 
 
 
_TITLE "3D Object editor V 0.1 Alfa"
TYPE V '                informace v mrizce
    X AS SINGLE '      OpenGL souradnice obsazeneho bodu v X                                                      not used, will be used later
    Y AS SINGLE '      OpenGL souradnice obsazeneho bodu v Y
    Z AS SINGLE '      OpenGL souradnice obsazeneho bodu v Z
END TYPE
 
TYPE Triangle ' Souhrn o bodech z pole Grid - proste body ty a ty tvori tento trojuhelnik s touto texturou        not used, will be used later
    TriangleS AS LONG 'odkud v poli V jsou vrcholy tohoto trojuhelnika
    TriangleE AS LONG ' kam v poli V jsou vrcholy tohoto trojuhelnika
    Texture AS LONG 'cislo textury z pole textur pro tento trojuhelnik
END TYPE
 
TYPE texture
    name AS STRING * 12 '                                                                                               not used
END TYPE
 
 
TYPE W 'pro okna                                                                                                'used for program windows
    X1 AS LONG '
    Y1 AS LONG '
    X2 AS LONG '
    Y2 AS LONG '                                                                                              current window position X1,Y1,X2,Y2
    oX1 AS LONG
    oY1 AS LONG
    oX2 AS LONG
    oY2 AS LONG '                                                                                             previous window position oX1, oY1, oX2, oY2
    Status AS _BYTE '                                                                                            0 = standarnd, somewhere on the screen, -1 = closed, 1 = minimized, 2 = maximalized
    WName AS STRING * 12 '                                                                                            window name
    GActive AS INTEGER
    GXs AS LONG
    GXe AS LONG '
    GYs AS LONG '                                                                                             GXs, GYs, GXe, GYe = Grid X Start, Grid Y Start, Grid X end.... for grid
    GYe AS LONG '
    Gc AS _UNSIGNED LONG '                                                                                       Grid foreground color
    GBc AS _UNSIGNED LONG '                                                                                      Grid background color
    Gsize AS LONG '                                                                                           Grid size
    Draw_Pos AS _BYTE '                                                                                          Last click
END TYPE
REDIM SHARED W(0) AS W '
REDIM SHARED W2(0) AS LONG '                                                                                     'Contains records number from array W (for windows) and set foreground window. Foreground window is always ubound W2.
DIM SHARED Arr3D(100, 100, 100) AS SINGLE, ScreenBackGroundColor AS _UNSIGNED LONG, IconBack AS LONG
DIM SHARED ICOLeft, ICORight, ICOUp, ICODn, ICOClose, ICOMaximize, ICOMinimize, ICOSetup
 
IconBack = IconBackground
 
 
ScreenBackGroundColor = &HFF55AA99
CONST GridSizeX = 100 'later this all constants will be optional
CONST GridSizeY = 100
CONST GridSizeZ = 100
CONST GridSize = 16
 
 
 
W = _DESKTOPWIDTH
H = _DESKTOPHEIGHT
SCREEN _NEWIMAGE(W, H, 32)
CLS , ScreenBackGroundColor~&
wdth = _DESKTOPWIDTH / 2
hght = _DESKTOPHEIGHT / 2
 
 
 
 
W1 = Init_Window("Front View XY", 1, 71, wdth - 1, hght - 1, &HFFFFFFFF, &HFF888888, GridSize, 0)
W2 = Init_Window("Side View XZ", wdth + 1, 71, wdth * 2 - 1, hght, &HFF00FFFF, &HFF999999, GridSize, 0)
W3 = Init_Window("Bottom View YZ", 1, hght + 1, wdth, hght * 2 - 1, &HFFFFFFFF, &HFF7A7A7A, GridSize, 0)
W4 = Init_Window("3D Preview window", wdth + 1, hght + 1, wdth * 2 - 1, hght * 2 - 1, &HFF00CCFF, &HFF808080, GridSize, 0)
 
my = _DEST
LoadIcons 'my old program - editor.bm file
_DELAY .5
_DEST my: _SOURCE my
 
 
 
 
gte = 0
DO
    WHILE _MOUSEINPUT: WEND
    _MOUSESHOW "default"
    Draw_Window W1
    Draw_Window W2
    Draw_Window W3
    Draw_Window W4
 
 
    _DISPLAY
    _LIMIT 20
LOOP
 
 
 
 
SUB Grid (R AS INTEGER) 'i think, somewhere in this sub is bug, but i see it not.
 
 
REDIM MrY1 AS LONG
REDIM MrY2 AS LONG
REDIM MrX1 AS LONG
REDIM MrX2 AS LONG
REDIM Y1 AS LONG
REDIM Y2 AS LONG
REDIM X1 AS LONG
REDIM X2 AS LONG
 
 
 
 
 
 
X1 = W(R).X1
Y1 = W(R).Y1
X2 = W(R).X2
Y2 = W(R).Y2
 
'vlozi ovladaci prvky okna
_PUTIMAGE (X2 - 25, Y1 + 4), ICOClose
_PUTIMAGE (X2 - 42, Y1 + 4), ICOMaximize
_PUTIMAGE (X2 - 59, Y1 + 4), ICOMinimize
 
 
_PUTIMAGE (X2 - 20, Y2 - 20), ICORight
_PUTIMAGE (X1 + 5, Y2 - 20), ICOLeft
_PUTIMAGE (X2 - 20, Y1 + 24), ICOUp
_PUTIMAGE (X2 - 20, Y2 - 37), ICODn
 
LINE (X1 + 20, Y2 - 19)-(X2 - 20, Y2 - 7), &HFF88F888, B 'X rectangle
LINE (X2 - 19, Y1 + 40)-(X2 - 7, Y2 - 38), &HFF88F888, B 'Y rectangle
 
MX = _MOUSEX: MY = _MOUSEY: MB1 = _MOUSEBUTTON(1)
 
 
 
FOR U = LBOUND(w) TO UBOUND(w)
    IF MB1 THEN
        IF MX >= W(U).X1 AND MX <= W(U).X2 AND MY >= W(U).Y1 AND MY <= W(U).Y2 THEN 'if user is in some window area and click, set it as active. Window shift is possible by clicking and moving window header.
            IF UBOUND(w2) = U THEN EXIT FOR '
            Set_Active_Window U
            EXIT FOR
        END IF
    END IF
NEXT U
 
IF MX < X2 AND MX > X2 - 70 THEN
    IF MY >= Y1 AND MY <= Y1 + 19 THEN
        SELECT CASE MX
            CASE X2 - 25 TO X2 - 10
                LINE (X2 - 10, Y1 + 4)-(X2 - 25, Y1 + 19), &H99FF0000, BF 'icon CLOSE
                IF MB1 THEN
                    W(R).Status = -1 '                                     minimalize
                    LINE (X1, Y1)-(X2, Y2), ScreenBackGroundColor, BF
                END IF
 
 
            CASE X2 - 59 TO X2 - 44
                LINE (X2 - 59, Y1 + 4)-(X2 - 44, Y1 + 19), &H99FF0000, BF 'maximalize
                IF MB1 THEN
                    IF W(R).Status = 0 THEN
                        W(R).oX1 = X1
                        W(R).oY1 = Y1
                        W(R).oX2 = X2
                        W(R).oY2 = Y2
 
                        W(R).X1 = R * 70
                        W(R).X2 = W(R).X1 + 70
                        W(R).Y2 = _DESKTOPHEIGHT
                        W(R).Y1 = _DESKTOPHEIGHT - 70
                        W(R).Status = 1
 
                        Set_Active_Window R
                        Reset_Mouse
                        GOTO eif
                    END IF
 
                    IF W(R).Status = 2 THEN 'return previous state
                        W(R).X1 = W(R).oX1
                        W(R).Y1 = W(R).oY1
                        W(R).X2 = W(R).oX2
                        W(R).Y2 = W(R).oY2
                        W(R).Status = 0
 
                        X1 = W(R).oX1
                        Y1 = W(R).oY1
                        X2 = W(R).oX2
                        Y2 = W(R).oY2
 
                        Set_Active_Window R
                    END IF
                    eif:
                    LINE (0, 71)-(_DESKTOPWIDTH, _DESKTOPHEIGHT), ScreenBackGroundColor, BF
                END IF
 
 
            CASE X2 - 41 TO X2 - 27
                LINE (X2 - 41, Y1 + 4)-(X2 - 27, Y1 + 19), &H99FF0000, BF 'icon minimalize
                IF MB1 THEN
                    LINE (X1, Y1)-(X2, Y2), ScreenBackGroundColor, BF
                    IF W(R).Status = 1 THEN '        return previous state from minimalize
                        W(R).X1 = W(R).oX1
                        W(R).Y1 = W(R).oY1
                        W(R).X2 = W(R).oX2
                        W(R).Y2 = W(R).oY2
                        W(R).Status = 0
                        X1 = W(R).oX1
                        Y1 = W(R).oY1
                        X2 = W(R).oX2
                        Y2 = W(R).oY2
 
                        Set_Active_Window R
                        GOTO eif2
                    END IF
 
 
 
                    IF W(R).Status = 0 THEN 'Maximalize. First write current coordinates.
                        W(R).oX1 = X1
                        W(R).oY1 = Y1
                        W(R).oX2 = X2
                        W(R).oY2 = Y2
 
                        W(R).X1 = 3
                        W(R).X2 = _DESKTOPWIDTH - 3
                        W(R).Y2 = _DESKTOPHEIGHT - 5
                        W(R).Y1 = 71
                        W(R).Status = 2
                        Set_Active_Window R
                    END IF
                    eif2:
                END IF
        END SELECT
    END IF
END IF
 
'DRAW GRID IN WINDOWS
 
'Load previous grid coordinates (on grid positions)
 
MrY1 = W(R).GYs
MrY2 = W(R).GYe
MrX1 = W(R).GXs '                                   Positions on grid
MrX2 = W(R).GXe
 
'arrow up in windows
IF MX >= X2 - 19 AND MX <= X2 - 7 THEN
    IF MY >= Y1 + 26 AND MY <= Y1 + 38 THEN
        LINE (X2 - 19, Y1 + 26)-(X2 - 7, Y1 + 38), &H33FF0000, BF
        IF MB1 THEN MrY1 = MrY1 - 1
    END IF
END IF
 
'rrow down in windows
IF MX >= X2 - 19 AND MX <= X2 - 7 THEN
    IF MY >= Y2 - 38 AND MY <= Y2 - 26 THEN
        LINE (X2 - 19, Y2 - 26)-(X2 - 7, Y2 - 38), &H33FF0000, BF
        IF MB1 THEN MrY1 = MrY1 + 1
    END IF
END IF
 
'arrow left
IF MX >= X1 + 6 AND MX <= X1 + 18 THEN
    IF MY >= Y2 - 20 AND MY <= Y2 - 5 THEN
        LINE (X1 + 18, Y2 - 20)-(X1 + 6, Y2 - 5), &H33FF0000, BF
        IF MB1 THEN MrX1 = MrX1 - 1
    END IF
END IF
 
'arrow right
IF MX >= X2 - 18 AND MX <= X2 - 6 THEN
    IF MY >= Y2 - 20 AND MY <= Y2 - 5 THEN
        LINE (X2 - 18, Y2 - 20)-(X2 - 6, Y2 - 5), &H33FF0000, BF
        IF MB1 THEN MrX1 = MrX1 + 1 'tady mrX1 neblbne
    END IF
END IF
'if is here inserted: PRINT R: _DISPLAY: SLEEP, problem not occur. WHY?
 
 
 
IF R <= 2 THEN '                                I need view grid in window nr. 0,1,2. Window 3 use none grid. It is window for future OpenGL view.
    rrr = rrr + 1
    IF W(R).Status = 0 OR W(R).Status = 2 THEN
 
 
        GX1 = X1 + 10 '                        reset start coordinates for grid. It is different, if is window minimized or use other width, height, or is maximalized.
        GY1 = Y1 + 28 '                        this are relative coordinates.
        GX2 = X2 - 25 '
        GY2 = Y2 - 23 '
        Gsize = W(R).Gsize
 
 
        '  DO UNTIL (GX2 - GX1) MOD Gsize = 0 'reset grid size to value best for use in window for full fill.
        '  Gsize = Gsize - 1
        ' LOOP
        'musel sem to odstavit, protoze to nesmyslne menilo velikost mrizky za chodu (pri roztazeni okna z boku nebo zdola)
 
 
        'Every window show one piece in space (currently all show just X/Y)
        MinX = 0: MinY = 0: MinZ = 0
        SELECT CASE R
            CASE 0: MaxX = GridSizeX: MaxY = GridSizeY: Z = CurrentZ 'View XY
            CASE 1: MaxX = GridSizeX: MaxY = GridSizeZ: Z = CurrentY 'View YZ
            CASE 2: MaxX = GridSizeY: MaxY = GridSizeZ: Z = CurrentX 'View XZ
        END SELECT '               y                               x
 
 
        'MrX1 and MrY1 are field coordinates, not graphical!
 
 
        IF MrX1 < MinX THEN MrX1 = MinX 'LBOUND Overflow prevent
        IF MrY1 < MinY THEN MrY1 = MinY
 
        'claculate how much points can be viewed
        Xd = INT((GX2 - GX1 - Gsize) / Gsize)
        Yd = INT((GY2 - GY1 - Gsize) / Gsize)
 
        MrX2 = MrX1 + Xd
        MrY2 = MrY1 + Yd
 
 
        IF MrX2 > MaxX THEN MrX2 = MaxX 'UBOUND Overflow prevent
        IF MrY2 > MaxY THEN MrY2 = MaxY
 
 
        Z = 2 'Alpha test - set X, Y to Z = 2
        Arr3D(5, 7, 2) = 1
 
 
        IF MrX2 < MrX1 OR MrY2 < MrY1 THEN SOUND 350, .5: PRINT MrX2; MrX1, MrY2; MrY1: _DISPLAY: SLEEP
 
 
 
        FOR DrawGridY = MrY1 TO MrY2
            FOR DrawGridX = MrX1 TO MrX2
                ArrayX = DrawGridX
                ArrayY = DrawGridY
                IF Arr3D(ArrayX, ArrayY, Z) = 0 THEN
                    LINE (GX1 + (Gsize * DrawGridX) - (Gsize * MrX1), GY1 + (Gsize * DrawGridY) - (Gsize * MrY1))-(GX1 + (DrawGridX * Gsize) + Gsize - 1 - (Gsize * MrX1), GY1 + (DrawGridY * Gsize) + Gsize - 1 - (Gsize * MrY1)), &HFF0000FF, B
                ELSE
                    LINE (GX1 + (Gsize * DrawGridX) - (Gsize * MrX1), GY1 + (Gsize * DrawGridY) - (Gsize * MrY1))-(GX1 + (DrawGridX * Gsize) + Gsize - 1 - (Gsize * MrX1), GY1 + (DrawGridY * Gsize) + Gsize - 1 - (Gsize * MrY1)), &HFFFF0000, BF
                END IF
            NEXT
        NEXT
 
 
    END IF
 
 
 
 
END IF
 
 
'save grid positions to field
W(R).GYs = MrY1
W(R).GYe = MrY2
W(R).GXs = MrX1
W(R).GXe = MrX2
 
 
 
 
PCOPY _DISPLAY, 10
 
'pokracovat ovladanim a plnenim + kresbou mrizky
 
 
 
 
 
 
END SUB
 
SUB Set_Active_Window (window_nr AS INTEGER)
ii = 0
IF W2(UBOUND(w2) - 1) <> window_nr THEN
    DO UNTIL W2(ii) = window_nr
        ii = ii + 1
    LOOP
    SWAP W2(UBOUND(w2) - 1), W2(ii)
END IF
END SUB
 
SUB Reset_Mouse
DO UNTIL _MOUSEBUTTON(1) = 0
    WHILE _MOUSEINPUT: WEND
LOOP
END SUB
 
FUNCTION Init_Window (Wname AS STRING, X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER, GridColor AS _UNSIGNED LONG, BackgroundColor AS _UNSIGNED LONG, Size AS _BYTE, Status AS _BYTE) 'pri initu je mrizka na pocatku.
I = UBOUND(W)
W(I).X1 = X1: W(I).Y1 = Y1: W(I).X2 = X2: W(I).Y2 = Y2: W(I).Status = Status: W(I).Gc = GridColor: W(I).GBc = BackgroundColor: W(I).WName = Wname: W(I).Gsize = Size: W(I).GXe = GridSizeX: W(I).GYe = GridSizeY
W2(I) = I
REDIM _PRESERVE W(I + 1) AS W
REDIM _PRESERVE W2(I + 1) AS LONG
Init_Window = I
END FUNCTION
 
 
 
SUB Draw_Window (Window_NR AS LONG)
X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2: BackGroundColor~& = W(Window_NR).GBc: Wname$ = W(Window_NR).WName
Size = W(Window_NR).Gsize: GridColor~& = W(Window_NR).Gc
 
 
 
 
IF _MOUSEX >= X1 AND _MOUSEX <= X2 - 70 AND W(Window_NR).Status > -1 THEN 'omezeni kvuli ikonam ovladani okna
    IF _MOUSEY >= Y1 AND _MOUSEY <= Y1 + 19 THEN
        ' IF UBOUND(w2) - 1 = Window_NR THEN
        IF Window_NR = W2(UBOUND(w2) - 1) THEN _MOUSESHOW "link"
        IF _MOUSEBUTTON(1) THEN
 
            IF Window_NR = W2(UBOUND(w2) - 1) THEN
                ox1 = X1: ox2 = X2: oy1 = Y1: oy2 = Y2
 
 
 
                PCOPY _DISPLAY, 10
                DO UNTIL _MOUSEBUTTON(1) = 0
                    DO WHILE _MOUSEINPUT: LOOP
                    MMX = MOUSEMOVEMENTX * 3
                    MMY = MOUSEMOVEMENTY * 3
 
 
                    PCOPY 10, _DISPLAY
                    ooX1 = X1
                    X1 = X1 + MMX
                    ooy1 = Y1
                    Y1 = Y1 + MMY
                    X2 = X2 + MMX
                    ooy2 = Y2
                    Y2 = Y2 + MMY
 
 
                    IF Y1 < 70 THEN Y1 = 70: Y2 = ooy2
                    IF Y1 > _DESKTOPHEIGHT - 70 THEN Y1 = _DESKTOPHEIGHT - 70: Y2 = ooy2
                    IF X2 < 70 THEN X2 = 70
                    IF X1 > _DESKTOPWIDTH - 70 THEN X1 = _DESKTOPWIDTH - 70
                    '------------------------------------------
 
                    LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                    _DISPLAY
                LOOP
 
                PCOPY 10, _DISPLAY
            END IF
 
            '               FOR r = LBOUND(W) TO UBOUND(W)
            '              W(r).Draw_Pos = 0
            '             NEXT r
            '                W(Window_NR).Draw_Pos = 1
 
            W(Window_NR).X1 = X1: W(Window_NR).X2 = X2
            W(Window_NR).Y1 = Y1: W(Window_NR).Y2 = Y2
 
            IF W2(UBOUND(w2) - 1) <> Window_NR THEN
                DO UNTIL W2(ii) = Window_NR
                    ii = ii + 1
                LOOP
                SWAP W2(UBOUND(w2) - 1), W2(ii)
            END IF
 
 
            LINE (ox1, oy1)-(ox2, oy2), ScreenBackGroundColor~&, BF 'premaze cernou barvou puvodni pozici okna
        END IF
 
    END IF
    ' END IF
END IF
'----------------- PREDCHOZI BLOK RESI POSUN OKEN TAHEM ZA HORNI OKRAJ ----------------------------
 
'----------------- NASLEDUJE BLOK PRO ROZTAHOVANI TAHEM ZA LEVY, PRAVY, NEBO SPODNI OKRAJ ---------
 
IF W(Window_NR).Status > -1 THEN
    IF Window_NR = W2(UBOUND(w2) - 1) THEN 'omezeni manipulace s oknem pouze pro aktivni okno
        'levy okraj:
        IF _MOUSEX >= W(Window_NR).X1 AND _MOUSEX < W(Window_NR).X1 + 15 THEN
            IF _MOUSEY >= W(Window_NR).Y1 AND _MOUSEY <= W(Window_NR).Y2 - 25 THEN '   omezeni kvuli sipkam posunu mrizky
                ShiftLeft = 1
            END IF
        END IF
 
        'pravy okraj:
        IF _MOUSEX >= W(Window_NR).X2 - 15 AND _MOUSEX < W(Window_NR).X2 THEN
            IF _MOUSEY >= W(Window_NR).Y1 + 40 AND _MOUSEY <= W(Window_NR).Y2 - 40 THEN '   omezeni kvuli sipkam posunu mrizky
                ShiftRight = 1
            END IF
        END IF
 
        'spodni okraj
 
        IF _MOUSEX >= W(Window_NR).X1 + 20 AND _MOUSEX <= W(Window_NR).X2 - 20 THEN '   omezeni kvuli sipkam posunu mrizky
            IF _MOUSEY >= W(Window_NR).Y2 - 15 AND _MOUSEY <= W(Window_NR).Y2 THEN
                ShiftDown = 1
            END IF
        END IF
 
        IF ShiftLeft OR ShiftRight THEN _MOUSESHOW "horizontal"
        IF ShiftDown THEN _MOUSESHOW "vertical"
        '------------- PREDCHOZI BLOK RESI ROZSVECENI SIPEK <-> ATD PRI NAJETI MYSI NA KRAJ OKNA -------------
 
        IF ShiftLeft AND _MOUSEBUTTON(1) THEN
            PCOPY _DISPLAY, 10
            IF _MOUSEX > 5 THEN
                DO UNTIL _MOUSEBUTTON(1) = 0
                    IF W(Window_NR).X1 < W(Window_NR).X2 - 70 OR MMX = 1 THEN
                        WHILE _MOUSEINPUT: WEND
                        W(Window_NR).X1 = W(Window_NR).X1 + MOUSEMOVEMENTX * 3
                        X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2
                        PCOPY 10, _DISPLAY
                        LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                    ELSE
                        W(Window_NR).X1 = W(Window_NR).X2 - 71
                    END IF
                    _DISPLAY
                LOOP
                CLS , ScreenBackGroundColor~&
            END IF
        END IF
 
        IF ShiftRight AND _MOUSEBUTTON(1) THEN
            PCOPY _DISPLAY, 10
            IF _MOUSEX < _DESKTOPWIDTH - 5 THEN
                DO UNTIL _MOUSEBUTTON(1) = 0
                    IF W(Window_NR).X2 > W(Window_NR).X1 + 70 OR MMX = -1 THEN
                        WHILE _MOUSEINPUT: WEND
                        W(Window_NR).X2 = W(Window_NR).X2 + MOUSEMOVEMENTX * 3
                        X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2
                        PCOPY 10, _DISPLAY
                        LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                    ELSE
                        W(Window_NR).X2 = W(Window_NR).X1 + 71
                    END IF
                    _DISPLAY
                LOOP
                CLS , ScreenBackGroundColor~&
            END IF
        END IF
 
        IF ShiftDown AND _MOUSEBUTTON(1) THEN
            PCOPY _DISPLAY, 10
            IF _MOUSEY < _DESKTOPHEIGHT THEN
 
                DO UNTIL _MOUSEBUTTON(1) = 0
                    IF W(Window_NR).Y2 > W(Window_NR).Y1 + 70 THEN
                        WHILE _MOUSEINPUT: WEND
                        W(Window_NR).Y2 = W(Window_NR).Y2 + MOUSEMOVEMENTY * 3
                        X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2
                        PCOPY 10, _DISPLAY
                        LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B , 127
                    ELSE
                        W(Window_NR).Y2 = W(Window_NR).Y1 + 71
                    END IF
 
                    _DISPLAY
                LOOP
                CLS , ScreenBackGroundColor~&
            END IF
        END IF
 
 
    END IF 'konec kotroly STATUS > -1
 
 
END IF 'konec omezeni pohybu podle toho, jestli jde o aktivni okno.
'---------------------------------- next day -------------------------------------------------------------- 12-07-2019 ---------------------------------------------
'pridam tomu trochu na vzhledu. Jemny barevny prechod pro cast pod ikonami poresim funkci, aby se to stale nekreslilo.
'pozadi vlozim pred kresleni oken - radek 61, provedeny upravy a otestovani v Draw_Window
 
_PUTIMAGE (0, 0), IconBack 'vklad pozadi pod hornim pasem pro ikony
 
 
'Pridan EDITOR.BM pro loadovani ICO souboru (sipky pro okna)
'Pro vyssi prehlednost necham vzdy mrizku vcetne posunu na subu GRID.
'Grid bude kreslit na hotove okenni pozadi, cili az na konci tohoto SUBu.
 
 
 
'vykresleni oken v poradi tak, aby posledni aktivni okno bylo na vrchu.
FOR WW = LBOUND(w2) TO UBOUND(w2) - 1
    Window_NR = (W2(WW))
    IF W(Window_NR).Status = -1 THEN GOTO f 'VYPNE OKNO
 
    COLOR &HFFFFFFFF
    '  PRINT Window_NR: _DISPLAY
    X1 = W(Window_NR).X1: Y1 = W(Window_NR).Y1: X2 = W(Window_NR).X2: Y2 = W(Window_NR).Y2: BackGroundColor~& = W(Window_NR).GBc: Wname$ = W(Window_NR).WName
    Size = W(Window_NR).Gsize: GridColor~& = W(Window_NR).Gc
 
 
    LINE (X1, Y1)-(X2, Y2), BackGroundColor~&, BF
    LINE (X1, Y1 + 20)-(X2, Y2), &HFFFFFFFF, B
    LINE (X1 + 2, Y1 + 22)-(X2 - 2, Y2 - 2), &HFFFFFFFF, B
 
    LINE (X1 + 3, Y1)-(X2 - 3, Y1 + 19), _RGB32(183, 194, 200), BF
 
    LINE (X1, Y1)-(X2, Y2), &HFFFFFFFF, B
    LINE (X1 + 2, Y1 + 2)-(X2 - 2, Y2 - 2), &HFFFFFFFF, B
 
 
    COLOR &HFF000000
    _PRINTMODE _KEEPBACKGROUND
 
    IF X2 - X1 >= LEN(Wname$) * 16 + 50 THEN
        _PRINTSTRING (X1 + 40, Y1 + 4), "[" + Wname$ + "]" + STR$(Window_NR)
    ELSE
        chrs = _CEIL(X2 - X1 - 90) / 16
        IF chrs < 0 THEN chrs = 0
        nWname$ = LEFT$("[" + Wname$ + "]", chrs)
        _PRINTSTRING (X1 + 40, Y1 + 4), nWname$
    END IF
 
 
    Grid Window_NR
    f:
NEXT
END SUB
 
 
 
 
FUNCTION MOUSEMOVEMENTX
SHARED memory_mousemovementx
MOUSEMOVEMENTX = 0
IF _MOUSEX > memory_mousemovementx THEN memory_mousemovementx = _MOUSEX: MOUSEMOVEMENTX = 1: EXIT FUNCTION
IF _MOUSEX < memory_mousemovementx THEN memory_mousemovementx = _MOUSEX: MOUSEMOVEMENTX = -1
END FUNCTION
 
FUNCTION MOUSEMOVEMENTY
SHARED memory_mousemovementy
MOUSEMOVEMENTY = 0
IF _MOUSEY > memory_mousemovementy THEN memory_mousemovementy = _MOUSEY: MOUSEMOVEMENTY = 1: EXIT FUNCTION
IF _MOUSEY < memory_mousemovementy THEN memory_mousemovementy = _MOUSEY: MOUSEMOVEMENTY = -1
END FUNCTION
 
FUNCTION IconBackground&
a = _DEST
IconBackground& = _NEWIMAGE(_DESKTOPWIDTH, 70, 32)
_DEST IconBackground&
D = 85 / 70
DRA = 255
FOR Dr = 0 TO 70
    LINE (0, Dr)-(_DESKTOPWIDTH, Dr), _RGB32(DRA, DRA, DRA)
    DRA = DRA - D
NEXT
c = 70 / _DESKTOPWIDTH
CC = 127
FOR r = 0 TO _DESKTOPWIDTH
    PSET (r, 67), _RGB32(CC, CC, CC)
    PSET (r, 69), _RGB32(CC, CC, CC)
    CC = CC - c
NEXT
 
_DEST a
END FUNCTION
 
SUB LoadIcons
ICOLeft = LOADICO("ico/left.ico", 9)
ICORight = LOADICO("ico/right.ico", 9)
ICOUp = LOADICO("ico/up.ico", 9)
ICODn = LOADICO("ico/down.ico", 9)
ICOClose = LOADICO("ico/close.ico", 9)
ICOMaximize = LOADICO("ico/maximize.ico", 9)
ICOMinimize = LOADICO("ico/minimize.ico", 9)
ICOSetup = LOADICO("ico/setup.ico", 7)
END SUB
 
FUNCTION Window_Active (tX, tY, tX2, tY2)
FOR T = 0 TO 3
    S = W(T).Draw_Pos
    X1 = W(T).X1
    Y1 = W(T).Y1
    X2 = W(T).X2
    Y2 = W(T).Y2
    'detekce bodu v ctverci. pokud jedina strana je v jinem okne a toto okno ma priznak S = 1, pak funkce vrati cislo okna, ktere je aktivni. Pokud tam neni shoda, vrati cislo okna, ktere je v teto pozici.
 
 
 
 
NEXT
END FUNCTION
'$include:'editor.bm'
 

Petr · « **Reply #8 on:** July 14, 2019, 05:36:37 am »

Error localized specifically !!!! If you remove * 12 from STRING definitions in IDE 1.3 (which is necessary for IDE 1.1 but not 1.3) from the last source after the field definitions after the STRING field, then you will get the previous error. If you leave STRING * 12 there, then the error disappears.

TempodiBasic · « **Reply #9 on:** July 14, 2019, 01:59:32 pm »

Hi Petr

fantastic, you have found or a bug of parser or a empowerement that shifts QB64 far from QB45

see here

in fact I remember that I learnt UDT while I's learning Random access to file for defining RECORD and as QB help seems to affirm
in TYPE definition String must be fixed using *n

and in QB64 Wiki we have no mention of fixed string in TYPE page but all the examples show fixed strings
http://qb64.org/wiki/TYPE

but we have informations from STRING wiki page
http://qb64.org/wiki/STRING

Good, more we use QB64, more the developers' team gets back useful feedbacks.

TempodiBasic · « **Reply #10 on:** July 14, 2019, 02:17:22 pm »

Hi Petr
about your creature...

WOW!
It's great to have 4 windows that are sizeable, moveable, can be minimized, maximizide and closed.

Two feedback that may be useful:
1. For now dragging a window make slow the flow of program
2. if I overlap 2 windows and I click on the portion of the window that overlaps the other window the clickStroke is given to the window that has the low order (0-1-2-3) so there is no Zorder for windowing... if I click on window 3 that overlaps window 1 I'll aspect to interact with window 3 and not to focus window 1 that is under.
Thanks to read

Petr · « **Reply #11 on:** July 14, 2019, 02:28:14 pm »

Hi Tempo, I know about these problems, and I wanted to work on them... i run it and miss a grid in one window after running.... and start detective work why... :-D This is the version during development. I'm writing a feature now, that will solve the overlapping windows. Thank You :-D

Petr · « **Reply #12 on:** September 03, 2019, 02:27:11 pm »

Hi.

So after a very long time I decided to continue and release another development intermediate version of my 3D object editor. I improved the behavior of the windows, made real 3D viewable in the preview window, added some functions and several icons. The program is still far from complete.
A few words about the program function. The leftmost icon allows you to set
these things:
- Z offset for window 0 (X / Y). Moves the grid to the selected depth.
- Y offset for window 1 (X / Z). Moves the grid to the selected height in the body.
- X offset for window 2 (Y / Z). Moves the grid to the selected width in the body.

Just imagine having a book in your hand. Z is the page number in the book when looking at the book (that is, according to Z you can reach a specific depth inside the book).

The X offset is the same if you look at this book sideways, so the top-down axis is Y and the horizontal axis is Z, setting this to position the letter in a row on a specific page in the book,
(simply depth shift when looking at the body from the side)

The Y offset is again the same, if you visualize the bottom of the body. The Y offset determines the height at which a row is in a book, or otherwise, a depth shift when looking at a body so that its bottom is in front view.

the center point of the object. It is intended as the center around which the body will rotate.

Finally, set the ratio. This sets the total body size.
Since this is an early version of the program, I have only tested it on a rectangle in space.

Middle icon with pencil. Only works if the vertex field contains at least 4 records. It allows manual editing of the vertex field and their transcription. This is great for the spatial understanding of MAPTRIANGLE 3D. Notice how the drawing in Window 3 changes as you edit the coordinates.
The third icon allows you to delete the vertices to clear all windows.

I haven't worked on it at all for a while, because I had to prioritize more important and necessary things.

I plan to add (this is a must!) Option to select body textures, convert 2D to 3D, and interlayer copy. At the same time, the function one step back and other functions.

How to try it:
In the upper left window, use the arrows on the edge of the window to locate where the blue squares in the X and Y axes intersect. This is zero, the center of the body. Now, to maintain the proper texture of the inner texture, proceed as follows:

Click once left up above the blue crossing. Then to right up above the blue crossing. Then down left under the blue crossing and finally down right under the blue crossing. You have inserted 4 spatial points and you should see a rectangle or at least some white lines in window 3. You can now edit the 3D coordinates by clicking the center icon. To exit from the coordinates editor subroutine, press Esc. For erase all vertexes click to trash icon.

So far no great fame, but it will come someday :)

News:

Author Topic: 3D Object Editor: Start (Read 5850 times)

Petr

3D Object Editor: Start

TempodiBasic

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: First steps

Pete

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Start

TempodiBasic

Re: 3D Object Editor: Start

TempodiBasic

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Start

Petr

Re: 3D Object Editor: Continue