Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Стеганография (вшивание информации в рисунки)

01.01.2007
// Do the actual encryption of the message inside the picture. 
procedure TForm1
.btnEncryptClick(Sender: TObject);
 
var
   x
, y, i, j: Integer;
   
PixelData: TColor;
   
CharMask, CharData: Byte;
 
begin
   
// Assign the original picture to both the target encrypted image
 
// and delta image. Also make sure thier resolution is sufficient to
 
// indicate the change in the LSB.
  imgTarget
.Picture.Assign(imgOrig.Picture);
   imgDelta
.Picture.Assign(imgOrig.Picture);
   imgTarget
.Picture.Bitmap.PixelFormat := pf32bit;
   imgDelta
.Picture.Bitmap.PixelFormat := pf32bit;
   x
:= 0;
   y
:= 0;
   
// The letter 'c' is identified by the binary representation of '10000011'
 
// for each '1' in this number change the current pixel's LSB value.
 
with imgTarget.Picture.Bitmap do
     
for i := 1 to Length(sourceMessage.Text) do
     
begin
       
CharMask := $80;
       
// 8 bytes for every letter to be encrypted.
     
for j := 1 to 8 do
       
begin
         
// See if the current byte in the character is either '1' or '0'.
       
CharData := Byte(sourceMessage.Text[i]) and CharMask;
         
//Data is not zero - change the LSB of the current pixel.
       
if (CharData <> 0) then
         
begin
           
// Xor the LSB value - hence change its value.
         
PixelData := Canvas.Pixels[x, y] xor $1;
           
// Store the changed pixel color back in the Pixels array.
         
Canvas.Pixels[x, y] := PixelData;
         
end;
 
         
// Move to the next pixel.
        x
:= (x + 1) mod Width;
         
if (x = 0) then
         
begin
           
Inc(y);
         
end;
         
// Move the mask to be applied to the current character to the
       
// right, hence will now examine the next bit in the binary
       
// representation of the current letter to be encrypted.
       
CharMask := CharMask shr 1;
       
end;
     
end;
   
// Show the difference in the Delta image.
 
for y := 0 to imgOrig.Picture.Bitmap.Height -1 do
     
for x := 0 to imgOrig.Picture.Bitmap.Width -1 do
       
// Check for difference, the difference will show in the LSB of every
     
// pixel in the original and target images.
     
if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
         imgTarget
.Picture.Bitmap.Canvas.Pixels[x, y]) then
         imgDelta
.Picture.Bitmap.Canvas.Pixels[x, y] := clYellow;
 
end;
 
 
 
// Decryption ( by Lemy )
procedure TForm1
.btnDecryptClick(Sender: TObject);
 
Var
   x
, y: integer;
   mask
, ch: byte;
 
begin
   sourceMessage
.Clear;
   mask
:= $80;
   ch
:= 0;
   
for y := 0 to imgOrig.Picture.Bitmap.Height -1 do
   
begin
     
for x := 0 to imgOrig.Picture.Bitmap.Width -1 do
     
begin
       
// if the pixel is different then set related bit
     
if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
       imgTarget
.Picture.Bitmap.Canvas.Pixels[x, y]) then
         ch
:= ch or mask;
       
// shift the bit to the rigtht
      mask
:= mask shr 1;
       
// if the mask is 0 then the dexryption of a char is completed
     
// so add to the Text and rest the highest bit
     
if mask = 0 Then
       
begin
         sourceMessage
.Text := sourceMessage.Text + char(ch);
         mask
:= $80;
         ch
:= 0;
       
end;
     
end;
   
end;
 
end;

Взято с сайта: https://www.swissdelphicenter.ch