' ================================================================================================== ' ' Auteur : hubert.bayre@... ' Nom : tracer.mbx ' Date création : fevrier 2006 ' Date dernière modification : .... ' Description : editeur de map pour zigwigwi blaster ' Note : utilise maxgui. ' ' ================================================================================================== Strict Const MENU_OUVRIR=101 Const MENU_SAUVER=102 Const MENU_QUITTER=103 Const MENU_ABOUT = 104 Const MENU_CHARGER_MAP = 105 Const WWX = 1024 Const WWY = 768 ' ------------------------------------------------------------------------------------------- Global Win1:TGadget=CreateWindow("zigwigwis : editeur de map",0,0,WWX,WWY, Null, WINDOW_MENU|WINDOW_TITLEBAR) Global panel:Tgadget = CreatePanel(10,10,WWX-40,WWY-80,Win1,PANEL_ACTIVE) SetGadgetLayout panel,1,1,1,1 SetPanelColor panel,100,0,200 Global sv:Tgadget = CreateSlider(WWX-30,10,20,WWY-80,Win1,SLIDER_VERTICAL) Global sh:Tgadget = CreateSlider(10,WWY-70,WWX-40,20,Win1,SLIDER_HORIZONTAL) Global canvas:TGadget = CreateCanvas(0,0,WWX,WWY,panel) SetSliderRange sv,ClientWidth(panel),GadgetWidth(canvas) SetSliderRange sh,ClientHeight(panel),GadgetHeight(canvas) Global filemenu:TGadget = CreateMenu("&Menu",0,WindowMenu(Win1)) CreateMenu"&Ouvrir",MENU_OUVRIR,filemenu,KEY_O,MODIFIER_COMMAND CreateMenu"&Sauvegarder", MENU_SAUVER, filemenu, KEY_S, MODIFIER_COMMAND CreateMenu "",0, filemenu CreateMenu"&A propos",MENU_ABOUT,filemenu,KEY_A,MODIFIER_COMMAND CreateMenu "",0, filemenu CreateMenu"&Quitter",MENU_QUITTER,filemenu,KEY_F4,MODIFIER_COMMAND UpdateWindowMenu Win1 ' ------------------------------------------------------------------------------------------- Global Tiles:TPixmap = CreatePixmap (640,320, PF_RGBA8888) Global Ecran:TPixmap = CreatePixmap (1024,768, PF_RGBA8888) Global MapTileX : Int Global MapTileY : Int Global hImagePointeur : Timage = LoadImage ("pointeur.png") Global mx, my Global Liste_Tiles : TList = CreateList() ' ------------------------------------------------------------------------------------------- Type TTile Field x : Int Field y : Int Field Modele_x : Int Field Modele_y : Int ' --------------------------------------------------------------------------------------- Function Creer:TTile () Local t : TTile = New TTile t.x = mx / 32 t.y = my / 32 t.Modele_x = MapTileX * 32 t.Modele_y = MapTileX * 32 ListAddLast Liste_Tiles, t Return t End Function ' --------------------------------------------------------------------------------------- Method Afficher_sur_ecran () For Local i=0 To 31 For Local j = 0 To 31 Local p = ReadPixel (Tiles, Modele_x*32+i, Modele_y*32+j) WritePixel (Ecran, x+i,y+j,p) Next Next End Method ' --------------------------------------------------------------------------------------- Function Afficher_toutes (x : Int, y : Int, w : Int, h : Int) For Local t:TTile = EachIn Liste_tiles If (t.y >= y And t.y < y + h) Then If (t.x >=x And t.x < x + w) Then t.Afficher_sur_ecran() End If End If Next End Function ' --------------------------------------------------------------------------------------- End Type ' ------------------------------------------------------------------------------------------- Function Afficher_grille() Local x Local y SetColor 50,50,50 For x=0 To WWX Step 32 DrawLine x, 0, x, WWY Next For y=0 To WWY Step 32 DrawLine 0, y, WWX, y Next End Function ' ------------------------------------------------------------------------------------------- Function Fenetre_choix_tile() Local Win2:TGadget = CreateWindow("Selection de map",40,40,670,400,Null,WINDOW_MENU|WINDOW_TITLEBAR) Local Canvas2:TGadget= CreateCanvas(10,10,640,320,Win2) Local Menu:TGadget = CreateMenu("&Menu",0,WindowMenu(Win2)) CreateMenu"&Charger map",MENU_CHARGER_MAP,Menu, KEY_O,MODIFIER_COMMAND UpdateWindowMenu Win2 'ActivateWindow(Win2) Local lmx, lmy Local ox, oy While WaitEvent() SetGraphics CanvasGraphics(canvas2) Cls SetColor 255,255,255 DrawPixmap Tiles, 0,0 Afficher_grille() SetColor 0,255,0 DrawImage hImagePointeur, ox*32,oy*32 SetColor 255,0,0 DrawImage hImagePointeur, MapTileX*32,MapTileY*32 SetColor 255,255,255 DrawText "x=" + String(ox) + ",y=" + String(oy) ,0,0 Flip Select EventID() Case EVENT_WINDOWCLOSE Exit Case EVENT_MOUSEMOVE lmx = EventX() lmy = EventY() ox = lmx / 32 oy = lmy / 32 Case EVENT_MOUSEDOWN If EventData() = 1 Then MapTileX = ox MapTileY = oy End If Case EVENT_MENUACTION Select EventData() Case MENU_CHARGER_MAP Local filter$ = "Fichiers graphiques png:png" Local filename$ = RequestFile( "Sélectionnez un fichier",filter$ ) If filename$ <> "" Then Tiles = LoadPixmap (Filename$) End If End Select End Select Wend FreeGadget menu FreeGadget Canvas2 FreeGadget win2 End Function ' ---------------------------------------------------------------------------------------------- Local filter$ Local FileName$ While WaitEvent() SetGraphics CanvasGraphics(canvas) Cls ' <----- CRASH HERE !!! SetColor 255,255,255 TTile.Afficher_toutes (0, 0, 32, 24) DrawPixmap Ecran , 0,0 Afficher_grille() Flip Select EventID() Case EVENT_GADGETPAINT SetGadgetShape canvas,-SliderValue(sh),-SliderValue(sv),GadgetWidth(canvas),GadgetHeight(canvas) Case EVENT_MOUSEDOWN If EventData() = 2 Then Fenetre_choix_tile() Notify "revenu ici" End If If EventData() = 1 Then TTile.Creer() Notify "Tile créée" End If Case EVENT_MOUSEMOVE mx = EventX() my = EventY() SetSliderRange sh,ClientWidth(panel),GadgetWidth(canvas) SetSliderRange sv,ClientHeight(panel),GadgetHeight(canvas) SetGadgetShape canvas,-SliderValue(sh),-SliderValue(sv),GadgetWidth(canvas),GadgetHeight(canvas) Case EVENT_MENUACTION Select EventData() Case MENU_OUVRIR filter$ = "Fichiers de données Map:map" filename$ = RequestFile( "Sélectionnez un fichier",filter$ ) Case MENU_SAUVER filename$=RequestFile( "Enregistrer un fichier",filter$, True, filename$ ) If filename$ <> "" Then filter$="Fichiers de données Map Files:map" End If Case MENu_ABOUT Notify "Editeur de map - Hubert BAYRE - 2006." Case MENU_QUITTER Local Reponse = Confirm ("Voulez vous vraiment quitter") If Reponse Then FreeGadget canvas End End If End Select Case EVENT_WINDOWCLOSE Local Reponse = Confirm ("Voulez vous vraiment quitter") If Reponse Then FreeGadget canvas End End If Case EVENT_APPTERMINATE End End Select Wend
exit correctly from the win2 but now i've an crash error with the 'cls' line !!!!
SetGraphics CanvasGraphics(canvas)
cls <----- crash here !
RrrrrrrRRRRR.