Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "cgdiplus.inc"
Global hDlg, hBMP, hDC As Dword, imgW, imgH As Long, bmp$
Global pImage,pGraphics,token As Dword, StartupInput As GdiplusStartupInput
Global qFreq, qStart, qStop As Quad
%ID_Graphic = 500
%ID_Read = 501
%ID_Convert = 502
%ID_Save = 503
%ID_StatusBar = 504
Function PBMain() As Long
Dialog Font "Tahoma",10,0
Dialog New Pixels, 0, "Graphic Get/Set Bits Test",600,300,500,500, %WS_OverlappedWindow, 0 To hDlg
Control Add Button, hDlg, %ID_Read, "Read", 10,10,70,20
Control Add Button, hDlg, %ID_Convert, "Convert", 100,10,70,20
Control Add Button, hDlg, %ID_Save, "Save", 190,10,70,20
Control Add Graphic, hDlg, %ID_Graphic,"", 10,40,200,200, %WS_Border
Control Add Statusbar, hDlg, %ID_Statusbar,"", 0,0,0,0
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long
Select Case Cb.Msg
Case %WM_InitDialog
QueryPerformanceFrequency qFreq
'initialize GDIPlus
StartupInput.GdiplusVersion = 1
GdiplusStartup(token, StartupInput, ByVal %NULL)
Case %WM_Command
Select Case Cb.Ctl
Case %ID_Read
ReadImageFromFile Exe.Path$+"western12.jpg"
Graphic Attach hDlg, %ID_Graphic
Graphic Copy hBMP, 0
Statusbar Set Text hDlg, %ID_Statusbar, 1,0, Str$(imgW) + " x" + Str$(imgH)
Case %ID_Convert
QueryPerformanceCounter qStart
'---------------------------------------
ConvertToGrayScaleB
'---------------------------------------
QueryPerformanceCounter qStop
? Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
Graphic Attach hDlg, %ID_Graphic
Graphic Copy hBMP, 0
Case %ID_Save
SaveImageToFile Exe.Path$+"grayscale.jpg", "image/jpeg"
End Select
Case %WM_Size
Dialog Get Client hDlg To w,h
Control Set Client hDlg, %ID_Graphic, w-20,h-70
Graphic Set Bits bmp$
Case %WM_Destroy
'cleanup
If pImage Then GdipDisposeImage(pImage) 'GDIP cleanup
If pGraphics Then GdipDeleteGraphics(pGraphics) 'GDIP cleanup
'shut downn GDIPlus
GdiplusShutdown token ' Shutdown GDI+
End Select
End Function
Sub ReadImageFromFile(imgFileName As WStringZ * %Max_Path)
'load JPG/GIF/PNG image to memory bitmap from file
GdipLoadImageFromFile((imgFileName), pImage) 'pImage - image object
GdipGetImageWidth(pImage,imgW) 'get width
GdipGetImageHeight(pImage,imgH) 'get height
'create memory bitmap to hold the image
Graphic Bitmap New imgW,imgH To hBMP
Graphic Attach hBMP,0
Graphic Get DC To hDC 'hDC is for memory bitmap
GdipCreateFromHDC(hDC, pGraphics) 'create graphic object
GdipDrawImageRect(pGraphics, pImage, 0,0,imgW,imgH) 'draw image at 0,0
End Sub
Sub ConvertToGrayScale 'overlay 2D array on bit string
Local i,j,w,h,R,G,B,iColor As Long
'get the string from ID_Graphic1
Graphic Attach hBMP, 0
Graphic Get Bits To bmp$
'get width/height of image
w = Cvl(bmp$,1)
h = Cvl(bmp$,5)
'create overlay array
Dim BGRArray(w-1,h-1) As Long At StrPtr(bmp$)+8
'process the pixels (elements of the array)
For i = 0 To w-1
For j = 0 To h-1
Shift Left BGRArray(i,j),4
Shift Right BGRArray(i,j),4 'clear the Alpha value
iColor = BGRArray(i,j)
B = iColor Mod 256
G = (iColor\256) Mod 256
R = (iColor\256\256) Mod 256
iColor = 0.299*R + 0.587*G + 0.114*B
BGRArray(i,j) = Bgr(iColor,iColor,iColor)
Next j
Next i
'put the results back into the memory bitmap
Graphic Set Bits bmp$
End Sub
Sub SaveImageToFile(fName As WStringZ * %Max_Path, sMimeType As String)
Local sEncoderClsid As Guid, hBitmap, hGraphicDC As Dword
'get the DC of the memory bitmap into which the image was read
Graphic Attach hBMP, 0
Graphic Get DC To hDC
'get a bitmap/dc compatible with the GDI+ API
hBitmap = GetCurrentObject(hDC, %OBJ_Bitmap) 'from graphic target
GDIpCreateBitmapFromHBITMAP(hBitmap, ByVal %Null, pImage) 'create GDI+ image (pImage)
GdipCreateFromHDC hDC, pGraphics 'create graphic object containing Graphic Control
GdipDrawImageRect pGraphics, pImage, 0, 0, imgW, imgH 'use (0,0)-(140,110)
sEncoderClsid = Guid$(GDIPlusGetEncoderClsid((sMimeType)))
GdipSaveImageToFile pImage,fName, sEncoderClsid, ByVal %Null 'save to file
End Sub
Sub ConvertToGrayScaleB 'uses BYTE pointer/CVL solution
Local w,h,iColor,R,G,B,i As Long, bp As Byte Ptr, p As Long Ptr, bmp$
'get the string from ID_Graphic
Graphic Attach hBMP,0
Graphic Get Bits To bmp$
'get width/height of image
w = Cvl(bmp$,1)
h = Cvl(bmp$,5)
bp = StrPtr(bmp$)+8
p = bp
'get string position of coordinates and modify the string at that position
For i = 1 To w*h
B = @bp 'string BGR bytes positions are 0-R-G-B
Incr bp : G = @bp
Incr bp : R = @bp
Incr bp : Incr bp
iColor = 0.299*R + 0.587*G + 0.114*B 'create gray component
@p = Bgr(iColor,iColor,iColor) 'modify string at that position
Incr p
Next i
'put the modified string into ID_Graphic2
Graphic Set Bits bmp$
End Sub
'gbs_01423
'Date: 10-17-2014
http://www.garybeene.com/sw/gbsnippets.htm