还是颜色选择问题

lxq19851204 2009-09-22 03:45:49

上次开了一个帖没有说清楚,现在我重新开帖说明.

我的程序是:有4个optionButton(index 0,1,2,3)选择按钮,分别对应4种颜色,现在我要的效果是:

选择自定义颜色命令(mnuColor.click)时,可以弹出颜色选择框,可以让用户自由选择4个optionButton按钮的颜色.

言语表达不时很清晰,望抱歉!

...全文

122 19 打赏收藏转发到动态举报

写回复

用AI写文章

19 条回复

切换为时间正序

请发表友善的回复…

发表回复

lxq19851204 2009-09-23

打赏
举报

谢谢大家关注哈!
我会再开帖谢谢大伙的.

tc394879114 2009-09-22

打赏
举报

喔有意思

chinaboyzyq 2009-09-22

打赏
举报



'因为触摸屏，所以建议楼主如下做：

'为了方便用户，要用单双击来完成所有选色任务....

'要考虑好前景色与背景色的关系，不然后选择黑色背景后....



'1、增加一个form2，复制form1上的所有option1到form2,

    然后这个form2将起颜色选择预览及保存作用，双击某个

    option1数组控件，在弹出的颜色对话框上选择某种颜色，

    这种颜色将自动保存在setup.ini里，下次重启就是用户

    选的颜色。

'2、在form2上增加通用对话框控件CommonDialog1

'3、添加Module1

'4、分别复制以下代码到form1,form2和加Module1

'

'--------------form1 code-----------------------------

Option Explicit

 

Private Sub Command1_Click()

   Form2.Show 1

   

End Sub



Private Sub Form_Load()

    If Not FileExist("setup.ini") Then writeSetupIni

    readIniColor Form1

End Sub



Private Sub writeSetupIni()

    SetMyINI "option1", "color", &HD8E9EC, inipath

    SetMyINI "option2", "color", &HD8E9EC, inipath

    SetMyINI "option3", "color", &HD8E9EC, inipath

    SetMyINI "option4", "color", &HD8E9EC, inipath



End Sub



'--------------form2 code------------------------------

Option Explicit



Private Sub Form_Load()

    readIniColor Form2

End Sub



Private Sub Option1_DblClick(Index As Integer)

   On Error Resume Next

   Dim iSelect As Byte

   CommonDialog1.CancelError = True

   

   Select Case Index

       Case 0

          iSelect = 0

       Case 1

          iSelect = 1

       Case 2

          iSelect = 2

       Case 3

          iSelect = 3

    End Select

    CommonDialog1.ShowColor

    If Err.Number = 32755 Then Exit Sub

     

    Option1(iSelect).BackColor = CommonDialog1.Color

    Form1.Option1(iSelect).BackColor = CommonDialog1.Color

    Option1(iSelect).ForeColor = CommonDialog1.Color Xor &HFFFFFF

    Form1.Option1(iSelect).ForeColor = CommonDialog1.Color Xor &HFFFFFF

    

    Select Case Index

       Case 0

          SetMyINI "option1", "color", CommonDialog1.Color, inipath

       Case 1

          SetMyINI "option2", "color", CommonDialog1.Color, inipath

       Case 2

          SetMyINI "option3", "color", CommonDialog1.Color, inipath

       Case 3

          SetMyINI "option4", "color", CommonDialog1.Color, inipath

    End Select



End Sub



'--------------Module1 code----------------------------

Option Explicit

'操作ini文件

Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _

(ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, _

ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long



Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _

(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _

ByVal lplFileName As String) As Long



Private r As Long

Public inipath As String

    

'从setup.ini读信息

Public Function GetMyINI(AppName As String, KeyName As String, FileName As String) As String

   Dim RetStr As String

   RetStr = String(255, Chr(0))

   GetMyINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", _

              RetStr, Len(RetStr), FileName))

End Function



'设置setup.ini

Public Sub SetMyINI(AppName As String, KeyName As String, entry As String, FileName As String)

    r = WritePrivateProfileString(AppName, KeyName, entry, FileName)

    If r <> 1 Then MsgBox "出错啦！"

End Sub



Function FileExist(FileName As String) As Boolean

'=====-----判断文件是否已经存在-----=====

    inipath = App.Path & IIf(Len(App.Path) > 3, "\" & FileName, FileName)

    FileExist = IIf(Dir(inipath) <> "", True, False)

End Function



Sub readIniColor(obj As Object)

    obj.Option1(0).BackColor = GetMyINI("option1", "color", inipath)

    obj.Option1(1).BackColor = GetMyINI("option2", "color", inipath)

    obj.Option1(2).BackColor = GetMyINI("option3", "color", inipath)

    obj.Option1(3).BackColor = GetMyINI("option4", "color", inipath)

    obj.Option1(0).ForeColor = GetMyINI("option1", "color", inipath) Xor &HFFFFFF

    obj.Option1(1).ForeColor = GetMyINI("option2", "color", inipath) Xor &HFFFFFF

    obj.Option1(2).ForeColor = GetMyINI("option3", "color", inipath) Xor &HFFFFFF

    obj.Option1(3).ForeColor = GetMyINI("option4", "color", inipath) Xor &HFFFFFF

   

End Sub

孤独剑_LPZ 2009-09-22

打赏
举报

上面的帖子看来都只是改变optionButton(index 0,1,2,3)选择按钮的背景色，我原以为除了这些，还要动态的改变桌子的颜色，桌子的颜色与同类型的optionButton的颜色一样，点击optionButton，显示与它一样颜色的桌子。
闹了半天楼主仅需要这个功能，也许是我想得复杂了。

guyehanxinlei 2009-09-22

打赏
举报

贝隆 2009-09-22

打赏
举报

optcolor(index)和lblcolor（index）相对应，要设置颜色，点击lblcolor（index）即可。

贝隆 2009-09-22

打赏
举报

我做过触摸屏的颜色选择程序，是这样处理的：

Option Explicit



Private Sub Form_Load()

    Dim intP As Integer

On Error GoTo errSub

    For intP = 0 To 3

        optColor(intP).Value = False

    Next intP

    Exit Sub

errSub:

End Sub



'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

'过程功能：选择自定义颜色

'功能描述：

'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％

Private Sub lblColor_Click(Index As Integer)

On Error GoTo errSub

    With cdlColor

        .Color = lblColor(Index).BackColor

        .DialogTitle = "自定义颜色" & CStr(Index + 1) & "设置"

        .ShowColor

        lblColor(Index).BackColor = .Color

    End With

    Exit Sub

errSub:



End Sub

lxq19851204 2009-09-22

打赏
举报

我们是触摸屏的,很少配置键盘,基本上没有右键功能.

jhone99 2009-09-22

打赏
举报

如果要更灵活的应该在option上右键弹出菜单，点击菜单后选择颜色

Dim intOptIndex As Integer



Private Sub Option1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Button = 2 Then

        intOptIndex = Index

        PopupMenu mnuColor, 0, X, Y

    End If

End Sub



Private Sub mnuColor_Click()

    With CommonDialog1

        .ShowColor

        Option1(intOptIndex).BackColor = .Color

    End With

End Sub

jhone99 2009-09-22

打赏
举报

[Quote=引用 8 楼 lxq19851204 的回复:]
就象4楼这样的效果,不过4楼的颜色选择有几种缺陷.
1,退出后颜色就变为原来的颜色(改=没改).
2,修改过程太麻烦,别人刚好要改其中一个按钮的颜色,我选择好多次.

[/Quote]

1。要有保存机制

先在e盘建文件optioncolor.txt

Private Sub Form_Load()

    Call sub_GetColor

    

End Sub



Private Sub sub_GetColor()

    Dim str As String

    Dim i As Integer

    

    Open "e:\optioncolor.txt" For Input As #1

    

    If LOF(1) > 0 Then

        While Not EOF(1)

            Line Input #1, str

            Option1(i).BackColor = str

            i = i + 1

        Wend

    End If

    

    Close #1

    

End Sub



Private Sub Form_Unload(Cancel As Integer)

    Call sub_SaveColor

    

End Sub



Private Sub sub_SaveColor()

    Dim i As Integer

    

    Open "e:\optioncolor.txt" For Output As #2

    

    For i = 0 To 3

        Print #2, Option1(i).BackColor

    Next i

    

    Close #2



End Sub

2。
这个可以灵活选择哪一个

Private Sub mnuColor_Click()

    Dim intGet As Integer

    

    intGet = InputBox("要选择哪个option1的颜色", "color")

    

    With CommonDialog1

        .ShowColor

        Option1(intGet).BackColor = .Color

    End With



End Sub

SYSSZ 2009-09-22

打赏
举报

Private Sub Command1_Click()

Dim s As String

Dim i As Integer

s = InputBox("请输入数据（0-3）：", "数据输入")

i = Val(s)

MsgBox i

If i > 3 Or i < 0 Then Exit Sub

CommonDialog1.ShowColor



Option1(i).BackColor = CommonDialog1.Color



End Sub

lxq19851204 2009-09-22

打赏
举报

就象4楼这样的效果,不过4楼的颜色选择有几种缺陷.
1,退出后颜色就变为原来的颜色(改=没改).
2,修改过程太麻烦,别人刚好要改其中一个按钮的颜色,我选择好多次.

jhone99 2009-09-22

打赏
举报

6楼代码先提示要选择哪一个，这个要根据你的控件名称修改

jhone99 2009-09-22

打赏
举报

Private Sub mnuColor_Click()

    Dim i As Integer

    

    For i = 0 To 3

        MsgBox "选择option1(" & i & ")的颜色", vbOKOnly, "color"

        

        With CommonDialog1

            .ShowColor

            Option1(i).BackColor = .Color

        End With

    Next i

    

End Sub

SYSSZ 2009-09-22

打赏
举报



Private Sub Command1_Click()

CommonDialog1.ShowColor

CommonDialog2.ShowColor

CommonDialog3.ShowColor

CommonDialog4.ShowColor



Option1(0).BackColor = CommonDialog1.Color

Option1(1).BackColor = CommonDialog2.Color

Option1(2).BackColor = CommonDialog3.Color

Option1(3).BackColor = CommonDialog4.Color





End Sub

SYSSZ 2009-09-22

打赏
举报

Private Sub Command1_Click()

Static i As Integer

CommonDialog1.ShowColor

If i > 3 Then i = 0

Option1(i).BackColor = CommonDialog1.Color

i = i + 1



End Sub