procedure TForm1.aaa(bmpFrom, bmpTo: Tbitmap);
var
TmpImage, Monobmp: TBitmap;
IRect: TRect;
begin
MonoBmp := TBitmap.Create;
TmpImage:=Tbitmap.Create;
TmpImage.Width := bmpFrom.Width;
TmpImage.Height := bmpFrom.Height;
IRect := Rect(0, 0, bmpFrom.Width, bmpFrom.Height);
TmpImage.Canvas.Brush.Color := clBtnFace;
try
with MonoBmp do
begin
Assign(bmpFrom);
Canvas.Brush.Color := clBlack;
if Monochrome then
begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with TmpImage.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(IRect);
Brush.Color := clBlack;
Font.Color := clWhite;
CopyMode := MergePaint;
Draw(IRect.Left + 1, IRect.Top + 1, MonoBmp);
CopyMode := SrcAnd;
Draw(IRect.Left, IRect.Top, MonoBmp);
Brush.Color := clBtnShadow;
Font.Color := clBlack;
CopyMode := SrcPaint;
Draw(IRect.Left, IRect.Top, MonoBmp);
CopyMode := SrcCopy;
bmpTo.assign(TmpImage);
TmpImage.free;
end;
finally
MonoBmp.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aaa(image1.picture.bitmap, image2.picture.bitmap);
Image2.invalidate;
end;
|