vbAccelerator - Contents of code file: frmTest.frmVERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmTest
Caption = "vbAccelerator No Status Bar"
ClientHeight = 3405
ClientLeft = 4905
ClientTop = 3885
ClientWidth = 6585
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTest.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3405
ScaleWidth = 6585
Begin VB.CommandButton cmdAdd
Caption = "&Add Panel..."
Height = 375
Left = 60
TabIndex = 6
Top = 1320
Width = 1155
End
Begin VB.Timer tmrClock
Interval = 500
Left = 6060
Top = 1560
End
Begin VB.CommandButton cmdDel
Caption = "&Delete Panel"
Height = 375
Left = 60
TabIndex = 1
Top = 1740
Width = 1155
End
Begin VB.PictureBox picStatus
Align = 2 'Align Bottom
Height = 495
Left = 0
ScaleHeight = 435
ScaleWidth = 6525
TabIndex = 0
Top = 2910
Width = 6585
End
Begin VB.Label lblVBAccel
BackStyle = 0 'Transparent
Caption = "Advanced, free source code at
http://vbaccelerator.com"
ForeColor = &H0080C0FF&
Height = 375
Left = 2640
TabIndex = 4
Top = 420
Width = 2715
End
Begin VB.Image imgVBAccel
Height = 660
Left = 60
Picture = "frmTest.frx":1272
Top = 120
Width = 2535
End
Begin VB.Label lblLogoStripe
BackColor = &H000040C0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2580
TabIndex = 5
Top = 390
Width = 3855
End
Begin VB.Label lblLogoBack
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
Caption = "Label1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 795
Left = 0
TabIndex = 3
Top = 60
Width = 6555
End
Begin VB.Label lblSimple
Alignment = 2 'Center
BackColor = &H80000002&
Caption = "Click and hold/drag to demo simple mode"
ForeColor = &H80000009&
Height = 255
Left = 60
TabIndex = 2
Top = 1020
Width = 3075
End
Begin ComctlLib.ImageList ilsIcons
Left = 5940
Top = 960
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 4
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":1AFB
Key = "EDIT"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":1E15
Key = "VIEW"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":212F
Key = "MAIL"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTest.frx":2449
Key = "NEW"
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_cSBar As cNoStatusBar
Private Sub cmdAdd_Click()
Dim sI As String
Dim iPos As Long
sI = InputBox$("This inserts a panel with a random icon at a random
location." & vbCrLf & "Panel caption?", , "New Panel")
If (sI <> "") Then
iPos = Rnd * m_cSBar.PanelCount + 1
If (m_cSBar.PanelCount = 0) Or (iPos >= m_cSBar.PanelCount) Then
' Add to end
m_cSBar.AddPanel , sI, Rnd * ilsIcons.ListImages.Count
Else
' Insert panel
m_cSBar.AddPanel , sI, Rnd * ilsIcons.ListImages.Count, , , , , , iPos
End If
End If
End Sub
Private Sub cmdDel_Click()
If (m_cSBar.PanelCount > 0) Then
m_cSBar.RemovePanel m_cSBar.PanelCount
End If
End Sub
Private Sub Command1_Click()
m_cSBar.AddPanel , "Test", 1, , , , , , 1
End Sub
Private Sub Form_Load()
Set m_cSBar = New cNoStatusBar
With m_cSBar
.Create picStatus
picStatus.BorderStyle = 0
picStatus.ZOrder
.ImageList = ilsIcons
.AddPanel , , 0, 8, , , , "ICON"
.AddPanel , "This is the main no-status bar panel", , , True, , , "MAIN"
.AddPanel , "Mail", 3, , , , , "MAIL"
.AddPanel , Format$(Now, "short time"), , 0, , True, , "CLOCK"
.SizeGrip = True
picStatus.Height = .Height
End With
End Sub
Private Sub Form_Resize()
On Error Resume Next
lblLogoBack.Width = Me.ScaleWidth - lblLogoBack.Left * 2
lblLogoStripe.Width = lblLogoBack.Width - lblLogoStripe.Left - 4 *
Screen.TwipsPerPixelX
lblSimple.Width = Me.ScaleWidth - lblSimple.Left * 2
End Sub
Private Sub lblSimple_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
m_cSBar.SimpleMode = True
m_cSBar.SimpleText = "Drag mouse to see X,Y"
End Sub
Private Sub lblSimple_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If (Button = vbLeftButton) Then
m_cSBar.SimpleText = "Position (twips): " & X & "," & Y
End If
End Sub
Private Sub lblSimple_MouseUp(Button As Integer, Shift As Integer, X As Single,
Y As Single)
m_cSBar.SimpleMode = False
End Sub
Private Sub picStatus_Paint()
m_cSBar.Draw
End Sub
Private Sub picStatus_Resize()
picStatus_Paint
End Sub
Private Sub tmrClock_Timer()
If (m_cSBar.PanelExists("CLOCK")) Then
If (m_cSBar.PanelText("CLOCK") <> Format$(Now, "short time")) Then
m_cSBar.PanelText("CLOCK") = Format$(Now, "short time")
End If
End If
End Sub
|
|