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.
Related
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.
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 can't adjust a TTrackBar thumb size to a higher size. See the image:
I got a small thumb on the left, and I can't make it bigger (but not the TrackBar itself).
Desired thumb size is shown on an image with a red area.
Maybe I can use WINAPI somehow?
C++ apps have bigger thumb often.
This is what I'm actually hopping for:
It would seem like this cannot be done with the standard trackbar control. Indeed, I cannot see any trackbar style or trackbar message related to this. There is only the TBM_SETTHUMBLENGTH, which you also can access from VCL's TTrackBar.ThumbLength, but this also affects the height of the background sunken rectangle.
A corollory is that I doubt the observation that "C++ apps have bigger thumb often".
Of course, you can always make your own trackbar-like control.
Or do you only want to shrink the sunken rectangle? Then just set ShowSelRange to False in the Object Inspector. But if themes are on, you still cannot make the thumb bigger than about 24.
If you are on an old version of Delphi with no TrackBar.ShowSelRange, you need to remove the window style TBS_ENABLESELRANGE manually. You can do this at any time using SetWindowLong, or you can do it in CreateParams of a subclassed trackbar control. The simplest way might be to use an 'interposer class':
type
TTrackBar = class(ComCtrls.TTrackBar)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
...
implementation
{ TTrackBar }
procedure TTrackBar.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style and not TBS_ENABLESELRANGE;
end;
To get the appearance in the Notepad++ screenshot, you should also set TickMarks to tmBoth and TickStyle to tsNone.
This doesn't answer your question, though, which was about making the thumb larger. This will make the sunken rectangle smaller... From your screenshots, however, I would guess this is what you want.
Trackbar is one of the native controls that support custom draw. Basically, when themes are enabled, you can control various aspects of drawing the control, or you can tell the OS that you're overtaking drawing parts yourself. See more about custom draw here.
We don't have to overtake any drawing to play with the sizes of some parts a little bit. It is the VCL that draws the channel (the recessed tracking background), and the ticks. For ticks, there are already properties we can use. For the channel, we can deflate the rectangle a bit, and the VCL will take over from there. The thumb is drawn by the default window procedure, but it doesn't matter, the OS will draw the thumb to the modified rectangle.
The below example (for a horizontal trackbar) intercepts WM_NOTIFY notification sent to the form to carry out these modifications. This will only work if the trackbar is placed directly on the form. If this is not the case, you can derive a new control that descends from TTrackBar to handle CN_NOTIFY, or subclass the control, or its parent for WM_NOTIFY. All that matters is to handle the notification before the actual drawing is performed.
This is how the example looks:
type
TForm1 = class(TForm)
Button1: TButton;
TrackBar1: TTrackBar;
procedure FormCreate(Sender: TObject);
protected
procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
end;
...
uses
themes, commctrl, xpman;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
if ThemeServices.ThemesEnabled and
(TrackBar1.Orientation = trHorizontal) then begin
TrackBar1.TickMarks := tmBoth;
TrackBar1.TickStyle := tsNone;
TrackBar1.ThumbLength := 38;
end;
end;
procedure TForm1.WMNotify(var Msg: TWMNotify);
begin
if ThemeServices.ThemesEnabled and
(TrackBar1.Orientation = trHorizontal) then begin
if (Msg.IDCtrl = Longint(TrackBar1.Handle)) and
(Msg.NMHdr.code = NM_CUSTOMDRAW) and
(PNMCustomDraw(Msg.NMHdr).dwDrawStage = CDDS_ITEMPREPAINT) then begin
case PNMCustomDraw(Msg.NMHdr).dwItemSpec of
TBCD_THUMB: InflateRect(PNMCustomDraw(Msg.NMHdr).rc, -4, 0);
TBCD_CHANNEL:
with PNMCustomDraw(Msg.NMHdr).rc do begin
Top := Bottom div 2 + 2;
Bottom := Top + 5;
Inc(Left, 4);
Dec(Right, 4);
end;
end;
end;
end;
inherited;
end;
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! :-)