| ' Description:Show a Nice About Form ' 'Assumes:Create a form and place a label, button and 'timer in form Copy this code into the form module Make sure To Set the index Property of the label to 0, it must Not remain blank. ' 'Sample Code 'This code shows several different things 'runtime manipulation of controls 'some fun with movement of controls. 'Instructions: 'Create a form and place a label, button and 'timer in form Copy this code into the form module ' Make sure to set the index property of the label to 0, it must not remain blank. Option Explicit 'This makes you Declare all references Dim lCenterX As Long Dim lCenterY As Long Dim lRadiusX() As Long Dim lRadiusY() As Long Dim dblSpeedX() As Double Dim dblSpeedY() As Double Dim dblAngleX() As Double Dim dblAngleY() As Double 'You can mess with these constants Const conInterval = 100 'Timer Interval in 1/1000th of a second units, this controls how often labels are redrawn Const conFormWidth = 5 'Form Width In Inches Const conFormHeight = 3 'Form Height In Inches Const conSpeedAdjust = 0.2 'Speed Adjust ment, the higher the number the faster the labels will move Dim pi As Double Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() Dim l As Label Dim intCount As Integer Dim intMax As Integer On Error Goto Error_Form_Load Me.WhatsThisMode Me.Caption = "About" 'Setup Form width and height Me.Width = Me.ScaleX(conFormWidth, vbInches, Me.ScaleMode) Me.Height = Me.ScaleY(conFormHeight, vbInches, Me.ScaleMode) 'Setup Command Button Me.Command1.Caption = "Close" Me.Command1.Font.Name = "Arial" Me.Command1.Font.Size = Me.ScaleY(0.125, vbInches, vbPoints) Me.Command1.Font.Bold = True SetButtonSize Me.Command1 Me.Command1.Left = Me.ScaleX(0.125, vbInches, Me.ScaleMode) Me.Command1.Top = Me.ScaleHeight - Me.Command1.Height - Me.ScaleY(0.125, vbInches, Me.ScaleMode) 'Setup first label for Product name 'If you get a compile error here when you run the program 'You need to make sure you set the index property for this label to 0 (Zero). Set l = Me.Label1(0) 'Set font to be Arial Italic Bold and to be 1/4 inch high l.Font.Name = "Arial" l.Font.Size = Me.ScaleY(0.25, vbInches, vbPoints) l.Font.Italic = True l.Font.Bold = True l.Alignment = vbCenter l.BackStyle = vbTransparent l.Appearance = 0'Flat style l.BorderStyle = vbTransparent l.Top = 0 l.Caption = App.ProductName SetLabelSize l CenterLabel l l.Top = 0 'Set up version label Load Me.Label1(1) Set l = Me.Label1(1) l.Visible = True l.Font.Size = Me.ScaleY(0.125, vbInches, vbPoints) l.Font.Italic = False l.Font.Bold = False l.BackStyle = vbTransparent l.BorderStyle = vbTransparent l.Alignment = vbRightJustify l.Caption = "Ver. " & App.Major & "." & Format(App.Minor, "000") & "." & Format(App.Revision, "000") SetLabelSize l l.Top = Me.ScaleHeight - l.Height l.Left = Me.ScaleWidth - l.Width 'First Moveable Label Load Me.Label1(2) Set l = Me.Label1(2) l.Caption = "Roger Reeder" l.Visible = True l.Font.Size = Me.ScaleY(0.25, vbInches, vbPoints) l.Font.Italic = False l.Font.Bold = True l.BackStyle = vbTransparent l.BorderStyle = vbTransparent l.ForeColor = RGB(0, 0, 200) l.Alignment = vbCenter SetLabelSize l CenterLabel l 'Second Moveable Label Load Me.Label1(3) Set l = Me.Label1(3) l.Caption = "reederr@wpx-nw.com" l.Visible = True l.Font.Size = Me.ScaleY(0.1, vbInches, vbPoints) l.Font.Italic = False l.Font.Bold = False l.BackStyle = vbTransparent l.BorderStyle = vbTransparent l.Alignment = vbCenter SetLabelSize l CenterLabel l l.Top = Me.Label1(2).Top + Me.Label1(2).Height 'Third Moveable Label Load Me.Label1(4) Set l = Me.Label1(4) l.Caption = "Big" l.Visible = True l.Font.Size = Me.ScaleY(0.5, vbInches, vbPoints) l.Font.Italic = False l.Font.Bold = False l.BackStyle = vbTransparent l.BorderStyle = vbTransparent l.Alignment = vbCenter SetLabelSize l CenterLabel l l.Top = Me.Label1(4).Top + Me.Label1(4).Height 'You can make as many moveable labels as you want by continuing to load incremental me.Label1(x) 'Individual Angle, speed and radius of each label that is going to move ReDim dblSpeedX(Me.Label1.Count - 2) ReDim dblSpeedY(Me.Label1.Count - 2) ReDim dblAngleX(Me.Label1.Count - 2) ReDim dblAngleY(Me.Label1.Count - 2) ReDim lRadiusX(Me.Label1.Count - 2) ReDim lRadiusY(Me.Label1.Count - 2) 'Set pi pi = 4 * Atn(1) 'Center X and Y based on inside width and height of form lCenterX = Me.ScaleWidth / 2 lCenterY = Me.ScaleHeight / 2 'Setup moveable labels intMax = Me.Label1.Count - 3 Randomize For intCount = 0 To intMax Me.Label1(intCount + 2).MousePointer = vbArrowQuestion dblSpeedX(intCount) = 0.5 + Rnd * conSpeedAdjust - conSpeedAdjust / 2 dblSpeedY(intCount) = 0.5 + Rnd * conSpeedAdjust - conSpeedAdjust / 2 dblAngleX(intCount) = Rnd * 180 dblAngleY(intCount) = Rnd * 180 lRadiusX(intCount) = lCenterX - Me.Label1(intCount + 2).Width / 2 lRadiusY(intCount) = lCenterY - Me.Label1(intCount + 2).Height / 2 Next intCount Me.Timer1.Interval = conInterval Exit Sub Error_Form_Load: Select Case Err.Number Case Else MsgBox Err.Number & ": " & Err.Description, vbCritical, "Error Loading Form" End Select End Sub Private Sub Label1_Click(Index As Integer) MsgBox "You clicked On " & Me.Label1(Index).Caption, vbInformation, "Label Click" End Sub Private Sub Timer1_Timer() Dim intCount As Integer Dim intMax As Integer intMax = Me.Label1.Count - 3 For intCount = 0 To intMax Me.Label1(intCount + 2).Left = lCenterX + (Sin(pi / 180 * dblAngleX(intCount)) * lRadiusX(intCount)) - Me.Label1(intCount + 2).Width / 2 Me.Label1(intCount + 2).Top = lCenterY + (Cos(pi / 180 * dblAngleY(intCount)) * lRadiusY(intCount)) - Me.Label1(intCount + 2).Height / 2 dblAngleX(intCount) = dblAngleX(intCount) + dblSpeedX(intCount) dblAngleY(intCount) = dblAngleY(intCount) + dblSpeedY(intCount) dblSpeedX(intCount) = dblSpeedX(intCount) + (Rnd * conSpeedAdjust - conSpeedAdjust / 2) dblSpeedY(intCount) = dblSpeedY(intCount) + (Rnd * conSpeedAdjust - conSpeedAdjust / 2) Next intCount End Sub Private Sub CenterLabel(l As Label) l.Left = l.Parent.ScaleWidth / 2 - l.Width / 2 l.Top = l.Parent.ScaleHeight / 2 - l.Height / 2 End Sub Private Sub SetLabelSize(l As Label) Me.Font.Name = l.Font.Name Me.Font.Size = l.Font.Size Me.Font.Bold = l.Font.Bold Me.Font.Italic = l.Font.Italic 'Need to take into account BorderStyle l.Width = Me.TextWidth(l.Caption) + IIf(l.BorderStyle <> vbTransparent, Me.ScaleX(2, vbPixels, Me.ScaleMode) * 2, 0) l.Height = Me.TextHeight(l.Caption) + IIf(l.BorderStyle <> vbTransparent, Me.ScaleY(2, vbPixels, Me.ScaleMode) * 2, 0) End Sub Private Sub SetButtonSize(b As CommandButton) Me.Font.Name = b.Font.Name Me.Font.Size = b.Font.Size Me.Font.Bold = b.Font.Bold Me.Font.Italic = b.Font.Italic b.Width = Me.TextWidth(b.Caption) + Me.ScaleX(6, vbPixels, Me.ScaleMode) * 2 b.Height = Me.TextHeight(b.Caption) + Me.ScaleY(4, vbPixels, Me.ScaleMode) * 2 End Sub |
Neat About Form |
Express News India | Freelance ecommerce web development India