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.