home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
cdspy
/
f_outlin.frm
< prev
next >
Wrap
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