VFP在表单上画图(画直线、曲线等)

 本示例并没有应用GDI+

 

Public oform1
oform1=Newobject("form1")
oform1.Show
Return
 

Define Class form1 As Form
 

Top = 1
Left = 1
Height = 500
Width = 700
ScrollBars = 0
DoCreate = .T.
ShowTips = .F.
Picture = ""
BorderStyle = 2
Caption = "DrawLine"
MaxButton = .F.
MousePointer = 2
KeyPreview = .F.
AlwaysOnTop = .F.
BackColor = Rgb(255,255,255)
Name = "Form1"

Add Object shape1 As Shape With ;
    Top = -5, ;
    Left = 500, ;
    Height = 510, ;
    Width = 250, ;
    BackStyle = 1, ;
    BorderStyle = 1, ;
    BorderWidth = 5, ;
    MousePointer = 1, ;
    BackColor = Rgb(128,255,255), ;
    BorderColor = Rgb(0,0,255), ;
    Name = "Shape1"

Add Object spinner_linewidth As Spinner With ;
    Height = 24, ;
    InputMask = "99", ;
    KeyboardHighValue = 50, ;
    KeyboardLowValue = 1, ;
    Left = 544, ;
    SpinnerHighValue = 50.00, ;
    SpinnerLowValue = 1.00, ;
    Top = 174, ;
    Width = 120, ;
    Value = 1, ;
    Name = "Spinner_LineWidth"

Add Object command_clearline As CommandButton With ;
    Top = 441, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    Caption = "清除线条", ;
    Name = "Command_ClearLine"

Add Object line_sample As Line With ;
    BorderWidth = 1, ;
    Height = 0, ;
    Left = 544, ;
    Top = 50, ;
    Width = 120, ;
    LineSlant = "/", ;
    Name = "Line_Sample"

Add Object command_linecolor2 As CommandButton With ;
    Top = 306, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    Caption = "红色", ;
    ForeColor = Rgb(255,0,0), ;
    Name = "Command_LineColor2"

Add Object label2 As Label With ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "线条宽度:(像素)", ;
    Height = 16, ;
    Left = 544, ;
    Top = 158, ;
    Width = 92, ;
    Name = "Label2"

Add Object label4 As Label With ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "线条颜色:", ;
    Height = 16, ;
    Left = 544, ;
    Top = 268, ;
    Width = 56, ;
    Name = "Label4"

Add Object og_linetype As OptionGroup With ;
    AutoSize = .F., ;
    ButtonCount = 2, ;
    BackStyle = 0, ;
    BorderStyle = 1, ;
    Value = 1, ;
    Height = 26, ;
    Left = 544, ;
    Top = 118, ;
    Width = 120, ;
    Name = "OG_LineType", ;
    Option1.BackStyle = 0, ;
    Option1.Caption = "直线", ;
    Option1.Value = 1, ;
    Option1.Height = 16, ;
    Option1.Left = 5, ;
    Option1.Style = 0, ;
    Option1.Top = 5, ;
    Option1.Width = 45, ;
    Option1.AutoSize = .T., ;
    Option1.Name = "Option1", ;
    Option2.BackStyle = 0, ;
    Option2.Caption = "曲线", ;
    Option2.Height = 16, ;
    Option2.Left = 69, ;
    Option2.Style = 0, ;
    Option2.Top = 5, ;
    Option2.Width = 45, ;
    Option2.AutoSize = .T., ;
    Option2.Name = "Option2"

Add Object label1 As Label With ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "线条类型:", ;
    Height = 16, ;
    Left = 544, ;
    Top = 103, ;
    Width = 56, ;
    Name = "Label1"

Add Object combo_linestyle As ComboBox With ;
    RowSourceType = 1, ;
    RowSource = "实线,虚线,点线,点划线,双点划线,内实线,透明", ;
    Height = 24, ;
    Left = 544, ;
    MousePointer = 0, ;
    Style = 2, ;
    Top = 229, ;
    Width = 120, ;
    ReadOnly = .F., ;
    Name = "Combo_LineStyle"

Add Object label3 As Label With ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "线条样式:", ;
    Height = 16, ;
    Left = 544, ;
    Top = 213, ;
    Width = 56, ;
    Name = "Label3"

Add Object label0 As Label With ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontSize = 12, ;
    WordWrap = .F., ;
    BackStyle = 0, ;
    Caption = "此示列运行于 VFP9.0", ;
    Enabled = .T., ;
    Height = 20, ;
    Left = 518, ;
    Top = 482, ;
    Width = 167, ;
    ForeColor = Rgb(0,0,255), ;
    Name = "Label0"

Add Object command_linecolor3 As CommandButton With ;
    Top = 330, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    FontBold = .F., ;
    Caption = "绿色", ;
    ForeColor = Rgb(0,255,0), ;
    Name = "Command_LineColor3"

Add Object command_linecolor4 As CommandButton With ;
    Top = 354, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    Caption = "蓝色", ;
    ForeColor = Rgb(0,0,255), ;
    Name = "Command_LineColor4"

Add Object command_linecolor5 As CommandButton With ;
    Top = 378, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    Caption = "自定义颜色", ;
    ForeColor = Rgb(255,128,0), ;
    Name = "Command_LineColor5"

Add Object command_lineerase As CommandButton With ;
    Top = 417, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    Caption = "像皮擦", ;
    ForeColor = Rgb(255,255,255), ;
    Name = "Command_LineErase"

