Using: Delphi XE2, VCL 32-bit application, Windows 8
I'm trying to paint the background of my frame onto a panel (I'm using TJvPanel, because it exposes the OnPaint event) which is a child control of the frame.
After reading this post and adding a canvas as a field, I am still not successful.
After calling ShowAddReceiptPanel, it should draw the frame's (TfrmMyFrame) window contents with all the controls already on it (which include a grid and a pagecontrol) on the foreground panel, grayscaled, after being processed by the ProEffectImage method, but instead it shows an opaque white background. Am I missing something?
Here's my code:
type
TfrmMyFrame = class(TFrame)
pnlHdr: TPanel;
pnlAddNewBG: TJvPanel;
procedure pnlAddNewBGPaint(Sender: TObject);
private
{ Private declarations }
FBGImg: TProEffectImage;
Fcnvs: TCanvas;
procedure PaintWindow(DC: HDC); override;
procedure ShowAddReceiptPanel;
procedure HideAddReceiptPanel;
procedure ResizePanel_pnlAddNewBG;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
constructor TfrmMyFrame.Create(AOwner: TComponent);
begin
inherited;
FBGImg := TProEffectImage.Create(nil);
Fcnvs := TCanvas.Create;
end;
destructor TfrmMyFrame.Destroy;
begin
if Assigned(FBGImg) then
FBGImg.Free;
if Assigned(Fcnvs) then
Fcnvs.Free;
inherited;
end;
procedure TfrmMyFrame.ShowAddReceiptPanel;
begin
ResizePanel_pnlAddNewBG;
pnlAddNewBG.Visible := True;
end;
procedure TfrmMyFrame.PaintWindow(DC: HDC);
begin
inherited;
Fcnvs.Handle := DC;
end;
procedure TfrmMyFrame.pnlAddNewBGPaint(Sender: TObject);
var
l, t, w, h: Integer;
srct, drct: TRect;
begin
// Copy Frame canvas to BGImg bitmap
l := 0;
t := pnlHdr.Height;
w := ClientWidth;
h := ClientHeight - t;
srct := TRect.Create(l, t, w, h);
FBGImg.Width := w;
FBGImg.Height := h;
drct := TRect.Create(l, t, w, h);
FBGImg.Canvas.CopyMode := cmSrcCopy;
FBGImg.Canvas.CopyRect(drct, Fcnvs, srct);
// FBGImg.Picture.SaveToFile('c:\tmp\a.bmp');
FBGImg.Effect_AntiAlias;
FBGImg.Effect_GrayScale;
// Draw BGImg onto Option panel
TJvPanel(Sender).Canvas.CopyMode := cmSrcCopy;
TJvPanel(Sender).Canvas.Draw(0, 0, FBGImg.Picture.Graphic);
end;
procedure TfrmMyFrame.ResizePanel_pnlAddNewBG;
var
x1, y1, x2, y2: Integer;
bmp: TBitmap;
begin
x1 := 0;
y1 := pnlHdr.Height;
x2 := ClientWidth;
y2 := ClientHeight - y1;
pnlAddNewBG.SetBounds(x1, y1, x2, y2);
end;
The DC that you assign to your canvas handle is only valid during the PaintWindow call. You use it outside that function when it is not valid and hence the behaviour that you observe.
I think that you should be able to solve your problem by calling the PaintTo method. Create a bitmap of the right size and pass its canvas to PaintTo.
A TFrame does not have a canvas. You could create/add one, as TCustomControl does, but you do not have to. A canvas is just a handy wrapper around a Windows device context. The PaintWindow routine is called whenever the frame has to be (partially) redrawn. The parameter exhibits the DC, or you could obtain one with GetDC.
Then pseudo-code would be as follows:
procedure TfrmMyFrame.PaintWindow(DC: HDC);
begin
- Resize BG image and hide it (otherwise image itself will be copied too)
- Paint the frame's contents to the image with:
Self.PaintTo(FBGImg.Canvas.Handle, 0, 0)
- Process the special effects on FBGImg
- Paint the image onto DC with:
BitBlt(DC, 0, 0, ClientWidth, ClientHeight, FBGImage.Canvas.Handle, 0, 0, SRCCOPY);
end;
An easy way to get access to a Canvas on a TFrame is to add a TPaintBox on top of it with Align := alClient and using its Canvas property.
I expect this method to work with any version of Delphi, also in the future, and therefore use it instead of the PaintWindow method, which seems to be tricky.
Related
I'm very new to delphi programming:(
I'm trying to make a customized component with a transparent background layer and a top layer with circle shape. However, the below code works fine when added on to a form.
Exception the fact that is there is another component overlaps with or on top of the the customized component, it lies below and doesn't show.
I've tried below on a form
BadgeTest1.BringToFront;
BadgeTest1.ComponentIndex:=2;
IndexVal:= BadgeTest1.ComponentIndex;
However, still doens't work. Is there anyway for the customized component to show on top of the other components? only the circle shape part?
Also, I've been trying to place a caption in the center(horizontally and vertically) of the customized component, I've tried with TextOut() procedure. if there is a better option, could you please let me know?
below is my code for the customized component called BadgeTest.
Please, help,
Thank you so much!
type
TBadgeTest=class(TGraphicControl)
private
FCaption:TCaption;
FColor:TColor;
FLayers:TLayerCollection;
FHeight:Integer;
FWidth:Integer;
protected
procedure Paint; override;
procedure SetBkgLayer;
procedure SetSecondLayer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Caption:TCaption read FCaption write FCaption;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Sample', [TBadgeTest]);
end;
constructor TBadgeTest.Create(AOwner: TComponent);
var
ACanvas:TcxCanvas;
begin
inherited;
FHeight:=20;
Self.Height:=FHeight;
Constraints.MaxHeight:=20;
Constraints.MinHeight:=20;
FHeight:=20;
Self.Width:=FWidth;
Constraints.MaxWidth:=20;
Constraints.MinWidth:=20;
end;
destructor TBadgeTest.Destroy;
begin
inherited;
end;
procedure TBadgeTest.SetBkgLayer;
var
Bitmap:TBitmap32;
Layer: TCustomLayer;
begin
FLayers := TLayerCollection.Create(Self);
Layer := FLayers.Add(TBitmapLayer);
Layer.Index:=0;
Bitmap:= TBitmap32.Create;
Bitmap.DrawMode:=dmOpaque;
Bitmap.SetSize(Width, Height);
Bitmap.clear($00000000);
Bitmap.Canvas.Pen.Width:=0;
Bitmap.Canvas.Brush.Color:=$00107EFF;
Bitmap.Canvas.Brush.Style:=bsClear;
Bitmap.Canvas.Ellipse(Rect(0,0,20,20));
end;
procedure TBadgeTest.SetSecondLayer;
var
Bitmap:TBitmap32;
Layer: TCustomLayer;
begin
Layer := FLayers.Add(TBitmapLayer);
Layer.Index:=1;
Layer.LayerOptions:= LOB_VISIBLE;
Bitmap:=TBitmap32.Create;
Bitmap.DrawMode:=dmCustom;
Bitmap.SetSize(Width, Height);
Bitmap.clear($00000000);
Bitmap.Canvas.Pen.Width:=0;
Bitmap.Canvas.Brush.Color:=$00107EFF; //FF7E10
Bitmap.Canvas.Brush.Style:=bsSolid;
Bitmap.Canvas.Ellipse(Rect(0,0,Self.Width,Self.Height));
Layer.BringToFront;
Layer.BringToFront;
//Layer.Scaled:=true;
// Layer.Bitmap:=Bitmap;
end;
procedure TBadgeTest.Paint;
var
R:TRect;
borderColor : Integer;
fillCircle : Integer;
fontColor : Integer;
fontSize : Integer;
Bitmap:TBitmapImage;
const
_FF7E10_COLOR:Integer = $00107EFF; //#FF7E10
begin
inherited;
borderColor:=_FF7E10_COLOR;
fillCircle:=_FF7E10_COLOR;
Canvas.Pen.Create;
Canvas.Pen.Style:=psClear;
Canvas.Pen.Color:=borderColor;
Canvas.Pen.Width:=0;
SetBkgLayer;
SetSecondLayer;
Canvas.Brush.Create;
Canvas.Brush.Style:= bsClear;
Canvas.Brush.Color:=fillCircle;
Canvas.Ellipse(0,0,Self.Width,Self.Height);
Canvas.Font.Color:=clWhite;
Canvas.Font.Name:='Arial';
Canvas.Font.Size:=8;
Canvas.Font.Quality := fqNonAntialiased;
Canvas.Font.Style := [fsBold];
R.Create(0, 0, Self.Width, Self.Height);
//DrawText(Canvas.Handle, PChar(FCaption), -1, R, vaCenter);
// Canvas.DrawText(FCaption, R, taCenter, vaCenter, False, False);
Canvas.TextOut(5, 5, FCaption);
//SetTextAlign(Canvas.Handle, ta_center);
//DrawText(Canvas.Handle, PChar(FCaption),
//R.Create(1, 10, 2, 26);
// Self.Width := Canvas.TextWidth(FCaption) + 30;
end;
A TGraphicControl has no window handle, and is simply painted on its Parent DC.
You can't bring a TGraphicContol in front of a TWinContol descendant (such as TPanel, TButton, TEdit etc).
Either use a TWinControl descendant as shown in your previous question which could be brought in front of other child TWinControl, or redesign your UI in such a way that eliminates a situation where another TWinControl overlaps with or on top of your customized graphic control.
P.S: visual controls are referred to as "Controls", not "Components" (which are non-visual)
I've recently started converting an application to FireMonkey, and started with the simple controls. For some reason, their position is off, compared to dropped components on the form like say TPanel or TButton. From my tests, it appears the position is doubled.
My test project is simple: (in Delphi XE5)
create a new firemonkey HD application
drop a panel on the form at position (100,100) right click on it and "send to back"
paste the following code (adapt names where needed) for the custom component
code:
type
TTest = class(TPaintBox)
private
FBitmap: TBitmap;
public
Constructor Create(AOwner:TComponent); override;
Destructor Destroy; override;
procedure Paint; override;
end;
{ TTest }
constructor TTest.Create(AOwner: TComponent);
begin
inherited;
FBitmap := TBitmap.Create;
FBitmap.LoadFromFile('c:\test.png');
Width := FBitmap.Width;
Height := FBitmap.Height;
end;
destructor TTest.Destroy;
begin
FreeAndNil(FBitmap);
inherited;
end;
procedure TTest.Paint;
begin
Canvas.DrawBitmap(FBitmap,
TRectf.Create(0, 0, FBitmap.Width, FBitmap.Height),
AbsoluteRect,
1);
end;
paste the following code to dynamically create the above component
code:
procedure TForm2.FormCreate(Sender: TObject);
var t: TTest;
begin
t := TTest.Create(self);
t.Parent := self;
t.Position.X := 50;
t.Position.Y := 50;
end;
Build it for Win32.
On my end, the image appears in the upper left corner for the panel, which is at 100,100 but the control is clearly set to position itself at 50,50
Debugging shows correct values on positions and rects.
I can't figure out what is going on. Maybe somebody has some suggestions/explanations.
Thanks.
AbsoluteRect ist the rectangle of the Control relative to it's Form. If you want to paint something you have to use local coordinates, in this case LocalRect.
Canvas.DrawBitmap(FBitmap, TRectf.Create(0, 0, FBitmap.Width, FBitmap.Height), LocalRect, 1);
I asked this question before and deleted just because 1) it seemed like more work than I wanted to do, and 2) I went about asking my question poorly and it got closed. But, after doing more research, I've decided I will revisit this feature/question/how-to
I am attempting/wanting to create a blurred overlay as seen in the picture below. The obvious FMX.effect to use would be the 'Blur' effect. My question would be: how do I go about rendering the image the overlay would cover, or copying the image in an effective manner to blur for the overlay?
I have thought about using just two of the same bitmap, one for the background and one to blur but then I wouldn't be capture 'blur-ness' of controls or anything else on top of the original background. I also would think that if I were to have the overlay scroll into and out of view, then it would not look/appear as I would want it.
Considering the above, it all leads me to believe I need to dynamically capture the background to be blurred as the overlay scrolls/comes into view. How do I go about doing this and capturing current displayed screen content in Delphi XE6?
Not sure where to even start.
I do not own image *
After a little research on how to capture the parent control background I came up with the following code based on TMagnifierGlass class from FMX (Note that I made this code in XE5, you need to check XE6 compatibility):
TGlass = class(TControl)
private
FBlur: TBlurEffect;
FParentScreenshotBitmap: TBitmap;
function GetSoftness: Single;
procedure SetSoftness(Value: Single);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
property Softness: Single read GetSoftness write SetSoftness;
end;
{ TGlass }
constructor TGlass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// Create parent background
FParentScreenshotBitmap := TBitmap.Create(0, 0);
// Create blur
FBlur := TBlurEffect.Create(nil);
FBlur.Softness := 0.6;
end;
destructor TGlass.Destroy;
begin
FBlur.Free;
FParentScreenshotBitmap.Free;
inherited Destroy;
end;
function TGlass.GetSoftness: Single;
begin
Result := FBlur.Softness;
end;
procedure TGlass.SetSoftness(Value: Single);
begin
FBlur.Softness := Value;
end;
procedure TGlass.Paint;
var
ParentWidth: Single;
ParentHeight: Single;
procedure DefineParentSize;
begin
ParentWidth := 0;
ParentHeight := 0;
if Parent is TCustomForm then
begin
ParentWidth := (Parent as TCustomForm).ClientWidth;
ParentHeight := (Parent as TCustomForm).ClientHeight;
end;
if Parent is TControl then
begin
ParentWidth := (Parent as TControl).Width;
ParentHeight := (Parent as TControl).Height;
end;
end;
function IsBitmapSizeChanged(ABitmap: TBitmap; const ANewWidth, ANewHeight: Single): Boolean;
begin
Result := not SameValue(ANewWidth * ABitmap.BitmapScale, ABitmap.Width) or
not SameValue(ANewHeight * ABitmap.BitmapScale, ABitmap.Height);
end;
procedure MakeParentScreenshot;
var
Form: TCommonCustomForm;
Child: TFmxObject;
ParentControl: TControl;
begin
if FParentScreenshotBitmap.Canvas.BeginScene then
try
FDisablePaint := True;
if Parent is TCommonCustomForm then
begin
Form := Parent as TCommonCustomForm;
for Child in Form.Children do
if (Child is TControl) and (Child as TControl).Visible then
begin
ParentControl := Child as TControl;
ParentControl.PaintTo(FParentScreenshotBitmap.Canvas, ParentControl.ParentedRect);
end;
end
else
(Parent as TControl).PaintTo(FParentScreenshotBitmap.Canvas, RectF(0, 0, ParentWidth, ParentHeight));
finally
FDisablePaint := False;
FParentScreenshotBitmap.Canvas.EndScene;
end;
end;
begin
// Make screenshot of Parent control
DefineParentSize;
if IsBitmapSizeChanged(FParentScreenshotBitmap, ParentWidth, ParentHeight) then
FParentScreenshotBitmap.SetSize(Round(ParentWidth), Round(ParentHeight));
MakeParentScreenshot;
// Apply glass effect
Canvas.BeginScene;
try
FBlur.ProcessEffect(Canvas, FParentScreenshotBitmap, FBlur.Softness);
Canvas.DrawBitmap(FParentScreenshotBitmap, ParentedRect, LocalRect, 1, TRUE);
finally
Canvas.EndScene;
end;
end;
To use, just instantiate TGlass on top of any control, it should make the desired "glassy" effect that you are looking for
I created a TFrostGlass component which can also:
cache
have a background color tint
rounded corners
borders
You can see/download it here: https://github.com/Spelt/Frost-Glass
im working on delphi 7 and i want to how to copy/assign the content of a TpaintBox to a Tbitmap?
like this
public
{ Public declarations }
BitMap : TBitmap;
end;
i have a Tbitmap declared as public and i create it onFormCreate like this
procedure TForm1.FormCreate(Sender: TObject);
begin
BitMap := TBitMap.Create;
end;
Then i draw somthing on the bitmap like this
procedure TForm1.DrawOnPainBox;
begin
If BitMap.Width <> PaintBox1.Width then BitMap.Width := PaintBox1.Width;
If BitMap.Height <> PaintBox1.Height then BitMap.Height := PaintBox1.Height;
BitMap.Canvas.Rectangle(0,0,random(PaintBox1.Width ),random(PaintBox1.Height));
PaintBox1.Canvas.Draw(0,0,BitMap);
end;
with PaintBox1.Canvas.Draw(0,0,BitMap); we can display what is there in Bitmap to a paintbox but what is the reverse way?
how to assign/copy content of a paintbox to a bitmap?
`BitMap:=PaintBox1.Canvas.Brush.Bitmap;`
this compiles but if i do this and again call the procedure TForm1.DrawOnPainBox; i get access Violation and the debugger show the bitmap and PaintBox1.Canvas.Brush.Bitmap even though some lines are drawn on the paintBox
To assign the contents of a TPaintBox (let's call it PaintBox1) to a TBitmap (Bitmap, say), you can do
Bitmap.Width := PaintBox1.Width;
Bitmap.Height := PaintBox1.Height;
BitBlt(Bitmap.Canvas.Handle,
0,
0,
Bitmap.Width,
Bitmap.Height,
PaintBox1.Canvas.Handle,
0,
0,
SRCCOPY);
Notice: In newer versions of Delphi, you can use Bitmap.SetSize instead of Bitmap.Width and Bitmap.Height.
TBitmap.setsize has been introduced in Delphi 2006, you may be using an older version. Just replace
Bitmap.SetSize (X, Y)
by
Bitmap.Width := X
Bitmap.Height := Y
it's slower (but it matters only if you use it in a loop), but you will compile the code
if this happens too often, declare a new unit BitmapSize.pas:
unit BitmapSize;
interface
uses
graphics;
Type
TBitmapSize = class (TBitmap)
public
procedure Setsize (X, Y : integer);
end;
implementation
procedure TBitmapsize.Setsize(X, Y: integer);
begin
Width := X; // may need some more tests here (X > 0, Y > 0, ...)
Height := Y;
end;
end.
then replace in declaration and creation of your bitmap TBitmap with TBitmapSize.
..
Var
B : TBitmapSize;
..
B := TBitmapSize.Create;
Background
I/m building a custom FireMonkey GUI control. I want to render the control to a back buffer. The back buffer will be drawn on the control's canvas.
The back buffer is a Fmx.TBitmap object.
I am using a back buffer because the control rendering code is a little involved and does not need to be called each time the control is repainted. The back buffer will only be updated when some control properties change.
Problem
The BackBuffer.Canvas drawing operations have no visible effect. However clearing the bitmap, or setting the value of the bitmap pixels individually do work as expected.
For some reason the BackBuffer.Canvas object will not draw on the back buffer bitmap.
I think I've set the required Canvas.Fill properties correctly.
All the canvas properties I've checked appear to be correct. (Canvas width/height/etc)
I've extracted the relevant code in case that contains some clues.
TMyControl(TControl)
private
protected
BackBuffer : TBitmap;
procedure Paint; override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TMyControl.Create(AOwner: TComponent);
begin
inherited;
BackBuffer := TBitmap.Create(10, 10);
end;
procedure TFxSampleDisplay.Resize;
var
w, h : integer;
begin
inherited;
// Ensure BackBuffer is the same size as the control.
w := round(BoundsRect.Width);
h := round(BoundsRect.Height);
BackBuffer.SetSize(w,h);
end;
procedure TMyControl.Paint;
var
r : TRectF;
begin
inherited;
//******** This has visible results ********
BackBuffer.Clear($1100ff00); // Fill with semi-opaque green background
BackBuffer.Pixels[2,2] := $ffff0000; // Draw a red pixel
//******** This doesn't have visible results ********
r.Left := 0;
r.Top := 0;
r.Right := 50;
r.Bottom := 50;
BackBuffer.Canvas.Fill.Color := $ffff0000; // Set fill to RED.
BackBuffer.Canvas.Fill.Kind := TBrushKind.bkSolid;
BackBuffer.Canvas.FillRect(r, 10,10, AllCorners, 1);
//******** Draw the backbuffer on to the controls canvas ********
Canvas.DrawBitmap(BackBuffer, BoundsRect, BoundsRect, 1);
end;
Try surrounding your drawing with:
BackBuffer.Canvas.BeginScene;
..
..
BackBuffer.Canvas.EndScene;
BackBuffer.BitmapChanged;
P.S. I'm pretty new with FireMonkey style, so just try it out and write if it worked please!