Difference between revisions of "Intuition window goes OOP(ish)"
(→Implement message handlers: Add content) |
|||
(20 intermediate revisions by the same user not shown) | |||
Line 1: | Line 1: | ||
− | + | [[Category:Examples]] | |
− | + | A long while ago, someone on the aros-exec forums suggested/asked to use some (more) OOP to create f.i. native Intuition Windows. | |
− | + | Although that is fairly easy to accomplish, there never was an actual example showing how to do such a thing for those wanting to have a look. So, here we go :-) | |
− | + | Do note however, that the code showed herein is not complete, nor does it show good programing practice (even far from it). It is merely shown as a possible solution to the problem. Much more abstraction is required in order to be able to make practical use of the implementation as showed. | |
− | + | == Step 1: A starting point == | |
+ | |||
+ | In order to be able to show the reader how things are accomplished, we have to start with at least some bit of code. So, let's start out with a simple intuition window example. This example was taken from (and is copyrighted by) Thomas Rapp. | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | program | + | program Step1_SimpleWindow; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
Line 101: | Line 103: | ||
</source> | </source> | ||
− | The code itself doesn't do anything difficult to understand. It opens a Intuition Window and | + | The code itself doesn't do anything particularly difficult to understand. It opens a Intuition Window and processes the IDCMP messages and based on those messages give some feedback to the user. |
+ | |||
+ | The AsTag function is there for our convenience, and which is missing from FPC 3.0.x compiler (it is present for FPC 3.1.1 trunk compiler) | ||
+ | |||
+ | == Step 2: Classify the window == | ||
+ | |||
+ | So, now the question becomes: how do we turn the previous example into a Free Pascal Class ? | ||
− | + | Therefor we have to take a look at some of the used properties. | |
− | + | We can see that opening an Intuition window returns us a pointer to the created window (handle), and that this pointer is also used to close the window again. So for these basics we at least requires a handle variable for our window and a open() and close() method. | |
+ | |||
+ | When the window is created with OpenWindowTags() we can see that some tags are provided such as the placement of the window (left and top) and the dimensions of the window (width and height). Also a title is provided as a tag. | ||
+ | |||
+ | We turn all these into private variables and add properties for them in our class. | ||
+ | |||
+ | We put the code for our newly created class into a separate unit, so that things can be re-used with more convenience. | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | unit | + | unit Step2_IntWinClass; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
Line 119: | Line 133: | ||
type | type | ||
TIntuitionWindowClass = class | TIntuitionWindowClass = class | ||
− | + | private | |
FHandle : PWindow; | FHandle : PWindow; | ||
FLeft : LongInt; | FLeft : LongInt; | ||
Line 125: | Line 139: | ||
FWidth : LongInt; | FWidth : LongInt; | ||
FHeight : LongInt; | FHeight : LongInt; | ||
− | FTitle : | + | FTitle : AnsiString; |
− | + | protected | |
− | + | public | |
Constructor Create; | Constructor Create; | ||
Destructor Destroy; override; | Destructor Destroy; override; | ||
− | + | public | |
procedure Open; | procedure Open; | ||
procedure Close; | procedure Close; | ||
− | + | public | |
property Left : LongInt read FLeft write FLeft; | property Left : LongInt read FLeft write FLeft; | ||
property Top : LongInt read FTop write FTop; | property Top : LongInt read FTop write FTop; | ||
Line 210: | Line 224: | ||
</source> | </source> | ||
− | + | As you can see we've also added a constructor (Create) which initializes some default values for the FHandle and private window dimension variables as well as clear the private title variable. | |
+ | |||
+ | We've added a destructor (Destroy) that doesn't do anything useful atm, and is there just in case we need it (we can always remove it later on) | ||
Other then that we've added two methods, one to Open the Intuition Window and one to Close the Intuition Window and added code that actually perform these actions. | Other then that we've added two methods, one to Open the Intuition Window and one to Close the Intuition Window and added code that actually perform these actions. | ||
Line 217: | Line 233: | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | program | + | program Step2_ClassWindow; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
uses | uses | ||
− | + | Step2_IntWinClass, Exec, AGraphics, Intuition, InputEvent; | |
Line 301: | Line 317: | ||
Also here, no real rocket science. We have to take care of Creating and Destroying our class and we've replaced the 'normal' code that opened and closed the intuition Window by calling the Methods that we've just implemented. The message handling itself is still part of our main program. | Also here, no real rocket science. We have to take care of Creating and Destroying our class and we've replaced the 'normal' code that opened and closed the intuition Window by calling the Methods that we've just implemented. The message handling itself is still part of our main program. | ||
− | == | + | == Step 3: Moving around message handling == |
We're going to add to our class again, by moving the message handling from our main program to our class. | We're going to add to our class again, by moving the message handling from our main program to our class. | ||
<source lang=pascal> | <source lang=pascal> | ||
− | unit | + | unit Step3_IntWinClass; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
Line 314: | Line 330: | ||
uses | uses | ||
Intuition; | Intuition; | ||
+ | |||
type | type | ||
Line 466: | Line 483: | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | program | + | program Step3_ClassWindow; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
uses | uses | ||
− | + | Step3_IntWinClass, Exec, AGraphics, Intuition, InputEvent; | |
− | |||
− | |||
− | |||
− | |||
− | |||
Line 511: | Line 523: | ||
Easy enough, and things still work. A bit awkward perhaps, but it works (for this one window). | Easy enough, and things still work. A bit awkward perhaps, but it works (for this one window). | ||
− | == Dispatching messages == | + | == Step 4: Dispatching messages == |
Here is where things become a bit more interesting, as we're going to add a (IDCMP) message dispatcher to our class. | Here is where things become a bit more interesting, as we're going to add a (IDCMP) message dispatcher to our class. | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | unit | + | unit Step4_IntWinClass; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
Line 524: | Line 536: | ||
uses | uses | ||
Intuition; | Intuition; | ||
+ | |||
type | type | ||
Line 532: | Line 545: | ||
type | type | ||
− | |||
− | |||
− | |||
− | |||
TIntuitionWindowClass = class | TIntuitionWindowClass = class | ||
private | private | ||
Line 545: | Line 554: | ||
FTitle : AnsiString; | FTitle : AnsiString; | ||
FStopped : boolean; | FStopped : boolean; | ||
− | |||
− | |||
− | |||
protected | protected | ||
procedure MsgCloseWindow(var msg: TIntuitionMessageRec); Message IDCMP_CLOSEWINDOW; | procedure MsgCloseWindow(var msg: TIntuitionMessageRec); Message IDCMP_CLOSEWINDOW; | ||
procedure MsgMouseMove(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEMOVE; | procedure MsgMouseMove(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEMOVE; | ||
procedure MsgMouseButtons(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEBUTTONS; | procedure MsgMouseButtons(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEBUTTONS; | ||
− | public | + | public |
constructor Create; | constructor Create; | ||
destructor Destroy; override; | destructor Destroy; override; | ||
− | public | + | public |
procedure Open; | procedure Open; | ||
procedure Close; | procedure Close; | ||
procedure HandleMessages; | procedure HandleMessages; | ||
procedure DefaultHandler(var message); override; | procedure DefaultHandler(var message); override; | ||
− | public | + | public |
property Left : LongInt read FLeft write FLeft; | property Left : LongInt read FLeft write FLeft; | ||
property Top : LongInt read FTop write FTop; | property Top : LongInt read FTop write FTop; | ||
Line 567: | Line 573: | ||
property Title : String read FTitle write FTitle; | property Title : String read FTitle write FTitle; | ||
property Handle : PWindow read FHandle; | property Handle : PWindow read FHandle; | ||
− | |||
− | |||
− | |||
− | |||
end; | end; | ||
Line 641: | Line 643: | ||
then Intuition.CloseWindow(FHandle) | then Intuition.CloseWindow(FHandle) | ||
else Error('Unable to Close Window because the handle is invalid'); | else Error('Unable to Close Window because the handle is invalid'); | ||
+ | end; | ||
+ | |||
+ | |||
+ | procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar); | ||
+ | begin | ||
+ | GfxMove(rp, x, y); | ||
+ | SetABPenDrMd(rp, 1, 0, JAM2); | ||
+ | GfxText(rp, txt, strlen(txt)); | ||
+ | ClearEOL(rp); | ||
end; | end; | ||
Line 688: | Line 699: | ||
procedure TIntuitionWindowClass.DefaultHandler(var message); | procedure TIntuitionWindowClass.DefaultHandler(var message); | ||
begin | begin | ||
− | + | Writeln('invoked default handler'); | |
end; | end; | ||
procedure TIntuitionWindowClass.MsgCloseWindow(var msg: TIntuitionMessageRec); | procedure TIntuitionWindowClass.MsgCloseWindow(var msg: TIntuitionMessageRec); | ||
− | |||
− | |||
begin | begin | ||
WriteLn('IDCMP_CLOSEWINDOW message received'); | WriteLn('IDCMP_CLOSEWINDOW message received'); | ||
− | + | FStopped := true; | |
− | |||
− | FStopped := | ||
end; | end; | ||
procedure TIntuitionWindowClass.MsgMouseMove(var msg: TIntuitionMessageRec); | procedure TIntuitionWindowClass.MsgMouseMove(var msg: TIntuitionMessageRec); | ||
+ | var | ||
+ | buffer : String[80]; | ||
begin | begin | ||
WriteLn('IDCMP_MOUSEMOVE message received'); | WriteLn('IDCMP_MOUSEMOVE message received'); | ||
− | + | WriteStr(buffer, 'Mouseposition: x=', msg.IMsg^.MouseX, ' y=', msg.IMsg^.MouseY, #0); | |
− | + | print_text(FHandle^.RPort, 10, 30, @buffer[1]); | |
end; | end; | ||
Line 714: | Line 723: | ||
begin | begin | ||
WriteLn('IDCMP_MOUSEBUTTONS message received'); | WriteLn('IDCMP_MOUSEBUTTONS message received'); | ||
− | + | case msg.IMsg^.Code of | |
+ | IECODE_LBUTTON : print_text(FHandle^.RPort, 10, 60, 'Left mousebutton pressed'); | ||
+ | IECODE_LBUTTON or IECODE_UP_PREFIX : print_text(FHandle^.RPort, 10, 60, 'Left mousebutton released'); | ||
+ | IECODE_RBUTTON : print_text(FHandle^.RPort, 10, 90, 'Right mousebutton pressed'); | ||
+ | IECODE_RBUTTON or IECODE_UP_PREFIX : print_text(FHandle^.RPort, 10, 90, 'Right mousebutton released'); | ||
+ | end; | ||
end; | end; | ||
end. | end. | ||
+ | </source> | ||
− | + | The changes perhaps look difficult but, it actually isn't. | |
− | + | First we've added a new structure TIntuitionMessageRec, that is compatible with a Free Pascal Dispatch message, and at the same time is able to hold our intuition message information. | |
− | + | In order to be able to keep track whether or not our window is closed we defined a new private variable named Stopped. | |
− | + | Next thing we've added, are the 3 IDCMP message procedures. These get 'automatically' invoked by the dispatcher. | |
− | |||
− | We override the DefaultHandler that is standard part of TObject so that we can give some feedback to the suer in case none of our message is intercepted correctly (and the default handler is invoked) | + | We override the DefaultHandler that is standard part of TObject, so that we can give some feedback to the suer in case none of our message is intercepted correctly (and the default handler is invoked) |
Finally we adjust our HandleMessages method to call the TObject dispatcher. | Finally we adjust our HandleMessages method to call the TObject dispatcher. | ||
− | + | ||
+ | For our main program, and which comes to no surprise, nothing is changed. For the sake of completeness we post the code. | ||
<source lang="pascal"> | <source lang="pascal"> | ||
+ | program Step4_ClassWindow; | ||
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
uses | uses | ||
− | + | Step4_IntWinClass, Exec, AGraphics, Intuition, InputEvent; | |
+ | |||
//*-------------------------------------------------------------------------*/ | //*-------------------------------------------------------------------------*/ | ||
Line 764: | Line 781: | ||
result := (0); | result := (0); | ||
end; | end; | ||
+ | |||
begin | begin | ||
Line 770: | Line 788: | ||
</source> | </source> | ||
− | == Implement | + | == Step 5: Implement event handlers == |
− | + | For this step, we're going to implement support for event-handlers, instead of our class actually performing actions. | |
+ | |||
+ | So, let's start doing so (yes, we need to shuffle a large portion of the code around again) | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | unit | + | unit Step5_IntWinClass; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
Line 783: | Line 803: | ||
uses | uses | ||
Intuition; | Intuition; | ||
+ | |||
type | type | ||
Line 975: | Line 996: | ||
if Assigned(FOnMouseButtons) then FOnMouseButtons(msg.Imsg); | if Assigned(FOnMouseButtons) then FOnMouseButtons(msg.Imsg); | ||
end; | end; | ||
+ | |||
+ | end. | ||
</source> | </source> | ||
+ | |||
+ | Firstly we add 3 new type declarations for the event handlers (TOnCloseWindowProc, TOnMouseMoveProc and TOnMouseButtonsProc) as these declaration makes it easier for us to add event handling support. | ||
+ | |||
+ | Then we add 3 new private variables that are able to hold the actual event handlers. | ||
+ | |||
+ | Lastly we add the event properties so that the user is actually able to assign their custom event handler(s) to them. | ||
+ | |||
+ | Of course the support for event handling needs to be implemented as well, as can been seen in the code above. | ||
+ | |||
Now that the event handling is actually implemented we can make use of it in our main program. | Now that the event handling is actually implemented we can make use of it in our main program. | ||
<source lang="pascal"> | <source lang="pascal"> | ||
− | program | + | program Step5_ClassWindow; |
{$MODE OBJFPC}{$H+} | {$MODE OBJFPC}{$H+} | ||
uses | uses | ||
− | + | Step5_IntWinClass, Exec, AGraphics, Intuition, InputEvent; | |
+ | |||
+ | //*-------------------------------------------------------------------------*/ | ||
+ | //* */ | ||
+ | //*-------------------------------------------------------------------------*/ | ||
procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar); | procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar); | ||
Line 1,000: | Line 1,036: | ||
//* Window1 events | //* Window1 events | ||
//*-------------------------------------------------------------------------*/ | //*-------------------------------------------------------------------------*/ | ||
− | |||
procedure DoMouseMove(const IMsg: PIntuiMessage); | procedure DoMouseMove(const IMsg: PIntuiMessage); | ||
Line 1,020: | Line 1,055: | ||
end; | end; | ||
end; | end; | ||
+ | |||
procedure DoCloseWindow(var DoClose: boolean); | procedure DoCloseWindow(var DoClose: boolean); | ||
Line 1,059: | Line 1,095: | ||
end. | end. | ||
</source> | </source> | ||
+ | |||
+ | First thing to notice is that all user-feedback related code has found it's way back in the main program again. | ||
+ | |||
+ | The second thing that changed inside our main program code is that there are now 3 event-handler routines, and the main routine takes care to assign the event handlers to the instantiated class. | ||
Depending on which events are assigned our class is acting as desired. You can leave those events that you are not interested in or add new ones inside the class. | Depending on which events are assigned our class is acting as desired. You can leave those events that you are not interested in or add new ones inside the class. | ||
== What's next ? == | == What's next ? == | ||
+ | |||
+ | The above example is far from a full working windowclass. There are several issues with the current implementation: | ||
+ | * Properties such as Left and Height currently retrieve their values from private variables. This is plain wrong as the user can move the window around and resize it. None of the current properties are actually containing real live values. Several approaches can be taken to improve this situation, f.e. by retrieving the actual values or for example by also implementing and reacting on RESIZEWINDOW and MOVEWINDOW messages. | ||
+ | * The current implementation only takes care of a single window. Calling HandleMessages would only work for this one window (and further message handing would be stalled). In order to add support for multiple windows a 'global' message-loop would have to implemented using a single messageport (that is used for all windows). Note that in that case the creation of the window can not have it's IDCMP_xxx flags set on creation, but needs to be done with function ModifyIDCMP() | ||
+ | |||
+ | The example codes are also kindly provided by magorium and can be found [https://github.com/magorium/fpc-aros-wiki/tree/master/Topics/Intuition_Window_OOP here] (with an additional small bonus for those who are able to locate it). |
Latest revision as of 20:29, 13 September 2017
A long while ago, someone on the aros-exec forums suggested/asked to use some (more) OOP to create f.i. native Intuition Windows.
Although that is fairly easy to accomplish, there never was an actual example showing how to do such a thing for those wanting to have a look. So, here we go :-)
Do note however, that the code showed herein is not complete, nor does it show good programing practice (even far from it). It is merely shown as a possible solution to the problem. Much more abstraction is required in order to be able to make practical use of the implementation as showed.
Step 1: A starting point
In order to be able to show the reader how things are accomplished, we have to start with at least some bit of code. So, let's start out with a simple intuition window example. This example was taken from (and is copyrighted by) Thomas Rapp.
program Step1_SimpleWindow;
{$MODE OBJFPC}{$H+}
Uses
Exec, AGraphics, Intuition, InputEvent, Utility;
Function AsTag(tag: LongWord): LongInt; inline;
begin
Result := LongInt(tag);
end;
//*-------------------------------------------------------------------------*/
//* */
//*-------------------------------------------------------------------------*/
procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
GfxMove(rp, x, y);
SetABPenDrMd(rp, 1, 0, JAM2);
GfxText(rp, txt, strlen(txt));
ClearEOL(rp);
end;
//*-------------------------------------------------------------------------*/
//* Main routine */
//*-------------------------------------------------------------------------*/
function main: integer;
var
win : PWindow;
cont : Boolean;
msg : PIntuiMessage;
buffer : String[80];
begin
win := OpenWindowTags( nil,
[
AsTag(WA_Left) , 100,
AsTag(WA_Top) , 100,
AsTag(WA_Width) , 250,
AsTag(WA_Height) , 150,
AsTag(WA_Flags) , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
AsTag(WA_IDCMP) , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
TAG_END
]);
if Assigned(win) then
begin
cont := TRUE;
while (cont) do
begin
WaitPort(win^.UserPort);
while true do
begin
msg := PIntuiMessage(GetMsg(win^.UserPort));
if not Assigned(msg) then break;
case (msg^.IClass) of
IDCMP_CLOSEWINDOW:
cont := FALSE;
IDCMP_MOUSEMOVE:
begin
WriteStr(buffer, 'Mouseposition: x=', msg^.MouseX, ' y=', msg^.MouseY, #0);
print_text(win^.RPort, 10, 30, @buffer[1]);
end;
IDCMP_MOUSEBUTTONS:
case (msg^.Code) of
IECODE_LBUTTON : print_text(win^.RPort, 10, 60, 'Left mousebutton pressed');
IECODE_LBUTTON or IECODE_UP_PREFIX : print_text(win^.RPort, 10, 60, 'Left mousebutton released');
IECODE_RBUTTON : print_text(win^.RPort, 10, 90, 'Right mousebutton pressed');
IECODE_RBUTTON or IECODE_UP_PREFIX : print_text(win^.RPort, 10, 90, 'Right mousebutton released');
end;
end; // case
ReplyMsg(pMessage(msg));
end;
end; // while
CloseWindow(win);
end;
result := (0);
end;
begin
ExitCode := Main;
end.
The code itself doesn't do anything particularly difficult to understand. It opens a Intuition Window and processes the IDCMP messages and based on those messages give some feedback to the user.
The AsTag function is there for our convenience, and which is missing from FPC 3.0.x compiler (it is present for FPC 3.1.1 trunk compiler)
Step 2: Classify the window
So, now the question becomes: how do we turn the previous example into a Free Pascal Class ?
Therefor we have to take a look at some of the used properties.
We can see that opening an Intuition window returns us a pointer to the created window (handle), and that this pointer is also used to close the window again. So for these basics we at least requires a handle variable for our window and a open() and close() method.
When the window is created with OpenWindowTags() we can see that some tags are provided such as the placement of the window (left and top) and the dimensions of the window (width and height). Also a title is provided as a tag.
We turn all these into private variables and add properties for them in our class.
We put the code for our newly created class into a separate unit, so that things can be re-used with more convenience.
unit Step2_IntWinClass;
{$MODE OBJFPC}{$H+}
interface
uses
Intuition;
type
TIntuitionWindowClass = class
private
FHandle : PWindow;
FLeft : LongInt;
FTop : LongInt;
FWidth : LongInt;
FHeight : LongInt;
FTitle : AnsiString;
protected
public
Constructor Create;
Destructor Destroy; override;
public
procedure Open;
procedure Close;
public
property Left : LongInt read FLeft write FLeft;
property Top : LongInt read FTop write FTop;
property Width : LongInt read FWidth write FWidth;
property Height: LongInt read FHeight write FHeight;
property Title : String read FTitle write FTitle;
property Handle : PWindow read FHandle;
end;
implementation
uses
SysUtils;
Function AsTag(tag: LongWord): LongInt; inline;
begin
Result := LongInt(tag);
end;
procedure error(Const msg : string);
begin
raise exception.create(Msg) at
get_caller_addr(get_frame),
get_caller_frame(get_frame);
end;
Constructor TIntuitionWindowClass.Create;
begin
Inherited;
FHandle := nil;
FLeft := 10;
FTop := 10;
FHeight := 30;
FWidth := 30;
FTitle := '';
end;
Destructor TIntuitionWindowClass.Destroy;
begin
inherited;
end;
procedure TIntuitionWindowClass.Open;
begin
FHandle := OpenWindowTags( nil,
[
AsTag(WA_Left) , FLeft,
AsTag(WA_Top) , FTop,
AsTag(WA_Width) , FWidth,
AsTag(WA_Height) , FHeight,
AsTag(WA_Title) , PChar(FTitle),
// Non use settable flags (for now)
AsTag(WA_Flags) , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
AsTag(WA_IDCMP) , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
TAG_END
]);
if not Assigned(FHandle) then Error('Unable to Open Window');
end;
procedure TIntuitionWindowClass.Close;
begin
if Assigned(FHandle)
then CloseWindow(FHandle)
else Error('Unable to Close Window because the handle is invalid');
end;
end.
As you can see we've also added a constructor (Create) which initializes some default values for the FHandle and private window dimension variables as well as clear the private title variable.
We've added a destructor (Destroy) that doesn't do anything useful atm, and is there just in case we need it (we can always remove it later on)
Other then that we've added two methods, one to Open the Intuition Window and one to Close the Intuition Window and added code that actually perform these actions.
Now, we're going to make use of this new class and create a new program:
program Step2_ClassWindow;
{$MODE OBJFPC}{$H+}
uses
Step2_IntWinClass, Exec, AGraphics, Intuition, InputEvent;
//*-------------------------------------------------------------------------*/
//* */
//*-------------------------------------------------------------------------*/
procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
GfxMove(rp, x, y);
SetABPenDrMd(rp, 1, 0, JAM2);
GfxText(rp, txt, strlen(txt));
ClearEOL(rp);
end;
//*-------------------------------------------------------------------------*/
//* Main routine */
//*-------------------------------------------------------------------------*/
function main: integer;
var
Window1 : TIntuitionWindowClass;
cont : Boolean;
msg : PIntuiMessage;
buffer : String[80];
begin
Window1 := TIntuitionWindowClass.Create;
Window1.Left := 10;
Window1.Top := 20;
Window1.Height := 200;
Window1.Width := 320;
Window1.Title := 'This is window 1';
Window1.Open;
WaitPort(Window1.Handle^.UserPort);
cont := TRUE;
while (cont) do
begin
while true do
begin
msg := PIntuiMessage(GetMsg(Window1.Handle^.UserPort));
if not Assigned(msg) then break;
case (msg^.IClass) of
IDCMP_CLOSEWINDOW:
cont := FALSE;
IDCMP_MOUSEMOVE:
begin
WriteStr(buffer, 'Mouseposition: x=', msg^.MouseX, ' y=', msg^.MouseY, #0);
print_text(Window1.Handle^.RPort, 10, 30, @buffer[1]);
end;
IDCMP_MOUSEBUTTONS:
case (msg^.Code) of
IECODE_LBUTTON : print_text(Window1.Handle^.RPort, 10, 60, 'Left mousebutton pressed');
IECODE_LBUTTON or IECODE_UP_PREFIX : print_text(Window1.Handle^.RPort, 10, 60, 'Left mousebutton released');
IECODE_RBUTTON : print_text(Window1.Handle^.RPort, 10, 90, 'Right mousebutton pressed');
IECODE_RBUTTON or IECODE_UP_PREFIX : print_text(Window1.Handle^.RPort, 10, 90, 'Right mousebutton released');
end;
end; // case
ReplyMsg(pMessage(msg));
end;
end;
Window1.Close;
Window1.Free;
result := (0);
end;
begin
ExitCode := Main;
end.
Also here, no real rocket science. We have to take care of Creating and Destroying our class and we've replaced the 'normal' code that opened and closed the intuition Window by calling the Methods that we've just implemented. The message handling itself is still part of our main program.
Step 3: Moving around message handling
We're going to add to our class again, by moving the message handling from our main program to our class.
unit Step3_IntWinClass;
{$MODE OBJFPC}{$H+}
interface
uses
Intuition;
type
TIntuitionWindowClass = class
private
FHandle : PWindow;
FLeft : LongInt;
FTop : LongInt;
FWidth : LongInt;
FHeight : LongInt;
FTitle : AnsiString;
protected
public
Constructor Create;
Destructor Destroy; override;
public
procedure Open;
procedure Close;
procedure HandleMessages;
public
property Left : LongInt read FLeft write FLeft;
property Top : LongInt read FTop write FTop;
property Width : LongInt read FWidth write FWidth;
property Height: LongInt read FHeight write FHeight;
property Title : String read FTitle write FTitle;
property Handle : PWindow read FHandle;
end;
implementation
uses
SysUtils, Exec, AGraphics, InputEvent;
Function AsTag(tag: LongWord): LongInt; inline;
begin
Result := LongInt(tag);
end;
procedure error(Const msg : string);
begin
raise exception.create(Msg) at
get_caller_addr(get_frame),
get_caller_frame(get_frame);
end;
Constructor TIntuitionWindowClass.Create;
begin
Inherited;
FHandle := nil;
FLeft := 10;
FTop := 10;
FHeight := 30;
FWidth := 30;
FTitle := '';
end;
Destructor TIntuitionWindowClass.Destroy;
begin
inherited;
end;
procedure TIntuitionWindowClass.Open;
var
aTitle : PChar;
begin
if FTitle <> '' then aTitle := PChar(FTitle) else aTitle := nil;
FHandle := OpenWindowTags( nil,
[
AsTag(WA_Left) , FLeft,
AsTag(WA_Top) , FTop,
AsTag(WA_Width) , FWidth,
AsTag(WA_Height) , FHeight,
AsTag(WA_Title) , aTitle,
// Non use settable flags (for now)
AsTag(WA_Flags) , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
AsTag(WA_IDCMP) , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
TAG_END
]);
if not Assigned(FHandle) then Error('Unable to Open Window');
end;
procedure TIntuitionWindowClass.Close;
begin
if Assigned(FHandle)
then CloseWindow(FHandle)
else Error('Unable to Close Window because the handle is invalid');
end;
procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
GfxMove(rp, x, y);
SetABPenDrMd(rp, 1, 0, JAM2);
GfxText(rp, txt, strlen(txt));
ClearEOL(rp);
end;
procedure TIntuitionWindowClass.HandleMessages;
var
cont : Boolean;
msg : PIntuiMessage;
buffer : String[80];
begin
cont := TRUE;
while (cont) do
begin
WaitPort(FHandle^.UserPort);
while true do
begin
msg := PIntuiMessage(GetMsg(FHandle^.UserPort));
if not Assigned(msg) then break;
case (msg^.IClass) of
IDCMP_CLOSEWINDOW:
cont := FALSE;
IDCMP_MOUSEMOVE:
begin
WriteStr(buffer, 'Mouseposition: x=', msg^.MouseX, ' y=', msg^.MouseY, #0);
print_text(FHandle^.RPort, 10, 30, @buffer[1]);
end;
IDCMP_MOUSEBUTTONS:
case (msg^.Code) of
IECODE_LBUTTON : print_text(FHandle^.RPort, 10, 60, 'Left mousebutton pressed');
IECODE_LBUTTON or IECODE_UP_PREFIX : print_text(FHandle^.RPort, 10, 60, 'Left mousebutton released');
IECODE_RBUTTON : print_text(FHandle^.RPort, 10, 90, 'Right mousebutton pressed');
IECODE_RBUTTON or IECODE_UP_PREFIX : print_text(FHandle^.RPort, 10, 90, 'Right mousebutton released');
end;
end; // case
ReplyMsg(pMessage(msg));
end;
end;
end;
end.
The message handling is performed by our newly added method HandleMessages and as you can see the code is literally the code that was used in the main program before.
Now we have to make our main program make use of this new method.
program Step3_ClassWindow;
{$MODE OBJFPC}{$H+}
uses
Step3_IntWinClass, Exec, AGraphics, Intuition, InputEvent;
//*-------------------------------------------------------------------------*/
//* Main routine */
//*-------------------------------------------------------------------------*/
function main: integer;
var
Window1 : TIntuitionWindowClass;
begin
Window1 := TIntuitionWindowClass.Create;
Window1.Left := 10;
Window1.Top := 20;
Window1.Height := 200;
Window1.Width := 320;
Window1.Title := 'This is window 1';
Window1.Open;
Window1.HandleMessages;
Window1.Close;
Window1.Free;
result := (0);
end;
begin
ExitCode := Main;
end.
Easy enough, and things still work. A bit awkward perhaps, but it works (for this one window).
Step 4: Dispatching messages
Here is where things become a bit more interesting, as we're going to add a (IDCMP) message dispatcher to our class.
unit Step4_IntWinClass;
{$MODE OBJFPC}{$H+}
interface
uses
Intuition;
type
TIntuitionMessageRec = record
MsgCode : DWord;
IMsg : PIntuiMessage;
end;
type
TIntuitionWindowClass = class
private
FHandle : PWindow;
FLeft : LongInt;
FTop : LongInt;
FWidth : LongInt;
FHeight : LongInt;
FTitle : AnsiString;
FStopped : boolean;
protected
procedure MsgCloseWindow(var msg: TIntuitionMessageRec); Message IDCMP_CLOSEWINDOW;
procedure MsgMouseMove(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEMOVE;
procedure MsgMouseButtons(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEBUTTONS;
public
constructor Create;
destructor Destroy; override;
public
procedure Open;
procedure Close;
procedure HandleMessages;
procedure DefaultHandler(var message); override;
public
property Left : LongInt read FLeft write FLeft;
property Top : LongInt read FTop write FTop;
property Width : LongInt read FWidth write FWidth;
property Height : LongInt read FHeight write FHeight;
property Title : String read FTitle write FTitle;
property Handle : PWindow read FHandle;
end;
implementation
uses
SysUtils, Exec, AGraphics, InputEvent;
function AsTag(tag: LongWord): LongInt; inline;
begin
Result := LongInt(tag);
end;
procedure error(Const msg : string);
begin
raise exception.create(Msg) at
get_caller_addr(get_frame),
get_caller_frame(get_frame);
end;
Constructor TIntuitionWindowClass.Create;
begin
Inherited;
FHandle := nil;
FLeft := 10;
FTop := 10;
FHeight := 30;
FWidth := 30;
FTitle := '';
FStopped := false;
end;
Destructor TIntuitionWindowClass.Destroy;
begin
inherited;
end;
procedure TIntuitionWindowClass.Open;
var
aTitle : PChar;
begin
if FTitle <> '' then aTitle := PChar(FTitle) else aTitle := nil;
FHandle := OpenWindowTags( nil,
[
AsTag(WA_Left) , FLeft,
AsTag(WA_Top) , FTop,
AsTag(WA_Width) , FWidth,
AsTag(WA_Height) , FHeight,
AsTag(WA_Title) , aTitle,
// Non use settable flags (for now)
AsTag(WA_Flags) , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
AsTag(WA_IDCMP) , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
TAG_END
]);
if not Assigned(FHandle) then Error('Unable to Open Window');
end;
procedure TIntuitionWindowClass.Close;
begin
if Assigned(FHandle)
then Intuition.CloseWindow(FHandle)
else Error('Unable to Close Window because the handle is invalid');
end;
procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
GfxMove(rp, x, y);
SetABPenDrMd(rp, 1, 0, JAM2);
GfxText(rp, txt, strlen(txt));
ClearEOL(rp);
end;
procedure TIntuitionWindowClass.HandleMessages;
var
msg : PIntuiMessage;
msgrec : TIntuitionMessageRec;
begin
while not FStopped do
begin
WaitPort(FHandle^.UserPort);
while true do
begin
msg := PIntuiMessage(GetMsg(FHandle^.UserPort));
if not Assigned(msg) then break;
// WriteLn('ReplyMsg');
ReplyMsg(pMessage(msg));
// WriteLn('Dispatch');
MsgRec.MsgCode := msg^.IClass;
MsgRec.IMsg := msg;
Dispatch(msgrec);
end;
end;
end;
(*
http://www.freepascal.org/docs-html/rtl/system/tobject.defaulthandler.html
DefaultHandler is the default handler for messages. If a message has an
unknown message ID (i.e. does not appear in the table with integer message
handlers), then it will be passed to DefaultHandler by the Dispatch method.
*)
(*
http://www.freepascal.org/docs-html/rtl/system/tobject.dispatch.html
Dispatch looks in the message handler table for a handler that handles
message. The message is identified by the first dword (cardinal) in the
message structure.
If no matching message handler is found, the message is passed to the
DefaultHandler method, which can be overridden by descendent classes to add
custom handling of messages.
*)
procedure TIntuitionWindowClass.DefaultHandler(var message);
begin
Writeln('invoked default handler');
end;
procedure TIntuitionWindowClass.MsgCloseWindow(var msg: TIntuitionMessageRec);
begin
WriteLn('IDCMP_CLOSEWINDOW message received');
FStopped := true;
end;
procedure TIntuitionWindowClass.MsgMouseMove(var msg: TIntuitionMessageRec);
var
buffer : String[80];
begin
WriteLn('IDCMP_MOUSEMOVE message received');
WriteStr(buffer, 'Mouseposition: x=', msg.IMsg^.MouseX, ' y=', msg.IMsg^.MouseY, #0);
print_text(FHandle^.RPort, 10, 30, @buffer[1]);
end;
procedure TIntuitionWindowClass.MsgMouseButtons(var msg: TIntuitionMessageRec);
begin
WriteLn('IDCMP_MOUSEBUTTONS message received');
case msg.IMsg^.Code of
IECODE_LBUTTON : print_text(FHandle^.RPort, 10, 60, 'Left mousebutton pressed');
IECODE_LBUTTON or IECODE_UP_PREFIX : print_text(FHandle^.RPort, 10, 60, 'Left mousebutton released');
IECODE_RBUTTON : print_text(FHandle^.RPort, 10, 90, 'Right mousebutton pressed');
IECODE_RBUTTON or IECODE_UP_PREFIX : print_text(FHandle^.RPort, 10, 90, 'Right mousebutton released');
end;
end;
end.
The changes perhaps look difficult but, it actually isn't.
First we've added a new structure TIntuitionMessageRec, that is compatible with a Free Pascal Dispatch message, and at the same time is able to hold our intuition message information.
In order to be able to keep track whether or not our window is closed we defined a new private variable named Stopped.
Next thing we've added, are the 3 IDCMP message procedures. These get 'automatically' invoked by the dispatcher.
We override the DefaultHandler that is standard part of TObject, so that we can give some feedback to the suer in case none of our message is intercepted correctly (and the default handler is invoked)
Finally we adjust our HandleMessages method to call the TObject dispatcher.
For our main program, and which comes to no surprise, nothing is changed. For the sake of completeness we post the code.
program Step4_ClassWindow;
{$MODE OBJFPC}{$H+}
uses
Step4_IntWinClass, Exec, AGraphics, Intuition, InputEvent;
//*-------------------------------------------------------------------------*/
//* Main routine */
//*-------------------------------------------------------------------------*/
function main: integer;
var
Window1 : TIntuitionWindowClass;
begin
Window1 := TIntuitionWindowClass.Create;
Window1.Left := 10;
Window1.Top := 20;
Window1.Height := 200;
Window1.Width := 320;
Window1.Title := 'This is window 1';
Window1.Open;
Window1.HandleMessages;
Window1.Close;
Window1.Free;
result := (0);
end;
begin
ExitCode := Main;
end.
Step 5: Implement event handlers
For this step, we're going to implement support for event-handlers, instead of our class actually performing actions.
So, let's start doing so (yes, we need to shuffle a large portion of the code around again)
unit Step5_IntWinClass;
{$MODE OBJFPC}{$H+}
interface
uses
Intuition;
type
TIntuitionMessageRec = record
MsgCode : DWord;
IMsg : PIntuiMessage;
end;
type
TOnCloseWindowProc = procedure(var DoClose: boolean);
TOnMouseMoveProc = procedure(const IMsg: PIntuiMessage);
TOnMouseButtonsProc = procedure(const IMsg: PIntuiMessage);
TIntuitionWindowClass = class
private
FHandle : PWindow;
FLeft : LongInt;
FTop : LongInt;
FWidth : LongInt;
FHeight : LongInt;
FTitle : AnsiString;
FStopped : boolean;
FOnCloseWindow : TOnCloseWindowProc;
FOnMouseMove : TOnMouseMoveProc;
FOnMouseButtons : TOnMouseButtonsProc;
protected
procedure MsgCloseWindow(var msg: TIntuitionMessageRec); Message IDCMP_CLOSEWINDOW;
procedure MsgMouseMove(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEMOVE;
procedure MsgMouseButtons(var msg: TIntuitionMessageRec); Message IDCMP_MOUSEBUTTONS;
public // creator/destructor
constructor Create;
destructor Destroy; override;
public // methods
procedure Open;
procedure Close;
procedure HandleMessages;
procedure DefaultHandler(var message); override;
public // properties
property Left : LongInt read FLeft write FLeft;
property Top : LongInt read FTop write FTop;
property Width : LongInt read FWidth write FWidth;
property Height : LongInt read FHeight write FHeight;
property Title : String read FTitle write FTitle;
property Handle : PWindow read FHandle;
public // events
property OnCloseWindow : TOnCloseWindowProc read FOnCloseWindow write FOnCloseWindow;
property OnMouseMove : TOnMouseMoveProc read FOnMouseMove write FOnMouseMove;
property OnMouseButtons : TOnMouseButtonsProc read FOnMouseButtons write FOnMouseButtons;
end;
implementation
uses
SysUtils, Exec, AGraphics, InputEvent;
function AsTag(tag: LongWord): LongInt; inline;
begin
Result := LongInt(tag);
end;
procedure error(Const msg : string);
begin
raise exception.create(Msg) at
get_caller_addr(get_frame),
get_caller_frame(get_frame);
end;
Constructor TIntuitionWindowClass.Create;
begin
Inherited;
FHandle := nil;
FLeft := 10;
FTop := 10;
FHeight := 30;
FWidth := 30;
FTitle := '';
FStopped := false;
end;
Destructor TIntuitionWindowClass.Destroy;
begin
inherited;
end;
procedure TIntuitionWindowClass.Open;
var
aTitle : PChar;
begin
if FTitle <> '' then aTitle := PChar(FTitle) else aTitle := nil;
FHandle := OpenWindowTags( nil,
[
AsTag(WA_Left) , FLeft,
AsTag(WA_Top) , FTop,
AsTag(WA_Width) , FWidth,
AsTag(WA_Height) , FHeight,
AsTag(WA_Title) , aTitle,
// Non use settable flags (for now)
AsTag(WA_Flags) , AsTag(WFLG_CLOSEGADGET or WFLG_DRAGBAR or WFLG_DEPTHGADGET or WFLG_ACTIVATE or WFLG_GIMMEZEROZERO or WFLG_NOCAREREFRESH or WFLG_RMBTRAP or WFLG_REPORTMOUSE),
AsTag(WA_IDCMP) , AsTag(IDCMP_CLOSEWINDOW or IDCMP_MOUSEMOVE or IDCMP_MOUSEBUTTONS),
TAG_END
]);
if not Assigned(FHandle) then Error('Unable to Open Window');
end;
procedure TIntuitionWindowClass.Close;
begin
if Assigned(FHandle)
then Intuition.CloseWindow(FHandle)
else Error('Unable to Close Window because the handle is invalid');
end;
procedure TIntuitionWindowClass.HandleMessages;
var
msg : PIntuiMessage;
msgrec : TIntuitionMessageRec;
begin
while not FStopped do
begin
WaitPort(FHandle^.UserPort);
while true do
begin
msg := PIntuiMessage(GetMsg(FHandle^.UserPort));
if not Assigned(msg) then break;
// WriteLn('ReplyMsg');
ReplyMsg(pMessage(msg));
// WriteLn('Dispatch');
MsgRec.MsgCode := msg^.IClass;
MsgRec.IMsg := msg;
Dispatch(msgrec);
end;
end;
end;
(*
http://www.freepascal.org/docs-html/rtl/system/tobject.defaulthandler.html
DefaultHandler is the default handler for messages. If a message has an
unknown message ID (i.e. does not appear in the table with integer message
handlers), then it will be passed to DefaultHandler by the Dispatch method.
*)
(*
http://www.freepascal.org/docs-html/rtl/system/tobject.dispatch.html
Dispatch looks in the message handler table for a handler that handles
message. The message is identified by the first dword (cardinal) in the
message structure.
If no matching message handler is found, the message is passed to the
DefaultHandler method, which can be overridden by descendent classes to add
custom handling of messages.
*)
procedure TIntuitionWindowClass.DefaultHandler(var message);
begin
WriteLn('invoked default handler');
end;
procedure TIntuitionWindowClass.MsgCloseWindow(var msg: TIntuitionMessageRec);
var
DoClose: boolean = true;
begin
WriteLn('IDCMP_CLOSEWINDOW message received');
if Assigned(FOnCloseWindow) then FOnCloseWindow(DoClose);
FStopped := DoClose;
end;
procedure TIntuitionWindowClass.MsgMouseMove(var msg: TIntuitionMessageRec);
begin
WriteLn('IDCMP_MOUSEMOVE message received');
if assigned(FOnMouseMove) then FOnMouseMove(msg.IMsg);
end;
procedure TIntuitionWindowClass.MsgMouseButtons(var msg: TIntuitionMessageRec);
begin
WriteLn('IDCMP_MOUSEBUTTONS message received');
if Assigned(FOnMouseButtons) then FOnMouseButtons(msg.Imsg);
end;
end.
Firstly we add 3 new type declarations for the event handlers (TOnCloseWindowProc, TOnMouseMoveProc and TOnMouseButtonsProc) as these declaration makes it easier for us to add event handling support.
Then we add 3 new private variables that are able to hold the actual event handlers.
Lastly we add the event properties so that the user is actually able to assign their custom event handler(s) to them.
Of course the support for event handling needs to be implemented as well, as can been seen in the code above.
Now that the event handling is actually implemented we can make use of it in our main program.
program Step5_ClassWindow;
{$MODE OBJFPC}{$H+}
uses
Step5_IntWinClass, Exec, AGraphics, Intuition, InputEvent;
//*-------------------------------------------------------------------------*/
//* */
//*-------------------------------------------------------------------------*/
procedure print_text(rp: PRastPort; x: LongInt; y: LongInt; txt: PChar);
begin
GfxMove(rp, x, y);
SetABPenDrMd(rp, 1, 0, JAM2);
GfxText(rp, txt, strlen(txt));
ClearEOL(rp);
end;
//*-------------------------------------------------------------------------*/
//* Window1 events
//*-------------------------------------------------------------------------*/
procedure DoMouseMove(const IMsg: PIntuiMessage);
var
buffer : String[80];
begin
WriteStr(buffer, 'Mouseposition: x=', IMsg^.MouseX, ' y=', IMsg^.MouseY, #0);
print_text(IMsg^.IDCMPWindow^.RPort, 10, 30, @buffer[1]);
end;
procedure DoMouseButtons(const IMsg: PIntuiMessage);
begin
case IMsg^.Code of
IECODE_LBUTTON : print_text(IMsg^.IDCMPWindow^.RPort, 10, 60, 'Left mousebutton pressed');
IECODE_LBUTTON or IECODE_UP_PREFIX : print_text(IMsg^.IDCMPWindow^.RPort, 10, 60, 'Left mousebutton released');
IECODE_RBUTTON : print_text(IMsg^.IDCMPWindow^.RPort, 10, 90, 'Right mousebutton pressed');
IECODE_RBUTTON or IECODE_UP_PREFIX : print_text(IMsg^.IDCMPWindow^.RPort, 10, 90, 'Right mousebutton released');
end;
end;
procedure DoCloseWindow(var DoClose: boolean);
begin
DoClose := True;
end;
//*-------------------------------------------------------------------------*/
//* Main routine */
//*-------------------------------------------------------------------------*/
function main: integer;
var
Window1 : TIntuitionWindowClass;
begin
Window1 := TIntuitionWindowClass.Create;
Window1.Left := 10;
Window1.Top := 20;
Window1.Height := 200;
Window1.Width := 320;
Window1.Title := 'This is window 1';
Window1.OnMouseMove := @DoMouseMove;
Window1.OnMouseButtons := @DoMouseButtons;
Window1.OnCloseWindow := @DoCloseWindow;
Window1.Open;
Window1.HandleMessages;
Window1.Close;
Window1.Free;
result := (0);
end;
begin
ExitCode := Main;
end.
First thing to notice is that all user-feedback related code has found it's way back in the main program again.
The second thing that changed inside our main program code is that there are now 3 event-handler routines, and the main routine takes care to assign the event handlers to the instantiated class.
Depending on which events are assigned our class is acting as desired. You can leave those events that you are not interested in or add new ones inside the class.
What's next ?
The above example is far from a full working windowclass. There are several issues with the current implementation:
- Properties such as Left and Height currently retrieve their values from private variables. This is plain wrong as the user can move the window around and resize it. None of the current properties are actually containing real live values. Several approaches can be taken to improve this situation, f.e. by retrieving the actual values or for example by also implementing and reacting on RESIZEWINDOW and MOVEWINDOW messages.
- The current implementation only takes care of a single window. Calling HandleMessages would only work for this one window (and further message handing would be stalled). In order to add support for multiple windows a 'global' message-loop would have to implemented using a single messageport (that is used for all windows). Note that in that case the creation of the window can not have it's IDCMP_xxx flags set on creation, but needs to be done with function ModifyIDCMP()
The example codes are also kindly provided by magorium and can be found here (with an additional small bonus for those who are able to locate it).