⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 graphicsengine.bas

📁 超级C&C有没有搞错,VB还能编出这种即时策略游戏来!没错,这就是我们的超级C&C!虽然游戏经常无故退出,但是原码仍有很多可圈可点的地方.祝你早日编出中国的超级RA,超级KKND,超级星际,超级家园
💻 BAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
Dim lhdc As Long                ' Handle on surface context
' Load bitmap
hbm = LoadImage(ByVal 0&, strFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
' Get bitmap info
GetObject hbm, Len(bm), bm
' Fill surface description
With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    .dwWidth = bm.bmWidth
    .dwHeight = bm.bmHeight
End With
GraphicsLibs(Index).Width = bm.bmWidth
GraphicsLibs(Index).HalfWidth = Int(bm.bmWidth / 2)
GraphicsLibs(Index).Height = bm.bmHeight
GraphicsLibs(Index).HalfHeight = Int(bm.bmHeight / 2)
' Create surface
dd.CreateSurface ddsd, dds, Nothing
' Create memory device
hdcImage = CreateCompatibleDC(ByVal 0&)
' Select the bitmap in this memory device
SelectObject hdcImage, hbm
' Restore the surface
dds.Restore
' Get the surface's DC
dds.GetDC lhdc
' Copy from the memory device to the DirectDrawSurface
StretchBlt lhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, bm.bmWidth, bm.bmHeight, SRCCOPY
' Release the surface's DC
dds.ReleaseDC lhdc
' Release the memory device and the bitmap
DeleteDC hdcImage
DeleteObject hbm
' Returns the new surface
Set GraphicSurfaces(Index) = dds
End Sub
Private Function CreateDDSFromBitmapDirectly(dd As DirectDraw2, ByVal strFile As String) As DirectDrawSurface2
Dim hbm As Long                 ' Handle on bitmap
Dim bm As BITMAP                ' Bitmap header
Dim ddsd As DDSURFACEDESC       ' Surface description
Dim dds As DirectDrawSurface2   ' Created surface
Dim hdcImage As Long            ' Handle on image
Dim lhdc As Long                ' Handle on surface context
' Load bitmap
hbm = LoadImage(ByVal 0&, strFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
' Get bitmap info
GetObject hbm, Len(bm), bm
' Fill surface description
With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    .dwWidth = bm.bmWidth
    .dwHeight = bm.bmHeight
End With
' Create surface
dd.CreateSurface ddsd, dds, Nothing
' Create memory device
hdcImage = CreateCompatibleDC(ByVal 0&)
' Select the bitmap in this memory device
SelectObject hdcImage, hbm
' Restore the surface
dds.Restore
' Get the surface's DC
dds.GetDC lhdc
' Copy from the memory device to the DirectDrawSurface
StretchBlt lhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, bm.bmWidth, bm.bmHeight, SRCCOPY
' Release the surface's DC
dds.ReleaseDC lhdc
' Release the memory device and the bitmap
DeleteDC hdcImage
DeleteObject hbm
' Returns the new surface
Set CreateDDSFromBitmapDirectly = dds
End Function
Sub LoadGraphic(Index, Filename)
SpriteStuff.GraphicsLibs(Index).Active = True
Call GraphicsEngine.LoadGraphicOntoGraphicLib(Index, dd, Filename)
Call prepSrcColorKey(GraphicSurfaces(Index))
End Sub
Sub DisplayTextCenter(Text, Y, Pallete)
textlength = Len(Text)
X = ResolutionMidX - ((textlength * FONT_SPACINGX) / 2)
Call DisplayText(Text, X, Y, Pallete)
End Sub
Sub DisplayTextCenterRelative(Text, X, Y, Pallete)
textlength = Len(Text)
XDisp = X - ((textlength * FONT_SPACINGX) / 2)
YDisp = Y - ((FONT_SPACINGY) / 2)
Call DisplayText(Text, XDisp, YDisp, Pallete)
End Sub
Sub DisplayText(Text, X, Y, Pallete)
Dim DestBox As RECT, SrcBox As RECT
On Error Resume Next
TextString$ = UCase$(Text)
textlength = Len(TextString$)
For I = 1 To textlength
  CurrentCharacter$ = Mid$(TextString$, I, 1)
  If CurrentCharacter$ <> " " Then
      Select Case CurrentCharacter$
      Case "A"
        TextX = 0
        texty = 0
      Case "B"
        TextX = 1
        texty = 0
      
      Case "C"
        TextX = 2
        texty = 0
      Case "D"
        TextX = 3
        texty = 0
      Case "E"
        TextX = 4
        texty = 0
      Case "F"
        TextX = 5
        texty = 0
      
      Case "G"
        TextX = 6
        texty = 0
      Case "H"
        TextX = 7
        texty = 0
      Case "I"
        TextX = 8
        texty = 0
      Case "J"
        TextX = 9
        texty = 0
      Case "K"
        TextX = 10
        texty = 0
      Case "L"
        TextX = 11
        texty = 0
      Case "M"
        TextX = 12
        texty = 0
      Case "N"
        TextX = 13
        texty = 0
      Case "O"
        TextX = 14
        texty = 0
      Case "P"
        TextX = 15
        texty = 0
      Case "Q"
        TextX = 16
        texty = 0
      Case "R"
        TextX = 17
        texty = 0
      Case "S"
        TextX = 18
        texty = 0
      Case "T"
        TextX = 19
        texty = 0
      Case "U"
        TextX = 20
        texty = 0
      Case "V"
        TextX = 21
        texty = 0
      Case "W"
        TextX = 22
        texty = 0
      Case "X"
        TextX = 23
        texty = 0
      Case "Y"
        TextX = 24
        texty = 0
      Case "Z"
        TextX = 25
        texty = 0
      Case "1"
        TextX = 26
        texty = 0
      Case "2"
        TextX = 27
        texty = 0
      Case "3"
        TextX = 28
        texty = 0
      Case "4"
        TextX = 0
        texty = 1
      Case "5"
        TextX = 1
        texty = 1
      Case "6"
        TextX = 2
        texty = 1
      Case "7"
        TextX = 3
        texty = 1
      
      Case "8"
        TextX = 4
        texty = 1
      Case "9"
        TextX = 5
        texty = 1
      Case "0"
        TextX = 6
        texty = 1
      Case "."
        TextX = 7
        texty = 1
      Case ","
        TextX = 8
        texty = 1
      Case "?"
        TextX = 9
        texty = 1
      Case "!"
        TextX = 10
        texty = 1
      Case "*"
        TextX = 11
        texty = 1
      Case "/"
        TextX = 12
        texty = 1
      Case "\"
        TextX = 13
        texty = 1
      Case "["
        TextX = 14
        texty = 1
      Case "]"
        TextX = 15
        texty = 1
      Case "("
        TextX = 16
        texty = 1
      Case ")"
        TextX = 17
        texty = 1
      Case "$"
        TextX = 18
        texty = 1
      Case "#"
        TextX = 19
        texty = 1
      Case "<"
        TextX = 20
        texty = 1
      Case ">"
        TextX = 21
        texty = 1
      Case "&"
        TextX = 22
        texty = 1
      Case "@"
        TextX = 22
        texty = 1
      
      Case "-"
        TextX = 23
        texty = 1
      Case "+"
        TextX = 24
        texty = 1
      Case "="
        TextX = 25
        texty = 1
      Case "'"
        TextX = 26
        texty = 1
      Case CHARACTER_QOUTE
        TextX = 27
        texty = 1
      Case ":"
        TextX = 28
        texty = 1
      End Select
      If X < 0 Then
        DestBox.Left = ((FONT_LastCharacter - (-(I - 1) + textlength)) * FONT_SPACINGX) - FONT_SPACINGX
        DestBox.Right = DestBox.Left + FONT_SIZE
      Else
        DestBox.Left = ((I - 1) * FONT_SPACINGX) + X
        DestBox.Right = DestBox.Left + FONT_SIZE
      End If
      DestBox.Top = Y
      DestBox.bottom = DestBox.Top + FONT_SIZE
      SrcBox.Top = texty * FONT_SIZE
      SrcBox.bottom = (texty + 1) * FONT_SIZE
      SrcBox.Left = TextX * FONT_SIZE
      SrcBox.Right = (TextX + 1) * FONT_SIZE
      
      If Pallete = PALLETE_WHITE Then
        SrcBox.Top = SrcBox.Top + GraphicsLibs(InGameConstants(InGameConstant_PICINDEX_FontLib)).HalfHeight
        SrcBox.bottom = SrcBox.bottom + GraphicsLibs(InGameConstants(InGameConstant_PICINDEX_FontLib)).HalfHeight
      End If
      
      ' Set the transparent color
      GraphicSurfaces(InGameConstants(InGameConstant_PICINDEX_FontLib)).Restore
      ' Blit the image to the back buffer

      
      
      ddsBack.BltFast DestBox.Left, DestBox.Top, GraphicSurfaces(InGameConstants(InGameConstant_PICINDEX_FontLib)), SrcBox, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
  
  
  
  End If
Next I
End Sub
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -