Bom Vamos Começar.
Abra o Client~Side
e crie um novo Class Modules com o nome de clsWindowed
dentro dele você adicione isso!
agora vamos no frmLogin
crie uma Check Box dentro dela(pode sem em baixo de salvar mesmo)
se você perceber o nome dela devera estar check2 ou algo parecido
bom continuando no frmLogin mais agora dentro dos Codigos dela!
você proucure por
abaixo disso adicione
agora no modGameLogic proucure por
em cima disso adicione
no frmMirage dentro do COdigos proucure por
mude a sub todo por
agora no modDirectX proucure por
mude a Sub Inteira por
Bom Testaram e Falaro que Funciona.
Creditos: Gu1lh3rm3
Abra o Client~Side
e crie um novo Class Modules com o nome de clsWindowed
dentro dele você adicione isso!
Código:
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
' Used to support captionless drag
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
' Undocumented message constant.
Private Const WM_GETSYSMENU = &H313
' Used to get window style bits.
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
' Style bits.
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SYSMENU = &H80000
Private Const WS_CAPTION = &HC00000
' Extended Style bits.
Private Const WS_EX_TOPMOST = &H8
Private Const WS_EX_TOOLWINDOW = &H80
Private Const WS_EX_CONTEXTHELP = &H400
' Force total pRedraw that shows new styles.
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOSIZE = &H1
' Used to toggle into topmost layer.
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private WithEvents mClient As Form
Private mhWnd As Long
Public Property Get Client() As Form
' Return reference to client form.
Set Client = mClient
End Property
Public Property Set Client(ByVal obj As Form)
' Store reference to client form.
Set mClient = obj
' Cache hWnd as it'll be accessed frequently.
If mClient Is Nothing Then
mhWnd = 0
Else
mhWnd = mClient.hWnd
End If
End Property
Public Function fFlipBit(ByVal Bit As Long, ByVal Value As Boolean) As Boolean
Dim lStyle As Long
' Retrieve current style bits.
lStyle = GetWindowLong(mhWnd, GWL_STYLE)
' Set requested bit On or Off and Redraw.
If Value Then
lStyle = lStyle Or Bit
Else
lStyle = lStyle And Not Bit
End If
Call SetWindowLong(mhWnd, GWL_STYLE, lStyle)
Call pRedraw
' Return success code.
fFlipBit = (lStyle = GetWindowLong(mhWnd, GWL_STYLE))
End Function
Public Property Let Titlebar(ByVal Value As Boolean)
' Set WS_CAPTION On or Off as requested.
Call fFlipBit(WS_CAPTION, Value)
End Property
Public Property Get Titlebar() As Boolean
' Return value of WS_CAPTION bit.
Titlebar = CBool(fStyle And WS_CAPTION)
End Property
Public Sub pRedraw()
' Redraw window with new style.
Const swpFlags As Long = _
SWP_FRAMECHANGED Or SWP_NOMOVE Or _
SWP_NOZORDER Or SWP_NOSIZE
Call SetWindowPos(mhWnd, 0, 0, 0, 0, 0, swpFlags)
End Sub
Private Function fStyle(Optional ByVal NewBits As Long = 0) As Long
'
' Set new style bits.
'
If NewBits Then
Call SetWindowLong(mhWnd, GWL_STYLE, NewBits)
End If
' Retrieve current style bits.
fStyle = GetWindowLong(mhWnd, GWL_STYLE)
End Function
agora vamos no frmLogin
crie uma Check Box dentro dela(pode sem em baixo de salvar mesmo)
se você perceber o nome dela devera estar check2 ou algo parecido
bom continuando no frmLogin mais agora dentro dos Codigos dela!
você proucure por
Código:
If Check1.Value = Checked Then
Call PutVar(App.Path & "\config.ini", "CONFIG", "Password", txtPassword.Text)
Else
Call PutVar(App.Path & "\config.ini", "CONFIG", "Password", "")
End If
Código:
If Check2.Value = Checked Then
Call PutVar(App.Path & "\config.ini", "CONFIG", "FullScreen", 1)
Else
Call PutVar(App.Path & "\config.ini", "CONFIG", "FullScreen", "")
End If
Código:
' Menu states
Código:
' FullScreen ou Normal
Public mclsStyle As clsWindowed
Código:
Private Sub Form_Load()
mude a sub todo por
Código:
Private Sub Form_Load()
Dim I As Long
Dim Ending As String
Set mclsStyle = New clsWindowed
Set mclsStyle.Client = Me
For I = 1 To 3
If I = 1 Then Ending = ".gif"
If I = 2 Then Ending = ".jpg"
If I = 3 Then Ending = ".png"
If FileExist("GUI\game" & Ending) Then frmMirage.Picture = LoadPicture(App.Path & "\GUI\game" & Ending)
Next I
End Sub
Código:
Sub InitDirectX()
Código:
Sub InitDirectX()
' Initialize direct draw
If GetVar(App.Path & "\config.ini", "CONFIG", "FullScreen") = "" Then
Set DD = DX.DirectDrawCreate("")
frmMirage.WindowState = 0
mclsStyle.Titlebar = True
Else
Set DD = DX.DirectDrawCreate("")
DD.SetDisplayMode 800, 600, 16, 0, DDSDM_DEFAULT
mclsStyle.Titlebar = False
End If
frmMirage.Show
' Indicate windows mode application
Call DD.SetCooperativeLevel(frmMirage.hWnd, DDSCL_NORMAL)
' Init type and get the primary surface
DDSD_Primary.lFlags = DDSD_CAPS
DDSD_Primary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
Set DD_PrimarySurf = DD.CreateSurface(DDSD_Primary)
' Create the clipper
Set DD_Clip = DD.CreateClipper(0)
' Associate the picture hwnd with the clipper
DD_Clip.SetHWnd frmMirage.picScreen.hWnd
' Have the blits to the screen clipped to the picture box
DD_PrimarySurf.SetClipper DD_Clip
' Initialize all surfaces
Call InitSurfaces
End Sub
Bom Testaram e Falaro que Funciona.
Creditos: Gu1lh3rm3