GS-Zone
Facebook Twitter

CODIGOS!. Ir al Indice

Reglas del Foro
* Por favor, lee las reglas de los foros de Programación antes de hacer un nuevo tema!

Moderadores: Moderadores de Argentum, Especialistas de Argentum, Especialistas de Programación

5

Nota » 08 Oct 2010 15:08

Buenas tardes, necesitaba los siguientes codigos :

1º CODIGO : Al crear el personaje , algunas cabezas aparecen y otras no. Quisiera hacer que el Humano venga con algunas cabezas y lo mismo para las demas cabezas.

2º CODIGO : Al apretar Lanzar Hechizos o Al Atacar te diga Necesitas estar en modo Combate y una ves apretado la C que te deje lanzar hechizos o atacar. Yo busque y encontre Eliminar Modo Combate.Pero no es el que yo quiero.

3º CODIGO : Quisiera un Launcher, Encontre 2 pero no me sirvieron.



Desde ya muchas gracias !.
eL LevanTe
Usuario Registrado
40
Newbie [4]
Registrado: Años de membresíaAños de membresíaAños de membresíaAños de membresía
Mensajes: 99
Arriba

Nota » 08 Oct 2010 16:12

No se que hiciste con el otro tema, pero yo ya te habia respondido para los ultimos dos problemas y andaba.

Fijate.
Franeg95
Aguante River Plate ! ! !
902
Moderador
Registrado: Años de membresíaAños de membresíaAños de membresía
Ubicación: Villa adelina, Vicente Lopez.
Mensajes: 14427
Aportes: 305
Premios: 10
Señor Moderador (3) Señor Reglamento (1) Aportes (2) Embajador (3) Detector de Bugs (1)
Arriba

Nota » 09 Oct 2010 03:00

El tercero.. Es de Midraks mira :
Imagen
Todo en el cliente


1-Creamos un nuevo formulario llamado frmLauncher, y le cambiamos las siguientes propiedades:
•BorderStyle = 0 - None
•AutoRedraw = True

2-Abrimos el codigo del frmLauncher y ponemos esto:
Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
  1. MOSTRAR TODO EL CÓDIGO | NUMERO DE LINEA | OCULTAR/MOSTRAR | SELECCIONAR TODO
  2. Private Sub Form_Load()
  3.     Me.Picture = LoadPicture("X") 'Cambiamos la X por donde se encuentra nuestra imagen.
  4.     Me.width = Me.ScaleX(Me.Picture.width, vbHimetric, vbTwips)
  5.     Me.height = Me.ScaleY(Me.Picture.height, vbHimetric, vbTwips)
  6.    
  7.     MakeFormTransparent Me, vbRed
  8. End Sub



3-Agregamos un nuevo modulo llamado modLauncher y dentro ponemos lo siguiente:
MOSTRAR TODO EL CÓDIGO | NUMERO DE LINEA | OCULTAR/MOSTRAR | SELECCIONAR TODO
Option Explicit

Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
  1. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  2. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
  3. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  4. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  5. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  6. Private Const RGN_OR As Long = 2&
  7.  
  8. Private Declare Sub OleTranslateColor Lib "oleaut32.dll" ( _
  9.      ByVal clr As Long, _
  10.      ByVal hpal As Long, _
  11.      ByRef lpcolorref As Long)
  12.  
  13. Private Type BITMAPINFOHEADER
  14.     biSize As Long
  15.     biWidth As Long
  16.     biHeight As Long
  17.     biPlanes As Integer
  18.     biBitCount As Integer
  19.     biCompression As Long
  20.     biSizeImage As Long
  21.     biXPelsPerMeter As Long
  22.     biYPelsPerMeter As Long
  23.     biClrUsed As Long
  24.     biClrImportant As Long
  25. End Type
  26.  
  27. Private Type RGBQUAD
  28.     rgbBlue As Byte
  29.     rgbGreen As Byte
  30.     rgbRed As Byte
  31.     rgbReserved As Byte
  32. End Type
  33.  
  34. Private Type BITMAPINFO
  35.     bmiHeader As BITMAPINFOHEADER
  36.     bmiColors As RGBQUAD
  37. End Type
  38.  
  39. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  40. Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
  41. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  42. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  43. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
  44. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  45.  
  46. Private Const BI_RGB As Long = 0&
  47. Private Const DIB_RGB_COLORS As Long = 0&
  48.  
  49. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  50. Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  51. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  52. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  53.  
  54. Private Const LWA_COLORKEY As Long = &H1&
  55. Private Const GWL_EXSTYLE As Long = (-20&)
  56. Private Const WS_EX_LAYERED As Long = &H80000
  57.  
  58. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  59. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  60. Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
  61.  
  62. Public Const WM_NCLBUTTONDOWN As Long = &HA1&
  63. Public Const HTCAPTION As Long = 2&
  64.  
  65.  Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  66.  Public Declare Function ReleaseCapture Lib "user32" () As Long
  67.  
  68.  
  69. Public Function MakeFormTransparent(frm As Form, ByVal lngTransColor As Long)
  70.     Dim hRegion As Long
  71.     Dim WinStyle As Long
  72.    
  73.     'Systemfarben ggf. in RGB-Werte übersetzen
  74.     If lngTransColor < 0 Then OleTranslateColor lngTransColor, 0&, lngTransColor
  75.  
  76.     'Ab Windows 2000/98 geht das relativ einfach per API
  77.     'Mit IsFunctionExported wird geprüft, ob die Funktion
  78.     'SetLayeredWindowAttributes unter diesem Betriebsystem unterstützt wird.
  79.     If IsFunctionExported("SetLayeredWindowAttributes", "user32") Then
  80.         'Den Fenster-Stil auf "Layered" setzen
  81.         WinStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
  82.         WinStyle = WinStyle Or WS_EX_LAYERED
  83.         SetWindowLong frm.hWnd, GWL_EXSTYLE, WinStyle
  84.         SetLayeredWindowAttributes frm.hWnd, lngTransColor, 0&, LWA_COLORKEY
  85.        
  86.     Else 'Manuell die Region erstellen und übernehmen
  87.         hRegion = RegionFromBitmap(frm, lngTransColor)
  88.         SetWindowRgn frm.hWnd, hRegion, True
  89.         DeleteObject hRegion
  90.     End If
  91. End Function
  92.  
  93. Private Function RegionFromBitmap(picSource As Object, ByVal lngTransColor As Long) As Long
  94.     Dim lngRetr As Long, lngHeight As Long, lngWidth As Long
  95.     Dim lngRgnFinal As Long, lngRgnTmp As Long
  96.     Dim lngStart As Long
  97.     Dim x As Long, y As Long
  98.     Dim hDC As Long
  99.    
  100.     Dim bi24BitInfo As BITMAPINFO
  101.     Dim iBitmap As Long
  102.     Dim BWidth As Long
  103.     Dim BHeight As Long
  104.     Dim iDC As Long
  105.     Dim PicBits() As Byte
  106.     Dim Col As Long
  107.     Dim OldScaleMode As ScaleModeConstants
  108.    
  109.     OldScaleMode = picSource.ScaleMode
  110.     picSource.ScaleMode = vbPixels
  111.    
  112.     hDC = picSource.hDC
  113.     lngWidth = picSource.ScaleWidth '- 1
  114.     lngHeight = picSource.ScaleHeight - 1
  115.  
  116.     BWidth = (picSource.ScaleWidth \ 4) * 4 + 4
  117.     BHeight = picSource.ScaleHeight
  118.  
  119.     'Bitmap-Header
  120.     With bi24BitInfo.bmiHeader
  121.         .biBitCount = 24
  122.         .biCompression = BI_RGB
  123.         .biPlanes = 1
  124.         .biSize = Len(bi24BitInfo.bmiHeader)
  125.         .biWidth = BWidth
  126.         .biHeight = BHeight + 1
  127.     End With
  128.     'ByteArrays in der erforderlichen Größe anlegen
  129.     ReDim PicBits(0 To bi24BitInfo.bmiHeader.biWidth * 3 - 1, 0 To bi24BitInfo.bmiHeader.biHeight - 1)
  130.    
  131.     iDC = CreateCompatibleDC(hDC)
  132.     'Gerätekontextunabhängige Bitmap (DIB) erzeugen
  133.     iBitmap = CreateDIBSection(iDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
  134.     'iBitmap in den neuen DIB-DC wählen
  135.     Call SelectObject(iDC, iBitmap)
  136.     'hDC des Quell-Fensters in den hDC der DIB kopieren
  137.     Call BitBlt(iDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, hDC, 0, 0, vbSrcCopy)
  138.     'Gerätekontextunabhängige Bitmap in ByteArrays kopieren
  139.     Call GetDIBits(hDC, iBitmap, 0, bi24BitInfo.bmiHeader.biHeight, PicBits(0, 0), bi24BitInfo, DIB_RGB_COLORS)
  140.    
  141.     'Wir brauchen nur den Array, also können wir die Bitmap direkt wieder löschen.
  142.    
  143.     'DIB-DC
  144.     Call DeleteDC(iDC)
  145.     'Bitmap
  146.     Call DeleteObject(iBitmap)
  147.  
  148.     lngRgnFinal = CreateRectRgn(0, 0, 0, 0)
  149.     For y = 0 To lngHeight
  150.         x = 0
  151.         Do While x < lngWidth
  152.             Do While x < lngWidth And _
  153.                 RGB(PicBits(x * 3 + 2, lngHeight - y + 1), _
  154.                     PicBits(x * 3 + 1, lngHeight - y + 1), _
  155.                     PicBits(x * 3, lngHeight - y + 1) _
  156.                     ) = lngTransColor
  157.                
  158.                 x = x + 1
  159.             Loop
  160.             If x <= lngWidth Then
  161.                 lngStart = x
  162.                 Do While x < lngWidth And _
  163.                     RGB(PicBits(x * 3 + 2, lngHeight - y + 1), _
  164.                         PicBits(x * 3 + 1, lngHeight - y + 1), _
  165.                         PicBits(x * 3, lngHeight - y + 1) _
  166.                         ) <> lngTransColor
  167.                     x = x + 1
  168.                 Loop
  169.                 If x + 1 > lngWidth Then x = lngWidth
  170.                 lngRgnTmp = CreateRectRgn(lngStart, y, x, y + 1)
  171.                 lngRetr = CombineRgn(lngRgnFinal, lngRgnFinal, lngRgnTmp, RGN_OR)
  172.                 DeleteObject lngRgnTmp
  173.             End If
  174.         Loop
  175.     Next
  176.  
  177.     picSource.ScaleMode = OldScaleMode
  178.     RegionFromBitmap = lngRgnFinal
  179. End Function
  180.  
  181. 'Code von vbVision:
  182. 'Diese Funktion überprüft, ob die angegebene Function von einer DLL exportiert wird.
  183. Private Function IsFunctionExported(ByVal sFunction As String, ByVal sModule As String) As Boolean
  184.     Dim hMod As Long, lpFunc As Long, bLibLoaded As Boolean
  185.    
  186.     'Handle der DLL erhalten
  187.     hMod = GetModuleHandle(sModule)
  188.     If hMod = 0 Then 'Falls DLL nicht registriert ...
  189.         hMod = LoadLibrary(sModule) 'DLL in den Speicher laden.
  190.         If hMod Then bLibLoaded = True
  191.     End If
  192.    
  193.     If hMod Then
  194.         If GetProcAddress(hMod, sFunction) Then IsFunctionExported = True
  195.     End If
  196.    
  197.     If bLibLoaded Then Call FreeLibrary(hMod)
  198. End Function



4-Ahora lo mas importante, como hacer la imagen para que el formulario quede transparente
•Primero que nada tenemos que tener una imagen que nosotros queramos poner en .gif

•Aca les dejo la imagen que use yo para que se den una idea:

Imagen


Para hacer esto lo que tenemos que hacer es cambiarle una propiedad al FrmLauncher.
Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
  1. BackColor=&H000000FF&


Aca quedaria todo el formulario en color rojo.
Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
  1. MOSTRAR TODO EL CÓDIGO | NUMERO DE LINEA | OCULTAR/MOSTRAR | SELECCIONAR TODO
  2. MakeFormTransparent Me, vbRed


Si queremos poner otro color de fondo simplemente tendremos que cambiarl el vbRed por nuestro color de fondo, por ejemplo, si le ponen de color de fondo negro ponemos vbBlack, si es azul vbBlue, etc..

Bueno, espero que les guste
Cualquier duda consulten!



Saludoos.-

Leooh.-
- IstheriusAO Staff -
163
Aprendiz [6]
Registrado: Años de membresíaAños de membresía
Ubicación: Adolfo gonzales chaves
Mensajes: 431
Aportes: 2
Premios: 1
Embajador (1)
Arriba

Nota » 09 Oct 2010 11:28

Gracias por el Launcher, necesitaria los otros 2 codigos , desde ya muchas gracias.
eL LevanTe
Usuario Registrado
40
Newbie [4]
Registrado: Años de membresíaAños de membresíaAños de membresíaAños de membresía
Mensajes: 99
Arriba

Nota » 10 Oct 2010 05:25

1: fijate el aporte que hicieron a ese tema, y cuando tengas que agregar el módulo cambia esta parte:
Mostrar Todo el Código | Numero de Linea | Ocultar/Mostrar | Seleccionar todo
  1. Select Case frmCrearPersonaje.lstGenero.List(frmCrearPersonaje.lstGenero.ListIndex)
  2.    Case "Hombre"
  3.         Select Case frmCrearPersonaje.lstRaza.List(frmCrearPersonaje.lstRaza.ListIndex)
  4.             Case "Humano"
  5.                 Actual = 1
  6.                 MaxEleccion = 30
  7.                 MinEleccion = 1
  8.             Case "Elfo"
  9.                 Actual = 101
  10.                 MaxEleccion = 113
  11.                 MinEleccion = 101
  12.             Case "Elfo Oscuro"
  13.                 Actual = 202
  14.                 MaxEleccion = 209
  15.                 MinEleccion = 202
  16.             Case "Enano"
  17.                 Actual = 301
  18.                 MaxEleccion = 305
  19.                 MinEleccion = 301
  20.             Case "Gnomo"
  21.                 Actual = 401
  22.                 MaxEleccion = 406
  23.                 MinEleccion = 401
  24.             Case Else
  25.                 Actual = 30
  26.                 MaxEleccion = 30
  27.                 MinEleccion = 30
  28.         End Select
  29.    Case "Mujer"
  30.         Select Case frmCrearPersonaje.lstRaza.List(frmCrearPersonaje.lstRaza.ListIndex)
  31.             Case "Humano"
  32.                 Actual = 70
  33.                 MaxEleccion = 76
  34.                 MinEleccion = 70
  35.             Case "Elfo"
  36.                 Actual = 170
  37.                 MaxEleccion = 176
  38.                 MinEleccion = 170
  39.             Case "Elfo Oscuro"
  40.                 Actual = 270
  41.                 MaxEleccion = 280
  42.                 MinEleccion = 270
  43.             Case "Gnomo"
  44.                 Actual = 470
  45.                 MaxEleccion = 474
  46.                 MinEleccion = 470
  47.             Case "Enano"
  48.                 Actual = 370
  49.                 MaxEleccion = 373
  50.                 MinEleccion = 370
  51.             Case Else
  52.                 Actual = 70
  53.                 MaxEleccion = 70
  54.                 MinEleccion = 70
  55.         End Select
  56. End Select

Cambia los numeros de los MaxEleccion y MinEleccion de acuerdo a como hayas acomodado las cabezas.

2, ¿? eso no es lo que viene con el ao ya? De última agarra un cliente que lo tenga y copialo.
aguz rlz
7
Destructor de Mentes [9]
Registrado: Años de membresíaAños de membresíaAños de membresíaAños de membresía
Mensajes: 946
Aportes: 17
Arriba

Volver a AO 0.11.2 / AOReady

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados