VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cS2Dmd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'Smoki2D Mem Draw
'2004/2005 by SmokingFish
'mail@SmokingFish.de
'__________________________
'Description :
'DirectX / Software Hybrid Engine

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private DX As DirectX8
Private D3D As Direct3D8
Private D3DDevice As Direct3DDevice8
Private D3DX As D3DX8
Private FrontBuffer As Direct3DSurface8
Private BackBuffer As Direct3DSurface8
Private D3DRec As D3DLOCKED_RECT
Private Running As Boolean

Private Const FVF = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR
Private Const SRCCOPY = &HCC0020
Private Const DIB_RGB_COLORS = 0
Private Const BI_RGB = 0&
Private Const LR_LOADFROMFILE = &H10
Private Const IMAGE_BITMAP = 0&

Private Declare Function SMOKI2DMD_Initialize Lib "smoki2dmd.dll" (ByVal Destination As Long, ByVal Width As Integer, ByVal Height As Integer) As Long
Private Declare Function SMOKI2DMD_RenderTexture Lib "smoki2dmd.dll" (ByVal ID As Integer, ByVal x As Integer, ByVal y As Integer, ByVal SourceWidth As Integer, ByVal SourceHeight As Integer, ByVal SourceX As Integer, ByVal SourceY As Integer, ByVal colorkey As Long, ByVal Alpha As Integer, ByVal ColorOverlay As Long) As Long
Private Declare Function SMOKI2DMD_RefreshDestination Lib "smoki2dmd.dll" (ByVal Destination As Long, ByVal Pitch As Integer) As Long
Private Declare Function SMOKI2DMD_SetClippingWindow Lib "smoki2dmd.dll" (ByVal x As Integer, ByVal y As Integer, ByVal Width As Integer, ByVal Height As Integer) As Long
Private Declare Function SMOKI2DMD_Unload Lib "smoki2dmd.dll" () As Long
Private Declare Function SMOKI2DMD_UnloadTexture Lib "smoki2dmd.dll" (ByVal ID As Integer) As Long

Public ScreenWidth As Integer
Public ScreenHeight As Integer

Private FPS As New cS2DFps
Private px_BackBuffer() As Long

Private Scale2x As Boolean

Public Function GetFPS() As Integer
        
    GetFPS = FPS.SmoothFps
    
End Function

Public Function Clear()

    D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, vbBlack, 1#, 0

End Function

Public Function BeginScene()

    FPS.CalcFps
    D3DDevice.BeginScene
    BackBuffer.LockRect D3DRec, ByVal 0, ByVal 0
    
    If Not Scale2x Then SMOKI2DMD_RefreshDestination D3DRec.pBits, D3DRec.Pitch

End Function

Public Function EndScene()

    If Scale2x Then SCALE2X_Scale2x_Ext VarPtr(px_BackBuffer(0)), ByVal D3DRec.pBits, ScreenWidth / 2, ScreenHeight / 2
    
    BackBuffer.UnlockRect
    D3DDevice.EndScene
    
End Function

Public Function Flip()

    D3DDevice.Present ByVal 0, ByVal 0, ByVal 0, ByVal 0

End Function

Public Function Unload()
 
    Set D3DDevice = Nothing
    Set D3D = Nothing
    Set DX = Nothing
    
    SMOKI2DMD_Unload
    
    End
    
End Function

Public Function Initialize(Destination As Long, Width As Integer, Height As Integer, Optional Filter As Boolean = False)

    Scale2x = Filter
    
    Dim DispMode As D3DDISPLAYMODE
    Dim D3DWindow As D3DPRESENT_PARAMETERS
    
    ScreenWidth = Width
    ScreenHeight = Height
    
    Set DX = New DirectX8
    Set D3D = DX.Direct3DCreate()
    Set D3DX = New D3DX8
    
    D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, DispMode
    
    DispMode.Format = D3DFMT_A8R8G8B8
    'DispMode.Format = D3DFMT_R5G6B5
    
    D3DWindow.Windowed = 1
    D3DWindow.SwapEffect = D3DSWAPEFFECT_FLIP
    D3DWindow.BackBufferCount = 1
    D3DWindow.BackBufferFormat = DispMode.Format
    D3DWindow.hDeviceWindow = Destination
    D3DWindow.Flags = D3DPRESENTFLAG_LOCKABLE_BACKBUFFER
    
    Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Destination, D3DCREATE_HARDWARE_VERTEXPROCESSING, D3DWindow)
    
    D3DDevice.SetVertexShader FVF
    D3DDevice.SetRenderState D3DRS_LIGHTING, False
    D3DDevice.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
    D3DDevice.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
    D3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True
    
    Set FrontBuffer = D3DDevice.CreateImageSurface(DispMode.Width, DispMode.Height, D3DFMT_A8R8G8B8)
    D3DDevice.GetFrontBuffer FrontBuffer

    Set BackBuffer = D3DDevice.GetRenderTarget
    
    ReDim px_BackBuffer((Width / 2) * (Height / 2))
    
    If Not Scale2x Then
        BackBuffer.LockRect D3DRec, ByVal 0, ByVal 0
        SMOKI2DMD_Initialize D3DRec.pBits, Width, Height
        BackBuffer.UnlockRect
    End If
    
    If Scale2x Then SMOKI2DMD_Initialize ByVal VarPtr(px_BackBuffer(0)), Width / 2, Height / 2

End Function

Public Function RenderTexture(ID As Integer, x As Integer, y As Integer, Optional sx As Integer = 0, Optional sy As Integer = 0, Optional sw As Integer = -1, Optional sh As Integer = -1, Optional colorkey As Long = vbMagenta, Optional Alpha As Integer = 255, Optional ColorOverlay As Long = vbWhite)
    
    SMOKI2DMD_RenderTexture ID, x, y, sw, sh, sx, sy, colorkey, Alpha, ColorOverlay
    
End Function
