Mensaje enviado por SJIMENOH28@smail1.ocenf.org (SJIMENOH28)
Estás haciendo mal dos cosas:
1-Lo más importante: No se debe borrar, bajo ningún concepto, un objeto GDI mientras esté seleccionado en un contexto de dispositivo. Primero se libera seleccionando otro y despues se borra.
2- Si utilizas como contexto de dispositivo un control o formulario de VB (picturebox) debes restaurar el objeto por defecto cuando acabes de usar el anterior.
Te pongo dos ejemplos (casi identicos) para utilizar los dos objetos que citas:
'Pluma
Dim hPen&, hOldPen&
hPen = CreatePen(OPAQUE, AnchoBorde, ColorBorde) 'creas el objeto
hOldPen = SelectObject(hdc, hPen) ' lo seleccionas y devuelve el anterior
'Utilizas la función de dibujo deseada
SelectObject(hdc, hOldPen ) 'restauras el anterior
DeleteObject (hPen) 'y borras el utilizado
'Pincel
Dim hBrush&, hOldBrush&
hBrush = CreateSolidBrush(ColorRelleno)
hOldBrush = SelectObject(hdc, hBrush)
'Utilizas la función de dibujo
SelectObject(hdc, hOldBrush )
DeleteObject (hBrush )
Saludos
Santiago Jimeno (Madrid)
SJIMENOH28@smail1.ocenf.org
-----Mensaje original-----
De: tonimp <tonimp@ole.com>
Para: vb-esp@ccc.uba.ar <vb-esp@ccc.uba.ar>
Fecha: miércoles 1 de marzo de 2000 10:06 a.m.
Asunto: vb-esp : Dibujando con Rectangle de API se me vienen abajo los
recursos ¿Por que?
Quiero dibujar numerosos rectángulos de distintos colores, pero se me
vienen abajo los recursos?
¿Qué estoy haciendo mal?
¿Están mal creados o utilizados los pinceles y las plumas?
Private Function Rectangulo(pct1 As PictureBox, X1 As Long, Y1 As Long,
X2 As Long, Y2 As Long, Optional ColorRelleno As Long = -1, Optional
ColorBorde As Long = -1, Optional AnchoBorde As Long = 1) As Long
Dim di As Long
Dim hdc As Long
Dim Brush1 As Long
Dim Pen1 As Long
On Error GoTo Err1
hdc = pct1.hdc
If Not ColorRelleno = -1 Then
Brush1 = CreateSolidBrush(ColorRelleno)
di = SelectObject(hdc, Brush1)
End If
If Not ColorBorde = -1 Then
Pen1 = CreatePen(OPAQUE, AnchoBorde, ColorBorde)
di = SelectObject(hdc, Pen1)
End If
di = Rectangle(hdc, X1, Y1, X2, Y2)
If Pen1 <> 0 Then Call DeleteObject(Pen1)
If Brush1 <> 0 Then Call DeleteObject(Brush1)
Exit Function
Err1:
Rectangulo = Err
End Function
Ayudenme por que me voy a volver loco. Muchas gracias de antemano.