Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Mensajes - vbgedo

Páginas: [1]
1
He encontrado este código, pero no trabajo por qué?


Código: [Seleccionar]

Option Explicit

Private Declare Function LoadLibraryEx _
                Lib "kernel32" _
                Alias "LoadLibraryExA" (ByVal lpLibFileName As String, _
                                        ByVal hFile As Long, _
                                        ByVal dwFlags As Long) As Long
                                       
Private Declare Function FreeLibrary _
                Lib "kernel32" (ByVal hLibModule As Long) As Long
                                       
Private m_hMod As Long

Const ID_TEST_NEW = 111
Const ID_TEST_ECLUB = 112
                                       
Private Sub LoadResources()
    Dim IDS() As Long
   
    ReDim IDS(1)
    IDS(0) = ID_TEST_NEW
    IDS(1) = ID_TEST_ECLUB
   
    If (m_hMod <> 0) Then
        FreeLibrary m_hMod
    End If

    m_hMod = 0
   
    m_hMod = LoadLibraryEx(App.Path + "\Project1.exe", 0, 0)
   
    ImageManager.Icons.LoadBitmapFromResource LoadLibraryEx(App.Path + "\Project1.exe", 0, 0), ID_TEST_NEW, IDS(0), xtpImageNormal
    ImageManager.Icons.LoadBitmapFromResource LoadLibraryEx(App.Path + "\Project1.exe", 0, 0), ID_TEST_ECLUB, IDS(1), xtpImageNormal
   
    If (m_hMod <> 0) Then
        FreeLibrary m_hMod
    End If
   
End Sub


Private Sub Form_Load()

    CommandBarsGlobalSettings.App = App
   
    CommandBars.DeleteAll
   
    Dim Toolbar As CommandBar
     
    Set Toolbar = CommandBars.Add("mainapp", xtpBarTop)
    With Toolbar.Controls
        .Add xtpControlButton, ID_TEST_NEW, "&Test"
    End With
       
    LoadResources
   
    Set CommandBars.Icons = ImageManager.Icons
   
    PushButton1.Icon = ImageManager.Icons.GetImage(0, 0)
End Sub




por favor ayuda

2
Hola:
          Para imágenes sin "alpha channel" (transparencias y demases) puedes usar lo siguiente:

Código: (VB) [Seleccionar]
PushButton01.Picture = LoadPicture(App.Path & "\imagen.ico")
Pero si lo que deseas es cargar imágenes con transparencias (PNG, BMP o ICO con "alpha channel", etc.) te recomiendo continúes usando el Objecto ImageManager de los controles XtremeSuite, pues la alternativa seria usar el ucImage o el Módulo para ller PNG de la página Recursos VisualBasic, y para el caso sería lo mismo pero con archivos adicionales en tu proyecto.

Saludos Cordiales

http://leandroascierto.com/blog/ucimage-y-ucimagelist/
http://www.recursosvisualbasic.com.ar/htm/ocx-componentes-activex-dll/102-modulo-para-leer-png.htm


gracias , pero ¿cómo puedo cargar una imagen PNG de archivo de recursos de ImageManager ?

Tengo 400 imágenes PNG y tengo que cargarlo a ImageManager en runtime

3
Hola a todos

i utilizar este código para cargar la imagen de ImageManager

PushButton1.Icon = ImageManager1.Icons.GetImage(1, 1)

i necesidad de cargar el icono de un archivo o recurso gusta esto

app.path & ("\images\icon1.png")

cómo hacer esto ?

4
Visual Basic 6 / Re:cómo hacer transparente PictureBox ?
« en: Junio 30, 2016, 10:16:21 am »
Lavolpe hace tiempo creo un truco para hacer un picturebox transparente

http://www.vbforums.com/showthread.php?601310-VB6-Fake-Transparency-for-PictureBox

Código: (VB) [Seleccionar]
Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function SetViewportOrgEx Lib "gdi32.dll" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Const WM_PAINT As Long = &HF&

Private Sub Command1_Click()
    Dim vPt As POINTAPI
    With Picture1
       ClientToScreen .hWnd, vPt ' convert 0,0 to screen coords
       ScreenToClient .Container.hWnd, vPt ' convert that to container's coords
       SetViewportOrgEx .hDC, -vPt.X, -vPt.Y, vPt ' offset the picbox DC
       SendMessage .Container.hWnd, WM_PAINT, .hDC, ByVal 0& ' tell VB to repaint
       SetViewportOrgEx .hDC, vPt.X, vPt.Y, vPt ' reset picbox DC
       If .AutoRedraw = True then .Refresh
   End With
End Sub

muchas gracias  :)

5
Visual Basic 6 / Re:cómo hacer transparente PictureBox ?
« en: Junio 15, 2016, 09:41:11 am »
hola no se puede hacer eso con un picturebox, a lo sumo se puede hacer un truco que es pintar en el picture el fondo del formulario con un 50% utilizando el api TransparentBlt de todas formas no le encuentro mucha finalidad hacerlo asi, quizas te sea mas util utilizar el ucImage


muchas gracias


Just as a handy tip, there's also a compatible GdiTransparentBlt() API directly in the Gdi32.dll library under any contemporary MS Windows OS starting with Windows 2000 Professional/Server and up.

So, if you have Gdi32.dll already loaded for other purposes in your application, there is no need to map yet another extra graphics library in the process address space.

muchas gracias

6
Visual Basic 6 / cómo hacer transparente PictureBox ?
« en: Junio 15, 2016, 12:58:25 am »
Hola a todos

Quiero hacer transparente PictureBox 50 % como el cambio de opacidad

