Programmatically created Label will not right-justify - vb6

Creating a label programatically (i.e. not in designer) won't right-align on my form.
Set lblStatus = StatusForm.Controls.Add("VB.Label", "lbl" & xml(Prop, "column"))
With lblStatus
.Visible = True
.Caption = Text
.Alignment = vbRightJustify
.WordWrap = False
.AutoSize = True
.top = Index * (lblStatus.height)
.left = MaxWidth - Screen.TwipsPerPixelX * 15
.Width = StatusForm.TextWidth(Text)
End With
I created three of these controls, but they continue to expand from the left, rather than from the right:
Ideally, I want those labels (surrounded by #) to have their semicolons line up.

Since you set AutoSize to true, the width is set to the precise width of the text, leaving no room for alignment.
To layout the text within a fixed width, turn off AutoSize.

Related

Firemonkey TListBox changing background color at runtime

I there a way, at runtime, other than using styles, to change the background color of a TListBox? Can I use the OnPaint event?
Because the TListbox doesn't have a property to change the background color, I can only think of the following, which is based on combining two components, of which one (the TListBox) uses a built-in style. Note however, that this is not depending on TStyleBook nor any of the style files supplied with Delphi Firemonkey.
Place a TRectangle as a background for the TListBox. Set its Fill - Color property to a color you like. (I used "Cornsilk" in the example).
Place the TListBox on the rectangle as a child of the rectangle. In the "Object Inspector" locate the StyleLookup property and change its value to transparentlistboxstyle. This makes the listbox transparent and the rectangle and its fill color to shine through.
If you make the TListBox one pixel smaller than the rectangle on each side, you can use the Sides property to provide a thin frame around the listbox. Or you can choose to make them equally sized and not show any frame.
My test result looks like this:
The TRectangle and the TListbox properties from the .fmx file:
object Rectangle1: TRectangle
Anchors = [akLeft, akTop, akBottom]
Fill.Color = claCornsilk
Position.X = 7.000000000000000000
Position.Y = 40.000000000000000000
Size.Width = 361.000000000000000000
Size.Height = 219.000000000000000000
Size.PlatformDefault = False
object ListBox1: TListBox
Anchors = [akLeft, akTop, akRight, akBottom]
Position.X = 1.000000000000000000
Position.Y = 1.000000000000000000
Size.Width = 359.000000000000000000
Size.Height = 217.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'transparentlistboxstyle'
TabOrder = 0
ParentShowHint = False
ShowHint = False
DisableFocusEffect = True
ItemHeight = 48.000000000000000000
DefaultItemStyles.ItemStyle = 'listboxitemrightdetail'
DefaultItemStyles.GroupHeaderStyle = ''
DefaultItemStyles.GroupFooterStyle = ''
Viewport.Width = 359.000000000000000000
Viewport.Height = 217.000000000000000000
end
end
To change the color of ListBox1, you actually change the color of the TRectangle:
procedure TForm5.ColorListBox1ItemClick(const Sender: TCustomListBox;
const Item: TListBoxItem);
begin
Rectangle1.Fill.Color := TColorListBox(Sender).Color;
end;

NSTextField text not showing

I am trying to draw a text with background color and border radius, but the text does not show.
I've used sizeToFit to make the textfield fit its content.
When the below code is added to its superview, this is what is shown:
As you can see, the text is missing even though the view has adjusted itself to fit the text. I have tried setting a huge frame but its the same issue.
let text = NSTextField(frame: NSRect(x: 0, y: 0, width: 0, height: 0))
text.stringValue = "ABC"
text.sizeToFit()
text.wantsLayer = true
text.isBordered = true
text.drawsBackground = true
let textFieldLayer = CALayer()
text.layer = textFieldLayer
text.backgroundColor = NSColor.blue
text.layer?.backgroundColor = NSColor.blue.cgColor
text.layer?.borderColor = NSColor.red.cgColor
text.layer?.borderWidth = 1
text.layer?.cornerRadius = 5
text.textColor = NSColor.red
let positionRelativeToScreen = toOrigin(point: positionFlipped, size: text.frame.size)
let positionRelativeToWindow = borderWindow.convertPoint(fromScreen: positionRelativeToScreen)
text.frame.origin = positionRelativeToWindow
return text
Solution was to remove textFieldLayer. Thanks #Willeke!

Paint a border around every image in a Word document

Is there a way to add a border around every image in Word? I know that I can create a custom paragraph style with a border and put the image in there, but maybe I can just specify a global image style, like in CSS:
img { border: 1px solid #000 }
Unfortunately, there is no picture style concept available in Word. Therefore, something like specifying a global style for images similar to CSS is not possible.
What you can do is write a VBA macro that adds the border to all images. The code is a little different depending on whether your image is formatted to be inline with text (InlineShape) or floating (Shape):
Sub AddBorderToPictures()
' Add border to pictures that are "inline with text"
Dim oInlineShape As inlineShape
For Each oInlineShape In ActiveDocument.InlineShapes
oInlineShape.Borders.Enable = True
oInlineShape.Borders.OutsideColor = wdColorBlack
oInlineShape.Borders.OutsideLineWidth = wdLineWidth100pt
oInlineShape.Borders.OutsideLineStyle = wdLineStyleSingle
Next
' Add border to pictures that are floating
Dim oShape As shape
For Each oShape In ActiveDocument.Shapes
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
oShape.Line.Weight = 1
oShape.Line.DashStyle = msoLineSolid
Next
End Sub
If apparently setting the line width to wdLineWidth100pt is an issue, you can try using the actual underlying integer value instead, e.g.:
oInlineShape.Borders.OutsideLineWidth = 8
This is how the constant is defined:
public enum WdLineWidth
{
wdLineWidth025pt = 2,
wdLineWidth050pt = 4,
wdLineWidth075pt = 6,
wdLineWidth100pt = 8,
wdLineWidth150pt = 12,
wdLineWidth225pt = 18,
wdLineWidth300pt = 24,
wdLineWidth450pt = 36,
wdLineWidth600pt = 48,
}

How do you calculate the height of the title bar in VB6?

I'm trying to display one form relative to a Button on a control below it.
But Button.top is relative to the titlebar of the bottom form, and the top form will be relative to the screen.
So, to compensate for that I need to now how tall the titlebar is.
I've used Form.height-Form.ScalehHeight but ScaleHeight doesn't include the title bar or the border so Scaleheight is inflated slightly.
Anyone know how to calculate the height of just the title bar?
You need to use the GetSystemMetrics API call to get the height of the titlebar.
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4
Property Get TitleBarHeight() as Long
TitleBarHeight = GetSystemMetrics(SM_CYCAPTION)
End Property
Note: This will return the height in pixels. If you need twips you will have to convert using a form's ScaleY method like so: Me.ScaleY(TitleBarHeight(), vbPixels, vbTwips)
Subtract it back out:
(Form.height-Form.ScaleHeight) - (Form.Width-Form.ScaleWidth) / 2
"Recursive's" answer above is not quite correct. It subtracts twice the border width - there is a border on the left and one on the right!
We get the best results with this:
(Form.Height-Form.ScaleHeight) - (Form.Width-Form.ScaleWidth)/2
' For completeness:
Public Const SM_CYCAPTION = 4
Public Const SM_CYBORDER = 6
Public Const SM_CYFRAME = 33
' in Pixels
Property Get NonClinetHeight()
FrameH = GetSystemMetrics(SM_CYFRAME) ' Total height, Top + Bottom
CaptionH = GetSystemMetrics(SM_CYCAPTION)
BorderH = GetSystemMetrics(SM_CYBORDER) ' Border around Client area
NonClinetHeight = FrameH + CaptionH + (BorderH * 2)
End Property
You'll probably need to make a Win32 API call to GetSystemMetrics()
You can use the ClientToScreen() windows API function to convert a point from client coordinates to screen coordinates:
Dim Position As Point
Position.x = 0
Position.y = 0
ClientToScreen Me.hWnd, Position
FormTop = Position.y
If you want to skip this and go direct to the button, you can use the button's position (in pixels):
Position.x = This.ScaleX(Button.Left, this.ScaleMode, vbPixels)
Position.Y = This.ScaleY(Button.Top, this.ScaleMode, vbPixels)
...
Or just get the buttons position using GetWindowRect()
Dim Position2 As Rect
GetClientRect Button.hWnd, Position2
Position.x = Position2.left
Position.y = Position2.top
...

Vertical Scrolling Marquee for foxpro

Could anyone could point me to some code/give me ideas on how to create a smooth scrolling vertical marquee for VFP 8 or 9?
Any help is appreciated.
Here's a quick program that will scroll messages. Put the following in a prg file and run it.
I'd make a containerScrollArea a class that encapsulates the timer, labels, and scrolling code. Give it GetNextMessage method that you can override to retrieve the messages.
* Put a container on the screen to hold our scroller
_screen.AddObject("containerScrollArea", "container")
WITH _Screen.containerScrollArea
* Size it
.Visible = .t.
.Width = 100
.Height = 100
* Add two labels, one to hold each scrolling message
.AddObject("labelScroll1", "Label")
.AddObject("labelScroll2", "Label")
* This timer will move the labels to scroll them
.AddObject("timerScroller", "ScrollTimer")
ENDWITH
WITH _Screen.containerScrollArea.labelScroll1
* The labels are positioned below the margin of the container, so they're not initially visible
.Top = 101
.Height = 100
.Visible = .t.
.WordWrap = .t.
.BackStyle= 0
.Caption = "This is the first scrolling text, which is scrolling."
ENDWITH
WITH _Screen.containerScrollArea.labelScroll2
* The labels are positioned below the margin of the container, so they're not initially visible
.Top = 200
.Height = 100
.Visible = .t.
.WordWrap = .t.
.BackStyle= 0
.Caption = "This is the second scrolling text, which is scrolling."
ENDWITH
* Start the timer, which scrolls the labels
_Screen.containerScrollArea.timerScroller.Interval = 100
DEFINE CLASS ScrollTimer AS Timer
PROCEDURE Timer
* If the first label is still in view, move it by one pixel
IF This.Parent.labelScroll1.Top > -100
This.Parent.labelScroll1.Top = This.Parent.labelScroll1.Top - 1
ELSE
* If the first label has scrolled out of view on the top of the container, move it back to the bottom.
This.Parent.labelScroll1.Top = 101
* Load some new text here
ENDIF
IF This.Parent.labelScroll2.Top > -100
* If the second label is still in view, move it by one pixel
This.Parent.labelScroll2.Top = This.Parent.labelScroll2.Top - 1
ELSE
* If the second label has scrolled out of view on the top of the container, move it back to the bottom.
This.Parent.labelScroll2.Top = 101
* Load some new text here
ENDIF
ENDPROC
ENDDEFINE
You can use Scrollable Container
Unfortunately the nature of my work leaves me no time for fooling around with graphics, however if I did I would look into using GDI+ with VFP. Here is an article to get you started

Resources