paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 01:05:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed startcode for library

Browse Source
This commit is contained in:
nils 2003-02-11 20:24:44 +00:00
parent ff2d3b7d06
commit 376c1348d0
6 changed files with 546 additions and 187 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
packages/extra/amunits/otherlibs/amarquee/units/amarquee.pas
View File

@ -30,6 +30,9 @@
use_auto_openlib. use_auto_openlib.
12 Jan 2003. 12 Jan 2003.
Changed startcode for unit.
10 Feb 2003.
nils.sjoholm@mailbox.swipnet.se nils.sjoholm@mailbox.swipnet.se
} }
@ -294,10 +297,24 @@ FUNCTION QNewSessionAsyncTags(host : string; port : LONGINT; name : string; cons
FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : Array Of Const) : pQSession; FUNCTION QNewHostSessionTags(hostnames : string; port : pLONGINT; names : string; const argv : Array Of Const) : pQSession;
FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : Array Of Const) : pQSession; FUNCTION QNewServerSessionTags(hostNames : string; progNames : string; const argv : Array Of Const) : pQSession;
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitAMARQUEELibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
AMARQUEEIsCompiledHow : longint;
IMPLEMENTATION IMPLEMENTATION
uses msgbox ,pastoc, tagsarray; uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
pastoc,tagsarray;
FUNCTION QFreeSession(session : pQSession) : LONGINT; FUNCTION QFreeSession(session : pQSession) : LONGINT;
BEGIN BEGIN
@ -1051,50 +1068,95 @@ begin
QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv)); QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv));
end; end;
{$I useautoopenlib.inc}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of amarquee.library}
var
amarquee_exit : pointer;
const const
VERSION : string[2] = '50'; { Change VERSION and LIBVERSION to proper values }
procedure CloseAmarqueeLibrary; VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of amarquee.library}
{$Info don't forget to use InitAMARQUEELibrary in the beginning of your program}
var
amarquee_exit : Pointer;
procedure CloseamarqueeLibrary;
begin begin
ExitProc := amarquee_exit; ExitProc := amarquee_exit;
if AmarqueeBase <> nil then begin if AMarqueeBase <> nil then begin
CloseLibrary(AmarqueeBase); CloseLibrary(AMarqueeBase);
AmarqueeBase := nil; AMarqueeBase := nil;
end;
end;
procedure InitAMARQUEELibrary;
begin
AMarqueeBase := nil;
AMarqueeBase := OpenLibrary(AMARQUEENAME,LIBVERSION);
if AMarqueeBase <> nil then begin
amarquee_exit := ExitProc;
ExitProc := @CloseamarqueeLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open amarquee.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end; end;
end; end;
begin begin
AmarqueeBase := nil; AMARQUEEIsCompiledHow := 2;
AmarqueeBase := OpenLibrary(AmarqueeNAME,50); {$endif use_init_openlib}
if AmarqueeBase <> nil then begin
Amarquee_exit := ExitProc; {$ifdef use_auto_openlib}
ExitProc := @CloseAmarqueeLibrary; {$Info Compiling autoopening of amarquee.library}
var
amarquee_exit : Pointer;
procedure CloseamarqueeLibrary;
begin
ExitProc := amarquee_exit;
if AMarqueeBase <> nil then begin
CloseLibrary(AMarqueeBase);
AMarqueeBase := nil;
end;
end;
begin
AMarqueeBase := nil;
AMarqueeBase := OpenLibrary(AMARQUEENAME,LIBVERSION);
if AMarqueeBase <> nil then begin
amarquee_exit := ExitProc;
ExitProc := @CloseamarqueeLibrary;
AMARQUEEIsCompiledHow := 1;
end else begin end else begin
MessageBox('FPC Pascal Error', MessageBox('FPC Pascal Error',
'Can''t open Amarquee.library version ' + 'Can''t open amarquee.library version ' + VERSION + #10 +
VERSION + 'Deallocating resources and closing down',
chr(10) + 'Oops');
'Deallocating resources and closing down', halt(20);
'Oops');
halt(20);
end; end;
{$else}
{$Warning No autoopening of amarquee.library compiled}
{$Info Make sure you open amarquee.library yourself}
{$endif use_auto_openlib} {$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
AMARQUEEIsCompiledHow := 3;
{$Warning No autoopening of amarquee.library compiled}
{$Warning Make sure you open amarquee.library yourself}
{$endif dont_use_openlib}
END. (* UNIT AMARQUEE *) END. (* UNIT AMARQUEE *)
{ {
$Log$ $Log$
Revision 1.1 2003-01-12 20:40:47 nils Revision 1.2 2003-02-11 20:24:44 nils
* changed startcode for library
Revision 1.1 2003/01/12 20:40:47 nils
* initial release * initial release
} }

115
packages/extra/amunits/otherlibs/gtlayout/units/gtlayout.pas
View File

@ -32,6 +32,9 @@
use_auto_openlib. use_auto_openlib.
12 Jan 2003. 12 Jan 2003.
Changed startcode for unit.
10 Feb 2003.
nils.sjoholm@mailbox.swipnet.se nils.sjoholm@mailbox.swipnet.se
} }
@ -556,13 +559,14 @@ const
pHelpMsg = ^tHelpMsg; pHelpMsg = ^tHelpMsg;
{ pUWord = ^UWord; } { pUWord = ^UWord; }
ppGadget = ^pGadget; ppGadget = ^pGadget;
pUWORD = ^UWORD;
PROCEDURE LT_LevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; VAR par6 : LONGINT; VAR par7 : LONGINT; last : LONGINT); PROCEDURE LT_LevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; par6 : pLONGINT; par7 : pLONGINT; last : LONGINT);
PROCEDURE LT_DeleteHandle(last : pLayoutHandle); PROCEDURE LT_DeleteHandle(last : pLayoutHandle);
FUNCTION LT_CreateHandle(par1 : pScreen; last : pTextAttr) : pLayoutHandle; FUNCTION LT_CreateHandle(par1 : pScreen; last : pTextAttr) : pLayoutHandle;
FUNCTION LT_CreateHandleTagList(par1 : pScreen; tags : pTagItem) : pLayoutHandle; FUNCTION LT_CreateHandleTagList(par1 : pScreen; tags : pTagItem) : pLayoutHandle;
FUNCTION LT_Rebuild(par1 : pLayoutHandle; par2 : pIBox; par3 : LONGINT; par4 : LONGINT; last : LONGINT) : BOOLEAN; FUNCTION LT_Rebuild(par1 : pLayoutHandle; par2 : pIBox; par3 : LONGINT; par4 : LONGINT; last : LONGINT) : BOOLEAN;
PROCEDURE LT_HandleInput(par1 : pLayoutHandle; par2 : ulong; var par3 : ulong; var par4 : UWORD; last :ppGadget); PROCEDURE LT_HandleInput(par1 : pLayoutHandle; par2 : ulong; par3 : pulong; par4 : pUWORD; last :ppGadget);
PROCEDURE LT_BeginRefresh(last : pLayoutHandle); PROCEDURE LT_BeginRefresh(last : pLayoutHandle);
PROCEDURE LT_EndRefresh(par1 : pLayoutHandle; last : LONGINT); PROCEDURE LT_EndRefresh(par1 : pLayoutHandle; last : LONGINT);
FUNCTION LT_GetAttributesA(par1 : pLayoutHandle; par2 : LONGINT; tags : pTagItem) : LONGINT; FUNCTION LT_GetAttributesA(par1 : pLayoutHandle; par2 : LONGINT; tags : pTagItem) : LONGINT;
@ -587,12 +591,12 @@ FUNCTION LT_BuildA(par1 : pLayoutHandle; tags : pTagItem) : pWindow;
FUNCTION LT_RebuildTagList(par1 : pLayoutHandle; par2 : LONGINT; tags : pTagItem) : BOOLEAN; FUNCTION LT_RebuildTagList(par1 : pLayoutHandle; par2 : LONGINT; tags : pTagItem) : BOOLEAN;
PROCEDURE LT_UpdateStrings(last : pLayoutHandle); PROCEDURE LT_UpdateStrings(last : pLayoutHandle);
PROCEDURE LT_DisposeMenu(last : pMenu); PROCEDURE LT_DisposeMenu(last : pMenu);
FUNCTION LT_NewMenuTemplate(par1 : pScreen; par2 : pTextAttr; par3 : pImage; par4 : pImage; VAR par5 : LONGINT; last : pNewMenu) : pMenu; FUNCTION LT_NewMenuTemplate(par1 : pScreen; par2 : pTextAttr; par3 : pImage; par4 : pImage; par5 : pLONGINT; last : pNewMenu) : pMenu;
FUNCTION LT_NewMenuTagList(tags : pTagItem) : pMenu; FUNCTION LT_NewMenuTagList(tags : pTagItem) : pMenu;
PROCEDURE LT_MenuControlTagList(par1 : pWindow; par2 : pMenu; tags : pTagItem); PROCEDURE LT_MenuControlTagList(par1 : pWindow; par2 : pMenu; tags : pTagItem);
FUNCTION LT_GetMenuItem(par1 : pMenu; last : ulong) : pMenuItem; FUNCTION LT_GetMenuItem(par1 : pMenu; last : ulong) : pMenuItem;
FUNCTION LT_FindMenuCommand(par1 : pMenu; par2 : ulong; par3 : ulong; last : pGadget) : pMenuItem; FUNCTION LT_FindMenuCommand(par1 : pMenu; par2 : ulong; par3 : ulong; last : pGadget) : pMenuItem;
PROCEDURE LT_NewLevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; VAR par6 : LONGINT; VAR par7 : LONGINT; last : LONGINT); PROCEDURE LT_NewLevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; par6 : pLONGINT; par7 : pLONGINT; last : LONGINT);
PROCEDURE LT_Refresh(last : pLayoutHandle); PROCEDURE LT_Refresh(last : pLayoutHandle);
PROCEDURE LT_CatchUpRefresh(last : pLayoutHandle); PROCEDURE LT_CatchUpRefresh(last : pLayoutHandle);
FUNCTION LT_GetWindowUserData(par1 : pWindow; last : POINTER) : POINTER; FUNCTION LT_GetWindowUserData(par1 : pWindow; last : POINTER) : POINTER;
@ -607,7 +611,7 @@ FUNCTION LT_GetAttributes(handle : pLayoutHandle; id : LONGINT; const tagList :
PROCEDURE LT_SetAttributes(handle : pLayoutHandle; id : LONGINT; const tagList : Array Of Const); PROCEDURE LT_SetAttributes(handle : pLayoutHandle; id : LONGINT; const tagList : Array Of Const);
PROCEDURE LT_Add(handle : pLayoutHandle; _type : LONGINT; _label : pCHAR; id : LONGINT; const tagList : Array Of Const); PROCEDURE LT_Add(handle : pLayoutHandle; _type : LONGINT; _label : pCHAR; id : LONGINT; const tagList : Array Of Const);
PROCEDURE LT_New(handle : pLayoutHandle; const tagList : Array Of Const); PROCEDURE LT_New(handle : pLayoutHandle; const tagList : Array Of Const);
FUNCTION LT_Layout(handle : pLayoutHandle; title : pCHAR; bounds : pIBox; extraWidth : LONGINT; extraHeight : LONGINT; idcmp : CARDINAL; align : LONGINT; const tagParams : Array Of Const) : pWindow; FUNCTION LT_Layout(handle : pLayoutHandle; title : pCHAR; bounds : pIBox; extraWidth : LONGINT; extraHeight : LONGINT; idcmp : longword; align : LONGINT; const tagParams : Array Of Const) : pWindow;
FUNCTION LT_LayoutMenus(handle : pLayoutHandle; menuTemplate : pNewMenu; const tagParams : Array Of Const) : pMenu; FUNCTION LT_LayoutMenus(handle : pLayoutHandle; menuTemplate : pNewMenu; const tagParams : Array Of Const) : pMenu;
FUNCTION LT_Build(handle : pLayoutHandle; const tagParams : Array Of Const) : pWindow; FUNCTION LT_Build(handle : pLayoutHandle; const tagParams : Array Of Const) : pWindow;
FUNCTION LT_RebuildTags(handle : pLayoutHandle; clear : LONGINT; const tags : Array Of Const) : BOOLEAN; FUNCTION LT_RebuildTags(handle : pLayoutHandle; clear : LONGINT; const tags : Array Of Const) : BOOLEAN;
@ -617,12 +621,25 @@ PROCEDURE LT_MenuControlTags(window : pWindow; intuitionMenu : pMenu; const tags
VAR GTLayoutBase : pLibrary; VAR GTLayoutBase : pLibrary;
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitGTLAYOUTLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
GTLAYOUTIsCompiledHow : longint;
IMPLEMENTATION IMPLEMENTATION
uses msgbox,tagsarray; uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
tagsarray;
PROCEDURE LT_LevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; VAR par6 : LONGINT; VAR par7 : LONGINT; last : LONGINT); PROCEDURE LT_LevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; par6 : pLONGINT; par7 : pLONGINT; last : LONGINT);
BEGIN BEGIN
ASM ASM
MOVE.L A6,-(A7) MOVE.L A6,-(A7)
@ -696,7 +713,7 @@ BEGIN
END; END;
END; END;
PROCEDURE LT_HandleInput(par1 : pLayoutHandle; par2 : ulong; var par3 : ulong;var par4 : UWORD; last : ppGadget); PROCEDURE LT_HandleInput(par1 : pLayoutHandle; par2 : ulong; par3 : pulong;par4 : pUWORD; last : ppGadget);
BEGIN BEGIN
ASM ASM
MOVE.L A6,-(A7) MOVE.L A6,-(A7)
@ -1021,7 +1038,7 @@ BEGIN
END; END;
END; END;
FUNCTION LT_NewMenuTemplate(par1 : pScreen; par2 : pTextAttr; par3 : pImage; par4 : pImage; VAR par5 : LONGINT; last : pNewMenu) : pMenu; FUNCTION LT_NewMenuTemplate(par1 : pScreen; par2 : pTextAttr; par3 : pImage; par4 : pImage; par5 : pLONGINT; last : pNewMenu) : pMenu;
BEGIN BEGIN
ASM ASM
MOVE.L A6,-(A7) MOVE.L A6,-(A7)
@ -1091,7 +1108,7 @@ BEGIN
END; END;
END; END;
PROCEDURE LT_NewLevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; VAR par6 : LONGINT; VAR par7 : LONGINT; last : LONGINT); PROCEDURE LT_NewLevelWidth(par1 : pLayoutHandle; par2 : pCHAR; par3 : POINTER; par4 : LONGINT; par5 : LONGINT; par6 : pLONGINT; par7 : pLONGINT; last : LONGINT);
BEGIN BEGIN
ASM ASM
MOVE.L A6,-(A7) MOVE.L A6,-(A7)
@ -1173,7 +1190,7 @@ begin
LT_NewA(handle , readintags(tagList)); LT_NewA(handle , readintags(tagList));
end; end;
FUNCTION LT_Layout(handle : pLayoutHandle; title : pCHAR; bounds : pIBox; extraWidth : LONGINT; extraHeight : LONGINT; idcmp : CARDINAL; align : LONGINT; const tagParams : Array Of Const) : pWindow; FUNCTION LT_Layout(handle : pLayoutHandle; title : pCHAR; bounds : pIBox; extraWidth : LONGINT; extraHeight : LONGINT; idcmp : longword; align : LONGINT; const tagParams : Array Of Const) : pWindow;
begin begin
LT_Layout := LT_LayoutA(handle , title , bounds , extraWidth , extraHeight , idcmp , align , readintags(tagParams)); LT_Layout := LT_LayoutA(handle , title , bounds , extraWidth , extraHeight , idcmp , align , readintags(tagParams));
end; end;
@ -1203,15 +1220,20 @@ begin
LT_MenuControlTagList(window , intuitionMenu , readintags(tags)); LT_MenuControlTagList(window , intuitionMenu , readintags(tags));
end; end;
const
{ Change VERSION and LIBVERSION to proper values }
{$I useautoopenlib.inc} VERSION : string[2] = '0';
{$ifdef use_auto_openlib} LIBVERSION : Cardinal = 0;
{$Info Compiling autoopening of gtlayout.library}
{$ifdef use_init_openlib}
{$Info Compiling initopening of gtlayout.library}
{$Info don't forget to use InitGTLAYOUTLibrary in the beginning of your program}
var var
gtlayout_exit : pointer; gtlayout_exit : Pointer;
procedure CloseGTLayoutLibrary; procedure ClosegtlayoutLibrary;
begin begin
ExitProc := gtlayout_exit; ExitProc := gtlayout_exit;
if GTLayoutBase <> nil then begin if GTLayoutBase <> nil then begin
@ -1220,29 +1242,66 @@ begin
end; end;
end; end;
const procedure InitGTLAYOUTLibrary;
VERSION : string[1] = '0'; begin
GTLayoutBase := nil;
GTLayoutBase := OpenLibrary(GTLAYOUTNAME,LIBVERSION);
if GTLayoutBase <> nil then begin
gtlayout_exit := ExitProc;
ExitProc := @ClosegtlayoutLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open gtlayout.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
GTLAYOUTIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of gtlayout.library}
var
gtlayout_exit : Pointer;
procedure ClosegtlayoutLibrary;
begin
ExitProc := gtlayout_exit;
if GTLayoutBase <> nil then begin
CloseLibrary(GTLayoutBase);
GTLayoutBase := nil;
end;
end;
begin begin
GTLayoutBase := nil; GTLayoutBase := nil;
GTLayOutBase := OpenLibrary(GTLAYOUTNAME,0); GTLayoutBase := OpenLibrary(GTLAYOUTNAME,LIBVERSION);
if GTLayoutBase <> nil then begin if GTLayoutBase <> nil then begin
gtlayout_exit := ExitProc; gtlayout_exit := ExitProc;
ExitProc := @CloseGTLayoutLibrary; ExitProc := @ClosegtlayoutLibrary;
GTLAYOUTIsCompiledHow := 1;
end else begin end else begin
MessageBox('FPC Pascal Error', MessageBox('FPC Pascal Error',
'Can''t open gtlayout.library version ' + 'Can''t open gtlayout.library version ' + VERSION + #10 +
VERSION + 'Deallocating resources and closing down',
chr(10) + 'Oops');
'Deallocating resources and closing down',
'Oops');
halt(20); halt(20);
end; end;
{$else}
{$Warning No autoopening of gtlayout.library compiled}
{$Info Make sure you open gtlayout.library yourself}
{$endif use_auto_openlib} {$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
GTLAYOUTIsCompiledHow := 3;
{$Warning No autoopening of gtlayout.library compiled}
{$Warning Make sure you open gtlayout.library yourself}
{$endif dont_use_openlib}
END. (* UNIT GTLAYOUT *) END. (* UNIT GTLAYOUT *)
{ {

131
packages/extra/amunits/otherlibs/identify/units/identify.pas
View File

@ -2,7 +2,7 @@
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
A file in Amiga system run time library. A file in Amiga system run time library.
Copyright (c) 2001 by Nils Sjoholm Copyright (c) 2001-2003 by Nils Sjoholm
member of the Amiga RTL development team. member of the Amiga RTL development team.
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
@ -29,6 +29,10 @@
use_auto_openlib. use_auto_openlib.
12 Jan 2003. 12 Jan 2003.
Changed cardinal > longword.
Changed startcode for unit.
11 Feb 2003.
nils.sjoholm@mailbox.swipnet.se nils.sjoholm@mailbox.swipnet.se
} }
@ -423,12 +427,12 @@ FUNCTION IdEstimateFormatSize(String_ : pCHAR; Tags : pTagItem) : Ulong;
} }
FUNCTION IdExpansionTags(const TagList : Array Of Const) : LONGINT; FUNCTION IdExpansionTags(const TagList : Array Of Const) : LONGINT;
FUNCTION IdHardwareTags(Type_ : CARDINAL; const TagList : Array Of Const) : pCHAR; FUNCTION IdHardwareTags(Type_ : longword; const TagList : Array Of Const) : pCHAR;
FUNCTION IdAlertTags(ID : CARDINAL; const TagList : Array Of Const) : LONGINT; FUNCTION IdAlertTags(ID : longword; const TagList : Array Of Const) : LONGINT;
FUNCTION IdFunctionTags(LibName : pCHAR; Offset : LONGINT; const TagList : Array Of Const) : LONGINT; FUNCTION IdFunctionTags(LibName : pCHAR; Offset : LONGINT; const TagList : Array Of Const) : LONGINT;
FUNCTION IdHardwareNumTags(Type_ : CARDINAL; const TagList : Array Of Const) : CARDINAL; FUNCTION IdHardwareNumTags(Type_ : longword; const TagList : Array Of Const) : longword;
FUNCTION IdFormatStringTags(String_ : pCHAR; Buffer : pCHAR; Length : CARDINAL; const Tags : Array Of Const) : CARDINAL; FUNCTION IdFormatStringTags(String_ : pCHAR; Buffer : pCHAR; Length : longword; const Tags : Array Of Const) : longword;
FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : CARDINAL; FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : longword;
{ {
Overlay functions Overlay functions
@ -438,12 +442,26 @@ FUNCTION IdFunction(LibName : string; Offset : LONGINT; TagList : pTagItem) : LO
FUNCTION IdFormatString(String_ : string; Buffer : pCHAR; Length : Ulong; Tags : pTagItem) : Ulong; FUNCTION IdFormatString(String_ : string; Buffer : pCHAR; Length : Ulong; Tags : pTagItem) : Ulong;
FUNCTION IdEstimateFormatSize(String_ : string; Tags : pTagItem) : Ulong; FUNCTION IdEstimateFormatSize(String_ : string; Tags : pTagItem) : Ulong;
FUNCTION IdFunctionTags(LibName : string; Offset : LONGINT; const TagList : Array Of Const) : LONGINT; FUNCTION IdFunctionTags(LibName : string; Offset : LONGINT; const TagList : Array Of Const) : LONGINT;
FUNCTION IdFormatStringTags(String_ : string; Buffer : pCHAR; Length : CARDINAL; const Tags : Array Of Const) : CARDINAL; FUNCTION IdFormatStringTags(String_ : string; Buffer : pCHAR; Length : longword; const Tags : Array Of Const) : longword;
FUNCTION IdEstimateFormatSizeTags(String_ : string; const Tags : Array Of Const) : CARDINAL; FUNCTION IdEstimateFormatSizeTags(String_ : string; const Tags : Array Of Const) : longword;
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitIDENTIFYLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
IDENTIFYIsCompiledHow : longint;
IMPLEMENTATION IMPLEMENTATION
uses msgbox,tagsarray,pastoc; uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
tagsarray,pastoc;
FUNCTION IdExpansion(TagList : pTagItem) : LONGINT; FUNCTION IdExpansion(TagList : pTagItem) : LONGINT;
BEGIN BEGIN
@ -556,12 +574,12 @@ begin
IdExpansionTags := IdExpansion(readintags(TagList)); IdExpansionTags := IdExpansion(readintags(TagList));
end; end;
FUNCTION IdHardwareTags(Type_ : CARDINAL; const TagList : Array Of Const) : pCHAR; FUNCTION IdHardwareTags(Type_ : longword; const TagList : Array Of Const) : pCHAR;
begin begin
IdHardwareTags := IdHardware(Type_ , readintags(TagList)); IdHardwareTags := IdHardware(Type_ , readintags(TagList));
end; end;
FUNCTION IdAlertTags(ID : CARDINAL; const TagList : Array Of Const) : LONGINT; FUNCTION IdAlertTags(ID : longword; const TagList : Array Of Const) : LONGINT;
begin begin
IdAlertTags := IdAlert(ID , readintags(TagList)); IdAlertTags := IdAlert(ID , readintags(TagList));
end; end;
@ -571,17 +589,17 @@ begin
IdFunctionTags := IdFunction(LibName , Offset , readintags(TagList)); IdFunctionTags := IdFunction(LibName , Offset , readintags(TagList));
end; end;
FUNCTION IdHardwareNumTags(Type_ : CARDINAL; const TagList : Array Of Const) : CARDINAL; FUNCTION IdHardwareNumTags(Type_ : longword; const TagList : Array Of Const) : longword;
begin begin
IdHardwareNumTags := IdHardwareNum(Type_ , readintags(TagList)); IdHardwareNumTags := IdHardwareNum(Type_ , readintags(TagList));
end; end;
FUNCTION IdFormatStringTags(String_ : pCHAR; Buffer : pCHAR; Length : CARDINAL; const Tags : Array Of Const) : CARDINAL; FUNCTION IdFormatStringTags(String_ : pCHAR; Buffer : pCHAR; Length : longword; const Tags : Array Of Const) : longword;
begin begin
IdFormatStringTags := IdFormatString(String_ , Buffer , Length , readintags(Tags)); IdFormatStringTags := IdFormatString(String_ , Buffer , Length , readintags(Tags));
end; end;
FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : CARDINAL; FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : longword;
begin begin
IdEstimateFormatSizeTags := IdEstimateFormatSize(String_ , readintags(Tags)); IdEstimateFormatSizeTags := IdEstimateFormatSize(String_ , readintags(Tags));
end; end;
@ -610,56 +628,97 @@ begin
IdFunctionTags := IdFunction(pas2c(LibName),Offset,readintags(TagList)); IdFunctionTags := IdFunction(pas2c(LibName),Offset,readintags(TagList));
end; end;
FUNCTION IdFormatStringTags(String_ : string; Buffer : pCHAR; Length : CARDINAL; const Tags : Array Of Const) : CARDINAL; FUNCTION IdFormatStringTags(String_ : string; Buffer : pCHAR; Length : longword; const Tags : Array Of Const) : longword;
begin begin
IdFormatStringTags := IdFormatString(pas2c(String_),Buffer,Length,readintags(Tags)); IdFormatStringTags := IdFormatString(pas2c(String_),Buffer,Length,readintags(Tags));
end; end;
FUNCTION IdEstimateFormatSizeTags(String_ : string; const Tags : Array Of Const) : CARDINAL; FUNCTION IdEstimateFormatSizeTags(String_ : string; const Tags : Array Of Const) : longword;
begin begin
IdEstimateFormatSizeTags := IdEstimateFormatSize(pas2c(String_),readintags(Tags)); IdEstimateFormatSizeTags := IdEstimateFormatSize(pas2c(String_),readintags(Tags));
end; end;
{$I useautoopenlib.inc} const
{$ifdef use_auto_openlib} { Change VERSION and LIBVERSION to proper values }
{$Info Compiling autoopening of identify.library}
VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of identify.library}
{$Info don't forget to use InitIDENTIFYLibrary in the beginning of your program}
var var
identify_exit : Pointer; identify_exit : Pointer;
procedure CloseIdentifyLibrary; procedure CloseidentifyLibrary;
begin begin
ExitProc := identify_exit; ExitProc := identify_exit;
if IdentifyBase <> nil then begin if IdentifyBase <> nil then begin
CloseLibrary(IdentifyBase); CloseLibrary(IdentifyBase);
IdentifyBase := nil; IdentifyBase := nil;
end; end;
end; end;
const procedure InitIDENTIFYLibrary;
VERSION : string[2] = '12'; begin
LIBVERSION : Cardinal = 12; IdentifyBase := nil;
IdentifyBase := OpenLibrary(IDENTIFYNAME,LIBVERSION);
if IdentifyBase <> nil then begin
identify_exit := ExitProc;
ExitProc := @CloseidentifyLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open identify.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
IDENTIFYIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of identify.library}
var
identify_exit : Pointer;
procedure CloseidentifyLibrary;
begin
ExitProc := identify_exit;
if IdentifyBase <> nil then begin
CloseLibrary(IdentifyBase);
IdentifyBase := nil;
end;
end;
begin begin
IdentifyBase := nil; IdentifyBase := nil;
IdentifyBase := OpenLibrary(IDENTIFYNAME,LIBVERSION); IdentifyBase := OpenLibrary(IDENTIFYNAME,LIBVERSION);
if IdentifyBase <> nil then begin if IdentifyBase <> nil then begin
identify_exit := ExitProc; identify_exit := ExitProc;
ExitProc := @CloseIdentifyLibrary; ExitProc := @CloseidentifyLibrary;
IDENTIFYIsCompiledHow := 1;
end else begin end else begin
MessageBox('FPC Pascal Error', MessageBox('FPC Pascal Error',
'Can''t open identify.library version ' + 'Can''t open identify.library version ' + VERSION + #10 +
VERSION + 'Deallocating resources and closing down',
chr(10) + 'Oops');
'Deallocating resources and closing down', halt(20);
'Oops');
halt(20);
end; end;
{$else}
{$Warning No autoopening of identify.library compiled}
{$Info Make sure you open identify.library yourself}
{$endif use_auto_openlib} {$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
IDENTIFYIsCompiledHow := 3;
{$Warning No autoopening of identify.library compiled}
{$Warning Make sure you open identify.library yourself}
{$endif dont_use_openlib}
END. (* UNIT IDENTIFY *) END. (* UNIT IDENTIFY *)

121
packages/extra/amunits/otherlibs/picasso/units/picasso96api.pas
View File

@ -27,6 +27,10 @@
use_auto_openlib. use_auto_openlib.
12 Jan 2003. 12 Jan 2003.
Changed cardinal > longword.
Changed startcode for unit.
11 Feb 2003.
nils.sjoholm@mailbox.swipnet.se nils.sjoholm@mailbox.swipnet.se
} }
@ -47,7 +51,7 @@ USES Exec, utility, graphics, intuition;
} }
const const
P96NAME : PChar = 'Picasso96API.library'; PICASSO96APINAME : PChar = 'Picasso96API.library';
{************************************************************************} {************************************************************************}
{ Types for RGBFormat used { Types for RGBFormat used
} }
@ -433,20 +437,34 @@ FUNCTION p96EncodeColor(RGBFormat : RGBFTYPE; Color : Ulong) : Ulong;
{ {
Functions and procedures with array of const go here Functions and procedures with array of const go here
} }
FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : CARDINAL; FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : longword;
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : CARDINAL; FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : longword;
FUNCTION p96AllocModeListTags(const Tags : Array Of Const) : pList; FUNCTION p96AllocModeListTags(const Tags : Array Of Const) : pList;
FUNCTION p96OpenScreenTags(const Tags : Array Of Const) : pScreen; FUNCTION p96OpenScreenTags(const Tags : Array Of Const) : pScreen;
FUNCTION p96PIP_OpenTags(const Tags : Array Of Const) : pWindow; FUNCTION p96PIP_OpenTags(const Tags : Array Of Const) : pWindow;
FUNCTION p96PIP_SetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT; FUNCTION p96PIP_SetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT;
FUNCTION p96PIP_GetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT; FUNCTION p96PIP_GetTags(Window : pWindow; const Tags : Array Of Const) : LONGINT;
FUNCTION p96GetRTGDataTags(const Tags : Array Of Const) : LONGINT; FUNCTION p96GetRTGDataTags(const Tags : Array Of Const) : LONGINT;
FUNCTION p96GetBoardDataTags(Board : CARDINAL; const Tags : Array Of Const) : LONGINT; FUNCTION p96GetBoardDataTags(Board : longword; const Tags : Array Of Const) : LONGINT;
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitPICASSO96APILibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
PICASSO96APIIsCompiledHow : longint;
IMPLEMENTATION IMPLEMENTATION
uses msgbox,tagsarray; uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
tagsarray;
FUNCTION p96AllocBitMap(SizeX : Ulong; SizeY : Ulong; Depth : Ulong; Flags : Ulong; Friend : pBitMap; RGBFormat : RGBFTYPE) : pBitMap; FUNCTION p96AllocBitMap(SizeX : Ulong; SizeY : Ulong; Depth : Ulong; Flags : Ulong; Friend : pBitMap; RGBFormat : RGBFTYPE) : pBitMap;
BEGIN BEGIN
@ -814,12 +832,12 @@ END;
{ {
Functions and procedures with array of const go here Functions and procedures with array of const go here
} }
FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : CARDINAL; FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : longword;
begin begin
p96BestModeIDTags := p96BestModeIDTagList(readintags(Tags)); p96BestModeIDTags := p96BestModeIDTagList(readintags(Tags));
end; end;
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : CARDINAL; FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : longword;
begin begin
p96RequestModeIDTags := p96RequestModeIDTagList(readintags(Tags)); p96RequestModeIDTags := p96RequestModeIDTagList(readintags(Tags));
end; end;
@ -854,52 +872,93 @@ begin
p96GetRTGDataTags := p96GetRTGDataTagList(readintags(Tags)); p96GetRTGDataTags := p96GetRTGDataTagList(readintags(Tags));
end; end;
FUNCTION p96GetBoardDataTags(Board : CARDINAL; const Tags : Array Of Const) : LONGINT; FUNCTION p96GetBoardDataTags(Board : longword; const Tags : Array Of Const) : LONGINT;
begin begin
p96GetBoardDataTags := p96GetBoardDataTagList(Board , readintags(Tags)); p96GetBoardDataTags := p96GetBoardDataTagList(Board , readintags(Tags));
end; end;
const
{ Change VERSION and LIBVERSION to proper values }
{$I useautoopenlib.inc} VERSION : string[2] = '0';
{$ifdef use_auto_openlib} LIBVERSION : longword = 0;
{$Info Compiling autoopening of picasso96api.library}
{$ifdef use_init_openlib}
{$Info Compiling initopening of picasso96api.library}
{$Info don't forget to use InitPICASSO96APILibrary in the beginning of your program}
var var
picasso96_exit : pointer; picasso96api_exit : Pointer;
procedure ClosePicasso96Library; procedure Closepicasso96apiLibrary;
begin begin
ExitProc := picasso96_exit; ExitProc := picasso96api_exit;
if P96Base <> nil then begin if P96Base <> nil then begin
CloseLibrary(P96Base); CloseLibrary(P96Base);
P96Base := nil; P96Base := nil;
end; end;
end; end;
const procedure InitPICASSO96APILibrary;
VERSION : string[2] = '2'; begin
LIBVERSION = 2; P96Base := nil;
P96Base := OpenLibrary(PICASSO96APINAME,LIBVERSION);
if P96Base <> nil then begin
picasso96api_exit := ExitProc;
ExitProc := @Closepicasso96apiLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open picasso96api.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
PICASSO96APIIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of picasso96api.library}
var
picasso96api_exit : Pointer;
procedure Closepicasso96apiLibrary;
begin
ExitProc := picasso96api_exit;
if P96Base <> nil then begin
CloseLibrary(P96Base);
P96Base := nil;
end;
end;
begin begin
P96Base := nil; P96Base := nil;
P96Base := OpenLibrary(P96NAME,LIBVERSION); P96Base := OpenLibrary(PICASSO96APINAME,LIBVERSION);
if P96Base <> nil then begin if P96Base <> nil then begin
picasso96_exit := ExitProc; picasso96api_exit := ExitProc;
ExitProc := @ClosePicasso96Library; ExitProc := @Closepicasso96apiLibrary;
PICASSO96APIIsCompiledHow := 1;
end else begin end else begin
MessageBox('FPC Pascal Error', MessageBox('FPC Pascal Error',
'Can''t open Piccaso96Api.library version ' + 'Can''t open picasso96api.library version ' + VERSION + #10 +
VERSION + 'Deallocating resources and closing down',
chr(10) + 'Oops');
'Deallocating resources and closing down', halt(20);
'Oops');
halt(20);
end; end;
{$else}
{$Warning No autoopening of picasso96api.library compiled}
{$Info Make sure you open picasso96api.library yourself}
{$endif use_auto_openlib} {$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
PICASSO96APIIsCompiledHow := 3;
{$Warning No autoopening of picasso96api.library compiled}
{$Warning Make sure you open picasso96api.library yourself}
{$endif dont_use_openlib}
END. (* UNIT PICASSO96API *) END. (* UNIT PICASSO96API *)
{ {

118
packages/extra/amunits/otherlibs/reqtools/units/reqtools.pas
View File

@ -30,6 +30,9 @@
use_auto_openlib. use_auto_openlib.
12 Jan 2003. 12 Jan 2003.
Changed startcode for unit.
11 Feb 2003.
nils.sjoholm@mailbox.swipnet.se nils.sjoholm@mailbox.swipnet.se
} }
@ -671,11 +674,24 @@ FUNCTION rtPaletteRequest(title : String; reqinfo : prtReqInfo; const argv : Arr
FUNCTION rtScreenModeRequest(screenmodereq : prtScreenModeRequester; title : String; const argv : Array Of Const) : ULONG; FUNCTION rtScreenModeRequest(screenmodereq : prtScreenModeRequester; title : String; const argv : Array Of Const) : ULONG;
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitREQTOOLSLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
REQTOOLSIsCompiledHow : longint;
IMPLEMENTATION IMPLEMENTATION
uses msgbox,pastoc,tagsarray; uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
tagsarray,pastoc;
FUNCTION rtAllocRequestA(typ : ULONG; taglist : pTagItem) : POINTER; FUNCTION rtAllocRequestA(typ : ULONG; taglist : pTagItem) : POINTER;
BEGIN BEGIN
@ -1117,45 +1133,87 @@ FUNCTION rtScreenModeRequest(screenmodereq : prtScreenModeRequester; title : Str
begin begin
rtScreenModeRequest := rtScreenModeRequestA(screenmodereq,title,readintags(argv)); rtScreenModeRequest := rtScreenModeRequestA(screenmodereq,title,readintags(argv));
end; end;
{$I useautoopenlib.inc}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of reqtools.library}
var
reqtools_exit : Pointer;
PROCEDURE CloseReqToolsLibrary;
BEGIN
ExitProc := reqtools_exit;
if ReqToolsBase <> nil then begin
CloseLibrary(ReqToolsBase);
ReqToolsBase := nil;
end;
END;
const const
VERSION : string[2] = '38'; { Change VERSION and LIBVERSION to proper values }
BEGIN VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of reqtools.library}
{$Info don't forget to use InitREQTOOLSLibrary in the beginning of your program}
var
reqtools_exit : Pointer;
procedure ClosereqtoolsLibrary;
begin
ExitProc := reqtools_exit;
if ReqToolsBase <> nil then begin
CloseLibrary(ReqToolsBase);
ReqToolsBase := nil;
end;
end;
procedure InitREQTOOLSLibrary;
begin
ReqToolsBase := nil; ReqToolsBase := nil;
ReqToolsBase := OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION); ReqToolsBase := OpenLibrary(REQTOOLSNAME,LIBVERSION);
IF ReqToolsBase <> NIL THEN begin if ReqToolsBase <> nil then begin
reqtools_exit := ExitProc; reqtools_exit := ExitProc;
ExitProc := @CloseReqToolsLibrary; ExitProc := @ClosereqtoolsLibrary;
end else begin end else begin
MessageBox('FPC Pascal Error', MessageBox('FPC Pascal Error',
'Can''t open reqtools.library version ' + 'Can''t open reqtools.library version ' + VERSION + #10 +
VERSION + 'Deallocating resources and closing down',
chr(10) + 'Oops');
'Deallocating resources and closing down',
'Oops');
halt(20); halt(20);
end; end;
{$else} end;
{$Warning No autoopening of reqtools.library compiled}
{$Info Make sure you open reqtools.library yourself} begin
REQTOOLSIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of reqtools.library}
var
reqtools_exit : Pointer;
procedure ClosereqtoolsLibrary;
begin
ExitProc := reqtools_exit;
if ReqToolsBase <> nil then begin
CloseLibrary(ReqToolsBase);
ReqToolsBase := nil;
end;
end;
begin
ReqToolsBase := nil;
ReqToolsBase := OpenLibrary(REQTOOLSNAME,LIBVERSION);
if ReqToolsBase <> nil then begin
reqtools_exit := ExitProc;
ExitProc := @ClosereqtoolsLibrary;
REQTOOLSIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open reqtools.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib} {$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
REQTOOLSIsCompiledHow := 3;
{$Warning No autoopening of reqtools.library compiled}
{$Warning Make sure you open reqtools.library yourself}
{$endif dont_use_openlib}
END. (* UNIT REQTOOLS *) END. (* UNIT REQTOOLS *)

124
packages/extra/amunits/otherlibs/triton/units/triton.pas
View File

@ -24,6 +24,11 @@
use_auto_openlib. use_auto_openlib.
12 Jan 2003. 12 Jan 2003.
Changed integer > smallint.
Changed cardinal > longword.
Changed startcode for unit.
11 Feb 2003.
nils.sjoholm@mailbox.swipnet.se Nils Sjoholm nils.sjoholm@mailbox.swipnet.se Nils Sjoholm
} }
@ -185,7 +190,7 @@ class_DisplayObject *}
XResize : BOOL; {* Horizontally resizable? *} XResize : BOOL; {* Horizontally resizable? *}
YResize : BOOL; {* Vertically resizable? *} YResize : BOOL; {* Vertically resizable? *}
QuickHelpString : STRPTR; {* QuickHelp string *} QuickHelpString : STRPTR; {* QuickHelp string *}
Shortcut : Integer; {* The object's shortcut *} Shortcut : smallint; {* The object's shortcut *}
Backfilltype : ULONG; {* The object's backfill type *} Backfilltype : ULONG; {* The object's backfill type *}
Installed : BOOL; {* Does the object have an on-screen Installed : BOOL; {* Does the object have an on-screen
representation? *} representation? *}
@ -682,8 +687,8 @@ surrounding array *}
VAR TritonBase : pLibrary; VAR TritonBase : pLibrary;
FUNCTION TR_AddClass(app : pTR_App; d0arg : CARDINAL; supertag : CARDINAL; defaultmethod : LONGINT; FUNCTION TR_AddClass(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT;
datasize : CARDINAL; tags : pTagItem) : BOOLEAN; datasize : longword; tags : pTagItem) : BOOLEAN;
PROCEDURE TR_AreaFill(project : pTR_Project; rp : pRastPort; left : ULONG; top : PROCEDURE TR_AreaFill(project : pTR_Project; rp : pRastPort; left : ULONG; top :
ULONG; right : ULONG; bottom : ULONG; typ : ULONG; dummy : POINTER); ULONG; right : ULONG; bottom : ULONG; typ : ULONG; dummy : POINTER);
FUNCTION TR_AutoRequest(app : pTR_App; lockproject : pTR_Project; wintags : pTagItem) FUNCTION TR_AutoRequest(app : pTR_App; lockproject : pTR_Project; wintags : pTagItem)
@ -743,8 +748,8 @@ FUNCTION TR_Wait(app : pTR_App; otherbits : ULONG) : ULONG;
{ {
Functions with array of const Functions with array of const
} }
FUNCTION TR_AddClassTags(app : pTR_App; d0arg : CARDINAL; supertag : CARDINAL; FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword;
defaultmethod : LONGINT; datasize : CARDINAL; const tags : Array Of Const) : BOOLEAN; defaultmethod : LONGINT; datasize : longword; const tags : Array Of Const) : BOOLEAN;
FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : Array Of Const) : pTR_Project; FUNCTION TR_OpenProjectTags(app : pTR_App; const taglist : Array Of Const) : pTR_Project;
FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : Array Of Const): ULONG; FUNCTION TR_AutoRequestTags(app : pTR_App; lockproject : pTR_Project; const wintags : Array Of Const): ULONG;
FUNCTION TR_CreateAppTags(const apptags : Array of Const) : pTR_App; FUNCTION TR_CreateAppTags(const apptags : Array of Const) : pTR_App;
@ -773,11 +778,23 @@ procedure TR_SetWindowTitle(p : pTR_Project; thetitle : string);
procedure TR_SetWindowTitle(p : pTR_Project; thetitle : PChar); procedure TR_SetWindowTitle(p : pTR_Project; thetitle : PChar);
procedure TR_UpdateListView(p : pTR_Project; gadid : Longint; thelist: pList); procedure TR_UpdateListView(p : pTR_Project; gadid : Longint; thelist: pList);
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitTRITONLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
TRITONIsCompiledHow : longint;
IMPLEMENTATION IMPLEMENTATION
uses msgbox, tagsarray,pastoc; uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
tagsarray,pastoc;
procedure TR_Disable(p : pTR_Project; id : Longint); procedure TR_Disable(p : pTR_Project; id : Longint);
begin begin
@ -864,7 +881,7 @@ begin
TR_SetAttribute(p,gadid,0,Longint(thelist)); TR_SetAttribute(p,gadid,0,Longint(thelist));
end; end;
FUNCTION TR_AddClass(app : pTR_App; d0arg : CARDINAL; supertag : CARDINAL; defaultmethod : LONGINT; datasize : CARDINAL; tags : pTagItem) : BOOLEAN; FUNCTION TR_AddClass(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; tags : pTagItem) : BOOLEAN;
BEGIN BEGIN
ASM ASM
MOVE.L A6,-(A7) MOVE.L A6,-(A7)
@ -1390,7 +1407,7 @@ END;
{ {
Functions and procedures with array of const go here Functions and procedures with array of const go here
} }
FUNCTION TR_AddClassTags(app : pTR_App; d0arg : CARDINAL; supertag : CARDINAL; defaultmethod : LONGINT; datasize : CARDINAL; const tags : Array Of Const) : BOOLEAN; FUNCTION TR_AddClassTags(app : pTR_App; d0arg : longword; supertag : longword; defaultmethod : LONGINT; datasize : longword; const tags : Array Of Const) : BOOLEAN;
begin begin
TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , readintags(tags)); TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , readintags(tags));
end; end;
@ -1430,31 +1447,35 @@ begin
TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt),readintags(taglist)); TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt),readintags(taglist));
end; end;
{$I useautoopenlib.inc} const
{$ifdef use_auto_openlib} { Change VERSION and LIBVERSION to proper values }
{$Info Compiling autoopening of triton.library}
var
triton_exit : Pointer;
PROCEDURE CloseTritonLibrary; VERSION : string[2] = '0';
BEGIN LIBVERSION : longword = 0;
ExitProc := triton_exit;
if TritonBase <> nil then begin {$ifdef use_init_openlib}
{$Info Compiling initopening of triton.library}
{$Info don't forget to use InitTRITONLibrary in the beginning of your program}
var
triton_exit : Pointer;
procedure ClosetritonLibrary;
begin
ExitProc := triton_exit;
if TritonBase <> nil then begin
CloseLibrary(TritonBase); CloseLibrary(TritonBase);
TritonBase := nil; TritonBase := nil;
end; end;
END; end;
const procedure InitTRITONLibrary;
VERSION : string[2] = '6'; begin
BEGIN
TritonBase := nil; TritonBase := nil;
TritonBase := OpenLibrary(TRITONNAME,TRITONVERSION); TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
IF TritonBase <> NIL THEN begin if TritonBase <> nil then begin
triton_exit := ExitProc; triton_exit := ExitProc;
ExitProc := @CloseTritonLibrary; ExitProc := @ClosetritonLibrary;
end else begin end else begin
MessageBox('FPC Pascal Error', MessageBox('FPC Pascal Error',
'Can''t open triton.library version ' + VERSION + #10 + 'Can''t open triton.library version ' + VERSION + #10 +
@ -1462,11 +1483,52 @@ BEGIN
'Oops'); 'Oops');
halt(20); halt(20);
end; end;
{$else} end;
{$Warning No autoopening of triton.library compiled}
{$Info Make sure you open triton.library yourself} begin
TRITONIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of triton.library}
var
triton_exit : Pointer;
procedure ClosetritonLibrary;
begin
ExitProc := triton_exit;
if TritonBase <> nil then begin
CloseLibrary(TritonBase);
TritonBase := nil;
end;
end;
begin
TritonBase := nil;
TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
if TritonBase <> nil then begin
triton_exit := ExitProc;
ExitProc := @ClosetritonLibrary;
TRITONIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open triton.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib} {$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
TRITONIsCompiledHow := 3;
{$Warning No autoopening of triton.library compiled}
{$Warning Make sure you open triton.library yourself}
{$endif dont_use_openlib}
END. (* UNIT TRITON *) END. (* UNIT TRITON *)
{ {