Hirdetés
- Xiaomi: Android 16 zápor, zivatar
- Xiaomi 15T - reakció nélkül nincs egyensúly
- Honor Magic6 Pro - kör közepén számok
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- A Galaxy S26-tal együtt késik a One UI 8.5
- Lecsap az S26 Ultra az Exynos 2600-ra
- „Új mérce az Android világában” – Kezünkben a Vivo X300 és X300 Pro
- Samsung Galaxy S23 Ultra - non plus ultra
- Samsung Galaxy Z Fold5 - toldozás-foldozás
- Nokia E51 - kecs és fém
Új hozzászólás Aktív témák
-
#878
b14
senior tag
Egyik(Ember)
#877
b14
senior tag
válasz
Egyik(Ember)
#877
üzenetére
2003 óta szerintem már meg tudta oldani
-
#775
b14
senior tag
Darth_Revan
#774
b14
senior tag
válasz
Darth_Revan
#774
üzenetére
Középső karakter?
Az hanyadik?
-
b14
senior tag
uses crt;
var i, j ,k:integer; s:array [1..100] of string; w:string;
begin
clrscr;
i:=0;
repeat
inc(i);
write('Az '+i+'. érték: ');readln(s[ i ]); {A *-gal lehet megszakítani a bevitelt}
until s[ i ]<>'*';
k:=i;
for i:=1 to k do
for j:=1 to i-1 do
if(s[j] > s[j+1] then { csere }
begin
w := s[j];
s[j] := s[j+1];
s[j+1] := w;
end;
clrscr;
for i:=1 to k do writeln('Sorba rakva az '+i+'érték: '+s[ i ]);
end.
[Szerkesztve] -
#673
b14
senior tag
Panzermeyer
#672
b14
senior tag
válasz
Panzermeyer
#672
üzenetére
Felvettelek.
-
#671
b14
senior tag
Panzermeyer
#670
b14
senior tag
válasz
Panzermeyer
#670
üzenetére
milyen eljérésok kellenek? msnem van.
-
#635
b14
senior tag
[HUN]Zolee
#634
b14
senior tag
válasz
[HUN]Zolee
#634
üzenetére
-
#622
b14
senior tag
[HUN]Zolee
#621
b14
senior tag
válasz
[HUN]Zolee
#621
üzenetére
Turbo Pascal.
-
#612
b14
senior tag
hummerdikk
#611
b14
senior tag
válasz
hummerdikk
#611
üzenetére
Pascalt talalsz a freepascal.org-on.
MOD: leirast pedig a prog.hu-on talalsz.
[Szerkesztve] -
#597
b14
senior tag
Darth_Revan
#596
b14
senior tag
válasz
Darth_Revan
#596
üzenetére
1. osztály, de régen volt: 1234: egy darab eezreees, két daraaab szááázas, háárooom daraaaab tííízes és nééégy daraab eeegyees. Legabááis mi igy tanultuk annak idején.
Ha valaki megírja helyetted, akkor sose tudsz majd progzani, de ha segítséget kérsz, akkor szívesen segít bárki (szerintem), ha megíros, az a legjobb, és ha sok benne továbbra is a hiba, akkor ki fogja valaki neked javítani.
Mondhatod, hogy egy nagy hülye vagyok, de ez a tapasztalat (már amennyi van), merő jó szándélkból mondtam ezt.
Na és most megírom.
Szerk: ha meguntad a próbálkozást, akkor ide is berakom a progit.
[Szerkesztve] -
#283
b14
senior tag
[HUN]Zolee
#278
b14
senior tag
válasz
[HUN]Zolee
#278
üzenetére
HI
Sztem tulbonyolitod
Ugy egyszerubb lenne, hogy :
uses crt;
var
f: text;
s:string;
begin
clrscr;
assign(f,'filename.kit');
append(f);
writeln(f,s);
readkey;
end.
Szerintem igy jo
Nem irtam commenteket (magyarazatokat) , remelem nem is kel, de ha megis akkor szolj.
Ez a program egyszeru valtozata, nincs benne fajl letezesenek ellenozese (file exist)
Ha tudok meg segiteni akkor szolj
[Szerkesztve] -
b14
senior tag
bocs, de most nem vagok valami jo formamban, es elnezest kerek az elozo kisse ''tulreagallt'' uzenetemert.
Bar az megsem ertem, hogy a megoldasokkal mi a baj?
Es azt sem, hogy Khalox-nak mi baja van velem, mert mindig ezt magyarazza , hogy melik bolygorol vagyok
Valamit mar ujithatna a szovegen. -
#251
b14
senior tag
Pufokaboka
#245
b14
senior tag
válasz
Pufokaboka
#245
üzenetére
Hogy kell asm-ben programozni?
Konyv? -
b14
senior tag
Nem teljesen ertelek.
Talan egy kicsit.
Azzal kapcsolatban, amit iral (...123a....) nem probalkoztam, de nem is nagyon erdekel.
igy szoktam pl egy szam hosszusagat nezve:
uses crt;
var
a:string;
b,c,d:integer;
begin
clrscr;
writeln('Kérek egy számot');
readln(a);
b:=length(a);
val(a,c,d);
if d <>0 then begin writeln('hiba'); readln; halt; end;
writeln('Ez osszesen ',b,' jegyu szam');
readln;
halt;
end. -
b14
senior tag
Az elso string: tudod, hogy mire kell.
Az elso integer: A visszatérő értéke;
A masodik integer: ha <> 0 -val akkor nem csak szam volt a stringben(az elsoben) = hiba a konverzióban
egyebkent nem tudja(aki a kérdést feltette), hogy a word tipusuban szam van(szerintem)
de nem szemrehányás és nem is piszkálás szándékából irtam ezt; -
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 -
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; -
b14
senior tag
válasz
KovacsUr
#120
üzenetére
Hello
Mindenesetre kosz a megoldasokat, de enmashogy oldottam meg, de az kicsit hosszabb.
Leirom, hogy mas talan megnezi.
biztos van benne hiba, mert fejbol irom.
uses crt;
var
szam,hosszusaga:longint;
filetemp
ext;
ch:char;
begin
writeln('Kerek egy szamot');
readln(szam);
assign(filetemp,'c:\nemkell.txt');
rewrite(filetemp);
write(filetemp,szam);
close(filetemp);
assign(filetemp,'c:\nemkell.txt');
reset(filetemp);
repeat
read(filetemp,ch);
hosszusaga:=hosszusaga+1
until eof(filetemp);
close(filetemp);
writeln('A szam hossza: ',hosszusaga);
end.
Bocsesz a zold kis pofiert,de a kettospont t az a pofi es mashogy nem tuttam
[Szerkesztve] -
ext;Új hozzászólás Aktív témák
- DELL P2714H "27 colos kalibrált IPS panellal rendelkező monitorom eladó tökéletes állapotban!
- MSI GTX 1070 Ti GAMING 8G stabil, működésileg megbízható állapotban eladó!
- Xiaomi 13T Dobozzal Töltővel
- G.Skill Ripjaws S5 32GB 2x16gb kit 6400mhz CL32!! GARI: 2026.06.-ig.Alacsony profilú,hütőbordás!
- WD 480GB Greene SN350 (WDS480G2G0C) M.2 2280 NVMe PCI-E3.0 x4 SSD
- Lenovo ThinkPad P15 Gen 1 Intel i7-10875H 32GB 512GB Nvidia Quadro RTX 3000 1 év garancia
- Eladó Samsung Galaxy S22 8/128GB / 12 hó jótállás
- ÁRGARANCIA!Épített KomPhone Ryzen 5 7600X 16/32/64GB RAM RX 9060XT 16GB GAMER PC termékbeszámítással
- BESZÁMÍTÁS! ASUS Z97-K Z97 chipset alaplap garanciával hibátlan működéssel
- HIBÁTLAN iPhone 13 mini 128GB Starlight -1 ÉV GARANCIA - Kártyafüggetlen, MS3828
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Promenade Publishing House Kft.
Város: Budapest