2018年12月02日

How to use VB NET Predefined Hatch Brush and Known colors in VB 6.0

  A hatch pattern brush fills a closed area with a simple pattern of lines, dots or other shapes, VB 6.0 support only six hatch styles, and Win 32 Api support 26 hatch styles(actually oly six are useful?). While VB NET offer 56 hatch styles (53 styles are

useful), if we can use VB NETdefault hatch brushes in VB 6.0 , it will be a wonderful thing? Is it possible? The answer is “yes”, and how to do it. The concept is quite easy and simple.

(2).In VB NET using a arrayList to store the list of hatch name.

hatchCol.Add("0_Horizontal_0")

        hatchCol.Add("1_Horizontal_0")

        hatchCol.Add("2_Vertical_1")

        hatchCol.Add("3_ForwardDiagonal_2")

        hatchCol.Add("4_BackwardDiagonal_3")

        hatchCol.Add("5_LargeGrid_4")

        hatchCol.Add("6_LargeGrid_4")

        hatchCol.Add("7_LargeGrid_4")

        hatchCol.Add("8_DiagonalCross_5")

        hatchCol.Add("9_Percent05_6")

        hatchCol.Add("10_Percent10_7")

        hatchCol.Add("11_Percent20_8")

        hatchCol.Add("12_Percent25_9")

        hatchCol.Add("13_Percent30_10")

        hatchCol.Add("14_Percent40_11")

        hatchCol.Add("15_Percent50_12")

        hatchCol.Add("16_Percent60_13")

        hatchCol.Add("17_Percent70_14")

        hatchCol.Add("18_Percent75_15")

        hatchCol.Add("19_Percent80_16")

        hatchCol.Add("20_Percent90_17")

        hatchCol.Add("21_LightDownwardDiagonal_18")

        hatchCol.Add("22_LightUpwardDiagonal_19")

        hatchCol.Add("23_DarkDownwardDiagonal_20")

        hatchCol.Add("24_DarkUpwardDiagonal_21")

        hatchCol.Add("25_WideDownwardDiagonal_22")

        hatchCol.Add("26_WideUpwardDiagonal_23")

        hatchCol.Add("27_LightVertical_24")

        hatchCol.Add("28_LightHorizontal_25")

        hatchCol.Add("29_NarrowVertical_26")

        hatchCol.Add("30_NarrowHorizonta_27")

        hatchCol.Add("31_DarkVertical_28")

        hatchCol.Add("32_DarkHorizontal_29")

        hatchCol.Add("33_DashedDownwardDiagonal_30")

        hatchCol.Add("34_DashedUpwardDiagonal_31")

        hatchCol.Add("35_DashedHorizontal_32")

        hatchCol.Add("36_DashedVertical_33")

        hatchCol.Add("37_SmallConfetti_34")

        hatchCol.Add("38_LargeConfetti_35")

        hatchCol.Add("39_ZigZag_36")

        hatchCol.Add("40_Wave_37")

        hatchCol.Add("41_DiagonalBrick_38")

        hatchCol.Add("42_HorizontalBrick_39")

        hatchCol.Add("43_Weave_40")

        hatchCol.Add("44_Plaid_41")

        hatchCol.Add("45_Divot_42")

        hatchCol.Add("46_DottedGrid_43")

        hatchCol.Add("47_DottedDiamond_44")

        hatchCol.Add("48_Shingle_45")

        hatchCol.Add("49_Trellis_46")

        hatchCol.Add("50_Sphere_47")

        hatchCol.Add("51_SmallGrid_48")

        hatchCol.Add("52_SmallCheckerBoard_48")

        hatchCol.Add("53_LargeCheckerBoard_50")

        hatchCol.Add("54_OutlinedDiamond_51")

        hatchCol.Add("55_SolidDiamond_52")

(2). In VB NET using the following snippet code to draw the VB NET default hatch patterns on a PictureBox and save it as a bitmap.

Private Sub hatchPlot(ByVal canvas As PictureBox, ByVal nx As Integer, ByVal ny As Integer)

        canvas.Image = New Bitmap(canvas.ClientSize.Width, canvas.ClientSize.Height, Format32bppArgb)

        Dim gp As Graphics = Graphics.FromImage(canvas.Image)

        gp.Clear(canvas.BackColor)

        Dim iX As Single, jY As Single

        Dim x1p As Single, y1p As Single, x2p As Single, y2p As Single       

        Dim st As String, count As Long

        xspace = (canvas.ClientSize.Width - 1) / nx

        yspace = (canvas.ClientSize.Height - 1) / ny

        count = 0

        For jY = 0 To ny - 1

            For iX = 0 To nx - 1

                x1p = iX * xspace

                y1p = jY * yspace

                x2p = (iX + 1) * xspace

                y2p = (jY + 1) * yspace

                Dim the_brush As New HatchBrush

the_brush= Drawing2D.HatchBrush(HatchstylesInd(count), _

 Color.Black, Color.White)

                gp.FillRectangle(the_brush, x1p, y1p, x2p - x1p, y2p - y1p)

                gp.DrawRectangle(New Pen(Color.Red), x1p, y1p, x2p - x1p, y2p - y1p)

                count = count + 1

            Next iX

        Next jY

        bmp = New Bitmap(canvas.Image)

        canvas.Image = bmp

        gp.Dispose()

    End Sub

   The Picture will look like as following.

 (3). In VB NETwe use a 8pixels*8pixels PictureBox(PicReal,backcolor=

Color.White, foreColor=Color.Black) as a canvas and fill it by each Hatch pattern, and using getPixel() to retrieve the color data. The pattern color data for the first one( 0_Horizontal_0) and last one(55_SolidDiamond_52) are something like:

Case 0

bmpDataStr(0) = "0,0,0,0,0,0,0,0" ‘0 for Color.black

bmpDataStr(1) = "1,1,1,1,1,1,1,1" ‘1 for Color.white

bmpDataStr(2) = "1,1,1,1,1,1,1,1"

bmpDataStr(3) = "1,1,1,1,1,1,1,1"

bmpDataStr(4) = "1,1,1,1,1,1,1,1"

bmpDataStr(5) = "1,1,1,1,1,1,1,1"

bmpDataStr(6) = "1,1,1,1,1,1,1,1"

bmpDataStr(7) = "1,1,1,1,1,1,1,1"

Case 55

bmpDataStr(0) = "1,1,1,0,1,1,1,1"

bmpDataStr(1) = "1,1,0,0,0,1,1,1"

bmpDataStr(2) = "1,0,0,0,0,0,1,1"

bmpDataStr(3) = "0,0,0,0,0,0,0,1"

bmpDataStr(4) = "1,0,0,0,0,0,1,1"

bmpDataStr(5) = "1,1,0,0,0,1,1,1"

bmpDataStr(6) = "1,1,1,0,1,1,1,1"

bmpDataStr(7) = "1,1,1,1,1,1,1,1"

(4). In VB 6.0 using a PictureBox(PicHatchs) to load the hatch patterns bitmap by Loadpicture() function.

(5).Copy VB NET pattern color data to Sub PatternDatasVBNet()

Private Sub PatternDatasVBNet(ByVal PatternIndex As Integer, ByRef bmpDataStr() As String)

  Erase bmpDataStr

  ReDim Preserve bmpDataStr(0 To 7)

  Select Case PatternIndex

Case 0

bmpDataStr(0) = "0,0,0,0,0,0,0,0"

bmpDataStr(1) = "1,1,1,1,1,1,1,1"

bmpDataStr(2) = "1,1,1,1,1,1,1,1"

bmpDataStr(3) = "1,1,1,1,1,1,1,1"

bmpDataStr(4) = "1,1,1,1,1,1,1,1"

bmpDataStr(5) = "1,1,1,1,1,1,1,1"

bmpDataStr(6) = "1,1,1,1,1,1,1,1"

bmpDataStr(7) = "1,1,1,1,1,1,1,1"

bmpDataStr(0) = "0,0,0,0,0,0,0,0"

bmpDataStr(1) = "0,1,1,1,0,1,1,1"

bmpDataStr(2) = "0,1,1,1,0,1,1,1"

