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"
#Resource "ruler.pbr"
Type CustomColors
c(15) As Long
End Type
%IDM_Vertical = 501
%IDM_Horizontal = 502
%IDM_Direction = 503
%IDM_Exit = 504
%IDM_Sep = 505
%IDM_OnTop = 506
%IDM_Pixels = 507
%IDM_Inches = 508
%IDM_FG = 509
%IDM_BG = 510
%IDM_Default = 511
%IDM_Minimize = 512
%IDM_Dim = 513
%IDM_Right = 550
%IDM_Left = 551
%IDM_Up = 552
%IDM_Down = 553
%IDM_sRight = 554
%IDM_sLeft = 555
%IDM_sUp = 556
%IDM_sDown = 557
Global hDlg, hDC, hBMP, hBMPDC, hContext As Dword
Global resizePT, pt As PointAPI, CustomColorList as CustomColors
Global startX, startY, Layout, Direction, ResizeInWork As Long
Global OnTop, ScaleUnits, cFore, cBack, cBG, DimOnLostFocus As Long
Function PBMain() As Long
Dialog New Pixels, 0, "Ruler",300,300,400,50, %WS_Popup + %WS_Border, To hDlg
Dialog Set Icon hDlg, "ruler"
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local x,y,w,h As Long, PS As PaintStruct, R As Rect
Select Case Cb.Msg
Case %WM_InitDialog
BuildAcceleratorTable
Settings_INI "get"
cBG = cBack
CreatehBMP
CreateContextMenu
AdjustFeatures
If OnTop Then SetWindowPos hDlg, %HWND_TOPMOST, 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
Menu Set State hContext, ByCmd %IDM_OnTop, OnTop * 8
Menu Set State hContext, ByCmd %IDM_Dim, DimOnLostFocus * 8
Case %WM_LButtonDblClk
Dialog Set Loc hDlg, 300,300 : Dialog Set Size hDlg,440,35
Case %WM_Size
DrawRuler
Dialog Redraw hDlg
Case %WM_KillFocus
If DimOnLostFocus Then
cBG = cBack
cBack = %RGB_GainsBoro
CreatehBMP : DrawRuler : Dialog Redraw hDlg
End If
Case %WM_SetFocus
If DimOnLostFocus Then
cBack = cBG
CreatehBMP : DrawRuler : Dialog Redraw hDlg
End If
Case %WM_ContextMenu
x = Lo(Integer,Cb.LParam) : y = Hi(Integer, Cb.LParam) 'WM_ContextMenu returns xy coordinates of mouse
TrackPopupMenu hContext, %TPM_LEFTALIGN, x, y, 0, hDlg, ByVal 0 'put context menu where mouse is
Function = 0 : Exit Function
Case %WM_Command
Select Case Cb.Ctl
Case %IDM_Vertical : Layout = 0 : AdjustFeatures
Case %IDM_Horizontal : Layout = 1 : AdjustFeatures
Case %IDM_Direction : Direction = Direction Xor 1 : DrawRuler : Dialog Redraw hDlg
Case %IDM_Exit : Dialog End hDlg
Case %IDM_Left : MoveDialog("L")
Case %IDM_Right : MoveDialog("R")
Case %IDM_Up : MoveDialog("U")
Case %IDM_Down : MoveDialog("D")
Case %IDM_sLeft : ResizeDialog(-5,0)
Case %IDM_sRight : ResizeDialog(+5,0)
Case %IDM_sUp : ResizeDialog(0,-5)
Case %IDM_sDown : ResizeDialog(0,+5)
Case %IDM_Minimize : Dialog Show State hDlg, %SW_Minimize
Case %IDM_Pixels : ScaleUnits = 0 : AdjustFeatures : DrawRuler : Dialog Redraw hDlg
Case %IDM_Inches : ScaleUnits = 1 : AdjustFeatures : DrawRuler : Dialog Redraw hDlg
Case %IDM_Default
cFore = %Black : cBack = %Yellow
CreatehBMP : DrawRuler : Dialog Redraw hDlg
Case %IDM_FG
cFore = SelectColor(cFore)
CreatehBMP : DrawRuler : Dialog Redraw hDlg
Case %IDM_BG
cBack = SelectColor(cBack) : cBG = cBack
CreatehBMP : DrawRuler : Dialog Redraw hDlg
Case %IDM_OnTop
OnTop = OnTop Xor 1
Menu Set State hContext, ByCmd %IDM_OnTop, OnTop * 8
SetWindowPos hDlg, IIf(OnTop, %HWND_TOPMOST, %HWND_NOTOPMOST), 0, 0, 0, 0, %SWP_NOMOVE Or %SWP_NOSIZE
Case %IDM_Dim
DimOnLostFocus = DimOnLostFocus Xor 1
Menu Set State hContext, ByCmd %IDM_Dim, DimOnLostFocus * 8
End Select
Case %WM_Paint
Dialog Get Size hDlg To w,h
hDC = BeginPaint(hDlg, PS)
BitBlt hDC, 0,0,w,h, hBMPDC, 0,0, %SRCCopy 'copy ruler image to dialog surface
EndPaint hDlg, PS
Case %WM_LButtonDown
Dialog Get Size hDlg To w,h
GetCursorPos pt 'screen position
ScreenToClient hDlg, pt 'overlay position
If pt.x < (w-17) Or pt.y < (h-17) Then
'off marker
If Cb.WParam = %MK_LBUTTON Then SendMessage hDlg, %WM_NCLButtonDown, %HTCaption, ByVal %Null ' force drag
Else
SetCapture hDlg
resizePT = pt
Dialog Get Size hDlg To startX,startY
ResizeInWork = 1 'on marker
End If
Case %WM_MouseMove
If ResizeInWork Then
GetCursorPos pt 'screen position
ScreenToClient hDlg, pt 'overlay position
' If ((startX + pt.x - resizePT.x)>10) And ((startY + pt.y - resizePT.y)>10) Then _
' Dialog Set Size hDlg, startX + (pt.x - resizePT.x), startY + (pt.y - resizePT.y)
DIALOG SET SIZE hDlg, MAX(startX + (pt.x - resizePT.x), 20), MAX(startY + (pt.y - resizePT.y), 20)
End If
Case %WM_LButtonUp
ResizeInWork = 0
ReleaseCapture
Dialog Redraw hDlg
Case %WM_Destroy
Settings_INI "save"
End Select
End Function
Sub DrawRuler
Select Case ScaleUnits
Case 0 : DrawRuler_Pixels
Case 1 : DrawRuler_Inches
End Select
End Sub
Sub DrawRuler_Pixels
'Layout (0=vert, 1=horz) and Direction (0=left-to-right, 1=right-to-left)
Local w,h,i,k As Long
Local x,y As Single
Dialog Get Size hDlg To w,h
Graphic Clear cBack
If Layout Then
'horizontal
If Direction Then
k = 5
For i = 0 To w Step 5
If i Mod 50 Then
Graphic Line (i+k,0)-(i+k,5), cFore
Graphic Line (i+k,h)-(i+k,h-8), cFore
Else
Graphic Line (i+k,0)-(i+k,h), cFore
Graphic Text Size LTrim$(Str$(i)) To x,y
Graphic Set Pos (i+k - x/2,h/2 - y/2)
Graphic Print LTrim$(Str$(i))
End If
Next i
Else
k = 8
For i = 0 To w Step 5
If i Mod 50 Then
Graphic Line (w-i-k,0)-(w-i-k,5), cFore
Graphic Line (w-i-k,h)-(w-i-k,h-8), cFore
Else
Graphic Line (w-i-k,0)-(w-i-k,h), cFore
Graphic Text Size LTrim$(Str$(i)) To x,y
Graphic Set Pos (w-i-k - x/2,h/2 - y/2)
Graphic Print LTrim$(Str$(i))
End If
Next i
End If
Else
'vertical
If Direction Then
k = 7
For i = 0 To h Step 5
If i Mod 50 Then
Graphic Line (0,k+i)-(5,k+i), cFore
Graphic Line (w,k+i)-(w-5,k+i), cFore
Else
Graphic Line (0,k+i)-(w,k+i), cFore
Graphic Text Size LTrim$(Str$(i)) To x,y
Graphic Set Pos (w/2 - x/2, k+i - y/2)
Graphic Print LTrim$(Str$(i))
End If
Next i
Else
k = 9
For i = 0 To h Step 5
If i Mod 50 Then
Graphic Line (0,h-i-k)-(5,h-i-k), cFore
Graphic Line (w,h-i-k)-(w-5,h-i-k), cFore
Else
Graphic Line (0,h-i-k)-(w,h-i-k), cFore
Graphic Text Size LTrim$(Str$(i)) To x,y
Graphic Set Pos (w/2 - x/2, h-i-k - y/2)
Graphic Print LTrim$(Str$(i))
End If
Next i
End If
End If
'draw gripper
For i = w-17 To w-2 Step 3
Graphic Line (i,h)-(w,h-w+i), %rgb_LightGray
Graphic Line (i+1,h)-(w,h-w+i+1), %rgb_DimGray
Graphic Line (i+2,h)-(w,h-w+i+2), %rgb_Gray
Next i
Graphic ReDraw
End Sub
Sub AdjustFeatures
Local w,h As Long
Dialog Get Size hDlg To w,h
If Layout Then
'horizontal
Menu Set State hContext, ByCmd %IDM_Horizontal, 8
Menu Set State hContext, ByCmd %IDM_Vertical, 0
if (Max(w,h)) > 10 And (Min(w,h)>10) Then Dialog Set Size hDlg, Max(w,h), Min(w,h)
Else
'vertical
Menu Set State hContext, ByCmd %IDM_Horizontal, 0
Menu Set State hContext, ByCmd %IDM_Vertical, 8
If (Min(w,h)>10) And (Max(w,h)>10) Then Dialog Set Size hDlg, Min(w,h), Max(w,h)
End If
If ScaleUnits Then
'inches
Menu Set State hContext, ByCmd %IDM_Pixels, 0
Menu Set State hContext, ByCmd %IDM_Inches, 8
Else
'pixels
Menu Set State hContext, ByCmd %IDM_Pixels, 8
Menu Set State hContext, ByCmd %IDM_Inches, 0
End If
End Sub
Sub Settings_INI(Task$)
Local xResult, yResult, tempAsciiZ As Asciiz * %Max_Path
Local i,x,y As Long, INIFileName As Asciiz * %Max_Path
INIFileName = EXE.Path$ + "gbsnapper.ini" 'defines file name (any file name will work)
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", "440", xResult, %Max_Path, INIFileName
GetPrivateProfileString "All", "Height", "35", yResult, %Max_Path, INIFileName
Dialog Set Size hDlg,Val(xResult$), Val(yResult$) 'width/height
'get numeric variables
Getprivateprofilestring "All", "Layout", "1", tempAsciiZ, %Max_Path, INIFileName
Layout = Val(tempAsciiZ)
Getprivateprofilestring "All", "Direction", "1", tempAsciiZ, %Max_Path, INIFileName
Direction = Val(tempAsciiZ)
Getprivateprofilestring "All", "OnTop", "1", tempAsciiZ, %Max_Path, INIFileName
OnTop = Val(tempAsciiZ)
Getprivateprofilestring "All", "ScaleUnits", "0", tempAsciiZ, %Max_Path, INIFileName
ScaleUnits = Val(tempAsciiZ)
Getprivateprofilestring "All", "cFore", str$(%Black), tempAsciiZ, %Max_Path, INIFileName
cFore = Val(tempAsciiZ)
Getprivateprofilestring "All", "cBack", Str$(%Yellow), tempAsciiZ, %Max_Path, INIFileName
cBack = Val(tempAsciiZ)
Getprivateprofilestring "All", "DimOnLostFocus", "1", tempAsciiZ, %Max_Path, INIFileName
DimOnLostFocus = Val(tempAsciiZ)
For i = 0 To 15
Getprivateprofilestring "Custom", "CustomColorC" + Format$(i,"00"), "", tempAsciiZ, %Max_Path, INIFileName
CustomColorList.c(i) = Val(tempAsciiZ)
Next i
End If
If Task$ = "save" Then
'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
'save numeric variables
tempASCIIZ = Str$(Layout)
WritePrivateProfileString "All", "Layout", tempASCIIZ, INIFileName
tempASCIIZ = Str$(Direction)
WritePrivateProfileString "All", "Direction", tempASCIIZ, INIFileName
tempASCIIZ = Str$(OnTop)
WritePrivateProfileString "All", "OnTop", tempASCIIZ, INIFileName
tempASCIIZ = Str$(ScaleUnits)
WritePrivateProfileString "All", "ScaleUnits", tempASCIIZ, INIFileName
tempASCIIZ = Str$(cFore)
WritePrivateProfileString "All", "cFore", tempASCIIZ, INIFileName
tempASCIIZ = Str$(cBG)
WritePrivateProfileString "All", "cBack", tempASCIIZ, INIFileName
tempASCIIZ = Str$(DimOnLostFocus)
WritePrivateProfileString "All", "DimOnLostFocus", tempASCIIZ, INIFileName
For i = 0 To 15
tempAsciiZ = Str$(CustomColorList.c(i))
WritePrivateProfileString "Custom", "CustomColorC" + Format$(i,"00"), tempAsciiZ, INIFileName
Next i
End If
End Sub
Sub CreateContextMenu
Menu New PopUp To hContext
Menu Add String, hContext, "&Horizontal", %IDM_Horizontal, %MF_Enabled
Menu Add String, hContext, "&Vertical", %IDM_Vertical, %MF_Enabled
Menu Add String, hContext, "-", %IDM_Sep, 0
Menu Add String, hContext, "On &Top", %IDM_OnTop, %MF_Enabled
Menu Add String, hContext, "Dim on &Lost Focus", %IDM_Dim, %MF_Enabled
Menu Add String, hContext, "-", %IDM_Sep, 0
Menu Add String, hContext, "Toggle &Direction", %IDM_Direction, %MF_Enabled
Menu Add String, hContext, "&Minimize", %IDM_Minimize, %MF_Enabled
Menu Add String, hContext, "-", %IDM_Sep, 0
Menu Add String, hContext, "&Pixels", %IDM_Pixels, %MF_Enabled
Menu Add String, hContext, "&Inches", %IDM_Inches, %MF_Enabled
Menu Add String, hContext, "-", %IDM_Sep, 0
Menu Add String, hContext, "Select &FG Color", %IDM_FG, %MF_Enabled
Menu Add String, hContext, "Select &BG Color", %IDM_BG, %MF_Enabled
Menu Add String, hContext, "Use Default &Colors", %IDM_Default, %MF_Enabled
Menu Add String, hContext, "-", %IDM_Sep, 0
Menu Add String, hContext, "E&xit", %IDM_Exit, %MF_Enabled
End Sub
Sub CreatehBMP
Local w,h As Long
If hBMP Then Graphic Bitmap End
Desktop Get Size To w,h
Graphic Bitmap New w,h To hBMP
Graphic Attach hBMP, 0, ReDraw
Graphic Color cFore, cBack
Graphic Get DC To hBMPDC
End Sub
Sub BuildAcceleratorTable
Local c As Long, ac() As ACCELAPI, hAccelerator As Dword ' for keyboard accelator table values
Dim ac(19)
ac(c).fvirt = %FVIRTKEY : ac(c).key = %VK_Left : ac(c).cmd = %IDM_Left : Incr c
ac(c).fvirt = %FVIRTKEY : ac(c).key = %VK_Right : ac(c).cmd = %IDM_Right : Incr c
ac(c).fvirt = %FVIRTKEY : ac(c).key = %VK_Up : ac(c).cmd = %IDM_Up : Incr c
ac(c).fvirt = %FVIRTKEY : ac(c).key = %VK_Down : ac(c).cmd = %IDM_Down : Incr c
ac(c).fvirt = %FVIRTKEY or %FShift : ac(c).key = %VK_Left : ac(c).cmd = %IDM_sLeft : Incr c
ac(c).fvirt = %FVIRTKEY or %FShift : ac(c).key = %VK_Right : ac(c).cmd = %IDM_sRight : Incr c
ac(c).fvirt = %FVIRTKEY or %FShift : ac(c).key = %VK_Up : ac(c).cmd = %IDM_sUp : Incr c
ac(c).fvirt = %FVIRTKEY or %FShift : ac(c).key = %VK_Down : ac(c).cmd = %IDM_sDown : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_H : ac(c).cmd = %IDM_Horizontal : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_V : ac(c).cmd = %IDM_Vertical : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_T : ac(c).cmd = %IDM_OnTop : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_D : ac(c).cmd = %IDM_Direction : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_M : ac(c).cmd = %IDM_Minimize : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_P : ac(c).cmd = %IDM_Pixels : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_I : ac(c).cmd = %IDM_Inches : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_F : ac(c).cmd = %IDM_FG : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_B : ac(c).cmd = %IDM_BG : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_C : ac(c).cmd = %IDM_Default : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_X : ac(c).cmd = %IDM_Exit : Incr c
ac(c).fvirt = %FVIRTKEY or %FALT: ac(c).key = %VK_L : ac(c).cmd = %IDM_Dim : Incr c
Accel Attach hDlg, AC() To hAccelerator
End Sub
Sub MoveDialog(D$)
Local x,y As Long
Dialog Get Loc hDlg To x,y
Select Case D$
Case "L" : Dialog Set Loc hDlg, x-1,y
Case "R" : Dialog Set Loc hDlg, x+1,y
Case "U" : Dialog Set Loc hDlg, x,y-1
Case "D" : Dialog Set Loc hDlg, x,y+1
End Select
End Sub
Sub DrawRuler_Inches
'Layout (0=vert, 1=horz) and Direction (0=left-to-right, 1=right-to-left)
Local w,h,k,px,py,iCountA,iCountB As Long 'pk = pixels per inch
Local x,y,i,j As Long 'pk = pixels per inch
Graphic Get PPI to px, py
Dialog Get Size hDlg To w,h
Graphic Clear cBack
If Layout Then
'horizontal
If Direction Then
k = 5
For i = 0 To w Step px
iCountB = 0
For j = i to i+px Step px/10
If iCountB Mod 5 then
Graphic Line (j+k,0)-(j+k,5), cFore
Graphic Line (j+k,h)-(j+k,h-8), cFore
Else
Graphic Line (j+k,0)-(j+k,10), cFore
Graphic Line (j+k,h)-(j+k,h-13), cFore
End If
Incr iCountB
Next j
Graphic Line (i+k,0)-(i+k,h), cFore
Graphic Text Size LTrim$(Str$(iCountA)) To x,y
Graphic Set Pos (i+k - x/2,h/2 - y/2)
Graphic Print LTrim$(Str$(iCountA))
Incr iCountA
Next i
Else
k = 8
For i = 0 To w Step px
iCountB = 0
For j = i to i+px Step px/10
If iCountB Mod 5 then
Graphic Line (w-j-k,0)-(w-j-k,5), cFore
Graphic Line (w-j-k,h)-(w-j-k,h-8), cFore
Else
Graphic Line (w-j-k,0)-(w-j-k,10), cFore
Graphic Line (w-j-k,h)-(w-j-k,h-13), cFore
End If
Incr iCountB
Next j
Graphic Line (w-i-k,0)-(w-i-k,h), cFore
Graphic Text Size LTrim$(Str$(iCountA)) To x,y
Graphic Set Pos (w-i-k - x/2,h/2 - y/2)
Graphic Print LTrim$(Str$(iCountA))
Incr iCountA
Next i
End If
Else
'vertical
If Direction Then
k = 7
For i = 0 To h Step py
iCountB = 0
For j = i to i+py Step py/10
If iCountB Mod 5 then
Graphic Line (0,j+k)-(5,j+k), cFore
Graphic Line (w,j+k)-(w-8,j+k), cFore
Else
Graphic Line (0,j+k)-(10,j+k), cFore
Graphic Line (w,j+k)-(w-13,j+k), cFore
End If
Incr iCountB
Next j
Graphic Line (0,i+k)-(w,i+k), cFore
Graphic Text Size LTrim$(Str$(iCountA)) To x,y
Graphic Set Pos (w/2 - x/2, i+k - y/2)
Graphic Print LTrim$(Str$(iCountA))
Incr iCountA
Next i
Else
k = 9
For i = 0 To h Step py
iCountB = 0
For j = i to i+py Step py/10
If iCountB Mod 5 then
Graphic Line (0,h-j-k)-(5,h-j-k), cFore
Graphic Line (w,h-j-k)-(w-8,h-j-k), cFore
Else
Graphic Line (0,h-j-k)-(10,h-j-k), cFore
Graphic Line (w,h-j-k)-(w-13,h-j-k), cFore
End If
Incr iCountB
Next j
Graphic Line (0,h-i-k)-(w,h-i-k), cFore
Graphic Text Size LTrim$(Str$(iCountA)) To x,y
Graphic Set Pos (w/2 - x/2, h-i-k - y/2)
Graphic Print LTrim$(Str$(iCountA))
Incr iCountA
Next i
End If
End If
'draw gripper
For i = w-17 To w-2 Step 3
Graphic Line (i,h)-(w,h-w+i), %rgb_LightGray
Graphic Line (i+1,h)-(w,h-w+i+1), %rgb_DimGray
Graphic Line (i+2,h)-(w,h-w+i+2), %rgb_Gray
Next i
Graphic ReDraw
End Sub
Function SelectColor(startcolor&) As Long 'works on pControl
Local ColorResult&
Display Color hDlg, 200, 200, startcolor&, CustomColorList ,0 To ColorResult&
If ColorResult& = -1 Then Function = startcolor& Else Function = ColorResult&
SetFocus hDlg
End Function
Sub ResizeDialog(dx As Long, dy As Long)
Local w,h As Long
Dialog Get Size hDlg to w,h
If (w+dx > 10) and (h+dy > 10) Then Dialog Set Size hDlg, w+dx,h+dy
End Sub
'gbs_01107
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm