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/