bmpDataStr(3) = "0,1,1,1,0,1,1,1"

bmpDataStr(4) = "0,0,0,0,0,0,0,0"

bmpDataStr(5) = "0,1,1,1,0,1,1,1"

bmpDataStr(6) = "0,1,1,1,0,1,1,1"

bmpDataStr(7) = "0,1,1,1,0,1,1,1"

.

.

.

Case 55

bmpDataStr(0) = "1,1,1,0,1,1,1,1"

bmpDataStr(1) = "1,1,0,0,0,1,1,1"

bmpDataStr(2) = "1,0,0,0,0,0,1,1"

bmpDataStr(3) = "0,0,0,0,0,0,0,1"

bmpDataStr(4) = "1,0,0,0,0,0,1,1"

bmpDataStr(5) = "1,1,0,0,0,1,1,1"

bmpDataStr(6) = "1,1,1,0,1,1,1,1"

bmpDataStr(7) = "1,1,1,1,1,1,1,1"

End Select

End Sub

(6). In PicHatchs_MouseDown we use the code to get the VB NET hatch index.

Private Sub PicHatchs_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

        Dim Xm, Ym

        On Error Resume Next

        If Button = VB LeftButton Then

            Xm = Int(X / lcXspace) ‘lcXspace=width of each style

            Ym = Int(Y / lcYspace) ‘lcyspace=width of each style

            lcVB netPatternInd = Ym * 4 + Xm

           Lblnetxy.Caption = "x= " & X & "; y= " & Y & " ;StyleIndex= " & lcVB netPatternInd

           CmdPlotbyVnetdata_Click

        End If

    End Sub

(7). By clicking sub CmdPlotbyVnetdata_Click to show the result.

Private Sub CmdPlotbyVnetdata_Click()

Dim bmpdatastrNet() As String

Dim stArray() As String

Erase bmpdatastrNet

PatternDatasVB Net lcVB netPatternInd, bmpdatastrNet

ReDim Preserve bmpdatastrNet(0 To UBound(bmpdatastrNet))

PicReal.ScaleMode = 3

PicReal.AutoRedraw = True

PicReal.BorderStyle = 1

PicReal.Width = 8

PicReal.Height = 8

PicReal.AutoSize = True

PicReal.Visible = True

Dim j As Integer, i As Integer

For j = 0 To UBound(bmpdatastrNet)

   Erase stArray

   stArray = Split(bmpdatastrNet(j), ",", -1, VB TextCompare)

   ReDim Preserve stArray(0 To UBound(stArray))

For i = 0 To UBound(bmpdatastrNet)

    If Val(stArray(i)) = 1 Then

        PicReal.PSet (i, j), VB White

    Else

       PicReal.PSet (i, j), VB Blue

    End If

Next i

Next j

PicReal.Picture = PicReal.Image

PicReal.Refresh

 On Error GoTo errhander

              PicDraw.Cls

              PicDraw.Picture = Nothing

              PicDraw.AutoRedraw = True

              Dim newBrush As Long, OldBrush As Long

              PicDraw.DrawStyle = 0

              PicDraw.FillStyle = 1

              PicDraw.Circle (40, 40), 35

               newBrush = CreatePatternBrush(PicReal.Picture)   'image for forecolor ,picture for origin picture

               OldBrush = SelectObject(PicDraw.hdc, newBrush)

               ExtFloodFill PicDraw.hdc, 32, 32, PicDraw.Point(32, 32), FLOODFILLSURFACE 'PicDraw.Point(70, 70) is backcolor

               SelectObject PicDraw.hdc, OldBrush

               DeleteObject newBrush

            PicDraw.Refresh

            Exit Sub

errhander:

    MsgBox ("err in sub CmdPlotbyVnetdata_Click ")

    Exit Sub

End Sub

(8).Follow the similar procedure ,you can draw down the known color of Vb Net,

   by using the snippet code. Attched here,and save the picture as a bitmap.

   In VB 6.0 you just load the bitmap into a PictureBox which saved previously in Vb net,and use point() or Api getpixel() to pick the color you want.

Private Sub FrmCollections_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Dim colorNames As New System.Collections.Generic.List(Of String)

        Dim count As Integer = 0

        For Each colorknown As KnownColor In [Enum].GetValues(GetType(KnownColor)) 'list color from Arraylist'從列舉預設顏色陣列清單中取出顏色物件

            Dim Colorspec As Color = Color.FromKnownColor(colorknown) '

            If Not Colorspec.IsSystemColor Then

                colorNames.Add(colorknown.ToString())

                ReDim Preserve colortables(count), colorNameStrs(count)

                colortables(count) = Colorspec

                colorNameStrs(count) = colorknown.ToString

                count += 1

            End If

        Next colorknown

        'colorNames.Sort() 'If need then use this statement to sort the color name

        For Each colorName As String In colorNames

            ListBox1.Items.Add(colorName) 'write color name to listBox寫出顏色到ListBox1

        Next colorName

    End Sub

    Private Sub ListBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) _

    Handles ListBox1.SelectedIndexChanged '從ListBox1選取顏色

        Dim st1 As String

        st1 = ListBox1.SelectedItem.ToString

        Dim col1 As Color

        col1 = Color.FromName(LblColor.Text)

        Dim st2 As String = GetHexColor(col1)

        LblColor.Text = st1

        PicColorShow.BackColor = Color.FromName(st1) 'display color 顯示顏色

    End Sub

    Private Sub DrawKnownColors(ByRef Canvas As PictureBox, ByVal nGridX As Integer, ByVal nGridY As Integer)

        Dim i, j As Integer

        Dim xspace, yspace As Single

        xspace = (Canvas.Width - 1) / nGridX

        yspace = (Canvas.Height - 1) / nGridY

        Canvas.Image = New Bitmap(Canvas.Width, Canvas.Height)

        bmp = Canvas.Image

        Dim gr As Graphics = Graphics.FromImage(bmp)

        Dim count As Integer = 0

        For j = 0 To nGridY - 1

            For i = 0 To nGridX - 1

                Dim x1 As Single = i * xspace

                Dim y1 As Single = j * yspace

                Dim x2 As Single = (i + 1) * xspace

                Dim y2 As Single = (j + 1) * yspace

                gr.FillRectangle(New SolidBrush(colortables(count)), x1, y1, x2, y2)

                gr.DrawRectangle(New Pen(Color.Black), x1, y1, x2, y2)

                count += 1

            Next

        Next

        Canvas.Image = bmp

        gr.Dispose()

    End Sub

    Private Sub ButDrawColors_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButDrawColors.Click

        DrawKnownColors(picColorsA, 47, 3)

        DrawKnownColors(PicColorsB, 3, 47)

    End Sub

    Private Sub picColorsA_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picColorsA.MouseMove

        Dim xspace, yspace As Single

        xspace = (picColorsA.Width - 1) / 47

        yspace = (picColorsA.Height - 1) / 3

        Dim xm, ym As Integer

        xm = e.X \ xspace

        ym = e.Y \ yspace

        Dim indcol As Integer = ym * 47 + xm

        If indcol <= 140 Then LblColIndA.Text = "colorIndex= " & indcol & "; " & colorNameStrs(indcol) & " ;R=" & colortables(indcol).R _

        & " ;G=" & colortables(indcol).G & ";B=" & colortables(indcol).B

    End Sub

    Private Sub picColorsB_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PicColorsB.MouseMove

        Dim xspace, yspace As Single

        xspace = (PicColorsB.Width - 1) / 3

        yspace = (PicColorsB.Height - 1) / 47

        Dim xm, ym As Integer

        xm = e.X \ xspace

        ym = e.Y \ yspace

        Dim indcol As Integer = ym * 3 + xm

        If indcol <= 140 Then LblColIndB.Text = "colorIndex= " & indcol & "; " & colorNameStrs(indcol) & " ;R=" & colortables(indcol).R _

        & " ;G=" & colortables(indcol).G & ";B=" & colortables(indcol).B

    End Sub

Name(您的大名)
E_MAIL(您的電子信箱)
Comment or Suggestion(您想反應的狀況，建議，或諮詢事項)