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

Delphi Sources



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

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

Конечно в 1 картинку без изменения её размера зашить файл неполучится, а вот хм... так сказать... "между" 2мя битмапами вполне.
Ну впрочем код прост как 2жды 2 поэтому без теории. Сразу к делу
Код:
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 Кбайт, 25 просмотров)
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter