Graphic Control - Image Gallery

Category: Controls - .Techniques

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
 
#Include "win32api.inc"
#Include "cgdiplus.inc"
 
%IDC_Graphic = 500
%IDM_Escape  = 501
 
Global hDlg, hGraphic, hBMPSolo, hDCSolo, hIcon As Dword
Global SimpleMenu, GalleryCount, wSolo, hSolo, wGrid, hGrid As Long
Global GalleryCFN$, ListData() As String, Cells() As Rect
Global pImage, pGraphics, token As Dword
Global StartupInput As GdiplusStartupInput
 
Function PBMain()
 
   Dialog Default Font "Arial Black", 12, 1   'for toolbar
   Dialog New Pixels, 0, "Gallery",,,1400,1000, %WS_SysMenu To hDlg
 
   Control Add Graphic, hDlg, %IDC_Graphic, "", 0, 0, 1400,1000, %SS_Notify
   Control Handle hDlg, %IDC_Graphic To hGraphic
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
   Dialog Show Modal hDlg Call GalleryDlgProc
End Function
 
CallBack Function GalleryDlgProc() As Long
   Local pt As Point, rc As Rect, temp$
   Select Case Cb.Msg
      Case %WM_InitDialog
         wGrid = 3 : hGrid = 3   'size of grid holding images
         hIcon = LoadIcon(ByVal %Null, ByVal %IDI_Information)  'use a system icon for the dialog
         SendMessage hDlg, %WM_SetIcon, %ICON_BIG, hIcon        'use a system icon for the dialog
         BuildAcceleratorTable
         'initialize GDI
         StartupInput.GdiplusVersion = 1                    'initialize GDIPlus
         GdiplusStartup(token, StartupInput, ByVal %NULL)   'initialize GDIPlus
         GalleryGetFileList
         BuildGalleryCells
         DrawGallery
 
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDM_Escape     : sBeep : Dialog End hDlg
            Case %IDC_Graphic    : sBeep : GalleryGraphicClick
         End Select
 
      Case %WM_ContextMenu       : sBeep : Dialog End hDlg
   End Select
End Function
 
Sub DrawGallery
   Local w,h As Long
   Graphic Color %Black, %Gray
   Graphic Clear
   Graphic Font "Arial Black", 68, 1
   Select Case SimpleMenu
      Case 0
         DrawFolderMontage
      Case Else
         GalleryLoadSoloFromFile GalleryCFN     'create hBMPSolo, hDCSolo, wSolo, hSolo
         Control Get Client hDlg, %IDC_Graphic To w,h
         GalleryDisplaySolo 0,0,w,h                             'put hBMPSolo in container bounded by x,y,w,h ... keep AR
   End Select
   Graphic ReDraw
End Sub
 
Sub GalleryGraphicClick
   Local i As Long, pt As Point
   If UBound(ListData) = 0 Then sBeep : Exit Sub
 
   If SimpleMenu = 0 Then
      'show selected image
      GetCursorPos pt : ScreenToClient hGraphic, pt
      For i = 1 To UBound(Cells)
         If PtinRect(Cells(i),pt) Then Exit For
      Next i
      If i > GalleryCount Then sBeep : Exit Sub
      GalleryCFN = ListData(i)
      SimpleMenu = 1
   Else
      SimpleMenu = 0
   End If
   DrawGallery
 
End Sub
 
Sub GalleryGetFileList
   Local temp$, Extension$
   ReDim ListData(5000)
   GalleryCount = 0
 
   temp$ = Dir$("*.*", %SubDir)
   While Len(temp$)
      Extension$ = LCase$(PathName$(Extn,temp$))
      If Extension$ <> ".exeAnd Extension$ <> ".basThen
         Incr GalleryCount
         ListData(GalleryCount) = temp$
      End If
      temp$ = Dir$(Next)
   Wend
   ReDim Preserve ListData(GalleryCount)
