Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Ваши программы
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 16.09.2009, 21:31
UNAT UNAT вне форума
Прохожий
 
Регистрация: 16.09.2009
Сообщения: 2
Репутация: 10
Вопрос "Вшивание" данных в картинку

Конечно в 1 картинку без изменения её размера зашить файл неполучится, а вот хм... так сказать... "между" 2мя битмапами вполне.
Ну впрочем код прост как 2жды 2 поэтому без теории. Сразу к делу
Код:
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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
unit Unit3;
 
{Простейший пример вшивания данных в изображение
 После обработки изменения каждого канала цвета
 не превышают 5, что не сильно заметно если цвет
 не белый}
 
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;
 
type
  TForm3 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    I1: TImage;
    PB: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form3: TForm3;
 
implementation
{$R *.dfm}
 
{Следующая процедура получает строку
 которая содержит в себе цвет в формате
 FF-красный FF-зеленый и FF-синий
 и расбивает её на 3 части для
 дальнейшего использования}
Procedure RGBr(RGB:string; VAR Rs,Gs,Bs:String);
Begin
  Rs:=Copy(RGB,1,2); //думаю тут всё ясно
  delete(RGB,1,2);   //просто работа со строками
  Gs:=Copy(RGB,1,2);
  delete(RGB,1,2);
  Bs:=RGB;
End;
 
{Процедура модифицурует значения каналов RGB
 на соответствующие значеия (RGBm(rm,gm,bm:integer)}
 
Procedure RGBm(rm,gm,bm:integer; VAR Rs,Gs,Bs:string);
VAR bty:byte;
Begin
  bty:=strtoint('$'+rs)+rm; // Переводим значение каналов
  rs:=inttohex(bty,2);   // из 16-ричной в 10-чную систему счисления
  bty:=strtoint('$'+gs)+gm; // увеличиваем на заданное значение
  gs:=inttohex(bty,2); // и переводим обратно в 16-ричную
  bty:=strtoint('$'+bs)+bm; // для последующей записи
  bs:=inttohex(bty,2);  // модифицированного значения в файл
End;
 
{процедура записи модифицированных данных
 в файл}
 
Procedure WriteToBmp(FileName,BitmapName,SavePath:string);
VAR  i,j,len,olen:integer; // разные числа для разных целей
     bm:TBitmap; // компонент для обработки и сохранения изображения
     Rs,Gs,Bs,RGB,bt:string; // цветав 16-ричной системе
     mR,mG,mB:byte; // теже цвета но в байтах
     b:byte; // просто ещё 1 число
     F:File; // *nocomment*
begin
 bm:=TBitmap.Create; // создаем наш битмап
 bm.LoadFromFile(BitmapName); //загружаем в него неизмененное изображение
 assignfile(F,Filename); //открываем файл, который
 reset(F,1);  // хотим зашить в битмап, для чтения
 len:=Filesize(F); //получаем его длину
 ShowMessage('объем информации равен '+inttostr(bm.Width*bm.Height)+'будет записано '+inttostr(len));
 // nocomment
 Form3.PB.Min:=0;
 // Незабываем что лучше знать в какой стадии наш процесс
 form3.PB.Max:=bm.Width;
 for I := 0 to bm.Width - 1 do // запускаем цикл перебора
  begin  // всем пикселей изображения
   for j := 0 to bm.Height - 1 do // Тоесть по высоте и ширине
     Begin
      RGB:=IntToHex(ColorToRGB(bm.Canvas.Pixels[i,j]),6);
      // преобразуем цвет текущего пикселя в доступный нам формат
      RGBr(RGB,rs,gs,bs);
      // разлагаем его на составляющие для
      // пущей доступности
      if not(EoF(F)) then
      // пока файл не закончится
      Begin
      BlockRead(F,b,1);
      // читаем его по 1 байту
      bt:=inttostr(b);
      // это надо щас узнаете зачем
      if length(bt)=1 then bt:='00'+bt else
       if length(bt)=2 then bt:='0'+bt;
      mR:=StrToint(copy(bt,1,1));
      mG:=StrToint(copy(bt,2,1));
      mB:=StrToint(copy(bt,3,1));
      {вот собственно основная часть, момент
      так сказать истины, байт информации из
      файла разбивается на 3 отдельных числа,
      тоесть например 255 разобьется на 2 5 5
      после чего 3 канала цвета будут увеличены
      на эти значения, что и позволит закодировать
      в разности этих значений данный байт}
      End else
       begin
         mr:=0;
         mg:=0;
         mb:=0;
       //  ХЗ косяк вышел всяк бывает XD
       end;
      RGBm(mR,mG,mB,rs,gs,bs);
      // модифицируем
      RGB:=rs+gs+Bs;
      // вновь собираем в RGB
      bm.Canvas.Pixels[i,j]:=strtoint('$'+RGB);
      // меняем это на полотне
     End;
      Form3.PB.Position:=i;
      //  опятьтаки не забываем о
      // видимости работы программы
  end;
 bm.SaveToFile(SavePath);
 // сохраняем результат
 Closefile(F);
 // закрываем файл
End;
 
{
опятьтаки основная прцедура для
вытягивания байта из разности
хм... каналов чтоли... одного и
того же пикселя с разных изображений
как это делается видно из кода,
используемые в нем функции
 уже были рассмотрены ранее
}
 
Procedure RGBc(R1,G1,B1,R2,G2,B2:string; VAR b:byte);
VAR rm,gm,bm:byte;
    s:string;
Begin
 Rm:=strtoint('$'+R2)-strtoint('$'+R1);
 Gm:=strtoint('$'+G2)-strtoint('$'+G1);
 Bm:=strtoint('$'+B2)-strtoint('$'+B1);
 s:=inttostr(abs(Rm))+inttostr(abs(Gm))+inttostr(abs(Bm));
 b:=StrToInt(s);
End;
 
 
// эта процедура очень похожа на ту, что вшивала файл в изображение
// посему  прокоментирую только основные моменты
Procedure WriteToFile(FileName,BitmapName,SavePath:string);
VAR  i,j,len,olen:integer;
     bm:TBitmap;
     Rs,Gs,Bs,RGB,bt:string;
     mR,mG,mB:integer;
     bm1:TBitmap;
     Rs1,Gs1,Bs1,RGB1,bt1:string;
     b:byte;
     F:File;
begin
 bm:=TBitmap.Create;
 bm.LoadFromFile(BitmapName);
 bm1:=Tbitmap.Create;
 bm1.LoadFromFile(SavePath);
 assignfile(F,Filename);
 rewrite(F,1);
 len:=Filesize(F);
 Form3.PB.Min:=0;
 form3.PB.Max:=bm.Width;
 for I := 0 to bm.Width - 1 do
  begin
   for j := 0 to bm.Height - 1 do
     Begin
      RGB:=IntToHex(ColorToRGB(bm.Canvas.Pixels[i,j]),6);
      RGB1:=IntToHex(ColorToRGB(bm1.Canvas.Pixels[i,j]),6);
      RGBr(RGB,rs,gs,bs);
      RGBr(RGB1,rs1,gs1,bs1);
      RGBc(rs,gs,bs,rs1,gs1,bs1,b);
      BlockWrite(F,b,1);
      {
       вот и основной момент
       из 2х изображений получаем один
       и тотже пиксель, тоесть его цвет
       разлагаем на каналы и ищем разность
       этих каналов, после чего эти 3
       разности собираются в 1 байт
       (например R1-234 R-235 тогда разность
        у нас 1 и первая цифра байта будет 1
        тоесть 1хх и тутже этот байт запи-
        сывается в выходной файл)
      }
     End;
    Form3.PB.Position:=i;
  end;
 Closefile(F);
End;
 
procedure TForm3.Button1Click(Sender: TObject);
begin
WriteToBmp(Edit3.text,edit1.Text,Edit2.Text);
// вот и обработчики
end;
 
procedure TForm3.Button2Click(Sender: TObject);
begin
WriteToFile(Edit3.text,edit1.Text,Edit2.Text);
end;
 
end.
Всё прокоментировано довольно подробно и просто, ибо сложно не умею и болит голова, да и терминов незнаю. Писал сам ради интереса. Хотелосьбы слышать мнение. Незнаю получитсяли прикрепить саму прогу, но я попробую.
З.Ы. Если на картинке есть белый цвет то изменения "значительны"
Вложения
Тип файла: rar FileInBmp.rar (9.5 Кбайт, 26 просмотров)
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:45.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025