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;
Related
I am new to Delphi creating runtime Tgrid and want to add some rows and columns. I googled but not getting any thing. i am at level zero. what i have tried i mentioned it below.This code is showing nothing on my form.
procedure TForm1.Button1Click(Sender: TObject);
var
Grid : TGrid;
begin
Grid := TGrid.Create(Form1);
Grid.Visible := True;
Grid.Margins.Left := 10;
Grid.Margins.Right := 10;
Grid.Margins.Top := 10;
Grid.Margins.Bottom := 10;
Grid.RowCount := 5;
end;
The grid control must have a parent control. Indeed, naturally, the system must know where (on the screen) to put your control!
You probably want the grid to have the form as its parent. If so, just add Grid.Parent := Form1; after the construction of the grid.
Of course, when you add this missing line of code and get to see the grid, you'll very soon notice that your Margins assignments have no effect. That's because by default you control the position of the control (no pun intended) manually using its Top, Left, Height, and Width properties.
But should you start experimenting with the Align property, you'll discover the effect of the margins, if you also set AlignWithMargins to True. For instance, if you set Align to alClient, the control will occupy all of its parent's client area, save the margins.
Can you give me the names of the functions needed for this purpose? I'm using Delphi XE 5. I want to get this effect:
Window: half transparent
Font: fully visible.
I will use "System" font (zero problems with AA)
What do I look on MSDN? What functions (name) do I need to use?
This is basically the same idea as in Marcus' answer, but with some enhancements. You might have to adjust this to your needs, but the principle is the following:
Create form1 with the following properties:
AlphaBlend := True;
AlphaBlendValue := 128;
BorderStyle := bsNone;
Create form2 with the controls as desired and the following properties:
Color := clFuchsia; // or whatever color is not used
TransparentColor := true;
TransparentColorValue := Color;
Declare a Boolean field in form1 named AllowMove.
In TForm1.FormShow call the following code:
begin
form2.BorderStyle := bsNone;
form2.SetBounds(0, 0, ClientWidth, ClientHeight);
form2.Show;
AllowMove := true;
end;
Declare a Boolean field in form1 named AllowMove and a message handler for WM_MOVE:
procedure WMMOVE(var Message: TMessage); message WM_MOVE;
procedure TForm1.WMMOVE(var Message: TMessage);
begin
inherited;
if AllowMove then begin
Form2.Left := Message.LParamLo;
Form2.Top := Message.LParamHi;
end;
Message.Result := 0;
end;
The only way that I know to get that kind of effect is to render the window contents to an in-memory bitmap, then apply the desired alpha values to the non-font pixels, and then use UpdateLayeredWindow() to display the bitmap on a window. You cannot achieve that affect with a TForm as it relies on SetLayeredWindowAttributes() instead.
Create a 32bit bitmap and draw the desired background on it with alpha values, using a separate array to keep track of the current pixel values in the spots you are going to draw text on, then draw the actual text and use the array to detect which pixels were changed so you can clear the alpha values from just those pixels. Then display the bitmap.
You can get something close by layering two forms over each other. Set the bottom form's color to blue, enable AlphaBlend, and set AlphaBlend to something like 100. That just provides the blue background.
On second form, set TransparentColor to clBtnFace, and put your label there. Set the label font's quality to fqAntialiased.
Set both form's BorderStyle to bsNone.
Lay the second form over the first form, and there you go.
This might be workable if you don't plan on letting the user move the forms, or you move them together.
I use Delphi7, PageControl with owner-draw. I can't get so plain and nice look of tabs, as I see on not-owner-drawn PageControls. What's bad:
when using owner-draw, I can't draw on "entire" tab header area, small 1-2px frame around tab header is painted by OS.
1) Delphi not owner-draw, look is OK too (XPMan used):
2) Delphi owner-draw, you see not entire tab header can be colored (XPMan used):
I draw current tab with blue and others with white, here. Only example.
Code:
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
c: TCanvas;
begin
c:= (Control as TPageControl).Canvas;
if Active then
c.Brush.Color:= clBlue
else
c.Brush.Color:= clWhite;
c.FillRect(Rect);
end;
2b) Delphi owner-draw in real app (XPMan used):
Why do i need to use owner-draw? Simple. To draw X button on tab headers, to paint upper-line with custom color, to paint icons from imagelists.
I'm looking for a way to paint ENTIRE rect of tab headers, not decreased rect which is given to PageControl owner-draw events. I tried to increase the rect given by owner-draw events, but this doesn't help, OS repaints this thin 1-2px frame around tab headers anyway.
The tabs of an owner drawn native "tab control" (TPageControl in VCL, although its ascendant is appropriately named TCustomTabControl - it is anyone's guess why the creative naming..), is expected to be painted by its parent control while processing WM_DRAWITEM messages, as documented here.
The VCL takes the burden from the parent by mutating the message to a CN_DRAWITEM message and sending it to the control itself. In this process the VCL has no further intervention. It just calls the OnDrawTab message handler if it is assigned by user code, passing appropriate parameters.
So, it's not the VCL that draws the borders around tabs, but the OS itself. Also, evidently, it doesn't do this during processing of WM_DRAWITEM messages but later in the painting process. You can verify this by putting an empty WM_DRAWITEM handler on the parent of a page control. Result is, whatever we paint in the event handler, it will later get borders by the OS.
What we might try is to try to prevent what the OS draws take effect, we have the device context (as Canvas.Handle) after all. Unfortunately this route also is a dead end because the VCL, after the event handler returns, restores the device context's state.
The only way, then, we have is to completely abandon handling an OnDrawTab event, and acting upon CN_DRAWITEM message. Below sample code use an interposer class, but you can subclass the control any way you like. Make sure that OwnerDrawn is set.
type
TPageControl = class(comctrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
TForm1 = class(TForm)
..
..
procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
Color: TColor;
Rect: TRect;
Rgn: HRGN;
begin
Color := 0;
// draw in different colors so we see where we've drawn
case Message.DrawItemStruct.itemID of
0: Color := $D0C0BF;
1: Color := $D0C0DF;
2: Color := $D0C0FF;
end;
SetDCBrushColor(Message.DrawItemStruct.hDC, Color);
// we don't want to get clipped in the passed rectangle
SelectClipRgn(Message.DrawItemStruct.hDC, 0);
// magic numbers corresponding to where the OS draw the borders
Rect := Message.DrawItemStruct.rcItem;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
Inc(Rect.Left, 2);
// Inc(Rect.Top, 1);
Dec(Rect.Right, 2);
Dec(Rect.Bottom, 3);
end else begin
Dec(Rect.Left, 2);
Dec(Rect.Top, 2);
Inc(Rect.Right, 2);
Inc(Rect.Bottom);
end;
FillRect(Message.DrawItemStruct.hDC, Rect,
GetStockObject(DC_BRUSH));
// just some indication for the active tab
SetROP2(Message.DrawItemStruct.hDC, R2_NOTXORPEN);
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
Ellipse(Message.DrawItemStruct.hDC, Rect.Left + 4, Rect.Top + 4,
Rect.Left + 12, Rect.Top + 12);
// we want to clip the DC so that the borders to be drawn are out of region
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
DeleteObject(Rgn);
Message.Result := 1;
inherited;
end;
Here is how the above looks here:
From what I can tell, you are simply looking to have themed painting of your application. In Delphi 7, all you need to do to achieve that is to add an application manifest that specifies the use of comctl32 version 6. The simple way to do so is to add a TXPManifest component to one of your forms or data modules, or just to reference the XPMan unit in your project.
Since you want the system to paint your page control, you must not do any owner drawing.
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! :-)