End Sub
 
Sub BuildGalleryCells
   Local i,j,iPos,w,h As Long, temp$
   Control Get Client hDlg, %IDC_Graphic To w,h
   w = w/wGrid : h = h/hGrid
   ReDim Cells(wGrid * hGrid)
   For j = 1 To hGrid
      For i = 1 To wGrid
         Incr iPos
         Cells(iPos).nLeft  = (i-1)*w
         Cells(iPos).nRight = Cells(iPos).nLeft + w
         Cells(iPos).nTop   = (j-1)*h
         Cells(iPos).nBottom = Cells(iPos).nTop + h
      Next j
   Next i
End Sub
 
Sub DrawFolderMontage
   Local i,iCount,x,y,wCell,hCell,m As Long, temp$
   'draw box around each cell
   For i = 1 To UBound(Cells)
      Graphic Box (Cells(i).nLeft,Cells(i).nTop)-(Cells(i).nRight,Cells(i).nBottom),, %Black
   Next i
 
   'display each file in a cell
   m = 5   'margin
   For i = 1 To UBound(ListData)
      x = Cells(i).nLeft
      y = Cells(i).nTop
      wCell = Cells(i).nRight  - x
      hCell = Cells(i).nBottom - y
      GalleryLoadSoloFromFile ListData(i)
      GalleryDisplaySolo x+m, y+m, wCell-2*m, hCell-2*m    'put hBMPSolo in container bounded by x,y,w,h ... keep AR
 
   Next i
End Sub
 
Sub GalleryLoadSoloFromFile(fName$)
   'load JPG/GIF/PNG image to memory bitmap from file
   GdipLoadImageFromFile((fName$), pImage)  'pImage - image object
   GdipGetImageWidth(pImage,wSolo)          'get width
   GdipGetImageHeight(pImage,hSolo)         'get height
 
   'get rid of existing hBMPSolo Memory Bitmap
   If hBMPSolo Then
      Graphic Attach hBMPSolo, 0
      Graphic Bitmap End : hBMPSolo = 0
   End If
 
   'create memory bitmap for holding the image
   Graphic Bitmap New wSolo,hSolo To hBMPSolo
   Graphic Attach hBMPSolo,0
   Graphic Get DC To hDCSolo                                 'hDC is for memory bitmap
   GdipCreateFromHDC(hDCSolo, pGraphics)                     'create graphic object
   GdipDrawImageRect(pGraphics, pImage, 0,0,wSolo,hSolo)     'draw image at 0,0
 
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
End Sub
 
Sub GalleryDisplaySolo(x As Long, y As Long, wCont As Long, hCont As Long)
   Local wNew, hNew, xNew, yNew As Long
   Graphic Attach hDlg, %IDC_Graphic, ReDraw
   'get new width to fit in Gallery cell with same AR
   'wCont,hCont = container size : hImg,wImg = original image size : wNew,hNew = image size to fit in container
   wNew = wSolo / Max(wSolo / wCont, hSolo / hCont)
   hNew = hSolo / Max(wSolo / wCont, hSolo / hCont)
   xNew = x + (wCont-wNew)/2
   yNew = y + (hCont-hNew)/2
   Graphic Stretch hBMPSolo, 0, (0,0)-(wSolo,hSolo) To (xNew,yNew)-(xNew+wNew,yNew+hNew), %Mix_CopySrc, %HalfTone
   Graphic ReDraw
End Sub
 
Sub sBeep
   WinBeep (250,300)
End Sub
 
Sub BuildAcceleratorTable
   Local c As Long, ac() As ACCELAPI, hAccelerator As Dword  ' for keyboard accelator table values
   Dim ac(0)
   ac(c).fvirt = %FVIRTKEY               : ac(c).key   = %VK_Escape         : ac(c).cmd   = %IDM_Escape       : Incr c   '0
   Accel Attach hDlg, AC() To hAccelerator
End Sub


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