Picture Art

Category: Art

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#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 LongAs 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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm