vb:Cg色彩精灵第三部分: 部分重点代码分析
发布时间:2020-12-17 07:35:38 所属栏目:百科 来源:网络整理
导读:翻出来以前写的一篇文章:Cg色彩精灵,这是用vb6来写的 搞图像创作都有那么个难题,就是在上色时候老是配不好颜色,不是显得红了就是偏蓝,不得不参考别人的配色或者翻看颜色参考书,为什么不尝试自己做一个保存颜色的程序,把觉得好的颜色存储起来,方便在
翻出来以前写的一篇文章:Cg色彩精灵,这是用vb6来写的
第三部分:部分重点代码分析 1、模块 Module1 Public ColorId As Long ‘公有变量,FormMain传递给FormAE的颜色编号,仅在修改颜色时有用 Public AddOrEdit As Boolean ‘公有变量,决定了FormAE窗体是增加新颜色还是修改原有颜色 Sub Main() '这里是链接到数据库的语句,请参看源代码 FormMain.Show End Sub Function GetR(colorvalue As Long) As Integer '此函数取得红色(R)基色值 GetR = colorvalue And &HFF 'colorvalue为传递的颜色值 End Function Function GetG(colorvalue As Long) As Integer '此函数取得绿色(R)基色值 GetG = (colorvalue And CLng("&HFF00")) / 256 End Function Function GetB(colorvalue As Long) As Integer '此函数取得蓝色(R)基色值 GetB = (colorvalue And &HFF0000) / 65536 End Function 2、模块 Module2 ‘Api函数声明省略,请参看第二部分。 Public Function GetColor() As Long '获得屏幕某点颜色值 Dim Dc As Long Dim rret As Long Dim MousePos As POINTAPI Dc = GetDC(0) '取得整个屏幕的Dc rret = GetCursorPos(MousePos) '获取鼠标当前位置坐标 GetColor = GetPixel(Dc,MousePos.X,MousePos.Y) '获取鼠标当前像素点的颜色值 rret = ReleaseDC(0,Dc) '释放屏幕Dc End Function
Private Sub CmdAddType_Click() '增加颜色类型 StrSql = "insert into colortypetable(colortype) values('" & ColorType & "')" Rs.Open StrSql 'ColorType是使用者输入的颜色类型名称 ComboColor.AddItem ColorType ‘这里用到了AddItem方法 End Sub Private Sub CmdDelType_Click() ‘删除颜色类型,确保默认的类型不被删除 If ComboColor.Text = "默认的类型" Then MsgBox "默认的类型不能删除" Exit Sub End If If MsgBox("删除类型,该类型下的颜色将会被置于默认的类型下" & "确定继续吗?",vbYesNo) = vbYes Then StrSql = "delete * from colortypetable where colortype='" & ComboColor.Text & "'" Rs.Open StrSql StrSql = "update colornametable set colortype='默认的类型' where colortype='" & ComboColor.Text & "'" Rs.Open StrSql ComboColor.RemoveItem (ComboColor.ListIndex) ComboColor.Text = "默认的类型" Else Exit Sub End If End Sub Private Sub CmdDel_Click() '删除颜色名称 StrSql = "delete * from colornametable where index=" & _ ListColor.ItemData (ListColor.ListIndex) Rs.Open StrSql '这里删除在ListBox中选中的颜色名称 End Sub Private Sub CmdEdit_Click() '编辑颜色 ColorId = ListColor.ItemData(ListColor.ListIndex) AddOrEdit = False FormAE.Show 1 End Sub Private Sub ComboColor_Click() ListColor.Clear StrSql = "select * from ColorNameTable where colortype='" & ComboColor.Text & "'" Rs.Open StrSql If Not Rs.EOF Then Do While Not Rs.EOF ListColor.AddItem Rs("colorname") ListColor.ItemData(ListColor.ListCount - 1) = Rs("index") '记录表中对应的编号 Rs.MoveNext Loop Rs.Close Else Rs.Close End If End Sub Private Sub Form_Load() StrSql = "select * from ColorTypeTable" Rs.Open StrSql If Not Rs.EOF Then Do While Not Rs.EOF ComboColor.AddItem Rs("colortype") Rs.MoveNext Loop Rs.Close ComboColor.Text = ComboColor.List(0) Else Rs.Close End If End Sub Private Sub ListColor_Click() StrSql = "select * from ColorNameTable where index=" & ListColor.ItemData (ListColor.ListIndex) Rs.Open StrSql '这里不用判断是否为EOF TextColorName.Text = Rs("colorname") PicColor.BackColor = CLng(Rs("colorvalue")) TextRgb10.Text = GetR(CLng(Rs("colorvalue"))) & "," & GetG(CLng(Rs("colorvalue"))) & "," & GetB(CLng(Rs("colorvalue"))) Dim Value16() As String Value16 = Split(TextRgb10.Text,",") ‘这里用到了Split()函数 TextRgb16.Text = "#" & Right("00" & Hex(Value16(0)),2) & Right("00" & Hex(Value16(1)),2) & Right("00" & Hex(Value16(2)),2) Rs.Close End Sub
Sub SaveColor() StrSql = "insert into colornametable(colorname,colortype,colorvalue) values('" & Trim(TextColorName) & "','" & ComboColor.Text & "','" & CStr(PicShow.BackColor) & "')" Rs.Open StrSql End Sub Sub EditColor() StrSql = "update colornametable set colorname='" & Trim(TextColorName.Text) & "',colortype='" & ComboColor.Text & "',colorvalue='" & CStr(PicShow.BackColor) & "' where index=" & ColorId Rs.Open StrSql End Sub Private Sub CmdOk_Click() If AddOrEdit = True Then Call SaveColor '保存新的颜色 Else Call EditColor '保存修改后的颜色 End If Unload Me End Sub Private Sub Form_Load() StrSql = "select * from ColorTypeTable" Rs.Open StrSql Do While Not Rs.EOF '不用判断是否为空,因为ColorTypeTable中始终有一项,即默认的类型 ComboColor.AddItem Rs("colortype") Rs.MoveNext Loop Rs.Close ComboColor.Text = ComboColor.List(0) If AddOrEdit = True Then Me.Caption = "增加新颜色" PicR.BackColor = RGB(255,0) PicG.BackColor = RGB(0,255,0) PicB.BackColor = RGB(0,255) Else '修改颜色 Me.Caption = "修改颜色" StrSql = "select * from colornametable where index=" & ColorId Rs.Open StrSql If Rs.EOF Then MsgBox "打开数据库出错" Rs.Close Exit Sub Else ‘以下为获取数据,并计算RGB分量 ComboColor.Text = Rs("colortype") TextColorName = Rs("colorname") HScrollColor(0).Value = GetR(Rs("colorvalue")) TextValue(0) = CStr(HScrollColor(0)) HScrollColor(1).Value = GetG(Rs("colorvalue")) TextValue(1) = CStr(HScrollColor(1)) HScrollColor(2).Value = GetB(Rs("colorvalue")) TextValue(2) = CStr(HScrollColor(2)) PicR.BackColor = RGB(GetR(Rs("colorvalue")),0) PicG.BackColor = RGB(0,GetG(Rs("colorvalue")),0) PicB.BackColor = RGB(0,GetB(Rs("colorvalue"))) Rs.Close End If End If End Sub Private Sub HScrollColor_Change(Index As Integer) If Option1(0).Value = True Then TextValue(Index).Text = HScrollColor(Index).Value Else TextValue(Index).Text = Hex(HScrollColor(Index).Value) End If PicShow.BackColor = RGB(HScrollColor(0).Value,HScrollColor(1).Value,HScrollColor(2).Value) End Sub 5、窗体FormPick Sub SaveColor() '此函数保存颜色 StrSql = "insert into colornametable(colorname,'" & CStr(PicPick.BackColor) & "')" Rs.Open StrSql End Sub Private Sub CmdOk_Click() Call SaveColor '调用SaveColor函数来保存颜色 Unload Me End Sub Private Sub CmdPick_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single) Dim gret As Long If Button = vbLeftButton Then gret = GetCapture() '开始接受鼠标输入 Me.MousePointer = 2 '设置鼠标指针为十字星模式 End If End Sub Private Sub CmdPick_MouseMove(Button As Integer,Y As Single) Dim PickColors As Long If Button = vbLeftButton Then PickColors = GetColor() '调用Module2中的GetColor()来获取某点颜色 PicPick.BackColor = PickColors End If End Sub Private Sub CmdPick_MouseUp(Button As Integer,Y As Single) Dim rret As Long rret = ReleaseCapture() '释放鼠标捕获 Me.MousePointer = 0 End Sub Private Sub Form_Load() ‘取色窗体载入时 Dim WindowPos As Long WindowPos = SetWindowPos(Me.hwnd,HWND_TOPMOST,100,Me.Width / 15,Me.Height / 15,SWP_NOSIZE) ‘设置窗体为任何窗体的顶部 End Sub (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |