 |
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 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 10.04.2012, 23:46 Titel: Probleme mit ohne Taskleiste und ??? |
|
|
Hi Leute,
1. Ich hab versucht mich an MODs Code von KIRBY zu bediehnen, doch leider wird wenn ich aus dem Code ne EXE erstelle immernoch in der Taskleiste der EXE-Pfad angezeigt, so als hät ich die EIngabeaufforderung offen.
2. So sollte es sein: BG Transparent - am oberen Fenster(bzw Desktop)rand wird ein Button angezeigt - bei Klick auf diesen SOLLTE er sich vergrößern und weitere Auswahlmöglichkeiten anzeigen.
Und so ist es: teilweise wird bei Ausführungsbeginn nichts angezeigt sondern erst wenn ich auf den Desktop oder ein anderes Fenster klicke
Oder bei Klick auf Button vergrößert sich das sichtbare Feld erst nach Klick auf was anderes.
wer es Probieren möchte sollte noch die Farben ändern da diese bei mir aus einer DAT abgefragt werden
Code: | DECLARE SUB autowrite (c AS INTEGER,ze AS INTEGER,sp AS INTEGER,wort AS STRING)
DECLARE SUB ENDE
DIM AS INTEGER w, h, depth
DIM AS INTEGER wmaus,hmaus,mrad,mbuttons,mclib,mrad2,mradoffset
DIM AS INTEGER I
DIM TIST AS STRING*6
DIM AS STRING keytxt
TYPE Optionenblock
EigenerStatus AS STRING * 1
FPalette AS STRING * 1
REST AS STRING * 253
END TYPE
DIM Optionen AS Optionenblock
TYPE Farbenblock
BG1 AS DOUBLE
BG2 AS DOUBLE
G1 AS DOUBLE
G2 AS DOUBLE
END TYPE
DIM Farben AS Farbenblock
#INCLUDE "fbgfx.bi"
#Include Once "windows.bi"
ScreenControl FB.GET_DESKTOP_SIZE, w, h
SCREENRES w -1 , h - 1, 32,, FB.GFX_SHAPED_WINDOW or FB.GFX_ALWAYS_ON_TOP
Color ,RGB(255, 0, 255) : Cls 'kein HG
WindowTitle "PostMail"
Dim As HANDLE hWnd = FindWindow(0, StrPtr("Postmail"))
ShowWindow(hWnd, SW_HIDE)
SetWindowLong (hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
ShowWindow(hWnd, SW_SHOW)
'Programm
CLOSE: OPEN "C:\PostMail\Option.dat" FOR RANDOM AS #1 LEN=LEN(Optionen)
GET #1, 1, Optionen
CLOSE: OPEN "C:\PostMail\FarbSet.dat" FOR RANDOM AS #1 LEN=LEN(Farben)
GET #1, VAL(Optionen.FPalette), Farben
CLOSE
LINE (w / 2 - 30, 1) - STEP (60, 9),Farben.BG1,BF '&hABCD45
autowrite (Farben.G2, 3, w / 2 - (4 * 6) + 1, "postmail") '&h00FF00
DO'Programm
SLEEP 1
GETMOUSE (wmaus,hmaus,mrad,mbuttons,mclib)
mrad2=mrad-mradoffset 'mrad erhält 2te variable zum späteren zurücksetzen
'beispiel: if mbuttons = 1 then mradoffset=mrad .....
'zum zurücksetzen des rades
keytxt = INKEY
IF keytxt = CHR(27) THEN ENDE 'ESC
'PostMail abfrage
IF mbuttons = 1 AND wmaus > w / 2 - 30 AND wmaus < w / 2 + 30 AND _
hmaus > 0 AND hmaus < 10 THEN
LINE (w / 2 - 30, 10) - STEP (60, 69),Farben.BG1,BF
autowrite (Farben.G2, 23, w / 2 - (4 * 6) + 1, "neuer pc") '&h00FF00
autowrite (Farben.G2, 33, w / 2 - (4 * 6) + 1, "optionen")
autowrite (Farben.G2, 53, w / 2 - (2 * 6) + 1, "mail")
autowrite (Farben.G2, 73, w / 2 - (2 * 6) + 1, "exit")
'PostMail Tasten
DO
SLEEP 1
GETMOUSE (wmaus,hmaus,mrad,mbuttons,mclib)
mrad2=mrad-mradoffset
'neuer PC TASTE
IF mbuttons = 1 AND wmaus > w / 2 - 30 AND wmaus < w / 2 + 30 AND _
hmaus > 19 AND hmaus < 30 THEN
SLEEP 150
COLOR Farben.G2: ? "NEUER PC" '&h00FF00
END IF
IF mbuttons = 2 THEN EXIT DO
LOOP'PostMail Tasten
CLS
LINE (w / 2 - 30, 1) - STEP (60, 9),Farben.BG1,BF '&hABCD45
autowrite (Farben.G2, 3, w / 2 - (4 * 6) + 1, "postmail") '&h00FF00
END IF'PostMail abfrage
LOOP'Programm
SUB autowrite (c AS INTEGER,ze AS INTEGER,sp AS INTEGER,wort AS STRING)
DIM AS INTEGER i
DIM AS STRING bust
COLOR c
FOR i = 1 TO LEN(wort)
bust = MID(wort, i, 1)
IF bust = "a" OR bust = "A" THEN PSET (sp, ze + 4): DRAW "u3 e1 r2 d4 u2 l3": sp = sp + 6: GOTO awende 'A
IF bust = "ä" OR bust = "Ä" OR ASC(bust) = 132 THEN PSET (sp, ze + 4): DRAW "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1": sp = sp + 7: GOTO awende'Ž
IF bust = "b" OR bust = "B" THEN PSET (sp, ze): DRAW "d4 r2 e1 h1 l1 r1 e1 h1 l2": sp = sp + 6: GOTO awende 'B
IF bust = "c" OR bust = "C" THEN PSET (sp + 3, ze): DRAW "l2 g1 d2 f1 r2": sp = sp + 6: GOTO awende 'C
IF bust = "d" OR bust = "D" THEN PSET (sp, ze): DRAW "d4 r2 e1 u2 h1 l2": sp = sp + 6: GOTO awende 'D
IF bust = "e" OR bust = "E" THEN PSET (sp + 3, ze): DRAW "l3 d2 r2 l2 d2 r3": sp = sp + 6: GOTO awende 'E
IF bust = "f" OR bust = "F" THEN PSET (sp + 3, ze): DRAW "l3 d2 r2 l2 d2": sp = sp + 6: GOTO awende 'F
IF bust = "g" OR bust = "G" THEN PSET (sp + 3, ze): DRAW "l2 g1 d2 f1 r2 u2 l1": sp = sp + 6: GOTO awende 'G
IF bust = "h" OR bust = "H" THEN PSET (sp, ze): DRAW "d4 u2 r3 u2 d4": sp = sp + 6: GOTO awende 'H
IF bust = "i" OR bust = "I" THEN PSET (sp + 2, ze): DRAW "d4": sp = sp + 6: GOTO awende 'I
IF bust = "j" OR bust = "J" THEN PSET (sp, ze): DRAW "r3 d3 g1 l1 h1": sp = sp + 6: GOTO awende 'J
IF bust = "k" OR bust = "K" THEN PSET (sp, ze): DRAW "d4 u2 r1 e2 g2 f2": sp = sp + 6: GOTO awende 'K
IF bust = "l" OR bust = "L" THEN PSET (sp, ze): DRAW "d4 r3": sp = sp + 6: GOTO awende 'L
IF bust = "m" OR bust = "M" THEN PSET (sp, ze + 4): DRAW "u4 f2 e2 d4": sp = sp + 6: GOTO awende 'M
IF bust = "n" OR bust = "N" THEN PSET (sp, ze + 4): DRAW "u4 f4 u4": sp = sp + 6: GOTO awende 'N
IF bust = "o" OR bust = "O" THEN PSET (sp, ze + 1): DRAW "d2 f1 r1 e1 u2 h1 l1": sp = sp + 6: GOTO awende 'O
IF bust = "p" OR bust = "P" THEN PSET (sp, ze + 4): DRAW "u4 r2 f1 g1 l1": sp = sp + 6: GOTO awende 'P
IF bust = "q" OR bust = "Q" THEN PSET (sp, ze + 1): DRAW "d2 f1 r1 e1 f1 h1 u2 h1 l1": sp = sp + 7: GOTO awende 'Q
IF bust = "r" OR bust = "R" THEN PSET (sp, ze + 4): DRAW "u4 r2 f1 g1 l1 f2": sp = sp + 6: GOTO awende 'R
IF bust = "s" OR bust = "S" THEN PSET (sp, ze + 4): DRAW "r2 e1 h1 l1 h1 e1 r2": sp = sp + 6: GOTO awende 'S
IF bust = "t" OR bust = "T" THEN PSET (sp, ze): DRAW "r2 d4 u4 r2": sp = sp + 6: GOTO awende 'T
IF bust = "u" OR bust = "U" THEN PSET (sp, ze): DRAW "d4 r3 u4": sp = sp + 6: GOTO awende 'U
IF bust = "ü" OR bust = "Ü" THEN PSET (sp, ze - 1): DRAW "bd2 d3 r3 u3 bu2 r-1": sp = sp + 6: GOTO awende 'U
IF bust = "v" OR bust = "V" THEN PSET (sp, ze): DRAW "d2 f2 e2 u2": sp = sp + 7: GOTO awende 'V
IF bust = "w" OR bust = "W" THEN PSET (sp, ze): DRAW "d4 e2 f2 u4": sp = sp + 6: GOTO awende 'W
IF bust = "x" OR bust = "X" THEN PSET (sp, ze): DRAW "f4 h2 g2 e4": sp = sp + 6: GOTO awende 'X
IF bust = "y" OR bust = "Y" THEN PSET (sp, ze): DRAW "d2 r3 u2 d4 l2": sp = sp + 6: GOTO awende 'Y
IF bust = "z" OR bust = "Z" THEN PSET (sp, ze + 1): DRAW "u1 r3 g3 d1 r3 u1": sp = sp + 6: GOTO awende 'Z
IF bust = "0" THEN PSET (sp, ze + 1): DRAW "d2 f1 r2 e1 u2 h1 l2": sp = sp + 6: GOTO awende '0
IF bust = "1" THEN PSET (sp + 2, ze + 4): DRAW "u4 g2": sp = sp + 6: GOTO awende 'I
IF bust = "2" THEN PSET (sp, ze + 1): DRAW "e1 r1 f1 g3 r3": sp = sp + 6: GOTO awende '2
IF bust = "3" THEN PSET (sp, ze + 4): DRAW "r2 e1 h1 l1 r1 e1 h1 l2": sp = sp + 6: GOTO awende '3
IF bust = "4" THEN PSET (sp + 2, ze + 4): DRAW "u4 g2 d1 r3": sp = sp + 6: GOTO awende '4
IF bust = "5" THEN PSET (sp, ze + 4): DRAW "r2 e1 h1 l2 u2 r3": sp = sp + 6: GOTO awende '5
IF bust = "6" THEN PSET (sp + 2, ze): DRAW "l1 g1 d2 f1 r1 e1 h1 l1": sp = sp + 6: GOTO awende '6
IF bust = "7" THEN PSET (sp, ze + 1): DRAW "u1 r3 d1 g3": sp = sp + 6: GOTO awende '7
IF bust = "8" THEN PSET (sp, ze + 1): DRAW "f1 g1 f1 r1 e1 h1 e1 h1 l1": sp = sp + 6: GOTO awende '8
IF bust = "9" THEN PSET (sp + 2, ze + 2): DRAW "l1 h1 e1 r1 f1 d2 g1 l1": sp = sp + 6: GOTO awende '9
IF bust = "ß" THEN PSET (sp, ze + 5): DRAW "u5 r1 f1 d1 l1 r1 f1 g1": sp = sp + 6: GOTO awende 'B
IF bust = "%" THEN PSET (sp, ze): PSET (sp + 4, ze + 4): PSET (sp, ze + 4): DRAW "e4": sp = sp + 8: GOTO awende '%
IF bust = ">" THEN PSET (sp + 1, ze + 4): DRAW "e2 h2": sp = sp + 6: GOTO awende'>
IF bust = "<" THEN PSET (sp + 4, ze + 4): DRAW "h2 e2": sp = sp + 6: GOTO awende'>
IF bust = "/" THEN PSET (sp, ze + 4): DRAW "e4": sp = sp + 6: GOTO awende '/
IF bust = "\" THEN PSET (sp + 4, ze + 4): DRAW "h4": sp = sp + 6: GOTO awende '/
IF bust = "_" THEN PSET (sp, ze + 4): DRAW "r4": sp = sp + 6: GOTO awende '_
IF bust = "+" THEN PSET (sp + 1, ze + 2): DRAW "r2 l1 u1 d2": sp = sp + 6: GOTO awende '+
IF bust = "-" THEN PSET (sp + 1, ze + 2): DRAW "r2": sp = sp + 6: GOTO awende '-
IF bust = "." THEN PSET (sp + 2, ze + 4): DRAW "": sp = sp + 6: GOTO awende '.
IF bust = "," THEN PSET (sp + 2, ze + 4): DRAW "g1": sp = sp + 6: GOTO awende ',
IF bust = ":" THEN PSET (sp + 2, ze + 4): PSET (sp + 2, ze + 2): sp = sp + 6: GOTO awende ':
IF bust = " " THEN sp = sp + 6: GOTO awende 'leer
PSET (sp, ze + 4): DRAW "r4": sp = sp + 6
awende:
NEXT i
END SUB
SUB ENDE
CLOSE
END
END SUB |
|
|
Nach oben |
|
 |
MOD Fleißiger Referenzredakteur

Anmeldungsdatum: 10.09.2007 Beiträge: 1003
|
Verfasst am: 11.04.2012, 15:55 Titel: |
|
|
Soso, an Kirby bedient...
Ich kann mich nicht entsinnen, lauter GOTOs verwendet zu haben, oder IF-Kaskaden. Wenn du einen Code ohne irgendein GOTO postest und dir die Verwendung von, sagen wir SELECT CASE ansiehst, würde ich mir diesen neuen Code ansehen... |
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 11.04.2012, 20:35 Titel: |
|
|
ok das ist doch nen Deal
wozu ich allerdings sagen muss das GOTO nur in der autowrite SUB vorkommt
mir hat mal jemand hier empfohlen statt der IFs DATA anzuwenden aber das hab ich nicht hinbekommen bestimmte DATA Blöcke abzurufen
bin aber auch nicht auf die Idee gekommen SELECT CASE anzuwenden, aber das werd ich jetzt mal eben machen. |
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 11.04.2012, 21:34 Titel: |
|
|
So ich habe die GOTOs durch SELECT CASE ersetzt
ich hoffe du meintest mit den IF Kaskaden ebenfalls die in der SUB
denn wie ich die, die im Hauptcode stehen ersetzen könnte wüsste ich nicht.
Code: | DECLARE SUB autowrite (c AS INTEGER,ze AS INTEGER,sp AS INTEGER,wort AS STRING)
DECLARE SUB ENDE
DIM AS INTEGER w, h, depth
DIM AS INTEGER wmaus,hmaus,mrad,mbuttons,mclib,mrad2,mradoffset
DIM AS INTEGER I
DIM TIST AS STRING*6
DIM AS STRING keytxt
TYPE Optionenblock
EigenerStatus AS STRING * 1
FPalette AS STRING * 1
REST AS STRING * 253
END TYPE
DIM Optionen AS Optionenblock
TYPE Farbenblock
BG1 AS DOUBLE
BG2 AS DOUBLE
G1 AS DOUBLE
G2 AS DOUBLE
END TYPE
DIM Farben AS Farbenblock
#INCLUDE ONCE "fbgfx.bi"
#Include Once "windows.bi"
ScreenControl FB.GET_DESKTOP_SIZE, w, h
SCREENRES w -1 , h - 1, 32,, FB.GFX_SHAPED_WINDOW or FB.GFX_ALWAYS_ON_TOP
Color ,RGB(255, 0, 255) : Cls 'kein HG
WindowTitle "PostMail"
Dim As HANDLE hWnd = FindWindow(0, StrPtr("Postmail"))
ShowWindow(hWnd, SW_HIDE)
SetWindowLong (hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
ShowWindow(hWnd, SW_SHOW)
'Programm
CLOSE: OPEN EXEPATH + "\Option.dat" FOR RANDOM AS #1 LEN=LEN(Optionen)
GET #1, 1, Optionen
CLOSE: OPEN EXEPATH + "\FarbSet.dat" FOR RANDOM AS #1 LEN=LEN(Farben)
GET #1, VAL(Optionen.FPalette), Farben
CLOSE
LINE (w / 2 - 30, 1) - STEP (60, 9),Farben.BG1,BF '&hABCD45
autowrite (Farben.G2, 3, w / 2 - (4 * 6) + 1, "postmail") '&h00FF00
DO'Programm
SLEEP 1
GETMOUSE (wmaus,hmaus,mrad,mbuttons,mclib)
mrad2=mrad-mradoffset 'mrad erhält 2te variable zum späteren zurücksetzen
'beispiel: if mbuttons = 1 then mradoffset=mrad .....
'zum zurücksetzen des rades
keytxt = INKEY
IF keytxt = CHR(27) THEN ENDE 'ESC
'PostMail abfrage
IF mbuttons = 1 AND wmaus > w / 2 - 30 AND wmaus < w / 2 + 30 AND _
hmaus > 0 AND hmaus < 10 THEN
LINE (w / 2 - 30, 10) - STEP (60, 69),Farben.BG1,BF
autowrite (Farben.G2, 23, w / 2 - (4 * 6) + 1, "neuer pc") '&h00FF00
autowrite (Farben.G2, 33, w / 2 - (4 * 6) + 1, "optionen")
autowrite (Farben.G2, 53, w / 2 - (2 * 6) + 1, "mail")
autowrite (Farben.G2, 73, w / 2 - (2 * 6) + 1, "exit")
'PostMail Tasten
DO
SLEEP 1
GETMOUSE (wmaus,hmaus,mrad,mbuttons,mclib)
mrad2=mrad-mradoffset
'neuer PC TASTE
IF mbuttons = 1 AND wmaus > w / 2 - 30 AND wmaus < w / 2 + 30 AND _
hmaus > 19 AND hmaus < 30 THEN
SLEEP 150
COLOR Farben.G2: ? "NEUER PC" '&h00FF00
END IF
IF mbuttons = 2 THEN EXIT DO
LOOP'PostMail Tasten
CLS
LINE (w / 2 - 30, 1) - STEP (60, 9),Farben.BG1,BF '&hABCD45
autowrite (Farben.G2, 3, w / 2 - (4 * 6) + 1, "postmail") '&h00FF00
END IF'PostMail abfrage
LOOP'Programm
SUB autowrite (c AS INTEGER,ze AS INTEGER,sp AS INTEGER,wort AS STRING)
DIM AS INTEGER i
DIM AS STRING bust
COLOR c
FOR i = 1 TO LEN(wort)
bust = MID(wort, i, 1)
SELECT CASE bust
CASE "a", "A"
PSET (sp, ze + 4): DRAW "u3 e1 r2 d4 u2 l3": sp = sp + 6
CASE "ä", "Ä" ', ASC(132)
PSET (sp, ze + 4): DRAW "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1": sp = sp + 7
CASE "b", "B"
PSET (sp, ze): DRAW "d4 r2 e1 h1 l1 r1 e1 h1 l2": sp = sp + 6
CASE "c", "C"
PSET (sp + 3, ze): DRAW "l2 g1 d2 f1 r2": sp = sp + 6
CASE "d", "D"
PSET (sp, ze): DRAW "d4 r2 e1 u2 h1 l2": sp = sp + 6
CASE "e", "E"
PSET (sp + 3, ze): DRAW "l3 d2 r2 l2 d2 r3": sp = sp + 6
CASE "f", "F"
PSET (sp + 3, ze): DRAW "l3 d2 r2 l2 d2": sp = sp + 6
CASE "g", "G"
PSET (sp + 3, ze): DRAW "l2 g1 d2 f1 r2 u2 l1": sp = sp + 6
CASE "h", "H"
PSET (sp, ze): DRAW "d4 u2 r3 u2 d4": sp = sp + 6
CASE "i", "I"
PSET (sp + 2, ze): DRAW "d4": sp = sp + 6
CASE "j", "J"
PSET (sp, ze): DRAW "r3 d3 g1 l1 h1": sp = sp + 6
CASE "k", "K"
PSET (sp, ze): DRAW "d4 u2 r1 e2 g2 f2": sp = sp + 6
CASE "l", "L"
PSET (sp, ze): DRAW "d4 r3": sp = sp + 6
CASE "m", "M"
PSET (sp, ze + 4): DRAW "u4 f2 e2 d4": sp = sp + 6
CASE "n", "N"
PSET (sp, ze + 4): DRAW "u4 f4 u4": sp = sp + 6
CASE "o", "O"
PSET (sp, ze + 1): DRAW "d2 f1 r1 e1 u2 h1 l1": sp = sp + 6
CASE "ö", "Ö"
PSET (sp, ze + 4): DRAW "r4": sp = sp + 6
CASE "p", "P"
PSET (sp, ze + 4): DRAW "u4 r2 f1 g1 l1": sp = sp + 6
CASE "q", "Q"
PSET (sp, ze + 1): DRAW "d2 f1 r1 e1 f1 h1 u2 h1 l1": sp = sp + 7
CASE "r", "R"
PSET (sp, ze + 4): DRAW "u4 r2 f1 g1 l1 f2": sp = sp + 6
CASE "s", "S"
PSET (sp, ze + 4): DRAW "r2 e1 h1 l1 h1 e1 r2": sp = sp + 6
CASE "t", "T"
PSET (sp, ze): DRAW "r2 d4 u4 r2": sp = sp + 6
CASE "u", "U"
PSET (sp, ze): DRAW "d4 r3 u4": sp = sp + 6
CASE "ü", "Ü"
PSET (sp, ze - 1): DRAW "bd2 d3 r3 u3 bu2 r-1": sp = sp + 6
CASE "v", "V"
PSET (sp, ze): DRAW "d2 f2 e2 u2": sp = sp + 7
CASE "w", "W"
PSET (sp, ze): DRAW "d4 e2 f2 u4": sp = sp + 6
CASE "x", "X"
PSET (sp, ze): DRAW "f4 h2 g2 e4": sp = sp + 6
CASE "y", "Y"
PSET (sp, ze): DRAW "d2 r3 u2 d4 l2": sp = sp + 6
CASE "z", "Z"
PSET (sp, ze + 1): DRAW "u1 r3 g3 d1 r3 u1": sp = sp + 6
CASE "1"
PSET (sp + 2, ze + 4): DRAW "u4 g2": sp = sp + 6
CASE "2"
PSET (sp, ze + 1): DRAW "e1 r1 f1 g3 r3": sp = sp + 6
CASE "3"
PSET (sp, ze + 4): DRAW "r2 e1 h1 l1 r1 e1 h1 l2": sp = sp + 6
CASE "4"
PSET (sp + 2, ze + 4): DRAW "u4 g2 d1 r3": sp = sp + 6
CASE "5"
PSET (sp, ze + 4): DRAW "r2 e1 h1 l2 u2 r3": sp = sp + 6
CASE "6"
PSET (sp + 2, ze): DRAW "l1 g1 d2 f1 r1 e1 h1 l1": sp = sp + 6
CASE "7"
PSET (sp, ze + 1): DRAW "u1 r3 d1 g3": sp = sp + 6
CASE "8"
PSET (sp, ze + 1): DRAW "f1 g1 f1 r1 e1 h1 e1 h1 l1": sp = sp + 6
CASE "9"
PSET (sp + 2, ze + 2): DRAW "l1 h1 e1 r1 f1 d2 g1 l1": sp = sp + 6
CASE "0"
PSET (sp, ze + 1): DRAW "d2 f1 r2 e1 u2 h1 l2": sp = sp + 6
CASE "ß"
PSET (sp, ze + 5): DRAW "u5 r1 f1 d1 l1 r1 f1 g1": sp = sp + 6
CASE "%"
PSET (sp, ze): PSET (sp + 4, ze + 4): PSET (sp, ze + 4): DRAW "e4": sp = sp + 8
CASE ">"
PSET (sp + 1, ze + 4): DRAW "e2 h2": sp = sp + 6
CASE "<"
PSET (sp + 4, ze + 4): DRAW "h2 e2": sp = sp + 6
CASE "/"
PSET (sp, ze + 4): DRAW "e4": sp = sp + 6
CASE "\"
PSET (sp + 4, ze + 4): DRAW "h4": sp = sp + 6
CASE "_"
PSET (sp, ze + 4): DRAW "r4": sp = sp + 6
CASE "+"
PSET (sp + 1, ze + 2): DRAW "r2 l1 u1 d2": sp = sp + 6
CASE "-"
PSET (sp + 1, ze + 2): DRAW "r2": sp = sp + 6
CASE "."
PSET (sp + 2, ze + 4): DRAW "": sp = sp + 6
CASE ","
PSET (sp + 2, ze + 4): DRAW "g1": sp = sp + 6
CASE ":"
PSET (sp + 2, ze + 4): PSET (sp + 2, ze + 2): sp = sp + 6
CASE " "
sp = sp + 6
CASE ELSE
PSET (sp, ze + 4): DRAW "r4": sp = sp + 6
END SELECT
NEXT i
END SUB
SUB ENDE
CLOSE
END
END SUB
|
|
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
Verfasst am: 11.04.2012, 22:47 Titel: |
|
|
braesident hat Folgendes geschrieben: | mir hat mal jemand hier empfohlen statt der IFs DATA anzuwenden aber das hab ich nicht hinbekommen bestimmte DATA Blöcke abzurufen |
siehe RESTORE, wobei ich nicht glaube, dass das hier sehr viel effektiver wäre.
Etwas schneller wäre das ganze, wenn du nicht mit MID(wort, i, 1) arbeiten würdest, sondern gleich mit der String-Indizierung word[i-1] _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 12.04.2012, 11:13 Titel: |
|
|
hab ich mal probiert
Code: | FOR i = 1 TO LEN(wort)
bust = MID(wort, i, 1)
SELECT CASE wort[i-1]
CASE 65, 97'a
PSET (sp, ze + 4): DRAW "u3 e1 r2 d4 u2 l3": sp = sp + 6
CASE 132, 142'ä
PSET (sp, ze + 4): DRAW "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1": sp = sp + 7
|
geht auch gut bis auf die Umlaute (ü, ä, ö, ß), die ASCII codes gehen nicht |
|
Nach oben |
|
 |
MisterD

Anmeldungsdatum: 10.09.2004 Beiträge: 3071 Wohnort: bei Darmstadt
|
Verfasst am: 12.04.2012, 12:05 Titel: |
|
|
protip: mach nach dem end select einfach sp = sp + 6 und nur bei den cases wo's 7 sein muss von hand noch zusätzlich sp = sp + 1, das summiert sich ja dann auf. Ist einfacher als 200 mal +6 zu schreiben  _________________ "It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
Edsger W. Dijkstra |
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 12.04.2012, 13:11 Titel: |
|
|
ok mach ich |
|
Nach oben |
|
 |
dreael Administrator

Anmeldungsdatum: 10.09.2004 Beiträge: 2529 Wohnort: Hofen SH (Schweiz)
|
Verfasst am: 12.04.2012, 22:49 Titel: |
|
|
Das Ganze ist aus meiner Sicht eher wieder einmal ein typischer Fall für etwas mit Arrays zu machen. Siehe dazu auch
http://www.dreael.ch/Deutsch/BASIC-Knowhow-Ecke/Anfaengerfehler.html
In Deinem Fall sinnvoll: Mach doch einfach Arrays der Art
Code: | Dim Shared BuchGlyps(32 To 255) As String
Dim Shared AbstVo(32 To 255) As Integer
Dim Shared Abst(32 To 255) As Integer
For i=32 To 255
Read BuchGlyps(i), AbstVo(i), Abst(i)
Next i
' Und hier alle Zeichensatzdaten
Data "u3 e1 r2 d4 u2 l3", 0, 6, "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1", 4, 7
Data "d4 r2 e1 h1 l1 r1 e1 h1 l2", 0, 6, "l2 g1 d2 f1 r2", 3, 6
....
|
=> danach wird Deine Sub etwas sehr Kompaktes der Art
Code: | SUB autowrite (c AS INTEGER,ze AS INTEGER,sp AS INTEGER,wort AS STRING)
..
Dim As Integer bust
FOR i = 1 TO LEN(wort)
bust = Asc(UCase(MID(wort, i, 1)))
PSET (sp, ze + AbstVo(bust))
DRAW BuchGlyps(bust)
sp = sp + Abst(bust)
NEXT i
End Sub |
_________________ Teste die PC-Sicherheit mit www.sec-check.net |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
Verfasst am: 13.04.2012, 11:04 Titel: |
|
|
braesident hat Folgendes geschrieben: | Code: | FOR i = 1 TO LEN(wort)
bust = MID(wort, i, 1)
SELECT CASE wort[i-1]
CASE 65, 97'a
PSET (sp, ze + 4): DRAW "u3 e1 r2 d4 u2 l3": sp = sp + 6
CASE 132, 142'ä
PSET (sp, ze + 4): DRAW "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1": sp = sp + 7
|
|
Da kann das 'bust = MID(wort, i, 1)' getrost raus, das verwendest du ja nicht mehr.
braesident hat Folgendes geschrieben: | geht auch gut bis auf die Umlaute (ü, ä, ö, ß), die ASCII codes gehen nicht |
Ascii-Codes sind ja nur bis 127 definiert, für höhere Werte gibt es verschiedene Codepages. Welche Codenummer du brauchst, hängt davon ab, in welcher Kodierung du deinen Quelltext speicherst (oder wenn die Daten von außerhalb kommen: in welcher Kodierung sie dort vorliegen). Es ist recht wahrscheinlich, dass du die Codepage ISO 8859-15 verwendest. _________________ Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
Nach oben |
|
 |
MisterD

Anmeldungsdatum: 10.09.2004 Beiträge: 3071 Wohnort: bei Darmstadt
|
Verfasst am: 13.04.2012, 14:05 Titel: |
|
|
codepages sind nicht nur für werte >127 zuständig. Umlaute wie äöüß sind bereits bei werten unter 127 unterschiedlich pro charset. _________________ "It is practically impossible to teach good programming to students that have had a prior exposure to BASIC: as potential programmers they are mentally mutilated beyond hope of regeneration."
Edsger W. Dijkstra |
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 13.04.2012, 17:32 Titel: |
|
|
ok ich hab das mit den Codes so gelöst
Code: | SELECT CASE wort[i-1]
CASE 132, 142, 196, 228' Ä-> '-'-> 196 ä-> õ-> 228
PSET (sp, ze + 4): DRAW "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1": sp = sp + 1
CASE 148, 153, 214, 246 'Ö-> í-> 214 ö-> ÷-> 246
PSET (sp, ze + 4): DRAW "r4"
CASE 129, 154, 220, 252'Ü-> _-> 220 ü-> ³-> 252
PSET (sp, ze - 1): DRAW "bd2 d3 r3 u3 bu2 r-1"
CASE 225, 223'ß-> ¯-> 223
PSET (sp, ze + 5): DRAW "u5 r1 f1 d1 l1 r1 f1 g1" |
@dreael das werd ich mal seperat testen
ansonsten danke für die vielen Tips
aber hat nicht zufällig noch jemand ne Lösungsidee zu meinen eigendlichen Fragen? BITTE BITTE  |
|
Nach oben |
|
 |
XOR
Anmeldungsdatum: 23.07.2010 Beiträge: 161
|
Verfasst am: 14.04.2012, 13:13 Titel: |
|
|
so sollte es mit dem zeichnen gehen:
Code: | #Include Once "fbgfx.bi"
#Include Once "windows.bi"
Declare Sub autowrite (c As Integer,ze As Integer,sp As Integer,wort As String)
Declare Sub ENDE()
Dim As Integer w, h, depth
Dim As Integer wmaus,hmaus,mrad,mbuttons,mclib,mrad2,mradoffset
Dim As Integer I
Dim TIST As String*6
Dim As String keytxt
Type Optionenblock
EigenerStatus As String * 1
FPalette As String * 1
REST As String * 253
End Type
Dim Optionen As Optionenblock
Type Farbenblock
BG1 As Double
BG2 As Double
G1 As Double
G2 As Double
End Type
Dim Farben As Farbenblock
ScreenControl FB.GET_DESKTOP_SIZE, w, h
ScreenRes w-1 , h-1, 32,, FB.GFX_SHAPED_WINDOW Or FB.GFX_ALWAYS_ON_TOP
Dim As HWND hWnd
ScreenControl FB.GET_WINDOW_HANDLE, Cast(Integer, hWnd)
ShowWindow(hWnd, SW_HIDE)
SetWindowLong (hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
ShowWindow(hWnd, SW_SHOW)
ScreenLock
Line (0,0)-(w, h), RGB(255, 0, 255), bf
ScreenUnLock
'Programm
Close: Open ExePath + "\Option.dat" For Random As #1 Len=Len(Optionen)
Get #1, 1, Optionen
Close: Open ExePath + "\FarbSet.dat" For Random As #1 Len=Len(Farben)
Get #1, Val(Optionen.FPalette), Farben
Close
ScreenLock
Line (w / 2 - 30, 1) - Step (60, 9),Farben.BG1,BF '&hABCD45
autowrite (Farben.G2, 3, w / 2 - (4 * 6) + 1, "postmail") '&h00FF00
ScreenUnLock
Do 'Programm
Sleep 1
GetMouse (wmaus,hmaus,mrad,mbuttons,mclib)
mrad2=mrad-mradoffset 'mrad erhält 2te variable zum späteren zurücksetzen
'beispiel: if mbuttons = 1 then mradoffset=mrad .....
'zum zurücksetzen des rades
keytxt = Inkey
If keytxt = Chr(27) Then ENDE 'ESC
'PostMail abfrage
If mbuttons = 1 And wmaus > w / 2 - 30 And wmaus < w / 2 + 30 And _
hmaus > 0 And hmaus < 10 Then
ScreenLock
Line (w / 2 - 30, 10) - Step (60, 69),Farben.BG1,BF
autowrite (Farben.G2, 23, w / 2 - (4 * 6) + 1, "neuer pc") '&h00FF00
autowrite (Farben.G2, 33, w / 2 - (4 * 6) + 1, "optionen")
autowrite (Farben.G2, 53, w / 2 - (2 * 6) + 1, "mail")
autowrite (Farben.G2, 73, w / 2 - (2 * 6) + 1, "exit")
ScreenUnLock
'PostMail Tasten
Do
Sleep 1
GetMouse (wmaus,hmaus,mrad,mbuttons,mclib)
mrad2=mrad-mradoffset
'neuer PC TASTE
If mbuttons = 1 And wmaus > w / 2 - 30 And wmaus < w / 2 + 30 And _
hmaus > 19 And hmaus < 30 Then
Sleep 150
Color Farben.G2: ? "NEUER PC" '&h00FF00
End If
If mbuttons = 2 Then Exit Do
Loop'PostMail Tasten
ScreenLock
Line (0,0)-(w, h), RGB(255, 0, 255), bf
Line (w / 2 - 30, 1) - Step (60, 9),Farben.BG1,BF '&hABCD45
autowrite (Farben.G2, 3, w / 2 - (4 * 6) + 1, "postmail") '&h00FF00
ScreenUnLock
End If'PostMail abfrage
Loop'Programm
Sub autowrite (c As Integer,ze As Integer,sp As Integer,wort As String)
Dim As Integer i
Dim As String bust
Color c
For i = 1 To Len(wort)
bust = Mid(wort, i, 1)
Select Case bust
Case "a", "A"
PSet (sp, ze + 4): Draw "u3 e1 r2 d4 u2 l3": sp = sp + 6
Case "ä", "Ä" ', ASC(132)
PSet (sp, ze + 4): Draw "u2 e2 f2 d2 u2 l4 bu3 u-1 br4 d-1": sp = sp + 7
Case "b", "B"
PSet (sp, ze): Draw "d4 r2 e1 h1 l1 r1 e1 h1 l2": sp = sp + 6
Case "c", "C"
PSet (sp + 3, ze): Draw "l2 g1 d2 f1 r2": sp = sp + 6
Case "d", "D"
PSet (sp, ze): Draw "d4 r2 e1 u2 h1 l2": sp = sp + 6
Case "e", "E"
PSet (sp + 3, ze): Draw "l3 d2 r2 l2 d2 r3": sp = sp + 6
Case "f", "F"
PSet (sp + 3, ze): Draw "l3 d2 r2 l2 d2": sp = sp + 6
Case "g", "G"
PSet (sp + 3, ze): Draw "l2 g1 d2 f1 r2 u2 l1": sp = sp + 6
Case "h", "H"
PSet (sp, ze): Draw "d4 u2 r3 u2 d4": sp = sp + 6
Case "i", "I"
PSet (sp + 2, ze): Draw "d4": sp = sp + 6
Case "j", "J"
PSet (sp, ze): Draw "r3 d3 g1 l1 h1": sp = sp + 6
Case "k", "K"
PSet (sp, ze): Draw "d4 u2 r1 e2 g2 f2": sp = sp + 6
Case "l", "L"
PSet (sp, ze): Draw "d4 r3": sp = sp + 6
Case "m", "M"
PSet (sp, ze + 4): Draw "u4 f2 e2 d4": sp = sp + 6
Case "n", "N"
PSet (sp, ze + 4): Draw "u4 f4 u4": sp = sp + 6
Case "o", "O"
PSet (sp, ze + 1): Draw "d2 f1 r1 e1 u2 h1 l1": sp = sp + 6
Case "ö", "Ö"
PSet (sp, ze + 4): Draw "r4": sp = sp + 6
Case "p", "P"
PSet (sp, ze + 4): Draw "u4 r2 f1 g1 l1": sp = sp + 6
Case "q", "Q"
PSet (sp, ze + 1): Draw "d2 f1 r1 e1 f1 h1 u2 h1 l1": sp = sp + 7
Case "r", "R"
PSet (sp, ze + 4): Draw "u4 r2 f1 g1 l1 f2": sp = sp + 6
Case "s", "S"
PSet (sp, ze + 4): Draw "r2 e1 h1 l1 h1 e1 r2": sp = sp + 6
Case "t", "T"
PSet (sp, ze): Draw "r2 d4 u4 r2": sp = sp + 6
Case "u", "U"
PSet (sp, ze): Draw "d4 r3 u4": sp = sp + 6
Case "ü", "Ü"
PSet (sp, ze - 1): Draw "bd2 d3 r3 u3 bu2 r-1": sp = sp + 6
Case "v", "V"
PSet (sp, ze): Draw "d2 f2 e2 u2": sp = sp + 7
Case "w", "W"
PSet (sp, ze): Draw "d4 e2 f2 u4": sp = sp + 6
Case "x", "X"
PSet (sp, ze): Draw "f4 h2 g2 e4": sp = sp + 6
Case "y", "Y"
PSet (sp, ze): Draw "d2 r3 u2 d4 l2": sp = sp + 6
Case "z", "Z"
PSet (sp, ze + 1): Draw "u1 r3 g3 d1 r3 u1": sp = sp + 6
Case "1"
PSet (sp + 2, ze + 4): Draw "u4 g2": sp = sp + 6
Case "2"
PSet (sp, ze + 1): Draw "e1 r1 f1 g3 r3": sp = sp + 6
Case "3"
PSet (sp, ze + 4): Draw "r2 e1 h1 l1 r1 e1 h1 l2": sp = sp + 6
Case "4"
PSet (sp + 2, ze + 4): Draw "u4 g2 d1 r3": sp = sp + 6
Case "5"
PSet (sp, ze + 4): Draw "r2 e1 h1 l2 u2 r3": sp = sp + 6
Case "6"
PSet (sp + 2, ze): Draw "l1 g1 d2 f1 r1 e1 h1 l1": sp = sp + 6
Case "7"
PSet (sp, ze + 1): Draw "u1 r3 d1 g3": sp = sp + 6
Case "8"
PSet (sp, ze + 1): Draw "f1 g1 f1 r1 e1 h1 e1 h1 l1": sp = sp + 6
Case "9"
PSet (sp + 2, ze + 2): Draw "l1 h1 e1 r1 f1 d2 g1 l1": sp = sp + 6
Case "0"
PSet (sp, ze + 1): Draw "d2 f1 r2 e1 u2 h1 l2": sp = sp + 6
Case "ß"
PSet (sp, ze + 5): Draw "u5 r1 f1 d1 l1 r1 f1 g1": sp = sp + 6
Case "%"
PSet (sp, ze): PSet (sp + 4, ze + 4): PSet (sp, ze + 4): Draw "e4": sp = sp + 8
Case ">"
PSet (sp + 1, ze + 4): Draw "e2 h2": sp = sp + 6
Case "<"
PSet (sp + 4, ze + 4): Draw "h2 e2": sp = sp + 6
Case "/"
PSet (sp, ze + 4): Draw "e4": sp = sp + 6
Case "\"
PSet (sp + 4, ze + 4): Draw "h4": sp = sp + 6
Case "_"
PSet (sp, ze + 4): Draw "r4": sp = sp + 6
Case "+"
PSet (sp + 1, ze + 2): Draw "r2 l1 u1 d2": sp = sp + 6
Case "-"
PSet (sp + 1, ze + 2): Draw "r2": sp = sp + 6
Case "."
PSet (sp + 2, ze + 4): Draw "": sp = sp + 6
Case ","
PSet (sp + 2, ze + 4): Draw "g1": sp = sp + 6
Case ":"
PSet (sp + 2, ze + 4): PSet (sp + 2, ze + 2): sp = sp + 6
Case " "
sp = sp + 6
Case Else
PSet (sp, ze + 4): Draw "r4": sp = sp + 6
End Select
Next i
End Sub
Sub ENDE()
Close
End
End Sub |
die zeichensachen sollte man zwischen screenlock und screenunlock setzen, dann geht es. |
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 14.04.2012, 20:55 Titel: |
|
|
super das geht gut - es ging auch mit ständigen CLSs was natürlich total doof ist da ja jedesmal alles wieder gezeichet werden muss was nicht hätte gelöscht werden sollen.
weiß jetzt noch jemand warum nach dem Combilieren noch immer das DOS Fenster zu sehen ist und wie ich es weg bekomme also so wie bei MODs Kirby. Auch fehlt unter den EXE eigenschaften der 'Version' Reiter.
EDIT: Ich hab es mit dem Kirby-Code:
Code: | WindowTitle "PostMail"
Dim As HANDLE hWnd = FindWindow(0, StrPtr("PostMail"))
ShowWindow(hWnd, SW_HIDE)
SetWindowLong (hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
ShowWindow(hWnd, SW_SHOW)
| und mit XORs geposteten Code: Code: | Dim As HWND hWnd
ScreenControl FB.GET_WINDOW_HANDLE, Cast(Integer, hWnd)
ShowWindow(hWnd, SW_HIDE)
SetWindowLong (hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_TOOLWINDOW)
ShowWindow(hWnd, SW_SHOW)
| versucht. |
|
Nach oben |
|
 |
nemored

Anmeldungsdatum: 22.02.2007 Beiträge: 4704 Wohnort: ~/
|
|
Nach oben |
|
 |
braesident
Anmeldungsdatum: 15.04.2008 Beiträge: 189 Wohnort: Berlin
|
Verfasst am: 14.04.2012, 22:08 Titel: |
|
|
fantastisch - Danke |
|
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.
|
|