Hi Darren,
copying a bitmap line by line is the same for monochrome and for color
bitmaps.
First you have to calculate the size of a line in bytes
LineSize = Width * 3; // 3 bytes per pixel for pixelformat pf24bit
then you have to calculate the pitch (linesize aligned by 2 bytes)
Pitch = AlignWord(LineSize);
you can calculate the source pointer for scanline y
pSrc = pImageDataSrc + y * Pitch
the destination pointer is the scanline of the bitmap
pDst = bmpDest.Scanline[y];
then you can copy the whole scanline
CopyMemory(pDst,pSrc,LineSize);
Here is a small example you can play with, just create a new application in
delphi and drop an image and a button on the form:
----------------------------------------------------------
function AlignWord(const x: Integer): Integer;
begin
Result := (x + 1) and not 1;
end;
procedure WriteToColourBitmap(dstBitmap: TBitmap; const ImageData: PChar;
const Width, Height: Integer);
var
y, pitch, linesize: Integer;
pSrcScanline,pDstScanline: PChar;
begin
linesize := Width * 3; // 3 bytes per pixel for pf24bit
pitch := AlignWord(linesize);
for y := 0 to Height-1 do
begin
pSrcScanline := ImageData + y * pitch;
pDstScanline := dstBitmap.Scanline[y];
CopyMemory(pDstScanline,pSrcScanline,linesize);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
IMG_WIDTH = 543;
IMG_HEIGHT = 345;
BYTES_PER_PIXEL = 3; // 24 bit image
LINE_SIZE = IMG_WIDTH * BYTES_PER_PIXEL; // size of line in bytes
LINE_PITCH = (LINE_SIZE + 1) and not 1; // 2-byte aligned
var
ImageData: array[0..IMG_HEIGHT*LINE_PITCH-1] of byte;
x,y: Integer;
bmp: TBitmap;
begin
// fill buffer with some image data
FillMemory(@ImageData[0],SizeOf(ImageData),0);
for y := 0 to IMG_HEIGHT-1 do
begin
for x := 0 to IMG_WIDTH-1 do
begin
with PRGBTriple(@ImageData[y*LINE_PITCH+x*BYTES_PER_PIXEL])^ do
begin
rgbtBlue := Byte(x and not 15);
rgbtGreen := Byte(y and not 15);
rgbtRed := Byte(rgbtBlue+rgbtGreen);
end;
end;
end;
// Write ImageData to bitmap
bmp := TBitmap.Create;
try
bmp.Width := IMG_WIDTH;
bmp.Height := IMG_HEIGHT;
bmp.PixelFormat := pf24Bit;
WriteToColourBitmap(bmp,PChar(@ImageData[0]),IMG_WIDTH,IMG_HEIGHT);
Image1.Picture.Bitmap.Assign(bmp);
finally
bmp.Free;
end;
end;
> -----Original Message-----
> From: [EMAIL PROTECTED]
> [mailto:[EMAIL PROTECTED] Behalf Of Darren McBride
> Sent: Wednesday, March 30, 2005 11:32 AM
> To: 'Borland's Delphi Discussion List'
> Subject: Working with bitmaps
>
>
> Folks,
>
> Unfortunately I don't know enough about pointers and the like, but I'm
> trying to learn. People like Erwin Haid have provided me with HUGE help in
> the past, so I'm hoping someone can come to my aid again. It
> might only take
> someone with knowledge on this list a few minutes to fix what would
> otherwise take me days.
>
> Considering the following two routines, the
> WriteToMonochromeBitmap function
> writes the data far faster than the colour function because it writes the
> image data to the new image line by line, not pixel by pixel. In the
> WriteToColourBitmap function the target file is 24-bit - how do I
> replicate
> the scanline by scanline method in this function ?
>
> procedure WriteToColourBitmap(const ImageData: PChar; const Width, Height:
> Integer);
> var
> x, y, z, w, p: Integer;
> sl: PChar;
> pc: PRGBTriple;
> begin
> { get pixel co-ordinate }
> p := AlignWord(Width * 3);
>
> { create bitmap }
> if Assigned(gbBitmap) then
> begin
> { write band }
> z := Height - 1;
> for y := 0 to z do
> begin
> sl := ImageData + y * p;
> w := Width - 1;
> for x := 0 to w do
> begin
> pc := PRGBTriple(sl + x * 3);
> gbBitmap.Canvas.Pixels[x, gbImageHeight + y] := RGB(pc.rgbtBlue,
> pc.rgbtGreen, pc.rgbtRed);
> end;
> end;
> end;
> end;
>
> procedure WriteToMonochromeBitmap(const ImageData: PChar; const Width,
> Height: Integer);
> var
> x, y, z, w: Integer;
> sl: PChar;
> r: PByteArray;
> begin
> { check bitmap }
> if Assigned(gbBitmap) then
> begin
> { calculate scanline length }
> w := Trunc(Width / 8);
>
> { write band }
> z := Height - 1;
> for y := 0 to z do
> begin
> sl := ImageData + (y * w);
> r := PByteArray(gbBitmap.Scanline[y]);
> for x := 0 to (w - 1) do
> r[x] := Byte(sl[x]);
> end;
> end;
> end;
>
> Many, many thanks in advance,
> Darren
>
> --
> No virus found in this outgoing message.
> Checked by AVG Anti-Virus.
> Version: 7.0.308 / Virus Database: 266.8.5 - Release Date: 29/03/2005
>
>
>
> _______________________________________________
> Delphi mailing list -> [email protected]
> http://www.elists.org/mailman/listinfo/delphi
>
_______________________________________________
Delphi mailing list -> [email protected]
http://www.elists.org/mailman/listinfo/delphi
