VBA: Flimmerfrei zeichnen

Hi!
Jetzt hab ich schon wieder eine Frage ^^ und ich hoffe mir kann sie jemand beantworten :wink:

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! :wink:

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

Hallo,

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…

nö, BitBlt hilft da gar nicht, da hilft nur Double Buffering. Stell die Eigenschaft Autoredraw der Form auf True, wenn Dein Image auch Autoredraw kennt, dann auch da. (Ich kann nicht nachseheen, habe privat kein VBA)

Gruß, Rainer

Mit folgendem Quellcode zeichne ich eine Ellipse auf eine
ImageBox. Dies flimmert aber durch die Repaint Funktion.

Hi Andreas,
application.screenupdating=false
vor dem eigentlichen Zeichnencode und
application.screenupdating=true
danach bringt nichts?
Gruß
Reinhard