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! :-)
Related
I have an application which always starts initially maximized. This consists of putting Self.WindowState := wsMaximized; in the OnCreate of the main form.
Just before that, I'm assigning what should be the default dimensions of the main form, if the user were to change the window state to wsNormal.
So, in short, the main form's OnCreate handler looks something like:
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Width:= 1300;
Height:= 800;
WindowState:= wsMaximized;
end;
Theoretically, I could assign these dimensions in design-time, and that does what I need. However, due to the size of my screen, and thus the IDE, the whole form is not visible at one glance without scrolling. In design, I keep the form size small, so I can see everything. But in runtime, I need to assign these default dimensions, and then maximize it by default. When the user changes the window state out of maximized, I expect it to go to those dimensions I dynamically assigned.
The issue is that it seems to lose those dimensions after maximizing the form, and it reverts back to whatever values were in design-time. If I comment out the line WindowState:= wsMaximized; then it shows the form in the desired default dimensions. However, maximizing it seems to overwrite and ignore these values I had just assigned before it.
How can I create and show my main form maximized by default, while at the same time dynamically assigning the default size, without my assigned values getting lost?
(Confirmed with 10.3.3.)
The exact origin of this problem I cannot pinpoint, but a reasonable cause would be that during the constructor the form component is being read and that previous sizes seem to be explicitly backed up:
procedure TControl.SetWidth(Value: Integer);
begin
SetBounds(FLeft, FTop, Value, FHeight);
Include(FScalingFlags, sfWidth);
if csReading in ComponentState then
FExplicitWidth := FWidth;
end;
A possible solution is to set the desired sizes in the OnCreate event, like you are doing now, but postpone setting the desired WindowsState until the OnShow event.
procedure TForm1.FormCreate(Sender: TObject);
begin
Width := 1300;
Height := 800;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
WindowState := wsMaximized;
end;
Of course, you probably should prevent consecutive calls by using a one-off mechanism.
Please take a look at wsMaximized forms do not appear maximized too.
Apparently, the VCL does not store the explicit intermediate size (in some Delphi versions anyway) but seems to merge the change with that of the maximization when the form is actually shown.
Like Sertac Akyuz quite correctly suggested, you can use SetWindowPlacement to bypass this VCL interference:
procedure TForm1.FormCreate(Sender: TObject);
var
WindowPlacement: TWindowPlacement;
begin
GetWindowPlacement(Handle, WindowPlacement);
WindowPlacement.rcNormalPosition := Bounds(Left, Top, 1300, 800);
WindowPlacement.showCmd := SW_SHOWMAXIMIZED;
SetWindowPlacement(Handle, WindowPlacement);
end;
You must set form size on FormActivate:
procedure TfrmMain.FormActivate(Sender: TObject);
begin
if Tag = 0 then
begin
// Top := 100;
// Left := 100;
Width:= 1300;
Height:= 800;
WindowState:= wsMaximized;
Tag := 1;
end;
end;
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;
Following code creates knob with labels shifted to the right:
procedure TForm1.FormShow(Sender: TObject);
begin
_chart := TChart.Create(Self);
_chart.Parent := Self;
_chart.Align := alClient;
_knob := TKnobGauge.Create(Self);
_knob.ParentChart := _chart;
_knob.RotateLabels := False;
_knob.RotationAngle := 180;
end;
The same code as DFM produces the right knob.
What could be wrong?
TeeChart Pro v2015.16.150901 32bit VCL
Delphi 10
There is a bug in TChart. When I set
_chart.Title.Text.Text := 'Some title';
labels are on their places.
When I do
_chart.Title.Text.Text := '';
or
_chart.Title.Visible := False;
they are shifted.
The reason why the same code in DFM produced the right knob is that the visual designer extends my minimal chart declaration by adding several properties automatically. Among these properties was a chart title too. It is automatically filled by "TChart" text.
Sounds as exactly what is described in the ticket #1547, initially reported here.
Please, give a try at the workaround described in the ticket:
I can only workaround by having a small title with only a blank in it.
I have a TDBRadioGroup that I've added to my form.
I'd really like to have the caption to the left of it instead of on top (the form's a little busy and tall, and I'm trying to squeeze it in).
I can add my own label to the left of the Radio Group. But the control insists on reserving space of a Caption that does not exists. Is there a way I can turn it off completely?
The best we've come up with so far is sticking it on a TPanel and then hiding the top couple lines off-panel.
A TGroupBox (and it's descendant TDBGroupBox) are basically wrappers around the Windows GroupBox. The control is designed to sport a user-defined label across the upper-left corner, and doesn't have any style setting to remove it.
So, short of creating your own control to host a series of TRadioButton controls yourself and display them, there's no built-in way to disable the space reserved for the caption. You can suppress the text, of course, by setting the Caption := '', but the padding for the text descenders is not removed simply because the caption isn't displayed.
You can override the paint procedure for TRadioGroup so that the frame is drawn closer to the top of your item list. You could create a new component of type TNoCaptionRadioGroup. You might still have to use the panel trick that you have tried, but by lowering the top of the frame you can grab the space consumed by the non-existent caption. Something like this:
tNoCaptionRadioBox = class(TRadioGroup)
protected
procedure paint; override;
end;
procedure tNoCaptionRadioBox.paint;
var
H: Integer;
R: TRect;
begin
with Canvas do
begin
Font := Self.Font;
H := TextHeight('0');
R := Rect(0, H, Width, Height);
if Ctl3D then
begin
Inc(R.Left);
Inc(R.Top);
Brush.Color := clBtnHighlight;
FrameRect(R);
OffsetRect(R, -1, -1);
Brush.Color := clBtnShadow;
end else
Brush.Color := clWindowFrame;
FrameRect(R);
end;
end;
This is taken from the code for painting a TCustomGroupBox. I have removed the code for drawing the caption and have changed the top of the frame to the full height of the Font. Your actual captioned radio buttons will still be drawn where Windows wants them to be and with the default spacing.
Remember to register the new component by running the package installation tool.
procedure Register;
begin
RegisterComponents('myComponents', [tNoCaptionRadioBox]);
end;
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.