Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Debug Error On 'catch array/pointer errors - OFF in production
#Debug Display On 'display untrapped errors - OFF in production
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"
%IDC_gSource = 500
%IDC_gTarget = 600
%IDC_gEndTarget = 601
%IDC_Button = 700
%IDC_Bitmap = 701
%IDC_BitmapAvgColor = 702
%IDC_SourceColor = 703
%IDC_Label = 704
Global hDlg, hImgList, hBMP, hEndTarget, hSource As Dword, DisplayedImage(), ImageColors() As Long
Function PBMain() As Long
Dialog New Pixels, 0, "Picture Art",300,100,950,830, %WS_OverlappedWindow To hDlg
'source image from file
Control Add Graphic, hDlg, %IDC_gSource,"", 10,10,100,100, %SS_Notify
Control Handle hDlg, %IDC_gSource To hSource
Graphic Attach hDlg, %IDC_gSource
Graphic Render "cowgirl.bmp", (0,0)-(99,99)
Control Add Label, hDlg, %IDC_Label, "Bitmap:",10,170,60,20
Control Add Graphic, hDlg, %IDC_Bitmap,"", 80,170,32,32, %WS_Border 'small bitmap from gEndTarget
Control Add Label, hDlg, %IDC_Label, "Avg Color:",10,220,60,20
Control Add Label, hDlg, %IDC_BitmapAvgColor,"", 80,220,32,32, %WS_Border 'avg color of the small bitmap
Control Add Label, hDlg, %IDC_Label, "Source Color:",10,270,70,20
Control Add Label, hDlg, %IDC_SourceColor,"", 80,270,32,32, %WS_Border 'pixel color from soure image
Control Add Graphic, hDlg, %IDC_gEndTarget,"", 130,10,800,800, %SS_Notify
Graphic Attach hDlg, %IDC_gEndTarget
Control Handle hDlg, %IDC_gEndTarget To hEndTarget
Graphic Bitmap New 3200,3200 To hBMP
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local pt As Point,z,iColor As Long
Select Case Cb.Msg
Case %WM_InitDialog
ReDim ImageColors(100), DisplayedImage(100,100)
CreateImageList
SetImageAverageColors
CreatePictureArt
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_gSource, %IDC_gEndTarget
If Cb.CtlMsg = %STN_Clicked Then
GetCursorPos pt 'pt has xy screen coordinates
If Cb.Ctl = %IDC_gSource Then
ScreenToClient hSource, pt 'pt now has dialog client coordinates
Else
ScreenToClient hEndTarget, pt 'pt now has dialog client coordinates
pt.x = pt.x * 4 \32
pt.y = pt.y * 4 \32
End If
z = DisplayedImage(pt.x,pt.y)
'display full size selected image and the average color
Graphic Attach hDlg, %IDC_Bitmap
Graphic ImageList (0,0), hImgList, z, 0&, %ILD_Normal
Control Set Color hDlg, %IDC_BitmapAvgColor, ImageColors(z), ImageColors(z)
Graphic Attach hDlg, %IDC_gSource
Graphic Get Pixel (pt.x,pt.y) To iColor
Control Set Color hDlg, %IDC_SourceColor, iColor, iColor
Dialog ReDraw hDlg
End If
End Select
End Select
End Function
Sub SetImageAverageColors
Local i,j,R,G,B,w,h,iTemp As Long, hTemp As Dword, bmp$
Local PixelPtr As Long Ptr
Graphic Bitmap New 32,32 To hTemp
Graphic Attach hTemp,0
'get average RGB values across all pixels in each imagelist bitmap
For i = 1 To UBound(ImageColors)
R=0 : G=0 : B=0
Graphic ImageList (0,0),hImgList,i,0&,%ILD_Normal 'get bitmap from imagelist
Graphic Get Bits To bmp$
w = Cvl(bmp$,1) : h = Cvl(bmp$,5)
PixelPtr = StrPtr(bmp$) + 8
For j = 1 To w*h
iTemp = RGB(@PixelPTR)
R = R + GetRValue(iTemp)
G = G + GetGValue(iTemp)
B = B + GetBValue(iTemp)
Incr PixelPTR
Next j
ImageColors(i) = RGB(R/(w*h),G/(w*h),B/(w*h))
Next i
End Sub
Sub CreatePictureArt
'for each pixel, add a random 0/1, colored to match that of the pixel
Local hFont As Dword, i,j,x,y,w,h,iColor,iResult,iCount,pWidth,pHeight As Long, bmp$
Local PixelPtr As Long Ptr, t As String
Graphic Attach hDlg, %IDC_gSource
Graphic Get Bits To bmp$ 'color data from image
w = Cvl(bmp$,1) : h = Cvl(bmp$,5)
PixelPtr = StrPtr(bmp$) + 8
Graphic Attach hBMP, 0, ReDraw 'set target font to fixed-width
pWidth = 32 : pHeight = 32
For i = 1 To w*h
iColor = RGB(@PixelPTR)
Incr PixelPtr : Incr iCount
Graphic Get Pos To x,j 'j is throwaway number
iResult = BestMatch(iColor)
DisplayedImage(i Mod 100, i\100) = iResult 'store index for later retrieval
Graphic ImageList ((i Mod w)*pHeight,y), hImgList, iResult, 0&, %ILD_Normal
If iCount Mod w = 0 Then y = y + 32
Next
Graphic ReDraw
Graphic Attach hDlg, %IDC_gEndTarget
Graphic Stretch hBMP,0,(0,0)-(3200,3200) To (0,0)-(800,800) ,%Mix_CopySrc, %HalfTone
End Sub
Function BestMatch(iColor As Long) As Long
'return index of image whose average color is closest to iColor
Local i,R,G,B,RI,GI,BI,iTestValue,tempDelta,iHome,Delta As Long
R = GetRValue(iColor) : G = GetGValue(iColor) : B = GetBValue(iColor)
Delta = 255*255 + 255*255 + 255*255
For i = 1 To 100
RI = GetRValue(ImageColors(i))
GI = GetGValue(ImageColors(i))
BI = GetBValue(ImageColors(i))
tempDelta = (RI-R)*(RI-R) + (GI-G)*(GI-G) + (BI-B)*(BI-B)
If tempDelta < Delta Then Delta = tempDelta : Function = i
Next i
' Function = Rnd(0,100)
End Function
Sub CreateImageList()
'create imagelist w,h,depth,size
Local i As Long
ImageList New Icon 32,32,32,100 To hImgList
For i = 1 To 100
ImageList Add Icon hImgList, "mos" + Format$(i,"000")
Next i
End Sub
'gbs_00858
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm