Optimize this code

"dk" <[email protected]> Mon, 18 Aug 2003 07:44:17 +0700
Newsgroups gmane.comp.lang.delphi.programming
Message-ID <009d01c36521$e339d490$0b00a8c0@Station11>
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/