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