Re: Gradient Generator BMP Tool Improved

Here is Form2.frm
VERSION 5.00
Begin VB.Form Form2
Caption = "Form2"
ClientHeight = 5790
ClientLeft = 60
ClientTop = 345
ClientWidth = 10755
LinkTopic = "Form2"
ScaleHeight = 5790
ScaleWidth = 10755
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox FirstAndLast
Caption = "First and Last Colors"
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 = 1560
TabIndex = 30
Top = 1800
Width = 2175
End
Begin VB.TextBox Color2
Height = 375
Left = 2160
Locked = -1 'True
TabIndex = 27
TabStop = 0 'False
Top = 3960
Width = 1575
End
Begin VB.TextBox Blue2
Height = 375
Left = 1560
Locked = -1 'True
TabIndex = 26
TabStop = 0 'False
Top = 3960
Width = 495
End
Begin VB.TextBox Green2
Height = 375
Left = 840
Locked = -1 'True
TabIndex = 25
TabStop = 0 'False
Top = 3960
Width = 495
End
Begin VB.TextBox Red2
Height = 375
Left = 120
Locked = -1 'True
TabIndex = 24
TabStop = 0 'False
Top = 3960
Width = 495
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 = 17
Top = 5280
Width = 1215
End
Begin VB.TextBox NewPrefix
Height = 375
Left = 3840
TabIndex = 1
Top = 1080
Width = 6855
End
Begin VB.TextBox MsgText
Height = 375
Left = 3840
Locked = -1 'True
TabIndex = 9
TabStop = 0 'False
Top = 480
Width = 6855
End
Begin VB.PictureBox Pic2
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1815
Left = 8280
ScaleHeight = 121
ScaleMode = 3 'Pixel
ScaleWidth = 137
TabIndex = 8
TabStop = 0 'False
Top = 4440
Width = 2055
End
Begin VB.CommandButton BuildBtn
Caption = "&Build"
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 = 3
Top = 4680
Width = 1215
End
Begin VB.TextBox Blue1
Height = 375
Left = 1560
Locked = -1 'True
TabIndex = 7
TabStop = 0 'False
Top = 3240
Width = 495
End
Begin VB.TextBox Green1
Height = 375
Left = 840
Locked = -1 'True
TabIndex = 6
TabStop = 0 'False
Top = 3240
Width = 495
End
Begin VB.TextBox Red1
Height = 375
Left = 120
Locked = -1 'True
TabIndex = 5
TabStop = 0 'False
Top = 3240
Width = 495
End
Begin VB.TextBox Color
Height = 375
Left = 2160
Locked = -1 'True
TabIndex = 4
TabStop = 0 'False
Top = 3240
Width = 1575
End
Begin VB.CommandButton SelectBtn
Caption = "&Select"
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 = 0
Top = 360
Width = 1215
End
Begin VB.PictureBox Pic1
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 1695
Left = 3840
ScaleHeight = 113
ScaleMode = 3 'Pixel
ScaleWidth = 137
TabIndex = 2
Top = 4440
Width = 2055
End
Begin VB.Label Label4
Caption = "3. Restrict colors? "
Height = 255
Left = 1560
TabIndex = 29
Top = 1560
Width = 1575
End
Begin VB.Label Label15
Caption = "New Color"
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 = 2160
TabIndex = 28
Top = 3720
Width = 1575
End
Begin VB.Label Label14
Caption = "2. Select new image file name
---->"
Height = 375
Left = 1560
TabIndex = 23
Top = 960
Width = 2295
End
Begin VB.Label Label13
Caption = "Path to Source Image"
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 = 3840
TabIndex = 22
Top = 240
Width = 2535
End
Begin VB.Label Label12
Caption = "Replaced Color"
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 = 2160
TabIndex = 21
Top = 3000
Width = 1455
End
Begin VB.Label Label11
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 = 1560
TabIndex = 20
Top = 3000
Width = 615
End
Begin VB.Label Label10
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 = 840
TabIndex = 19
Top = 3000
Width = 615
End
Begin VB.Label Label9
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 = 120
TabIndex = 18
Top = 3000
Width = 615
End
Begin VB.Label Label8
Caption = "New Image (Actual Size)"
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 = 8280
TabIndex = 16
Top = 4200
Width = 2295
End
Begin VB.Label Label7
Caption = "Source (Actual Size)"
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 = 3840
TabIndex = 15
Top = 4200
Width = 2055
End
Begin VB.Label Label6
Caption = "New Image"
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 = 8280
TabIndex = 14
Top = 1560
Width = 2175
End
Begin VB.Label Label5
Caption = "Source Image"
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 = 3840
TabIndex = 13
Top = 1560
Width = 1935
End
Begin VB.Label Label3
Caption = "<-- 5. Click to build images"
Height = 375
Left = 1320
TabIndex = 12
Top = 4800
Visible = 0 'False
Width = 2295
End
Begin VB.Label Label2
Caption = "4. Click to select color to
change ---->"
Height = 615
Left = 1560
TabIndex = 11
Top = 2280
Width = 2295
End
Begin VB.Label Label1
Caption = "<-- 1. Click to select source
image file"
Height = 495
Left = 1320
TabIndex = 10
Top = 360
Width = 2415
End
Begin VB.Image Image2
Height = 2295
Left = 8280
Stretch = -1 'True
Top = 1800
Width = 2055
End
Begin VB.Image Image1
Height = 2295
Left = 3840
Stretch = -1 'True
Top = 1800
Width = 2055
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------------
' Module : Form2
' DateTime : 8/24/05 08:12
' Author : Philip S. Rist
' E-mail : prist@xxxxxxxxxxxx
' Web site : http://www.innernet.net/prist
' Purpose : Successively replace a selected color in an image
' with a series of colors creating one new image for
' each color.
'------------------------------------------------------------------------
' 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 mfilesys As Scripting.FileSystemObject

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 mColor As Long
Dim mRed3 As Long
Dim mGreen3 As Long
Dim mBlue3 As Long
Dim mFileName As String
Dim mFilePath As String
Dim mSourcePath As String
Dim mTargetPath As String
Dim mFileExtension As String

'
'------------------------------------------------------------------
' Procedure : CancelBtn_Click 8/24/05 08:12
' Purpose :
'------------------------------------------------------------------
Private Sub CancelBtn_Click()
Unload Me
End Sub

'
'------------------------------------------------------------------
' Procedure : Form_Resize 8/24/05 08:12
' Purpose :
'------------------------------------------------------------------
Private Sub Form_Resize()
Dim lHeight As Long

lHeight = Me.ScaleHeight
If lHeight > Pic1.Top Then
CancelBtn.Top = lHeight - CancelBtn.Height - 60
End If

End Sub

'
'------------------------------------------------------------------
' Procedure : SelectBtn_Click 8/24/05 08:12
' Purpose : Allows user to select a source image
'------------------------------------------------------------------
Private Sub SelectBtn_Click()
Dim lPos As Long

On Error GoTo selecterr
With Form1.CD
.DefaultExt = ".bmp"
.DialogTitle = "Select Source Image File"
.Filter = "BMP Image File
(*.bmp;*.ico;*.cur)|*.bmp;*.ico;*.cur|Windows Media File
(*.wmf)|*.wmf|Grapgic Files
(*.gif;*.jpg;*.jpe;*.jpeg)|*.gif;*.jpg;*.jpe;*.jpeg|All Files (*.*)|*.*"
.FilterIndex = 1
lPos = InStrRev(mSourcePath, "\")
If lPos > 0 Then
.InitDir = Left$(mSourcePath, lPos - 1)
Else
.InitDir = GetSetting("STS", "GradGen", "Source Directory",
"c:\temp")
End If

.ShowOpen

If Len(.FileName) > 0 Then
If mfilesys.FileExists(.FileName) Then
mFileName = .FileName
mSourcePath = mFileName
SaveSetting "STS", "GradGen", "Source Directory", mSourcePath
MsgText.Text = mFileName
Me.Caption = "STS\GradGen BMP Generator - Transforming " &
mFileName
Pic1.Picture = LoadPicture(mFileName)
Pic2.Picture = LoadPicture(mFileName)
Image1.Picture = LoadPicture(mFileName)
lPos = InStrRev(mFileName, "\")
If lPos > 0 Then
mFilePath = Left$(mFileName, lPos)
mFileName = Mid$(mFileName, lPos + 1)
ElseIf Mid$(mFileName, 2) = ":" Then
mFilePath = Left$(mFileName, 2) & "\"
mFileName = Mid$(mFileName, 3)
End If
lPos = InStrRev(mFileName, ".")
If lPos > 0 Then
mFileExtension = Mid$(mFileName, lPos)
mFileName = Left$(mFileName, lPos - 1)
End If

mTargetPath = GetSetting("STS", "GradGen", "Target Directory",
vbNullString)
If Len(mTargetPath) = 0 Then
mTargetPath = mFilePath
End If
NewPrefix.Text = mTargetPath & mFileName

Red1.Text = vbNullString
Green1.Text = vbNullString
Blue1.Text = vbNullString
End If
End If
End With
selecterr:
End Sub

'
'------------------------------------------------------------------
' Procedure : BuildBtn_Click 8/24/05 08:13
' Purpose : Allows user to build new image
'------------------------------------------------------------------
Private Sub BuildBtn_Click()
Screen.MousePointer = vbHourglass
BuildBMPs
Screen.MousePointer = vbNormal
End Sub

'
'------------------------------------------------------------------
' Procedure : Form_Load 8/24/05 08:13
' Purpose :
'------------------------------------------------------------------
Private Sub Form_Load()
Set mfilesys = New Scripting.FileSystemObject
BuildBtn.Visible = False
Label3.Visible = False
mFilePath = "F:\Temp"
Me.Caption = "STS\GradGen BMP Generator"
End Sub

'
'------------------------------------------------------------------
' Procedure : GenBMPs 8/24/05 08:13
' Purpose : Entry point from Form1
'------------------------------------------------------------------
Public Sub GenBMPs()
Me.Show vbModeless
End Sub

'
'------------------------------------------------------------------
' Procedure : Image1_MouseDown 8/24/05 08:13
' Purpose : Allows user to select color to be replaced
'------------------------------------------------------------------
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim h As Single
Dim w As Single

w = Image1.Width
h = Image1.Height

w = X / w
h = Y / h
w = w * Pic1.ScaleWidth
h = h * Pic1.ScaleHeight
mColor = Pic1.Point(w, h)
ShowColor

End Sub

'
'------------------------------------------------------------------
' Procedure : Pic1_MouseDown 9/5/05 13:10
' Purpose : Select color to change
'------------------------------------------------------------------
Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single)

mColor = Pic1.Point(X, Y)
ShowColor

End Sub
'
'------------------------------------------------------------------
' Procedure : ShowColor 9/5/05 13:10
' Purpose :
'------------------------------------------------------------------
Private Sub ShowColor()
Dim lColor As Long

If mColor >= 0 Then
Color.BackColor = mColor
End If
lColor = mColor

mRed3 = lColor Mod 256
Red1.Text = CStr(mRed3)

lColor = lColor \ 256
mGreen3 = lColor Mod 256
Green1.Text = CStr(mGreen3)

lColor = lColor \ 256
mBlue3 = lColor Mod 256
Blue1.Text = CStr(mBlue3)

BuildBtn.Visible = True
Label3.Visible = True

End Sub
'
'------------------------------------------------------------------
' Procedure : ReplaceColor 8/24/05 08:14
' Purpose : Perform color replacement
'------------------------------------------------------------------
Private Sub ReplaceColor(pColor As Long)
Dim lY As Single
Dim lX As Single
Dim lColor As Long

For lY = 0 To Pic1.Height
For lX = 0 To Pic1.Width
lColor = Pic1.Point(lX, lY)
If lColor = mColor Then
Pic2.PSet (lX, lY), pColor
End If
Next
Next

End Sub
'
'------------------------------------------------------------------
' Procedure : BuildBMPs 8/24/05 08:14
' Purpose : Build new image
'------------------------------------------------------------------
Private Sub BuildBMPs()
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 lInc As Single
Dim lR As Long
Dim lG As Long
Dim lB As Long
Dim lname As String
Dim lFileName As String
Dim lColorInc As Long
Dim lWhite As Long
Dim lBlack As Long
Dim lExtension As String
Dim lText As String

Pic2.Picture = LoadPicture(mSourcePath)
lText = MsgText.Text
lWhite = RGB(255, 255, 255)
lBlack = RGB(0, 0, 0)

mRed1 = Val(Form1.Red1.Text)
mGreen1 = Val(Form1.Green1.Text)
mBlue1 = Val(Form1.Blue1.Text)

mRed2 = Val(Form1.Red2.Text)
mGreen2 = Val(Form1.Green2.Text)
mBlue2 = Val(Form1.Blue2.Text)

lInc = Form1.Colors - 1
lRed = mRed1
lRedInc = (mRed2 - lRed) / lInc
lGreen = mGreen1
lGreenInc = (mGreen2 - lGreen) / lInc
lBlue = mBlue1
lBlueInc = (mBlue2 - lBlue) / lInc

On Error Resume Next

lFileName = NewPrefix.Text
lCount = InStrRev(lFileName, "\")
If lCount > 0 Then
SaveSetting "STS", "GradGen", "Target Directory", Left$(lFileName,
lCount)
End If

lExtension = UCase$(mFileExtension)
If lExtension <> ".BMP" _
And lExtension <> ".ICO" _
And lExtension <> ".CUR" Then
lExtension = ".BMP"
End If

If Len(lFileName) > 0 Then

If FirstAndLast.Value Then
lColorInc = Form1.Colors - 1
Else
lColorInc = 1
End If

For lCount = 0 To Form1.Colors - 1 Step lColorInc

Image2.Picture = Pic2.Image
Form2.Refresh

lR = (lRed + lCount * lRedInc) Mod 256
Red2.Text = CStr(lR)
lG = (lGreen + lCount * lGreenInc) Mod 256
Green2.Text = CStr(lG)
lB = (lBlue + lCount * lBlueInc) Mod 256
Blue2.Text = CStr(lB)
Color2.BackColor = RGB(lR, lG, lB)

lname = lFileName & "_" & CStr(lR) & "_" & _
CStr(lG) & "_" & CStr(lB) & lExtension
MsgText.Text = lname & " " & CStr(lCount + 1) & " of " & _
IIf(FirstAndLast, "2",
CStr(Form1.Colors))

ReplaceColor RGB(lR, lG, lB)

SavePicture Pic2.Image, lname

Next

Image2.Picture = Pic2.Image
End If
MsgText.Text = lText

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
>
>
>
>
>


.

Loading