home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / sharewar / win95nt / program / msgblast / data.z / SMALLCAP.FRM < prev    next >
Text File  |  1995-09-07  |  8KB  |  253 lines
  1. VERSION 4.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   3000
  5.    ClientLeft      =   3060
  6.    ClientTop       =   1560
  7.    ClientWidth     =   3180
  8.    ClipControls    =   0   'False
  9.    ControlBox      =   0   'False
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    Height          =   3345
  20.    Icon            =   "SMALLCAP.frx":0000
  21.    KeyPreview      =   -1  'True
  22.    Left            =   3030
  23.    LinkTopic       =   "Form1"
  24.    MaxButton       =   0   'False
  25.    MinButton       =   0   'False
  26.    ScaleHeight     =   3000
  27.    ScaleWidth      =   3180
  28.    Top             =   1245
  29.    Width           =   3240
  30.    Begin VB.CommandButton Command1 
  31.       Caption         =   "Quit"
  32.       Height          =   372
  33.       Left            =   1860
  34.       TabIndex        =   0
  35.       Top             =   2520
  36.       Width           =   972
  37.    End
  38.    Begin MessageBlaster.MsgBlaster MsgBlaster1 
  39.       Left            =   240
  40.       Top             =   2460
  41.       _version        =   65536
  42.       _extentx        =   847
  43.       _extenty        =   847
  44.       _stockprops     =   0
  45.       enabled         =   -1  'True
  46.       voodoo          =   "SMALLCAP.frx":000C
  47.    End
  48.    Begin VB.Label Label3 
  49.       Caption         =   "Try using the system menu. You'll find the about box there."
  50.       Height          =   375
  51.       Left            =   120
  52.       TabIndex        =   3
  53.       Top             =   1980
  54.       Width           =   3015
  55.    End
  56.    Begin VB.Label Label2 
  57.       Caption         =   "How to create a small caption in Visual Basic"
  58.       Height          =   435
  59.       Left            =   120
  60.       TabIndex        =   2
  61.       Top             =   180
  62.       Width           =   3015
  63.    End
  64.    Begin VB.Label Label1 
  65.       Caption         =   $"SMALLCAP.frx":12DC
  66.       Height          =   1215
  67.       Left            =   120
  68.       TabIndex        =   1
  69.       Top             =   660
  70.       Width           =   3015
  71.    End
  72. End
  73. Attribute VB_Name = "frmMain"
  74. Attribute VB_Creatable = False
  75. Attribute VB_Exposed = False
  76.  
  77.  
  78. Option Explicit
  79.  
  80. 'Virtual Key values
  81. Const VK_ESCAPE = &H1B
  82.  
  83. 'System Metrics Constants
  84. Const SM_CYMENU = 15
  85.  
  86. 'SysCommand, wParam values
  87. Const SC_MOVE = &HF010
  88. Const SC_CLOSE = &HF060
  89.  
  90. 'Menu Function values
  91. Const MF_SEPARATOR = &H800
  92. Const MF_ENABLED = 0
  93. Const MF_STRING = 0
  94. Const MF_BmyPosITION = 400
  95.  
  96. 'Menu ID's
  97. Const IDM_SYSMOVE = 101
  98. Const IDM_SYSCLOSE = 102
  99. Const IDM_ABOUT = 103
  100.  
  101. 'MsgBlaster property values
  102. Const PREPROCESS = -1
  103. Const EATMESSAGE = 0
  104. Const POSTPROCESS = 1
  105.  
  106. 'WM_NCHITTEST return values
  107. Const HTCLIENT = 1
  108. Const HTCAPTION = 2
  109. Const HTSYSMENU = 3
  110.  
  111. Dim mFormTop%
  112. Dim mFormLeft%
  113. Dim mxPos%
  114. Dim myPos%
  115. Dim mCaptionColor&
  116.  
  117. Dim mhSysMenu As Long
  118. Dim mScreenRect As RECT
  119. Dim mInSysMenu As Integer
  120.  
  121. Private Sub Command1_Click()
  122.     End
  123. End Sub
  124.  
  125. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  126.  
  127.   If (KeyCode = 115) And (Shift = 4) Then End
  128.   If (KeyCode = 18) And (Shift = 0) Then ShowSysMenu
  129.   If (KeyCode = 27) And (Shift = 0) Then mInSysMenu = False
  130. End Sub
  131.  
  132. Private Sub Form_Load()
  133.     Dim rc%
  134.  
  135.     Me.ScaleMode = 3
  136.     mCaptionColor& = GetSysColor(COLOR_ACTIVECAPTION) And &HFFFFFF
  137.     
  138.     mhSysMenu = CreatePopupMenu()
  139.     rc% = AppendMenu(mhSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSMOVE, "&Move")
  140.     rc% = AppendMenu(mhSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSCLOSE, "&Close  Alt+F4")
  141.     rc% = AppendMenu(mhSysMenu, MF_SEPARATOR, 0, "")
  142.     rc% = AppendMenu(mhSysMenu, MF_ENABLED Or MF_STRING, IDM_ABOUT, "&About")
  143.     mScreenRect.left = 0
  144.     mScreenRect.right = Screen.Width / Screen.TwipsPerPixelX
  145.     mScreenRect.top = 0
  146.     mScreenRect.bottom = Screen.Height / Screen.TwipsPerPixelY
  147.     Msgblaster1.hWndTarget = frmMain.hWnd
  148.     Msgblaster1.AddMessage WM_CLOSE, POSTPROCESS
  149.     Msgblaster1.AddMessage WM_COMMAND, POSTPROCESS
  150.     Msgblaster1.AddMessage WM_NCACTIVATE, POSTPROCESS
  151.     Msgblaster1.AddMessage WM_NCHITTEST, EATMESSAGE
  152.     Msgblaster1.AddMessage WM_NCLBUTTONDBLCLK, EATMESSAGE
  153.     Msgblaster1.AddMessage WM_NCLBUTTONDOWN, POSTPROCESS
  154.     
  155. End Sub
  156.  
  157.  
  158. Private Sub Form_Paint()
  159.   'Paint caption background
  160.   Line (0, -1)-Step(Me.Width, 9), mCaptionColor&, BF
  161.   'Horizontal line under caption
  162.   Line (0, 8)-Step(Me.ScaleWidth, 0), QBColor(0)
  163.   'Vertical line beteen control menu and caption
  164.   Line (10, 0)-Step(0, 8), QBColor(0)
  165.   'Background for control menu
  166.   Line (0, 0)-Step(9, 7), QBColor(7), BF
  167.   'Box for bar in control menu
  168.   Line (2, 2)-Step(5, 2), QBColor(0), B
  169.   'Line inside bar in control menu
  170.   Line (3, 3)-Step(4, 0), QBColor(15)
  171.   'Vertical shadow on bar in control menu
  172.   Line (8, 3)-Step(0, 3), QBColor(8)
  173.   'Horizontal shadow on bar in control menu
  174.   Line (3, 5)-Step(5, 0), QBColor(8)
  175. End Sub
  176.  
  177.  
  178. Private Sub ShowSysMenu()
  179.     Dim InPixels%
  180.     Dim x%, y%, rc%
  181.  
  182.     InPixels = Me.ScaleWidth
  183.     Me.ScaleMode = 1
  184.     
  185.     x = (left) \ (Me.ScaleWidth \ InPixels)
  186.     y = (9 * Screen.TwipsPerPixelY + (Me.top + (Me.Height - Me.ScaleHeight - (Me.Width - Me.ScaleWidth)))) \ (Me.ScaleWidth \ InPixels)
  187.     ScaleMode = 3
  188.     If (y + (3 * GetSystemMetrics(SM_CYMENU))) > (Screen.Height / Screen.TwipsPerPixelY) Then
  189.         rc% = TrackPopupMenu(mhSysMenu, 0, x, y - (3 * GetSystemMetrics(SM_CYMENU)) - 9, 0, Me.hWnd, mScreenRect)
  190.     Else
  191.         rc% = TrackPopupMenu(mhSysMenu, 0, x, y, 0, Me.hWnd, mScreenRect)
  192.     End If
  193.     mInSysMenu = True
  194. End Sub
  195.  
  196.  
  197.  
  198. Private Sub Msgblaster1_Message(ByVal hWnd As Long, ByVal Msg As Long, wParam As Long, lParam As Long, nPassage As Integer, lReturnValue As Long)
  199.    Dim rc&
  200.  
  201.     Select Case Msg
  202.         Case WM_NCACTIVATE
  203.             If wParam Then
  204.                 mCaptionColor = GetSysColor(COLOR_ACTIVECAPTION) And &HFFFFFF
  205.             Else
  206.                 mCaptionColor = GetSysColor(COLOR_INACTIVECAPTION) And &HFFFFFF
  207.             End If
  208.             Me.Refresh
  209.         Case WM_CLOSE
  210.             End
  211.         Case WM_NCHITTEST
  212.             mxPos = (lParam And &HFFFF&)
  213.             myPos = (lParam / 65536)
  214.             mFormTop = top / Screen.TwipsPerPixelY
  215.             mFormLeft = left / Screen.TwipsPerPixelX
  216.             If (myPos - mFormTop < 10) And (mxPos - mFormLeft > 10) Then
  217.                 lReturnValue = HTCAPTION
  218.                 mInSysMenu = False
  219.             ElseIf (myPos - mFormTop < 10) And (mxPos - mFormLeft < 10) Then
  220.                 lReturnValue = HTSYSMENU
  221.                 'mInSysMenu = True
  222.             Else
  223.                 lReturnValue = HTCLIENT
  224.                 mInSysMenu = False
  225.             End If
  226.         Case WM_NCLBUTTONDBLCLK
  227.             If wParam = HTSYSMENU Then
  228.                 End
  229.             End If
  230.         Case WM_NCLBUTTONDOWN
  231.             If wParam = HTSYSMENU Then
  232.                 If mInSysMenu Then
  233.                     mInSysMenu = False
  234.                     Exit Sub
  235.                 Else
  236.                     ShowSysMenu
  237.                 End If
  238.             End If
  239.         Case WM_COMMAND
  240.             Select Case wParam
  241.                 Case IDM_SYSMOVE
  242.                     rc& = SendMessage(hWnd, WM_SYSCOMMAND, SC_MOVE, 0)
  243.                 Case IDM_SYSCLOSE
  244.                     End
  245.                 Case IDM_ABOUT
  246.                     frmAbout.Show vbModal
  247.             End Select
  248.     End Select
  249.  
  250. End Sub
  251.  
  252.  
  253.