Mensajes

Código [Seleccionar] Expandir

   lB = (lColor And &HFF0000) \ &H10000
   lG = (lColor And &HFF00&) \ &H100
   lR = (lColor And &HFF)

Exelente code, como decia Coco, esta muy bueno para modificar ciertas cosas como por ejemplo los archivos de recursos.

Saludos

Hola, seria bueno que leas un buen tutorial

http://www.recursosvisualbasic.com.ar/htm/tutoriales/tutorial-basico6.htm


Saludos

Hola este es con CreateWindowEx y utiliza WaitMessage  para que el bucle no se coma el procesador

Código [Seleccionar] Expandir

Option Explicit

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long

Dim bEndLopp As Boolean
Dim Counter As Long
Sub main()
    Dim mWnd As Long
    mWnd = CreateWindowEx(0, "STATIC", "", 0, 0, 0, 0, 0, 0, 0, App.hInstance, 0&)
    SetTimer mWnd, 0, 1000, AddressOf TimerProc
    Do While bEndLopp = False
        DoEvents
        WaitMessage
    Loop
    KillTimer mWnd, 0
    DestroyWindow mWnd
End Sub

Public Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)

    Counter = Counter + 1
    Debug.Print Counter
    If Counter = 10 Then
        bEndLopp = True
    End If
   
End Sub



hola te recomiendo que te pegues una buelta por este enlace

es el foro de la dx_lib32

Saludos

Esta bueno, felicitaciones

hola yo no se nada del tema directX pero una textura no significa que pueda ser un bmp en todo caso deberias buscar algo como reateTextureFrombmp que no se si existe

otra cosa sugramente si lo creas tendrias que descargarlo por lo tanto tendrias que hacer algo como

dim hTextura as long

hTextura = D3DX.CreateTextureFromFile(D3DDevice,"C:\a.bmp")
D3DDevice.SetTexture 0, hTextura

y bueno despues tendrias que buscar como descargala


Saludos, seguramente Directx tambien debe tener alguna funcion para leer desde recursos.

Hola estas es una funcion para poder pintar un Hdc con una imagen en forma repetitiva, pero partiendo de otro hdc, creo que no exite un api que directamente haga esto, ya que utilizando CreatePatternBrush lo hace desde un bmp, bueno no se si les pueda servir pero en fin es mucho mas rapido que usar bucles, como veran en el siguiente ejemplo pueden compara la funcion "Pintar" con  "FillRectEx"

Código [Seleccionar] Expandir

Option Explicit
'Function: FillRectEx
'Autor Leandro Ascierto
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Declare Function GetTickCount& Lib "kernel32" ()

Private Sub Pintar()
Dim x As Long
Dim y As Long

Do While y < Me.ScaleHeight
    Do While x < Me.ScaleWidth
        BitBlt Me.hdc, x, y, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, vbSrcCopy
        x = x + Picture1.ScaleWidth
    Loop
    y = y + Picture1.ScaleHeight
    x = 0
Loop

End Sub

Private Sub Form_Load()
Me.Show
DoEvents
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Form_Resize
End Sub

Private Sub Form_Resize()
Dim i As Integer
Dim lTime As Long

'lTime = GetTickCount&
'For i = 0 To 100
    FillRectEx Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
    'call Pintar
'Next

'Debug.Print GetTickCount& - lTime
End Sub


Private Sub FillRectEx(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long, SrcDC As Long, SrcX As Long, SrcY As Long, SrcWidth As Long, SrcHeight As Long)
        Dim DC As Long
        Dim hDCMemory As Long
        Dim hBmp As Long
        Dim mBrush As Long
        Dim Rec As RECT

        DC = GetDC(0)
        hDCMemory = CreateCompatibleDC(0)
        hBmp = CreateCompatibleBitmap(DC, SrcWidth, SrcHeight)
        Call SelectObject(hDCMemory, hBmp)
        BitBlt hDCMemory, 0, 0, SrcWidth, SrcHeight, SrcDC, SrcX, SrcY, vbSrcCopy
        mBrush = CreatePatternBrush(hBmp)
        SetRect Rec, DestX, DestY, DestWidth + DestX, DestHeight + DestY
        FillRect DestDC, Rec, mBrush
       
        DeleteObject mBrush
        DeleteObject hBmp
        DeleteDC DC
        DeleteDC hDCMemory
End Sub


Saludos

hola encontre esta api en la msdn y como no esta en el apiguide ni en el apiviewer la pongo aca esta  buena es parecido al taskkill de windows

Esta es para Dessa que hace rato buscabamos algo asi.

Código [Seleccionar] Expandir


Option Explicit
Private Declare Function EndTask Lib "user32.dll" (ByVal hwnd As Long, ByVal fShutDown As Long, ByVal fForce As Long) As Long

Private Sub Command1_Click()
EndTask Me.hwnd, 0, 0
End Sub


para mas info.
http://msdn.microsoft.com/en-us/library/ms633492.aspx

hola dos que se me ocurren la primera la mas facil (creo) es usando lineas con AlphaBlend  e ir regulando la intensidad y la otra mas profesional dira es crear dos array de bits uno de la imagen y otro del destino y luego ir fucionado los bits en intesidad proporcinal al tamaño de la imagen.

eso si es lo que yo entiendo por efecto espejo, sino pone una imagen de lo que vos decis.

Saludos