|
(其实是线阵)
用记事本保存在另存为"PicZipper.frm"
- VERSION 5.00
- Begin VB.Form PicZipper
- BorderStyle = 1 'Fixed Single
- Caption = "图片压缩"
- ClientHeight = 1800
- ClientLeft = 45
- ClientTop = 390
- ClientWidth = 2340
- BeginProperty Font
- Name = "宋体"
- Size = 10.5
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 1800
- ScaleWidth = 2340
- StartUpPosition = 3 '窗口缺省
- Begin VB.PictureBox Picture4
- AutoRedraw = -1 'True
- DrawWidth = 3
- Height = 855
- Left = 1440
- ScaleHeight = 14.023
- ScaleMode = 6 'Millimeter
- ScaleWidth = 14.023
- TabIndex = 7
- Top = 0
- Width = 855
- End
- Begin VB.PictureBox Picture3
- AutoRedraw = -1 'True
- DrawWidth = 3
- Height = 855
- Left = 480
- ScaleHeight = 14.023
- ScaleMode = 6 'Millimeter
- ScaleWidth = 14.023
- TabIndex = 6
- Top = 0
- Width = 855
- End
- Begin VB.CommandButton Command3
- Caption = "输入"
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 1320
- TabIndex = 5
- Top = 1440
- Width = 495
- End
- Begin VB.TextBox Text1
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 270
- Left = 0
- TabIndex = 4
- Text = "Text1"
- Top = 1440
- Width = 1215
- End
- Begin VB.CommandButton Command2
- Caption = "重现"
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 960
- TabIndex = 3
- Top = 960
- Width = 855
- End
- Begin VB.CommandButton Command1
- Caption = "压缩"
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 0
- TabIndex = 2
- Top = 960
- Width = 855
- End
- Begin VB.PictureBox Picture2
- AutoRedraw = -1 'True
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 0
- ScaleHeight = 21
- ScaleMode = 3 'Pixel
- ScaleWidth = 21
- TabIndex = 1
- Top = 480
- Width = 375
- End
- Begin VB.PictureBox Picture1
- AutoRedraw = -1 'True
- BeginProperty Font
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 0
- ScaleHeight = 21
- ScaleMode = 3 'Pixel
- ScaleWidth = 21
- TabIndex = 0
- Top = 0
- Width = 375
- End
- End
- Attribute VB_Name = "PicZipper"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Option Explicit
- Dim F(-10 To 23, -10 To 23) As Boolean
- Dim F2(-10 To 23, -10 To 23) As Boolean
- Dim a(1 To 1000, 1 To 4) As Integer, LoA As Integer
- Dim T(1 To 8, 1 To 2) As Integer
- Private Sub Command1_Click()
- Dim I As Integer, J As Integer, Tc As Integer, L As Integer
- Dim Flag As Boolean, MaxL As Integer, cL As Integer
- Dim aI As Integer, aJ As Integer, aT As Integer, aL As Integer
- Dim C As Integer
- Debug.Print "Begin Character=", Text1
- Debug.Print " I", " J", " T", " L"
- Command3_Click
- For I = 1 To 12
- For J = 1 To 12
- If Picture1.Point(I - 1, J - 1) = vbBlack Then
- F(I, J) = True
- Else
- F(I, J) = False
- End If
- F2(I, J) = F(I, J)
- If F(I, J) Then Picture3.PSet (I, J)
- Next J
- Next I
- LoA = 0
- Do
- MaxL = 0
- For I = 1 To 12
- For J = 1 To 12
- For Tc = 1 To 8
- cL = 13
- Do
- L = 0: Flag = True: cL = cL - 1
- For C = 0 To cL - 1
- If Not F(I + C * T(Tc, 1), J + C * T(Tc, 2)) Then
- Flag = False
- Exit For
- End If
- If F2(I + C * T(Tc, 1), J + C * T(Tc, 2)) Then L = L + 1
- Next C
- Loop Until Flag Or (cL = 1)
- If (L > MaxL) And Flag Then
- MaxL = L: aI = I: aJ = J: aT = Tc: aL = cL
- End If
- Next Tc
- Next J
- Next I
- If MaxL > 0 Then
- LoA = LoA + 1
- a(LoA, 1) = aI
- a(LoA, 2) = aJ
- a(LoA, 3) = aT
- a(LoA, 4) = aL
- For C = 0 To aL - 1
- F2(aI + C * T(aT, 1), aJ + C * T(aT, 2)) = False
- Next C
- Debug.Print a(LoA, 1), a(LoA, 2), a(LoA, 3), a(LoA, 4)
- End If
- Loop Until MaxL = 0
- Debug.Print "End LoA=", LoA
- End Sub
- Private Sub Command2_Click()
- Dim I As Integer
- Picture2.Cls
- Picture4.Cls
- For I = 1 To LoA
- Picture2.Line (a(I, 1), a(I, 2))-(a(I, 1) + T(a(I, 3), 1) * a(I, 4), a(I, 2) + T(a(I, 3), 2) * a(I, 4))
- Picture4.Line (a(I, 1), a(I, 2))-(a(I, 1) + T(a(I, 3), 1) * a(I, 4), a(I, 2) + T(a(I, 3), 2) * a(I, 4))
- Next I
- End Sub
- Private Sub Command3_Click()
- Picture1.Cls
- Picture1.Print Text1
- Picture3.Cls
- End Sub
- Private Sub Form_Load()
- Dim I As Integer, J As Integer
- T(1, 1) = -1: T(2, 1) = -1: T(3, 1) = -1
- T(1, 2) = -1: T(2, 2) = 0: T(3, 2) = 1
- T(4, 1) = 0: T(5, 1) = 0
- T(4, 2) = -1: T(5, 2) = 1
- T(6, 1) = 1: T(7, 1) = 1: T(8, 1) = 1
- T(6, 2) = -1: T(7, 2) = 0: T(8, 2) = 1
- For I = -10 To 23
- For J = -10 To 23
- F(I, J) = False
- F2(I, J) = False
- Next J
- Next I
- End Sub
复制代码 |
|