home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 26
/
CD_ASCQ_26_1295.iso
/
vrac
/
sbardemo.zip
/
FORM1.FRM
< prev
next >
Wrap
Text File
|
1995-08-18
|
11KB
|
359 lines
VERSION 2.00
Begin Form Form1
BackColor = &H00808080&
Caption = "Status Bar Demo..."
ClientHeight = 2184
ClientLeft = 1800
ClientTop = 1248
ClientWidth = 2760
Height = 2604
KeyPreview = -1 'True
Left = 1752
LinkTopic = "Form1"
ScaleHeight = 2184
ScaleWidth = 2760
Top = 876
Width = 2856
Begin CommandButton Command1
Caption = "Flash Message"
Height = 300
Left = 72
TabIndex = 5
Top = 648
Width = 2604
End
Begin TextBox Text1
FontBold = 0 'False
FontItalic = 0 'False
FontName = "Courier New"
FontSize = 7.8
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 516
Left = 72
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Text = "Text1"
Top = 72
Width = 2604
End
Begin PictureBox StatusBar
Height = 456
Left = 72
ScaleHeight = 432
ScaleWidth = 2592
TabIndex = 1
Top = 1656
Width = 2616
Begin Timer StatTimer
Enabled = 0 'False
Interval = 200
Left = 72
Top = 72
End
Begin Label BogusLabel
BackStyle = 0 'Transparent
Caption = "Status Bar Panels Here!"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 7.8
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 228
Left = 504
TabIndex = 2
Top = 72
Visible = 0 'False
Width = 2028
End
End
Begin CommandButton Command2
Caption = "Exit"
Height = 300
Left = 72
TabIndex = 0
Top = 936
Width = 2604
End
Begin PictureBox sbar_pics
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 216
Left = 72
Picture = FORM1.FRX:0000
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 80
TabIndex = 4
Top = 1296
Visible = 0 'False
Width = 984
End
Begin Menu mnuPopUp
Caption = "&PopUp"
Visible = 0 'False
Begin Menu mnuPopItem
Caption = "&Dummy"
Index = 0
End
End
End
Option Explicit
Dim sb_panels() As PanelType
Dim sb_initialized As Integer
Dim iSwitchCount%
Dim bFlash%
Sub Command1_Click ()
If bFlash% Then
bFlash% = False
DisplayStatusBar StatusBar, sb_panels()
Command1.Caption = "Flash Message"
Else
bFlash% = True
FlashMessage StatusBar, "This is a Flashed Message.."
Command1.Caption = "Restore Status Bar"
End If
End Sub
Sub Command2_Click ()
StatTimer.Enabled = False
Unload Me
End
End Sub
Sub CreatePanels ()
'Use this procedure to create the panels you want...
'Call it from the Form_Load() Event...
'For use in multiple forms, cut and paste this into the general declarations section of
'each form. See the README.TXT file for more information.
Dim iMaxPanels%
iMaxPanels% = 9
ReDim sb_panels(iMaxPanels%)
sb_panels(1).sCaption = "Text Panel"
sb_panels(1).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
sb_panels(1).PanelStyle.iFormat = SBAR_TEXT
'sb_panels(1).sFontName =
'sb_panels(1).sFontSize =
'sb_panels(1).lFontColor =
'sb_panels(1).iFont3D = True
sb_panels(1).iFontBold = True
sb_panels(1).bVisible = True
sb_panels(2).sCaption = "Mixed Panel"
sb_panels(2).PanelStyle.iOther = 1
sb_panels(2).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
sb_panels(2).PanelStyle.iFormat = SBAR_ICONMIX
'sb_panels(2).PanelStyle.iBorderStyle = SBAR_PANEL_RAISED
'sb_panels(2).sFontName = "Courier New"
'sb_panels(2).sFontSize = "6.0"
'sb_panels(2).lFontColor = &HFF
'sb_panels(2).iFont3D = True
sb_panels(2).iFontBold = True
sb_panels(2).bVisible = True
sb_panels(3).sCaption = " Click This Button "
'sb_panels(3).PanelStyle.iBorderStyle = SBAR_PANEL_FLAT
sb_panels(3).PanelStyle.iFormat = SBAR_BUTTON
'sb_panels(3).sFontName = "Courier New"
'sb_panels(3).sFontSize = "6.0"
'sb_panels(3).lFontColor = &HFF
'sb_panels(3).iFont3D = True
sb_panels(3).iFontBold = True
sb_panels(3).bVisible = True
'sb_panels(4).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
sb_panels(4).PanelStyle.iOther = 3
sb_panels(4).PanelStyle.iFormat = SBAR_MINICON
'sb_panels(4).sFontName = "Courier New"
'sb_panels(4).sFontSize = "6.0"
'sb_panels(4).lFontColor = &HFF
'sb_panels(4).iFont3D = True
'sb_panels(4).iFontBold = True
sb_panels(4).bVisible = True
sb_panels(5).sCaption = "0%"
sb_panels(5).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
sb_panels(5).PanelStyle.iFormat = SBAR_METER
'sb_panels(5).sFontName = "Courier New"
'sb_panels(5).sFontSize = "6.0"
'sb_panels(5).lFontColor = &HFF
'sb_panels(5).iFont3D = True
'sb_panels(5).iFontBold = True
sb_panels(5).bVisible = True
sb_panels(6).sCaption = "Fixed Text"
'sb_panels(6).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
sb_panels(6).PanelStyle.iFormat = SBAR_FIXEDTEXT
'sb_panels(6).sFontName = "Courier New"
'sb_panels(6).sFontSize = "6.0"
sb_panels(6).lFontColor = &HFF
'sb_panels(6).iFont3D = True
sb_panels(6).iFontBold = True
sb_panels(6).bVisible = True
sb_panels(7).PanelStyle.iBorderStyle = SBAR_PANEL_RAISED
sb_panels(7).PanelStyle.iFormat = SBAR_CAPSLOCK
'sb_panels(7).PanelStyle.iOther = 3
'sb_panels(7).sFontName = "Courier New"
'sb_panels(7).sFontSize = "6.0"
'sb_panels(7).lFontColor = &HFF
'sb_panels(7).iFont3D = True
'sb_panels(7).iFontBold = True
sb_panels(7).bVisible = True
'sb_panels(8).sCaption = "Fixed Text Panel"
sb_panels(8).PanelStyle.iBorderStyle = SBAR_PANEL_RAISED
sb_panels(8).PanelStyle.iFormat = SBAR_NUMLOCK
'sb_panels(8).sFontName = "Arial"
'sb_panels(8).sFontSize = "6.0"
'sb_panels(8).lFontColor = &HFF
'sb_panels(8).iFont3D = True
'sb_panels(8).iFontBold = True
sb_panels(8).bVisible = True
'sb_panels(9).PanelStyle.iOther = 3
sb_panels(9).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
sb_panels(9).PanelStyle.iFormat = SBAR_FULLDATE
'sb_panels(9).sFontName = "Courier New"
'sb_panels(9).sFontSize = "6.0"
'sb_panels(9).lFontColor = &HFF
'sb_panels(9).iFont3D = True
'sb_panels(9).iFontBold = True
sb_panels(9).bVisible = True
'sb_panels(10).sCaption = "Mixed Panel"
'sb_panels(10).PanelStyle.iOther = 1
'sb_panels(10).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
'sb_panels(10).PanelStyle.iFormat = SBAR_ICONMIX
'sb_panels(10).sFontName = "Courier New"
'sb_panels(10).sFontSize = "6.0"
'sb_panels(10).lFontColor = &HFF
'sb_panels(10).iFont3D = True
'sb_panels(10).iFontBold = True
'sb_panels(10).bVisible = True
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
'In order for this to work, you must have the KeyPreview property set to True
UpdateKeyPanels StatusBar, sb_panels()
End Sub
Sub Form_Load ()
Dim bSuc%, iErr%
Me.Move 0, 0, Screen.Width, Screen.Height * .5
'Create our panels here
CreatePanels
bSuc% = InitializeStatusBar(Me, sb_panels())
sb_initialized = True
If Not LoadFileToTextBox(Text1, App.Path + "\README.TXT", iErr%) Then
Text1.Text = "Please read the README.TXT file for more information about the Status Bar and how you can add "
Text1.Text = Text1.Text + "Status Bar functionality to your VB application." + Chr$(13) + Chr$(10)
Text1.Text = Text1.Text + Chr$(13) + Chr$(10) + "Author: M. John Rodriguez" + Chr$(13) + Chr$(10)
Text1.Text = Text1.Text + "CompuServer ID: 100321, 620" + Chr$(13) + Chr$(10)
Text1.Text = Text1.Text + "Internet: jrodrigu@cpd.hqusareur.army.mil"
End If
bSuc% = ReadOnlyTextBox(Text1)
End Sub
Sub Form_Resize ()
On Local Error Resume Next
Text1.Move 0, 0, ScaleWidth, ScaleHeight - Command2.Height - Command1.Height - StatusBar.Height - 9
Command1.Move 0, Text1.Height + 3, ScaleWidth
Command2.Move 0, Command1.Top + Command1.Height + 3, ScaleWidth
End Sub
Sub StatTimer_Timer ()
'Here you can update the toggle and the time panels
UpdateStatusPanels StatusBar, sb_panels()
'UpdateTimePanels StatusBar, sb_panels()
'UpdateTextPanel StatusBar, sb_panels(1), "The Time is..."
'UpdateTextPanel StatusBar, sb_panels(7), Format$(Now, "ss")
iSwitchCount% = iSwitchCount% + 1
If iSwitchCount% > 4 Then
sb_panels(4).PanelStyle.iOther = sb_panels(4).PanelStyle.iOther + 1
If sb_panels(4).PanelStyle.iOther > 5 Then sb_panels(4).PanelStyle.iOther = 3
iSwitchCount% = 0
DrawStatusPanel StatusBar, sb_panels(4)
sb_panels(5).PanelStyle.iOther = sb_panels(5).PanelStyle.iOther + 1
If sb_panels(5).PanelStyle.iOther > 100 Then sb_panels(5).PanelStyle.iOther = 0
If sb_panels(5).PanelStyle.iOther < 33 Then
sb_panels(5).PanelStyle.lOther = &HFF&
ElseIf sb_panels(5).PanelStyle.iOther < 66 Then
sb_panels(5).PanelStyle.lOther = &HFFFF&
Else
sb_panels(5).PanelStyle.lOther = &HFF00&
End If
sb_panels(5).sCaption = Trim$(Str$(sb_panels(5).PanelStyle.iOther)) + "%"
DrawStatusPanel StatusBar, sb_panels(5)
End If
End Sub
Sub StatusBar_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'If you have any buttons in your status bar, use this procedure here to generate
SBarMouseDown StatusBar, Button, Shift, X, Y, sb_panels()
End Sub
Sub StatusBar_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
SBarMouseDown StatusBar, Button, Shift, X, Y, sb_panels()
End Sub
Sub StatusBar_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
SBarMouseUp StatusBar, Button, Shift, X, Y, sb_panels()
End Sub
Sub StatusBar_Resize ()
If Me.WindowState <> 1 Then
If sb_initialized Then DisplayStatusBar Me.StatusBar, sb_panels()
End If
'sbar_pics.Top = StatusBar.ScaleHeight + 20
End Sub