home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1999 January
/
pcwk_01_1999.iso
/
Wtestowe
/
Vistdstd
/
Install
/
Data.Z
/
Orgchart.FRM
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1996-09-05
|
11KB
|
315 lines
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