How to change the fontstyle without creating a new font? - windows

I'm trying to do something that's probably incredibly simple, yet everything I'm trying doesn't seem to work.
I'm making a windows forms app that just lets you preview some custom text using a hand full of different fonts.
What I'm trying to do is change the fontstyle of the label to italics if and when the checkbox is checked. While retaining the current font that it is.
"Display" is the name of my label. "Italicscb" is the name of the check box.
Below is the code I'm currently using:
Private Sub Italicscb_CheckedChanged(sender As Object, e As EventArgs) Handles
Italicscb.CheckedChanged
If Italicscb.CheckState = CheckState.Checked Then
Display.Font = New Font("Arial", 60, FontStyle.Italic)
Else
If Italicscb.CheckState = CheckState.Unchecked Then
Display.Font = New Font("Arial", 60, FontStyle.Bold)
End If
End If
End Sub
This works fine, but it requires me to enter a new font name. Which I don't want. I've tried to assign the current font a variable and plug that in, but that gives me an error.
Dim CF As Font
CF = Display.Font
If Italicscb.CheckState = CheckState.Checked Then
Display.Font = New Font(CF, 60, FontStyle.Italic)
Else
If Italicscb.CheckState = CheckState.Unchecked Then
Display.Font = New Font(CF, 60, FontStyle.Bold)
End If
End If
End Sub
I've also tried putting an if then loop in the individual font option buttons.
No errors, but nothing happens when I check the box.
if Italicscb.CheckState = CheckState.Checked Then
Display.Font = New Font("Freehand521 BT", 60, FontStyle.Italic)
Else
Display.Font = New Font("Freehand521 BT", 60, FontStyle.Bold)
End If
If anyone could point out what I'm doing wrong. I would really appreciate it.
I'm making this for my work by the way.
Thank you.
Image of my userform

First of all, use .Checked instead of .CheckState, so you avoid doing a lot of unnecessary checks:
If Italicscb.Checked Then
'Italic
Else
'Not italic
End If
Now, if you want only to change the fontStyle of Display (using an existing font name and size), you can create a new Font by using the constructor Font(Font, FontStyle), so your code will be:
Private Sub Italicscb_CheckedChanged(sender As Object, e As EventArgs) Handles Italicscb.CheckedChanged
If Italicscb.Checked Then
Display.Font = New Font(Display.Font, FontStyle.Italic)
Else
Display.Font = New Font(Display.Font, FontStyle.Regular)
End If
End Sub
It is also possible to obtain the same result with an elegant single line:
Private Sub Italicscb_CheckedChanged(sender As Object, e As EventArgs) Handles Italicscb.CheckedChanged
Display.Font = New Font(Display.Font, If(Italicscb.Checked, FontStyle.Italic, FontStyle.Regular))
End Sub
Here is the output:

Related

Automatically resize form/controls according to each computer's resolution

I've created a program that is fully functional and I have sent it to some clients. Some of them have really old computers with really low resolution and they can't access it easily since the form and the controls are oversized for them. Is there an easy way for me to make it to automatically resize both form and controls according to the resolution?
As I've said in the title, this is for Visual Basic 6.0. Thanks to all of you in advance.
You can store size and location of each control on the form, and move or resize controls according to your needs.
In the code below, I use "TabIndex" property as unique id for each control (I can't remember in my old VB6 memory if that's the right thing to do...).
I store the size of the form, and the size and location of each control in the Form_Load event.
Private lWidth As Long
Private lHeight As Long
Private Enum ePROPERTY
ep_Top = 0
ep_Left = 1
ep_Width = 2
ep_Height = 3
End Enum
Private aControlSize() As Long
Private Sub Form_Load()
Dim ctlTmp As Control
lWidth = Me.Width
lHeight = Me.Height
ReDim aControlSize(3, Form1.Controls.Count)
For Each ctlTmp In Form1.Controls
aControlSize(ctlTmp.TabIndex, ep_Top) = ctlTmp.Top
aControlSize(ctlTmp.TabIndex, ep_Left) = ctlTmp.Left
aControlSize(ctlTmp.TabIndex, ep_Width) = ctlTmp.Width
aControlSize(ctlTmp.TabIndex, ep_Height) = ctlTmp.Height
Next
End Sub
Then each time the form is resized (Form_resize event), you'll have to move or resize each control.
Some of them need to be anchored to the right or to the bottom (or both). Some need to be resized and moved. Others don't need nothing.
Private Sub Form_Resize()
Dim ctlTmp As Control
For Each ctlTmp In Form1.Controls
Select Case LCase$(ctlTmp.Name)
Case "text1"
' Text1 is anchored to the left and right borders of the form :
ctlTmp.Width = Me.Width - (lWidth - aControlSize(ctlTmp.TabIndex, ep_Width))
Case "command1"
' Command1 is anchored to the right border of the form :
ctlTmp.Left = aControlSize(ctlTmp.TabIndex, ep_Left) - (lWidth - Me.Width)
Case "check1"
' check1 is anchored to the bottom border of the form :
ctlTmp.Top = aControlSize(ctlTmp.TabIndex, ep_Top) - (lHeight - Me.Height)
End Select
Next
End Sub
Form loaded :
Form Resized :
Please be advised that my code is largely perfectible...
There's probably a more elegant solution that goes through overload each Control and to add properties/methods like the existing ones in dotnet.

Event Handlers for Dynamic Table Layout Panel in Visual Basic

I am making a risk-type game for school that dynamically creates a 4x4 grid of buttons inside a table layout panel in visual basic. I have successfully created the panel and buttons with names that correspond to the row and column of the button. There are also two parallel arrays - one for button owner and the other for button number - that correspond to the owner of the button and the number of "armies" in the button. My issue is that when the user clicks a certain button, I need to reference the button name/value to know how many "armies" the button has to control the "attack" portion of the player's turn.
The following code creates the table layout panel and the buttons with names.
'Create table Dynamically
Dim ColCount As Integer = 4
Dim RowCount As Integer = 4
Dim f As New System.Drawing.Font("Arial", 15)
riskTable.AutoScroll = True
riskTable.Dock = DockStyle.Fill
riskTable.ColumnCount = ColCount
riskTable.RowCount = RowCount
For rowNo As Integer = 0 To riskTable.RowCount - 1
For columnNo As Integer = 0 To riskTable.ColumnCount - 1
Dim buttonname As String
buttonname = "B" & rowNo & columnNo
Dim button As Control = New Button
button.Size = New Size(179, 100)
button.Name = buttonname
button.Text = "1"
button.ForeColor = Color.White
button.Font = f
AddHandler button.Click, AddressOf buttonname_Click
riskTable.Controls.Add(button, columnNo, rowNo)
Next
Next
Me.Controls.Add(riskTable)
This is the dynamic event handler that I created. I tried using 'Me.Click' to get the name of the button, but it only returns the name of the form. I need to have code in here that references the name of the currently clicked button to then in turn reference the box owner and box number arrays.
Private Sub buttonname_Click(sender As Object, e As EventArgs) Handles Me.Click
MessageBox.Show(Me.Name)
End Sub
Any help would be greatly appreciated! I think that once I get this working, the rest of the game will be pretty simple to figure out.
Thanks!
Put the name in 'button.Tag' instead/also:
button.Tag = buttonname
Then it is easy to get the name with:
Private Sub buttonname_Click(sender As Object, e As EventArgs) Handles Me.Click
Dim result As String = CType(CType(sender, System.Windows.Forms.Button).Tag, String)
End Sub
(Check the System.Windows.Forms.Button though, might need some tweak to match your buttons inside the table. riskTable.Controls.button ?)

Unbound imagecontrol ONLY show First image when imagelink is added in a 1:N relation

