Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/bdemo/t

Visual Basic Form | 1995-05-08 | 18.4 KB | 454 lines

VERSION 2.00
Begin Form ButtonTest
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Picture-Button Demo"
   ClientHeight    =   4215
   ClientLeft      =   2055
   ClientTop       =   1695
   ClientWidth     =   5190
   Height          =   4620
   Icon            =   BDEMO.FRX:0000
   Left            =   1995
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   281
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   346
   Top             =   1350
   Width           =   5310
   Begin PictureBox ButtonStrip
      BackColor       =   &H0000FFFF&
      Height          =   645
      Left            =   -45
      ScaleHeight     =   615
      ScaleWidth      =   5205
      TabIndex        =   1
      Top             =   3405
      Width           =   5235
      Begin PictureBox PictureUP
         BackColor       =   &H0000FFFF&
         BorderStyle     =   0  'None
         Height          =   420
         Left            =   3570
         Picture         =   BDEMO.FRX:0302
         ScaleHeight     =   420
         ScaleWidth      =   570
         TabIndex        =   4
         Top             =   75
         Width           =   570
      End
      Begin PictureBox PictureDN
         BackColor       =   &H0000FFFF&
         BorderStyle     =   0  'None
         Height          =   435
         Left            =   3570
         Picture         =   BDEMO.FRX:0604
         ScaleHeight     =   435
         ScaleWidth      =   540
         TabIndex        =   5
         Top             =   75
         Visible         =   0   'False
         Width           =   540
      End
      Begin PictureBox PushButton
         AutoRedraw      =   -1  'True
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00FFFFFF&
         Height          =   585
         Index           =   4
         Left            =   4170
         ScaleHeight     =   37
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   52
         TabIndex        =   12
         Top             =   15
         Width           =   810
         Begin PictureBox ButtonPict
            BackColor       =   &H00C0C0C0&
            BorderStyle     =   0  'None
            Height          =   270
            Index           =   4
            Left            =   75
            Picture         =   BDEMO.FRX:0906
            ScaleHeight     =   270
            ScaleWidth      =   615
            TabIndex        =   13
            Top             =   150
            Width           =   615
         End
      End
      Begin PictureBox PushButton
         AutoRedraw      =   -1  'True
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00FFFFFF&
         Height          =   585
         Index           =   3
         Left            =   2625
         ScaleHeight     =   37
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   52
         TabIndex        =   10
         Top             =   15
         Width           =   810
         Begin PictureBox ButtonPict
            BackColor       =   &H00C0C0C0&
            BorderStyle     =   0  'None
            Height          =   315
            Index           =   3
            Left            =   135
            Picture         =   BDEMO.FRX:0AD4
            ScaleHeight     =   315
            ScaleWidth      =   510
            TabIndex        =   11
            Top             =   120
            Width           =   510
         End
      End
      Begin PictureBox PushButton
         AutoRedraw      =   -1  'True
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00FFFFFF&
         Height          =   585
         Index           =   2
         Left            =   1830
         ScaleHeight     =   37
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   52
         TabIndex        =   8
         Top             =   15
         Width           =   810
         Begin PictureBox ButtonPict
            BackColor       =   &H00C0C0C0&
            BorderStyle     =   0  'None
            Height          =   420
            Index           =   2
            Left            =   150
            Picture         =   BDEMO.FRX:0D06
            ScaleHeight     =   420
            ScaleWidth      =   510
            TabIndex        =   9
            Top             =   45
            Width           =   510
         End
      End
      Begin PictureBox PushButton
         AutoRedraw      =   -1  'True
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00FFFFFF&
         Height          =   585
         Index           =   1
         Left            =   1035
         ScaleHeight     =   37
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   52
         TabIndex        =   6
         Top             =   15
         Width           =   810
         Begin PictureBox ButtonPict
            BackColor       =   &H00C0C0C0&
            BorderStyle     =   0  'None
            Height          =   450
            Index           =   1
            Left            =   210
            Picture         =   BDEMO.FRX:1008
            ScaleHeight     =   100
            ScaleMode       =   0  'User
            ScaleWidth      =   405
            TabIndex        =   7
            Top             =   45
            Width           =   405
         End
      End
      Begin PictureBox PushButton
         AutoRedraw      =   -1  'True
         BackColor       =   &H00C0C0C0&
         ForeColor       =   &H00FFFFFF&
         Height          =   585
         Index           =   0
         Left            =   240
         ScaleHeight     =   37
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   52
         TabIndex        =   2
         Top             =   15
         Width           =   810
         Begin PictureBox ButtonPict
            BackColor       =   &H00C0C0C0&
            BorderStyle     =   0  'None
            Height          =   405
            Index           =   0
            Left            =   165
            Picture         =   BDEMO.FRX:130A
            ScaleHeight     =   405
            ScaleMode       =   0  'User
            ScaleWidth      =   405
            TabIndex        =   3
            Top             =   75
            Width           =   510
         End
      End
   End
   Begin PictureBox Picture1
      BackColor       =   &H00FFFFFF&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   13.5
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00FFFFFF&
      Height          =   3105
      Left            =   165
      Picture         =   BDEMO.FRX:160C
      ScaleHeight     =   3075
      ScaleWidth      =   4830
      TabIndex        =   0
      Top             =   165
      Width           =   4860
   End
