Re: Gradient Generator BMP Tool Improved

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6660
ClientLeft = 165
ClientTop = 735
ClientWidth = 7980
LinkTopic = "Form1"
ScaleHeight = 6660
ScaleWidth = 7980
StartUpPosition = 3 'Windows Default
Begin MSComCtl2.UpDown UpDown7
Height = 405
Left = 1576
TabIndex = 31
Top = 5640
Width = 240
_ExtentX = 423
_ExtentY = 714
_Version = 393216
Value = 1
BuddyControl = "Increment"
BuddyDispid = 196609
OrigLeft = 1440
OrigTop = 6120
OrigRight = 1680
OrigBottom = 6495
Max = 31
Min = 1
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox Increment
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 1200
TabIndex = 30
Text = "1"
Top = 5640
Width = 375
End
Begin MSComCtl2.UpDown UpDown6
Height = 375
Left = 976
TabIndex = 28
Top = 1080
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
BuddyControl = "Red2"
BuddyDispid = 196625
OrigLeft = 1200
OrigTop = 1080
OrigRight = 1440
OrigBottom = 1455
Max = 255
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown5
Height = 375
Left = 976
TabIndex = 27
Top = 480
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
BuddyControl = "Red1"
BuddyDispid = 196628
OrigLeft = 1200
OrigTop = 480
OrigRight = 1440
OrigBottom = 855
Max = 255
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown4
Height = 375
Left = 2536
TabIndex = 26
Top = 1080
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
BuddyControl = "Green2"
BuddyDispid = 196624
OrigLeft = 2760
OrigTop = 1080
OrigRight = 3000
OrigBottom = 1455
Max = 255
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown3
Height = 375
Left = 2520
TabIndex = 25
Top = 480
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
BuddyControl = "Green1"
BuddyDispid = 196627
OrigLeft = 2760
OrigTop = 480
OrigRight = 3000
OrigBottom = 855
Max = 255
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown2
Height = 375
Left = 4096
TabIndex = 24
Top = 1080
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
BuddyControl = "Blue2"
BuddyDispid = 196623
OrigLeft = 4320
OrigTop = 1080
OrigRight = 4560
OrigBottom = 1455
Max = 255
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin MSComCtl2.UpDown UpDown1
Height = 375
Left = 4096
TabIndex = 23
TabStop = 0 'False
Top = 480
Width = 240
_ExtentX = 423
_ExtentY = 661
_Version = 393216
BuddyControl = "Blue1"
BuddyDispid = 196626
OrigLeft = 4320
OrigTop = 480
OrigRight = 4560
OrigBottom = 855
Max = 255
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.CommandButton CancelBtn
Cancel = -1 'True
Caption = "Cancel"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 19
TabStop = 0 'False
Top = 5160
Width = 1695
End
Begin VB.CommandButton BuildBtn
Caption = "Build"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 18
TabStop = 0 'False
Top = 4800
Width = 1695
End
Begin VB.TextBox Text2
Height = 375
Left = 4920
Locked = -1 'True
TabIndex = 17
TabStop = 0 'False
Top = 1080
Width = 1695
End
Begin VB.TextBox Text1
Height = 375
Left = 4920
Locked = -1 'True
TabIndex = 16
TabStop = 0 'False
Top = 480
Width = 1695
End
Begin VB.PictureBox ColorDisplay
Height = 4815
Left = 2040
MousePointer = 2 'Cross
ScaleHeight = 4755
ScaleWidth = 5715
TabIndex = 15
TabStop = 0 'False
Top = 1680
Width = 5775
End
Begin VB.Frame Frame1
Caption = "&Color Count"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3255
Left = 120
TabIndex = 8
Top = 1560
Width = 1695
Begin VB.OptionButton Option6
Caption = "256 Colors"
Height = 375
Left = 120
TabIndex = 14
Top = 2760
Width = 1335
End
Begin VB.OptionButton Option5
Caption = "128 Colors"
Height = 255
Left = 120
TabIndex = 13
Top = 2280
Width = 1215
End
Begin VB.OptionButton Option4
Caption = "64 Colors"
Height = 255
Left = 120
TabIndex = 12
Top = 1800
Width = 1215
End
Begin VB.OptionButton Option3
Caption = "32 colors"
Height = 255
Left = 120
TabIndex = 11
Top = 1320
Value = -1 'True
Width = 1455
End
Begin VB.OptionButton Option2
Caption = "16 Colors"
Height = 255
Left = 120
TabIndex = 10
Top = 840
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "8 colors"
Height = 375
Left = 120
TabIndex = 9
Top = 240
Width = 1335
End
End
Begin VB.CommandButton Color2
Caption = "Color&2"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6720
TabIndex = 1
Top = 1080
Width = 1095
End
Begin VB.TextBox Blue2
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3480
TabIndex = 7
Top = 1080
Width = 615
End
Begin VB.TextBox Green2
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
TabIndex = 5
Top = 1080
Width = 615
End
Begin VB.TextBox Red2
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 3
Top = 1080
Width = 615
End
Begin VB.TextBox Blue1
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3480
TabIndex = 6
Top = 480
Width = 615
End
Begin VB.TextBox Green1
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1920
TabIndex = 4
Top = 480
Width = 615
End
Begin VB.TextBox Red1
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 2
Top = 480
Width = 615
End
Begin VB.CommandButton Color1
Caption = "Color&1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6720
TabIndex = 0
Top = 480
Width = 1095
End
Begin MSComDlg.CommonDialog CD
Left = 7320
Top = 240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label Label4
Caption = "Increment"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 29
Top = 5640
Width = 855
End
Begin VB.Label Label3
Caption = "&Blue"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3480
TabIndex = 22
Top = 240
Width = 855
End
Begin VB.Label Label2
Caption = "&Green"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1920
TabIndex = 21
Top = 240
Width = 855
End
Begin VB.Label Label1
Caption = "&Red"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 20
Top = 240
Width = 855
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuTools
Caption = "&Tools"
Begin VB.Menu mnuToolsBMP
Caption = "&BMP Generator"
End
Begin VB.Menu mnuToolsColorize
Caption = "&Colorize"
End
End
Begin VB.Menu mnuHelp
Caption = "&Help"
Begin VB.Menu mnuHelpAbout
Caption = "&About"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------------
' Module : Form1
' DateTime : 8/16/05 02:14
' Author : Philip S. Rist
' E-mail : prist@xxxxxxxxxxxx
' Web site : http://www.innernet.net/prist
' Purpose :
'------------------------------------------------------------------------
' Copyright 2005 by St. Thomas Software - All rights reserved
'------------------------------------------------------------------------
' This product is used at your own risk. St.Thomas Software does not
' guarantee that this software does anything. Though it usually does
' something.
'
' This software is freeware. It may be used for amy moral purpose.
' If you feel you need to pay for this product, please send one million
' dollars or whatever you feel is appropriate to
'
' International Rescue Committee
' 122 East 42nd Street
' New York, NY 10168-1289
'------------------------------------------------------------------------
Option Explicit
Dim mRed1 As Long
Dim mGreen1 As Long
Dim mBlue1 As Long
Dim mRed2 As Long
Dim mGreen2 As Long
Dim mBlue2 As Long
Dim mWhite As Long
Dim mBlack As Long
Dim mRows As Long
Dim mColumns As Long
Dim mColors As Long

'
'------------------------------------------------------------------
' Procedure : CancelBtn_Click 8/16/05 03:51
' Purpose : Exit program
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub CancelBtn_Click()
Unload Me
End Sub

'
'------------------------------------------------------------------
' Procedure : ColorDisplay_MouseDown 8/16/05 03:51
' Purpose : Select colors from current color display
'<comment>
' No shift selects first color, shift selects second color
'</comment>
'------------------------------------------------------------------
Private Sub ColorDisplay_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim lColor As Long
Dim lRed As Long
Dim lGreen As Long
Dim lBlue As Long

lColor = ColorDisplay.Point(X, Y)
lRed = lColor Mod 256
lColor = lColor \ 256
lGreen = lColor Mod 256
lColor = lColor \ 256
lBlue = lColor Mod 256

If Shift = 0 Then
mRed1 = lRed
mGreen1 = lGreen
mBlue1 = lBlue
SetColor1
Else
mRed2 = lRed
mGreen2 = lGreen
mBlue2 = lBlue
SetColor2
End If

End Sub

'
'------------------------------------------------------------------
' Procedure : Color1_Click 8/16/05 03:56
' Purpose : Use standard dialog to set color 1
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Color1_Click()
mRed1 = Val(Red1.Text)
mGreen1 = Val(Green1.Text)
mBlue1 = Val(Blue1.Text)
GetColor mRed1, mGreen1, mBlue1
SetColor1

End Sub
'
'------------------------------------------------------------------
' Procedure : Color2_Click 8/16/05 03:55
' Purpose : Use standard dialog to set color 2
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Color2_Click()
mRed2 = Val(Red2.Text)
mGreen2 = Val(Green2.Text)
mBlue2 = Val(Blue2.Text)
GetColor mRed2, mGreen2, mBlue2
SetColor2

End Sub

'
'------------------------------------------------------------------
' Procedure : GetColor 8/16/05 03:54
' Purpose : Use standard dialog to select color
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub GetColor(pRed As Long, pGreen As Long, pBlue As Long)
Dim lColor As Long

With CD
.Color = RGB(pRed Mod 256, pGreen Mod 256, pBlue Mod 256)
.DialogTitle = "Color Search"
.ShowColor
lColor = .Color
pRed = lColor Mod 256
lColor = lColor \ 256
pGreen = lColor Mod 256
lColor = lColor \ 256
pBlue = lColor Mod 256
End With

End Sub

'
'------------------------------------------------------------------
' Procedure : SetColor 8/16/05 03:54
' Purpose : initialize both color 1 and 2
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub SetColor()
mRed1 = 0
mGreen1 = 0
mBlue1 = 0
SetColor1

mRed2 = 255
mGreen2 = 255
mBlue2 = 255
SetColor2

End Sub
'
'------------------------------------------------------------------
' Procedure : SetColor1 8/16/05 03:54
' Purpose : Show color 1 selection
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub SetColor1()
' Text1.BackColor = RGB(mRed1, mGreen1, mBlue1)
Red1.Text = CStr(mRed1)
Green1.Text = CStr(mGreen1)
Blue1.Text = CStr(mBlue1)
' Me.Refresh

End Sub
'
'------------------------------------------------------------------
' Procedure : SetColor2 8/16/05 03:53
' Purpose : Show color 2 selection
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub SetColor2()
' Text2.BackColor = RGB(mRed2, mGreen2, mBlue2)
Red2.Text = CStr(mRed2)
Green2.Text = CStr(mGreen2)
Blue2.Text = CStr(mBlue2)
' Me.Refresh

End Sub

'
'------------------------------------------------------------------
' Procedure : BuildBtn_Click 8/16/05 03:56
' Purpose : Build .BAS file
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub BuildBtn_Click()
BuildCode mRows, mColumns
End Sub

'
'------------------------------------------------------------------
' Procedure : Form_Load 8/16/05 03:56
' Purpose : Initialize form
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Form_Load()
mBlack = RGB(0, 0, 0)
mWhite = RGB(255, 255, 255)
SetColor
Me.Caption = "STS\GradGen Copyright 2005 by St. Thomas Software"

End Sub
'
'------------------------------------------------------------------
' Procedure : BuildCode 8/16/05 03:57
' Purpose : Build .BAS file
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub BuildCode(pRows As Long, pColumns As Long)
Dim lRed As Single
Dim lGreen As Single
Dim lBlue As Single
Dim lRedInc As Single
Dim lGreenInc As Single
Dim lBlueInc As Single
Dim lCount As Long
Dim lTop As Long
Dim lHeight As Long
Dim lBottom As Long
Dim lLeft As Long
Dim lRight As Long
Dim lWidth As Long
Dim lInc As Single
Dim lR As Long
Dim lG As Long
Dim lB As Long
Dim lText As String
Dim lname As String

lInc = pRows * pColumns - 1
lRed = mRed1
lRedInc = (mRed2 - lRed) / lInc
lGreen = mGreen1
lGreenInc = (mGreen2 - lGreen) / lInc
lBlue = mBlue1
lBlueInc = (mBlue2 - lBlue) / lInc

