Lucas Roberto Administrador
Mensagens : 711
| Assunto: [ALL] Full Screen com Check Box Dom 12 Dez 2010, 17:07 | |
| Bom Vamos Começar. Abra o Client~Sidee crie um novo Class Modules com o nome de clsWindoweddentro 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 frmLogincrie 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 | |
|
Convidado Convidado
| Assunto: Re: [ALL] Full Screen com Check Box Seg 13 Dez 2010, 12:23 | |
| |
|