Re: Optimize this code

Would you like to send the code now, please?
Does it required much changes to my code?
Thanks for the response.
 
I'm using DIBUltra (a freeware, http://perso.magic.fr/sleon/prog/DIBUltra/DIB_SRC.zip) as replacement for TBitmap. The use is like TBitmap very much, has pixels and scanline too. But why this code is still too slow? Not much speed improvement, just 50-80 ms, the whole process is around 2684 ms (85 kB data in bmp file: 800x600, 24bit bitmap running on WinXP Pro,Duron 700 Mhz, 256 MB, compiled on Delphi 5). Besides, DIBUltra can't save in windows bitmap yet. I need to save in windows bitmap format.

Here's the code, not all but I can send all if it's needed.
I think the problem is in proc Write, WriteByte, SetBit.
 
unit LSBStegano;

interface

uses Windows, Graphics, Classes, DIBUltra, DIBType;
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 DIB
    ColorPos: Integer;        // color position in each pixel : 0,1,2
    BitPos: Integer;          // bit position in color : 0 to fBitsXColor
    Width: Integer;           // width of DIB
    Height: Integer;          // height of DIB
//BMP: TBitmap;
    DIB: TDIBUltra;
    fMaxSize: Integer;        // max data can be stored
    fSize: Integer;           // data size
    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 LoadDIB(ADIB: TDIBUltra);
    function CheckNRead(HashVal: String; ABitsXColor: Integer): boolean;
    function GetMaxDataSize(DIBWidth, DIBHeight: 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;

pRGBTripleArray  =  ^TRGBTripleArray;
TRGBTripleArray  =  ARRAY[0..MaxPixelCount-1] OF TRGBTriple;

implementation

uses Math, SysUtils;

var  HashValue: string;

type
  // header is stored with 1 bit change per color
  TStegoHeader = record
    Hash: string[28];
    BitsXColor: Integer;
    Size: Integer;
  end;

constructor TStegoStream.Create(ABitsXColor: Integer);
begin
  // +2 to round up
  HeaderPixels := ((SizeOf(TStegoHeader) * 8 + 2) div 3);
  fBitsXColor := ABitsXColor;
end;

procedure TStegoStream.LoadDIB(ADIB: TDIBUltra);
begin
  inherited Create;
  DIB := ADIB;
  Width := DIB.Width;
  Height := DIB.Height;
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;

// the number of bit change in every pixel
function TStegoStream.BitsXPixel: Integer;
begin
  Result := fBitsXColor * 3;
end;

procedure TStegoStream.SetBit(Value: Integer);
var Pos : integer;
begin
  Pos := ColorPos * 8 + BitPos;
  Value := (Value and 1) Shl Pos;
  with DIB.Canvas do
  Pixels[X, Y] := (Pixels[X, Y] and not (1 shl Pos) or Value);
end;

procedure TStegoStream.WriteByte(Value: Integer);
var
  I: Integer;
begin
  for I := 0 to 7 do
    SetBit(Value shr I);
end;

// translation from coordinate in pixel, bit, and color to stream's position
function TStegoStream.XYBC2Position: Integer;
begin
  Result := ((Y * Width + X - HeaderPixels) * BitsXPixel + ColorPos *
              fBitsXColor + BitPos) div 8;
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.WriteStego(const FileName: string; HashV: string);
var
  Header: TStegoHeader;
begin
  // Set position to the beginning of bitmap
  X := 0;
  Y := 0;
  ColorPos := 0;
  BitPos := 0;
  // Get header information
  Header.Hash := HashV;
  Header.Size := fSize;
  Header.BitsXColor := fBitsXColor;
  // Save header with 1 bit change per color
  fBitsXColor := 1;
  Write(Header, SizeOf(TStegoHeader));
//  DIB.SaveToFile(FileName,DUsmDIBUltra{DUsmWindows}, DUpf24);
end;


It's what I said too long

.................
t3 := gettickcount;
Stego.CopyFrom(AMemStream,AMemStream.Size);
showmessage(inttostr(gettickcount - t3));
.................

Forgive my broken English,
thanks for helping,


DK



---------------------------------
Do you Yahoo!?
The New Yahoo! Search - Faster. Easier. Bingo.

[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/