On Error Resume Next

lname = InputBox("Enter color name:", "Color Name Dialog", "gColor")

lHeight = ColorDisplay.Height \ pRows
lTop = 0
lLeft = 0
lWidth = ColorDisplay.Width \ pColumns
lRight = 0
ColorDisplay.DrawWidth = 2
lText = vbCrLf

For lCount = 1 To (pRows * pColumns)
If (lCount Mod pRows) <> 1 Then
lBottom = lTop + lHeight
Else
lTop = 0
lBottom = lHeight
lLeft = lRight
lRight = lRight + lWidth
End If

lR = lRed Mod 256
lG = lGreen Mod 256
lB = lBlue Mod 256
lText = lText & "' Red: " & CStr(lR) & " Green: " & CStr(lG) & "
Blue: " & CStr(lB) & vbCrLf
lText = lText & " Public Const " & lname & CStr(lCount) & " As
Long = " & CStr((lB * 256 + lG) * 256 + lR) & vbCrLf
lTop = lBottom
lRed = lRed + lRedInc
lGreen = lGreen + lGreenInc
lBlue = lBlue + lBlueInc
Next

If Len(lText) > 0 Then
With CD
.DefaultExt = ".bas"
.DialogTitle = "Color Table File Selection Dialog"
.FileName = lname & ".bas"
.InitDir = "K:\_np\vb6 np\unfinished"
.ShowSave
If Len(.FileName) > 0 Then
Open .FileName For Output As #1
Print #1, lText
Close #1
Else
Clipboard.SetText lText
End If
End With
End If



End Sub
'
'------------------------------------------------------------------
' Procedure : DisplayColors 8/16/05 03:57
' Purpose : Display generated colors
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub DisplayColors(pRows As Long, pColumns As Long)
Dim lRed As Single
Dim lGreen As Single
Dim lBlue As Single
Dim lRedInc As Single
Dim lGreenInc As Single
Dim lBlueInc As Single
Dim lCount As Long
Dim lTop As Long
Dim lHeight As Long
Dim lBottom As Long
Dim lLeft As Long
Dim lRight As Long
Dim lWidth As Long
Dim lInc As Single
Dim lR As Long
Dim lG As Long
Dim lB As Long
Dim lColor As Long

mRows = pRows
mColumns = pColumns

lInc = pRows * pColumns - 1
lRed = mRed1
lRedInc = (mRed2 - lRed) / lInc
lGreen = mGreen1
lGreenInc = (mGreen2 - lGreen) / lInc
lBlue = mBlue1
lBlueInc = (mBlue2 - lBlue) / lInc

On Error Resume Next
With ColorDisplay
.Refresh
lHeight = ColorDisplay.Height \ pRows
lTop = 0
lLeft = 0
lWidth = ColorDisplay.Width \ pColumns
lRight = 0
ColorDisplay.DrawWidth = 2
ColorDisplay.ForeColor = RGB(255, 255, 255)
lColor = pRows * pColumns \ 2

For lCount = 1 To (pRows * pColumns)
If (lCount Mod pRows) <> 1 Then
lBottom = lTop + lHeight
Else
lTop = 0
lBottom = lHeight
lLeft = lRight
lRight = lRight + lWidth
End If
lR = lRed Mod 256
lG = lGreen Mod 256
lB = lBlue Mod 256
ColorDisplay.Line (lLeft, lTop)-(lRight, lBottom), RGB(lR, lG, lB),
BF
If pRows < 32 Then
ColorDisplay.Line (lLeft, lTop)-(lRight, lBottom), RGB(0, 0, 0),
B
.CurrentX = lLeft + 10
.CurrentY = lTop + 10
ColorDisplay.Print CStr(lR) & "x" & CStr(lG) & "x" & CStr(lB)
End If
lTop = lBottom

lRed = lRed + lRedInc
lGreen = lGreen + lGreenInc
lBlue = lBlue + lBlueInc

If lCount = lColor Then
ColorDisplay.ForeColor = RGB(0, 0, 0)
End If
Next
End With

End Sub

'
'------------------------------------------------------------------
' Procedure : Form_Paint 8/16/05 03:58
' Purpose : Draw form with new color selection
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Form_Paint()

If Option1.Value = True Then
DisplayColors 8, 1
mColors = 8
ElseIf Option2.Value = True Then
DisplayColors 8, 2
mColors = 16
ElseIf Option3.Value = True Then
DisplayColors 8, 4
mColors = 32
ElseIf Option4.Value = True Then
DisplayColors 8, 8
mColors = 64
ElseIf Option5.Value = True Then
DisplayColors 16, 8
mColors = 128
ElseIf Option6.Value = True Then
DisplayColors 16, 16
mColors = 256
Else
DisplayColors 4, 4
mColors = 16
End If

End Sub

'
'------------------------------------------------------------------
' Procedure : Colors 8/30/05 16:55
' Purpose :
'<comment>
'
'</comment>
'------------------------------------------------------------------
Public Property Get Colors() As Long
Colors = mColors
End Property
'
'------------------------------------------------------------------
' Procedure : Form_Resize 8/16/05 03:58
' Purpose : Respond to resize request
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Form_Resize()
With ColorDisplay
.Width = Me.ScaleWidth - .Left - 60
.Height = Me.ScaleHeight - .Top - 60
End With
End Sub
'
'------------------------------------------------------------------
' Procedure : Blue1_change 8/16/05 03:59
' Purpose : Value may have been changed update colors
'------------------------------------------------------------------
Private Sub Blue1_change()
mBlue1 = Val(Blue1.Text)
Text1.BackColor = RGB(mRed1, mGreen1, mBlue1)
Me.Refresh

End Sub

'
'------------------------------------------------------------------
' Procedure : Form_Unload 8/30/05 16:55
' Purpose :
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
Dim lForm As Form
For Each lForm In Forms
If Not lForm Is Me Then
Unload lForm
End If
Next
End Sub

'
'------------------------------------------------------------------
' Procedure : Green1_change 8/16/05 03:59
' Purpose : Value may have been changed update colors
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Green1_Change()
mGreen1 = Val(Green1.Text)
Text1.BackColor = RGB(mRed1, mGreen1, mBlue1)
Me.Refresh

End Sub

Private Sub Increment_Change()
'End Sub
'
'Private Sub Increment_LostFocus()
Dim lIncrement As Long

lIncrement = Val(Increment.Text) Mod 32
UpDown1.Increment = lIncrement
UpDown2.Increment = lIncrement
UpDown3.Increment = lIncrement
UpDown4.Increment = lIncrement
UpDown5.Increment = lIncrement
UpDown6.Increment = lIncrement
End Sub

Private Sub mnuFileExit_Click()
Dim lForm As Form

For Each lForm In Forms
Unload lForm
Next

End Sub

Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal
End Sub

Private Sub mnuToolsBMP_Click()
Form2.GenBMPs

End Sub

Private Sub mnuToolsColorize_Click()
Form3.GenBMPs

End Sub

Private Sub Option1_Click()
Me.Refresh
End Sub
Private Sub Option2_Click()
Me.Refresh
End Sub
Private Sub Option3_Click()
Me.Refresh
End Sub
Private Sub Option4_Click()
Me.Refresh
End Sub
Private Sub Option5_Click()
Me.Refresh
End Sub
Private Sub Option6_Click()
Me.Refresh
End Sub

'
'------------------------------------------------------------------
' Procedure : Red1_change 8/16/05 03:59
' Purpose : Value may have been changed update colors
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Red1_Change()
mRed1 = Val(Red1.Text)
Text1.BackColor = RGB(mRed1, mGreen1, mBlue1)
Me.Refresh

End Sub
'
'------------------------------------------------------------------
' Procedure : Blue2_change 8/16/05 03:59
' Purpose : Value may have been changed update colors
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Blue2_Change()
mBlue2 = Val(Blue2.Text)
Text2.BackColor = RGB(mRed2, mGreen2, mBlue2)
Me.Refresh

End Sub

'
'------------------------------------------------------------------
' Procedure : Green2_change 8/16/05 03:59
' Purpose : Value may have been changed update colors
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Green2_change()
mGreen2 = Val(Green2.Text)
Text2.BackColor = RGB(mRed2, mGreen2, mBlue2)
Me.Refresh

