central.frm

这个代码是基于软盘修复

'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

'+--------------------------------------------------------+
'| (c) Manuel Augusto N. dos Santos - July 2000           |
'+--------------------------------------------------------+
Option Explicit
'--------------------------------------Windows API Functions
Private Declare Sub GetCursorPos Lib "user32" (lpPoint As Point)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As Point)
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ReleaseWinCapture Lib "user32" Alias "ReleaseCapture" () As Long
Private Declare Function SendWinMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function WinHelp Lib "user32.dll" Alias "WinHelpA" (ByVal hWndMain As Long, ByVal lpHelpFile As String, ByVal uCommand As Long, dwData As Any) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
'----------------------------------------------------Private
Private mInterval As Long    'intervalo (ms) para crono timer
'------------------------------------------------------Const
Private Const WM_MOVE = &HF012
Private Const WM_SYSCOMMAND = &H112
Private Const SRCCOPY = &HCC0020
Private Const HELP_CONTENTS = &H3&
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

'---------------------------------------------Control Events
Private Sub EditTimer_Timer()
  If mWork = 4 Then
    Call EditDisk(eoReading)
  Else
    EditTimer.Enabled = False
  End If
End Sub

Private Sub FocusCenter_KeyUp(KeyCode As Integer, Shift As Integer)
  Dim aux As Long
    
  If mWork <> 4 Then Exit Sub
  aux = SectorStat(SectorNumber(EditTrack, EditSide, EditSector))
  Call DisplaySectors(EditTrack, EditSide, EditSector, aux)
  Select Case KeyCode
    Case vbKeyLeft:
      If EditTrack > 0 Then EditTrack = EditTrack - 1 Else EditTrack = 79
    Case vbKeyRight:
      If EditTrack < 79 Then EditTrack = EditTrack + 1 Else EditTrack = 0
    Case vbKeyUp:
      aux = NumSectors()
      If EditSector > 1 Then
        EditSector = EditSector - aux
      Else
        If EditSide = 0 Then EditSide = 1 Else EditSide = 0
        EditSector = 19 - aux
      End If
    Case vbKeyDown:
      aux = NumSectors()
      If EditSector + aux <= 18 Then
        EditSector = EditSector + aux
      Else
        If EditSide = 0 Then EditSide = 1 Else EditSide = 0
        EditSector = 1
      End If
  End Select
  Call EditDisk(eoMove)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim Mpos As Point
  Dim Wpos As Point
  Dim res As Long
  
  res = ReleaseWinCapture()
  'res = SendWinMessage(Me.hWnd, WM_SYSCOMMAND, WM_MOVE, 0)  'does not work on NT
  res = SendWinMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  FocusCenter.SetFocus
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  CronoMode = tmNothing
  Crono.Enabled = False
  Crono.Interval = 0
  FocusCenter.SetFocus
End Sub

Private Sub Crono_Timer()
  Call InTimeControl
End Sub

Private Sub Form_Load()
  Dim i As Long
  Dim MyStr As String
 
  '公用缺省
  Crono.Enabled = False
  CronoMode = tmNothing
  mWork = 0
  mSaveName = "DTPRO.SAV"
  StartEnd.SetForm Central, StartEnd.Left, StartEnd.Top
  mJumpNext = 200
  mOperation = 1
  mLightRead = 1
  ToolTips = True
  Editting = False
  PosGO = 5
  MouseGO = False
  For i = 1 To 2880
    SectorStat(i) = statNormal
    SectorInfo(i) = IOempty
    SecCopy(i) = False
  Next i
  '默认 - 扫描
  mLightScan(1) = False: mLightScan(2) = False: mLightScan(3) = True
  mLightScan(4) = True:  mLightScan(5) = False: mLightScan(6) = False
  mLightScan(7) = False: mLightScan(8) = True
  mLightScan(9) = False: mLightScan(10) = False
  For i = 1 To 10: mUserOp(i) = mLightScan(i): Next i
  '默认 - 格式化
  mLightFormat(1) = True: mLightFormat(2) = False
  mLightFormat(3) = True: mLightFormat(4) = True
  '默认 - 恢复
  mLightRecover(1) = True:  mLightRecover(2) = False
  mLightRecover(3) = False: mLightRecover(4) = True: mLightRecover(5) = True
  '默认 - 编辑
  mLightEdit(1) = False:  mLightEdit(2) = False
  mLightEdit(3) = True:   mLightEdit(4) = False
  mLightEdit(5) = False
  mLightEdit(6) = False:  mLightEdit(7) = False
  mLightEdit(8) = False:  mLightEdit(9) = False
  '显示全部
  Call PicWindow_Click(3)  '完整视图
  '设置焦点
  MyStr = String(20, Chr$(0))
  MyStr = " Disktest PRO"
  SetWindowText Me.hWnd, MyStr
  '校验 Windows 版本
  IsWinNT = False
  If GetWindowsVersion() = 2 Then IsWinNT = True
End Sub

Private Sub GoTimer_Timer()
  Dim Pic As StdPicture
  
  If MouseGO Then
    If PosGO > 0 Then
      PosGO = PosGO - 1
      If (PosGO > 0) And (mWork > 0) Then PosGO = 0
      Set Pic = LoadResPicture(206 - PosGO, vbResBitmap)
      Central.PaintPicture Pic, PicGO.Left, PicGO.Top, 57, 17, 0, 0, 57, 17, vbSrcCopy
      If PosGO = 0 Then Call DisplayGoText
    End If
  Else
    If PosGO < 5 Then
      PosGO = PosGO + 1
      If (PosGO < 5) And (mWork > 0) Then PosGO = 5
      Set Pic = LoadResPicture(206 - PosGO, vbResBitmap)
      Central.PaintPicture Pic, PicGO.Left, PicGO.Top, 57, 17, 0, 0, 57, 17, vbSrcCopy
    Else
      GoTimer.Enabled = False
    End If
  End If
End Sub

Private Sub HelpDTP_Click()
  WinHelp Me.hWnd, "DTPRO.HLP", HELP_CONTENTS, ByVal 0
End Sub

Private Sub PicDisk_Click()
  Dim i As Long
  
  DoEvents
  If mWork > 0 Then Exit Sub
  If TestDiskReady = True Then
    Call PrepareDisk
    For i = 1 To 2880
      SecCopy(i) = False
    Next i
    Call ReDisplayTool
  End If
End Sub

Private Sub PicDisk_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If CronoMode = tmNothing Then
    CronoMode = tmOverDisk
    Crono.Interval = defInterval
    Crono.Enabled = True
  End If
End Sub

Private Sub PicGO_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If CronoMode = tmNothing Then
    CronoMode = tmOverGO
    Crono.Interval = defInterval
    Crono.Enabled = True
    If PosGO > 0 Then
      GoTimer.Enabled = True
      MouseGO = True
    End If
  End If
End Sub

Private Sub PicGO_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If mWork = 0 Then
    If PosGO = 0 Then
      Select Case mOperation
        Case 1: Call CentralSurfaceScan(2)
        Case 2: Call CentralFormatDisk(2)
        Case 3: Call CentralRecoverDisk(2)
        Case 4: Call CentralEditMode(2)
      End Select
    End If
  Else
    If mWork = 4 Then Call EditDisk(eoEndEdit)
    mWork = 0
    Call DisplayGoText
  End If
End Sub

Private Sub StartCursor_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StartEnd.MouseOp 1
End Sub

Private Sub EndCursor_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StartEnd.MouseOp 2
End Sub

Private Sub StartCursor_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StartEnd.MouseOp 0
End Sub

Private Sub EndCursor_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  StartEnd.MouseOp 0
End Sub

Private Sub PicCentral_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call StartControlAction(X, Y)
End Sub

Private Sub PicCentral_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call EndControlAction(X, Y)
End Sub

Private Sub PicClose_Click()
  If MarkBad = True Then
    Call WriteDiskDATA
    MarkBad = False
  End If
  Call CloseDiskIO
  Call DiskSystemReset
  End
End Sub

Private Sub PicClose_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If CronoMode = tmNothing Then
    CronoMode = tmOverExit
    Crono.Interval = defInterval
    Crono.Enabled = True
  End If
End Sub

Private Sub PicWindow_Click(Index As Integer)
  Dim i As Integer
  Dim wndReg As Long
  Dim wndRet As Long
  
  mModWin = Index
  '不规则窗体
  wndReg = RegionFromMask(CentralPics(1), mModWin, RGB(255, 255, 255))
  wndRet = SetWindowRgn(Me.hWnd, wndReg, True)
  Select Case Index
    Case 0:  '居中视图
      Central.Height = 154 * Screen.TwipsPerPixelY
      PicClose.Top = 39
      PicWindow(0).Top = 39: PicWindow(1).Top = 39
      PicWindow(2).Top = 39: PicWindow(3).Top = 39
      PicDisk.Top = 38
      TealTech.Top = 38
      HelpDTP.Top = 38
      PicCentral.Top = 53
      PicGO.Top = 39
    Case 1:  '表面视图
      Central.Height = 311 * Screen.TwipsPerPixelY
      PicClose.Top = 291
      PicWindow(0).Top = 291: PicWindow(1).Top = 291
      PicWindow(2).Top = 291: PicWindow(3).Top = 291
      PicDisk.Top = 290
      TealTech.Top = 290
      HelpDTP.Top = 290
      PicCentral.Top = 10000
      PicGO.Top = 291
    Case 2:  '小型视图
      Central.Height = 59 * Screen.TwipsPerPixelY
      PicClose.Top = 39
      PicWindow(0).Top = 39: PicWindow(1).Top = 39
      PicWindow(2).Top = 39: PicWindow(3).Top = 39
      PicDisk.Top = 38
      TealTech.Top = 38
      HelpDTP.Top = 38
      PicCentral.Top = 10000
      PicGO.Top = 39
    Case 3:  '完整视图
      Central.Height = 406 * Screen.TwipsPerPixelY
      PicClose.Top = 291
      PicWindow(0).Top = 291: PicWindow(1).Top = 291
      PicWindow(2).Top = 291: PicWindow(3).Top = 291
      PicDisk.Top = 290
      TealTech.Top = 290
      HelpDTP.Top = 290
      PicCentral.Top = 305
      PicGO.Top = 291
  End Select
  HelpDTP.Left = 428
  PicCentral.Left = 3
  PicClose.Left = 173
  PicDisk.Left = 233
  PicGO.Left = 262
  PicWindow(0).Left = 337: PicWindow(1).Left = 354
  PicWindow(2).Left = 371: PicWindow(3).Left = 388
  StartEnd.Left = 4: StartEnd.Top = 8
  TealTech.Left = 8
  Call VerifyControls
  Call ReDisplayCentral
End Sub

Private Sub PicWindow_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  If CronoMode = tmNothing Then
    CronoMode = tmOverChgWin1 + Index
    Crono.Interval = defInterval
    Crono.Enabled = True
  End If
End Sub

Private Sub TealTech_Click()
  MousePointer = 0
  ToolTips = False
  DoEvents
  About.Show vbModal, Me
  Unload About
  ToolTips = True
End Sub

Private Sub Tempo_Timer()
  Dim NovoNow As Long
  
  If (mModWin = 1) Or (mModWin = 2) Then Exit Sub
  NovoNow = CalcNowSeconds(H24)
  If NovoNow <> oldNow Then
    If oldNow >= 0 Then
      Call Ponteiros(Central, oldNow, 0, 398, 60 + Central.PicCentral.Top - 21, 15)
    End If
    Call Ponteiros(Central, NovoNow, 1, 398, 60 + Central.PicCentral.Top - 21, 15)
    oldNow = NovoNow
  End If
End Sub

Private Sub TimedWave1_Added()
  Select Case mModWin
    Case 1, 2: Exit Sub
    Case 0: BitBlt Central.hDC, 484, 112, TimedWave1.Width, TimedWave1.Height, TimedWave1.hDC, 0, 0, SRCCOPY
    Case 3: BitBlt Central.hDC, 484, 364, TimedWave1.Width, TimedWave1.Height, TimedWave1.hDC, 0, 0, SRCCOPY
  End Select
End Sub

Private Sub ToolTipTimer_Timer()
  Dim tMain As Byte, tSub As Byte
  Dim Mpos As Point, Fpos As Point
  
  Call GetCursorPos(Mpos)
  Call GetFormCursorPos(Mpos, Central.Left, Central.Top, Fpos)
  Call ToolTipAtMouse(tMain, tSub, Fpos.X, Fpos.Y - Central.PicCentral.Top + 21)
  Call DisplayToolTip(tMain, tSub)
End Sub