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
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$ = "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
'gbs_00887
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm