![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() |
Анастасия |
![]()
Сообщение
#1
|
Новичок ![]() Группа: Пользователи Сообщений: 41 Пол: Женский Реальное имя: Анастасия Репутация: ![]() ![]() ![]() |
На языке Паскаль создайте программу, которая позволяет закодировать слово с использованием кодовой таблицы ASCII (один символ – восемь двоичных цифр) и проведите ручное «архивирование» закодированной информации по принципу; создается строка из наборов вида
Например: ABBA - 01000001010000100100001001000001 –> (архивация - один ноль, одна единица и т.д.) 10 11 50 11 10 11 40 11 20 11 40 11 20 11 50 11 Код program fff; uses crt; var a :array[1..20] of byte;s:array[1..10] of string[8]; y:string[100]; sis :byte; {systema schisleniya} i,j,l,o,k :integer; {schetchik zifr} z:string[10]; begin clrscr; sis:=2;y:=''; writeln('vvedi z');readln(z); WRITELN('-------------------------------'); for i:=1 to length(z) do begin write(' V ASCII z ='); writeln( ord(z[i]),' '); l:= ord(z[i]); k:=ord(z[i]);j:=0; repeat inc(j); a[j]:=k mod sis; k:=k div sis; until k<sis; if k<>0 then begin inc(j); a[j]:=k; end; Write(l,'(10) -> '); for o:=8 downto 1 do begin Write(a[o]); str(a[o],s[o]); y:=y+s[o];end; Writeln('(',sis,').');writeln; writeln( 'y= ',y); end; writeln;writeln('----------------------------------'); o:=0;j:=0;k:=0; for i:=1 to length(y) do begin if y[i]='0' then begin o:=o+1; if copy(y,i+1,1)<>'0' then begin k:=k+1; writeln('N ',k,' ' ,o,'0 ');o:=0; end; end; if y[i]='1' then begin j:=j+1;if copy(y,i+1,1)<>'1'then begin k:=k+1; writeln('N ',k,' ',j,'1');j:=0;end; end; end; readkey; end. Может кто знает, как сделать короче? |
![]() ![]() |
![]() |
Текстовая версия | 21.06.2025 15:56 |