'The main procedures in this program are the general
'procedures ButtonUp and ButtonDown. Form_Load initializes
'the buttons in the up position and stores the locations
'of their pictures.
'To use these procedures in your program:
'   1.  Create a picture box control with the CtlName set
'       to "PushButton"
'   2.  Create a picture box control on top of the PushButtton
'       picture box and set the CtlName to "ButtonPict".
'   3.  Copy both picture boxes by selecting the PushButton
'       picture box and executing the "Edit-Copy" command.
'   4.  Paste a copy for each button you want to create and
'       create the control arrays PushButton() and ButtonPict().
'       These procedures were obviously designed to control
'       more than one button. You can, however, modify them
'       if you need only one simulated button.
'   6.  Adjust the buttons to the sizes you want. Although the
'       routines should work with any size buttons, there is
'       a practical limit because of the time it takes for VB
'       to draw the lines on them.
'   5.  Load your pictures (icon, bmp, etc) into the picture
'       boxes on top of your buttons (ButtonPict()), size and
'       position them as necessary.
'   6.  Copy the subs ButtonUp and ButtonDown into the
'       (general) (declarations) section for your form and the
'       initializing routine into your Form_Load procedure.
'   7.  Put a CALL to ButtonDown in your PushButton_MouseDown and
'       ButtonPict_MouseDown event procedures. Likewise, put calls
'       to ButtonUp in your PushButton_MouseUp and ButtonPict_
'       MouseUp event procedures.
'   8.  Copy the declarations below into your program and change
'       the value of NumButtons% to the number of simulated
'       buttons on your form.
'That is all there is to it. See the comments in ButtonUp and
'ButtonDown for more information.
'The camera button (the camera that is a button) is handled differently.
'it is simply two separate pictures (not an array). The picture
'that represents the object in the up position is called PictureUp and
'is placed over the other (PictureDn). Your code only needs to
'handle the MouseUp and MouseDown events for the top picture, since
'the user cannot access the bottom picture. In your mouse event
'handlers, you just have to switch visibility between the two pictures.
'You could, of course, do all of your buttons this way by making
'two control arrays for the pictures, just like the other buttons,
'but this method requires a little more manual work, because you have
'to create both up and down representations of each picture. The camera
'was first drawn (using Iconwrks) in the up position with shadows on the
'right and bottom. Then the icon was copied and pasted into another
'icon - offset one pixel to the right and one pixel down from the original.
'The shadow was removed from the right and bottom and shadow was added
'to the top and left. You can load both icons into Icon Works to see
'what I mean.
'Change the Constant NumButtons% to the actual number of simulated
'buttons on your form.
Const NumButtons% = 5
Dim ix As Integer 'used to pass the index to the general procedures
Dim x1 As Integer 'These are used for
Dim x2 As Integer '   coordinates when
Dim y1 As Integer '   moving the pictures
Dim y2 As Integer '   on the buttons.
Dim ButtPictTop() As Single   'These will store the locations
Dim ButtPictLeft() As Single  '   of the button pictures when
                              '   the form is loaded.
Sub ButtonDown (ix As Integer)
'This procedure draws the button in the down position.
'Remember ScaleMode must be set to 3 (pixels) on PushButton()
'for this to work properly.
PushButton(ix).DrawWidth = 1  'Set line width to one pixel
'=========================================================
'*** First draw a black box around the button          ***
'---------------------------------------------------------
x1 = 0
x2 = PushButton(ix).ScaleWidth - 1
y1 = 0
y2 = PushButton(ix).ScaleHeight - 1
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(0), B
'=========================================================
'*** Next erase the white and dark inside lines and    ***
'*** change the white outside lines to dark grey.      ***
'---------------------------------------------------------
x1 = 1
x2 = PushButton(ix).ScaleWidth - 2
Y = PushButton(ix).ScaleHeight - 2
PushButton(ix).Line (x1, Y)-(x2, Y), QBColor(7)
Y = 1
PushButton(ix).Line (x1, Y)-(x2, Y), QBColor(8)
X = 1
y1 = 1: y2 = PushButton(ix).ScaleHeight
PushButton(ix).Line (X, y1)-(X, y2), QBColor(8)
X = PushButton(ix).ScaleWidth - 2
y1 = 2: y2 = PushButton(ix).ScaleHeight
PushButton(ix).Line (X, y1)-(X, y2), QBColor(7)
'=========================================================
'*** Move the picture down and right 1 pixel           ***
'---------------------------------------------------------
mx! = ButtPictLeft(ix) + 1
my! = ButtPictTop(ix) + 1
ButtonPict(ix).Move mx!, my!
'***********************************************************
'** The following code puts the demo text on the picture. **
'** You could process your button commands here or in the **
'** ButtonUP procedure.  Processing in the ButtonUP pro-  **
'** cedure would act like a Command_Click event.          **
'***********************************************************
Select Case ix              'ix is the button index
    Case 0
        a$ = "Camera"
    Case 1
        a$ = "Apple"
    Case 2
        a$ = "Folder"
    Case 3
        a$ = "Test"
    Case 4
        a$ = "Quit"
