modgraph.bas

这个代码是基于软盘修复

Attribute VB_Name = "modGraph"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/20
'描    述：软盘分析修复维护工具 Ver 1.3.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit

'------------------------------------------------Windows API
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
'-------------------------------------------------------Vars
Public ToolTips As Boolean

Private Const RGN_OR = 2

Public Enum OnOff
  setON = 1
  setOFF = 0
End Enum

'------------------------------------------------DigitalText
Public Sub DigitalText(ByVal pX As Long, ByVal pY As Long, ByVal Text As String, ByVal modo As Byte, Optional color As Long)
  Dim posChar As Long
  Dim StrTam As Long
  Dim CharVal As Long
  Dim PosX As Long
  
  StrTam = Len(Text)
  PosX = 0
  For posChar = 1 To StrTam
    CharVal = Asc(Mid(Text, posChar, 1))
    If (CharVal < 32) Or (CharVal > 90) Then CharVal = 45
    Select Case modo
      Case 1:
        Central.PaintPicture Central.Letters(0).Picture, pX + PosX, pY, 5, 8, (CharVal - 32) * 5, 0, 5, 8, vbSrcCopy
        PosX = PosX + 5
      Case 2:
        Central.PaintPicture Central.Letters(1).Picture, pX + PosX, pY, 5, 5, (CharVal - 32) * 5, 0, 5, 5, vbSrcCopy
        PosX = PosX + 5
      Case 3:
        If (CharVal < 48) Or (CharVal > 57) Then
          PosX = PosX + 2
        Else
          Central.PaintPicture Central.Numbers.Picture, pX + PosX, pY, 4, 5, (CharVal - 48) * 4, 0, 4, 5, vbSrcCopy
          PosX = PosX + 4
        End If
      Case 4:
        Call DigitalBitText(Central, pX, pY, Text, RGB(255, 0, 0), RGB(15, 40, 47), 1)
      Case 5:
        Call DigitalBitText(Central, pX, pY, Text, color, RGB(15, 40, 47), 1)
    End Select
  Next posChar
End Sub

'---------------------------------------------RegionFromMask
Public Function RegionFromMask(picSource As PictureBox, ByVal modo As Long, Optional lngTransColor As Long = -1) As Long
  Dim wndRgn As Long, wndRgnTmp As Long, wndRgnAux As Long
  Dim pX As Long, pY As Long
  Dim tX As Long, tY As Long
  Dim pixVal As Long
  Dim rX1 As Long, rX2 As Long
  Dim shiftY As Long
  
  If lngTransColor = -1 Then lngTransColor = RGB(255, 255, 255)
  wndRgn = 0
  'set form shape
  Select Case modo
    Case 0: 'accelerate process for Central view
      shiftY = 252
      tY = 405
      tX = picSource.Width
      wndRgn = CreateRectRgn(1, 1, tX + 1, 33)
    Case 1: 'accelerate process for Surface view
      shiftY = 0
      tY = 310
      tX = picSource.Width
      wndRgn = CreateRectRgn(1, 1, tX + 1, 285)
    Case 2: 'accelerate process for Small view
      shiftY = 252
      tY = 310
      tX = picSource.Width
      wndRgn = CreateRectRgn(1, 1, tX + 1, 33)
    Case 3: 'accelerate process for Full view
      shiftY = 0
      tY = 405
      tX = picSource.Width
      wndRgn = CreateRectRgn(1, 1, tX + 1, 285)
  End Select
  'get mask pixels
  For pY = 285 To tY
    pX = 1
    Do While pX <= tX
      Do While (GetPixel(picSource.hDC, pX - 1, pY - 1) = lngTransColor) And (pX <= tX)
        pX = pX + 1
      Loop
      If pX <= tX Then
        rX1 = pX
        Do While (GetPixel(picSource.hDC, pX - 1, pY - 1) <> lngTransColor) And (pX <= tX)
          pX = pX + 1
        Loop
        rX2 = pX - 1
        wndRgnTmp = CreateRectRgn(rX1, pY - shiftY, rX2 + 1, pY + 1 - shiftY)
        wndRgnAux = CombineRgn(wndRgn, wndRgn, wndRgnTmp, RGN_OR)
        Call DeleteObject(wndRgnTmp)
      End If
    Loop
  Next pY
  RegionFromMask = wndRgn
End Function

'---------------------------------------------BrilhoPicClose
Public Sub BrilhoPicClose(ByVal modo As OnOff)
  If modo = setON Then
    Central.PicClose.Picture = LoadResPicture(102, vbResBitmap)
  Else
    Central.PicClose.Picture = LoadResPicture(101, vbResBitmap)
  End If
End Sub

'----------------------------------------------BrilhoPicDisk
Public Sub BrilhoPicDisk(ByVal modo As OnOff)
  If modo = setON Then
    Central.PicDisk.Picture = LoadResPicture(113, vbResBitmap)
  Else
    Central.PicDisk.Picture = LoadResPicture(112, vbResBitmap)
  End If
End Sub

'--------------------------------------------BrilhoPicWindow
Public Sub BrilhoPicWindow(ByVal Index As Integer, ByVal modo As OnOff)
  If modo = setON Then
    Central.PicWindow(Index).Picture = LoadResPicture(104 + Index * 2, vbResBitmap)
  Else
    Central.PicWindow(Index).Picture = LoadResPicture(103 + Index * 2, vbResBitmap)
  End If
End Sub

'--------------------------------------DisplayCentralSurface
Public Sub DisplayCentralSurface(ByVal Index As Integer)
  Dim Pic As New StdPicture
  
  Select Case Index
    Case 0:
      Set Pic = Central.CentralPics(3).Picture
      Central.PaintPicture Pic, 0, 0, 572, 32, 0, 0, 572, 32, vbSrcCopy
    Case 1:
      Set Pic = Central.CentralPics(2).Picture
      Central.PaintPicture Pic, 0, 0, 572, 284, 0, 0, 572, 284, vbSrcCopy
    Case 2:
      Set Pic = Central.CentralPics(3).Picture
      Central.PaintPicture Pic, 0, 0, 572, 32, 0, 0, 572, 32, vbSrcCopy
    Case 3:
      Set Pic = Central.CentralPics(2).Picture
      Central.PaintPicture Pic, 0, 0, 572, 284, 0, 0, 572, 284, vbSrcCopy
  End Select
  Set Pic = Nothing
End Sub

'---------------------------------------------DisplayCentral
Public Sub DisplayCentral(ByVal Index As Integer)
  Dim Pic As New StdPicture
  
  Select Case Index
    Case 0:
      Set Pic = Central.CentralPics(0).Picture
      Central.PaintPicture Pic, 0, 32, 572, 121, 0, 0, 572, 121, vbSrcCopy
    Case 1:
      Set Pic = LoadResPicture(114, vbResBitmap)
      Central.PaintPicture Pic, 0, 284, 572, 26, 0, 0, 572, 26, vbSrcCopy
    Case 2:
      Set Pic = LoadResPicture(114, vbResBitmap)
      Central.PaintPicture Pic, 0, 32, 572, 26, 0, 0, 572, 26, vbSrcCopy
    Case 3:
      Set Pic = Central.CentralPics(0).Picture
      Central.PaintPicture Pic, 0, 284, 572, 121, 0, 0, 572, 121, vbSrcCopy
  End Select
  oldNow = -1
  Set Pic = Nothing
End Sub

'-------------------------------------------RadioButtonCheck
Public Sub RadioButtonCheck(ByVal Aceso As Boolean, ByVal X As Long, ByVal Y As Long)
  Dim Pic As New StdPicture
  
  If Aceso Then
    Set Pic = LoadResPicture(116, vbResBitmap)
  Else
    Set Pic = LoadResPicture(115, vbResBitmap)
  End If
  Central.PaintPicture Pic, X, Y, 12, 11, 0, 0, 12, 11, vbSrcCopy
  Set Pic = Nothing
End Sub

'------------------------------------------------ControlDown
Public Sub ControlDown(ByVal modo As Byte, ByVal MainOp As Byte, ByVal SubOp As Byte)
  Dim Y As Long
  
  If (mModWin = 1) Or (mModWin = 2) Then Exit Sub
  Y = Central.PicCentral.Top - 21
  
  Select Case MainOp
    Case 1: 'Scan (Mark/Jump/Depth/Copy)
      Call DrawBox3D(Central, modo, 214, 31 + Y + (SubOp - 7) * 15, 32, 15)
    Case 2: 'Format (Mark/Jump)
      Call DrawBox3D(Central, modo, 214, 31 + Y + (SubOp - 3) * 15, 32, 15)
    Case 3: 'Recover (Mark/Jump/Depth/Up/Down/File)
      Select Case SubOp
        Case 3, 4, 5: 'Mark/Jump/Depth
          Call DrawBox3D(Central, modo, 214, 31 + Y + (SubOp - 3) * 15, 32, 15)
        Case 6: 'Up
          Call DrawBox3D(Central, modo, 149, 65 + Y, 11, 6)
        Case 7: 'Down
          Call DrawBox3D(Central, modo, 138, 65 + Y, 11, 6)
        Case 8: 'File
          Call DrawBox3D(Central, modo, 223, 78 + Y, 19, 10)
      End Select
    Case 4: 'Edit (Format/Overwrite/Mark/Unmark)
      Call DrawBox3D(Central, modo, 219, 31 + Y + (SubOp - 6) * 15, 27, 15)
   'Case 5: N Read
    Case 6: 'Main
      Call DrawBox3D(Central, modo, 264, 28 + Y + (SubOp - 1) * 18, 51, 17)
  End Select
End Sub

'------------------------------------------DisplayEditValues
Public Sub DisplayEditValues()
  Dim Y As Long
  Dim Bad As Long, Good As Long, Avail As Long, Percent As Long
    
  If (mModWin = 1) Or (mModWin = 2) Then Exit Sub
  Y = Central.PicCentral.Top - 21
  Call CountSectors(Bad, Good, Avail, Percent)
  Call DigitalText(181, 47 + Y, Str0N(Good, 4), 3)
  Call DigitalText(177, 53 + Y, Str0N(Good * 512, 7), 3)
  Call DigitalText(177, 59 + Y, Str0N(Avail, 7), 3)
  Call DigitalText(177, 65 + Y, Str0N(Bad * 512, 7), 3)
  Call DigitalText(181, 71 + Y, Str0N(Bad, 4), 3)
End Sub