-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathfrmDiskEd.frm
1214 lines (1128 loc) · 44.7 KB
/
frmDiskEd.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
VERSION 5.00
Begin VB.Form frmDiskEd
BorderStyle = 1 'Fixed Single
Caption = "Disk Image Editor"
ClientHeight = 6135
ClientLeft = 45
ClientTop = 390
ClientWidth = 14835
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 409
ScaleMode = 3 'Pixel
ScaleWidth = 989
StartUpPosition = 3 'Windows Default
Begin VB.Frame frSector
Height = 1185
Left = 5310
TabIndex = 17
Top = 420
Width = 9435
Begin VB.CommandButton cmdBlockOps
Caption = "Restore"
Height = 585
Index = 4
Left = 8490
TabIndex = 32
Top = 510
Width = 825
End
Begin VB.CommandButton cmdBlockOps
Caption = "Fill"
Height = 285
Index = 3
Left = 7620
TabIndex = 31
Top = 810
Width = 825
End
Begin VB.CommandButton cmdBlockOps
Caption = "Zero"
Height = 285
Index = 2
Left = 7620
TabIndex = 30
Top = 510
Width = 825
End
Begin VB.CommandButton cmdBlockOps
Caption = "Paste"
Height = 285
Index = 1
Left = 8490
TabIndex = 29
Top = 180
Width = 825
End
Begin VB.CommandButton cmdBlockOps
Caption = "Copy"
Height = 285
Index = 0
Left = 7620
TabIndex = 28
Top = 180
Width = 825
End
Begin VB.TextBox txtLTrack
BackColor = &H00FFFFFF&
Enabled = 0 'False
Height = 285
Left = 2100
TabIndex = 23
Text = "00"
Top = 480
Width = 405
End
Begin VB.TextBox txtLSector
Enabled = 0 'False
Height = 285
Left = 2100
TabIndex = 22
Text = "00"
Top = 810
Width = 405
End
Begin VB.TextBox txtCurSector
Height = 285
Left = 870
TabIndex = 21
Text = "00"
Top = 810
Width = 405
End
Begin VB.TextBox txtCurTrack
Height = 285
Left = 870
TabIndex = 20
Text = "00"
Top = 480
Width = 405
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H000000C0&
Caption = "Error Map"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 465
Index = 11
Left = 5760
TabIndex = 46
Top = 600
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H0080C0FF&
Caption = "TT/SS"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 465
Index = 10
Left = 5130
TabIndex = 45
Top = 600
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H0080C0FF&
Caption = "SET"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 9
Left = 5130
TabIndex = 44
Top = 300
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H000080FF&
Caption = "TT/SS"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 465
Index = 8
Left = 4500
TabIndex = 43
Top = 600
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H000080FF&
Caption = "SET"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 7
Left = 4500
TabIndex = 42
Top = 300
Width = 585
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "QUICK NAV:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2610
TabIndex = 41
Top = 210
Width = 1080
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00008000&
Caption = "First BAM"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 465
Index = 6
Left = 3870
TabIndex = 40
Top = 600
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00800000&
Caption = "First DIR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 465
Index = 5
Left = 3240
TabIndex = 39
Top = 600
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00C000C0&
Caption = "TT/SS LINK"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 465
Index = 4
Left = 2610
TabIndex = 38
Top = 600
Width = 585
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00808000&
Caption = "<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 3
Left = 1320
TabIndex = 37
Top = 810
Width = 225
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00808000&
Caption = ">"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 2
Left = 1590
TabIndex = 36
Top = 810
Width = 225
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00808000&
Caption = ">"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 0
Left = 1590
TabIndex = 35
Top = 510
Width = 225
End
Begin VB.Label lblNav
Alignment = 2 'Center
BackColor = &H00808000&
Caption = "<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Index = 1
Left = 1320
TabIndex = 34
Top = 510
Width = 225
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "LINK:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 2010
TabIndex = 27
Top = 210
Width = 495
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "CURRENT:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 150
TabIndex = 26
Top = 210
Width = 975
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "T:"
Height = 195
Left = 1935
TabIndex = 25
Top = 510
Width = 150
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "S:"
Height = 195
Left = 1935
TabIndex = 24
Top = 840
Width = 150
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "SECTOR:"
Height = 195
Left = 60
TabIndex = 19
Top = 840
Width = 765
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "TRACK:"
Height = 195
Left = 30
TabIndex = 18
Top = 510
Width = 765
End
End
Begin VB.PictureBox picV
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FF0000&
ForeColor = &H80000008&
Height = 3855
Left = 5310
ScaleHeight = 255
ScaleMode = 3 'Pixel
ScaleWidth = 609
TabIndex = 16
Top = 1710
Width = 9165
End
Begin VB.VScrollBar vsV
Height = 3855
LargeChange = 2
Left = 14460
Max = 20
TabIndex = 14
Top = 1710
Width = 285
End
Begin VB.CommandButton cmdSave
Caption = "Save Changes"
Height = 285
Left = 13260
TabIndex = 13
Top = 60
Width = 1515
End
Begin VB.CheckBox cbShAll
Caption = "ALL"
Height = 285
Left = 60
TabIndex = 9
Top = 5940
Width = 705
End
Begin VB.VScrollBar vsDir
Height = 5145
Left = 4890
Max = 20
TabIndex = 8
Top = 420
Width = 255
End
Begin VB.PictureBox picED
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H8000000D&
ForeColor = &H80000008&
Height = 465
Left = 5310
ScaleHeight = 29
ScaleMode = 3 'Pixel
ScaleWidth = 145
TabIndex = 0
ToolTipText = "Editing Box: ENTER=Done, ESC=Abort, END=Toggle Case"
Top = 5610
Visible = 0 'False
Width = 2205
End
Begin VB.PictureBox picFree
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FF0000&
ForeColor = &H80000008&
Height = 285
Left = 60
ScaleHeight = 17
ScaleMode = 3 'Pixel
ScaleWidth = 319
TabIndex = 7
Top = 5640
Width = 4815
End
Begin VB.PictureBox picID
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FF0000&
ForeColor = &H80000008&
Height = 270
Left = 3990
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 33
TabIndex = 6
Top = 60
Width = 525
End
Begin VB.PictureBox picHeader
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FF0000&
ForeColor = &H80000008&
Height = 270
Left = 60
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 254
TabIndex = 5
Top = 60
Width = 3840
End
Begin VB.PictureBox PicFiles
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FF0000&
ForeColor = &H80000008&
Height = 5145
Left = 60
ScaleHeight = 341
ScaleMode = 3 'Pixel
ScaleWidth = 321
TabIndex = 4
Top = 420
Width = 4845
End
Begin VB.PictureBox picDOS
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FF0000&
ForeColor = &H80000008&
Height = 270
Left = 4620
ScaleHeight = 16
ScaleMode = 3 'Pixel
ScaleWidth = 33
TabIndex = 3
Top = 60
Width = 525
End
Begin VB.PictureBox picFontSet
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 2205
Left = 5070
ScaleHeight = 2175
ScaleWidth = 4335
TabIndex = 2
Top = 6240
Width = 4365
End
Begin VB.Timer Timer1
Interval = 500
Left = 16860
Top = 120
End
Begin VB.Label lblDebug
Caption = "Label7"
Height = 375
Left = 7800
TabIndex = 33
Top = 5700
Width = 5985
End
Begin VB.Label lblView
Alignment = 2 'Center
BackColor = &H000000C0&
BorderStyle = 1 'Fixed Single
Caption = "Error Map"
ForeColor = &H00FFFFFF&
Height = 300
Index = 3
Left = 10260
TabIndex = 15
Tag = "&H00FF0000&"
ToolTipText = "Click to View X-Cable directory"
Top = 60
Width = 1575
End
Begin VB.Label lblView
Alignment = 2 'Center
BackColor = &H000080FF&
BorderStyle = 1 'Fixed Single
Caption = "Sector"
ForeColor = &H00FFFFFF&
Height = 300
Index = 2
Left = 8610
TabIndex = 12
Tag = "&H00FF0000&"
ToolTipText = "Click to View X-Cable directory"
Top = 60
Width = 1575
End
Begin VB.Label lblView
Alignment = 2 'Center
BackColor = &H00008000&
BorderStyle = 1 'Fixed Single
Caption = "Block Avail Map"
ForeColor = &H00FFFFFF&
Height = 300
Index = 1
Left = 6960
TabIndex = 11
Tag = "&H00FF0000&"
ToolTipText = "Click to View X-Cable directory"
Top = 60
Width = 1575
End
Begin VB.Label lblView
Alignment = 2 'Center
BackColor = &H00C00000&
BorderStyle = 1 'Fixed Single
Caption = "Directory Entry"
ForeColor = &H00FFFFFF&
Height = 300
Index = 0
Left = 5310
TabIndex = 10
Tag = "&H00FF0000&"
ToolTipText = "Click to View X-Cable directory"
Top = 60
Width = 1575
End
Begin VB.Label lblX
Caption = "0"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 13890
TabIndex = 1
Top = 5610
Width = 795
End
End
Attribute VB_Name = "frmDiskEd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' CBM-Transfer - Copyright (C) 2007-2017 Steve J. Gray
' ====================================================
'
' frmDiskEd - Disk Image File Editor
'
' Edit Disk Images (D64, D71, D80 etc). View Sectors.
'
' NOTE: This feature is incomplete! Viewing is limited, and writing is not supported.
Dim Blink As Boolean
Dim FontSet As Integer
Dim LastRow As Integer, LastCol As Integer, LastW As Integer, LastH As Integer 'Save printing position
Dim GetKey As Integer, GetCode As Integer
Dim ViewMode As Integer
Dim DIFilename As String 'Disk Image Filename
Dim TPos(160) 'File Offsets for track starts - must add sector offset
Dim DI As DskImg 'The parameters for the disk image
Dim Hdr As Header1Type 'The Header Info (will be re-dim'd later for proper format)
Dim DEntry(244) As DirEntryType 'Directory Entry (will be re-dim'd later for proper format)
Dim bam As BAM4Type 'BAM Track entry (will be re-dim'd later for proper format)
Dim BBuf As String * 256 'Disk Sector Buffer
Dim CBuf As String * 256 'Copy Buffer
Dim UBuf As String * 256 'UNDO Buffer
Dim TrackNum As Integer, SectorNum As Integer 'Current Track and Sector
Dim LinkT As Integer, LinkS As Integer 'Sector Link - first two bytes of sector point to next sector
Dim DFIO As Integer 'Disk File# - remains open for all subs
Dim UserT1 As Integer, UserS1 As Integer 'User Block1
Dim UserT2 As Integer, UserS2 As Integer 'User Block1
'---- Load the Form
Private Sub Form_Load()
On Error Resume Next
'-- Load FONTs - Each character is 8x8pixels. Two 256-character fonts arranged in 32x16 grid
' (graphics set followed by text set)
picFontSet.Picture = LoadPicture(ExeDir & "\font-c64.bmp")
Me.Show
End Sub
'---- Unload Form
Private Sub Form_Unload(Cancel As Integer)
Close DFIO 'Close disk image file
End Sub
'---- Load a Disk Image
' This routine is called from the main form with the name of the disk imaged passed to it
Public Sub LoadImg(ByVal Filename As String)
Dim Ext As String, DParamFile, FIO As Integer, FLen As Long
If Exists(Filename) = False Then Exit Sub
DIFilename = Filename 'Remember the Disk Image filename
Me.Caption = "Disk Image Editor: " & DIFilename 'Set the Titlebar
DFIO = FreeFile
Open Filename For Binary As DFIO 'Open the Disk Image File - DO NOT CLOSE FILE!!!!!
FLen = LOF(DFIO): DI.FileSize = FLen 'Get the File Size
Ext = FileExt(Filename) 'Get Disk Image Type (Extension)
DParamFile = ExeDir & "image-" & Ext & ".txt" 'Filename for Paramters
If Exists(DParamFile) = True Then
LoadParams DParamFile 'Load the Parameters
ReadDir 'Read Directory
ViewMode = 2 'TEMP: sector editor
SelectTab 'Select TAB
TrackNum = DI.DirT: SectorNum = DI.DirS 'TEMP: Directory Track and Sector
ChangeTS 'ValidateTS, ReadBlock and Update View
Else
MyMsg "Fatal Error: Can't load Disk Image Parameter File!"
Unload Me 'Ooops, no go!
End If
End Sub
'---- Read Directory and Header, then Display It
Private Sub ReadDir()
End Sub
'---- Handle clicking of View Tab Buttons
Private Sub lblView_Click(Index As Integer)
ViewMode = Index
SelectTab
End Sub
'---- Set View Tab Button Hilighting
Private Sub SelectTab()
Dim a As Integer
For a = 0 To 3
lblView(a).Font.Bold = False
lblView(a).ForeColor = vbBlack
Next a
If DI.MaxErr = 0 Then
lblView(3).Enabled = False
lblNav(11).Visible = False
Else
lblView(3).Enabled = True 'Show or Hide Error block tab
lblNav(11).Visible = True
End If
lblView(ViewMode).Font.Bold = True
lblView(ViewMode).ForeColor = vbWhite
DoEvents
'-- Hide Elements
picV.Visible = False
vsV.Visible = False
frSector.Visible = False
'-- Unhide Elements and set parameters
Select Case ViewMode
Case 0
Case 1
Case 2 'Sector
picV.Visible = True 'Show output area
vsV.Min = 1: vsV.Max = 17 'Set scrollbar range
vsV.Visible = True 'Show the scrollbar
frSector.Visible = True 'Show Info Frame
Case 3
End Select
End Sub
'---- Update the Current view
Private Sub UpdateView()
Select Case ViewMode
Case 0: ViewDEnt 'Directory Entry
Case 1: ViewBAM 'BAM
Case 2: ViewSector 'Sector
Case 3: ViewError 'Error
End Select
DoEvents
End Sub
'---- View Directory Entry
Private Sub ViewDEnt()
End Sub
'---- View BAM
Private Sub ViewBAM()
End Sub
'---- View Sector
Private Sub ViewSector()
Dim i As Integer, j As Integer, n As Integer, bv As String * 1, hv As String
Dim Out As String, Out2 As String, TopRow As Integer
TopRow = vsV.value - 1: lblX.Caption = Str(TopRow) 'Read Scrollbar value for top line
txtCurTrack.Text = Str(TrackNum) 'Track
txtCurSector.Text = Str(SectorNum) 'Sector
n = GetBV(1): LinkT = n: txtLTrack.Text = Str(n) 'Link-to Track
n = GetBV(2): LinkS = n: txtLSector.Text = Str(n) 'Link-to Track
If LinkT = 0 Then lblNav(4).Visible = False Else lblNav(4).Visible = True 'Show or Hide Link Button
For i = 0 To 15
n = (TopRow + i) * 8 'Calculate Top Offset
Out = MyHex(n, 2) & ": ": Out2 = "" 'Set initial output strings
For j = 0 To 7
bv = GetBC(n + j + 1) 'Get the byte
hv = Asc(bv) 'Hex value
Out = Out & MyHex(hv, 2) & " " 'Add to hex output string
Out2 = Out2 & bv 'Add to cbm output string
Next j
CBMPrint Out, i, 0, 0, 36, 2, 0, picV 'Print the hex values
CBMPrint Out2, i, 29, 0, 36, 2, 0, picV 'Print the cbm characters
Next i
End Sub
'---- View Error Block (if Disk Image has one)
Private Sub ViewError()
End Sub
'---- Navigate Sector View
Private Sub lblNav_Click(Index As Integer)
Select Case Index
Case 0: TrackNum = TrackNum + 1 'Track UP
Case 1: TrackNum = TrackNum - 1 'Track DOWN
Case 2: SectorNum = SectorNum + 1 'Sector UP
Case 3: SectorNum = SectorNum - 1 'Sector DOWN
Case 4: If LinkT > 0 Then TrackNum = LinkT: SectorNum = LinkS 'Jump to Link (Track must be >0)
Case 5: TrackNum = DI.DirT: SectorNum = DI.DirS 'Jump to First Directory Block
Case 6: TrackNum = DI.BAMT: SectorNum = DI.BAMS 'Jump to First BAM Block
Case 7
UserT1 = TrackNum: UserS1 = SectorNum 'Set User Jump1
lblNav(8).Caption = TTSS(UserT1, UserS1)
Case 8: TrackNum = UserT1: SectorNum = UserS1 'Jump to User Block
Case 9
UserT2 = TrackNum: UserS2 = SectorNum 'Set User Jump2
lblNav(10).Caption = TTSS(UserT2, UserS2)
Case 10: TrackNum = UserT2: SectorNum = UserS2 'Jump to User Block
Case 11 'Error Map
End Select
ValidateTS 'Correct T or S if needed
GetBlock 'Read the block (TrackNum,SectorNum)
UpdateView 'Display it
End Sub
'---- Block Operations
Private Sub cmdBlockOps_Click(Index As Integer)
Dim Tmp As String, n As Integer
Select Case Index
Case 0: CBuf = BBuf 'Copy Buffer
Case 1: BBuf = CBuf 'Paste Buffer
Case 2: BBuf = String(256, Chr(0)) 'Zero Buffer
Case 3
Tmp = InputBox("Enter DECIMAL value to fill:", "Fill Block", "00")
If Tmp <> "" Then
n = Int(Val(Tmp)) 'Get value
BBuf = String(256, Chr(n)) 'Fill it
End If
Case 4: BBuf = UBuf 'Restore Buffer
End Select
UpdateView 'Display it
End Sub
'---- Keypress on CBM EDIT field
Private Sub picED_KeyDown(KeyCode As Integer, Shift As Integer)
GetCode = KeyCode
lblKeyD.Caption = Str(KeyCode)
End Sub
Private Sub picEd_KeyPress(KeyAscii As Integer)
GetKey = KeyAscii 'Pass it to global variable
lblKeystroke.Caption = Str(KeyAscii)
End Sub
Private Sub picED_LostFocus()
GetKey = 27 'If you click somewhere else assume ESC
End Sub
Private Sub picHeader_Click()
Dim Txt As String
Txt = CBMEdit(picHeader, "header", 0, 15, 2, 0, 0, 0) 'dummy
End Sub
Private Sub picID_Click()
Dim Txt As String
Txt = CBMEdit(picID, "id", 0, 1, 2, 0, 0, 0) 'dummy
End Sub
Private Sub picDOS_Click()
Dim Txt As String
Txt = CBMEdit(picDOS, "2a", 0, 1, 2, 0, 0, 0) 'dummy
End Sub
'---- Blinking Cursor timing
Private Sub Timer1_Timer()
Blink = Not Blink
End Sub
'---- CBM Print Routine for ASCII/SCREEN
' Mode selects format for Txt parameter: 0=ASCII, 1=SCREEN
' picFontSet is picturebox containing CBM font bitmap in 8x8 format with 32 character wide lines
' picP is the picturebox that you want to print to (byref)
' Row,Col are positions calculated with zoom factored in (negative value means use last position)
' MaxR,MaxC is the size of the printing box (negative value means use last position)
'
Sub CBMPrint(ByVal Txt As String, ByVal Row As Integer, ByVal Col As Integer, ByVal MaxR As Integer, ByVal MaxC As Integer, ByVal Zoom As Integer, ByVal Mode As Integer, ByRef picP As PictureBox)
Dim Ch As Integer, i As Integer, Z As Integer, ZZ As Integer, FS As Integer, RR As Integer
Dim R As Integer, C As Integer, SR As Integer, SC As Integer, R2 As Integer, C2 As Integer
R = Row: If Row < 0 Then R = LastRow 'Row# to start printing. If Row is negative then use Last Row
C = Col: If Col < 0 Then C = LastCol 'Col# to start printing. If Col is negative then use last Col
If MaxR < 0 Then MaxR = LastH
If MaxC < 0 Then MaxC = LastW
FS = FontSet * 64 'Font Set selection
ZZ = 8: Z = Zoom * ZZ 'Zoom
RR = R * Z: cc = C * Z 'Row/Col Pixel for start position
For i = 1 To Len(Txt)
Ch = Asc(Mid(Txt, i, 1)) 'Character to print
If Mode = 0 Then
Select Case Ch
Case 64 To 127: Ch = Ch - 64
'Case 96 To 127: Ch = Ch - 96 'Convert to Screen Code
End Select
End If
SR = Ch \ 32: SC = Ch Mod 32 'Source Row,Col for character in Font
R2 = SR * ZZ + FS: C2 = SC * ZZ 'Position in Font
picP.PaintPicture picFontSet.Image, cc, RR, Z, Z, C2, R2, ZZ, ZZ 'Blit it (with zoom)
C = C + 1: cc = cc + Z 'Next Col
If C > MaxC Then
C = 0: R = R + 1: If R > MaxR Then Exit For 'Next line, exit when at BOTTOM
RR = R * Z: cc = C * Z
End If
Next i
LastRow = R: LastCol = C: LastH = MaxR: LastW = MaxC 'Remember position and size
End Sub
'---- CBM Field Edit Routine for ASCII/SCREEN
' Mode selects format for Txt parameter: 0=ASCII, 1=SCREEN
' Uses picED picturebox. Position/size the box before calling this edit routine
' MaxR,MaxC are size of edit box and determines max size for editing
' Fmt is field type 0=Any,1=Numeric,2=Hex
' XFlag determines if cursor movement out of field acts as <CR> (ie: ends input). END key toggle case