Re: Optimize this code

Don't work with pixels when you need to do a fair ammount of
processing load into a DIB.....

Tony

--- In [email protected], "dk" <dread_k1@y...> wrote:
> Hi all,
> Is there anyone can optimize this code?
> I'm making a steganography program based on LSB insertion bit, I
think the problem is in the use of property pixels from TCanvas. It's
too slow. HEre's the code: 
> 
> unit LSBStegano;
> 
> interface
> 
> uses Windows, Graphics, Classes;
> const
>     MaxPixelCount  =  32768;
> 
> type
>   TStegoStream = class(TStream)
>   private
>     fBitsXColor: Integer;     // number of bit change in each color
: 1 - 8
>     X, Y: Integer;            // pixel position in bitmap
>     ColorPos: Integer;        // color position in each pixel : 0,1,2
>     BitPos: Integer;          // bit position in color : 0 to
fBitsXColor
>     Width: Integer;
>     Height: Integer;
>     BMP: TBitmap;
>     fMaxSize: Integer;
>     fSize: Integer;
>     HeaderPixels: Integer;    // number of pixel needed to store the
header
> 
>     procedure NextBit;
>     procedure SetBit(Value: Integer);
>     function GetBit: Integer;
>     function ReadByte: Integer;
>     procedure WriteByte(Value: Integer);
>     function XYBC2Position: Integer;
>     procedure Position2XYBC(Position: Integer);
>     function BitsXPixel: Integer;
>   public
>     constructor Create(ABitsXColor: Integer);
>     destructor Destroy; override;
>     procedure LoadBitmap(ABMP: TBitmap);
>     function CheckNRead(HashVal: String; ABitsXColor: Integer): boolean;
>     function GetMaxDataSize(BitmapWidth, BitmapHeight: word): longword;
>     function Read(var Buffer; Count: Longint): Longint; override;
>     function Write(const Buffer; Count: Longint): Longint; override;
>     function Seek(Offset: Longint; Origin: Word): Longint; overload;
> override;
>     procedure SetSize(NewSize: Longint); overload; override;
>     procedure WriteStego(const FileName: string; HashV: string);
>     property MaxSize: Integer read fMaxSize;
>     property BitsXColor: Integer read fBitsXColor;
>   end;
>
-------------------------------------------------------------------------
> procedure TStegoStream.LoadBitmap(ABMP: TBitmap);
> begin
>   inherited Create;
>   BMP := ABMP;
>   BMP.PixelFormat := pf24bit;
>   //  fBitsXColor := 1;
>   Width := BMP.Width;
>   Height := BMP.Height;
> end;
> 
> procedure TStegoStream.WriteStego(const FileName: string; HashV:
string);
> var
>   OldX, OldY, OldC, OldB: Integer;
>   Header: TStegoHeader;
> begin
>   X := 0;
>   Y := 0;
>   ColorPos := 0;
>   BitPos := 0;
>   Header.Hash := HashV;
>   Header.Size := fSize;
>   Header.BitsXColor := fBitsXColor;
>   fBitsXColor := 1;
>   Write(Header, SizeOf(TStegoHeader));
>   BMP.SaveToFile(FileName);
> end;
> 
> function TStegoStream.Write(const Buffer; Count: Longint): Longint;
> var
>   I: Integer;
> begin
>   Result := Min(Count, fMaxSize - XYBC2Position);
>   for I := 0 to Result - 1 do begin
>     WriteByte(TByteArray(Buffer)[I]);
>   end;
>   fSize := Max(fSize, XYBC2Position);
> end;
> 
> procedure TStegoStream.WriteByte(Value: Integer);
> var
>   I: Integer;
> begin
>   for I := 0 to 7 do
>     SetBit(Value shr I);
> end;
> 
> procedure TStegoStream.SetBit(Value: Integer);
> var
>   NewColor: TColor;
>   Pos: Integer;
>   R: PRGBTripleArray;
> begin
>   NewColor := BMP.Canvas.Pixels[X, Y];
>   Value := Value and 1;
>   Pos := ColorPos * 8 + BitPos;
>   NewColor := NewColor and not(1 shl Pos);
>   NewColor := NewColor or (Value shl Pos);
>   BMP.Canvas.Pixels[X, Y] := NewColor;
>   NextBit;
> end;
> 
> procedure TStegoStream.NextBit;
> begin
>   Inc(BitPos);
>   if BitPos = fBitsXColor then begin
>     BitPos := 0;
>     Inc(ColorPos);
>     if ColorPos = 3 then begin
>       ColorPos := 0;
>       Inc(X);
>       if X = Width then begin
>         X := 0;
>         Inc(Y);
>       end;
>     end;
>   end;
> end;
> 
> Thanks before
> 
> DK
> 
> [Non-text portions of this message have been removed]


------------------------ Yahoo! Groups Sponsor ---------------------~-->
Buy Ink Cartridges or Refill Kits for Your HP, Epson, Canon or Lexmark
Printer at Myinks.com. Free s/h on orders $50 or more to the US & Canada. http://www.c1tracking.com/l.asp?cid=5511
http://us.click.yahoo.com/l.m7sD/LIdGAA/qnsNAA/i7folB/TM
---------------------------------------------------------------------~->

Delphi VCL Top Sites!
http://www.sandbrooksoftware.com/TS/TS2/Components.shtml
---------------------------------------------------------------
Unsubscribe:[email protected]
List owner:[email protected]
--------------------------------------------------------------- 

Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/