Can't get transparent color for TBitmap - pascal

I have a bitmap that I want to draw on TPaintBox. The problem is that I have to rotate it to a specific angle before. I decided to use TBitmap32.
I do it this way: I create a TBitmap first, then transfer it to TBitmap32, do a conversion and move TBitmap32 to TBitmap again. I am drawing this last TBitmap on TPaintBox. The problem is I can't get transparency.
The bitmap has a red background that I want to make transparent. Will you help? What am I doing wrong?
carImage32 := TBitmap32.Create;
carImage32.Width := carImageTMP.Width;
carImage32.Height := carImageTMP.Height;
carImage32.Canvas.Draw(0, 0, carImageTMP); //assign TBitmap
carImage := TBitmap.Create;
carImage.Width := carImageTMP.Width;
carImage.Height := carImageTMP.Height;
RotateBitmap(carImage32,angle,false,clNone,True);
carImage.Transparent:=True;
carImage.TransparentColor:=clRed;
carImage.Assign(carImage32);
paintBox.Canvas.Draw(0,0,carImage);

I solved my problem.
I should use also for TBitmap32 this part of code:
auto.carImage32.DrawMode:=dmTransparent;
auto.carImage32.OuterColor:=clRed32;
and worked :)

Related

Assign a picture to a TImage and define the background color of transparent pixels

Problem:
I have a TImage on a Delphi VCL form and want to assign a TGraphic.
The picture has transparent pixels.
When displaying the picture inside the TImage I want to display all transparent pixels in the color clBlue.
Unfortunately TImage does not have a property for a background color.
What I have already tried:
Fill the TImage with blue and afterwards to assign the picture:
MyImage.Canvas.Brush.Style := bsSolid;
MyImage.Canvas.Brush.Color := clBlue;
MyImage.Canvas.FillRect(Rect(0, 0, MyImage.Width, MyImage.Height));
MyImage.Picture.Assign(MyGraphic);
Set the TransparentColor of the bitmap:
MyImage.Picture.Bitmap.TransparentColor := clBlue;
MyImage.Picture.Assign(MyGraphic);
Nothing worked :-(
Create a new TBitmap of the desired size, and fill it completely with a solid clBlue color.
Then, draw the source image transparently onto this TBitmap, so that the blue color shows through the transparent areas.
Then, assign this TBitmap to the TImage.
Alternatively, place the TImage onto a TPanel, set the panel's color to clBlue, and then assign the transparent image as-is to the TImage.
Alternatively, use a TPaintBox instead of a TImage. In the TPaintBox.OnPaint event, draw a clBlue background onto the TPaintBox.Canvas, then draw the source image transparently onto the Canvas.
procedure DrawPictureWithBackgroundColor(Image: TImage; Graphic: TGraphic; BackgroundColor: TColor);
begin
Image.Canvas.Brush.Style := bsSolid;
Image.Canvas.Brush.Color := BackgroundColor;
Image.Canvas.FillRect(Rect(0, 0, Image.Width, Image.Height));
Image.Canvas.StretchDraw(Rect(0, 0, Image.Width, Image.Height), Graphic);
end;
Usage:
DrawPictureWithBackgroundColor(MyImage, MyGraphic, clBlue);
MyGraphic contains the picture data itself.
MyImage is the control/container which makes the picture visible on the form.

Draw a vertically centered multi-line string using WinAPI's "DrawText" function

I am trying to draw a word-wrapped string within centered both vertically and horizontally within a bitmap using WinAPI's DrawText function.
The problem is that if text is longer than the available space and "END ELLIPSIS" (...) is added to a cropped string, the reported drawing coordinates returned when using the "DT_CALCRECT" report the uncropped number of lines which messes with the vertical centering calculations.
I read many posts on this, and thought that "Delphi - Draw text multiline in the centre of a rect" may hold the answer, but it didn't (screenshot of the code output using the sample in the linked question http://zoomplayer.com/pix/font_vcenter.jpg). The author of the accepted answer suggested I create a new question so here it is.
For quick-reference, here is a slightly simplified (removing unrelated code) text rendering code from the linked accepted answer:
procedure DrawTextCentered(Canvas: TCanvas; const R: TRect; S: String);
var
DrawRect: TRect;
DrawFlags: Cardinal;
begin
DrawRect := R;
DrawFlags := DT_END_ELLIPSIS or DT_NOPREFIX or DT_WORDBREAK or
DT_EDITCONTROL or DT_CENTER;
DrawText(Canvas.Handle, PChar(S), -1, DrawRect, DrawFlags or DT_CALCRECT);
DrawRect.Right := R.Right;
if DrawRect.Bottom < R.Bottom then
OffsetRect(DrawRect, 0, (R.Bottom - DrawRect.Bottom) div 2)
else
DrawRect.Bottom := R.Bottom;
DrawTextEx(Canvas.Handle, PChar(S), -1, DrawRect, DrawFlags, nil);
end;
As you can see from the screenshot, the problem is after the initial call to DrawText with the "DT_CALCRECT" flag to measure the output height for later vertical centering, rendering the string "Trending in: Worldwide" returns a DrawRect.Bottom value representing 3 lines of text even though only 2 lines are drawn, breaking the vertical centering code.

How access size information of a image via code

I'm using Delphi 10.1 Berlin and I need to create an image and set his Canvas size equals to be equal to the bitmap size. To be more specific I want to access this properties:
Where say: "Sized by Image". But I can't figure out how can I acces this, help please! :-D
EDIT: This is the code that I'm using, if you guys need to understand better what I'm trying to achieve:
imgProdutoZoom := TImage.Create(rtFundoArredondadoZoom);
imgProdutoZoom.Parent := rtFundoArredondadoZoom;
imgProdutoZoom.Align := TAlignLayout.Client;
imgProdutoZoom.Bitmap.Assign(imgProduto.Bitmap);
imgProdutoZoom.WrapMode := TImageWrapMode.Fit;
imgProdutoZoom.Name := 'imgZoom'+ IntToStr(i);
I found this code: imgProdutoZoom.MultiResBitmap.SizeKind.Source;
But the console give me an error: '[dcc32 Error] MainFrm.pas(628): E2018 Record, object or class type required'
You did not show what rtFundoArredondadoZoom is, but I assume it is a TRectangle.
When you set
imgProdutoZoom.Parent := rtFundoArredondadoZoom;
imgProdutoZoom.Align := TAlignLayout.Client;
you are telling to fill up the area of the parent (rtFundoArredondadoZoom). However, since TImage.WrapMode by default is TImageWrapMode.Fit, the image retains its aspect ratio and doesn't stretch to fill the parent.
Now, the limiting factor in your setup is the rtFundoArredondadoZoom rectangle, and specifically its height. To show the image in its full size, you need to set
rtFundoArredondadoZoom.Height := imgProdutoZoom.Bitmap.Height;
You may at times also want to set the width of the rectangle.
The following image shows an image in original size to the left, and te same image on a rectangle with smaller height using basically your code
Then after applying the height setting on the rectangle
Your code corrected accordingly would be:
imgProdutoZoom := TImage.Create(rtFundoArredondadoZoom);
imgProdutoZoom.Parent := rtFundoArredondadoZoom;
imgProdutoZoom.Align := TAlignLayout.Client;
imgProdutoZoom.Bitmap.Assign(imgProduto.Bitmap);
// imgProdutoZoom.WrapMode := TImageWrapMode.Fit; // not needed
rtFundoArredondadoZoom.Height := imgProdutoZoom.Bitmap.Height; // add this
imgProdutoZoom.Name := 'imgZoom'+ IntToStr(i);

How do i undo the effect of IntersectClipRect?

Given the following code snippet:
procedure TPicture.PaintLine(_Canvas: TCanvas; _Left, _Top, _Right, _Bottom: Integer);
begin
IntersectClipRect(_Canvas.Handle, _Left, _Top, _Right, _Bottom);
try
_Canvas.MoveTo(_Left - 10, _Top - 10);
_Canvas.LineTo(_Right + 10, _Bottom + 10);
// (This is an example only, the actual drawing is much more complex.)
finally
SelectClipRgn(_Canvas.Handle, 0); // This does too much
end;
end;
I want to undo the clipping effected by the call to IntersectClipRect so the previously active clipping becomes active again. In the above code, this is done by SelectClipRgn(...,0) which turns off clipping altogether. This works, kind of, but afterwards there is no clipping active so any drawing that is executed after the above will paint to areas that should not be painted to.
So, what is the correct way to undo only the effect of IntersectClipRect?
EDIT: Removed the unnecessary CreateRectRgn and DeleteObject code after I understood the comment from Sertac, to make the question more readable for others that might stumble upon it later.
You can save and restore the state of the DC:
var
// RGN: HRGN;
SavedDC: Integer;
begin
// RGN := CreateRectRgn(_Left, _Top, _Right, _Bottom);
SavedDC := SaveDC(_Canvas.Handle);
try
IntersectClipRect(_Canvas.Handle, _Left, _Top, _Right, _Bottom);
_Canvas.MoveTo(_Left - 10, _Top - 10);
_Canvas.LineTo(_Right + 10, _Bottom + 10);
// (This is an example only, the actual drawing is much more complex.)
finally
RestoreDC(_Canvas.Handle, SavedDC);
end;
...
IIRC, first store the current clip region using GetClipRgn, and after you're done, SelectClipRgn the stored region again.
Looking at your code, it should be enough to SelectClipRgnyour RGN again, because:
The IntersectClipRect function creates a new clipping region from the intersection of the current clipping region and the specified rectangle.

How to render RichEdit Text to a canvas by keeping font smoothness

i am trying to render RichEdit to a bitmap. I want to make backgrond tranparent.
I could achieve that by the code above. The problem is that when i set bitmap as tranparent
only the transparent color becomes transparent. Is there any way to handle the pixels on the edge
which are diffrent from background color and also different from font color. i mean making the pixels
semi-tranparent on the edge which makes a smooth view.
Graphics::TBitmap *bitmap = new Graphics::TBitmap();
bitmap->Width = RichEdit1->Width ;
bitmap->Height = RichEdit1->Height ;
TRect BoundingBox(0,0,RichEdit1->Width, RichEdit1->Height) ;
// Render RichEdit to bitmap
TFormatRange formatRange;
int twipsPerPixel = 1440 / Screen->PixelsPerInch;
formatRange.hdc = bitmap->Canvas->Handle;
formatRange.hdcTarget = bitmap->Canvas->Handle;
formatRange.chrg.cpMin = 0;
formatRange.chrg.cpMax = -1;
formatRange.rc.top = 2 * twipsPerPixel;
formatRange.rc.bottom = (BoundingBox.Height() - 4) * twipsPerPixel + formatRange.rc.top;
formatRange.rc.left = 2 * twipsPerPixel;
formatRange.rc.right = (BoundingBox.Width() - 4) * twipsPerPixel;
// Measure text's height.
RichEdit1->Perform(EM_FORMATRANGE, 0, 0);
RichEdit1->Perform(EM_FORMATRANGE, 0, (LPARAM) &formatRange);
formatRange.rc.bottom = (BoundingBox.Height() - 4) * twipsPerPixel + formatRange.rc.top;
formatRange.rc.left = 2 * twipsPerPixel;
formatRange.rc.right = (BoundingBox.Width() - 4) * twipsPerPixel;
formatRange.rcPage = formatRange.rc;
/**
* Draw..
**************************************************************************/
RichEdit1->Perform(EM_FORMATRANGE, 1, (LPARAM) &formatRange);
RichEdit1->Perform(EM_FORMATRANGE, 0, 0);
// Draw background
// Use different background color to see the trasparency problem
this->Canvas->Brush->Color = clRed ;
this->Canvas->Rectangle(0,0,RichEdit1->Width , RichEdit1->Height );
// Draw the transparent bitmap
bitmap->Transparent = true ;
bitmap->TransparentColor = RichEdit1->Color ;
this->Canvas->Draw(0,0,bitmap);
Thanx.
Font smoothing works with partial transparency using an alpha channel. The Transparent and TransparentColor properties of TBitmap are therefore not applicable.
You haven't said which version of the C++ Builder/VCL you are using, but more modern versions have better support for partial transparency than some of the older ones.
To get this to work you will need to set the PixelFormat of your bitmap to be pf32bit. You may also need to set AlphaFormat to afDefined.
If you can't get TBitmap to do what you need then you'll have to revert to GDI commands to create a suitable HBITMAP. You can at least assign that to the Handle property of a TBitmap and usually from there everything behaves.
Note that I am not a user of C++ Builder but do know the VCL from Delphi.
UPDATE
I tried this out in Delphi and the following worked fine for me:
procedure TForm4.Button1ClickBMP(Sender: TObject);
var
BMP: TBitmap;
fmtRange: TFormatRange;
intPPI, Flags: Integer;
begin
BMP := TBitmap.Create;
Try
BMP.PixelFormat := pf32bit;
BMP.SetSize(RichEdit1.Width, RichEdit1.Height);
FillChar(fmtRange, SizeOf(fmtRange), 0);
with fmtRange do begin
hDC := BMP.Canvas.Handle;
hdcTarget := hDC;
intPPI := Screen.PixelsPerInch;
rc := Rect(
0,
0,
RichEdit1.Width*1440 div intPPI,
RichEdit1.Height*1440 div intPPI
);
rcPage := rc;
chrg.cpMin := 0;
chrg.cpMax := -1;
end;
Flags := 1;
RichEdit1.Perform(EM_FORMATRANGE, Flags, Longint(#fmtRange));
RichEdit1.Perform(EM_FORMATRANGE, 0, 0);
BMP.SaveToFile('c:\desktop\test.bmp');
Finally
FreeAndNil(BMP);
End;
end;
The output looks like this, blown up somewhat to see the anti-aliasing:
I hope this helps, because it looks like you are very nearly there!
As David has answered already, sub-pixel antialiasing requires knowledge of the background colour. This is explained in more detailed in this answer. In essence, when you do sub-pixel anti-aliasing you treat the three colour channels as having different spatial offsets (which is where the apparent increase in resolution comes from). This means they need different alpha values, but of course there is only one alpha channel.
You can of course do regular full-pixel grayscale antialiasing over a transparent background. Perhaps this would be good enough? Some of the other answers in the question linked above suggest ways to achieve this. Have a look at ANTIALIASED_QUALITY (vs. CLEARTYPE_QUALITY) in the LOGFONT structure. (I haven't tried this.)

Resources