 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Type
Anmeldungsdatum: 24.02.2006
Beiträge: 187
Wohnort: Dresden
|
 Verfasst am: 04.01.2007, 16:24 Titel: Mal wieder ein Compiler problem... |
 |
|
Hallo Leudde,
frohes Neues erstma!
So, nun zum Prob:
ich habe wieder mal das Problem, dass ich mein Qbasic Programm nicht compilieren kann.
Wie zu erwartem, läuft das Programm unter QuickBasic ohne Probleme. Wenn ich es aber compilieren will, bekomme ich folgende Fehlermeldung:
Kann mir einer sagen, woran das liegt?
Ich habe unter anderem DS4QB von www.saga-games.de.ms verwendet. - Kann das Problem damit zusammenhängen?
P.S.: Diesmal ist das Prog nicht zu groß 
MfG Type |
|
| Nach oben |
|
 |
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 04.01.2007, 16:51 Titel: |
|
|
1) Neueste DS4QB-Version (Kam am 01.01 raus^^) downloaden Aber an meinem Code kanns eig net liegen.
2) Wie groß is der Source? 
3) Es gibt einige Dinge, die in der IDE funzen, die der Compiler aber seltsamerweise net rafft. Aber da es in "internet fehler nahe xxxx" ist, kann's das auch net sein. Das ist seeeeehr seltsam :/
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Type
Anmeldungsdatum: 24.02.2006
Beiträge: 187
Wohnort: Dresden
|
| Verfasst am: 04.01.2007, 17:52 Titel: |
|
|
Ich bin immer wieder erstaunt wie schnell die Antworten hier kommen
Also an dem DS4QB liegt es wirklich nicht. Allerdings wird nach der aktualisierung der subs jetzt mein Programm bei jedem start zuerst minimiert. Was ja eigentlich nicht sein sollte - ich werde wieder auf die ältere Version zurückgreifen.
Das Programm ist allein 26 KB groß. + die Include Dateien sind es 48 KB, also nicht viel...
EDIT:
Noch ne antwort!? - COOL!
Ähm... ok - aber ich sach gleich mein programmierstil is für'n Ar*** (wenn's überhaupt einer ist )
| Code: | DECLARE SUB Sys.StreamVol (Volume AS INTEGER, Channel AS INTEGER)
DEFINT A-Z
'Soundsystem-Grundfunktionen
DECLARE SUB Sys.ShutDown ()
DECLARE SUB Sys.Start ()
DECLARE SUB Sys.WriteCommand (SoundCommand AS STRING)
'Stream-Abspielfunkltionen
DECLARE SUB Sys.LoadStream (Filename AS STRING, LoopIt AS INTEGER, Channel AS INTEGER)
DECLARE SUB Sys.LoadStreamMem (Filename AS STRING, LoopIt AS INTEGER, Channel AS INTEGER)
DECLARE SUB Sys.PlayStream (ResumeMode AS INTEGER, Channel AS INTEGER)
DECLARE SUB Sys.StopStream (Channel AS INTEGER)
DECLARE SUB Sys.RemoveStream (Channel AS INTEGER)
DECLARE SUB AltFont (jy%, jX%, AltFontText$, AltFontF%)
DECLARE SUB flamme ()
DECLARE SUB SHOWBMP (FileName1$)
COMMON SHARED X AS INTEGER, Y AS INTEGER
DIM SHARED zeile%
REM $INCLUDE: 'files\datag.bas'
REM $INCLUDE: 'files\datak.bas'
REM $INCLUDE: 'files\dataz.bas'
REM $INCLUDE: 'files\datas.bas'
Sys.Start
Sys.LoadStream "files\musik\temple~1.ogg", 1, 1
Sys.StreamVol 100, 1
OPEN "Files\text.elt" FOR INPUT AS #1
DO UNTIL EOF(1)
LINE INPUT #1, dummy$
zeile% = zeile% + 1
LOOP
CLOSE #1
DIM SHARED Datei$(zeile%)
OPEN "Files\text.elt" FOR INPUT AS #1
FOR load% = 0 TO zeile% - 1
LINE INPUT #1, Datei$(load%)
NEXT load%
CLOSE #1
SCREEN 13
SLEEP 2
CALL SHOWBMP("files\pic\buch.all")
CLOSE
DEF SEG = &HA000
BLOAD "files\pic\buch.int"
flamme
Sys.ShutDown
END
LEER:
DATA 0,0,0,0,0,1,0,0,0,0,0,0
DATA 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
DATA 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
DATA 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
DATA 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
REST:
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DATA 15,15,15,15,15,15,15,15,15,15,15,15
DEFSNG A-Z
SUB AltFont (jy%, jX%, AltFontText$, AltFontF%)
jy% = (jy% - 1) * 9
jX% = (jX% - 2) * 12
DIM AltFontP%(11, 8)
DIM Feld%(LEN(AltFontText$))
FOR AltFontA% = 1 TO LEN(AltFontText$)
char$ = MID$(AltFontText$, AltFontA%, 1)
IF char$ = "B" THEN
RESTORE gB
ELSEIF char$ = "A" THEN
RESTORE gA
ELSEIF char$ = "C" THEN
RESTORE gC
ELSEIF char$ = "D" THEN
RESTORE gD
ELSEIF char$ = "E" THEN
RESTORE gE
ELSEIF char$ = "F" THEN
RESTORE gF
ELSEIF char$ = "G" THEN
RESTORE gG
ELSEIF char$ = "H" THEN
RESTORE gH
ELSEIF char$ = "I" THEN
RESTORE gI
ELSEIF char$ = "J" THEN
RESTORE gJ
ELSEIF char$ = "K" THEN
RESTORE gK
ELSEIF char$ = "L" THEN
RESTORE gL
ELSEIF char$ = "M" THEN
RESTORE gM
ELSEIF char$ = "N" THEN
RESTORE gN
ELSEIF char$ = "O" THEN
RESTORE ggO
ELSEIF char$ = "P" THEN
RESTORE gP
ELSEIF char$ = "Q" THEN
RESTORE gQ
ELSEIF char$ = "R" THEN
RESTORE gR
ELSEIF char$ = "S" THEN
RESTORE gS
ELSEIF char$ = "T" THEN
RESTORE gT
ELSEIF char$ = "U" THEN
RESTORE gU
ELSEIF char$ = "V" THEN
RESTORE gV
ELSEIF char$ = "W" THEN
RESTORE gW
ELSEIF char$ = "X" THEN
RESTORE gX
ELSEIF char$ = "Y" THEN
RESTORE gY
ELSEIF char$ = "Z" THEN
RESTORE gZ
ELSEIF char$ = "a" THEN
RESTORE kA
ELSEIF char$ = "b" THEN
RESTORE kB
ELSEIF char$ = "c" THEN
RESTORE kC
ELSEIF char$ = "d" THEN
RESTORE kD
ELSEIF char$ = "e" THEN
RESTORE kE
ELSEIF char$ = "f" THEN
RESTORE kF
ELSEIF char$ = "g" THEN
RESTORE kG
ELSEIF char$ = "h" THEN
RESTORE kH
ELSEIF char$ = "i" THEN
RESTORE kI
ELSEIF char$ = "j" THEN
RESTORE kj
ELSEIF char$ = "k" THEN
RESTORE kK
ELSEIF char$ = "l" THEN
RESTORE kL
ELSEIF char$ = "m" THEN
RESTORE kM
ELSEIF char$ = "n" THEN
RESTORE kN
ELSEIF char$ = "o" THEN
RESTORE kO
ELSEIF char$ = "p" THEN
RESTORE kP
ELSEIF char$ = "q" THEN
RESTORE kQ
ELSEIF char$ = "r" THEN
RESTORE kR
ELSEIF char$ = "s" THEN
RESTORE kS
ELSEIF char$ = "t" THEN
RESTORE kT
ELSEIF char$ = "u" THEN
RESTORE kU
ELSEIF char$ = "v" THEN
RESTORE kV
ELSEIF char$ = "w" THEN
RESTORE kW
ELSEIF char$ = "x" THEN
RESTORE kX
ELSEIF char$ = "y" THEN
RESTORE kY
ELSEIF char$ = "z" THEN
RESTORE kZ
ELSEIF char$ = "0" THEN
RESTORE 0
ELSEIF char$ = "1" THEN
RESTORE 1
ELSEIF char$ = "2" THEN
RESTORE 2
ELSEIF char$ = "3" THEN
RESTORE 3
ELSEIF char$ = "4" THEN
RESTORE 4
ELSEIF char$ = "5" THEN
RESTORE 5
ELSEIF char$ = "6" THEN
RESTORE 6
ELSEIF char$ = "7" THEN
RESTORE 7
ELSEIF char$ = "8" THEN
RESTORE 8
ELSEIF char$ = "9" THEN
RESTORE 9
ELSEIF char$ = "„" THEN
RESTORE kAE
ELSEIF char$ = "”" THEN
RESTORE kOE
ELSEIF char$ = "?" THEN
RESTORE kUE
ELSEIF char$ = "Ž" THEN
RESTORE gAE
ELSEIF char$ = "™" THEN
RESTORE gOE
ELSEIF char$ = "š" THEN
RESTORE gUE
ELSEIF char$ = "á" THEN
RESTORE ESSZETT
ELSEIF char$ = "." THEN
RESTORE PUNKT
ELSEIF char$ = "!" THEN
RESTORE AUSRUF
ELSEIF char$ = "?" THEN
RESTORE FRAGE
ELSEIF char$ = "(" THEN
RESTORE KLAMMERAUF
ELSEIF char$ = ")" THEN
RESTORE KLAMMERZU
ELSEIF char$ = CHR$(34) THEN
RESTORE ANFUEHRUNG
ELSEIF char$ = "-" THEN
RESTORE STRICH
ELSEIF char$ = ":" THEN
RESTORE DOPPEL
ELSEIF char$ = "," THEN
RESTORE KOMMA
ELSEIF char$ = " " THEN
RESTORE LEER
ELSE
RESTORE REST
END IF
FOR AltFontY% = 0 TO 8
READ AltFontP%(0, AltFontY%), AltFontP%(1, AltFontY%), AltFontP%(2, AltFontY%), AltFontP%(3, AltFontY%), AltFontP%(4, AltFontY%), AltFontP%(5, AltFontY%), AltFontP%(6, AltFontY%), AltFontP%(7, AltFontY%), AltFontP%(8, AltFontY%), AltFontP%(9 _
, AltFontY%), AltFontP%(10, AltFontY%), AltFontP%(11, AltFontY%)
NEXT AltFontY%
FOR AltFontX% = 0 TO 11
FOR AltFontY% = 0 TO 8
IF AltFontP%(AltFontX%, AltFontY%) = 1 THEN Feld%(AltFontA%) = AltFontX%
AltFontW% = 0
FOR AltFontZ% = 1 TO AltFontA%
AltFontW% = AltFontW% + Feld%(AltFontZ%)
NEXT AltFontZ%
IF Feld%(AltFontA%) = 0 THEN Feld%(AltFontA%) = 13
IF AltFontX% = 0 AND AltFontY% = 0 THEN AltFontW% = AltFontW% + 13
IF AltFontP%(AltFontX%, AltFontY%) = 15 THEN PSET (jX% + AltFontX% + AltFontW%, AltFontY% + jy%), AltFontF%
NEXT AltFontY%
NEXT AltFontX%
NEXT AltFontA%
END SUB
SUB flamme
DIM bild%(14 TO 27, 57 TO 108)
FOR sx% = 14 TO 27
FOR sy% = 57 TO 108
bild%(sx%, sy%) = POINT(sx%, sy%)
NEXT sy%
NEXT sx%
DIM c(11) AS INTEGER
RANDOMIZE TIMER
v% = 100
fls% = 3
fmax% = 140
fmin% = 100
sw% = 1
fxkoo% = -135
farben:
f% = 0
g% = 0
FOR i% = 1 TO 140
IF i% < 32 THEN PALETTE i% + 99, i%
IF i% >= 32 AND i% < 63 THEN
f% = f% + 1
PALETTE i% + 99, i% + f% * 256
END IF
IF i% >= 63 AND i% < 95 THEN
f% = f% + 1
PALETTE i% + 99, 63 + f% * 256
END IF
IF i% >= 95 AND i% <= 140 THEN
g% = g% + 1
PALETTE i% + 99, 63 + 63 * 256 + g% * 256 ^ 2
END IF
NEXT i%
PALETTE 240, 10 + 10 * 256 + 10 * 256 ^ 2
flamme:
DO
fy% = 105
DO
fy% = fy% - 1
FOR fx% = 150 + fxkoo% TO 161 + fxkoo%
c% = POINT(fx%, fy% + 1)
IF c% = 0 THEN fx% = fx% + 1: c% = POINT(fx%, fy% + 1)
c% = c% - fls%
IF c% > 239 OR c% < 100 THEN c% = bild%(fx%, fy%)
PSET (fx%, fy%), c%
NEXT fx%
LOOP UNTIL POINT(156 + fxkoo%, fy%) = 0
LINE (156 + fxkoo%, fy% - 1)-(156 + fxkoo%, fy% - sw%), 0
i% = RND * 10
IF i% MOD 2 = 0 THEN c(6) = c(6) + sw% ELSE c(6) = c(6) - sw%
IF c(6) <= fmin% - sw% THEN c(6) = fmin% + sw%
IF c(6) >= fmax% + sw% THEN c(6) = fmax% - sw%
c(1) = c(6) - 100
c(2) = c(6) - 80
c(3) = c(6) - 60
c(4) = c(6) - 40
c(5) = c(6) - 20
c(7) = c(5)
c(8) = c(4)
c(9) = c(3)
c(10) = c(2)
c(11) = c(1)
FOR i% = 1 TO 11
IF c(i%) < 0 THEN c(i%) = 0
PSET (150 + i% + fxkoo%, 105), c(i%) + 99
PSET (150 + i% + fxkoo%, 106), c(i%) + 89
IF POINT(150 + i% + fxkoo%, 106) > 239 OR POINT(150 + i% + fxkoo%, 106) < 100 THEN PSET (150 + i% + fxkoo%, 106), bild%(150 + i% + fxkoo%, 106)
PSET (150 + i% + fxkoo%, 107), c(i%) + 69
IF POINT(150 + i% + fxkoo%, 107) > 239 OR POINT(150 + i% + fxkoo%, 107) < 100 THEN PSET (150 + i% + fxkoo%, 107), bild%(150 + i% + fxkoo%, 107)
PSET (150 + i% + fxkoo%, 108), c(i%) + 24
IF POINT(150 + i% + fxkoo%, 108) > 239 OR POINT(150 + i% + fxkoo%, 108) < 100 THEN PSET (150 + i% + fxkoo%, 108), bild%(150 + i% + fxkoo%, 108)
NEXT i%
PSET (155 + fxkoo%, 108), 240
PSET (156 + fxkoo%, 107), 240
'30 Zeichen max.
IF TIMER >= tim! + .053 THEN
tim! = TIMER
IF b% <= LEN(Datei$(z%)) THEN
b% = b% + 1
ELSE
IF z% < zeile% THEN a% = a% + 1: z% = z% + 1: b% = 1
IF a% = 22 THEN
DEF SEG = &HA000
BLOAD "files\pic\buch.int"
a% = 0
END IF
END IF
IF z% <= zeile% THEN AltFont a% + 1, 5, LEFT$(Datei$(z%), b%), 176
IF z% = zeile% THEN
IF v% > 0 THEN
v% = v% - 1
Sys.StreamVol v%, 1
END IF
IF v% = 0 THEN
Sys.StopStream 1
Sys.StreamVol 100, 1
END IF
END IF
END IF
i$ = INKEY$
LOOP UNTIL i$ = CHR$(27) OR v% = 0
END SUB
SUB SHOWBMP (FileName1$)
OPEN FileName1$ FOR BINARY AS #1
IF LOF(1) = 0 THEN
PRINT " FILE IS EMPTY"
CLOSE #255
KILL FileName1$
EXIT SUB
END IF
'/* Extracts the first 2 bytes of the file */'
ValidBMP$ = SPACE$(2)
GET #1, 1, ValidBMP$
'/* If the first 2 bytes of the file are not BM then a line of text is printed, */'
'/* and the program ends */'
IF ValidBMP$ <> "BM" THEN
PRINT " THE FILE SPECIFIED IS NOT A VALID BMP"
EXIT SUB
END IF
'/* Extracts the offset of the picture data in the file */'
LocationOfPictureData$ = SPACE$(4)
GET #1, 11, LocationOfPictureData$
LocationOfPictureData = CVL(LocationOfPictureData$)
'/* Extracts the BMP type (Win or OS/2) */'
BMPType$ = SPACE$(4)
GET #1, 15, BMPType$
'/* If the BMPType is for OS/2 then the a line of text is printed, then */'
'/* program ends */'
IF CVL(BMPType$) = 12 OR CVL(BMPType$) = 64 THEN
PRINT " THIS BMP IS FOR THE OS/2 AND CAN'T BE OPENED IN THIS VERSION OF OPENBMP"
PRINT " PLEASE SEND ANY OS/2 BMP TO phililpz85@hotmail.com"
PRINT " BY SENDING OS/2 BMP's TO US, WE WILL HOPEFULLY BE ABLE TO OPEN THEM IN THE"
PRINT " NEXT VERSION OF OPENBMP"
EXIT SUB
END IF
'/* Extracts the Width and Height in Pixels of the Image */'
'/* and also the number of bits per pixel (bpp) */'
PixelWidth$ = SPACE$(4)
PixelHeight$ = SPACE$(4)
BitsPerPixel$ = SPACE$(2)
Compression$ = SPACE$(4)
GET #1, 19, PixelWidth$
GET #1, 23, PixelHeight$
GET #1, 29, BitsPerPixel$
GET #1, 31, Compression$
PixelWidth = CVL(PixelWidth$)
PixelHeight = CVL(PixelHeight$)
BitsPerPixel = CVI(BitsPerPixel$)
NumberOfColors = 2 ^ BitsPerPixel
'/* Changing to suitable screen modes to display the Image */'
IF BitsPerPixel = 1 THEN
IF PixelWidth > 640 OR PixelHeight > 480 THEN
PRINT " 1-BIT IMAGE IS TO LARGE"
EXIT SUB
END IF
SCREEN 11
ELSEIF BitsPerPixel = 4 THEN
SCREEN 12
ELSEIF BitsPerPixel = 16 OR BitsPerPixel = 32 THEN
PRINT " Error 16-BIT and 32-BIT BMPs cannot be loaded"
CLOSE #1
EXIT SUB
END IF
'/* If image is not 24-bit then load palette information from file */'
IF BitsPerPixel <> 24 THEN
'/* Extracts Palette information for the colors used in the image */'
PaletteColors$ = SPACE$(NumberOfColors * 4)
GET #1, 55, PaletteColors$
FOR Loops = 0 TO NumberOfColors - 1
'/* Changes the Palette of each color to the one specified in the file */'
IF BitsPerPixel = 1 AND Loops = 1 THEN Loops = 15
OUT &H3C8, Loops
IF BitsPerPixel = 1 AND Loops = 15 THEN Loops = 1
OUT &H3C9, ASC(MID$(PaletteColors$, Loops * 4 + 3, 1)) \ 4 'Red
OUT &H3C9, ASC(MID$(PaletteColors$, Loops * 4 + 2, 1)) \ 4 'Green
OUT &H3C9, ASC(MID$(PaletteColors$, Loops * 4 + 1, 1)) \ 4 'Blue
NEXT Loops
'/* Finds correct location of Picture data */'
IF LocationOfPictureData = 0 THEN
LocationOfPictureData = LOC(255) + 1
ELSE
LocationOfPictureData = LocationOfPictureData + 1
END IF
END IF
IF CVL(Compression$) = 1 THEN
PixelColors$ = SPACE$(1): NoOfSameColors$ = SPACE$(1)
RightMovement$ = SPACE$(1): UpMovement$ = SPACE$(1)
ActualWidth = PixelWidth / 320: ActualHeight = PixelHeight / 200
IF ActualWidth < 1 THEN ActualWidth = 1
IF ActualHeight < 1 THEN ActualHeight = 1
X = 0: Y = PixelHeight - 1
DO
GET #1, , NoOfSameColors$
IF ASC(NoOfSameColors$) <> 0 THEN
GET #1, , PixelColors$
IF X + ASC(NoOfSameColors$) = PixelWidth THEN NoOfSameColors$ = CHR$(ASC(NoOfSameColors$) - 1)
LINE (X / ActualWidth, Y / ActualHeight)-STEP(ASC(NoOfSameColors$) / ActualWidth, 0), ASC(PixelColors$)
X = X + ASC(NoOfSameColors$)
ELSE
GET #1, , PixelColors$
IF ASC(PixelColors$) = 0 THEN
X = 0: Y = Y - 1
IF Y < 0 THEN EXIT SUB
'/* Used to skip the unnecessary lines in large pictures
WHILE Y MOD ActualHeight <> 0
DO
GET #1, , NoOfSameColors$
IF ASC(NoOfSameColors$) <> 0 THEN
GET #1, , PixelColors$
ELSE
GET #1, , PixelColors$
IF ASC(PixelColors$) = 0 THEN
EXIT DO
ELSEIF ASC(PixelColors$) = 1 THEN
EXIT SUB
ELSEIF ASC(PixelColors$) = 2 THEN
Bytez$ = SPACE$(2)
GET #1, , Bytez$
EXIT DO
ELSE
Bytez$ = SPACE$(ASC(PixelColors$))
IF ASC(PixelColors$) MOD 2 = 1 THEN Bytez$ = Bytez$ + " "
GET #1, , Bytez$
END IF
END IF
LOOP
Y = Y - 1
WEND
ELSEIF ASC(PixelColors$) = 1 THEN
EXIT DO
ELSEIF ASC(PixelColors$) = 2 THEN
GET #1, , RightMovement$
GET #1, , UpMovement$
X = X + ASC(RightMovement$): Y = Y + ASC(UpMovement$)
ELSE
PixelColor$ = SPACE$(1)
FOR Loops = 1 TO ASC(PixelColors$)
GET #1, , PixelColor$
X = X + 1
NEXT Loops
IF ASC(PixelColors$) MOD 2 = 1 THEN GET #1, , PixelColor$
END IF
END IF
LOOP
EXIT SUB
ELSEIF CVL(Compression$) = 2 THEN
PixelColors$ = SPACE$(1): NoOfSameColors$ = SPACE$(1)
RightMovement$ = SPACE$(1): UpMovement$ = SPACE$(1)
ActualWidth = PixelWidth / 640: ActualHeight = PixelHeight / 480
IF ActualWidth < 1 THEN ActualWidth = 1
IF ActualHeight < 1 THEN ActualHeight = 1
X = 0: Y = PixelHeight - 1
DO
GET #1, , NoOfSameColors$
IF ASC(NoOfSameColors$) <> 0 THEN
GET #1, , PixelColors$
FOR Loops = 0 TO ASC(NoOfSameColors$) - 1 STEP 2
X = X + 1
IF Loops + 1 <> ASC(NoOfSameColors$) THEN
X = X + 1
END IF
NEXT Loops
ELSE
GET #1, , PixelColors$
IF ASC(PixelColors$) = 0 THEN
X = 0: Y = Y - 1
IF Y < 0 THEN EXIT SUB
'/* Used to skip the unnecessary lines in large pictures
WHILE Y MOD ActualHeight <> 0
DO
GET #1, , NoOfSameColors$
IF ASC(NoOfSameColors$) <> 0 THEN
GET #1, , PixelColors$
ELSE
GET #1, , PixelColors$
IF ASC(PixelColors$) = 0 THEN
EXIT DO
ELSEIF ASC(PixelColors$) = 1 THEN
EXIT SUB
ELSEIF ASC(PixelColors$) = 2 THEN
Bytez$ = SPACE$(2)
GET #1, , Bytez$
EXIT DO
ELSE
PixelColors = ASC(PixelColors$)
IF PixelColors MOD 2 = 1 THEN
PixelColors = PixelColors + 1
END IF
PixelColors = PixelColors / 2
IF PixelColors MOD 2 = 1 THEN
PixelColors = PixelColors + 1
END IF
Bytez$ = SPACE$(PixelColors)
GET #1, , Bytez$
END IF
END IF
LOOP
Y = Y - 1
WEND
ELSEIF ASC(PixelColors$) = 1 THEN
EXIT DO
ELSEIF ASC(PixelColors$) = 2 THEN
GET #1, , RightMovement$
GET #1, , UpMovement$
X = X + ASC(RightMovement$): Y = Y + ASC(UpMovement$)
ELSE
PixelColor$ = SPACE$(1): PixelColors = ASC(PixelColors$)
FOR Loops = 0 TO PixelColors - 1
IF Loops MOD 2 = 0 THEN
GET #1, , PixelColor$
X = X + 1
END IF
IF Loops MOD 2 = 1 THEN
X = X + 1
END IF
NEXT Loops
IF PixelColors MOD 2 = 1 THEN
PixelColors = PixelColors + 1
END IF
NoOfBytes = PixelColors / 2
IF (NoOfBytes MOD 2) = 1 THEN
GET #1, , PixelColor$
END IF
END IF
END IF
LOOP
EXIT SUB
END IF
IF BitsPerPixel = 8 THEN
LineExtract$ = SPACE$(PixelWidth)
IF (4 - (PixelWidth MOD 4)) <> 4 THEN
LineExtract$ = LineExtract$ + SPACE$(4 - (PixelWidth MOD 4))
END IF
LineExtract& = LEN(LineExtract$)
ActualHeight! = 199 / (PixelHeight - 1)
ActualWidth! = 319 / (PixelWidth - 1)
IF ActualHeight! > 1 THEN ActualHeight! = 1
IF ActualWidth! > 1 THEN ActualWidth! = 1
ActualHeight1! = (PixelHeight - 1) / 199
ActualWidth1! = (PixelWidth - 1) / 319
IF ActualHeight1! < 1 THEN ActualHeight1! = 1
IF ActualWidth1! < 1 THEN ActualWidth1! = 1
IF ActualHeight! = 1 AND ActualWidth! = 1 THEN
SEEK #1, LocationOfPictureData
FOR Y = PixelHeight - 1 TO 0 STEP -1
GET #1, , LineExtract$
NEXT Y
ELSE
FOR Y = 0 TO PixelHeight - 1 STEP ActualHeight1!
GET #1, LocationOfPictureData + ((PixelHeight - Y - 1) * LineExtract&), LineExtract$
NEXT Y
END IF
ELSEIF BitsPerPixel = 4 THEN
LineExtract$ = SPACE$(PixelWidth \ 2)
IF (4 - ((PixelWidth MOD 8) / 2)) <> 4 THEN
LineExtract$ = LineExtract$ + SPACE$((4 - ((PixelWidth MOD 8) / 2)))
END IF
LineExtract& = LEN(LineExtract$)
ActualHeight! = 479 / (PixelHeight - 1)
ActualWidth! = 639 / (PixelWidth - 1)
IF ActualHeight! > 1 THEN ActualHeight! = 1
IF ActualWidth! > 1 THEN ActualWidth! = 1
ActualHeight1! = (PixelHeight - 1) / 479
ActualWidth1! = (PixelWidth - 1) / 639
IF ActualHeight1! < 1 THEN ActualHeight1! = 1
IF ActualWidth1! < 1 THEN ActualWidth1! = 1
IF ActualWidth! = 1 AND ActualHeight! = 1 THEN
SEEK #1, LocationOfPictureData
FOR Y = PixelHeight - 1 TO 0 STEP -1
GET #1, , LineExtract$
FOR X = 0 TO (PixelWidth / 2) - 1
PixelColor = ASC(MID$(LineExtract$, X + 1, 1))
NEXT X
NEXT Y
ELSE
FOR Y = 0 TO PixelHeight - 1 STEP ActualHeight1!
GET #1, LocationOfPictureData + ((PixelHeight - 1 - Y) * LineExtract&), LineExtract$
FOR X = 0 TO (PixelWidth / 2) - 1 STEP ActualWidth1!
PixelColor = ASC(MID$(LineExtract$, X + 1, 1))
NEXT X
NEXT Y
END IF
ELSEIF BitsPerPixel = 1 THEN
LineExtract$ = SPACE$(PixelWidth \ 8)
IF (4 - ((PixelWidth MOD 32) / 8)) <> 4 THEN
LineExtract$ = LineExtract$ + SPACE$((4 - ((PixelWidth MOD 32) / 8)))
END IF
LineExtract& = LEN(LineExtract$)
FOR Y = 0 TO PixelHeight - 1
DEF SEG = &HA000
GET #1, LocationOfPictureData + ((PixelHeight - Y - 1) * LineExtract&), LineExtract$
FOR X = 0 TO CINT(PixelWidth / 8) - 1
IF Y < 409 THEN
POKE (Y * 80 + X), ASC(MID$(LineExtract$, X + 1, 1))
ELSE
DEF SEG = &HA7D0
POKE ((Y - 400) * 80 + X), ASC(MID$(LineExtract$, X + 1, 1))
END IF
NEXT X
NEXT Y
DEF SEG
END IF
END SUB
DEFINT A-Z
'Diese SUB l„dt einen Stream (MPx, WAV, OGG) auf den angegebenen Kanal und
'wiederholt ihn ggf.
'Der Stream wird sofort abgespielt.
'
'Parameter:
'Filename - Dein Dateiname, z.B. Background.mp3
'LoopIt - Soll die Datei in einer Schleife gespielt werden?
'Channel - Ein Soundkanal. Insgesamt gibt es 32 davon. Eine Zahl zwischen 1
' und 32 w„hlt einen Kanal, -1 sucht einen freien Platz.
SUB Sys.LoadStream (Filename AS STRING, LoopIt AS INTEGER, Channel AS INTEGER)
IF (Channel < 1 OR Channel > 32) AND Channel <> -1 THEN EXIT SUB '32 Kan„le
Sys.LoadStreamMem Filename, LoopIt, Channel
Sys.PlayStream 0, Channel
END SUB
'Diese SUB l„dt einen Stream (MPx, WAV, OGG) auf den angegebenen Kanal und
'wiederholt ihn ggf.
'Der Stream wird noch NICHT abgespielt!
'
'Parameter:
'Filename - Dein Dateiname, z.B. Background.mp3
'LoopIt - Soll die Datei in einer Schleife gespielt werden?
'Channel - Ein Soundkanal. Insgesamt gibt es 32 davon. Eine Zahl zwischen 1
' und 32 w„hlt einen Kanal, -1 sucht einen freien Platz.
SUB Sys.LoadStreamMem (Filename AS STRING, LoopIt AS INTEGER, Channel AS INTEGER)
IF (Channel < 1 OR Channel > 32) AND Channel <> -1 THEN EXIT SUB '32 Kan„le
IF LoopIt <> 0 THEN LoopIt = 1
Sys.WriteCommand "LOADSTREAM" + Filename + "|" + LTRIM$(STR$(LoopIt)) + "|" + LTRIM$(STR$(Channel))
END SUB
'Diese SUB spielt einen Stream-Kanal ab, nachdem er gestoppt oder pausiert
'wurde.
'
'Parameter:
'ResumeMode - Wenn die Variable 1 ist, wird das St?ck nach PauseStream fort-
' gesetzt. Wenn sie 0 ist, wird das St?ck von vorne abgespielt.
' Der Parameter hat keine Einfluss auf Streams, die mit StopStream
' gestoppt wurden!
'Channel - Ein Soundkanal. Insgesamt gibt es 32 davon. Eine Zahl zwischen 1
' und 32 w„hlt einen Kanal.
SUB Sys.PlayStream (ResumeMode AS INTEGER, Channel AS INTEGER)
IF (Channel < 1 OR Channel > 32) THEN EXIT SUB '32 Kan„le
IF ResumeMode <> 0 THEN ResumeMode = -1
Sys.WriteCommand "CHANNELPLAY" + LTRIM$(STR$(Channel + 32)) + "|" + LTRIM$(STR$(ResumeMode))
END SUB
'Diese SUB entfernt einen Stream (MPx, WAV, OGG) auf dem
'angegebenen Kanal aus dem Speicher.
'
'Parameter:
'Channel - Ein Soundkanal. Insgesamt gibt es 32 davon. Eine Zahl zwischen 1
' und 32 w„hlt einen Kanal.
SUB Sys.RemoveStream (Channel AS INTEGER)
IF (Channel < 1 OR Channel > 32) THEN EXIT SUB '32 Kan„le
Sys.WriteCommand "REMOVESTREAM|" + LTRIM$(STR$(Channel))
END SUB
'Diese SUB entfernt das Soundsystem aus dem Speicher.
'
SUB Sys.ShutDown
Sys.WriteCommand "SHUTDOWN"
END SUB
'Diese SUB startet das DS4QB-Soundsystem
'
SUB Sys.Start
'Syntax: Start /M ds4qb.exe [Test-Programm]
'Befehle in [Eckigen Klammern] m?ssen nicht angegeben werden.
'Start - Ein Windows-Befehl
'/M - Die Anwendung l„uft im Hintergrund
'ds4qb.exe - Das Soundsystem
'[Test-Programm] - Hier kann dein Programm-Name stehen, der auf der
' Soundsystem-Oberfl„che angegeben wird.
SHELL "drivers\ds4qb\dsstart /M drivers\ds4qb\ds4qb.exe SEQUENZ"
END SUB
'Diese SUB stoppt einen Stream-Kanal
'
'Parameter:
'Channel - Ein Soundkanal. Insgesamt gibt es 32 davon. Eine Zahl zwischen 1
' und 32 w„hlt einen Kanal.
SUB Sys.StopStream (Channel AS INTEGER)
IF (Channel < 1 OR Channel > 32) THEN EXIT SUB '32 Kan„le
Sys.WriteCommand "CHANNELSTOP" + LTRIM$(STR$(Channel + 32))
END SUB
SUB Sys.StreamVol (Volume AS INTEGER, Channel AS INTEGER)
'Diese SUB ver„ndert die Lautst„rke eines Stream-Kanals.
'
'Parameter:
'Volume - Die Lautst„rke. Ein Wert zwischen 0 und 100
'Channel - Ein Soundkanal. Insgesamt gibt es 32 davon. Eine Zahl zwischen 1
' und 32 w„hlt einen Kanal.
IF (Channel < 1 OR Channel > 32) THEN EXIT SUB '32 Kan„le
Sys.WriteCommand "STREAMVOL" + LTRIM$(STR$(Volume)) + "|" + LTRIM$(STR$(Channel))
END SUB
'Interner Befehl f?r das Soundsystem
'
SUB Sys.WriteCommand (SoundCommand AS STRING)
SysFr = FREEFILE
OPEN "drivers\ds4qb\DS-CODE.TMP" FOR APPEND AS SysFr
PRINT #SysFr, SoundCommand
CLOSE SysFr
END SUB
|
Irgendwie klann ich mir nicht vorstellen, dass das nur 26 KB sind...
Das Codeschnipsel mit der Kerze kennt ihr bestimmt von Dominik Sedivy.
Zuletzt bearbeitet von Type am 04.01.2007, 18:02, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 04.01.2007, 18:02 Titel: |
|
|
26kb = mehr als 26000 zeichen
argh, die font-routine ist wirklich...nennen wir es...grauenhaft
btw: wegen ds4qb: du musst in der sub sys.start vlt mal /min und /m austauschen (weiß nicht, ob da jetzt /min oder /m steht, einfach ausprobieren!)
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Type
Anmeldungsdatum: 24.02.2006
Beiträge: 187
Wohnort: Dresden
|
| Verfasst am: 04.01.2007, 18:05 Titel: |
|
|
das mit dem /min oder /m hab ich schon ausprobiert. Hab auch versucht start davor zu setzen etc. hat nix genützt.
Noch'n EDIT:
Ich glaube dem Compiler ist die Font-Routine auch zu "grauenhaft"
Wenn ich sie weglasse, kann ich das Programm Compilieren...  |
|
| Nach oben |
|
|
Sebastian
Administrator
Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland
|
|
| Nach oben |
|
|
Type
Anmeldungsdatum: 24.02.2006
Beiträge: 187
Wohnort: Dresden
|
| Verfasst am: 04.01.2007, 18:22 Titel: |
|
|
hm... da muss ich ja die ganzen DATA anweisungen umschreiben... aber trotzdem danke!
EDIT: War zwar etwas Arbeit aber jetz funzt es! - Danke für eure Hilfe!
Zuletzt bearbeitet von Type am 04.01.2007, 20:30, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 04.01.2007, 19:57 Titel: |
|
|
schau mal, auf meiner webseite habe ich auch noch eine font-routine im angebot
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Type
Anmeldungsdatum: 24.02.2006
Beiträge: 187
Wohnort: Dresden
|
| Verfasst am: 04.01.2007, 20:32 Titel: |
|
|
| ich weis, aber ich wollte mir halt selber mal eine bauen |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 04.01.2007, 20:40 Titel: |
|
|
...was dir in diesem fall nicht gelungen ist (jetzt nicht böse sein )
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Elvis
Anmeldungsdatum: 01.06.2006
Beiträge: 818
Wohnort: Deutschland, BW
|
| Verfasst am: 04.01.2007, 20:58 Titel: |
|
|
@Type
Aber wenigstens machst du immer brav Einrückungen und benutzt kein
GOTO. Du hättest mal meinen Programmerstil von vor einem Jahr sehen
müssen (Zeilenmarken, keine SUBS, seeeehr oft GOTO, keine Einrückungen,
nichtssagende Variablen usw.  ). So langsam hab ich mich aber von
diesem Stil gelöst.  
Grüße, Elvis
_________________
Geforce 7300GT (256MB GDDR3, Gainward) -- 2x 512MB (DDR2 800, MDT) -- AMD Athlon64 X2 EE 3800+ -- Asrock ALiveNF5-eSATA2+ |
|
| Nach oben |
|
|
Lutz Ifer
Grillmeister
Anmeldungsdatum: 23.09.2005
Beiträge: 555
|
| Verfasst am: 04.01.2007, 22:13 Titel: |
|
|
das problem, dass sich ein qb/qbasic-programm nicht mehr compilieren, aber immer noch per interpreter ausführen ließ, hatte ich auch schon mal (mit meinem fake-os / gui projekt "ufos").
die fehlersuche war etwas unkonventionell:
nach einem backup meiner dateien (die gui bestand aus zwei .bas-dateien), habe ich einfach sub für sub die inhalte der subs/functions gelöscht, und versucht, den verbleibenden "programmkrüppel" zu kompilieren. und irgendwann bin ich dann drauf gekommen, dass der inhalt einer einzigen funktion diesen "internen fehler nähe nirgendwo" verursachte.
dann gleiches spielchen innerhalb der funktion. zeile für zeile löschen, und die zeile finden, die das kompilieren verhindert. innerhalb dieser zeile (bei mir wars irgendwas mit "if bla then irgendwas = a \ b", vielleicht auch noch was mitm array, keine ahnung...) war's die integer-division ("\") diesen fehler verursachte. bis heute habe ich keine ahnung, was das sollte, oder warum oder wie oder was-auch-immer da falsch gelaufen ist. also wenn da einer aufklären kann...
mfg
Lutz  Ifer
_________________
Wahnsinn ist nur die Antwort einer gesunden Psyche auf eine kranke Gesellschaft. |
|
| Nach oben |
|
|
|
|
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.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