End Select
a$ = a$ + " Button"
picture1.CurrentX = 100
picture1.CurrentY = 100
picture1.Print a$
End Sub
Sub ButtonPict_MouseDown (index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'===========================================================
'*** This is necessary in case someone presses the mouse ***
'*** button while the pointer is over the picture on the ***
'*** button instead of the button itself.                ***
'-----------------------------------------------------------
Call ButtonDown(index)
End Sub
Sub ButtonPict_MouseUp (index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'===========================================================
'*** This is necessary in case someone pressed the mouse ***
'*** button while the pointer was over the picture on    ***
'*** the button instead of the button itself.            ***
'-----------------------------------------------------------
Call ButtonUP(index)
If index = 4 Then End
End Sub
Sub ButtonUP (ix As Integer)
PushButton(ix).DrawWidth = 1
'=========================================================
'*** Draw 2 white lines accross the top of the button. ***
'*** The second is 1 pixel shorter than the first.     ***
'---------------------------------------------------------
x1 = 0: x2 = PushButton(ix).ScaleWidth - 1
y1 = 0: y2 = 0
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(15)
x1 = 0: x2 = PushButton(ix).ScaleWidth - 2
y1 = 1: y2 = 1
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(15)
'=========================================================
'***  Draw 2 dark lines on the left side of the button. **
'***  The second is 2 pixels shorter than the first.    **
'---------------------------------------------------------
x1 = PushButton(ix).ScaleWidth - 1: x2 = x1
y1 = 1: y2 = PushButton(ix).ScaleHeight - 1
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(8)
x1 = PushButton(ix).ScaleWidth - 2: x2 = x1
y1 = 2: y2 = PushButton(ix).ScaleHeight - 2
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(8)
'=========================================================
'*** Draw 2 white lines down the left side of the button *
'*** The second is 2 pixels shorter than the first.      *
'---------------------------------------------------------
x1 = 0: x2 = x1
y1 = 1: y2 = PushButton(ix).ScaleHeight - 1
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(15)
x1 = 1: x2 = x1
y1 = 2: y2 = PushButton(ix).ScaleHeight - 2
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(15)
'=========================================================
'*** Draw 2 dark lines at the bottom of the button.    ***
'*** The second is 2 pixels longer than the first.     ***
'---------------------------------------------------------
x1 = 1: x2 = PushButton(ix).ScaleWidth - 1
y1 = PushButton(ix).ScaleHeight - 2: y2 = y1
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(8)
x1 = 0: x2 = PushButton(ix).ScaleWidth
y1 = PushButton(ix).ScaleHeight - 1: y2 = y1
PushButton(ix).Line (x1, y1)-(x2, y2), QBColor(8)
'=========================================================
'*** Move the picture up and left 1 pixel              ***
'---------------------------------------------------------
mx! = ButtPictLeft(ix)
my! = ButtPictTop(ix)
ButtonPict(ix).Move mx!, my!
'*******************************************************
'**  You could put your button processing code here   **
'**  to look like a Command_Click event.              **
'*******************************************************
picture1.Refresh    'For this demo just erase the text
                    'on the picture.
End Sub
Sub Form_Load ()
ReDim ButtPictTop(NumButtons - 1)
ReDim ButtPictLeft(NumButtons - 1)
For ix = 0 To NumButtons - 1    'Display all the buttons
    ButtPictTop(ix) = ButtonPict(ix).Top
    ButtPictLeft(ix) = ButtonPict(ix).Left
    Call ButtonUP(ix)           'in the up position.
Next ix
End Sub
Sub Picture1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
picture1.CurrentX = 100
picture1.CurrentY = 100
picture1.Print "This picture is just for decoration."
End Sub
Sub Picture1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
picture1.Refresh
End Sub
Sub PictureUP_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'=======================================================
'*** This handles the camera that is not on a button ***
'=======================================================
PictureDN.Visible = -1
PictureUP.Visible = 0
'********************************************************
'**  Process code here - just like a command_MouseDown **
'**  event. Or you could put your code in the MouseUP  **
'**  procedure to make it look like a Command_Click.   **
'********************************************************
picture1.CurrentX = 100
picture1.CurrentY = 100
picture1.Print "You're holding the camera down."
End Sub
Sub PictureUP_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
'******************************************************
'** This procedure handles the camera that is not on **
'** a button.                                        **
'******************************************************
PictureUP.Visible = -1
PictureDN.Visible = 0
'******************************************************
'**  Process code here - just like a command button  **
'******************************************************
picture1.Refresh
End Sub
Sub PushButton_MouseDown (index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ButtonDown(index)
End Sub
Sub PushButton_MouseUp (index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ButtonUP(index)
If index = 4 Then End
End Sub