Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
0 / 0 / 0
Регистрация: 29.05.2012
Сообщений: 5
1

Мне нужно в программе, метки заменить на цикл(программа реализации сжатия информации алгоритм RLE)

29.05.2012, 22:24. Просмотров 861. Ответов 9
Метки нет (Все метки)

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, STRUTILS;
 
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    GroupBox4: TGroupBox;
    Edit4: TEdit;
    Button8: TButton;
    GroupBox5: TGroupBox;
    Edit5: TEdit;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    GroupBox7: TGroupBox;
    Memo1: TMemo;
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
type
  symbol=record
    count:byte;
    value:byte;
  end;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button8Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit4.Text:= OpenDialog1.FileName;
end;
 
procedure TForm1.Button9Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit5.Text:= OpenDialog1.FileName;
end;
 
//сжатие
procedure TForm1.Button10Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
  label go1;
  label go2;
  label go3;
  label go4;
begin
  AssignFile(INFILE,edit4.Text);
  AssignFile(OUTFILE,edit5.Text);
  rewrite(OUTFILE);
  if FileExists(Edit4.Text) then
  begin
    count:=1;
    reset(INFILE);
    read(INFILE, b1);
    go1:
      if eof(INFILE) then goto go4
      else begin
        read(INFILE, b2);
        if b1=b2 then goto go2 else goto go3;
      end;
    go2:
      if count=254 then goto go3
      else begin
        inc(count);
        goto go1;
      end;
    go3:
      write(OUTFILE, b1);
      if count>1 then begin
        write(OUTFILE, b1);
        write(OUTFILE, count);
      end;
      b1:=b2;
      count:=1;
      goto go1;
    go4:
      write(OUTFILE, b1);
      if count>1 then begin
        write(OUTFILE, b1);
        write(OUTFILE, count);
      end;
       memo1.Lines.Clear;
       memo1.Lines.Add('Входной файл: '+inttostr(FileSize(infile))+' байт');
       memo1.Lines.Add('Выходной файл: '+inttostr(FileSize(outfile))+' байт');
       memo1.Lines.Add('Процент сжатия: '+inttostr(100-round(100*FileSize(outfile)/FileSize(infile)))+'%');
      CloseFile(INFILE);
      CloseFile(OUTFILE);
  end;
end;
//================== сжатие
 
//----------------- распаковка 
procedure TForm1.Button11Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
  label go1;
  label go2;
  label go3;
  label go4;
begin
  AssignFile(INFILE,edit5.Text);
  AssignFile(OUTFILE,edit4.Text);
  rewrite(OUTFILE);
  if FileExists(Edit5.Text) then
    count:=1;
    reset(INFILE);
    read(INFILE, b1);
    go1:
      if eof(INFILE) then goto go4
      else begin
        if count=254 then begin
          write (OUTFILE, b1);
          read(INFILE, b1);
        end;
        read(INFILE, b2);
        if b1=b2 then goto go2 else goto go3;
      end;
    go2:
      read(INFILE, b2);
      count:=1;
      repeat
        write(OUTFILE, b1);
        inc(count);
      until count=b2;
      goto go1;
    go3:
      write(OUTFILE, b1);
      b1:=b2;
      count:=1;
      goto go1;
    go4:
      write(OUTFILE, b1);
      CloseFile(INFILE);
      CloseFile(OUTFILE);
end;
//===================== распаковка
 
end.
Заранее очень благодарна!!!!!
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
29.05.2012, 22:24
Ответы с готовыми решениями:

В программе использованы метки, нужно поменять на цикл
uses crt; var A,B: array of integer; j,q,t,k,l,h,r,p: integer; label 1; Begin Clrscr; Write...

Алгоритм сжатия RLE
Здравствуйте, очень нужна помощь в задании! Просто очень срочно, пожалуйста! Написать программу...

Алгоритм RLE для сжатия изображения
Буду очень признателен в помощи в решении данного вопроса. Начал с того, что сохраняю изображение...

Алгоритм сжатия RLE. От этого зависит зачет по предмету)
Напишите программу, которая: 1. будет считывать с клавиатуры раздельно (через Enter) вводимую ...

9
3940 / 1865 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
30.05.2012, 07:38 2
В подробности не вдавался. Только выполнил просьбу:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, STRUTILS;
 
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    GroupBox4: TGroupBox;
    Edit4: TEdit;
    Button8: TButton;
    GroupBox5: TGroupBox;
    Edit5: TEdit;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    GroupBox7: TGroupBox;
    Memo1: TMemo;
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
type
  symbol=record
    count:byte;
    value:byte;
  end;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button8Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit4.Text:= OpenDialog1.FileName;
end;
 
procedure TForm1.Button9Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit5.Text:= OpenDialog1.FileName;
end;
 
//сжатие
procedure TForm1.Button10Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
begin
  AssignFile(INFILE,edit4.Text);
  AssignFile(OUTFILE,edit5.Text);
  rewrite(OUTFILE);
  if FileExists(Edit4.Text) then
  begin
    count:=1;
    reset(INFILE);
    read(INFILE, b1);
 
    While Not eof(INFILE) Do
    Begin
      read(INFILE, b2);
      if ((b1=b2) And (count<>254)) then
      inc(count) Else
      Begin
        write(OUTFILE, b1);
        if count>1 then
        begin
          write(OUTFILE, b1);
          write(OUTFILE, count);
        end;
        b1:=b2;
        count:=1;
      End;
    End;
    write(OUTFILE, b1);
    if count>1 then begin
      write(OUTFILE, b1);
      write(OUTFILE, count);
    end;
     memo1.Lines.Clear;
     memo1.Lines.Add('Входной файл: '+inttostr(FileSize(infile))+' байт');
     memo1.Lines.Add('Выходной файл: '+inttostr(FileSize(outfile))+' байт');
     memo1.Lines.Add('Процент сжатия: '+inttostr(100-round(100*FileSize(outfile)/FileSize(infile)))+'%');
    CloseFile(INFILE);
    CloseFile(OUTFILE);
  end;
end;
//================== сжатие
 
//----------------- распаковка
procedure TForm1.Button11Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
begin
  AssignFile(INFILE,edit5.Text);
  AssignFile(OUTFILE,edit4.Text);
  rewrite(OUTFILE);
  if FileExists(Edit5.Text) then
  count:=1;
 
  reset(INFILE);
  read(INFILE, b1);
  While Not eof(INFILE) Do
  Begin
    if count=254 then
    begin
      write (OUTFILE, b1);
      read(INFILE, b1);
    end;
    read(INFILE, b2);
    if b1=b2 then
    Begin
      read(INFILE, b2);
      count:=1;
      repeat
        write(OUTFILE, b1);
        inc(count);
      until count=b2;
    End Else
    Begin
      write(OUTFILE, b1);
      b1:=b2;
      count:=1;
    End;
  End;
  write(OUTFILE, b1);
  CloseFile(INFILE);
  CloseFile(OUTFILE);
end;
//===================== распаковка
 
end.
1
0 / 0 / 0
Регистрация: 29.05.2012
Сообщений: 5
09.06.2012, 16:38  [ТС] 3
Спасибо огромное, вы мне безумно помогли! Извините что сразу не ответила блудила на сайте, не могла найди где написала =)))

Добавлено через 44 минуты
я решила немного изменить программу тем, что когда они будут сжиматься одинаковые символы будут писаться только один раз с записываться количество этих повторов, а не 2 как было раньше, на сжатие смогла изменить, а на распаковку не могу придумать как это правильно написать, подскажите пожалуйста!
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, STRUTILS;
 
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    GroupBox4: TGroupBox;
    Edit4: TEdit;
    Button8: TButton;
    GroupBox5: TGroupBox;
    Edit5: TEdit;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    GroupBox7: TGroupBox;
    Memo1: TMemo;
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
type
  symbol=record
    count:byte;
    value:byte;
  end;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button8Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit4.Text:= OpenDialog1.FileName;
end;
 
procedure TForm1.Button9Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit5.Text:= OpenDialog1.FileName;
end;
 
