title image


Smiley TIPP: Kreis per API auf ein Formular zeichnen
Das geht so:



Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, _

ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long

Private Declare Function ArcTo Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, _

ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long

Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, _

ByVal crColor As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, _

ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Const BLACK_BRUSH = 4

Private Const BLACK_PEN = 7

Private Const PS_SOLID = 0



Private Sub Draw_Click()

Dim hdc As Long, hpen As Long, hbrush As Long, _

x As Long, y As Long, r As Long, s As Double

hdc = GetWindowDC(Me.hwnd)

hpen = CreatePen(PS_SOLID, 2, RGB(0, 0, 0)) ' schwarze Linie

SelectObject hdc, hpen

hbrush = CreateSolidBrush(RGB(255, 0, 0)) ' rote Füllung

SelectObject hdc, hbrush

x = 200 ' Koordinaten des Mittelpunkts

y = 200

r = 100 ' Radius

Ellipse hdc, x - r, y - r, x + r, y + r

ReleaseDC Me.hwnd, hdc

End Sub







Gruß aus dem Norden
Reinhard


Bitte immer die Access-Version angeben!
DB-Wiki


Wie man Fragen richtig stellt

YaccessAccess-FAQUnd ansonsten: Wikipedia




geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: