Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Problem mit Programmierung eines Spriteeditors

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
Thorben



Anmeldungsdatum: 26.04.2005
Beiträge: 173
Wohnort: SH

BeitragVerfasst am: 24.05.2005, 19:28    Titel: Problem mit Programmierung eines Spriteeditors Antworten mit Zitat

Hallo

Also ich hab hier begonnen einen Spiriteditor zu Programmieren
funktioniert er nicht ordnungs gemäß. Nachdem mann ein paar Teile gemalt hat Funktionieren die Tastenabfrage mit INKEY$ nicht mehr
möchte mann dann das Bild Speichern und klickt auf das Feld zum Speichern passiert nichts und mann kann weder weiter Malen noch
Ihrgend etwas anderes tun.

Hab ich hier einen Fehler gemacht oder ist da was anderes nicht inordnung??

Code:
DECLARE SUB TD.INPUT(Text$,Ty,Tx,max.text,Fa)
screen 20,256,2,1
NeuesBild::CLS

AufrufsNr=00
Xraster  =15
Yraster  =100
FeldGrX  =08
FeldGrY  =07
Farbe    =10


GOSUB Hintergrund

Do
   KEY$=INKEY$
   IF KEY$ = chr$(27) THEN EXIT DO
   IF KEY$ = "f" or KEY$ = "F" THEN GOTO FarbAuswahl
   IF KEY$ = "s" or KEY$ = "S" THEN GOTO Speichern
   IF KEY$ = "l" or KEY$ = "L" THEN GOTO Laden
   IF MT% = 0 THEN STATUSButton = 0
   Getmouse(MX%,MY%,,MT%)
   IF MT%=1 then
      IF MX% > 200 +FeldGrX AND MX% < 200 + Xraster * FeldGrX + FeldGrX AND MY% > 10 + FeldGrY AND MY% < 10 + Yraster * (FeldGrY) + FeldGrY THEN
         PAINT (MX%,MY%), Farbe, 8: gosub Ansicht
      END IF
      IF MX% > 20 AND MX% < 120 AND MY% > 153 AND MY% < 183 AND STATUSButton = 0 THEN GOTO NeuesBild
      IF MX% > 20 AND MX% < 120 AND MY% > 248 AND MY% < 278 AND STATUSButton = 0 THEN Gosub Speichern
      IF MX% > 20 AND MX% < 120 AND MY% > 343 AND MY% < 373 AND STATUSButton = 0 THEN Gosub Laden
      IF MX% > 20 AND MX% < 120 AND MY% > 440 AND MY% < 470 AND STATUSButton = 0 THEN EXIT DO
      IF MX% > 20 AND MX% < 120 AND MY% > 55 AND MY% < 85 THEN
         FarbAuswahl: AusFar=0:STATUSButton = 1
         FOR YF= 1 to 480 step 15
            FOR XF = 1 to 120 step 15
               AusFar=AusFar+1
               line (XF+10,YF+100)-step(15,15),AusFar,BF
            next XF
         NEXT YF 
         DO
            KEY$=INKEY$
            IF KEY$ = CHR$(27) THEN EXIT DO
            Getmouse(MX%,MY%,,MT%)
            For XFT = 1 to 120 step 15
                FOR YFT = 1 to 480 step 15
                    IF MX% > XFT+10 AND MX% < XFT+25 AND MY% > YFT+100 AND MY% < YFT+115 and MT%=1 THEN
                       Farbe=(XFT/15)+8*(YFT/15):Ext=1
                    END IF
                NEXT YFT
            NEXT XFT 
         LOOP UNTIL Ext=1:Ext=0 
         Line (10,100)-step(125,485),0,BF:gosub Hintergrund
         color Farbe:locate 5,5:print "Farbe";Farbe
      END IF
   END IF
     
   IF MT%=2 then
      IF MX% > 200 +FeldGrX AND MX% < 200 + Xraster * FeldGrX + FeldGrX AND MY% > 10 + FeldGrY AND MY% < 10 + Yraster * (FeldGrY) + FeldGrY THEN
         PAINT (MX%,MY%), 0, 8: gosub Ansicht
      END IF
   END IF
   
LOOP
Ansicht:
for XAr = 1 to Xraster
   for YAr = 1 to Yraster
      pset (XAr+(90-(Xraster/2)),YAr+600),point (XAr*FeldGrX+(200+(FeldGrX/2)),YAr*FeldGrY+(10+FeldGrY/2))
   next YAr
next XAr
RETURN


Speichern:
TD.INPUT File$,26,2,15,9
open File$+".TD" for output as #1
write #1,Xraster,Yraster
for XAr = 1 to Xraster
   for YAr = 1 to Yraster
      write #1,point (XAr*FeldGrX+(200+(FeldGrX/2)),YAr*FeldGrY+(10+FeldGrY/2))
   next YAr
next XAr
RETURN


Laden::AufrufsNr=0
TD.INPUT File$,26,2,15,9
open File$+".TD" for input as #1
INPUT #1,Xraster,Yraster
CLS:GOSUB Hintergrund
for XAr = 1 to Xraster
   for YAr = 1 to Yraster
      INPUT #1, FaBi:paint(XAr*FeldGrX+(200+(FeldGrX/2)),YAr*FeldGrY+(10+FeldGrY/2)),FaBi,8
   next YAr
next XAr
RETURN

Hintergrund:
IF AufrufsNr=0 THEN
For Xras = 1 to Xraster
   FOR Yras = 1 to Yraster
      LINE (Xras*FeldGrX+200,Yras*(FeldGrY)+10)-step(FeldGrX,FeldGrY),8,B
   Next Yras
Next Xras
END IF:AufrufsNr=1
'Farbauswahl
Line (20,55)-step(100,30),15,B
color Farbe:locate 5,5:print "Farbe" ;Farbe
Line (20,153)-step(100,30),15,B
color 15:locate 11,5:print "Neues Bild"
Line (20,248)-step(100,30),15,B
color 15:locate 17,5:print "Speichern"
Line (20,343)-step(100,30),15,B
color 15:locate 23,7:print "Laden"
Line (20,440)-step(100,30),15,B
color 15:locate 29,6:print "Beenden"

'Asichts Fenster
Line (90-(Xraster/2),600)-step(Xraster+1,Yraster+1),15,B
RETURN
end

SUB TD.INPUT(kurtz.text$,namY,namX,max.text,Fa) : DIM Sav$(max.text)
 FOR Be = 1 TO max.text: LOCATE namY, namX + Be: PRINT "-": NEXT Be
 DO
   DO
     Key$ = INKEY$
   LOOP WHILE Key$ = ""
   IF Key$ = CHR$(13) THEN EXIT DO
   IF Key$ = CHR$(8) THEN
     IF Del = 1 THEN
       Num = Num - 1: Key$ = "-"
     ELSE
       Num = Num: Del = 1: Key$ = "-"
     END IF
   ELSE
     Num = Num + 1: Del = 0
   END IF
   IF Num <= 0 THEN Num = Num + 1
   IF Num > max.text THEN Num = Num - 1
   IF Sav$(Num - 1) = "-" THEN Num = Num - 1
   Sav$(Num) = Key$
   LOCATE namY, namX + Num
   COLOR Fa: PRINT Sav$(Num)
 LOOP

 FOR Num = 1 TO max.text
   IF Sav$(Num) = "-" THEN Sav$(Num) = ""
   kurtz.text$ = kurtz.text$ + Sav$(Num)
 NEXT Num
END SUB
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Sebastian
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland

BeitragVerfasst am: 24.05.2005, 20:13    Titel: Antworten mit Zitat

Hallo.

Bitte aussagekräftige Beitragstitel wählen und Quellcodes in Zukunft in [code]-Tags schreiben.

Viele Grüße!
Sebastian
_________________

Der Markt regelt das! | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz