' 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
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
TYPE W
'pro okna 'used for program windows Y2
AS LONG ' current window position X1,Y1,X2,Y2 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 GYs
AS LONG ' GXs, GYs, GXe, GYe = Grid X Start, Grid Y Start, Grid X end.... for gridREDIM 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 ICOLeft
, ICORight
, ICOUp
, ICODn
, ICOClose
, ICOMaximize
, ICOMinimize
, ICOSetup
IconBack = IconBackground
ScreenBackGroundColor = &HFF55AA99
CONST GridSizeX
= 100 'later this all constants will be optional
CLS , ScreenBackGroundColor~&
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
gte = 0
Draw_Window W1
Draw_Window W2
Draw_Window W3
Draw_Window W4
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
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
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. Set_Active_Window U
LINE (X2
- 10, Y1
+ 4)-(X2
- 25, Y1
+ 19), &H99FF0000, BF
'icon CLOSE W(R).Status = -1 ' minimalize
LINE (X1
, Y1
)-(X2
, Y2
), ScreenBackGroundColor
, BF
LINE (X2
- 59, Y1
+ 4)-(X2
- 44, Y1
+ 19), &H99FF0000, BF
'maximalize 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).Status = 1
Set_Active_Window R
Reset_Mouse
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
eif:
LINE (X2
- 41, Y1
+ 4)-(X2
- 27, Y1
+ 19), &H99FF0000, BF
'icon minimalize 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
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).Y1 = 71
W(R).Status = 2
Set_Active_Window R
eif2:
'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
LINE (X2
- 19, Y1
+ 26)-(X2
- 7, Y1
+ 38), &H33FF0000, BF
'rrow down in windows
LINE (X2
- 19, Y2
- 26)-(X2
- 7, Y2
- 38), &H33FF0000, BF
'arrow left
LINE (X1
+ 18, Y2
- 20)-(X1
+ 6, Y2
- 5), &H33FF0000, BF
'arrow right
LINE (X2
- 18, Y2
- 20)-(X2
- 6, Y2
- 5), &H33FF0000, BF
IF MB1
THEN MrX1
= MrX1
+ 1 'tady mrX1 neblbne '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
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
'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
)), &HFF0000FF, B
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
'save grid positions to field
W(R).GYs = MrY1
W(R).GYe = MrY2
W(R).GXs = MrX1
W(R).GXe = MrX2
'pokracovat ovladanim a plnenim + kresbou mrizky
ii = 0
ii = ii + 1
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
Init_Window = I
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 UBOUND(w2) - 1 = Window_NR THEN
ox1 = X1: ox2 = X2: oy1 = Y1: oy2 = Y2
MMX = MOUSEMOVEMENTX * 3
MMY = MOUSEMOVEMENTY * 3
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
'------------------------------------------
LINE (X1
, Y1
)-(X2
, Y2
), &HFFFFFFFF, B
, 127
' 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
ii = ii + 1
LINE (ox1
, oy1
)-(ox2
, oy2
), ScreenBackGroundColor~&
, BF
'premaze cernou barvou puvodni pozici okna
' 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:
ShiftLeft = 1
'pravy okraj:
ShiftRight = 1
'spodni okraj
ShiftDown = 1
'------------- PREDCHOZI BLOK RESI ROZSVECENI SIPEK <-> ATD PRI NAJETI MYSI NA KRAJ OKNA -------------
IF W
(Window_NR
).X1
< W
(Window_NR
).X2
- 70 OR MMX
= 1 THEN 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
LINE (X1
, Y1
)-(X2
, Y2
), &HFFFFFFFF, B
, 127 W(Window_NR).X1 = W(Window_NR).X2 - 71
CLS , ScreenBackGroundColor~&
IF W
(Window_NR
).X2
> W
(Window_NR
).X1
+ 70 OR MMX
= -1 THEN 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
LINE (X1
, Y1
)-(X2
, Y2
), &HFFFFFFFF, B
, 127 W(Window_NR).X2 = W(Window_NR).X1 + 71
CLS , ScreenBackGroundColor~&
IF W
(Window_NR
).Y2
> W
(Window_NR
).Y1
+ 70 THEN 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
LINE (X1
, Y1
)-(X2
, Y2
), &HFFFFFFFF, B
, 127 W(Window_NR).Y2 = W(Window_NR).Y1 + 71
CLS , ScreenBackGroundColor~&
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.
Window_NR = (W2(WW))
IF W
(Window_NR
).Status
= -1 THEN GOTO f
'VYPNE OKNO
' 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
chrs
= _CEIL(X2
- X1
- 90) / 16 nWname$
= LEFT$("[" + Wname$
+ "]", chrs
)
Grid Window_NR
f:
MOUSEMOVEMENTX = 0
MOUSEMOVEMENTY = 0
D = 85 / 70
DRA = 255
DRA = DRA - D
CC = 127
CC = CC - c
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)
FUNCTION Window_Active
(tX
, tY
, tX2
, tY2
) 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.
'$include:'editor.bm'