modtextextention.bas

一款飞机射击游戏的源代码

Attribute VB_Name = "ModTextExtention"
Option Explicit

Private HandPen As Long
Private OldPen As Long
Private IsPlaying As Boolean
Private IsINSTART As Boolean '用来判断过程是否已经在运行，不允许被外部更改
Public Function ShowLife(ByVal Hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Times As Long, Optional ByVal DColor As Long, Optional ByVal TColor As Long) As Long
On Error Resume Next
Dim N As Long
    If TColor Then SetTextColor Hdc, TColor
      
    If DColor Then
        HandPen = CreatePen(0, Width, DColor)
        OldPen = SelectObject(Hdc, HandPen)
    End If
        
    Call TextOut(Hdc, X, Y - 6 + Height \ 2, "Life", 4)
    If Times > 10 Then Times = 10
    For N = 0 To Times - 1
        MoveToEx Hdc, X + 30 + N * 2 * Width, Y, ByVal 0&
        LineTo Hdc, X + 30 + N * 2 * Width, Y + Height
    Next N
    DeleteObject SelectObject(Hdc, OldPen)
End Function
Public Function ShowHoldFire(ByVal Hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal Height As Long, ByVal Times As Long, Optional ByVal DColor As Long = &HFF00)
On Error Resume Next
Dim N As Long
    If Times = 48 Then DColor = Int(Rnd * &HFFFFFF)
    HandPen = CreatePen(0, 1, DColor)
    OldPen = SelectObject(Hdc, HandPen)
    For N = 0 To Times - 1
        MoveToEx Hdc, X + N, Y, ByVal 0&
        LineTo Hdc, X + N, Y + Height
    Next N
    DeleteObject SelectObject(Hdc, OldPen)
End Function
Public Sub DrawScore(ByVal Hdc As Long, ScoreStr() As String, ByVal X As Long, ByVal Y As Long, ByVal Times As Long, Optional ByVal Colo As Long = &HFF)
On Error Resume Next
Dim N As Long
Dim OldColor As Long
    OldColor = GetTextColor(Hdc)
    SetTextColor Hdc, Colo
    For N = 0 To Times - 1
        TextOut Hdc, X, Y + N * 20, ScoreStr(N + 1), Len(ScoreStr(N + 1))
    Next N
    SetTextColor Hdc, OldColor
    
End Sub
Public Sub ShowBomb(ByVal Hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal Times As Long, Optional ByVal BColor As Long = &HFF)
    SetTextColor Hdc, BColor
    SetTextAlign Hdc, TA_LEFT Or TA_TOP Or TA_NOUPDATECP
    If Times > 8 Then Times = 8
        TextOut Hdc, X, Y, Left("BBBBBBBB", Times), Times
        
End Sub
Public Sub ShowTotalAndMap(ByVal Hdc As Long, ByVal X As Long, ByVal Y As Long, Optional ByVal SColor As Long = &HFF00)
Static TotalOrMap As Integer
Dim S As String
TotalOrMap = TotalOrMap Mod 550 + 1
    SetTextColor Hdc, SColor
    SetTextAlign Hdc, TA_CENTER Or TA_TOP
    Select Case TotalOrMap
        Case Is < 100
            S = "CREDITS:" & CStr(CurContinueAll)
        Case Is < 150
        Case Is < 250
            S = "MAP NAME:" & Trim(Map.HeadMapFile.NameMap)
        Case Is < 300
        Case Is < 400
            S = "MAP EDITOR:" & Trim(Map.HeadMapFile.Editor)
        Case Is < 450
        Case Is < 550
            S = Trim(Map.HeadMapFile.MapDescription)
    End Select
    TextOut Hdc, X, Y, S, Len(S)
End Sub