home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / sbardemo.zip / FORM1.FRM < prev    next >
Text File  |  1995-08-18  |  11KB  |  359 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00808080&
  4.    Caption         =   "Status Bar Demo..."
  5.    ClientHeight    =   2184
  6.    ClientLeft      =   1800
  7.    ClientTop       =   1248
  8.    ClientWidth     =   2760
  9.    Height          =   2604
  10.    KeyPreview      =   -1  'True
  11.    Left            =   1752
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   2184
  14.    ScaleWidth      =   2760
  15.    Top             =   876
  16.    Width           =   2856
  17.    Begin CommandButton Command1 
  18.       Caption         =   "Flash Message"
  19.       Height          =   300
  20.       Left            =   72
  21.       TabIndex        =   5
  22.       Top             =   648
  23.       Width           =   2604
  24.    End
  25.    Begin TextBox Text1 
  26.       FontBold        =   0   'False
  27.       FontItalic      =   0   'False
  28.       FontName        =   "Courier New"
  29.       FontSize        =   7.8
  30.       FontStrikethru  =   0   'False
  31.       FontUnderline   =   0   'False
  32.       Height          =   516
  33.       Left            =   72
  34.       MultiLine       =   -1  'True
  35.       ScrollBars      =   2  'Vertical
  36.       TabIndex        =   3
  37.       Text            =   "Text1"
  38.       Top             =   72
  39.       Width           =   2604
  40.    End
  41.    Begin PictureBox StatusBar 
  42.       Height          =   456
  43.       Left            =   72
  44.       ScaleHeight     =   432
  45.       ScaleWidth      =   2592
  46.       TabIndex        =   1
  47.       Top             =   1656
  48.       Width           =   2616
  49.       Begin Timer StatTimer 
  50.          Enabled         =   0   'False
  51.          Interval        =   200
  52.          Left            =   72
  53.          Top             =   72
  54.       End
  55.       Begin Label BogusLabel 
  56.          BackStyle       =   0  'Transparent
  57.          Caption         =   "Status Bar Panels Here!"
  58.          FontBold        =   0   'False
  59.          FontItalic      =   0   'False
  60.          FontName        =   "MS Sans Serif"
  61.          FontSize        =   7.8
  62.          FontStrikethru  =   0   'False
  63.          FontUnderline   =   0   'False
  64.          Height          =   228
  65.          Left            =   504
  66.          TabIndex        =   2
  67.          Top             =   72
  68.          Visible         =   0   'False
  69.          Width           =   2028
  70.       End
  71.    End
  72.    Begin CommandButton Command2 
  73.       Caption         =   "Exit"
  74.       Height          =   300
  75.       Left            =   72
  76.       TabIndex        =   0
  77.       Top             =   936
  78.       Width           =   2604
  79.    End
  80.    Begin PictureBox sbar_pics 
  81.       AutoRedraw      =   -1  'True
  82.       AutoSize        =   -1  'True
  83.       Height          =   216
  84.       Left            =   72
  85.       Picture         =   FORM1.FRX:0000
  86.       ScaleHeight     =   16
  87.       ScaleMode       =   3  'Pixel
  88.       ScaleWidth      =   80
  89.       TabIndex        =   4
  90.       Top             =   1296
  91.       Visible         =   0   'False
  92.       Width           =   984
  93.    End
  94.    Begin Menu mnuPopUp 
  95.       Caption         =   "&PopUp"
  96.       Visible         =   0   'False
  97.       Begin Menu mnuPopItem 
  98.          Caption         =   "&Dummy"
  99.          Index           =   0
  100.       End
  101.    End
  102. End
  103. Option Explicit
  104.  
  105. Dim sb_panels() As PanelType
  106. Dim sb_initialized As Integer
  107.  
  108. Dim iSwitchCount%
  109.  
  110. Dim bFlash%
  111.  
  112. Sub Command1_Click ()
  113.  
  114. If bFlash% Then
  115.     bFlash% = False
  116.     DisplayStatusBar StatusBar, sb_panels()
  117.     Command1.Caption = "Flash Message"
  118. Else
  119.     bFlash% = True
  120.     FlashMessage StatusBar, "This is a Flashed Message.."
  121.     Command1.Caption = "Restore Status Bar"
  122. End If
  123.  
  124.  
  125. End Sub
  126.  
  127. Sub Command2_Click ()
  128.  
  129. StatTimer.Enabled = False
  130.  
  131. Unload Me
  132.  
  133. End
  134.  
  135. End Sub
  136.  
  137. Sub CreatePanels ()
  138.  
  139.  
  140. 'Use this procedure to create the panels you want...
  141. 'Call it from the Form_Load() Event...
  142. 'For use in multiple forms, cut and paste this into the general declarations section of
  143. 'each form.  See the README.TXT file for more information.
  144.  
  145. Dim iMaxPanels%
  146.  
  147. iMaxPanels% = 9
  148.  
  149. ReDim sb_panels(iMaxPanels%)
  150.  
  151. sb_panels(1).sCaption = "Text Panel"
  152. sb_panels(1).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  153. sb_panels(1).PanelStyle.iFormat = SBAR_TEXT
  154. 'sb_panels(1).sFontName =
  155. 'sb_panels(1).sFontSize =
  156. 'sb_panels(1).lFontColor =
  157. 'sb_panels(1).iFont3D = True
  158. sb_panels(1).iFontBold = True
  159. sb_panels(1).bVisible = True
  160.  
  161. sb_panels(2).sCaption = "Mixed Panel"
  162. sb_panels(2).PanelStyle.iOther = 1
  163. sb_panels(2).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  164. sb_panels(2).PanelStyle.iFormat = SBAR_ICONMIX
  165. 'sb_panels(2).PanelStyle.iBorderStyle = SBAR_PANEL_RAISED
  166. 'sb_panels(2).sFontName = "Courier New"
  167. 'sb_panels(2).sFontSize = "6.0"
  168. 'sb_panels(2).lFontColor = &HFF
  169. 'sb_panels(2).iFont3D = True
  170. sb_panels(2).iFontBold = True
  171. sb_panels(2).bVisible = True
  172.  
  173. sb_panels(3).sCaption = " Click This Button "
  174. 'sb_panels(3).PanelStyle.iBorderStyle = SBAR_PANEL_FLAT
  175. sb_panels(3).PanelStyle.iFormat = SBAR_BUTTON
  176. 'sb_panels(3).sFontName = "Courier New"
  177. 'sb_panels(3).sFontSize = "6.0"
  178. 'sb_panels(3).lFontColor = &HFF
  179. 'sb_panels(3).iFont3D = True
  180. sb_panels(3).iFontBold = True
  181. sb_panels(3).bVisible = True
  182.  
  183.  
  184. 'sb_panels(4).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  185. sb_panels(4).PanelStyle.iOther = 3
  186. sb_panels(4).PanelStyle.iFormat = SBAR_MINICON
  187. 'sb_panels(4).sFontName = "Courier New"
  188. 'sb_panels(4).sFontSize = "6.0"
  189. 'sb_panels(4).lFontColor = &HFF
  190. 'sb_panels(4).iFont3D = True
  191. 'sb_panels(4).iFontBold = True
  192. sb_panels(4).bVisible = True
  193.  
  194. sb_panels(5).sCaption = "0%"
  195. sb_panels(5).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  196. sb_panels(5).PanelStyle.iFormat = SBAR_METER
  197. 'sb_panels(5).sFontName = "Courier New"
  198. 'sb_panels(5).sFontSize = "6.0"
  199. 'sb_panels(5).lFontColor = &HFF
  200. 'sb_panels(5).iFont3D = True
  201. 'sb_panels(5).iFontBold = True
  202. sb_panels(5).bVisible = True
  203.  
  204. sb_panels(6).sCaption = "Fixed Text"
  205. 'sb_panels(6).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  206. sb_panels(6).PanelStyle.iFormat = SBAR_FIXEDTEXT
  207. 'sb_panels(6).sFontName = "Courier New"
  208. 'sb_panels(6).sFontSize = "6.0"
  209. sb_panels(6).lFontColor = &HFF
  210. 'sb_panels(6).iFont3D = True
  211. sb_panels(6).iFontBold = True
  212. sb_panels(6).bVisible = True
  213.  
  214. sb_panels(7).PanelStyle.iBorderStyle = SBAR_PANEL_RAISED
  215. sb_panels(7).PanelStyle.iFormat = SBAR_CAPSLOCK
  216. 'sb_panels(7).PanelStyle.iOther = 3
  217. 'sb_panels(7).sFontName = "Courier New"
  218. 'sb_panels(7).sFontSize = "6.0"
  219. 'sb_panels(7).lFontColor = &HFF
  220. 'sb_panels(7).iFont3D = True
  221. 'sb_panels(7).iFontBold = True
  222. sb_panels(7).bVisible = True
  223.  
  224. 'sb_panels(8).sCaption = "Fixed Text Panel"
  225. sb_panels(8).PanelStyle.iBorderStyle = SBAR_PANEL_RAISED
  226. sb_panels(8).PanelStyle.iFormat = SBAR_NUMLOCK
  227. 'sb_panels(8).sFontName = "Arial"
  228. 'sb_panels(8).sFontSize = "6.0"
  229. 'sb_panels(8).lFontColor = &HFF
  230. 'sb_panels(8).iFont3D = True
  231. 'sb_panels(8).iFontBold = True
  232. sb_panels(8).bVisible = True
  233.  
  234. 'sb_panels(9).PanelStyle.iOther = 3
  235. sb_panels(9).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  236. sb_panels(9).PanelStyle.iFormat = SBAR_FULLDATE
  237. 'sb_panels(9).sFontName = "Courier New"
  238. 'sb_panels(9).sFontSize = "6.0"
  239. 'sb_panels(9).lFontColor = &HFF
  240. 'sb_panels(9).iFont3D = True
  241. 'sb_panels(9).iFontBold = True
  242. sb_panels(9).bVisible = True
  243.  
  244. 'sb_panels(10).sCaption = "Mixed Panel"
  245. 'sb_panels(10).PanelStyle.iOther = 1
  246. 'sb_panels(10).PanelStyle.iBorderStyle = SBAR_PANEL_RECESSED
  247. 'sb_panels(10).PanelStyle.iFormat = SBAR_ICONMIX
  248. 'sb_panels(10).sFontName = "Courier New"
  249. 'sb_panels(10).sFontSize = "6.0"
  250. 'sb_panels(10).lFontColor = &HFF
  251. 'sb_panels(10).iFont3D = True
  252. 'sb_panels(10).iFontBold = True
  253. 'sb_panels(10).bVisible = True
  254.  
  255.  
  256. End Sub
  257.  
  258. Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
  259.  
  260. 'In order for this to work, you must have the KeyPreview property set to True
  261.  
  262. UpdateKeyPanels StatusBar, sb_panels()
  263.  
  264. End Sub
  265.  
  266. Sub Form_Load ()
  267.  
  268. Dim bSuc%, iErr%
  269.  
  270. Me.Move 0, 0, Screen.Width, Screen.Height * .5
  271.  
  272. 'Create our panels here
  273. CreatePanels
  274. bSuc% = InitializeStatusBar(Me, sb_panels())
  275. sb_initialized = True
  276.  
  277. If Not LoadFileToTextBox(Text1, App.Path + "\README.TXT", iErr%) Then
  278.     Text1.Text = "Please read the README.TXT file for more information about the Status Bar and how you can add "
  279.     Text1.Text = Text1.Text + "Status Bar functionality to your VB application." + Chr$(13) + Chr$(10)
  280.     Text1.Text = Text1.Text + Chr$(13) + Chr$(10) + "Author:  M. John Rodriguez" + Chr$(13) + Chr$(10)
  281.     Text1.Text = Text1.Text + "CompuServer ID:  100321, 620" + Chr$(13) + Chr$(10)
  282.     Text1.Text = Text1.Text + "Internet:  jrodrigu@cpd.hqusareur.army.mil"
  283. End If
  284.  
  285. bSuc% = ReadOnlyTextBox(Text1)
  286.  
  287.  
  288. End Sub
  289.  
  290. Sub Form_Resize ()
  291.  
  292. On Local Error Resume Next
  293. Text1.Move 0, 0, ScaleWidth, ScaleHeight - Command2.Height - Command1.Height - StatusBar.Height - 9
  294. Command1.Move 0, Text1.Height + 3, ScaleWidth
  295. Command2.Move 0, Command1.Top + Command1.Height + 3, ScaleWidth
  296.  
  297. End Sub
  298.  
  299. Sub StatTimer_Timer ()
  300.  
  301. 'Here you can update the toggle and the time panels
  302. UpdateStatusPanels StatusBar, sb_panels()
  303. 'UpdateTimePanels StatusBar, sb_panels()
  304.  
  305. 'UpdateTextPanel StatusBar, sb_panels(1), "The Time is..."
  306. 'UpdateTextPanel StatusBar, sb_panels(7), Format$(Now, "ss")
  307.  
  308. iSwitchCount% = iSwitchCount% + 1
  309.  
  310. If iSwitchCount% > 4 Then
  311.     sb_panels(4).PanelStyle.iOther = sb_panels(4).PanelStyle.iOther + 1
  312.     If sb_panels(4).PanelStyle.iOther > 5 Then sb_panels(4).PanelStyle.iOther = 3
  313.     iSwitchCount% = 0
  314.     DrawStatusPanel StatusBar, sb_panels(4)
  315.     sb_panels(5).PanelStyle.iOther = sb_panels(5).PanelStyle.iOther + 1
  316.     If sb_panels(5).PanelStyle.iOther > 100 Then sb_panels(5).PanelStyle.iOther = 0
  317.     If sb_panels(5).PanelStyle.iOther < 33 Then
  318.         sb_panels(5).PanelStyle.lOther = &HFF&
  319.     ElseIf sb_panels(5).PanelStyle.iOther < 66 Then
  320.         sb_panels(5).PanelStyle.lOther = &HFFFF&
  321.     Else
  322.         sb_panels(5).PanelStyle.lOther = &HFF00&
  323.     End If
  324.     sb_panels(5).sCaption = Trim$(Str$(sb_panels(5).PanelStyle.iOther)) + "%"
  325.     DrawStatusPanel StatusBar, sb_panels(5)
  326. End If
  327.  
  328. End Sub
  329.  
  330. Sub StatusBar_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  331.  
  332. 'If you have any buttons in your status bar, use this procedure here to generate
  333. SBarMouseDown StatusBar, Button, Shift, X, Y, sb_panels()
  334.  
  335. End Sub
  336.  
  337. Sub StatusBar_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  338.  
  339. SBarMouseDown StatusBar, Button, Shift, X, Y, sb_panels()
  340.  
  341. End Sub
  342.  
  343. Sub StatusBar_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  344.  
  345. SBarMouseUp StatusBar, Button, Shift, X, Y, sb_panels()
  346.  
  347. End Sub
  348.  
  349. Sub StatusBar_Resize ()
  350.  
  351. If Me.WindowState <> 1 Then
  352.     If sb_initialized Then DisplayStatusBar Me.StatusBar, sb_panels()
  353. End If
  354.  
  355. 'sbar_pics.Top = StatusBar.ScaleHeight + 20
  356.  
  357. End Sub
  358.  
  359.