Abundant Technologies - IT Consulting Experts

 Source Code Library

 Code Details

     
Option Explicit Private ROffset As Integer Private GOffset As Integer Private BOffset As Integer 'Event Declarations: Event AfterUpdate() 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtBack,txtBack,-1,BackColor Public Property Get PageBackColor() As OLE_COLOR PageBackColor = txtBack.BackColor End Property Public Property Let PageBackColor(ByVal New_PageBackColor As OLE_COLOR) txtBack.BackColor() = New_PageBackColor PropertyChanged "PageBackColor" End Property 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES! 'MappingInfo=txtFore,txtFore,-1,BackColor Public Property Get PageForeColor() As OLE_COLOR PageForeColor = txtFore.BackColor End Property Public Property Let PageForeColor(ByVal New_PageForeColor As OLE_COLOR) txtFore.BackColor() = New_PageForeColor PropertyChanged "PageForeColor" End Property Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim tmpX As Single Dim tmpY As Single tmpX = X / 35 tmpY = Y / 30 ' Text1 = tmpX ' Text2 = tmpY If tmpX >= 1 And tmpX <= 8.86 Then If tmpY >= 1 And tmpY <= 8.86 Then If tmpX - Fix(tmpX) <= 0.86 Then If tmpY - Fix(tmpY) <= 0.86 Then Select Case Shift Case 0 ROffset = 0 GOffset = 0 BOffset = 0 SetColor Fix(tmpX), Fix(tmpY), Button Case 1 ROffset = ROffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button Case 2 GOffset = GOffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button Case 3 ROffset = ROffset + 10 GOffset = GOffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button Case 4 BOffset = BOffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button Case 5 ROffset = ROffset + 10 BOffset = BOffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button Case 6 GOffset = GOffset + 10 BOffset = BOffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button Case 7 ROffset = ROffset + 10 GOffset = GOffset + 10 BOffset = BOffset + 10 SetColor Fix(tmpX), Fix(tmpY), Button End Select End If End If End If End If End Sub Private Sub UserControl_Paint() Dim Color(1 To 64) As OLE_COLOR Dim iRed As Variant Dim iGreen As Variant Dim iBlue As Variant Dim row As Integer Dim col As Integer Dim X1 As Integer Dim X2 As Integer Dim Y1 As Integer Dim Y2 As Integer Cls LoadColors iRed, iGreen, iBlue Line (10, 10)-(UserControl.ScaleWidth - 10, UserControl.ScaleHeight - 10), , B For row = 1 To 8 For col = 1 To 8 X1 = (col * 35) X2 = X1 + 30 Y1 = (row * 30) Y2 = Y1 + 25 Line (X1 - 1, Y1 - 1)-(X2, Y2), vbBlack, B Line (X1, Y1)-(X2 + 1, Y2 + 1), vbWhite, B Line (X1, Y1)-(X2, Y2), RGB(iRed((col - 1) + ((row - 1) * 8)), iGreen((col - 1) + ((row - 1) * 8)), iBlue((col - 1) + ((row - 1) * 8))), BF Next Next End Sub 'Load property values from storage Private Sub UserControl_ReadProperties(PropBag As PropertyBag) txtBack.BackColor = PropBag.ReadProperty("PageBackColor", &HFFFFFF) txtFore.BackColor = PropBag.ReadProperty("PageForeColor", &H0&) End Sub Private Sub UserControl_Resize() UserControl.Height = 6750 UserControl.Width = 7700 End Sub 'Write property values to storage Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("PageBackColor", txtBack.BackColor, &HFFFFFF) Call PropBag.WriteProperty("PageForeColor", txtFore.BackColor, &H0&) End Sub Private Sub LoadColors(r As Variant, g As Variant, B As Variant) r = Array(255, 255, 128, 0, 128, 0, 255, 255, 255, 255, 128, 0, 0, 0, 128, 255, 128, 255, 0, 0, 0, 128, 128, 255, 128, 255, 0, 0, 0, 0, 128, 128, 64, 128, 0, 0, 0, 0, 64, 64, 0, 128, 128, 128, 64, 192, 64, 255, 255, 239, 223, 207, 191, 175, 159, 143, 127, 111, 95, 79, 63, 47, 31, 15) g = Array(128, 255, 255, 255, 255, 128, 128, 128, 0, 255, 255, 255, 255, 128, 128, 0, 64, 128, 255, 128, 64, 128, 0, 0, 0, 128, 128, 128, 0, 0, 0, 0, 0, 64, 64, 64, 0, 0, 0, 0, 0, 128, 128, 128, 128, 192, 0, 255, 255, 239, 223, 207, 191, 175, 159, 143, 127, 111, 95, 79, 63, 47, 31, 15) B = Array(128, 128, 128, 128, 255, 255, 192, 255, 0, 0, 0, 64, 255, 192, 192, 255, 64, 64, 0, 128, 128, 255, 64, 128, 0, 0, 0, 64, 255, 160, 128, 255, 0, 0, 0, 64, 128, 64, 64, 128, 0, 0, 64, 128, 128, 192, 64, 255, 255, 239, 223, 207, 191, 175, 159, 143, 127, 111, 95, 79, 63, 47, 31, 15) End Sub Private Sub SetColor(ByVal i As Integer, ByVal j As Integer, ByVal B As Integer) Dim iRed As Variant Dim iGreen As Variant Dim iBlue As Variant Dim NewColor As OLE_COLOR LoadColors iRed, iGreen, iBlue NewColor = RGB(iRed((i - 1) + ((j - 1) * 8)) + ROffset, iGreen((i - 1) + ((j - 1) * 8)) + GOffset, iBlue((i - 1) + ((j - 1) * 8)) + BOffset) If (optFore And B = 1) Or (optBack And B = 2) Then If txtFore.BackColor <> NewColor Then txtFore.BackColor = NewColor RaiseEvent AfterUpdate End If Else If txtBack.BackColor <> NewColor Then txtBack.BackColor = NewColor RaiseEvent AfterUpdate End If End If End Sub

Mail To: info@3pc.com