Copiar y Rotar Graficos con GDI+ en VB6

[TOLO68]

Hola a todos, me llamo Tolo
y esta es mi primera pregunta en el foro
Estoy trabajando con graficos gdi+ en vb6 y ya he probado varias cosas pero no lo consigo.

en un picturebox cargo una imagen con:
GdipLoadImageFromFile StrPtr(App.Path & "\gauge_speedometer_chart_2.png"), img
    GdipGetImageWidth img, w
    GdipGetImageHeight img, h

luego la puedo rotar con:

GdipRotateWorldTransform g, Angle, MatrixOrderAppend
GdipTranslateWorldTransform g, X, Y, MatrixOrderAppend

pero la imagen es un archivo....

Mi pregunta es
se puede por ejemplo rotar una imagen de un picturebox que la he dibujado yo previamente con las funciones por ejemplo de:

GdipDrawLine

es decir en el picturebox dibujo una linea o elipse o lo que sea y despues rotar esta linea o todo lo que este dibujado en el picturebox, y si es posible, me gustaria rotar solo lo ke es la linea, o sea que el color de fondo del picturebox como si fuera transparente, porke esta linea seguramente la tengo que rotar en otro picturebox que tiene una imagen de fondo.

Gracias de antemano y espero que me puedan ayudar
ya que por google he visto que en esta web y en la de LaVolpe sabeis bastante sobre GDI+

[LeandroA]

Hola bienvenido al foro, para hacer lo que quieres el picture no serviria ya que no es transparente, para eso tenes que crear un lienzo transparente y dibujar sobre el y luego lo dibujas al picture con rotación, en este momento no recuerdo si se podía hacer directamente con alguna Api de GDI+ (casi seguro que si hay) pero bien, puedes utilizar el api CreateDIBSection() y en el cual puedes dibujar lineas y elipses
 de todas formas te doy un consejo rotar una linea es mucho mas rapido que rortar una imagen por lo que no se hasta que punto te conviene hacer todo esto.
pero bueno quizas si en tu caso es necesario rotar como imagen, si conoces a LaVolpe el hizo una suite de clases si mal no recuerdo era algo de c32bppDIB.cls  donde podes manipular bien lienzos, rotar imagen etc todo con GDI+


un link que te puede orientar https://autohotkey.com/board/topic/37927-help-with-gdi-clearing-image-after-updating/

cualquier duda preguntas, saludos.

[Virgil Tracy]

¿ Y que es lo que quieres hacer ?, en este ejemplo basado de uno de codeproject, cada frame de la rotacion del pie se dibuja completo en un buffer y luego se copia en el usercontrol, lo que da la sensacion de que esta rotando, el control dibuja pie 2d y 3d






http://www.mediafire.com/file/dbjcqyma8in01e0/PieControl.rar

Para trabajar gdiplus en vb6 utilizo una clase wrapper de psc, que te permite usar gdiplus casi con la misma sintaxis de .net

GpGDIPlus Wrapper v1.0---Using GDI+ From VB
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=45451&lngWId=1

[TOLO68]

Hola de nuevo, os explico lo que quiero hacer, tenia de hace tiempo unos controles OCX desarrollados en VB que la web la visito casi todos los paises del mundo, y tuve un promedio de 1500 descargas por control. la mayoria de ellos eran para audio (knob, vumeter, switch, etc...)

Ahora los estoy mejorando con GDI+, mas que nada para lo de poder dibujar con antialias y algunas cosas mas, como la velocidad

He mirado el ejemplo este Virgil Tracy pero demasiado codigo, lo mismo que el control de LaVolpe que no se como se llama, que tambien tiene un monton de cosas que ni voy a usar, aunque bueno si que es, jejejejejejej

un ejemplo seria el vumeter analogico de estos de aguja

primero creo el fondo en un PictureBox_1



seria el vumeter sin la aguja, por ejemplo un picturebox negro, con un Arc en GDI+
verde y rojo(eso ya se como hacerlo), ejejejej

Y aqui viene la pregunta

en el mismo usercontrol hay otro picturebox_2 con el color background blanco,donde dibujo una linea roja(por poner un ejemplo) con el metodo line.......

entonces tengo que pasar esta linea roja al otro picturebox_1 donde esta el fondo del vumeter, pero del picturebox_2 donde cojo la aguja, solo quiero esta linea sin el fondo, o sea que tendria que decirle, el color blanco quiero que sea transparente al copiarla en el picturebox_1 que contiene el fondo, para que al pasarla al solo se vea la linea, pero esta linea la quiero por ej mover o rotar una vez copiada, no se si me he explicado bien, esto lo he podido hacer teniendo la linea en un archivo gif o png, entonces cargo este archivo en el mismo picturebox que el fondo y, la puedo mover y rotar.

ojo.... cuando he creado el fondo hago picturebox.picture=picturebox.image, asi me conserva el fondo, y cuando hago el picturebox.cls al tener que mover la linea redibujandola el fondo no se borra, supongo que esto ya lo sabiais pero es para que entendais un poco mas lo que os digo, esto no creo que sea muy dificil, pero lo necesitare para bastantes controles.

porque otra manera que habia pensado es crear la linea en un picturebox, guardar esta imagen en un archivo con el color blanco como transparente, y luego cargarla en el PictureBox_1, pero no me agrada demasiado.

en resumen........

PictureBox_1 = Dibujo el Fondo
PictureBox_2 = Dibujo la Aguja(linea roja con fondo blanco)
Copio PictureBox_2 (sin el fondo blanco), al PictureBox_1. (Como si hiciera una mascara)
Mover o rotar el PictureBox_2 sobre el PictureBox_1

por cierto se pueden subir archivos zip en el foro?, porque si acaso subiria uno con el codigo fuente minimo si os fuera mejor para verlo

muchas gracias, seguire investigando, jejejejej.

ahhhhhhh, y feliz año nuevo!!!!!!!!

[NEBIRE]

Bien, al parecer tú simplemente quieres rotar una línea y nada más...
Entonces simplemente haces uso de picture.line y todo lo que necesitas es rotar el punto de destino (si el de origen permanece en el radio, ese no hace falta rotarlo). Por tanto, es suficiente con cambiar el punto de destino conforme al ángulo que se requiera.

Eso sí, las líneas de VB, aparecen serradas, por lo que si quieres más calidad, debieras dibujarla en un backbuffer, y con GDI aplicarle un antialias (si conviene) y luego 'blit'arlo al destino... también con GDI.
Esto conlleva, que ya que vas a usar GDI (incluso GDI+) y un backbuffer, tengas una clase para permitir todo el trabajo y no solo la línea... es más trabajo preparatroio, pero la ventaja es que luego te valdrá para sucesivos proyectos.
Si la línea es de solo 1 ó 2 píxels de ancho, no se aprecia el aserramiento...

Código para rotar un punto:
Es importante notar el sentido de avance de los grados en sentido antihorario... y la corrección hecha para hacerlo al revés...
En un form, coloca lo siguientes objetos:
1 picturebox, 1 Scrollbar vertical u horizontal, 1 timer y un checkbox y disponlo tal como se aprecia en la imagen (más o menos)

Código: [Seleccionar]

' nuestras variables
Dim Xo          As Long      '  x origen
Dim Yo          As Long      '  Y origen
Dim Xd          As Long      '  X destino
Dim Yd          As Long      '  Y destion
Dim Dxy         As Long      ' desplazamiento X e Y

' Las cordenadas destino del punto final de la línea corta del circulo pequeño
Dim dx          As Long
Dim dy          As Long

' Giro es el valor actual de partes del todal en que subdividamos el círculo:
'   un valor entre 0 y MaxPartesPorGiro
Dim giro As Integer ' un valor entre 0 y 359, pero podría ser entre 0 y 100 o 0 y 150000... especifica las subdivisiones para completar una vuelta completa
Const MaxPartesPorGiro As Long = 360 ' este valor debe ser el límite del scroll...

Const naranja As Long = &H80FF&   ' es el color para dibujar nuestra 'naranja'.
Const Pitag2 As Double = (2 * 3.14159265358979) ' la constante pitagórica *2 = 6'28 aprox.
 
 
' el chackbox activa y desactiva el timer, que es donde se eejcuta la rutina de calculo y dibujado
Private Sub Check1_Click()
    If Check1.Value = 0 Then
        Check1.Caption = "Rotar"
    Else
        Check1.Caption = "Parar"
    End If
    Timer1.Enabled = Not Timer1.Enabled
End Sub

'  al crear el formulario establecemos los valores iniciales
Private Sub Form_Load()
    Timer1.Enabled = False ' paramos el timer y le damos un valor rápido al intérvalo...
    Timer1.Interval = 1
 
     VScroll1.Max = (MaxPartesPorGiro - 1) '  limitamos nuestro scroll con la misma cantidad de pasos que queremos que dé para una vuelta completa de la 'naranaja'
   VScroll1.LargeChange = 10
   
    '  dividimos el picturebox en 400 partes de ancho y  alto, si el picturebox no es cuadrado del todo, los giros tendrán forma de elipse.... prueba a modificar el tamaño para verificarlo..
    Picture1.Scale (-400, -400)-(400, 400)
    With Picture1
        .DrawWidth = 4     ' un grosor grande para que sea más perceptible a la vista
        .BackColor = vbBlack
        .AutoRedraw = True ' evitaremnos demasiados parpadeos... pero no todos.
    End With
   
    Xo = 80             ' nuestra naranja NO ESTÁ en el centro del mundo. por tanto nuestra rotación es alrededor del mundo, no sobre su propio eje. (con un punto tampoco lo notaríamos, si girara sobre su eje) --- he añadido también una línea y más cosas... para que lo estudies bien...
    Yo = 80
    Dxy = (80 / 2)      ' la mitad del valor previo
   
    dx = 30: dy = 30
   
   Me.Show          ' antes que nada lo dibujamos todo para que se vea donde está colocado inicialmente cada cosa...
   Call Timer1_Timer
End Sub
 
' cuando no actúa el timer, podemos rotar manualmente, paso a paso la línea y la 'naranja'
Private Sub VScroll1_Change()
    giro = VScroll1.Value
    Call Timer1_Timer
End Sub
 

