📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 2640
ClientLeft = 60
ClientTop = 345
ClientWidth = 6225
LinkTopic = "Form1"
ScaleHeight = 176
ScaleMode = 3 'Pixel
ScaleWidth = 415
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Load Groups"
Height = 315
Left = 4500
TabIndex = 11
Top = 1125
Width = 1635
End
Begin VB.ComboBox Combo1
Height = 315
ItemData = "Form1.frx":0000
Left = 1875
List = "Form1.frx":000D
Style = 2 'Dropdown List
TabIndex = 10
Top = 1095
Width = 1110
End
Begin MSComDlg.CommonDialog cd1
Left = 5295
Top = 2625
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.PictureBox picForeColor
Height = 450
Left = 4485
ScaleHeight = 390
ScaleWidth = 1635
TabIndex = 8
Top = 540
Width = 1695
Begin VB.CommandButton cdmForeColor
Caption = "ForeColor"
Height = 390
Left = 0
TabIndex = 9
Top = 0
Width = 930
End
End
Begin VB.PictureBox picBackColor
Height = 450
Left = 4485
ScaleHeight = 390
ScaleWidth = 1635
TabIndex = 6
Top = 45
Width = 1695
Begin VB.CommandButton cmdBackColor
Caption = "BackColor"
Height = 390
Left = 0
TabIndex = 7
Top = 0
Width = 930
End
End
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 840
Left = 1800
ScaleHeight = 56
ScaleMode = 3 'Pixel
ScaleWidth = 288
TabIndex = 4
Top = 1590
Width = 4320
End
Begin VB.PictureBox picTMP
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 210
Left = 3900
ScaleHeight = 14
ScaleMode = 3 'Pixel
ScaleWidth = 72
TabIndex = 3
Top = 3240
Visible = 0 'False
Width = 1080
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 210
Left = 1845
ScaleHeight = 14
ScaleMode = 3 'Pixel
ScaleWidth = 72
TabIndex = 1
Top = 705
Width = 1080
End
Begin VB.ListBox List1
Height = 2205
Left = 15
TabIndex = 0
Top = 270
Width = 1725
End
Begin VB.Label Label2
Caption = "1x"
Height = 180
Left = 1935
TabIndex = 5
Top = 480
Width = 555
End
Begin VB.Label Label1
Caption = "Groups"
Height = 225
Left = 105
TabIndex = 2
Top = 15
Width = 1125
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Phonebook As PhonebookAdapterDS3.PhonebookSuite3
Private Type GroupItem
index As Long
Name As String
Picture As IPictureDisp
End Type
Private Groups(0 To 4) As GroupItem
Function GetGroupPicture(CGI As ICallerGroupIcon, index As Long, picBox As PictureBox) As IPictureDisp
'Get every byte from the callergroupicon and create a string
'with '0's and '1's that represent the picture pixels
Dim x As Byte
Dim x1 As Byte
Dim xByte As Byte
Dim pix As Integer
Dim p$
'We leave the first 4 bytes (header)
For i% = 4 To CGI.GetOTAByteCount - 1
pix = CGI.GetOTAByte(i%)
p$ = p$ & GetBinaryString(pix)
Next i%
c% = 1
For row = 0 To CGI.Height - 1
For col = 0 To CGI.Width - 1
If Mid$(p$, c%, 1) = "0" Then
h& = picBox.BackColor
Else
h& = picBox.ForeColor
End If
c% = c% + 1
picBox.PSet (col, row), h&
Next col
Next row
Set GetGroupPicture = picBox.Image
picBox.Cls
End Function
Private Sub Load_Groups()
Dim CG As ICallerGroup2
For i& = 0 To 4
GetCallerGroupSettings CG, i&
Groups(i&).index = i&
Groups(i&).Name = CG.Name
Set Groups(i&).Picture = GetGroupPicture(CG.Icon, i&, picTMP)
Next i&
End Sub
Function GetBinaryString(c As Integer) As String
'Converts a number to the binary format
'eg input is '7' and output is '00100111'
Dim lInput As Double
Dim sOutput As String
Dim iX As Integer
lInput = CLng(c)
sOutput = "" 'reset output string
While lInput > 0
iX = lInput Mod 2 'return the modulus
sOutput = iX & sOutput 'append result to output string
lInput = Int(lInput / 2) 'return the next number for calculation
Wend
While Len(sOutput) < 8 'add leading zeros if the result is shorter than 8 characters
sOutput = 0 & sOutput
Wend
GetBinaryString = sOutput
End Function
Private Sub GetCallerGroupSettings(CallerGroup As PhonebookAdapterDS3.ICallerGroup2, ByVal index As Long)
'Get the callergroup object
On Error GoTo ErrorTrap
'query caller group settings
Set CallerGroup = Phonebook.GetCallerGroup(index)
Exit Sub
ErrorTrap:
Dim ErrorCode As PhonebookAdapterDS3.NmpAdapterError
ErrorCode = Phonebook.GetLastError
If ErrorCode = errInvalidParameter Then
MsgBox "Error #" & ErrorCode & ": invalid parameter."
Else
MsgBox "Error #" & Phonebook.GetLastError & " in querying caller group settings."
End If
End Sub
Private Sub cdmForeColor_Click()
cd1.ShowColor
picForeColor.BackColor = cd1.Color
picTMP.ForeColor = cd1.Color
g& = List1.ListIndex
List1.Clear
Load_Groups
For i& = 0 To 4
List1.AddItem Groups(i&).index & " " & Groups(i&).Name
List1.ItemData(List1.NewIndex) = i&
Next i&
List1.ListIndex = g&
End Sub
Private Sub cmdBackColor_Click()
cd1.ShowColor
picBackColor.BackColor = cd1.Color
picTMP.BackColor = cd1.Color
g& = List1.ListIndex
List1.Clear
Load_Groups
For i& = 0 To 4
List1.AddItem Groups(i&).index & " " & Groups(i&).Name
List1.ItemData(List1.NewIndex) = i&
Next i&
List1.ListIndex = g&
End Sub
Private Sub Combo1_Click()
Picture2.Move Picture2.Left, Picture2.Top, (Combo1.ListIndex + 2) * 72, (Combo1.ListIndex + 2) * 14
If Picture1 <> 0 Then
Picture2.PaintPicture Picture1.Picture, 0, 0, (Combo1.ListIndex + 2) * 72, (Combo1.ListIndex + 2) * 14, 0, 0, 72, 14, vbSrcCopy
End If
End Sub
Private Sub Command1_Click()
MousePointer = 11
List1.Clear
For i& = 0 To 4
List1.AddItem Groups(i&).index & " " & Groups(i&).Name
List1.ItemData(List1.NewIndex) = i&
Next i&
Combo1.ListIndex = 0
If List1.ListCount > 0 Then List1.ListIndex = 0
MousePointer = 0
End Sub
Private Sub Form_Load()
mpusepointer = 11
picBackColor.BackColor = picTMP.BackColor
picForeColor.BackColor = picTMP.ForeColor
Show
Set Phonebook = New PhonebookAdapterDS3.PhonebookSuite3
Load_Groups
For i& = 0 To 4
List1.AddItem Groups(i&).index & " " & Groups(i&).Name
List1.ItemData(List1.NewIndex) = i&
Next i&
Combo1.ListIndex = 0
If List1.ListCount > 0 Then List1.ListIndex = 0
MousePointer = 0
End Sub
Private Sub List1_Click()
Set Picture1.Picture = Groups(List1.ItemData(List1.ListIndex)).Picture
Picture2.PaintPicture Picture1.Picture, 0, 0, (Combo1.ListIndex + 2) * 72, (Combo1.ListIndex + 2) * 14, 0, 0, 72, 14, vbSrcCopy
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -