mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 22:20:19 +02:00
* update
This commit is contained in:
nils
parent
5935825da6
commit
193a79de1a
@ -1,33 +1,57 @@
|
||||
PROGRAM AslTest;
|
||||
{$mode objfpc}
|
||||
|
||||
uses Exec, Utility, Asl;
|
||||
uses Exec, Utility, Asl, msgbox, systemvartags;
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
{
|
||||
History:
|
||||
Now use TAGS and pas2c.
|
||||
Removed the opening of asl.library,
|
||||
handled by unit asl.
|
||||
1 Nov 1998.
|
||||
|
||||
Added MessageBox for report.
|
||||
31 Jul 2000.
|
||||
|
||||
Changed to use systemvartags and
|
||||
AllocAslRequestTags.
|
||||
09 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
}
|
||||
|
||||
VAR
|
||||
fr : pFileRequester;
|
||||
dummy : BOOLEAN;
|
||||
thetags : array [0..3] of tTagItem;
|
||||
BEGIN
|
||||
AslBase := OpenLibrary(AslName,37);
|
||||
IF AslBase <> NIL THEN BEGIN
|
||||
thetags[0] := TagItem(ASLFR_InitialPattern,Longint(PChar('#?'#0)));
|
||||
thetags[1] := TagItem(ASLFR_TitleText,Longint(PChar('Test av ASL-Requester by NS'#0)));
|
||||
thetags[2] := TagItem(ASLFR_DoPatterns,1);
|
||||
thetags[3].ti_Tag := TAG_DONE;
|
||||
|
||||
fr := AllocAslRequest(ASL_FileRequest,@thetags);
|
||||
IF fr <> nil THEN BEGIN
|
||||
dummy := AslRequest(fr,NIL);
|
||||
if dummy then begin
|
||||
writeln('The path is :',fr^.rf_Dir);
|
||||
writeln('And the file is :',fr^.rf_File);
|
||||
end else writeln('You canceled');
|
||||
FreeAslRequest(fr);
|
||||
END;
|
||||
CloseLibrary(AslBase);
|
||||
END else writeln('no asl.library');
|
||||
fr := AllocAslRequestTags(ASL_FileRequest,[
|
||||
ASLFR_InitialPattern,'#?',
|
||||
ASLFR_TitleText,'Test av ASL-Requester by NS',
|
||||
ASLFR_DoPatterns,ltrue,
|
||||
TAG_DONE]);
|
||||
|
||||
IF fr <> nil THEN BEGIN
|
||||
dummy := AslRequest(fr,NIL);
|
||||
if dummy then begin
|
||||
MessageBox('Test of Asl',
|
||||
' The path is :' +
|
||||
strpas(fr^.rf_Dir) +
|
||||
chr(10) +
|
||||
'And the file is :' +
|
||||
strpas(fr^.rf_File),
|
||||
'OK');
|
||||
end else MessageBox('Test of Asl','You canceled','OK');
|
||||
FreeAslRequest(fr);
|
||||
END;
|
||||
END.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -1,5 +1,7 @@
|
||||
Program Bezier;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
{
|
||||
This program draws Bezier curves using the degree elevation
|
||||
method. For large numbers of points (more than 10, for
|
||||
@ -7,6 +9,7 @@ Program Bezier;
|
||||
}
|
||||
|
||||
{
|
||||
History:
|
||||
Changed the source to use 2.0+.
|
||||
Looks a lot better.
|
||||
Added CloseWindowSafely.
|
||||
@ -17,12 +20,23 @@ Program Bezier;
|
||||
Translated the source to fpc.
|
||||
20 Aug 1998.
|
||||
|
||||
Changed to use TAGS and pas2c.
|
||||
31 Oct 1998.
|
||||
|
||||
Removed Opening of graphics.library,
|
||||
handled by graphics.pas.
|
||||
21 Mar 2001.
|
||||
|
||||
Uses systemvartags and
|
||||
OpenScreenTags
|
||||
OpenWindowTags
|
||||
Text to GText.
|
||||
09 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
}
|
||||
|
||||
uses exec, intuition, graphics, utility;
|
||||
|
||||
{$I tagutils.inc}
|
||||
uses exec, intuition, graphics, utility,pastoc, systemvartags;
|
||||
|
||||
type
|
||||
PointRec = packed Record
|
||||
@ -32,7 +46,7 @@ type
|
||||
Const
|
||||
w : pWindow = Nil;
|
||||
s : pScreen = Nil;
|
||||
ltrue : longint = 1;
|
||||
|
||||
{
|
||||
This will make the new look for screen.
|
||||
SA_Pens, Integer(pens)
|
||||
@ -40,22 +54,17 @@ Const
|
||||
pens : array [0..0] of integer = (not 0);
|
||||
|
||||
Var
|
||||
m : pMessage;
|
||||
rp : pRastPort;
|
||||
|
||||
PointCount : Word;
|
||||
Points : Array [1..200] of PointRec;
|
||||
|
||||
t, tprime : Real;
|
||||
|
||||
LastX, LastY : Word;
|
||||
tags : array[0..13] of tTagItem;
|
||||
|
||||
Procedure CleanUpAndDie;
|
||||
begin
|
||||
if w <> Nil then CloseWindow(w);
|
||||
if s <> Nil then CloseScreen(s);
|
||||
if Gfxbase <> nil then CloseLibrary(GfxBase);
|
||||
if assigned(w) then CloseWindow(w);
|
||||
if assigned(s) then CloseScreen(s);
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
@ -123,7 +132,8 @@ var
|
||||
end;
|
||||
|
||||
begin
|
||||
dummy := ModifyIDCMP(w, IDCMP_CLOSEWINDOW or IDCMP_MOUSEBUTTONS or IDCMP_MOUSEMOVE);
|
||||
dummy := ModifyIDCMP(w, IDCMP_CLOSEWINDOW or IDCMP_MOUSEBUTTONS or
|
||||
IDCMP_MOUSEMOVE);
|
||||
SetDrMd(rp, COMPLEMENT);
|
||||
PointCount := 0;
|
||||
Leave := False;
|
||||
@ -198,8 +208,6 @@ begin
|
||||
end;
|
||||
|
||||
Procedure DrawBezier;
|
||||
var
|
||||
i : Word;
|
||||
begin
|
||||
SetAPen(rp, 2);
|
||||
while PointCount < 100 do begin
|
||||
@ -213,41 +221,50 @@ begin
|
||||
end;
|
||||
|
||||
begin
|
||||
GfxBase := OpenLibrary(GRAPHICSNAME,37);
|
||||
|
||||
tags[0] := TagItem(SA_Pens, Long(@pens));
|
||||
tags[1] := TagItem(SA_Depth, 2);
|
||||
tags[2] := TagItem(SA_DisplayID, HIRES_KEY);
|
||||
tags[3] := TagItem(SA_Title, Long(PChar('Simple Bezier Curves'#0)));
|
||||
tags[4].ti_Tag := TAG_END;
|
||||
s := OpenScreenTagList(nil, @tags);
|
||||
s := OpenScreenTags(nil,[SA_Pens,@pens,
|
||||
SA_Depth, 2,
|
||||
SA_DisplayID, HIRES_KEY,
|
||||
SA_Title, 'Simple Bezier Curves',
|
||||
TAG_END]);
|
||||
|
||||
if s = NIL then CleanUpAndDie;
|
||||
|
||||
tags[0] := TagItem(WA_IDCMP, IDCMP_CLOSEWINDOW);
|
||||
tags[1] := TagItem(WA_Left, 0);
|
||||
tags[2] := TagItem(WA_Top, s^.BarHeight +1);
|
||||
tags[3] := TagItem(WA_Width, s^.Width);
|
||||
tags[4] := TagItem(WA_Height, s^.Height - (s^.BarHeight + 1));
|
||||
tags[5] := TagItem(WA_DepthGadget, ltrue);
|
||||
tags[6] := TagItem(WA_DragBar, ltrue);
|
||||
tags[7] := TagItem(WA_CloseGadget, ltrue);
|
||||
tags[8] := TagItem(WA_ReportMouse, ltrue);
|
||||
tags[9] := TagItem(WA_SmartRefresh, ltrue);
|
||||
tags[10] := TagItem(WA_Activate, ltrue);
|
||||
tags[11] := TagItem(WA_Title, long(PChar('Close the Window to Quit'#0)));
|
||||
tags[12] := TagItem(WA_CustomScreen, long(s));
|
||||
tags[13].ti_Tag := TAG_END;
|
||||
w := OpenWindowTagList(nil, @tags);
|
||||
w := OpenWindowTags(nil,[
|
||||
WA_IDCMP, IDCMP_CLOSEWINDOW,
|
||||
WA_Left, 0,
|
||||
WA_Top, s^.BarHeight +1,
|
||||
WA_Width, s^.Width,
|
||||
WA_Height, s^.Height - (s^.BarHeight + 1),
|
||||
WA_DepthGadget, ltrue,
|
||||
WA_DragBar, ltrue,
|
||||
WA_CloseGadget, ltrue,
|
||||
WA_ReportMouse, ltrue,
|
||||
WA_SmartRefresh, ltrue,
|
||||
WA_Activate, ltrue,
|
||||
WA_Title, 'Close the Window to Quit',
|
||||
WA_CustomScreen, s,
|
||||
TAG_END]);
|
||||
|
||||
IF w=NIL THEN CleanUpAndDie;
|
||||
|
||||
rp := w^.RPort;
|
||||
Move(rp, 252, 20);
|
||||
Text(rp, PChar('Enter points by pressing the left mouse button'#0), 46);
|
||||
Move(rp, 252, 30);
|
||||
Text(rp, PChar('Double click on the last point to begin drawing'#0), 47);
|
||||
GText(rp, pas2c('Enter points by pressing the left mouse button'), 46);
|
||||
Move(rp, 252, 40);
|
||||
GText(rp, pas2c('Double click on the last point to begin drawing'), 47);
|
||||
repeat
|
||||
GetPoints; { Both these routines will quit if }
|
||||
DrawBezier; { the window is closed. }
|
||||
until False;
|
||||
CleanUpAndDie;
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
Program GadtoolsMenu;
|
||||
{$mode objfpc}
|
||||
|
||||
{* gadtoolsmenu.p
|
||||
** Example showing the basic usage of the menu system with a window.
|
||||
@ -6,52 +7,76 @@ Program GadtoolsMenu;
|
||||
**
|
||||
*}
|
||||
|
||||
uses Exec, Intuition, Utility, GadTools;
|
||||
{
|
||||
Changed to use TAGS and pas2c.
|
||||
1 Nov 1998.
|
||||
|
||||
Updated for systemvartags.
|
||||
28 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
}
|
||||
|
||||
uses Exec, Intuition, Utility, GadTools, systemvartags;
|
||||
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
const
|
||||
|
||||
mynewmenu : array[0..15] of tNewMenu = (
|
||||
(nm_Type: NM_TITLE; nm_Label:'Project'; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Open...'; nm_CommKey:'O'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Save'; nm_CommKey:'S'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:nil; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label:'Project'; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Open...'; nm_CommKey:'O'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Save'; nm_CommKey:'S'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:nil; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
|
||||
(nm_Type: NM_ITEM; nm_Label:'Print'; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_SUB; nm_Label:'Draft'; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_SUB; nm_Label:'NLQ'; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:nil; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Print'; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_SUB; nm_Label:'Draft'; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_SUB; nm_Label:'NLQ'; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:nil; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
|
||||
(nm_Type: NM_ITEM; nm_Label:'Quit...'; nm_CommKey:'Q'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Quit...'; nm_CommKey:'Q'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
|
||||
(nm_Type: NM_TITLE; nm_Label:'Edit'; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Cut'; nm_CommKey:'X'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Copy'; nm_CommKey:'C'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Paste'; nm_CommKey:'V'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:nil; nm_CommKey: NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label:'Edit'; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Cut'; nm_CommKey:'X'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Copy'; nm_CommKey:'C'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Paste'; nm_CommKey:'V'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:nil; nm_CommKey: NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
|
||||
(nm_Type: NM_ITEM; nm_Label:'Undo'; nm_CommKey:'Z'; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label:'Undo'; nm_CommKey:'Z'; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL),
|
||||
|
||||
(nm_Type: NM_END; nm_Label:NIL; nm_CommKey:NIL; nm_Flags:0; nm_MutualExclude:0; nm_UserData:NIL));
|
||||
(nm_Type: NM_END; nm_Label:NIL; nm_CommKey:NIL; nm_Flags:0;
|
||||
nm_MutualExclude:0; nm_UserData:NIL));
|
||||
|
||||
var
|
||||
win : pWindow;
|
||||
myVisualInfo : Pointer;
|
||||
menuStrip : pMenu;
|
||||
tags : array[0..6] of tTagItem;
|
||||
msg : pMessage;
|
||||
done : boolean;
|
||||
|
||||
Procedure Die;
|
||||
begin
|
||||
if MenuStrip <> nil then begin
|
||||
if assigned(MenuStrip) then begin
|
||||
ClearMenuStrip(win);
|
||||
FreeMenus(MenuStrip);
|
||||
end;
|
||||
if myVisualInfo <> nil then FreeVisualInfo(myVisualInfo);
|
||||
if win <> Nil then CloseWindow(win);
|
||||
if GadToolsBase <> nil then CloseLibrary(GadToolsBase);
|
||||
if assigned(myVisualInfo) then FreeVisualInfo(myVisualInfo);
|
||||
if assigned(win) then CloseWindow(win);
|
||||
Halt(0);
|
||||
end;
|
||||
|
||||
@ -100,17 +125,16 @@ end;
|
||||
*}
|
||||
|
||||
begin
|
||||
GadToolsBase := OpenLibrary(PChar('gadtools.library'#0), 37);
|
||||
if GadToolsBase = nil then die;
|
||||
|
||||
tags[0] := TagItem(WA_Width, 400);
|
||||
tags[1] := TagItem(WA_Activate, 1);
|
||||
tags[2] := TagItem(WA_Height, 100);
|
||||
tags[3] := TagItem(WA_CloseGadget, 1);
|
||||
tags[4] := TagItem(WA_Title, Long(PChar('Menu Test Window'#0)));
|
||||
tags[5] := TagItem(WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK);
|
||||
tags[6].ti_Tag := TAG_END;
|
||||
win := OpenWindowTagList(NIL, @tags);
|
||||
win := OpenWindowTags(NIL, [
|
||||
WA_Width, 400,
|
||||
WA_Activate, ltrue,
|
||||
WA_Height, 100,
|
||||
WA_CloseGadget, ltrue,
|
||||
WA_Title, 'Menu Test Window',
|
||||
WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK,
|
||||
TAG_END]);
|
||||
|
||||
if win = nil then die;
|
||||
|
||||
myVisualInfo := GetVisualInfoA(win^.WScreen,nil);
|
||||
@ -124,9 +148,9 @@ begin
|
||||
mynewmenu[13].nm_Label := PChar(NM_BARLABEL);
|
||||
|
||||
if pExecBase(_ExecBase)^.LibNode.Lib_Version >= 39 then begin
|
||||
tags[0] := TagItem(GTMN_FrontPen, 1);
|
||||
tags[1].ti_Tag := TAG_END;
|
||||
MenuStrip := CreateMenusA(@mynewmenu,@tags);
|
||||
MenuStrip := CreateMenus(@mynewmenu, [
|
||||
GTMN_FrontPen, 1,
|
||||
TAG_END]);
|
||||
end else MenuStrip := CreateMenusA(@mynewmenu,NIL);
|
||||
|
||||
if menuStrip = nil then die;
|
||||
@ -143,4 +167,9 @@ begin
|
||||
die;
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
@ -1,19 +1,31 @@
|
||||
PROGRAM ImageGadget;
|
||||
{$mode objfpc}
|
||||
|
||||
{
|
||||
An example on how to use GadTools gadgets,
|
||||
on the same time how to use images.
|
||||
|
||||
20 Sep 1998.
|
||||
|
||||
Changed the code to use TAGS, now also use
|
||||
pas2c for strings-pchar.
|
||||
1 Nov 1998.
|
||||
|
||||
Removed opening of gadtools.library.
|
||||
Will be opened by unit gadtools.
|
||||
16 Jul 2000.
|
||||
|
||||
Update to use systemvartags. Not a
|
||||
very nice demo, needs to rewrite to
|
||||
handle more bitplanes.
|
||||
28 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
}
|
||||
|
||||
USES Intuition, Exec, Graphics, GadTools, Utility;
|
||||
USES Intuition, Exec, Graphics, GadTools, Utility, systemvartags,pastoc;
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
CONST
|
||||
MSG_CANT_OPEN_GTLIB : PChar = 'Can''t open gadtools.library V37 or higher.';
|
||||
MSG_NO_PS : PChar = 'Can''t lock Public Screen';
|
||||
MSG_NO_VI : PChar = 'Can''t get Visual Info';
|
||||
MSG_NO_MEM : PChar = 'Not enough memory free';
|
||||
@ -229,11 +241,11 @@ VAR
|
||||
renderi,
|
||||
selecti : tImage;
|
||||
wp : pWindow;
|
||||
t : ARRAY[0..6] OF tTagItem;
|
||||
|
||||
|
||||
function NewGadget(left,top,width,height : Integer; txt : PChar; txtattr: pTextAttr;
|
||||
id : word; flags: Longint; visinfo, userdata : Pointer): tNewGadget;
|
||||
id : word; flags: Longint; visinfo, userdata : Pointer):
|
||||
tNewGadget;
|
||||
var
|
||||
ng : tNewGadget;
|
||||
begin
|
||||
@ -290,13 +302,12 @@ END;
|
||||
|
||||
PROCEDURE CleanUp(why : PChar; rc : BYTE);
|
||||
BEGIN
|
||||
IF wp <> NIL THEN CloseWindow(wp);
|
||||
IF gl <> NIL THEN FreeGadgets(gl);
|
||||
IF vi <> NIL THEN FreeVisualInfo(vi);
|
||||
IF firstimage <> NIL THEN FreeVec(firstimage);
|
||||
IF secondimage <> NIL THEN FreeVec(secondimage);
|
||||
IF assigned(wp) THEN CloseWindow(wp);
|
||||
IF assigned(gl) THEN FreeGadgets(gl);
|
||||
IF assigned(vi) THEN FreeVisualInfo(vi);
|
||||
IF assigned(firstimage) THEN FreeVec(firstimage);
|
||||
IF assigned(secondimage) THEN FreeVec(secondimage);
|
||||
IF why <> nil THEN i := EasyReq(NIL,WIN_TITLE,why,OK_TEXT);
|
||||
IF GadToolsBase <> NIL THEN CloseLibrary(GadToolsBase);
|
||||
HALT(rc);
|
||||
END;
|
||||
|
||||
@ -349,17 +360,17 @@ BEGIN
|
||||
g^.GadgetRender := @renderi;
|
||||
g^.SelectRender := @selecti;
|
||||
|
||||
t[0] := TagItem(WA_Gadgets, LONG(gl));
|
||||
t[1].ti_Tag := WA_Title;
|
||||
t[1].ti_Data := long(PChar('Images in Gadgets'#0));
|
||||
t[2] := TagItem(WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
|
||||
WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
|
||||
WFLG_ACTIVATE);
|
||||
t[3] := TagItem(WA_Idcmp, IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW);
|
||||
t[4] := TagItem(WA_InnerWidth, 100);
|
||||
t[5] := TagItem(WA_InnerHeight, 50);
|
||||
t[6].ti_Tag := TAG_DONE;
|
||||
wp := OpenWindowTagList(NIL,@t);
|
||||
wp := OpenWindowTags(NIL,[
|
||||
WA_Gadgets,gl,
|
||||
WA_Title, 'Images in Gadgets',
|
||||
WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
|
||||
WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
|
||||
WFLG_ACTIVATE,
|
||||
WA_Idcmp, IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW,
|
||||
WA_InnerWidth, 100,
|
||||
WA_InnerHeight, 50,
|
||||
TAG_DONE]);
|
||||
|
||||
IF wp = NIL THEN CleanUp(MSG_NO_WP, 20);
|
||||
END;
|
||||
|
||||
@ -380,7 +391,7 @@ BEGIN
|
||||
CASE iclass OF
|
||||
IDCMP_CLOSEWINDOW : ende := TRUE;
|
||||
IDCMP_GADGETUP :
|
||||
i := EasyReq(wp,WIN_TITLE,PChar('You have clicked on the Gadget!'#0),pchar('Wheeew!'#0));
|
||||
i := EasyReq(wp,WIN_TITLE,pas2c('You have clicked on the Gadget!'),pas2c('Wheeew!'));
|
||||
ELSE END;
|
||||
msg := GT_GetIMsg(wp^.UserPort);
|
||||
END;
|
||||
@ -388,8 +399,6 @@ BEGIN
|
||||
END;
|
||||
|
||||
BEGIN
|
||||
GadToolsBase := OpenLibrary(GADTOOLSNAME,37);
|
||||
IF GadToolsBase = NIL THEN CleanUp(MSG_CANT_OPEN_GTLIB, 20);
|
||||
new(gl);
|
||||
CloneDatas;
|
||||
AllocateImages;
|
||||
@ -398,4 +407,11 @@ BEGIN
|
||||
CleanUp(nil,0);
|
||||
END.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
Program Moire;
|
||||
|
||||
{$mode objfpc}
|
||||
{
|
||||
Will now open a default screen (can be any size) with
|
||||
the new look. The window get it's size depending on
|
||||
@ -8,22 +8,30 @@ Program Moire;
|
||||
|
||||
Translated to FPC from PCQ Pascal.
|
||||
15 Aug 1998.
|
||||
|
||||
Changed to use vartags and pas2c.
|
||||
18 Jan 2000.
|
||||
|
||||
Removed opening of graphics.library.
|
||||
21 Mar 2001.
|
||||
|
||||
Reworked to use systemvartags.
|
||||
28 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
}
|
||||
|
||||
uses Exec, Intuition, Graphics, Utility;
|
||||
uses Exec, Intuition, Graphics, Utility, systemvartags;
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
const
|
||||
pens : array [0..0] of Integer = ( not 0);
|
||||
ltrue = 1;
|
||||
|
||||
|
||||
var
|
||||
w : pWindow;
|
||||
s : pScreen;
|
||||
m : pMessage;
|
||||
thetags : array[0..17] of tTagItem;
|
||||
|
||||
|
||||
Procedure DoDrawing(RP : pRastPort);
|
||||
@ -70,38 +78,37 @@ begin
|
||||
the startup code created. Same with DOS, although we don't
|
||||
use that here. }
|
||||
|
||||
GfxBase := OpenLibrary(GRAPHICSNAME,0);
|
||||
if GfxBase <> nil then begin
|
||||
|
||||
|
||||
thetags[0] := TagItem(SA_Pens, longint(@pens));
|
||||
thetags[1] := TagItem(SA_Depth, 2);
|
||||
thetags[2] := TagItem(SA_DisplayID, HIRES_KEY);
|
||||
thetags[3] := TagItem(SA_Title, Long(PChar('Close the Window to End This Demonstration'#0)));
|
||||
thetags[4].ti_Tag := TAG_END;
|
||||
s := OpenScreenTags(NIL, [
|
||||
SA_Pens, @pens,
|
||||
SA_Depth, 2,
|
||||
SA_DisplayID, HIRES_KEY,
|
||||
SA_Title, 'Close the Window to End This Demonstration',
|
||||
TAG_END]);
|
||||
|
||||
s := OpenScreenTagList(NIL, @thetags);
|
||||
if s <> NIL then begin
|
||||
|
||||
thetags[0] := TagItem(WA_IDCMP, IDCMP_CLOSEWINDOW);
|
||||
thetags[1] := TagItem(WA_Left, 20);
|
||||
thetags[2] := TagItem(WA_Top, 50);
|
||||
thetags[3] := TagItem(WA_Width, 336);
|
||||
thetags[4] := TagItem(WA_Height, 100);
|
||||
thetags[5] := TagItem(WA_MinWidth, 50);
|
||||
thetags[6] := TagItem(WA_MinHeight, 20);
|
||||
thetags[7] := TagItem(WA_MaxWidth, -1);
|
||||
thetags[8] := TagItem(WA_MaxHeight, -1);
|
||||
thetags[9] := TagItem(WA_DepthGadget, ltrue);
|
||||
thetags[10] := TagItem(WA_DragBar, -1);
|
||||
thetags[11] := TagItem(WA_CloseGadget, -1);
|
||||
thetags[12] := TagItem(WA_SizeGadget, -1);
|
||||
thetags[13] := TagItem(WA_SmartRefresh, -1);
|
||||
thetags[14] := TagItem(WA_Activate, -1);
|
||||
thetags[15] := TagItem(WA_Title, Long(PChar('Feel Free to Re-Size the Window'#0)));
|
||||
thetags[16] := TagItem(WA_CustomScreen, Long(s));
|
||||
thetags[17].ti_Tag := TAG_END;
|
||||
w := OpenWindowTags(NIL, [
|
||||
WA_IDCMP, IDCMP_CLOSEWINDOW,
|
||||
WA_Left, 20,
|
||||
WA_Top, 50,
|
||||
WA_Width, 336,
|
||||
WA_Height, 100,
|
||||
WA_MinWidth, 50,
|
||||
WA_MinHeight, 20,
|
||||
WA_MaxWidth, -1,
|
||||
WA_MaxHeight, -1,
|
||||
WA_DepthGadget, ltrue,
|
||||
WA_DragBar, -1,
|
||||
WA_CloseGadget, -1,
|
||||
WA_SizeGadget, -1,
|
||||
WA_SmartRefresh, -1,
|
||||
WA_Activate, -1,
|
||||
WA_Title, 'Feel Free to Re-Size the Window',
|
||||
WA_CustomScreen, s,
|
||||
TAG_END]);
|
||||
|
||||
w := OpenWindowTagList(NIL, @thetags);
|
||||
IF w <> NIL THEN begin
|
||||
|
||||
DoDrawing(w^.RPort);
|
||||
@ -116,7 +123,13 @@ begin
|
||||
CloseScreen(s);
|
||||
end else
|
||||
writeln('Could not open the screen.');
|
||||
CloseLibrary(GfxBase);
|
||||
end else writeln('no graphics.library');
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
@ -23,17 +23,27 @@ PROGRAM SortDemo;
|
||||
window stayed locked.
|
||||
Aug 23 1998.
|
||||
|
||||
Added MessageBox for report.
|
||||
31 Jul 2000.
|
||||
|
||||
Removed opening of graphics.library.
|
||||
21 Mar 2001.
|
||||
|
||||
Reworked to use systemvartags.
|
||||
28 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
|
||||
One last remark, the heapsort can't be stoped
|
||||
so you have to wait until it's finished.
|
||||
}
|
||||
|
||||
uses Exec, Intuition, Graphics, Utility, GadTools;
|
||||
uses Exec, Intuition, Graphics, Utility, GadTools, msgbox,systemvartags;
|
||||
{$mode objfpc}
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
CONST version : PChar = '$VER: SortDemo 1.3 (23-Aug-98)';
|
||||
CONST
|
||||
vers : string = '$VER: SortDemo 1.3 ' + {$I %DATE%} + ' ' + {$I %TIME%}#0;
|
||||
|
||||
nmax=2000;
|
||||
|
||||
@ -44,7 +54,7 @@ CONST version : PChar = '$VER: SortDemo 1.3 (23-Aug-98)';
|
||||
s : pScreen = Nil;
|
||||
MenuStrip : pMenu = Nil;
|
||||
vi : Pointer = Nil;
|
||||
ltrue : longint = -1;
|
||||
|
||||
|
||||
modenames : Array[0..7] of string[10] = (
|
||||
'Heapsort',
|
||||
@ -63,31 +73,53 @@ CONST version : PChar = '$VER: SortDemo 1.3 (23-Aug-98)';
|
||||
}
|
||||
|
||||
nm : array[0..21] of tNewMenu = (
|
||||
(nm_Type: NM_TITLE; nm_Label: 'Demo'; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Start'; nm_CommKey: 'S'; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Stop'; nm_CommKey: 'H'; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label: 'Demo';nm_CommKey: NIL; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Start';nm_CommKey: 'S'; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Stop';nm_CommKey: 'H'; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
|
||||
{ this will be a barlabel, have to set this one later }
|
||||
(nm_Type: NM_ITEM; nm_Label: NIL; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: NIL; nm_CommKey: NIL; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Quit'; nm_CommKey: 'Q'; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label: 'Algorithm'; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'HeapSort'; nm_CommKey: '1'; nm_Flags: CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 254; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'ShellSort'; nm_CommKey: '2'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 253; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Pick out'; nm_CommKey: '3'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 251; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Insert'; nm_CommKey: '4'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 247; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'ShakerSort'; nm_CommKey: '5'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 239; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'BubbleSort'; nm_CommKey: '6'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 223; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'QuickSort'; nm_CommKey: '7'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 191; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'MergeSort'; nm_CommKey: '8'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 127; nm_UserData: NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label: 'Preferences'; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Data'; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Random'; nm_CommKey: 'R'; nm_Flags: CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 2; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Malicious'; nm_CommKey: 'M'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 1; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Diagram'; nm_CommKey: NIL; nm_Flags: 0; nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Needles'; nm_CommKey: 'N'; nm_Flags: CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 2; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Dots'; nm_CommKey: 'D'; nm_Flags: CHECKIT+MENUTOGGLE; nm_MutualExclude: 1; nm_UserData: NIL),
|
||||
(nm_Type: NM_END; nm_Label: NIL; nm_CommKey: NIL; nm_Flags: 0;nm_MutualExclude:0;nm_UserData:NIL));
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Quit'; nm_CommKey: 'Q'; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label: 'Algorithm'; nm_CommKey: NIL; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'HeapSort'; nm_CommKey: '1'; nm_Flags:
|
||||
CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 254; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'ShellSort'; nm_CommKey: '2'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 253; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Pick out'; nm_CommKey: '3'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 251; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Insert'; nm_CommKey: '4'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 247; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'ShakerSort'; nm_CommKey: '5'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 239; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'BubbleSort'; nm_CommKey: '6'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 223; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'QuickSort'; nm_CommKey: '7'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 191; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'MergeSort'; nm_CommKey: '8'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 127; nm_UserData: NIL),
|
||||
(nm_Type: NM_TITLE; nm_Label: 'Preferences'; nm_CommKey: NIL; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Data'; nm_CommKey: NIL; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Random'; nm_CommKey: 'R'; nm_Flags:
|
||||
CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 2; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Malicious'; nm_CommKey: 'M'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 1; nm_UserData: NIL),
|
||||
(nm_Type: NM_ITEM; nm_Label: 'Diagram'; nm_CommKey: NIL; nm_Flags: 0;
|
||||
nm_MutualExclude: 0; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Needles'; nm_CommKey: 'N'; nm_Flags:
|
||||
CHECKIT+CHECKED+MENUTOGGLE; nm_MutualExclude: 2; nm_UserData: NIL),
|
||||
(nm_Type: NM_SUB; nm_Label: 'Dots'; nm_CommKey: 'D'; nm_Flags:
|
||||
CHECKIT+MENUTOGGLE; nm_MutualExclude: 1; nm_UserData: NIL),
|
||||
(nm_Type: NM_END; nm_Label: NIL; nm_CommKey: NIL; nm_Flags:
|
||||
0;nm_MutualExclude:0;nm_UserData:NIL));
|
||||
|
||||
|
||||
VAR sort: ARRAY[1..nmax] OF Real;
|
||||
@ -99,19 +131,16 @@ VAR sort: ARRAY[1..nmax] OF Real;
|
||||
Msg : pMessage;
|
||||
wintitle : string[80];
|
||||
scrtitle : string[80];
|
||||
tags : array[1..18] of tTagItem;
|
||||
|
||||
Procedure CleanUp(s : string; err : Integer);
|
||||
begin
|
||||
if MenuStrip <> nil then begin
|
||||
if assigned(MenuStrip) then begin
|
||||
ClearMenuStrip(w);
|
||||
FreeMenus(MenuStrip);
|
||||
end;
|
||||
if vi <> nil then FreeVisualInfo(vi);
|
||||
if w <> nil then CloseWindow(w);
|
||||
if GfxBase <> nil then CloseLibrary(GfxBase);
|
||||
if GadToolsBase <> nil then CloseLibrary(GadToolsBase);
|
||||
if s <> '' then writeln(s);
|
||||
if assigned(vi) then FreeVisualInfo(vi);
|
||||
if assigned(w) then CloseWindow(w);
|
||||
if s <> '' then MessageBox('SortDemo Report',s,'OK');
|
||||
Halt(err);
|
||||
end;
|
||||
|
||||
@ -220,7 +249,7 @@ BEGIN
|
||||
wintitle := '<- ' + IntToStr(num) + ' Data ->'
|
||||
ELSE
|
||||
wintitle := IntToStr(time) + ' Seconds';
|
||||
scrtitle := strpas(@version[6]) + ' - ' + s;
|
||||
scrtitle := strpas(@vers[6]) + ' - ' + s;
|
||||
wintitle := wintitle + #0;
|
||||
scrtitle := scrtitle + #0;
|
||||
SetWindowTitles(w,@wintitle[1],@scrtitle[1]);
|
||||
@ -463,10 +492,6 @@ END;
|
||||
|
||||
Procedure OpenEverything;
|
||||
begin
|
||||
GadToolsBase := OpenLibrary(PChar('gadtools.library'#0),37);
|
||||
if GadToolsBase = nil then CleanUp('Can''t open gadtools.library',20);
|
||||
GfxBase := OpenLibrary(GRAPHICSNAME,37);
|
||||
if GfxBase = nil then CleanUp('Can''t open graphics.library',20);
|
||||
|
||||
s := LockPubScreen(nil);
|
||||
if s = nil then CleanUp('Could not lock pubscreen',10);
|
||||
@ -474,25 +499,27 @@ begin
|
||||
vi := GetVisualInfoA(s, NIL);
|
||||
if vi = nil then CleanUp('No visual info',10);
|
||||
|
||||
tags[1] := TagItem(WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or IDCMP_NEWSIZE);
|
||||
tags[2] := TagItem(WA_Left, 0);
|
||||
tags[3] := TagItem(WA_Top, s^.BarHeight+1);
|
||||
tags[4] := TagItem(WA_Width, 224);
|
||||
tags[5] := TagItem(WA_Height, s^.Height-(s^.BarHeight-1));
|
||||
tags[6] := TagItem(WA_MinWidth, MinWinX);
|
||||
tags[7] := TagItem(WA_MinHeight, MinWinY);
|
||||
tags[8] := TagItem(WA_MaxWidth, -1);
|
||||
tags[9] := TagItem(WA_MaxHeight, -1);
|
||||
tags[10] := TagItem(WA_DepthGadget, ltrue);
|
||||
tags[11] := TagItem(WA_DragBar, ltrue);
|
||||
tags[12] := TagItem(WA_CloseGadget, ltrue);
|
||||
tags[13] := TagItem(WA_SizeGadget, ltrue);
|
||||
tags[14] := TagItem(WA_Activate, ltrue);
|
||||
tags[15] := TagItem(WA_SizeBRight, ltrue);
|
||||
tags[16] := TagItem(WA_GimmeZeroZero, ltrue);
|
||||
tags[17] := TagItem(WA_PubScreen, longint(s));
|
||||
tags[18].ti_Tag := TAG_END;
|
||||
w := OpenWindowTagList(NIL, @tags[1]);
|
||||
w := OpenWindowTags(NIL, [
|
||||
WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or
|
||||
IDCMP_NEWSIZE,
|
||||
WA_Left, 0,
|
||||
WA_Top, s^.BarHeight+1,
|
||||
WA_Width, 224,
|
||||
WA_Height, s^.Height-(s^.BarHeight-1),
|
||||
WA_MinWidth, MinWinX,
|
||||
WA_MinHeight, MinWinY,
|
||||
WA_MaxWidth, -1,
|
||||
WA_MaxHeight, -1,
|
||||
WA_DepthGadget, ltrue,
|
||||
WA_DragBar, ltrue,
|
||||
WA_CloseGadget, ltrue,
|
||||
WA_SizeGadget, ltrue,
|
||||
WA_Activate, ltrue,
|
||||
WA_SizeBRight, ltrue,
|
||||
WA_GimmeZeroZero, ltrue,
|
||||
WA_PubScreen, s,
|
||||
TAG_END]);
|
||||
|
||||
IF w=NIL THEN CleanUp('Could not open window',20);
|
||||
|
||||
Rast := w^.RPort;
|
||||
@ -501,9 +528,8 @@ begin
|
||||
nm[3].nm_Label := PChar(NM_BARLABEL);
|
||||
|
||||
if pExecBase(_ExecBase)^.LibNode.Lib_Version >= 39 then begin
|
||||
tags[1] := TagItem(GTMN_FrontPen, 1);
|
||||
tags[2].ti_Tag := TAG_END;
|
||||
MenuStrip := CreateMenusA(@nm,@tags[1]);
|
||||
MenuStrip := CreateMenus(@nm,[
|
||||
GTMN_FrontPen, 1, TAG_END]);
|
||||
end else MenuStrip := CreateMenusA(@nm,NIL);
|
||||
|
||||
if MenuStrip = nil then CleanUp('Could not open Menus',10);
|
||||
@ -612,5 +638,12 @@ begin
|
||||
CleanUp('',0);
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,9 +1,9 @@
|
||||
PROGRAM Sterne;
|
||||
{$mode objfpc}
|
||||
|
||||
uses Exec, Graphics, Intuition, Utility, systemvartags;
|
||||
|
||||
|
||||
uses Exec, Graphics, Intuition, Utility;
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
CONST MAX_STERNE = 42;
|
||||
MAX_GESCHW = 15;
|
||||
@ -92,38 +92,32 @@ END;
|
||||
PROCEDURE CleanUp(str:string; code : Longint);
|
||||
|
||||
BEGIN
|
||||
If Win<>Nil Then
|
||||
If assigned(Win) Then
|
||||
CloseWindow(Win);
|
||||
If (Scr<>Nil) then CloseScreen(Scr);
|
||||
if GfxBase <> nil then CloseLibrary(GfxBase);
|
||||
If assigned(Scr) then CloseScreen(Scr);
|
||||
if str <> '' then writeln(str);
|
||||
Halt(code);
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE Init;
|
||||
var
|
||||
thetags : array[0..3] of tTagItem;
|
||||
|
||||
BEGIN
|
||||
GfxBase := OpenLibrary(GRAPHICSNAME,0);
|
||||
if GfxBase = nil then CleanUp('no graphics.library',20);
|
||||
|
||||
Scr:=Nil; Win:=Nil;
|
||||
|
||||
thetags[0] := TagItem(SA_Depth, 3);
|
||||
thetags[1] := TagItem(SA_DisplayID, HIRES_KEY);
|
||||
thetags[2].ti_Tag := TAG_END;
|
||||
Scr := OpenScreenTags(NIL,[
|
||||
SA_Depth, 3,
|
||||
SA_DisplayID, HIRES_KEY,
|
||||
TAG_END]);
|
||||
|
||||
Scr := OpenScreenTagList(NIL,@thetags);
|
||||
If Scr=Nil Then CleanUp('No screen',20);
|
||||
|
||||
thetags[0] := TagItem(WA_Flags, WFLG_BORDERLESS);
|
||||
thetags[1] := TagItem(WA_IDCMP, IDCMP_MOUSEBUTTONS);
|
||||
thetags[2] := TagItem(WA_CustomScreen, Longint(Scr));
|
||||
thetags[3].ti_Tag := TAG_DONE;
|
||||
Win:=OpenWindowTags(Nil, [
|
||||
WA_Flags, WFLG_BORDERLESS,
|
||||
WA_IDCMP, IDCMP_MOUSEBUTTONS,
|
||||
WA_CustomScreen, Scr,
|
||||
TAG_DONE]);
|
||||
|
||||
Win:=OpenWindowTagList(Nil, @thetags);
|
||||
If Win=Nil Then CleanUp('No window',20);
|
||||
|
||||
initSterne;
|
||||
@ -155,3 +149,11 @@ BEGIN
|
||||
CleanUp('',0);
|
||||
END.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -1,13 +1,38 @@
|
||||
PROGRAM Talk2Boopsi;
|
||||
|
||||
{ This example creates a Boopsi prop gadget and integer string gadget, connecting them so they }
|
||||
{ update each other when the user changes their value. The example program only initializes }
|
||||
{ the gadgets and puts them on the window; it doesn't have to interact with them to make them }
|
||||
{ talk to each other. }
|
||||
{$mode objfpc}
|
||||
|
||||
{ This example creates a Boopsi prop gadget and integer string gadget, connecting them
|
||||
so they }
|
||||
{ update each other when the user changes their value. The example program only
|
||||
initializes }
|
||||
{ the gadgets and puts them on the window; it doesn't have to interact with them to
|
||||
make them }
|
||||
{ talk to each other.
|
||||
}
|
||||
|
||||
{
|
||||
History:
|
||||
|
||||
Changed to use TAGS.
|
||||
16 Jul 2000.
|
||||
|
||||
Added MessageBox for report.
|
||||
31 Jul 2000.
|
||||
|
||||
Changed to use array of const.
|
||||
OpenWindowTags,
|
||||
NewObject and
|
||||
SetGadgetAttrs
|
||||
12 Nov 2002.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
|
||||
}
|
||||
|
||||
uses Exec, Intuition, Utility,msgbox, systemvartags;
|
||||
|
||||
uses Exec, Intuition, Utility;
|
||||
|
||||
{$I tagutils.inc}
|
||||
|
||||
VAR
|
||||
w : pWindow;
|
||||
@ -17,7 +42,6 @@ VAR
|
||||
done : BOOLEAN;
|
||||
dummy : Word;
|
||||
temp : Longint;
|
||||
thetags : array[0..11] of tTagItem;
|
||||
prop2intmap : array[0..1] of tTagItem;
|
||||
int2propmap : array[0..1] of tTagItem;
|
||||
|
||||
@ -25,7 +49,7 @@ CONST
|
||||
|
||||
vers : PChar = '$VER: Talk2boopsi 37.1';
|
||||
|
||||
PROPGADGET_ID = 1;
|
||||
PROPGADGET_ID = 1;
|
||||
INTGADGET_ID = 2;
|
||||
PROPGADGETWIDTH = 10;
|
||||
PROPGADGETHEIGHT = 80;
|
||||
@ -39,10 +63,10 @@ CONST
|
||||
|
||||
PROCEDURE CleanUp(Why : STRING; err: Word);
|
||||
BEGIN
|
||||
IF prop <> NIL THEN DisposeObject(prop);
|
||||
IF int <> NIL THEN DisposeObject(int);
|
||||
IF w <> NIL THEN CloseWindow(w);
|
||||
IF Why <> '' THEN WriteLN(Why);
|
||||
IF assigned(prop) THEN DisposeObject(prop);
|
||||
IF assigned(int) THEN DisposeObject(int);
|
||||
IF assigned(w) THEN CloseWindow(w);
|
||||
IF Why <> '' THEN MessageBox('Boopsi Report',Why,'OK');
|
||||
Halt(err);
|
||||
END;
|
||||
|
||||
@ -50,64 +74,61 @@ BEGIN
|
||||
|
||||
done := FALSE;
|
||||
|
||||
prop2intmap[0] := TagItem(PGA_Top, STRINGA_LongVal);
|
||||
prop2intmap[0].ti_Tag := PGA_Top;
|
||||
prop2intmap[0].ti_Data := STRINGA_LongVal;
|
||||
prop2intmap[1].ti_Tag := TAG_END;
|
||||
|
||||
int2propmap[0] := TagItem(STRINGA_LongVal, PGA_Top);
|
||||
int2propmap[0].ti_Tag := STRINGA_LongVal;
|
||||
int2propmap[0].ti_Data := PGA_Top;
|
||||
int2propmap[1].ti_Tag := TAG_END;
|
||||
|
||||
thetags[0] := TagItem(WA_Flags, WFLG_DEPTHGADGET + WFLG_DRAGBAR +
|
||||
WFLG_CLOSEGADGET + WFLG_SIZEGADGET + WFLG_ACTIVATE);
|
||||
thetags[1] := TagItem(WA_IDCMP, IDCMP_CLOSEWINDOW);
|
||||
thetags[2] := TagItem(WA_Width, MINWINDOWWIDTH + 10);
|
||||
thetags[3] := TagItem(WA_Height, MINWINDOWHEIGHT + 10);
|
||||
thetags[4] := TagItem(WA_MinWidth, MINWINDOWWIDTH);
|
||||
thetags[5] := TagItem(WA_MinHeight, MINWINDOWHEIGHT);
|
||||
thetags[6].ti_Tag := TAG_END;
|
||||
|
||||
w := OpenWindowTagList(NIL,@thetags);
|
||||
w := OpenWindowTags(NIL,[
|
||||
WA_Flags, WFLG_DEPTHGADGET + WFLG_DRAGBAR +
|
||||
WFLG_CLOSEGADGET + WFLG_SIZEGADGET + WFLG_ACTIVATE,
|
||||
WA_IDCMP, IDCMP_CLOSEWINDOW,
|
||||
WA_Width, MINWINDOWWIDTH + 10,
|
||||
WA_Height, MINWINDOWHEIGHT + 10,
|
||||
WA_MinWidth, MINWINDOWWIDTH,
|
||||
WA_MinHeight, MINWINDOWHEIGHT,
|
||||
TAG_END]);
|
||||
|
||||
IF w=NIL THEN CleanUp('No window',20);
|
||||
|
||||
thetags[0] := TagItem(GA_ID, PROPGADGET_ID);
|
||||
thetags[1] := TagItem(GA_Top, (w^.BorderTop) + 5);
|
||||
thetags[2] := TagItem(GA_Left, (w^.BorderLeft) + 5);
|
||||
thetags[3] := TagItem(GA_Width, PROPGADGETWIDTH);
|
||||
thetags[4] := TagItem(GA_Height, PROPGADGETHEIGHT);
|
||||
thetags[5] := TagItem(ICA_MAP, Longint(@prop2intmap));
|
||||
thetags[6] := TagItem(PGA_Total, TOTAL);
|
||||
thetags[7] := TagItem(PGA_Top, INITIALVAL);
|
||||
thetags[8] := TagItem(PGA_Visible, VISIBLE);
|
||||
thetags[9] := TagItem(PGA_NewLook, 1); { true }
|
||||
thetags[10].ti_Tag := TAG_END;
|
||||
|
||||
prop := NewObjectA(NIL, PChar('propgclass'#0),@thetags);
|
||||
prop := NewObject(NIL, 'propgclass',[
|
||||
GA_ID, PROPGADGET_ID,
|
||||
GA_Top, (w^.BorderTop) + 5,
|
||||
GA_Left, (w^.BorderLeft) + 5,
|
||||
GA_Width, PROPGADGETWIDTH,
|
||||
GA_Height, PROPGADGETHEIGHT,
|
||||
ICA_MAP, @prop2intmap,
|
||||
PGA_Total, TOTAL,
|
||||
PGA_Top, INITIALVAL,
|
||||
PGA_Visible, VISIBLE,
|
||||
PGA_NewLook, ltrue,
|
||||
TAG_END]);
|
||||
|
||||
IF prop = NIL THEN CleanUp('No propgadget',20);
|
||||
|
||||
|
||||
thetags[0] := TagItem(GA_ID, INTGADGET_ID);
|
||||
thetags[2] := TagItem(GA_Top, (w^.BorderTop) + 5);
|
||||
thetags[3] := TagItem(GA_Left, (w^.BorderLeft) + PROPGADGETWIDTH + 10);
|
||||
thetags[4] := TagItem(GA_Width, MINWINDOWWIDTH -
|
||||
int := NewObject(NIL, 'strgclass',[
|
||||
GA_ID, INTGADGET_ID,
|
||||
GA_Top, (w^.BorderTop) + 5,
|
||||
GA_Left, (w^.BorderLeft) + PROPGADGETWIDTH + 10,
|
||||
GA_Width, MINWINDOWWIDTH -
|
||||
(w^.BorderLeft + w^.BorderRight +
|
||||
PROPGADGETWIDTH + 15));
|
||||
thetags[5] := TagItem(GA_Height, INTGADGETHEIGHT);
|
||||
PROPGADGETWIDTH + 15),
|
||||
GA_Height, INTGADGETHEIGHT,
|
||||
|
||||
thetags[6] := TagItem(ICA_MAP, Longint(@int2propmap));
|
||||
thetags[7] := TagItem(ICA_TARGET, Longint(prop));
|
||||
thetags[8] := TagItem(GA_Previous, Longint(prop));
|
||||
ICA_MAP, @int2propmap,
|
||||
ICA_TARGET, prop,
|
||||
GA_Previous, prop,
|
||||
|
||||
thetags[9] := TagItem(STRINGA_LongVal, INITIALVAL);
|
||||
thetags[10] := TagItem(STRINGA_MaxChars, MAXCHARS);
|
||||
thetags[11].ti_Tag := TAG_END;
|
||||
STRINGA_LongVal, INITIALVAL,
|
||||
STRINGA_MaxChars, MAXCHARS,
|
||||
TAG_END]);
|
||||
|
||||
int := NewObjectA(NIL, PChar('strgclass'#0),@thetags);
|
||||
|
||||
thetags[0] := TagItem(ICA_TARGET, Longint(int));
|
||||
thetags[1].ti_Tag := TAG_END;
|
||||
|
||||
temp := SetGadgetAttrsA(prop, w, NIL,@thetags);
|
||||
temp := SetGadgetAttrs(prop, w, NIL,[
|
||||
ICA_TARGET, int,
|
||||
TAG_END]);
|
||||
|
||||
IF int = NIL THEN CleanUp('No INTEGER gadget',20);
|
||||
|
||||
@ -125,7 +146,14 @@ BEGIN
|
||||
CleanUp('',0);
|
||||
END.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-11-28 19:40:45 nils
|
||||
* update
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user