Date: 02-16-2022
Return to Index
#Compiler PBWin 10
created by gbSnippets
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
Enum Equates Singular
IDC_Button = 500
IDC_FitImage
IDC_Plus
IDC_Minus
IDC_100
IDC_Graphic
End Enum
Global hDlg As Dword, Zoom As Single, FitImage As Long, fName$
Function PBMain() As Long
Dialog Default Font "Tahoma", 12
Dialog New Pixels, 0, "PowerBASIC",300,300,600,440, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Button,"Display", 10,5,100,25
Control Add Button, hDlg, %IDC_Plus,"Zoom In", 130,5,100,25
Control Add Button, hDlg, %IDC_Minus,"Zoom Out", 250,5,100,25
Control Add Button, hDlg, %IDC_100,"Zoom 100%", 370,5,100,25
Control Add Button, hDlg, %IDC_FitImage,"Fit Image", 490,5,100,25
Control Add Graphic, hDlg, %IDC_Graphic, "", 0,40,600,400, %WS_Border Or %SS_Notify
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long
Select Case Cb.Msg
Case %WM_InitDialog
FitImage = 1
Zoom = 1
fName$ = "chess.bmp"
Case %WM_Command
Select Case Cb.Ctl
Case %IdCancel : Dialog End hDlg
Case %IDC_FitImage : FitImage Xor=1 : DisplayImage_BMPDDT : SetCaption
Case %IDC_Plus : FitImage = 0 : Zoom += 0.25 : Zoom = Min(3,Zoom) : DisplayImage_BMPDDT : SetCaption
Case %IDC_Minus : FitImage = 0 : Zoom -= 0.25 : Zoom = Max(0.25, Zoom) : DisplayImage_BMPDDT : SetCaption
Case %IDC_100 : FitImage = 0 : Zoom = 1 : DisplayImage_BMPDDT
End Select
Case %WM_Size
Dialog Get Client hDlg To w,h
Control Set Size hDlg, %IDC_Graphic, w, h-40
DisplayImage_BMPDDT : SetCaption
End Select
End Function
Sub SetCaption : Dialog Set Text hDlg, fName$ + " Zoom: " + Format$(Zoom,"0.00") + " FitImage:" + Str$(FitImage) : End Sub
Sub DisplayImage_BMPDDT
Local iRow, x,y, wNew, hNew, wImg, hImg, wViewer, hViewer As Long, hBMP As Dword
'Draw Selected image to fit inside
Graphic Clear
If IsFalse IsFile(fName$) Then Beep : Exit Sub
Graphic Get Client To wViewer, hViewer
Graphic Bitmap Load fName$, 0, 0 To hBMP
Graphic Attach hBMP, 0
Graphic Get Canvas To wImg, hImg
If FitImage Then
wNew = wImg / Max(wImg / wViewer, hImg / hViewer)
hNew = hImg / Max(wImg / wViewer, hImg / hViewer)
Else
wNew = wImg * Zoom
hNew = hImg * Zoom
End If
x = (wViewer - wNew)/2
y = (hViewer - hNew)/2
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Graphic Stretch hBMP, 0, (0,0)-(wImg,hImg) To (x,y)-(x+wNew,y+hNew), %Mix_CopySrc, %HalfTone
Graphic Attach hBMP, 0
Graphic Bitmap End
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Graphic ReDraw
End Sub
Sub ReadJPG_to_MemoryBitmapImageFromFile(imgFileName As WStringZ * %Max_Path)
'load JPG/GIF/PNG image to memory bitmap from file
Local pImage,pGraphics,token As Dword, StartupInput As GdiplusStartupInput
'initialize GDIPlus
StartupInput.GdiplusVersion = 1
GdiplusStartup(token, StartupInput, ByVal %NULL)
'load image/get properties
GdipLoadImageFromFile((imgFileName), pImage) 'pImage - image object
GdipGetImageWidth(pImage,imgW) 'get width
GdipGetImageHeight(pImage,imgH) 'get height
Graphic Bitmap New imgW,imgH To hBMP
Graphic Attach hBMP,0
Graphic Get DC To hDC 'hDC is for memory bitmap
GdipCreateFromHDC(hDC, pGraphics) 'create graphic object
GdipDrawImageRect(pGraphics, pImage, 0,0,imgW,imgH) 'draw image at 0,0
'GdipDrawImage(pGraphics, pImage, 0,0) 'draw image at 0,0
'cleanup
If pImage Then GdipDisposeImage(pImage) 'GDIP cleanup
If pGraphics Then GdipDeleteGraphics(pGraphics) 'GDIP cleanup
'shut downn GDIPlus
GdiplusShutdown token ' Shutdown GDI+
End Sub
http://www.garybeene.com/sw/gbsnippets.htm