| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Greif
Administrator
Dołączył: 15 Sty 2007
Posty: 756
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Piotrowice k.Oświęcimia
|
 Wysłany: Pon 19:47, 15 Sty 2007 Temat postu: Tematy Waszych programów |
|
|
Witam,
mój temat to:
Temat nr 6: Uporządkuj ciąg łańcuchów znaków w porządku alfabetycznym.
Zastosuj metodę sortowania przez wybór.
Już mam to napisane, jeżeli ktoś chce rady, może spokojnie pisać, może ja odpowiem, a może ktoś bardziej oblatany w pascalu...
Mój program:
| Kod: | program sortowanie_przez_wybor;
uses crt;
const N=30;
var
lista:array[1..N] of string;
l,i,ilosc,j,pmin:integer;
x:string;
begin
clrscr;
writeln('|"""""""""""""""""""""""""|');
writeln('| AP Krak˘w SP EFS gr.2 |');
writeln('| (C)2006 Tomasz Milowski |');
writeln('| Sortowanie przez wybor |');
writeln('| |');
writeln(' """""""""""""""""""""""""');
writeln;
{ Wczytanie ilo˜ci element˘w listy (ˆaäcuch˘w) }
write('Podaj ilo˜† element˘w listy: ');
readln(ilosc);
writeln;
{ Uzupeˆniam tablic© lista[] ciĄgami znakow }
for l:=1 to ilosc do
begin
write ('Prosz© poda† element ',l,' --> ');
readln(lista[l]);
end;
writeln;
{ Wypisanie danych nieposortowanych }
write('Wpisane zostaˆy nast©pujĄce ciĄgi znak˘w -> ');
for l:=1 to ilosc do write(lista[l],' ');writeln;
{ Sortowanie }
for j:=1 to ilosc-1 do
begin
pmin:=j;
for i:=j+1 to ilosc do
if lista[i]<lista[pmin] then
pmin:=i;
x:=lista[pmin];
lista[pmin]:=lista[j];
lista[j]:=x;
end;
{ Wypisanie wyniku sortowania }
writeln;
writeln('Lista posortowana:');
writeln;
for i:=1 to ilosc do writeln(i:10,'> ',lista[i]);
writeln;
writeln('Nacisnij Enter...');
readln;
end. |
Oczywiście w programie polskie znaki są, po prostu kodowanie się nie zgadza przy przeklejaniu, sorry...
Pozdrawiam
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
 |
|
|
 |
pablospp
Początkujący
Dołączył: 15 Sty 2007
Posty: 8
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Zabierzów
|
| Wysłany: Pią 19:21, 19 Sty 2007 Temat postu: mój temat z pascala |
|
|
Napisać funkcje logiczną, która określa, czy zmienna znakowa jest literą czy nie. Wykorzystać ja w programie, który usuwa z ciągu znaków wszystkie znaki nie będące literą.
| Kod: | program USUWACZ;
uses crt;
var ciagwe, ciagwy:string;
i:integer
function USUN(zn:char):boolean;
begin
if((ord(zn)>=65)and(ord(zn)<=90))or((ord(zn)>=97)and(ord(zn)<=122))then
USUN:=true else
USUN:=false;
end;
begin
clrscr;
ciagwe:='';
ciagwy:='';
writeln('Ten program usuwa wszystkie znaki nie będące literą z wprowadzonego ciągu znaków.');
writeln('Program kończy wpisanie słowa end.');
writeln;
writeln('Wprowadż ciąg znaków: ');
write('>');
readln(ciagwe);
while ciagwe<>'end' do
begin
i:=1;
while i<=length(ciagwe)do
begin;
if USUN(ciagwe[i]) then
ciagwy:=ciagwy+ciagwe[i];
i:=i+1;
end;
writeln;
writeln('Oto wynik: ')
writeln(ciagwy);
writeln;
ciagwy:='';
writeln('Wprowadź następny ciąg znaków:');
write('>');
readln(ciagwe);
end;
end. |
Post został pochwalony 0 razy
Ostatnio zmieniony przez pablospp dnia Sob 0:20, 20 Sty 2007, w całości zmieniany 3 razy
|
|
| Powrót do góry |
|
|
Regina
Początkujący
Dołączył: 17 Sty 2007
Posty: 2
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
|
| Wysłany: Pią 23:03, 19 Sty 2007 Temat postu: temat, z którym nie mogę sobie poradzić.... |
|
|
Za nic nie mogę wymyślić rozwiązania do mojego zadanka - może ktoś mi pomoże..... bardzo ładnie proszę:
Narysować pęk linii prostych przecinających się w środku ekranu, o losowo wybranych kolorach i biegnących pod kątami od 0 st. do 60 st. co 10 st.
Nie wiem czy wyjść od wykresu funkcji, czy od średnicy koła, czy może jeszcze inaczej - czy ktoś mógłby mi podpowiedzieć?
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
mogur
Coś już napisał
Dołączył: 15 Sty 2007
Posty: 41
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Alwernia
|
| Wysłany: Sob 8:37, 20 Sty 2007 Temat postu: Re: mój temat z pascala |
|
|
brakowało 2 ; teraz chodzi
| Kod: | program USUWACZ;
uses crt;
var ciagwe, ciagwy:string;
i:integer
function USUN(zn:char):boolean;
begin
if((ord(zn)>=65)and(ord(zn)<=90))or((ord(zn)>=97)and(ord(zn)<=122))then
USUN:=true else;
USUN:=false;
end;
begin
clrscr;
ciagwe:='';
ciagwy:='';
writeln('Ten program usuwa wszystkie znaki nie będące literą z wprowadzonego ciągu znaków.');
writeln('Program kończy wpisanie słowa end.');
writeln;
writeln('Wprowadż ciąg znaków: ');
write('>');
readln(ciagwe);
while ciagwe<>'end' do
begin
i:=1;
while i<=length(ciagwe)do
begin;
if USUN(ciagwe[i]) then
ciagwy:=ciagwy+ciagwe[i];
i:=i+1;
end;
writeln;
writeln('Oto wynik: ');
writeln(ciagwy);
writeln;
ciagwy:='';
writeln('Wprowadź następny ciąg znaków:');
write('>');
readln(ciagwe);
end;
end. |
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
Greif
Administrator
Dołączył: 15 Sty 2007
Posty: 756
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Piotrowice k.Oświęcimia
|
| Wysłany: Sob 19:37, 20 Sty 2007 Temat postu: Sortowanie przez wybór, ale liczb rzeczywistych |
|
|
Cześć,
dziś zaliczaliśmy, trochę się zdziwiłem, bo musiałem przerobić mój program, tak aby sortował nie łańcuchy znaków, ale liczby rzeczywiste.
Udało się, poniżej listing:
| Kod: | program sortowanie_przez_wybor;
uses crt;
var
lista:array[1..30] of real;
l,i,ilosc,j,pmin:integer;
x:real;
begin
clrscr;
writeln('|"""""""""""""""""""""""""|');
writeln('| AP Kraków SP EFS gr.2 |');
writeln('| (C)2006 Tomasz Milowski |');
writeln('| Sortowanie przez wybór |');
writeln('| |');
writeln(' """""""""""""""""""""""""');
writeln;
{ Wczytanie ilości elementów listy (łańcuchów) }
write('Podaj ilość elementów listy: ');
readln(ilosc);
writeln;
{ Uzupełniam tablicę "lista[]" ciągami znaków }
for l:=1 to ilosc do
begin
write ('Proszę podać element ',l,' --> ');
readln(lista[l]);
end;
writeln;
{ Wypisanie danych nieposortowanych }
write('Wpisane zostały następujące ciągi znaków -> ');
for l:=1 to ilosc do write(lista[l],' ');writeln;
{ Sortowanie }
for j:=1 to ilosc-1 do
begin
pmin:=j;
for i:=j+1 to ilosc do
if lista[i]<lista[pmin] then
pmin:=i;
x:=lista[pmin];
lista[pmin]:=lista[j];
lista[j]:=x;
end;
{ Wypisanie wyniku sortowania }
writeln;
writeln('Lista posortowana:');
writeln;
for i:=1 to ilosc do writeln(i:10,'> ',lista[i]);
writeln;
writeln('Naciśnij Enter...');
readln;
end. |
Oczywiście na komentarze nie patrzcie, zmieniłem tylko to co konieczne, żeby program działał...
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
Bernadka
Początkujący
Dołączył: 17 Sty 2007
Posty: 8
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Kraków
|
| Wysłany: Nie 20:39, 21 Sty 2007 Temat postu: |
|
|
Mój temat:
Napisz program, który rysuje wykres dowolnego wielomianu stopnia mniejszego niż 10.
Program zajmuje ponad 6 stron, dlatego jeśli któs pała chęcią, żeby go mieć proszę o mail i wyślę program z rozszerzeniem .pas lub .exe
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
Greif
Administrator
Dołączył: 15 Sty 2007
Posty: 756
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Piotrowice k.Oświęcimia
|
| Wysłany: Pon 1:49, 22 Sty 2007 Temat postu: Nie martw się na zapas :P |
|
|
Cześć,
nic się nie przejmuj, wklej tu ten kod (.exe na nic się nie przyda), tylko między znacznikami CODE.
Będziemy wszyscy oglądać i podziwiać. 
Pozdrawiam
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
xmir
Początkujący
Dołączył: 23 Sty 2007
Posty: 1
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: bochnia
|
| Wysłany: Wto 17:18, 23 Sty 2007 Temat postu: |
|
|
hej 
ja miałem zrobić piłkę, która wędruje z dolnego lewego rogu ekranu na górę do środka i do prawego dolnego rogu ekranu..
a kod jest taki:
| Kod: |
program pilka;
uses crt, graph;
var a,b,x,y: integer;
f: boolean;
i: integer;
begin
ClrScr;
DetectGraph(a,b); {wykrycie parametrow grafiki}
InitGraph(a,b,'c:\TP\BGI'); {inicjacja bibliotek grafiki}
x:=10; {początkowe ustawienie środka koła - lewy dolny róg ekranu}
y:=GetMaxY-10;
f:=true;
repeat
ClearDevice; {wyczyszczenie ekranu}
circle(x,y,10); {narysowanie koła o środku (x,y) i promieniu 10}
for i:=1 to 50 do delay(60000); {opóźnienie}
{zmiana pozycji środka koła: x zwiększamy najpierw o 1, potem o 2, y zmniejszamy najpierw o 2, potem o 3, i tak w kolko}
{dzięki temu koło dąży do środka górnej krawędzi ekranu}
if f=true then
begin
f:=false;
x:=x+1;
y:=y-2;
end
else
begin
x:=x+2;
y:=y-3;
f:=true;
end;
until y<=10;
{zmiana pozycji środka koła: x zwiększamy o 3, y zwiększamy najpierw o 3, potem o 1, i tak w kolko}
{dzięki temu koło dąży do prawego dolnego rogu ekranu}
repeat
ClearDevice;
circle(x,y,10);
for i:=1 to 50 do delay(60000);
if f=true then
begin
f:=false;
x:=x+3;
y:=y+3;
end
else
begin
y:=y+1;
f:=true;
end;
until x>=GetMaxX-10;
repeat until Keypressed;
CloseGraph;
end.
|
pozdr, mirek.
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
Regina
Początkujący
Dołączył: 17 Sty 2007
Posty: 2
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
|
| Wysłany: Wto 22:28, 23 Sty 2007 Temat postu: |
|
|
Mam, mam, mam mój program  : oczywiście mój pęk prostych tyczy się stopni od 0 do 360...:
program linie;
uses graph,crt;
const katalogbgi='C:\tp\bgi';
var ster,tryb,kat,x1,y1:integer;
var x,y,z:real;
function radian(kat:real):real;
begin
radian:=(kat*3.141592)/180;
end;
begin
ster:=VGA;
tryb:=2;
InitGraph(ster,tryb,katalogbgi);
uottext('pek prostych');
kat:=0;
repeat
kat:=kat+2;
x:=800*sin(radian(kat));
y:=800*cos(radian(kat));
x1:=trunc(y);
x1:=320+x1;
y1:=trunc(y);
y1:=240+y1;
line (320,240,x1,y1);
until kat>360;
repeat until keypressed;
CloseGraph;
end.
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
mogur
Coś już napisał
Dołączył: 15 Sty 2007
Posty: 41
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Alwernia
|
| Wysłany: Wto 22:37, 23 Sty 2007 Temat postu: |
|
|
małą literówka
< outtext >
a poza tym
u mnie rysuje tylko jedną linię
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
Greif
Administrator
Dołączył: 15 Sty 2007
Posty: 756
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Piotrowice k.Oświęcimia
|
| Wysłany: Wto 22:48, 23 Sty 2007 Temat postu: Pewnie brakuje znacznika CODE |
|
|
Pewnie chodzi znowu o ten znacznik CODE...
Regina, edytuj swój post i obejmij znacznikiem CODE swój program, albo go po prostu prześlij do mnie, to ja to poprawię.
Pozdrawiam
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
ozzy369
Początkujący
Dołączył: 15 Sty 2007
Posty: 6
Przeczytał: 0 tematów
Ostrzeżeń: 0/5
Skąd: Myślachowice
|
| Wysłany: Sob 10:49, 27 Sty 2007 Temat postu: |
|
|
Cześc.
Ja miałem napisć program, który wczytuje dwa wyrazy i sprawdza, czy litery z pierwszego wyrazu powtarzają się w drugim.
| Kod: |
program dwa_slowa;
uses CRT;
type litery=array[1..20] of char;
var l:litery;s1,s2:string[20];i,j,m,n:integer;a:char;
procedure dane;
BEGIN
clrscr;
gotoxy(17,4);
writeln('Prosz© poda† pierwsze sˆowo: '); gotoxy(17,6);readln(s1);
clrscr;
gotoxy(17,4);
writeln('Prosz© poda† drugie sˆowo: ');gotoxy(17,6); readln(s2);
end;
Procedure zapis;
begin
if m=1 then l[m]:=s1[i]
else
for n:=1 to m-1 do
begin
if s1[i]=l[n] then l[m]:='&';
end;
if l[m]<>'&' then l[m]:=s1[i];
if l[m]<>'&' then m:=m+1;
l[m]:=#0;
end;
procedure wypisz;
begin
CLRSCR;
if m-1=0 then begin
gotoxy(2,4);
writeln('˝adna z liter pierwszego wyrazu NIESTETY nie powt˘rzyˆa si© w drugim wyrazie');
gotoxy(30,12);
writeln('BARDZO MI PRZYKRO ;(');
end
else begin
gotoxy(17,4);
writeln('IstniejĄ ',m-1,' litery, kt˘re powtarzajĄ sie ');
gotoxy(20,6);
writeln('w sˆowach "',s1,'" i w "',s2,'" a sĄ to:');
gotoxy(25,8);
for i:=1 to m-1 do
begin
if s1[i]=' ' then write('SPACJA ,');
write(l[i],', ')
end;
end;
end;
procedure porownaj;
begin
m:=1;
for i:=1 to ord(s1[0]) do
begin
for j:=1 to ord(s2[0]) do
begin
if s1[i]=s2[j] then zapis
end;
end;
end;
procedure wyjdz;
begin
CLRSCR;
gotoxy(23,12);
writeln('Dzi©kuj© za skorzystanie z programu');
delay(3000);
halt;
end;
procedure witaj;
begin
clrscr;
gotoxy(37,8);
writeln('WITAM.');
gotoxy(22,12);
writeln('Program por˘wna dwa wyrazy i wypisze');
gotoxy(22,14);
writeln('powtarzajĄce si© w nich litery.');
gotoxy(10,22);
writeln('Uruchomi† program? t/n :'); a:=readkey;
if a<>'t' then wyjdz
else
end;
procedure pytaj;
begin
gotoxy(40,23);
writeln('Czy chcesz wyj˜† z programu? t/n :'); a:=readkey;
if a='t' then wyjdz
else
end;
{program gˆ˘wny}
begin
witaj;
repeat
dane;
porownaj;
wypisz;
pytaj;
until l[20]='|';
end.
|
Post został pochwalony 0 razy
|
|
| Powrót do góry |
|
|
|
