PC Shareware 2000 January

home *** CD-ROM | disk | FTP | other *** search

/ PC Shareware 2000 January / PCShareware-1-00.iso / trials / Fc7 / ABC.Z / ORGCHART.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1996-12-16 | 25.0 KB | 665 lines

VERSION 4.00 Begin VB.Form OrgChartDlg Appearance = 0 'Flat BackColor = &H00C0C0C0& BorderStyle = 1 'Fixed Single Caption = "Organization Chart DEMO" ClientHeight = 1815 ClientLeft = 465 ClientTop = 1755 ClientWidth = 5535 FillColor = &H00C0C0C0& 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 = &H80000008& Height = 2220 Icon = "ORGCHART.frx":0000 Left = 405 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 1815 ScaleWidth = 5535 Top = 1410 Width = 5655 Begin VB.CommandButton OptionsBtn Appearance = 0 'Flat BackColor = &H80000005& Caption = "Options..." Height = 375 Left = 4080 TabIndex = 5 Top = 720 Width = 1335 End Begin VB.CommandButton CancelBtn Appearance = 0 'Flat BackColor = &H80000005& Caption = "Cancel" Height = 375 Left = 2820 TabIndex = 4 Top = 1320 Width = 1335 End Begin VB.CommandButton BrowseBtn Appearance = 0 'Flat BackColor = &H80000005& Caption = "Browse..." Height = 375 Left = 4080 TabIndex = 3 Top = 240 Width = 1335 End Begin VB.CommandButton OKBtn Appearance = 0 'Flat BackColor = &H80000005& Caption = "OK" Default = -1 'True Enabled = 0 'False Height = 375 Left = 1320 TabIndex = 2 Top = 1320 Width = 1335 End Begin VB.TextBox OrgChartTextFileEdit Appearance = 0 'Flat BackColor = &H00FFFFFF& BeginProperty Font name = "MS Sans Serif" charset = 0 weight = 400 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 285 Left = 120 TabIndex = 1 Top = 600 Width = 3675 End Begin MSComDlg.CommonDialog OrgChartBrowse Left = 360 Top = 1320 _Version = 65536 _ExtentX = 847 _ExtentY = 847 _StockProps = 0 End Begin AbcflowLib.ABC ABC1 Height = 375 Left = 4560 TabIndex = 6 Top = 1320 Width = 495 _version = 65536 _extentx = 873 _extenty = 661 _stockprops = 1 End Begin VB.Line Line6 BorderColor = &H00808080& X1 = 0 X2 = 5520 Y1 = 1800 Y2 = 1800 End Begin VB.Line Line5 BorderColor = &H00808080& X1 = 5520 X2 = 5520 Y1 = 1800 Y2 = 0 End Begin VB.Line Line4 BorderColor = &H00FFFFFF& X1 = 5520 X2 = 0 Y1 = 0 Y2 = 0 End Begin VB.Line Line3 BorderColor = &H00FFFFFF& X1 = 0 X2 = 0 Y1 = 1800 Y2 = 0 End Begin VB.Line Line2 BorderColor = &H00FFFFFF& X1 = 0 X2 = 5520 Y1 = 1210 Y2 = 1210 End Begin VB.Line Line1 BorderColor = &H00808080& X1 = 0 X2 = 5520 Y1 = 1200 Y2 = 1200 End Begin VB.Label Label1 Appearance = 0 'Flat BackColor = &H00C0C0C0& Caption = "ASCII Text File:" ForeColor = &H80000008& Height = 255 Left = 120 TabIndex = 0 Top = 360 Width = 2055 End Attribute VB_Name = "OrgChartDlg" Attribute VB_Creatable = False Attribute VB_Exposed = False Dim ABC As Object Dim FormatIter As Integer Dim LoopIter As Integer Dim TotalFormatIter As Integer Dim req_objs As Integer Private Sub ABC1_AppQuitNOTIFY() End End Sub Private Sub BrowseBtn_Click() OrgChartBrowse.Action = 1 ' OrgChartBrowse.Filename = OrgChartTextFileEdit.Text OrgChartTextFileEdit.Text = LCase(OrgChartBrowse.Filename) OrgChartBrowse.Filename = "*.txt" End Sub Private Function CalcPercent() As Integer CalcPercent = 100 * ((LoopIter / req_objs) / TotalFormatIter + (FormatIter - 1) / TotalFormatIter) + 1 If CalcPerent > 100 Then CalcPercent = 100 If CalcPerent < 0 Then CalcPercent = 0 LoopIter = LoopIter + 1 End Function Private Sub CancelBtn_Click() Unload OrgChartDlg End Sub Private Sub Command2_Click() OrgChartBrowse.Action = 1 End Sub Private Function DoCreateOrgChart(ByVal Filename As String) As Integer Dim OrgItem As String Dim Chart As Object Dim cur_pos As Integer Dim len_str As Integer Rem Make a new chart Set Chart = ABC.New Rem Set the right shape palette Chart.CurrentShapePalette = "Standard" Chart.CurrentShape = "Process" ABC.ShapePaletteVisible = False Rem Set the Chart's internal type Chart.Type = "PROCESS" Rem Turn off master items Chart.MasterItems.Hideall Chart.DrawDirection = 2 Chart.DrawPositionX = 4 Chart.DrawPositionY = 1 Chart.DrawSpacingY = 0.25 Chart.CurrentLineRouting = 3 If OrgChartOptionsDlg.TopToBottomRBtn.Value = True Or OrgChartOptionsDlg.BottomToTopRBtn = True Then vertical = True Else vertical = False End If If OrgChartOptionsDlg.BottomToTopRBtn.Value = True Or OrgChartOptionsDlg.RightToLeftRBtn = True Then inverted = True Else inverted = False End If If vertical Then Chart.PageLayout.Orientation = 1 Else Chart.PageLayout.Orientation = 0 End If Chart.NoRepaint = True len_file = FileLen(Filename) If len_file < 32767 And len_file > 0 Then Dim EntireFile As String Dim test_ascCode As Integer Dim rank As Integer Dim index As Integer Dim cur_obj_count As Integer Dim num_levels As Integer Open Filename For Binary Access Read As #1 EntireFile = String$(len_file, " ") Get #1, , EntireFile Close Rem Set up the progess bar ABC.PercentGauge "Organization Chart DEMO", "PASS 1 of 2: Reading & parsing file..." DrawnCount = 0 req_objs = GetNumLines(EntireFile) + 1 ReDim ShapeList(req_objs) As Object ReDim ShapeRefStack(req_objs) As Integer ReDim RelationMap(req_objs, 3) As Integer Const first_child = 1, next_sibling = 2, parent = 3 cur_pos = 1 index = 2 cur_obj_count = 1 ShapeRefStack(1) = 1 Do While cur_pos < len_file + 1 test_ascCode = Asc(Mid$(EntireFile, cur_pos, 1)) rank = 2 While test_ascCode <> 13 And test_ascCode <> 10 And cur_pos < len_file + 1 If test_ascCode = 9 Then rank = rank + 1 Else OrgItem = OrgItem + Chr$(test_ascCode) End If cur_pos = cur_pos + 1 test_ascCode = Asc(Mid$(EntireFile, cur_pos, 1)) Wend cur_pos = cur_pos + 1 OrgItem = FormatOrgString(OrgItem) If rank > num_levels Then num_levels = rank End If If Len(OrgItem) > 0 Then If rank > index Then index = index + 1 ElseIf rank < index Then index = rank End If Chart.DrawPositionX = 1 + (index) Chart.DrawPositionY = 2 cur_obj_count = cur_obj_count + 1 Set ShapeList(cur_obj_count) = Chart.DrawShape("Process") ShapeList(cur_obj_count).Text = OrgItem Rem update status bar DrawnCount = DrawnCount + 1 ABC.PercentGaugeValue = 100 * DrawnCount / (req_objs - 1) 'Give all the shapes some attributes here ShapeList(cur_obj_count).Shape.FillColor = ABC.YELLOW ShapeList(cur_obj_count).Shape.BorderColor = ABC.BLUE ShapeList(cur_obj_count).Shape.ShadowStyle = 1 ShapeList(cur_obj_count).Shape.NumberShown = False ShapeList(cur_obj_count).Shape.BorderWidth = 3 ShapeList(cur_obj_count).Shape.FitShapeToText ShapeRefStack(index) = cur_obj_count RelationMap(cur_obj_count, parent) = ShapeRefStack(index - 1) RelationMap(cur_obj_count, next_sibling) = RelationMap(RelationMap(cur_obj_count, parent), first_child) RelationMap(RelationMap(cur_obj_count, parent), first_child) = cur_obj_count RelationMap(cur_obj_count, first_child) = 0 OrgItem = "" End If If ABC.PercentGaugeCancelled Then Exit Do Loop If ABC.PercentGaugeCancelled Then GoTo DoCreateAbort ABC.PercentGauge "Organization Chart DEMO", "PASS 2 of 2: Formatting chart..." Rem There are currently five iterations of formatting TotalFormatIter = 5 FormatIter = 0 'We need to go through the list and make sure 'the sizes work according to the Options Dlg Const size_cx = 1, size_cy = 2 Dim finished As Integer ReDim obj_size_level(req_objs, 2) As Double Dim counter As Integer finished = False cur_obj_count = 1 index = 1 Call NewGaugeLoop 'Here we traverse the tree gathering the maximum size box in each level While Not ABC.PercentGaugeCancelled And Not finished Rem update status bar ABC.PercentGaugeValue = CalcPercent() If cur_obj_count <> 1 Then If ShapeList(cur_obj_count).Height > obj_size_level(index, size_cy) Then obj_size_level(index, size_cy) = ShapeList(cur_obj_count).Height End If If ShapeList(cur_obj_count).Width > obj_size_level(index, size_cx) Then obj_size_level(index, size_cx) = ShapeList(cur_obj_count).Width End If End If If RelationMap(cur_obj_count, first_child) = 0 Then ShapeRefStack(index) = cur_obj_count cur_obj_count = RelationMap(cur_obj_count, next_sibling) While cur_obj_count = 0 And index <> 1 index = index - 1 If index > 1 Then cur_obj_count = ShapeRefStack(index) If cur_obj_count Then cur_obj_count = RelationMap(cur_obj_count, next_sibling) End If End If Wend Else ShapeRefStack(index) = cur_obj_count index = index + 1 cur_obj_count = RelationMap(cur_obj_count, first_child) End If If index = 1 Then finished = True End If Wend 'Now we have to adjust if the manager's size increases. If OrgChartOptionsDlg.IncreaseMgrSize.Value = True Then For counter = num_levels - 1 To 2 Step -1 If obj_size_level(counter, size_cx) < obj_size_level(counter + 1, size_cx) Then obj_size_level(counter, size_cx) = obj_size_level(counter + 1, size_cx) End If If obj_size_level(counter, size_cy) < obj_size_level(counter + 1, size_cy) Then obj_size_level(counter, size_cy) = obj_size_level(counter + 1, size_cy) End If Next End If 'Reinitialize the loop vars finished = False cur_obj_count = 1 index = 1 Call NewGaugeLoop 'Here we traverse the tree gathering the maximum size box in each level While Not ABC.PercentGaugeCancelled And Not finished Rem update status bar ABC.PercentGaugeValue = CalcPercent() If cur_obj_count <> 1 Then If OrgChartOptionsDlg.EqualWithinLevels.Value = True Then ShapeList(cur_obj_count).Width = obj_size_level(index, size_cx) ShapeList(cur_obj_count).Height = obj_size_level(index, size_cy) Else 'The object has to be at least as big as the biggest on the next level If OrgChartOptionsDlg.IncreaseMgrSize.Value = True Then If index < num_levels And index > 1 Then If ShapeList(cur_obj_count).Width < obj_size_level(index + 1, size_cx) Then ShapeList(cur_obj_count).Width = obj_size_level(index + 1, size_cx) End If If ShapeList(cur_obj_count).Height < obj_size_level(index + 1, size_cy) Then ShapeList(cur_obj_count).Height = obj_size_level(index + 1, size_cy) End If End If End If End If End If If RelationMap(cur_obj_count, first_child) = 0 Then ShapeRefStack(index) = cur_obj_count cur_obj_count = RelationMap(cur_obj_count, next_sibling) While cur_obj_count = 0 And index <> 1 index = index - 1 If index > 1 Then cur_obj_count = ShapeRefStack(index) If cur_obj_count Then cur_obj_count = RelationMap(cur_obj_count, next_sibling) End If End If Wend Else ShapeRefStack(index) = cur_obj_count index = index + 1 cur_obj_count = RelationMap(cur_obj_count, first_child) End If If index = 1 Then finished = True End If Wend 'Format the chart *here* 'start at the top (the "God" object) ReDim size_branch(req_objs) As Double ReDim size_level(req_objs) As Double Dim box_spacing_peers As Double Dim box_spacing_levels As Double ' Dim vertical As Integer ' Dim inverted As Integer box_spacing_peers = Val(OrgChartOptionsDlg.BoxSpacing.Text) box_spacing_levels = box_spacing_peers * 2 finished = False cur_obj_count = 1 index = 1 Call NewGaugeLoop 'We're just calculating the sizes that these shapes need so far. While Not ABC.PercentGaugeCancelled And Not finished Rem update status bar ABC.PercentGaugeValue = CalcPercent() If cur_obj_count <> 1 Then If vertical = True Then If ShapeList(cur_obj_count).Height > size_level(index) Then size_level(index) = ShapeList(cur_obj_count).Height End If Else If ShapeList(cur_obj_count).Width > size_level(index) Then size_level(index) = ShapeList(cur_obj_count).Width End If End If End If If RelationMap(cur_obj_count, first_child) = 0 Then ShapeRefStack(index) = cur_obj_count For counter = 1 To index If vertical = True Then size_branch(ShapeRefStack(counter)) = size_branch(ShapeRefStack(counter)) + ShapeList(cur_obj_count).Width + box_spacing_peers Else size_branch(ShapeRefStack(counter)) = size_branch(ShapeRefStack(counter)) + ShapeList(cur_obj_count).Height + box_spacing_peers End If Next cur_obj_count = RelationMap(cur_obj_count, next_sibling) While cur_obj_count = 0 And index <> 1 index = index - 1 If index > 1 Then cur_obj_count = ShapeRefStack(index) If cur_obj_count Then cur_obj_count = RelationMap(cur_obj_count, next_sibling) End If End If Wend Else ShapeRefStack(index) = cur_obj_count index = index + 1 cur_obj_count = RelationMap(cur_obj_count, first_child) End If If index = 1 Then finished = True End If Wend Dim posX As Double Dim posY As Double Dim newline As Object 'I'll have to admit - this is a little hard to follow - but it's BASIC you know, Visual or not 'Can't do too much about the recursion stuff in BASIC posX = box_spacing_peers + size_branch(1) posY = 0 mirrorX = box_spacing_peers + size_branch(1) mirrorY = box_spacing_levels cur_obj_count = 1 index = 1 finished = False For counter = 2 To num_levels mirrorY = mirrorY + size_level(counter) + box_spacing_levels Next Call NewGaugeLoop 'This is recursion in disguise.... 'Don't be confused-> X and Y are reversed if this is not vertical While Not ABC.PercentGaugeCancelled And Not finished Rem update status bar ABC.PercentGaugeValue = CalcPercent() If cur_obj_count <> 1 Then If vertical Then ShapeList(cur_obj_count).CenterX = posX - (size_branch(cur_obj_count) / 2) Else ShapeList(cur_obj_count).CenterY = posX - (size_branch(cur_obj_count) / 2) End If posY = box_spacing_levels For counter = 2 To index - 1 posY = posY + size_level(counter) + box_spacing_levels Next If vertical Then If inverted Then ShapeList(cur_obj_count).Bottom = mirrorY - posY Else ShapeList(cur_obj_count).Top = posY End If Else If inverted Then ShapeList(cur_obj_count).Right = mirrorY - posY Else ShapeList(cur_obj_count).Left = posY End If End If End If If RelationMap(cur_obj_count, first_child) = 0 Then posX = posX - size_branch(cur_obj_count) cur_obj_count = RelationMap(cur_obj_count, next_sibling) While cur_obj_count = 0 And index <> 1 index = index - 1 If index > 1 Then cur_obj_count = ShapeRefStack(index) If cur_obj_count Then cur_obj_count = RelationMap(cur_obj_count, next_sibling) End If End If Wend Else ShapeRefStack(index) = cur_obj_count index = index + 1 cur_obj_count = RelationMap(cur_obj_count, first_child) End If If index = 1 Then finished = True End If Wend Call NewGaugeLoop Junk = CalcPercent() ' since we're skipping an object in this loop For counter = 2 To req_objs If ABC.PercentGaugeCancelled Then Exit For ABC.PercentGaugeValue = CalcPercent() If RelationMap(counter, parent) > 1 Then If vertical Then If inverted Then Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 0, 2) Else Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 2, 0) End If Else If inverted Then Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 3, 1) Else Set newline = Chart.DrawLine(ShapeList(RelationMap(counter, parent)), ShapeList(counter), 1, 3) End If End If newline.Line_.StemWidth = 3 newline.Line_.DestArrowStyle = 0 newline.Line_.SourceArrowStyle = 0 newline.Line_.Color = ABC.BLUE End If Next DoCreateOrgChart = 1 Else DoCreateOrgChart = 0 End If DoCreateAbort: Chart.View = 2 Chart.NoRepaint = False Chart.Repaint ABC.HidePercentGauge End Function Private Sub Form_Load() Set ABC = CreateObject("ABCFlow.application") ABC.Visible = True OrgChartTextFileEdit = LCase(App.Path + "\ORGCHRT1.TXT") Load OrgChartOptionsDlg ABC.RegisterEvent ABC1, APPNAME, "AppQuitNOTIFY" End Sub Private Sub Form_Unload(Cancel As Integer) Unload OrgChartOptionsDlg End Sub Private Function FormatOrgString(ByVal OrgString As String) As String Dim index As Integer Dim len_str As Integer Dim test_ascCode As Integer Dim in_quotes As Integer Dim FormattedStr As String index = 1 in_quotes = False len_str = Len(OrgString) FormattedStr = "" While index < (len_str + 1) test_ascCode = Asc(Mid$(OrgString, index)) If test_ascCode = 34 Then in_quotes = Not in_quotes ElseIf in_quotes Then FormattedStr = FormattedStr + Chr$(test_ascCode) ElseIf test_ascCode = 44 Then: Rem comma FormattedStr = FormattedStr + Chr$(13) End If index = index + 1 Wend FormatOrgString = FormattedStr End Function Private Function GetNumLines(test_str As String) As Integer Dim len_str As Integer Dim index As Integer Dim in_line_feed As Integer Dim test_ascCode As Integer Dim total_lines As Integer in_line_feed = True index = 1 len_str = Len(test_str) total_lines = 0 While index < len_str + 1 test_ascCode = Asc(Mid$(test_str, index)) If test_ascCode = 13 Or test_ascCode = 10 Then If Not in_line_feed Then total_lines = total_lines + 1 in_line_feed = True End If Else in_line_feed = False End If index = index + 1 Wend GetNumLines = total_lines End Function Private Sub NewGaugeLoop() LoopIter = 0 FormatIter = FormatIter + 1 End Sub Private Sub OKBtn_Click() OrgChartDlg.WindowState = 1 ' iconize form OrgChartDlg.Refresh success = DoCreateOrgChart(OrgChartTextFileEdit.Text) End Sub Private Sub OptionsBtn_Click() OrgChartDlg.Enabled = False OrgChartOptionsDlg.Show End Sub Private Sub OrgChartTextFileEdit_Change() Call ValidateFilename End Sub Private Sub ValidateFilename() On Error Resume Next Attr = GetAttr(OrgChartTextFileEdit) If Err Then OKBtn.Enabled = False Else OKBtn.Enabled = True End If End Sub