home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmOrgChart
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- Caption = "Visio Organizational Chart"
- ClientHeight = 5430
- ClientLeft = 705
- ClientTop = 2040
- ClientWidth = 6270
- FillColor = &H00808080&
- FillStyle = 0 'Solid
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- ForeColor = &H00808080&
- Height = 6120
- Icon = "ORGCHART.frx":0000
- KeyPreview = -1 'True
- Left = 645
- LinkTopic = "Form1"
- ScaleHeight = 5430
- ScaleWidth = 6270
- Top = 1410
- Width = 6390
- Begin VB.Frame Frame1
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- Caption = "Organization Chart"
- ForeColor = &H00000000&
- Height = 4455
- Left = 120
- TabIndex = 3
- Top = 840
- Width = 6015
- Begin MSOutl.Outline Outline1
- Height = 3975
- Left = 120
- TabIndex = 2
- TabStop = 0 'False
- Top = 360
- Width = 5775
- _Version = 65536
- _ExtentX = 10186
- _ExtentY = 7011
- _StockProps = 77
- ForeColor = -2147483640
- BackColor = -2147483643
- Style = 4
- PicturePlus = "ORGCHART.frx":030A
- PictureMinus = "ORGCHART.frx":0404
- PictureLeaf = "ORGCHART.frx":04FE
- PictureOpen = "ORGCHART.frx":05F8
- PictureClosed = "ORGCHART.frx":06F2
- End
- End
- Begin VB.TextBox Text1
- Appearance = 0 'Flat
- BackColor = &H00FFFFFF&
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 0
- weight = 700
- size = 9.75
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- Height = 360
- Left = 120
- TabIndex = 0
- TabStop = 0 'False
- Text = "Text1"
- Top = 360
- Width = 6015
- End
- Begin VB.Label Label1
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- Caption = "Name:"
- ForeColor = &H80000008&
- Height = 255
- Left = 120
- TabIndex = 1
- Top = 120
- Width = 6015
- End
- Begin VB.Menu mnuChart
- Caption = "&Chart"
- Begin VB.Menu mnuChartItem
- Caption = "Show &All Items"
- Checked = -1 'True
- Index = 0
- Shortcut = ^A
- End
- Begin VB.Menu mnuChartItem
- Caption = "&Create Chart"
- Index = 1
- End
- Begin VB.Menu mnuChartItem
- Caption = "Read Chart From &Visio"
- Index = 2
- End
- End
- Begin VB.Menu mnuCommand
- Caption = "C&ommands"
- Begin VB.Menu mnuCommandItem
- Caption = "&Promote"
- Index = 0
- End
- Begin VB.Menu mnuCommandItem
- Caption = "&Demote"
- Index = 1
- End
- Begin VB.Menu mnuCommandItem
- Caption = "De&lete"
- Index = 2
- End
- Begin VB.Menu mnuCommandItem
- Caption = "Delete B&ranch"
- Index = 3
- End
- End
- Attribute VB_Name = "frmOrgChart"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- '------------------------------------------------------------------------------
- '------------------------------------------------------------------------------
- '-- Visio Organization Chart AddOn
- '-- (C)1993 Shapeware Corporation
- '-- File Name : OrgChart.frm
- '-- Description : Main form for the OrgChart AddOn
- '-- Audit Trail:
- '-- 09/15/93 - v3.000 - aw - Moved code into the module orchart.bas.
- '-- Started on keyboard equiv, but needs more work!
- '-- Idea was to make a global keyboard handler which
- '-- explains why form.Keypreview = False etc.
- '-- Reorganized the menus according to the code that
- '-- I moved to the module.
- '-- 07/**/93 - v2.000 - bl - Added option read orgchart in menu chart.
- '-- **/**/** - v1.000 - ** - Created.
- '------------------------------------------------------------------------------
- '------------------------------------------------------------------------------
- Option Explicit
- Private Declare Function GetKeyState Lib "User" (ByVal nVirtKey As Integer) As Integer
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
- Dim temp As Integer, ind As Integer
- Select Case KeyCode
- Case KEY_TAB:
- If (Shift And SHIFT_MASK) > 0 Then
- PromoteItem
- Else
- DemoteItem
- End If
- Text1.SetFocus
- Case KEY_DOWN
- If (Shift And CTRL_MASK) > 0 Then
- movedown
- UpdateFields
- ElseIf Outline1.ListIndex < (Outline1.ListCount - 1) Then
- Outline1.ListIndex = Outline1.ListIndex + 1
- UpdateFields
- Else
- Beep
- End If
- Case KEY_BACK
- If Text1.Text = "" Then
- temp = Outline1.ListIndex
- mnuCommandItem_click DeleteBranch
- If Outline1.ListCount > 0 Then Outline1.ListIndex = temp - 1
- UpdateFields
- Else
- If Outline1.ListIndex <> -1 Then
- Outline1.List(Outline1.ListIndex) = Text1.Text
- Outline1.Refresh
- SuperExpand (Outline1.ListIndex)
- Else
- Beep
- End If
- End If
- Case KEY_RETURN
- ind = Outline1.ListIndex
- If Outline1.ListIndex <> -1 Then
- If Outline1.List(ind) <> "" Then
- Outline1.AddItem ""
- Outline1.ListIndex = Outline1.ListIndex + 1
- If Outline1.Indent(Outline1.ListIndex) > 1 Then
- Outline1.Indent(Outline1.ListIndex) = Outline1.Indent(Outline1.ListIndex - 1)
- End If
- Else
- Beep
- End If
- Else
- Beep
- Outline1.AddItem ""
- Outline1.Indent(0) = 0
- Outline1.ListIndex = Outline1.ListCount - 1
- End If
- UpdateFields
- Outline1.Refresh
- SuperExpand (Outline1.ListIndex)
- End Select
- End Sub
- Private Sub Form_KeyPress(KeyAscii As Integer)
- '------------------------------------------------------------------------------------------------
- '------------------------------------------------------------------------------------------------
- '-- Some keystrokes causes the system to beep, avoid beep by intercepting
- '-- the enter key.
- Select Case KeyAscii
- Case KEY_RETURN:
- KeyAscii = 0
- Case KEY_TAB:
- KeyAscii = 0
- End Select
- End Sub
- Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
- Select Case KeyCode
- Case KEY_LEFT
- If (Shift And CTRL_MASK) > 0 Then mnuCommandItem_click Promote
- Case KEY_RIGHT
- If (Shift And CTRL_MASK) > 0 Then
- If (Shift And ALT_MASK) > 0 Then
- mnuCommandItem_click DeleteBranch
- Else
- mnuCommandItem_click Demote
- End If
- End If
- Case KEY_UP
- If (Shift And CTRL_MASK) > 0 Then
- moveup
- UpdateFields
- ElseIf Outline1.ListIndex <> 0 Then
- Outline1.ListIndex = Outline1.ListIndex - 1
- UpdateFields
- Else
- Beep
- End If
- Case Else
- If Outline1.ListIndex <> -1 Then
- Outline1.List(Outline1.ListIndex) = Text1.Text
- Outline1.Refresh
- SuperExpand (Outline1.ListIndex)
- Else
- Beep
- Text1.Text = ""
- End If
- End Select
- End Sub
- Private Sub Form_Load()
- frmOrgChart.Outline1.AddItem ""
- Outline1.ListIndex = 0
- Outline1.Indent(Outline1.ListIndex) = 0
- UpdateFields
- End Sub
- Private Sub mnuChartItem_Click(Index As Integer)
- '------------------------------------------------------------------------------------------------
- '------------------------------------------------------------------------------------------------
- '-- The three menu items in the menu Chart
- Dim strMsg As String
- Select Case Index
- Case ShowItems:
- If Not mnuChartItem(ShowItems).Checked Then TopExpand (0)
- mnuChartItem(ShowItems).Checked = Not mnuChartItem(ShowItems).Checked
- Case CreateChart:
- If Outline1.ListCount > 0 Then
- CreateOrgChart
- Else
- Beep
- End If
- Case ReadChart:
- If Not (frmOrgChart.Outline1.ListCount <> 0 And frmOrgChart.Outline1.List(0) = "") Then
- strMsg = "Continuing will erase current orgchart, continue?"
- If MsgBox(strMsg, MB_YESNO, "OrgChart") = IDNO Then
- Exit Sub
- Else
- frmOrgChart.Text1.Text = ""
- frmOrgChart.Outline1.Clear
- End If
- End If
- ReadOrgChart
- End Select
- End Sub
- Private Sub mnuCommandItem_click(Index As Integer)
- '-- Then four menu items in the menu Command
- Select Case Index
- Case Promote:
- PromoteItem
- Case Demote:
- DemoteItem
- Case Delet:
- DeleteItem
- Case DeleteBranch:
- DeleteItemBranch
- End Select
- End Sub
- Private Sub Outline1_Click()
- UpdateFields
- Text1.SetFocus
- End Sub
- Private Sub Outline1_Collapse(ListIndex As Integer)
- If frmOrgChart.mnuChartItem(ShowItems).Checked Then
- TopExpand (ListIndex)
- End If
- Text1.SetFocus
- End Sub
- Private Sub Outline1_DblClick()
- TopExpand (Outline1.ListIndex)
- Text1.SetFocus
- End Sub
-