Programming Tool Box/SIMS_2.iso/code/cdspy/f_outlin.frm

Text File | 1995-02-26 | 6KB | 216 lines

VERSION 2.00
Begin Form F_Outline
   Caption         =   "Inhalt"
   ClientHeight    =   5355
   ClientLeft      =   1335
   ClientTop       =   1770
   ClientWidth     =   3570
   Height          =   5760
   Left            =   1275
   LinkTopic       =   "Form2"
   MDIChild        =   -1  'True
   ScaleHeight     =   5355
   ScaleWidth      =   3570
   Tag             =   "Inhalt"
   Top             =   1425
   Width           =   3690
   Begin Outline Outline
      Height          =   3525
      Left            =   120
      PictureClosed   =   F_OUTLIN.FRX:0000
      PictureLeaf     =   F_OUTLIN.FRX:00E2
      PictureMinus    =   F_OUTLIN.FRX:01C4
      PictureOpen     =   F_OUTLIN.FRX:02A6
      PicturePlus     =   F_OUTLIN.FRX:0388
      TabIndex        =   0
      Tag             =   "Outline"
      Top             =   90
      Width           =   3075
   End
   Begin Label LblStatusbar
      AutoSize        =   -1  'True
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Left            =   120
      TabIndex        =   1
      Top             =   3840
      Width           =   45
   End
   Begin Shape ShpStatusbar
      Height          =   255
      Left            =   120
      Top             =   3840
      Width           =   3255
   End
End
Option Explicit
Option Compare Text
Dim GL_ListIndex%
Dim GL_AktElement As TM_AktElement

Sub Form_Activate ()
  GM_AktElement = GL_AktElement
  PM_RefreshForms
End Sub

Sub Form_Load ()
  PM_LiesForm Me
  Rem Show3d Me
  PM_ReadItems Me.Outline, 0, -1, 1
  If Outline.ListCount > 0 Then Outline.Expand(0) = True
  Outline_Click
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  If UnloadMode = 0 Then
    Cancel = True
    Exit Sub
  Else
    PM_SchreibForm Me
  End If
End Sub

Sub Form_Resize ()
FreezeOn mdicdSpy.hWnd
  If F_CheckFormSize(Me, 3000, 4000) = True Then
    P_ResizeObjectToForm Me, Outline, 100
    Outline.Top = 300
    Outline.Height = FM_Max(Me.ScaleHeight - 600, 200)
    ShpStatusbar.Move 100, Me.ScaleHeight - 250, Me.ScaleWidth - 200, 200
    LblStatusbar.Move 200, Me.ScaleHeight - 250

    ' Zeichnen
    Me.AutoRedraw = True
    Me.Cls
    Show3d Me
    Me.DrawWidth = 2
    Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), QBColor(7), B
    Me.DrawWidth = 1
    Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight), QBColor(15), B

    P_Show3dTwips Me, Outline, 1
  End If

FreezeOn 0
End Sub

Sub Outline_Click ()
  Dim Res&
  Dim pos%
  If Outline.ListIndex < 0 Then Exit Sub
  Me.MousePointer = 11
  PM_ReadCDInfo Me.Outline, GL_AktElement
  GM_AktElement = GL_AktElement
  Me.LblStatusbar = GM_DB.Verzeichnis$
  Show3d Me
  PM_RefreshForms
  GL_ListIndex% = Outline.ListIndex
  Me.MousePointer = 0
End Sub

Sub Outline_Collapse (ListIndex As Integer)
  Dim i%
  On Error Resume Next
  Me.MousePointer = 11' Sanduhr
  Do
    i% = Outline.Indent(ListIndex% + 1)
    If Err <> 0 Or Outline.Indent(ListIndex) >= i% Then
      Outline.AddItem "Hilfs", ListIndex% + 1
      Exit Do
    Else
      Outline.RemoveItem ListIndex% + 1
    End If
  Loop
  Outline.List(ListIndex% + 1) = "Hilfs"
  Outline.Indent(ListIndex% + 1) = Outline.Indent(ListIndex%) + 1
  Outline.ListIndex = GL_ListIndex%
  Me.MousePointer = 0' Default
End Sub

Sub Outline_DblClick ()
  If Me.Outline.PictureType(Me.Outline.ListIndex) = 2 Then
    Set G_Control = Outline
    PopupMenu mdicdSpy!MnuSetup
    Exit Sub
  End If
  If Me.Outline.Expand(Me.Outline.ListIndex) Then
    Outline_Collapse (Me.Outline.ListIndex)
  Else
    Outline_Expand (Me.Outline.ListIndex)
  End If
End Sub

Sub Outline_Expand (ListIndex As Integer)
  On Error GoTo Err_Outline_Expand
  Static working%
  Dim tmp%
  Dim i%
  Dim Indent%
  Dim ID&
  If working% Or Not Me.Outline.HasSubItems(ListIndex%) Then
    'Me.Outline.Refresh
    Exit Sub
  End If
  On Error Resume Next
  working% = True
  Me.MousePointer = 11 'Sanduhr
  Indent% = Me.Outline.Indent(ListIndex%)
  ID& = Me.Outline.ItemData(ListIndex%)
  For i% = 0 To Me.Outline.ListCount - 1
    If Me.Outline.ItemData(i%) = ID& Then
      ListIndex% = i%
      Exit For
    End If
  Next i%
  tmp% = ListIndex
  PM_ReadItems Me.Outline, Me.Outline.ItemData(ListIndex%), ListIndex%, Me.Outline.Indent(ListIndex%) + 1
  Me.Outline.Expand(tmp%) = True
  Me.Outline.ListIndex = tmp%
  working% = False
  Me.MousePointer = 0 ' default
  Exit Sub
Err_Outline_Expand:
  working% = False
  Me.MousePointer = 0' default
  MsgBox "Der Speicher ist voll! Bitte schliessen Sie mindestens eine Gliederungsebene bevor Sie weitere Ebenen ÷ffnen.", 48, "Fehler"
  Exit Sub
End Sub

Sub Outline_KeyUp (KeyCode As Integer, Shift As Integer)
  If Outline.ListIndex <> GL_ListIndex% Then
    Outline_Click
  End If
End Sub

Sub Outline_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button And 2 Then
    Set G_Control = Outline
    PopupMenu mdicdSpy!MnuSetup
  End If
End Sub

Sub Outline_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Outline.ListIndex <> GL_ListIndex% Then
    Outline_Click
  End If
End Sub

Sub Outline_PictureClick (ListIndex As Integer)
  Outline.ListIndex = ListIndex
  Outline_Click
End Sub

Sub Outline_PictureDblClick (ListIndex As Integer)
  If Me.Outline.Expand(Me.Outline.ListIndex) Then
    Outline_Collapse (Me.Outline.ListIndex)
  Else
    Outline_Expand (Me.Outline.ListIndex)
  End If
End Sub