Hi!
Jetzt hab ich schon wieder eine Frage ^^ und ich hoffe mir kann sie jemand beantworten
Mit folgendem Quellcode zeichne ich eine Ellipse auf eine ImageBox. Dies flimmert aber durch die Repaint Funktion. Angeblich kann man das mit der Funktion BitBlt beheben… aber ich weiss nicht wie ich das hier (ohne PictureBox) anwenden kann.
Vielen Dank schonmal für Eure Hilfe und ein schönes Wochenende!
MfG, Andi
Public Declare Function GetDC Lib „User32“ (ByVal hwnd As Long) As Long
Public Declare Function FindWindow Lib „User32“ Alias „FindWindowA“ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetPixel Lib „gdi32“ (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Public hwnd As Long
Public hdc As Long
Public e_X1 As Double
Public e_X2 As Double
Public e_Y1 As Double
Public e_Y2 As Double
Public Sub Ellipse(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, Farbe As Variant)
Dim zX As Double
Dim zY As Double
For I = 0 To 3.14 * 2 Step 0.1
zX = ((X1 + ((X2 - X1) / 2) * Math.Cos(I)) * 1.33) + ufBildEditor.Image1.left
zY = ((Y1 + ((Y2 - Y1) / 2) * Math.Sin(I)) * 1.33) + ufBildEditor.Image1.top
SetPixel hdc, zX, zY, vbBlack
SetPixel hdc, zX + 0.5, zY + 0.5, Farbe
SetPixel hdc, zX + 0.5, zY - 0.5, Farbe
SetPixel hdc, zX - 0.5, zY + 0.5, Farbe
SetPixel hdc, zX - 0.5, zY - 0.5, Farbe
SetPixel hdc, zX + 0.75, zY + 0.75, Farbe
SetPixel hdc, zX + 0.75, zY - 0.75, Farbe
SetPixel hdc, zX - 0.75, zY + 0.75, Farbe
SetPixel hdc, zX - 0.75, zY - 0.75, Farbe
Next I
End Sub
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
DownFlag = True
e_X1 = x
e_Y1 = y
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If DownFlag = True Then
Me.Repaint
e_X2 = x
e_Y2 = y
Call Ellipse(e_X1, e_Y1, e_X2, e_Y2, vbRed)
End If
End Sub
Private Sub Image1_Mouseup(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
DownFlag = False
End Sub
Private Sub UserForm_Initialize()
hwnd = FindWindow(vbNullString, Me.Caption)
hdc = GetDC(hwnd)
End Sub