I want to try to create a firemonkey visual component and I have seen online that TControl gives the basic needs. This is what I have done so far:
TMyTest = class(TControl)
strict private
//code...
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
//code...
end;
I have looked at the source code of a FMX component called PlotGrid and I have copied what it does. My class descends from TControl (like PlotGrid) and it overrides Paint (like PlotGrid). Look at the code:
constructor TMyTest.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
SetAcceptsControls(False);
end;
destructor TMyTest.Destroy;
begin
inherited;
end;
procedure TMyTest.Paint;
var
i: integer;
a, b: TPointF;
begin
Canvas.Fill.Color := TAlphaColorRec.White;
Canvas.Stroke.Color := TAlphaColorRec.Black;
Canvas.Stroke.Thickness := 2;
a.X := 0; a.Y := Height/2;
b.X := Width; b.Y := Height/2;
Canvas.DrawLine(a, b, 1);
end;
Given this code, I expect to have something like this (I have edited with paint the image, it's not the real one)
The problem is that I get this
The component is fine because I see all the methods and properties and they work. The component is functional BUT I cannot see it in the designer! If I run the FMX application I cannot see the colors:
Any idea?
I have set the Opacity := 1; at the beginning of the Paint event but still nothing.
Your control is painting on shared canvas. By the time it reaches your control's Paint method value of Canvas.Stroke.Kind is TBrushKind.None so if you don't assign some other value to it, it will not actually paint anything.
You have to add
Canvas.Stroke.Kind := TBrushKind.Solid;
But, that will only paint horizontal line (you forgot to create points and make DrawLine call for vertical one) and it will not fill the background with white color.
The simplest way to do so is with
Canvas.ClearRect(ClipRect, TAlphaColorRec.White);
In general common canvas values can (and will) be changed by other controls. Better way to deal with those is to mimic code from TShape providing your own TFill and TStroke fields and assigning those to canvas before painting. That way you can be sure that you will not miss setting some particular Stroke or Fill value that can be changed outside your control.
Related
I have a form with about 168 Timage objects containing Icons that are user selectable.
I wish to make each Icon move Down and Right by 3 pixels when the mouse is over the Timage object. I want it to return to its original position when the mouse leaves the Timage. This will add a pleasing effect to the user interface.
I know I can do this in the OnMouseEnter and OnMouseLeave events and it works well - however I cannot help but think that there must be a more elegant / efficient method to produce this effect for all 168 Timage objects, rather than creating 168 OnMouseEnter procedures and 168 OnMouseLeave procedures.
Any help much appreciated ...
It is enough to create a single OnMouseEnter event handler procedure and assign it to every component (similar for OnMouseLeave).
If these components were created in design-time (hard to imagine), then you can select all 168 images in the Form Designer, and then go to the Object Inspector and assign the events in a single go, as Remy Lebeau wrote in comments. Alternative way - use existing list of components (assuming that owner is form and there is no other TImages on the form):
for i := 0 to Components.Count - 1 do
if Components[i] is TImage then //perhaps more conditions to separate needed images
TImage(Components[i]).OnMouseEnter := EnterHandler;
If components were created in run-time and they are stored in array or list, handler assigning is simpler:
for i := 0 to Images.Length - 1 do
Images[i].OnMouseEnter := EnterHandler;
Then you can work with each component using the event's Sender argument:
procedure TMyForm.EnterHandler(Sender: TObject);
begin
TImage(Sender).Left := TImage(Sender).Left + 3;
TImage(Sender).Top := TImage(Sender).Top + 3;
end;
procedure TMyForm.LeaveHandler(Sender: TObject);
begin
TImage(Sender).Left := TImage(Sender).Left - 3;
TImage(Sender).Top := TImage(Sender).Top - 3;
end;
The cleanest solution here would be to create a custom component and to sanitize your design away from such a heavy and flat design-time layout. These naturally become difficult to maintain and to modify.
That said, if you want a quick hack to save yourself a lot of typing and clicking, you can use an interposer class to inject this mouse behaviour.
In the interface section of your Form's unit, add the following class above the Form's class declaration:
type
TImage = class(Vcl.ExtCtrls.TImage)
private
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
end;
TForm1 = class(TForm)
{ ... rest of your form as normal }
end;
And then, in the implementation section, add this:
procedure TImage.CMMouseEnter(var Message: TMessage);
begin
inherited;
Top := Top + 3;
Left := Left + 3;
end;
procedure TImage.CMMouseLeave(var Message: TMessage);
begin
inherited;
Top := Top - 3;
Left := Left - 3;
end;
Defining an interposer like this effectively causes your modified TImage class to replace all of the existing TImage components that are placed on the Form at design-time.
Note that this example is only for VCL on Windows. For a cross-platform solution using FMX, all UI controls have virtual DoMouseEnter() and DoMouseLeave() methods that you can override instead, eg:
type
TImage = class(FMX.Objects.TImage)
protected
procedure DoMouseEnter; override;
procedure DoMouseLeave; override;
end;
...
procedure TImage.DoMouseEnter;
begin
inherited;
Top := Top + 3;
Left := Left + 3;
end;
procedure TImage.DoMouseLeave;
begin
inherited;
Top := Top - 3;
Left := Left - 3;
end;
When you drag column headings to reorder them in Windows Explorer (or drag tabs in Chrome) you get a nice animation where the other header buttons shift around to make space.
I'm trying to replicate that in a header control I'm writing. The header buttons are not separate controls, so I have one control on which I do hit tests to determine which button is being clicked. Apart from a few strategies that will introduce copious amounts of flicker, I'm not really certain how to go about doing those animations.
Try to use your own paint buffer (if DoubleBuffered is not good enough):
Create the buffer (TCanvas or HDC)
Paint your control to this buffer (OnAnimationTimer and/or OnChange)
TMyControl.Paint: copy buffer to target canvas
[you can use this buffer not only for animation]
be careful with count of GDI objects
something like this:
type
TMyControl = class(TWinControl)
private
FAnimationBuffer: TBitmap;
FTimer: Cardinal;
procedure OnTimer(var Message: TMessage); message WM_TIMER;
protected
procedure Paint; override;
procedure Animate(columnA, columnB: Integer; frames: Byte);
end;
procedure TMyControl.OnTimer(var Message: TMessage);
begin
//todo : paint control state to FAnimationBuffer
if Visible then
Invalidate;
end;
procedure TMyControl.Paint;
begin
Canvas.Draw(0,0,FAnimationBuffer);
end;
procedure TMyControl.Animate;
begin
FTimer := SetTimer(Handle, 1, 100, nil);
end;
I am trying to simple thing. But i couldn' t :(
I have an TImage, which name is overview.
I want to draw a rectangle which is on the overview but independent from overview. So i added a TImage front of the overview and drawed a rectangle. Rectangle works but i just can see the TImage or overview. I tried to giving a transparency to rectImg but rectImg completely disappear.
with rectImg.Canvas do
begin
Pen.Color:= clRed;
Rectangle(0, 0, rectImg.Width, rectImg.Height);
end;
I draw on a paint, what i want to make.
That rect can be resizable indepented from img.
Thanks in advice.
If I understand your question correctly, you effectively want to visually frame the image without drawing the frame on the original graphic itself, i.e. rectImg.Picture should not return a framed graphic. Two ways immediately come to mind:
a) Dump TImage and use TPaintBox, manually maintaining the core graphic and doing any stretching or whatever via method calls rather than property settings on the component.
b) Extend TImage to have an OnPaint event that gets raised after TImage has done its standard painting.
With respect to (b), you can do it either as an interposer class or a custom component. As an interposer class you could do this:
1) Re-declare TImage immediately above your form class:
type
TPaintEvent = procedure (Sender: TObject; Canvas: TCanvas) of object;
TImage = class(Vcl.ExtCtrls.TImage) //use class(ExtCtrls.TImage) if pre-XE2
strict private
FOnPaint: TPaintEvent;
protected
procedure Paint; override;
published
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
end;
TMyForm = class(TForm)
//...
2) Implement the Paint override as so (slightly fiddly as TImage redefines the Canvas property of the base class):
type
TGraphicControlAccess = class(TGraphicControl);
procedure TImage.Paint;
begin
inherited;
if Assigned(FOnPaint) then
FOnPaint(Self, TGraphicControlAccess(Self).Canvas);
end;
3) Declare a suitable event handler in the form class:
procedure rectImgPaint(Sender: TObject; Canvas: TCanvas);
4) Implement the handler like so - note you need to set Brush.Style to bsClear to not create a filled rectangle:
procedure TMyForm.rectImgPaint(Sender: TObject; Canvas: TCanvas);
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clRed;
Canvas.Rectangle(0, 0, rectImg.Width, rectImg.Height);
end;
5) Assign the event handler in the form's OnCreate event:
procedure TMyForm.ImagePaint.FormCreate(Sender: TObject);
begin
rectImg.OnPaint := rectImgPaint;
end;
I leave converting the interposer class to a custom component as an exercise for the reader...
Postscript
Two other thoughts now I think of them:
Oddly enough, FMX is actually nicer here because its TImage provides a OnPaint event as standard.
If it is literally just a frame you want, a codeless alternative would be to overlay the TImage with a TShape, setting the shape's Brush.Style property to bsClear as we did in the coding solution. In that situation, set the shape's Enabled property to False if you have any OnClick or OnMouseXXX handlers assigned to the image.
I have component (descendat of TPanel) where I implemented Transparency and BrushStyle (using TImage) properties.
All it's ok when I have one component of this type on the form. Bun when I pun on the form more components of this type only first visible component is painted. When form is moved and first component is under other window or outside desktop next component is painted.
unit TransparentPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, stdctrls;
type
TTransparentPanel = class(TPanel)
private
FTransparent: Boolean;
FBrushStyle: TBrushStyle;
FImage: TImage;
procedure SetTransparent(const Value: Boolean);
procedure SetBrushStyle(const Value: TBrushStyle);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Transparent: Boolean read FTransparent write SetTransparent default
True;
property BrushStyle: TBrushStyle read FBrushStyle write SetBrushStyle default
bsBDiagonal;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('TransparentPanel', [TTransparentPanel]);
end;
constructor TTransparentPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTransparent := True;
FBrushStyle := bsBDiagonal;
FImage := TImage.Create(Self);
FImage.Align := alClient;
FImage.Parent := Self;
FImage.Transparent := FTransparent;
end;
procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if ((not (csDesigning in ComponentState)) and FTransparent) then
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
destructor TTransparentPanel.Destroy;
begin
if Assigned(FImage) then
FreeAndNil(FImage);
inherited Destroy;
end;
procedure TTransparentPanel.Paint;
var
XBitMap,
BitmapBrush: TBitmap;
XOldDC: HDC;
XRect: TRect;
ParentCanvas: TCanvas;
begin
{This panel will be transparent only in Run Time}
if (csDesigning in ComponentState) or (not FTransparent) or (FBrushStyle in [bsClear, bsSolid]) then
inherited Paint
else
begin
XRect := ClientRect;
XOldDC := Canvas.Handle;
XBitMap := TBitmap.Create;
BitmapBrush := TBitmap.Create;
try
XBitMap.Height := Height;
XBitMap.Width := Width;
Canvas.Handle := XBitMap.Canvas.Handle;
inherited Paint;
RedrawWindow(Parent.Handle, #XRect, 0,
RDW_ERASE or RDW_INVALIDATE or
RDW_NOCHILDREN or RDW_UPDATENOW);
BitmapBrush.Width := FImage.Width;
BitmapBrush.Height := FImage.Height;
BitmapBrush.Canvas.Brush.Color := clBlack;
BitmapBrush.Canvas.Brush.Style := FBrushStyle;
SetBkColor(BitmapBrush.Canvas.Handle, clWhite);
BitmapBrush.Canvas.FillRect(BitmapBrush.Canvas.ClipRect);
FImage.Canvas.Draw(0, 0, BitmapBrush);
finally
Canvas.Handle := XOldDC;
Canvas.BrushCopy(XRect, XBitMap, XRect, Color);
XBitMap.Free;
BitmapBrush.Free;
end;
end;
end;
procedure TTransparentPanel.SetBrushStyle(const Value: TBrushStyle);
begin
if (FBrushStyle <> Value) then
begin
FBrushStyle := Value;
Invalidate;
end
end;
procedure TTransparentPanel.SetTransparent(const Value: Boolean);
begin
if (FTransparent <> Value) then
begin
FTransparent := Value;
FImage.Transparent := Value;
Invalidate;
end;
end;
end.
What is wrong?
OK, a few tips:
Only one component is drawn, because during painting the client area of the control is invalidated again, so you create an infinite stream of WM_PAINT messages, and the second component never gets drawn. Until the first one is made invisible, as you describe. You can see this from the CPU load, having one of your components on a form uses 100% of one core on my system (Delphi 2007, component created at runtime).
You should try to remove the bitmap you draw into, and make use of the DoubleBuffered property instead.
What is FImage actually used for?
If you modify the create parameters depending on the value of the Transparent property, then you need to recreate the window handle when the property changes.
Maybe you can get rid of the component completely, and use a TPaintBox instead? It is transparent as long as you don't paint the background yourself. But I can't tell from your code what you actually want to achieve, so it's hard to say.
I think you want a control that can contain other controls — like TPanel can do — and a control that can display the contents of the window underneath it — like TImage can do when its Transparent property is set. It appears you are under the mistaken impression that if you put one control on top of another, you'll get the behavior of both combined. That's what's wrong.
First thing you should do is get rid of the TImage control. That's just making things more complicated than they need to be. When you need to draw a brush pattern on the panel, draw it directly onto the panel.
Next, realize that the ws_ex_Transparent window style controls whether siblings of the window are painted first. That says nothing about whether the parent of the window gets repainted. If the parent of your panel has the ws_ClipChildren style set, then it will not paint itself underneath where your panel supposedly is. It looks like it would help you if the parent of your panel control had the ws_ex_Composited style set, but as a component writer, you don't get control over your controls' parents.
TImage is able to appear transparent because it is not a windowed control. It has no window handle, so the OS rules about painting and clipping don't apply to it. From Windows' point of view, TImage doesn't exist at all. What we in the Delphi world perceive as the TImage painting itself is really the parent window deferring to a separate subroutine to paint a certain region of the parent window. Because of that, the TImage painting code can simply not paint over some of the parent's area.
If I were doing this, I'd ask myself whether the control with the brush pattern really needed to be a container control. Could I instead just use an ordinary TImage with a repeating brush pattern drawn on it? Other controls can still go on top of it, but they won't be considered children of the pattern control.
Try to look at the Graphics32 library : it's very good at drawing things and works great with Bitmaps and Transparency
If you want the panel to be transparent, all you need to do is override Paint and do nothing (or paint a transparent image, for example), and also catch the WM_ERASEBKGND message and do nothing here as well. This ensures the panel doesn't paint itself at all.
Make sure also to exclude the csOpaque flag from ControlStyle, so the parent knows it should paint itself underneath the panel.
The stuff you have in Paint is absolutely horrible, by the way (I mean the RedrawWindow thing). Get rid of it. And WS_EX_TRANSPARENT is meant for toplevel windows only, not for controls.
I'm trying to create with Delphi a component inherited from TLabel, with some custom graphics added to it on TLabel.Paint. I want the graphics to be on left side of text, so I overrode GetClientRect:
function TMyComponent.GetClientRect: TRect;
begin
result := inherited GetClientRect;
result.Left := 20;
end;
This solution has major problem I'd like to solve: It's not possible to click on the "graphics area" of the control, only label area. If the caption is empty string, it's not possible to select the component in designer by clicking it at all. Any ideas?
First excuse-me for my bad English.
I think it is not a good idea change the ClientRect of the component. This property is used for many internal methods and procedures so you can accidentally change the functionality/operation of that component.
I think that you can change the point to write the text (20 pixels in the DoDrawText procedure -for example-) and the component can respond on events in the graphic area.
procedure TGrlabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
Rect.Left := 20;
inherited;
end;
procedure TGrlabel.Paint;
begin
inherited;
Canvas.Brush.Color := clRed;
Canvas.Pen.Color := clRed;
Canvas.pen.Width := 3;
Canvas.MoveTo(5,5);
Canvas.LineTo(15,8);
end;
What methods/functionality are you getting from TLabel that you need this component to do?
Would you perhaps be better making a descendent of (say, TImage) and draw your text as part of it's paint method?
If it's really got to be a TLabel descendant (with all that this entails) then I think you'll be stuck with this design-time issue, as doesn't TLabel have this problem anyway when the caption is empty?
I'll be interested in the other answers you get! :-)