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"
%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 = 4 : 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
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
ResetGridSize
BuildGalleryCells
DrawFolderMontage
Case Else
Graphic Set Fixed
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
pt.x = pt.x + Graphic(View.X)
pt.y = pt.y + Graphic(View.Y)
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$ <> ".exe" And Extension$ <> ".bas" Then
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
Graphic Get Canvas 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
Sub ResetGridSize
Local w,h As Long
'get new hGrid (number of rows)
hGrid = UBound(ListData) / wGrid
If hGrid * wGrid < UBound(ListData) Then Incr hGrid
Control Get Client hDlg, %IDC_Graphic To w,h
Graphic Set Virtual w,hGrid*(w/wGrid)
End Sub
http://www.garybeene.com/sw/gbsnippets.htm