home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch28code / shared.bas < prev    next >
Encoding:
BASIC Source File  |  1995-08-02  |  4.9 KB  |  110 lines
  1. Attribute VB_Name = "basShared"
  2. '*********************************************************************
  3. ' SHARED.BAS - This module contains code that is shared by two or
  4. '              more modules.
  5. '*********************************************************************
  6. Option Explicit
  7. '*********************************************************************
  8. ' Declare SetWindowPos for AlwaysOnTop.
  9. '*********************************************************************
  10. #If Win32 Then
  11. Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd&, _
  12.     ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
  13.     ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Boolean
  14. #Else
  15. Private Declare Function SetWindowPos Lib "User" (ByVal hWnd%, _
  16.         ByVal hb%, ByVal x%, ByVal y%, ByVal cx%, ByVal cy%, _
  17.         ByVal FLAGS%) As Integer
  18. #End If
  19. '*********************************************************************
  20. ' Forces a window to stay in front of all other windows.
  21. '*********************************************************************
  22. Public Sub AlwaysOnTop(FormName As Form, TopMost As Boolean)
  23. Const HWND_TOPMOST = -1
  24. Const HWND_NOTOPMOST = -2
  25. Const SWP_NOSIZE = &H1
  26. Const SWP_NOMOVE = &H2
  27. Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  28.     '*****************************************************************
  29.     ' Set the window to TopMost, and ignore the return value.
  30.     '*****************************************************************
  31.     If TopMost Then
  32.         SetWindowPos FormName.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
  33.     '*****************************************************************
  34.     ' Otherwise, return the window to its normal non-topmost state.
  35.     '*****************************************************************
  36.     Else
  37.         SetWindowPos FormName.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS
  38.     End If
  39. End Sub
  40. '*********************************************************************
  41. ' Displays and unloads the splash form.
  42. '*********************************************************************
  43. Public Sub SplashVisible(bState As Boolean, Optional ByVal sCaption)
  44.     If bState Then
  45.         sCaption = IIf(IsMissing(sCaption), "Loading...Please Wait!", _
  46.                                                            sCaption)
  47.         With frmSplash
  48.             .lblMessage = sCaption
  49.             .Show
  50.             .Refresh
  51.         End With
  52.     Else
  53.         DoEvents
  54.         Unload frmSplash
  55.     End If
  56. End Sub
  57. '*********************************************************************
  58. ' This Procedure draws a 3D button (in either a up or down state),
  59. ' draws a picture, and prints a caption.
  60. '*********************************************************************
  61. Public Sub DrawButton(pBox As PictureBox, IsDown As Boolean, _
  62.                     IsResource As Boolean, Optional ByVal sCaption, _
  63.                     Optional ByVal sIcon)
  64. Dim Offset%, where%, sTag$
  65.     '*****************************************************************
  66.     ' If the button is supposed to be down, then offset it by 2 pixels.
  67.     '*****************************************************************
  68.     On Error Resume Next
  69.     If IsDown Then Offset = 2
  70.     '*****************************************************************
  71.     ' The tag can contain a caption and a name of a sIcon. The format
  72.     ' is "sCaption|sIcon".  If a caption and icon were provided, then
  73.     ' the tag is ignored.
  74.     '*****************************************************************
  75.     sTag = Trim(pBox.Tag)
  76.     where = InStr(sTag, "|")
  77.     If sTag <> "" Then
  78.         sCaption = IIf(IsMissing(sCaption), Left(sTag, where - 1), _
  79.                        sCaption)
  80.         sIcon = IIf(IsMissing(sIcon), Mid(sTag, where + 1), sIcon)
  81.     Else
  82.         sCaption = IIf(IsMissing(sCaption), "", sCaption)
  83.         sIcon = IIf(IsMissing(sIcon), "", sIcon)
  84.     End If
  85.     '*****************************************************************
  86.     ' Clear the picture box, and redraw the 3D effect.
  87.     '*****************************************************************
  88.     pBox.Cls
  89.     Draw3DPicBorder pBox, IsDown
  90.     '*****************************************************************
  91.     ' Paint the picture from a file, or icon resource, then vertically
  92.     ' center position for the caption.
  93.     '*****************************************************************
  94.     With pBox
  95.         If IsResource Then
  96.             .PaintPicture LoadResPicture(sIcon, vbResIcon), 10, _
  97.                 ((pBox.Height / 2) - 16) + Offset
  98.         Else
  99.             .PaintPicture LoadPicture(sIcon), 10, 4 + Offset
  100.         End If
  101.         .CurrentY = (pBox.Height / 2) - (pBox.TextHeight("X") / 2) _
  102.                     + Offset
  103.         .CurrentX = 52
  104.     End With
  105.     '*****************************************************************
  106.     ' Draw the caption.
  107.     '*****************************************************************
  108.     pBox.Print sCaption
  109. End Sub
  110.