From 88ca2ea14ba6651404cd4ea347ac8f06afdd0558 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 14 Jan 2025 00:06:33 +1300 Subject: Ensured Widgets will remove themselves from a Group upon dealloc and Groups won't inadvertantly dealloc Widgets upon Clear --- src/fltk-widgets-groups-scrolls.ads | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) (limited to 'src/fltk-widgets-groups-scrolls.ads') diff --git a/src/fltk-widgets-groups-scrolls.ads b/src/fltk-widgets-groups-scrolls.ads index 11b7f9a..8030fcd 100644 --- a/src/fltk-widgets-groups-scrolls.ads +++ b/src/fltk-widgets-groups-scrolls.ads @@ -4,6 +4,11 @@ -- Released into the public domain +with + + FLTK.Widgets.Valuators.Sliders.Scrollbars; + + package FLTK.Widgets.Groups.Scrolls is @@ -36,6 +41,17 @@ package FLTK.Widgets.Groups.Scrolls is + function H_Bar + (This : in out Scroll) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + function V_Bar + (This : in out Scroll) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + + + procedure Clear (This : in out Scroll); @@ -86,7 +102,9 @@ package FLTK.Widgets.Groups.Scrolls is private - type Scroll is new Group with null record; + type Scroll is new Group with record + Horizon, Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; + end record; overriding procedure Initialize (This : in out Scroll); @@ -97,12 +115,10 @@ private procedure Extra_Init (This : in out Scroll; X, Y, W, H : in Integer; - Text : in String) - with Inline; + Text : in String); procedure Extra_Final - (This : in out Scroll) - with Inline; + (This : in out Scroll); pragma Inline (Clear); -- cgit