如何开发带有箭头的直线控件!!

fanfree 2003-01-08 09:34:31
rt
...全文
100 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
zqfleaf 2003-01-08
  • 打赏
  • 举报
回复
如何画自己的控件
SUMMARY
The Win32 API includes a handy function called DrawFrameControl. This function is useful for drawing many of the standard Windows 95, Windows 98, or Windows Me 3D controls as graphic objects on your forms. The function only draws the controls on your form. To make these drawings behave like controls, you must add code to provide this functionality.
MORE INFORMATION
This sample demonstrates how to use the DrawFrameControl function. You create a module that declares the necessary constants and the DrawFrameControl function. The form contains code to call the function and draw the controls on your form. When you run the program, control drawings appear on the form.


1.Start a new project in Visual Basic. Form1 is created by default.
2.Add a BAS module to the project and add the following code to the module:
'*****************************************************************
' DrawFram.bas - Contains API declarations and constants for the
' DrawFrameControl API function.
'*****************************************************************
Option Explicit

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' flags for DrawFrameControl

Public Const DFC_CAPTION = 1 'Title bar
Public Const DFC_MENU = 2 'Menu
Public Const DFC_SCROLL = 3 'Scroll bar
Public Const DFC_BUTTON = 4 'Standard button

Public Const DFCS_CAPTIONCLOSE = &H0 'Close button
Public Const DFCS_CAPTIONMIN = &H1 'Minimize button
Public Const DFCS_CAPTIONMAX = &H2 'Maximize button
Public Const DFCS_CAPTIONRESTORE = &H3 'Restore button
Public Const DFCS_CAPTIONHELP = &H4 'Windows 95 only:
'Help button

Public Const DFCS_MENUARROW = &H0 'Submenu arrow
Public Const DFCS_MENUCHECK = &H1 'Check mark
Public Const DFCS_MENUBULLET = &H2 'Bullet
Public Const DFCS_MENUARROWRIGHT = &H4

Public Const DFCS_SCROLLUP = &H0 'Up arrow of scroll
'bar
Public Const DFCS_SCROLLDOWN = &H1 'Down arrow of
'scroll bar
Public Const DFCS_SCROLLLEFT = &H2 'Left arrow of
'scroll bar
Public Const DFCS_SCROLLRIGHT = &H3 'Right arrow of
'scroll bar
Public Const DFCS_SCROLLCOMBOBOX = &H5 'Combo box scroll
'bar
Public Const DFCS_SCROLLSIZEGRIP = &H8 'Size grip
Public Const DFCS_SCROLLSIZEGRIPRIGHT = &H10 'Size grip in
'bottom-right
'corner of window

Public Const DFCS_BUTTONCHECK = &H0 'Check box

Public Const DFCS_BUTTONRADIO = &H4 'Radio button
Public Const DFCS_BUTTON3STATE = &H8 'Three-state button
Public Const DFCS_BUTTONPUSH = &H10 'Push button

Public Const DFCS_INACTIVE = &H100 'Button is inactive
'(grayed)
Public Const DFCS_PUSHED = &H200 'Button is pushed
Public Const DFCS_CHECKED = &H400 'Button is checked

Public Const DFCS_ADJUSTRECT = &H2000 'Bounding rectangle is
'adjusted to exclude the
'surrounding edge of the
'push button

Public Const DFCS_FLAT = &H4000 'Button has a flat border
Public Const DFCS_MONO = &H8000 'Button has a monochrome
'border

Public Declare Function DrawFrameControl Lib "user32" (ByVal _
hDC&, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) _
As Boolean


3.Copy the following code to the Form1 Code Window:
'********************************************************************
' DrawFram.frm - Demonstrates how to use DrawFrameControl
'********************************************************************
Option Explicit

'********************************************************************
' Helper function that allows a you to load a rect on one line
'********************************************************************
Private Function MakeRect(l As Long, t As Long, w As Long, _
h As Long) As RECT
With MakeRect
.Left = l
.Top = t
.Right = l + w
.Bottom = t + h
End With

End Function

Private Sub Form_Load()
ScaleMode = vbPixels
AutoRedraw = True

'Captions
DrawFrameControl hDC, MakeRect(10, 10, 15, 15), DFC_CAPTION, _
DFCS_CAPTIONCLOSE

DrawFrameControl hDC, MakeRect(10, 30, 15, 15), DFC_CAPTION, _
DFCS_CAPTIONRESTORE

DrawFrameControl hDC, MakeRect(10, 50, 15, 15), DFC_CAPTION, _
DFCS_CAPTIONMAX Or DFCS_INACTIVE

' Menus
DrawFrameControl hDC, MakeRect(30, 10, 15, 15), DFC_MENU, _
DFCS_MENUARROW

DrawFrameControl hDC, MakeRect(30, 30, 15, 15), DFC_MENU, _
DFCS_MENUCHECK

DrawFrameControl hDC, MakeRect(30, 50, 15, 15), DFC_MENU, _
DFCS_MENUBULLET

' Scrollbars
DrawFrameControl hDC, MakeRect(50, 10, 15, 15), DFC_SCROLL, _
DFCS_SCROLLUP

DrawFrameControl hDC, MakeRect(50, 30, 15, 15), DFC_SCROLL, _
DFCS_SCROLLSIZEGRIP

DrawFrameControl hDC, MakeRect(50, 50, 15, 15), DFC_SCROLL, _
DFCS_SCROLLRIGHT Or DFCS_INACTIVE