//сжатие
procedure TForm1.Button10Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
begin
  AssignFile(INFILE,edit4.Text);
  AssignFile(OUTFILE,edit5.Text);
  rewrite(OUTFILE);
  if FileExists(Edit4.Text) then
  begin
    count:=1;
    reset(INFILE);
    read(INFILE, b1);
 
    While Not eof(INFILE) Do
    Begin
      read(INFILE, b2);
      if ((b1=b2) And (count<>254)) then
      inc(count) Else
      Begin
        write(OUTFILE, b1);
 
        b1:=b2;
        count:=1;
      End;
    End;
    write(OUTFILE, b1);
 
      write(OUTFILE, count);
    end;
     memo1.Lines.Clear;
     memo1.Lines.Add('Входной файл: '+inttostr(FileSize(infile))+' байт');
     memo1.Lines.Add('Выходной файл: '+inttostr(FileSize(outfile))+' байт');
     memo1.Lines.Add('Процент сжатия: '+inttostr(100-round(100*FileSize(outfile)/FileSize(infile)))+'%');
    CloseFile(INFILE);
    CloseFile(OUTFILE);
  end;
 
//================== сжатие
 
//----------------- распаковка
procedure TForm1.Button11Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
begin
  AssignFile(INFILE,edit5.Text);
  AssignFile(OUTFILE,edit4.Text);
  rewrite(OUTFILE);
  if FileExists(Edit5.Text) then
  count:=1;
 
  reset(INFILE);
  read(INFILE, b1);
  While Not eof(INFILE) Do
  Begin
    if count=254 then
    begin
      write (OUTFILE, b1);
      read(INFILE, b1);
    end;
    read(INFILE, b2);
    if b1=b2 then
    Begin
      read(INFILE, b2);
      count:=1;
      repeat
        write(OUTFILE, b1);
        inc(count);
      until count=b2;
    End Else
    Begin
      write(OUTFILE, b1);
      b1:=b2;
      count:=1;
    End;
  End;
  write(OUTFILE, b1);
  CloseFile(INFILE);
  CloseFile(OUTFILE);
end;
//===================== распаковка
 
end.
Заранее спасибо!
0
3940 / 1865 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
09.06.2012, 17:04 4
Девушка, оформляйте, пожалуйста код тегами. А то нечитабельно вообще. Для этого щелкайте в панели редактора слово Delphi. Оно находится под знаком #. После этого между тегами начала и конца (в этом месте после щелчка остаётся курсор) вставляете свой код. Или по другому. Можете выделить текст и потом щелкнуть соответствующий тег в панели редактора. Результат такой же. Я вам помогу, но чуть позже. Выложите, пожалуйста, код, оформленный тегами. Чтобы посмотреть до того как ответите, как получилось - нажимаете "предварительный просмотр".

А для того, чтобы видеть темы, в которых вы подписаны (это те где вы писали свои сообщения), переходите в "Мой кабинет". Там вам всегда приходят сообщения при любом сообщении в этих темах (подписанных). Там же есть "посмотреть все темы с подпиской" - вы можете на любую перейти.

Ещё должен обратить ваше внимание, что если вы не перемещаетесь по форуму - страница на которой вы стоите сама не обновляется. Т.е. даже если вам пришел ответ - вы это сможете увидеть только тогда, когда обновите страницу. Это такой кружочек со стрелкой вверху на панели браузера (может вы это сами знаете). Так что, периодически, обновляйте страницу, если ждёте ответ. И ждать лучше всего в своём кабинете. Там вы всегда сможете увидеть, если придёт личное сообщение или сообщение в подписанной теме. Естественно, после обновления страницы.
1
0 / 0 / 0
Регистрация: 29.05.2012
Сообщений: 5
09.06.2012, 17:33  [ТС] 5
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, STRUTILS;
 
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
GroupBox4: TGroupBox;
Edit4: TEdit;
Button8: TButton;
GroupBox5: TGroupBox;
Edit5: TEdit;
Button9: TButton;
Button10: TButton;
Button11: TButton;
GroupBox7: TGroupBox;
Memo1: TMemo;
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
 
private
{ Private declarations }
public
{ Public declarations }
end;
 
var
Form1: TForm1;
type
symbol=record
count:byte;
value:byte;
end;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button8Click(Sender: TObject);
begin
OpenDialog1.Execute;
edit4.Text:= OpenDialog1.FileName;
end;
 
procedure TForm1.Button9Click(Sender: TObject);
begin
OpenDialog1.Execute;
edit5.Text:= OpenDialog1.FileName;
end;
 
//сжатие
procedure TForm1.Button10Click(Sender: TObject);
var
INFILE, OUTFILE: file of byte;
b1, b2, count: byte;
begin
AssignFile(INFILE,edit4.Text);
AssignFile(OUTFILE,edit5.Text);
rewrite(OUTFILE);
if FileExists(Edit4.Text) then
begin
count:=1;
reset(INFILE);
read(INFILE, b1);
 
While Not eof(INFILE) Do
Begin
read(INFILE, b2);
if ((b1=b2) And (count<>254)) then
inc(count) Else
Begin
write(OUTFILE, b1);
 
b1:=b2;
count:=1;
End;
End;
write(OUTFILE, b1);
 
write(OUTFILE, count);
end;
memo1.Lines.Clear;
memo1.Lines.Add('Входной файл: '+inttostr(FileSize(infile))+' байт');
memo1.Lines.Add('Выходной файл: '+inttostr(FileSize(outfile))+' байт');
memo1.Lines.Add('Процент сжатия: '+inttostr(100-round(100*FileSize(outfile)/FileSize(infile)))+'%');
CloseFile(INFILE);
CloseFile(OUTFILE);
end;
 
//================== сжатие
 
//----------------- распаковка
procedure TForm1.Button11Click(Sender: TObject);
var
INFILE, OUTFILE: file of byte;
b1, b2, count: byte;
begin
AssignFile(INFILE,edit5.Text);
AssignFile(OUTFILE,edit4.Text);
rewrite(OUTFILE);
if FileExists(Edit5.Text) then
count:=1;
 
reset(INFILE);
read(INFILE, b1);
While Not eof(INFILE) Do
Begin
if count=254 then
begin
write (OUTFILE, b1);
read(INFILE, b1);
end;
read(INFILE, b2);
if b1=b2 then
Begin
read(INFILE, b2);
count:=1;
repeat
write(OUTFILE, b1);
inc(count);
until count=b2;
End Else
Begin
write(OUTFILE, b1);
b1:=b2;
count:=1;
End;
End;
write(OUTFILE, b1);
CloseFile(INFILE);
CloseFile(OUTFILE);
end;
//===================== распаковка
 
end.
спасибо за помощь глупышке, такими темпами по умнею =)))
0
3940 / 1865 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
09.06.2012, 22:23 6
Вот код из первого варианта. Я уже вник в логику, увидел ошибки в коде распаковки и исправил их.
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, STRUTILS;
 
type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    GroupBox4: TGroupBox;
    Edit4: TEdit;
    Button8: TButton;
    GroupBox5: TGroupBox;
    Edit5: TEdit;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    GroupBox7: TGroupBox;
    Memo1: TMemo;
    procedure Button10Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
type
  symbol=record
    count:byte;
    value:byte;
  end;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button8Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit4.Text:= OpenDialog1.FileName;
end;
 
procedure TForm1.Button9Click(Sender: TObject);
begin
  OpenDialog1.Execute;
  edit5.Text:= OpenDialog1.FileName;
end;
 
//сжатие
procedure TForm1.Button10Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
begin
  AssignFile(INFILE,edit4.Text);
  AssignFile(OUTFILE,edit5.Text);
  rewrite(OUTFILE);
  if FileExists(Edit4.Text) then
  begin
    count:=1;
    reset(INFILE);
    read(INFILE, b1);
 
    While Not eof(INFILE) Do
    Begin
      read(INFILE, b2);
      if ((b1=b2) And (count<>254)) then
      inc(count) Else
      Begin
        write(OUTFILE, b1);
        if count>1 then
        begin
          write(OUTFILE, b1);
          write(OUTFILE, count);
        end;
        b1:=b2;
        count:=1;
      End;
    End;
    write(OUTFILE, b1);
    if count>1 then
    begin
      write(OUTFILE, b1);
      write(OUTFILE, count);
    end;
     memo1.Lines.Clear;
     memo1.Lines.Add('Входной файл: '+inttostr(FileSize(infile))+' байт');
     memo1.Lines.Add('Выходной файл: '+inttostr(FileSize(outfile))+' байт');
     memo1.Lines.Add('Процент сжатия: '+inttostr(100-round(100*FileSize(outfile)/FileSize(infile)))+'%');
    CloseFile(INFILE);
    CloseFile(OUTFILE);
  end;
end;
//================== сжатие
 
//----------------- распаковка
procedure TForm1.Button11Click(Sender: TObject);
var
  INFILE, OUTFILE: file of byte;
  b1, b2, count: byte;
begin
  AssignFile(INFILE,edit5.Text);
  AssignFile(OUTFILE,edit4.Text);
  rewrite(OUTFILE);
  if Not FileExists(Edit5.Text) then Exit;
 
  count:=1;
 
  reset(INFILE);
  read(INFILE, b1);
  While Not eof(INFILE) Do
  Begin
    if count=254 then
    begin
      write (OUTFILE, b1);
      read(INFILE, b1);
    end;
    read(INFILE, b2);
    if b1=b2 then
    Begin
      read(INFILE, count);
      repeat
        write(OUTFILE, b1);
        dec(count);
      until count=0;
      Count:=254;
    End Else
    Begin
      write(OUTFILE, b1);
      b1:=b2;
      count:=1;
    End;
  End;
  if count<>254 then write(OUTFILE, b1);
  CloseFile(INFILE);
  CloseFile(OUTFILE);
end;
//===================== распаковка
 
end.
Ваше желание убрать ещё один символ при упаковке - понятно. Но в этом случае у вас не будет признака повторяющегося символа. Сейчас у вас символы, которые не повторяются, идут подряд. А если встретился повторяющийся - пишется их 2, потом количество. И при распаковке, если встретилось 2 повторяющихся символа - вы знаете, что следующий байт - количество повторов этого символа. Если же вы будете писать только по одному - следующий код может быть любой от 0 до 255. И это может быть просто следующий символ.
Имеющийся код достаточно оптимальный и оптимизации уже не поддаётся. Так что не занимайтесь глупостями.
1
0 / 0 / 0
Регистрация: 29.05.2012
Сообщений: 5
10.06.2012, 12:27  [ТС] 7
вот по этому я, видимо, и не смогла придумать как это сделать)))) спасибо за истраченное время, безумно благодарна

Добавлено через 13 часов 14 минут
Можно ещё вопрос,а почему мы в распаковке счетчик приравняли к 254??? зачем это??
0
3940 / 1865 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
10.06.2012, 13:38 8
а почему мы в распаковке счетчик приравняли к 254??? зачем это??
Вы, наверное, имеете в виду строку 134 в последнем выложенном мной коде.
Там получается в переменных b1 и b2 - находятся два последних считанных кода из файла. Они сравниваются и если не равны - первый записывается в выходной файл, а второй - в b1 и в b2 читается следующий код из файла. Но перед этим, естественно, при заходе на следующий цикл проверяется на конец файла.
Если же у нас b1 и b2 сравнились - мы читаем количество повторений, выдаём это количество символов b1 в выходной файл. А дальше у нас нет следующего символа в b1. Т.е. в b1 нужно считать очередной символ. Но при этом, опять же, нужно проверить на конец файла. Можно было сделать это сразу после записи count символов b1 в выходной файл. Проверить на конец файла, считать и идти дальше. Но опять же - после выхода из цикла сразу после записи count символов b1 в выходной файл, получится, что в b1 не будет следующего символа. А это тоже нужно учитывать, так как при нормальном завершении этого цикла в b1 остаётся символ, который не выдан в выходной файл, и его нужно тоже записать.
Так что код 254 в count служит как признак отсутствия символа в b1.
Но я, таки не досмотрел, и там есть ошибка. Согласно нумерации в последнем коде строки 121-125 нужно заменить на:
Delphi
1
2
3
4
5
    if count=254 then
    begin
      read(INFILE, b1);
      count:=1;
    end;
Ну и, мне кажется, что и в упаковке и в распаковке вместо 254 можно везде поставить 255 - это максимальное значение переменной типа Byte.
1
0 / 0 / 0
Регистрация: 29.05.2012
Сообщений: 5
10.06.2012, 13:50  [ТС] 9
так она работает лучше, и я спрашивала про 121 строчку...
0
3940 / 1865 / 337
Регистрация: 16.03.2012
Сообщений: 3,880
10.06.2012, 14:08 10
Если в начало цикла приходим с кодом 254 в count, значит в b1 нет очередного кода и мы его читаем.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
10.06.2012, 14:08

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Не работает программа сжатия RLE
Не работает программа сжатия текста RLE program Project2; {$APPTYPE CONSOLE} uses ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.