Background:
Entry is via a subform for adding/showing/linking images.
I do not want to store the image files within my DB, the image folder is separate. The DB will grow rather large in time.
I have created a click-control enabling a popup for user to browse and click on the imagePATH to be added in a Bound Textfield (called Bildadress, no not misspelled in My country, Grin ) in the subform.
See code below.
Then I add a new unbound Image-control and specify its Controlsource = the Textfield mentioned above.
For the firs image this works wonderful, but for the following the Image-control returns NULL (not show att all). The data in the Textfield updates as it should.
Will the 2nd stage only work in a 1:1 relationship OR can I (with your help) use VBA code to make this work?
OPTIMAL would be to get this to work and also a 2nd Bound Textfield just displaying the actual image file name. .
I hope someone out there have encountered this problem who also didnt want to use Attachment to store the files within the databae.
CODE:
Private Sub AddFilePath_Click()
Call Selectfile
End Sub
Public Function Selectfile() As String
Dim Fd As FileDialog
Set Fd = Application.FileDialog(msoFileDialogOpen)
With Fd
.AllowMultiSelect = False
.Title = "Välj önskad fil"
If .Show = True Then
Selectfile = .SelectedItems(1)
Me.Bildadress = Selectfile
Else
Exit Function
End If
End With
Set Fd = Nothing
End Function
If you use a bound textbox that holds the image-path then you can use
Me.Imagecontrol.Picture = Me.BoundTextControl.Value
to load the picture into an unbound image control. In your case that would be something like
If .Show = True Then
Me.Bildadress.value = .SelectedItems(1)
Me.Bild.Picture = Me.Bildadress.value
Else
It would be best to also load the respective picture in the OnCurrent Event.
Private Sub Form_Current()
Me.Bild.Picture = Me.Bildadress.value
End Sub
However, keep in mind that access is a one-file-database and you break that paradigm when using links to external files where the files would belong into the DB.

Partition powerpoint lines into different objects

I have many power point slides and each slide has many lines but all those lines are in the same objects. I want now to add some animation including appears for each line with click.
How I can partition the lines in each slide such that every line will be in its own object
Note, I am using powerpoint 2010
Thanks,
AA
This isn't perfect; you'll need to add more code to pick up ALL of the formatting from the original text, but it's a start. Click within the text box you want to modify, then run the TEST sub. Once it's adjusted to your taste, it's a fairly simple matter to extend it to act on every text box in the entire presentation (though not tables, charts, smartart, stuff like that)
Sub Test()
TextBoxToLines ActiveWindow.Selection.ShapeRange(1)
End Sub
Sub TextBoxToLines(oSh As Shape)
Dim oSl As Slide
Dim oNewShape As Shape
Dim oRng As TextRange
Dim x As Long
With oSh
Set oSl = .Parent
With .TextFrame.TextRange
For x = 1 To .Paragraphs.Count
Set oRng = .Paragraphs(x)
Set oNewShape = oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, _
oRng.BoundLeft, oRng.BoundTop, oRng.BoundWidth, oRng.BoundHeight)
With oNewShape
.TextFrame.AutoSize = ppAutoSizeNone
.Left = oRng.BoundLeft
.Top = oRng.BoundTop
.Width = oSh.Width
.Height = oSh.Height
With .TextFrame.TextRange
.Text = oRng.Text
.Font.Name = oRng.Font.Name
.Font.Size = oRng.Font.Size
' etc ... pick up any other font formatting you need
' from oRng, which represents the current paragraph of
' the original text
' Bullets, tabs, etc.
End With
End With
Next
End With
End With
oSh.Delete
End Sub

How to call a visio macro from a stencil

i have written some Macros for Visio. Now I copied these to a Stencil called Macros.vss
How can I call my Macros now?
It all depends on what the macros do and how you'd like to call them. I'm going to assume they're simply macros that will execute something within the active Visio page.
By default in Visio VBA, any public subs with no arguments get added to the Visio Tools->Macros menu, in a folder named by the document holding the macros (in this case Macros) and then separated into folders by module name. If you're the only person using the macros then you probably don't need to do anything else.
However, since you put them in a vss file I'll assume you'd like to distribute them to other people.
There's something funny (and by funny I mean irritating) about Visio and how toolbars and buttons work, when added programmatically. Unfortunately, when you create a toolbar using the UIObject and Toolbar and ToolbarItem classes, Visio is going to assume the code you're calling resides in the active drawing, and cannot be in a stencil. So I can give you a little guidance on using those classes, but basically it consists of distributing a .vst template along with your .vss files, with just a single required sub in the .vst file.
So, instead of using a custom toolbar, you can attach code to shape masters in your .vss file that execute the code when they get dropped on a drawing document (using CALLTHIS and the EventDrop event in the shapesheet). With this method I just have a sub that gets called using callthis that takes a shape object as an argument, executes some code, then deletes the shape (if I don't want it around anymore).
And lastly, you can manipulate the Visio UI programmatically to add a toolbar and buttons for your macros. Below is some sample code, basically the way I do it with a solution I developed. As I mentioned above, the most important part of using this method is to have a document template (.vst) that holds a sub (with the below code it must be named RunStencilMacro) that takes a string as an argument. This string should be the "DocumentName.ModuleName.SubName". This sub must take the DocumentName out of the string, and get a Document object handle to that document. Then it must do ExecuteLine on that document with the ModuleName.SubName portion. You'll have to step through the code and figure some things out, but once you get the hang of what's going on it should make sense.
I'm not sure of any other ways to execute the macros interactively with VBA. I think exe and COM addons may not have this issue with toolbars...
Private Sub ExampleUI()
Dim UI As Visio.UIObject
Dim ToolbarSet As Visio.ToolbarSet
Dim Toolbars As Visio.Toolbars
Dim Toolbar As Visio.Toolbar
Dim ToolbarItems As Visio.ToolbarItems
Dim ToolbarItem As Visio.ToolbarItem
Dim TotalToolBars As Integer
Dim Toolbarpos As Integer
Const ToolbarName = "My Toolbar"
' Get the UIObject object for the toolbars.
If Visio.Application.CustomToolbars Is Nothing Then
If Visio.ActiveDocument.CustomToolbars Is Nothing Then
Set UI = Visio.Application.BuiltInToolbars(0)
Else
Set UI = Visio.ActiveDocument.CustomToolbars
End If
Else
Set UI = Visio.Application.CustomToolbars
End If
Set ToolbarSet = UI.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Delete toolbar if it exists already
TotalToolBars = ToolbarSet.Toolbars.Count
For i = 1 To TotalToolBars
Set Toolbar = ToolbarSet.Toolbars.Item(i - 1)
If Toolbar.Caption = ToolbarName Then
Toolbar.Visible = False
Toolbar.Delete
Exit For
End If
Next
' create toolbar
Set Toolbar = ToolbarSet.Toolbars.Add
Toolbar.Caption = ToolbarName
Dim IconPos As Long ' counter to determine where to put a button in the toolbar
IconPos = IconPos + 1
Dim IconFunction As String
IconFunction = """Macros.Module1.SubName"""
Set ToolbarItem = Toolbar.ToolbarItems.AddAt(IconPos)
With ToolbarItem
.AddOnName = "RunStencilMacro """ & IconFunction & """"
.Caption = "Button 1"
.CntrlType = Visio.visCtrlTypeBUTTON
.Enabled = True
.state = Visio.visButtonUp
.Style = Visio.visButtonIcon
.Visible = True
.IconFileName ("16x16IconFullFilePath.ico")
End With
' Now establish the position of this toolbar
With Toolbar
.Position = visBarTop 'Top overall docking area
.Left = 0 'Puts it x pixels from the left
.RowIndex = 13
.Protection = visBarNoCustomize
Toolbar.Enabled = True
.Visible = True
End With
Visio.Application.SetCustomToolbars UI
Visio.ActiveDocument.SetCustomToolbars UI
End Sub

Resources