here's another one: (excerpt from http://www.advdelphisys.co
Function BitmapToGrayscale(
Bitmap : TBitmap
): Boolean;
Var
Jpeg : TJPEGImage;
Begin
Result := False;
If Bitmap = nil Then Exit;
Try
Jpeg := TJPEGImage.Create();
Try
Jpeg.Assign(Bitmap);
Jpeg.CompressionQuality := 100;
Jpeg.Compress;
Jpeg.Grayscale := True;
Bitmap.Canvas.Draw(0, 0, Jpeg);
Result := True;
Finally
Jpeg.Free;
End;
Except
Result := False;
End;
End;
Function BitmapToGrayscale(
BitmapSource: TBitmap;
BitmapOut : TBitmap
): Boolean; OverLoad;
Var
Bitmap : TBitmap;
Begin
Bitmap := TBitmap.Create();
Try
Result := BitmapToGrayscale(Bitmap);
If Result Then BitmapOut.Assign(Bitmap);
Finally
Bitmap.Free;
End;
End;
Function BitmapToGrayscale(
BitmapSourceFile: String;
BitmapOutFile : String
): Boolean; OverLoad;
Var
Bitmap : TBitmap;
Begin
Result := False;
Try
If Not FileExists(BitmapSourceFil
Bitmap := TBitmap.Create();
Try
Bitmap.LoadFromFile(Bitmap
Result := BitmapToGrayscale(Bitmap);
If Result Then
Begin
If FileExists(BitmapOutFile) Then DeleteFile(BitmapOutFile);
Bitmap.SaveToFile(BitmapOu
End;
Finally
Bitmap.Free;
End;
Except
Result := False;
End;
End;
Function BitmapToGrayscale(
BitmapFile: String
): Boolean; OverLoad;
Begin
Result :=
BitmapToGrayscale(
BitmapFile, //BitmapSourceFile: String;
BitmapFile //BitmapOutFile : String
);//): Boolean; OverLoad;
End;
Main Topics
Browse All Topics
by: DragonSlayerPosted on 2006-04-16 at 05:32:14ID: 16464023
something like this?
procedure GrayScale(b: TBitmap);
var
i, j, Colr : Integer;
sl : pRGBArray; // Scanline
begin
if b.PixelFormat <> pf24bit then begin
ShowMessage('Not a 24Bit color bitmap!');
Exit;
end;
for j:=0 to b.Height-1 do begin
sl := b.ScanLine[j];
for i:=0 to b.Width-1 do begin
Colr:=HiByte(sl[i].rgbtRed
sl[i].rgbtBlue * 28);
sl[i].rgbtRed := Colr;
sl[i].rgbtGreen := Colr;
sl[i].rgbtBlue := Colr;
end;
end;
end;
alternatively, look at
http://www.efg2.com/Lab/Li
http://www.efg2.com/Lab/Li
for 256 colored bitmaps whereby you need to set the palette for it as well.