' por fin nuestra rutina de cálculo y dibujado
Private Sub Timer1_Timer()
    Dim tmp As Long
    Dim Radian As Double ' o single, para no despreciar decimales, aunque aquí nuestro 'mundo' (el picturebox) es entero
   
    Picture1.Cls       ' borramos el picturebox (a lo bruto, es un proyecto de ejemplo), sería más correcto borrar solo la línea y el punto que cambian, ...usando adecuadamente Drawmode con valor XOR, y redibujando en el mismo sitio, se consigue.

    ' Rotación en el centro del picture: Aquí se rota a lo largo de una línea recta imaginaria (el punto final de la línea)
    ' Estos objetos se dibujan en el centro del picture, nota, como aquí: Xo y Yo, desaparecen del cálculo de cordenadas del destino, se usan dX y dY y se preservan entre llamadas...
    Radian = ((Pitag2 / 360) * giro)           ' calculamos el ángulo (en radianes)
    tmp = Cos(Radian) * dx + Sin(Radian) * dy  ' calculamos la cordenada x de destino
    Yd = Cos(Radian) * dy - Sin(Radian) * dx   ' calculamos la cordenada y de destino
    dx = tmp ' dx, no puede ser alterada pués debe usarse el valor de entrada tras serle asignado un nuevo valor.
   
    ' dibujamos un círculo, como referencia visual
    Picture1.Circle (0, 0), 80, vbBlue
    ' dibujamos una línea desde el centro hacia una línea recta horizontal imaginaria...
    Picture1.Line (0, 0)-(dx + 10, dy + 10), vbRed
    ' este punto en el centro del picture, cordenadas 0,0 encima de todo, para verlo claro.
    Picture1.PSet (0, 0), vbGreen


    ' Rotación LOCAL respecto de una cordenada dada... (es decir no está en el centro del 'UNIVERSO')
   ' OJO: 'Xo' y 'Yo' se han fijado en 80... al inicio.
    Radian = ((Pitag2 / 360) * (MaxPartesPorGiro - giro))     ' calculamos el ángulo (en radianes)
    Xd = Cos(Radian) * Xo + Sin(Radian) * Yo    ' calculamos la cordenada x de destino
    Yd = Cos(Radian) * Yo - Sin(Radian) * Xo    ' calculamos la cordenada y de destino
 
    ' OJO: tanto el círculo como la línea y el punto están desplazados, ya que VB, condiera los valores de dibujado en 0,0
    '  entonces para centrar nuestros 3 objetos consigo mismos, debemos dibujar todos desplazados 40puntos de escala
    ' (mirar unas líneas más arriba la nota sobre Xo y Yo)
   
    ' dibujamos un círculo, como referencia visual
    Picture1.Circle (Dxy, Dxy), 140, vbBlue
    ' dibujamos una línea desde el centro hacia un punto en el círculo...
    Picture1.Line (Dxy, Dxy)-(Xd + Dxy, Yd + Dxy), vbWhite
    ' dibujamos nuestra naranja, le hemos añadido a 'X' e 'Y' 40, porque es la mitad de 80 , la distancia a la que se encuentra del centro, para que sea una rotación concéntrica, sino sería describiría el círculo desplazado respecto delcentro del mundo... prueba quitando los valores...
    Picture1.PSet (Xd + Dxy, Yd + Dxy), naranja

   
    ' aumentamos el giro para el próximo ciclo. Nota como truncamos el valor para que nunca exceda, y regrese al origen después del final...
    giro = (giro + 1) Mod MaxPartesPorGiro    ' 360 actualmente.  ' Esto sirve solo cuando actúa el timer y realiza el giro de modo automático...
End Sub
Pulsa f5 y desliza el scroll con el ratón, o bien activa el checkbox... para que opere el timer automáticamente...
Nota que el parpadeo se ha reducido notablemente con la propiedad autoredraw a True, del picturebox, es causa de no usar un backbuffer, no existe una sincronización... y ciertamente usando VB6, requiere además una función antialias para suavizar las líneas... pero para lo que necesitas, te vale...

son apenas 7 líneas de código... el equivalente a tu código, sería la línea que va girando como el reloj, sobre el círculo...


Como puedes ver, ahora si dibujamos una línea, con origen en las cordenadas 0,0 y destino en el punto, hacemos lo que quieres, solo te falta delimitar el ángulo...

Código: [Seleccionar]

' Cordenadas de origen de la línea
     Xo = 80           
     Yo = 80
     Dxy = (80 / 2)     
' Cálculo del punto final de la línea conforme al ángulo recibido.
    Radian = ((Pitag2 / 360) * (MaxPartesPorGiro - giro))     ' calculamos el ángulo (en radianes)
    Xd = Cos(Radian) * Xo + Sin(Radian) * Yo    ' calculamos la cordenada x de destino
    Yd = Cos(Radian) * Yo - Sin(Radian) * Xo    ' calculamos la cordenada y de destino

    Picture1.Line (Xo, Yo)-(Xo + Xd , Yo +  Yd), vbWhite
Lo que te queda por tanto es acotar los límites del ángulo en que se mueve la aguja del búmetro, por tanto practica con el ejemplo del código limitando los valores min y max de VScroll...

[LeandroA]

Hola tal como te dice NEBIRE, no es necesario rotar una imagen se puede hacer tranquilamente dibujando la linea sobre el destino, como te dije anteriormente es muchisimo mas rapdio que rotar un gráfico (excepto que quieras que tu flecha sea una imagen)
ya que buscas el antialias, es conveniente GDI+ hasta para hacer el arco, te voy a pasar un ejemplo pero no me funciona bien la parte de la flecha porque no me llevo bien con las matemáticas (sin, cos) quizás NEBIRE o Virgil Tracy puedan ayudar mas en ese tema.

Código: (vb) [Seleccionar]

Option Explicit

Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long
Private Declare Function GdipDeleteBrush Lib "GdiPlus.dll" (ByVal mBrush As Long) As Long
Private Declare Function GdipFillEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mBrush As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GdipCreatePath Lib "GdiPlus.dll" (ByVal mBrushMode As Long, ByRef mPath As Long) As Long
Private Declare Function GdipDeletePath Lib "GdiPlus.dll" (ByVal mPath As Long) As Long
Private Declare Function GdipCreateLineBrushFromRectI Lib "GdiPlus.dll" (ByRef mRect As RECTL, ByVal mColor1 As Long, ByVal mColor2 As Long, ByVal mMode As LinearGradientMode, ByVal mWrapMode As WrapMode, ByRef mLineGradient As Long) As Long
Private Declare Function GdipAddPathEllipseI Lib "GdiPlus.dll" (ByVal mPath As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
Private Declare Function GdipSetPathGradientCenterColor Lib "GdiPlus.dll" (ByVal mBrush As Long, ByVal mColors As Long) As Long
Private Declare Function GdipSetPathGradientSurroundColorsWithCount Lib "GdiPlus.dll" (ByVal mBrush As Long, ByRef mColor As Long, ByRef mCount As Long) As Long
Private Declare Function GdipCreatePathGradientFromPath Lib "GdiPlus.dll" (ByVal mPath As Long, ByRef mPolyGradient As Long) As Long
Private Declare Function GdipSetLinePresetBlend Lib "GdiPlus.dll" (ByVal mBrush As Long, ByRef mBlend As Long, ByRef mPositions As Single, ByVal mCount As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
 
Private Declare Function GdipAddPathArc Lib "GdiPlus.dll" (ByVal mPath As Long, ByVal mX As Single, ByVal mY As Single, ByVal mWidth As Single, ByVal mHeight As Single, ByVal mStartAngle As Single, ByVal mSweepAngle As Single) As Long
Private Declare Function GdipDrawPath Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mPath As Long) As Long
Private Declare Function GdipClearPathMarkers Lib "GdiPlus.dll" (ByVal mPath As Long) As Long
Private Declare Function GdipAddPathLine Lib "GdiPlus.dll" (ByVal mPath As Long, ByVal mX1 As Single, ByVal mY1 As Single, ByVal mX2 As Single, ByVal mY2 As Single) As Long
Private Declare Function GdipCreatePen1 Lib "GdiPlus.dll" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As Long, ByRef mPen As Long) As Long
Private Declare Function GdipDeletePen Lib "GdiPlus.dll" (ByVal mPen As Long) As Long
Private Declare Function GdipResetPath Lib "GdiPlus.dll" (ByVal mPath As Long) As Long
Private Declare Function GdipSetPenStartCap Lib "GdiPlus.dll" (ByVal mPen As Long, ByVal mStartCap As LineCap) As Long

Private Enum LineCap
    LineCapFlat = &H0
    LineCapSquare = &H1
    LineCapRound = &H2
    LineCapTriangle = &H3
    LineCapNoAnchor = &H10
    LineCapSquareAnchor = &H11
    LineCapRoundAnchor = &H12
    LineCapDiamondAnchor = &H13
    LineCapArrowAnchor = &H14
    LineCapCustom = &HFF
    LineCapAnchorMask = &HF0
End Enum
 
Private Type RECTL
    Left    As Long
    Top     As Long
    Width   As Long
    Height  As Long
End Type
 
Private Enum LinearGradientMode
    LinearGradientModeHorizontal = &H0
    LinearGradientModeVertical = &H1
    LinearGradientModeForwardDiagonal = &H2
    LinearGradientModeBackwardDiagonal = &H3
End Enum
 
Private Enum WrapMode
    WrapModeTile = &H0
    WrapModeTileFlipX = &H1
    WrapModeTileFlipy = &H2
    WrapModeTileFlipXY = &H3
    WrapModeClamp = &H4
End Enum
 
Private Type GDIPlusStartupInput
    GdiPlusVersion                      As Long
    DebugEventCallback                  As Long
    SuppressBackgroundThread            As Long
    SuppressExternalCodecs              As Long
End Type
 
Const UnitPixel = &H2
Const PI = 3.14159265359
Private Const SmoothingModeAntiAlias    As Long = &H4
Private GdipToken As Long
 
 
Private Sub Form_Load()
    Call InitGDI
    Me.BackColor = vbBlack
    Me.ScaleMode = vbPixels
    Me.AutoRedraw = True
    Call TEST
End Sub
 
Private Sub TEST()
    Dim hGraphics As Long
    Dim hBrush As Long
    Dim mPath As Long
    Dim mRect As RECTL
    Dim col(2) As Long
    Dim pos(2) As Single
    Dim Angle As Single
    Dim hPen As Long
    Dim X As Single
    Dim Y As Single
    Dim Radius As Double
    Dim AngleInRadians As Double

    If GdipCreateFromHDC(hdc, hGraphics) = 0 Then
 
        'aplica el modo antialias
        Call GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)

        Call GdipCreatePath(&H0, mPath)
       
        'Arco Verde
        Angle = 90
        GdipAddPathArc mPath, 50, 50, Me.ScaleWidth - 100, Me.ScaleHeight, -160, Angle + 1
        GdipCreatePen1 ConvertColor(vbGreen, 100), 10, UnitPixel, hPen
        GdipDrawPath hGraphics, hPen, mPath
        GdipDeletePen hPen
        GdipResetPath mPath
       
        'Arco Rojo
        Angle = 45
        GdipAddPathArc mPath, 50, 50, Me.ScaleWidth - 100, Me.ScaleHeight, -160 + 90, Angle + 1
        GdipCreatePen1 ConvertColor(vbRed, 100), 10, UnitPixel, hPen
        GdipDrawPath hGraphics, hPen, mPath
        GdipDeletePen hPen
        GdipResetPath mPath

        'Linea
        '-----------------------------------Esto esta mal------------
        Angle = -160 '+ 90
        Radius = -(Me.ScaleWidth - 100) / 2
        AngleInRadians = Angle * PI / 180
        X = Radius * Cos(AngleInRadians)
        Radius = -Me.ScaleHeight
        Y = Radius * Sin(AngleInRadians)

        '--------------------------------------------------------------
       
        GdipAddPathLine mPath, X, Y, Me.ScaleWidth / 2, 200
       
        GdipCreatePen1 ConvertColor(vbWhite, 100), 4, UnitPixel, hPen
        GdipSetPenStartCap hPen, LineCapArrowAnchor
        GdipDrawPath hGraphics, hPen, mPath
        GdipDeletePen hPen

        Call GdipDeletePath(mPath)
 
        Call GdipDeleteGraphics(hGraphics)
    End If

End Sub
 
