Region of Interest

Category: Miscellaneous

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
%IDC_Graphic = 500
Global hDlg, hFont, hDC As Dword, R,R2,ROI As Rect, pText As String
Global pL,pT,pR,pB As Single
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Draw Rectangle",300,300,300,300, %WS_OverlappedWindow To hDlg
   Control Add Graphic, hDlg, %IDC_Graphic,"",0,0,300,300
   Graphic Attach hDlg, %IDC_Graphic
   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
         Settings_INI "get"
      Case %WM_Destroy
         Settings_INI "save"
      Case %WM_Size
         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
         DrawContent
      Case %WM_RButtonDown
         R.nLeft = Lo(Word, Cb.LParam)   : R.nTop  = Hi(Word, Cb.LParam)
      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
   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 i,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
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$ = "getThen
      '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
 
'gbs_00887
'Date: 03-10-2012


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