as the title says , I need to serialize my font.
I have tried the following approach unfortunately to no avail.
This is what I have and what happens;
I have a drawing application and certain variables and properties need to be serialized.
(So , Xml.Serialization has been used.)
Now this has already been done in a huge portion and I've created some other attributes which needed to be serialized and it works.
There is one base class and classes such as drawablestar, drawableeclipse ,etc. all inherit from this class. As does my drawabletextboxclass.
The base class is Serializable as can be seen in the sample below.
It looks like this...
Imports System.Xml.Serialization
<Serializable()> _
Public MustInherit Class Drawable
' Drawing characteristics.
'Font characteristics
<XmlIgnore()> Public FontFamily As String
<XmlIgnore()> Public FontSize As Integer
<XmlIgnore()> Public FontType As Integer
<XmlIgnore()> Public ForeColor As Color
<XmlIgnore()> Public FillColor As Color
<XmlAttributeAttribute()> Public LineWidth As Integer = 0
<XmlAttributeAttribute()> Public X1 As Integer
<XmlAttributeAttribute()> Public Y1 As Integer
<XmlAttributeAttribute()> Public X2 As Integer
<XmlAttributeAttribute()> Public Y2 As Integer
' attributes for size textbox
<XmlAttributeAttribute()> Public widthLabel As Integer
<XmlAttributeAttribute()> Public heightLabel As Integer
'<XmlTextAttribute()> Public FontFamily As String
'<XmlAttributeAttribute()> Public FontSize As Integer
'this should actually not be here..
<XmlAttributeAttribute()> Public s_InsertLabel As String
' Indicates whether we should draw as selected.
<XmlIgnore()> Public IsSelected As Boolean = False
' Constructors.
Public Sub New()
ForeColor = Color.Black
FillColor = Color.White
'FontFamily = "Impact"
'FontSize = 12
End Sub
Friend WriteOnly Property _Label() As String
Set(ByVal Value As String)
s_InsertLabel = Value
End Set
End Property
Public Sub New(ByVal fore_color As Color, ByVal fill_color As Color, Optional ByVal line_width As Integer = 0)
LineWidth = line_width
ForeColor = fore_color
FillColor = fill_color
' FontFamily = Font_Family
' FontSize = Font_Size
End Sub
' Property procedures to serialize and
' deserialize ForeColor and FillColor.
<XmlAttributeAttribute("ForeColor")> _
Public Property ForeColorArgb() As Integer
Get
Return ForeColor.ToArgb()
End Get
Set(ByVal Value As Integer)
ForeColor = Color.FromArgb(Value)
End Set
End Property
<XmlAttributeAttribute("BackColor")> _
Public Property FillColorArgb() As Integer
Get
Return FillColor.ToArgb()
End Get
Set(ByVal Value As Integer)
FillColor = Color.FromArgb(Value)
End Set
End Property
'Property procedures to serialize and
'deserialize Font
<XmlAttributeAttribute("InsertLabel")> _
Public Property InsertLabel_() As String
Get
Return s_InsertLabel
End Get
Set(ByVal value As String)
s_InsertLabel = value
End Set
End Property
<XmlAttributeAttribute("FontSize")> _
Public Property FontSizeGet() As Integer
Get
Return FontSize
End Get
Set(ByVal value As Integer)
FontSize = value
End Set
End Property
<XmlAttributeAttribute("FontFamily")> _
Public Property FontFamilyGet() As String
Get
Return FontFamily
End Get
Set(ByVal value As String)
FontFamily = value
End Set
End Property
<XmlAttributeAttribute("FontType")> _
Public Property FontType_() As Integer
Get
Return FontType
End Get
Set(ByVal value As Integer)
FontType = value
End Set
End Property
#Region "Methods to override"
Public MustOverride Sub Draw(ByVal gr As Graphics)
' Return the object's bounding rectangle.
Public MustOverride Function GetBounds() As Rectangle
...... ........
.....
End Class
My textbox class which looks like this , is the one that needs to save it's font.
Imports System.Math
Imports System.Xml.Serialization
Imports System.Windows.Forms
<Serializable()> _
Public Class DrawableTextBox
Inherits Drawable
Private i_StringLength As Integer
Private i_StringWidth As Integer
Private drawFont As Font = New Font(FontFamily, 12, FontStyle.Regular)
Private brsTextColor As Brush = Brushes.Black
Private s_insertLabelTextbox As String = "label"
' Constructors.
Public Sub New()
End Sub
Public Sub New(ByVal objCanvas As PictureBox, ByVal fore_color As Color, ByVal fill_color As Color, Optional ByVal line_width As Integer = 0, Optional ByVal new_x1 As Integer = 0, Optional ByVal new_y1 As Integer = 0, Optional ByVal new_x2 As Integer = 1, Optional ByVal new_y2 As Integer = 1)
MyBase.New(fore_color, fill_color, line_width)
Dim objGraphics As Graphics = objCanvas.CreateGraphics()
X1 = new_x1
Y1 = new_y1
'Only rectangles ,circles and stars can resize for now b_Movement
b_Movement = True
Dim frm As New frmTextbox
frm.MyFont = drawFont
frm.ShowDialog()
If frm.DialogResult = DialogResult.OK Then
FontFamily = frm.MyFont.FontFamily.Name
FontSize = frm.MyFont.Size
FontType = frm.MyFont.Style
'drawFont = frm.MyFont
drawFont = New Font(FontFamily, FontSize)
drawFont = FontAttributes()
brsTextColor = New SolidBrush(frm.txtLabel.ForeColor)
s_InsertLabel = frm.txtLabel.Text
i_StringLength = s_InsertLabel.Length
'gefixtf
Dim objSizeF As SizeF = objGraphics.MeasureString(s_InsertLabel, drawFont, New PointF(X2 - X1, Y2 - Y1), New StringFormat(StringFormatFlags.NoClip))
Dim objPoint As Point = objCanvas.PointToClient(New Point(X1 + objSizeF.Width, Y1 + objSizeF.Height))
widthLabel = objSizeF.Width
heightLabel = objSizeF.Height
X2 = X1 + widthLabel
Y2 = Y1 + heightLabel
Else
Throw New ApplicationException()
End If
End Sub
' Draw the object on this Graphics surface.
Public Overrides Sub Draw(ByVal gr As System.Drawing.Graphics)
' Make a Rectangle representing this rectangle.
Dim rectString As Rectangle
rectString = New Rectangle(X1, Y1, widthLabel, heightLabel)
rectString = GetBounds()
' See if we're selected.
If IsSelected Then
gr.DrawString(s_InsertLabel, drawFont, brsTextColor, X1, Y1)
'gr.DrawRectangle(Pens.Black, rect) ' Pens.Transparent
gr.DrawRectangle(Pens.Black, rectString)
' Draw grab handles.
DrawGrabHandle(gr, X1, Y1)
DrawGrabHandle(gr, X1, Y2)
DrawGrabHandle(gr, X2, Y2)
DrawGrabHandle(gr, X2, Y1)
Else
gr.DrawString(s_InsertLabel, drawFont, brsTextColor, X1, Y1)
'gr.DrawRectangle(Pens.Black, rect) ' Pens.Transparent
gr.DrawRectangle(Pens.Black, rectString)
End If
End Sub
'get fontattributes
Public Function FontAttributes() As Font
Return New Font(FontFamily, 12, FontStyle.Regular)
End Function
' Return the object's bounding rectangle.
Public Overrides Function GetBounds() As System.Drawing.Rectangle
Return New Rectangle( _
Min(X1, X1), _
Min(Y1, Y1), _
Abs(widthLabel), _
Abs(heightLabel))
End Function
' Return True if this point is on the object.
Public Overrides Function IsAt(ByVal x As Integer, ByVal y As Integer) As Boolean
Return (x >= Min(X1, X2)) AndAlso _
(x <= Max(X1, X2)) AndAlso _
(y >= Min(Y1, Y2)) AndAlso _
(y <= Max(Y1, Y2))
End Function
' Move the second point.
Public Overrides Sub NewPoint(ByVal x As Integer, ByVal y As Integer)
X2 = x
Y2 = y
End Sub
' Return True if the object is empty (e.g. a zero-length line).
Public Overrides Function IsEmpty() As Boolean
Return (X1 = X2) AndAlso (Y1 = Y2)
End Function
End Class
The coordinates ( X1 ,X2,Y1, Y2 ) are needed to draw a circle , rectangle etc. ( in the other classes ).This all works.
If I load my saved file it shows me the correct location and correct size of drawn objects. If I open my xml file I can see all values are correctly saved ( including my FontFamily ).
Also the color which can be adjusted is saved and then properly displayed when I load a previously saved drawing.
Of course because the coordinates work, if I insert a textField ,the location where it is being displayed is correct.
However here comes the problem , my fontSize and fontfamily don't work.
As you can see I created them in the base class, However this does not
work. Is my approach completely off? What can I do ?
Before saving
img14.imageshack.us/i/beforeos.jpg/
After loading the Font jumps back to Sans serif and size 12.
I could really use some help here..
Edit: I've been using the sample from this website
http://www.vb-helper.com/howto_net_drawing_framework.html
UPDATE:
The problem with creating a font property is that the xml serializer just won't take it.
#OregonGhost I'm certain that's what you mean as well , I'm just not really following your solution( thought i did , forgive me ).
So I figured hey why not create some sort of font class that would inherit from my base class since this one will be serialized( a bit crazy I know.. creating a font class for a font class) . So that I could create my " own " font objects instead of using the standard font class( since this one doesn't work with xml serializer). But decided not to do it.
#OregonGhost Now I saw something in indeed c# and I'm assuming you mean indeed something like this
public Font FontObject
{
get
{
return (Font) settings["font"];
}
set
{
settings["font"] = value;
}
}
In which settings is a hashtable.
Are you suggesting something like this ?
Related
I have a DataGridView with a number of columns; one of which is a DataGridViewComboBoxColumn. I have set my DataGridView.EditMode = EditOnEnter.
My rows are set to the height of a few lines of text as this shows the user all available space for their text, however this appears to cause the ComboBox cell to temporarily resize when clicked.
Here is a screen shot of my column:
The second, third and fourth cells are the default row height. The first cell is what is the state if the ComboBox when the cell is first clicked. You then must click again (in the now small box) to actually display the contents of the ComboBox:
It looks like the ComboBox is resizing to the height of the text.
Once you leave cell it resizes itself back to the default row height:
How I can stop this behaviour and force the ComboBox to keep it's size equal to that of the row height?
This is the Custom Combo Box. Add this to you project and you can drop it in a Windows Form and use it as a normal ComboBox
CustomComboBox
<ToolboxItem(true)> _
<ToolboxBitmap(GetType(ComboBox))> _
partial public class CustomComboBox
Inherits ComboBox
sub New()
DrawMode = DrawMode.OwnerDrawFixed
DropDownStyle = ComboBoxStyle.DropDownList
ItemHeight = 26
DropDownHeight = ItemHeight * 6
end sub
protected Overrides sub OnDrawItem( e As DrawItemEventArgs)
if (e.Index >= 0) then
e.DrawBackground()
e.DrawFocusRectangle()
using b as New SolidBrush(ForeColor)
dim name as String = Items(e.Index).ToString()
dim textLeft as Int32 = e.Bounds.Left + 3
dim textTop as Int32 = e.Bounds.Top + (e.Bounds.Height / 2) - (Font.Height / 2)
dim textWidth as Int32 = e.Bounds.Width - e.Bounds.Width
dim textHeight as Int32 = e.Bounds.Height
Dim textTarget as Rectangle = new Rectangle(textLeft, textTop, textWidth, textHeight)
e.Graphics.DrawString(name, Font, b, textTarget)
end using
end if
end sub
End Class
To change the height of the ComboBox and the amount of space given to each item inside it, alter the value ItemHeight in the constructor.
In order to put this into a DataGridView you will need to create a custom Cell, Column, and EditControl. All three are relatively easy to create as you can see from the code below.
CustomComboBoxCell
public class CustomComboBoxCell
Inherits DataGridViewTextBoxCell
public overrides sub InitializeEditingControl(rowIndex As Int32 , initialFormattedValue As Object , dataGridViewCellStyle As DataGridViewCellStyle )
' Set the value of the editing control to the current cell value.
mybase.InitializeEditingControl(rowIndex, initialFormattedValue, dataGridViewCellStyle)
dim ctl as CustomComboBoxEditControl = CType(DataGridView.EditingControl, CustomComboBoxEditControl)
Dim col As CustomComboBoxColumn = CType(DataGridView.Columns(DataGridView.CurrentCell.ColumnIndex), CustomComboBoxColumn)
Dim row As DataGridViewRow = CType(DataGridView.Rows(DataGridView.CurrentCell.RowIndex), DataGridViewRow)
ctl.DataSource = col.DataSource
ctl.Height = DataGridView.RowTemplate.Height
ctl.ItemHeight = row.Height - 6
' Use the default row value when Value property is null.
if (me.Value is Nothing OrElse me.Value is DBNull.Value)
ctl.Text = me.DefaultNewRowValue
else
ctl.Text = me.Value
end if
end sub
public overrides ReadOnly property EditType() As Type
get
return GetType(CustomComboBoxEditControl)
end get
end Property
public overrides readonly property FormattedValueType () as Type
get
return GetType(String)
end get
end Property
public overrides ReadOnly property ValueType() As Type
get
return GetType(String)
End Get
end property
public overrides ReadOnly property DefaultNewRowValue() as Object
get
return String.Empty
end Get
end Property
protected Overrides sub Paint(graphics As Graphics , _
clipBounds As Rectangle , _
cellBounds As Rectangle , _
rowIndex As int32 , _
cellState As DataGridViewElementStates , _
value As Object , _
formattedValue As Object , _
errorText As String , _
cellStyle As DataGridViewCellStyle , _
advancedBorderStyle As DataGridViewAdvancedBorderStyle , _
paintParts As DataGridViewPaintParts)
'base.Paint(graphics, clipBounds, cellBounds, rowIndex, cellState, value, formattedValue, errorText, cellStyle, advancedBorderStyle, paintParts)
mybase.Paint(graphics, clipBounds, cellBounds, rowIndex, cellState, String.Empty, String.Empty, errorText, cellStyle, advancedBorderStyle, paintParts)
if (TypeOf value is string)
Dim valueString As String = Convert.ToString(value)
if (not String.IsNullOrEmpty(valueString))
Dim b As Brush = new SolidBrush(cellStyle.ForeColor)
Dim textLeft as Int32 = cellBounds.Left + 6
Dim textTop as Int32 = cellBounds.Top + (cellBounds.Height / 2) - (cellStyle.Font.Height / 2)
Dim textWidth as Int32 = cellBounds.Width - cellBounds.Width
Dim textHeight as Int32 = cellBounds.Height
Dim textTarget As Rectangle = new Rectangle(textLeft, textTop, textWidth, textHeight)
graphics.DrawString(valueString, cellStyle.Font, b, textTarget)
end if
end if
end sub
end class
CustomComboBoxColumn
public class CustomComboBoxColumn
Inherits DataGridViewColumn
sub new ()
mybase.new(New CustomComboBoxCell())
end sub
public Property DataSource() as Object
public overrides property CellTemplate() As DataGridViewCell
get
return mybase.CellTemplate
end get
set
Dim targetType as Type = GetType(CustomComboBoxCell)
' Ensure that the cell used for the template is a CustomComboBoxCell.
if (not IsNothing(value) AndAlso
not value.GetType().IsAssignableFrom(targetType))
Dim errorMessage As String = $"CellTemplate must be of the type {targetType}."
throw new InvalidCastException(errorMessage)
end if
mybase.CellTemplate = value
end set
End Property
public overrides Function Clone() as Object
Dim retVal As CustomComboBoxColumn = CType(mybase.Clone(), CustomComboBoxColumn)
retVal.DataSource = me.DataSource
return retVal
End Function
end class
CustomComboBoxEditControl
<ToolboxItem(false)>
public class CustomComboBoxEditControl
Inherits CustomComboBox
Implements IDataGridViewEditingControl
public Sub New ()
IDataGridViewEditingControl_EditingControlFormattedValue = false
end sub
Public Property IDataGridViewEditingControl_EditingControlDataGridView As DataGridView Implements IDataGridViewEditingControl.EditingControlDataGridView
Public Property IDataGridViewEditingControl_EditingControlValueChanged As Boolean Implements IDataGridViewEditingControl.EditingControlValueChanged
Public Property IDataGridViewEditingControl_EditingControlRowIndex As Integer Implements IDataGridViewEditingControl.EditingControlRowIndex
Public Function IDataGridViewEditingControl_GetEditingControlFormattedValue(context As DataGridViewDataErrorContexts) As Object Implements IDataGridViewEditingControl.GetEditingControlFormattedValue
return IDataGridViewEditingControl_EditingControlFormattedValue
End Function
Public ReadOnly Property IDataGridViewEditingControl_RepositionEditingControlOnValueChange As Boolean Implements IDataGridViewEditingControl.RepositionEditingControlOnValueChange
get
return False
End Get
end property
Public ReadOnly Property IDataGridViewEditingControl_EditingPanelCursor As Cursor Implements IDataGridViewEditingControl.EditingPanelCursor
get
Return MyBase.Cursor
End Get
end Property
Public Property IDataGridViewEditingControl_EditingControlFormattedValue As Object Implements IDataGridViewEditingControl.EditingControlFormattedValue
get
return me.selectedItem
End Get
Set(value As Object)
me.SelectedItem = value
End Set
end property
Public Sub IDataGridViewEditingControl_ApplyCellStyleToEditingControl(dataGridViewCellStyle As DataGridViewCellStyle) Implements IDataGridViewEditingControl.ApplyCellStyleToEditingControl
me.Font = dataGridViewCellStyle.Font
me.ForeColor = dataGridViewCellStyle.ForeColor
me.BackColor = dataGridViewCellStyle.BackColor
End Sub
Public Function IDataGridViewEditingControl_EditingControlWantsInputKey(keyData As Keys, dataGridViewWantsInputKey As Boolean) As Boolean Implements IDataGridViewEditingControl.EditingControlWantsInputKey
select (keydata and Keys.KeyCode)
case Keys.Escape, Keys.Up, Keys.Down, Keys.Home, Keys.End, Keys.PageDown, Keys.PageUp
return true
Case else
return Not dataGridViewWantsInputKey
end Select
End Function
Public Sub IDataGridViewEditingControl_PrepareEditingControlForEdit(selectAll As Boolean) Implements IDataGridViewEditingControl.PrepareEditingControlForEdit
' Do nothing
End Sub
protected overrides sub OnSelectedValueChanged( eventArgs as EventArgs)
' Notify the DataGridView that the contents of the cell have changed.
Me.IDataGridViewEditingControl_EditingControlValueChanged = true
Me.IDataGridViewEditingControl_EditingControlDataGridView.NotifyCurrentCellDirty(true)
end sub
End Class
This is then added to the Form by using:
grid.AutoGenerateColumns = false
grid.RowTemplate.Height = 45
Dim customComboBoxColumn as new CustomComboBoxColumn()
customComboBoxColumn.DataPropertyName = "Custom Drop Down"
customComboBoxColumn.DataSource = DropDownItems1
dataGridView1.Columns.Add(customComboBoxColumn)
Dim regularComboBoxColumn as new DataGridViewComboBoxColumn()
regularComboBoxColumn.DataPropertyName = "Regular Drop Down"
regularComboBoxColumn.DataSource = DropDownItems2
dataGridView1.Columns.Add(regularComboBoxColumn)
This is what it looks like when placed on the form. The left hand column is the new CustomComboBoxColumn and the one on the right is the standard DataGridViewComboBoxColumn
How do you create a databinding into a textbox that is created at runtime?
Code that created my textbox control
Private Function ADD_TEXTBOX_CONTROL(ByVal ParentControl As Control,
ByVal Name As String,
ByVal Text As String,
ByVal Width As Integer,
ByVal Pos_X As Integer,
ByVal Pos_Y As Integer,
ByVal oNewControlTooltip As String) As TextBox
Dim oTB As New TextBox
oTB.Name = Name
oTB.Text = Text
oTB.Width = Width
oTB.Location = New Drawing.Point(Pos_X, Pos_Y)
ParentControl.Controls.Add(oTB)
Return oTB
End Function
Lets say i would want to bind this textbox with a class property created in the namespace. So that if my textbox value changes, the Body_Cilinder.Height is adjusted as well.
Namespace BODY_NAMESPACE
' Class that defines all the Cilinders properties for easy access.
Class Body_Cilinder
' Counter to determinate the cilinder quantity required.
Public Shared Count As Integer = 0
' Property decalration fir cilinder properties
Private _Index As Integer
Private _Elevation As Double
Private _Height As Double
' Cilinder Index number As Integer for finding the position.
Public Property Index() As Integer
Get
Index = _Index
End Get
Set(ByVal value As Integer)
_Index = value
End Set
End Property
' Cilinder Elevation to define the cilinder elevation from the T.L.
Public Property Elevation() As Double
Get
Elevation = _Elevation
End Get
Set(value As Double)
_Elevation = value
End Set
End Property
' Cilinder Height to define the cilinder height.
Public Property Height() As Double
Get
Height = _Height
End Get
Set(value As Double)
_Height = value
End Set
End Property
' Add Cilinder count every-time a new "Body Cilinder" instance Is created
Public Sub New()
Count = Count + 1
End Sub
End Class
End Namespace
What do I need to add?
I found this example but I don't quite get how it functions
textBox1.DataBindings.Add _
(New Binding("Text", ds, "customers.custName"))
Link to source
How to call the base functions in vb.net?
Imports System.Data.Sql
Imports System.Data.SqlClient
Public Class Box
Public length As Double ' Length of a box
Public breadth As Double ' Breadth of a box
Public height As Double ' Height of a box
Public function setLength(ByVal len As Double)
length = len
End Sub
Public Sub setBreadth(ByVal bre As Double)
breadth = bre
End Sub
Public Sub setHeight(ByVal hei As Double)
height = hei
End Sub
Public Function getVolume() As Double
Return length * breadth * height
End Function
End Class
It says syntax error when I use MyBase to call the base functions
Public Class myChild : Inherits Box
'box 1 specification
MyBase.setLength(6.0)
MyBase.setBreadth(7.0)
MyBase.setHeight(5.0)
'box 2 specification
MyBase.setLength(12.0)
MyBase.setBreadth(13.0)
MyBase.setHeight(10.0)
'volume of box 1
volume = MyBase.getVolume()
Console.WriteLine("Volume of Box1 : {0}", volume)
'volume of box 2
volume = MyBase.getVolume()
End Class
You can't call MyBase from there as the object hasn't yet been constructed.
A better implementation would be:
Box.vb
Public Class Box
Private mLength As Double ' Length of a box
Private mBreadth As Double ' Breadth of a box
Private mHeight As Double ' Height of a box
Public Sub New(ByVal length As Double, ByVal breadth As Double, ByVal height As Double)
Me.mLength = length
Me.mBreadth = breadth
Me.mHeight = height
End Sub
Public Property Length As Double
Get
Return Me.mLength
End Get
Set(ByVal value As Double)
Me.mLength = value
End Set
End Property
Public Property Breadth As Double
Get
Return Me.mBreadth
End Get
Set(ByVal value As Double)
Me.mBreadth = value
End Set
End Property
Public Property Height As Double
Get
Return Me.mHeight
End Get
Set(ByVal value As Double)
Me.mHeight = value
End Set
End Property
Public Function getVolume() As Double
Return Length * Breadth * Height
End Function
End Class
Child.vb
Public Class Child : Inherits Box
Public Sub New(ByVal length As Double, ByVal breadth As Double, ByVal height As Double)
MyBase.New(length, breadth, height)
End Sub
End Class
Example
Sub Main()
Dim box1 As New Child(6.0, 7.0, 5.0)
Dim box2 As New Child(12.0, 13.0, 10.0)
Console.WriteLine("box1 volume is: {0}", box1.getVolume())
Console.WriteLine("box2 volume is: {0}", box2.getVolume())
End Sub
Is it possible (using COM and regasm.exe) to have a vba function call a vb.net function - which creates the class in vb.net and then passes the class back to vba, where it is recognised as a vba class?
In VBA, I can work with classes by using Insert>Class Module. I have set up a function that creates a class.
Private length As Double
Private height As Double
Public Sub init(ByRef hgt As Double)
height = hgt
length = dbl_height()
End Sub
Public Function dbl_height()
dbl_height = height * 2
End Function
I can initialize it accordingly using this function:
Public Function CreateClassFunction(foo As Integer)
Dim my_rect As Rectangle
Set my_rect = New Rectangle
my_rect.init (foo)
Set CreateClassFunction = my_rect
End Function
I can also do the same thing in vb.net with virtually identical code.
Public Class Rectangle
Private length As Double
Private height As Double
Public Sub init(ByRef hgt As Double)
height = hgt
length = dbl_height()
End Sub
Public Function dbl_height()
dbl_height = height * 2
End Function
End Class
where this vb.net function creates the class:
Public Function CreateClassFunction(foo As Integer) As Rectangle
Dim my_rect As Rectangle
my_rect = New Rectangle
my_rect.init(foo)
CreateClassFunction = my_rect
End Function
I can pull in a Variant/Object/Rectangle into vba using:
Function MyCreateClass(a As Double)
Dim classLib As New MyAnalytics.Class1
Set MyCreateClass = classLib.CreateClassFunction(a)
End Function
However this object does not have the height or length variables. (It says "no variables" on the watch window)
Edit:
Amended code as per Mat's Mug answer:
Public Class Rectangle
Private plength As Double
Private pheight As Double
Public Property length() As Double
Get
Return plength
End Get
Set(ByVal value As Double)
plength = value
End Set
End Property
Public Property height() As Double
Get
Return pheight
End Get
Set(ByVal value As Double)
pheight = value
End Set
End Property
Public Sub init(ByRef hgt As Double)
height = hgt
length = dbl_height()
End Sub
Public Function dbl_height()
dbl_height = height * 2
End Function
End Class
and testing in VBA:
Function MyCreateClass(a As Double)
Dim classLib As New MyAnalytics.Class1
Set MyCreateClass = classLib.CreateClassFunction(a)
Debug.Print MyCreateClass.Height()
Debug.Print MyCreateClass.length()
MyCreateClass.Height = 30
MyCreateClass.length = 20
Debug.Print MyCreateClass.Height()
Debug.Print MyCreateClass.length()
MyCreateClass.init (100)
Debug.Print MyCreateClass.Height()
Debug.Print MyCreateClass.length()
End Function
It won't be recognized as a VBA class - it's not a VBA class, but a COM object.
Your Rectangle class has private fields. Private fields are, well, Private. This is, roughly, what VBA sees:
Public Class Rectangle
Sub init(ByRef hgt As Double)
Function dbl_height()
End Class
Where are the fields?
Private length As Double
Private height As Double
You haven't exposed them - as far as VBA goes, they don't exist.
Now, you could make them Public - but then you would be breaking encapsulation by exposing fields; don't do that!
Expose property getters instead, and setters if you want VBA code to be able to change the Length and Height properties of a Rectangle instance.
I've used the following code, taken from here, to create my own custom column for datagridview, so that I can now have images and text in the same cell:
Public Class TextAndImageColumn
Inherits DataGridViewTextBoxColumn
Private imageValue As Image
Private m_imageSize As Size
Public Sub New()
Me.CellTemplate = New TextAndImageCell
End Sub
Public Overloads Overrides Function Clone() As Object
Dim c As TextAndImageColumn = TryCast(MyBase.Clone, TextAndImageColumn)
c.imageValue = Me.imageValue
c.m_imageSize = Me.m_imageSize
Return c
End Function
Public Property Image() As Image
Get
Return Me.imageValue
End Get
Set(ByVal value As Image)
Me.imageValue = value
Me.m_imageSize = value.Size
Dim inheritedPadding As Padding = Me.DefaultCellStyle.Padding
Me.DefaultCellStyle.Padding = New Padding(ImageSize.Width, inheritedPadding.Top, inheritedPadding.Right, inheritedPadding.Bottom)
End Set
End Property
Private ReadOnly Property TextAndImageCellTemplate() As TextAndImageCell
Get
Return TryCast(Me.CellTemplate, TextAndImageCell)
End Get
End Property
Friend ReadOnly Property ImageSize() As Size
Get
Return m_imageSize
End Get
End Property
End Class
Public Class TextAndImageCell
Inherits DataGridViewTextBoxCell
Private imageValue As Image
Private imageSize As Size
Public Overloads Overrides Function Clone() As Object
Dim c As TextAndImageCell = TryCast(MyBase.Clone, TextAndImageCell)
c.imageValue = Me.imageValue
c.imageSize = Me.imageSize
Return c
End Function
Public Property Image() As Image
Get
If Me.OwningColumn Is Nothing OrElse Me.OwningTextAndImageColumn Is Nothing Then
Return imageValue
Else
If Not (Me.imageValue Is Nothing) Then
Return Me.imageValue
Else
Return Me.OwningTextAndImageColumn.Image
End If
End If
End Get
Set(ByVal value As Image)
Me.imageValue = value
Me.imageSize = value.Size
Dim inheritedPadding As Padding = Me.InheritedStyle.Padding
Me.Style.Padding = New Padding(imageSize.Width, inheritedPadding.Top, inheritedPadding.Right, inheritedPadding.Bottom)
End Set
End Property
Protected Overloads Overrides Sub Paint(graphics As Graphics, clipBounds As Rectangle, cellBounds As Rectangle,
rowIndex As Integer, cellState As DataGridViewElementStates, value As Object, formattedValue As Object,
errorText As String, cellStyle As DataGridViewCellStyle, advancedBorderStyle As DataGridViewAdvancedBorderStyle,
paintParts As DataGridViewPaintParts)
MyBase.Paint(graphics, clipBounds, cellBounds, rowIndex, cellState, value, formattedValue, errorText, cellStyle, advancedBorderStyle, paintParts)
If Not (Me.Image Is Nothing) Then
Dim container As System.Drawing.Drawing2D.GraphicsContainer = graphics.BeginContainer
graphics.SetClip(cellBounds)
graphics.DrawImageUnscaled(Me.Image, cellBounds.Location)
graphics.EndContainer(container)
End If
End Sub
Private ReadOnly Property OwningTextAndImageColumn() As TextAndImageColumn
Get
Return TryCast(Me.OwningColumn, TextAndImageColumn)
End Get
End Property
End Class
It works very well, except that the image that I use is right at the edges of the cell. I'd like to give it a small margin. How can I do this?
You could add a property to TextAndImageCell like :
Private m_imagePadding As New Padding(3)
Public Property ImagePadding() As Padding
Get
Return m_imagePadding
End Get
Set(ByVal value As Padding)
m_imagePadding = value
End Set
End Property
and implement (in Paint) like :
graphics.DrawImageUnscaled(Me.Image, _
New Point(cellBounds.Location.X + m_imagePadding.Left, _
cellBounds.Location.Y + m_imagePadding.Top))
also would need to change in TextAndImageColumn :
Me.DefaultCellStyle.Padding = New Padding(ImageSize.Width + _
TextAndImageCellTemplate.ImagePadding.Right, inheritedPadding.Top, _
inheritedPadding.Right, inheritedPadding.Bottom)
There's room for refinement, obviously (trigger redraws on padding change, sort out row heights, text padding, etc) but something like this should work.