frmsignpostview.frm

短信平台管理系统是一个短信收发的平台,用户可以找一些代理的短信平台(IP),在系统里修改一些设置就可以进行短信的收发,有短信服务器的IP,服务器端口.系统还有一些常用用户的设置,包括客户资料,客户分类

         TabIndex        =   3
         Top             =   960
         Width           =   7455
         Begin VB.CommandButton Cmdeditgraph 
            Caption         =   "编辑背景图片"
            Height          =   375
            Left            =   3360
            TabIndex        =   30
            Top             =   120
            Width           =   1695
         End
         Begin VB.Image Imgall 
            Height          =   1440
            Left            =   240
            Picture         =   "frmsignpostview.frx":490A
            Top             =   600
            Width           =   2880
         End
         Begin VB.Label lblLabels 
            Caption         =   "公共背景图片："
            Height          =   255
            Index           =   4
            Left            =   360
            TabIndex        =   33
            Top             =   240
            Width           =   1455
         End
         Begin VB.OLE OLE2 
            Appearance      =   0  'Flat
            Class           =   "Paint.Picture"
            Height          =   1455
            Left            =   3360
            OleObjectBlob   =   "frmsignpostview.frx":6D8C
            SourceDoc       =   "D:\CHENGYANJUN\LED\SRC\GRAPH\RIGHT.BMP"
            TabIndex        =   31
            Top             =   600
            Width           =   2895
         End
      End
      Begin VB.Frame framsendno 
         Height          =   2415
         Left            =   360
         TabIndex        =   1
         Top             =   5280
         Width           =   5895
         Begin VB.Label Label3 
            AutoSize        =   -1  'True
            Caption         =   "请在屏幕的路口信息中输入"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   15.75
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H000000FF&
            Height          =   435
            Left            =   1080
            TabIndex        =   2
            Top             =   1080
            Width           =   3780
         End
      End
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   1200
      Top             =   6960
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   1
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmsignpostview.frx":9FA4
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmsignpostview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Const CONSTG = "G"
Public ledname As String
Public ledid As String

Dim modelPath As String
Dim ledCs As ledcontents
Dim curledcontent As ledcontent
Dim newledContent As New ledcontent

Dim Fontnames As constvalues
Dim Colors As constvalues
Dim Styles As constvalues
Dim uploadfroms As constvalues
Dim dictionarys As constvalues
Dim leddatax As New LEDData


Private Sub ChkIsupload_Click()
    If Me.ChkIsupload = 1 Then
        Me.Cmdsend.Enabled = True
    Else
        Me.Cmdsend.Enabled = False
    End If
    
End Sub

Private Sub Cmdcancel_Click()
    Unload Me
End Sub

Private Sub Cmdclear_Click()
    Me.txtcontent = ""
End Sub

Private Sub Cmdeditgraph_Click()
    On Error Resume Next
    Me.OLE2.DoVerb 1
End Sub

Private Sub Cmdpreview_Click()
    Dim isall As Boolean
    isall = True
    getNewvalue
    With leddatax
        .start
        .Clear 0, 0, WP, HP
        If newledContent.uploadfrom <> Modleddisp.FROMTEXT Then
            If newledContent.uploadfrom = Modleddisp.FROMMG Then
                If newledContent.allgmodel <> "" Then
                    .DrawBMP 0, 0, WP, HP, 0, 0, WP, HP, modelPath & newledContent.allgmodel
                    isall = False
                End If
            Else
                If newledContent.modelgrah <> "" Then
                    .DrawBMP 0, 0, WP, HP, 0, 0, WP, HP, modelPath & newledContent.modelgrah
                    isall = False
                End If
            End If
        End If
        If newledContent.uploadfrom <> Modleddisp.FROMGRAPH Then
            If newledContent.newcontent <> "" Then
                Drawtexttobmp leddatax, newledContent.newcontent, isall, newledContent.fontname, newledContent.color
            End If
        End If
        leddatax.outBMP App.Path & "\tempx.bmp"
        leddatax.over
        Set Me.Imgpreview.Picture = LoadPicture(App.Path & "\tempx.bmp")
    End With
End Sub





Private Sub Cmdsend_Click()
    saveASet
    On Error Resume Next
    frmMain.StopTomer
    If uploadOnepage(curledcontent, True, Me) Then
            curledcontent.isupload = True
            curledcontent.oldcontent = curledcontent.newcontent
            Me.Lvwmessages.ListItems(CInt(newledContent.ledgraphno)).SubItems(2) = IIf(curledcontent.isupload = True, "已发送", "需要发送")
            
            If curledcontent.uploadfrom <> FROMGRAPH And curledcontent.newcontent = "" Then
                Me.Lvwmessages.ListItems(CInt(newledContent.ledgraphno)).SubItems(2) = "无信息发送"
            End If
            
            
            Me.ChkIsupload.value = 0
            Me.Imgold.Picture = LoadPicture(App.Path & "\graph\" & curledcontent.bmpfname)
            MsgBox "消息发送成功！", vbOKOnly, "提示"
    Else
        MsgBox "消息发送不成功，请重新发送！", vbOKOnly, "提示"
    End If
    frmMain.startTimer
End Sub

Private Sub cmdsendled_Click()
    On Error Resume Next
    frmMain.StopTomer
    Upload True, Me.ledid, , Me
    frmMain.startTimer
    fillList
    loadAset
End Sub

Private Sub Combodict_Click()
    If dictionarys.Item(Combodict.Text).value = "" Then
    Else
        Me.txtcontent = Me.txtcontent & dictionarys.Item(Combodict.Text).value
    End If
End Sub






Private Sub Command1_Click()

End Sub

Private Sub Form_Load()
    If Not User.CanDo(1, False) Then
        Cmdeditgraph.Enabled = False
    Else
        Cmdeditgraph.Enabled = True
    End If
    modelPath = App.Path & "\model\"
    Me.caption = Me.caption & "：" & ledname
    '参照设置
    Set Fontnames = constmaintain.getcvalues(constmaintain.fontname)
    Set Colors = constmaintain.getcvalues(constmaintain.color)
    Set Styles = constmaintain.getcvalues(constmaintain.DISPSTYLE)
    Set uploadfroms = constmaintain.getcvalues(constmaintain.uploadfrom)
    Set dictionarys = constmaintain.getcvalues(constmaintain.dictionary)
    
    initcombo dictionarys, Me.Combodict, ""

    'listview 的填写
    fillList
    '设置第一个消息

    loadAset
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '保存设置
    '释放对象
    saveASet
    releObject Fontnames
    releObject Colors
    releObject Styles
    releObject uploadfroms
    releObject ledCs
    releObject curledcontent
    releObject newledContent
    releObject leddatax
    releObject dictionarys
End Sub

'listview 的填写
Sub fillList()
    Dim lm As ledcontent
    Dim Item As ListItem
    With Me.Lvwmessages.ColumnHeaders
        .Clear
        .Add , "ledgraphno", "图形编号", 1200
        .Add , "modelname", "图形名称", 1500
        .Add , "isupload", "需要发送？", 1500
    End With
    
    Set ledCs = GetLedcontents(ledid, False)
    Lvwmessages.ListItems.Clear
    Set Lvwmessages.Icons = Me.ImageList1
    For Each lm In ledCs
        
        Set Item = Lvwmessages.ListItems.Add(lm.ledgraphno, CONSTG & lm.ledgraphno, lm.ledgraphno)
        Item.SubItems(1) = lm.modelname
        Item.SubItems(2) = IIf(lm.isupload = True, "已发送", "需要发送")
        
        If lm.uploadfrom <> FROMGRAPH And lm.newcontent = "" Then
               Item.SubItems(2) = "无信息发送"
        End If
        
    Next
    Lvwmessages.View = lvwReport
    Set curledcontent = ledCs.Item(Lvwmessages.SelectedItem.Text)
End Sub


'初始一个消息的设置
Sub loadAset()
    Me.txtcontent = curledcontent.newcontent
    Me.lblname = curledcontent.modelname
    initcombo Fontnames, Me.Combofontname, curledcontent.fontname
    initcombo Colors, Me.Combocolor, curledcontent.color
    initcombo Styles, Me.Combostyle, curledcontent.playstyle
    initcombo uploadfroms, Me.ComboUPLOADFROM, curledcontent.uploadfrom
    Me.Imgpreview.Picture = LoadPicture(App.Path & "\temp.bmp")
    Me.Imgold.Picture = LoadPicture(App.Path & "\graph\" & curledcontent.bmpfname)
    If curledcontent.allgmodel <> "" Then
        Set Me.Imgall.Picture = LoadPicture(modelPath & curledcontent.allgmodel)
    End If
    
    If curledcontent.isupload = True Then
        Me.ChkIsupload.value = 0
    Else
        Me.ChkIsupload.value = 1
    End If
    ChkIsupload_Click
    On Error Resume Next
    If curledcontent.modelgrah <> "" Then
       
        Me.OLE2.CreateLink modelPath & curledcontent.modelgrah
    End If
End Sub

Sub getNewvalue()
    Dim needsend As Boolean
    With newledContent
        .color = Colors.Item(Combocolor.Text).value
        .newcontent = Me.txtcontent
        .fontname = Fontnames.Item(Me.Combofontname.Text).value
        .playstyle = Styles.Item(Me.Combostyle.Text).value
        .uploadfrom = uploadfroms.Item(Me.ComboUPLOADFROM.Text).value
        .ledgraphno = curledcontent.ledgraphno
        .allgmodel = curledcontent.allgmodel
        .modelgrah = curledcontent.modelgrah
        .ledno = curledcontent.ledno
        '发送完成=不需要上传 并且 内容没有改变
        needsend = IIf(Me.ChkIsupload = 1, True, False)
        .isupload = (Not needsend) And (curledcontent.oldcontent = newledContent.newcontent)
    End With
    
End Sub

'保存一个消息的设置
Sub saveASet()
    getNewvalue
    If issame(curledcontent, newledContent) Then Exit Sub
    If LedmodelMaintain.pupdateContent(curledcontent, newledContent) Then
        '(value.isupload or (value.newcontent <> oldvalue.newcontent))
        LedmodelMaintain.getledcontent newledContent, curledcontent
        
        Me.Lvwmessages.ListItems(CInt(newledContent.ledgraphno)).SubItems(2) = IIf(curledcontent.isupload = True, "已发送", "需要发送")
        If curledcontent.uploadfrom <> FROMGRAPH And curledcontent.newcontent = "" Then
            Me.Lvwmessages.ListItems(CInt(newledContent.ledgraphno)).SubItems(2) = "无信息发送"
        End If
    End If
    
    
End Sub
Function issame(oldV As ledcontent, newV As ledcontent) As Boolean
    issame = True
    If oldV.color <> newV.color Then issame = False
    If oldV.newcontent <> newV.newcontent Then issame = False
    If oldV.fontname <> newV.fontname Then issame = False
    If oldV.playstyle <> newV.playstyle Then issame = False
    If oldV.uploadfrom <> newV.uploadfrom Then issame = False
    If oldV.isupload <> newV.isupload Then issame = False
    
End Function

Private Sub Lvwmessages_ItemClick(ByVal Item As MSComctlLib.ListItem)
    If Item.key <> CONSTG & curledcontent.ledgraphno Then
        saveASet
        Set curledcontent = ledCs.Item(Lvwmessages.SelectedItem.Text)
        loadAset
        
    End If
End Sub


Private Sub txtcontent_Change()
'    On Error GoTo errh
'    If curledcontent.oldcontent <> Me.txtcontent Then
'        Me.ChkIsupload = 0
'    Else
'        Me.ChkIsupload = 1
'    End If
'    ChkIsupload_Click
'errh:

End Sub