home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
cdspy
/
haupt.frm
< prev
next >
Wrap
Text File
|
1995-02-27
|
22KB
|
671 lines
VERSION 2.00
Begin Form haupt
Caption = "CD-Spy"
ClientHeight = 4470
ClientLeft = 2580
ClientTop = 4290
ClientWidth = 9000
Height = 5160
Left = 2520
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 298
ScaleMode = 3 'Pixel
ScaleWidth = 600
Top = 3660
Width = 9120
Begin PictureBox Pic_Statusbar
Align = 2 'Align Bottom
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 285
Left = 0
ScaleHeight = 19
ScaleMode = 3 'Pixel
ScaleWidth = 600
TabIndex = 10
TabStop = 0 'False
Top = 4185
Width = 9000
Begin TextBox Txt_Status2
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 4380
MousePointer = 1 'Arrow
TabIndex = 13
Text = " NM/ag"
Top = 60
Width = 4425
End
Begin TextBox Txt_Status1
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 90
MousePointer = 1 'Arrow
TabIndex = 12
Text = " NM/ag"
Top = 60
Width = 4065
End
End
Begin PictureBox Pic_Toolbar
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 4965
Left = 7380
ScaleHeight = 4965
ScaleWidth = 1500
TabIndex = 0
TabStop = 0 'False
Top = 300
Width = 1500
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Start"
Enabled = 0 'False
Height = 525
Index = 8
Left = 0
TabIndex = 19
Top = 495
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Readme"
Enabled = 0 'False
Height = 525
Index = 7
Left = 0
TabIndex = 18
Top = 3555
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Dummy"
Enabled = 0 'False
Height = 525
Index = 6
Left = 0
TabIndex = 14
Top = 4320
Visible = 0 'False
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Hilfedatei"
Enabled = 0 'False
Height = 525
Index = 5
Left = 0
TabIndex = 6
Top = 3045
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Code"
Enabled = 0 'False
Height = 525
Index = 4
Left = 0
TabIndex = 5
Top = 2535
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Installieren"
Enabled = 0 'False
Height = 525
Index = 3
Left = 0
TabIndex = 4
Top = 2025
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Kopieren"
Enabled = 0 'False
Height = 525
Index = 2
Left = 0
TabIndex = 3
Top = 1515
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Demo"
Enabled = 0 'False
Height = 525
Index = 1
Left = 0
TabIndex = 2
Top = 1005
Width = 1500
End
Begin CommandButton Cmd_Array
BackColor = &H00C0C0C0&
Caption = "Info"
Enabled = 0 'False
Height = 525
Index = 0
Left = 0
TabIndex = 1
Top = 0
Width = 1500
End
End
Begin PictureBox Pic_Buttonbar
Align = 1 'Align Top
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 405
Left = 0
ScaleHeight = 27
ScaleMode = 3 'Pixel
ScaleWidth = 600
TabIndex = 11
TabStop = 0 'False
Top = 0
Width = 9000
End
Begin PictureBox Pic_Splitbar
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 4845
Left = 2520
MousePointer = 9 'Size W E
ScaleHeight = 323
ScaleMode = 3 'Pixel
ScaleWidth = 7
TabIndex = 8
TabStop = 0 'False
Top = 540
Width = 105
End
Begin Outline Outline
BorderStyle = 0 'None
Height = 4695
Left = 90
PictureClosed = HAUPT.FRX:0000
PictureLeaf = HAUPT.FRX:00E2
PictureMinus = HAUPT.FRX:01C4
PictureOpen = HAUPT.FRX:02A6
PicturePlus = HAUPT.FRX:0388
TabIndex = 7
Tag = "Outline"
Top = 630
Width = 3075
End
Begin PictureBox Pic_Anzeige
BackColor = &H00C0C0C0&
BorderStyle = 0 'None
Height = 4695
Left = 3390
ScaleHeight = 313
ScaleMode = 3 'Pixel
ScaleWidth = 259
TabIndex = 9
TabStop = 0 'False
Top = 570
Width = 3885
Begin VScrollBar VSc_Anzeige
Height = 4725
Left = 3630
TabIndex = 17
Top = -30
Visible = 0 'False
Width = 255
End
Begin FileListBox Fil_Projekt
Height = 1980
Left = 1050
Pattern = "*.MAK;*.BAS;*.FRM"
TabIndex = 16
Top = -30
Visible = 0 'False
Width = 1665
End
Begin Label Lbl_Info
AutoSize = -1 'True
BackColor = &H00FFFFFF&
Height = 3555
Left = 30
TabIndex = 15
Tag = "Info"
Top = 30
Width = 975
WordWrap = -1 'True
End
End
Begin Shape Shp_BS
Height = 4815
Left = 30
Top = 540
Width = 7395
End
Begin Menu Datei
Caption = "&Datei"
Begin Menu MnuDatei
Caption = "Einlesen"
Index = 0
End
Begin Menu MnuDatei
Caption = "-"
Index = 1
End
Begin Menu MnuDatei
Caption = "Ende"
Index = 2
End
End
Begin Menu Mnu_HSuche
Caption = "&Suchen"
Begin Menu Mnu_Suche
Caption = "Titeltext"
Index = 0
End
Begin Menu Mnu_Suche
Caption = "Stichworte"
Index = 1
End
Begin Menu Mnu_Suche
Caption = "Codesequenz"
Index = 2
End
End
Begin Menu MnuSetup
Caption = "Setup"
Visible = 0 'False
Begin Menu MnuSubSetup
Caption = "&Einstellungen"
End
End
End
' --------------------------------------------------------
' Haupt
' --------------------------------------------------------
' Hauptformular des CD-Spy's.
' --------------------------------------------------------
' Autor : NM/ag
' Datum :
' Version :
' --------------------------------------------------------
Option Explicit
Dim GL_ListIndex%
Const LC_MIN_TXT_STATUS2 = 20
Sub Cmd_Array_Click (Index As Integer)
Dim i%
Dim L_Verz$
On Error GoTo Err_Cmd_Array_Click
If Index = GCM_CMD_INFO Or Index = GCM_CMD_CODE Then PM_ChangeCmdState (Index)
Select Case Index
Case Is = GCM_CMD_INFO
Lbl_Info.Visible = True
Fil_Projekt.Visible = False
Case Is = GCM_CMD_START
Cmd_Array(Index).Enabled = False
' Aktuelles Verzeichnis und Laufwerk sichern
L_Verz$ = CurDir$
' Aktuelles Verzeichnis und Laufwerk setzen
ChDrive (GM_DB.Verzeichnis)
ChDir (GM_DB.Verzeichnis)
PM_ShellAndWait (FM_Verz$(GM_DB.Verzeichnis) & Cmd_Array(Index).Tag)
' Ursprⁿngliches Verzeichnis und Laufwerk wiederherstellen
ChDrive L_Verz$
ChDir L_Verz$
Cmd_Array(Index).Enabled = True
Cmd_Array(Index).SetFocus
Exit Sub
Case Is = GCM_CMD_DEMO
Cmd_Array(Index).Enabled = False
PM_ShellAndWait (FM_Verz$(GM_DB.Verzeichnis) & Cmd_Array(Index).Tag)
Cmd_Array(Index).Enabled = True
Cmd_Array(Index).SetFocus
Exit Sub
Case Is = GCM_CMD_INSTALL
Cmd_Array(Index).Enabled = False
PM_ShellAndWait (FM_Verz$(GM_DB.Verzeichnis) & Cmd_Array(Index).Tag)
Cmd_Array(Index).Enabled = True
Cmd_Array(Index).SetFocus
Exit Sub
Case Is = GCM_CMD_CODE
Lbl_Info.Visible = False
Fil_Projekt.Path = Cmd_Array(Index).Tag
Fil_Projekt.Visible = True
Case Is = GCM_CMD_HILFE
Cmd_Array(Index).Enabled = False
PM_ShellAndWait (Cmd_Array(Index).Tag)
Cmd_Array(Index).Enabled = True
Cmd_Array(Index).SetFocus
Case Is = GCM_CMD_README
'PM_EditFile FM_Verz$(GM_DB.Verzeichnis$) & CMD_Array(Index).Tag
PM_LookforExt FM_Verz$(GM_DB.Verzeichnis$) & Cmd_Array(Index).Tag
Case Is = GCM_CMD_COPY
F_Kopie.Show 1
If G_CopyFiles$ <> "" Then
PM_CopyFiles
End If
End Select
Exit Sub
Err_Cmd_Array_Click:
Select Case Err
Case Is = GCM_OWNER_ERROR
If Index = GCM_CMD_README Then
MsgBox "Die Datei " & Cmd_Array(Index).Tag & " kann nicht betrachtet werden, weil die Verknⁿpfung fehlt!", 48, "Fehler"
End If
Case Else
MsgBox "Die Funktion kann leider nicht ausgefⁿhrt werden.", 48, "Fehler"
End Select
Exit Sub
End Sub
Sub Cmd_Array_KeyUp (Index As Integer, KeyCode As Integer, Shift As Integer)
If Index = GCM_CMD_INFO Or Index = GCM_CMD_CODE Then
PM_ChangeCmdState (Index)
KeyCode = 0
End If
End Sub
Sub Fil_Projekt_DblClick ()
PM_EditFile FM_Verz$((Fil_Projekt.Path)) & Fil_Projekt
End Sub
Sub Fil_Projekt_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 2 Then
Set G_Control = Fil_Projekt
PopupMenu MnuSetup
End If
End Sub
Sub Form_Load ()
Dim L_Res&
PM_LiesForm Me
Haupt!Pic_Splitbar.Left = Val(F_GetPrivatIni("Einstellungen", GCM_SPLITT))
PM_LiesControl Lbl_Info
PM_LiesControl Outline
'PM_ReadItems 0, -1, 1
If Outline.ListCount > 0 Then Outline.Expand(0) = True
Outline_Click
' Textfelder im Statusbar auf readonly setzen
L_Res& = SendMessage(Txt_Status1.hWnd, &H400 + 31, -1, "")
L_Res& = SendMessage(Txt_status2.hWnd, &H400 + 31, -1, "")
Me.Show
End Sub
Sub Form_Resize ()
On Error Resume Next
screen.MousePointer = 11 ' Sanduhr
freezeOn Me.hWnd
Shp_BS.Top = Pic_Buttonbar.Height + 2
Pic_Toolbar.Top = Shp_BS.Top - 3
Pic_Statusbar.Top = Me.ScaleHeight - Pic_Statusbar.Height
Shp_BS.Width = FM_Max(Me.ScaleWidth - Pic_Toolbar.Width - 4, 0)
Pic_Splitbar.Left = FM_Min((Pic_Splitbar.Left), Shp_BS.Width - Pic_Splitbar.Width)
Shp_BS.Height = FM_Max(Me.ScaleHeight - Pic_Statusbar.Height - Pic_Buttonbar.Height - 2, 0)
Pic_Toolbar.Left = FM_Max(Me.ScaleWidth - Pic_Toolbar.Width, 0)
Lbl_Info.Visible = False
Pic_Splitbar.Visible = False
Pic_Anzeige.Visible = False
Pic_Toolbar.Visible = False
Me.Cls
PM_show3d Me
Pic_Toolbar.Visible = True
Pic_Anzeige.Visible = True
Pic_Splitbar.Visible = True
Lbl_Info.Visible = True
Pic_Splitbar.Refresh
PM_RefreshAnzeige
FreezeOff
screen.MousePointer = 0 ' Standard
End Sub
Sub Form_Unload (Cancel As Integer)
PM_SchreibForm Me
P_WritePrivatInit "Einstellungen", GCM_SPLITT, Haupt!Pic_Splitbar.Left
Cancel = False
End
End Sub
Sub Lbl_Info_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 2 Then
Set G_Control = Lbl_Info
PopupMenu MnuSetup
End If
End Sub
Sub Mnu_Suche_Click (Index As Integer)
Select Case Index
Case Is = 0
Case Is = 1 ' Stichwortsuche
F_Search.Show
F_Search.Caption = "Stichwortsuche"
P_SetWindowTop F_Search
Case Is = 2
End Select
End Sub
Sub MnuDatei_Click (Index As Integer)
Dim i&
Select Case Index
Case Is = 0
Me.MousePointer = 11 ' Sanduhr
PM_GenerateDB "N:\CD"
Me.MousePointer = 0 ' Standard
Case Is = 2
Unload Me
End Select
End Sub
Sub MnuSubSetup_Click ()
screen.MousePointer = 11 'Sanduhr
F_Setup.Show 1
Set G_Control = Nothing
End Sub
Sub Outline_Click ()
Dim Res&
Dim pos%
If Outline.ListIndex < 0 Then Exit Sub
Me.MousePointer = 11
'PM_ReadCDInfo
Txt_Status1 = " " & GM_DB.Verzeichnis
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% = Haupt.Outline.Indent(ListIndex% + 1)
If Err <> 0 Or Haupt.Outline.Indent(ListIndex) >= i% Then
Haupt.Outline.AddItem "Hilfs", ListIndex% + 1
Exit Do
Else
Haupt.Outline.RemoveItem ListIndex% + 1
End If
Loop
Haupt.Outline.List(ListIndex% + 1) = "Hilfs"
Haupt.Outline.Indent(ListIndex% + 1) = Haupt.Outline.Indent(ListIndex%) + 1
Haupt.Outline.ListIndex = GL_ListIndex%
Me.MousePointer = 0' Default
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 Haupt.Outline.HasSubItems(ListIndex%) Then
Haupt.Outline.Refresh
Exit Sub
End If
On Error Resume Next
working% = True
Me.MousePointer = 11 'Sanduhr
Indent% = Haupt.Outline.Indent(ListIndex%)
ID& = Haupt.Outline.ItemData(ListIndex%)
' For i% = 0 To Haupt.Outline.ListCount - 1
' If Haupt.Outline.Indent(i%) >= Indent% And Haupt.Outline.IsItemVisible(i%) And Haupt.Outline.HasSubItems(i%) Then
' If Err <> 0 Then Exit For
' Outline_Collapse i%
' End If
' Next i%
For i% = 0 To Haupt.Outline.ListCount - 1
If Haupt.Outline.ItemData(i%) = ID& Then
ListIndex% = i%
Exit For
End If
Next i%
tmp% = ListIndex
'PM_ReadItems Haupt.Outline.ItemData(ListIndex%), ListIndex%, Haupt.Outline.Indent(ListIndex%) + 1
Haupt.Outline.Expand(tmp%) = True
Haupt.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_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Outline.ListIndex <> GL_ListIndex% Then
Outline_Click
End If
If Button And 2 Then
Set G_Control = Outline
PopupMenu MnuSetup
End If
End Sub
Sub Pic_ButtonBar_Paint ()
Pic_Buttonbar.Line (0, 0)-(Me.ScaleWidth, 0), &HFFFFFF
Pic_Buttonbar.Line (0, Pic_Buttonbar.ScaleHeight - 2)-(Me.ScaleWidth, Pic_Buttonbar.ScaleHeight - 2), &H808080
Pic_Buttonbar.Line (0, Pic_Buttonbar.ScaleHeight - 1)-(Me.ScaleWidth, Pic_Buttonbar.ScaleHeight - 1), 0
End Sub
Sub Pic_Splitbar_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Pic_Splitbar.Tag = X
End Sub
Sub Pic_Splitbar_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Static working%
Dim PosX As Single
If working% Then Exit Sub
working% = True
If Button And 1 Then
PosX! = Pic_Splitbar.Left + (X - Val(Pic_Splitbar.Tag))
If PosX! < Shp_BS.Left Then PosX! = Shp_BS.Left
If PosX! > Shp_BS.Left + Shp_BS.Width - Pic_Splitbar.Width Then PosX! = Shp_BS.Left + Shp_BS.Width - Pic_Splitbar.Width
Pic_Splitbar.Left = PosX!
End If
working% = False
End Sub
Sub Pic_Splitbar_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Pic_Splitbar.Refresh
PM_RefreshAnzeige
End Sub
Sub Pic_Splitbar_Paint ()
Dim Wert&, WertX&, WertY&
Pic_Splitbar.Height = Shp_BS.Height - 2
Pic_Splitbar.Top = Shp_BS.Top + 1
Pic_Splitbar.Line (0, 0)-(0, Pic_Splitbar.ScaleHeight), 0
Pic_Splitbar.Line (1, 0)-(1, Pic_Splitbar.ScaleHeight), &HFFFFFF
Pic_Splitbar.Line (Pic_Splitbar.ScaleWidth - 1, 0)-(Pic_Splitbar.ScaleWidth - 1, Pic_Splitbar.ScaleHeight), &H808080
Pic_Splitbar.Line (Pic_Splitbar.ScaleWidth - 1, 0)-(Pic_Splitbar.ScaleWidth - 1, Pic_Splitbar.ScaleHeight), 0
WertX& = Shp_BS.Left + 1
WertY& = Shp_BS.Top + 1
If Outline.Left <> WertX& Or Outline.Top <> WertY& Then
Outline.Move WertX&, WertY&
End If
Wert& = FM_Max(Pic_Splitbar.Left - Shp_BS.Left, 0)
If Outline.Width <> Wert& Then
Outline.Width = Wert&
End If
Wert& = FM_Max(Pic_Splitbar.Height - 1, 0)
If Outline.Height <> Wert& Then
Outline.Height = Wert&
End If
WertX& = Pic_Splitbar.Left + Pic_Splitbar.Width - 1
WertY& = Shp_BS.Top + 1
If Pic_Anzeige.Left <> WertX& Or Pic_Anzeige.Top <> WertY& Then
Pic_Anzeige.Move WertX&, WertY&
End If
Wert& = FM_Max(Shp_BS.Width - Pic_Splitbar.Left - Pic_Splitbar.Width + 2, 0)
If Pic_Anzeige.Width <> Wert& Then
Pic_Anzeige.Width = Wert&
End If
Wert& = Pic_Splitbar.Height - 1
If Pic_Anzeige.Height <> Wert& Then
Pic_Anzeige.Height = Wert& 'Outline.Height
End If
End Sub
Sub Pic_Statusbar_Paint ()
Const BLACK = &H0&
Const WHITE = &HFFFFFF
Const GRAY = &HC0C0C0
Const DGRAY = &H808080
Pic_Statusbar.Line (0, 0)-(Me.ScaleWidth, 0)
Pic_Statusbar.Line (0, 1)-(Me.ScaleWidth, 1), &HFFFFFF
Txt_status2.Left = Txt_Status1.Left + Txt_Status1.Width + 6
Txt_status2.Width = FM_Max(Me.ScaleWidth - Txt_status2.Left - 6, LC_MIN_TXT_STATUS2)
Pic_Statusbar.Line (Txt_Status1.Left + 1, Txt_Status1.Top + 1)-(Txt_Status1.Width + 0 + Txt_Status1.Left, Txt_Status1.Top + Txt_Status1.Height), WHITE, B
Pic_Statusbar.Line (Txt_Status1.Left - 1, Txt_Status1.Top - 1)-(Txt_Status1.Width + 1 + Txt_Status1.Left, Txt_Status1.Top + Txt_Status1.Height + 1), DGRAY, B
Pic_Statusbar.Line (Txt_Status1.Left - 2, Txt_Status1.Top - 2)-(Txt_Status1.Width + Txt_Status1.Left + 1, Txt_Status1.Top + Txt_Status1.Height + 1), GRAY, B
Pic_Statusbar.Line (Txt_status2.Left + 1, Txt_status2.Top + 1)-(Txt_status2.Width + 0 + Txt_status2.Left, Txt_Status1.Top + Txt_Status1.Height), WHITE, B
Pic_Statusbar.Line (Txt_status2.Left - 1, Txt_status2.Top - 1)-(Txt_status2.Width + 1 + Txt_status2.Left, Txt_Status1.Top + Txt_Status1.Height + 1), DGRAY, B
Pic_Statusbar.Line (Txt_status2.Left - 2, Txt_status2.Top - 2)-(Txt_status2.Width + Txt_status2.Left + 1, Txt_Status1.Top + Txt_Status1.Height + 1), GRAY, B
End Sub
Sub Txt_Status1_GotFocus ()
SendKeys "{TAB}", 0
End Sub
Sub Txt_Status2_GotFocus ()
SendKeys "{TAB}", 0
End Sub
Sub VSc_Anzeige_Change ()
Haupt!Lbl_Info.Top = -Haupt!VSc_Anzeige.Value * Haupt!Pic_Anzeige.TextHeight("@")
End Sub