How to force a black and white printou of a color image

rbuser

Hi...

I?m having some trouble with printing a wmf image that I need to be
interpreted as Black and white, no matter on what printer it is sent to.

Is there a way to accomplish this with RB?

Thanks,

Eduardo Gomes
Insurance Solutions

rbuser

One choice would be to convert it to grayscale yourself before printing it.

You could use or start from one of these convert fonctions :

function ConvertBitmapToGrayscale1(const Bitmap: TBitmap): TBitmap;
var
i, j: Integer;
Grayshade, Red, Green, Blue: Byte;
PixelColor: Longint;
begin
with Bitmap do
for i := 0 to Width - 1 do
for j := 0 to Height - 1 do
begin
PixelColor := ColorToRGB(Canvas.Pixels[i, j]);
Red := PixelColor;
Green := PixelColor shr 8;
Blue := PixelColor shr 16;
Grayshade := Round(0.3 * Red + 0.6 * Green + 0.1 * Blue);
Canvas.Pixels[i, j] := RGB(Grayshade, Grayshade, Grayshade);
end;
Result := Bitmap;
end;



procedure ConvertBitmapToGrayscale2(const Bmp: TBitmap);
{From: Pascal Enz, pascal.enz@datacomm.ch }
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;
var
x, y, Gray: Integer;
Row: PRGBArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.ScanLine[y];
for x := 0 to Bmp.Width - 1 do
begin
Gray := (Row[x].rgbtRed + Row[x].rgbtGreen +
Row[x].rgbtBlue) div 3;
Row[x].rgbtRed := Gray;
Row[x].rgbtGreen := Gray;
Row[x].rgbtBlue := Gray;
end;
end;
end;


procedure ConvertBitmapToGrayscale3(const Bitmap: TBitmap);
type
PPixelRec = ^TPixelRec;
TPixelRec = packed record
B: Byte;
G: Byte;
R: Byte;
Reserved: Byte;
end;
var
X: Integer;
Y: Integer;
P: PPixelRec;
Gray: Byte;
begin
Assert(Bitmap.PixelFormat = pf32Bit);
for Y := 0 to (Bitmap.Height - 1) do
begin
P := Bitmap.ScanLine[Y];
for X := 0 to (Bitmap.Width - 1) do
begin
Gray := Round(0.30 * P.R + 0.59 * P.G + 0.11 * P.B);
// Gray := (P.R shr 2) + (P.R shr 4) + (P.G shr 1) + (P.G shr 4) +
(P.B shr 3);
P.R := Gray;
P.G := Gray;
P.B := Gray;
Inc(P);
end;
end;
end;


--
Daniel Lemire

rbuser

Thanks,

Gonna try it out...

Eduardo Gomes
Insurance Solutions