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

📄 frmmain.frm

📁 此源码是一种RGB颜色的调配
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      Top             =   0
      Width           =   7305
   End
   Begin VB.Menu mnuFile 
      Caption         =   "Archivo"
      Begin VB.Menu mnuFileExit 
         Caption         =   "Salir"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "Help"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "Acerca de ..."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private mFondoRojo             As Integer
Private mFondoVerde            As Integer
Private mFondoAzul             As Integer
Private mTextoRojo             As Integer
Private mTextoVerde            As Integer
Private mTextoAzul             As Integer
Private mValorRojo             As Integer
Private mValorVerde            As Integer
Private mValorAzul             As Integer
Private mValorColorTexto       As Long
Private mValorColorFondo       As Long
 
 
 
 
 
 
 

Private Sub cmdCopiaFondo_Click()
    On Error GoTo errorHandler

    Clipboard.Clear
    If optLong.Value = True Then
        Clipboard.SetText lblValorFondo.Caption
    Else
        Clipboard.SetText "&H" & lblValorFondo.Caption
    End If

    Exit Sub
errorHandler:
    MsgBox "Error en frmMain.cmdCopiaFondo_Click ; " & Err.Number & vbCrLf & _
           Err.Description
End Sub

Private Sub cmdCopiaTexto_Click()
    On Error GoTo errorHandler

    Clipboard.Clear
    If optLong.Value = True Then
        Clipboard.SetText lblValorTexto.Caption
    Else
        Clipboard.SetText "&H" & lblValorTexto.Caption
    End If

    Exit Sub
errorHandler:
    MsgBox "Error en frmMain.cmdCopiaTexto_Click ; " & Err.Number & vbCrLf & _
           Err.Description
End Sub

Private Sub cmdSalir_Click()
    Unload Me
End Sub



Private Sub Form_Load()
    On Error GoTo errorHandler
    Me.ScaleMode = vbPixels
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2

    hscrRojo.Min = 0
    hscrRojo.Max = 255
    
    hscrVerde.Min = 0
    hscrVerde.Max = 255
    
    hscrAzul.Min = 0
    hscrAzul.Max = 255
    
    hscrRojo.SmallChange = 1
    hscrRojo.LargeChange = 20
    
    hscrVerde.SmallChange = 1
    hscrVerde.LargeChange = 20
    
    hscrAzul.SmallChange = 1
    hscrAzul.LargeChange = 20
    
    txtRojo.BackColor = RGB(hscrRojo.Value, 0, 0)
    txtVerde.BackColor = RGB(0, hscrVerde.Value, 0)
    txtAzul.BackColor = RGB(0, 0, hscrAzul.Value)
    
    lblRojo.Caption = hscrRojo.Value
    lblVerde.Caption = hscrVerde.Value
    lblAzul.Caption = hscrAzul.Value
    
    mValorRojo = hscrRojo.Value
    mValorVerde = hscrVerde.Value
    mValorAzul = hscrAzul.Value
    mValorColorTexto = RGB(mValorRojo, mValorVerde, mValorAzul)
    mValorColorFondo = RGB(255, 255, 255)
    mFondoRojo = 255
    mFondoVerde = 255
    mFondoAzul = 255
    mTextoRojo = 0
    mTextoRojo = 0
    mTextoRojo = 0
'    mColorFondo = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
'    mColorTexto = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
    optLong.Value = True
    lblValorTexto.Caption = mValorColorTexto
    lblValorFondo.Caption = mValorColorFondo
    optTexto.Value = True
    

    Exit Sub
errorHandler:
    MsgBox "Error en frmMain.Form_Load ; " & Err.Number & vbCrLf & _
           Err.Description
End Sub

Private Sub hscrAzul_Change()
    On Error GoTo errorHandler

    mValorAzul = hscrAzul.Value

    lblAzul.Caption = hscrAzul.Value
    txtAzul.BackColor = RGB(0, 0, hscrAzul.Value)

    If optTexto = True Then
        mTextoAzul = hscrAzul.Value
        lblTexto.ForeColor = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
        If optLong = True Then
            lblValorTexto.Caption = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
        Else
            lblValorTexto.Caption = Hex(RGB(mTextoRojo, mTextoVerde, mTextoAzul))
        End If
    Else
        mFondoAzul = hscrAzul.Value
        lblTexto.BackColor = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
        If optLong = True Then
            lblValorFondo.Caption = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
        Else
            lblValorFondo.Caption = Hex(RGB(mFondoRojo, mFondoVerde, mFondoAzul))
        End If
    End If

    Exit Sub
errorHandler:
    MsgBox "Error en frmMain.hscrAzul_Change ; " & Err.Number & vbCrLf & _
           Err.Description
End Sub

Private Sub hscrRojo_Change()
    On Error GoTo errorHandler

    mValorRojo = hscrRojo.Value

    lblRojo.Caption = hscrRojo.Value
    txtRojo.BackColor = RGB(hscrRojo.Value, 0, 0)
   
    If optTexto = True Then
        mTextoRojo = hscrRojo.Value
        lblTexto.ForeColor = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
        If optLong.Value = True Then
            lblValorTexto.Caption = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
        Else
            lblValorTexto.Caption = Hex(RGB(mTextoRojo, mTextoVerde, mTextoAzul))
        End If
    Else
        mFondoRojo = hscrRojo.Value
        lblTexto.BackColor = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
        If optLong.Value = True Then
            lblValorFondo.Caption = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
        Else
            lblValorFondo.Caption = Hex(RGB(mFondoRojo, mFondoVerde, mFondoAzul))
        End If
    End If

    Exit Sub
errorHandler:
    MsgBox "Error en frmMain.hscrRojo_Change ; " & Err.Number & vbCrLf & _
           Err.Description
End Sub

Private Sub hscrVerde_Change()
    On Error GoTo errorHandler

    mValorVerde = hscrVerde.Value

    lblVerde.Caption = hscrVerde.Value
    txtVerde.BackColor = RGB(0, hscrVerde.Value, 0)
   
    If optTexto = True Then
        mTextoVerde = hscrVerde.Value
        lblTexto.ForeColor = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
        If optLong.Value = True Then
            lblValorTexto.Caption = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
        Else
            lblValorTexto.Caption = Hex(RGB(mTextoRojo, mTextoVerde, mTextoAzul))
        End If
    Else
        mFondoVerde = hscrVerde.Value
        lblTexto.BackColor = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
        If optLong.Value = True Then
            lblValorFondo.Caption = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
        Else
            lblValorFondo.Caption = Hex(RGB(mFondoRojo, mFondoVerde, mFondoAzul))
        End If
    End If


    Exit Sub
errorHandler:
    MsgBox "Error en frmMain.hscrVerde_Change ; " & Err.Number & vbCrLf & _
           Err.Description
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal
End Sub

Private Sub optFondo_Click()
    hscrRojo.Value = mFondoRojo
    hscrVerde.Value = mFondoVerde
    hscrAzul.Value = mFondoAzul
End Sub

Private Sub optHex_Click()
    lblValorTexto.Caption = Hex(RGB(mTextoRojo, mTextoVerde, mTextoAzul))
    lblValorFondo.Caption = Hex(RGB(mFondoRojo, mFondoVerde, mFondoAzul))
End Sub

Private Sub optLong_Click()
    lblValorTexto.Caption = RGB(mTextoRojo, mTextoVerde, mTextoAzul)
    lblValorFondo.Caption = RGB(mFondoRojo, mFondoVerde, mFondoAzul)
End Sub

Private Sub optTexto_Click()
    hscrRojo.Value = mTextoRojo
    hscrVerde.Value = mTextoVerde
    hscrAzul.Value = mTextoAzul
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -