forum.boolean.name

forum.boolean.name (http://forum.boolean.name/index.php)
-   2D-программирование (http://forum.boolean.name/forumdisplay.php?f=13)
-   -   гексогональная тайловая карта(изометрия) (http://forum.boolean.name/showthread.php?t=16878)

polopok 18.06.2012 14:38

Ответ: гексогональная тайловая карта(изометрия)
 
Вложений: 1
Улучшенное перемещение , некоторые изменения в коде.
Код:



Type Pos
Field x,y,id
Field i,j
Field wood ,wdx ,wdy
Field wall ,wx ,wy
End Type


Graphics 800,600,32 ,2

geroy=LoadAnimImage("tip.png",32,32,0,12) :MaskImage geroy,0,0,0
imgtile=CreateImage(41,21)
SetBuffer ImageBuffer(imgtile) ;картинка гекса
        Color 125,22,22
        Line 0,10,10,0
        Line 10,0,30,0
        Line 30,0,40,10
        Line 40,10,30,20
        Line 30,20,10,20
        Line 10,20,0,10
        Color 255,255,255
imgtile0=CreateImage(41,21)
SetBuffer ImageBuffer(imgtile0) ;картинка мыши
        Color 5,0,255
        Rect  10,0,20,20,0
        Color 255,255,255
woods=CreateImage(23,19)
SetBuffer ImageBuffer(woods) ;картинка дерева
        Color 11,255,255
        Oval  13,5,10,10,1
        Color 211,0,125
        Line 20,10,22,18
        Color 255,255,255
wall=CreateImage(41,31)
SetBuffer ImageBuffer(wall) ;картинка стены
L1= 11 :L2= 30
L3= 11 :L4= 20
        Color 111,78,78
       
        For w= 1 To 10
                Line w,L3,w,L4
                L3= L3-1 :L4= L4+1
        Next
        For w= 30 To 40
                Line w,L3,w,L4
                L3= L3+1 :L4= L4-1
        Next
        Color 141,141,141
        For w= 1 To 10
                Line L1,w,L2,w
                L1= L1-1 :L2= L2+1
        Next
        For w= 11 To 20
                Line L1,w,L2,w
                L1= L1+1 :L2= L2-1
        Next
        Color 121,99,99
        Rect 10,20,21,10,1
SetBuffer BackBuffer()


Restore map_data

d =40  :dd =(d/2) : ddd =(dd/2)
tilex=13  : tiley=58 ;количество ячеек 13*58
sx=  0 : sy=10
pozx = 3
pozy = 3
ShipX = 165 : LastClickX = 165 : OldClickX = 165
ShipY = 30  : LastClickY = 30  : OldClickY = 30
For j=0 To tiley-1
        For i=0 To tilex-1
               
                If (j Mod 2)  Then
                        x =  i*(d+dd)
                Else
                        x =  i*(d+dd)+( dd+ddd)
                EndIf
                       
                        y = j*10
                       
                        id = id +1
                        Read c
                       
                        locates.pos = New pos

                        locates\id = id
                        locates\i  = i
                        locates\j  = j
                        If c = 1 Then
                        locates\wall  = c
                        locates\wx  = x
                        locates\wy  = y                       
                        Else If c = 2 Then
                        locates\wood  = c
                        locates\x  = x
                        locates\y  = y       
                        Else
                        locates\x  = x
                        locates\y  = y                       
                        EndIf

        Next
Next
FlushMouse
While Not KeyHit(1)
Cls
mx = MouseX() : my = MouseY()

        ; управление картой
        If KeyDown(205) Then sx=sx+5
        If KeyDown(203) Then sx=sx-5
        If KeyDown(200) Then sy=sy-5
        If KeyDown(208) Then sy=sy+5
       
        ; рисуем гексо-сетку
        For j=0 To tiley-1
        For i=0 To tilex-1
               
                If (j Mod 2)  Then
                        x =  i*(d+dd)
                Else
                        x =  i*(d+dd)+( dd+ddd)
                EndIf       
                        y = j*10
                       
                DrawImage imgtile ,sx+x ,sy+y
        Next
        Next
       
        ; главный цикл перебора
        For locates.pos = Each pos

                If locates\wall Then ; генерация стен
                        DrawImage wall ,sx+locates\wx ,(sy+locates\wy)-10
                EndIf

                If locates\wood Then ; генерация стен
                        DrawImage woods ,sx+locates\x+Rnd(7,12) ,(sy+locates\y)-Rnd(11,15)
                EndIf
               
                        If locates\i = pozx And locates\j=pozy Then ; проверка положения героя (сырой вариант)
                       
                                ;вычиление положения героя и напрвления движения
                                       
                                Select True         
                                        Case ShipX< LastClickX And ShipY< LastClickY
                                                ShipX = ShipX + 5        :OldClickX = OldClickX + 5       
                                                ShipY = ShipY + 5  :OldClickY = OldClickY + 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (1) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку       
                                               
                                        Case ShipX< LastClickX And ShipY> LastClickY
                                                ShipX = ShipX + 5        :OldClickX = OldClickX + 5       
                                                ShipY = ShipY - 5  :OldClickY = OldClickY - 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (4) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку       
                                               
                                        Case ShipX> LastClickX And ShipY< LastClickY
                                                ShipX = ShipX - 5        :OldClickX = OldClickX - 5       
                                                ShipY = ShipY + 5  :OldClickY = OldClickY + 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (1) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку       
                                               
                                        Case ShipX> LastClickX And ShipY> LastClickY
                                                ShipX = ShipX - 5        :OldClickX = OldClickX - 5       
                                                ShipY = ShipY - 5  :OldClickY = OldClickY - 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (4) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку       
                                                                                               
                                        Case ShipX< LastClickX And ShipY= LastClickY
                                                ShipX = ShipX + 5        :OldClickX = OldClickX + 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (3) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k2 ; рисуем картинку       
                                                                               
                                        Case ShipX> LastClickX And ShipY= LastClickY
                                                ShipX = ShipX - 5    :OldClickX = OldClickX - 5
                                                k3 = (k3 + 1) Mod (3) + (3 * (2) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k3 ; рисуем картинку       
                                                                               
                                        Case ShipY< LastClickY And ShipX= LastClickX
                                                ShipY = ShipY + 5  :OldClickY = OldClickY + 5
                                k = (k + 1) Mod (3) + (3 * (1) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k ; рисуем картинку
                                                                                       
                                        Case ShipY> LastClickY And ShipX= LastClickX
                                                ShipY = ShipY - 5        :OldClickY = OldClickY - 5
                                                k4 = (k4 + 1) Mod (3) + (3 * (4) - 3)
                                                DrawImage geroy,ShipX-15 ,ShipY ,k4 ; рисуем картинку               
                                                                       
                                        Default
                                                DrawImage geroy,(ShipX-15) ,ShipY ,1 ; рисуем картинку
                                End Select                                         
                               
                                If sx+ShipX = locates\wx And sy+ShipY = locates\wy
                               
                                EndIf


                        EndIf       
                ;EndIf
                ; проверка на попадание мыши в гексагон
                If  InsideHexagon(mx,my,sx+locates\x+0,sy+locates\y+10,sx+locates\x+10,sy+locates\y+0,sx+locates\x+30,sy+locates\y+0,sx+locates\x+40,sy+locates\y+10,sx+locates\x+30,sy+locates\y+20,sx+locates\x+10,sy+locates\y+20)=1 Then
                        DrawImage imgtile0 ,sx+locates\x ,sy+locates\y
                       
                       
                        If MouseHit( 1 )
                                OldClickX = LastClickX  ; старые координаты мыши после клика мыши
                                OldClickY = LastClickY                               
                                LastClickX = locates\x+15 ; новые координаты мыши после клика мыши
                                LastClickY = locates\y-10
                               
                                pozx = locates\i ; номера ячеек после клика мыши
                                pozy = locates\j
                        Else
                                Text 10, 0," "+locates\i+"."+locates\j ;выводит номера ячеек под мышью
                        EndIf
                EndIf

        Next

        ; инфо
        Text 10, 10," "+pozx+"."+pozy
        Text 10, 30,"  "+OldClickX+"_"+OldClickY+"  "+LastClickX+"_"+LastClickY
        Text 10, 40," ShipX =  "+ShipX+" | ShipY = "+ShipY
               
Flip
Wend
; высвобождаем память
Delete Each pos
FreeImage wall
FreeImage woods
FreeImage  imgtile
FreeImage  imgtile0
End



; данные карты
.map_data
Data 1,1,1,1,1,1,1,1,1,1,1,1,1                ,1,1,1,1,1,1,1,1,1,1,1,1,1                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,2,0,0,0,0,0,0,0,1                ,1,0,0,0,2,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,2,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,1,1,0,0,0,0,1                ,1,0,0,0,0,1,1,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,1,0,0,0,0,0,0,1                ,1,0,0,0,0,1,0,0,0,0,0,0,0                ,0,0,0,0,1,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,1,0,0,0,0,0,0,0,1                ,1,0,0,0,1,0,0,0,0,1,0,0,0                ,0,0,0,1,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1                ,1,1,1,1,1,1,1,1,1,1,1,1,1                ;,1,1,1,1,1,1,1,1,1,1,1,1,1                ,1,1,1,1,1,1,1,1,1,1,1,1,1

;--------------- функция проверки точки в гексагоне ---------------------------------------------------
Function dot(x0,y0,x1,y1,x2,y2)
        Return (x1-x0)*(y2-y1)-(x2-x1)*(y1-y0)
End Function

Function InsideHexagon(px,py,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,x5,y5)
        If dot(x0,y0,x1,y1,px,py)>0
                If dot(x1,y1,x2,y2,px,py)>0
                        If dot(x2,y2,x3,y3,px,py)>0
                                If dot(x3,y3,x4,y4,px,py)>0
                                        If dot(x4,y4,x5,y5,px,py)>0
                                                If dot(x5,y5,x0,y0,px,py)>0
                                                        Return True
                                                EndIf
                                        EndIf
                                EndIf
                        EndIf
                EndIf
        EndIf
End Function
;________________________________________________________________________



картинка во вложении

polopok 18.06.2012 16:03

Ответ: гексогональная тайловая карта(изометрия)
 
Вложений: 1
Появились новые текстуры...

Код:



Type Pos
Field x,y,id
Field i,j
Field wood ,wdx ,wdy
Field wall ,wx ,wy
Field tree
End Type


Graphics 800,600,32 ,2

geroy =LoadAnimImage("images\tip.png",32,32,0,12) :MaskImage geroy,0,0,0
trees =LoadAnimImage("images\trees1.png",40,36,0,6) :MaskImage trees,0,0,0
grass =LoadAnimImage("images\grass1.png",40,40,0,5) :MaskImage grass ,0,0,0
dom  =LoadImage("images\dom.png") :MaskImage dom,0,0,0
;grass =LoadImage("images\grass.png") ;:MaskImage geroy,0,0,0
imgtile=CreateImage(41,21)
SetBuffer ImageBuffer(imgtile) ;картинка гекса
        Color 125,22,22
        Line 0,10,10,0
        Line 10,0,30,0
        Line 30,0,40,10
        Line 40,10,30,20
        Line 30,20,10,20
        Line 10,20,0,10
        Color 255,255,255
imgtile0=CreateImage(41,21)
SetBuffer ImageBuffer(imgtile0) ;картинка мыши
        Color 5,0,255
        Rect  10,0,20,20,0
        Color 255,255,255
SetBuffer BackBuffer()


Restore map_data

d =40  :dd =(d/2) : ddd =(dd/2)
tilex=13  : tiley=58 ;количество ячеек 13*58
sx=  0 : sy=10
pozx = 3
pozy = 3
ShipX = 165 : LastClickX = 165 : OldClickX = 165
ShipY = 30  : LastClickY = 30  : OldClickY = 30
For j=0 To tiley-1
        For i=0 To tilex-1
               
                If (j Mod 2)  Then
                        x =  i*(d+dd)
                Else
                        x =  i*(d+dd)+( dd+ddd)
                EndIf
                       
                        y = j*10
                       
                        id = id +1
                        Read c
                       
                        locates.pos = New pos

                        locates\id = id
                        locates\i  = i
                        locates\j  = j
                        If c = 1 Then
                        locates\wall  = c
                        locates\wx  = x
                        locates\wy  = y                       
                        Else If c = 2 Then
                        locates\wood  = c
                        locates\x  = x
                        locates\y  = y       
                        locates\tree = Rnd(1,5)
                        Else
                        locates\x  = x
                        locates\y  = y                       
                        EndIf

        Next
Next
FlushMouse
While Not KeyHit(1)
ClsColor 35,60,60
Cls
mx = MouseX() : my = MouseY()

        ; управление картой
        If KeyDown(205) Then sx=sx+5
        If KeyDown(203) Then sx=sx-5
        If KeyDown(200) Then sy=sy-5
        If KeyDown(208) Then sy=sy+5
       
        ; рисуем гексо-сетку
        For j=0 To tiley-1
        For i=0 To tilex-1
               
                If (j Mod 2)  Then
                        x =  i*(d+dd)
                Else
                        x =  i*(d+dd)+( dd+ddd)
                EndIf       
                        y = j*10
                       
                DrawImage grass ,sx+x ,sy+y,gr = (gr + 1) Mod (3) + (3 * (4) - 3)
        Next
        Next
       
        ; главный цикл перебора
        For locates.pos = Each pos

                If locates\wall Then ; генерация стен
                        DrawImage dom ,sx+locates\wx ,(sy+locates\wy)-10
                EndIf
               
                        If locates\i = pozx And locates\j=pozy Then ; проверка положения героя (сырой вариант)
                       
                                ;вычиление положения героя и напрвления движения
                                       
                                Select True         
                                        Case ShipX< LastClickX And ShipY< LastClickY
                                                ShipX = ShipX + 5        :OldClickX = OldClickX + 5       
                                                ShipY = ShipY + 5  :OldClickY = OldClickY + 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (1) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку       
                                               
                                        Case ShipX< LastClickX And ShipY> LastClickY
                                                ShipX = ShipX + 5        :OldClickX = OldClickX + 5       
                                                ShipY = ShipY - 5  :OldClickY = OldClickY - 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (4) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку       
                                               
                                        Case ShipX> LastClickX And ShipY< LastClickY
                                                ShipX = ShipX - 5        :OldClickX = OldClickX - 5       
                                                ShipY = ShipY + 5  :OldClickY = OldClickY + 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (1) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку       
                                               
                                        Case ShipX> LastClickX And ShipY> LastClickY
                                                ShipX = ShipX - 5        :OldClickX = OldClickX - 5       
                                                ShipY = ShipY - 5  :OldClickY = OldClickY - 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (4) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку       
                                                                                               
                                        Case ShipX< LastClickX And ShipY= LastClickY
                                                ShipX = ShipX + 5        :OldClickX = OldClickX + 5
                                                k2 = (k2 + 1) Mod (3) + (3 * (3) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k2 ; рисуем картинку       
                                                                               
                                        Case ShipX> LastClickX And ShipY= LastClickY
                                                ShipX = ShipX - 5    :OldClickX = OldClickX - 5
                                                k3 = (k3 + 1) Mod (3) + (3 * (2) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k3 ; рисуем картинку       
                                                                               
                                        Case ShipY< LastClickY And ShipX= LastClickX
                                                ShipY = ShipY + 5  :OldClickY = OldClickY + 5
                                k = (k + 1) Mod (3) + (3 * (1) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k ; рисуем картинку
                                                                                       
                                        Case ShipY> LastClickY And ShipX= LastClickX
                                                ShipY = ShipY - 5        :OldClickY = OldClickY - 5
                                                k4 = (k4 + 1) Mod (3) + (3 * (4) - 3)
                                                DrawImage geroy,sx+ShipX-15 ,sy+ShipY ,k4 ; рисуем картинку       
                                                                       
                                        Default
                                                DrawImage geroy,sx+(ShipX-15) ,sy+ShipY ,1 ; рисуем картинку
                                End Select
                                                                       
                        EndIf       
                If locates\wood Then ; генерация стен
                        DrawImage trees ,sx+locates\x ,(sy+locates\y),locates\tree
                EndIf
                ; проверка на попадание мыши в гексагон
                If  InsideHexagon(mx,my,sx+locates\x+0,sy+locates\y+10,sx+locates\x+10,sy+locates\y+0,sx+locates\x+30,sy+locates\y+0,sx+locates\x+40,sy+locates\y+10,sx+locates\x+30,sy+locates\y+20,sx+locates\x+10,sy+locates\y+20)=1 Then
                        DrawImage imgtile0 ,sx+locates\x ,sy+locates\y
                       
                        If MouseHit( 1 )
                        FlushMouse
                                OldClickX = LastClickX  ; старые координаты мыши после клика мыши
                                OldClickY = LastClickY                               
                                LastClickX = locates\x+15 ; новые координаты мыши после клика мыши
                                LastClickY = locates\y-10
                               
                                pozx = locates\i ; номера ячеек после клика мыши
                                pozy = locates\j
                        Else
                                Text 10, 0," "+locates\i+"."+locates\j ;выводит номера ячеек под мышью
                        EndIf
                EndIf

        Next

        ; инфо
        Color 50,50,50
        Rect 5,15,145,35
        Color 255,255,255
        Text 10, 10," "+pozx+"."+pozy
        Text 10, 20,"  "+OldClickX+"_"+OldClickY+"  "+LastClickX+"_"+LastClickY
        Text 10, 30," ShipX =  "+ShipX+" | ShipY = "+ShipY
               
Flip
Wend
; высвобождаем память
Delete Each pos
FreeImage  imgtile
FreeImage  imgtile0
FreeImage  geroy
FreeImage dom
FreeImage grass
End



; данные карты
.map_data
Data 1,1,1,1,1,1,1,1,1,1,1,1,1                ,1,1,1,1,1,1,1,1,1,1,1,1,1                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,2,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,2,2,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,2,2,0,0,0,0
Data 0,0,0,0,2,0,0,0,0,0,0,0,1                ,1,0,0,0,2,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,2,0,0,0,1                ,1,0,0,0,0,0,0,2,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,1,1,0,0,0,0,1                ,1,0,0,0,0,1,1,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,1,0,0,0,0,0,0,1                ,1,0,0,0,0,1,0,0,0,0,0,0,0                ,0,0,0,0,1,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,1,0,0,0,0,0,0,0,1                ,1,0,0,0,1,0,0,0,0,1,0,0,0                ,0,0,0,1,0,0,0,0,0,0,0,0,1                ,1,0,0,0,2,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,2,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,2,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,2,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0                ,0,0,0,0,0,0,0,0,0,0,0,0,1                ,1,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1                ,1,1,1,1,1,1,1,1,1,1,1,1,1                ;,1,1,1,1,1,1,1,1,1,1,1,1,1                ,1,1,1,1,1,1,1,1,1,1,1,1,1

;--------------- функция проверки точки в гексагоне ---------------------------------------------------
Function dot(x0,y0,x1,y1,x2,y2)
        Return (x1-x0)*(y2-y1)-(x2-x1)*(y1-y0)
End Function

Function InsideHexagon(px,py,x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,x5,y5)
        If dot(x0,y0,x1,y1,px,py)>0
                If dot(x1,y1,x2,y2,px,py)>0
                        If dot(x2,y2,x3,y3,px,py)>0
                                If dot(x3,y3,x4,y4,px,py)>0
                                        If dot(x4,y4,x5,y5,px,py)>0
                                                If dot(x5,y5,x0,y0,px,py)>0
                                                        Return True
                                                EndIf
                                        EndIf
                                EndIf
                        EndIf
                EndIf
        EndIf
End Function
;________________________________________________________________________


Распаковать архив в папку с сохранённой программой !( в архиве необходимые текстуры)

Jlemyp 18.06.2012 20:45

Ответ: гексогональная тайловая карта(изометрия)
 
Спасибо кажется разобрался.Если возникнут вопросы на которые сам не найду решения,задам.Надеюсь поможешь.(это не вопрос а задумка:мне нужно будет знать какие номера саседних гексов будут находится вокруг игрока,что бы узнать проходимый или нет).Если знаешь сразу ответ не откажусь от подсказки.

polopok 20.06.2012 12:58

Ответ: гексогональная тайловая карта(изометрия)
 
Так номера вычислить просто . Берём номер ячейки персонажа ,например 2,4 _(i,j) ,тогда номера вокруг персонажа будут ,при моей форме гексов
_____ 2,4-2 _____
2,4-1| 2,4 | 2+1,4-1
2,4+1 ______ 2+1,4+1
_____|2,4+2 |______

polopok 21.06.2012 17:33

Ответ: гексогональная тайловая карта(изометрия)
 
Вложений: 1
Продолжаем ...
Теперь можно добавлять новых героев (нажав на клавиатуре цифру 1
Так же несколько изменён код

Продолжение следует ... :)

polopok 01.07.2012 13:01

Ответ: гексогональная тайловая карта(изометрия)
 
Итак начнём сначала и постепенно будем усложнять .
Здесь :
  1. прорисовка тайлов
  2. определение тайла по нажатии мыши
  3. прорисовка только тех гексов ,что находятся в зоне видимости
  4. зона вывода меню для всякого рода кнопок ,мини карты ,ресурсов и тд.
  5. вывод инфо
Для просмотра кода нажмите OFFTOP
Код:

;_______________________________________________________________________________

Global gex_grass , gex , gex_activ , gex_water , gex_wall , gex_wood
Global tilex , tiley , CamX , CamY , HexagonNumber , N
Global w , h , pw , h2 , oldx , oldy , kx , ky , xx , yy , sxx , syy , sx# , sy# , mouseSelect , mx# , my#

Const GrWidth = 800        ;ширина экрана
Const GrHeight = 600        ;высота  экрана
;_______________________________________________________________________________
       
Graphics GrWidth , GrHeight , 32 , 2

        fntArial=LoadFont("Arial",14)                ;загрузка шрифта с указанием размера шрифта
        SetFont fntArial                                ;активация шрифта
       
        ; вычисление центра экрана :
        CenterMapX = GrWidth/2                        ;половина ширины экрана
        CenterMapY = GrHeight/2                ;половина высоты  экрана
       
        w = 40                                                ;ширина тайла
        h = 20                                                ;высота тайла
        tilex =10                                                ;кол-во тайлов по горизонтали
        tiley = 5                                                ;кол-во тайлов по вертикали
       
        pw = w/4*3                                        ;параметр смещения тайлов по горизонтали
        h2 = h/2                                                ;половина высоты тайла
       
        ;позиция камеры :
        CamX =0                                               
        CamY =0               
               
        Dim Map( tilex+1 +10,  tiley+1 +10)
;gex = LoadImage ("hex3.png") :MaskImage gex,255,255,255
        CreateImages()        ;создаём или загружаем  изображения , анимированые изображения
        LoadMap( "D:\vitalii\blitz\гексы\maps2.txt")
SetBuffer BackBuffer()        ;устанавливаем задний буффер

;__________ Main programm _____________________________________________________________________

While Not KeyHit(1)                                        ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112                                ;цвет очистки экрана
Cls                                                                ;очистка экрана
        mx# = MouseX() : my# = MouseY()        ; координаты мыши

        DrawMap()                                        ;прорисовываем карту       
        KeyMouse()                                        ;события мыши , клавиатуры
               
               

               
        DrawMenu()                                        ;прорисовка меню в игре
        Text mx,my,"^"                                        ;отображает положение курсора
       
;__________ Info  _____________________________________________________________________
       
        Info()
;______________________________________________________________________________
               
Flip                                                                ; Меняем буфер
Wend
FreeFont fntArial                                        ; удаляем шрифт
End

;_______________________________________________________________________________
       
        Function Info()
                Text 100 ,525 ,"kx : "+kx+"  ky :"+ky+"  oldx : "+oldx +" oldy : "+oldy;+"  ix : "+ix +" jy : "+jy
                Text 100 ,540 ," U : "+sxx+"  V :"+syy
                Text 100 ,555 ," Mouse X : "+xx+"  Mouse Y :"+yy
        ;        Text 100 ,575 ,"Координаты мышы в сетке : UX : "+mx+"  VY :"+my       
        End Function
;_______________________________________________________________________________
               
        Function KeyMouse()       
                               
                                If KeyHit(49) Then N = 1 - N                                        ; (отобразить | скрыть) id ячейки по нажатию клавиши N
                                If MouseDown(2) Then  mouseSelect = False                ; сброс выбора ячейки
                                If MouseDown(1) Then                                                ; выбор ячейки
                               
                                        oldx = kx : oldy = ky                                                ; старые координаты мыши
                                        sx# =Floor#  (mx# /(w+0.15) * 4/3 - 0.15)        ; вычисление номера ячейки по горизонтали
                                        sy# =Floor#  ( my# /h - (sx# Mod 2)/2 )                ; вычисление номера ячейки по вертикали 
                                        sxx = Int (sx#)                                                        ; округление результата
                                        syy = Int (sy#)
                               
                                                xx = sxx * pw                                                ; вычисление координат ячейки по номеру  ячейки
                                                yy = syy * h +(sxx Mod 2)*h2       
                                               
                                        mouseSelect = True
                                Else
                                        kx = xx : ky = yy                                                ; новые координаты мыши
                                EndIf
        End Function                         
;_______________________________________________________________________________
                                       
        Function DrawMap()
                For j=0 To tiley
                        For i=0 To tilex
                                                        x = i * pw                                                        ; вычисление координат ячейки по номеру
                                                        y = (j * h +(i Mod 2)*h2)
                                                       
                                                       
                                                       
                                If RectsOverlap (0 , 0 , 600  ,  500  , x , y , w , h ) Then        ; прорисовывает только то ,что попадает в зону видимости экрана       
                               
                                                        DrawImage gex, x +CamX , y  +CamY                ; прорисовывает гексы
                                                If Map(i , j) <= 0
                                                        DrawImage gex_grass, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "0"
                                                       
                                                Else If Map(i , j) = 1
                                                        DrawImage gex_wood, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "1"
                                                       
                                                Else If Map(i , j) = 2
                                                        DrawImage gex_wall, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "2"
                                                       
                                                Else If Map(i , j) = 3
                                                        DrawImage gex_water, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "3"
                                                       
                                                Else If Map(i , j) = 4
                                                        ;DrawImage gex_water, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "4"
                                                EndIf
                                               
                                        If N = 1 Then                                                                        ; id только в целях отладки ! Так как жутко тормозит                                                       
                                                HexagonNumber = i+ j * tilex                                        ; id ячейки
                                                Text  x +CamX  +10, y  +CamY +5 , HexagonNumber        ; текст id ячейки
                                        EndIf               

                                        If mouseSelect = True Then                ;если ячейка выбрана рисовать ...
                                                DrawImage gex_activ , kx +locx , ky +locy
                                        EndIf                       
                                               
                                End If       
                              Next
                Next
        End Function
;_______________________________________________________________________________
               
        Function LoadMap(file$)
       
                filein = ReadFile(file$)
                mapline = 0
                If filein <> 0 Then
                While Not Eof(filein)
                mapStr$ = ReadLine$(filein)
                Wend               
                CloseFile(filein)               
                                For j=0 To tilex
                                                        For i=0 To tilex
                                                                mapline  = mapline  +1
                                                                Map(i , j ) = Int( Mid (mapStr$, mapline  , 1))       
                                                                                               
                                                              Next
                                Next
                               
                        Else       
                                               
                        RuntimeError "Такого файла нет"
                        CloseFile(filein)
                        Delay 1000
                        ;Exit
               

                        End If
        End Function
;_______________________________________________________________________________
       
        Function DrawMenu()
                        Color 0 , 109 , 39                               
                                Rect 0 , 0 , 600 , 500 ,0
                                Color 139 , 134 , 78       
                                Rect 600 , 0 , 200 , 500 ,1               
                                Rect 0 , 500 , 800 , 100 ,1       
                        Color 255,255,255
        End Function
;_______________________________________________________________________________
       
        Function CreateImages()
                gex = CreateImage(w+1,h+1)                ; создаём изображение гекса
                SetBuffer ImageBuffer(gex)
                Color 238,118,0
                Line 0,h/2                ,w/4,0
                Line w/4,0        ,pw,0
                Line pw,0        ,w,h/2
                Line w,h/2        ,pw,h
                Line pw,h        ,w/4,h
                Line w/4,h        ,0,h/2
               
                gex_activ = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_activ)
                        Color 102,5,0
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_grass = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_grass)
                        Color 50,205,50
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_water = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_water)
                        Color 0,206,209
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_wall = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_wall)
                        Color 205,197,191
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_wood = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_wood)
                        SeedRnd MilliSecs()
                        Color 0,197,90
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                        For q1 = 0 To Rnd(12,46)
                                Color 5,Rnd(40,180),Rnd(40,180)
                                Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
                        Next
                       
                Color 255,255,255
        End Function


polopok 01.07.2012 21:05

Ответ: гексогональная тайловая карта(изометрия)
 
Добавил загрузку карты .
Прежде чем запустить этот код создайте карту в редакторе катры (он ниже)

Код:

;_______________________________________________________________________________

Global gex_grass , gex , gex_activ , gex_water , gex_wall , gex_wood
Global tilex , tiley , CamX , CamY , HexagonNumber , N
Global w , h , pw , h2 , oldx , oldy , kx , ky , xx , yy , sxx , syy , sx# , sy# , mouseSelect , mx# , my#

Const GrWidth = 800        ;ширина экрана
Const GrHeight = 600        ;высота  экрана
;_______________________________________________________________________________
       
Graphics GrWidth , GrHeight , 32 , 2

        fntArial=LoadFont("Arial",14)                ;загрузка шрифта с указанием размера шрифта
        SetFont fntArial                                ;активация шрифта
       
        ; вычисление центра экрана :
        CenterMapX = GrWidth/2                        ;половина ширины экрана
        CenterMapY = GrHeight/2                ;половина высоты  экрана
       
        w = 40                                                ;ширина тайла
        h = 20                                                ;высота тайла
        tilex =10                                                ;кол-во тайлов по горизонтали
        tiley = 5                                                ;кол-во тайлов по вертикали
       
        pw = w/4*3                                        ;параметр смещения тайлов по горизонтали
        h2 = h/2                                                ;половина высоты тайла
       
        ;позиция камеры :
        CamX =0                                               
        CamY =0               
               
        Dim Map( tilex+1 +10,  tiley+1 +10)
;gex = LoadImage ("hex3.png") :MaskImage gex,255,255,255
        CreateImages()        ;создаём или загружаем  изображения , анимированые изображения
        LoadMap( "D:\vitalii\blitz\гексы\maps2.txt")
SetBuffer BackBuffer()        ;устанавливаем задний буффер

;__________ Main programm _____________________________________________________________________

While Not KeyHit(1)                                        ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112                                ;цвет очистки экрана
Cls                                                                ;очистка экрана
        mx# = MouseX() : my# = MouseY()        ; координаты мыши

        DrawMap()                                        ;прорисовываем карту       
        KeyMouse()                                        ;события мыши , клавиатуры
               
               

               
        DrawMenu()                                        ;прорисовка меню в игре
        Text mx,my,"^"                                        ;отображает положение курсора
       
;__________ Info  _____________________________________________________________________
       
        Info()
;______________________________________________________________________________
               
Flip                                                                ; Меняем буфер
Wend
FreeFont fntArial                                        ; удаляем шрифт
End

;_______________________________________________________________________________
       
        Function Info()
                Text 100 ,525 ,"kx : "+kx+"  ky :"+ky+"  oldx : "+oldx +" oldy : "+oldy;+"  ix : "+ix +" jy : "+jy
                Text 100 ,540 ," U : "+sxx+"  V :"+syy
                Text 100 ,555 ," Mouse X : "+xx+"  Mouse Y :"+yy
        ;        Text 100 ,575 ,"Координаты мышы в сетке : UX : "+mx+"  VY :"+my       
        End Function
;_______________________________________________________________________________
               
        Function KeyMouse()       
                               
                                If KeyHit(49) Then N = 1 - N                                        ; (отобразить | скрыть) id ячейки по нажатию клавиши N
                                If MouseDown(2) Then  mouseSelect = False                ; сброс выбора ячейки
                                If MouseDown(1) Then                                                ; выбор ячейки
                               
                                        oldx = kx : oldy = ky                                                ; старые координаты мыши
                                        sx# =Floor#  (mx# /(w+0.15) * 4/3 - 0.15)        ; вычисление номера ячейки по горизонтали
                                        sy# =Floor#  ( my# /h - (sx# Mod 2)/2 )                ; вычисление номера ячейки по вертикали 
                                        sxx = Int (sx#)                                                        ; округление результата
                                        syy = Int (sy#)
                               
                                                xx = sxx * pw                                                ; вычисление координат ячейки по номеру  ячейки
                                                yy = syy * h +(sxx Mod 2)*h2       
                                               
                                        mouseSelect = True
                                Else
                                        kx = xx : ky = yy                                                ; новые координаты мыши
                                EndIf
        End Function                         
;_______________________________________________________________________________
                                       
        Function DrawMap()
                For j=0 To tiley
                        For i=0 To tilex
                                                        x = i * pw                                                        ; вычисление координат ячейки по номеру
                                                        y = (j * h +(i Mod 2)*h2)
                                                       
                                                       
                                                       
                                If RectsOverlap (0 , 0 , 600  ,  500  , x , y , w , h ) Then        ; прорисовывает только то ,что попадает в зону видимости экрана       
                               
                                                        DrawImage gex, x +CamX , y  +CamY                ; прорисовывает гексы
                                                If Map(i , j) <= 0
                                                        DrawImage gex_grass, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "0"
                                                       
                                                Else If Map(i , j) = 1
                                                        DrawImage gex_wood, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "1"
                                                       
                                                Else If Map(i , j) = 2
                                                        DrawImage gex_wall, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "2"
                                                       
                                                Else If Map(i , j) = 3
                                                        DrawImage gex_water, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "3"
                                                       
                                                Else If Map(i , j) = 4
                                                        ;DrawImage gex_water, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "4"
                                                EndIf
                                               
                                        If N = 1 Then                                                                        ; id только в целях отладки ! Так как жутко тормозит                                                       
                                                HexagonNumber = i+ j * tilex                                        ; id ячейки
                                                Text  x +CamX  +10, y  +CamY +5 , HexagonNumber        ; текст id ячейки
                                        EndIf               

                                        If mouseSelect = True Then                ;если ячейка выбрана рисовать ...
                                                DrawImage gex_activ , kx +locx , ky +locy
                                        EndIf                       
                                               
                                End If       
                              Next
                Next
        End Function
;_______________________________________________________________________________
               
        Function LoadMap(file$)
       
                filein = ReadFile(file$)
                mapline = 0
                If filein <> 0 Then
                While Not Eof(filein)
                mapStr$ = ReadLine$(filein)
                Wend               
                CloseFile(filein)               
                                For j=0 To tilex
                                                        For i=0 To tilex
                                                                mapline  = mapline  +1
                                                                Map(i , j ) = Int( Mid (mapStr$, mapline  , 1))       
                                                                                               
                                                              Next
                                Next
                               
                        Else       
                                               
                        RuntimeError "Такого файла нет"
                        CloseFile(filein)
                        Delay 1000
                        ;Exit
               

                        End If
        End Function
;_______________________________________________________________________________
       
        Function DrawMenu()
                        Color 0 , 109 , 39                               
                                Rect 0 , 0 , 600 , 500 ,0
                                Color 139 , 134 , 78       
                                Rect 600 , 0 , 200 , 500 ,1               
                                Rect 0 , 500 , 800 , 100 ,1       
                        Color 255,255,255
        End Function
;_______________________________________________________________________________
       
        Function CreateImages()
                gex = CreateImage(w+1,h+1)                ; создаём изображение гекса
                SetBuffer ImageBuffer(gex)
                Color 238,118,0
                Line 0,h/2                ,w/4,0
                Line w/4,0        ,pw,0
                Line pw,0        ,w,h/2
                Line w,h/2        ,pw,h
                Line pw,h        ,w/4,h
                Line w/4,h        ,0,h/2
               
                gex_activ = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_activ)
                        Color 102,5,0
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_grass = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_grass)
                        Color 50,205,50
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_water = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_water)
                        Color 0,206,209
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_wall = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_wall)
                        Color 205,197,191
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                gex_wood = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_wood)
                        SeedRnd MilliSecs()
                        Color 0,197,90
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                        For q1 = 0 To Rnd(12,46)
                                Color 5,Rnd(40,180),Rnd(40,180)
                                Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
                        Next
                       
                Color 255,255,255
        End Function



Редактор карты :
Код:

;_______________________________________________________________________________

Global  image0 , gex , gex_activ ,  image1 ,  image2 ,  image3
Global tilex , tiley , CamX , CamY , sel
Global w , h , pw , h2 , oldx , oldy , kx , ky , xx , yy , sxx , syy , sx# , sy# , mouseSelect , mx# , my#

Const GrWidth = 800        ;ширина экрана
Const GrHeight = 600        ;высота  экрана
;_______________________________________________________________________________
       
Graphics GrWidth , GrHeight , 32 , 2

        fntArial=LoadFont("Arial",14)                ;загрузка шрифта с указанием размера шрифта
        SetFont fntArial                                ;активация шрифта
       
        ; вычисление центра экрана :
        CenterMapX = GrWidth/2                        ;половина ширины экрана
        CenterMapY = GrHeight/2                ;половина высоты  экрана
       
        w = 40                                                ;ширина тайла
        h = 20                                                ;высота тайла
        tilex =10                                                ;кол-во тайлов по горизонтали
        tiley = 5                                                ;кол-во тайлов по вертикали
       
        pw = w/4*3                                        ;параметр смещения тайлов по горизонтали
        h2 = h/2                                                ;половина высоты тайла
       
        ;позиция камеры :
        CamX =0                                               
        CamY =0               
               
        Dim Map( tilex+1 ,  tiley+1 )
;gex = LoadImage ("hex3.png") :MaskImage gex,255,255,255
        CreateImages()        ;создаём или загружаем  изображения , анимированые изображения
        ;SaveMap( "D:\vitalii\blitz\гексы\maps2.txt")
SetBuffer BackBuffer()        ;устанавливаем задний буффер

;__________ Main programm _____________________________________________________________________

While Not KeyHit(1)                                        ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112                                ;цвет очистки экрана
Cls                                                                ;очистка экрана
        mx# = MouseX() : my# = MouseY()        ; координаты мыши

        DrawMap()                                        ;прорисовываем карту       
        DrawMenu()                                        ;прорисовка меню в игре       
        DrawTiles()       
        KeyMouse()                                        ;события мыши , клавиатуры


        Text mx,my,"^"                                        ;отображает положение курсора
       
;__________ Info  _____________________________________________________________________
       
        Info()
;______________________________________________________________________________
               
Flip                                                                ; Меняем буфер
Wend
FreeFont fntArial                                        ; удаляем шрифт
End


;_______________________________________________________________________________
       
        Function DrawTiles()
                        Color 120,120,122                               
                                Rect 620 , 30 ,150 , 240 ,1
                        Color 0 , 109 , 39
                                Rect 620 , 30 ,150 , 240 ,0
                                DrawImage  image0,624 , 34
                                DrawImage  image1,624 , 34*2
                                DrawImage  image2,624 , 34*3
                                DrawImage  image3,624 , 34*4
                        Color 255,255,255
                                Text 664 , 34," - трава"
                                Text 664 , 34*2," - дерево"
                                Text 664 , 34*3," - стена"
                                Text 664 , 34*4," - вода"
                        Color 120,120,122                               
                                Rect 625 ,175 ,120 , 20 ,1
                        Color 0 , 109 , 39
                                Rect 625 , 175 ,120 , 20 ,0
                        Color 255,255,255
                                Text 635 , 177," Сохранить карту"
                                                       
        End Function
;_______________________________________________________________________________
       
        Function Info()
                Text 100 ,525 ,"kx : "+kx+"  ky :"+ky+"  oldx : "+oldx +" oldy : "+oldy;+"  ix : "+ix +" jy : "+jy
                Text 100 ,540 ," U : "+sxx+"  V :"+syy
                Text 100 ,555 ," Mouse X : "+xx+"  Mouse Y :"+yy
                Text 100 ,575 ," sel : "+sel;+"  VY :"+my       
        End Function
;_______________________________________________________________________________
               
        Function KeyMouse()       
                If mx < 600 Then
                                If MouseDown(2) Then  mouseSelect = False        : sel = 0        ; сброс выбора ячейки
                                If MouseDown(1) Then                                                ; выбор ячейки
                               
                                        oldx = kx : oldy = ky                                                ; старые координаты мыши
                                        sx# =Floor#  (mx# /(w+0.15) * 4/3 - 0.15)        ; вычисление номера ячейки по горизонтали
                                        sy# =Floor#  ( my# /h - (sx# Mod 2)/2 )                ; вычисление номера ячейки по вертикали 
                                        sxx = Int (sx#)                                                        ; округление результата
                                        syy = Int (sy#)
                               
                                                xx = sxx * pw                                                ; вычисление координат ячейки по номеру  ячейки
                                                yy = syy * h +(sxx Mod 2)*h2       
                                               
                                        mouseSelect = True
                                Else
                                        kx = xx : ky = yy                                                ; новые координаты мыши
                                EndIf
                Else
                       
                        For qq = 1 To 4
                        If RectsOverlap ( 624 , 34*qq , w , h , mx , my , 2 , 2) Then
                                Color 255,69,0
                                Rect 624 , 34*qq , w , h ,0
                                Color 255,255,255
                               
                                If  MouseDown(1) Then
                                        mouseSelect = False
                                        sel = qq
                                EndIf
                        End If
                        Next
                       
                        If RectsOverlap ( 625 , 175 ,120 , 20 , mx , my , 2 , 2) Then
                                Color 255,69,0
                                Rect 625 , 175 ,120 , 20 ,0
                                                Color 255,255,255
                                If  MouseDown(1) Then
                                        SaveMap( "D:\vitalii\blitz\гексы\maps2.txt")
                                                EndIf               
                        EndIf
                       
                End If
        End Function                         
;_______________________________________________________________________________
                                       
        Function DrawMap()
                For j=0 To tiley
                        For i=0 To tilex
                                                        x = i * pw                                                        ; вычисление координат ячейки по номеру
                                                        y = (j * h +(i Mod 2)*h2)
                                                       
                                                       
                                If RectsOverlap (0 , 0 , 600  ,  500  , x , y , w , h ) Then        ; прорисовывает только то ,что попадает в зону видимости экрана       
                               
                                                        DrawImage gex, x +CamX , y  +CamY                ; прорисовывает гексы
                                                If Map(i , j) <= 0
                                                        DrawImage image0, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "0"
                                                Else If Map(i , j) = 1
                                                        DrawImage image1, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "1"
                                                Else If Map(i , j) = 2
                                                        DrawImage image2, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "2"
                                                Else If Map(i , j) = 3
                                                        DrawImage image3, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "3"
                                                Else If Map(i , j) = 4
                                                        ;DrawImage gex_water, x +CamX , y  +CamY
                                                        Text  x +CamX  +10, y  +CamY +5 , "4"
                                                EndIf                       
                                        Select sel
                                                Case 0
                                                       
                                                Case 1
                                                        DrawImage  image0, mx +CamX , my  +CamY
                                                Case 2
                                                        DrawImage  image1, mx +CamX , my  +CamY
                                                Case 3
                                                        DrawImage  image2, mx +CamX , my  +CamY
                                                Case 4
                                                        DrawImage  image3, mx +CamX , my  +CamY
                                        End Select
                                        If mouseSelect = True Then                ;если ячейка выбрана рисовать ...
                                                If  sxx >-1 And sxx< tilex+1 And syy>-1 And syy< tiley+1 Then
                                                        Map(sxx , syy) = sel - 1
                                                EndIf       
                                        End If               
                                               
                                End If       
                              Next
                Next
        End Function
;_______________________________________________________________________________
               
        Function SaveMap(file$)
       
                fileout = WriteFile(file$)
               
                                For j=1 To tiley+1
                                                        For i=1 To tilex+1
                                                                String$ = String$+ Str (Map(i-1 , j-1))       
                                                                Text 635 , 200,"Идёт сохранение . . . "                               
                                                              Next
                                                Next
                        WriteLine( fileout, String$)
                        Text 635 , 200,"Сохранено !"
                CloseFile( fileout )

        End Function
;_______________________________________________________________________________
       
        Function DrawMenu()
                        Color 0 , 109 , 39                               
                                Rect 0 , 0 , 600 , 500 ,0
                                Color 139 , 134 , 78       
                                Rect 600 , 0 , 200 , 500 ,1               
                                Rect 0 , 500 , 800 , 100 ,1       
                        Color 255,255,255
        End Function
;_______________________________________________________________________________
       
        Function CreateImages()
                gex = CreateImage(w+1,h+1)                ; создаём изображение гекса
                SetBuffer ImageBuffer(gex)
                Color 238,118,0
                Line 0,h/2                ,w/4,0
                Line w/4,0        ,pw,0
                Line pw,0        ,w,h/2
                Line w,h/2        ,pw,h
                Line pw,h        ,w/4,h
                Line w/4,h        ,0,h/2
               
                gex_activ = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_activ)
                        Color 102,5,0
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image0 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image0)
                        Color 50,205,50
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image3 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image3)
                        Color 0,206,209
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image2 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image2)
                        Color 205,197,191
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image1 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image1)
                        SeedRnd MilliSecs()
                        Color 0,197,90
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                        For q1 = 0 To Rnd(12,46)
                                Color 5,Rnd(40,180),Rnd(40,180)
                                Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
                        Next
                       
                Color 255,255,255
        End Function


Черный крыс 01.07.2012 22:57

Ответ: гексогональная тайловая карта(изометрия)
 
Аффтар посмотри как это дело реализовано в БМаксовском фрэймворке DW Lab. - там все с открытыми исходниками.

polopok 02.07.2012 06:22

Ответ: гексогональная тайловая карта(изометрия)
 
Цитата:

Аффтар посмотри как это дело реализовано в БМаксовском фрэймворке DW Lab. - там все с открытыми исходниками.
Так я ж написал что постепенно буду усложнять ,править код ,видоизменять
Кстати , в основной программе нужно поменять путь :
LoadMap( "D:\vitalii\blitz\гексы\maps2.txt")

например на:
LoadMap( "maps2.txt")
А то будет выдавать что файла не существует

Nex 02.07.2012 06:56

Ответ: гексогональная тайловая карта(изометрия)
 
Полный путь не обязательно писать. Можно написать путь из папки игры. Например: "map\maps2.txt"

polopok 02.07.2012 08:04

Ответ: гексогональная тайловая карта(изометрия)
 
А я о чём !

Черный крыс 02.07.2012 13:57

Ответ: гексогональная тайловая карта(изометрия)
 
Абсолютные пути, конечно не допустимы, как было сказано - используй относительные пути к файлам.

Так вот я и посоветовал, прежде чем что то усложнять - посмотри как это делается ;) возможно появятся новые идеи и мысли по реализации.

polopok 02.07.2012 18:51

Ответ: гексогональная тайловая карта(изометрия)
 
Спасибо за совет ,в принципе у меня особой цели или идеи нет ,так баловство. Ну и конечно интересно . А вообще , думаю тем кто начинает или продолжает Блиц игрострой ,тоже интересно. Тем более по гексагонам тема на русском мало освещена , зато по ромбам инфы в достатке.
Так отдельная просьба присмотреться к этой теме может чем поможешь али посоветуешь.

polopok 05.07.2012 08:41

Ответ: гексогональная тайловая карта(изометрия)
 
Добавил скроллинг по карте ,мини карту :

Код:


        Type map
                Field i , j , x , y , tile
        End Type

Global w , h , w2 , h2 , tilex , tiley , camx , camy , cmapx , cmapy , speed# , cx , cy , posx , posy , positionscrollx , positionscrolly , plx , ply
Global sx# , sy# , sxx , syy , mx# , my# , xx , yy , kx , ky , oldx , oldy , sel , mouseSelect , ssx ,ssy ,f
Global plxx , plyy
Global gex , image1 , image2 , image3 , image4

Const GrWidth = 800        ;ширина экрана
Const GrHeight = 600        ;высота  экрана
;_______________________________________________________________________________
       
Graphics GrWidth , GrHeight , 32 , 2

        fntArial=LoadFont("Arial",14)                ;загрузка шрифта с указанием размера шрифта
        SetFont fntArial                                ;активация шрифта

        w = 40                                                ;ширина тайла
        h = 20                                                ;высота тайла
        tilex = 32                ;21                                ;кол-во тайлов по горизонтали
        tiley = 32                ;31                                ;кол-во тайлов по вертикали
        w2 = w/4*3                                        ;параметр смещения тайлов по горизонтали
        h2 = h/2                                                ;половина высоты тайла       
       
        ;вычисление центра карты
        posx = (tilex * w)/2 -120
        posy = (tiley * h)/2 -10
        ;вычисление центра экрана :
        cmapx = GrWidth/2        - 100                ;половина ширины экрана
        cmapy = GrHeight/2                                ;половина высоты  экрана       
       
        ;позиция камеры :
        camx =0                                               
        camy =0       
        ;позиция фокуса камеры:       
        positionscrollx = 510
        positionscrolly = 310
       
        CreateImages()
