Region of Interest II

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
%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$ = "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
 
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


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