esperando la ayuda

gracias a todos

7
Visual Basic 6 / Re:Cómo modificar el código?
« en: Julio 21, 2014, 01:05:21 am »
hello, give an explanation of why not in English is complicated for me, you can put controls, but these are not rendered, there are some methods, which is to put another container window on same.

if you are interested in deepening the topic see the following suite of classes cWidget.cls 

http://leandroascierto.com/blog/estado-del-tiempo/


Thank you for help

but I don't understand this example

If there is another solution please help me

Wait for Help

8
Visual Basic 6 / Re:Cómo modificar el código?
« en: Julio 17, 2014, 10:48:55 pm »
Me parece que uso un traductor, y se refiere a poner controles sobre el formulario, y bueno la respuesta mas corta es no  :D

This is exactly that I want but why no ?

9
Visual Basic 6 / Re:Cómo modificar el código?
« en: Julio 17, 2014, 10:47:13 pm »
No entiendo, que significa "quiero poner las herramientas"?

i need to add tools on form

10
Visual Basic 6 / Cómo modificar el código?
« en: Julio 14, 2014, 08:29:10 pm »
Hola Encontré este código a través de este tema

http://leandroascierto.com/foro/index.php?topic=2298.0

Código: [Seleccionar]
Option Explicit
Public Declare Function ReleaseCapture Lib "user32" () As Long
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
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (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
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, ByVal crKey As Long, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal image As Long, Height As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (gToken As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal gToken As Long)
 
Private Type BLENDFUNCTION
    BlendOp As Byte
    BlendFlags As Byte
    SourceConstantAlpha As Byte
    AlphaFormat As Byte
End Type
 
Private Type Size
    cx As Long
    cy As Long
End Type
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As  Long
    biYPelsPerMeter As  Long
    biClrUsed As Long
    biClrImportant As Long
End Type
 
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors() As Long
End Type
 
Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type
 
Private Const ULW_ALPHA         As Long = &H2
Private Const DIB_RGB_COLORS     As  Long = 0
Private Const AC_SRC_ALPHA      As Long = &H1
Private Const AC_SRC_OVER       As Long = &H0
Private Const WS_EX_LAYERED     As Long = &H80000
Private Const GWL_EXSTYLE       As Long = -20
Private Const HWND_TOPMOST      As Long = -1
Private Const SWP_NOMOVE        As Long = &H2
Public Const HTCAPTION         As Long = 2
Public Const WM_NCLBUTTONDOWN  As Long = &HA1
 
Public Function SplashForm(Frm As Form, sImgPath As String) As Boolean
    Dim GpInput     As GdiplusStartupInput
    Dim BI           As BITMAPINFO
    Dim hImage      As Long
    Dim hGraphics   As Long
    Dim SZ           Ace Size
    Dim PT          As POINTAPI
    Dim mDC         As Long
    Dim hBitmap     As Long
    Dim BF          As BLENDFUNCTION
    Dim gToken      As Long
    Dim OldhBitmap   As  Long
 
    GpInput.GdiplusVersion = 1
   
    If GdiplusStartup(gToken, GpInput) = 0 Then
       
        If GdipLoadImageFromFile(StrConv(sImgPath, vbUnicode), hImage) = 0 Then
       
            Call GdipGetImageWidth(hImage, SZ.cx)
            Call GdipGetImageHeight(hImage, SZ.cy)
           
            mDC = CreateCompatibleDC(Frm.hdc)
            With BI.bmiHeader
               .biSize = Len(BI.bmiHeader)
               .biBitCount = 32
               .biWidth = SZ.cx
               .biHeight = SZ.cy
               .biPlanes = 1
               .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
            End With
           
            hBitmap = CreateDIBSection(mDC, BI, DIB_RGB_COLORS, ByVal 0, 0, 0)
            OldhBitmap = SelectObject(mDC, hBitmap)
           
            Call GdipCreateFromHDC(mDC, hGraphics)
            Call GdipDrawImageRect(hGraphics, hImage, 0, 0, SZ.cx, SZ.cy)
            Call GdipDisposeImage(hImage)
            Call GdipDeleteGraphics(hGraphics)
            Call GdiplusShutdown(gToken)
        Else
            Call GdiplusShutdown(gToken)
            MsgBox "Error reading image" , vbCritical
            Exit Function
        End  If
    Else
         MsgBox "Failed to start GDI +" , vbCritical
         Exit Function
    End  If
 
    SetWindowLong Frm.hwnd, GWL_EXSTYLE, GetWindowLong(Frm.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetWindowPos Frm.hwnd, HWND_TOPMOST, 0, 0, SZ.cx, SZ.cy, SWP_NOMOVE
 
    With BF
       .AlphaFormat = AC_SRC_ALPHA
       .BlendOp = AC_SRC_OVER
       .SourceConstantAlpha = 255
    End With
 
    SplashForm = UpdateLayeredWindow(Frm.hwnd, Frm.hdc, ByVal 0&, SZ, mDC, PT, 0, BF, ULW_ALPHA)
 
    DeleteObject SelectObject (MDC OldhBitmap)
    DeleteDC mDC
End Function


Código: [Seleccionar]
Option Explicit
 
Private Sub Form_Load()
    Call SplashForm(Me, "C:\Users\Windows\Desktop\FormTransp\aaa.png")
End Sub
 
Private Sub Form_DblClick()
    Unload Me
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ReleaseCapture
    SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub


Quiero poner las herramientas en forma hay una manera o una solución para eso

A la espera de ayuda

Gracias a todos

Páginas: [1]