Position of label caption inside ProgressBar - delphi

I want to put a label inside progress bar. And this label caption is dynamic.
How can I get the label position ALWAYS on center inside the ProgressBar?
What I've tried ;
Label1.Parent := progressBar1;
Label1Top := progressBar1.Height div 2;
Label1.Left := progressBar1.Width div 2
It shows ugly, and not in center like I want.
If I set Label1.Left := progresBar1.Width div 2 - xxx it will be on center only for certain caption. I want to have any caption be placed on center.
Edited
Answer from #KenWhite is working good.
Solution from #DavidHeffernan just great.

Set the label's AutoSize property to False. Change the Alignment property to taCenter and Layout to tlCenter. Size the label to the progressbar's ClientWidth and ClientHeight, and set its Left to 0.
Label1.Parent := progressBar1;
Label1.AutoSize := False;
Label1.Transparent := True;
Label1.Top := 0;
Label1.Left := 0;
Label1.Width := progressBar1.ClientWidth;
Label1.Height := progressBar1.ClientHeight;
Label1.Alignment := taCenter;
Label1.Layout := tlCenter;
Here's an example of the appearance:

You might decide to derive a progress bar control that paints the text itself rather than relying on a separate label. Some sample code to demonstrate:
type
TProgressBarWithText = class(TProgressBar)
private
FProgressText: string;
protected
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
published
property ProgressText: string read FProgressText write FProgressText;
end;
procedure TProgressBarWithText.WMPaint(var Message: TWMPaint);
var
DC: HDC;
prevfont: HGDIOBJ;
prevbkmode: Integer;
R: TRect;
begin
inherited;
if ProgressText <> '' then
begin
R := ClientRect;
DC := GetWindowDC(Handle);
prevbkmode := SetBkMode(DC, TRANSPARENT);
prevfont := SelectObject(DC, Font.Handle);
DrawText(DC, PChar(ProgressText), Length(ProgressText),
R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
SelectObject(DC, prevfont);
SetBkMode(DC, prevbkmode);
ReleaseDC(Handle, DC);
end;
end;
The advantage of this approach is that your progress bar and text display are self-contained. There's no need for two separate controls that you have to coordinate.

Related

I want to draw 2 rectangles that superimpose on one another with Windows.FillRect

I want to draw 2 rectangles that superimpose on one another. One of which I want it a smaller size(A) than the other one (B) so that I can view the one at the back(B).
procedure DrawRectangle(drawDC:HDC;cellBrush:TBrush);
var
gridCellRect, gridCellRect1 :Trect ;
begin
gridCellRect.Top := 75;
gridCellRect.Bottom := 150;
gridCellRect.Left := 192;
gridCellRect.right := 200;
SetBkMode(drawDC, OPAQUE);
cellBrush.color := claqua;
Windows.FillRect(DrawDC, gridCellRect, cellBrush.Handle);
gridCellRect1 := gridCellRect;
// I tried to modify the top position to make it visible
gridCellRect1.Top := gridCellRect -5;
cellBrush.color := clBlack;
Windows.FillRect(DrawDC, gridCellRect, cellBrush.Handle);
end;
You've got your colors reversed (you're drawing in the wrong order), your gridCellRect.Left and gridCellRect.Right are far too narrow (8 pixels), and you don't need the call to SetBkMode at all.
In addition, you've got an error in gridCellRect - 5 (which won't even compile), and you never try to draw to the rectangle defined in gridCellRect1 even if it did. (Your second call to FillRect uses gridCellRect instead of gridCellRect1.)
Here's a corrected version of the code that should get you started:
procedure DrawRectangle(drawDC:HDC;cellBrush:TBrush);
var
gridCellRect, gridCellRect1 :Trect ;
begin
gridCellRect.Top := 75;
gridCellRect.Bottom := 150;
gridCellRect.Left := 125; // Changed left and right to widen
gridCellRect.right := 200;
cellBrush.color := clBlack;
Windows.FillRect(DrawDC, gridCellRect, cellBrush.Handle);
gridCellRect1 := gridCellRect;
gridCellRect1.Top := gridCellRect.Top + 5;
gridCellRect1.Bottom := gridCellRect.Bottom - 5;
cellBrush.color := clAqua;
Windows.FillRect(DrawDC, gridCellRect1, cellBrush.Handle);
end;
Tested with
procedure TForm1.FormPaint(Sender: TObject);
begin
DrawRectangle(Canvas.Handle, Canvas.Brush);
end;

Display extra text in treeview nodes, not just node.text

I have a TTreeView in Delphi, with nodes at three levels.
I use node data to store another label besides the node text.
Type
TNodeData = class
ExtraNodeLabel: WideString;
//... other members
end;
I have an OnAdvancedCustomDrawItem event, where i want to display this ExtraNodeLabel before the node text.
I wish to achieve this:
The blue text would be the extra label.
higlighted item: first two words are also an extra label
What i got so far, is this:
Problems:
For some reason i can't draw text with different style if i use DrawText/drawTextW (I need drawtextW because of unicode data)
The other problem is, that anything outside the dotted focus rectangle is unclickable
What needs to be solved:
How can i draw text with different style using DrawText/DrawtextW
How can i make the whole text clickable?
Code:
procedure TMainForm.TntTreeView1AdvancedCustomDrawItem(
Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
var
txtrect, fullrect : TRect;
DC: HDC;
fs: integer;
fc: TColor;
ExtralabelRect: TRect;
nData: TNodeData;
begin
nData := nil;
if assigned(Node.Data) then begin
nData := TNodeData(Node.Data);
end;
DC := TntTreeView1.canvas.Handle;
txtRect := Node.DisplayRect(True);
fullrect := Node.DisplayRect(False);
if stage = cdPostPaint then begin
TntTreeView1.Canvas.FillRect(txtRect);
if (cdsFocused In State) And (cdsSelected in State) then begin
DrawFocusRect(DC,txtRect);
end;
txtRect.Left := txtRect.Left + 1;
txtRect.Top := txtRect.Top + 1;
txtRect.Right := txtRect.Right - 1;
txtRect.Bottom := txtRect.Bottom - 1;
ExtralabelRect := txtRect;
fs := TntTreeView1.Canvas.Font.size;
fc := TntTreeView1.Canvas.Font.Color;
if (nData <> nil) And (nData.ExtraNodeLabel <> '') then begin
TntTreeView1.Canvas.Font.Size := 7;
TntTreeView1.Canvas.Font.color := clBlue;
DrawTextW(
DC,
PWideChar(nData.ExtraNodeLabel),
Length(nData.ExtraNodeLabel),
ExtraLabelRect,
DT_LEFT or DT_CALCRECT or DT_VCENTER
);
DrawTextW(
DC,
PWideChar(nData.ExtraNodeLabel),
Length(nData.ExtraNodeLabel),
ExtraLabelRect,
DT_LEFT or DT_VCENTER
);
txtRect.right := txtRect.Right + ExtraLabelRect.Right + 5;
txtRect.Left := ExtraLabelRect.Right + 5;
end;
TntTreeView1.Canvas.Font.Size := fs;
TntTreeView1.Canvas.Font.color := fc;
DrawTextW(
DC,
PWideChar((Node as TTntTreeNode).Text),
-1,
txtRect,
DT_LEFT or DT_VCENTER
);
end;
end;
Solution by the OP
I managed to partially solve custom drawing, by defining a TFont variable, and using SelectObject and setTextColor. Setting font color and style works, but setting the font size doesn't.
var
nFont: TFont;
begin
DC := TntTreeView1.Canvas.Handle;
NFont := TFont.Create;
// rest of the code here ...
// i tried to set nFont.Size, but it doesn't seem to work
nFont.Size := 7;
nFont.Color := colorToRGB(clBlue);
nFont.Style := TntTreeview1.Font.Style + [fsBold];
SelectObject(DC,NFont.Handle);
SetTextColor(DC,colortoRGB(clBlue));
DrawTextW(
DC,
PWideChar(nData.nodeLabel),
Length(nData.nodeLabel),
ExtraLabelRect,
DT_LEFT or DT_VCENTER
);
// rest of the code here
end;
Source:
I used the idea from here
Update 2
I solved the second problem by setting the treeview's RowSelect property to true.
For this, to work, i had to set the ShowLines property to false, and custom draw the lines and the buttons. It works now.
Update 3
I improved the solution for the first problem, by not creating a new font, but selecting the canvas font for displaying text, and this way i was able to change any aspect of the font, and the system cleartype settings are also applied:
// set font size for the canvas font (font style can be set the same time)
TntTreeView1.Canvas.Font.Size := 7;
// select canvas font for DC
SelectObject(DC,TntTreeView1.Canvas.Font.Handle);
// set font color
SetTextColor(DC,colortoRGB(clBlue));

How to set size of inactive (hidden) dock clients' tabs in JVCL Docking component?

The only dock style in JVCL that I know that has the auto hide function (to pin the dock clients) is JvDockVSNetStyle. I'm using it but I can't set the size of the inactive pinned panes' tabs. When hidden, the tabs don't show the title of the pane, only the name of the active pane is shown. Sorry, I can't post an example image because that's my first question.
In the object inpector there is an option called ChannelOption with the ActivePaneSize property. Is there a way to set the inactive pane size so it can show its name? Or maybe there is another dock style that I'm missing that has the same functions?
I'm using C++Builder and JVCL 3.45.
i did it by commenting out these code parts:
procedure TJvDockVSChannel.GetBlockRect(Block: TJvDockVSBlock; Index: Integer;
var ARect: TRect);
var
BlockWidth: Integer;
begin
// HERE
// if Block.VSPane[Index] <> Block.ActivePane then
// BlockWidth := Block.InactiveBlockWidth
// else
BlockWidth := Block.ActiveBlockWidth;
<snip>
procedure TJvDockVSChannel.Paint;
var
I: Integer;
<snip>
begin
VisiblePaneCount := 0;
for I := 0 to Block.VSPaneCount - 1 do
begin
if not Block.VSPane[I].FVisible then
Continue;
GetBlockRect(Block, I, DrawRect);
Canvas.Brush.Color := TabColor;
Canvas.FillRect(DrawRect);
Canvas.Brush.Color := clGray;
Canvas.FrameRect(DrawRect);
AdjustImagePos;
Block.FImageList.Draw(Canvas, DrawRect.Left, DrawRect.Top, I, dsTransparent, itImage);
// HERE
// if Block.ActivePane = Block.VSPane[I] then
begin
if Align in [alTop, alBottom] then
Inc(DrawRect.Left, Block.InactiveBlockWidth)
else
if Align in [alLeft, alRight] then
begin
Inc(DrawRect.Top, Block.InactiveBlockWidth);
if Align = alLeft then
DrawRect.Left := 15
else
DrawRect.Left := 20;
DrawRect.Right := DrawRect.Left + (DrawRect.Bottom - DrawRect.Top);
end;
Canvas.Brush.Color := TabColor;
Canvas.Pen.Color := clBlack;
Dec(DrawRect.Right, 3);
OldGraphicsMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
Canvas.Brush.Style := bsClear;
// HERE (changed options)
DrawText(Canvas.Handle, PChar(Block.VSPane[I].FDockForm.Caption), -1, DrawRect, {DT_END_ELLIPSIS or} DT_NOCLIP);
There is an event in TJvDockServer called DoFinishSetDockPanelSize.
Within the function you create for that event you can access the size of a form using Dockpanel. There may be a way from here to set the size of the tabs.

Dynamically created THTMLabel.Height always return default value?

I am creating a number of dynamically created THTMLabels but after these are created,when I try to get it's height,it always return the default height value.
Here is my code:
for i := 0 to ASentencePtr^.MUS.Count - 1 do
begin
j := Random(slTemp.Count);
sSen := ASentencePtr^.MUS.Strings[StrToInt(slTemp.Strings[j])] + ' / ';
THTMLabel.Create(Self).Name := 'lblSen_' + slTemp.Strings[j];
with THTMLabel(FindComponent('lblSen_' + slTemp.Strings[j])) do
begin
Font.Size := 18;
Font.Style := [fsBold];
Parent := FlowPanel1;
Width := Parent.Width;
Cursor := crHandPoint;
DragMode := dmAutomatic;
ControlStyle := ControlStyle + [csDisplayDragImage];
HTMLText.Add(sSen);
Autosizing := True;
end;
slTemp.Delete(j);
end;
Now when I try to access THTMLabel(FindComponent('lblSen_0')).Height, it returns only the default value which is 17. Where have I gone wrong? Any thoughts anyone? Any help is greatly appreciated, thanks.
We had the same problems but managed to solve them with the THTMLStaticText component and this function that calculates the height when dynamically (height) adjusted:
function CalculateDynamicHeight( aLabel: TLabel; htmlStaticText: THTMLStaticText): Integer;
var
lRect : TRect;
lText : string;
begin
lRect := Rect( 0, 0, htmlStaticText.Width, 0);
lText := htmlStaticText.Text;
aLabel.Caption := htmlStaticText.Text;
aLabel.Font := htmlStaticText.Font;
aLabel.Canvas.Font := htmlStaticText.Font;
aLabel.Canvas.TextRect(
{var} lRect, //will be modified to fit the text dimensions
{var} lText, //not modified, unless you use the "tfModifyingString" flag
[tfCalcRect, tfWordBreak] //flags to say "compute text dimensions with line breaks"
);
ASSERT( lRect.Top = 0 ); //this shouldn't have moved
aLabel.Height := lRect.Bottom;
Result := lRect.Bottom;
end;
The function requires a TLabel component, used exclusively for calculation purposes (you can set the visibility to false). The htmlStaticText component should have AutoSize set to true (in our case AutoSizeType is set to asVertical) and the htmlStaticText.Text should be present when calling the function.
I think THTMLLabel is part of the Jedi Library, itsn't? This problem is weird. I don't know the implementation of this control, but if you are having this problem, then there's may be a very bad implementation of the AutoSize Property.
If you can't inspect and fix the source of this control, try to use the BoundsRect property to get the height:
LabelHeight := THTMLabel(FindComponent('lblSen_0')).BoundsRect.Bottom;

Custom MessageBox icon background white

I'm using a class for custom messageboxes. But my problem is that, icon background is always white. Code below displays the icons. Can somebody tell me what is wrong in this code? I want icon background to be transparent.
try
if not custb then
case i of
MB_ICONINFORMATION:ico.Handle := LoadIcon( 0, IDI_INFORMATION);
MB_ICONEXCLAMATION:ico.Handle := LoadIcon( 0, IDI_EXCLAMATION);
MB_ICONQUESTION:ico.Handle := LoadIcon( 0, IDI_QUESTION);
MB_ICONERROR:ico.Handle := LoadIcon( 0, IDI_ERROR);
end;
with timage.Create( frm) do
begin
parent := frm;
transparent := True;
if custb then
begin
height := glyph.Height;
width := Glyph.Width;
end
else
begin
height := ico.Height;
width := ico.Width;
end;
ih := height;
top := Height div 2 + 2;
it := Top;
left := Width div 2 + 2;
il := Left + width + width div 2;
if width <= 16 then
begin
il := il + 16;
left := left + 8;
end;
if height <= 16 then
begin
it := it + 8;
top := top + 8;
end;
if custb then picture := Glyph else canvas.Draw( 0, 0, ico);
end;
finally
end;
if not custb then ico.Free;
end
Best wishes,
evilone
My code to do this very thing looks like this:
function StandardDialogIcon(DlgType: TMsgDlgType): PChar;
begin
case DlgType of
mtWarning:
Result := IDI_WARNING;
mtError:
Result := IDI_ERROR;
mtInformation:
Result := IDI_INFORMATION;
mtConfirmation:
Result := IDI_QUESTION;
else
Result := nil;
end;
end;
...
Image.Picture.Icon.Handle := LoadIcon(0, StandardDialogIcon(DlgType));
There's no need to set any properties on Image, you can simply ignore Transparent.
Extract from online help for TImage.Transparent:
Setting Transparent sets the
Transparent property of the Picture.
Note: Transparent has no effect
unless the Picture property specifies
a TBitmap object.
This means two things for you:
only set transparent property after the picture has been assigned
Use TBitmap for your image and assign thtat to the picture property.
Have a look at the following link, that describes a function that converts an icon to a bitmap: Delph-Library: Convert icon to bitmap.
Excerpt:
// Konvertiert Ico zu Bitmap
procedure IcoToBmpA(Ico: TIcon; Bmp: TBitmap; SmallIcon: Boolean);
var
WH: Byte; // Width and Height
begin
with Bmp do begin
Canvas.Brush.Color := clFuchsia;
TransparentColor := clFuchsia;
Width := 32; Height := 32;
Canvas.Draw(0, 0, Ico);
if SmallIcon then WH := 16 else WH := 32;
Canvas.StretchDraw(Rect(0, 0, WH, WH), Bmp);
Width := WH; Height := WH;
Transparent := True;
end;
end;

Resources