Private Sub Form_Resize()
    Cls
    Call TEST
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call TerminateGDI
End Sub
 
 
' funcion para convertir un color long a un BGRA(Blue, Green, Red, Alpha)
Private Function ConvertColor(Color As Long, Opacity As Long) As Long
    Dim BGRA(0 To 3) As Byte
 
    BGRA(3) = CByte((Abs(Opacity) / 100) * 255)
    BGRA(0) = ((Color \ &H10000) And &HFF)
    BGRA(1) = ((Color \ &H100) And &HFF)
    BGRA(2) = (Color And &HFF)
    CopyMemory ConvertColor, BGRA(0), 4&
End Function

 
'Inicia GDI+
Private Sub InitGDI()
    Dim GdipStartupInput As GDIPlusStartupInput
    GdipStartupInput.GdiPlusVersion = 1&
    Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
 
'Termina GDI+
Private Sub TerminateGDI()
    Call GdiplusShutdown(GdipToken)
End Sub
hay muchas apis declaradas de mas, no las quite por si luego te sirven.

[NEBIRE]

Leandro, una flechita es un triángulo, y un triángulo son tres puntos, luego basta con reposicionar localmente cada uno de los 3 puntos, conforme a su posición inicial y luego con un floodFill, pintar el interior... Más simple incluso, una vez rotado los puntos, usarlos para crear un polígono relleno, con GDI+...
Otra solución es dibujar un 'pie', esto es un cuadrante de un circulo, con la puta como vértice final de la flecha...

Tolo68, la flechita puedes verla como 3 líneas, cuyos vertices van de uno al otro, es decir

Código: [Seleccionar]

objeto.line (x,y)-(dx,dy), color
objeto.line - (dx1,dy1), color
objeto.line - (x,y), colorYa que sin usar el otro par de cordenadas (sena las de origen o las de destino), refiere a los valores CurrentX y CurrentY actuales, que son las cordenadas gráficas donde se ha pintado por última vez (con métodos gráficos, pset, circle,  print... por tanto conociendo los valores de los puntos x,y ... dx,dy ... dx1, dy1 con esto, lo pintas con 3 líneas...

Código: [Seleccionar]

public type Point2D
    X as long
    Y as long
end type

' Rota un punto (Pt) los grados (G) reclamados en un plano 2D, y devuelve la posición del punto.
'   G: grados de giro (ver notas debajo del código)
'   Pt: El punto con sus cordenadas. OJO:
public function RotarPunto2D(byval G as single, byref Pt as Point2D) as Point2D
     Const Pi2 as double=  (2 * 3.14159265358979) `la costante es mejor definirla a nivel del módulo.
     Dim Radian as double

     Radian = Pi2 / (360 * G)
     RotarPunto2D.X = Cos(Radian ) * Pt.X + Sin(Radian ) * Pt.Y
     RotarPunto2D.Y = Cos(Radian ) * Pt.Y - Sin(Radian ) * Pt.X
end function



OJO: Si el ángulo recibido, es absoluto (0-359 grados) o relativos (incrementales al valor actual. Esto determina que valores deben pasarse como punto. Es preferible siempre que sea absoluto, por dos razones, 1º el valor del punto a pasar siempre será el mismo lo que simplifica el asunto y 2º evitamos que se pierda precisión, por culpa de los redondedos decimales, ya que se van incrementando errores...
   Si el "Angulo es Absoluto", entonces las cordenadas son las iniciales siempre, esto es, el valor que tenían esos puntos cuando tenía un ángulo de 0º... por ejemplo: si se recibe un ángulo de 15º y antes estaba en un ángulo de 124º, ahora estará en 15º (valor absoluto)
    Si el "Angulo es Relativo", entonces las cordenadas a enviar son las cordenadas actuales del punto, en este caso, el ángulo implica aumentar o disminuir el que tiene actualemnte, por ejemplo: si antes estaba a 124º y se recibe 15º, ahora tendrá 139º (valor incremental).
El giro debe ser considerado SIEMPRE respecto del centro del eje de cordenadas, es decir cordenadas 0,0. Como en VB las cordenadas 0,0 son la esquina superior izquierda de las ventanas, por tanto a la hora de dibujar, siempre hay que aplicar (sumar) el desplazamiento (Left y Top) del objeto a los valores obtenidos (del punto en cuestión). Si no quieres complicarte con esto último, lo mejos es escalar el contenedor con objeto.Scale(-x,-y)-(x,y) si los valores de x son mayores que los de Y, tienes una elipse, parecida al búmetro de tu imagen.

Dibujar un pie (cuadrante) con Circle, en VB

Código: [Seleccionar]

' Nota, las cordenadas negativas, es para dibujarla sobre el picture del código de arriba, donde el picture esta escalado a (-400,-400)-(400,400), si no es usa escala, hay que darle valores positivos, si no quedara fuera de la zona del picture...
Picture1.Circle (-300, -200), 180, , -0.00002, - pi/2  ' 1.57



[TOLO68]

Hola de nuevo, gracias por responder
creo que me enrolle demasiado la ultima vez, os pego el codigo de lo que estoy usando y al final os digo realmente lo que quiero.

Lo de rotar la linea con Sin y Cos, y otros ejemplos, todo eso ya lo habia hecho en el Vumeter Antiguo

Aqui va el codigo

////////////////////////////////////////////////////////////

Private Sub Form_Load()

   

          "linea.gif" es la linea de la que os hablaba, que es un dibujo creado con   paintshop o cualquier otro programa
           
    Form1.Cls
    InitGDIPlus
   
    GdipCreateFromHDC Picture1.hDC, graphics
    GdipSetSmoothingMode graphics, SmoothingModeAntiAlias
   
    GdipLoadImageFromFile StrPtr("Linea.gif"), img
          '----- aqui cargo linea.gif en img
   
    GdipGetImageWidth img, w
    GdipGetImageHeight img, h
   
    Rotate HScroll1.Value, graphics, 142, 143
   
End Sub
------------------------------------------------------------
Private Sub HScroll1_Scroll()
    Picture1.Cls
    InitGDIPlus
   
    GdipCreateFromHDC Picture1.hDC, graphics
    GdipSetSmoothingMode graphics, SmoothingModeAntiAlias
   
    GdipLoadImageFromFile StrPtr("Linea.gif"), img
           '----- aqui cargo linea.gif en img
   
    GdipGetImageWidth img, w
    GdipGetImageHeight img, h
   
    Rotate HScroll1.Value, graphics, 142, 142

End Sub
------------------------------------------------------------
Sub Rotate(Angle As Single, g As Long, x As Single, y As Integer)
    GdipRotateWorldTransform g, Angle, MatrixOrderAppend
    GdipTranslateWorldTransform g, x, y, MatrixOrderAppend
    GdipDrawImageRect g, img, -w + HScroll2.Value, -h \ 2, w, h
End Sub
------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
    TerminateGDIPlus
End Sub
------------------------------------------------------------
Private Sub InitGDIPlus()
    Dim uInput As GdiplusStartupInput
   
    uInput.GdiplusVersion = 1
    If GdiplusStartup(token, uInput) <> Ok Then
        MsgBox "GDI+ ?", vbCritical, "InitError"
        End
    End If
End Sub
------------------------------------------------------------
Private Sub TerminateGDIPlus()
    GdipDisposeImage img
    GdipDeleteGraphics graphics
   
    GdiplusShutdown token
End Sub

////////////////////////////////////////////////////////////

si probais este codigo y os da algun error no os preocupeis porque estoy en pruebas y le he hecho modificaciones

aqui viene la cuestion

si os fijais en la linea siguiente:

GdipLoadImageFromFile StrPtr("Linea.gif"), img
           '----- aqui cargo linea.gif en img

Esta me carga la imagen desde un fichero.

y lo que yo quiero es que la imagen la coja desde otro picturebox que tengo puesto (por ejemplo "PictureBox2" donde yo le dibujo lo que quiero, lineas, circulos o flechas con metodos como picture2.pset(0,0)-(24,65),vbred o picture2.circle(.....)

o sea que quedaria algo asi, pero no se que llamada a gdiplus necesito
por ej

GdipLoadImageFromHdc StrPtr(PictureBox2.hdc), img

la llamada "GdipLoadImageFromHdc" me la he inventado, es para que veais mas o menos lo que quiero

como hacer un BitBlt desde picture2.hdc a picture1.hdc

entonces con esto rotaria lo que tengo dibujado en el PictureBox2 y no la linea.gif

imaginaros que tengo en un picturebox el chasis de un auto visto de lado, y en otro picturebox las ruedas, entonces copio las ruedas al picturebox del auto, y las ruedas las giro con rotate

Otra vez ya me enrolle sin querer jejejejejeje

espero haberme explicado bien

Si puedo os paso un link de un ejemplo parecido pero en GDI normal, no en GDI+

Gracias de antemano

Saludos a todos los del Foro

[TOLO68]

Hola a Todos, Leandro acabo de usar el ejemplo que me has puesto y lo voy a probar, pero te juro que solo abrirlo me mondaba de la risa, porque has hecho el vumeter que parecia un "clon" de la foto que habia enviado, jaajaja, menudo currazo te has pegado!!!!!!!

Gracias

[LeandroA]

Hola Tolo68, no se si ya lo resolviste pero bueno tuve un poco de tiempo y pude hacer lo de la flecha, ademas lo que te pase estaba utilizando Paths y no era necesario ya que se puede trabajar directamente sobre el gráfico.
aca te arme un ejemplo con la flecha funcionando, agrega un hscroll1 en el ejemplo se maneja por % de 1 a 100, después vos lo adaptas a tus necesidades.  y lo pasas al usercontrol.

Código: (vb) [Seleccionar]

Option Explicit

Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
Private Declare Function GdipCreatePen1 Lib "GdiPlus.dll" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As Long, ByRef mPen As Long) As Long
Private Declare Function GdipDeletePen Lib "GdiPlus.dll" (ByVal mPen As Long) As Long
Private Declare Function GdipSetPenStartCap Lib "GdiPlus.dll" (ByVal mPen As Long, ByVal mStartCap As Long) As Long
Private Declare Function GdipDrawArc Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mX As Single, ByVal mY As Single, ByVal mWidth As Single, ByVal mHeight As Single, ByVal mStartAngle As Single, ByVal mSweepAngle As Single) As Long
Private Declare Function GdipDrawLine Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mX1 As Single, ByVal mY1 As Single, ByVal mX2 As Single, ByVal mY2 As Single) As Long

Private Type GDIPlusStartupInput
    GdiPlusVersion                      As Long
    DebugEventCallback                  As Long
    SuppressBackgroundThread            As Long
    SuppressExternalCodecs              As Long
End Type
 
Private Const LineCapDiamondAnchor = &H13
Private Const UnitPixel = &H2
Private Const PI = 3.14159265359
Private Const SmoothingModeAntiAlias    As Long = &H4
Private GdipToken As Long
 
 
Private Sub Form_Load()
    Call InitGDI
    Me.BackColor = vbBlack
    Me.ScaleMode = vbPixels
    Me.AutoRedraw = True
    HScroll1.Max = 100
    Me.Height = Me.Width / 2
    Call TEST
End Sub
 
Private Sub TEST()
    Dim hGraphics As Long
    Dim Angle As Single
    Dim hPen As Long
    Dim X As Single
    Dim Y As Single
    Dim Radian As Single
    Dim Percent As Integer
    Dim Radio As Single

    If GdipCreateFromHDC(hdc, hGraphics) = 0 Then
 
        'aplica el modo antialias
        Call GdipSetSmoothingMode(hGraphics, SmoothingModeAntiAlias)

        'Arco Verde
        Angle = 90 '+ 45
        GdipCreatePen1 ConvertColor(vbGreen, 100), 10, UnitPixel, hPen
        GdipDrawArc hGraphics, hPen, 50, 50, Me.ScaleWidth - 100, Me.ScaleWidth - 100, -160, Angle + 1
        GdipDeletePen hPen

       
        'Arco Rojo
        Angle = 45
        GdipCreatePen1 ConvertColor(vbRed, 100), 10, UnitPixel, hPen
        GdipDrawArc hGraphics, hPen, 50, 50, Me.ScaleWidth - 100, Me.ScaleWidth - 100, -160 + 90, Angle + 1
        GdipDeletePen hPen
 

        'Linea
       
        Percent = HScroll1.Value
       
        Angle = 200 + (Percent * 136 / 100)
        Radio = (Me.ScaleWidth - 100) / 2
        Radian = ((PI * 2) / 360) * Angle
        X = Cos(Radian) * Radio
        Y = Sin(Radian) * Radio
        GdipCreatePen1 ConvertColor(vbWhite, 100), 4, UnitPixel, hPen
        GdipSetPenStartCap hPen, LineCapDiamondAnchor
        GdipDrawLine hGraphics, hPen, Me.ScaleWidth / 2 + X, Me.ScaleWidth / 2 + Y, Me.ScaleWidth / 2, Me.ScaleWidth / 2
        GdipDeletePen hPen

 
        Call GdipDeleteGraphics(hGraphics)
    End If

End Sub
 
Private Sub Form_Resize()
    Cls
    Call TEST
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call TerminateGDI
End Sub
 
 
' funcion para convertir un color long a un BGRA(Blue, Green, Red, Alpha)
Private Function ConvertColor(Color As Long, Opacity As Long) As Long
    Dim BGRA(0 To 3) As Byte
 
    BGRA(3) = CByte((Abs(Opacity) / 100) * 255)
    BGRA(0) = ((Color \ &H10000) And &HFF)
    BGRA(1) = ((Color \ &H100) And &HFF)
    BGRA(2) = (Color And &HFF)
    CopyMemory ConvertColor, BGRA(0), 4&
End Function

 
'Inicia GDI+
Private Sub InitGDI()
    Dim GdipStartupInput As GDIPlusStartupInput
    GdipStartupInput.GdiPlusVersion = 1&
    Call GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Sub
 
'Termina GDI+
Private Sub TerminateGDI()
    Call GdiplusShutdown(GdipToken)
End Sub

Private Sub HScroll1_Change()
    Cls
    TEST
End Sub

Private Sub HScroll1_Scroll()
    Cls
    TEST
End Sub
un tips puede que utilizando GDI+ con usercontrols te de algunos problemas en el ide, pero eso tiene solución cualquier cosa pregunta.  Saludos.

[NEBIRE]

Yo también estuve anoche corrigiendo la línea sobre el código de Leandro y básicamente es poco diferente...

Solo reseñar que yo opté por no borrar con Cls, si no sobrescribir la línea con negro (el color del fondo) y añadí un reborde gris a todo el arco...

El cambio del código respecto de este último código que ha puesto Leandro:
- Comentar todos los Cls, excepto el del Form_resize
- Para rescribir la línea es necesario mantener las cordenadas previas X,Y del extremo de la aguja, luego es necesario sacar los Dim X as single y Dim Y as single, de la sub Test, al módulo...
- El siguiente código va justo antes de dibujar el arco verde:

Código: [Seleccionar]

            ' Borrar la anterior Aguja                            un poco más gruesa la aguja que borra
            GdipCreatePen1 ConvertColor(vbBlack, 100), 6, UnitPixel, hPen
            GdipSetPenStartCap hPen, LineCapDiamondAnchor
            GdipDrawLine hGraphics, hPen, ((Me.ScaleWidth / 2) + X), ((Me.ScaleWidth / 2) + Y), (Me.ScaleWidth / 2), (Me.ScaleWidth / 2)
            GdipDeletePen hPen

            ' Arco Gris
            Angle = 137 ' Esto es: la suma de los siguientes + un margen por cada extremo
            GdipCreatePen1 ConvertColor(&H808080, 100), 14, UnitPixel, hPen
            GdipDrawArc hGraphics, hPen, 50, 50, Me.ScaleWidth - 100, Me.ScaleWidth - 100, -160 - 1, Angle + 1
            GdipDeletePen hPen

Y Después de la línea:
Call GdipDeleteGraphics(hGraphics)
Requiere un:

Código: [Seleccionar]

Call GdipDeleteGraphics(hGraphics)
Me.Refresh ' de lo contrario no se redibuja...

El efecto de sobrescribir la aguja en la posición previa antes de cambiar a la nueva, tiene un efecto, brillante, debido al antialias cuando va dibuando el blanco sobre fondo negro, que a gran tamaño desmerece, pero a pequeño tamaño resulta más o menos agrabable...  Para borrar bien del todo, basta definir un poco más gruesa la brocha (pen), que hace las veces de aguja, por eso se ha puesto a un ancho de 6, puede cambiarse a 4, para ver el efecto descrito...

[TOLO68]

Hola a todos, gracias Leandro y Nebire por haber dedicado vuestro valioso tiempo a ayudarme en estos 2 ultimos codigos, pero siento deciros que todo esto ya lo tenia hecho, jejejej, tanto lo de dibujar el arco rojo y negro(que alli si que era un bitmap), como la linea movil con el sin y cos, de hecho en el control antiguo ya usaba este sistema.

Si buscais en google "rotate plgblt vb6" hasta que veais una foto como esta, podeis descargar el codigo



es de una pagina llamada VBForums.com

Y asi podreis ver lo que quiero, no pongo el link porque no se que pasa que desde casa no puedo entrar en VBForums, pero si en el resto de webs, cosas de la informatica.

os explico un poco antes lo que es

El fondo es un bitmap estatico, la rejilla la dibuja el propio VB, pero en el cuadro negro de arriba a la izquiera yo voy dibujando con el mouse todo ese garabato de lineas que hay, este no rota, pero el contenido de este lo copia al de la derecha con el fondo transparente(haciendo una mascara), y por ultimo copia el de la derecha abajo y alli lo va rotando con un timer que va poniendo los grados.

yo voy dibujando con el mouse en el picturebox negro, que aqui es donde dibujaria
la flecha circulo o mando giratorio tipo knob, a base de codigo(lo del mouse es porque el ejemplo es asi.

realmente quiero hacerlo asi, porque la aguja me la va a dibujar el mismo control, asi la dibuja con el color y forma que yo quiero con metodos line, circle etc, pero.... solo la creo al iniciar el control o redimensionarlo, en un picturebox_1 por ej, y una vez creada la copio del picturebox_1 al picturebox_2 y en el 2 es donde la roto, me explico.

asi podria crear agujas, knobs, o lo que sea
Que esto es lo que no tengo en los primeros codigos que puse, porque la aguja me la carga de un archivo del disco "C:\.....Archivo.gif" que es un dibujo asi



en resumen, lo que no quiero es dibujar una linea y moverla con coordenadas,
si no crear esta linea en un picturebox, para luego copiarla y rotarla en otro

seria algo como crear un dibujo en una ventana de photoshop, y una vez creado copiarlo a otra ventana y rotarlo, o rotarlo en la primera y copiarlo a la otra ya rotado.

o sea lo que necesito saber es como copiar el contenido el picturebox_1 que he creado yo al picturebox_2, pero con GdiPlus, para que la rotacion tenga antialias.

Bueno ojala entendais mas o menos lo que quiero, aparte lo mejor de este foro es que esta en español, porque yo de ingles poco, jejejejeje

Muchas gracias

[NEBIRE]

Ahora si te entendí... Cuando hablabas de GDI+ solo lo quieres usar para asegurarte cierta calidad.
Y si, PlgBlt, es la api ParalelogramoBlt, que puede rotar en 3D una imagen cargada. es la Api, que suele usarse cuando ves esos efectos de 'pasar página' en las imágenes...

Ya veré esta noche de montarte algo sencillo con transparencia (dibujando en el fondo de un picturebox, por ejemplo, aunque insisto que usando un backbuffer y usando GDI, tienes más calidad en el dibujo.

De entrada te comento, que pitando en VB, puedes pasarlo a picturedisp y luego usarlo con APIs, sin problema...
por ejemplo:

Código: [Seleccionar]

public function Dibujo as IpictureDisp

picture1.Line (0,0)-(4000,4000), vbblue,bf  ' un rectángulo relleno
picture1.line (120,120)-(3880,3880),vbwhite, bf  ' otro rectángulo relleno, dentro del anterior
picture1.line(1900,1900)-(2100,2100),vbred ' un rectangulo dentro del anterior.

Set Dibujo = picture1.Image  ' image contiene el gráfico actual.
End sub

Y lo podrías llamar así:

Código: [Seleccionar]

picture1.move(6000)  ' apartamos el picturebox, del área donde se pinta en el formulario... (o picture1.left = 6000)
form1.autoredraw=true  ' que el form, tenga gráficos persistentes, para que se autoredibuje, cuando algo se coloque encima
Set Form1.picture = Dibujo

Esta noche te miro algo sencillo con transparencia en un contenedor que acepta métodos gráficos... Un usercontrol , es muy buena opción, porque tiene tanto la propiedad Maskpicture, como la propiedad Maskcolor...

[TOLO68]

Muchas gracias NEBIRE, me imagino que has mirado el ejemplo.
Eso es lo que tendria que haber hecho el primer dia de la pregunta, ejejejeje. Bueno voy a seguir con los otros controles que tengo para ver si los voy acabando.
Tengo que hacer los manuales, los PAD, etc... Uno de los mejores es el "Vumeter LED" que cuando lo redimensionas, el mismo se va autocreando, va añadiendo leds y pintandolos segun el color normal o peek, o el "Display HEX" o "Display Matrix", que lo hice con mascaras asi, puedo elegir entre los 16 millones de colores para los digitos y el fondo, con solo 1 bitmap de 2 colores.

Y tambien probare el codigo que me has enviado.

Saludos.

[NEBIRE]

Hola Tolo68...
Se me ha hecho tarde llegar a casa (en España son ya las 00:40), pero el poquito tiempo que he podido dedicarle, ya está en marcha...

Solo le proveo de unas simples funciones de dibujo luego tu ya lo amplías bajo tus necesidades, incluso mejor si usas funciones GDI, con API... yo para algo rápido simplemente te proveo funciones de VB... pero una vez que veas como está hecho, te será muy fácil extenderlo...

Te montaré un proyecto cargado con dos instancias del control para mostrar su uso...
El código es extremadamente sencillo. De hecho, no llleva ni APIs, ni otro código que replicar las funciones que VB ya posee (eso sí,  bajo una perspectiva más cómoda, ya que los métodos gráficos son heredados del viejo QuickBasic y VB, los mantuvo por compatibilidad y nunca los quitó, porque no los sustituyó por nada mejor...)

Bueno, se pueden añadir un par de propiedades para manejar el color deseado... ...podría ser útil y hasta necesario en alguna circunstancia...