SetBuffer BackBuffer()        ;устанавливаем задний буффер

        s.map = CreateMap()
        MapScroll()       
       
;__________ Main programm _____________________________________________________________________
FlushMouse
MoveMouse 300,300
While Not KeyHit(1)                                        ;ESC для выхода из цикла и завершения программы
ClsColor 110,110,112                                ;цвет очистки экрана
Cls                                                                ;очистка экрана
        mx# = MouseX() : my# = MouseY()        ; координаты мыши
       
        SaveMap()
        LoadMap()       
        KeyMouse()
        MapScroll()
        MouseScroll()
        MouseSelTile()
        DrawMap()
        DrawMenu()
        DrawMiniMap()
        MouseInMiniMap()
        MouseSelect()

        Info()
Flip                                                                ; Меняем буфер
Wend
FreeFont fntArial                                        ; удаляем шрифт
End



;_______________________________________________________________________________
                                       
        Function LoadMap()
                If RectsOverlap (mx , my , 1 , 1 , 606 , 180+ 145, 100 ,25  ) And MouseDown(1) Then
                filein = ReadFile("karta.txt")
                mapStr$ = ReadLine$(filein)
                f=0
                        For s.map = Each map
                                Text 606 - camx , (180+ 145) -camy , "Идёт загрузка . . .  "
                                s\tile = Int( Mid (mapStr$, f+1  , 1))
                                f = f+1
                        Next
                        CloseFile( filein)
                        Text 606 - camx , (180+ 145) -camy , "Загружено !"
                EndIf
        End Function

;_______________________________________________________________________________
                                       
        Function SaveMap()
                If RectsOverlap (mx , my , 1 , 1 , 606 , 180+ 120, 100 ,25  ) And MouseHit(1) Then
                fileout = WriteFile("karta.txt")
                        For s.map = Each map
                                Text 606 - camx , (180+ 125) -camy , "Идёт сохранение . . . "
                                String$ = String$+ Str (s\tile)
                        Next
                        WriteLine( fileout, String$)
                        CloseFile( fileout )
                        Text 606 - camx , (180+ 125) -camy , "Сохранено !"
                EndIf
        End Function

;_______________________________________________________________________________
                                       
        Function MouseSelect()
                If sel = 1 Then DrawImage image1, mx -camx , my -camy
                If sel = 2 Then        DrawImage image2, mx -camx , my -camy
                If sel = 3 Then        DrawImage image3, mx -camx , my -camy
                If sel = 4 Then        DrawImage image4, mx -camx , my -camy
        End Function

;_______________________________________________________________________________
                                       
        Function MouseSelTile()
                If mx > 600 Then
                        For qs = 1 To 4
                                If RectsOverlap (mx , my , 1 , 1 , 606 , 180+ qs*h, w ,h  ) Then
                                        If MouseDown(1) Then
                                                sel = 0
                                                sel = qs
                                        EndIf
                                End If
                        Next
                End If
                Plot mx  - camx, my -camy
        End Function