Add Object command_linecolor1 As CommandButton With ;
    Top = 282, ;
    Left = 544, ;
    Height = 25, ;
    Width = 120, ;
    Caption = "黑色", ;
    ForeColor = Rgb(0,0,0), ;
    Name = "Command_LineColor1"

Procedure Unload
    Release gaBezierPoints
Endproc

Procedure Load
    Public gaBezierPoints[4,2]
    gaBezierPoints[1,1]=0
    gaBezierPoints[1,2]=0
    gaBezierPoints[2,1]=80
    gaBezierPoints[2,2]=25
    gaBezierPoints[3,1]=0
    gaBezierPoints[3,2]=75
    gaBezierPoints[4,1]=100
    gaBezierPoints[4,2]=100
Endproc

Procedure MouseDown
    Lparameters nButton,nShift,nXCoord,nYCoord
    If This.MousePointer=2
        This.CurrentX=nXCoord
        This.CurrentY=nYCoord
    Endif
Endproc

Procedure MouseUp
    Lparameters nButton,nShift,nXCoord,nYCoord
    If nButton=1 And Thisform.OG_LineType.Value=1 And nXCoord<=500
        Thisform.Line(This.CurrentX,This.CurrentY,nXCoord,nYCoord)
    Endif
Endproc

Procedure MouseMove
    Lparameters nButton,nShift,nXCoord,nYCoord
    If nXCoord>500
        This.MousePointer=1
    Else
        This.MousePointer=2
    Endif
    If nButton=1 And This.MousePointer=2 And Thisform.OG_LineType.Value=2
        This.Line(This.CurrentX,This.CurrentY,nXCoord,nYCoord)
    Endif
Endproc

Procedure spinner_linewidth.InteractiveChange
    If This.Value>50
        This.Value=50
    Endif
    If This.Value<1
        This.Value=1
    Endif
    Thisform.Combo_LineStyle.ListItemId=1
    If This.Value>1
        Thisform.Combo_LineStyle.Enabled=.F.
    Else
        Thisform.Combo_LineStyle.Enabled=.T.
    Endif
    Thisform.Combo_LineStyle.InteractiveChange()
    Store This.Value To Thisform.DrawWidth,Thisform.Line_Sample.BorderWidth
    Thisform.Line_Sample.Refresh
Endproc

Procedure command_clearline.Click
    Thisform.Cls
Endproc

Procedure command_linecolor2.Click
    Store Rgb(255,0,0) To Thisform.Line_Sample.BorderColor,Thisform.ForeColor
    Thisform.Line_Sample.Refresh
Endproc

Procedure og_linetype.InteractiveChange
    If This.Value=1
        Thisform.line_Sample.Polypoints=""
        Thisform.Line_Sample.LineSlant="/"
        Thisform.Line_Sample.Move(544,50,120,0)
    Else
        Thisform.line_Sample.Polypoints="gaBezierPoints"
        Thisform.line_Sample.LineSlant='S'
        Thisform.Line_Sample.Move(530,5,150,80)
    Endif
    Thisform.Line_Sample.Refresh
Endproc

Procedure combo_linestyle.InteractiveChange
    Do Case
        Case This.DisplayValue="实线"
            Thisform.DrawStyle=0
            Thisform.Line_Sample.BorderStyle=1
        Case This.DisplayValue="虚线"
            Thisform.DrawStyle=1
            Thisform.Line_Sample.BorderStyle=2
        Case This.DisplayValue="点线"
            Thisform.DrawStyle=2
            Thisform.Line_Sample.BorderStyle=3
        Case This.DisplayValue="点划线"
            Thisform.DrawStyle=3
            Thisform.Line_Sample.BorderStyle=4
        Case This.DisplayValue="双点划线"
            Thisform.DrawStyle=4
            Thisform.Line_Sample.BorderStyle=5
        Case This.DisplayValue="内实线"
            Thisform.DrawStyle=6
            Thisform.Line_Sample.BorderStyle=6
        Case This.DisplayValue="透明"
            Thisform.DrawStyle=5
            Thisform.Line_Sample.BorderStyle=0
    Endcase
    Thisform.Line_Sample.Refresh
Endproc

Procedure combo_linestyle.Init
    This.ListItemId=1
Endproc

Procedure command_linecolor3.Click
    Store Rgb(0,255,0) To Thisform.Line_Sample.BorderColor,Thisform.ForeColor
    Thisform.Line_Sample.Refresh
Endproc

Procedure command_linecolor4.Click
    Store Rgb(0,0,255) To Thisform.Line_Sample.BorderColor,Thisform.ForeColor
    Thisform.Line_Sample.Refresh
Endproc

Procedure command_linecolor5.Click
    lnColor=Getcolor(Thisform.Line_Sample.BorderColor)
    If lnColor#-1
        Store lnColor To Thisform.Line_Sample.BorderColor,Thisform.ForeColor
        Thisform.Line_Sample.Refresh
    Endif
Endproc

Procedure command_lineerase.Click
    Store Rgb(255,255,255) To Thisform.ForeColor
    Thisform.OG_LineType.Value=2
    Thisform.OG_LineType.InteractiveChange()
    Thisform.Line_Sample.Refresh
Endproc

Procedure command_linecolor1.Click
    Store Rgb(0,0,0) To Thisform.Line_Sample.BorderColor,Thisform.ForeColor
    Thisform.Line_Sample.Refresh
Endproc

Enddefine