⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmlogodemo.frm

📁 Nokia FBus
💻 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 + -