I have a TCard ( TGraphicControl component) and it has a property
background (TPicture)
I would like to be able to dim out or darken the background. Thus if i can play the card in the game then its normal. If i can not play the card in the game then its darken out. I have tried putting Tcard.enabled :=false Like you would a button, but it does not dim it out or darken the image / background.
Also I could not find a alphablend property for TPicture as i thought this might help.
With what property or component would i need to get this effect?
Handling Enabled
Following your example, the enabled state of TButton is drawn by Windows. For your own control, a visual reflection of a disabled state should be drawn by yourself. Within the overriden Paint routine this will simply mean:
if Enabled then
// draw enabled
else
// draw disabled;
The VCL takes care of handling a change of the Enabled property, since it calls Invalidate on the CM_ENABLEDCHANGED message.
Drawing dimmed
The most simple solution is to draw all that has to be drawn alphablended:
procedure TCard.Paint;
var
Tmp: TBitmap;
BlendFunc: TBlendFunction;
begin
if Enabled then
InternalPaint(Canvas)
else
begin
Tmp := TBitmap.Create;
try
Tmp.SetSize(Width, Height);
InternalPaint(Tmp.Canvas);
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := 80;
BlendFunc.AlphaFormat := 0;
WinApi.Windows.AlphaBlend(Canvas.Handle, 0, 0, Width, Height,
Tmp.Canvas.Handle, 0, 0, Width, Height, BlendFunc);
finally
Tmp.Free;
end;
end;
end;
Wherein the InternalPaint routine does everything you are doing now, for example:
procedure TCard.InternalPaint(ACanvas: TCanvas);
var
R: TRect;
begin
R := ClientRect;
ACanvas.Brush.Color := clGray;
ACanvas.Rectangle(R);
InflateRect(R, -7, -7);
if (FPicture.Graphic <> nil) and (not FPicture.Graphic.Empty) then
ACanvas.StretchDraw(R, FPicture.Graphic);
end;
All this with the following result:
The SourceConstantAlpha factor (max 255) signifies by how much the temporarily bitmap is blended with the destination surface. The default color of the Canvas is the color of the Parent (assuming you do not interfere with erasing background or something), which is clBtnFace in the above image. If that destination is all white, then the bitmap is faded to white. If you would like a blending color or a darkened effect, then add these two lines before AlphaBlend:
Canvas.Brush.Color := clBlack; //or clMaroon
Canvas.FillRect(ClientRect);
Related
I have a TPaintBox that I want to clear. But I still need the transparency, so drawing a rectangle is not a possibility. How can I clear it?
Note that a TPaintBox has no concept of being transparent. To give the impression of transparency you can prevent painting in the area you want to show through (show what is behind the TPaintBox).
In the sample below, I have a TImage with the landscape picture. On top of that, there is a TPaintBox which draws the cross of red lines. With Button1 I toggle a boolean flag (TimeToClear) and call PaintBox1.Invalidate;
The OnPaint method:
procedure TForm26.PaintBox1Paint(Sender: TObject);
begin
// Simply exit to prevent any painting;
if TimeToClear then Exit;
// Otherwise perform normal drawing
with (Sender as TPaintBox).Canvas do
begin
Pen.Style := psSolid;
Pen.Color := Vcl.Graphics.clRed;
Pen.Width := 5;
MoveTo( 0, 0);
LineTo(105,105);
MoveTo(105, 0);
LineTo( 0,105);
end;
end;
I'm trying to implement a layered painting system inside one of our internal components and I have problems blending bitmaps containing text.
Following code fragment shows the problem:
uses
GR32;
procedure DrawBitmaps;
var
bmp1: TBitmap32;
bmp2: TBitmap32;
begin
bmp1 := TBitmap32.Create;
bmp1.Width := 100;
bmp1.Height := 100;
bmp1.FillRect(0, 0, 100, 100, clWhite32);
bmp1.FillRect(0, 0, 80, 80, clTrGreen32);
bmp1.Font.Size := -16;
bmp1.Font.Color := clBlack;
bmp1.TextOut(2, 10, 'Green');
bmp1.SaveToFile('c:\0\bmp1.bmp');
bmp2 := TBitmap32.Create;
bmp2.Width := 80;
bmp2.Height := 80;
bmp2.FillRect(0, 0, 80, 80, clTrRed32);
bmp2.Font.Size := -16;
bmp2.Font.Color := clBlack;
bmp2.TextOut(2, 50, 'Red');
bmp2.SaveToFile('c:\0\bmp2.bmp');
bmp2.DrawMode := dmBlend;
bmp2.DrawTo(bmp1, 20, 20);
bmp1.SaveToFile('c:\0\bmpcombined.bmp');
bmp1.Free;
bmp2.Free;
end;
Resulting images:
bmp1:
bmp2:
bmpcombined:
As you can see, text is painted in black on bmp and bmp2, but appears white on bmpcombined.
I'm guessing the problem lies in TextOut which maps to Windows.ExtTextOut (via GR32_Backends_VCL.pas, TGDIBackend.Textout). That method doesn't handle transparency and paints text with alpha 00 (color is $000000 instead of $FF000000).
As a quick fix, setting bmp2.Font.Color to $FF000000 doesn't help.
bmp2.Font.Color := TColor(clBlack32);
I am using fresh sources from GitHub
How should I paint a non-transparent text on a semi-transparent background so that I could blend this into a larger picture?
As far as I remember the TextOut function was only meant as a direct way to add some text to the bitmap, lacking all the fixes you mentioned above.
In order to remain full control over transparency you might want to use
procedure TBitmap32.RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32);
instead.
It uses the techniques you mentioned in your own answer, but on a more sophisticated level. It also allows you to use anti-aliasing (based on oversampling), but today it's not actually recommended to use any other anti-aliasing technique other than what the font-engine outputs (to take full advantage of font-hinting).
As you are using the latest source code you could also consider to use VPR to render the text (see example 'TextVPR'). It converts the outline of the text as vectors and use the vector drawing capabilities of Graphics32 (by default the engine 'VPR' is used, hence the name) to render it onto the screen. There's also a stripped down engine of AGG included, which itself is based on the FreeType1 engine, which might be slightly faster for fonts.
Speaking of performance: Keep in mind that every other approach than TextOut will obviously decrease the performance. So if you aim for high performance might better cook your own code (based on TextOut).
Otherwise the TextVPR approach leaves you with more freedom, especially when it comes to filling the text (with a gradient for example) or transforming the text (to a curve or such).
The best solution I could find requires three helper functions.
TransparentToOpaque changes all fully transparent pixels to opaque.
procedure TransparentToOpaque(bmp: TCustomBitmap32);
var
I: Integer;
D: PColor32Entry;
begin
D := PColor32Entry(#bmp.Bits[0]);
for I := 0 to bmp.Width * bmp.Height - 1 do begin
if D.A = 0 then
D.A := $FF;
Inc(D);
end;
bmp.Changed;
end;
FlipTransparency changes all fully transparent pixels to opaque and vice versa.
procedure FlipTransparency(bmp: TCustomBitmap32);
var
I: Integer;
D: PColor32Entry;
begin
D := PColor32Entry(#bmp.Bits[0]);
for I := 0 to bmp.Width * bmp.Height - 1 do begin
if D.A = 0 then
D.A := $FF
else if D.A = $FF then
D.A := 0;
Inc(D);
end;
bmp.Changed;
end;
MakeOpaque marks all pixels as opaque.
procedure MakeOpaque(bmp: TCustomBitmap32);
var
I: Integer;
D: PColor32Entry;
begin
D := PColor32Entry(#bmp.Bits[0]);
for I := 0 to bmp.Width * bmp.Height - 1 do begin
D.A := $FF;
Inc(D);
end;
bmp.Changed;
end;
Following tricks can then be applied.
After drawing text on the main image bmp1 which doesn't contain transparent pixels, code calls TransparentToOpaque to prevent problems with blending later on.
When drawing on a (semi)transparent bitmap bmp2, code creates yet another bitmap bmp3 and fills it with an opaque version of that (semi)transparent bitmap. This will ensure that font is aliased to correct colors in the TextOut call.
After the TextOut bmp3 contains opaque background and transparent text. FlipTransparency is then called to generate opaque text on a transparent background.
bmp3 is blended onto bmp2. This gives up opaque text on a (semi)transparent background.
bmp2 is blended onto bmp1.
Example code:
procedure TForm53.DrawBitmaps;
var
bmp1: TBitmap32;
bmp2: TBitmap32;
bmp3: TBitmap32;
begin
bmp1 := TBitmap32.Create;
bmp1.Width := 100;
bmp1.Height := 100;
bmp1.FillRect(0, 0, 100, 100, clWhite32);
bmp1.FillRect(0, 0, 80, 80, clTrGreen32);
bmp1.Font.Size := -16;
bmp1.Font.Color := clBlack;
bmp1.TextOut(2, 10, 'Green');
//Mark all fully transparent pixels (generated with TextOut) as opaque.
TransparentToOpaque(bmp1);
SaveBitmap32ToPNG(bmp1, 'c:\0\bmp1a.png');
bmp2 := TBitmap32.Create;
bmp2.Width := 80;
bmp2.Height := 80;
bmp2.FillRect(0, 0, 80, 80, clTrRed32);
//Create bitmap, large enough to contain drawn text (same size as original bitmap in this example).
bmp3 := TBitmap32.Create;
bmp3.Width := bmp2.Width;
bmp3.Height := bmp2.Height;
//Copy `bmp2` to `bmp3`.
bmp2.DrawMode := dmOpaque;
bmp2.DrawTo(bmp3, 0, 0);
//Mark all pixels as opaque (alpha = $FF)
MakeOpaque(bmp3);
//Draw text on `bmp3`. This will create proper aliasing.
bmp3.Font.Size := -16;
bmp3.Font.Color := clBlack;
bmp3.TextOut(2, 50, 'Red');
//Make all fully transparent pixels (TextOut) opaque and all fully opaque pixels
// (background coming from `bmp2`) transparent.
FlipTransparency(bmp3);
SaveBitmap32ToPNG(bmp3, 'c:\0\bmp3a.png');
//Blend `bmp3` on semi-transparent background (`bmp2`).
bmp3.DrawMode := dmBlend;
bmp3.DrawTo(bmp2, 0, 0);
SaveBitmap32ToPNG(bmp2, 'c:\0\bmp2a.png');
//Blend background + text onto main image.
bmp2.DrawMode := dmBlend;
bmp2.DrawTo(bmp1, 20, 20);
SaveBitmap32ToPNG(bmp1, 'c:\0\bmpcombineda.png');
bmp1.Free;
bmp2.Free;
bmp3.Free;
end;
Resulting images:
bmp1a:
bmp2a:
bmp3a:
bmpcombineda:
I have problems saving an ImgView32 layer as a TRANSPARENT PNG.
I use the code from this question to do the saving.
However, the image saves with a white background.
Here is how I initialize my ImgView32, create a layer on it, and then draw a line on it:
procedure TputLine.FormCreate(Sender: TObject);
var
P: TPoint;
W, H: Single;
imwidth: integer;
imheight: integer;
begin
imwidth := Iv1.Width;
imheight := Iv1.Height;
with iv1 do
begin
Selection := nil;
Layers.Clear;
Scale := 1;
Scaled := True;
Bitmap.DrawMode := dmTransparent;
Bitmap.SetSize(imwidth, imheight);
Bitmap.Canvas.Pen.Width := 4;
end;
BL := TBitmapLayer.Create(iv1.Layers);
try
BL.Bitmap.DrawMode := dmTransparent;
BL.Bitmap.SetSize(imwidth,imheight);
BL.Bitmap.Canvas.Pen.Width := penwidth;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
BL.Scaled := False;
except
BL.Free;
raise;
end;
end;
So iv1 is the name of my ImgView32.
Then I draw a line on it using this code:
var
bm32:TBitmapLayer;
...
begin
bm32:=(iv1.Layers[0] as TBitmapLayer).Bitmap;
bm32.canvas.pen.color:=clwhite;
bm32.canvas.brush.color:=clwhite;
bm32.canvas.rectangle(0,0,bm32.width-1, bm32.height-1);
bm32.canvas.Pen.Color:=WinColor(ColorPickerGTK1.SelectedColor);
bm32.canvas.brush.color:=clWhite;
bm32.Canvas.Pen.Width:=3;
bm32.Canvas.MoveTo(0,bm32.Height);
bm32.Canvas.LineTo(0+150,bm32.Height-250);
end;
If I use the clWhite32 for the above code when drawing the rectangle, then when saving the PNG, the background of the imgView turns black... So I do not understand the problem really.
I do the saving like this:
procedure TputLine.Button2Click(Sender: TObject);
var
myLay:TBitmapLayer;
begin
mylay := iv1.Layers.Items[0] as TBitmapLayer;
SavePNGTransparentX(mylay.Bitmap);
end;
and the actual saving code (from the link described above)
procedure TPutLine.SavePNGTransparentX(bm32:TBitmap32);
var
Y: Integer;
X: Integer;
Png: TPortableNetworkGraphic32;
function IsWhite(Color32: TColor32): Boolean;
begin
Result:= (TColor32Entry(Color32).B = 255) and
(TColor32Entry(Color32).G = 255) and
(TColor32Entry(Color32).R = 255);
end;
begin
bm32.ResetAlpha;
for Y := 0 to bm32.Height-1 do
for X := 0 to bm32.Width-1 do
begin
if IsWhite(bm32.Pixel[X, Y]) then
bm32.Pixel[X,Y]:=Color32(255,255,255,0);
end;
Png:= TPortableNetworkGraphic32.Create;
Png.Assign(bm32);
Png.SaveToFile('C:\ThisShouldBeTransparent.png');
Png.Free;
end;
I do not understand why it does not save the layer as transparent PNG.
How can I fix it? Any idea is welcome.
You can replicate my problem using the above code. It uses GR32_PNG and GR32_PortableNetworkGraphic. You only need to add a TImgView32 control to your form and add the code listed above.
The reason to the problem seems to be two-fold.
First, when you call Png.Assign(bm32); in unit GR32_PNG, it attempts to find out what the smallest format would be to store the image in. If the image has less than 256 distinct colors, it creates a paletted format, and depending on how many colors it finds, the bit depth can become 1, 2, 4 or 8. As far as my knowledge goes, only images with TrueColor and Alpha can be saved as variable transparency png images.
Secondly, you draw with only one color, which triggers the above problem. This is of course not your fault, IMO the above mentioned analysis should be possible to bypass.
The TPortableNetworkGraphic32 class has two properties, BitDepth and ColorType wich control the format of the png image, that would be useful, if they were settable! Attempting to set them in code as:
Png.BitDepth := 8;
Png.ColorType := ctTrueColorAlpha;
leads to exceptions
EPngError with message 'Bit depth may not be specified directly yet!
EPngError with message 'Color Type may not be specified directly yet!
From the wording we can assume some further development in the future.
The cure
To bypass the above described image analysis, you can change line 459 in GR32_PNG.pas.
procedure TPortableNetworkGraphic32.AssignPropertiesFromBitmap32()
var
...
begin
...
IsPalette := True; // <--- change to False
...
That will take care of the bit depth analysis and prevents palette creation if less than 256 colors.
After this hack you can use the SavePNGTransparentX() procedure to save a TBitmap32 to a .png file and preserving transparency.
Then, there's one change more that you may be interested in, regarding the SavePNGTransparentX() procedure. As you have seen, it requires the background of your drawing surface to be white, because it specifically sets the Alpha channel to zero for all white pixels. A TBitmapLayer is however initialized with all pixels (RGBA) as all zeros, so the color components of each pixel makes up to black color (which is not visible because the alpha channel is zero). Therefore you need to fill the drawing layer with white, which makes it opaque, which again covers up all lower layers (beneath the drawing layer).
To make a correction to this you can
remove the initialization of the drawing layer to all white
change the IsWhite function into an IsBlack function
change the assignment of the transparent pixels
Code would become
procedure TForm8.SavePNGTransparentX(bm32:TBitmap32);
var
Y: Integer;
X: Integer;
Png: TPortableNetworkGraphic32;
function IsBlack(Color32: TColor32): Boolean;
begin
Result:= (TColor32Entry(Color32).B = 0) and
(TColor32Entry(Color32).G = 0) and
(TColor32Entry(Color32).R = 0);
end;
function IsWhite(Color32: TColor32): Boolean;
begin
Result:= (TColor32Entry(Color32).B = 255) and
(TColor32Entry(Color32).G = 255) and
(TColor32Entry(Color32).R = 255);
end;
begin
bm32.ResetAlpha;
for Y := 0 to bm32.Height-1 do
for X := 0 to bm32.Width-1 do
begin
// if IsWhite(bm32.Pixel[X, Y]) then
// bm32.Pixel[X,Y]:=Color32(255,255,255, 0);
if IsBlack(bm32.Pixel[X, Y]) then
bm32.Pixel[X,Y]:=Color32( 0, 0, 0, 0);
end;
Png:= TPortableNetworkGraphic32.Create;
Png.Assign(bm32);
Png.SaveToFile('C:\tmp\imgs\ThisShouldBeTransparent3.png');
Png.Free;
end;
With this change you can see the layers beneath your drawing layer and the resulting file of your drawing layer will have all non-drawn pixels transparent.
There is however still one problem in general with the above procedure, and that is that partially transparent pixels loose their transparency, but that will remain for a future excercise.
Here's a few images, First the ImageView with a bitmap loaded on the bottom layer:
Then, I draw a blue cross on the BL layer (ref. your code) using basically the code in your Button1Click() but without the white rectangle.
Then I save the BL layer to a .png file and look at it with Windows Explorer "Preview":
Using the following code in Delphi 2007:
procedure TfrmTest.PaintBox1Paint(Sender: TObject);
const
Rect_Size = 10;
begin
PaintBox1.Canvas.Brush.Color := clYellow;
PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.width, PaintBox1.height));
PaintBox1.Canvas.Brush.Color := clRed;
DrawARect(PaintBox1.Canvas, 0, 0, Rect_Size, Rect_Size);
end;
procedure TfrmTest.DrawARect(ACanvas: TCanvas; iLeft, iTop, iWidth, iHeight: Integer);
var
rgnMain: HRGN;
begin
rgnMain := CreateRectRgn(iLeft, iTop, iLeft + iWidth, iTop + iHeight);
try
SelectClipRgn(ACanvas.handle, rgnMain);
ACanvas.FillRect(ACanvas.ClipRect);
SelectClipRgn(ACanvas.handle, 0);
finally
DeleteObject(rgnMain);
end;
end;
I get this:
(Yellow area shows boundaries of PaintBox1).
alt text http://www.freeimagehosting.net/uploads/62cf687d29.jpg
(Image shows a form with a yellow box [PaintBox1] in the center. However my red rectange [rgnMain] has been drawn at pos 0,0 on the form)
My expectation was that the red rectangle would be at the top left of the PaintBox1 canvas, not the form's canvas. Why is it not? Can regions only be used with controls that have a Windows handle?
Thanks
Device Contexts require a window handle. What VCL does for non-windowed controls is to offset the view port of the DC acquired for the TWinControl they are on, by using SetWindowOrgEx in TWinControl.PaintControls. The new view port is in logical units. So for 'TGraphicControl's, which does not descend from TWinControl, you can use GDI functions which work on logical coordinates. See the remarks section for SelectClipRgn, which says the coordinates should be specified in device units. You'd offset the region or the coordinates.
Problem in drawing a semi transparent PNG image on TBitmap object.
If the TBitmap's ,HandleType is set to bmDDB, then the canvas is drawn transparent.
But the problem is it doesn't work on all kinds of machines (for ex: Windows on apple computers).
When a TBitmap's HandleType property is set to bmDIB, canvas background is drawn white.
bmp.HandleType := bmDIB;
I tried setting Brush style to bsClear. But it draws the transparent pixels in black color.
How can I draw an image preserving its transparency and smooth curved edges.
Thanks
Pavan.
It is certainly possible to paint a bmDIB bitmap with transparent background to a canvas:
procedure TForm1.FormPaint(Sender: TObject);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32bit;
Bmp.HandleType := bmDIB;
Bmp.Width := 700;
Bmp.Height := 400;
Bmp.Transparent := TRUE;
Bmp.TransparentColor := clMaroon;
with Bmp.Canvas do begin
Brush.Color := clMaroon;
FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
Brush.Color := clBlue;
FillRect(Rect(42, 42, 200, 300));
end;
Canvas.Draw(12, 12, Bmp);
finally
Bmp.Free;
end;
end;
Note that the whole bitmap is filled first with the colour set as TransparentColor.
But for more control and speed you should look into a solution that is not as dependent on the GDI (which involves graphics card and driver capabilities), something like Graphics32.