Difference between revisions of "Intuition window goes OOP(ish)"
(→The beginning =: removed typo + added code) |
(→We need a class: Added content) |
||
Line 104: | Line 104: | ||
== We need a class == | == We need a class == | ||
+ | |||
+ | Now that we have seen what properties are part of the window we can create a class based on that. We put the class in a separate unit. | ||
+ | |||
+ | <source lang="pascal"> | ||
+ | unit IntWinClass; | ||
+ | |||
+ | {$MODE OBJFPC}{$H+} | ||
+ | |||
+ | interface | ||
+ | |||
+ | uses | ||
+ | Intuition; | ||
+ | |||
+ | type | ||
+ | TIntuitionWindowClass = class | ||
+ | private | ||
+ | FHandle : PWindow; | ||
+ | FLeft : LongInt; | ||
+ | FTop : LongInt; | ||
+ | FWidth : LongInt; | ||
+ | FHeight : LongInt; | ||
+ | FTitle : String; | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | We've 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. | ||
+ | |||
+ | 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: | ||
+ | |||
+ | <source language="pascal"> | ||
+ | program ClassWindow; | ||
+ | |||
+ | {$MODE OBJFPC}{$H+} | ||
+ | |||
+ | uses | ||
+ | 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. | ||
+ | </source> | ||
+ | |||
+ | 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. | ||
== Move around message handling == | == Move around message handling == |
Revision as of 20:40, 27 March 2017
A long while ago, someone on the aros-exec forums suggested to use some (more) OOP to create f.i. native Intuition Windows.
Although i already knew it is possible to do, i never managed to create a example 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 that). 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 these examples.
The beginning
Let's start out with a simple intuition window example, this example was taken from Thomas Rapp.
program 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 difficult to understand. It opens a Intuition Window and reacts to some IDCMP messages and based on those messages give some feedback to the user.
We need a class
Now that we have seen what properties are part of the window we can create a class based on that. We put the class in a separate unit.
unit IntWinClass;
{$MODE OBJFPC}{$H+}
interface
uses
Intuition;
type
TIntuitionWindowClass = class
private
FHandle : PWindow;
FLeft : LongInt;
FTop : LongInt;
FWidth : LongInt;
FHeight : LongInt;
FTitle : String;
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.
We've 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.
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 ClassWindow;
{$MODE OBJFPC}{$H+}
uses
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.