;_______________________________________________________________________________
                                       
        Function MouseInMiniMap()
                If mx > 600 Then
                        If RectsOverlap (mx , my , 1 , 1 , 606 , 31 , 148 , 148 ) Then
                                If MouseHit(1) Then
                                        plx = (mx -606)
                                        ply = (my -31)
                                        plxx =  plx *6.6
                                        plyy = ply *4.5
                                       
                                        positionscrollx = plxx
                                        positionscrolly = plyy
                                EndIf
                        End If
                End If
                Plot mx  - camx, my -camy
        End Function

;_______________________________________________________________________________
                                       
        Function DrawMiniMap()
                        Color 0 , 0 , 0       
                                Rect 605 - camx , 30 -camy, 150 , 150 ,1
                        Color 0 , 109 , 39       
                                Rect 605 - camx , 30 -camy, 150 , 150 ,0
                        Color 0 , 109 , 39       
                                Rect 606 - camx , (180+ 120) -camy , 100 , 25 ,1
                        Color 0 , 109 , 39       
                                Rect 606 - camx , (180+ 145) -camy , 100 , 25 ,1
                        Color 255,255,255
                                Text 606 - camx , (180+ 120) -camy , " Сохранить карту "
                                Text 606 - camx , (180+ 145) -camy , " Загрузить карту "
                        Color 255,255,255
        End Function

