Visual Basic para Aplicaciones - Dibujo en Formulario

Life is soft - evento anual de software empresarial
 
Vista:

Dibujo en Formulario

Publicado por Nelson Muñoz Coll (2 intervenciones) el 27/02/2007 21:34:17
Si tengo una base de datos que se llama "Triángulo", luego un formulario de nombre "Formul1", pregunto: ¿Se puede escribir código en el "Código del Formulario" que me dibuje un triángulo en el "Formul1"?. Si la respuesta es afirmativa, ¿Cómo sería el código para que dibuje un triángulo cuyos vértices son: A(2,3); B(6,3); C(4,6)?. Gracias de antemano.
Nelson: [email protected]
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:Dibujo en Formulario

Publicado por JuanC (243 intervenciones) el 28/02/2007 15:27:56
La cosa no es tan simple... pero se puede!

Option Explicit

Public Const PS_SOLID As Long = 0
Public Type PointAPI
x As Long
y As Long
End Type

Declare Function apiLineTo Lib "gdi32" Alias "LineTo" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function apiCreatePen Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal _
nWidth As Long, ByVal crColor As Long) As Long
Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Declare Function apiMoveTo Lib "gdi32" Alias "MoveToEx" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, lpPoint As PointAPI) As Long

' ---------------------------------------------------

Option Explicit

Sub Dibuja_Triangulo()
Dim hwnd&, hdc&
Dim hPen&, hOldPen&, lpP As PointAPI
Dim x%, y%

hwnd = apiFindWindow(vbNullString, Me.Caption)
hdc = apiGetDC(hwnd)
hPen = apiCreatePen(PS_SOLID, 1, RGB(255, 0, 0))
hOldPen = apiSelectObject(hdc, hPen)

x = 50
y = 50

apiMoveTo hdc, x, y, lpP

apiLineTo hdc, x, y + 50
apiLineTo hdc, x + 50, y + 50
apiLineTo hdc, x, y

apiSelectObject hdc, hOldPen
apiDeleteObject hPen
End Sub

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:Dibujo en Formulario

Publicado por JuanC (243 intervenciones) el 28/02/2007 16:07:42
Otra versión de lo mismo... usando Polyline

Declare Function apiPolyline Lib "gdi32" Alias "Polyline" (ByVal hdc As Long, lpPoint As PointAPI, ByVal nCount As Long) As Long

'----------------------------------------

Sub Dibuja_Triangulo()
Dim hWnd&, hdc&
Dim hPen&, hOldPen&, lpP As PointAPI
Dim a(3) As PointAPI

hWnd = apiFindWindow(vbNullString, Me.Caption)
hdc = apiGetDC(hWnd)
hPen = apiCreatePen(PS_SOLID, 1, RGB(255, 0, 0))
hOldPen = apiSelectObject(hdc, hPen)

With a(0)
.x = 50
.y = 50
End With
With a(1)
.x = 50
.y = 100
End With
With a(2)
.x = 100
.y = 100
End With
With a(3)
.x = 50
.y = 50
End With

apiPolyline hdc, a(0), UBound(a) + 1

apiSelectObject hdc, hOldPen
apiDeleteObject hPen
End Sub

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar