> Tous les forums > Forum Autres langages
 qbasicSujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
qbasic45
  Posté le 26/04/2013 @ 15:21 
Aller en bas de la page 
Petit astucien

Salut à tous

Besoin d'aide pour qbsic 4.5
je voudrais un programmes
donc une donner est

a$="123456789" donner de depart

il devrais faire deplaser les numero de place

1) 123456789
2) 123456798
3) 123456879
4) 123456897
5) 123456978
6) 123456987

jusque il arrive a

?) 987654321

Merci de votre aide

Publicité
w36xb2w
 Posté le 27/04/2013 à 11:30 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour

essaye ceci

10 'par w36xb2w 1989
20 DIM M$(15)
'bb$= mot dans data
'b$ mot a traiter

100 SCREEN 12: ' MENU
110 CLS : DEFINT A-Z
130 PRINT "A - ANAGRAMME"
140 PRINT "C - CONTREPETERIES"
150 PRINT "F - FIN"
160 Tex$ = "ACF": GOSUB 8000: nb = 0: ON k GOTO 170, 2000, 3000

' Anagramme
170 CLS : PRINT "( 3 a 11 lettres )"
190 INPUT "VOTRE MOT : ", M$: M$ = LCASE$(M$): mm$ = M$
200 L = LEN(M$): IF L < 3 OR L > 11 THEN PRINT CHR$(7); : GOTO 170
205 GOSUB 9000
210 PRINT "E cran ou I mprimante ?"
220 Tex$ = "EI": GOSUB 8000: impr = k - 1: IF impr THEN PRINT ; CHR$(27); CHR$(64); : PRINT CHR$(15); ""
230 NPL = INT(79 / (L + 1))
240 FOR i = 1 TO L: M$(i) = MID$(M$, i, 1): NEXT
250 GOTO 4000

'Contrepetrie
2000 PRINT "( 3 a 10 Syllabes )"
2020 PRINT "Votre MOT , par syllabe :"; : PRINT " ( ENTER=fin )": i = 1: LTOT = 0
2030 INPUT "", M$(i)
2040 IF M$(i) = "" AND i > 3 THEN i = i - 1: GOTO 2060
2050 IF i < 10 THEN i = i + 1: GOTO 2030
2060 FOR J = 1 TO i: LTOT = LTOT + LEN(M$(J)): NEXT
2063 L = i
2070 NPL = INT(79 / (LTOT + 1))
2075 GOSUB 9000
2076 FOR i = 1 TO 2500: NEXT
2080
2081 GOTO 4000

3000 'FINAL
3010 CLS
3020 END

4000 'ecran
4010
4011 INPUT "Voulez vous verifier avec le dictionnaire O ui N on "; O$: O$ = UCASE$(O$)
IF O$ = "" OR O$ = "O" THEN qq$ = "O" ELSE qq$ = "N"
4030 CLS : pg = 1
PRINT "M= MENU P=Page suivante PAGE "; pg;
4060 PRINT STRING$(80, "_")