;_______________________________________________________________________________
                                       
        Function DrawMenu()
                        Color 0 , 109 , 39                               
                                Rect 0 -camx , 0 -camy, 600 , 600 ,0
                        Color 139 , 134 , 78       
                                Rect 600 - camx , 0 -camy, 200 , 600 ,1       
       
                        Color 255,255,255
                       
                        DrawImage image1, 606 -camx , 180+ (h*1) -camy
                        DrawImage image2, 606 -camx , 180+ (h*2) -camy
                        DrawImage image3, 606 -camx , 180+ (h*3) -camy
                        DrawImage image4, 606 -camx , 180+ (h*4) -camy
        End Function

;_______________________________________________________________________________
                                       
        Function MouseScroll()
                If mx# > 25 Then positionscrollx = positionscrollx + 5
                        If positionscrollx > 705  Then positionscrollx = 705 ;positionscrollx = positionscrollx - 20 
                If mx# < GrWidth - 25 Then positionscrollx = positionscrollx - 5
                        If positionscrollx  < 300 Then positionscrollx = 300 ;positionscrollx = positionscrollx + 20 
               
                If my# > 25 Then positionscrolly = positionscrolly + 5
                        If positionscrolly > 380 Then  positionscrolly = 380 ;positionscrolly = positionscrolly - 20 
                If my# < GrHeight - 25 Then positionscrolly = positionscrolly - 5
                        If positionscrolly  < 295 Then positionscrolly = 295 ;positionscrolly = positionscrolly + 20 
                Origin camx , camy
        End Function
;_______________________________________________________________________________
                                       
        Function MapScroll()
                camx = camx + ((( -(positionscrollx ) + cmapx ) - camx ) * 0.09 )
                camy = camy + ((( -(positionscrolly ) + cmapy ) - camy ) * 0.09 )
        End Function

;_______________________________________________________________________________
                                       
        Function DrawMap()
                For s.map = Each map
                        If RectsOverlap (0 - camx , 0 - camy , 600  ,  600  , s\x , s\y , w , h ) Then        ; прорисовывает только то ,что попадает в зону видимости экрана       
                        DrawImage gex , s\x - cx , s\y - cy
                                If s\tile <= 1 Then DrawImage image1  , s\x - cx , s\y - cy
                                If s\tile = 2 Then DrawImage image2  , s\x - cx , s\y - cy
                                If s\tile = 3 Then DrawImage image3  , s\x - cx , s\y - cy
                                If s\tile = 4 Then DrawImage image4  , s\x - cx , s\y - cy
;                        Text s\x - cx + 5 , s\y - cy + 5 , s\i +"  "+s\j+"  "+s\tile
                                If mouseSelect = True Then
                                        If s\x = xx And s\y = yy Then
                                                s\tile = sel
                                        EndIf
                                EndIf
                        EndIf
                Next
                Text posx , posy ,"x"
                Text cmapx -camx , cmapy -camy ,"+"
               
        End Function

;_______________________________________________________________________________
               
        Function KeyMouse()       

                                If MouseDown(2) Then  mouseSelect = False        : sel = 0                ; сброс выбора ячейки
                                If MouseDown(1) Then                                                                ; выбор ячейки
                                        If mx# < 600
                                                oldx = kx : oldy = ky                                                        ; старые координаты мыши
                                                sx# =Floor# (( mx# -camx )  / (w+0.15) * 4/3 - 0.15 )        ; вычисление номера ячейки по горизонтали
                                                sy# =Floor# (( my# -camy ) / h - (sx# Mod 2)/2 )        ; вычисление номера ячейки по вертикали 
                                                sxx = Int (sx#)                                                                ; округление результата
                                                syy = Int (sy#)
                                       
                                                xx = sxx * w2                                                                ; вычисление координат ячейки по номеру  ячейки
                                                yy = syy * h +(sxx Mod 2)*h2       
                                               

                                                mouseSelect = True
                                        EndIf
                                Else
                                        kx = xx : ky = yy                                                                ; новые координаты мыши

                                EndIf

        End Function                         

;_______________________________________________________________________________
               
        Function CreateMap.map()
       
                For j=0 To tiley
                        For i=0 To tilex
                               
                                x = i * w2                                                        ; вычисление координат ячейки по номеру
                                y = j * h +(i Mod 2)*h2
                               
                                Local this.map = New map
                                this\x = x
                                this\y = y
                                this\i = i
                                this\j = j
                                this\tile = 0
                        Next
                Next
                Return this.map
        End Function
       
;_______________________________________________________________________________
       
        Function CreateImages()
                gex = CreateImage(w+1,h+1)                ; создаём изображение гекса
                SetBuffer ImageBuffer(gex)
                Color 238,118,0
                Line 0,h2                ,w/4,0
                Line w/4,0        ,w2,0
                Line w2,0                ,w,h2
                Line w,h2                ,w2,h
                Line w2,h                ,w/4,h
                Line w/4,h        ,0,h2
               
                gex_activ = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(gex_activ)
                        Color 102,5,0
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image1 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image1)
                        Color 50,205,50
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image4 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image4)
                        Color 0,206,209
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image3 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image3)
                        Color 205,197,191
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                       
                image2 = CreateImage(w+1,h+1)        ; создаём изображение активной ячейки
                SetBuffer ImageBuffer(image2)
                        SeedRnd MilliSecs()
                        Color 0,197,90
                        Rect (w/4 +0.15) , 0 ,  (w/2 +0.15) , h ,1
                        For q1 = 0 To Rnd(12,46)
                                Color 5,Rnd(40,180),Rnd(40,180)
                                Oval Rnd (5,w-5) , Rnd (5,h-5) , Rnd (5,2) , Rnd (5,2) , 1
                        Next
                       
                Color 255,255,255
        End Function
       
;_______________________________________________________________________________
       
        Function Info()
                Text 620  - camx ,525 -camy -40 ," camx  : "+camx  +"  camy  :"+camy
                Text 620  - camx ,540 -camy -40 ," U : "+sxx+"  V :"+syy
                Text 620  - camx ,555 -camy -40 ," Mouse X : "+kx+"  Mouse Y :"+ky
                Text 620  - camx ,575 -camy -40 ," Oldx : "+oldx +" Oldy : "+oldy
                Text 620  - camx ,590 -camy -40 ," sel : "+sel+"  mouseSelect  :"+mouseSelect       
;                Text 620  - camx ,605 -camy -40 ," plxx : "+plxx +"  plyy :"+plyy;       
;                Text 620  - camx ,510 -camy -40 ," poscrollx : "+positionscrollx +"  poscrolly :"+positionscrolly
;                Text 620  - camx ,525 -camy -40 ," posx : "+posx +"  posy :"+posy
;                Text 620  - camx ,540 -camy -40 ," cmapx : "+cmapx +"  cmapy :"+cmapy
        End Function


polopok 05.07.2012 08:52

Ответ: гексогональная тайловая карта(изометрия)
 
Причём по мини карте можно кликнуть . Перемещение карты ,так же осуществляется мышью , достаточно подвести мышь к краям экрана .


Часовой пояс GMT +4, время: 18:31.

vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot