Új hozzászólás Aktív témák
-
bakaiadam
csendes tag
köst az előső segítséget,megint lenne egy kérdésem,mért tüntek el a karakterek a képernyőről éás csak a kurzor villog?(crt,dos modul)
-
b14
senior tag
En keszitettem egy sajat unitot: http://pascal.uw.hu/progs/bu.tpu
Nem egy nagy cucc.
Csak a munkamat konnyitem vele. Ha valakit erdekel az eljarasok listaja, az irjon a pascal@pro.hu címre. Azt elmondom elore, hogy van benne egy elok(hatterszn,szovegszi:byte) eljaraws ez helyettesiti a textcolor,backgoroundcolort eljarasokat !!!VIGYZAT AZ ELOK, MIELOTT BEALLITANA A HATTERSZINT, SZOVEGSZINT KEPERNYOT TOROL!!!!
udv b14;''...de a konfigjából kiindulva, nem hiszem, hogy 40 éves családos ember lenne...'' -- by Slax
-
bakaiadam
csendes tag
program jatek;
uses {graph,}dos,crt;
var vege:boolean;
var ezelotti,gomb:char;
var regihelyzet,helyj2,szam,szam2,szam3,regihelyzetregihely,szin,helyj,helyzet:byte;
var g,h,b,a,fsd,fdd,szaml,hely2,hely,ido,ora,perc,masod,ms,{,a,b,}c:longint;
procedure jatekmenet2;
begin
randomize;
if (helyzet=hely2) and (helyj2=1) then vege:=true;
hely2:=random(3);
hely2:=hely2+10;
end;
procedure jatekmenet;
begin
randomize;
if (helyzet=hely) and (helyj=1) then vege:=true;
hely:=random(3);
hely:=hely+10;
end;
procedure kepetfrissit;
begin
helyj:=helyj-1;
helyj2:=helyj2-1;
if helyj2=1 then clrscr;
if helyj=1 then clrscr;
if helyj2=1 then jatekmenet2;
if helyj2=1 then helyj2:=10;
if helyj=1 then jatekmenet;
if helyj=1 then helyj:=10;
if hely=10 then jatekmenet;
if hely2=10 then jatekmenet2;
gotoxy(hely,helyj+1);
textcolor(black);
write('ţ');
gotoxy(hely2,helyj2+1);
write('ţ');
gotoxy(helyzet,1);
textcolor(red);
write('|');
textcolor(green);
gotoxy(hely,helyj);
write('1');
gotoxy(hely2,helyj2);
write('2');
end;
procedure idozit;
begin
gettime(g,h,b,a);
ido:=b;
{if b<59 then ido:=b+1;
if b=59 then ido:=1;}
repeat
gettime(g,h,b,a);
gomb:='0';
repeat
if ido<>b then readkey;
until readkey<>'0';
if readkey<>'0' then gomb:='a';
ezelotti:=readkey;
if readkey='d' then gomb:='d';
if readkey='a' then gomb:='a';
if readkey='s' then gomb:='s';
if gomb='d'then helyzet:=12;
if gomb='a'then helyzet:=10;
if gomb='s' then helyzet:=11;
gotoxy(11,1);
write(' ');
gotoxy(12,1);
write(' ');
gotoxy(10,1);
write(' ');
gotoxy(helyzet,1);
textcolor(red);
write('ţ');
until {((gomb<>'0') and (ezelotti<>readkey) or} ido<b;
end;
procedure kepetfrissit1;
begin
helyj:=10;
helyj2:=14;
gotoxy(hely,helyj+1);
textcolor(black);
write(' ');
gotoxy(hely2,helyj2+1);
write(' ');
gotoxy(helyzet,1);
textcolor(red);
write('|');
textcolor(green);
gotoxy(hely,helyj);
write('|');
gotoxy(hely2,helyj2);
write('|');
end;
begin
hely:=11;
hely2:=12;
helyj:=10;
helyj2:=14;
jatekmenet;
jatekmenet2;
repeat
szaml:=szaml+1;
idozit;
kepetfrissit;
until vege=true;
end.
Mit szóltok hozzá?Csak az a fránya readkey meg lenne oldva -
bakaiadam
csendes tag
program jatek;
uses {graph,}dos,crt;
var vege:boolean;
var ezelotti,gomb:char;
var regihelyzet,helyj2,szam,szam2,szam3,regihelyzetregihely,szin,helyj,helyzet:byte;
var g,h,b,a,fsd,fdd,szaml,hely2,hely,ido,ora,perc,masod,ms,{,a,b,}c:longint;
procedure jatekmenet2;
begin
randomize;
if (helyzet=hely2) and (helyj2=1) then vege:=true;
hely2:=random(3);
hely2:=hely2+10;
end;
procedure jatekmenet;
begin
randomize;
if (helyzet=hely) and (helyj=1) then vege:=true;
hely:=random(3);
hely:=hely+10;
end;
procedure kepetfrissit;
begin
helyj:=helyj-1;
helyj2:=helyj2-1;
if helyj2=1 then clrscr;
if helyj=1 then clrscr;
if helyj2=1 then jatekmenet2;
if helyj2=1 then helyj2:=10;
if helyj=1 then jatekmenet;
if helyj=1 then helyj:=10;
if hely=10 then jatekmenet;
if hely2=10 then jatekmenet2;
gotoxy(hely,helyj+1);
textcolor(black);
write('ţ');
gotoxy(hely2,helyj2+1);
write('ţ');
gotoxy(helyzet,1);
textcolor(red);
write('|');
textcolor(green);
gotoxy(hely,helyj);
write('1');
gotoxy(hely2,helyj2);
write('2');
end;
procedure idozit;
begin
gettime(g,h,b,a);
ido:=b;
{if b<59 then ido:=b+1;
if b=59 then ido:=1;}
repeat
gettime(g,h,b,a);
gomb:='0';
repeat
if ido<>b then readkey;
until readkey<>'0';
if readkey<>'0' then gomb:='a';
ezelotti:=readkey;
if readkey='d' then gomb:='d';
if readkey='a' then gomb:='a';
if readkey='s' then gomb:='s';
if gomb='d'then helyzet:=12;
if gomb='a'then helyzet:=10;
if gomb='s' then helyzet:=11;
gotoxy(11,1);
write(' ');
gotoxy(12,1);
write(' ');
gotoxy(10,1);
write(' ');
gotoxy(helyzet,1);
textcolor(red);
write('ţ');
until {((gomb<>'0') and (ezelotti<>readkey) or} ido<b;
end;
procedure kepetfrissit1;
begin
helyj:=10;
helyj2:=14;
gotoxy(hely,helyj+1);
textcolor(black);
write(' ');
gotoxy(hely2,helyj2+1);
write(' ');
gotoxy(helyzet,1);
textcolor(red);
write('|');
textcolor(green);
gotoxy(hely,helyj);
write('|');
gotoxy(hely2,helyj2);
write('|');
end;
begin
hely:=11;
hely2:=12;
helyj:=10;
helyj2:=14;
jatekmenet;
jatekmenet2;
repeat
szaml:=szaml+1;
idozit;
kepetfrissit;
until vege=true;
end.
Mit szóltok hozzá?Csak az a fránya readkey meg lenne oldva -
bakaiadam
csendes tag
de a readkaey helyett tudtok valami más parancsot ajánlani
-
rgb7
tag
törölni a pascalt, használjatok qbasicek!
-
bakaiadam
csendes tag
ha mondjuk bemásolnád és elindítanád, észrevehető,hogy amig nem adsz meg egy betüt,addig szünetelteti a program futását
-
b14
senior tag
a szoveges kepernyo egy bizonyos karakteret hogy lehet lekerdezni?
''...de a konfigjából kiindulva, nem hiszem, hogy 40 éves családos ember lenne...'' -- by Slax
-
Gyuri16
senior tag
marmint hogy egy bizinyos koordinatan milyen karakter van? Arra van egy jo dolog. Itt az egesz kepernyod egy 2 dimenzios tombben van benne. Igy nez ki:
kep : array [1..25,1..80] of record c:char; a:byte end absolute $b800:$0000;
egy kis komment, ha a kepernyod beallitasa 80*25 akkor egy van, de ha 80*50 akkor a 25 ot termeszetesen at kell irnod 50 re.
ezt beirod elejere a var hoz, aztan le tudod kerdezni a jeleket igy:
kep[1,1].c= ez a 1,1 koordinatan levo karaktert adja meg
kep[1,1].a= ez meg a szine
megadni is megtudod termeszetesen:
kep[1,1].c:='a';
kep[1,1].a:=blue;
vagy ha a kocka hatterszinet szeretned megadni, akkor azt is lehet, ha pl kek hatteret szeretnel:
kep[1,1].a:=blue * 16;
a szorzas 16al azert van ott, mivel a szint 8 bit adja meg, a felso 4 adja meg a hatteret az also negy meg a karakter szinet, namarmost ha a felso 4et akarom megadni akkor odebb kell tolnom az egeszet neggyel, tehat 2 a negyedikennel, ami 16 (ha nem vilagos nezzuk a tizes szamrendszert, ha van egy szamod pl 5 abbol 500 at akarsz csinalni, tehat odebbtolni 2 hellyel 10 a masodikonnal kell szorozni).
Remelem tudtam segiteniNem vagyok egoista, csak uborkagyalu!
-
B-52
csendes tag
Hello!!!!!!!!!!!
Kis segitség kénne, hogyan lehet beszórni képet háttérnek?????????????
(forráskód jólene példaként) -
B-52
csendes tag
Nincs sok időm, ha valakí tud segíteni jeleze!!!!!!!!!
-
bakaiadam
csendes tag
a keypressed azért nem jó,mert csak 2 értéket vehet fel és a program 3 értékkel dolgozik
-
Gyuri16
senior tag
válasz bakaiadam #170 üzenetére
ezt nem teljesen ertem, szerintem igy a legjobb, a programod nem neztem, de valoszinu meg lehet igy irni, persze ehhez ertenem kellene azt amit mondtal, milyen 2-3 ertek?
vagyis mi a 3 ertek, ugye a keypressed vagy true vagy false, ez utan meg valamibe readkeyozol, es ott mar mindent be tudsz olvasni
[Szerkesztve]Nem vagyok egoista, csak uborkagyalu!
-
KovacsUr
addikt
Milyen képernyőmódot használsz? Szöveges módban kicsit nehézkes lesz a dolog, a standard BGI csak 16 színt tud, úgyhogy nem lesz túl szép, hacsak nem valami egyszerű logoról van szó... Ha valami külső SVGA könyvtárat használsz, akkor már egész szépen megoldhatod.
So it goes… We stand alone by standing stones and turn them into circles.
-
bakaiadam
csendes tag
a keypressed azért nem jó mert ez csak true és false lehet,a readkey meg akár száz is(százgombos billentyűzeten),de ebben nem vagyok biztos,amúgy tetszik a program?
-
Gyuri16
senior tag
válasz bakaiadam #177 üzenetére
pont az a lenyek, hogy a kepressed csak true vagy false lehet, igy megcsinalod''
if keypressed then valtozo:=readkey
ez azt csinalja, hogy csak akkor csinalja a readkeyt, amikor tenyleg megnyomsz valamit. Probald ki, biztos hogy menni fog. Ha meglesz megnezem a programotNem vagyok egoista, csak uborkagyalu!
-
Gyuri16
senior tag
-
B-52
csendes tag
válasz KovacsUr #176 üzenetére
Hello!
Sajna csak 16-s tud kezelni jobb tipppeket szivesen fogadok, egyébkén nem régen programozok tehát ne képzald, hogy netán profilennék ezért ha van információd azt érthetően küld.Ja a jövőhéten készlesz a torpedó alapverziója majd ha érdekel elküldhetem.
Na hello.:y -
b14
senior tag
Hello!
http://pascal.uw.hu/progs/bmpread.pas
http://pascal.uw.hu/progs/bitmap.tpu''...de a konfigjából kiindulva, nem hiszem, hogy 40 éves családos ember lenne...'' -- by Slax
-
b14
senior tag
Ha egybe nezem, csodalkozok, hogy milyen szep hosszu ki topic lett és mennyire eltértünk a témátol
[Szerkesztve]''...de a konfigjából kiindulva, nem hiszem, hogy 40 éves családos ember lenne...'' -- by Slax
-
b14
senior tag
(* bmpread.pas *)
program Bitmap_olvasasa;
uses crt, graph, bitmap;
var gvezerlo, gmod,
hibakod, x, y :integer;
nev : string;
begin
clrscr;
writeln('K‚ren a .BMP f jl nev‚t: ');
readln(nev);
if nev='' then nev:='donald.bmp';
{ A grafika bekapcsol sa automatikus hardver ‚s m˘d detekt l ssal }
detectgraph(gvezerlo,gmod);
initgraph(gvezerlo,gmod,'');
{ Ha nem sikerlt bekapcsolni a grafik t kil‚p‚s a programb˘l }
hibakod := GraphResult;
if hibakod <> grOK then
begin
WriteLn('Grafika hiba:');
WriteLn(GraphErrorMsg(hibakod));
Halt(1);
end;
{ A .BMP f jl beolvas sa ‚s megjelenˇt‚se }
bmpdisplay(nev);
readln;
{ A grafika kikapcsol sa ‚s a sz”veges zemm˘d vissza llˇt sa}
closegraph;
restorecrtmode;
end.
Es a hsznalt unit:
(* BITMAP.PAS *)
{ a grafikus k‚perny“ k”zep‚re
16 szˇn– bitk‚p felolvas s t v‚gz“ modul }
unit bitmap;
interface
{ 16 szˇn– bitk‚p megjelenˇt‚se }
procedure BMPDisplay(FileName: string);
implementation
uses Graph;
type
TBitMapHeader = Record { a bitk‚p fejl‚ce }
bfType : word;
bfSize : longint;
bfReserved : longint; { 0 }
bfOffBits : longint;
biSize : longint;
biWidth : longint;
biHeight : longint;
biPlanes : word; { 1 }
biBitCount : word; {1,4,8,24}
biCompression : longint;
biSizeImage : longint; {b jtban}
biXPelsPerMeter : longint;
biYPelsPerMeter : longint;
biClrUsed : longint;
biClrImportant : longint;
end;
TRGBQuad = Record { az RGB-paletta elemei }
rgbBlue,
rgbGreen,
rgbRed,
rgbReserved : Byte;
end;
TByteArray = Array[0..50000] of byte;
{----------------------------------------------------}
{ 4-bites szˇneket tartalmaz˘ .BMP f jl tartalm nak }
{ megjelenˇt‚se a k‚perny“ k”zep‚n }
{----------------------------------------------------}
procedure Display4 (var f : file; BitMapHeader : TBitMapHeader);
var
i, y: Integer;
RGBQuad : TRGBQuad;
TwoPixel, Black : Byte;
Line : ^TByteArray;
number : word;
CurrentX, BeginX, BeginY, EndY : Integer;
begin
if GetMaxColor < 15 then
begin
OutText ('Ez a m˘d nem t mogatja a 4 bites szˇnek haszn lat t!');
Exit;
end;
Black := 16;
{ a palettaszˇnek felolvas sa }
for i:= 0 to 15 do
begin
BlockRead(f, RGBQuad, SizeOf(RGBQuad));
if (longint(RGBQuad)=0) then Black := i;
with RGBQuad do
SetRGBPalette(i, rgbRed shr 2, rgbGreen shr 2, rgbBlue shr 2);
SetPalette(i,i);
end;
{ a bitk‚p k”z‚pre igazˇt sa }
with BitMapHeader do
begin
{ a k‚psor b jtok sz ma }
Number := (biWidth div 2 + 3) and not 3;
{ k”z‚pre helyezi a k‚perny“n }
BeginX := (GetMaxX - biWidth) div 2;
BeginY := GetMaxY - (GetMaxY - biHeight) div 2;
EndY := BeginY + 1 - biHeight;
end;
{ a k‚p bitjeinek feldolgoz sa }
GetMem (Line, number + 1);
{ soronk‚nt }
for y:=BeginY downto EndY do
begin
BlockRead(f, Line^[1], number);
CurrentX := BeginX;
{ b jtonk‚nt }
for i:=1 to number do
begin
TwoPixel := Line^; { k‚t k‚ppont }
if TwoPixel shr 4 <> Black then { a fels“ }
PutPixel(CurrentX, y ,TwoPixel shr 4);
Inc(CurrentX);
if TwoPixel and 15 <> Black then { az als˘ }
PutPixel(CurrentX, y, TwoPixel and 15);
Inc(CurrentX);
end;
end;
FreeMem (Line, number+1);
end;
procedure NotDisplay(colors:byte);
var
tst : string[4];
begin
str(colors, tst);
OutText (tst+' bites szˇneket tartalmaz˘ bitk‚p megjelenˇt‚s‚re nem alkalmas!');
end;
{--------------------------------------------}
{ A megadott nev– .BMP llom ny feldolgoz sa }
{--------------------------------------------}
procedure BMPDisplay(FileName: string);
var f: file;
BitMapHeader : TBitMapHeader;
begin
Assign(f,FileName);
FileMode := 0; {Read Only}
{$I-}
Reset(f,1);
FileMode := 2; {Default}
{$I+}
if IOResult<>0 then
begin
OutText ('A(z) '+FileName+' nev– f jl nem l‚tezik!');
Exit;
end;
{ a bitk‚pfejl‚c beolvas sa }
BlockRead(f, BitMapHeader, SizeOf(BitMapHeader));
with BitMapHeader do
begin
if (bfType<>19778) or (bfReserved<>0) or (biPlanes<>1) then
begin
OutText ('Nem Windows bitk‚p llom ny!');
Close(f);
Exit;
end;
if biCompression<>0 then
begin
OutText ('Nem tud megjelenˇteni t”m”rˇtett llom nyt!');
Close(f);
Exit;
end;
ClearDevice;
case biBitCount of
1 : NotDisplay(1); { 1-bites szˇn: ? }
4 : Display4(f, BitMapHeader);{ 4-bites szˇn }
8 : NotDisplay(8); { 8-bites szˇn: ? }
24 : NotDisplay(24); { 24-bites szˇn: ? }
else
begin
OutText ('Nem Windows bitk‚p llom ny!');
Close(f);
Exit;
end;
end;
end;
Close(f);
end;
end.
Remelem erre volt szukseged.
Tovabbi jo programozást.
Ha nem erre lett volnaszukseged akkor csak szolj vannak meg ilyen dolgaim''...de a konfigjából kiindulva, nem hiszem, hogy 40 éves családos ember lenne...'' -- by Slax
-
bakaiadam
csendes tag
sziasztok,még 1 kérdésem lenne,hogyan lehet egy string-et karakterekre bontva word-ökké alakítani,nagyon fontos lenne,thx
-
warezlord
tag
válasz bakaiadam #191 üzenetére
hallod te gyerek!
a STRING az egy olyan változó amibe szöveges értékek vannak benne.
pl: hiba=abcdefg;
Ahol a hiba az a string típusú változónak a neve, az abcdefg meg annak a tartalma.
ÉS a word típusú változó meg egész számokat képes tárolni, szal nem hiszem hogy stringből wordbe lehetne ''konvertálni''...
Legfeljebb így lehetséges:
hiba=abcdefg;
hiba[1]=a; ahol a hiba[x] a hiba x értékét adja ki...
hiba[2]=b;
és így tovább...
De ha akarod akkor leírhatom a teljes programot!
Csak mondd meg mihez kell! Mit kell csinálni + mibe kell másolni stb...
PL: hiba,x:string {ezek a változók és típusaik}
hiba:=abcdefg;
hiba[1]{ami egyenlő az a betűvel}:=x;
Akkor x értékbe benne lesz ami a hiba sorozat 1. karakterje, vagyis az x értékben a betű lesz...
De ha akarod akkor részletezhetek...
warezlordTévedni emberi dolog, de összekutyulni valamit csak számítógéppel lehet igazán...
-
warezlord
tag
Késő délutáni UP!!!
Tévedni emberi dolog, de összekutyulni valamit csak számítógéppel lehet igazán...
-
Gyuri16
senior tag
válasz warezlord #192 üzenetére
na azert ebbe van 1-2 hiba:
hiba=abcdefg;
ez igy nem jo, hanem igy:
hiba:='abcdefg';
aztan:
hiba[1]{ami egyenlő az a betűvel}:=x;
Akkor x értékbe benne lesz ami a hiba sorozat 1. karakterje, vagyis az x értékben a betű lesz...
x:=hiba[1];
esetleg igy, mert mindig a bal oldali valtozoba teszi a jobb oldalon levo valtozot, nem forditva
lehet hogy arra gondolt az illeto, hogy ha van egy stringje, ami ilyen:
valtozo:='123';
akkor ezt hogyan lehet wordbe beletenni. Azt meg pontosan azzal lehet, amit irtal, tehat:
szam:word;
szam:=vatozo[1]*100+valtozo[2]*10+valtozo[3];Nem vagyok egoista, csak uborkagyalu!
-
khalox
őstag
Err, ez tényleg mind szép, ám az eredeti probléma 'specifikációja', hogyismondjam... kissé hiányosnak tűnik.
Nem értem mit is akar? Szövegként adott szám karaktereit sorban word-ökké alakítani egy tömbben? Vagy egy stringként adott számot akar word-dé (mert arra van egyszerű függvény...).
Vagy a szöveg karaktereinek kódjait akarja 16 biten (unicode?)? Vagy mit?
[Szerkesztve]
Új hozzászólás Aktív témák
- Gyúrósok ide!
- Kormányok / autós szimulátorok topicja
- Milyen CPU léghűtést vegyek?
- Kicsit extrémre sikerült a Hyte belépője a készre szerelt vízhűtések világába
- Mozgásban a 33 Immortals
- ASUS routerek
- Fejhallgató erősítő és DAC topik
- Publikálta a Microsoft az MS-DOS 4.0 forráskódját
- Házi barkács, gányolás, tákolás, megdöbbentő gépek!
- Automata kávégépek
- További aktív témák...