Autor Tema: Dibujar Varios Cuadrados  (Leído 4342 veces)

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

k_arlytos

  • Megabyte
  • ***
  • Mensajes: 211
  • Reputación: +2/-4
    • Ver Perfil
Dibujar Varios Cuadrados
« en: Agosto 03, 2015, 07:31:06 pm »
Buenas tardes quisiera poder dibujar con api varios duadrados y dentro de esos cuadrados texto
estoy intenando primero dibujar los cuadrados pero no me sale

Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long

Private Sub Form_Load()

    Me.ScaleMode = vbPixels
    Dim i As Integer
    For i = 0 To 2
        drawArea Me.hdc, i
    Next i
   
End Sub

Private Sub drawArea(ByRef DEShdc As Long, ByVal i As Integer)
    Dim hPen        As Long
    Dim hBrush      As Long
    Dim OldBrush    As Long
    Dim OldPen      As Long

   
    hPen = CreatePen(0, 1, &H3C5AD7)
    hBrush = CreateSolidBrush(&H86E5&)
   
    OldBrush = SelectObject(DEShdc, hBrush)
    OldPen = SelectObject(DEShdc, hPen)
   
    RoundRect hdc, 1, 100 * i, 20, 50, 8, 8
   
    Call SelectObject(DEShdc, OldPen)
    Call SelectObject(DEShdc, OldBrush)
   
    DeleteObject hPen
    DeleteObject hBrush
   
End Sub

ESTE CODIGO LO QUE HACE ES DIBUJAR DOS CUADRADOS PERO NO PUEDO SEPARARLOS
QUISIERA QUE ESTE SEPARADO Y ENCIMA DE CADA CUADRADO DIBUJAR UN TEXTO, ESTA ES LA IDEA PRIMORDIAL QUE TENGO

MUCHAS GRACIAS

"Comentar el código es como limpiar el cuarto de baño; nadie quiere hacerlo, pero el resultado es siempre una experiencia más agradable para uno mismo y sus invitados"

Virgil Tracy

  • Kilobyte
  • **
  • Mensajes: 64
  • Reputación: +38/-1
    • Ver Perfil
Re:Dibujar Varios Cuadrados
« Respuesta #1 en: Agosto 07, 2015, 05:18:33 am »
Estas usando posiciones fijas para los puntos del rectangulo, para x2,y2 usa posiciones relativas a x1,y1 mas un ancho y un alto
Para el texto puedes usar TextOut, DrawText
Instala el API-Guide, donde encontraras todas las definiciones de las apis mas ejemplos de como usarlas, en Herramientas y Utilidades para VB6 en este foro la puedes encontrar  :D

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

Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

Private Sub Form_Load()

    Me.ScaleMode = vbPixels
    Me.AutoRedraw = True
   
    Dim i As Integer
    For i = 0 To 2
        drawArea Me.hdc, i
    Next i
   
End Sub

Private Sub drawArea(ByRef DEShdc As Long, ByVal i As Integer)
    Dim hPen        As Long
    Dim hBrush      As Long
    Dim OldBrush    As Long
    Dim OldPen      As Long

   
    hPen = CreatePen(0, 1, &H3C5AD7)
    hBrush = CreateSolidBrush(&H86E5&)
   
    OldBrush = SelectObject(DEShdc, hBrush)
    OldPen = SelectObject(DEShdc, hPen)
   
    Dim x As Long
    Dim y As Long
    Dim cText As String
   
    x = 1
    y = 20 + (100 * i)
   
    'TextOut usa ForeColor como color de texto
    'y Font como fuente de texto
    cText = "UN TEXTO"
    TextOut DEShdc, x, y - 15, cText, Len(cText)
   
    'x1,y1
    '  *---------+
    '  |         |
    '  |         h
    '  |         |
    '  +----w----*
    '          x2,y2
    'x2 = x1 + w
    'y2 = y1 + h
    '
    'x1,y1 y x2,y2 son los puntos de la diagonal del rectangulo
    'x1 + ancho rectangulo es x2
    'y1 + alto rectangulo es y2
    RoundRect hdc, x, y, x + 20, y + 50, 8, 8
   
    Call SelectObject(DEShdc, OldPen)
    Call SelectObject(DEShdc, OldBrush)
   
    DeleteObject hPen
    DeleteObject hBrush
   
End Sub

k_arlytos

  • Megabyte
  • ***
  • Mensajes: 211
  • Reputación: +2/-4
    • Ver Perfil
Re:Dibujar Varios Cuadrados
« Respuesta #2 en: Agosto 07, 2015, 01:01:29 pm »
muchas gracias ya lo estoy estudiando una ultima consulta como se podria hacer para ponerle una fuente?
yo lo hacia de esta manera para cada texto que dibujaba

        .Font = "Century Gothic"
        .FontBold = True
        .FontItalic = False
        .ForeColor = &H0&
        .FontSize = 10
        SetRect TRect, 0, 5, 430, 30
        DrawText .hdc, m_sPrecio, Len(m_sPrecio), TRect, DT_RIGHT

no se si exista otra forma de hacer con apis, muchas gracias
"Comentar el código es como limpiar el cuarto de baño; nadie quiere hacerlo, pero el resultado es siempre una experiencia más agradable para uno mismo y sus invitados"

LeandroA

  • Administrador
  • Petabyte
  • *****
  • Mensajes: 1128
  • Reputación: +151/-8
    • Ver Perfil
Re:Dibujar Varios Cuadrados
« Respuesta #3 en: Agosto 07, 2015, 01:43:52 pm »
hola Karlitos no te doy un ejemplo poque no tengo ni el vb ni el api guide pero bueno usa las apis CreateFont para crear la fuente despues se la asignas al hdc con SelectObject y por ultimo la elminias con DeleteObject
todas esas apis si las googleas te vas encontrar ejemplos en vb6

Saludos.

k_arlytos

  • Megabyte
  • ***
  • Mensajes: 211
  • Reputación: +2/-4
    • Ver Perfil
Re:Dibujar Varios Cuadrados
« Respuesta #4 en: Agosto 08, 2015, 12:18:30 am »
Gracias leandro, recuerdas del proyecto que creaste "Facebook" un control llamado ucItem cuando quiero pasar de foco un item a otro con el teclado de las flechas no se puede, hay alguna forma de poder hacer eso?.
"Comentar el código es como limpiar el cuarto de baño; nadie quiere hacerlo, pero el resultado es siempre una experiencia más agradable para uno mismo y sus invitados"