Autor Tema: BackGroud Color  (Leído 2929 veces)

0 Usuarios y 1 Visitante están viendo este tema.

bebekbdg

  • Bytes
  • *
  • Mensajes: 15
  • Reputación: +0/-0
    • Ver Perfil
BackGroud Color
« en: Agosto 24, 2013, 09:23:23 am »
anyone can you help me
i have this code

Código: [Seleccionar]
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd 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 BitBlt Lib "gdi32.dll" (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 Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode 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 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 m_hDC As Long
 
Private Sub Command1_Click()

    Dim hBitmap As Long
    Dim DC As Long
    Dim BI As BITMAPINFO
   
    DC = GetDC(0)
    m_hDC = CreateCompatibleDC(DC)
   
    With BI.bmiHeader
        .biSize = Len(BI.bmiHeader)
        .biBitCount = 32
        .biWidth = Picture1.ScaleWidth
        .biHeight = Picture1.ScaleHeight
        .biPlanes = 1
        .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
    End With
   
    hBitmap = CreateDIBSection(m_hDC, BI, DIB_RGB_COLORS, ByVal 0, 0, 0)
    OldhBitmap = SelectObject(m_hDC, hBitmap)
    Call BitBlt(Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, m_hDC, 0, 0, vbSrcCopy)
   
End Sub


output on picturebox is black color
how do I want to output on picturebox cant set by color like VbRed

LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1128
  • Reputación: +151/-8
    • Ver Perfil
Re:BackGroud Color
« Respuesta #1 en: Agosto 24, 2013, 05:52:37 pm »
not understand its purpose, but I guess it is this (FillRect API)

Código: (vb) [Seleccionar]
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd 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 BitBlt Lib "gdi32.dll" (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 Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode 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 DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom 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 m_hDC As Long
 
Private Sub Command1_Click()

    Dim hBitmap As Long
    Dim DC As Long
    Dim BI As BITMAPINFO
    Dim tRECT As RECT
    Dim hBrush As Long
   
    DC = GetDC(0)
    m_hDC = CreateCompatibleDC(DC)
   
    With BI.bmiHeader
        .biSize = Len(BI.bmiHeader)
        .biBitCount = 32
        .biWidth = Picture1.ScaleWidth
        .biHeight = Picture1.ScaleHeight
        .biPlanes = 1
        .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
    End With
   
    hBitmap = CreateDIBSection(m_hDC, BI, DIB_RGB_COLORS, ByVal 0, 0, 0)
    OldhBitmap = SelectObject(m_hDC, hBitmap)
    ReleaseDC 0&, DC
   
    tRECT.Right = Picture1.ScaleWidth
    tRECT.Bottom = Picture1.ScaleHeight
    hBrush = CreateSolidBrush(vbRed)
    FillRect m_hDC, tRECT, hBrush
    DeleteObject hBrush
   
    Call BitBlt(Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, m_hDC, 0, 0, vbSrcCopy)
   
    DeleteObject SelectObject(m_hDC, OldhBitmap)
    DeleteDC m_hDC
   
    'or ?
    'tRECT.Right = Picture1.ScaleWidth
    'tRECT.Bottom = Picture1.ScaleHeight
    'hBrush = CreateSolidBrush(vbRed)
    'FillRect Picture1.hdc, tRECT, hBrush
    'DeleteObject hBrush
   
End Sub

bebekbdg

  • Bytes
  • *
  • Mensajes: 15
  • Reputación: +0/-0
    • Ver Perfil
Re:BackGroud Color
« Respuesta #2 en: Agosto 25, 2013, 09:41:40 pm »
Thank you very much