paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 09:50:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

amiga: examples fixed and updated

Browse Source 
git-svn-id: trunk@48988 -
This commit is contained in:
marcus 2021-03-15 20:46:29 +00:00
parent c4dfb2c8bd
commit 6a92798603
5 changed files with 33 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
packages/amunits/examples/asltest.pas
View File

@ -28,18 +28,18 @@ BEGIN
fr := AllocAslRequestTags(ASL_FileRequest,[
ASLFR_InitialPattern, AsTag('#?'),
ASLFR_TitleText, AsTag('Test av ASL-Requester by NS'),
ASLFR_DoPatterns, LTrue,
ASLFR_DoPatterns, AsTag(True),
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) +
' The path is:" ' +
string(fr^.rf_Dir) + '"' +
chr(10) +
'And the file is :' +
strpas(fr^.rf_File),
'And the file is: "' +
string(fr^.rf_File) + '"',
'OK');
end else MessageBox('Test of Asl','You canceled','OK');
FreeAslRequest(fr);

42
packages/amunits/examples/bezier.pas
View File

@ -124,15 +124,13 @@ var
begin
SetDrMd(rp, JAM1);
SetAPen(rp, 0);
RectFill(rp, BorderLeft, BorderTop,
BorderRight, BorderBottom);
RectFill(rp, BorderLeft, BorderTop, BorderRight, BorderBottom);
SetDrMd(rp, COMPLEMENT);
SetAPen(rp, 3);
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;
@ -149,25 +147,25 @@ IDCMP_MOUSEMOVE);
case StoreMsg.IClass of
IDCMP_MOUSEMOVE : if PointCount > 0 then begin
if not OutOfBounds then
DrawLine;
DrawLine;
LastX := StoreMsg.MouseX;
LastY := StoreMsg.MouseY;
if (LastX > BorderLeft) and
(LastX < BorderRight) and
(LastY > BorderTop) and
(LastY < BorderBottom) then begin
DrawLine;
OutOfBounds := False;
(LastX < BorderRight) and
(LastY > BorderTop) and
(LastY < BorderBottom) then begin
DrawLine;
OutOfBounds := False;
end else
OutOfBounds := True;
OutOfBounds := True;
end;
IDCMP_MOUSEBUTTONS : if StoreMsg.Code = SELECTUP then begin
if PointCount > 0 then
Leave := CheckForExit
Leave := CheckForExit
else
ClearIt;
if (not Leave) and (not OutOfBounds) then
AddPoint;
AddPoint;
end;
IDCMP_CLOSEWINDOW : CleanUpAndDie;
end;
@ -222,7 +220,7 @@ end;
begin
s := OpenScreenTags(nil,[
AsTag(SA_Pens), AsTag(@pens),
AsTag(SA_Pens), AsTag(@pens),
AsTag(SA_Depth), 2,
AsTag(SA_DisplayID), HIRES_KEY,
AsTag(SA_Title), AsTag('Simple Bezier Curves'),
@ -230,23 +228,23 @@ begin
if s = NIL then CleanUpAndDie;
w := OpenWindowTags(nil,[
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_DepthGadget, AsTag(True),
WA_DragBar, AsTag(True),
WA_CloseGadget, AsTag(True),
WA_ReportMouse, AsTag(True),
WA_SmartRefresh, AsTag(True),
WA_Activate, AsTag(True),
WA_Title, AsTag('Close the Window to Quit'),
WA_CustomScreen, AsTag(s),
TAG_END]);
IF w=NIL THEN CleanUpAndDie;
IF w = NIL THEN CleanUpAndDie;
rp := w^.RPort;
GfxMove(rp, 252, 30);

6
packages/amunits/examples/deviceinfo.pas
View File

@ -21,7 +21,7 @@
Program DeviceInfo;
uses exec,amigados,strings;
uses exec,amigados;
Const
MaxSize = 80;
@ -44,7 +44,7 @@ End;
Procedure AsdaLaVista(warum : String ; code : longint);
Begin
If Inf <> Nil Then ExecFreeMem(Inf,SizeOf(tInfoData));
If Inf <> Nil Then FreeMem(Inf);
If warum <> '' Then WriteLn('',warum,'');
halt(code);
End;
@ -56,7 +56,7 @@ Begin
If ParamCount = 0 Then AsdaLaVista(' DiskInfo V1.0, © 1992 T.Schmid - Usage : DiskInfo Dfx:',0);
MyFile := ParamStr(1) + #0;
Inf:=pInfoData(ExecAllocMem( SizeOf(tInfoData), MEMF_PUBLIC ) );
Inf:=pInfoData(AllocMem( SizeOf(tInfoData) ) );
If Inf=Nil Then AsdaLaVista('No memory',5);
s:= 'Writeenabled';

4
packages/amunits/examples/easygadtools.pas
View File

@ -118,8 +118,8 @@ BEGIN
gad := ButtonGadget(2,10,HG,200,HGadget,'Screen Requester');
HG := HG + DistGad + 3;
//gad := CycleGadget(3,100,HG,100,HGadget,'Cycle me',@strarray);
//HG := HG + DistGad+4;
gad := CycleGadget(3,100,HG,100,HGadget,'Cycle me',@strarray);
HG := HG + DistGad+4;
gad := ButtonGadget(4,10,HG,96,HGadget,'OK');
gad := ButtonGadget(5,115,HG,96,HGadget,'Cancel');

6
packages/amunits/examples/otherlibs/requestmodeid.pas
View File

@ -45,9 +45,9 @@ Begin
rda:=ReadArgs (template,@vecarray,Nil);
If rda<>Nil Then Begin
If vecarray[0] <> 0 then width := long(@vecarray[0]);
If vecarray[1] <> 0 then height := long(@vecarray[1]);
If vecarray[2] <> 0 then depth := long(@vecarray[2]);
If vecarray[0] <> 0 then width := PlongInt(vecarray[0])^;
If vecarray[1] <> 0 then height := PLongInt(vecarray[1])^;
If vecarray[2] <> 0 then depth := PLongInt(vecarray[2])^;
FreeArgs(rda);
End;