?? form1.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -