Universo Games
Ola , Convidado



Você ainda não e cadastrado então cadastre-se e veja todas as atualizações no mundo rpg!!!
Universo Games

Suporte e Desenvolvimento só no Universo Games

Ola Convidado, Seja Bem vindo a equipe lhe deseja boa sorte no seu projeto!

Você não está conectado. Conecte-se ou registre-se

[ALL] Full Screen com Check Box

Ver o tópico anterior Ver o tópico seguinte Ir em baixo  Mensagem [Página 1 de 1]

1Tutorial [ALL] Full Screen com Check Box em Dom 12 Dez 2010, 15:07

Luucas Robeerto


Fundador
Fundador
Bom Vamos Começar.
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
abaixo disso adicione
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
agora no modGameLogic proucure por
Código:
' Menu states
em cima disso adicione
Código:
' FullScreen ou Normal
Public mclsStyle As clsWindowed
no frmMirage dentro do COdigos proucure por
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
agora no modDirectX proucure por
Código:

Sub InitDirectX()
mude a Sub Inteira por
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 Testaro e Falaro que Funciona.
Código:

Creditos: Gu1lh3rm3


_______________________________________________________________________________________________________

[Você precisa estar registrado e conectado para ver esta imagem.]
Spoiler:
[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver esta imagem.]

[Você precisa estar registrado e conectado para ver esta imagem.]
[Você precisa estar registrado e conectado para ver esta imagem.]
http://universogamesmmo.forumeiros.com

2Tutorial Re: [ALL] Full Screen com Check Box em Seg 13 Dez 2010, 10:23

willame


Membro
Membro
Boa!

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo  Mensagem [Página 1 de 1]

Permissão deste fórum:
Você não pode responder aos tópicos neste fórum