Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Simple Color Palette
Author:
Michel Renaud
E-mail:
Click to e-mail author
Submitted:
10/25/2006
Version:
VB.NET 2003
Compatibility:
VB.NET 2003, VB 2005
Category:
Forms
Views:
19342
Using controls that supports transparent colors runtime color palette.
Declarations:
'none
Code:
Public Class CPalette Inherits System.Windows.Forms.Form #Region " Windows Form Designer generated code " Public Sub New() MyBase.New() 'This call is required by the Windows Form Designer. InitializeComponent() 'Add any initialization after the InitializeComponent() call End Sub 'Form overrides dispose to clean up the component list. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub 'Required by the Windows Form Designer Private components As System.ComponentModel.IContainer 'NOTE: The following procedure is required by the Windows Form Designer 'It can be modified using the Windows Form Designer. 'Do not modify it using the code editor. Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu Friend WithEvents mnuContol1 As System.Windows.Forms.MenuItem Friend WithEvents mnuColorsNew As System.Windows.Forms.MenuItem Friend WithEvents mnuPaint As System.Windows.Forms.MenuItem Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem Friend WithEvents PictureBox1 As System.Windows.Forms.PictureBox Friend WithEvents Label1 As System.Windows.Forms.Label
Private Sub InitializeComponent() Me.MainMenu1 = New System.Windows.Forms.MainMenu Me.mnuContol1 = New System.Windows.Forms.MenuItem Me.mnuColorsNew = New System.Windows.Forms.MenuItem Me.mnuPaint = New System.Windows.Forms.MenuItem Me.MenuItem1 = New System.Windows.Forms.MenuItem Me.PictureBox1 = New System.Windows.Forms.PictureBox Me.Label1 = New System.Windows.Forms.Label Me.SuspendLayout() ' 'MainMenu1 ' Me.MainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuContol1}) ' 'mnuContol1 ' Me.mnuContol1.Index = 0 Me.mnuContol1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuColorsNew, Me.mnuPaint, Me.MenuItem1}) Me.mnuContol1.Text = "Colors Controls" ' 'mnuColorsNew ' Me.mnuColorsNew.Index = 0 Me.mnuColorsNew.Text = "New Colors" ' 'mnuPaint ' Me.mnuPaint.Index = 1 Me.mnuPaint.Text = "Paint" ' 'MenuItem1 ' Me.MenuItem1.Index = 2 Me.MenuItem1.Text = "" ' 'PictureBox1 ' Me.PictureBox1.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D Me.PictureBox1.Location = New System.Drawing.Point(288, 32) Me.PictureBox1.Name = "PictureBox1" Me.PictureBox1.Size = New System.Drawing.Size(32, 232) Me.PictureBox1.TabIndex = 0 Me.PictureBox1.TabStop = False ' 'Label1 ' Me.Label1.Location = New System.Drawing.Point(272, 8) Me.Label1.Name = "Label1" Me.Label1.Size = New System.Drawing.Size(56, 24) Me.Label1.TabIndex = 1 Me.Label1.Text = "Selected" ' 'CPalette ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(328, 266) Me.Controls.Add(Me.Label1) Me.Controls.Add(Me.PictureBox1) Me.Menu = Me.MainMenu1 Me.Name = "CPalette" Me.Text = "CPalette" Me.ResumeLayout(False) End Sub #End Region Dim b As Button Private Sub CPalette_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim col, row As Integer Dim spacing As Integer = 5 For col = 1 To 10 For row = 1 To 10 b = New Button With b .Tag = col * row .BackColor = RandomQBColor() .Height = 20 : .Width = 20 .Left = row * (.Width + spacing) b.Top = col * (b.Height + spacing) End With AddHandler b.Click, AddressOf btn_click AddHandler b.Click, AddressOf Setcolor Me.Controls.Add(b) Next Next Me.Height = 350 Me.Text = "Random Color Selector" ' Double buffer. Me.SetStyle( _ ControlStyles.AllPaintingInWmPaint Or _ ControlStyles.UserPaint Or _ ControlStyles.DoubleBuffer, _ True) Me.UpdateStyles() End Sub Private Sub btn_click(ByVal sender As Object, ByVal e As System.EventArgs) Dim o As Color = CType(sender, Button).BackColor Dim c As String Dim ColorNumR, ColorNumAlpha, ColorNumBlue, ColorNumG As String If MessageBox.Show(Color.FromName(o.Name).ToString & vbNewLine & Color.FromName(o.ToString).ToString) = DialogResult.OK Then Dim strColor As String = (o.ToString) Dim m As String = strColor.ToCharArray Me.Text = "" For Each c In m If Char.IsDigit(c) = True Then ColorNumBlue &= c ColorNumR &= c ColorNumAlpha &= c ColorNumG &= c End If Next End If Dim rnd As New Random Dim r As Integer = CInt(rnd.Next(1, 255)) Dim g As Integer = CInt(rnd.Next(1, 255)) Dim b As Integer = CInt(rnd.Next(1, 255)) Dim Alpha As Integer = CInt(rnd.Next(1, 255)) End Sub Private Function RandomQBColor() As Color Static gen As New Random Dim b As Integer = CInt(gen.Next(1, 255)) Dim g As Integer = CInt(gen.Next(1, 255)) Dim r As Integer = CInt(gen.Next(1, 255)) Dim Alpha As Integer = CInt(gen.Next(1, 255)) Return Color.FromArgb(Alpha, r, g, b) End Function Private Sub CPalette_Paint() Dim col, row As Integer Dim brsh As Brush Dim g As Graphics Dim f As New Form f.Height = 450 f.Width = 420 g = f.CreateGraphics f.Show() For col = 1 To 400 Step 25 For row = 1 To 400 Step 25 Dim r As Rectangle = New Rectangle(col, row, 20, 20) Dim rF As New RectangleF(col, row, 18, 18) g.DrawRectangle(New Pen(Color.Black, 2), r) g.FillRectangle(Brushes.Cornsilk, rF) Next Next End Sub Public Sub Setcolor(ByVal Sender As System.Object, ByVal e As EventArgs) 'Send the color shown to the object 'only as few controls can support transparent back grounds Me.PictureBox1.BackColor = CType(Sender, Button).BackColor Dim f As New Form Dim p As New PictureBox Dim l As New Label Dim o As Color = CType(Sender, Button).BackColor With l .AutoSize = True .Location = (New Point(60, 120)) .Text = o.ToString .BackColor = Color.Yellow End With With p .Dock = DockStyle.Fill .Controls.Add(l) .BackColor = CType(Sender, Button).BackColor End With With f .Show() .Text = Color.FromName(o.Name).ToString .Controls.Add(p) End With ' Me.SetStyle(ControlStyles.ResizeRedraw, True) ' Me.SetStyle(ControlStyles.DoubleBuffer, True) ' Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True) End Sub Private Sub mnuColorsNew_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuColorsNew.Click Dim f As New CPalette f.Show() End Sub Private Sub mnuPaint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPaint.Click CPalette_Paint() End Sub End Class
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement