Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
%IDC_Graphic = 500
%ID_Timer = 501
Global hDlg, hFont, hDC As Dword, R,R2,ROI As Rect, pText As String
Global pL,pT,pR,pB As Single, ReSizeInWork,AllowAnimation As Long
Function PBMain() As Long
Dialog New Pixels, 0, "Region of Interest",300,300,300,300, %WS_OverlappedWindow To hDlg
Control Add Graphic, hDlg, %IDC_Graphic,"",0,0,300,300
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long
Static OldAllowAnimation As Long
Select Case Cb.Msg
Case %WM_InitDialog
Settings_INI "get"
SetTimer hDlg, %ID_Timer, 100, ByVal %Null
Case %WM_Destroy
KillTimer hDlg, %ID_Timer
Case %WM_Timer
If AllowAnimation Then DisplayAnimation
Case %WM_Destroy
Settings_INI "save"
Case %WM_LButtonDblClk
AllowAnimation = AllowAnimation Xor 1
If AllowAnimation = 0 Then DrawContent
Case %WM_Size
ReSizeInWork = 1
Dialog Get Client hDlg To w,h
Control Set Size hDlg, %IDC_Graphic,w,h
ROI.nLeft = pL * w : ROI.nRight = pR * w
ROI.nTop = pT * h : ROI.nBottom = pB * h
SetMainFontSize
If AllowAnimation = 0 Then DrawContent
ReSizeInWork = 0
Case %WM_RButtonDown
R.nLeft = Lo(Word, Cb.LParam) : R.nTop = Hi(Word, Cb.LParam)
OldAllowAnimation = AllowAnimation
AllowAnimation = 0
Case %WM_MouseMove
R.nRight = Lo(Word, Cb.LParam) : R.nBottom = Hi(Word, Cb.LParam)
If (Cb.WParam And %MK_RBUTTON) Then DrawRect 1 '1 means erase old line AND draw new line
Case %WM_RButtonUp
DrawRect 0 '0 means erase old line, but not draw new one
SetMainFontSize
DrawContent
AllowAnimation = OldAllowAnimation
End Select
End Function
Sub DrawRect(Flag As Long) '1=moving 0=done
'erase the old focus rectangle, draw the new focus rectangle, save the new rect as ROI
Local w,h As Long
Dialog Get Client hDlg To w,h
hDC = GetDC(hDlg)
DrawFocusRect hDC, R2 'remove the previous rectangle
ROI.nLeft = Min(R.nLeft,R.nRight) 'these 4 lines allow mouse to move in any direction
ROI.nRight = Max(R.nLeft,R.nRight)
ROI.nTop = Min(R.nTop,R.nBottom)
ROI.nBottom = Max(R.nTop,R.nBottom)
pL = ROI.nLeft / w : pT = ROI.nTop / h
pR = ROI.nRight / w : pB = ROI.nBottom / h
If Flag Then DrawFocusRect hDC, ROI : R2 = ROI Else Reset R2
ReleaseDC hDlg, hDC
End Sub
Sub DrawContent
'draw the text, centered within the ROI rectangle
Local x,y,w,h As Long
Dialog Get Client hDlg To w,h
pText = "Region"
Graphic Style 2
Graphic Clear
Graphic Color -1,-2
Graphic Render "dive.bmp", (0,0)-(w,h)
Graphic Box (ROI.nLeft,ROI.nTop)-(ROI.nRight,ROI.nBottom), , %Red
Graphic Text Size pText To x,y
Graphic Set Pos (ROI.nLeft + (ROI.nRight-ROI.nLeft-x)/2, ROI.nTop + (ROI.nBottom-ROI.nTop-y)/2)
Graphic Print pText
Graphic ReDraw
End Sub
Sub SetMainFontSize
'set font size so that text will fit within the ROI rectangle
' Local Lower,Upper,x,y,fSize As Long
Local Lower,Upper,fSize,x,y As Single ', x,y AS Long
Lower = 1 : Upper = 1000
Do Until (Upper <= (Lower + 1))
fSize = (Lower + Upper) / 2
Font New "Consolas", fSize, 1 To hFont
Graphic Set Font hFont
Graphic Text Size pText To x,y
If (x < 0.8*(ROI.nRight-ROI.nLeft)) And (y < 0.8*(ROI.nBottom-ROI.nTop)) Then
Lower = fSize 'fits inside
Else
Upper = fSize 'goes outside
End If
Loop
End Sub
Sub Settings_INI(task$)
'save the ROI in an INI file for the next session
Local xResult, yResult, tempZ, INIFileName As AsciiZ*%Max_Path, x,y As Long
INIFileName = Exe.Path$ + Exe.Name$ + ".ini"
If task$ = "get" Then
'get dialog top/left from INI file and use to set Dialog location
GetPrivateProfileString "All", "Left", "300", xResult, %Max_Path, INIFileName
GetPrivateProfileString "All", "Top", "300", yResult, %Max_Path, INIFileName
Dialog Set Loc hDlg, Val(xResult$), Val(yResult$) 'left/top
'get dialog width/height from INI file and use to set Dialog size
GetPrivateProfileString "All", "Width", "400", xResult, %Max_Path, INIFileName
GetPrivateProfileString "All", "Height", "200", yResult, %Max_Path, INIFileName
Dialog Set Size hDlg,Val(xResult$), Val(yResult$) 'width/height
GetPrivateProfileString "All", "ROIT", "0", tempz, %Max_Path, INIFileName : ROI.nTop = Val(tempz)
GetPrivateProfileString "All", "ROIL", "0", tempz, %Max_Path, INIFileName : ROI.nLeft = Val(tempz)
GetPrivateProfileString "All", "ROIR", "0", tempz, %Max_Path, INIFileName : ROI.nRight = Val(tempz)
GetPrivateProfileString "All", "ROIB", "0", tempz, %Max_Path, INIFileName : ROI.nBottom = Val(tempz)
GetPrivateProfileString "All", "pL", "0", tempz, %Max_Path, INIFileName : pL = Val(tempz)
GetPrivateProfileString "All", "pT", "0", tempz, %Max_Path, INIFileName : pT = Val(tempz)
GetPrivateProfileString "All", "pR", "0", tempz, %Max_Path, INIFileName : pR = Val(tempz)
GetPrivateProfileString "All", "pB", "0", tempz, %Max_Path, INIFileName : pB = Val(tempz)
Else
'save dialog size/location unless minimized or maximized
If IsFalse(IsIconic(hDlg) Or IsZoomed(hDlg)) Then
Dialog Get Loc hDlg To x,y
WritePrivateProfileString "All", "Left", Str$(x), INIFileName
WritePrivateProfileString "All", "Top", Str$(y), INIFileName
Dialog Get Size hDlg To x,y
WritePrivateProfileString "All", "Width", Str$(x), INIFileName
WritePrivateProfileString "All", "Height", Str$(y), INIFileName
End If
WritePrivateProfileString "All", "ROIT", (Str$(ROI.nTop)), INIFileName
WritePrivateProfileString "All", "ROIL", (Str$(ROI.nLeft)), INIFileName
WritePrivateProfileString "All", "ROIR", (Str$(ROI.nRight)), INIFileName
WritePrivateProfileString "All", "ROIB", (Str$(ROI.nBottom)), INIFileName
WritePrivateProfileString "All", "pL", (Str$(pL)), INIFileName
WritePrivateProfileString "All", "pT", (Str$(pT)), INIFileName
WritePrivateProfileString "All", "pR", (Str$(pR)), INIFileName
WritePrivateProfileString "All", "pB", (Str$(pB)), INIFileName
End If
End Sub
Sub DisplayAnimation
'do something inside ROI
If ReSizeInWork Then Exit Sub
Local i,BarW,w,h As Long
Static iCount As Single
Dialog Get Client hDlg To w,h
BarW = (ROI.nRight-ROI.nLeft)\20
Dim Bars((ROI.nRight-ROI.nLeft)/BarW) As Single
Graphic Style 0
Graphic Clear
Graphic Render "dive.bmp", (0,0)-(w,h)
Graphic Box (ROI.nLeft,ROI.nTop)-(ROI.nRight,ROI.nBottom),, %rgb_Black,%rgb_DarkGray
For i = 1 To UBound(Bars)
'set bar heights (value of 0-1
Bars(i) = Abs(Sin(iCount + i*0.06))
'plot each bar
Graphic Box (ROI.nLeft+(i-1)*BarW, ROI.nTop+(ROI.nBottom-ROI.nTop)*(1-Bars(i))) _
-(ROI.nLeft + i*BarW - 2, ROI.nBottom),, %rgb_DarkSlateGray,%rgb_DarkSlateGray
Next i
Graphic ReDraw
iCount = iCount + 0.06
End Sub
'gbs_00888
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm