如何绘制点线

use color alike backcolor

解决方案 »

  1.   

    if backcolor is white
    and forecolor is blackthe line u drawd is distinct coarsenessif u line two color with rgb( 233, 233, 233 ) abut upon the black line, it seems fine
      

  2.   

    my answer is wrong, sorry
      

  3.   

    就是 ExtCreatePen 函数用法，帮助说明我都有，就是运行不成功 :(
      

  4.   

    请问lineto api怎么用得，能不能贴段代码看看，谢谢
      

  5.   

    VERSION 5.00
    Begin VB.Form frmExtPen 
       Caption         =   "Extended Pen Testing"
       ClientHeight    =   4785
       ClientLeft      =   1095
       ClientTop       =   1515
       ClientWidth     =   5865
       LinkTopic       =   "Form1"
       PaletteMode     =   1  'UseZOrder
       ScaleHeight     =   4785
       ScaleWidth      =   5865
       Begin VB.CheckBox chkCross 
          Caption         =   "Cross Pattern"
          Height          =   195
          Left            =   3660
          TabIndex        =   22
          Top             =   3720
          Width           =   1755
       End
       Begin VB.HScrollBar scrMiter 
          Height          =   255
          Left            =   4980
          Max             =   20
          Min             =   1
          TabIndex        =   18
          Top             =   4020
          Value           =   10
          Width           =   795
       End
       Begin VB.Frame Frame4 
          Caption         =   "Join"
          Height          =   1275
          Left            =   3480
          TabIndex        =   14
          Top             =   1380
          Width           =   2355
          Begin VB.OptionButton chkJoin 
             Caption         =   "Round"
             Height          =   255
             Index           =   2
             Left            =   120
             TabIndex        =   17
             Top             =   840
             Width           =   2175
          End
          Begin VB.OptionButton chkJoin 
             Caption         =   "Miter"
             Height          =   255
             Index           =   1
             Left            =   120
             TabIndex        =   16
             Top             =   540
             Width           =   2175
          End
          Begin VB.OptionButton chkJoin 
             Caption         =   "Bevel"
             Height          =   255
             Index           =   0
             Left            =   120
             TabIndex        =   15
             Top             =   240
             Value           =   -1  'True
             Width           =   2175
          End
       End
       Begin VB.Frame Frame3 
          Caption         =   "EndCap"
          Height          =   1215
          Left            =   3480
          TabIndex        =   10
          Top             =   120
          Width           =   2355
          Begin VB.OptionButton chkEndcap 
             Caption         =   "Flat"
             Height          =   255
             Index           =   2
             Left            =   180
             TabIndex        =   13
             Top             =   840
             Width           =   1635
          End
          Begin VB.OptionButton chkEndcap 
             Caption         =   "Square"
             Height          =   255
             Index           =   1
             Left            =   180
             TabIndex        =   12
             Top             =   540
             Width           =   1635
          End
          Begin VB.OptionButton chkEndcap 
             Caption         =   "Round"
             Height          =   255
             Index           =   0
             Left            =   180
             TabIndex        =   11
             Top             =   240
             Value           =   -1  'True
             Width           =   1635
          End
       End
       Begin VB.HScrollBar scrWidth 
          Height          =   255
          Left            =   4980
          Max             =   10
          Min             =   1
          TabIndex        =   8
          Top             =   4380
          Value           =   1
          Width           =   795
       End
       Begin VB.Frame Frame2 
          Caption         =   "Style"
          Height          =   1395
          Left            =   180
          TabIndex        =   4
          Top             =   3240
          Width           =   3135
          Begin VB.OptionButton chkStyle 
             Caption         =   "User ___ . . _"
             Height          =   255
             Index           =   2
             Left            =   120
             TabIndex        =   7
             Top             =   960
             Width           =   1695
          End
          Begin VB.OptionButton chkStyle 
             Caption         =   "Dash"
             Height          =   255
             Index           =   1
             Left            =   120
             TabIndex        =   6
             Top             =   600
             Width           =   1695
          End
          Begin VB.OptionButton chkStyle 
             Caption         =   "Solid"
             Height          =   255
             Index           =   0
             Left            =   120
             TabIndex        =   5
             Top             =   240
             Value           =   -1  'True
             Width           =   1695
          End
       End
       Begin VB.Frame Frame1 
          Caption         =   "Type"
          Height          =   975
          Left            =   3480
          TabIndex        =   1
          Top             =   2700
          Width           =   2355
          Begin VB.OptionButton chkType 
             Caption         =   "Geometric"
             Height          =   315
             Index           =   1
             Left            =   180
             TabIndex        =   3
             Top             =   540
             Width           =   1455
          End
          Begin VB.OptionButton chkType 
             Caption         =   "Cosmetic"
             Height          =   255
             Index           =   0
             Left            =   180
             TabIndex        =   2
             Top             =   240
             Value           =   -1  'True
             Width           =   1635
          End
       End
       Begin VB.PictureBox Picture1 
          Height          =   2895
          Left            =   180
          ScaleHeight     =   191
          ScaleMode       =   3  'Pixel
          ScaleWidth      =   203
          TabIndex        =   0
          Top             =   180
          Width           =   3075
       End
       Begin VB.Label lblWidth 
          Caption         =   "1"
          Height          =   255
          Left            =   4620
          TabIndex        =   21
          Top             =   4380
          Width           =   315
       End
       Begin VB.Label lblMiter 
          Caption         =   "10"
          Height          =   255
          Left            =   4620
          TabIndex        =   20
          Top             =   4020
          Width           =   315
       End
       Begin VB.Label Label2 
          Alignment       =   1  'Right Justify
          Caption         =   "Miter limit:"
          Height          =   255
          Left            =   3720
          TabIndex        =   19
          Top             =   4020
          Width           =   795
       End
       Begin VB.Label Label1 
          Alignment       =   1  'Right Justify
          Caption         =   "Width:"
          Height          =   255
          Left            =   3660
          TabIndex        =   9
          Top             =   4380
          Width           =   855
       End
    End
    Attribute VB_Name = "frmExtPen"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
      

  6.   

    Option Explicit
    ' Copyright ?1997 by Desaware Inc. All Rights ReservedDim ExtendedPen&
    Dim CustomStyle(8) As Long
    Private Const CustomStyleLength = 8
    Dim BrushInfo As LOGBRUSHPrivate Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function StrokePath Lib "gdi32" (ByVal hdc As Long) As Long
    Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Any) 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 LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function SetMiterLimit Lib "gdi32" (ByVal hdc As Long, ByVal eNewLimit As Single, peOldLimit As Single) As Long
    Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As LongPrivate Type POINTAPI
            x As Long
            y As Long
    End TypePrivate Type LOGBRUSH
            lbStyle As Long
            lbColor As Long
            lbHatch As Long
    End TypePrivate Const PS_SOLID = 0
    Private Const PS_DASH = 1                    '  -------
    Private Const PS_DOT = 2                     '  .......
    Private Const PS_DASHDOT = 3                 '  _._._._
    Private Const PS_DASHDOTDOT = 4              '  _.._.._
    Private Const PS_NULL = 5
    Private Const PS_INSIDEFRAME = 6
    Private Const PS_USERSTYLE = 7
    Private Const PS_ALTERNATE = 8
    Private Const PS_STYLE_MASK = &HFPrivate Const PS_ENDCAP_ROUND = &H0
    Private Const PS_ENDCAP_SQUARE = &H100
    Private Const PS_ENDCAP_FLAT = &H200
    Private Const PS_ENDCAP_MASK = &HF00Private Const PS_JOIN_ROUND = &H0
    Private Const PS_JOIN_BEVEL = &H1000
    Private Const PS_JOIN_MITER = &H2000
    Private Const PS_JOIN_MASK = &HF000Private Const PS_COSMETIC = &H0
    Private Const PS_GEOMETRIC = &H10000
    Private Const PS_TYPE_MASK = &HF0000
    Private Const BS_SOLID = 0
    Private Const BS_NULL = 1
    Private Const BS_HOLLOW = BS_NULL
    Private Const BS_HATCHED = 2
    Private Const BS_PATTERN = 3
    Private Const BS_INDEXED = 4
    Private Const BS_DIBPATTERN = 5
    Private Const BS_DIBPATTERNPT = 6
    Private Const BS_PATTERN8X8 = 7
    Private Const BS_DIBPATTERN8X8 = 8
    '  Hatch Styles
    Private Const HS_HORIZONTAL = 0              '  -----
    Private Const HS_VERTICAL = 1                '  |||||
    Private Const HS_FDIAGONAL = 2               '  \\\\\
    Private Const HS_BDIAGONAL = 3               '  /////
    Private Const HS_CROSS = 4                   '  +++++
    Private Const HS_DIAGCROSS = 5               '  xxxxxPrivate Sub chkCross_Click()
        Picture1.RefreshEnd SubPrivate Sub chkEndcap_Click(Index As Integer)
        Picture1.Refresh
    End SubPrivate Sub chkJoin_Click(Index As Integer)
       Picture1.Refresh
    End Sub
    Private Sub chkStyle_Click(Index As Integer)
        Picture1.Refresh
    End SubPrivate Sub chkType_Click(Index As Integer)
        Picture1.Refresh
    End Sub
    Private Sub Form_Load()
        CustomStyle(0) = 3
        CustomStyle(1) = 1
        CustomStyle(2) = 1
        CustomStyle(3) = 2
        CustomStyle(4) = 1
        CustomStyle(5) = 2
        CustomStyle(6) = 1
        CustomStyle(7) = 2
        BrushInfo.lbColor = RGB(0, 255, 0)
        BrushInfo.lbHatch = HS_CROSS
    End SubPrivate Sub DoPenUpdate()
        Dim di&
        Dim pentype&, penstyle&, endcap&, join&
        Dim usewidth&
        ' Delete the pen if it exists
        If ExtendedPen Then di = DeleteObject(ExtendedPen)
        If chkType(0).Value Then pentype = PS_COSMETIC Else pentype = PS_GEOMETRIC
        If chkStyle(0).Value Then penstyle = PS_SOLID
        If chkStyle(1).Value Then penstyle = PS_DASH
        If chkStyle(2).Value Then penstyle = PS_USERSTYLE
        If chkEndcap(0).Value Then endcap = PS_ENDCAP_ROUND
        If chkEndcap(1).Value Then endcap = PS_ENDCAP_SQUARE
        If chkEndcap(2).Value Then endcap = PS_ENDCAP_FLAT
        If chkJoin(0).Value Then join = PS_JOIN_BEVEL
        If chkJoin(1).Value Then join = PS_JOIN_MITER
        If chkJoin(2).Value Then join = PS_JOIN_ROUND
        ' Set the pen style
        If chkCross.Value = 1 Then BrushInfo.lbStyle = BS_HATCHED Else BrushInfo.lbStyle = BS_SOLID
        If pentype = PS_COSMETIC Then usewidth = 1 Else usewidth = scrWidth.Value
        If penstyle = PS_USERSTYLE Then
            ExtendedPen = ExtCreatePen(pentype Or penstyle Or endcap Or join, usewidth, BrushInfo, CustomStyleLength, CustomStyle(0))
        Else
            ExtendedPen = ExtCreatePen(pentype Or penstyle Or endcap Or join, usewidth, BrushInfo, 0, ByVal 0&)
        End IfEnd Sub
    Private Sub Form_Unload(Cancel As Integer)
        Dim di&
        If ExtendedPen Then di = DeleteObject(ExtendedPen)
    End SubPrivate Sub Picture1_Paint()
        Dim di&
        Dim pt As POINTAPI
        Dim oldpen&
        Dim oldmiter As Single
        Dim newmiter As Single
        DoPenUpdate
        newmiter = scrMiter
        di = SetMiterLimit(Picture1.hdc, newmiter, oldmiter)
        oldpen = SelectObject(Picture1.hdc, ExtendedPen&)
        di = MoveToEx(Picture1.hdc, 10, 150, pt)
        di = LineTo(Picture1.hdc, 10, 20)
        di = LineTo(Picture1.hdc, 40, 150)
        di = LineTo(Picture1.hdc, 50, 20)
        di = LineTo(Picture1.hdc, 70, 20)
        di = LineTo(Picture1.hdc, 70, 150)
        di = BeginPath(Picture1.hdc)
        di = MoveToEx(Picture1.hdc, 100, 150, pt)
        di = LineTo(Picture1.hdc, 100, 20)
        di = LineTo(Picture1.hdc, 130, 150)
        di = LineTo(Picture1.hdc, 140, 20)
        di = LineTo(Picture1.hdc, 160, 20)
        di = LineTo(Picture1.hdc, 160, 150)
        di = EndPath(Picture1.hdc)
        di = StrokePath(Picture1.hdc)
        
        
        di = SelectObject(Picture1.hdc, oldpen)
        di = SetMiterLimit(Picture1.hdc, oldmiter, newmiter)
    End Sub
    Private Sub scrMiter_Change()
        lblMiter.Caption = Str$(scrMiter.Value)
        Picture1.Refresh
    End SubPrivate Sub scrWidth_Change()
        lblWidth.Caption = Str$(scrWidth.Value)
        Picture1.Refresh
    End Sub以上文字保存为 ExtPen.frm这是书上得例题，但我测试该例题得"User ___ . . _" 方式运行同样不成功，不知道为是么 ExtCreatePen 也是返回 0