Mastodon
Programmierung

Bitmaps: Create a monochrome bitmap

This function creates a ‘grayed’ out bitmap.
Simply pass it a bitmap and a outline color.


[code lang=”delphi”]function TForm1.CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor): TBitmap;
const
ROP_DSPDxax = $00E20746;
var
MonoBmp: TBitmap;
IRect: TRect;
begin
IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
Result := TBitmap.Create;
try
Result.Width := FOriginal.Width;
Result.Height := FOriginal.Height;
MonoBmp := TBitmap.Create;
try
with MonoBmp do begin
Assign(FOriginal);
{$IFDEF S_D3}
HandleType := bmDDB;
{$ENDIF}
Canvas.Brush.Color := clBlack;
if Monochrome then begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with Result.Canvas do begin
Brush.Color := OutlineColor;
FillRect(IRect);
Brush.Color := clBtnHighlight;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 1, 1, IRect.Right – IRect.Left, IRect.Bottom – IRect.Top, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
Brush.Color := clBtnShadow;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 0, 0, IRect.Right – IRect.Left, IRect.Bottom – IRect.Top, MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
end;
finally
MonoBmp.Free;
end;
except
Result.Free;
raise;
end;
end;
[/code]
And this is one way you can call it.

[code lang=”delphi”]Image2.Picture.Bitmap := CreateDisabledBitmap(Image1.Picture.Bitmap, clBtnFace);
[/code]

[tags]Delphi, Graphic[/tags]

0 Kommentare zu “Bitmaps: Create a monochrome bitmap

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht.