diff --git a/Forms/VBP_FormGrayscale.frm b/Forms/VBP_FormGrayscale.frm index da38e3f67e..6619027660 100644 --- a/Forms/VBP_FormGrayscale.frm +++ b/Forms/VBP_FormGrayscale.frm @@ -1,13 +1,13 @@ VERSION 5.00 Begin VB.Form FormGrayscale BorderStyle = 4 'Fixed ToolWindow - Caption = " Grayscale Conversion" - ClientHeight = 2505 + Caption = " Color to Grayscale Conversion" + ClientHeight = 5985 ClientLeft = 45 ClientTop = 285 - ClientWidth = 5460 + ClientWidth = 6495 BeginProperty Font - Name = "Arial" + Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 400 @@ -18,21 +18,67 @@ Begin VB.Form FormGrayscale LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False - ScaleHeight = 167 + ScaleHeight = 399 ScaleMode = 3 'Pixel - ScaleWidth = 364 + ScaleWidth = 433 ShowInTaskbar = 0 'False StartUpPosition = 1 'CenterOwner Visible = 0 'False + Begin VB.PictureBox picPreview + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H80000005& + BeginProperty Font + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H80000008& + Height = 2730 + Left = 240 + ScaleHeight = 180 + ScaleMode = 3 'Pixel + ScaleWidth = 191 + TabIndex = 8 + Top = 240 + Width = 2895 + End + Begin VB.PictureBox picEffect + Appearance = 0 'Flat + AutoRedraw = -1 'True + BackColor = &H80000005& + BeginProperty Font + Name = "MS Sans Serif" + Size = 8.25 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H80000008& + Height = 2730 + Left = 3360 + ScaleHeight = 180 + ScaleMode = 3 'Pixel + ScaleWidth = 191 + TabIndex = 7 + Top = 240 + Width = 2895 + End Begin VB.HScrollBar hsShades Height = 255 - Left = 1080 + Left = 3000 Max = 254 Min = 3 TabIndex = 2 - Top = 1200 + Top = 4200 Value = 3 - Width = 4215 + Width = 2865 End Begin VB.TextBox txtShades BeginProperty Font @@ -46,10 +92,10 @@ Begin VB.Form FormGrayscale EndProperty ForeColor = &H00800000& Height = 315 - Left = 480 + Left = 2400 TabIndex = 1 Text = "3" - Top = 1170 + Top = 4170 Visible = 0 'False Width = 495 End @@ -66,47 +112,86 @@ Begin VB.Form FormGrayscale EndProperty ForeColor = &H00800000& Height = 330 - Left = 1080 + Left = 2400 Style = 2 'Dropdown List TabIndex = 0 - Top = 480 + Top = 3600 Width = 3495 End Begin VB.CommandButton CmdOK Caption = "OK" Default = -1 'True + Height = 375 + Left = 3960 + TabIndex = 3 + Top = 5400 + Width = 1125 + End + Begin VB.CommandButton CmdCancel + Cancel = -1 'True + Caption = "Cancel" + Height = 375 + Left = 5160 + TabIndex = 4 + Top = 5400 + Width = 1125 + End + Begin VB.Label lblBeforeandAfter + BackStyle = 0 'Transparent + Caption = " Before After" BeginProperty Font - Name = "Tahoma" + Name = "Arial" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False + Italic = -1 'True + Strikethrough = 0 'False + EndProperty + ForeColor = &H00400000& + Height = 255 + Left = 240 + TabIndex = 9 + Top = 3000 + Width = 3975 + End + Begin VB.Label lblAdditional + AutoSize = -1 'True + Caption = "Additional options:" + BeginProperty Font + Name = "Tahoma" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 375 - Left = 2880 - TabIndex = 3 - Top = 1920 - Width = 1125 + ForeColor = &H00400000& + Height = 210 + Left = 600 + TabIndex = 6 + Top = 4200 + Width = 1515 End - Begin VB.CommandButton CmdCancel - Cancel = -1 'True - Caption = "Cancel" + Begin VB.Label lblAlgorithm + AutoSize = -1 'True + Caption = "Grayscale algorithm:" BeginProperty Font Name = "Tahoma" - Size = 8.25 + Size = 9 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty - Height = 375 - Left = 4080 - TabIndex = 4 - Top = 1920 - Width = 1125 + ForeColor = &H00400000& + Height = 210 + Left = 600 + TabIndex = 5 + Top = 3645 + Width = 1620 End End Attribute VB_Name = "FormGrayscale" @@ -131,6 +216,29 @@ Attribute VB_Exposed = False Option Explicit +'This routine is used to call the appropriate grayscale routine with the preview flag set +Private Sub drawGrayscalePreview() + + 'Error checking + If EntryValid(txtShades, hsShades.Min, hsShades.Max, False, False) Then + + Select Case cboMethod.ListIndex + Case 0 + MenuGrayscaleAverage True + Case 1 + MenuGrayscale True + Case 2 + MenuDesaturate True + Case 3 + fGrayscaleCustom hsShades.Value, True + Case 4 + fGrayscaleCustomDither hsShades.Value, True + End Select + + End If + +End Sub + '********************************************************************* 'The next three methods exist to activate/deactivate the textbox and scrollbar Private Sub cboMethod_Click() @@ -139,6 +247,7 @@ Private Sub cboMethod_Click() Else ShowControls False End If + drawGrayscalePreview End Sub Private Sub cboMethod_KeyDown(KeyCode As Integer, Shift As Integer) @@ -147,11 +256,13 @@ Private Sub cboMethod_KeyDown(KeyCode As Integer, Shift As Integer) Else ShowControls False End If + drawGrayscalePreview End Sub Private Sub ShowControls(ByVal toShow As Boolean) txtShades.Visible = toShow hsShades.Visible = toShow + lblAdditional.Visible = toShow End Sub '********************************************************************* @@ -165,7 +276,9 @@ Private Sub CmdOK_Click() 'Error checking If EntryValid(txtShades, hsShades.Min, hsShades.Max) Then + Me.Visible = False + Select Case cboMethod.ListIndex Case 0 Process GrayscaleAverage @@ -176,9 +289,11 @@ Private Sub CmdOK_Click() Case 3 Process GrayscaleCustom, hsShades.Value Case 4 - Process GrayscaleDitherCustom, hsShades.Value + Process GrayscaleCustomDither, hsShades.Value End Select + Unload Me + Else AutoSelectText txtShades End If @@ -187,7 +302,8 @@ End Sub 'Initialize the combo box Private Sub Form_Load() - + + 'Set up the grayscale options combo box cboMethod.AddItem "Average", 0 cboMethod.AddItem "ITU Standard", 1 cboMethod.AddItem "Desaturate", 2 @@ -195,57 +311,129 @@ Private Sub Form_Load() cboMethod.AddItem "X # of shades (dithered)", 4 cboMethod.ListIndex = 1 + 'Render the preview images + DrawPreviewImage PicPreview + DrawPreviewImage PicEffect + 'Assign the system hand cursor to all relevant objects setHandCursorForAll Me + 'Draw the initial preview + drawGrayscalePreview + End Sub 'Reduce to X # gray shades -Public Sub fGrayscaleCustom(ByVal NumToConvertTo As Long) - GetImageData - Message "Converting to " & NumToConvertTo & " shades of gray..." +Public Sub fGrayscaleCustom(ByVal NumToConvertTo As Long, Optional ByVal toPreview As Boolean = False) + + 'Get the appropriate set of image data contingent on whether this is a preview or not + If toPreview = True Then + GetPreviewData PicPreview + Else + Message "Converting to " & NumToConvertTo & " shades of gray..." + GetImageData + SetProgBarMax PicHeightL + End If + + 'Build a look-up table for our custom grayscale conversion results Dim MagicNum As Single - Dim CurrentColor As Long MagicNum = (255 / (NumToConvertTo - 1)) Dim LookUp(0 To 255) As Long For x = 0 To 255 LookUp(x) = Int((CDbl(x) / MagicNum) + 0.5) * MagicNum If LookUp(x) > 255 Then LookUp(x) = 255 Next x - SetProgBarMax PicHeightL - Dim r1 As Long, g1 As Long, b1 As Long + + 'Build another look-up table for our initial grayscale index calculation + Dim grayLookUp(0 To 765) As Byte + For x = 0 To 765 + grayLookUp(x) = x \ 3 + Next x + + Dim r As Long, g As Long, b As Long, gray As Long + + 'Calculate loop values based on previewing/not-previewing + Dim initX As Long, initY As Long, finX As Long, finY As Long + If toPreview = True Then + initX = PreviewX + finX = PreviewX + PreviewWidth + initY = PreviewY + finY = PreviewY + PreviewHeight + Else + initX = 0 + finX = PicWidthL + initY = 0 + finY = PicHeightL + End If + Dim QuickVal As Long - For y = 0 To PicHeightL - For x = 0 To PicWidthL + For y = initY To finY + For x = initX To finX + QuickVal = x * 3 - r1 = ImageData(QuickVal + 2, y) - g1 = ImageData(QuickVal + 1, y) - b1 = ImageData(QuickVal, y) - CurrentColor = (r1 + g1 + b1) \ 3 - ImageData(QuickVal + 2, y) = LookUp(CurrentColor) - ImageData(QuickVal + 1, y) = LookUp(CurrentColor) - ImageData(QuickVal, y) = LookUp(CurrentColor) + + r = ImageData(QuickVal + 2, y) + g = ImageData(QuickVal + 1, y) + b = ImageData(QuickVal, y) + gray = grayLookUp(r + g + b) + + ImageData(QuickVal + 2, y) = LookUp(gray) + ImageData(QuickVal + 1, y) = LookUp(gray) + ImageData(QuickVal, y) = LookUp(gray) + Next x - If y Mod 20 = 0 Then SetProgBarVal y + If toPreview = False Then + If (y Mod 20 = 0) Then SetProgBarVal y + End If Next y - SetImageData - Message "Finished." + + If toPreview = True Then + SetPreviewData PicEffect + Else + SetImageData + Message "Finished." + End If + End Sub 'Reduce to X # gray shades (dithered) -Public Sub fGrayscaleCustomDither(ByVal NumToConvertTo As Long) - GetImageData - Message "Converting to " & NumToConvertTo & " shades of gray..." +Public Sub fGrayscaleCustomDither(ByVal NumToConvertTo As Long, Optional ByVal toPreview As Boolean = False) + + 'Get the appropriate set of image data contingent on whether this is a preview or not + If toPreview = True Then + GetPreviewData PicPreview + Else + Message "Converting to " & NumToConvertTo & " shades of gray, with dithering..." + GetImageData + SetProgBarMax PicHeightL + End If + Dim MagicNum As Single - Dim CurrentColor As Long MagicNum = (255 / (NumToConvertTo - 1)) - SetProgBarMax PicHeightL + + Dim CurrentColor As Long + Dim EV As Long Dim CC As Long Dim r1 As Long, g1 As Long, b1 As Long + + 'Calculate loop values based on previewing/not-previewing + Dim initX As Long, initY As Long, finX As Long, finY As Long + If toPreview = True Then + initX = PreviewX + finX = PreviewX + PreviewWidth + initY = PreviewY + finY = PreviewY + PreviewHeight + Else + initX = 0 + finX = PicWidthL + initY = 0 + finY = PicHeightL + End If + Dim QuickVal As Long - For y = 0 To PicHeightL - For x = 0 To PicWidthL + For y = initY To finY + For x = initX To finX QuickVal = x * 3 r1 = ImageData(QuickVal + 2, y) g1 = ImageData(QuickVal + 1, y) @@ -261,26 +449,58 @@ Public Sub fGrayscaleCustomDither(ByVal NumToConvertTo As Long) ImageData(QuickVal, y) = CC Next x EV = 0 - If y Mod 20 = 0 Then SetProgBarVal y + If toPreview = False Then + If (y Mod 20 = 0) Then SetProgBarVal y + End If Next y - SetImageData - Message "Finished." + + If toPreview = True Then + SetPreviewData PicEffect + Else + SetImageData + Message "Finished." + End If + End Sub 'Reduce to gray via (r+g+b)/3 -Public Sub MenuGrayscaleAverage() +Public Sub MenuGrayscaleAverage(Optional ByVal toPreview As Boolean = False) + + 'Get the appropriate set of image data contingent on whether this is a preview or not + If toPreview = True Then + GetPreviewData PicPreview + Else + Message "Converting image to grayscale..." + GetImageData + SetProgBarMax PicWidthL + End If + Dim CurrentColor As Byte - Dim r As Integer, g As Integer, b As Integer - Message "Converting to grayscale..." - SetProgBarMax PicWidthL + Dim r As Long, g As Long, b As Long + Dim LookUp(0 To 765) As Byte For x = 0 To 765 LookUp(x) = x \ 3 Next x + + 'Calculate loop values based on previewing/not-previewing + Dim initX As Long, initY As Long, finX As Long, finY As Long + If toPreview = True Then + initX = PreviewX + finX = PreviewX + PreviewWidth + initY = PreviewY + finY = PreviewY + PreviewHeight + Else + initX = 0 + finX = PicWidthL + initY = 0 + finY = PicHeightL + End If + Dim QuickVal As Long - For x = 0 To PicWidthL + For x = initX To finX QuickVal = x * 3 - For y = 0 To PicHeightL + For y = initY To finY r = ImageData(QuickVal + 2, y) g = ImageData(QuickVal + 1, y) b = ImageData(QuickVal, y) @@ -289,65 +509,138 @@ Public Sub MenuGrayscaleAverage() ImageData(QuickVal + 1, y) = CurrentColor ImageData(QuickVal + 2, y) = CurrentColor Next y - If x Mod 20 = 0 Then SetProgBarVal x + If toPreview = False Then + If (x Mod 20 = 0) Then SetProgBarVal x + End If Next x - SetImageData - Message "Finished." + + If toPreview = True Then + SetPreviewData PicEffect + Else + SetImageData + Message "Finished." + End If + End Sub 'Reduce to gray in a more human-eye friendly manner -Public Sub MenuGrayscale() - Dim CurrentColor As Integer +Public Sub MenuGrayscale(Optional ByVal toPreview As Boolean = False) + + 'Get the appropriate set of image data contingent on whether this is a preview or not + If toPreview = True Then + GetPreviewData PicPreview + Else + Message "Generating ITU standard grayscale image..." + GetImageData + SetProgBarMax PicWidthL + End If + + Dim CurrentColor As Long Dim r As Long, g As Long, b As Long - Message "Generating ITU standard grayscale image..." - SetProgBarMax PicWidthL + + 'Calculate loop values based on previewing/not-previewing + Dim initX As Long, initY As Long, finX As Long, finY As Long + If toPreview = True Then + initX = PreviewX + finX = PreviewX + PreviewWidth + initY = PreviewY + finY = PreviewY + PreviewHeight + Else + initX = 0 + finX = PicWidthL + initY = 0 + finY = PicHeightL + End If + Dim QuickVal As Long - For x = 0 To PicWidthL + For x = initX To finX QuickVal = x * 3 - For y = 0 To PicHeightL + For y = initY To finY r = ImageData(QuickVal + 2, y) g = ImageData(QuickVal + 1, y) b = ImageData(QuickVal, y) CurrentColor = (222 * r + 707 * g + 71 * b) \ 1000 - ByteMe CurrentColor + ByteMeL CurrentColor ImageData(QuickVal, y) = CurrentColor ImageData(QuickVal + 1, y) = CurrentColor ImageData(QuickVal + 2, y) = CurrentColor Next y - If x Mod 20 = 0 Then SetProgBarVal x + If toPreview = False Then + If (x Mod 20 = 0) Then SetProgBarVal x + End If Next x - SetImageData - Message "Finished." + + If toPreview = True Then + SetPreviewData PicEffect + Else + SetImageData + Message "Finished." + End If + End Sub 'Reduce to gray via HSL -> convert S to 0 -Public Sub MenuDesaturate() +Public Sub MenuDesaturate(Optional ByVal toPreview As Boolean = False) + + 'Get the appropriate set of image data contingent on whether this is a preview or not + If toPreview = True Then + GetPreviewData PicPreview + Else + Message "Desaturating image..." + GetImageData + SetProgBarMax PicWidthL + End If + Dim r As Long, g As Long, b As Long Dim HH As Single, SS As Single, LL As Single - Message "Desaturating image..." - SetProgBarMax PicWidthL - SetProgBarVal 0 + + 'Calculate loop values based on previewing/not-previewing + Dim initX As Long, initY As Long, finX As Long, finY As Long + If toPreview = True Then + initX = PreviewX + finX = PreviewX + PreviewWidth + initY = PreviewY + finY = PreviewY + PreviewHeight + Else + initX = 0 + finX = PicWidthL + initY = 0 + finY = PicHeightL + End If + Dim QuickVal As Long - For x = 0 To PicWidthL + For x = initX To finX QuickVal = x * 3 - For y = 0 To PicHeightL + For y = initY To finY + 'Get the temporary values r = ImageData(QuickVal + 2, y) g = ImageData(QuickVal + 1, y) b = ImageData(QuickVal, y) - 'Get the hue and saturation + + 'Use the RGB values to calculate corresponding hue, saturation, and luminance values tRGBToHSL r, g, b, HH, SS, LL - 'Convert back to RGB using our artificial saturation value + + 'Set saturation to zero, then convert HSL back into RGB values tHSLToRGB HH, 0, LL, r, g, b + 'Assign those values into the array ImageData(QuickVal + 2, y) = r ImageData(QuickVal + 1, y) = g ImageData(QuickVal, y) = b Next y - If x Mod 20 = 0 Then SetProgBarVal x + If toPreview = False Then + If (x Mod 20 = 0) Then SetProgBarVal x + End If Next x - SetImageData - Message "Finished." + + If toPreview = True Then + SetPreviewData PicEffect + Else + SetImageData + Message "Finished." + End If + End Sub Private Sub hsShades_Change() @@ -361,6 +654,7 @@ End Sub Private Sub txtShades_Change() If EntryValid(txtShades, hsShades.Min, hsShades.Max, False, False) Then hsShades.Value = val(txtShades) + drawGrayscalePreview End If End Sub diff --git a/Modules/VBP_ProcessorModule.bas b/Modules/VBP_ProcessorModule.bas index 30263dd154..88b89462e9 100644 --- a/Modules/VBP_ProcessorModule.bas +++ b/Modules/VBP_ProcessorModule.bas @@ -73,7 +73,7 @@ Option Explicit Public Const GrayScale As Long = 301 Public Const GrayscaleAverage As Long = 302 Public Const GrayscaleCustom As Long = 303 - Public Const GrayscaleDitherCustom As Long = 304 + Public Const GrayscaleCustomDither As Long = 304 'Area filters; numbers 400-499 '-Blur @@ -442,7 +442,7 @@ Public Sub Process(ByVal pType As Long, Optional pOPCODE As Variant = 0, Optiona FormGrayscale.MenuGrayscaleAverage Case GrayscaleCustom FormGrayscale.fGrayscaleCustom pOPCODE - Case GrayscaleDitherCustom + Case GrayscaleCustomDither FormGrayscale.fGrayscaleCustomDither pOPCODE End Select End If diff --git a/PhotoDemon.exe b/PhotoDemon.exe index 1bd3c5beef..e38014d452 100644 Binary files a/PhotoDemon.exe and b/PhotoDemon.exe differ diff --git a/PhotoDemon.vbp b/PhotoDemon.vbp index 83cd9415b6..6d6260a27a 100644 --- a/PhotoDemon.vbp +++ b/PhotoDemon.vbp @@ -101,7 +101,7 @@ Description="PhotoDemon" CompatibleMode="0" MajorVer=4 MinorVer=3 -RevisionVer=26 +RevisionVer=27 AutoIncrementVer=1 ServerSupportFiles=0 VersionComments="©2000-2012 Tanner Helland - www.tannerhelland.com"