{
This file is part of the Free Pascal run time library.
A file in Amiga system run time library.
Copyright (c) 1998-2003 by Nils Sjoholm
member of the Amiga RTL development team.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{
History:
Added overlay functions for Pchar->Strings, functions
and procedures.
14 Jul 2000.
Removed amigaoverlays, use smartlink instead.
05 Nov 2002.
Added the defines use_amiga_smartlink and
use_auto_openlib. Implemented autoopening of
the library.
14 Jan 2003.
Update for AmigaOS 3.9.
A lof of new const and a record.
Functions added.
FUNCTION DupDiskObjectA
FUNCTION IconControlA
PROCEDURE DrawIconStateA
FUNCTION GetIconRectangleA
FUNCTION NewDiskObject
FUNCTION GetIconTagList
FUNCTION PutIconTagList
FUNCTION LayoutIconA
PROCEDURE ChangeToSelectedIconColor
plus overlay for
FUNCTION GetIconTagList;
FUNCTION PutIconTagList
Changed start code for unit.
02 Feb 2003.
Changed cardinal > longword.
09 Feb 2003.
nils.sjoholm@mailbox.swipnet.se
}
{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
{$smartlink on}
{$endif use_amiga_smartlink}
unit icon;
INTERFACE
uses exec, workbench,utility,amigados,graphics,intuition,datatypes;
const
ICONA_Dummy = TAG_USER + $9000;
{ }
{ Error reporting (LONG ) }
ICONA_ErrorCode = ICONA_Dummy + 1;
{ Points to the tag item that caused the error (struct TagItem ). }
ICONA_ErrorTagItem = ICONA_Dummy + 75;
{ }
{ Global options for IconControlA() }
{ Screen to use for remapping Workbench icons to (struct Screen ) }
ICONCTRLA_SetGlobalScreen = ICONA_Dummy + 2;
ICONCTRLA_GetGlobalScreen = ICONA_Dummy + 3;
{ Icon color remapping precision; defaults to PRECISION_ICON (LONG) }
ICONCTRLA_SetGlobalPrecision = ICONA_Dummy + 4;
ICONCTRLA_GetGlobalPrecision = ICONA_Dummy + 5;
{ Icon frame size dimensions (struct Rectangle ) }
ICONCTRLA_SetGlobalEmbossRect = ICONA_Dummy + 6;
ICONCTRLA_GetGlobalEmbossRect = ICONA_Dummy + 7;
{ Render image without frame (BOOL) }
ICONCTRLA_SetGlobalFrameless = ICONA_Dummy + 8;
ICONCTRLA_GetGlobalFrameless = ICONA_Dummy + 9;
{ Enable NewIcons support (BOOL) }
ICONCTRLA_SetGlobalNewIconsSupport = ICONA_Dummy + 10;
ICONCTRLA_GetGlobalNewIconsSupport = ICONA_Dummy + 11;
{ Enable color icon support (BOOL) }
ICONCTRLA_SetGlobalColorIconSupport = ICONA_Dummy + 77;
ICONCTRLA_GetGlobalColorIconSupport = ICONA_Dummy + 78;
{ Set/Get the hook to be called when identifying a file (struct Hook ) }
ICONCTRLA_SetGlobalIdentifyHook = ICONA_Dummy + 12;
ICONCTRLA_GetGlobalIdentifyHook = ICONA_Dummy + 13;
{ Set/get the maximum length of a file/drawer name supported
by icon.library (LONG).
}
ICONCTRLA_SetGlobalMaxNameLength = ICONA_Dummy + 67;
ICONCTRLA_GetGlobalMaxNameLength = ICONA_Dummy + 68;
{**************************************************************************}
{ Per icon local options for IconControlA() }
{ Get the icon rendering masks (PLANEPTR) }
ICONCTRLA_GetImageMask1 = ICONA_Dummy + 14;
ICONCTRLA_GetImageMask2 = ICONA_Dummy + 15;
{ Transparent image color; set to -1 if opaque }
ICONCTRLA_SetTransparentColor1 = ICONA_Dummy + 16;
ICONCTRLA_GetTransparentColor1 = ICONA_Dummy + 17;
ICONCTRLA_SetTransparentColor2 = ICONA_Dummy + 18;
ICONCTRLA_GetTransparentColor2 = ICONA_Dummy + 19;
{ Image color palette (struct ColorRegister ) }
ICONCTRLA_SetPalette1 = ICONA_Dummy + 20;
ICONCTRLA_GetPalette1 = ICONA_Dummy + 21;
ICONCTRLA_SetPalette2 = ICONA_Dummy + 22;
ICONCTRLA_GetPalette2 = ICONA_Dummy + 23;
{ Size of image color palette (LONG) }
ICONCTRLA_SetPaletteSize1 = ICONA_Dummy + 24;
ICONCTRLA_GetPaletteSize1 = ICONA_Dummy + 25;
ICONCTRLA_SetPaletteSize2 = ICONA_Dummy + 26;
ICONCTRLA_GetPaletteSize2 = ICONA_Dummy + 27;
{ Image data; one by per pixel (UBYTE ) }
ICONCTRLA_SetImageData1 = ICONA_Dummy + 28;
ICONCTRLA_GetImageData1 = ICONA_Dummy + 29;
ICONCTRLA_SetImageData2 = ICONA_Dummy + 30;
ICONCTRLA_GetImageData2 = ICONA_Dummy + 31;
{ Render image without frame (BOOL) }
ICONCTRLA_SetFrameless = ICONA_Dummy + 32;
ICONCTRLA_GetFrameless = ICONA_Dummy + 33;
{ Enable NewIcons support (BOOL) }
ICONCTRLA_SetNewIconsSupport = ICONA_Dummy + 34;
ICONCTRLA_GetNewIconsSupport = ICONA_Dummy + 35;
{ Icon aspect ratio (UBYTE ) }
ICONCTRLA_SetAspectRatio = ICONA_Dummy + 36;
ICONCTRLA_GetAspectRatio = ICONA_Dummy + 37;
{ Icon dimensions; valid only for palette mapped icon images (LONG) }
ICONCTRLA_SetWidth = ICONA_Dummy + 38;
ICONCTRLA_GetWidth = ICONA_Dummy + 39;
ICONCTRLA_SetHeight = ICONA_Dummy + 40;
ICONCTRLA_GetHeight = ICONA_Dummy + 41;
{ Check whether the icon is palette mapped (LONG ). }
ICONCTRLA_IsPaletteMapped = ICONA_Dummy + 42;
{ Get the screen the icon is attached to (struct Screen ). }
ICONCTRLA_GetScreen = ICONA_Dummy + 43;
{ Check whether the icon has a real select image (LONG ). }
ICONCTRLA_HasRealImage2 = ICONA_Dummy + 44;
{ Check whether the icon is of the NewIcon type (LONG ). }
ICONCTRLA_IsNewIcon = ICONA_Dummy + 79;
{ Check whether this icon was allocated by icon.library
or if consists solely of a statically allocated
struct DiskObject. (LONG ).
}
ICONCTRLA_IsNativeIcon = ICONA_Dummy + 80;
{**************************************************************************}
{ Icon aspect ratio is not known. }
ICON_ASPECT_RATIO_UNKNOWN = 0;
{ Tags for use with GetIconTagList() }
{ Default icon type to retrieve (LONG) }
ICONGETA_GetDefaultType = ICONA_Dummy+45;
{ Retrieve default icon for the given name (STRPTR) }
ICONGETA_GetDefaultName = ICONA_Dummy + 46;
{ Return a default icon if the requested icon
file cannot be found (BOOL).
}
ICONGETA_FailIfUnavailable = ICONA_Dummy + 47;
{ If possible, retrieve a palette mapped icon (BOOL). }
ICONGETA_GetPaletteMappedIcon = ICONA_Dummy + 48;
{ Set if the icon returned is a default icon (BOOL ). }
ICONGETA_IsDefaultIcon = ICONA_Dummy + 49;
{ Remap the icon to the default screen, if possible (BOOL). }
ICONGETA_RemapIcon = ICONA_Dummy + 50;
{ Generate icon image masks (BOOL). }
ICONGETA_GenerateImageMasks = ICONA_Dummy + 51;
{ Label text to be assigned to the icon (STRPTR). }
ICONGETA_Label = ICONA_Dummy + 52;
{ Screen to remap the icon to (struct Screen ). }
ICONGETA_Screen = ICONA_Dummy + 69;
{**************************************************************************}
{ Tags for use with PutIconTagList() }
{ Notify Workbench of the icon being written (BOOL) }
ICONPUTA_NotifyWorkbench = ICONA_Dummy + 53;
{ Store icon as the default for this type (LONG) }
ICONPUTA_PutDefaultType = ICONA_Dummy + 54;
{ Store icon as a default for the given name (STRPTR) }
ICONPUTA_PutDefaultName = ICONA_Dummy + 55;
{ When storing a palette mapped icon, don't save the
the original planar icon image with the file. Replace
it with a tiny replacement image.
}
ICONPUTA_DropPlanarIconImage = ICONA_Dummy + 56;
{ Don't write the chunky icon image data to disk. }
ICONPUTA_DropChunkyIconImage = ICONA_Dummy + 57;
{ Don't write the NewIcons tool types to disk. }
ICONPUTA_DropNewIconToolTypes = ICONA_Dummy + 58;
{ If this tag is enabled, the writer will examine the
icon image data to find out whether it can compress
it more efficiently. This may take extra time and
is not generally recommended.
}
ICONPUTA_OptimizeImageSpace = ICONA_Dummy + 59;
{ Don't write the entire icon file back to disk,
only change the do->do_CurrentX/do->do_CurrentY
members.
}
ICONPUTA_OnlyUpdatePosition = ICONA_Dummy + 72;
{ Before writing a palette mapped icon back to disk,
icon.library will make sure that the original
planar image data is stored in the file. If you
don't want that to happen, set this option to
FALSE. This will allow you to change the planar icon
image data written back to disk.
}
ICONPUTA_PreserveOldIconImages = ICONA_Dummy + 84;
{**************************************************************************}
{ For use with the file identification hook. }
type
PIconIdentifyMsg = ^tIconIdentifyMsg;
tIconIdentifyMsg = record
{ Libraries that are already opened for your use. }
iim_SysBase : PLibrary;
iim_DOSBase : PLibrary;
iim_UtilityBase : PLibrary;
iim_IconBase : PLibrary;
{ File context information. }
iim_FileLock : BPTR; { Lock on the object to return an icon for. }
iim_ParentLock : BPTR; { Lock on the object's parent directory, if available. }
iim_FIB : PFileInfoBlock; { Already initialized for you. }
iim_FileHandle : BPTR; { If non-NULL, pointer to the file to examine,
* positioned right at the first byte, ready
* for you to use.
}
iim_Tags : PTagItem; { Tags passed to GetIconTagList(). }
end;
{**************************************************************************}
{ Tags for use with DupDiskObjectA() }
const
{ Duplicate do_DrawerData }
ICONDUPA_DuplicateDrawerData = ICONA_Dummy + 60;
{ Duplicate the Image structures. }
ICONDUPA_DuplicateImages = ICONA_Dummy + 61;
{ Duplicate the image data (Image->ImageData) itself. }
ICONDUPA_DuplicateImageData = ICONA_Dummy + 62;
{ Duplicate the default tool. }
ICONDUPA_DuplicateDefaultTool = ICONA_Dummy + 63;
{ Duplicate the tool types list. }
ICONDUPA_DuplicateToolTypes = ICONA_Dummy + 64;
{ Duplicate the tool window. }
ICONDUPA_DuplicateToolWindow = ICONA_Dummy + 65;
{ If the icon to be duplicated is in fact a palette mapped
icon which has never been set up to be displayed on the
screen, turn the duplicate into that palette mapped icon.
}
ICONDUPA_ActivateImageData = ICONA_Dummy + 82;
{**************************************************************************}
{ Tags for use with DrawIconStateA() and GetIconRectangleA(). }
{ Drawing information to use (struct DrawInfo ). }
ICONDRAWA_DrawInfo = ICONA_Dummy + 66;
{ Draw the icon without the surrounding frame (BOOL). }
ICONDRAWA_Frameless = ICONA_Dummy + 70;
{ Erase the background before drawing a frameless icon (BOOL). }
ICONDRAWA_EraseBackground = ICONA_Dummy + 71;
{ Draw the icon without the surrounding border and frame (BOOL). }
ICONDRAWA_Borderless = ICONA_Dummy + 83;
{ The icon to be drawn refers to a linked object (BOOL). }
ICONDRAWA_IsLink = ICONA_Dummy + 89;
{**************************************************************************}
{ Reserved tags; don't use! }
ICONA_Reserved1 = ICONA_Dummy + 73;
ICONA_Reserved2 = ICONA_Dummy + 74;
ICONA_Reserved3 = ICONA_Dummy + 76;
ICONA_Reserved4 = ICONA_Dummy + 81;
ICONA_Reserved5 = ICONA_Dummy + 85;
ICONA_Reserved6 = ICONA_Dummy + 86;
ICONA_Reserved7 = ICONA_Dummy + 87;
ICONA_Reserved8 = ICONA_Dummy + 88;
{ }
ICONA_LAST_TAG = ICONA_Dummy + 89;
{**************************************************************************}
Const
ICONNAME : PChar = 'icon.library';
VAR IconBase : pLibrary;
FUNCTION AddFreeList(freelist : pFreeList;const mem : POINTER; size : ULONG) : BOOLEAN;
FUNCTION BumpRevision(newname : pCHAR;const oldname : pCHAR) : pCHAR;
FUNCTION DeleteDiskObject(const name : pCHAR) : BOOLEAN;
FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : pCHAR) : pCHAR;
PROCEDURE FreeDiskObject(diskobj : pDiskObject);
PROCEDURE FreeFreeList(freelist : pFreeList);
FUNCTION GetDefDiskObject(typ : LONGINT) : pDiskObject;
FUNCTION GetDiskObject(const name : pCHAR) : pDiskObject;
FUNCTION GetDiskObjectNew(const name : pCHAR) : pDiskObject;
FUNCTION MatchToolValue(const typeString : pCHAR;const value : pCHAR) : BOOLEAN;
FUNCTION PutDefDiskObject(const diskObject : pDiskObject) : BOOLEAN;
FUNCTION PutDiskObject(const name : pCHAR;const diskobj : pDiskObject) : BOOLEAN;
{ version 44 }
FUNCTION DupDiskObjectA(CONST diskObject : pDiskObject; CONST tags : pTagItem) : pDiskObject;
FUNCTION IconControlA(icon : pDiskObject; CONST tags : pTagItem) : longword;
PROCEDURE DrawIconStateA(rp : pRastPort; CONST icon : pDiskObject; CONST label_ : pCHAR; leftOffset : LONGINT; topOffset : LONGINT; state : longword; CONST tags : pTagItem);
FUNCTION GetIconRectangleA(rp : pRastPort; CONST icon : pDiskObject; CONST label_ : pCHAR; rect : pRectangle; CONST tags : pTagItem) : BOOLEAN;
FUNCTION NewDiskObject(type_ : LONGINT) : pDiskObject;
FUNCTION GetIconTagList(CONST name : pCHAR; CONST tags : pTagItem) : pDiskObject;
FUNCTION PutIconTagList(CONST name : pCHAR; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
FUNCTION LayoutIconA(icon : pDiskObject; screen : pScreen; tags : pTagItem) : BOOLEAN;
PROCEDURE ChangeToSelectedIconColor(cr : pColorRegister);
{ overlay }
FUNCTION BumpRevision(newname : string;const oldname : pCHAR) : pCHAR;
FUNCTION BumpRevision(newname : pCHar;const oldname : string) : pCHAR;
FUNCTION BumpRevision(newname : string;const oldname : string) : pCHAR;
FUNCTION DeleteDiskObject(const name : string) : BOOLEAN;
FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : string) : pCHAR;
FUNCTION GetDiskObject(const name : string) : pDiskObject;
FUNCTION GetDiskObjectNew(const name : string) : pDiskObject;
FUNCTION MatchToolValue(const typeString :string;const value : pCHAR) : BOOLEAN;
FUNCTION MatchToolValue(const typeString : pCHAR;const value : string) : BOOLEAN;
FUNCTION MatchToolValue(const typeString : string;const value : string) : BOOLEAN;
FUNCTION PutDiskObject(const name : string;const diskobj : pDiskObject) : BOOLEAN;
{ version 44 overlay}
FUNCTION GetIconTagList(CONST name : string; CONST tags : pTagItem) : pDiskObject;
FUNCTION PutIconTagList(CONST name : string; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
{macros}
function PACK_ICON_ASPECT_RATIO(num,den : longint) : longint;
{Here we read how to compile this unit}
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitICONLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
ICONIsCompiledHow : longint;
IMPLEMENTATION
uses
{$ifndef dont_use_openlib}
msgbox,
{$endif dont_use_openlib}
pastoc;
function PACK_ICON_ASPECT_RATIO(num,den : longint) : longint;
begin
PACK_ICON_ASPECT_RATIO:=(num shl 4) or den;
end;
FUNCTION AddFreeList(freelist : pFreeList;const mem : POINTER; size : ULONG) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L freelist,A0
MOVEA.L mem,A1
MOVEA.L size,A2
MOVEA.L IconBase,A6
JSR -072(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION BumpRevision(newname : pCHAR;const oldname : pCHAR) : pCHAR;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L newname,A0
MOVEA.L oldname,A1
MOVEA.L IconBase,A6
JSR -108(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION DeleteDiskObject(const name : pCHAR) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L name,A0
MOVEA.L IconBase,A6
JSR -138(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : pCHAR) : pCHAR;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L toolTypeArray,A0
MOVEA.L typeName,A1
MOVEA.L IconBase,A6
JSR -096(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE FreeDiskObject(diskobj : pDiskObject);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L diskobj,A0
MOVEA.L IconBase,A6
JSR -090(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE FreeFreeList(freelist : pFreeList);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L freelist,A0
MOVEA.L IconBase,A6
JSR -054(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION GetDefDiskObject(typ : LONGINT) : pDiskObject;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L typ,D0
MOVEA.L IconBase,A6
JSR -120(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetDiskObject(const name : pCHAR) : pDiskObject;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L name,A0
MOVEA.L IconBase,A6
JSR -078(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetDiskObjectNew(const name : pCHAR) : pDiskObject;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L name,A0
MOVEA.L IconBase,A6
JSR -132(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION MatchToolValue(const typeString : pCHAR;const value : pCHAR) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L typeString,A0
MOVEA.L value,A1
MOVEA.L IconBase,A6
JSR -102(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION PutDefDiskObject(const diskObject : pDiskObject) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L diskObject,A0
MOVEA.L IconBase,A6
JSR -126(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION PutDiskObject(const name : pCHAR;const diskobj : pDiskObject) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L name,A0
MOVEA.L diskobj,A1
MOVEA.L IconBase,A6
JSR -084(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION DupDiskObjectA(CONST diskObject : pDiskObject; CONST tags : pTagItem) : pDiskObject;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L diskObject,A0
MOVEA.L tags,A1
MOVEA.L IconBase,A6
JSR -150(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION IconControlA(icon : pDiskObject; CONST tags : pTagItem) : longword;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L icon,A0
MOVEA.L tags,A1
MOVEA.L IconBase,A6
JSR -156(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE DrawIconStateA(rp : pRastPort; CONST icon : pDiskObject; CONST label_ : pCHAR; leftOffset : LONGINT; topOffset : LONGINT; state : longword; CONST tags : pTagItem);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L rp,A0
MOVEA.L icon,A1
MOVEA.L label_,A2
MOVE.L leftOffset,D0
MOVE.L topOffset,D1
MOVE.L state,D2
MOVEA.L tags,A3
MOVEA.L IconBase,A6
JSR -162(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION GetIconRectangleA(rp : pRastPort; CONST icon : pDiskObject; CONST label_ : pCHAR; rect : pRectangle; CONST tags : pTagItem) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L rp,A0
MOVEA.L icon,A1
MOVEA.L label_,A2
MOVEA.L rect,A3
MOVEA.L tags,A4
MOVEA.L IconBase,A6
JSR -168(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION NewDiskObject(type_ : LONGINT) : pDiskObject;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L type_,D0
MOVEA.L IconBase,A6
JSR -174(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetIconTagList(CONST name : pCHAR; CONST tags : pTagItem) : pDiskObject;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L name,A0
MOVEA.L tags,A1
MOVEA.L IconBase,A6
JSR -180(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION PutIconTagList(CONST name : pCHAR; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L name,A0
MOVEA.L icon,A1
MOVEA.L tags,A2
MOVEA.L IconBase,A6
JSR -186(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
FUNCTION LayoutIconA(icon : pDiskObject; screen : pScreen; tags : pTagItem) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L icon,A0
MOVEA.L screen,A1
MOVEA.L tags,A2
MOVEA.L IconBase,A6
JSR -192(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
PROCEDURE ChangeToSelectedIconColor(cr : pColorRegister);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L cr,A0
MOVEA.L IconBase,A6
JSR -198(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION BumpRevision(newname : string;const oldname : pCHAR) : pCHAR;
begin
BumpRevision := BumpRevision(pas2c(newname),oldname);
end;
FUNCTION BumpRevision(newname : pCHar;const oldname : string) : pCHAR;
begin
BumpRevision := BumpRevision(newname,pas2c(oldname));
end;
FUNCTION BumpRevision(newname : string;const oldname : string) : pCHAR;
begin
BumpRevision := BumpRevision(pas2c(newname),pas2c(oldname));
end;
FUNCTION DeleteDiskObject(const name : string) : BOOLEAN;
begin
DeleteDiskObject := DeleteDiskObject(pas2c(name));
end;
FUNCTION FindToolType(const toolTypeArray : POINTER;const typeName : string) : pCHAR;
begin
FindToolType := FindToolType(toolTypeArray,pas2c(typeName));
end;
FUNCTION GetDiskObject(const name : string) : pDiskObject;
begin
GetDiskObject := GetDiskObject(pas2c(name));
end;
FUNCTION GetDiskObjectNew(const name : string) : pDiskObject;
begin
GetDiskObjectNew := GetDiskObjectNew(pas2c(name));
end;
FUNCTION MatchToolValue(const typeString : string;const value : pCHAR) : BOOLEAN;
begin
MatchToolValue := MatchToolValue(pas2c(typeString),value);
end;
FUNCTION MatchToolValue(const typeString : pCHAR;const value : string) : BOOLEAN;
begin
MatchToolValue := MatchToolValue(typeString,pas2c(value));
end;
FUNCTION MatchToolValue(const typeString : string;const value : string) : BOOLEAN;
begin
MatchToolValue := MatchToolValue(pas2c(typeString),pas2c(value));
end;
FUNCTION PutDiskObject(const name : string;const diskobj : pDiskObject) : BOOLEAN;
begin
PutDiskObject := PutDiskObject(pas2c(name),diskobj);
end;
FUNCTION GetIconTagList(CONST name : string; CONST tags : pTagItem) : pDiskObject;
begin
GetIconTagList := GetIconTagList(pas2c(name),tags);
end;
FUNCTION PutIconTagList(CONST name : string; CONST icon : pDiskObject; CONST tags : pTagItem) : BOOLEAN;
begin
PutIconTagList := PutIconTagList(pas2c(name),icon,tags);
end;
const
{ Change VERSION and LIBVERSION to proper values }
VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of icon.library}
{$Info don't forget to use InitICONLibrary in the beginning of your program}
var
icon_exit : Pointer;
procedure CloseiconLibrary;
begin
ExitProc := icon_exit;
if IconBase <> nil then begin
CloseLibrary(IconBase);
IconBase := nil;
end;
end;
procedure InitICONLibrary;
begin
IconBase := nil;
IconBase := OpenLibrary(ICONNAME,LIBVERSION);
if IconBase <> nil then begin
icon_exit := ExitProc;
ExitProc := @CloseiconLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open icon.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
ICONIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of icon.library}
var
icon_exit : Pointer;
procedure CloseiconLibrary;
begin
ExitProc := icon_exit;
if IconBase <> nil then begin
CloseLibrary(IconBase);
IconBase := nil;
end;
end;
begin
IconBase := nil;
IconBase := OpenLibrary(ICONNAME,LIBVERSION);
if IconBase <> nil then begin
icon_exit := ExitProc;
ExitProc := @CloseiconLibrary;
ICONIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open icon.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
ICONIsCompiledHow := 3;
{$Warning No autoopening of icon.library compiled}
{$Warning Make sure you open icon.library yourself}
{$endif dont_use_openlib}
END. (* UNIT ICON *)
{
$Log: icon.pas,v $
Revision 1.5 2003/02/10 17:59:46 nils
* fixes for delphi mode
Revision 1.4 2003/02/07 20:48:36 nils
* update for amigaos 3.9
* changed startcode for library
Revision 1.3 2003/01/14 18:46:04 nils
* added defines use_amia_smartlink and use_auto_openlib
* implemented autoopening of library
Revision 1.2 2002/11/18 20:54:32 nils
* update check internal log
}
syntax highlighted by Code2HTML, v. 0.9.1