/PREPROCESS; moving and sizing window with canvas;
Posted: Thu Oct 29, 2015 3:40 pm
Is a reformatter for PB available as the /PREPROCESS does destroy any formatting...?
(What I like in the source given is how smart and stable canvasgadget works...)
(What I like in the source given is how smart and stable canvasgadget works...)
Code: Select all
Structure SSheetSizer
PB .i
Nr .i
EndStructure
Structure SSheet
PB .i
Header .i
Box .i
EdgeWidth .i
Title .s
Calendar .i
CommandBar .i
IsBeforeClosing .i
GridSize .i
*Sizers .SSheetSizer[9]
DesktopX .i
DesktopY .i
EndStructure
Declare draw_SheetHeader (*Sheet.SSheet)
Declare draw_Sizer_Sheet (*Sizer.SSheetSizer)
Declare onCallback_Sheet_GUI (hWnd, uMsg, WParam, LParam)
Declare onCallback_SheetHeader ()
Declare onCallback_Sizer_Sheet ()
Declare onClose_Sheet ()
Declare onSize_Sheet ()
Declare OpenSheet (PB, X, Y, W, H, Title.s, Flags=0)
Declare setCursorWindow (PB, Cursor)
Declare size_Sizers_Sheet (*Sheet.SSheet)
Declare snapToGrid_Sheet (*Sheet.SSheet)
Declare test_Sheet_GUI ()
Declare WindowNrFromHandle (Handle)
Declare WindowEdgeWidth (PB, Width=#PB_Ignore)
#Color_WhiteSmoke = $F5F5F5
#Color_Gray = $808080
test_Sheet_GUI()
Procedure test_Sheet_GUI()
*Sheet.SSheet = OpenSheet(#PB_Any, 16, 16, 640, 480, "Test PBSheet", #PB_Window_ScreenCentered)
snapToGrid_Sheet(*Sheet)
if *Sheet\PB
repeat
if not IsWindow(*Sheet\PB)
break
endif
Protected NrEvent = WaitWindowEvent()
forever
endif
EndProcedure
procedure OpenSheet(Win, X, Y, W, H, Title.s, Flags=0)
Protected R
Protected i
R = OpenWindow(Win, X, Y, W, H, "", Flags | #PB_Window_BorderLess)
if R
Protected *Sheet.SSheet = AllocateStructure(SSheet)
*Sheet\PB = R
SetWindowData(R, *Sheet)
SetWindowCallback(@onCallback_Sheet_GUI(), R)
SetWindowColor(R, RGB(255, 255, 255))
BindEvent(#PB_Event_CloseWindow, @onClose_Sheet(), Win)
*Sheet\EdgeWidth = 6
*Sheet\Title = Title
*Sheet\GridSize = 16
with *Sheet
Protected ew = *Sheet\EdgeWidth
for i = 1 to 8
*Sheet\Sizers[i] = AllocateStructure(SSheetSizer)
next i
*Sheet\Sizers[1]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[1]\PB, #PB_Canvas_Cursor, #PB_Cursor_LeftUpRightDown)
*Sheet\Sizers[2]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[2]\PB, #PB_Canvas_Cursor, #PB_Cursor_UpDown)
*Sheet\Sizers[3]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[3]\PB, #PB_Canvas_Cursor, #PB_Cursor_LeftDownRightUp)
*Sheet\Sizers[4]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[4]\PB, #PB_Canvas_Cursor, #PB_Cursor_LeftRight)
*Sheet\Sizers[5]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[5]\PB, #PB_Canvas_Cursor, #PB_Cursor_LeftUpRightDown)
*Sheet\Sizers[6]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[6]\PB, #PB_Canvas_Cursor, #PB_Cursor_UpDown)
*Sheet\Sizers[7]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[7]\PB, #PB_Canvas_Cursor, #PB_Cursor_LeftDownRightUp)
*Sheet\Sizers[8]\PB = CanvasGadget(#PB_Any, 0, 0, 0, 0) :
SetGadgetAttribute(*Sheet\Sizers[8]\PB, #PB_Canvas_Cursor, #PB_Cursor_LeftRight)
size_Sizers_Sheet(*Sheet)
for i = 1 to 8
protected PB = *Sheet\Sizers[i]\PB
*Sheet\Sizers[i]\Nr = i
SetGadgetData(PB, *Sheet\Sizers[i])
draw_Sizer_Sheet(*Sheet\Sizers[i])
next i
for i = 1 to 8
BindGadgetEvent(*Sheet\Sizers[i]\PB, @onCallback_Sizer_Sheet())
next i
EndWith
if *Sheet\Header
endif
*Sheet\EdgeWidth = 6
endif
ProcedureReturn *Sheet
EndProcedure
Procedure draw_SheetHeader(*Sheet.SSheet)
Protected Header = *Sheet\Header
if Header=0
ProcedureReturn
endif
Protected F = LoadFont(#PB_Any, "Arial", 9, #PB_Font_HighQuality)
Protected W = GadgetWidth(Header)
Protected H = GadgetHeight(Header)
if StartDrawing(CanvasOutput(Header))
Box(0, 0, W, H, #Color_WhiteSmoke)
if IsFont(F)
DrawingFont(FontID(F))
endif
DrawText(2, 4, *Sheet\Title, #Color_Gray, #Color_WhiteSmoke)
Protected XColor
Protected BColor
if *Sheet\IsBeforeClosing
else
XColor = #Color_Gray
BColor = #Color_WhiteSmoke
endif
DrawText(W - 16, 4, " X ", XColor, BColor)
StopDrawing()
endif
if F
FreeFont(F)
endif
EndProcedure
Procedure draw_Sizer_Sheet(*Sizer.SSheetSizer)
Protected PB = *Sizer\PB
if StartDrawing(CanvasOutput(PB))
box(0, 0, GadgetWidth(PB), GadgetHeight(PB), #Color_WhiteSmoke)
StopDrawing()
endif
EndProcedure
Procedure onClose_Sheet()
Protected Win = EventWindow()
if Win
Protected *Sheet.SSheet = GetWindowData(Win)
CloseWindow(Win)
endif
EndProcedure
Procedure onSize_Sheet()
Protected PB = EventWindow()
if PB
Protected *Sheet.SSheet = GetWindowData(PB)
Protected Header = *Sheet\Header
Protected Box = *Sheet\Box
Protected W = WindowWidth(PB)
Protected H = WindowHeight(PB)
endif
EndProcedure
Procedure onCallback_Sheet_GUI(hWnd, uMsg, WParam, LParam)
Protected Win = WindowNrFromHandle(hWnd)
if Win<=0
ProcedureReturn #PB_ProcessPureBasicEvents
endif
Protected *Sheet.SSheet = GetWindowData(Win)
Protected Event = uMsg
select Event
case #WM_LBUTTONDOWN
SendMessage_(WindowID(Win), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
snapToGrid_Sheet(*Sheet)
default
endSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure onCallback_SheetHeader()
Protected Win = EventWindow()
Protected PB = EventGadget()
Protected NrEventType = EventType()
Static IsDragging = #False
Static OffsetX = 0
Static OffsetY = 0
Protected W = GadgetWidth(PB)
Protected H = GadgetHeight(PB)
Protected MX = GetGadgetAttribute(PB, #PB_Canvas_MouseX)
Protected MY = GetGadgetAttribute(PB, #PB_Canvas_MouseY)
Protected *Sheet.SSheet = GetWindowData(Win)
If IsDragging
ResizeWindow(Win, DesktopMouseX() - OffsetX, DesktopMouseY() - OffsetY, #PB_Ignore, #PB_Ignore)
EndIf
select NrEventType
case #PB_EventType_LeftButtonDown
if MX>W - 16 and MX<W - 4
PostEvent(#PB_Event_CloseWindow, Win, 0)
else
IsDragging = #True
endif
case #PB_EventType_LeftButtonUp
IsDragging = #False
snapToGrid_Sheet(*Sheet)
case #PB_EventType_MouseMove
OffsetX = DesktopMouseX() - WindowX(Win)
OffsetY = DesktopMouseY() - WindowY(Win)
if MX>W - 16 and MX<W - 4 and MY>=4 and MY<=20
if not *Sheet\IsBeforeClosing
*Sheet\IsBeforeClosing = #True
draw_SheetHeader(*Sheet)
endif
else
if *Sheet\IsBeforeClosing
*Sheet\IsBeforeClosing = #False
draw_SheetHeader(*Sheet)
endif
endif
default
endSelect
ProcedureReturn #False
EndProcedure
Procedure onCallback_Sizer_Sheet()
Protected Win = EventWindow()
Protected Gadget = EventGadget()
Protected NrEventType = EventType()
Protected *Sizer.SSheetSizer = GetGadgetData(Gadget)
Protected *Sheet.SSheet
Protected L
Protected T
Protected W
Protected H
Protected Y
Protected X
Protected DY
Protected DX
static OldY
static OldX
static IsDragging
select NrEventType
case #PB_EventType_LeftButtonDown
IsDragging = #True
OldX = DesktopMouseX()
OldY = DesktopMouseY()
case #PB_EventType_MouseMove
if IsDragging
*Sheet.SSheet = GetWindowData(Win)
W = WindowWidth(Win)
H = WindowHeight(Win)
L = WindowX(Win)
T = WindowY(Win)
X = DesktopMouseX()
Y = DesktopMouseY()
DX = X - OldX
DY = Y - OldY
select *Sizer\Nr
case 1
T + DY:
L + DX:
W - DX:
H - DY
case 2
T + DY:
H - DY
case 3
T + DY:
:
W + DX:
H - DY
case 4
W + DX
case 5
W + DX:
H + DY
case 6
H + DY
case 7
L + DX:
W - DX:
H + DY
case 8
L + DX:
W -DX
default
endSelect
ResizeWindow(Win, L, T, W, H)
size_Sizers_Sheet(*Sheet)
OldY = Y
OldX = X
endif
case #PB_EventType_LeftButtonUp
IsDragging = #False
*Sheet.SSheet = GetWindowData(Win)
snapToGrid_Sheet(*Sheet)
default
endSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure snapToGrid_Sheet(*Sheet.SSheet)
Protected Win = *Sheet\PB
Protected X = WindowX(Win)
Protected Y = WindowY(Win)
Protected W = WindowWidth(Win)
Protected H = WindowHeight(Win)
Protected G = *Sheet\GridSize
X = Int(X / G) * G
Y = Int(Y / G) * G
w = Int(W / G) * G
H = Int(H / G) * G
ResizeWindow(Win, X, Y, W, H)
W = WindowWidth(Win)
H = WindowHeight(Win)
with *Sheet
Protected ew = *Sheet\EdgeWidth
ResizeGadget(*Sheet\Sizers[1]\PB, 0, 0, ew, ew)
ResizeGadget(*Sheet\Sizers[2]\PB, ew, 0, W - (ew * 2), ew)
ResizeGadget(*Sheet\Sizers[3]\PB, W - ew, 0, ew, ew)
ResizeGadget(*Sheet\Sizers[4]\PB, W - ew, ew, ew, H - (ew * 2))
ResizeGadget(*Sheet\Sizers[5]\PB, W - ew, H - ew, ew, ew)
ResizeGadget(*Sheet\Sizers[6]\PB, ew, H-ew, W - (ew * 2), ew)
ResizeGadget(*Sheet\Sizers[7]\PB, W - ew, H - ew, ew, ew)
ResizeGadget(*Sheet\Sizers[8]\PB, 0, ew, ew, H - (ew * 2))
endWith
EndProcedure
Procedure WindowNrFromHandle(Handle)
Protected Class.s, WindowNumber.l
WindowNumber = -1
Class = Space(255)
GetClassName_(Handle, @Class, 254)
If Left(Class, 11) = "WindowClass"
WindowNumber = Val(Right(Class, Len(Class) - 12))
EndIf
ProcedureReturn WindowNumber
EndProcedure
Procedure setCursorWindow(PB, Cursor)
Protected C = LoadCursor_(0, Cursor)
SetCursor_(C)
EndProcedure
Procedure size_Sizers_Sheet(*Sheet.SSheet)
Protected Win = *Sheet\PB
Protected X = WindowX(Win)
Protected Y = WindowY(Win)
Protected W = WindowWidth(Win)
Protected H = WindowHeight(Win)
Protected i
with *Sheet
Protected ew = *Sheet\EdgeWidth
ResizeGadget(*Sheet\Sizers[1]\PB, 0, 0, ew, ew)
ResizeGadget(*Sheet\Sizers[2]\PB, ew, 0, W - (ew * 2), ew)
ResizeGadget(*Sheet\Sizers[3]\PB, W - ew, 0, ew, ew)
ResizeGadget(*Sheet\Sizers[4]\PB, W - ew, ew, ew, H - (ew * 2))
ResizeGadget(*Sheet\Sizers[5]\PB, W - ew, H - ew, ew, ew)
ResizeGadget(*Sheet\Sizers[6]\PB, ew, H-ew, W - (ew * 2), ew)
ResizeGadget(*Sheet\Sizers[7]\PB, 0, H - ew, ew, ew)
ResizeGadget(*Sheet\Sizers[8]\PB, 0, ew, ew, H - (ew * 2))
for i = 1 to 8
draw_Sizer_Sheet(*Sheet\Sizers[i])
next i
endWith
EndProcedure