' Checkboxes
DrawFrameControl hDC, MakeRect(70, 10, 15, 15), DFC_BUTTON, _
DFCS_BUTTONCHECK

DrawFrameControl hDC, MakeRect(70, 30, 15, 15), DFC_BUTTON, _
DFCS_BUTTONCHECK Or DFCS_CHECKED

DrawFrameControl hDC, MakeRect(70, 50, 15, 15), DFC_BUTTON, _
DFCS_BUTTONCHECK Or DFCS_CHECKED Or DFCS_BUTTON3STATE

' Option Buttons
DrawFrameControl hDC, MakeRect(90, 10, 15, 15), DFC_BUTTON, _
DFCS_BUTTONRADIO

DrawFrameControl hDC, MakeRect(90, 30, 15, 15), DFC_BUTTON, _
DFCS_BUTTONRADIO Or DFCS_CHECKED

DrawFrameControl hDC, MakeRect(90, 50, 15, 15), DFC_BUTTON, _
DFCS_BUTTONRADIO Or DFCS_CHECKED Or DFCS_FLAT

' Push Button
DrawFrameControl hDC, MakeRect(110, 10, 50, 20), DFC_BUTTON, _
DFCS_BUTTONPUSH

DrawFrameControl hDC, MakeRect(110, 40, 50, 20), DFC_BUTTON, _
DFCS_BUTTONPUSH Or DFCS_PUSHED

End Sub


4.On the Run menu, click Start or press the F5 key to start the program. The form appears with drawings of the controls.
gxingmin 2003-01-08
  • 打赏
  • 举报
回复
'新建一个自定义控件Arrow
'AutoRedaw=true
'代码如下

Const PI = 3.1415926

Dim LineAngle As Double
Dim OldLineAngle As Double
'Dim rc As RECT

Dim X1 As Single, X2 As Single ''''声明圆心坐标变量

Private Sub UserControl_Show()

UserControl.Width = 200
UserControl.Height = 200

End Sub

Public Property Get DrawMode() As Integer
DrawMode = UserControl.DrawMode
End Property

Public Property Let DrawMode(ByVal New_DrawMode As Integer)
UserControl.DrawMode() = New_DrawMode
PropertyChanged "DrawMode"
End Property

Public Sub PaintAngle(BegX As Single, BegY As Single, EndX As Single, EndY As Single)
UserControl.DrawMode = vbCopyPen
UserControl.Cls
DrawWidth = 1

If EndX = BegX Then
If EndY > BegY Then
X1 = 100
Y1 = 200
LineAngle = PI / 2
Else
X1 = 100
Y1 = 0
LineAngle = PI * 3 / 2
End If
ElseIf EndX > BegX Then
LineAngle = PI - Atn((EndY - BegY) / (EndX - BegX))
If EndY > BegY Then
If (EndY - BegY) / (EndX - BegX) < 1 Then
X1 = 200
Y1 = 100 + 100 * (EndY - BegY) / (EndX - BegX)
Else
X1 = 100 + 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 200
End If
Else
If (EndY - BegY) / (EndX - BegX) > -1 Then
X1 = 200
Y1 = 100 + 100 * (EndY - BegY) / (EndX - BegX)
Else
X1 = 100 - 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 0
End If
End If
Else
LineAngle = 2 * PI - Atn((EndY - BegY) / (EndX - BegX))
If EndY > BegY Then
If (EndY - BegY) / (EndX - BegX) > -1 Then
X1 = 0
Y1 = 100 - 100 * (EndY - BegY) / (EndX - BegX)
Else
X1 = 100 + 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 200
End If
Else
If (EndY - BegY) / (EndX - BegX) > 1 Then
X1 = 100 - 100 * (EndX - BegX) / (EndY - BegY)
Y1 = 0
Else
X1 = 0
Y1 = 100 - 100 * (EndY - BegY) / (EndX - BegX)
End If
End If
End If

''''''''''''''''开始画扇形
If LineAngle + PI / 12 <= PI * 2 Then
Circle (X1, Y1), 200, &H80000007, -(LineAngle - PI / 12), -(LineAngle + PI / 12)
ElseIf LineAngle - PI / 12 >= PI * 2 Then
Circle (X1, Y1), 200, &H80000007, -(LineAngle - PI / 12 - PI * 2), -(LineAngle + PI / 12 - PI * 2)
Else 'LineAngle - PI / 12 < PI * 2 and LineAngle + PI / 12 > PI * 2
Circle (X1, Y1), 200, &H80000007, -(LineAngle - PI / 12), -(LineAngle + PI / 12 - PI * 2)
End If

End Sub


'在Form窗体上放一个Line1,一个Arrow1
'代码如下
Option Explicit

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.X1 = X
Line1.Y1 = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Line1.X2 = X
Line1.Y2 = Y

Arrow1.Left = (Line1.X1 + Line1.X2 - Arrow1.Width) / 2
Arrow1.Top = (Line1.Y1 + Line1.Y2 - Arrow1.Height) / 2
Arrow1.PaintAngle Line1.X1, Line1.Y1, Line1.X2, Line1.Y2

End Sub
qqqdong 2003-01-08
  • 打赏
  • 举报
回复
<-----
是不是这样的,如果是用usercontrol
将其背景设为 backstyle = 0
fanfree 2003-01-08
  • 打赏
  • 举报
回复
先谢各位!!

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