📄 frmlogodemo.frm
字号:
VERSION 5.00
Begin VB.Form frmLogoDemo
BorderStyle = 3 'Fixed Dialog
Caption = "Logo Demo"
ClientHeight = 2535
ClientLeft = 45
ClientTop = 330
ClientWidth = 6135
DrawMode = 7 'Invert
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2535
ScaleWidth = 6135
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton cmdSms
Caption = "Send SMS"
Enabled = 0 'False
Height = 300
Left = 2880
TabIndex = 10
Top = 2160
Width = 975
End
Begin VB.TextBox txtDestination
Height = 285
Left = 120
TabIndex = 9
Text = "enter phone number"
Top = 2160
Width = 2655
End
Begin VB.CommandButton cmdAnimate
Caption = "Animate Logo!"
Height = 300
Left = 3960
TabIndex = 8
Top = 1440
Width = 2055
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BackColor = &H80000005&
FillStyle = 0 'Solid
Height = 1260
Left = 120
ScaleHeight = 80
ScaleMode = 3 'Pixel
ScaleWidth = 389
TabIndex = 7
Top = 120
Width = 5895
End
Begin VB.TextBox txtFile
Height = 285
Left = 120
TabIndex = 6
Text = "test.nlm"
Top = 1800
Width = 3735
End
Begin VB.CommandButton cmdRead
Caption = "Read file"
Height = 300
Left = 3960
TabIndex = 5
Top = 1800
Width = 975
End
Begin VB.CommandButton cmdWrite
Caption = "Write file"
Enabled = 0 'False
Height = 300
Left = 5040
TabIndex = 4
Top = 1800
Width = 975
End
Begin VB.TextBox txtNetCode
Height = 285
Left = 1920
TabIndex = 2
Top = 1440
Width = 855
End
Begin VB.CommandButton cmdUpload
Caption = "Upload"
Enabled = 0 'False
Height = 300
Left = 2880
TabIndex = 1
Top = 1440
Width = 975
End
Begin VB.CommandButton cmdDownload
Caption = "Download"
Height = 300
Left = 120
TabIndex = 0
Top = 1440
Width = 975
End
Begin VB.Label lblNetCode
AutoSize = -1 'True
Caption = "Net Code:"
Height = 195
Left = 1200
TabIndex = 3
Top = 1485
Width = 720
End
End
Attribute VB_Name = "frmLogoDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private bPaint As Boolean
Private Sub cmdAnimate_Click()
With frm15Demo.MobileFBUSControl1
If Not .AnimateLogo Then
.LoadAnimation App.Path & "\mfbus.gif"
.AnimateLogo = True
Else
.AnimateLogo = False
End If
End With
End Sub
Private Sub cmdDownload_Click()
Screen.MousePointer = vbHourglass
frm15Demo.MobileFBUSControl1.Logo.Download fbOperatorLogo
txtNetCode.Text = frm15Demo.MobileFBUSControl1.Logo.NetCode
PaintLogo
End Sub
Private Sub cmdRead_Click()
Dim sFile As String
Screen.MousePointer = vbHourglass
sFile = Trim(txtFile.Text)
If InStr(sFile, "\") = 0 Then sFile = App.Path & "\" & sFile
frm15Demo.MobileFBUSControl1.Logo.ReadFile sFile
PaintLogo
End Sub
Private Sub cmdSms_Click()
With frm15Demo.MobileFBUSControl1.Logo
.NetCode = txtNetCode.Text
.SendAsSMS txtDestination.Text
End With
End Sub
Private Sub cmdUpload_Click()
Dim X As Integer, Y As Integer
On Error Resume Next
Screen.MousePointer = vbHourglass
With frm15Demo.MobileFBUSControl1.Logo
.NetCode = txtNetCode.Text
.Upload
End With
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdWrite_Click()
Dim sFile As String, iPos As Integer
With frm15Demo.MobileFBUSControl1.Logo
If .LogoType = fbOperatorLogo Then
sFile = Trim(txtFile.Text)
iPos = InStrRev(sFile, ".")
If iPos > 0 Then
sFile = Left(sFile, iPos) & "nol"
ElseIf sFile = "" Then
sFile = "MFBus15.nol"
Else
sFile = sFile & ".nol"
End If
txtFile.Text = sFile
If InStr(sFile, "\") = 0 Then sFile = App.Path & "\" & sFile
.WriteFile sFile
End If
End With
End Sub
Private Sub Form_Load()
With frm15Demo.MobileFBUSControl1
.Logo.ReadFile App.Path & "\mobfbus.nlm"
.Logo.LogoType = fbOperatorLogo
txtNetCode = .ProviderCode
.Logo.NetCode = txtNetCode
PaintLogo
End With
Screen.MousePointer = vbDefault
End Sub
Public Sub PaintLogo()
Dim ix As Integer, iy As Integer
Dim px As Long, py As Long, r As Long
Screen.MousePointer = vbHourglass
Picture1.Visible = False
Picture1.Cls
With frm15Demo.MobileFBUSControl1.Logo
If .Width > 0 And .Height > 0 Then
Picture1.FillColor = 0
Picture1.ForeColor = 0
ix = Picture1.ScaleWidth / (2 * .Width)
iy = Picture1.ScaleHeight / (2 * .Height)
r = IIf(ix < iy, ix, iy)
If r < 1 Then r = 1
For iy = 0 To .Height - 1
py = r + (iy * Picture1.ScaleHeight) / .Height
For ix = 0 To .Width - 1
px = r + (ix * Picture1.ScaleWidth) / .Width
If .Pixel(ix, iy) = 0 Then
Picture1.Circle (px, py), r
End If
Next ix
Next iy
End If
cmdUpload.Enabled = (.LogoType = fbOperatorLogo) And (.NetCode <> "")
cmdWrite.Enabled = cmdUpload.Enabled
txtDestination_Change
End With
Picture1.Visible = True
Screen.MousePointer = vbDefault
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ix As Integer, iy As Integer
Dim px As Long, py As Long, r As Long
If (Button And 1) = 1 Then
With frm15Demo.MobileFBUSControl1.Logo
If .Width > 0 And .Height > 0 Then
ix = Picture1.ScaleWidth / (2 * .Width)
iy = Picture1.ScaleHeight / (2 * .Height)
r = IIf(ix < iy, ix, iy)
If r < 1 Then r = 1
iy = ((Y - r) * .Height) / Picture1.ScaleHeight
ix = ((X - r) * .Width) / Picture1.ScaleWidth
py = r + (iy * Picture1.ScaleHeight) / .Height
px = r + (ix * Picture1.ScaleWidth) / .Width
bPaint = (.Pixel(ix, iy) <> 0)
End If
End With
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ix As Integer, iy As Integer
Dim px As Long, py As Long, r As Long
If (Button And 1) = 1 Then
With frm15Demo.MobileFBUSControl1.Logo
If .Width > 0 And .Height > 0 Then
ix = Picture1.ScaleWidth / (2 * .Width)
iy = Picture1.ScaleHeight / (2 * .Height)
r = IIf(ix < iy, ix, iy)
If r < 1 Then r = 1
iy = ((Y - r) * .Height) / Picture1.ScaleHeight
ix = ((X - r) * .Width) / Picture1.ScaleWidth
py = r + (iy * Picture1.ScaleHeight) / .Height
px = r + (ix * Picture1.ScaleWidth) / .Width
.Pixel(ix, iy) = IIf(bPaint, 0, 1)
If bPaint Then
Picture1.FillColor = 0
Picture1.ForeColor = 0
Else
Picture1.FillColor = Picture1.BackColor
Picture1.ForeColor = Picture1.BackColor
End If
Picture1.Circle (px, py), r
End If
End With
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Picture1_MouseMove Button, Shift, X, Y
End Sub
Private Sub txtDestination_Change()
Dim sTxt As String
sTxt = Replace(txtDestination.Text, " ", "")
sTxt = Replace(sTxt, "(", "")
sTxt = Replace(sTxt, ")", "")
cmdSms.Enabled = IsNumeric(sTxt) And (Len(sTxt) > 5) And cmdUpload.Enabled
End Sub
Private Sub txtDestination_GotFocus()
If txtDestination.Text = "enter phone number" Then
txtDestination.SelStart = 0
txtDestination.SelLength = Len(txtDestination.Text)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -