Kod:
Option Compare Database
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Sub dikdörtgen_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Position As POINTAPI
GetCursorPos Position
If Button > 0 Then
Call cızgı(GetWindowDC(0), 4, Me.Metin4, Me.Metin2, Position.X - 1, Position.Y + 1, Position.X + 1, Position.Y + 1)
End If
End Sub
Sub cızgı(hdc As Long, _
PenType As Long, _
BorderW As Long, BorderKl As Long, _
iX1 As Long, iY1 As Long, _
iX2 As Long, iY2 As Long)
Dim Pt As POINTAPI
Dim hPn As Long, hPnOld As Long
hPn = CreatePen(PenType, BorderW, BorderKl Xor &H1000000)
hPnOld = SelectObject(hdc, hPn)
MoveToEx hdc, iX1, iY1, Pt
LineTo hdc, iX2, iY2
SelectObject hdc, hPnOld
DeleteObject hPn
End Sub
eğer şayet yapamaz isen ben örneği eklereinm burdaki metin2 renk metin4 nokta boyutu dikdörtgen ise dikdörtgen işte ancak arka planı beyaz ve normal ha unutmadan metin kutularına sayıları girmeden çizmeye kalkma arıza verir
metin2 ye sayı girdikten sonra metin4 sayı gireceksin ondan sonra tekrar metin 2 ye gireceksinki metin 4 e yazılan sayıyı görsün yoksa metin 4 ü boş görüyor
örneğin ekte