5000 ' TRAITEMENT
5010 b$ = ""
5020 FOR A1 = 1 TO L
5025 IF A1 = 0 THEN 5490
5030 b$ = M$(A1)
5031 IF L = 1 THEN 5380
5035 '
5040 FOR A2 = 1 TO L
5050 IF A2 = A1 THEN 5480
5060 b$ = M$(A1) + M$(A2)
5061 IF L = 2 THEN 5380
5065 '
5070 FOR A3 = 1 TO L
5080 IF A3 = A1 OR A3 = A2 THEN 5470
5090 b$ = M$(A1) + M$(A2) + M$(A3)
5100 IF L = 3 THEN 5380
5105 '
5110 FOR A4 = 1 TO L
5120 IF A4 = A1 OR A4 = A2 OR A4 = A3 THEN 5460
5130 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4)
5140 IF L = 4 THEN 5380
5145 '
5150 FOR A5 = 1 TO L
5160 IF A5 = A1 OR A5 = A2 OR A5 = A3 OR A5 = A4 THEN 5450
5170 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5)
5180 IF L = 5 THEN 5380
5185 '
5190 FOR A6 = 1 TO L
5200 IF A6 = A1 OR A6 = A2 OR A6 = A3 OR A6 = A4 OR A6 = A5 THEN 5440
5210 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5) + M$(A6)
5220 IF L = 6 THEN 5380
5225 '
5230 FOR A7 = 1 TO L
5240 IF A7 = A1 OR A7 = A2 OR A7 = A3 OR A7 = A4 OR A7 = A5 OR A7 = A6 THEN 5430
5250 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5) + M$(A6) + M$(A7)
5260 IF L = 7 THEN 5380
5265 '
5270 FOR A8 = 1 TO L
5280 IF A8 = A1 OR A8 = A2 OR A8 = A3 OR A8 = A4 OR A8 = A5 OR A8 = A6 OR A8 = A7 THEN 5420
5290 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5) + M$(A6) + M$(A7) + M$(A8)
5300 IF L = 8 THEN 5380
5305 '
5310 FOR A9 = 1 TO L
5320 IF A9 = A1 OR A9 = A2 OR A9 = A3 OR A9 = A4 OR A9 = A5 OR A9 = A6 OR A9 = A7 OR A9 = A8 THEN 5410
5330 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5) + M$(A6) + M$(A7) + M$(A8) + M$(A9)
5340 IF L = 9 THEN 5380
5345 '
5350 FOR A10 = 1 TO L
5360 IF A10 = A1 OR A10 = A2 OR A10 = A3 OR A10 = A4 OR A10 = A5 OR A10 = A6 OR A10 = A7 OR A10 = A8 OR A10 = A9 THEN 5400
5370 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5) + M$(A6) + M$(A7) + M$(A8) + M$(A9) + M$(A10)
5371 IF L = 10 THEN 5380

5372 FOR A11 = 1 TO L
5373 IF A11 = A1 OR A11 = A2 OR A11 = A3 OR A11 = A4 OR A11 = A5 OR A11 = A6 OR A11 = A7 OR A11 = A8 OR A11 = A9 OR A11 = A10 THEN 5399
5374 b$ = M$(A1) + M$(A2) + M$(A3) + M$(A4) + M$(A5) + M$(A6) + M$(A7) + M$(A8) + M$(A9) + M$(A10) + M$(A11)
5375 IF L = 11 THEN 5380
5376 '

5380 GOSUB 6000: 'ecriture
5390 ON L - 2 GOTO 5470, 5460, 5450, 5440, 5430, 5420, 5410, 5400, 5399
5399 NEXT A11
5400 NEXT A10
5410 NEXT A9
5420 NEXT A8
5430 NEXT A7
5440 NEXT A6
5450 NEXT A5
5460 NEXT A4
5470 NEXT A3
5480 NEXT A2
5490 NEXT A1
5500
IF impr = 1 THEN PRINT CHR$(27); CHR$(64): PRINT CHR$(15): RUN 100
5520 q$ = ""
5521 WHILE q$ = ""
5522 q$ = UCASE$(INKEY$)
5523 WEND
5524 IF q$ = "M" THEN RUN 100 ELSE 5520

5999 ' ECRITURE
6000 IF qq$ = "N" THEN 6020
6001 IF L = 3 THEN RESTORE 13000
6002 IF L = 4 THEN RESTORE 14000
6003 IF L = 5 THEN RESTORE 15000
6004 IF L = 6 THEN RESTORE 16000
6005 IF L = 7 THEN RESTORE 17000
6006 IF L = 8 THEN RESTORE 18000
6007 IF L = 9 THEN RESTORE 19000
6008 IF L = 10 THEN RESTORE 20000
6009 IF L = 11 THEN RESTORE 30000
6010 IF impr = 1 THEN 6060

6012 WHILE bb$ <> (b$): READ bb$
6013 IF bb$ = "*" THEN 6020
6015 WEND


6020 t = t + 1
6021 nb = nb + 1
6025 IF (b$) = bb$ THEN b$ = UCASE$(b$)
6026 PRINT " "; (b$);
6027 IF t = NPL THEN t = 0
6030 WHILE q$ = "": q$ = UCASE$(INKEY$): WEND: IF q$ = "M" THEN RUN 100 ELSE IF q$ <> "P" THEN 6030
6050 GOTO 6070

6060 t = t + 1
6061 PRINT " "; b$;
6062 IF t = INT(132 / (L + 1)) THEN t = 0: PRINT CHR$(13)

6070 b$ = "": RETURN
6090 RETURN
6999 '

8000 'REPONSE A UN MENU
8010 LT = LEN(Tex$): r$ = ""
8020 PRINT "Reponse (";
8030 FOR i = 1 TO LT - 1
8040 PRINT MID$(Tex$, i, 1); ","; : NEXT
8050 PRINT RIGHT$(Tex$, 1); ")"
8060 Tex$ = UCASE$(Tex$)
8070 WHILE r$ = "": r$ = INKEY$: WEND
8080 r$ = UCASE$(r$): k = INSTR(Tex$, r$)
8090 IF k = 0 THEN r$ = "": PRINT CHR$(7); : GOTO 8070
8100 RETURN

8900 'traitement
9000 RESTORE 10000: FOR i = 3 TO L: READ comb$: NEXT
CLS : PRINT "Combinaisons="; comb$
9010 RETURN

10000 DATA 6,24,120,720,5040,40320,362880,3628800,39916800,479001600
13000
DATA abc,ace,acr,ade,aga,age,agi,ahi,aie,ail,ain,air,ais,ale,alp,ame,ami,ana,ane,

qbasic45
 Posté le 27/04/2013 à 16:07 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

bonjour

sa fonctoin parfaitement

je suprime les lignes

6002 IF L = 4 THEN RESTORE 14000
6003 IF L = 5 THEN RESTORE 15000
6004 IF L = 6 THEN RESTORE 16000
6005 IF L = 7 THEN RESTORE 17000
6006 IF L = 8 THEN RESTORE 18000
6007 IF L = 9 THEN RESTORE 19000
6008 IF L = 10 THEN RESTORE 20000
6009 IF L = 11 THEN RESTORE 30000

car il sont pas dans ton programme

merci pour ta gentillesse

w36xb2w
 Posté le 27/04/2013 à 18:48 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour

C'est normal je n 'ai pas tout joint car trop long

ce logiciel me servait pour chercher les combinaisons de lettres pour trouver un mot dans les data classés par nombre de lettres et le programme établisait la comparaison avec ce qu'il trouvait et les mots entrés comme une dico de scrabble et ne donne en sortie que ce qui est Ok

Exemple pirate,parite,paitre,etc..



Modifié par w36xb2w le 30/04/2013 09:59
w36xb2w
 Posté le 09/07/2013 à 16:29 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour

Programme pour calculer les triangles quelconque.

Si une personne sait comment on peut programmer une impression écran je suis preneur

DECLARE SUB sortie ()
DECLARE SUB reponse (r$)
CLEAR
CLS
LOCATE 11, 15: PRINT "ÛÛÛÛÛ ÛÛÛÛ Û ÛÛÛ Û Û ÛÛÛÛÛ Û ÛÛÛÛ"
LOCATE 12, 15: PRINT " Û Û Û Û Û Û ÛÛ Û Û Û Û "
LOCATE 13, 15: PRINT " Û ÛÛÛÛ Û ÛÛÛÛÛ Û Û Û Û ÛÛ Û ÛÛÛ "
LOCATE 14, 15: PRINT " Û Û Û Û Û Û Û ÛÛ Û Û Û Û "
LOCATE 15, 15: PRINT " Û Û Û Û Û Û Û Û ÛÛÛÛÛ ÛÛÛÛ ÛÛÛÛ"
LOCATE 17, 15: PRINT "réalisé par w36xb2w le 16 11 88"
LOCATE 18, 15: PRINT "adapté sur PC en QUICKBASIC le 17.07.94"
LOCATE 19, 15: PRINT "Sortie Ecran ou fichier"
LOCATE 20, 20: GOSUB attente
PRINT FRE(0)
CONST pi = 3.14159#
DIM a(1), b(1), c(1)
DEF FNdeg (a) = a / pi * 180

debut: CLS
LOCATE 1, 2: PRINT "Entrez dans l'ordre la base oppos‚e … l'angle connu"
LOCATE 2, 2: INPUT "base Connue a = "; a: IF a = 0 THEN GOTO debut:
LOCATE 3, 2: INPUT "cot‚ si Connu b = "; b
LOCATE 4, 2: INPUT "cot‚ si Connu c = "; c

GOSUB 14000
50
IF b = 0 AND c = 0 THEN
LOCATE 5, 2: PRINT "Entrez au moins 2 angles "
END IF
LOCATE 7, 2: INPUT "angle oppos‚ au cot‚ a = "; aa
LOCATE 8, 2: INPUT "angle oppos‚ au cot‚ b = "; bb
IF b < 0 AND bb < 0 OR c < 0 AND bb < 0 THEN GOTO debut
IF aa >= 0 AND bb >= 0 THEN n = 180 - aa - bb ELSE GOTO debut
IF n <= 0 THEN GOTO 50
LOCATE 9, 2: PRINT "angle opposé au coté c = "; n;
INPUT cc
100
GOSUB 40000
2030 GOSUB 16000
IF aa > 0 AND cc > 0 THEN b = a * SIN(ccrad + aarad) / SIN(aarad)
IF cc > 0 AND bb > 0 THEN b = a * SIN(bbrad) / SIN(bbrad + ccrad)
IF bb > 0 AND aa > 0 THEN c = a * SIN(bbrad + aarad) / SIN(aarad)
GOSUB 14000
4000 IF b = 0 AND c > 0 AND aa = 0 AND bb > 0 AND cc = 0 THEN
a(1) = a * SIN(bbrad) / a
m = (1 - a(1) ^ 2)
aa = ATN(a(1) / SQR(m)) * 180 / pi

GOSUB 14000
END IF
4020 IF b > 0 AND c = 0 AND aa = 0 AND bb = 0 AND cc > 0 THEN
c = SQR(a ^ 2 + b ^ 2 - 2 * a * b * COS(ccrad))
b(1) = b * SIN(ccrad) / c
m = (1 - b(1) ^ 2)
bb = ATN(b(1) / SQR(m)) * 180 / pi
GOSUB 14000
END IF
4030 IF b > 0 AND c = 0 AND aa < 180 AND bb = 0 AND cc = 0 THEN
b(1) = b * SIN(aarad) / a
m = (1 - b(1) ^ 2)
bb = ATN(b(1) / SQR(m)) * 180 / pi
c(1) = pi - aarad - bbrad
cc = FNdeg(c(1))
GOSUB 40000

GOSUB 14000
END IF
4040 IF b > 0 AND c = 0 AND aa > 180 AND bb = 0 AND cc = 0 THEN
b(1) = b * SIN(aarad) / a
m = (1 - b(1) ^ 2)
bb = ATN(b(1) / SQR(m)) * 180 / pi
aa = aa - 180

GOSUB 14000
END IF
IF cc = 0 THEN 6000
5000 WHILE bb = 0
b(1) = b / a * SIN(aarad)
m = (1 - b(1) ^ 2)
bb = ATN(b(1) / SQR(m)) * 180 / pi

WEND
5500 IF aa < 180 AND bb > 0 THEN
cc = 180 - aa - bb
ELSE cc = 180 * 2 - aa - bb
END IF
c(1) = cc / 180 * pi

6000 WHILE cc = 0
c(1) = a * SIN(aarad) / b
m = (1 - c(1) ^ 2)
cc = ATN(c(1) / SQR(m)) * 180 / pi
WEND
IF cc > 180 THEN cc = cc - 360
GOSUB 40000
GOSUB 16000
IF aa > 0 AND cc > 0 THEN c = a * SIN(ccrad) / SIN(aarad)

7000 IF CINT(aa + bb + cc) <> 180 THEN GOSUB Question:
'******************************************************
7020
rep$ = "O"
CALL sortie
GOSUB impression
GOSUB attente
GOSUB 13000
'***********************************************
Question:
PRINT "Voulez vous recommencer O N:"
DO
DO
rep$ = INKEY$
LOOP WHILE rep$ = ""
rep$ = UCASE$(rep$)
IF rep$ = "O" THEN
EXIT DO
ELSEIF rep$ = "N" THEN
END
END IF
LOOP
GOTO debut:
'***********************************
12000 IF a > b + c OR b > a + c OR c > a + b THEN PRINT "erreur": GOTO debut
p = (a + b + c) / 2
12020 m = (p - a)
a(1) = (2 * p * m / b / c) - 1
IF a(1) = 0 THEN
a(1) = 1: aa = 90
ELSE
m = (1 - a(1) ^ 2)
aa = ATN((SQR(m) / a(1))) * 180 / pi
END IF

12030 m = (p - b)
b(1) = (2 * p * m / a / c) - 1
IF b(1) = 0 THEN
b(1) = 1: bb = 90
ELSE
m = (1 - b(1) ^ 2)
bb = ATN((SQR(m) / b(1))) * 180 / pi

END IF
12035 IF c(1) = pi / 2 THEN
cc = 90
' PRINT "12035 cc"; cc
GOTO 12060
END IF
12040 m = (p - c)
c(1) = (2 * p * m / a / b) - 1
IF c(1) = 0 THEN
c(1) = pi / 2
cc = 90
ELSE
m = (1 - c(1) ^ 2)
cc = ATN((SQR(m) / c(1))) * 180 / pi
END IF
IF cc < 0 THEN cc = 180 + cc
GOSUB 40000

12060 GOSUB 7020
RETURN
'****************************************
13000 bas = a * i
coteb = b * i
cotec = c * i
coteh = h * i
zz = coteb ^ 2 - coteh ^ 2
d = SQR(zz)
RETURN
'****************************************
14000 IF b > 0 AND c > 0 THEN GOSUB 12000
RETURN
'******************************
'si 2 angles connus recherche du troisieme
16000 IF aa > 0 AND cc > 0 THEN bb = 180 - aa - cc
IF cc > 0 AND bb > 0 THEN aa = 180 - cc - bb
IF bb > 0 AND aa > 0 THEN cc = 180 - bb - aa
GOSUB 40000
RETURN
'*******************************
impression:
IF bb < 0 THEN bb = 180 + bb
IF cc < 0 THEN cc = 180 + cc
IF aa < 0 THEN aa = 180 + aa
h = b * SIN(ccrad)
LOCATE 2, 2: PRINT #1, USING "BASE a = #######.###"; a
LOCATE 3, 2: PRINT #1, USING "COTE b = #######.###"; b
LOCATE 4, 2: PRINT #1, USING "COTE c = #######.###"; c
LOCATE 5, 2: PRINT #1, USING "Hauteur h = #######.###"; h
LOCATE 7, 2: PRINT #1, USING "Angle oppose au cote a = #######.## Deg"; aa
LOCATE 8, 2: PRINT #1, USING "Angle oppose au cote b = #######.## Deg"; bb
LOCATE 9, 2: PRINT #1, USING "Angle oppose au cote c = #######.## Deg"; cc
GOSUB attente:
GOSUB dessin:
RETURN
'**************************
20000
RESTORE 20000
ii = 1
WHILE ii <> 12
CLS
a = 0: b = 0: c = 0
aa = 0: bb = 0: cc = 0
aarad = 0: bbrad = 0: ccrad = 0
READ a, b, c, aa, bb, cc
PRINT
PRINT "exemple"; ii
ii = ii + 1
IF INKEY$ = "0" THEN GOSUB debut:
CLS : GOTO 100
WEND
DATA 3,0,0,36.87,53.13,0
DATA 3,0,0,36.87,0 ,90
DATA 3,0,0,0 ,53.13,90
DATA 3,4,0,0 ,53.13,90
DATA 3,4,5,0 ,0 ,0
DATA 3,0,5,0 ,53.13,90
RETURN
'****************************
40000
aarad = aa / 180 * pi
bbrad = bb / 180 * pi
ccrad = cc / 180 * pi
RETURN
'****************************
dessin:
' 10=vert 11=bleu 12=rouge 13=rose 14=jaune cf 5.38 du guide
' 0=noir 1=bleu 2=vert 3=emeraude 4=rouge 5=violet 6=bleu 7=gris
SCREEN 12
'definition de la fenetre maxi
WINDOW (-1000, -600)-(300, 300)
'********************
WHILE coteh < 400 OR bas < 1000
GOSUB 13000
i = i + 1.5
WEND
'**********************
WHILE coteh >= 400 OR bas >= 1000
GOSUB 13000
i = i - 1.5
WEND
'*********************
PSET STEP(-400, -200)
LINE -STEP(bas, 0), 7

LOCATE 25, 15: PRINT , USING "BASE (a) ######.##"; a
LOCATE 8, 30: PRINT , USING "ANGLE (A) ###.##"; aa
IF cc <= 90 THEN
LINE -STEP(-d, coteh), 7
LINE -STEP(-(bas - d), -coteh), 7
LOCATE 15, 40: PRINT , USING " Cot‚ (b) ######.##"; b
LOCATE 15, 5: PRINT , USING " Cot‚ (c) ######.##"; c

LOCATE 23, 10: PRINT , USING "ANGLE (B) ###.##"; bb
LOCATE 23, 50: PRINT , USING "ANGLE (C) ###.##"; cc
ELSE
LINE -STEP(d, coteh), 7
LINE -STEP(-(bas + d), -coteh), 7
LOCATE 15, 40: PRINT , USING " Cot‚ (B) ######.##"; b
LOCATE 15, 10: PRINT , USING " Cot‚ (C) ######.##"; c

LOCATE 23, 10: PRINT , USING "ANGLE (A)###.##"; bb
LOCATE 23, 50: PRINT , USING "ANGLE (B)###.##"; cc

END IF
RETURN
'*****************************
attente:
DO
LOOP WHILE INKEY$ = ""
CLS
PRINT "Appuyer sur une touche"
RETURN
'******************************

SUB reponse (r$)
INPUT ; r$
IF r$ = "" THEN r$ = "N"
r$ = UCASE$(MID$(r$, 1, 1))
IF r$ = "" THEN reponse (r$)
IF r$ <> "O" AND r$ <> "N" THEN BEEP
END SUB

SUB sortie

'SYSTEMINFO /
CLOSE #1
DO

LOCATE 17, 20: PRINT "Sortie vers un fichier (F)"
LOCATE 18, 20: PRINT "Sortie sur Ecran ----->(E)"
LOCATE 19, 20: PRINT "Reprendre un calcul--->(R)"
LOCATE 20, 20: PRINT "Abandonner ----------->(A) "
choix$ = UCASE$(INPUT$(1))
LOOP WHILE choix$ <> "F" AND choix$ <> "R" AND choix$ <> "A" AND choix$ <> "E"
SELECT CASE choix$
CASE "F"
d$ = "c:\"
CLS
LOCATE 18, 20: PRINT "Choix disque résultat => "; d$
n$ = "TRIANGLE.TXT"
LOCATE 20, 20: PRINT "Nom du fichier sortie => "; n$
nn$ = d$ + n$
OPEN n$ FOR OUTPUT AS #1
CASE "R"
impr = 0
RUN "triangle.exe"
CASE "E"
WIDTH "scrn:", 255
OPEN "scrn:" FOR OUTPUT AS #1
CASE "A"
END
END SELECT
END SUB

rdany62
 Posté le 09/07/2013 à 16:59 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Bonjour,

QBasic, çà fait longtemps...

Il y avait, il me semble, lprint, pour l'impression (à la place de print), mais çà "pointe" vers LPT1, çà ne marchera peut être pas si:

- tu as Windows XP ou ultérieur (ton programme accèderait directement au matériel)

- tu as une imprimante USB

C'est à vérifier (jamais essayé). Ca pourrait marcher si qb n'accède pas directement aux IO du port LPT et si l'invite de commande de Windows redirige les requêtes envoyées au LPT1 sur l'imprimante. Idem, il me semble que les imprimantes ne disant pas d'un jeu de caractères intégré ne fonctionnent pas (c'est particulier, imprimer depuis un programme écrit en QB sur un PC actuel).

Sinon, il y a freebasic, compatible (en grande partie) avec le QBasic: http://fr.wikipedia.org/wiki/FreeBasic

L'IDE qui va bien: http://fbide.freebasic.net/

Par contre, FBIDE intègre une ancienne version du compilo FreeBasic, tu peux télécharger le dernier ici: http://sourceforge.net/projects/fbc/

Je n'ai rien trouvé concernant l'impression avec FreeBasic (il est pas mal, je m'en suis déjà servi à titre personnel).

[EDIT]

Je me rapelle que sur Amstrad CPC, il fallait envoyer ses octects sur la canal 8 pour imprimer, par ex: print #8,"Hello world !"

C'est peut-être aussi le cas avec QBasic (après avoir ouvert PRN en écriture), mais çà date vraiment et j'ai un peu de mal à me souvenir.

[/EDIT]

[EDIT #2]

A l'époque, j'utilsais la touche "impr. écran" de mon clavier, je sais pas si marcherait encore.

Si l'écran doit contenir du graphisme, celui-ci ne sera pas imprimé avec ce type de méthodes.

En cas de présence de graphismes:

- sous QBasic:

- solution #1: simuler un appui sur "impr écran"

- solution #2: récupérer le contenu du buffer vidéo (segment 0xA000 dans les modes graphiques standards et 0xB800 dans les modes textes standard, en principe), en faire un bitmap, et, tout en balayant (zone rectangulaire par zone rectangulaire) ce bitmap, redéfinir un caractère avec les données du bitmap, en prenant soin de les remettre dans le bon format, pour l'envoyer vers l'imprimante.

- sous FreeBasic:

- récupérer le contenu du buffer et l'envoyer sur l'imprimante (si FreeBasic gère l'impression)

[/EDIT #2]



Modifié par rdany62 le 09/07/2013 17:57
qbasic45
 Posté le 10/07/2013 à 00:58 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

bonjour w36xb2w

' EXEMPLE
' cli sur ton disk dur ( C ) fait un nouveau dossier ( le nom ) Donne
' et pour l'imprimer en usb ton imprimante me en .txt

DECLARE SUB Lire ()
DECLARE SUB Ecrire ()

COMMON SHARED fichier$
fichier$ = "C:\donne\Notes.txt"
CLS
DO
LOCATE 1, 1: PRINT " [L]ire | [E]crire | [Q]uitter "
DO
Touche$ = UCASE$(INKEY$)
LOOP UNTIL Touche$ <> " "
SELECT CASE Touche$
CASE "L"
Lire
CASE "E"
Ecrire
END SELECT
LOOP UNTIL Touche$ = "Q"
END

SUB Ecrire
'dure ecrit dans le fichier
CLS
PRINT " Ecrire sautez une ligne pour finir "
PRINT
OPEN fichier$ FOR OUTPUT AS #1
DO
LINE INPUT Texte$
PRINT #1, Texte$
LOOP UNTIL Texte$ = " "
CLOSE #1
END SUB

SUB Lire
'lit le contenu du fichier
CLS
PRINT " *** Bloc-Notes *** "
PRINT
OPEN fichier$ FOR INPUT AS #1
DO UNTIL EOF(1) = -1
LINE INPUT #1, Ligne$
PRINT Ligne$
LOOP
CLOSE #1
END SUB



Modifié par qbasic45 le 10/07/2013 01:00
Page : [1] 
Page 1 sur 1

Vous devez être connecté pour poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Sujets relatifs
vieille question sur Qbasic...
Qbasic
télécharger Qbasic
QBasic
probleme sur qbasic j'suis un noobie...
aide en QBASIC et en HTML
 > Tous les forums > Forum Autres langages