PC World Komputer 1998 January/Pcwk0198.iso/Wtestowe/Microgfx/FCTRIALL/ABC.Z/MENU.FRM

Text File | 1996-12-16 | 5KB | 174 lines

VERSION 4.00
Begin VB.Form Form1
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "Menus DEMO"
   ClientHeight    =   2550
   ClientLeft      =   795
   ClientTop       =   1530
   ClientWidth     =   3975
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   2955
   Icon            =   "MENU.frx":0000
   Left            =   735
   LinkTopic       =   "Form1"
   ScaleHeight     =   2550
   ScaleWidth      =   3975
   Top             =   1185
   Width           =   4095
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   255
      Picture         =   "MENU.frx":030A
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   3
      Top             =   915
      Width           =   495
   End
   Begin AbcflowLib.ABC ABC1
      Height          =   615
      Left            =   0
      TabIndex        =   4
      Top             =   1440
      Width           =   615
      _version        =   65536
      _extentx        =   1085
      _extenty        =   1085
      _stockprops     =   1
   End
   Begin VB.Label Label3
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "(c) Micrografx Inc., 1995. All Rights Reserved."
      ForeColor       =   &H80000008&
      Height          =   390
      Left            =   885
      TabIndex        =   0
      Top             =   990
      Width           =   3000
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "When this VB program is running, a new menu is added to ABC. The menu adds object counting functionality to ABC."
      ForeColor       =   &H80000008&
      Height          =   615
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   3495
   End
   Begin VB.Label Label2
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "<---- Double-click on this custom OCX in VB 4.0 edit mode to see the event handling code."
      ForeColor       =   &H80000008&
      Height          =   855
      Left            =   720
      TabIndex        =   1
      Top             =   1560
      Visible         =   0   'False
      Width           =   3015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim ABC As Object

Const SHAPECOUNT = "Shape Count..."
Const LINECOUNT = "Line Count..."

Private Sub ABC1_AppMenuSUBCLASS(ByVal MenuItem As Object, Override As Boolean)
    ABC.HourGlass = True
    If MenuItem = SHAPECOUNT Then
        CountShapes
    ElseIf ABC1.MenuItem = LINECOUNT Then
        CountLines
    End If
    ABC.HourGlass = False
End Sub

Private Sub ABC1_AppQuitNOTIFY()
    End
End Sub

Private Sub CountLines()
    Dim Objects As Object, Obj As Object

    Lines = 0
    Set Objects = ABC.ActiveChart.Objects

    Do
        Set Obj = Objects.ItemFromAll
        If Obj.Valid And Obj.Type = 1 Then
            Lines = Lines + 1
        End If
    Loop While Obj.Valid

    If Lines = 0 Then
        Message = "There are no lines in this chart."
    ElseIf Lines = 1 Then
        Message = "There is one line in this chart."
    Else
        Message = "There are " & Lines & " lines in this chart."
    End If

    ABC.MsgBox Message
End Sub

Private Sub CountShapes()
    Dim Objects As Object, Obj As Object

    Shapes = 0
    Set Objects = ABC.ActiveChart.Objects

    Do
        Set Obj = Objects.ItemFromAll
        If Obj.Valid And Obj.Type = 0 Then
            Shapes = Shapes + 1
        End If
    Loop While Obj.Valid

    If Shapes = 0 Then
        Message = "There are no shapes in this chart."
    ElseIf Shapes = 1 Then
        Message = "There is one shape in this chart."
    Else
        Message = "There are " & Shapes & " shapes in this chart."
    End If

    ABC.MsgBox Message
End Sub

Private Sub Form_Load()
    Dim Menu As Object

    Set ABC = CreateObject("ABCFlow.application")
    ABC.Visible = True

    ' Get the ABC Quit event so the Menu
    ' sample can unload when ABC Quits
    ABC.RegisterEvent ABC1, Form1.Caption, "AppQuitNOTIFY"

    Set Menu = ABC.AddMenu("Stats", ABC1, Form1.Caption)
    Menu.AppendItem SHAPECOUNT
    Menu.AppendItem LINECOUNT
    Form1.WindowState = 1   ' Minimize Menu Sample Form
End Sub