Uses "UI"Uses "gdip"
Uses "File"
' -- ID numbers of controls
Begin ControlID
%cCanvasDB
%tAnimationTimer
End ControlID
Global Images() As DWord
Global nFiles As Long
Global nFrame As Long
'----------------------------------------------------------
'---Dialog Callback for the main window
'----------------------------------------------------------
Function TBMain()
Local hDlg As DWord
Local i As Long
Dim sFiles() As String
' Load all images from the directory
' ---CHANGE AS NEEDED---
nFiles = DIR_ListArray(sFiles, APP_ScriptPath & "images\", "*.jpg", %FILE_NORMAL Or %FILE_ADDPATH)
If nFiles Then
ReDim Images(nFiles)
For i = 1 To nFiles
Images(i) = GDIp_LoadImageFromFile(sFiles(i))
Next i
Else
Beep
Exit Function
EndIf
' Dialog New Pixels, 0, "GDI+ and Canvas Demo",-1,-1, 720, 480, _
' %WS_POPUP Or %WS_VISIBLE Or _
' %WS_CLIPCHILDREN Or %WS_CAPTION Or _
' %WS_SYSMENU Or %WS_MINIMIZEBOX To hDlg
Dialog New Pixels, 0, "thinBasic using GDI+", -1, -1, 720, 480, _
%WS_OVERLAPPEDWINDOW Or %WS_CLIPCHILDREN, _
0 To hDlg
Dialog Show Modal hDlg, Call dlgProc
End Function
'----------------------------------------------------------
'---Dialog Callback for the main window
'----------------------------------------------------------
CallBack Function dlgProc() As Long
Static idxImage As long
Local cx, cy As Long
'---
Select Case CBMSG
Case %WM_INITDIALOG
'Dialog Get Client CBHNDL To cx, cy
''---Place controls here
'Control Add Canvas, CBHNDL, %cCanvasDB, "", 0, 0, cx, cy
'---
Dialog Set Timer CBHNDL, %tAnimationTimer, 10, %NULL
idxImage = 1
Image_Draw(CBHNDL, idxImage)
Case %WM_SIZE
'---At every window resize ... delete canvas control and recreate it the same size as the window client area
Dialog Get Client CBHNDL To cx, cy
'---Place controls here
Control Kill CBHNDL, %cCanvasDB
Control Add Canvas, CBHNDL, %cCanvasDB, "", 0, 0, cx, cy
Case %WM_TIMER
Image_Draw(CBHNDL, idxImage)
idxImage += 1
If idxImage > UBound(Images) Then
idxImage = 1
EndIf
Case %WM_CLOSE
Images_Dispose
End Select
End Function
'----------------------------------------------------------
'---
'----------------------------------------------------------
Function Images_Load() As Long
End Function
'----------------------------------------------------------
'---
'----------------------------------------------------------
Function Images_Dispose() As Long
Local lIdx As Long
'---Clear allocated memory for images
For lIdx = 1 To UBound(Images)
GDIp_DisposeImage(Images(lIdx))
Next i
End Function
'----------------------------------------------------------
'---
'----------------------------------------------------------
Function Image_Draw(ByVal hDlg As DWord, ByVal ImageIndex As DWord)
Dim pGraphics As DWord
Dim pThumbnail As DWord
Dim hDC As DWord
Local cx, cy As Long
If ImageIndex < 1 Or ImageIndex > UBound(Images) Then
Exit Function
End If
Canvas_Attach(hDlg, %cCanvasDB, %TRUE)
Canvas_Clear(Rgb(0,0,0), %CANVAS_FILLSTYLE_SOLID)
hDC = Canvas_GetDC
pGraphics = GDIp_CreateFromHDC(hdc)
Dialog Get Client hDlg To cx, cy
'---Create a thumbnail the same size of the dialog client size
pThumbnail = GDIp_GetImageThumbnail(Images(ImageIndex), cx, cy)
'GDIp_DrawImage(pGraphics, Images(ImageIndex), 1, 1)
GDIp_DrawImage(pGraphics, pThumbnail, 1, 1)
Canvas_Redraw
GDIp_DisposeImage(pThumbnail)
GDIp_DeleteGraphics(pGraphics)
End Function
Bookmarks