modgraphics.bas

入侵检测是近几年发展起来的新型网络安全策略

    lngResult = SetBkMode(hDcMemory, OPAQUE)
    lngResult = SetBkColor(hDcMemory, lngBackColour)
    Call DrawRect(hDcMemory, lngBackColour, 0, 0, (Area.Right - Area.Left), (Area.Bottom - Area.Top))
End Sub
Public Sub Gradient(ByVal lngDesthDc As Long, ByVal lngStartCol As Long, ByVal FinishCol As Long, ByVal intLeft As Integer, ByVal intTop As Integer, ByVal intWidth As Integer, ByVal intHeight As Integer, ByVal Direction As GradientTo, Optional ByVal udtMeasurement As Scaling = 1, Optional ByVal bytLineWidth As Byte = 1)
    'draws a gradient from colour mblnStart to colour Finish, and assums
    'that all measurments passed to it are in pixels unless otherwise
    'specified.
    Dim intCounter                  As Integer
    Dim intBiggestDiff              As Integer
    Dim Colour                      As RGBVal
    Dim mblnStart                   As RGBVal
    Dim Finish                      As RGBVal
    Dim sngAddRed                   As Single
    Dim sngAddGreen                 As Single
    Dim sngAddBlue                  As Single
    'perform all necessary calculations before drawing gradient
    'such as converting long to rgb values, and getting the correct
    'scaling for the bitmap.
    mblnStart = GetRGB(lngStartCol)
    Finish = GetRGB(FinishCol)
    If udtMeasurement = InTwips Then
        intLeft = intLeft / Screen.TwipsPerPixelX
        intTop = intTop / Screen.TwipsPerPixelY
        intWidth = intWidth / Screen.TwipsPerPixelX
        intHeight = intHeight / Screen.TwipsPerPixelY
    End If
    'draw the colour gradient
    Select Case Direction
        Case GradVertical
            intBiggestDiff = intWidth
        Case GradHorizontal
            intBiggestDiff = intHeight
    End Select
    'calculate how much to increment/decrement each colour per step
    sngAddRed = (bytLineWidth * ((Finish.Red) - mblnStart.Red) / intBiggestDiff)
    sngAddGreen = (bytLineWidth * ((Finish.Green) - mblnStart.Green) / intBiggestDiff)
    sngAddBlue = (bytLineWidth * ((Finish.Blue) - mblnStart.Blue) / intBiggestDiff)
    Colour = mblnStart
    'calculate the colour of each line before drawing it on the bitmap
    For intCounter = 0 To intBiggestDiff Step bytLineWidth
        'find the point between colour mblnStart and Colour Finish that
        'corresponds to the point between 0 and intBiggestDiff
        'check for overflow
        If Colour.Red > 255 Then
            Colour.Red = 255
        Else
            If Colour.Red < 0 Then Colour.Red = 0
        End If
        If Colour.Green > 255 Then
            Colour.Green = 255
        Else
            If Colour.Green < 0 Then Colour.Green = 0
        End If
        If Colour.Blue > 255 Then
            Colour.Blue = 255
        Else
            If Colour.Blue < 0 Then Colour.Blue = 0
        End If
        'draw the gradient in the proper orientation in the calculated colour
        Select Case Direction
            Case GradVertical
                Call DrawLine(lngDesthDc, intCounter + intLeft, intTop, intCounter + intLeft, intHeight + intTop, RGB(Colour.Red, Colour.Green, Colour.Blue), bytLineWidth, InPixels)
            Case GradHorizontal
                Call DrawLine(lngDesthDc, intLeft, intCounter + intTop, intLeft + intWidth, intTop + intCounter, RGB(Colour.Red, Colour.Green, Colour.Blue), bytLineWidth, InPixels)
        End Select
        'set next colour
        Colour.Red = Colour.Red + sngAddRed
        Colour.Green = Colour.Green + sngAddGreen
        Colour.Blue = Colour.Blue + sngAddBlue
    Next intCounter
End Sub
Public Sub MakeText(ByVal hDcSurphase As Long, ByVal strText As String, ByVal intTop As Integer, ByVal intLeft As Integer, ByVal intHeight As Integer, ByVal intWidth As Integer, ByRef udtFont As FontStruc, Optional ByVal udtMeasurement As Scaling = 0)
    'This procedure will draw strText onto the bitmap in the specified udtFont,
    'colour and position.
    Dim udtAPIFont                  As LogFont
    Dim lngAlignment                As Long
    Dim udtTextRect                 As RECT
    Dim lngResult                   As Long
    Dim lngJunk                     As Long
    Dim hDcFont                     As Long
    Dim hDcOldFont                  As Long
    Dim intCounter                  As Integer
    'set Measurement values
    udtTextRect.Top = intTop
    udtTextRect.Left = intLeft
    udtTextRect.Right = intLeft + intWidth
    udtTextRect.Bottom = intTop + intHeight
    If udtMeasurement = InTwips Then Call RectToPixels(udtTextRect) 'convert to pixels
    'Create details about the udtFont using the udtFont structure
    '====================
    'convert point size to pixels
    udtAPIFont.lfHeight = -((udtFont.PointSize * GetDeviceCaps(hDcSurphase, LOGPIXELSY)) / 72)
    udtAPIFont.lfCharSet = DEFAULT_CHARSET
    udtAPIFont.lfClipPrecision = CLIP_DEFAULT_PRECIS
    udtAPIFont.lfEscapement = 0
    'move the name of the udtFont into the array
    For intCounter = 1 To Len(udtFont.Name)
        udtAPIFont.lfFaceName(intCounter) = Asc(Mid(udtFont.Name, intCounter, 1))
    Next intCounter
    'this has to be a Null terminated string
    udtAPIFont.lfFaceName(intCounter) = 0
    udtAPIFont.lfItalic = udtFont.Italic
    udtAPIFont.lfUnderline = udtFont.Underline
    udtAPIFont.lfStrikeOut = udtFont.StrikeThru
    udtAPIFont.lfOrientation = 0
    udtAPIFont.lfOutPrecision = OUT_DEFAULT_PRECIS
    udtAPIFont.lfPitchAndFamily = DEFAULT_PITCH
    udtAPIFont.lfQuality = PROOF_QUALITY
    udtAPIFont.lfWeight = IIf(udtFont.Bold, FW_BOLD, FW_NORMAL)
    udtAPIFont.lfWidth = 0
    hDcFont = CreateFontIndirect(udtAPIFont)
    hDcOldFont = SelectObject(hDcSurphase, hDcFont)
    '====================
    Select Case udtFont.Alignment
        Case vbLeftAlign
            lngAlignment = DT_LEFT
        Case vbCentreAlign
            lngAlignment = DT_CENTER
        Case vbRightAlign
            lngAlignment = DT_RIGHT
    End Select
    'Draw the strText into the off-screen bitmap before copying the
    'new bitmap (with the strText) onto the screen.
    lngResult = SetBkMode(hDcSurphase, TRANSPARENT)
    lngResult = SetTextColor(hDcSurphase, udtFont.Colour)
    lngResult = DrawText(hDcSurphase, strText, Len(strText), udtTextRect, lngAlignment)
    'clean up by deleting the off-screen bitmap and udtFont
    lngJunk = SelectObject(hDcSurphase, hDcOldFont)
    lngJunk = DeleteObject(hDcFont)
End Sub
Public Sub DeleteBitmap(ByRef hDcMemory As Long, ByRef hDcBitmap As Long, ByRef hDcPointer As Long)
    'This will remove the bitmap that stored what was displayed before
    'the text was written to the screen, from memory.
    Dim lngJunk                     As Long
    If hDcMemory = 0 Then Exit Sub 'there is nothing to delete. Exit the sub-routine
    'delete the device context
    lngJunk = SelectObject(hDcMemory, hDcPointer)
    lngJunk = DeleteObject(hDcBitmap)
    lngJunk = DeleteDC(hDcMemory)
    'show that the device context has been deleted by setting
    'all parameters passed to the procedure to zero
    hDcMemory = 0
    hDcBitmap = 0
    hDcPointer = 0
End Sub
Public Sub Pause(lngTicks As Long)
    Dim J_Timer                     As clsWaitableTimer
    'pause execution of the program for a specified number of lngTicks
    Set J_Timer = New clsWaitableTimer
    If lngTicks < 0 Then lngTicks = 0
    J_Timer.Wait lngTicks
    Set J_Timer = Nothing
End Sub
Public Sub RectToPixels(ByRef TheRect As RECT)
    'converts twips to pixels in a rect structure
    TheRect.Left = TheRect.Left \ Screen.TwipsPerPixelX
    TheRect.Right = TheRect.Right \ Screen.TwipsPerPixelX
    TheRect.Top = TheRect.Top \ Screen.TwipsPerPixelY
    TheRect.Bottom = TheRect.Bottom \ Screen.TwipsPerPixelY
