{ 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 *)