End Sub

'
'------------------------------------------------------------------
' Procedure : Red2_change 8/16/05 04:00
' Purpose : Value may have been changed update colors
'<comment>
'
'</comment>
'------------------------------------------------------------------
Private Sub Red2_change()
mRed2 = Val(Red2.Text)
Text2.BackColor = RGB(mRed2, mGreen2, mBlue2)
Me.Refresh

End Sub

'Private Sub UpDown7_Change()
' Increment_Change
'End Sub

cut
here -----------------------------------------------------------------------
----------
"Philip S. Rist" <prist@xxxxxxxxxxxx> wrote in message
news:dfi2sv02656@xxxxxxxxxxxxxxxxxxxxx
>
> This is a simple VB6 program I put together this week. Currently it is
> composed of four forms. The source will be posted in replys to this post.
> There should be three .frm and one .vbp. The rest you should be able to
> figure out.
>
> Form1: This form is used to select two colors to form the beginning and
> ending colors of a gradient. The program generates the requested number
of
> colors evenly spaced between these two colors. The Build button is used
to
> generate a .BAS file containing VB6 CONSTant definitions for all the
colors
> displayed. The gradient can contain 8, 16, 32, 64, 128 or 256 colors.
> Depending on the terminal colors chosen these may or may not be unique
> colors. The increment at the bottom sets the increment for the UpDown
> controls. Clicking on a displayed color will set it as the dark end
> terminating color. Shift clicking a color will set it as the bright end
> terminating color.
>
> Form2: This form is activated from the Tools | BMP Generator menu item.
> This form is used to generate a series of images (.BMP, .ICO or .CUR).
One
> image is generated for each color in the Form1 gradient. The user selects
> an image file and one color on that image file. That color will be
replaced
> with the gradient color from Form1. No other colors are changed. The
user
> can choose to use only the first and last color in the gradient.
>
> Form3: This form is activated from the Tools | Colorize menu item. All
> colors except white, black and a color chosen by the user are replaced by
a
> color from the Form1 gradient. The replacement color is chosen based on
the
> intensity of the image color. Dark colors are replaced with colors at the
> top of the gradient, light colors by colors at the bottom of the gradient.
> T
>
> You can select one color to remain unchanged. If you do not want to save
a
> color check 'No saved color'. Black and white will be saved by default
> unless you selct to replace them as explained below. This option should
be
> used for any other color.
>
> To replace black check the 'Convert black' option. Unless the reverse
color
> order is checked black will be replaced with the first color in the
> gradient. This is usually the darkest color.
> To replace white check the 'Convert white' option. Unless the reverse
> color order is checked white will be replaced with the last color in the
> gradient. This is usually the lightest color.
>
> You can also choose to reverse color intensity so that dark colors are
> replaced by light colors and light colors are replaced by dark colors.
> Check 'Reverse color order' to accomplish this.
>
> Since this program works on a pixel by pixel basis it can be very slow on
> large images. It should be used only on small .bmp files and icons.
>
> This program seems to work ok on my system. I have not tried testing it
on
> any other systems. There still may some problems. Give it a try. You
have
> the source. You can always change it to do what you want. Send all
> comments to Philip S. Rist at prist@xxxxxxxxxxxxx
>
> '------------------------------------------------------------------------
> ' Module : STS\GradGen
> ' DateTime : 8/24/05 08:16
> ' Author : Philip S. Rist
> ' E-mail : prist@xxxxxxxxxxxx
> ' Web site : http://www.innernet.net/prist
> '
> '------------------------------------------------------------------------
> ' Copyright 2005 by St. Thomas Software - All rights reserved
> '------------------------------------------------------------------------
> ' This product is used at your own risk. St.Thomas Software does not
> ' guarantee that this software does anything. Though it usually does
> ' something.
> '
> ' This software is freeware. It may be used for amy moral purpose.
> ' If you feel you need to pay for this product, please send one million
> ' dollars or whatever you feel is appropriate to
> '
> ' International Rescue Committee
> ' 122 East 42nd Street
> ' New York, NY 10168-1289
> '------------------------------------------------------------------------
>
>
> Thank you
> Philip S. Rist
>
>
>
>
>


.