End Sub
Public Sub DrawRect(ByVal lngHDC As Long, ByVal lngColour As Long, ByVal intLeft As Integer, ByVal intTop As Integer, ByVal intRight As Integer, ByVal intBottom As Integer, Optional ByVal udtMeasurement As Scaling = InPixels, Optional ByVal lngStyle As Long = BS_SOLID, Optional ByVal lngPattern As Long = HS_SOLID)
    'this draws a rectangle using the co-ordinates
    'and lngColour given.
    Dim StartRect                   As RECT
    Dim lngResult                   As Long
    Dim lngJunk                     As Long
    Dim lnghBrush                   As Long
    Dim BrushStuff                  As LogBrush
    'check if conversion is necessary
    If udtMeasurement = InTwips Then
        'convert to pixels
        intLeft = intLeft / Screen.TwipsPerPixelX
        intTop = intTop / Screen.TwipsPerPixelY
        intRight = intRight / Screen.TwipsPerPixelX
        intBottom = intBottom / Screen.TwipsPerPixelY
    End If
    'initalise values
    StartRect.Top = intTop
    StartRect.Left = intLeft
    StartRect.Bottom = intBottom
    StartRect.Right = intRight
    'create a brush
    BrushStuff.lbColor = lngColour
    BrushStuff.lbHatch = lngPattern
    BrushStuff.lbStyle = lngStyle
    'apply the brush to the device context
    lnghBrush = CreateBrushIndirect(BrushStuff)
    lnghBrush = SelectObject(lngHDC, lnghBrush)
    'draw a rectangle
    lngResult = PatBlt(lngHDC, intLeft, intTop, (intRight - intLeft), (intBottom - intTop), PATCOPY)
    'A "Brush" object was created. It must be removed from memory.
    lngJunk = SelectObject(lngHDC, lnghBrush)
    lngJunk = DeleteObject(lngJunk)
End Sub
Public Function GetRGB(ByVal lngColour As Long) As RGBVal
    'Convert Long to RGB:
    'if the lngcolour value is greater than acceptable then half the value
    If (lngColour > RGB(255, 255, 255)) Or (lngColour < (RGB(255, 255, 255) * -1)) Then Exit Function
    GetRGB.Blue = (lngColour \ 65536)
    GetRGB.Green = ((lngColour - (GetRGB.Blue * 65536)) \ 256)
    GetRGB.Red = (lngColour - (GetRGB.Blue * (65536)) - ((GetRGB.Green) * 256))
End Function
Public Sub DrawLine(lngHDC As Long, ByVal intX1 As Integer, ByVal intY1 As Integer, ByVal intX2 As Integer, ByVal intY2 As Integer, Optional ByVal lngColour As Long = 0, Optional ByVal intWidth As Integer = 1, Optional ByVal udtMeasurement As Scaling = InTwips)
    'This will draw a line from point1 to point2
    Const NumOfPoints = 2
    Dim lngResult                   As Long
    Dim lnghPen                     As Long
    Dim PenStuff                    As LogPen
    Dim Junk                        As Long
    Dim Points(NumOfPoints)         As POINTAPI
    'check if conversion is necessary
    If udtMeasurement = InTwips Then
        'convert twip values to pixels
        intX1 = intX1 / Screen.TwipsPerPixelX
        intX2 = intX2 / Screen.TwipsPerPixelX
        intY1 = intY1 / Screen.TwipsPerPixelY
        intY2 = intY2 / Screen.TwipsPerPixelY
    End If
    'Find out if a specific lngColour is to be set. If so set it.
    PenStuff.lopnColor = lngColour
    PenStuff.lopnStyle = PS_GEOMETRIC
    PenStuff.lopnWidth.X = intWidth
    'apply the pen settings to the device context
    lnghPen = CreatePenIndirect(PenStuff)
    lnghPen = SelectObject(lngHDC, lnghPen)
    'set the points
    Points(1).X = intX1
    Points(1).Y = intY1
    Points(2).X = intX2
    Points(2).Y = intY2
    'draw the line
    lngResult = Polyline(lngHDC, Points(1), NumOfPoints)
    lngResult = GetLastError
    'A "Pen" object was created. It must be removed from memory.
    Junk = SelectObject(lngHDC, lnghPen)
    Junk = DeleteObject(Junk)
End Sub