form1.frm

LCD点阵图形取模VB纺写

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "3510i液晶显示器取模助手"
   ClientHeight    =   3960
   ClientLeft      =   5355
   ClientTop       =   2895
   ClientWidth     =   3720
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   264
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   248
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   1065
      Left            =   240
      ScaleHeight     =   67
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   98
      TabIndex        =   8
      Top             =   600
      Width           =   1530
   End
   Begin VB.PictureBox Picture3 
      AutoRedraw      =   -1  'True
      Height          =   1065
      Left            =   1920
      ScaleHeight     =   67
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   98
      TabIndex        =   6
      Top             =   600
      Width           =   1530
   End
   Begin VB.Frame Frame1 
      Caption         =   "Frame1"
      Height          =   1935
      Left            =   240
      TabIndex        =   1
      Top             =   1800
      Width           =   3255
      Begin VB.CommandButton Command1 
         Caption         =   "打开文件"
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   1455
      End
      Begin VB.CommandButton Command2 
         Caption         =   "取模"
         Height          =   375
         Left            =   1680
         TabIndex        =   4
         Top             =   360
         Width           =   1335
      End
      Begin VB.CommandButton Command4 
         Caption         =   "保存为bin文件"
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   840
         Width           =   1455
      End
      Begin VB.CommandButton Command3 
         Caption         =   "关于本程序"
         Height          =   375
         Left            =   1680
         TabIndex        =   2
         Top             =   840
         Width           =   1335
      End
      Begin VB.Label Label3 
         Caption         =   "*注：取模后自动复制到剪贴板"
         Height          =   375
         Left            =   120
         TabIndex        =   10
         Top             =   1440
         Width           =   2895
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   6240
      Top             =   7200
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox Text1 
      Height          =   3255
      Left            =   1920
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "Form1.frx":0000
      Top             =   6960
      Width           =   7935
   End
   Begin VB.Label Label1 
      Caption         =   "打开的图片："
      Height          =   255
      Left            =   240
      TabIndex        =   9
      Top             =   240
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "取模效果预揽："
      Height          =   255
      Left            =   1920
      TabIndex        =   7
      Top             =   240
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim buffer(9849) As Byte
Dim str As String

Private Sub Command1_Click()
    Dim x, Y As Integer
    Dim i, j As Integer
    Dim n As Integer
    Dim Red As Byte
    Dim Green As Byte
    Dim Blue As Byte
    Dim Color As Long
    Dim temp, temp2 As Integer
    
    CommonDialog1.ShowOpen
    
    Picture1.Picture = LoadPicture(CommonDialog1.FileName)
    Y = 67
    x = 98

    str = ""
    For j = 0 To Y - 1
        
        For i = 0 To x - 1
            
            Color = Picture1.Point(i, j)
            
            Red = Color Mod 256
            
            Green = ((Color And &HFF00) / 256) Mod 256
            Blue = ((Color And &HFF0000) / 65536) Mod 256

            
            temp = (j * x * 1.5) + Int(i * 1.5)
            temp2 = (j * x + i) Mod 2
            n = n + 1
            If temp2 = 0 Then
                buffer(temp) = (Red And &HF0) Or ((Green And &HF0) / 16)
                buffer(temp + 1) = Blue And &HF0
            
            Else
                buffer(temp) = buffer(temp) Or ((Red And &HF0) / 16)
                buffer(temp + 1) = (Green And &HF0) Or ((Blue And &HF0) / 16)
            End If
        Next
        
    
    Next
    
    Call Pre_View

    Label3.Caption = "已打开" & CommonDialog1.FileName
      

End Sub

Function hex2(value As Byte)
    If value > 15 Then
        hex2 = "0x" & Hex(value)
    Else
        hex2 = "0x0" & Hex(value)
    End If
    

End Function

Private Sub Command2_Click()
    Dim i, j As Integer
    Dim str_temp As String
    Dim n As Integer
    For i = 0 To (9849 / 16) - 1
        str_temp = ""
        For j = 0 To 15
            str_temp = str_temp & hex2(buffer(i * 16 + j)) & ","
            n = n + 1
        Next
        str_temp = str_temp & Chr(13) & Chr(10)
        str = str & str_temp
    Next
    Text1.Text = str
    
    Clipboard.SetText str
    Label3.Caption = "已完成，取模数据已放到剪贴板，为c语言格式，请在IDE里粘贴"
 
End Sub
 
Sub Pre_View()
    Dim r, g, b As Byte
    Dim x, Y As Integer
    
    Dim n As Integer
    Dim temp As Integer
    Dim temp2 As Byte
    
    For Y = 0 To 67 - 1
        
        For x = 0 To 98 - 1



            temp = (Y * 98 * 1.5) + Int(x * 1.5)
            temp2 = (Y * 98 + x) Mod 2
            n = n + 1
            If temp2 = 0 Then
                r = buffer(temp) And &HF0
                g = (buffer(temp) And &HF) * 16
                b = buffer(temp + 1) And &HF0
            Else
            
                r = (buffer(temp) And &HF) * 16
                g = buffer(temp + 1) And &HF0
                b = (buffer(temp + 1) And &HF) * 16
            
            End If
            
            Picture3.PSet (x, Y), RGB(r, g, b)
            
        Next
        
    
    Next
    
    
    
End Sub

Private Sub Command3_Click()
    Form2.Show
    
End Sub

Private Sub Command4_Click()

    Dim i As Integer
    CommonDialog1.Filter = "*.bin|*.bin"
    CommonDialog1.ShowSave
    
    If CommonDialog1.FileName = "" Then
        
        
        Exit Sub
        
        
    End If
    Open CommonDialog1.FileName For Binary As #2

    For i = 0 To 9848
       
        Put #2, , buffer(i)
        
    Next
    
    
    Close #2
    
    
    
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub