Grayscale image: Difference between revisions
Content added Content deleted
m (→{{header|Phix}}: minor tidy) |
(=={{header|Visual Basic}}== Added Visual Basic code) |
||
Line 1,828: | Line 1,828: | ||
} |
} |
||
Return</lang> |
Return</lang> |
||
=={{header|Visual Basic}}== |
|||
{{works with|Visual Basic|5}} |
|||
{{works with|Visual Basic|6}} |
|||
<lang vb>Option Explicit |
|||
Private Type BITMAP |
|||
bmType As Long |
|||
bmWidth As Long |
|||
bmHeight As Long |
|||
bmWidthBytes As Long |
|||
bmPlanes As Integer |
|||
bmBitsPixel As Integer |
|||
bmBits As Long |
|||
End Type |
|||
Private Type RGB |
|||
Red As Byte |
|||
Green As Byte |
|||
Blue As Byte |
|||
Alpha As Byte |
|||
End Type |
|||
Private Type RGBColor |
|||
Color As Long |
|||
End Type |
|||
Public Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long |
|||
Public Declare Function GetObjectA Lib "gdi32.dll" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long |
|||
Public Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long |
|||
Public Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long |
|||
Public Declare Function SetPixel Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long |
|||
Public Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long |
|||
Sub Main() |
|||
Dim p As stdole.IPictureDisp |
|||
Dim hdc As Long |
|||
Dim bmp As BITMAP |
|||
Dim i As Long, x As Long, y As Long |
|||
Dim tRGB As RGB, cRGB As RGBColor |
|||
Set p = VB.LoadPicture("T:\TestData\Input_Colored.bmp") |
|||
hdc = CreateCompatibleDC(0) |
|||
GetObjectA p.Handle, Len(bmp), bmp |
|||
SelectObject hdc, p.Handle |
|||
For x = 0 To bmp.bmWidth - 1 |
|||
For y = 0 To bmp.bmHeight - 1 |
|||
cRGB.Color = GetPixel(hdc, x, y) |
|||
LSet tRGB = cRGB |
|||
i = (0.2126 * tRGB.Red + 0.7152 * tRGB.Green + 0.0722 * tRGB.Blue) |
|||
SetPixel hdc, x, y, RGB(i, i, i) |
|||
Next y |
|||
Next x |
|||
VB.SavePicture p, "T:\TestData\Output_GrayScale.bmp" |
|||
DeleteDC hdc |
|||
End Sub</lang> |
|||
=={{header|Visual Basic .NET}}== |
=={{header|Visual Basic .NET}}== |