|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
02.06.2010, 20:53 | #1 |
Пользователь
Регистрация: 02.06.2010
Сообщений: 15
|
ввод текста с клавиатуры
написать программу ввода такого текста с клавиатуры;
б) напечатать все слова ,отличающиеся от последнего слова ,и совпадающие с начальным отрезком алфавита (a , a b ,a b c и т.д) uses crt; var Form1: TForm1; M:array[1..80] of char; Mps: array[1..80] of char; i,t,dlina,ii,j,k,n,kol_vo,chislo,fi rst,last:integer; obmen:char; F:TextFile; implementation {$R *.dfm} procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); //ввод с клавиатуры begin case key of 'a'..'z': begin M[i]:=(key); i:=i+1; end; ' ': begin M[i]:=(key); i:=i+1; end; '.': begin M[i]:=(key); i:=i+1; end; chr(8): if i<>1 then i:=i-1; else key:=chr(0); end; end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Clear; Memo1.Visible:=true; AssignFile(F,'file.txt'); //создаем файл {$I-} Rewrite(F); {$I+} if IOResult<>0 then begin showmessage('действие не удалось'); exit; end; CloseFile(F); chislo:=0; //находим длину for ii:=1 to i-1 do begin if (M[ii]='.') then chislo:=chislo+1; if (M[ii]='.') and (chislo=1) then dlina:=ii-1; end; AssignFile(F,'file.txt'); {$I-} Append(F); WriteLn(F,'text length : ',dlina); Reset(F); Memo1.Lines.LoadFromFile('file.txt' ); {$I+} if IOResult<>0 then begin showmessage('действие не удалось'); exit; end; CloseFile(F); k:=1; //последнее слово j:=dlina; while ((M[j]=' ')and (j>0)) do j:=j-1; while ( (M[j]<>' ') and (j>0)) do begin Mps[k]:=M[j]; j:=j-1; kol_vo:=k; k:=k+1; end; n:=1; k:=kol_vo; while n<k do begin obmen:=Mps[n]; Mps[n]:=Mps[k]; Mps[k]:=obmen; n:=n+1; k:=k-1; end; AssignFile(F,'file.txt'); {$I-} Append(F); Write(F,'last word : '); for k:=1 to kol_vo do Write(F,Mps[k]); Reset(F); Memo1.Lines.LoadFromFile('file.txt' ); {$I+} if IOResult<>0 then begin showmessage('действие не удалось'); exit; end; CloseFile(F); //сравнение AssignFile(F,'file.txt'); {$I-} Append(F); WriteLn(F); WriteLn(F,'result : '); j:=dlina; while ((M[j]=' ')and (j>0)) do j:=j-1; i:=1; while i<=(j-kol_vo) do begin Write(F,' '); if M[i]=' ' then i:=i+1; first:=i; while (M[i]<>' ') do i:=i+1; last:=i-1; if (last-first+1)<>kol_vo then begin Write(F,M[first]); for ii:=first+1 to last do begin if (M[ii]<>M[first]) then Write(F,M[ii]); end; //Write(F,' '); end else begin i:=first; chislo:=0; k:=1; while k<=kol_vo do begin if M[i]<>Mps[k] then chislo:=chislo+1; i:=i+1; k:=k+1; end; if chislo<>0 then begin Write(F,M[first]); for ii:=first+1 to last do if (M[ii]<>M[first]) then Write(F,M[ii]); end else i:=last+1; end; i:=i+1; end; Reset(F); Memo1.Lines.LoadFromFile('file.txt' ); {$I+} if IOResult<>0 then begin showmessage('действие не удалось'); exit; end; CloseFile(F); end; procedure TForm1.Button2Click(Sender: TObject); begin //сброс Memo1.Clear; dlina:=0; edit1.Text:=''; i:=1; n:=0; k:=0; n:=0; kol_vo:=0; chislo:=0; first:=0; last:=0; end; procedure TForm1.FormCreate(Sender: TObject); begin i:=1; end; end. неудаеться запустить в чем ошибка? |
02.06.2010, 23:02 | #2 |
Пользователь
Регистрация: 18.02.2010
Сообщений: 96
|
эт те в делфи надо писать
|
02.06.2010, 23:05 | #3 |
Пользователь
Регистрация: 02.06.2010
Сообщений: 15
|
здесь половина на дельфи...нужно на паскаль перевести ...я некоторые строчки убрал выдает ошибку ....
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
ввод с клавиатуры | Sparky | Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM | 6 | 15.03.2020 14:34 |
Ввод текста с клавиатуры | Impulsive | Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM | 2 | 31.05.2010 13:44 |
Ввод чисел с клавиатуры | SAVIK | Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM | 19 | 26.05.2008 12:54 |
ввод данных с клавиатуры | juden | Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM | 2 | 07.05.2008 18:05 |