setnews.frm

OA编程 源代码

      Left            =   1080
      Top             =   4440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog DlgSetFont 
      Left            =   480
      Top             =   4440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label LabRight 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "设置成功！"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF00FF&
      Height          =   315
      Left            =   960
      TabIndex        =   20
      Top             =   4530
      Visible         =   0   'False
      Width           =   1650
   End
   Begin VB.Label LabPreNews 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label1"
      ForeColor       =   &H80000008&
      Height          =   735
      Left            =   120
      TabIndex        =   19
      Top             =   3480
      Width           =   4335
   End
   Begin VB.Label LabPreTitle 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label1"
      ForeColor       =   &H80000008&
      Height          =   735
      Left            =   120
      TabIndex        =   9
      Top             =   2760
      Width           =   4335
   End
End
Attribute VB_Name = "FrmSetNews"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub CmdSelectNColor_Click()
    On Error GoTo CancelClick
    
    DlgSelectColor.DialogTitle = "选择新闻颜色"
    If Len(TxtNColor.Text) = 0 Then
        DlgSelectColor.Color = Val("&H00FFFFFF&")
    Else
        DlgSelectColor.Color = Val(Trim(TxtNColor.Text))
    End If
    DlgSelectColor.Flags = cdlCCPreventFullOpen + cdlCCRGBInit
    
    DlgSelectColor.ShowColor
    
    TxtNColor.Text = TenToSix(DlgSelectColor.Color)
    TxtNColor.ForeColor = DlgSelectColor.Color
    
    LabPreNews.ForeColor = Val(Trim(TxtNColor.Text))
    
    Exit Sub
CancelClick:
End Sub

Private Sub CmdSelectSColor_Click()
    On Error GoTo CancelClick
    
    DlgSelectColor.DialogTitle = "选择标题颜色"
    If Len(TxtColor.Text) = 0 Then
        DlgSelectColor.Color = Val("&H00FFFFFF&")
    Else
        DlgSelectColor.Color = Val(Trim(TxtColor.Text))
    End If
    DlgSelectColor.Flags = cdlCCPreventFullOpen + cdlCCRGBInit
    
    DlgSelectColor.ShowColor
    
    TxtColor.Text = TenToSix(DlgSelectColor.Color)
    TxtColor.ForeColor = DlgSelectColor.Color
    
    LabPreTitle.ForeColor = Val(Trim(TxtColor.Text))
    
    Exit Sub
CancelClick:
End Sub

Private Sub CmdSetFont_Click()
    On Error GoTo CancelClick
    
    DlgSetFont.DialogTitle = "设置标题字体及字体大小"
    If Len(TxtFont.Text) = 0 Then
        DlgSetFont.FontName = "宋体"
    Else
        DlgSetFont.FontName = Trim(TxtFont.Text)
    End If
    If Val(Trim(TxtFontSize.Text)) = 0 Then
        DlgSetFont.FontSize = 8
    Else
        DlgSetFont.FontSize = Val(Trim(TxtFontSize.Text))
    End If
    DlgSetFont.Flags = cdlCFBoth
    
    DlgSetFont.ShowFont
    
    TxtFont.Text = DlgSetFont.FontName
    TxtFontSize.Text = DlgSetFont.FontSize
    
    LabPreTitle.Font = Trim(TxtFont.Text)
    LabPreTitle.FontSize = Val(Trim(TxtFontSize.Text))
    
    Exit Sub
CancelClick:
End Sub

Private Sub CmdSetNFont_Click()
    On Error GoTo CancelClick
    
    DlgSetFont.DialogTitle = "设置新闻字体及字体大小"
    If Len(TxtNFont.Text) = 0 Then
        DlgSetFont.FontName = "宋体"
    Else
        DlgSetFont.FontName = Trim(TxtNFont.Text)
    End If
    If Val(Trim(TxtNFontSize.Text)) = 0 Then
        DlgSetFont.FontSize = 8
    Else
        DlgSetFont.FontSize = Val(Trim(TxtNFontSize.Text))
    End If
    DlgSetFont.Flags = cdlCFBoth
    
    DlgSetFont.ShowFont
    
    TxtNFont.Text = DlgSetFont.FontName
    TxtNFontSize.Text = DlgSetFont.FontSize
    
    LabPreNews.Font = Trim(TxtNFont.Text)
    LabPreNews.FontSize = Val(Trim(TxtNFontSize.Text))
    
    Exit Sub
CancelClick:
End Sub

Private Sub Form_Load()
    On Error GoTo DatabaseError
    
    FrmSetNews.ScaleHeight = FrmSetNews.Height
    FrmSetNews.ScaleWidth = FrmSetNews.Width
    FrmSetNews.Top = (Screen.Height - FrmSetNews.Height - TitleHeight) / 2
    FrmSetNews.Left = (Screen.Width - FrmSetNews.Width) / 2
    
    sql = "SELECT * FROM NewsStyle"
    Set rst = gclsDatabase.RDOSelect(sql)
    
    If rst.RowCount > 0 Then
        TxtTitle.Text = Trim(rst!Title)
        TxtNFont.Text = Trim(rst!FontName)
        TxtNFontSize.Text = Trim(str(rst!FontSize))
        TxtNColor.Text = Trim(rst!FontColor)
        TxtFont.Text = Trim(rst!tFontName)
        TxtFontSize.Text = Trim(str(rst!tFontSize))
        TxtColor.Text = Trim(rst!tFontColor)
        
        LabPreTitle.Caption = Trim(TxtTitle.Text)
        LabPreTitle.Font = Trim(TxtFont.Text)
        LabPreTitle.FontSize = Val(Trim(TxtFontSize.Text))
        LabPreTitle.ForeColor = Val(Trim(TxtColor.Text))
    
        LabPreNews.Caption = "新闻索引"
        LabPreNews.Font = Trim(TxtNFont.Text)
        LabPreNews.FontSize = Val(Trim(TxtNFontSize.Text))
        LabPreNews.ForeColor = Val(Trim(TxtNColor.Text))
    Else
        TxtTitle.Text = "新闻公告板"
        TxtFont.Text = "宋体"
        TxtFontSize.Text = "18"
        TxtColor.Text = "&H00000000&"
        TxtNFont.Text = "宋体"
        TxtNFontSize.Text = "8"
        TxtNColor.Text = "&H00000000&"
        
        LabPreTitle.Caption = Trim(TxtTitle.Text)
        LabPreTitle.Font = Trim(TxtFont.Text)
        LabPreTitle.FontSize = Val(Trim(TxtFontSize.Text))
        LabPreTitle.ForeColor = Val(Trim(TxtColor.Text))
    
        LabPreNews.Caption = "新闻索引"
        LabPreNews.Font = Trim(TxtNFont.Text)
        LabPreNews.FontSize = Val(Trim(TxtNFontSize.Text))
        LabPreNews.ForeColor = Val(Trim(TxtNColor.Text))
    End If
    
    rst.Close
        '换皮肤
    Call LoadSkin(Me)
    Exit Sub
DatabaseError:
    Call ManageQuit
End Sub

Private Sub CmdSetMainPage_Click()
    On Error GoTo DatabaseError

    sql = "DELETE FROM NewsStyle"
    Return_Var = gclsDatabase.RDODelete(sql)
    
    sql = "INSERT INTO NewsStyle VALUES("
    sql = sql & "'" & Trim(TxtNFont.Text) & "',"
    sql = sql & Trim(TxtNFontSize.Text) & ","
    sql = sql & "'" & Trim(TxtNColor.Text) & "',"
    sql = sql & "'" & Trim(TxtFont.Text) & "',"
    sql = sql & Trim(TxtFontSize.Text) & ","
    sql = sql & "'" & Trim(TxtColor.Text) & "',"
    sql = sql & "'" & Trim(TxtTitle.Text) & "')"
    Return_Var = gclsDatabase.RDOInsert(sql)
    If Return_Var = 0 Then GoTo DatabaseError

    'MsgBox "新闻公告板风格设置成功！", vbInformation, "系统信息"
    LabRight.Visible = True
    TimeInfo.Enabled = True
    
    Exit Sub
DatabaseError:
    Call ManageQuit
End Sub

Private Sub TimeInfo_Timer()
    LabRight.Visible = False
    TimeInfo.Enabled = False
End Sub

Private Sub TxtTitle_Change()
    LabPreTitle.Caption = Trim(TxtTitle.Text)
End Sub