modmisc.bas

一款漂亮的控件。 快

Attribute VB_Name = "modMisc"
Option Explicit

Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function ExtFloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long, ByVal wFillType As Long) As Long

Global cX As Long, cY As Long
Global i As Long, j As Long
Global tmpCol As Long
Global r As Long, g As Long, b As Long
Global larrCol() As Long
Global curTools As Integer
Global tColors As Colors
Global sX As Long, sY As Long
Global upX As Long, upY As Long
Global stat As Boolean, stat1 As Boolean
Global wX As Long, wX1 As Long, wY As Long, wY1 As Long
Global curX As Long, curY As Long
Global propFillStyle As Long
Global tmpCol1 As Long, tmpCol2 As Long, FirstChoose As Boolean

Public Type cPoint
    cX As Double
    cY As Double
End Type

Public Type Colors
    lBCol As Long
    lFCol As Long
End Type




Public Sub PrepareImg()
    ReDim larrCol(2, cX, cY)
    For i = 0 To cX
        For j = 0 To cY
            tmpCol = GetPixel(frmMain.picMain.hdc, i, j)
            r = tmpCol Mod 256
            g = (tmpCol / 256) Mod 256
            b = tmpCol / 256 / 256
            larrCol(0, i, j) = r
            larrCol(1, i, j) = g
            larrCol(2, i, j) = b
        Next j
        frmMain.pg1.Value = i * 100 \ (cX - 1)
    Next i
    frmMain.pg1.Value = 0
End Sub


Public Sub UndoFilters()
    On Error Resume Next
    
    frmMain.picMain.PaintPicture frmMain.picUndo.Picture, 0, 0
End Sub

Public Sub ResizePicBoxes()
    Dim lw As Long, lh As Long
    
    With frmMain
        .picMain.Refresh
        lh = .picMain.Height
        lw = .picMain.Width
     
    End With
    
End Sub
    
Public Function FileExist(sFileN As String) As Boolean
    Dim tmpRv As Long
    
    On Error Resume Next
    tmpRv = GetAttr(sFileN)
    If Err Then
        FileExist = False
    Else
        FileExist = True
    End If
End Function



Public Sub Filling(col As Long, ByVal FStyle As Long, x, y)
    Dim a As Long
    
    frmMain.picMain.FillStyle = FStyle
    frmMain.picMain.FillColor = tColors.lFCol
    a = ExtFloodFill(frmMain.picMain.hdc, x, y, col, 1)
    frmMain.picMain.FillStyle = 1
End Sub