Virtual-Mac/frmMain.frm
2018-02-22 12:04:06 -06:00

704 lines
19 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{E1742569-C6BE-4FBD-ADF3-F1DDD40BF642}#1.0#0"; "SysTray.ocx"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Virtual Mac Console"
ClientHeight = 3030
ClientLeft = 150
ClientTop = 840
ClientWidth = 5295
FillColor = &H8000000A&
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3030
ScaleWidth = 5295
StartUpPosition = 3 'Windows Default
Begin sysTray.Tray VirtualMacTrayIcon
Left = 4725
Top = 2400
_ExtentX = 847
_ExtentY = 847
ToolTipText = "Virtual Mac"
IconPicture = "frmMain.frx":18BA
End
Begin VB.CommandButton Start
Caption = "Start"
Default = -1 'True
Enabled = 0 'False
Height = 340
Left = 4000
TabIndex = 3
Top = 1575
Width = 1140
End
Begin VB.CommandButton Remove
Caption = "Remove"
Enabled = 0 'False
Height = 340
Left = 4000
TabIndex = 2
Top = 1000
Width = 1140
End
Begin VB.CommandButton Settings
Caption = "Settings"
Enabled = 0 'False
Height = 340
Left = 4000
TabIndex = 1
Top = 550
Width = 1140
End
Begin VB.CommandButton NewMac
Caption = "New..."
Height = 340
Left = 4000
TabIndex = 0
Top = 100
Width = 1140
End
Begin VB.PictureBox VMGraphicList
BackColor = &H00FFFFFF&
Height = 2775
Left = 120
ScaleHeight = 2715
ScaleWidth = 3675
TabIndex = 5
Top = 120
Width = 3735
Begin VB.VScrollBar VMGraphicScroll
Enabled = 0 'False
Height = 2715
Left = 3420
Max = 1
TabIndex = 10
Top = 0
Width = 260
End
Begin VB.Frame VM
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 915
Index = 0
Left = 0
TabIndex = 6
Top = -915
Width = 3400
Begin VB.PictureBox VMSnap
Height = 640
Index = 0
Left = 120
ScaleHeight = 585
ScaleWidth = 795
TabIndex = 7
Top = 140
Width = 855
End
Begin VB.Label VMName
BackStyle = 0 'Transparent
Caption = "Example Name"
Height = 255
Index = 0
Left = 1200
TabIndex = 9
Top = 120
Width = 2295
End
Begin VB.Label VMDescription
BackStyle = 0 'Transparent
Caption = "Not running"
Height = 255
Index = 0
Left = 1200
TabIndex = 8
Top = 480
Width = 2295
End
End
End
Begin VB.ListBox VMList
Height = 2790
ItemData = "frmMain.frx":3184
Left = 120
List = "frmMain.frx":3186
TabIndex = 4
Top = 120
Width = 3735
End
Begin VB.Menu mnuFile
Caption = "File"
Begin VB.Menu mnuNewMac
Caption = "New Mac Wizard"
End
Begin VB.Menu mnuNewDisk
Caption = "New Disk Wizard"
End
Begin VB.Menu mnuFileBar0
Caption = "-"
End
Begin VB.Menu mnuFileOptions
Caption = "Options"
End
Begin VB.Menu mnuFileBar1
Caption = "-"
End
Begin VB.Menu mnuFileExit
Caption = "Exit"
End
End
Begin VB.Menu mnuAction
Caption = "Action"
Begin VB.Menu mnuActionStart
Caption = "Start"
End
Begin VB.Menu mnuActionBar0
Caption = "-"
End
Begin VB.Menu mnuActionPause
Caption = "Pause"
Enabled = 0 'False
End
Begin VB.Menu mnuActionRestart
Caption = "Restart"
Enabled = 0 'False
End
Begin VB.Menu mnuActionBar1
Caption = "-"
End
Begin VB.Menu mnuActionRemove
Caption = "Remove"
End
Begin VB.Menu mnuActionBar2
Caption = "-"
End
Begin VB.Menu mnuActionSettings
Caption = "Settings"
End
Begin VB.Menu mnuActionProperties
Caption = "Properties"
Enabled = 0 'False
End
End
Begin VB.Menu mnuHelp
Caption = "Help"
Begin VB.Menu mnuHelpContents
Caption = "Virtual Mac Help"
End
Begin VB.Menu mnuHelpSearchForHelpOn
Caption = "Online Help"
End
Begin VB.Menu mnuHelpBar0
Caption = "-"
End
Begin VB.Menu mnuHelpAbout
Caption = "About Virtual Mac..."
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetParent _
Lib "user32" ( _
ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Public Sub RedrawList()
On Error Resume Next
'===Declarations===
Dim retF As Long 'To set the parent of the Frame
Dim retS As Long 'To set the parent of the VMSnap
Dim i As Long 'Used to identify the graphic being handled
Dim X As Long 'Used to know which and where was the last graphic
'===Duplicate the items so we can have more than 1 machine at time===
'Check how much items exist. The items are created as they exist in a
'hidden list. Let's mean you made 2 VMs, then 2 items will be added to
'this hidden list, and this Instruction called RedrawList will check how
'much items you made, then it will draw the number of items (In this case, 2)
'To do this, it will draw every item individually, and will repeat the
'actions until it gets to all the items using a 'For' cycle
For i = 1 To VMList.ListCount
X = i - 1
'Load the right item (If there are 3 items, we will load the fourth and so on)
Load VM(i)
Load VMName(i)
Load VMDescription(i)
Load VMSnap(i)
'==Set the items to their respective parents==
'Frame and PictureBox Parents
retF = SetParent(VM(i).hwnd, VMGraphicList.hwnd)
retS = SetParent(VMSnap(i).hwnd, VM(i).hwnd)
'As these are labels, they need the container property (SetParent will not work on these)
Set VMName(i).Container = VM(i)
Set VMDescription(i).Container = VM(i)
'===Set position properties for the items===
'Machine List Item (The frame)
VM(i).Visible = True
VM(i).Top = VM(X).Top + VM(0).Height
VM(i).Left = 0
'Machine Name
VMName(i).Visible = True
VMName(i).Top = VMName(X).Top
VMName(i).Left = VMName(X).Left
VMName(i).Caption = VMList.List(i - 1)
'Machine Description (Status)
VMDescription(i).Visible = True
VMDescription(i).Top = VMDescription(X).Top
VMDescription(i).Left = VMDescription(X).Left
VMDescription(i).Caption = "Not running"
'Machine Picture Properties (When running, it will show a
'screenshot of the machine screen)
VMSnap(i).Visible = True
VMSnap(i).Top = VMSnap(X).Top
VMSnap(i).Left = VMSnap(X).Left
Next
End Sub
Private Sub Form_GotFocus()
'===Bug fix===
'There was a bug that made the Main form to show prior
'to the New Mac Wizard when there were no machines
'and New Mac Wizard showed up automatically
If VMList.ListCount = 0 Then
If frmNewMac.Visible = True Then
frmNewMac.Show
End If
End If
End Sub
Private Sub Form_Load()
If VMList.ListCount = 0 Then
frmNewMac.Show
frmNewMac.SetFocus
End If
RedrawList
End Sub
Private Sub Form_Terminate()
VirtualMacTrayIcon.RemoverSystray
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
'close all sub forms
For i = Forms.Count - 1 To 1 Step -1
Unload Forms(i)
Next
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
frmMain.VirtualMacTrayIcon.RemoverSystray
End Sub
Public Sub Start68kEmulation()
'MsgBox "VirtualMac <20> Beta 0.1.2. Only Motorola 68000 emulation supported (68k.exe must be same as Virtual Mac Directory)", vbInformation
MsgBox "Virtual Mac <20> 0.1.2 Beta. Virtualization isn't supported (again). Only fake OS X screen plus example stuff avaible"
'Shell (App.Path & "\68k.exe"), vbNormalFocus
frmVirtualMacintosh.Show
End Sub
Public Sub EnableButtons()
mnuActionStart.Enabled = True
'mnuActionPause.Enabled = True
'mnuActionRestart.Enabled = True
mnuActionRemove.Enabled = True
mnuActionSettings.Enabled = True
'mnuActionProperties.Enabled = True
Settings.Enabled = True
Remove.Enabled = True
Start.Enabled = True
End Sub
Private Sub StartPPCEmulation()
MsgBox "PPC.exe MUST be in the same directory as VirtualMac. Launching SheepShaver WITHOUT PREFS (Expect errors)", vbInformation
Shell (App.Path & "\PPC.exe"), vbNormalFocus
End Sub
Private Sub mnuActionRemove_Click()
RemoveSelectedMac
End Sub
Public Sub RemoveSelectedMac()
'Declarations
Dim Focused As Boolean
Dim Answer As Integer
Dim X As Long
'Checks that you have a machine selected
If VMList.ListIndex <> -1 Then
Focused = True
End If
'Asks you if you really want to delete the machine
If Focused = True Then
Answer = MsgBox("You have choosen to remove '" & VMList.List(VMList.ListIndex) & "' from the Virtual Mac Console. Removing items from this list will not delete the .mcc or .dsk files from your physical computer. Do you want to remove this Virtual Mac from the Virtual Mac Console?", vbExclamation + vbYesNo, "Virtual Mac")
'If you don't want that old Mac Plus, this
'is where it's deleted and recycled (Maybe)
If Answer = 6 Then
'First let's unload all the list items
For X = 1 To VMList.ListCount
VM(X).Visible = False
VMName(X).Visible = False
VMDescription(X).Visible = False
VMSnap(X).Visible = False
Unload VMName(X)
Unload VMDescription(X)
Unload VMSnap(X)
Unload VM(X)
Next
'Let's delete the item from the hidden list
VMList.RemoveItem VMList.ListIndex
DisableButtons 'Disable the buttons
'And finally redraw (Reload) the items in the list
RedrawList
End If
End If
End Sub
Private Sub mnuActionSettings_Click()
frmVMSettings.Caption = "Settings for " & VMList.List(VMList.ListIndex)
frmVMSettings.Show
End Sub
Private Sub mnuActionStart_Click()
Start68kEmulation
End Sub
Private Sub mnuFileOptions_Click()
frmOptions.Show
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show
End Sub
Private Sub mnuHelpSearchForHelpOn_Click()
Dim nRet As Integer
'si no hay archivo de ayuda para este proyecto, mostrar un mensaje al usuario
'puede establecer el archivo de Ayuda para su aplicaci<63>n en el cuadro
'de di<64>logo Propiedades del proyecto
If Len(App.HelpFile) = 0 Then
MsgBox "Cannot show help contents. There is no help content avaible (yet)", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuHelpContents_Click()
Dim nRet As Integer
'si no hay archivo de ayuda para este proyecto, mostrar un mensaje al usuario
'puede establecer el archivo de Ayuda para la aplicaci<63>n en el cuadro
'de di<64>logo Propiedades del proyecto
If Len(App.HelpFile) = 0 Then
MsgBox "Cannot show help contents. There is no help content avaible (yet)", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End
End Sub
Private Sub mnuNewDisk_Click()
frmNewDisk.Show
End Sub
Private Sub mnuNewMac_Click()
frmNewMac.Show
End Sub
Private Sub NewMac_Click()
frmNewMac.Show
End Sub
Private Sub Remove_Click()
RemoveSelectedMac
End Sub
Private Sub Settings_Click()
OpenSettingsFor VMList.List(VMList.ListIndex)
End Sub
Public Sub OpenSettingsFor(MacName As String)
frmVMSettings.Caption = "Settings for " & MacName
frmVMSettings.Show
End Sub
Private Sub Start_Click()
Start68kEmulation
End Sub
Private Sub VirtualMacTrayIcon_DblClick(Button As Integer)
MsgBox "XDR"
'frmMain.ShowInTaskbar = True
End Sub
Public Sub DisableButtons()
mnuActionStart.Enabled = False
mnuActionPause.Enabled = False
mnuActionRestart.Enabled = False
mnuActionRemove.Enabled = False
mnuActionSettings.Enabled = False
mnuActionProperties.Enabled = False
Settings.Enabled = False
Remove.Enabled = False
Start.Enabled = False
End Sub
Private Sub VM_Click(Index As Integer)
'===Makes it look like you selected an object===
'When you make a single click, you'll select the element
'Declarations
Dim X As Long
'This makes all the items 'un-select', in other words, makes them white
For X = 1 To VMList.ListCount
VM(X).BackColor = &HFFFFFF
Next
'This selects the current item
VM(Index).BackColor = &H8000000D
'Let's enable those buttons and select the
'corresponding item in the hidden list
EnableButtons
VMList.ListIndex = Index - 1
End Sub
Private Sub VM_DblClick(Index As Integer)
Start68kEmulation
End Sub
Private Sub VMDescription_Click(Index As Integer)
'===Makes it look like you selected an object===
'When you make a single click, you'll select the element
'Declarations
Dim X As Long
'This makes all the items 'un-select', in other words, makes them white
For X = 1 To VMList.ListCount
VM(X).BackColor = &HFFFFFF
Next
'This selects the current item
VM(Index).BackColor = &H8000000D
'Let's enable those buttons and select the
'corresponding item in the hidden list
EnableButtons
VMList.ListIndex = Index - 1
End Sub
Private Sub VMDescription_DblClick(Index As Integer)
Start68kEmulation
End Sub
Private Sub VMGraphicList_Click()
'To handle errors in execution time (And avoid that
'the app will crash just because a human error)
On Error GoTo ErrorHandler
'Declarations
Dim X As Long
If VMList.ListCount > 0 Then
DisableButtons
VMList.ListIndex = -1
For X = 1 To VMList.ListCount
VM(X).BackColor = &HFFFFFF
Next
End If
ErrorHandler:
If Err.Number <> 0 Then
If Err.Number = 340 Then Resume Next
If Not Err.Number = 340 Then
MsgBox "Error '" & Err.Number & "' in execution time. " & Err.Description, vbExclamation
End If
End If
End Sub
Private Sub VMGraphicScroll_Change()
'===Will make the top of the list items to go up and down===
'Funny declarations (Maybe not funny...)
'Dim X As Long
'Dim Sum As Long
'Sum = VM(0) * VM.Count
'Let's place down every item
'For X = 1 To Sum
'Next
End Sub
Private Sub VMList_Click()
If VMList.ListIndex <> -1 Then
EnableButtons
End If
End Sub
Private Sub VMList_GotFocus()
If VMList.ListIndex <> -1 Then
EnableButtons
End If
End Sub
Private Sub VMName_Click(Index As Integer)
'===Makes it look like you selected an object===
'When you make a single click, you'll select the element
'Declarations
Dim X As Long
'This makes all the items 'un-select', in other words, makes them white
For X = 1 To VMList.ListCount
VM(X).BackColor = &HFFFFFF
Next
'This selects the current item
VM(Index).BackColor = &H8000000D
'Let's enable those buttons and select the
'corresponding item in the hidden list
EnableButtons
VMList.ListIndex = Index - 1
End Sub
Private Sub VMName_DblClick(Index As Integer)
Start68kEmulation
End Sub
Private Sub VMSnap_Click(Index As Integer)
'===Makes it look like you selected an object===
'When you make a single click, you'll select the element
'Declarations
Dim X As Long
'This makes all the items 'un-select', in other words, makes them white
For X = 1 To VMList.ListCount
VM(X).BackColor = &HFFFFFF
Next
'This selects the current item
VM(Index).BackColor = &H8000000D
'Let's enable those buttons and select the
'corresponding item in the hidden list
EnableButtons
VMList.ListIndex = Index - 1
End Sub
Private Sub VMSnap_DblClick(Index As Integer)
Start68kEmulation
End Sub