mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-01 10:02:33 +02:00
* changed startcode for library
This commit is contained in:
nils
parent
ff2d3b7d06
commit
376c1348d0
@ -30,6 +30,9 @@
|
||||
use_auto_openlib.
|
||||
12 Jan 2003.
|
||||
|
||||
Changed startcode for unit.
|
||||
10 Feb 2003.
|
||||
|
||||
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 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
|
||||
|
||||
uses msgbox ,pastoc, tagsarray;
|
||||
uses
|
||||
{$ifndef dont_use_openlib}
|
||||
msgbox,
|
||||
{$endif dont_use_openlib}
|
||||
pastoc,tagsarray;
|
||||
|
||||
|
||||
FUNCTION QFreeSession(session : pQSession) : LONGINT;
|
||||
BEGIN
|
||||
@ -1051,50 +1068,95 @@ begin
|
||||
QNewServerSessionTags := QNewServerSession(hostnames,prognames,readintags(argv));
|
||||
end;
|
||||
|
||||
|
||||
{$I useautoopenlib.inc}
|
||||
{$ifdef use_auto_openlib}
|
||||
{$Info Compiling autoopening of amarquee.library}
|
||||
var
|
||||
amarquee_exit : pointer;
|
||||
|
||||
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
|
||||
ExitProc := amarquee_exit;
|
||||
if AmarqueeBase <> nil then begin
|
||||
CloseLibrary(AmarqueeBase);
|
||||
AmarqueeBase := nil;
|
||||
if AMarqueeBase <> nil then begin
|
||||
CloseLibrary(AMarqueeBase);
|
||||
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;
|
||||
|
||||
begin
|
||||
AmarqueeBase := nil;
|
||||
AmarqueeBase := OpenLibrary(AmarqueeNAME,50);
|
||||
if AmarqueeBase <> nil then begin
|
||||
Amarquee_exit := ExitProc;
|
||||
ExitProc := @CloseAmarqueeLibrary;
|
||||
AMARQUEEIsCompiledHow := 2;
|
||||
{$endif use_init_openlib}
|
||||
|
||||
{$ifdef use_auto_openlib}
|
||||
{$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
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open Amarquee.library version ' +
|
||||
VERSION +
|
||||
chr(10) +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
'Can''t open amarquee.library version ' + VERSION + #10 +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
end;
|
||||
{$else}
|
||||
{$Warning No autoopening of amarquee.library compiled}
|
||||
{$Info Make sure you open amarquee.library yourself}
|
||||
|
||||
{$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 *)
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
}
|
||||
|
||||
@ -32,6 +32,9 @@
|
||||
use_auto_openlib.
|
||||
12 Jan 2003.
|
||||
|
||||
Changed startcode for unit.
|
||||
10 Feb 2003.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
|
||||
}
|
||||
@ -556,13 +559,14 @@ const
|
||||
pHelpMsg = ^tHelpMsg;
|
||||
{ pUWord = ^UWord; }
|
||||
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);
|
||||
FUNCTION LT_CreateHandle(par1 : pScreen; last : pTextAttr) : pLayoutHandle;
|
||||
FUNCTION LT_CreateHandleTagList(par1 : pScreen; tags : pTagItem) : pLayoutHandle;
|
||||
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_EndRefresh(par1 : pLayoutHandle; last : 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;
|
||||
PROCEDURE LT_UpdateStrings(last : pLayoutHandle);
|
||||
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;
|
||||
PROCEDURE LT_MenuControlTagList(par1 : pWindow; par2 : pMenu; tags : pTagItem);
|
||||
FUNCTION LT_GetMenuItem(par1 : pMenu; last : ulong) : 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_CatchUpRefresh(last : pLayoutHandle);
|
||||
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_Add(handle : pLayoutHandle; _type : LONGINT; _label : pCHAR; id : LONGINT; 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_Build(handle : pLayoutHandle; const tagParams : Array Of Const) : pWindow;
|
||||
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;
|
||||
|
||||
{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
|
||||
|
||||
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
|
||||
ASM
|
||||
MOVE.L A6,-(A7)
|
||||
@ -696,7 +713,7 @@ BEGIN
|
||||
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
|
||||
ASM
|
||||
MOVE.L A6,-(A7)
|
||||
@ -1021,7 +1038,7 @@ BEGIN
|
||||
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
|
||||
ASM
|
||||
MOVE.L A6,-(A7)
|
||||
@ -1091,7 +1108,7 @@ BEGIN
|
||||
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
|
||||
ASM
|
||||
MOVE.L A6,-(A7)
|
||||
@ -1173,7 +1190,7 @@ begin
|
||||
LT_NewA(handle , readintags(tagList));
|
||||
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
|
||||
LT_Layout := LT_LayoutA(handle , title , bounds , extraWidth , extraHeight , idcmp , align , readintags(tagParams));
|
||||
end;
|
||||
@ -1203,15 +1220,20 @@ begin
|
||||
LT_MenuControlTagList(window , intuitionMenu , readintags(tags));
|
||||
end;
|
||||
|
||||
const
|
||||
{ Change VERSION and LIBVERSION to proper values }
|
||||
|
||||
{$I useautoopenlib.inc}
|
||||
{$ifdef use_auto_openlib}
|
||||
{$Info Compiling autoopening of gtlayout.library}
|
||||
VERSION : string[2] = '0';
|
||||
LIBVERSION : Cardinal = 0;
|
||||
|
||||
{$ifdef use_init_openlib}
|
||||
{$Info Compiling initopening of gtlayout.library}
|
||||
{$Info don't forget to use InitGTLAYOUTLibrary in the beginning of your program}
|
||||
|
||||
var
|
||||
gtlayout_exit : pointer;
|
||||
gtlayout_exit : Pointer;
|
||||
|
||||
procedure CloseGTLayoutLibrary;
|
||||
procedure ClosegtlayoutLibrary;
|
||||
begin
|
||||
ExitProc := gtlayout_exit;
|
||||
if GTLayoutBase <> nil then begin
|
||||
@ -1220,33 +1242,70 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
VERSION : string[1] = '0';
|
||||
procedure InitGTLAYOUTLibrary;
|
||||
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
|
||||
GTLayoutBase := nil;
|
||||
GTLayOutBase := OpenLibrary(GTLAYOUTNAME,0);
|
||||
GTLayoutBase := OpenLibrary(GTLAYOUTNAME,LIBVERSION);
|
||||
if GTLayoutBase <> nil then begin
|
||||
gtlayout_exit := ExitProc;
|
||||
ExitProc := @CloseGTLayoutLibrary;
|
||||
ExitProc := @ClosegtlayoutLibrary;
|
||||
GTLAYOUTIsCompiledHow := 1;
|
||||
end else begin
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open gtlayout.library version ' +
|
||||
VERSION +
|
||||
chr(10) +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
'Can''t open gtlayout.library version ' + VERSION + #10 +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
end;
|
||||
{$else}
|
||||
{$Warning No autoopening of gtlayout.library compiled}
|
||||
{$Info Make sure you open gtlayout.library yourself}
|
||||
|
||||
{$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 *)
|
||||
|
||||
{
|
||||
$Log
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
This file is part of the Free Pascal 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.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
@ -29,6 +29,10 @@
|
||||
use_auto_openlib.
|
||||
12 Jan 2003.
|
||||
|
||||
Changed cardinal > longword.
|
||||
Changed startcode for unit.
|
||||
11 Feb 2003.
|
||||
|
||||
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 IdHardwareTags(Type_ : CARDINAL; const TagList : Array Of Const) : pCHAR;
|
||||
FUNCTION IdAlertTags(ID : CARDINAL; const TagList : Array Of Const) : LONGINT;
|
||||
FUNCTION IdHardwareTags(Type_ : longword; const TagList : Array Of Const) : pCHAR;
|
||||
FUNCTION IdAlertTags(ID : longword; 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 IdFormatStringTags(String_ : pCHAR; Buffer : pCHAR; Length : CARDINAL; const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION IdHardwareNumTags(Type_ : longword; const TagList : Array Of Const) : longword;
|
||||
FUNCTION IdFormatStringTags(String_ : pCHAR; Buffer : pCHAR; Length : longword; const Tags : Array Of Const) : longword;
|
||||
FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : longword;
|
||||
|
||||
{
|
||||
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 IdEstimateFormatSize(String_ : string; Tags : pTagItem) : Ulong;
|
||||
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 IdEstimateFormatSizeTags(String_ : string; 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) : 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
|
||||
|
||||
uses msgbox,tagsarray,pastoc;
|
||||
uses
|
||||
{$ifndef dont_use_openlib}
|
||||
msgbox,
|
||||
{$endif dont_use_openlib}
|
||||
tagsarray,pastoc;
|
||||
|
||||
FUNCTION IdExpansion(TagList : pTagItem) : LONGINT;
|
||||
BEGIN
|
||||
@ -556,12 +574,12 @@ begin
|
||||
IdExpansionTags := IdExpansion(readintags(TagList));
|
||||
end;
|
||||
|
||||
FUNCTION IdHardwareTags(Type_ : CARDINAL; const TagList : Array Of Const) : pCHAR;
|
||||
FUNCTION IdHardwareTags(Type_ : longword; const TagList : Array Of Const) : pCHAR;
|
||||
begin
|
||||
IdHardwareTags := IdHardware(Type_ , readintags(TagList));
|
||||
end;
|
||||
|
||||
FUNCTION IdAlertTags(ID : CARDINAL; const TagList : Array Of Const) : LONGINT;
|
||||
FUNCTION IdAlertTags(ID : longword; const TagList : Array Of Const) : LONGINT;
|
||||
begin
|
||||
IdAlertTags := IdAlert(ID , readintags(TagList));
|
||||
end;
|
||||
@ -571,17 +589,17 @@ begin
|
||||
IdFunctionTags := IdFunction(LibName , Offset , readintags(TagList));
|
||||
end;
|
||||
|
||||
FUNCTION IdHardwareNumTags(Type_ : CARDINAL; const TagList : Array Of Const) : CARDINAL;
|
||||
FUNCTION IdHardwareNumTags(Type_ : longword; const TagList : Array Of Const) : longword;
|
||||
begin
|
||||
IdHardwareNumTags := IdHardwareNum(Type_ , readintags(TagList));
|
||||
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
|
||||
IdFormatStringTags := IdFormatString(String_ , Buffer , Length , readintags(Tags));
|
||||
end;
|
||||
|
||||
FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION IdEstimateFormatSizeTags(String_ : pCHAR; const Tags : Array Of Const) : longword;
|
||||
begin
|
||||
IdEstimateFormatSizeTags := IdEstimateFormatSize(String_ , readintags(Tags));
|
||||
end;
|
||||
@ -610,56 +628,97 @@ begin
|
||||
IdFunctionTags := IdFunction(pas2c(LibName),Offset,readintags(TagList));
|
||||
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
|
||||
IdFormatStringTags := IdFormatString(pas2c(String_),Buffer,Length,readintags(Tags));
|
||||
end;
|
||||
|
||||
FUNCTION IdEstimateFormatSizeTags(String_ : string; const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION IdEstimateFormatSizeTags(String_ : string; const Tags : Array Of Const) : longword;
|
||||
begin
|
||||
IdEstimateFormatSizeTags := IdEstimateFormatSize(pas2c(String_),readintags(Tags));
|
||||
end;
|
||||
|
||||
{$I useautoopenlib.inc}
|
||||
{$ifdef use_auto_openlib}
|
||||
{$Info Compiling autoopening of identify.library}
|
||||
const
|
||||
{ Change VERSION and LIBVERSION to proper values }
|
||||
|
||||
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
|
||||
identify_exit : Pointer;
|
||||
|
||||
procedure CloseIdentifyLibrary;
|
||||
procedure CloseidentifyLibrary;
|
||||
begin
|
||||
ExitProc := identify_exit;
|
||||
if IdentifyBase <> nil then begin
|
||||
CloseLibrary(IdentifyBase);
|
||||
IdentifyBase := nil;
|
||||
CloseLibrary(IdentifyBase);
|
||||
IdentifyBase := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
VERSION : string[2] = '12';
|
||||
LIBVERSION : Cardinal = 12;
|
||||
procedure InitIDENTIFYLibrary;
|
||||
begin
|
||||
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
|
||||
IdentifyBase := nil;
|
||||
IdentifyBase := OpenLibrary(IDENTIFYNAME,LIBVERSION);
|
||||
if IdentifyBase <> nil then begin
|
||||
identify_exit := ExitProc;
|
||||
ExitProc := @CloseIdentifyLibrary;
|
||||
identify_exit := ExitProc;
|
||||
ExitProc := @CloseidentifyLibrary;
|
||||
IDENTIFYIsCompiledHow := 1;
|
||||
end else begin
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open identify.library version ' +
|
||||
VERSION +
|
||||
chr(10) +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
'Can''t open identify.library version ' + VERSION + #10 +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
end;
|
||||
{$else}
|
||||
{$Warning No autoopening of identify.library compiled}
|
||||
{$Info Make sure you open identify.library yourself}
|
||||
|
||||
{$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 *)
|
||||
|
||||
@ -667,4 +726,4 @@ END. (* UNIT IDENTIFY *)
|
||||
$Log
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
@ -22,11 +22,15 @@
|
||||
|
||||
Updated to fpc 1.0.7
|
||||
08 Jan 2003
|
||||
|
||||
|
||||
Added the defines use_amiga_smartlink and
|
||||
use_auto_openlib.
|
||||
12 Jan 2003.
|
||||
|
||||
Changed cardinal > longword.
|
||||
Changed startcode for unit.
|
||||
11 Feb 2003.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se
|
||||
|
||||
}
|
||||
@ -47,7 +51,7 @@ USES Exec, utility, graphics, intuition;
|
||||
}
|
||||
|
||||
const
|
||||
P96NAME : PChar = 'Picasso96API.library';
|
||||
PICASSO96APINAME : PChar = 'Picasso96API.library';
|
||||
{************************************************************************}
|
||||
{ Types for RGBFormat used
|
||||
}
|
||||
@ -433,20 +437,34 @@ FUNCTION p96EncodeColor(RGBFormat : RGBFTYPE; Color : Ulong) : Ulong;
|
||||
{
|
||||
Functions and procedures with array of const go here
|
||||
}
|
||||
FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION p96BestModeIDTags(const Tags : Array Of Const) : longword;
|
||||
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : longword;
|
||||
FUNCTION p96AllocModeListTags(const Tags : Array Of Const) : pList;
|
||||
FUNCTION p96OpenScreenTags(const Tags : Array Of Const) : pScreen;
|
||||
FUNCTION p96PIP_OpenTags(const Tags : Array Of Const) : pWindow;
|
||||
FUNCTION p96PIP_SetTags(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 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
|
||||
|
||||
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;
|
||||
BEGIN
|
||||
@ -814,12 +832,12 @@ END;
|
||||
{
|
||||
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
|
||||
p96BestModeIDTags := p96BestModeIDTagList(readintags(Tags));
|
||||
end;
|
||||
|
||||
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : CARDINAL;
|
||||
FUNCTION p96RequestModeIDTags(const Tags : Array Of Const) : longword;
|
||||
begin
|
||||
p96RequestModeIDTags := p96RequestModeIDTagList(readintags(Tags));
|
||||
end;
|
||||
@ -854,52 +872,93 @@ begin
|
||||
p96GetRTGDataTags := p96GetRTGDataTagList(readintags(Tags));
|
||||
end;
|
||||
|
||||
FUNCTION p96GetBoardDataTags(Board : CARDINAL; const Tags : Array Of Const) : LONGINT;
|
||||
FUNCTION p96GetBoardDataTags(Board : longword; const Tags : Array Of Const) : LONGINT;
|
||||
begin
|
||||
p96GetBoardDataTags := p96GetBoardDataTagList(Board , readintags(Tags));
|
||||
end;
|
||||
|
||||
const
|
||||
{ Change VERSION and LIBVERSION to proper values }
|
||||
|
||||
{$I useautoopenlib.inc}
|
||||
{$ifdef use_auto_openlib}
|
||||
{$Info Compiling autoopening of picasso96api.library}
|
||||
VERSION : string[2] = '0';
|
||||
LIBVERSION : longword = 0;
|
||||
|
||||
{$ifdef use_init_openlib}
|
||||
{$Info Compiling initopening of picasso96api.library}
|
||||
{$Info don't forget to use InitPICASSO96APILibrary in the beginning of your program}
|
||||
|
||||
var
|
||||
picasso96_exit : pointer;
|
||||
picasso96api_exit : Pointer;
|
||||
|
||||
procedure ClosePicasso96Library;
|
||||
procedure Closepicasso96apiLibrary;
|
||||
begin
|
||||
ExitProc := picasso96_exit;
|
||||
ExitProc := picasso96api_exit;
|
||||
if P96Base <> nil then begin
|
||||
CloseLibrary(P96Base);
|
||||
P96Base := nil;
|
||||
CloseLibrary(P96Base);
|
||||
P96Base := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
VERSION : string[2] = '2';
|
||||
LIBVERSION = 2;
|
||||
procedure InitPICASSO96APILibrary;
|
||||
begin
|
||||
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
|
||||
P96Base := nil;
|
||||
P96Base := OpenLibrary(P96NAME,LIBVERSION);
|
||||
P96Base := OpenLibrary(PICASSO96APINAME,LIBVERSION);
|
||||
if P96Base <> nil then begin
|
||||
picasso96_exit := ExitProc;
|
||||
ExitProc := @ClosePicasso96Library;
|
||||
picasso96api_exit := ExitProc;
|
||||
ExitProc := @Closepicasso96apiLibrary;
|
||||
PICASSO96APIIsCompiledHow := 1;
|
||||
end else begin
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open Piccaso96Api.library version ' +
|
||||
VERSION +
|
||||
chr(10) +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
'Can''t open picasso96api.library version ' + VERSION + #10 +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
end;
|
||||
{$else}
|
||||
{$Warning No autoopening of picasso96api.library compiled}
|
||||
{$Info Make sure you open picasso96api.library yourself}
|
||||
|
||||
{$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 *)
|
||||
|
||||
{
|
||||
|
||||
@ -29,6 +29,9 @@
|
||||
Added the defines use_amiga_smartlink and
|
||||
use_auto_openlib.
|
||||
12 Jan 2003.
|
||||
|
||||
Changed startcode for unit.
|
||||
11 Feb 2003.
|
||||
|
||||
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;
|
||||
|
||||
|
||||
{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
|
||||
|
||||
uses msgbox,pastoc,tagsarray;
|
||||
uses
|
||||
{$ifndef dont_use_openlib}
|
||||
msgbox,
|
||||
{$endif dont_use_openlib}
|
||||
tagsarray,pastoc;
|
||||
|
||||
FUNCTION rtAllocRequestA(typ : ULONG; taglist : pTagItem) : POINTER;
|
||||
BEGIN
|
||||
@ -1117,45 +1133,87 @@ FUNCTION rtScreenModeRequest(screenmodereq : prtScreenModeRequester; title : Str
|
||||
begin
|
||||
rtScreenModeRequest := rtScreenModeRequestA(screenmodereq,title,readintags(argv));
|
||||
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
|
||||
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 := OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION);
|
||||
IF ReqToolsBase <> NIL THEN begin
|
||||
ReqToolsBase := OpenLibrary(REQTOOLSNAME,LIBVERSION);
|
||||
if ReqToolsBase <> nil then begin
|
||||
reqtools_exit := ExitProc;
|
||||
ExitProc := @CloseReqToolsLibrary;
|
||||
ExitProc := @ClosereqtoolsLibrary;
|
||||
end else begin
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open reqtools.library version ' +
|
||||
VERSION +
|
||||
chr(10) +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open reqtools.library version ' + VERSION + #10 +
|
||||
'Deallocating resources and closing down',
|
||||
'Oops');
|
||||
halt(20);
|
||||
end;
|
||||
{$else}
|
||||
{$Warning No autoopening of reqtools.library compiled}
|
||||
{$Info Make sure you open reqtools.library yourself}
|
||||
end;
|
||||
|
||||
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}
|
||||
|
||||
{$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 *)
|
||||
|
||||
@ -24,6 +24,11 @@
|
||||
use_auto_openlib.
|
||||
12 Jan 2003.
|
||||
|
||||
Changed integer > smallint.
|
||||
Changed cardinal > longword.
|
||||
Changed startcode for unit.
|
||||
11 Feb 2003.
|
||||
|
||||
nils.sjoholm@mailbox.swipnet.se Nils Sjoholm
|
||||
|
||||
}
|
||||
@ -185,7 +190,7 @@ class_DisplayObject *}
|
||||
XResize : BOOL; {* Horizontally resizable? *}
|
||||
YResize : BOOL; {* Vertically resizable? *}
|
||||
QuickHelpString : STRPTR; {* QuickHelp string *}
|
||||
Shortcut : Integer; {* The object's shortcut *}
|
||||
Shortcut : smallint; {* The object's shortcut *}
|
||||
Backfilltype : ULONG; {* The object's backfill type *}
|
||||
Installed : BOOL; {* Does the object have an on-screen
|
||||
representation? *}
|
||||
@ -682,8 +687,8 @@ surrounding array *}
|
||||
|
||||
VAR TritonBase : pLibrary;
|
||||
|
||||
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;
|
||||
PROCEDURE TR_AreaFill(project : pTR_Project; rp : pRastPort; left : ULONG; top :
|
||||
ULONG; right : ULONG; bottom : ULONG; typ : ULONG; dummy : POINTER);
|
||||
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
|
||||
}
|
||||
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;
|
||||
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_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_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
|
||||
|
||||
uses msgbox, tagsarray,pastoc;
|
||||
|
||||
uses
|
||||
{$ifndef dont_use_openlib}
|
||||
msgbox,
|
||||
{$endif dont_use_openlib}
|
||||
tagsarray,pastoc;
|
||||
|
||||
procedure TR_Disable(p : pTR_Project; id : Longint);
|
||||
begin
|
||||
@ -864,7 +881,7 @@ begin
|
||||
TR_SetAttribute(p,gadid,0,Longint(thelist));
|
||||
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
|
||||
ASM
|
||||
MOVE.L A6,-(A7)
|
||||
@ -1390,7 +1407,7 @@ END;
|
||||
{
|
||||
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
|
||||
TR_AddClassTags := TR_AddClass(app , d0arg , supertag , defaultmethod , datasize , readintags(tags));
|
||||
end;
|
||||
@ -1430,31 +1447,35 @@ begin
|
||||
TR_EasyRequestTags := TR_EasyRequest(app,pas2c(bodyfmt),pas2c(gadfmt),readintags(taglist));
|
||||
end;
|
||||
|
||||
{$I useautoopenlib.inc}
|
||||
{$ifdef use_auto_openlib}
|
||||
{$Info Compiling autoopening of triton.library}
|
||||
var
|
||||
triton_exit : Pointer;
|
||||
const
|
||||
{ Change VERSION and LIBVERSION to proper values }
|
||||
|
||||
PROCEDURE CloseTritonLibrary;
|
||||
BEGIN
|
||||
ExitProc := triton_exit;
|
||||
if TritonBase <> nil then begin
|
||||
VERSION : string[2] = '0';
|
||||
LIBVERSION : longword = 0;
|
||||
|
||||
{$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);
|
||||
TritonBase := nil;
|
||||
end;
|
||||
END;
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
VERSION : string[2] = '6';
|
||||
|
||||
|
||||
BEGIN
|
||||
procedure InitTRITONLibrary;
|
||||
begin
|
||||
TritonBase := nil;
|
||||
TritonBase := OpenLibrary(TRITONNAME,TRITONVERSION);
|
||||
IF TritonBase <> NIL THEN begin
|
||||
TritonBase := OpenLibrary(TRITONNAME,LIBVERSION);
|
||||
if TritonBase <> nil then begin
|
||||
triton_exit := ExitProc;
|
||||
ExitProc := @CloseTritonLibrary;
|
||||
ExitProc := @ClosetritonLibrary;
|
||||
end else begin
|
||||
MessageBox('FPC Pascal Error',
|
||||
'Can''t open triton.library version ' + VERSION + #10 +
|
||||
@ -1462,11 +1483,52 @@ BEGIN
|
||||
'Oops');
|
||||
halt(20);
|
||||
end;
|
||||
{$else}
|
||||
{$Warning No autoopening of triton.library compiled}
|
||||
{$Info Make sure you open triton.library yourself}
|
||||
end;
|
||||
|
||||
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}
|
||||
|
||||
{$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 *)
|
||||
|
||||
{
|
||||
|
||||
Loading…
Reference in New Issue
Block a user