diff options
55 files changed, 18491 insertions, 0 deletions
diff --git a/Game/Code/lib/JEDI-SDLv1.0/placeholder.txt b/Game/Code/lib/JEDI-SDLv1.0/placeholder.txt new file mode 100644 index 00000000..d4073d15 --- /dev/null +++ b/Game/Code/lib/JEDI-SDLv1.0/placeholder.txt @@ -0,0 +1,4 @@ +grab Jedi-sdl from : + http://sourceforge.net/projects/jedi-sdl + +and extract in this directory !!
\ No newline at end of file diff --git a/Game/Code/lib/PngImage/Tpngimage.DPK b/Game/Code/lib/PngImage/Tpngimage.DPK new file mode 100644 index 00000000..b9c395f4 --- /dev/null +++ b/Game/Code/lib/PngImage/Tpngimage.DPK @@ -0,0 +1,34 @@ +package Tpngimage;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$IMPLICITBUILD OFF}
+
+requires
+ rtl,
+ vcl;
+
+contains
+ pngimage in 'pngimage.pas';
+
+end.
diff --git a/Game/Code/lib/PngImage/Tpngimage.cfg b/Game/Code/lib/PngImage/Tpngimage.cfg new file mode 100644 index 00000000..4a78a005 --- /dev/null +++ b/Game/Code/lib/PngImage/Tpngimage.cfg @@ -0,0 +1,40 @@ +-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-GD
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-LE"C:\Documents and Settings\Jay Binks\My Documents\Borland Studio Projects\Bpl"
+-LN"C:\Documents and Settings\Jay Binks\My Documents\Borland Studio Projects\Bpl"
+-Z
+-w-UNSAFE_TYPE
+-w-UNSAFE_CODE
+-w-UNSAFE_CAST
diff --git a/Game/Code/lib/PngImage/Tpngimage.drc b/Game/Code/lib/PngImage/Tpngimage.drc new file mode 100644 index 00000000..52d3a522 --- /dev/null +++ b/Game/Code/lib/PngImage/Tpngimage.drc @@ -0,0 +1,62 @@ +/* VER180
+ Generated by the Borland Delphi Pascal Compiler
+ because -GD or --drc was supplied to the compiler.
+
+ This file contains compiler-generated resources that
+ were bound to the executable.
+ If this file is empty, then no compiler-generated
+ resources were bound to the produced executable.
+*/
+
+#define pnglang_EPNGNoImageDataText 65504
+#define pnglang_EPNGCannotChangeSizeText 65505
+#define pnglang_EPNGCannotAddChunkText 65506
+#define pnglang_EPNGCannotAddInvalidImageText 65507
+#define pnglang_EPNGCouldNotLoadResourceText 65508
+#define pnglang_EPNGOutMemoryText 65509
+#define pnglang_EPNGCannotChangeTransparentText 65510
+#define pnglang_EPNGHeaderNotPresentText 65511
+#define pnglang_EPngInvalidCRCText 65520
+#define pnglang_EPNGInvalidIHDRText 65521
+#define pnglang_EPNGMissingMultipleIDATText 65522
+#define pnglang_EPNGZLIBErrorText 65523
+#define pnglang_EPNGInvalidPaletteText 65524
+#define pnglang_EPNGInvalidFileHeaderText 65525
+#define pnglang_EPNGIHDRNotFirstText 65526
+#define pnglang_EPNGNotExistsText 65527
+#define pnglang_EPNGSizeExceedsText 65528
+#define pnglang_EPNGUnknownPalEntryText 65529
+#define pnglang_EPNGMissingPaletteText 65530
+#define pnglang_EPNGUnknownCriticalChunkText 65531
+#define pnglang_EPNGUnknownCompressionText 65532
+#define pnglang_EPNGUnknownInterlaceText 65533
+#define pnglang_EPNGCannotAssignChunkText 65534
+#define pnglang_EPNGUnexpectedEndText 65535
+STRINGTABLE
+BEGIN
+ pnglang_EPNGNoImageDataText, "This \"Portable Network Graphics\" image contains no data."
+ pnglang_EPNGCannotChangeSizeText, "The \"Portable Network Graphics\" image can not be resize by changing width and height properties. Try assigning the image from a bitmap."
+ pnglang_EPNGCannotAddChunkText, "The program tried to add a existent critical chunk to the current image which is not allowed."
+ pnglang_EPNGCannotAddInvalidImageText, "It's not allowed to add a new chunk because the current image is invalid."
+ pnglang_EPNGCouldNotLoadResourceText, "The png image could not be loaded from the resource ID."
+ pnglang_EPNGOutMemoryText, "Some operation could not be performed because the system is out of resources. Close some windows and try again."
+ pnglang_EPNGCannotChangeTransparentText, "Setting bit transparency color is not allowed for png images containing alpha value for each pixel (COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)"
+ pnglang_EPNGHeaderNotPresentText, "This operation is not valid because the current image contains no valid header."
+ pnglang_EPngInvalidCRCText, "This \"Portable Network Graphics\" image is not valid because it contains invalid pieces of data (crc error)"
+ pnglang_EPNGInvalidIHDRText, "The \"Portable Network Graphics\" image could not be loaded because one of its main piece of data (ihdr) might be corrupted"
+ pnglang_EPNGMissingMultipleIDATText, "This \"Portable Network Graphics\" image is invalid because it has missing image parts."
+ pnglang_EPNGZLIBErrorText, "Could not decompress the image because it contains invalid compressed data.\r\n Description: "
+ pnglang_EPNGInvalidPaletteText, "The \"Portable Network Graphics\" image contains an invalid palette."
+ pnglang_EPNGInvalidFileHeaderText, "The file being readed is not a valid \"Portable Network Graphics\" image because it contains an invalid header. This file may be corruped, try obtaining it again."
+ pnglang_EPNGIHDRNotFirstText, "This \"Portable Network Graphics\" image is not supported or it might be invalid.\r\n(IHDR chunk is not the first)"
+ pnglang_EPNGNotExistsText, "The png file could not be loaded because it does not exists."
+ pnglang_EPNGSizeExceedsText, "This \"Portable Network Graphics\" image is not supported because either it's width or height exceeds the maximum size, which is 65535 pixels length."
+ pnglang_EPNGUnknownPalEntryText, "There is no such palette entry."
+ pnglang_EPNGMissingPaletteText, "This \"Portable Network Graphics\" could not be loaded because it uses a color table which is missing."
+ pnglang_EPNGUnknownCriticalChunkText, "This \"Portable Network Graphics\" image contains an unknown critical part which could not be decoded."
+ pnglang_EPNGUnknownCompressionText, "This \"Portable Network Graphics\" image is encoded with an unknown compression scheme which could not be decoded."
+ pnglang_EPNGUnknownInterlaceText, "This \"Portable Network Graphics\" image uses an unknown interlace scheme which could not be decoded."
+ pnglang_EPNGCannotAssignChunkText, "The chunks must be compatible to be assigned."
+ pnglang_EPNGUnexpectedEndText, "This \"Portable Network Graphics\" image is invalid because the decoder found an unexpected end of the file."
+END
+
diff --git a/Game/Code/lib/PngImage/Tpngimage.res b/Game/Code/lib/PngImage/Tpngimage.res Binary files differnew file mode 100644 index 00000000..aac9aa64 --- /dev/null +++ b/Game/Code/lib/PngImage/Tpngimage.res diff --git a/Game/Code/lib/PngImage/Tpngimage.stat b/Game/Code/lib/PngImage/Tpngimage.stat new file mode 100644 index 00000000..57f32789 --- /dev/null +++ b/Game/Code/lib/PngImage/Tpngimage.stat @@ -0,0 +1,10 @@ +[Stats]
+EditorSecs=3
+DesignerSecs=1
+InspectorSecs=1
+CompileSecs=1542
+OtherSecs=11
+StartTime=5/6/2004 7:36:05 PM
+RealKeys=0
+EffectiveKeys=0
+DebugSecs=1
diff --git a/Game/Code/lib/PngImage/lazarustest.lpi b/Game/Code/lib/PngImage/lazarustest.lpi new file mode 100644 index 00000000..4dec8a9e --- /dev/null +++ b/Game/Code/lib/PngImage/lazarustest.lpi @@ -0,0 +1,239 @@ +<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="\"/>
+ <Version Value="5"/>
+ <General>
+ <MainUnit Value="0"/>
+ <IconPath Value="./"/>
+ <TargetFileExt Value=".exe"/>
+ <ActiveEditorIndexAtStart Value="0"/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ <Language Value=""/>
+ <CharSet Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <Units Count="8">
+ <Unit0>
+ <Filename Value="lazarustest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="lazarustest"/>
+ <CursorPos X="49" Y="11"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="0"/>
+ <UsageCount Value="23"/>
+ <Loaded Value="True"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="delphi\bass.pas"/>
+ <UnitName Value="Bass"/>
+ <CursorPos X="12" Y="539"/>
+ <TopLine Value="589"/>
+ <UsageCount Value="10"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="avformat.pas"/>
+ <UnitName Value="avformat"/>
+ <CursorPos X="38" Y="594"/>
+ <TopLine Value="567"/>
+ <UsageCount Value="10"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="avcodec.pas"/>
+ <UnitName Value="avcodec"/>
+ <CursorPos X="3" Y="1796"/>
+ <TopLine Value="1775"/>
+ <UsageCount Value="11"/>
+ </Unit3>
+ <Unit4>
+ <Filename Value="avio.pas"/>
+ <UnitName Value="avio"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="1"/>
+ <UsageCount Value="11"/>
+ </Unit4>
+ <Unit5>
+ <Filename Value="pngimage.pas"/>
+ <UnitName Value="pngimage"/>
+ <CursorPos X="20" Y="133"/>
+ <TopLine Value="121"/>
+ <EditorIndex Value="1"/>
+ <UsageCount Value="10"/>
+ <Loaded Value="True"/>
+ </Unit5>
+ <Unit6>
+ <Filename Value="pngzlib.pas"/>
+ <UnitName Value="pngzlib"/>
+ <CursorPos X="6" Y="111"/>
+ <TopLine Value="91"/>
+ <EditorIndex Value="3"/>
+ <UsageCount Value="10"/>
+ <Loaded Value="True"/>
+ </Unit6>
+ <Unit7>
+ <Filename Value="pnglang.pas"/>
+ <UnitName Value="pnglang"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="2"/>
+ <UsageCount Value="10"/>
+ <Loaded Value="True"/>
+ </Unit7>
+ </Units>
+ <JumpHistory Count="30" HistoryIndex="29">
+ <Position1>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="4037" Column="16" TopLine="4017"/>
+ </Position1>
+ <Position2>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="19" Column="1" TopLine="1"/>
+ </Position2>
+ <Position3>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="6" Column="1" TopLine="1"/>
+ </Position3>
+ <Position4>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="4" Column="1" TopLine="1"/>
+ </Position4>
+ <Position5>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="8" Column="30" TopLine="1"/>
+ </Position5>
+ <Position6>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="38" Column="37" TopLine="18"/>
+ </Position6>
+ <Position7>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="52" Column="16" TopLine="31"/>
+ </Position7>
+ <Position8>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="6" Column="1" TopLine="1"/>
+ </Position8>
+ <Position9>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="124" Column="82" TopLine="86"/>
+ </Position9>
+ <Position10>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="1" Column="1" TopLine="1"/>
+ </Position10>
+ <Position11>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="103" Column="6" TopLine="83"/>
+ </Position11>
+ <Position12>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="104" Column="6" TopLine="84"/>
+ </Position12>
+ <Position13>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="105" Column="6" TopLine="85"/>
+ </Position13>
+ <Position14>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="106" Column="6" TopLine="86"/>
+ </Position14>
+ <Position15>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="107" Column="6" TopLine="87"/>
+ </Position15>
+ <Position16>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="108" Column="6" TopLine="88"/>
+ </Position16>
+ <Position17>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="109" Column="6" TopLine="89"/>
+ </Position17>
+ <Position18>
+ <Filename Value="pngzlib.pas"/>
+ <Caret Line="110" Column="6" TopLine="90"/>
+ </Position18>
+ <Position19>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="4037" Column="62" TopLine="4017"/>
+ </Position19>
+ <Position20>
+ <Filename Value="pnglang.pas"/>
+ <Caret Line="275" Column="31" TopLine="255"/>
+ </Position20>
+ <Position21>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="19" Column="1" TopLine="1"/>
+ </Position21>
+ <Position22>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="1" Column="1" TopLine="1"/>
+ </Position22>
+ <Position23>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="19" Column="1" TopLine="1"/>
+ </Position23>
+ <Position24>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="1" Column="1" TopLine="1"/>
+ </Position24>
+ <Position25>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="139" Column="10" TopLine="119"/>
+ </Position25>
+ <Position26>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="138" Column="1" TopLine="119"/>
+ </Position26>
+ <Position27>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="146" Column="38" TopLine="121"/>
+ </Position27>
+ <Position28>
+ <Filename Value="pngimage.pas"/>
+ <Caret Line="141" Column="2" TopLine="121"/>
+ </Position28>
+ <Position29>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="11" Column="20" TopLine="1"/>
+ </Position29>
+ <Position30>
+ <Filename Value="lazarustest.lpr"/>
+ <Caret Line="14" Column="1" TopLine="1"/>
+ </Position30>
+ </JumpHistory>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <PathDelim Value="\"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+ <Debugging>
+ <Exceptions Count="2">
+ <Item1>
+ <Name Value="ECodetoolError"/>
+ </Item1>
+ <Item2>
+ <Name Value="EFOpenError"/>
+ </Item2>
+ </Exceptions>
+ </Debugging>
+</CONFIG>
diff --git a/Game/Code/lib/PngImage/lazarustest.lpr b/Game/Code/lib/PngImage/lazarustest.lpr new file mode 100644 index 00000000..f567b6cb --- /dev/null +++ b/Game/Code/lib/PngImage/lazarustest.lpr @@ -0,0 +1,15 @@ +program lazarustest;
+
+uses
+ pngimage in 'pngimage.pas',
+ pnglang in 'pnglang.pas',
+ pngzlib in 'pngzlib.pas',
+ sysutils;
+
+begin
+ writeln( 'pngimage is NOT lazarus compatible' );
+ writeln( 'It might compile ( not link though ), however the object files are in borland obj format' );
+ writeln( 'to use this, it will need to be in GCC object file format format' );
+ writeln( 'Or we can use the lazarus / freepascal png unit' );
+end.
+
diff --git a/Game/Code/lib/PngImage/obj/adler32.obj b/Game/Code/lib/PngImage/obj/adler32.obj Binary files differnew file mode 100644 index 00000000..7da9fd19 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/adler32.obj diff --git a/Game/Code/lib/PngImage/obj/deflate.obj b/Game/Code/lib/PngImage/obj/deflate.obj Binary files differnew file mode 100644 index 00000000..804e9334 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/deflate.obj diff --git a/Game/Code/lib/PngImage/obj/infblock.obj b/Game/Code/lib/PngImage/obj/infblock.obj Binary files differnew file mode 100644 index 00000000..3bc38e41 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/infblock.obj diff --git a/Game/Code/lib/PngImage/obj/infcodes.obj b/Game/Code/lib/PngImage/obj/infcodes.obj Binary files differnew file mode 100644 index 00000000..faec2222 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/infcodes.obj diff --git a/Game/Code/lib/PngImage/obj/inffast.obj b/Game/Code/lib/PngImage/obj/inffast.obj Binary files differnew file mode 100644 index 00000000..62e18ceb --- /dev/null +++ b/Game/Code/lib/PngImage/obj/inffast.obj diff --git a/Game/Code/lib/PngImage/obj/inflate.obj b/Game/Code/lib/PngImage/obj/inflate.obj Binary files differnew file mode 100644 index 00000000..7dc522e0 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/inflate.obj diff --git a/Game/Code/lib/PngImage/obj/inftrees.obj b/Game/Code/lib/PngImage/obj/inftrees.obj Binary files differnew file mode 100644 index 00000000..5755233f --- /dev/null +++ b/Game/Code/lib/PngImage/obj/inftrees.obj diff --git a/Game/Code/lib/PngImage/obj/infutil.obj b/Game/Code/lib/PngImage/obj/infutil.obj Binary files differnew file mode 100644 index 00000000..7e175a83 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/infutil.obj diff --git a/Game/Code/lib/PngImage/obj/trees.obj b/Game/Code/lib/PngImage/obj/trees.obj Binary files differnew file mode 100644 index 00000000..81f05568 --- /dev/null +++ b/Game/Code/lib/PngImage/obj/trees.obj diff --git a/Game/Code/lib/PngImage/pngimage.chm b/Game/Code/lib/PngImage/pngimage.chm Binary files differnew file mode 100644 index 00000000..c7e51b2e --- /dev/null +++ b/Game/Code/lib/PngImage/pngimage.chm diff --git a/Game/Code/lib/PngImage/pngimage.pas b/Game/Code/lib/PngImage/pngimage.pas new file mode 100644 index 00000000..ecd52c5b --- /dev/null +++ b/Game/Code/lib/PngImage/pngimage.pas @@ -0,0 +1,5213 @@ +{Portable Network Graphics Delphi 1.4361 (8 March 2003) }
+
+{This is the latest implementation for TPngImage component }
+{It's meant to be a full replacement for the previous one. }
+{There are lots of new improvements, including cleaner code, }
+{full partial transparency support, speed improvements, }
+{saving using ADAM 7 interlacing, better error handling, also }
+{the best compression for the final image ever. And now it's }
+{truly able to read about any png image. }
+
+{
+ Version 1.4361
+ 2003-03-04 - Fixed important bug for simple transparency when using
+ RGB, Grayscale color modes
+
+ Version 1.436
+ 2003-03-04 - * NEW * Property Pixels for direct access to pixels
+ * IMPROVED * Palette property (TPngObject) (read only)
+ Slovenian traslation for the component (Miha Petelin)
+ Help file update (scanline article/png->jpg example)
+
+ Version 1.435
+ 2003-11-03 - * NEW * New chunk implementation zTXt (method AddzTXt)
+ * NEW * New compiler flags to store the extra 8 bits
+ from 16 bits samples (when saving it is ignored), the
+ extra data may be acessed using ExtraScanline property
+ * Fixed * a bug on tIMe chunk
+ French translation included (Thanks to IBE Software)
+ Bugs fixed
+
+ Version 1.432
+ 2002-08-24 - * NEW * A new method, CreateAlpha will transform the
+ current image into partial transparency.
+ Help file updated with a new article on how to handle
+ partial transparency.
+
+ Version 1.431
+ 2002-08-14 - Fixed and tested to work on:
+ C++ Builder 3
+ C++ Builder 5
+ Delphi 3
+ There was an error when setting TransparentColor, fixed
+ New method, RemoveTransparency to remove image
+ BIT TRANSPARENCY
+
+ Version 1.43
+ 2002-08-01 - * NEW * Support for Delphi 3 and C++ Builder 3
+ Implements mostly some things that were missing,
+ a few tweaks and fixes.
+
+ Version 1.428
+ 2002-07-24 - More minor fixes (thanks to Ian Boyd)
+ Bit transparency fixes
+ * NEW * Finally support to bit transparency
+ (palette / rgb / grayscale -> all)
+
+ Version 1.427
+ 2002-07-19 - Lots of bugs and leaks fixed
+ * NEW * method to easy adding text comments, AddtEXt
+ * NEW * property for setting bit transparency,
+ TransparentColor
+
+ Version 1.426
+ 2002-07-18 - Clipboard finally fixed (hope)
+ Changed UseDelphi trigger to UseDelphi
+ * NEW * Support for bit transparency bitmaps
+ when assigning from/to TBitmap objects
+ Altough it does not support drawing transparent
+ parts of bit transparency pngs (only partial)
+ it is closer than ever
+
+ Version 1.425
+ 2002-07-01 - Clipboard methods implemented
+ Lots of bugs fixed
+
+ Version 1.424
+ 2002-05-16 - Scanline and AlphaScanline are now working correctly.
+ New methods for handling the clipboard
+
+ Version 1.423
+ 2002-05-16 - * NEW * Partial transparency for 1, 2, 4 and 8 bits is
+ also supported using the tRNS chunk (for palette and
+ grayscaling).
+ New bug fixes (Peter Haas).
+
+ Version 1.422
+ 2002-05-14 - Fixed some critical leaks, thanks to Peter Haas tips.
+ New translation for German (Peter Haas).
+
+ Version 1.421
+ 2002-05-06 - Now uses new ZLIB version, 1.1.4 with some security
+ fixes.
+ LoadFromResourceID and LoadFromResourceName added and
+ help file updated for that.
+ The resources strings are now located in pnglang.pas.
+ New translation for Brazilian Portuguese.
+ Bugs fixed.
+
+ IMPORTANT: I'm currently looking for bugs on the library. If
+ anyone has found one, please send me an email and
+ I will fix right away. Thanks for all the help and
+ ideias I'm receiving so far.}
+
+{My new email is: gubadaud@terra.com.br}
+{Website link : pngdelphi.sourceforge.net}
+{Gustavo Huffenbacher Daud}
+
+unit pngimage;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{Triggers avaliable (edit the fields bellow)}
+{$IFNDef FPC}
+{$DEFINE UseDelphi} //Disable fat vcl units (perfect to small apps)
+{$ENDIF}
+
+{$DEFINE ErrorOnUnknownCritical} //Error when finds an unknown critical chunk
+{$DEFINE CheckCRC} //Enables CRC checking
+{$DEFINE RegisterGraphic} //Registers TPNGObject to use with TPicture
+{$DEFINE PartialTransparentDraw} //Draws partial transparent images
+{.$DEFINE Store16bits} //Stores the extra 8 bits from 16bits/sample
+{.$DEFINE Debug} //For programming purposes
+{$RANGECHECKS OFF} {$J+}
+
+
+
+uses
+ Windows,
+ {$IFDEF UseDelphi}
+ Classes,
+ Graphics,
+ SysUtils,
+ {$ENDIF}
+ {$IFDEF Debug}
+ dialogs,
+ {$ENDIF}
+ pngzlib,
+ pnglang;
+
+{$IFNDEF UseDelphi}
+ const
+ soFromBeginning = 0;
+ soFromCurrent = 1;
+ soFromEnd = 2;
+{$ENDIF}
+
+const
+ {ZLIB constants}
+ ZLIBErrors: Array[-6..2] of string = ('incompatible version (-6)',
+ 'buffer error (-5)', 'insufficient memory (-4)', 'data error (-3)',
+ 'stream error (-2)', 'file error (-1)', '(0)', 'stream end (1)',
+ 'need dictionary (2)');
+ Z_NO_FLUSH = 0;
+ Z_FINISH = 4;
+ Z_STREAM_END = 1;
+
+ {Avaliable PNG filters for mode 0}
+ FILTER_NONE = 0;
+ FILTER_SUB = 1;
+ FILTER_UP = 2;
+ FILTER_AVERAGE = 3;
+ FILTER_PAETH = 4;
+
+ {Avaliable color modes for PNG}
+ COLOR_GRAYSCALE = 0;
+ COLOR_RGB = 2;
+ COLOR_PALETTE = 3;
+ COLOR_GRAYSCALEALPHA = 4;
+ COLOR_RGBALPHA = 6;
+
+
+type
+ {$IFNDEF UseDelphi}
+ {Custom exception handler}
+ Exception = class(TObject)
+ constructor Create(Msg: String);
+ end;
+ ExceptClass = class of Exception;
+ TColor = ColorRef;
+ {$ENDIF}
+
+ {Error types}
+ EPNGOutMemory = class(Exception);
+ EPngError = class(Exception);
+ EPngUnexpectedEnd = class(Exception);
+ EPngInvalidCRC = class(Exception);
+ EPngInvalidIHDR = class(Exception);
+ EPNGMissingMultipleIDAT = class(Exception);
+ EPNGZLIBError = class(Exception);
+ EPNGInvalidPalette = class(Exception);
+ EPNGInvalidFileHeader = class(Exception);
+ EPNGIHDRNotFirst = class(Exception);
+ EPNGNotExists = class(Exception);
+ EPNGSizeExceeds = class(Exception);
+ EPNGMissingPalette = class(Exception);
+ EPNGUnknownCriticalChunk = class(Exception);
+ EPNGUnknownCompression = class(Exception);
+ EPNGUnknownInterlace = class(Exception);
+ EPNGNoImageData = class(Exception);
+ EPNGCouldNotLoadResource = class(Exception);
+ EPNGCannotChangeTransparent = class(Exception);
+ EPNGHeaderNotPresent = class(Exception);
+
+type
+ {Direct access to pixels using R,G,B}
+ TRGBLine = array[word] of TRGBTriple;
+ pRGBLine = ^TRGBLine;
+
+ {Same as TBitmapInfo but with allocated space for}
+ {palette entries}
+ TMAXBITMAPINFO = packed record
+ bmiHeader: TBitmapInfoHeader;
+ bmiColors: packed array[0..255] of TRGBQuad;
+ end;
+
+ {Transparency mode for pngs}
+ TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial);
+ {Pointer to a cardinal type}
+ pCardinal = ^Cardinal;
+ {Access to a rgb pixel}
+ pRGBPixel = ^TRGBPixel;
+ TRGBPixel = packed record
+ B, G, R: Byte;
+ end;
+
+ {Pointer to an array of bytes type}
+ TByteArray = Array[Word] of Byte;
+ pByteArray = ^TByteArray;
+
+ {Forward}
+ TPNGObject = class;
+ pPointerArray = ^TPointerArray;
+ TPointerArray = Array[Word] of Pointer;
+
+ {Contains a list of objects}
+ TPNGPointerList = class
+ private
+ fOwner: TPNGObject;
+ fCount : Cardinal;
+ fMemory: pPointerArray;
+ function GetItem(Index: Cardinal): Pointer;
+ procedure SetItem(Index: Cardinal; const Value: Pointer);
+ protected
+ {Removes an item}
+ function Remove(Value: Pointer): Pointer; virtual;
+ {Inserts an item}
+ procedure Insert(Value: Pointer; Position: Cardinal);
+ {Add a new item}
+ procedure Add(Value: Pointer);
+ {Returns an item}
+ property Item[Index: Cardinal]: Pointer read GetItem write SetItem;
+ {Set the size of the list}
+ procedure SetSize(const Size: Cardinal);
+ {Returns owner}
+ property Owner: TPNGObject read fOwner;
+ public
+ {Returns number of items}
+ property Count: Cardinal read fCount write SetSize;
+ {Object being either created or destroyed}
+ constructor Create(AOwner: TPNGObject);
+ destructor Destroy; override;
+ end;
+
+ {Forward declaration}
+ TChunk = class;
+ TChunkClass = class of TChunk;
+
+ {Same as TPNGPointerList but providing typecasted values}
+ TPNGList = class(TPNGPointerList)
+ private
+ {Used with property Item}
+ function GetItem(Index: Cardinal): TChunk;
+ public
+ {Removes an item}
+ procedure RemoveChunk(Chunk: TChunk); overload;
+ {Add a new chunk using the class from the parameter}
+ function Add(ChunkClass: TChunkClass): TChunk;
+ {Returns pointer to the first chunk of class}
+ function ItemFromClass(ChunkClass: TChunkClass): TChunk;
+ {Returns a chunk item from the list}
+ property Item[Index: Cardinal]: TChunk read GetItem;
+ end;
+
+ {$IFNDEF UseDelphi}
+ {The STREAMs bellow are only needed in case delphi provided ones is not}
+ {avaliable (UseDelphi trigger not set)}
+ {Object becomes handles}
+ TCanvas = THandle;
+ TBitmap = HBitmap;
+ {Trick to work}
+ TPersistent = TObject;
+
+ {Base class for all streams}
+ TStream = class
+ protected
+ {Returning/setting size}
+ function GetSize: Longint; virtual;
+ procedure SetSize(const Value: Longint); virtual; abstract;
+ {Returns/set position}
+ function GetPosition: Longint; virtual;
+ procedure SetPosition(const Value: Longint); virtual;
+ public
+ {Returns/sets current position}
+ property Position: Longint read GetPosition write SetPosition;
+ {Property returns/sets size}
+ property Size: Longint read GetSize write SetSize;
+ {Allows reading/writing data}
+ function Read(var Buffer; Count: Longint): Cardinal; virtual; abstract;
+ function Write(const Buffer; Count: Longint): Cardinal; virtual; abstract;
+ {Copies from another Stream}
+ function CopyFrom(Source: TStream;
+ Count: Cardinal): Cardinal; virtual;
+ {Seeks a stream position}
+ function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
+ end;
+
+ {File stream modes}
+ TFileStreamMode = (fsmRead, fsmWrite, fsmCreate);
+ TFileStreamModeSet = set of TFileStreamMode;
+
+ {File stream for reading from files}
+ TFileStream = class(TStream)
+ private
+ {Opened mode}
+ Filemode: TFileStreamModeSet;
+ {Handle}
+ fHandle: THandle;
+ protected
+ {Set the size of the file}
+ procedure SetSize(const Value: Longint); override;
+ public
+ {Seeks a file position}
+ function Seek(Offset: Longint; Origin: Word): Longint; override;
+ {Reads/writes data from/to the file}
+ function Read(var Buffer; Count: Longint): Cardinal; override;
+ function Write(const Buffer; Count: Longint): Cardinal; override;
+ {Stream being created and destroy}
+ constructor Create(Filename: String; Mode: TFileStreamModeSet);
+ destructor Destroy; override;
+ end;
+
+ {Stream for reading from resources}
+ TResourceStream = class(TStream)
+ constructor Create(Instance: HInst; const ResName: String; ResType:PChar);
+ private
+ {Variables for reading}
+ Size: Integer;
+ Memory: Pointer;
+ Position: Integer;
+ protected
+ {Set the size of the file}
+ procedure SetSize(const Value: Longint); override;
+ public
+ {Stream processing}
+ function Read(var Buffer; Count: Integer): Cardinal; override;
+ function Seek(Offset: Integer; Origin: Word): Longint; override;
+ function Write(const Buffer; Count: Longint): Cardinal; override;
+ end;
+ {$ENDIF}
+
+ {Forward}
+ TChunkIHDR = class;
+ {Interlace method}
+ TInterlaceMethod = (imNone, imAdam7);
+ {Compression level type}
+ TCompressionLevel = 0..9;
+ {Filters type}
+ TFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth);
+ TFilters = set of TFilter;
+
+ {Png implementation object}
+ TPngObject = class{$IFDEF UseDelphi}(TGraphic){$ENDIF}
+ protected
+ {Gamma table values}
+ GammaTable, InverseGamma: Array[Byte] of Byte;
+ procedure InitializeGamma;
+ private
+ {Temporary palette}
+ TempPalette: HPalette;
+ {Filters to test to encode}
+ fFilters: TFilters;
+ {Compression level for ZLIB}
+ fCompressionLevel: TCompressionLevel;
+ {Maximum size for IDAT chunks}
+ fMaxIdatSize: Cardinal;
+ {Returns if image is interlaced}
+ fInterlaceMethod: TInterlaceMethod;
+ {Chunks object}
+ fChunkList: TPngList;
+ {Clear all chunks in the list}
+ procedure ClearChunks;
+ {Returns if header is present}
+ function HeaderPresent: Boolean;
+ {Returns linesize and byte offset for pixels}
+ procedure GetPixelInfo(var LineSize, Offset: Cardinal);
+ procedure SetMaxIdatSize(const Value: Cardinal);
+ function GetAlphaScanline(const LineIndex: Integer): pByteArray;
+ function GetScanline(const LineIndex: Integer): Pointer;
+ {$IFDEF Store16bits}
+ function GetExtraScanline(const LineIndex: Integer): Pointer;
+ {$ENDIF}
+ function GetTransparencyMode: TPNGTransparencyMode;
+ function GetTransparentColor: TColor;
+ procedure SetTransparentColor(const Value: TColor);
+ protected
+ {Returns the image palette}
+ function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
+ {Returns/sets image width and height}
+ function GetWidth: Integer; {$IFDEF UseDelphi}override;{$ENDIF}
+ function GetHeight: Integer; {$IFDEF UseDelphi}override; {$ENDIF}
+ procedure SetWidth(Value: Integer); {$IFDEF UseDelphi}override; {$ENDIF}
+ procedure SetHeight(Value: Integer); {$IFDEF UseDelphi}override;{$ENDIF}
+ {Assigns from another TPNGObject}
+ procedure AssignPNG(Source: TPNGObject);
+ {Returns if the image is empty}
+ function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF}
+ {Used with property Header}
+ function GetHeader: TChunkIHDR;
+ {Draws using partial transparency}
+ procedure DrawPartialTrans(DC: HDC; Rect: TRect);
+ {$IFDEF UseDelphi}
+ {Returns if the image is transparent}
+ function GetTransparent: Boolean; override;
+ {$ENDIF}
+ {Returns a pixel}
+ function GetPixels(const X, Y: Integer): TColor; virtual;
+ procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual;
+ public
+ {Generates alpha information}
+ procedure CreateAlpha;
+ {Removes the image transparency}
+ procedure RemoveTransparency;
+ {Transparent color}
+ property TransparentColor: TColor read GetTransparentColor write
+ SetTransparentColor;
+ {Add text chunk, TChunkTEXT, TChunkzTXT}
+ procedure AddtEXt(const Keyword, Text: String);
+ procedure AddzTXt(const Keyword, Text: String);
+ {$IFDEF UseDelphi}
+ {Saves to clipboard format (thanks to Antoine Pottern)}
+ procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
+ var APalette: HPalette); override;
+ procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
+ APalette: HPalette); override;
+ {$ENDIF}
+ {Calling errors}
+ procedure RaiseError(ExceptionClass: ExceptClass; Text: String);
+ {Returns a scanline from png}
+ property Scanline[const Index: Integer]: Pointer read GetScanline;
+ {$IFDEF Store16bits}
+ property ExtraScanline[const Index: Integer]: Pointer read GetExtraScanline;
+ {$ENDIF}
+ property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
+ {Returns pointer to the header}
+ property Header: TChunkIHDR read GetHeader;
+ {Returns the transparency mode used by this png}
+ property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
+ {Assigns from another object}
+ procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
+ {Assigns to another object}
+ procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
+ {Assigns from a windows bitmap handle}
+ procedure AssignHandle(Handle: HBitmap; Transparent: Boolean;
+ TransparentColor: ColorRef);
+ {Draws the image into a canvas}
+ procedure Draw(ACanvas: TCanvas; const Rect: TRect);
+ {$IFDEF UseDelphi}override;{$ENDIF}
+ {Width and height properties}
+ property Width: Integer read GetWidth;
+ property Height: Integer read GetHeight;
+ {Returns if the image is interlaced}
+ property InterlaceMethod: TInterlaceMethod read fInterlaceMethod
+ write fInterlaceMethod;
+ {Filters to test to encode}
+ property Filters: TFilters read fFilters write fFilters;
+ {Maximum size for IDAT chunks, default and minimum is 65536}
+ property MaxIdatSize: Cardinal read fMaxIdatSize write SetMaxIdatSize;
+ {Property to return if the image is empty or not}
+ property Empty: Boolean read GetEmpty;
+ {Compression level}
+ property CompressionLevel: TCompressionLevel read fCompressionLevel
+ write fCompressionLevel;
+ {Access to the chunk list}
+ property Chunks: TPngList read fChunkList;
+ {Object being created and destroyed}
+ constructor Create; {$IFDEF UseDelphi}override;{$ENDIF}
+ destructor Destroy; override;
+ {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{$ENDIF}
+ {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{$ENDIF}
+ procedure LoadFromStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}
+ procedure SaveToStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}
+ {Loading the image from resources}
+ procedure LoadFromResourceName(Instance: HInst; const Name: String);
+ procedure LoadFromResourceID(Instance: HInst; ResID: Integer);
+ {Access to the png pixels}
+ property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels;
+ {Palette property}
+ {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette;{$ENDIF}
+ end;
+
+ {Chunk name object}
+ TChunkName = Array[0..3] of Char;
+
+ {Global chunk object}
+ TChunk = class
+ private
+ {Contains data}
+ fData: Pointer;
+ fDataSize: Cardinal;
+ {Stores owner}
+ fOwner: TPngObject;
+ {Stores the chunk name}
+ fName: TChunkName;
+ {Returns pointer to the TChunkIHDR}
+ function GetHeader: TChunkIHDR;
+ {Used with property index}
+ function GetIndex: Integer;
+ {Should return chunk class/name}
+ class function GetName: String; virtual;
+ {Returns the chunk name}
+ function GetChunkName: String;
+ public
+ {Returns index from list}
+ property Index: Integer read GetIndex;
+ {Returns pointer to the TChunkIHDR}
+ property Header: TChunkIHDR read GetHeader;
+ {Resize the data}
+ procedure ResizeData(const NewSize: Cardinal);
+ {Returns data and size}
+ property Data: Pointer read fData;
+ property DataSize: Cardinal read fDataSize;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); virtual;
+ {Returns owner}
+ property Owner: TPngObject read fOwner;
+ {Being destroyed/created}
+ constructor Create(Owner: TPngObject); virtual;
+ destructor Destroy; override;
+ {Returns chunk class/name}
+ property Name: String read GetChunkName;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; virtual;
+ {Saves the chunk to a stream}
+ function SaveData(Stream: TStream): Boolean;
+ function SaveToStream(Stream: TStream): Boolean; virtual;
+ end;
+
+ {Chunk classes}
+ TChunkIEND = class(TChunk); {End chunk}
+
+ {IHDR data}
+ pIHDRData = ^TIHDRData;
+ TIHDRData = packed record
+ Width, Height: Cardinal;
+ BitDepth,
+ ColorType,
+ CompressionMethod,
+ FilterMethod,
+ InterlaceMethod: Byte;
+ end;
+
+ {Information header chunk}
+ TChunkIHDR = class(TChunk)
+ private
+ {Current image}
+ ImageHandle: HBitmap;
+ ImageDC: HDC;
+
+ {Output windows bitmap}
+ HasPalette: Boolean;
+ BitmapInfo: TMaxBitmapInfo;
+ BytesPerRow: Integer;
+ {Stores the image bytes}
+ {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
+ ImageData: pointer;
+ ImageAlpha: Pointer;
+
+ {Contains all the ihdr data}
+ IHDRData: TIHDRData;
+ protected
+ {Resizes the image data to fill the color type, bit depth, }
+ {width and height parameters}
+ procedure PrepareImageData;
+ {Release allocated ImageData memory}
+ procedure FreeImageData;
+ public
+ {Properties}
+ property Width: Cardinal read IHDRData.Width write IHDRData.Width;
+ property Height: Cardinal read IHDRData.Height write IHDRData.Height;
+ property BitDepth: Byte read IHDRData.BitDepth write IHDRData.BitDepth;
+ property ColorType: Byte read IHDRData.ColorType write IHDRData.ColorType;
+ property CompressionMethod: Byte read IHDRData.CompressionMethod
+ write IHDRData.CompressionMethod;
+ property FilterMethod: Byte read IHDRData.FilterMethod
+ write IHDRData.FilterMethod;
+ property InterlaceMethod: Byte read IHDRData.InterlaceMethod
+ write IHDRData.InterlaceMethod;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Destructor/constructor}
+ constructor Create(Owner: TPngObject); override;
+ destructor Destroy; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Gamma chunk}
+ TChunkgAMA = class(TChunk)
+ private
+ {Returns/sets the value for the gamma chunk}
+ function GetValue: Cardinal;
+ procedure SetValue(const Value: Cardinal);
+ public
+ {Returns/sets gamma value}
+ property Gamma: Cardinal read GetValue write SetValue;
+ {Loading the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Being created}
+ constructor Create(Owner: TPngObject); override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {ZLIB Decompression extra information}
+ TZStreamRec2 = packed record
+ {From ZLIB}
+ ZLIB: TZStreamRec;
+ {Additional info}
+ Data: Pointer;
+ fStream : TStream;
+ end;
+
+ {Palette chunk}
+ TChunkPLTE = class(TChunk)
+ private
+ {Number of items in the palette}
+ fCount: Integer;
+ {Contains the palette handle}
+ function GetPaletteItem(Index: Byte): TRGBQuad;
+ public
+ {Returns the color for each item in the palette}
+ property Item[Index: Byte]: TRGBQuad read GetPaletteItem;
+ {Returns the number of items in the palette}
+ property Count: Integer read fCount;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Transparency information}
+ TChunktRNS = class(TChunk)
+ private
+ fBitTransparency: Boolean;
+ function GetTransparentColor: ColorRef;
+ {Returns the transparent color}
+ procedure SetTransparentColor(const Value: ColorRef);
+ public
+ {Palette values for transparency}
+ PaletteValues: Array[Byte] of Byte;
+ {Returns if it uses bit transparency}
+ property BitTransparency: Boolean read fBitTransparency;
+ {Returns the transparent color}
+ property TransparentColor: ColorRef read GetTransparentColor write
+ SetTransparentColor;
+ {Loads/saves the chunk from/to a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {Actual image information}
+ TChunkIDAT = class(TChunk)
+ private
+ {Holds another pointer to the TChunkIHDR}
+ Header: TChunkIHDR;
+ {Stores temporary image width and height}
+ ImageWidth, ImageHeight: Integer;
+ {Size in bytes of each line and offset}
+ Row_Bytes, Offset : Cardinal;
+ {Contains data for the lines}
+ Encode_Buffer: Array[0..5] of pByteArray;
+ Row_Buffer: Array[Boolean] of pByteArray;
+ {Variable to invert the Row_Buffer used}
+ RowUsed: Boolean;
+ {Ending position for the current IDAT chunk}
+ EndPos: Integer;
+ {Filter the current line}
+ procedure FilterRow;
+ {Filter to encode and returns the best filter}
+ function FilterToEncode: Byte;
+ {Reads ZLIB compressed data}
+ function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
+ Count: Integer; var EndPos: Integer; var crcfile: Cardinal): Integer;
+ {Compress and writes IDAT data}
+ procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
+ const Length: Cardinal);
+ procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);
+ {Prepares the palette}
+ procedure PreparePalette;
+ protected
+ {Decode interlaced image}
+ procedure DecodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
+ {Decode non interlaced imaged}
+ procedure DecodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer;
+ var crcfile: Cardinal);
+ protected
+ {Encode non interlaced images}
+ procedure EncodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+ {Encode interlaced images}
+ procedure EncodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+ protected
+ {Memory copy methods to decode}
+ procedure CopyNonInterlacedRGB8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedRGB16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedPalette148(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedPalette2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGray2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGrayscale16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedRGBAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedRGBAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGrayscaleAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyNonInterlacedGrayscaleAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGB8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGB16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedPalette2(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGray2(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+ protected
+ {Memory copy methods to encode}
+ procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pChar);
+ procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+ public
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ end;
+
+ {Image last modification chunk}
+ TChunktIME = class(TChunk)
+ private
+ {Holds the variables}
+ fYear: Word;
+ fMonth, fDay, fHour, fMinute, fSecond: Byte;
+ public
+ {Returns/sets variables}
+ property Year: Word read fYear write fYear;
+ property Month: Byte read fMonth write fMonth;
+ property Day: Byte read fDay write fDay;
+ property Hour: Byte read fHour write fHour;
+ property Minute: Byte read fMinute write fMinute;
+ property Second: Byte read fSecond write fSecond;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ end;
+
+ {Textual data}
+ TChunktEXt = class(TChunk)
+ private
+ fKeyword, fText: String;
+ public
+ {Keyword and text}
+ property Keyword: String read fKeyword write fKeyword;
+ property Text: String read fText write fText;
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ {Assigns from another TChunk}
+ procedure Assign(Source: TChunk); override;
+ end;
+
+ {zTXT chunk}
+ TChunkzTXt = class(TChunktEXt)
+ {Loads the chunk from a stream}
+ function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean; override;
+ {Saves the chunk to a stream}
+ function SaveToStream(Stream: TStream): Boolean; override;
+ end;
+
+{Here we test if it's c++ builder or delphi version 3 or less}
+{$IFDEF VER110}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER100}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER93}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER90}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+{$IFDEF VER80}{$DEFINE DelphiBuilder3Less}{$ENDIF}
+
+
+{Registers a new chunk class}
+procedure RegisterChunk(ChunkClass: TChunkClass);
+{Calculates crc}
+function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer
+ {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
+{Invert bytes using assembly}
+function ByteSwap(const a: integer): integer;
+
+implementation
+
+var
+ ChunkClasses: TPngPointerList;
+ {Table of CRCs of all 8-bit messages}
+ crc_table: Array[0..255] of Cardinal;
+ {Flag: has the table been computed? Initially false}
+ crc_table_computed: Boolean;
+
+{Draw transparent image using transparent color}
+procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer;
+ var srcHeader: TBitmapInfoHeader;
+ srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF);
+var
+ cColor: COLORREF;
+ bmAndBack, bmAndObject, bmAndMem: HBITMAP;
+ bmBackOld, bmObjectOld, bmMemOld: HBITMAP;
+ hdcMem, hdcBack, hdcObject, hdcTemp: HDC;
+ ptSize, orgSize: TPOINT;
+ OldBitmap, DrawBitmap: HBITMAP;
+begin
+ hdcTemp := CreateCompatibleDC(dc);
+ // Select the bitmap
+ DrawBitmap := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^,
+ DIB_RGB_COLORS);
+ OldBitmap := SelectObject(hdcTemp, DrawBitmap);
+
+ // Sizes
+ OrgSize.x := abs(srcHeader.biWidth);
+ OrgSize.y := abs(srcHeader.biHeight);
+ ptSize.x := Rect.Right - Rect.Left; // Get width of bitmap
+ ptSize.y := Rect.Bottom - Rect.Top; // Get height of bitmap
+
+ // Create some DCs to hold temporary data.
+ hdcBack := CreateCompatibleDC(dc);
+ hdcObject := CreateCompatibleDC(dc);
+ hdcMem := CreateCompatibleDC(dc);
+
+ // Create a bitmap for each DC. DCs are required for a number of
+ // GDI functions.
+
+ // Monochrome DCs
+ bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
+ bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
+
+ bmAndMem := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);
+
+ // Each DC must select a bitmap object to store pixel data.
+ bmBackOld := SelectObject(hdcBack, bmAndBack);
+ bmObjectOld := SelectObject(hdcObject, bmAndObject);
+ bmMemOld := SelectObject(hdcMem, bmAndMem);
+
+ // Set the background color of the source DC to the color.
+ // contained in the parts of the bitmap that should be transparent
+ cColor := SetBkColor(hdcTemp, cTransparentColor);
+
+ // Create the object mask for the bitmap by performing a BitBlt
+ // from the source bitmap to a monochrome bitmap.
+ StretchBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
+ orgSize.x, orgSize.y, SRCCOPY);
+
+ // Set the background color of the source DC back to the original
+ // color.
+ SetBkColor(hdcTemp, cColor);
+
+ // Create the inverse of the object mask.
+ BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0,
+ NOTSRCCOPY);
+
+ // Copy the background of the main DC to the destination.
+ BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, Rect.Left, Rect.Top,
+ SRCCOPY);
+
+ // Mask out the places where the bitmap will be placed.
+ BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
+
+ // Mask out the transparent colored pixels on the bitmap.
+// BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
+ StretchBlt(hdcTemp, 0, 0, OrgSize.x, OrgSize.y, hdcBack, 0, 0,
+ PtSize.x, PtSize.y, SRCAND);
+
+ // XOR the bitmap with the background on the destination DC.
+ StretchBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
+ OrgSize.x, OrgSize.y, SRCPAINT);
+
+ // Copy the destination to the screen.
+ BitBlt(dc, Rect.Left, Rect.Top, ptSize.x, ptSize.y, hdcMem, 0, 0,
+ SRCCOPY);
+
+ // Delete the memory bitmaps.
+ DeleteObject(SelectObject(hdcBack, bmBackOld));
+ DeleteObject(SelectObject(hdcObject, bmObjectOld));
+ DeleteObject(SelectObject(hdcMem, bmMemOld));
+ DeleteObject(SelectObject(hdcTemp, OldBitmap));
+
+ // Delete the memory DCs.
+ DeleteDC(hdcMem);
+ DeleteDC(hdcBack);
+ DeleteDC(hdcObject);
+ DeleteDC(hdcTemp);
+end;
+
+{Make the table for a fast CRC.}
+procedure make_crc_table;
+var
+ c: Cardinal;
+ n, k: Integer;
+begin
+
+ {fill the crc table}
+ for n := 0 to 255 do
+ begin
+ c := Cardinal(n);
+ for k := 0 to 7 do
+ begin
+ if Boolean(c and 1) then
+ c := $edb88320 xor (c shr 1)
+ else
+ c := c shr 1;
+ end;
+ crc_table[n] := c;
+ end;
+
+ {The table has already being computated}
+ crc_table_computed := true;
+end;
+
+{Update a running CRC with the bytes buf[0..len-1]--the CRC
+ should be initialized to all 1's, and the transmitted value
+ is the 1's complement of the final running CRC (see the
+ crc() routine below)).}
+function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer
+ {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
+var
+ c: Cardinal;
+ n: Integer;
+begin
+ c := crc;
+
+ {Create the crc table in case it has not being computed yet}
+ if not crc_table_computed then make_crc_table;
+
+ {Update}
+ for n := 0 to len - 1 do
+ c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8);
+
+ {Returns}
+ Result := c;
+end;
+
+{$IFNDEF UseDelphi}
+ function FileExists(Filename: String): Boolean;
+ var
+ FindFile: THandle;
+ FindData: TWin32FindData;
+ begin
+ FindFile := FindFirstFile(PChar(Filename), FindData);
+ Result := FindFile <> INVALID_HANDLE_VALUE;
+ if Result then Windows.FindClose(FindFile);
+ end;
+
+
+{$ENDIF}
+
+{$IFNDEF UseDelphi}
+ {Exception implementation}
+ constructor Exception.Create(Msg: String);
+ begin
+ end;
+{$ENDIF}
+
+{Calculates the paeth predictor}
+function PaethPredictor(a, b, c: Byte): Byte;
+var
+ pa, pb, pc: Integer;
+begin
+ { a = left, b = above, c = upper left }
+ pa := abs(b - c); { distances to a, b, c }
+ pb := abs(a - c);
+ pc := abs(a + b - c * 2);
+
+ { return nearest of a, b, c, breaking ties in order a, b, c }
+ if (pa <= pb) and (pa <= pc) then
+ Result := a
+ else
+ if pb <= pc then
+ Result := b
+ else
+ Result := c;
+end;
+
+{Invert bytes using assembly}
+function ByteSwap(const a: integer): integer;
+asm
+ bswap eax
+end;
+function ByteSwap16(inp:word): word;
+asm
+ bswap eax
+ shr eax, 16
+end;
+
+{Calculates number of bytes for the number of pixels using the}
+{color mode in the paramenter}
+function BytesForPixels(const Pixels: Integer; const ColorType,
+ BitDepth: Byte): Integer;
+begin
+ case ColorType of
+ {Palette and grayscale contains a single value, for palette}
+ {an value of size 2^bitdepth pointing to the palette index}
+ {and grayscale the value from 0 to 2^bitdepth with color intesity}
+ COLOR_GRAYSCALE, COLOR_PALETTE:
+ Result := (Pixels * BitDepth + 7) div 8;
+ {RGB contains 3 values R, G, B with size 2^bitdepth each}
+ COLOR_RGB:
+ Result := (Pixels * BitDepth * 3) div 8;
+ {Contains one value followed by alpha value booth size 2^bitdepth}
+ COLOR_GRAYSCALEALPHA:
+ Result := (Pixels * BitDepth * 2) div 8;
+ {Contains four values size 2^bitdepth, Red, Green, Blue and alpha}
+ COLOR_RGBALPHA:
+ Result := (Pixels * BitDepth * 4) div 8;
+ else
+ Result := 0;
+ end {case ColorType}
+end;
+
+type
+ pChunkClassInfo = ^TChunkClassInfo;
+ TChunkClassInfo = record
+ ClassName: TChunkClass;
+ end;
+
+{Register a chunk type}
+procedure RegisterChunk(ChunkClass: TChunkClass);
+var
+ NewClass: pChunkClassInfo;
+begin
+ {In case the list object has not being created yet}
+ if ChunkClasses = nil then ChunkClasses := TPngPointerList.Create(nil);
+
+ {Add this new class}
+ new(NewClass);
+ NewClass^.ClassName := ChunkClass;
+ ChunkClasses.Add(NewClass);
+end;
+
+{Free chunk class list}
+procedure FreeChunkClassList;
+var
+ i: Integer;
+begin
+ if (ChunkClasses <> nil) then
+ begin
+ FOR i := 0 TO ChunkClasses.Count - 1 do
+ Dispose(pChunkClassInfo(ChunkClasses.Item[i]));
+ ChunkClasses.Free;
+ end;
+end;
+
+{Registering of common chunk classes}
+procedure RegisterCommonChunks;
+begin
+ {Important chunks}
+ RegisterChunk(TChunkIEND);
+ RegisterChunk(TChunkIHDR);
+ RegisterChunk(TChunkIDAT);
+ RegisterChunk(TChunkPLTE);
+ RegisterChunk(TChunkgAMA);
+ RegisterChunk(TChunktRNS);
+
+ {Not so important chunks}
+ RegisterChunk(TChunktIME);
+ RegisterChunk(TChunktEXt);
+ RegisterChunk(TChunkzTXt);
+end;
+
+{Creates a new chunk of this class}
+function CreateClassChunk(Owner: TPngObject; Name: TChunkName): TChunk;
+var
+ i : Integer;
+ NewChunk: TChunkClass;
+begin
+ {Looks for this chunk}
+ NewChunk := TChunk; {In case there is no registered class for this}
+
+ {Looks for this class in all registered chunks}
+ if Assigned(ChunkClasses) then
+ FOR i := 0 TO ChunkClasses.Count - 1 DO
+ begin
+ if pChunkClassInfo(ChunkClasses.Item[i])^.ClassName.GetName = Name then
+ begin
+ NewChunk := pChunkClassInfo(ChunkClasses.Item[i])^.ClassName;
+ break;
+ end;
+ end;
+
+ {Returns chunk class}
+ Result := NewChunk.Create(Owner);
+ Result.fName := Name;
+end;
+
+{ZLIB support}
+
+const
+ ZLIBAllocate = High(Word);
+
+{Initializes ZLIB for decompression}
+function ZLIBInitInflate(Stream: TStream): TZStreamRec2;
+begin
+ {Fill record}
+ Fillchar(Result, SIZEOF(TZStreamRec2), #0);
+
+ {Set internal record information}
+ with Result do
+ begin
+ GetMem(Data, ZLIBAllocate);
+ fStream := Stream;
+ end;
+
+ {Init decompression}
+ InflateInit_(Result.zlib, zlib_version, SIZEOF(TZStreamRec));
+end;
+
+{Initializes ZLIB for compression}
+function ZLIBInitDeflate(Stream: TStream;
+ Level: TCompressionlevel; Size: Cardinal): TZStreamRec2;
+begin
+ {Fill record}
+ Fillchar(Result, SIZEOF(TZStreamRec2), #0);
+
+ {Set internal record information}
+ with Result, ZLIB do
+ begin
+ GetMem(Data, Size);
+ fStream := Stream;
+ next_out := Data;
+ avail_out := Size;
+ end;
+
+ {Inits compression}
+ deflateInit_(Result.zlib, Level, zlib_version, sizeof(TZStreamRec));
+end;
+
+{Terminates ZLIB for compression}
+procedure ZLIBTerminateDeflate(var ZLIBStream: TZStreamRec2);
+begin
+ {Terminates decompression}
+ DeflateEnd(ZLIBStream.zlib);
+ {Free internal record}
+ FreeMem(ZLIBStream.Data, ZLIBAllocate);
+end;
+
+{Terminates ZLIB for decompression}
+procedure ZLIBTerminateInflate(var ZLIBStream: TZStreamRec2);
+begin
+ {Terminates decompression}
+ InflateEnd(ZLIBStream.zlib);
+ {Free internal record}
+ FreeMem(ZLIBStream.Data, ZLIBAllocate);
+end;
+
+{Decompresses ZLIB into a memory address}
+function DecompressZLIB(const Input: Pointer; InputSize: Integer;
+ var Output: Pointer; var OutputSize: Integer;
+ var ErrorOutput: String): Boolean;
+var
+ StreamRec : TZStreamRec;
+ Buffer : Array[Byte] of Byte;
+ InflateRet: Integer;
+begin
+ with StreamRec do
+ begin
+ {Initializes}
+ Result := True;
+ OutputSize := 0;
+
+ {Prepares the data to decompress}
+ FillChar(StreamRec, SizeOf(TZStreamRec), #0);
+ InflateInit_(StreamRec, zlib_version, SIZEOF(TZStreamRec));
+ next_in := Input;
+ avail_in := InputSize;
+
+ {Decodes data}
+ repeat
+ {In case it needs an output buffer}
+ if (avail_out = 0) then
+ begin
+ next_out := @Buffer;
+ avail_out := SizeOf(Buffer);
+ end {if (avail_out = 0)};
+
+ {Decompress and put in output}
+ InflateRet := inflate(StreamRec, 0);
+ if (InflateRet = Z_STREAM_END) or (InflateRet = 0) then
+ begin
+ {Reallocates output buffer}
+ inc(OutputSize, total_out);
+ if Output = nil then
+ GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
+ {Copies the new data}
+ CopyMemory(pointer(Longint(Output) + OutputSize - total_out), @Buffer, total_out);
+ end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
+ {Now tests for errors}
+ else if InflateRet < 0 then
+ begin
+ Result := False;
+ ErrorOutput := StreamRec.msg;
+ InflateEnd(StreamRec);
+ Exit;
+ end {if InflateRet < 0}
+ until InflateRet = Z_STREAM_END;
+
+ {Terminates decompression}
+ InflateEnd(StreamRec);
+ end {with StreamRec}
+
+end;
+
+{Compresses ZLIB into a memory address}
+function CompressZLIB(Input: Pointer; InputSize, CompressionLevel: Integer;
+ var Output: Pointer; var OutputSize: Integer;
+ var ErrorOutput: String): Boolean;
+var
+ StreamRec : TZStreamRec;
+ Buffer : Array[Byte] of Byte;
+ DeflateRet: Integer;
+begin
+ with StreamRec do
+ begin
+ Result := True; {By default returns TRUE as everything might have gone ok}
+ OutputSize := 0; {Initialize}
+ {Prepares the data to compress}
+ FillChar(StreamRec, SizeOf(TZStreamRec), #0);
+ DeflateInit_(StreamRec, CompressionLevel,zlib_version, SIZEOF(TZStreamRec));
+
+ next_in := Input;
+ avail_in := InputSize;
+
+ while avail_in > 0 do
+ begin
+ {When it needs new buffer to stores the compressed data}
+ if avail_out = 0 then
+ begin
+ {Restore buffer}
+ next_out := @Buffer;
+ avail_out := SizeOf(Buffer);
+ end {if avail_out = 0};
+
+ {Compresses}
+ DeflateRet := deflate(StreamRec, Z_FINISH);
+
+ if (DeflateRet = Z_STREAM_END) or (DeflateRet = 0) then
+ begin
+ {Updates the output memory}
+ inc(OutputSize, total_out);
+ if Output = nil then
+ GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
+
+ {Copies the new data}
+ CopyMemory(Pointer(Longint(Output) + OutputSize - total_out), @Buffer, total_out);
+ end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
+ {Now tests for errors}
+ else if DeflateRet < 0 then
+ begin
+ Result := False;
+ ErrorOutput := StreamRec.msg;
+ DeflateEnd(StreamRec);
+ Exit;
+ end {if InflateRet < 0}
+
+ end {while avail_in > 0};
+
+ {Finishes compressing}
+ DeflateEnd(StreamRec);
+ end {with StreamRec}
+
+end;
+
+{TPngPointerList implementation}
+
+{Object being created}
+constructor TPngPointerList.Create(AOwner: TPNGObject);
+begin
+ inherited Create; {Let ancestor work}
+ {Holds owner}
+ fOwner := AOwner;
+ {Memory pointer not being used yet}
+ fMemory := nil;
+ {No items yet}
+ fCount := 0;
+end;
+
+{Removes value from the list}
+function TPngPointerList.Remove(Value: Pointer): Pointer;
+var
+ I, Position: Integer;
+begin
+ {Gets item position}
+ Position := -1;
+ FOR I := 0 TO Count - 1 DO
+ if Value = Item[I] then Position := I;
+ {In case a match was found}
+ if Position >= 0 then
+ begin
+ Result := Item[Position]; {Returns pointer}
+ {Remove item and move memory}
+ Dec(fCount);
+ if Position < Integer(FCount) then
+ System.Move(fMemory^[Position + 1], fMemory^[Position],
+ (Integer(fCount) - Position) * SizeOf(Pointer));
+ end {if Position >= 0} else Result := nil
+end;
+
+{Add a new value in the list}
+procedure TPngPointerList.Add(Value: Pointer);
+begin
+ Count := Count + 1;
+ Item[Count - 1] := Value;
+end;
+
+
+{Object being destroyed}
+destructor TPngPointerList.Destroy;
+begin
+ {Release memory if needed}
+ if fMemory <> nil then
+ FreeMem(fMemory, fCount * sizeof(Pointer));
+
+ {Free things}
+ inherited Destroy;
+end;
+
+{Returns one item from the list}
+function TPngPointerList.GetItem(Index: Cardinal): Pointer;
+begin
+ if (Index <= Count - 1) then
+ Result := fMemory[Index]
+ else
+ {In case it's out of bounds}
+ Result := nil;
+end;
+
+{Inserts a new item in the list}
+procedure TPngPointerList.Insert(Value: Pointer; Position: Cardinal);
+begin
+ if (Position < Count) then
+ begin
+ {Increase item count}
+ SetSize(Count + 1);
+ {Move other pointers}
+ if Position < Count then
+ System.Move(fMemory^[Position], fMemory^[Position + 1],
+ (Count - Position - 1) * SizeOf(Pointer));
+ {Sets item}
+ Item[Position] := Value;
+ end;
+end;
+
+{Sets one item from the list}
+procedure TPngPointerList.SetItem(Index: Cardinal; const Value: Pointer);
+begin
+ {If index is in bounds, set value}
+ if (Index <= Count - 1) then
+ fMemory[Index] := Value
+end;
+
+{This method resizes the list}
+procedure TPngPointerList.SetSize(const Size: Cardinal);
+begin
+ {Sets the size}
+ if (fMemory = nil) and (Size > 0) then
+ GetMem(fMemory, Size * SIZEOF(Pointer))
+ else
+ if Size > 0 then {Only realloc if the new size is greater than 0}
+ ReallocMem(fMemory, Size * SIZEOF(Pointer))
+ else
+ {In case user is resize to 0 items}
+ begin
+ FreeMem(fMemory);
+ fMemory := nil;
+ end;
+ {Update count}
+ fCount := Size;
+end;
+
+{TPNGList implementation}
+
+{Removes an item}
+procedure TPNGList.RemoveChunk(Chunk: TChunk);
+begin
+ Remove(Chunk);
+ Chunk.Free
+end;
+
+{Add a new item}
+function TPNGList.Add(ChunkClass: TChunkClass): TChunk;
+var
+ IHDR: TChunkIHDR;
+ IEND: TChunkIEND;
+
+ IDAT: TChunkIDAT;
+ PLTE: TChunkPLTE;
+begin
+ Result := nil; {Default result}
+ {Adding these is not allowed}
+ if (ChunkClass = TChunkIHDR) or (ChunkClass = TChunkIDAT) or
+ (ChunkClass = TChunkPLTE) or (ChunkClass = TChunkIEND) then
+ fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
+ {Two of these is not allowed}
+ else if ((ChunkClass = TChunkgAMA) and (ItemFromClass(TChunkgAMA) <> nil)) or
+ ((ChunkClass = TChunktRNS) and (ItemFromClass(TChunktRNS) <> nil)) then
+ fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
+ {There must have an IEND and IHDR chunk}
+ else if (ItemFromClass(TChunkIEND) = nil) or
+ (ItemFromClass(TChunkIHDR) = nil) then
+ fOwner.RaiseError(EPngError, EPNGCannotAddInvalidImageText)
+ else
+ begin
+ {Get common chunks}
+ IHDR := ItemFromClass(TChunkIHDR) as TChunkIHDR;
+ IEND := ItemFromClass(TChunkIEND) as TChunkIEND;
+ {Create new chunk}
+ Result := ChunkClass.Create(Owner);
+ {Add to the list}
+ if (ChunkClass = TChunkgAMA) then
+ Insert(Result, IHDR.Index + 1)
+ {Transparency chunk (fix by Ian Boyd)}
+ else if (ChunkClass = TChunktRNS) then
+ begin
+ {Transparecy chunk must be after PLTE; before IDAT}
+ IDAT := ItemFromClass(TChunkIDAT) as TChunkIDAT;
+ PLTE := ItemFromClass(TChunkPLTE) as TChunkPLTE;
+
+ if Assigned(PLTE) then
+ Insert(Result, PLTE.Index + 1)
+ else if Assigned(IDAT) then
+ Insert(Result, IDAT.Index)
+ else
+ Insert(Result, IHDR.Index + 1)
+ end
+ else {All other chunks}
+ Insert(Result, IEND.Index);
+ end {if}
+end;
+
+{Returns item from the list}
+function TPNGList.GetItem(Index: Cardinal): TChunk;
+begin
+ Result := inherited GetItem(Index);
+end;
+
+{Returns first item from the list using the class from parameter}
+function TPNGList.ItemFromClass(ChunkClass: TChunkClass): TChunk;
+var
+ i: Integer;
+begin
+ Result := nil; {Initial result}
+ FOR i := 0 TO Count - 1 DO
+ {Test if this item has the same class}
+ if Item[i] is ChunkClass then
+ begin
+ {Returns this item and exit}
+ Result := Item[i];
+ break;
+ end {if}
+end;
+
+{$IFNDEF UseDelphi}
+
+ {TStream implementation}
+
+ {Copies all from another stream}
+ function TStream.CopyFrom(Source: TStream; Count: Cardinal): Cardinal;
+ const
+ MaxBytes = $f000;
+ var
+ Buffer: PChar;
+ BufSize, N: Cardinal;
+ begin
+ {If count is zero, copy everything from Source}
+ if Count = 0 then
+ begin
+ Source.Seek(0, soFromBeginning);
+ Count := Source.Size;
+ end;
+
+ Result := Count; {Returns the number of bytes readed}
+ {Allocates memory}
+ if Count > MaxBytes then BufSize := MaxBytes else BufSize := Count;
+ GetMem(Buffer, BufSize);
+
+ {Copy memory}
+ while Count > 0 do
+ begin
+ if Count > BufSize then N := BufSize else N := Count;
+ Source.Read(Buffer^, N);
+ Write(Buffer^, N);
+ dec(Count, N);
+ end;
+
+ {Deallocates memory}
+ FreeMem(Buffer, BufSize);
+ end;
+
+{Set current stream position}
+procedure TStream.SetPosition(const Value: Longint);
+begin
+ Seek(Value, soFromBeginning);
+end;
+
+{Returns position}
+function TStream.GetPosition: Longint;
+begin
+ Result := Seek(0, soFromCurrent);
+end;
+
+ {Returns stream size}
+function TStream.GetSize: Longint;
+ var
+ Pos: Cardinal;
+ begin
+ Pos := Seek(0, soFromCurrent);
+ Result := Seek(0, soFromEnd);
+ Seek(Pos, soFromCurrent);
+ end;
+
+ {TFileStream implementation}
+
+ {Filestream object being created}
+ constructor TFileStream.Create(Filename: String; Mode: TFileStreamModeSet);
+ {Makes file mode}
+ function OpenMode: DWORD;
+ begin
+ Result := 0;
+ if fsmRead in Mode then Result := GENERIC_READ;
+ if (fsmWrite in Mode) or (fsmCreate in Mode) then
+ Result := Result OR GENERIC_WRITE;
+ end;
+ const
+ IsCreate: Array[Boolean] of Integer = (OPEN_ALWAYS, CREATE_ALWAYS);
+ begin
+ {Call ancestor}
+ inherited Create;
+
+ {Create handle}
+ fHandle := CreateFile(PChar(Filename), OpenMode, FILE_SHARE_READ or
+ FILE_SHARE_WRITE, nil, IsCreate[fsmCreate in Mode], 0, 0);
+ {Store mode}
+ FileMode := Mode;
+ end;
+
+ {Filestream object being destroyed}
+ destructor TFileStream.Destroy;
+ begin
+ {Terminates file and close}
+ if FileMode = [fsmWrite] then
+ SetEndOfFile(fHandle);
+ CloseHandle(fHandle);
+
+ {Call ancestor}
+ inherited Destroy;
+ end;
+
+ {Writes data to the file}
+ function TFileStream.Write(const Buffer; Count: Longint): Cardinal;
+ begin
+ if not WriteFile(fHandle, Buffer, Count, Result, nil) then
+ Result := 0;
+ end;
+
+ {Reads data from the file}
+ function TFileStream.Read(var Buffer; Count: Longint): Cardinal;
+ begin
+ if not ReadFile(fHandle, Buffer, Count, Result, nil) then
+ Result := 0;
+ end;
+
+ {Seeks the file position}
+ function TFileStream.Seek(Offset: Integer; Origin: Word): Longint;
+ begin
+ Result := SetFilePointer(fHandle, Offset, nil, Origin);
+ end;
+
+ {Sets the size of the file}
+ procedure TFileStream.SetSize(const Value: Longint);
+ begin
+ Seek(Value, soFromBeginning);
+ SetEndOfFile(fHandle);
+ end;
+
+ {TResourceStream implementation}
+
+ {Creates the resource stream}
+ constructor TResourceStream.Create(Instance: HInst; const ResName: String;
+ ResType: PChar);
+ var
+ ResID: HRSRC;
+ ResGlobal: HGlobal;
+ begin
+ {Obtains the resource ID}
+ ResID := FindResource(hInstance, PChar(ResName), RT_RCDATA);
+ if ResID = 0 then raise EPNGError.Create('');
+ {Obtains memory and size}
+ ResGlobal := LoadResource(hInstance, ResID);
+ Size := SizeOfResource(hInstance, ResID);
+ Memory := LockResource(ResGlobal);
+ if (ResGlobal = 0) or (Memory = nil) then EPNGError.Create('');
+ end;
+
+
+ {Setting resource stream size is not supported}
+ procedure TResourceStream.SetSize(const Value: Integer);
+ begin
+ end;
+
+ {Writing into a resource stream is not supported}
+ function TResourceStream.Write(const Buffer; Count: Integer): Cardinal;
+ begin
+ Result := 0;
+ end;
+
+ {Reads data from the stream}
+ function TResourceStream.Read(var Buffer; Count: Integer): Cardinal;
+ begin
+ //Returns data
+ CopyMemory(@Buffer, pointer(Longint(Memory) + Position), Count);
+ //Update position
+ inc(Position, Count);
+ //Returns
+ Result := Count;
+ end;
+
+ {Seeks data}
+ function TResourceStream.Seek(Offset: Integer; Origin: Word): Longint;
+ begin
+ {Move depending on the origin}
+ case Origin of
+ soFromBeginning: Position := Offset;
+ soFromCurrent: inc(Position, Offset);
+ soFromEnd: Position := Size + Offset;
+ end;
+
+ {Returns the current position}
+ Result := Position;
+ end;
+
+{$ENDIF}
+
+{TChunk implementation}
+
+{Resizes the data}
+procedure TChunk.ResizeData(const NewSize: Cardinal);
+begin
+ fDataSize := NewSize;
+ ReallocMem(fData, NewSize + 1);
+end;
+
+{Returns index from list}
+function TChunk.GetIndex: Integer;
+var
+ i: Integer;
+begin
+ Result := -1; {Avoiding warnings}
+ {Searches in the list}
+ FOR i := 0 TO Owner.Chunks.Count - 1 DO
+ if Owner.Chunks.Item[i] = Self then
+ begin
+ {Found match}
+ Result := i;
+ exit;
+ end {for i}
+end;
+
+{Returns pointer to the TChunkIHDR}
+function TChunk.GetHeader: TChunkIHDR;
+begin
+ Result := Owner.Chunks.Item[0] as TChunkIHDR;
+end;
+
+{Assigns from another TChunk}
+procedure TChunk.Assign(Source: TChunk);
+begin
+ {Copy properties}
+ fName := Source.fName;
+ {Set data size and realloc}
+ ResizeData(Source.fDataSize);
+
+ {Copy data (if there's any)}
+ if fDataSize > 0 then CopyMemory(fData, Source.fData, fDataSize);
+end;
+
+{Chunk being created}
+constructor TChunk.Create(Owner: TPngObject);
+var
+ ChunkName: String;
+begin
+ {Ancestor create}
+ inherited Create;
+
+ {If it's a registered class, set the chunk name based on the class}
+ {name. For instance, if the class name is TChunkgAMA, the GAMA part}
+ {will become the chunk name}
+ ChunkName := Copy(ClassName, Length('TChunk') + 1, Length(ClassName));
+ if Length(ChunkName) = 4 then CopyMemory(@fName[0], @ChunkName[1], 4);
+
+ {Initialize data holder}
+ GetMem(fData, 1);
+ fDataSize := 0;
+ {Record owner}
+ fOwner := Owner;
+end;
+
+{Chunk being destroyed}
+destructor TChunk.Destroy;
+begin
+ {Free data holder}
+ FreeMem(fData, fDataSize + 1);
+ {Let ancestor destroy}
+ inherited Destroy;
+end;
+
+{Returns the chunk name 1}
+function TChunk.GetChunkName: String;
+begin
+ Result := fName
+end;
+
+{Returns the chunk name 2}
+class function TChunk.GetName: String;
+begin
+ {For avoid writing GetName for each TChunk descendent, by default for}
+ {classes which don't declare GetName, it will look for the class name}
+ {to extract the chunk kind. Example, if the class name is TChunkIEND }
+ {this method extracts and returns IEND}
+ Result := Copy(ClassName, Length('TChunk') + 1, Length(ClassName));
+end;
+
+{Saves the data to the stream}
+function TChunk.SaveData(Stream: TStream): Boolean;
+var
+ ChunkSize, ChunkCRC: Cardinal;
+begin
+ {First, write the size for the following data in the chunk}
+ ChunkSize := ByteSwap(DataSize);
+ Stream.Write(ChunkSize, 4);
+ {The chunk name}
+ Stream.Write(fName, 4);
+ {If there is data for the chunk, write it}
+ if DataSize > 0 then Stream.Write(Data^, DataSize);
+ {Calculates and write CRC}
+ ChunkCRC := update_crc($ffffffff, @fName[0], 4);
+ ChunkCRC := Byteswap(update_crc(ChunkCRC, Data, DataSize) xor $ffffffff);
+ Stream.Write(ChunkCRC, 4);
+
+ {Returns that everything went ok}
+ Result := TRUE;
+end;
+
+{Saves the chunk to the stream}
+function TChunk.SaveToStream(Stream: TStream): Boolean;
+begin
+ Result := SaveData(Stream)
+end;
+
+
+{Loads the chunk from a stream}
+function TChunk.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+var
+ CheckCRC: Cardinal;
+ {$IFDEF CheckCRC}RightCRC: Cardinal;{$ENDIF}
+begin
+ {Copies data from source}
+ ResizeData(Size);
+ if Size > 0 then Stream.Read(fData^, Size);
+ {Reads CRC}
+ Stream.Read(CheckCRC, 4);
+ CheckCrc := ByteSwap(CheckCRC);
+
+ {Check if crc readed is valid}
+ {$IFDEF CheckCRC}
+ RightCRC := update_crc($ffffffff, @ChunkName[0], 4);
+ RightCRC := update_crc(RightCRC, fData, Size) xor $ffffffff;
+ Result := RightCRC = CheckCrc;
+
+ {Handle CRC error}
+ if not Result then
+ begin
+ {In case it coult not load chunk}
+ Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText);
+ exit;
+ end
+ {$ELSE}Result := TRUE; {$ENDIF}
+
+end;
+
+{TChunktIME implementation}
+
+{Chunk being loaded from a stream}
+function TChunktIME.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+begin
+ {Let ancestor load the data}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result or (Size <> 7) then exit; {Size must be 7}
+
+ {Reads data}
+ fYear := ((pByte(Longint(Data) )^) * 256)+ (pByte(Longint(Data) + 1)^);
+ fMonth := pByte(Longint(Data) + 2)^;
+ fDay := pByte(Longint(Data) + 3)^;
+ fHour := pByte(Longint(Data) + 4)^;
+ fMinute := pByte(Longint(Data) + 5)^;
+ fSecond := pByte(Longint(Data) + 6)^;
+end;
+
+{Saving the chunk to a stream}
+function TChunktIME.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Update data}
+ ResizeData(7); {Make sure the size is 7}
+ pWord(Data)^ := Year;
+ pByte(Longint(Data) + 2)^ := Month;
+ pByte(Longint(Data) + 3)^ := Day;
+ pByte(Longint(Data) + 4)^ := Hour;
+ pByte(Longint(Data) + 5)^ := Minute;
+ pByte(Longint(Data) + 6)^ := Second;
+
+ {Let inherited save data}
+ Result := inherited SaveToStream(Stream);
+end;
+
+{TChunkztXt implementation}
+
+{Loading the chunk from a stream}
+function TChunkzTXt.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+var
+ ErrorOutput: String;
+ CompressionMethod: Byte;
+ Output: Pointer;
+ OutputSize: Integer;
+begin
+ {Load data from stream and validate}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result or (Size < 4) then exit;
+ fKeyword := PChar(Data); {Get keyword and compression method bellow}
+ CompressionMethod := pByte(Longint(fKeyword) + Length(fKeyword))^;
+ fText := '';
+
+ {In case the compression is 0 (only one accepted by specs), reads it}
+ if CompressionMethod = 0 then
+ begin
+ Output := nil;
+ if DecompressZLIB(PChar(Longint(Data) + Length(fKeyword) + 2),
+ Size - Length(fKeyword) - 2, Output, OutputSize, ErrorOutput) then
+ begin
+ SetLength(fText, OutputSize);
+ CopyMemory(@fText[1], Output, OutputSize);
+ end {if DecompressZLIB(...};
+ FreeMem(Output);
+ end {if CompressionMethod = 0}
+
+end;
+
+{Saving the chunk to a stream}
+function TChunkztXt.SaveToStream(Stream: TStream): Boolean;
+var
+ Output: Pointer;
+ OutputSize: Integer;
+ ErrorOutput: String;
+begin
+ Output := nil; {Initializes output}
+ if fText = '' then fText := ' ';
+
+ {Compresses the data}
+ if CompressZLIB(@fText[1], Length(fText), Owner.CompressionLevel, Output,
+ OutputSize, ErrorOutput) then
+ begin
+ {Size is length from keyword, plus a null character to divide}
+ {plus the compression method, plus the length of the text (zlib compressed)}
+ ResizeData(Length(fKeyword) + 2 + OutputSize);
+
+ Fillchar(Data^, DataSize, #0);
+ {Copies the keyword data}
+ if Keyword <> '' then
+ CopyMemory(Data, @fKeyword[1], Length(Keyword));
+ {Compression method 0 (inflate/deflate)}
+ pByte(pointer(Longint(Data) + Length(Keyword) + 1))^ := 0;
+ if OutputSize > 0 then
+ CopyMemory(pointer(Longint(Data) + Length(Keyword) + 2), Output, OutputSize);
+
+ {Let ancestor calculate crc and save}
+ Result := SaveData(Stream);
+ end {if CompressZLIB(...} else Result := False;
+
+ {Frees output}
+ if Output <> nil then FreeMem(Output)
+end;
+
+{TChunktEXt implementation}
+
+{Assigns from another text chunk}
+procedure TChunktEXt.Assign(Source: TChunk);
+begin
+ fKeyword := TChunktEXt(Source).fKeyword;
+ fText := TChunktEXt(Source).fText;
+end;
+
+{Loading the chunk from a stream}
+function TChunktEXt.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+begin
+ {Load data from stream and validate}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result or (Size < 3) then exit;
+ {Get text}
+ fKeyword := PChar(Data);
+ SetLength(fText, Size - Length(fKeyword) - 1);
+ CopyMemory(@fText[1], pointer(Longint(Data) + Length(fKeyword) + 1), Length(fText));
+end;
+
+{Saving the chunk to a stream}
+function TChunktEXt.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Size is length from keyword, plus a null character to divide}
+ {plus the length of the text}
+ ResizeData(Length(fKeyword) + 1 + Length(fText));
+ Fillchar(Data^, DataSize, #0);
+ {Copy data}
+ if Keyword <> '' then
+ CopyMemory(Data, @fKeyword[1], Length(Keyword));
+ if Text <> '' then
+ CopyMemory(pointer(Longint(Data) + Length(Keyword) + 1), @fText[1], Length(Text));
+ {Let ancestor calculate crc and save}
+ Result := inherited SaveToStream(Stream);
+end;
+
+
+{TChunkIHDR implementation}
+
+{Chunk being created}
+constructor TChunkIHDR.Create(Owner: TPngObject);
+begin
+ {Call inherited}
+ inherited Create(Owner);
+ {Prepare pointers}
+ ImageHandle := 0;
+ ImageDC := 0;
+end;
+
+{Chunk being destroyed}
+destructor TChunkIHDR.Destroy;
+begin
+ {Free memory}
+ FreeImageData();
+
+ {Calls TChunk destroy}
+ inherited Destroy;
+end;
+
+{Assigns from another IHDR chunk}
+procedure TChunkIHDR.Assign(Source: TChunk);
+begin
+ {Copy the IHDR data}
+ if Source is TChunkIHDR then
+ begin
+ {Copy IHDR values}
+ IHDRData := TChunkIHDR(Source).IHDRData;
+
+ {Prepare to hold data by filling BitmapInfo structure and}
+ {resizing ImageData and ImageAlpha memory allocations}
+ PrepareImageData();
+
+ {Copy image data}
+ CopyMemory(ImageData, TChunkIHDR(Source).ImageData,
+ BytesPerRow * Integer(Height));
+ CopyMemory(ImageAlpha, TChunkIHDR(Source).ImageAlpha,
+ Integer(Width) * Integer(Height));
+
+ {Copy palette colors}
+ BitmapInfo.bmiColors := TChunkIHDR(Source).BitmapInfo.bmiColors;
+ end
+ else
+ Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
+end;
+
+{Release allocated image data}
+procedure TChunkIHDR.FreeImageData;
+begin
+ {Free old image data}
+ if ImageHandle <> 0 then DeleteObject(ImageHandle);
+ if ImageDC <> 0 then DeleteDC(ImageDC);
+ if ImageAlpha <> nil then FreeMem(ImageAlpha);
+ {$IFDEF Store16bits}
+ if ExtraImageData <> nil then FreeMem(ExtraImageData);
+ {$ENDIF}
+ ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := nil;
+end;
+
+{Chunk being loaded from a stream}
+function TChunkIHDR.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+begin
+ {Let TChunk load it}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result then Exit;
+
+ {Now check values}
+ {Note: It's recommended by png specification to make sure that the size}
+ {must be 13 bytes to be valid, but some images with 14 bytes were found}
+ {which could be loaded by internet explorer and other tools}
+ if (fDataSize < SIZEOF(TIHdrData)) then
+ begin
+ {Ihdr must always have at least 13 bytes}
+ Result := False;
+ Owner.RaiseError(EPNGInvalidIHDR, EPNGInvalidIHDRText);
+ exit;
+ end;
+
+ {Everything ok, reads IHDR}
+ IHDRData := pIHDRData(fData)^;
+ IHDRData.Width := ByteSwap(IHDRData.Width);
+ IHDRData.Height := ByteSwap(IHDRData.Height);
+
+ {The width and height must not be larger than 65535 pixels}
+ if (IHDRData.Width > High(Word)) or (IHDRData.Height > High(Word)) then
+ begin
+ Result := False;
+ Owner.RaiseError(EPNGSizeExceeds, EPNGSizeExceedsText);
+ exit;
+ end {if IHDRData.Width > High(Word)};
+ {Compression method must be 0 (inflate/deflate)}
+ if (IHDRData.CompressionMethod <> 0) then
+ begin
+ Result := False;
+ Owner.RaiseError(EPNGUnknownCompression, EPNGUnknownCompressionText);
+ exit;
+ end;
+ {Interlace must be either 0 (none) or 7 (adam7)}
+ if (IHDRData.InterlaceMethod <> 0) and (IHDRData.InterlaceMethod <> 1) then
+ begin
+ Result := False;
+ Owner.RaiseError(EPNGUnknownInterlace, EPNGUnknownInterlaceText);
+ exit;
+ end;
+
+ {Updates owner properties}
+ Owner.InterlaceMethod := TInterlaceMethod(IHDRData.InterlaceMethod);
+
+ {Prepares data to hold image}
+ PrepareImageData();
+end;
+
+{Saving the IHDR chunk to a stream}
+function TChunkIHDR.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Ignore 2 bits images}
+ if BitDepth = 2 then BitDepth := 4;
+
+ {It needs to do is update the data with the IHDR data}
+ {structure containing the write values}
+ ResizeData(SizeOf(TIHDRData));
+ pIHDRData(fData)^ := IHDRData;
+ {..byteswap 4 byte types}
+ pIHDRData(fData)^.Width := ByteSwap(pIHDRData(fData)^.Width);
+ pIHDRData(fData)^.Height := ByteSwap(pIHDRData(fData)^.Height);
+ {..update interlace method}
+ pIHDRData(fData)^.InterlaceMethod := Byte(Owner.InterlaceMethod);
+ {..and then let the ancestor SaveToStream do the hard work}
+ Result := inherited SaveToStream(Stream);
+end;
+
+{Resizes the image data to fill the color type, bit depth, }
+{width and height parameters}
+procedure TChunkIHDR.PrepareImageData();
+
+ {Set the bitmap info}
+ procedure SetInfo(const Bitdepth: Integer; const Palette: Boolean);
+ begin
+
+ {Copy if the bitmap contain palette entries}
+ HasPalette := Palette;
+ {Initialize the structure with zeros}
+ fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
+ {Fill the strucutre}
+ with BitmapInfo.bmiHeader do
+ begin
+ biSize := sizeof(TBitmapInfoHeader);
+ biHeight := Height;
+ biWidth := Width;
+ biPlanes := 1;
+ biBitCount := BitDepth;
+ biCompression := BI_RGB;
+ end {with BitmapInfo.bmiHeader}
+ end;
+begin
+ {Prepare bitmap info header}
+ Fillchar(BitmapInfo, sizeof(TMaxBitmapInfo), #0);
+ {Release old image data}
+ FreeImageData();
+
+ {Obtain number of bits for each pixel}
+ case ColorType of
+ COLOR_GRAYSCALE, COLOR_PALETTE, COLOR_GRAYSCALEALPHA:
+ case BitDepth of
+ {These are supported by windows}
+ 1, 4, 8: SetInfo(BitDepth, TRUE);
+ {2 bits for each pixel is not supported by windows bitmap}
+ 2 : SetInfo(4, TRUE);
+ {Also 16 bits (2 bytes) for each pixel is not supported}
+ {and should be transormed into a 8 bit grayscale}
+ 16 : SetInfo(8, TRUE);
+ end;
+ {Only 1 byte (8 bits) is supported}
+ COLOR_RGB, COLOR_RGBALPHA: SetInfo(24, FALSE);
+ end {case ColorType};
+ {Number of bytes for each scanline}
+ BytesPerRow := (((BitmapInfo.bmiHeader.biBitCount * Width) + 31)
+ and not 31) div 8;
+
+ {Build array for alpha information, if necessary}
+ if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
+ begin
+ GetMem(ImageAlpha, Integer(Width) * Integer(Height));
+ FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #0);
+ end;
+
+ {Build array for extra byte information}
+ {$IFDEF Store16bits}
+ if (BitDepth = 16) then
+ begin
+ GetMem(ExtraImageData, BytesPerRow * Integer(Height));
+ FillChar(ExtraImageData^, BytesPerRow * Integer(Height), #0);
+ end;
+ {$ENDIF}
+
+ {Creates the image to hold the data, CreateDIBSection does a better}
+ {work in allocating necessary memory}
+ ImageDC := CreateCompatibleDC(0);
+ ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^,
+ DIB_RGB_COLORS, ImageData, 0, 0);
+
+ {Clears the old palette (if any)}
+ with Owner do
+ if TempPalette <> 0 then
+ begin
+ DeleteObject(TempPalette);
+ TempPalette := 0;
+ end {with Owner, if TempPalette <> 0};
+
+ {Build array and allocate bytes for each row}
+ zeromemory(ImageData, BytesPerRow * Integer(Height));
+end;
+
+{TChunktRNS implementation}
+
+{$IFNDEF UseDelphi}
+function CompareMem(P1, P2: pByte; const Size: Integer): Boolean;
+var i: Integer;
+begin
+ Result := True;
+ for i := 1 to Size do
+ begin
+ if P1^ <> P2^ then Result := False;
+ inc(P1); inc(P2);
+ end {for i}
+end;
+{$ENDIF}
+
+{Sets the transpararent color}
+procedure TChunktRNS.SetTransparentColor(const Value: ColorRef);
+var
+ i: Byte;
+ LookColor: TRGBQuad;
+begin
+ {Clears the palette values}
+ Fillchar(PaletteValues, SizeOf(PaletteValues), #0);
+ {Sets that it uses bit transparency}
+ fBitTransparency := True;
+
+
+ {Depends on the color type}
+ with Header do
+ case ColorType of
+ COLOR_GRAYSCALE:
+ begin
+ Self.ResizeData(2);
+ pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
+ end;
+ COLOR_RGB:
+ begin
+ Self.ResizeData(6);
+ pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
+ pWord(@PaletteValues[2])^ := ByteSwap16(GetGValue(Value));
+ pWord(@PaletteValues[4])^ := ByteSwap16(GetBValue(Value));
+ end;
+ COLOR_PALETTE:
+ begin
+ {Creates a RGBQuad to search for the color}
+ LookColor.rgbRed := GetRValue(Value);
+ LookColor.rgbGreen := GetGValue(Value);
+ LookColor.rgbBlue := GetBValue(Value);
+ {Look in the table for the entry}
+ for i := 0 to 255 do
+ if CompareMem(@BitmapInfo.bmiColors[i], @LookColor, 3) then
+ Break;
+ {Fill the transparency table}
+ Fillchar(PaletteValues, i, 255);
+ Self.ResizeData(i + 1)
+
+ end
+ end {case / with};
+
+end;
+
+{Returns the transparent color for the image}
+function TChunktRNS.GetTransparentColor: ColorRef;
+var
+ PaletteChunk: TChunkPLTE;
+ i: Integer;
+begin
+ Result := 0; {Default: Unknown transparent color}
+
+ {Depends on the color type}
+ with Header do
+ case ColorType of
+ COLOR_GRAYSCALE:
+ Result := RGB(PaletteValues[0], PaletteValues[0],
+ PaletteValues[0]);
+ COLOR_RGB:
+ Result := RGB(PaletteValues[1], PaletteValues[3], PaletteValues[5]);
+ COLOR_PALETTE:
+ begin
+ {Obtains the palette chunk}
+ PaletteChunk := Owner.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
+
+ {Looks for an entry with 0 transparency meaning that it is the}
+ {full transparent entry}
+ for i := 0 to Self.DataSize - 1 do
+ if PaletteValues[i] = 0 then
+ with PaletteChunk.GetPaletteItem(i) do
+ begin
+ Result := RGB(rgbRed, rgbGreen, rgbBlue);
+ break
+ end
+ end {COLOR_PALETTE}
+ end {case Header.ColorType};
+end;
+
+{Saving the chunk to a stream}
+function TChunktRNS.SaveToStream(Stream: TStream): Boolean;
+begin
+ {Copy palette into data buffer}
+ if DataSize <= 256 then
+ CopyMemory(fData, @PaletteValues[0], DataSize);
+
+ Result := inherited SaveToStream(Stream);
+end;
+
+{Assigns from another chunk}
+procedure TChunktRNS.Assign(Source: TChunk);
+begin
+ CopyMemory(@PaletteValues[0], @TChunkTrns(Source).PaletteValues[0], 256);
+ fBitTransparency := TChunkTrns(Source).fBitTransparency;
+ inherited Assign(Source);
+end;
+
+{Loads the chunk from a stream}
+function TChunktRNS.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+var
+ i, Differ255: Integer;
+begin
+ {Let inherited load}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+
+ if not Result then Exit;
+
+ {Make sure size is correct}
+ if Size > 256 then Owner.RaiseError(EPNGInvalidPalette,
+ EPNGInvalidPaletteText);
+
+ {The unset items should have value 255}
+ Fillchar(PaletteValues[0], 256, 255);
+ {Copy the other values}
+ CopyMemory(@PaletteValues[0], fData, Size);
+
+ {Create the mask if needed}
+ case Header.ColorType of
+ {Mask for grayscale and RGB}
+ COLOR_RGB, COLOR_GRAYSCALE: fBitTransparency := True;
+ COLOR_PALETTE:
+ begin
+ Differ255 := 0; {Count the entries with a value different from 255}
+ {Tests if it uses bit transparency}
+ for i := 0 to Size - 1 do
+ if PaletteValues[i] <> 255 then inc(Differ255);
+
+ {If it has one value different from 255 it is a bit transparency}
+ fBitTransparency := (Differ255 = 1);
+ end {COLOR_PALETTE}
+ end {case Header.ColorType};
+
+end;
+
+{Prepares the image palette}
+procedure TChunkIDAT.PreparePalette;
+var
+ Entries: Word;
+ j : Integer;
+begin
+ {In case the image uses grayscale, build a grayscale palette}
+ with Header do
+ if (ColorType = COLOR_GRAYSCALE) or (ColorType = COLOR_GRAYSCALEALPHA) then
+ begin
+ {Calculate total number of palette entries}
+ Entries := (1 shl Byte(BitmapInfo.bmiHeader.biBitCount));
+
+ FOR j := 0 TO Entries - 1 DO
+ with BitmapInfo.bmiColors[j] do
+ begin
+
+ {Calculate each palette entry}
+ rgbRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
+ rgbGreen := rgbRed;
+ rgbBlue := rgbRed;
+ end {with BitmapInfo.bmiColors[j]}
+ end {if ColorType = COLOR_GRAYSCALE..., with Header}
+end;
+
+{Reads from ZLIB}
+function TChunkIDAT.IDATZlibRead(var ZLIBStream: TZStreamRec2;
+ Buffer: Pointer; Count: Integer; var EndPos: Integer;
+ var crcfile: Cardinal): Integer;
+var
+ ProcResult : Integer;
+ IDATHeader : Array[0..3] of char;
+ IDATCRC : Cardinal;
+begin
+ {Uses internal record pointed by ZLIBStream to gather information}
+ with ZLIBStream, ZLIBStream.zlib do
+ begin
+ {Set the buffer the zlib will read into}
+ next_out := Buffer;
+ avail_out := Count;
+
+ {Decode until it reach the Count variable}
+ while avail_out > 0 do
+ begin
+ {In case it needs more data and it's in the end of a IDAT chunk,}
+ {it means that there are more IDAT chunks}
+ if (fStream.Position = EndPos) and (avail_out > 0) and
+ (avail_in = 0) then
+ begin
+ {End this chunk by reading and testing the crc value}
+ fStream.Read(IDATCRC, 4);
+
+ {$IFDEF CheckCRC}
+ if crcfile xor $ffffffff <> Cardinal(ByteSwap(IDATCRC)) then
+ begin
+ Result := -1;
+ Owner.RaiseError(EPNGInvalidCRC, EPNGInvalidCRCText);
+ exit;
+ end;
+ {$ENDIF}
+
+ {Start reading the next chunk}
+ fStream.Read(EndPos, 4); {Reads next chunk size}
+ fStream.Read(IDATHeader[0], 4); {Next chunk header}
+ {It must be a IDAT chunk since image data is required and PNG}
+ {specification says that multiple IDAT chunks must be consecutive}
+ if IDATHeader <> 'IDAT' then
+ begin
+ Owner.RaiseError(EPNGMissingMultipleIDAT, EPNGMissingMultipleIDATText);
+ result := -1;
+ exit;
+ end;
+
+ {Calculate chunk name part of the crc}
+ {$IFDEF CheckCRC}
+ crcfile := update_crc($ffffffff, @IDATHeader[0], 4);
+ {$ENDIF}
+ EndPos := fStream.Position + ByteSwap(EndPos);
+ end;
+
+
+ {In case it needs compressed data to read from}
+ if avail_in = 0 then
+ begin
+ {In case it's trying to read more than it is avaliable}
+ if fStream.Position + ZLIBAllocate > EndPos then
+ avail_in := fStream.Read(Data^, EndPos - fStream.Position)
+ else
+ avail_in := fStream.Read(Data^, ZLIBAllocate);
+ {Update crc}
+ {$IFDEF CheckCRC}
+ crcfile := update_crc(crcfile, Data, avail_in);
+ {$ENDIF}
+
+ {In case there is no more compressed data to read from}
+ if avail_in = 0 then
+ begin
+ Result := Count - avail_out;
+ Exit;
+ end;
+
+ {Set next buffer to read and record current position}
+ next_in := Data;
+
+ end {if avail_in = 0};
+
+ ProcResult := inflate(zlib, 0);
+
+ {In case the result was not sucessfull}
+ if (ProcResult < 0) then
+ begin
+ Result := -1;
+ Owner.RaiseError(EPNGZLIBError,
+ EPNGZLIBErrorText + zliberrors[procresult]);
+ exit;
+ end;
+
+ end {while avail_out > 0};
+
+ end {with};
+
+ {If everything gone ok, it returns the count bytes}
+ Result := Count;
+end;
+
+{TChunkIDAT implementation}
+
+const
+ {Adam 7 interlacing values}
+ RowStart: array[0..6] of Integer = (0, 0, 4, 0, 2, 0, 1);
+ ColumnStart: array[0..6] of Integer = (0, 4, 0, 2, 0, 1, 0);
+ RowIncrement: array[0..6] of Integer = (8, 8, 8, 4, 4, 2, 2);
+ ColumnIncrement: array[0..6] of Integer = (8, 8, 4, 4, 2, 2, 1);
+
+{Copy interlaced images with 1 byte for R, G, B}
+procedure TChunkIDAT.CopyInterlacedRGB8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+
+ {Move to next column}
+ inc(Src, 3);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy interlaced images with 2 bytes for R, G, B}
+procedure TChunkIDAT.CopyInterlacedRGB16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
+ Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);
+ {$ENDIF}
+
+ {Move to next column}
+ inc(Src, 6);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with palette using bit depths 1, 4 or 8}
+procedure TChunkIDAT.CopyInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+const
+ BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
+ StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4, 0, 0, 0, 0);
+var
+ CurBit, Col: Integer;
+ Dest2: PChar;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ repeat
+ {Copy data}
+ CurBit := StartBit[Header.BitDepth];
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Dest2 := pChar(Longint(Dest) + (Header.BitDepth * Col) div 8);
+ {Copy data}
+ Byte(Dest2^) := Byte(Dest2^) or
+ ( ((Byte(Src^) shr CurBit) and BitTable[Header.BitDepth])
+ shl (StartBit[Header.BitDepth] - (Col * Header.BitDepth mod 8)));
+
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, Header.BitDepth);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Src);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with palette using bit depth 2}
+procedure TChunkIDAT.CopyInterlacedPalette2(const Pass: Byte; Src, Dest,
+ Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ CurBit, Col: Integer;
+ Dest2: PChar;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ repeat
+ {Copy data}
+ CurBit := 6;
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Dest2 := pChar(Longint(Dest) + Col div 2);
+ {Copy data}
+ Byte(Dest2^) := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3)
+ shl (4 - (4 * Col) mod 8));
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, 2);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Src);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with grayscale using bit depth 2}
+procedure TChunkIDAT.CopyInterlacedGray2(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ CurBit, Col: Integer;
+ Dest2: PChar;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ repeat
+ {Copy data}
+ CurBit := 6;
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Dest2 := pChar(Longint(Dest) + Col div 2);
+ {Copy data}
+ Byte(Dest2^) := Byte(Dest2^) or ((((Byte(Src^) shr CurBit) shl 2) and $F)
+ shl (4 - (Col*4) mod 8));
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, 2);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Src);
+ until Col >= ImageWidth;
+end;
+
+{Copy ímages with palette using 2 bytes for each pixel}
+procedure TChunkIDAT.CopyInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col);
+ repeat
+ {Copy this row}
+ Dest^ := Src^; inc(Dest);
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+
+ {Move to next column}
+ inc(Src, 2);
+ inc(Dest, ColumnIncrement[Pass] - 1);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes interlaced RGB alpha with 1 byte for each sample}
+procedure TChunkIDAT.CopyInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row and alpha value}
+ Trans^ := pChar(Longint(Src) + 3)^;
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+
+ {Move to next column}
+ inc(Src, 4);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes interlaced RGB alpha with 2 bytes for each sample}
+procedure TChunkIDAT.CopyInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row and alpha value}
+ Trans^ := pChar(Longint(Src) + 6)^;
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);
+ {$ENDIF}
+
+ {Move to next column}
+ inc(Src, 8);
+ inc(Dest, ColumnIncrement[Pass] * 3 - 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes 8 bit grayscale image followed by an alpha sample}
+procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column, pointers to the data and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this grayscale value and alpha}
+ Dest^ := Src^; inc(Src);
+ Trans^ := Src^; inc(Src);
+
+ {Move to next column}
+ inc(Dest, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes 16 bit grayscale image followed by an alpha sample}
+procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column, pointers to the data and enter in loop}
+ Col := ColumnStart[Pass];
+ Dest := pChar(Longint(Dest) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+ {Copy this grayscale value and alpha, transforming 16 bits into 8}
+ Dest^ := Src^; inc(Src, 2);
+ Trans^ := Src^; inc(Src, 2);
+
+ {Move to next column}
+ inc(Dest, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Decodes an interlaced image}
+procedure TChunkIDAT.DecodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
+var
+ CurrentPass: Byte;
+ PixelsThisRow: Integer;
+ CurrentRow: Integer;
+ Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pChar;
+ CopyProc: procedure(const Pass: Byte; Src, Dest,
+ Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar) of object;
+begin
+
+ CopyProc := nil; {Initialize}
+ {Determine method to copy the image data}
+ case Header.ColorType of
+ {R, G, B values for each pixel}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := CopyInterlacedRGB8;
+ 16: CopyProc := CopyInterlacedRGB16;
+ end {case Header.BitDepth};
+ {Palette}
+ COLOR_PALETTE, COLOR_GRAYSCALE:
+ case Header.BitDepth of
+ 1, 4, 8: CopyProc := CopyInterlacedPalette148;
+ 2 : if Header.ColorType = COLOR_PALETTE then
+ CopyProc := CopyInterlacedPalette2
+ else
+ CopyProc := CopyInterlacedGray2;
+ 16 : CopyProc := CopyInterlacedGrayscale16;
+ end;
+ {RGB followed by alpha}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := CopyInterlacedRGBAlpha8;
+ 16: CopyProc := CopyInterlacedRGBAlpha16;
+ end;
+ {Grayscale followed by alpha}
+ COLOR_GRAYSCALEALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := CopyInterlacedGrayscaleAlpha8;
+ 16: CopyProc := CopyInterlacedGrayscaleAlpha16;
+ end;
+ end {case Header.ColorType};
+
+ {Adam7 method has 7 passes to make the final image}
+ FOR CurrentPass := 0 TO 6 DO
+ begin
+ {Calculates the number of pixels and bytes for this pass row}
+ PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
+ ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
+ Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
+ Header.BitDepth);
+ {Clear buffer for this pass}
+ ZeroMemory(Row_Buffer[not RowUsed], Row_Bytes);
+
+ {Get current row index}
+ CurrentRow := RowStart[CurrentPass];
+ {Get a pointer to the current row image data}
+ Data := pointer(Longint(Header.ImageData) + Header.BytesPerRow * (ImageHeight - 1 - CurrentRow));
+ Trans := pointer(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
+ {$IFDEF Store16bits}
+ Extra := pointer(Longint(Header.ExtraImageData) + Header.BytesPerRow * (ImageHeight - 1 - CurrentRow));
+ {$ENDIF}
+
+ if Row_Bytes > 0 then {There must have bytes for this interlaced pass}
+ while CurrentRow < ImageHeight do
+ begin
+ {Reads this line and filter}
+ if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1,
+ EndPos, CRCFile) = 0 then break;
+
+ FilterRow;
+ {Copy image data}
+
+ CopyProc(CurrentPass, @Row_Buffer[RowUsed][1], Data, Trans
+ {$IFDEF Store16bits}, Extra{$ENDIF});
+
+ {Use the other RowBuffer item}
+ RowUsed := not RowUsed;
+
+ {Move to the next row}
+ inc(CurrentRow, RowIncrement[CurrentPass]);
+ {Move pointer to the next line}
+ dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
+ inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
+ {$IFDEF Store16bits}
+ dec(Extra, RowIncrement[CurrentPass] * Header.BytesPerRow);
+ {$ENDIF}
+ end {while CurrentRow < ImageHeight};
+
+ end {FOR CurrentPass};
+
+end;
+
+{Copy 8 bits RGB image}
+procedure TChunkIDAT.CopyNonInterlacedRGB8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy pixel values}
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {Move to next pixel}
+ inc(Src, 3);
+ end {for I}
+end;
+
+{Copy 16 bits RGB image}
+procedure TChunkIDAT.CopyNonInterlacedRGB16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Since windows does not supports 2 bytes for
+ //each R, G, B value, the method will read only 1 byte from it
+ {Copy pixel values}
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);
+ {$ENDIF}
+
+ {Move to next pixel}
+ inc(Src, 6);
+ end {for I}
+end;
+
+{Copy types using palettes (1, 4 or 8 bits per pixel)}
+procedure TChunkIDAT.CopyNonInterlacedPalette148(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+begin
+ {It's simple as copying the data}
+ CopyMemory(Dest, Src, Row_Bytes);
+end;
+
+{Copy grayscale types using 2 bits for each pixel}
+procedure TChunkIDAT.CopyNonInterlacedGray2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ i: Integer;
+begin
+ {2 bits is not supported, this routine will converted into 4 bits}
+ FOR i := 1 TO Row_Bytes do
+ begin
+ Byte(Dest^) := ((Byte(Src^) shr 2) and $F) or ((Byte(Src^)) and $F0); inc(Dest);
+ Byte(Dest^) := ((Byte(Src^) shl 2) and $F) or ((Byte(Src^) shl 4) and $F0); inc(Dest);
+ inc(Src);
+ end {FOR i}
+end;
+
+{Copy types using palette with 2 bits for each pixel}
+procedure TChunkIDAT.CopyNonInterlacedPalette2(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ i: Integer;
+begin
+ {2 bits is not supported, this routine will converted into 4 bits}
+ FOR i := 1 TO Row_Bytes do
+ begin
+ Byte(Dest^) := ((Byte(Src^) shr 4) and $3) or ((Byte(Src^) shr 2) and $30); inc(Dest);
+ Byte(Dest^) := (Byte(Src^) and $3) or ((Byte(Src^) shl 2) and $30); inc(Dest);
+ inc(Src);
+ end {FOR i}
+end;
+
+{Copy grayscale images with 16 bits}
+procedure TChunkIDAT.CopyNonInterlacedGrayscale16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Windows does not supports 16 bits for each pixel in grayscale}
+ {mode, so reduce to 8}
+ Dest^ := Src^; inc(Dest);
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+
+ {Move to next pixel}
+ inc(Src, 2);
+ end {for I}
+end;
+
+{Copy 8 bits per sample RGB images followed by an alpha byte}
+procedure TChunkIDAT.CopyNonInterlacedRGBAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ i: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy pixel values and transparency}
+ Trans^ := pChar(Longint(Src) + 3)^;
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {Move to next pixel}
+ inc(Src, 4); inc(Trans);
+ end {for I}
+end;
+
+{Copy 16 bits RGB image with alpha using 2 bytes for each sample}
+procedure TChunkIDAT.CopyNonInterlacedRGBAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Copy rgb and alpha values (transforming from 16 bits to 8 bits)
+ {Copy pixel values}
+ Trans^ := pChar(Longint(Src) + 6)^;
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
+ {$IFDEF Store16bits}
+ {Copy extra pixel values}
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
+ Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);
+ {$ENDIF}
+ {Move to next pixel}
+ inc(Src, 8); inc(Trans);
+ end {for I}
+end;
+
+{Copy 8 bits per sample grayscale followed by alpha}
+procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha8(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy alpha value and then gray value}
+ Dest^ := Src^; inc(Src);
+ Trans^ := Src^; inc(Src);
+ inc(Dest); inc(Trans);
+ end;
+end;
+
+{Copy 16 bits per sample grayscale followed by alpha}
+procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha16(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy alpha value and then gray value}
+ {$IFDEF Store16bits}
+ Extra^ := pChar(Longint(Src) + 1)^; inc(Extra);
+ {$ENDIF}
+ Dest^ := Src^; inc(Src, 2);
+ Trans^ := Src^; inc(Src, 2);
+ inc(Dest); inc(Trans);
+ end;
+end;
+
+{Decode non interlaced image}
+procedure TChunkIDAT.DecodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
+var
+ j: Cardinal;
+ Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pChar;
+ CopyProc: procedure(
+ Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar) of object;
+begin
+ CopyProc := nil; {Initialize}
+ {Determines the method to copy the image data}
+ case Header.ColorType of
+ {R, G, B values}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := CopyNonInterlacedRGB8;
+ 16: CopyProc := CopyNonInterlacedRGB16;
+ end;
+ {Types using palettes}
+ COLOR_PALETTE, COLOR_GRAYSCALE:
+ case Header.BitDepth of
+ 1, 4, 8: CopyProc := CopyNonInterlacedPalette148;
+ 2 : if Header.ColorType = COLOR_PALETTE then
+ CopyProc := CopyNonInterlacedPalette2
+ else
+ CopyProc := CopyNonInterlacedGray2;
+ 16 : CopyProc := CopyNonInterlacedGrayscale16;
+ end;
+ {R, G, B followed by alpha}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8 : CopyProc := CopyNonInterlacedRGBAlpha8;
+ 16 : CopyProc := CopyNonInterlacedRGBAlpha16;
+ end;
+ {Grayscale followed by alpha}
+ COLOR_GRAYSCALEALPHA:
+ case Header.BitDepth of
+ 8 : CopyProc := CopyNonInterlacedGrayscaleAlpha8;
+ 16 : CopyProc := CopyNonInterlacedGrayscaleAlpha16;
+ end;
+ end;
+
+ {Get the image data pointer}
+ Longint(Data) := Longint(Header.ImageData) +
+ Header.BytesPerRow * (ImageHeight - 1);
+ Trans := Header.ImageAlpha;
+ {$IFDEF Store16bits}
+ Longint(Extra) := Longint(Header.ExtraImageData) +
+ Header.BytesPerRow * (ImageHeight - 1);
+ {$ENDIF}
+ {Reads each line}
+ FOR j := 0 to ImageHeight - 1 do
+ begin
+ {Read this line Row_Buffer[RowUsed][0] if the filter type for this line}
+ if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1, EndPos,
+ CRCFile) = 0 then break;
+
+ {Filter the current row}
+ FilterRow;
+ {Copies non interlaced row to image}
+ CopyProc(@Row_Buffer[RowUsed][1], Data, Trans{$IFDEF Store16bits}, Extra
+ {$ENDIF});
+
+ {Invert line used}
+ RowUsed := not RowUsed;
+ dec(Data, Header.BytesPerRow);
+ {$IFDEF Store16bits}dec(Extra, Header.BytesPerRow);{$ENDIF}
+ inc(Trans, ImageWidth);
+ end {for I};
+
+
+end;
+
+{Filter the current line}
+procedure TChunkIDAT.FilterRow;
+var
+ pp: Byte;
+ vv, left, above, aboveleft: Integer;
+ Col: Cardinal;
+begin
+ {Test the filter}
+ case Row_Buffer[RowUsed]^[0] of
+ {No filtering for this line}
+ FILTER_NONE: begin end;
+ {AND 255 serves only to never let the result be larger than one byte}
+ {Sub filter}
+ FILTER_SUB:
+ FOR Col := Offset + 1 to Row_Bytes DO
+ Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
+ Row_Buffer[RowUsed][Col - Offset]) and 255;
+ {Up filter}
+ FILTER_UP:
+ FOR Col := 1 to Row_Bytes DO
+ Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
+ Row_Buffer[not RowUsed][Col]) and 255;
+ {Average filter}
+ FILTER_AVERAGE:
+ FOR Col := 1 to Row_Bytes DO
+ begin
+ {Obtains up and left pixels}
+ above := Row_Buffer[not RowUsed][Col];
+ if col - 1 < Offset then
+ left := 0
+ else
+ Left := Row_Buffer[RowUsed][Col - Offset];
+
+ {Calculates}
+ Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
+ (left + above) div 2) and 255;
+ end;
+ {Paeth filter}
+ FILTER_PAETH:
+ begin
+ {Initialize}
+ left := 0;
+ aboveleft := 0;
+ {Test each byte}
+ FOR Col := 1 to Row_Bytes DO
+ begin
+ {Obtains above pixel}
+ above := Row_Buffer[not RowUsed][Col];
+ {Obtains left and top-left pixels}
+ if (col - 1 >= offset) Then
+ begin
+ left := row_buffer[RowUsed][col - offset];
+ aboveleft := row_buffer[not RowUsed][col - offset];
+ end;
+
+ {Obtains current pixel and paeth predictor}
+ vv := row_buffer[RowUsed][Col];
+ pp := PaethPredictor(left, above, aboveleft);
+
+ {Calculates}
+ Row_Buffer[RowUsed][Col] := (pp + vv) and $FF;
+ end {for};
+ end;
+
+ end {case};
+end;
+
+{Reads the image data from the stream}
+function TChunkIDAT.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
+ Size: Integer): Boolean;
+var
+ ZLIBStream: TZStreamRec2;
+ CRCCheck,
+ CRCFile : Cardinal;
+begin
+ {Get pointer to the header chunk}
+ Header := Owner.Chunks.Item[0] as TChunkIHDR;
+ {Build palette if necessary}
+ if Header.HasPalette then PreparePalette();
+
+ {Copy image width and height}
+ ImageWidth := Header.Width;
+ ImageHeight := Header.Height;
+
+ {Initialize to calculate CRC}
+ {$IFDEF CheckCRC}
+ CRCFile := update_crc($ffffffff, @ChunkName[0], 4);
+ {$ENDIF}
+
+ Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
+ ZLIBStream := ZLIBInitInflate(Stream); {Initializes decompression}
+
+ {Calculate ending position for the current IDAT chunk}
+ EndPos := Stream.Position + Size;
+
+ {Allocate memory}
+ GetMem(Row_Buffer[false], Row_Bytes + 1);
+ GetMem(Row_Buffer[true], Row_Bytes + 1);
+ ZeroMemory(Row_Buffer[false], Row_bytes + 1);
+ {Set the variable to alternate the Row_Buffer item to use}
+ RowUsed := TRUE;
+
+ {Call special methods for the different interlace methods}
+ case Owner.InterlaceMethod of
+ imNone: DecodeNonInterlaced(stream, ZLIBStream, Size, crcfile);
+ imAdam7: DecodeInterlacedAdam7(stream, ZLIBStream, size, crcfile);
+ end;
+
+ {Free memory}
+ ZLIBTerminateInflate(ZLIBStream); {Terminates decompression}
+ FreeMem(Row_Buffer[False], Row_Bytes + 1);
+ FreeMem(Row_Buffer[True], Row_Bytes + 1);
+
+ {Now checks CRC}
+ Stream.Read(CRCCheck, 4);
+ {$IFDEF CheckCRC}
+ CRCFile := CRCFile xor $ffffffff;
+ CRCCheck := ByteSwap(CRCCheck);
+ Result := CRCCheck = CRCFile;
+
+ {Handle CRC error}
+ if not Result then
+ begin
+ {In case it coult not load chunk}
+ Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText);
+ exit;
+ end;
+ {$ELSE}Result := TRUE; {$ENDIF}
+end;
+
+const
+ IDATHeader: Array[0..3] of char = ('I', 'D', 'A', 'T');
+ BUFFER = 5;
+
+{Saves the IDAT chunk to a stream}
+function TChunkIDAT.SaveToStream(Stream: TStream): Boolean;
+var
+ ZLIBStream : TZStreamRec2;
+begin
+ {Get pointer to the header chunk}
+ Header := Owner.Chunks.Item[0] as TChunkIHDR;
+ {Copy image width and height}
+ ImageWidth := Header.Width;
+ ImageHeight := Header.Height;
+ Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
+
+ {Allocate memory}
+ GetMem(Encode_Buffer[BUFFER], Row_Bytes);
+ ZeroMemory(Encode_Buffer[BUFFER], Row_Bytes);
+ {Allocate buffers for the filters selected}
+ {Filter none will always be calculated to the other filters to work}
+ GetMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
+ ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
+ if pfSub in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
+ if pfUp in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_UP], Row_Bytes);
+ if pfAverage in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
+ if pfPaeth in Owner.Filters then
+ GetMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);
+
+ {Initialize ZLIB}
+ ZLIBStream := ZLIBInitDeflate(Stream, Owner.fCompressionLevel,
+ Owner.MaxIdatSize);
+ {Write data depending on the interlace method}
+ case Owner.InterlaceMethod of
+ imNone: EncodeNonInterlaced(stream, ZLIBStream);
+ imAdam7: EncodeInterlacedAdam7(stream, ZLIBStream);
+ end;
+ {Terminates ZLIB}
+ ZLIBTerminateDeflate(ZLIBStream);
+
+ {Release allocated memory}
+ FreeMem(Encode_Buffer[BUFFER], Row_Bytes);
+ FreeMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
+ if pfSub in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
+ if pfUp in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_UP], Row_Bytes);
+ if pfAverage in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
+ if pfPaeth in Owner.Filters then
+ FreeMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);
+
+ {Everything went ok}
+ Result := True;
+end;
+
+{Writes the IDAT using the settings}
+procedure WriteIDAT(Stream: TStream; Data: Pointer; const Length: Cardinal);
+var
+ ChunkLen, CRC: Cardinal;
+begin
+ {Writes IDAT header}
+ ChunkLen := ByteSwap(Length);
+ Stream.Write(ChunkLen, 4); {Chunk length}
+ Stream.Write(IDATHeader[0], 4); {Idat header}
+ CRC := update_crc($ffffffff, @IDATHeader[0], 4); {Crc part for header}
+
+ {Writes IDAT data and calculates CRC for data}
+ Stream.Write(Data^, Length);
+ CRC := Byteswap(update_crc(CRC, Data, Length) xor $ffffffff);
+ {Writes final CRC}
+ Stream.Write(CRC, 4);
+end;
+
+{Compress and writes IDAT chunk data}
+procedure TChunkIDAT.IDATZlibWrite(var ZLIBStream: TZStreamRec2;
+ Buffer: Pointer; const Length: Cardinal);
+begin
+ with ZLIBStream, ZLIBStream.ZLIB do
+ begin
+ {Set data to be compressed}
+ next_in := Buffer;
+ avail_in := Length;
+
+ {Compress all the data avaliable to compress}
+ while avail_in > 0 do
+ begin
+ deflate(ZLIB, Z_NO_FLUSH);
+
+ {The whole buffer was used, save data to stream and restore buffer}
+ if avail_out = 0 then
+ begin
+ {Writes this IDAT chunk}
+ WriteIDAT(fStream, Data, ZLIBAllocate);
+
+ {Restore buffer}
+ next_out := Data;
+ avail_out := ZLIBAllocate;
+ end {if avail_out = 0};
+
+ end {while avail_in};
+
+ end {with ZLIBStream, ZLIBStream.ZLIB}
+end;
+
+{Finishes compressing data to write IDAT chunk}
+procedure TChunkIDAT.FinishIDATZlib(var ZLIBStream: TZStreamRec2);
+begin
+ with ZLIBStream, ZLIBStream.ZLIB do
+ begin
+ {Set data to be compressed}
+ next_in := nil;
+ avail_in := 0;
+
+ while deflate(ZLIB,Z_FINISH) <> Z_STREAM_END do
+ begin
+ {Writes this IDAT chunk}
+ WriteIDAT(fStream, Data, ZLIBAllocate - avail_out);
+ {Re-update buffer}
+ next_out := Data;
+ avail_out := ZLIBAllocate;
+ end;
+
+ if avail_out < ZLIBAllocate then
+ {Writes final IDAT}
+ WriteIDAT(fStream, Data, ZLIBAllocate - avail_out);
+
+ end {with ZLIBStream, ZLIBStream.ZLIB};
+end;
+
+{Copy memory to encode RGB image with 1 byte for each color sample}
+procedure TChunkIDAT.EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ {Copy pixel values}
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
+ {Move to next pixel}
+ inc(Src, 3);
+ end {for I}
+end;
+
+{Copy memory to encode RGB images with 16 bits for each color sample}
+procedure TChunkIDAT.EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
+ //for sample
+ {Copy pixel values}
+ pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2);
+ pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2);
+ pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2);
+ {Move to next pixel}
+ inc(Src, 3);
+ end {for I}
+
+end;
+
+{Copy memory to encode types using palettes (1, 4 or 8 bits per pixel)}
+procedure TChunkIDAT.EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
+begin
+ {It's simple as copying the data}
+ CopyMemory(Dest, Src, Row_Bytes);
+end;
+
+{Copy memory to encode grayscale images with 2 bytes for each sample}
+procedure TChunkIDAT.EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
+var
+ I: Integer;
+begin
+ FOR I := 1 TO ImageWidth DO
+ begin
+ //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
+ //for sample
+ pWORD(Dest)^ := pByte(Longint(Src))^; inc(Dest, 2);
+ {Move to next pixel}
+ inc(Src);
+ end {for I}
+end;
+
+{Encode images using RGB followed by an alpha value using 1 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+ inc(Src, 3); inc(Trans);
+ end {for i};
+end;
+
+{Encode images using RGB followed by an alpha value using 2 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest, 2);
+ pWord(Dest)^ := PByte(Longint(Trans) )^; inc(Dest, 2);
+ inc(Src, 3); inc(Trans);
+ end {for i};
+end;
+
+{Encode grayscale images followed by an alpha value using 1 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha8(
+ Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ Dest^ := Src^; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+ inc(Src); inc(Trans);
+ end {for i};
+end;
+
+{Encode grayscale images followed by an alpha value using 2 byte for each}
+procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha16(
+ Src, Dest, Trans: pChar);
+var
+ i: Integer;
+begin
+ {Copy the data to the destination, including data from Trans pointer}
+ FOR i := 1 TO ImageWidth do
+ begin
+ pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
+ inc(Src); inc(Trans);
+ end {for i};
+end;
+
+{Encode non interlaced images}
+procedure TChunkIDAT.EncodeNonInterlaced(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+var
+ {Current line}
+ j: Cardinal;
+ {Pointers to image data}
+ Data, Trans: PChar;
+ {Filter used for this line}
+ Filter: Byte;
+ {Method which will copy the data into the buffer}
+ CopyProc: procedure(Src, Dest, Trans: pChar) of object;
+begin
+ CopyProc := nil; {Initialize to avoid warnings}
+ {Defines the method to copy the data to the buffer depending on}
+ {the image parameters}
+ case Header.ColorType of
+ {R, G, B values}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeNonInterlacedRGB8;
+ 16: CopyProc := EncodeNonInterlacedRGB16;
+ end;
+ {Palette and grayscale values}
+ COLOR_GRAYSCALE, COLOR_PALETTE:
+ case Header.BitDepth of
+ 1, 4, 8: CopyProc := EncodeNonInterlacedPalette148;
+ 16: CopyProc := EncodeNonInterlacedGrayscale16;
+ end;
+ {RGB with a following alpha value}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeNonInterlacedRGBAlpha8;
+ 16: CopyProc := EncodeNonInterlacedRGBAlpha16;
+ end;
+ {Grayscale images followed by an alpha}
+ COLOR_GRAYSCALEALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeNonInterlacedGrayscaleAlpha8;
+ 16: CopyProc := EncodeNonInterlacedGrayscaleAlpha16;
+ end;
+ end {case Header.ColorType};
+
+ {Get the image data pointer}
+ Longint(Data) := Longint(Header.ImageData) +
+ Header.BytesPerRow * (ImageHeight - 1);
+ Trans := Header.ImageAlpha;
+
+ {Writes each line}
+ FOR j := 0 to ImageHeight - 1 do
+ begin
+ {Copy data into buffer}
+ CopyProc(Data, @Encode_Buffer[BUFFER][0], Trans);
+ {Filter data}
+ Filter := FilterToEncode;
+
+ {Compress data}
+ IDATZlibWrite(ZLIBStream, @Filter, 1);
+ IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);
+
+ {Adjust pointers to the actual image data}
+ dec(Data, Header.BytesPerRow);
+ inc(Trans, ImageWidth);
+ end;
+
+ {Compress and finishes copying the remaining data}
+ FinishIDATZlib(ZLIBStream);
+end;
+
+{Copy memory to encode interlaced images using RGB value with 1 byte for}
+{each color sample}
+procedure TChunkIDAT.EncodeInterlacedRGB8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy memory to encode interlaced RGB images with 2 bytes each color sample}
+procedure TChunkIDAT.EncodeInterlacedRGB16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2);
+ pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy memory to encode interlaced images using palettes using bit depths}
+{1, 4, 8 (each pixel in the image)}
+procedure TChunkIDAT.EncodeInterlacedPalette148(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+const
+ BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
+ StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4, 0, 0, 0, 0);
+var
+ CurBit, Col: Integer;
+ Src2: PChar;
+begin
+ {Clean the line}
+ fillchar(Dest^, Row_Bytes, #0);
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ with Header.BitmapInfo.bmiHeader do
+ repeat
+ {Copy data}
+ CurBit := StartBit[biBitCount];
+ repeat
+ {Adjust pointer to pixel byte bounds}
+ Src2 := pChar(Longint(Src) + (biBitCount * Col) div 8);
+ {Copy data}
+ Byte(Dest^) := Byte(Dest^) or
+ (((Byte(Src2^) shr (StartBit[Header.BitDepth] - (biBitCount * Col)
+ mod 8))) and (BitTable[biBitCount])) shl CurBit;
+
+ {Move to next column}
+ inc(Col, ColumnIncrement[Pass]);
+ {Will read next bits}
+ dec(CurBit, biBitCount);
+ until CurBit < 0;
+
+ {Move to next byte in source}
+ inc(Dest);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode interlaced grayscale images using 16 bits for each sample}
+procedure TChunkIDAT.EncodeInterlacedGrayscale16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := Byte(Src^); inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode interlaced rgb images followed by an alpha value, all using}
+{one byte for each sample}
+procedure TChunkIDAT.EncodeInterlacedRGBAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
+ Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode interlaced rgb images followed by an alpha value, all using}
+{two byte for each sample}
+procedure TChunkIDAT.EncodeInterlacedRGBAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col * 3);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := pByte(Longint(Src) + 2)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Longint(Src) + 1)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Longint(Src) )^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass] * 3);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode grayscale interlaced images followed by an alpha value, all}
+{using 1 byte for each sample}
+procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ Dest^ := Src^; inc(Dest);
+ Dest^ := Trans^; inc(Dest);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Copy to encode grayscale interlaced images followed by an alpha value, all}
+{using 2 bytes for each sample}
+procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
+ Src, Dest, Trans: pChar);
+var
+ Col: Integer;
+begin
+ {Get first column and enter in loop}
+ Col := ColumnStart[Pass];
+ Src := pChar(Longint(Src) + Col);
+ Trans := pChar(Longint(Trans) + Col);
+ repeat
+ {Copy this row}
+ pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
+ pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
+
+ {Move to next column}
+ inc(Src, ColumnIncrement[Pass]);
+ inc(Trans, ColumnIncrement[Pass]);
+ inc(Col, ColumnIncrement[Pass]);
+ until Col >= ImageWidth;
+end;
+
+{Encode interlaced images}
+procedure TChunkIDAT.EncodeInterlacedAdam7(Stream: TStream;
+ var ZLIBStream: TZStreamRec2);
+var
+ CurrentPass, Filter: Byte;
+ PixelsThisRow: Integer;
+ CurrentRow : Integer;
+ Trans, Data: pChar;
+ CopyProc: procedure(const Pass: Byte;
+ Src, Dest, Trans: pChar) of object;
+begin
+ CopyProc := nil; {Initialize to avoid warnings}
+ {Defines the method to copy the data to the buffer depending on}
+ {the image parameters}
+ case Header.ColorType of
+ {R, G, B values}
+ COLOR_RGB:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeInterlacedRGB8;
+ 16: CopyProc := EncodeInterlacedRGB16;
+ end;
+ {Grayscale and palette}
+ COLOR_PALETTE, COLOR_GRAYSCALE:
+ case Header.BitDepth of
+ 1, 4, 8: CopyProc := EncodeInterlacedPalette148;
+ 16: CopyProc := EncodeInterlacedGrayscale16;
+ end;
+ {RGB followed by alpha}
+ COLOR_RGBALPHA:
+ case Header.BitDepth of
+ 8: CopyProc := EncodeInterlacedRGBAlpha8;
+ 16: CopyProc := EncodeInterlacedRGBAlpha16;
+ end;
+ COLOR_GRAYSCALEALPHA:
+ {Grayscale followed by alpha}
+ case Header.BitDepth of
+ 8: CopyProc := EncodeInterlacedGrayscaleAlpha8;
+ 16: CopyProc := EncodeInterlacedGrayscaleAlpha16;
+ end;
+ end {case Header.ColorType};
+
+ {Compress the image using the seven passes for ADAM 7}
+ FOR CurrentPass := 0 TO 6 DO
+ begin
+ {Calculates the number of pixels and bytes for this pass row}
+ PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
+ ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
+ Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
+ Header.BitDepth);
+ ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
+
+ {Get current row index}
+ CurrentRow := RowStart[CurrentPass];
+ {Get a pointer to the current row image data}
+ Data := pointer(Longint(Header.ImageData) + Header.BytesPerRow * (ImageHeight - 1 - CurrentRow));
+ Trans := pointer(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
+
+ {Process all the image rows}
+ if Row_Bytes > 0 then
+ while CurrentRow < ImageHeight do
+ begin
+ {Copy data into buffer}
+ CopyProc(CurrentPass, Data, @Encode_Buffer[BUFFER][0], Trans);
+ {Filter data}
+ Filter := FilterToEncode;
+
+ {Compress data}
+ IDATZlibWrite(ZLIBStream, @Filter, 1);
+ IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);
+
+ {Move to the next row}
+ inc(CurrentRow, RowIncrement[CurrentPass]);
+ {Move pointer to the next line}
+ dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
+ inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
+ end {while CurrentRow < ImageHeight}
+
+ end {CurrentPass};
+
+ {Compress and finishes copying the remaining data}
+ FinishIDATZlib(ZLIBStream);
+end;
+
+{Filters the row to be encoded and returns the best filter}
+function TChunkIDAT.FilterToEncode: Byte;
+var
+ Run, LongestRun, ii, jj: Cardinal;
+ Last, Above, LastAbove: Byte;
+begin
+ {Selecting more filters using the Filters property from TPngObject}
+ {increases the chances to the file be much smaller, but decreases}
+ {the performace}
+
+ {This method will creates the same line data using the different}
+ {filter methods and select the best}
+
+ {Sub-filter}
+ if pfSub in Owner.Filters then
+ for ii := 0 to Row_Bytes - 1 do
+ begin
+ {There is no previous pixel when it's on the first pixel, so}
+ {set last as zero when in the first}
+ if (ii >= Offset) then
+ last := Encode_Buffer[BUFFER]^[ii - Offset]
+ else
+ last := 0;
+ Encode_Buffer[FILTER_SUB]^[ii] := Encode_Buffer[BUFFER]^[ii] - last;
+ end;
+
+ {Up filter}
+ if pfUp in Owner.Filters then
+ for ii := 0 to Row_Bytes - 1 do
+ Encode_Buffer[FILTER_UP]^[ii] := Encode_Buffer[BUFFER]^[ii] -
+ Encode_Buffer[FILTER_NONE]^[ii];
+
+ {Average filter}
+ if pfAverage in Owner.Filters then
+ for ii := 0 to Row_Bytes - 1 do
+ begin
+ {Get the previous pixel, if the current pixel is the first, the}
+ {previous is considered to be 0}
+ if (ii >= Offset) then
+ last := Encode_Buffer[BUFFER]^[ii - Offset]
+ else
+ last := 0;
+ {Get the pixel above}
+ above := Encode_Buffer[FILTER_NONE]^[ii];
+
+ {Calculates formula to the average pixel}
+ Encode_Buffer[FILTER_AVERAGE]^[ii] := Encode_Buffer[BUFFER]^[ii] -
+ (above + last) div 2 ;
+ end;
+
+ {Paeth filter (the slower)}
+ if pfPaeth in Owner.Filters then
+ begin
+ {Initialize}
+ last := 0;
+ lastabove := 0;
+ for ii := 0 to Row_Bytes - 1 do
+ begin
+ {In case this pixel is not the first in the line obtains the}
+ {previous one and the one above the previous}
+ if (ii >= Offset) then
+ begin
+ last := Encode_Buffer[BUFFER]^[ii - Offset];
+ lastabove := Encode_Buffer[FILTER_NONE]^[ii - Offset];
+ end;
+ {Obtains the pixel above}
+ above := Encode_Buffer[FILTER_NONE]^[ii];
+ {Calculate paeth filter for this byte}
+ Encode_Buffer[FILTER_PAETH]^[ii] := Encode_Buffer[BUFFER]^[ii] -
+ PaethPredictor(last, above, lastabove);
+ end;
+ end;
+
+ {Now calculates the same line using no filter, which is necessary}
+ {in order to have data to the filters when the next line comes}
+ CopyMemory(@Encode_Buffer[FILTER_NONE]^[0],
+ @Encode_Buffer[BUFFER]^[0], Row_Bytes);
+
+ {If only filter none is selected in the filter list, we don't need}
+ {to proceed and further}
+ if (Owner.Filters = [pfNone]) or (Owner.Filters = []) then
+ begin
+ Result := FILTER_NONE;
+ exit;
+ end {if (Owner.Filters = [pfNone...};
+
+ {Check which filter is the best by checking which has the larger}
+ {sequence of the same byte, since they are best compressed}
+ LongestRun := 0; Result := FILTER_NONE;
+ for ii := FILTER_NONE TO FILTER_PAETH do
+ {Check if this filter was selected}
+ if TFilter(ii) in Owner.Filters then
+ begin
+ Run := 0;
+ {Check if it's the only filter}
+ if Owner.Filters = [TFilter(ii)] then
+ begin
+ Result := ii;
+ exit;
+ end;
+
+ {Check using a sequence of four bytes}
+ for jj := 2 to Row_Bytes - 1 do
+ if (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-1]) or
+ (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-2]) then
+ inc(Run); {Count the number of sequences}
+
+ {Check if this one is the best so far}
+ if (Run > LongestRun) then
+ begin
+ Result := ii;
+ LongestRun := Run;
+ end {if (Run > LongestRun)};
+
+ end {if TFilter(ii) in Owner.Filters};
+end;
+
+{TChunkPLTE implementation}
+
+{Returns an item in the palette}
+function TChunkPLTE.GetPaletteItem(Index: Byte): TRGBQuad;
+begin
+ {Test if item is valid, if not raise error}
+ if Index > Count - 1 then
+ Owner.RaiseError(EPNGError, EPNGUnknownPalEntryText)
+ else
+ {Returns the item}
+ Result := Header.BitmapInfo.bmiColors[Index];
+end;
+
+{Loads the palette chunk from a stream}
+function TChunkPLTE.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+type
+ pPalEntry = ^PalEntry;
+ PalEntry = record r, g, b: Byte end;
+var
+ j : Integer; {For the FOR}
+ PalColor : pPalEntry;
+begin
+ {Let ancestor load data and check CRC}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result then exit;
+
+ {This chunk must be divisible by 3 in order to be valid}
+ if (Size mod 3 <> 0) or (Size div 3 > 256) then
+ begin
+ {Raise error}
+ Result := FALSE;
+ Owner.RaiseError(EPNGInvalidPalette, EPNGInvalidPaletteText);
+ exit;
+ end {if Size mod 3 <> 0};
+
+ {Fill array with the palette entries}
+ fCount := Size div 3;
+ PalColor := Data;
+ FOR j := 0 TO fCount - 1 DO
+ with Header.BitmapInfo.bmiColors[j] do
+ begin
+ rgbRed := Owner.GammaTable[PalColor.r];
+ rgbGreen := Owner.GammaTable[PalColor.g];
+ rgbBlue := Owner.GammaTable[PalColor.b];
+ rgbReserved := 0;
+ inc(PalColor); {Move to next palette entry}
+ end;
+end;
+
+{Saves the PLTE chunk to a stream}
+function TChunkPLTE.SaveToStream(Stream: TStream): Boolean;
+var
+ J: Integer;
+ DataPtr: pByte;
+begin
+ {Adjust size to hold all the palette items}
+ ResizeData(fCount * 3);
+ {Copy pointer to data}
+ DataPtr := fData;
+
+ {Copy palette items}
+ with Header do
+ FOR j := 0 TO fCount - 1 DO
+ with BitmapInfo.bmiColors[j] do
+ begin
+ DataPtr^ := Owner.InverseGamma[rgbRed] ; inc(DataPtr);
+ DataPtr^ := Owner.InverseGamma[rgbGreen]; inc(DataPtr);
+ DataPtr^ := Owner.InverseGamma[rgbBlue] ; inc(DataPtr);
+ end {with BitmapInfo};
+
+ {Let ancestor do the rest of the work}
+ Result := inherited SaveToStream(Stream);
+end;
+
+{Assigns from another PLTE chunk}
+procedure TChunkPLTE.Assign(Source: TChunk);
+begin
+ {Copy the number of palette items}
+ if Source is TChunkPLTE then
+ fCount := TChunkPLTE(Source).fCount
+ else
+ Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
+end;
+
+{TChunkgAMA implementation}
+
+{Assigns from another chunk}
+procedure TChunkgAMA.Assign(Source: TChunk);
+begin
+ {Copy the gamma value}
+ if Source is TChunkgAMA then
+ Gamma := TChunkgAMA(Source).Gamma
+ else
+ Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
+end;
+
+{Gamma chunk being created}
+constructor TChunkgAMA.Create(Owner: TPngObject);
+begin
+ {Call ancestor}
+ inherited Create(Owner);
+ Gamma := 1; {Initial value}
+end;
+
+{Returns gamma value}
+function TChunkgAMA.GetValue: Cardinal;
+begin
+ {Make sure that the size is four bytes}
+ if DataSize <> 4 then
+ begin
+ {Adjust size and returns 1}
+ ResizeData(4);
+ Result := 1;
+ end
+ {If it's right, read the value}
+ else Result := Cardinal(ByteSwap(pCardinal(Data)^))
+end;
+
+function Power(Base, Exponent: Extended): Extended;
+begin
+ if Exponent = 0.0 then
+ Result := 1.0 {Math rule}
+ else if (Base = 0) or (Exponent = 0) then Result := 0
+ else
+ Result := Exp(Exponent * Ln(Base));
+end;
+
+
+{Loading the chunk from a stream}
+function TChunkgAMA.LoadFromStream(Stream: TStream;
+ const ChunkName: TChunkName; Size: Integer): Boolean;
+var
+ i: Integer;
+ Value: Cardinal;
+begin
+ {Call ancestor and test if it went ok}
+ Result := inherited LoadFromStream(Stream, ChunkName, Size);
+ if not Result then exit;
+ Value := Gamma;
+ {Build gamma table and inverse table for saving}
+ if Value <> 0 then
+ with Owner do
+ FOR i := 0 TO 255 DO
+ begin
+ GammaTable[I] := Round(Power((I / 255), 1 /
+ (Value / 100000 * 2.2)) * 255);
+ InverseGamma[Round(Power((I / 255), 1 /
+ (Value / 100000 * 2.2)) * 255)] := I;
+ end
+end;
+
+{Sets the gamma value}
+procedure TChunkgAMA.SetValue(const Value: Cardinal);
+begin
+ {Make sure that the size is four bytes}
+ if DataSize <> 4 then ResizeData(4);
+ {If it's right, set the value}
+ pCardinal(Data)^ := ByteSwap(Value);
+end;
+
+{TPngObject implementation}
+
+{Assigns from another object}
+procedure TPngObject.Assign(Source: TPersistent);
+begin
+ {Assigns contents from another TPNGObject}
+ if Source is TPNGObject then
+ AssignPNG(Source as TPNGObject)
+ {Copy contents from a TBitmap}
+ {$IFDEF UseDelphi}else if Source is TBitmap then
+ with Source as TBitmap do
+ AssignHandle(Handle, Transparent,
+ ColorToRGB(TransparentColor)){$ENDIF}
+ {Unknown source, let ancestor deal with it}
+ else
+ inherited;
+end;
+
+{Clear all the chunks in the list}
+procedure TPngObject.ClearChunks;
+var
+ i: Integer;
+begin
+ {Initialize gamma}
+ InitializeGamma();
+ {Free all the objects and memory (0 chunks Bug fixed by Noel Sharpe)}
+ for i := 0 TO Integer(Chunks.Count) - 1 do
+ TChunk(Chunks.Item[i]).Free;
+ Chunks.Count := 0;
+end;
+
+{Portable Network Graphics object being created}
+constructor TPngObject.Create;
+begin
+ {Let it be created}
+ inherited Create;
+
+ {Initial properties}
+ TempPalette := 0;
+ fFilters := [pfSub];
+ fCompressionLevel := 7;
+ fInterlaceMethod := imNone;
+ fMaxIdatSize := High(Word);
+ {Create chunklist object}
+ fChunkList := TPngList.Create(Self);
+end;
+
+{Portable Network Graphics object being destroyed}
+destructor TPngObject.Destroy;
+begin
+ {Free object list}
+ ClearChunks;
+ fChunkList.Free;
+ {Free the temporary palette}
+ if TempPalette <> 0 then DeleteObject(TempPalette);
+
+ {Call ancestor destroy}
+ inherited Destroy;
+end;
+
+{Returns linesize and byte offset for pixels}
+procedure TPngObject.GetPixelInfo(var LineSize, Offset: Cardinal);
+begin
+ {There must be an Header chunk to calculate size}
+ if HeaderPresent then
+ begin
+ {Calculate number of bytes for each line}
+ LineSize := BytesForPixels(Header.Width, Header.ColorType, Header.BitDepth);
+
+ {Calculates byte offset}
+ Case Header.ColorType of
+ {Grayscale}
+ COLOR_GRAYSCALE:
+ If Header.BitDepth = 16 Then
+ Offset := 2
+ Else
+ Offset := 1 ;
+ {It always smaller or equal one byte, so it occupes one byte}
+ COLOR_PALETTE:
+ offset := 1;
+ {It might be 3 or 6 bytes}
+ COLOR_RGB:
+ offset := 3 * Header.BitDepth Div 8;
+ {It might be 2 or 4 bytes}
+ COLOR_GRAYSCALEALPHA:
+ offset := 2 * Header.BitDepth Div 8;
+ {4 or 8 bytes}
+ COLOR_RGBALPHA:
+ offset := 4 * Header.BitDepth Div 8;
+ else
+ Offset := 0;
+ End ;
+
+ end
+ else
+ begin
+ {In case if there isn't any Header chunk}
+ Offset := 0;
+ LineSize := 0;
+ end;
+
+end;
+
+{Returns image height}
+function TPngObject.GetHeight: Integer;
+begin
+ {There must be a Header chunk to get the size, otherwise returns 0}
+ if HeaderPresent then
+ Result := TChunkIHDR(Chunks.Item[0]).Height
+ else Result := 0;
+end;
+
+{Returns image width}
+function TPngObject.GetWidth: Integer;
+begin
+ {There must be a Header chunk to get the size, otherwise returns 0}
+ if HeaderPresent then
+ Result := Header.Width
+ else Result := 0;
+end;
+
+{Returns if the image is empty}
+function TPngObject.GetEmpty: Boolean;
+begin
+ Result := (Chunks.Count = 0);
+end;
+
+{Raises an error}
+procedure TPngObject.RaiseError(ExceptionClass: ExceptClass; Text: String);
+begin
+ raise ExceptionClass.Create(Text);
+end;
+
+{Set the maximum size for IDAT chunk}
+procedure TPngObject.SetMaxIdatSize(const Value: Cardinal);
+begin
+ {Make sure the size is at least 65535}
+ if Value < High(Word) then
+ fMaxIdatSize := High(Word) else fMaxIdatSize := Value;
+end;
+
+{$IFNDEF UseDelphi}
+ {Creates a file stream reading from the filename in the parameter and load}
+ procedure TPngObject.LoadFromFile(const Filename: String);
+ var
+ FileStream: TFileStream;
+ begin
+ {Test if the file exists}
+ if not FileExists(Filename) then
+ begin
+ {In case it does not exists, raise error}
+ RaiseError(EPNGNotExists, EPNGNotExistsText);
+ exit;
+ end;
+
+ {Creates the file stream to read}
+ FileStream := TFileStream.Create(Filename, [fsmRead]);
+ LoadFromStream(FileStream); {Loads the data}
+ FileStream.Free; {Free file stream}
+ end;
+
+ {Saves the current png image to a file}
+ procedure TPngObject.SaveToFile(const Filename: String);
+ var
+ FileStream: TFileStream;
+ begin
+ {Creates the file stream to write}
+ FileStream := TFileStream.Create(Filename, [fsmWrite]);
+ SaveToStream(FileStream); {Saves the data}
+ FileStream.Free; {Free file stream}
+ end;
+
+{$ENDIF}
+
+{Returns pointer to the chunk TChunkIHDR which should be the first}
+function TPngObject.GetHeader: TChunkIHDR;
+begin
+ {If there is a TChunkIHDR returns it, otherwise returns nil}
+ if (Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR) then
+ Result := Chunks.Item[0] as TChunkIHDR
+ else
+ begin
+ {No header, throw error message}
+ RaiseError(EPNGHeaderNotPresent, EPNGHeaderNotPresentText);
+ Result := nil
+ end
+end;
+
+{Draws using partial transparency}
+procedure TPngObject.DrawPartialTrans(DC: HDC; Rect: TRect);
+type
+ {Access to pixels}
+ TPixelLine = Array[Word] of TRGBQuad;
+ pPixelLine = ^TPixelLine;
+const
+ {Structure used to create the bitmap}
+ BitmapInfoHeader: TBitmapInfoHeader =
+ (biSize: sizeof(TBitmapInfoHeader);
+ biWidth: 100;
+ biHeight: 100;
+ biPlanes: 1;
+ biBitCount: 32;
+ biCompression: BI_RGB;
+ biSizeImage: 0;
+ biXPelsPerMeter: 0;
+ biYPelsPerMeter: 0;
+ biClrUsed: 0;
+ biClrImportant: 0);
+var
+ {Buffer bitmap creation}
+ BitmapInfo : TBitmapInfo;
+ BufferDC : HDC;
+ BufferBits : Pointer;
+ OldBitmap,
+ BufferBitmap: HBitmap;
+
+ {Transparency/palette chunks}
+ TransparencyChunk: TChunktRNS;
+ PaletteChunk: TChunkPLTE;
+ TransValue, PaletteIndex: Byte;
+ CurBit: Integer;
+ Data: PByte;
+
+ {Buffer bitmap modification}
+ BytesPerRowDest,
+ BytesPerRowSrc,
+ BytesPerRowAlpha: Integer;
+ ImageSource,
+ AlphaSource : pByteArray;
+ ImageData : pPixelLine;
+ i, j : Integer;
+begin
+ {Prepare to create the bitmap}
+ Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
+ BitmapInfoHeader.biWidth := Header.Width;
+ BitmapInfoHeader.biHeight := -1 * Header.Height;
+ BitmapInfo.bmiHeader := BitmapInfoHeader;
+
+ {Create the bitmap which will receive the background, the applied}
+ {alpha blending and then will be painted on the background}
+ BufferDC := CreateCompatibleDC(0);
+ {In case BufferDC could not be created}
+ if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText);
+ BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS,
+ BufferBits, 0, 0);
+ {In case buffer bitmap could not be created}
+ if (BufferBitmap = 0) or (BufferBits = Nil) then
+ begin
+ if BufferBitmap <> 0 then DeleteObject(BufferBitmap);
+ DeleteDC(BufferDC);
+ RaiseError(EPNGOutMemory, EPNGOutMemoryText);
+ end;
+
+ {Selects new bitmap and release old bitmap}
+ OldBitmap := SelectObject(BufferDC, BufferBitmap);
+
+ {Draws the background on the buffer image}
+ StretchBlt(BufferDC, 0, 0, Header.Width, Header.height, DC, Rect.Left,
+ Rect.Top, Header.Width, Header.Height, SRCCOPY);
+
+ {Obtain number of bytes for each row}
+ BytesPerRowAlpha := Header.Width;
+ BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * Width) + 31)
+ and not 31) div 8; {Number of bytes for each image row in destination}
+ BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +
+ 31) and not 31) div 8; {Number of bytes for each image row in source}
+
+ {Obtains image pointers}
+ ImageData := BufferBits;
+ AlphaSource := Header.ImageAlpha;
+ Longint(ImageSource) := Longint(Header.ImageData) +
+ Header.BytesPerRow * Longint(Header.Height - 1);
+
+ case Header.BitmapInfo.bmiHeader.biBitCount of
+ {R, G, B images}
+ 24:
+ FOR j := 1 TO Header.Height DO
+ begin
+ {Process all the pixels in this line}
+ FOR i := 0 TO Header.Width - 1 DO
+ with ImageData[i] do
+ begin
+ rgbRed := (255+ImageSource[2+i*3] * AlphaSource[i] + rgbRed * (255 -
+ AlphaSource[i])) shr 8;
+ rgbGreen := (255+ImageSource[1+i*3] * AlphaSource[i] + rgbGreen *
+ (255 - AlphaSource[i])) shr 8;
+ rgbBlue := (255+ImageSource[i*3] * AlphaSource[i] + rgbBlue *
+ (255 - AlphaSource[i])) shr 8;
+ end;
+
+ {Move pointers}
+ Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
+ Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
+ Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
+ end;
+ {Palette images with 1 byte for each pixel}
+ 1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
+ FOR j := 1 TO Header.Height DO
+ begin
+ {Process all the pixels in this line}
+ FOR i := 0 TO Header.Width - 1 DO
+ with ImageData[i], Header.BitmapInfo do begin
+ rgbRed := (255 + ImageSource[i] * AlphaSource[i] +
+ rgbRed * (255 - AlphaSource[i])) shr 8;
+ rgbGreen := (255 + ImageSource[i] * AlphaSource[i] +
+ rgbGreen * (255 - AlphaSource[i])) shr 8;
+ rgbBlue := (255 + ImageSource[i] * AlphaSource[i] +
+ rgbBlue * (255 - AlphaSource[i])) shr 8;
+ end;
+
+ {Move pointers}
+ Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
+ Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
+ Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
+ end
+ else {Palette images}
+ begin
+ {Obtain pointer to the transparency chunk}
+ TransparencyChunk := TChunktRNS(Chunks.ItemFromClass(TChunktRNS));
+ PaletteChunk := TChunkPLTE(Chunks.ItemFromClass(TChunkPLTE));
+
+ FOR j := 1 TO Header.Height DO
+ begin
+ {Process all the pixels in this line}
+ i := 0; Data := @ImageSource[0];
+ repeat
+ CurBit := 0;
+
+ repeat
+ {Obtains the palette index}
+ case Header.BitDepth of
+ 1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1;
+ 2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F;
+ else PaletteIndex := Data^;
+ end;
+
+ {Updates the image with the new pixel}
+ with ImageData[i] do
+ begin
+ TransValue := TransparencyChunk.PaletteValues[PaletteIndex];
+ rgbRed := (255 + PaletteChunk.Item[PaletteIndex].rgbRed *
+ TransValue + rgbRed * (255 - TransValue)) shr 8;
+ rgbGreen := (255 + PaletteChunk.Item[PaletteIndex].rgbGreen *
+ TransValue + rgbGreen * (255 - TransValue)) shr 8;
+ rgbBlue := (255 + PaletteChunk.Item[PaletteIndex].rgbBlue *
+ TransValue + rgbBlue * (255 - TransValue)) shr 8;
+ end;
+
+ {Move to next data}
+ inc(i); inc(CurBit, Header.BitmapInfo.bmiHeader.biBitCount);
+ until CurBit >= 8;
+ {Move to next source data}
+ inc(Data);
+ until i >= Integer(Header.Width);
+
+ {Move pointers}
+ Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
+ Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
+ end
+ end {Palette images}
+ end {case Header.BitmapInfo.bmiHeader.biBitCount};
+
+ {Draws the new bitmap on the foreground}
+ StretchBlt(DC, Rect.Left, Rect.Top, Header.Width, Header.Height, BufferDC,
+ 0, 0, Header.Width, Header.Height, SRCCOPY);
+
+ {Free bitmap}
+ SelectObject(BufferDC, OldBitmap);
+ DeleteObject(BufferBitmap);
+ DeleteDC(BufferDC);
+end;
+
+{Draws the image into a canvas}
+procedure TPngObject.Draw(ACanvas: TCanvas; const Rect: TRect);
+var
+ Header: TChunkIHDR;
+begin
+ {Quit in case there is no header, otherwise obtain it}
+ if (Chunks.Count = 0) or not (Chunks.GetItem(0) is TChunkIHDR) then Exit;
+ Header := Chunks.GetItem(0) as TChunkIHDR;
+
+ {Copy the data to the canvas}
+ case Self.TransparencyMode of
+ {$IFDEF PartialTransparentDraw}
+ ptmPartial:
+ DrawPartialTrans(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect);
+ {$ENDIF}
+ ptmBit: DrawTransparentBitmap(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF},
+ Header.ImageData, Header.BitmapInfo.bmiHeader,
+ pBitmapInfo(@Header.BitmapInfo), Rect,
+ {$IFDEF UseDelphi}ColorToRGB({$ENDIF}TransparentColor)
+ {$IFDEF UseDelphi}){$ENDIF}
+ else
+ StretchDiBits(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect.Left,
+ Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0,
+ Header.Width, Header.Height, Header.ImageData,
+ pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY)
+ end {case}
+end;
+
+{Characters for the header}
+const
+ PngHeader: Array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10);
+
+{Loads the image from a stream of data}
+procedure TPngObject.LoadFromStream(Stream: TStream);
+var
+ Header : Array[0..7] of Char;
+ HasIDAT : Boolean;
+
+ {Chunks reading}
+ ChunkCount : Cardinal;
+ ChunkLength: Cardinal;
+ ChunkName : TChunkName;
+begin
+ {Initialize before start loading chunks}
+ ChunkCount := 0;
+ ClearChunks();
+ {Reads the header}
+ Stream.Read(Header[0], 8);
+
+ {Test if the header matches}
+ if Header <> PngHeader then
+ begin
+ RaiseError(EPNGInvalidFileHeader, EPNGInvalidFileHeaderText);
+ Exit;
+ end;
+
+
+ HasIDAT := FALSE;
+ Chunks.Count := 10;
+
+ {Load chunks}
+ repeat
+ inc(ChunkCount); {Increment number of chunks}
+ if Chunks.Count < ChunkCount then {Resize the chunks list if needed}
+ Chunks.Count := Chunks.Count + 10;
+
+ {Reads chunk length and invert since it is in network order}
+ {also checks the Read method return, if it returns 0, it}
+ {means that no bytes was readed, probably because it reached}
+ {the end of the file}
+ if Stream.Read(ChunkLength, 4) = 0 then
+ begin
+ {In case it found the end of the file here}
+ Chunks.Count := ChunkCount - 1;
+ RaiseError(EPNGUnexpectedEnd, EPNGUnexpectedEndText);
+ end;
+
+ ChunkLength := ByteSwap(ChunkLength);
+ {Reads chunk name}
+ Stream.Read(Chunkname, 4);
+
+ {Here we check if the first chunk is the Header which is necessary}
+ {to the file in order to be a valid Portable Network Graphics image}
+ if (ChunkCount = 1) and (ChunkName <> 'IHDR') then
+ begin
+ Chunks.Count := ChunkCount - 1;
+ RaiseError(EPNGIHDRNotFirst, EPNGIHDRNotFirstText);
+ exit;
+ end;
+
+ {Has a previous IDAT}
+ if (HasIDAT and (ChunkName = 'IDAT')) or (ChunkName = 'cHRM') then
+ begin
+ dec(ChunkCount);
+ Stream.Seek(ChunkLength + 4, soFromCurrent);
+ Continue;
+ end;
+ {Tell it has an IDAT chunk}
+ if ChunkName = 'IDAT' then HasIDAT := TRUE;
+
+ {Creates object for this chunk}
+ Chunks.SetItem(ChunkCount - 1, CreateClassChunk(Self, ChunkName));
+
+ {Check if the chunk is critical and unknown}
+ {$IFDEF ErrorOnUnknownCritical}
+ if (TChunk(Chunks.Item[ChunkCount - 1]).ClassType = TChunk) and
+ ((Byte(ChunkName[0]) AND $20) = 0) and (ChunkName <> '') then
+ begin
+ Chunks.Count := ChunkCount;
+ RaiseError(EPNGUnknownCriticalChunk, EPNGUnknownCriticalChunkText);
+ end;
+ {$ENDIF}
+
+ {Loads it}
+ try if not TChunk(Chunks.Item[ChunkCount - 1]).LoadFromStream(Stream,
+ ChunkName, ChunkLength) then break;
+ except
+ Chunks.Count := ChunkCount;
+ raise;
+ end;
+
+ {Terminates when it reaches the IEND chunk}
+ until (ChunkName = 'IEND');
+
+ {Resize the list to the appropriate size}
+ Chunks.Count := ChunkCount;
+
+ {Check if there is data}
+ if not HasIDAT then
+ RaiseError(EPNGNoImageData, EPNGNoImageDataText);
+end;
+
+{Changing height is not supported}
+procedure TPngObject.SetHeight(Value: Integer);
+begin
+ RaiseError(EPNGError, EPNGCannotChangeSizeText);
+end;
+
+{Changing width is not supported}
+procedure TPngObject.SetWidth(Value: Integer);
+begin
+ RaiseError(EPNGError, EPNGCannotChangeSizeText);
+end;
+
+{$IFDEF UseDelphi}
+{Saves to clipboard format (thanks to Antoine Pottern)}
+procedure TPNGObject.SaveToClipboardFormat(var AFormat: Word;
+ var AData: THandle; var APalette: HPalette);
+begin
+ with TBitmap.Create do
+ try
+ Width := Self.Width;
+ Height := Self.Height;
+ Self.Draw(Canvas, Rect(0, 0, Width, Height));
+ SaveToClipboardFormat(AFormat, AData, APalette);
+ finally
+ Free;
+ end {try}
+end;
+
+{Loads data from clipboard}
+procedure TPngObject.LoadFromClipboardFormat(AFormat: Word;
+ AData: THandle; APalette: HPalette);
+begin
+ with TBitmap.Create do
+ try
+ LoadFromClipboardFormat(AFormat, AData, APalette);
+ Self.AssignHandle(Handle, False, 0);
+ finally
+ Free;
+ end {try}
+end;
+
+{Returns if the image is transparent}
+function TPngObject.GetTransparent: Boolean;
+begin
+ Result := (TransparencyMode <> ptmNone);
+end;
+
+{$ENDIF}
+
+{Saving the PNG image to a stream of data}
+procedure TPngObject.SaveToStream(Stream: TStream);
+var
+ j: Integer;
+begin
+ {Reads the header}
+ Stream.Write(PNGHeader[0], 8);
+ {Write each chunk}
+ FOR j := 0 TO Chunks.Count - 1 DO
+ Chunks.Item[j].SaveToStream(Stream)
+end;
+
+{Prepares the Header chunk}
+procedure BuildHeader(Header: TChunkIHDR; Handle: HBitmap; Info: pBitmap;
+ HasPalette: Boolean);
+var
+ DC: HDC;
+begin
+ {Set width and height}
+ Header.Width := Info.bmWidth;
+ Header.Height := abs(Info.bmHeight);
+ {Set bit depth}
+ if Info.bmBitsPixel >= 16 then
+ Header.BitDepth := 8 else Header.BitDepth := Info.bmBitsPixel;
+ {Set color type}
+ if Info.bmBitsPixel >= 16 then
+ Header.ColorType := COLOR_RGB else Header.ColorType := COLOR_PALETTE;
+ {Set other info}
+ Header.CompressionMethod := 0; {deflate/inflate}
+ Header.InterlaceMethod := 0; {no interlace}
+
+ {Prepares bitmap headers to hold data}
+ Header.PrepareImageData();
+ {Copy image data}
+ DC := CreateCompatibleDC(0);
+ GetDIBits(DC, Handle, 0, Header.Height, Header.ImageData,
+ pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS);
+ DeleteDC(DC);
+end;
+
+{Loads the image from a resource}
+procedure TPngObject.LoadFromResourceName(Instance: HInst;
+ const Name: String);
+var
+ ResStream: TResourceStream;
+begin
+ {Creates an especial stream to load from the resource}
+ try ResStream := TResourceStream.Create(Instance, Name, RT_RCDATA);
+ except RaiseError(EPNGCouldNotLoadResource, EPNGCouldNotLoadResourceText);
+ exit; end;
+
+ {Loads the png image from the resource}
+ try
+ LoadFromStream(ResStream);
+ finally
+ ResStream.Free;
+ end;
+end;
+
+{Loads the png from a resource ID}
+procedure TPngObject.LoadFromResourceID(Instance: HInst; ResID: Integer);
+begin
+ LoadFromResourceName(Instance, String(ResID));
+end;
+
+{Assigns this tpngobject to another object}
+procedure TPngObject.AssignTo(Dest: TPersistent);
+{$IFDEF UseDelphi}
+var
+ DeskDC: HDC;
+ TRNS: TChunkTRNS;
+{$ENDIF}
+begin
+ {If the destination is also a TPNGObject make it assign}
+ {this one}
+ if Dest is TPNGObject then
+ TPNGObject(Dest).AssignPNG(Self)
+ {$IFDEF UseDelphi}
+ {In case the destination is a bitmap}
+ else if (Dest is TBitmap) and HeaderPresent then
+ begin
+ {Device context}
+ DeskDC := GetDC(0);
+ {Copy the data}
+ TBitmap(Dest).Handle := CreateDIBitmap(DeskDC,
+ Header.BitmapInfo.bmiHeader, CBM_INIT, Header.ImageData,
+ pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS);
+ ReleaseDC(0, DeskDC);
+ {Tests for the best pixelformat}
+ case Header.BitmapInfo.bmiHeader.biBitCount of
+ 1: TBitmap(Dest).PixelFormat := pf1Bit;
+ 4: TBitmap(Dest).PixelFormat := pf4Bit;
+ 8: TBitmap(Dest).PixelFormat := pf8Bit;
+ 24: TBitmap(Dest).PixelFormat := pf24Bit;
+ 32: TBitmap(Dest).PixelFormat := pf32Bit;
+ end {case Header.BitmapInfo.bmiHeader.biBitCount};
+
+ {Copy transparency mode}
+ if (TransparencyMode = ptmBit) then
+ begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ TBitmap(Dest).TransparentColor := TRNS.TransparentColor;
+ TBitmap(Dest).Transparent := True
+ end {if (TransparencyMode = ptmBit)}
+
+ end
+ else
+ {Unknown destination kind, }
+ inherited AssignTo(Dest);
+ {$ENDIF}
+end;
+
+{Assigns from a bitmap object}
+procedure TPngObject.AssignHandle(Handle: HBitmap; Transparent: Boolean;
+ TransparentColor: ColorRef);
+var
+ BitmapInfo: Windows.TBitmap;
+ HasPalette: Boolean;
+
+ {Chunks}
+ Header: TChunkIHDR;
+ PLTE: TChunkPLTE;
+ IDAT: TChunkIDAT;
+ IEND: TChunkIEND;
+ TRNS: TChunkTRNS;
+begin
+ {Obtain bitmap info}
+ GetObject(Handle, SizeOf(BitmapInfo), @BitmapInfo);
+
+ {Only bit depths 1, 4 and 8 needs a palette}
+ HasPalette := (BitmapInfo.bmBitsPixel < 16);
+
+ {Clear old chunks and prepare}
+ ClearChunks();
+
+ {Create the chunks}
+ Header := TChunkIHDR.Create(Self);
+ if HasPalette then PLTE := TChunkPLTE.Create(Self) else PLTE := nil;
+ if Transparent then TRNS := TChunkTRNS.Create(Self) else TRNS := nil;
+ IDAT := TChunkIDAT.Create(Self);
+ IEND := TChunkIEND.Create(Self);
+
+ {Add chunks}
+ TPNGPointerList(Chunks).Add(Header);
+ if HasPalette then TPNGPointerList(Chunks).Add(PLTE);
+ if Transparent then TPNGPointerList(Chunks).Add(TRNS);
+ TPNGPointerList(Chunks).Add(IDAT);
+ TPNGPointerList(Chunks).Add(IEND);
+
+ {This method will fill the Header chunk with bitmap information}
+ {and copy the image data}
+ BuildHeader(Header, Handle, @BitmapInfo, HasPalette);
+ {In case there is a image data, set the PLTE chunk fCount variable}
+ {to the actual number of palette colors which is 2^(Bits for each pixel)}
+ if HasPalette then PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel;
+
+ {In case it is a transparent bitmap, prepares it}
+ if Transparent then TRNS.TransparentColor := TransparentColor;
+
+end;
+
+{Assigns from another PNG}
+procedure TPngObject.AssignPNG(Source: TPNGObject);
+var
+ J: Integer;
+begin
+ {Copy properties}
+ InterlaceMethod := Source.InterlaceMethod;
+ MaxIdatSize := Source.MaxIdatSize;
+ CompressionLevel := Source.CompressionLevel;
+ Filters := Source.Filters;
+
+ {Clear old chunks and prepare}
+ ClearChunks();
+ Chunks.Count := Source.Chunks.Count;
+ {Create chunks and makes a copy from the source}
+ FOR J := 0 TO Chunks.Count - 1 DO
+ with Source.Chunks do
+ begin
+ Chunks.SetItem(J, TChunkClass(TChunk(Item[J]).ClassType).Create(Self));
+ TChunk(Chunks.Item[J]).Assign(TChunk(Item[J]));
+ end {with};
+end;
+
+{Returns a alpha data scanline}
+function TPngObject.GetAlphaScanline(const LineIndex: Integer): pByteArray;
+begin
+ with Header do
+ if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
+ Longint(Result) := Longint(ImageAlpha) + (LineIndex * Longint(Width))
+ else Result := nil; {In case the image does not use alpha information}
+end;
+
+{$IFDEF Store16bits}
+{Returns a png data extra scanline}
+function TPngObject.GetExtraScanline(const LineIndex: Integer): Pointer;
+begin
+ with Header do
+ Longint(Result) := (Longint(ExtraImageData) + ((Longint(Height) - 1) *
+ BytesPerRow)) - (LineIndex * BytesPerRow);
+end;
+{$ENDIF}
+
+{Returns a png data scanline}
+function TPngObject.GetScanline(const LineIndex: Integer): Pointer;
+begin
+ with Header do
+ Longint(Result) := (Longint(ImageData) + ((Longint(Height) - 1) *
+ BytesPerRow)) - (LineIndex * BytesPerRow);
+end;
+
+{Initialize gamma table}
+procedure TPngObject.InitializeGamma;
+var
+ i: Integer;
+begin
+ {Build gamma table as if there was no gamma}
+ FOR i := 0 to 255 do
+ begin
+ GammaTable[i] := i;
+ InverseGamma[i] := i;
+ end {for i}
+end;
+
+{Returns the transparency mode used by this png}
+function TPngObject.GetTransparencyMode: TPNGTransparencyMode;
+var
+ TRNS: TChunkTRNS;
+begin
+ with Header do
+ begin
+ Result := ptmNone; {Default result}
+ {Gets the TRNS chunk pointer}
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+
+ {Test depending on the color type}
+ case ColorType of
+ {This modes are always partial}
+ COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Result := ptmPartial;
+ {This modes support bit transparency}
+ COLOR_RGB, COLOR_GRAYSCALE: if TRNS <> nil then Result := ptmBit;
+ {Supports booth translucid and bit}
+ COLOR_PALETTE:
+ {A TRNS chunk must be present, otherwise it won't support transparency}
+ if TRNS <> nil then
+ if TRNS.BitTransparency then
+ Result := ptmBit else Result := ptmPartial
+ end {case}
+
+ end {with Header}
+end;
+
+{Add a text chunk}
+procedure TPngObject.AddtEXt(const Keyword, Text: String);
+var
+ TextChunk: TChunkTEXT;
+begin
+ TextChunk := Chunks.Add(TChunkText) as TChunkTEXT;
+ TextChunk.Keyword := Keyword;
+ TextChunk.Text := Text;
+end;
+
+{Add a text chunk}
+procedure TPngObject.AddzTXt(const Keyword, Text: String);
+var
+ TextChunk: TChunkzTXt;
+begin
+ TextChunk := Chunks.Add(TChunkText) as TChunkzTXt;
+ TextChunk.Keyword := Keyword;
+ TextChunk.Text := Text;
+end;
+
+{Removes the image transparency}
+procedure TPngObject.RemoveTransparency;
+var
+ TRNS: TChunkTRNS;
+begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ if TRNS <> nil then Chunks.RemoveChunk(TRNS)
+end;
+
+{Generates alpha information}
+procedure TPngObject.CreateAlpha;
+var
+ TRNS: TChunkTRNS;
+begin
+ {Generates depending on the color type}
+ with Header do
+ case ColorType of
+ {Png allocates different memory space to hold alpha information}
+ {for these types}
+ COLOR_GRAYSCALE, COLOR_RGB:
+ begin
+ {Transform into the appropriate color type}
+ if ColorType = COLOR_GRAYSCALE then
+ ColorType := COLOR_GRAYSCALEALPHA
+ else ColorType := COLOR_RGBALPHA;
+ {Allocates memory to hold alpha information}
+ GetMem(ImageAlpha, Integer(Width) * Integer(Height));
+ FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #255);
+ end;
+ {Palette uses the TChunktRNS to store alpha}
+ COLOR_PALETTE:
+ begin
+ {Gets/creates TRNS chunk}
+ if Chunks.ItemFromClass(TChunkTRNS) = nil then
+ TRNS := Chunks.Add(TChunkTRNS) as TChunkTRNS
+ else
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+
+ {Prepares the TRNS chunk}
+ with TRNS do
+ begin
+ Fillchar(PaletteValues[0], 256, 255);
+ fDataSize := 1 shl Header.BitDepth;
+ fBitTransparency := False
+ end {with Chunks.Add};
+ end;
+ end {case Header.ColorType}
+
+end;
+
+{Returns transparent color}
+function TPngObject.GetTransparentColor: TColor;
+var
+ TRNS: TChunkTRNS;
+begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ {Reads the transparency chunk to get this info}
+ if Assigned(TRNS) then Result := TRNS.TransparentColor
+ else Result := 0
+end;
+
+{$OPTIMIZATION OFF}
+procedure TPngObject.SetTransparentColor(const Value: TColor);
+var
+ TRNS: TChunkTRNS;
+begin
+ if HeaderPresent then
+ {Tests the ColorType}
+ case Header.ColorType of
+ {Not allowed for this modes}
+ COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Self.RaiseError(
+ EPNGCannotChangeTransparent, EPNGCannotChangeTransparentText);
+ {Allowed}
+ COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE:
+ begin
+ TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
+ if not Assigned(TRNS) then TRNS := Chunks.Add(TChunkTRNS) as TChunkTRNS;
+
+ {Sets the transparency value from TRNS chunk}
+ TRNS.TransparentColor := {$IFDEF UseDelphi}ColorToRGB({$ENDIF}Value{$IFDEF UseDelphi}){$ENDIF}
+ end {COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE)}
+ end {case}
+end;
+
+{Returns if header is present}
+function TPngObject.HeaderPresent: Boolean;
+begin
+ Result := ((Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR))
+end;
+
+{Returns pixel for png using palette and grayscale}
+function GetByteArrayPixel(const png: TPngObject; const X, Y: Integer): TColor;
+var
+ ByteData: Byte;
+ DataDepth: Byte;
+begin
+ with png, Header do
+ begin
+ {Make sure the bitdepth is not greater than 8}
+ DataDepth := BitDepth;
+ if DataDepth > 8 then DataDepth := 8;
+ {Obtains the byte containing this pixel}
+ ByteData := pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)];
+ {Moves the bits we need to the right}
+ ByteData := (ByteData shr ((8 - DataDepth) -
+ (X mod (8 div DataDepth)) * DataDepth));
+ {Discard the unwanted pixels}
+ ByteData:= ByteData and ($FF shr (8 - DataDepth));
+
+ {For palette mode map the palette entry and for grayscale convert and
+ returns the intensity}
+ case ColorType of
+ COLOR_PALETTE:
+ with TChunkPLTE(png.Chunks.ItemFromClass(TChunkPLTE)).Item[ByteData] do
+ Result := rgb(GammaTable[rgbRed], GammaTable[rgbGreen],
+ GammaTable[rgbBlue]);
+ COLOR_GRAYSCALE:
+ begin
+ ByteData := GammaTable[ByteData * ((1 shl DataDepth) + 1)];
+ Result := rgb(ByteData, ByteData, ByteData);
+ end;
+ else Result := 0;
+ end {case};
+ end {with}
+end;
+
+{In case vcl units are not being used}
+{$IFNDEF UseDelphi}
+function ColorToRGB(const Color: TColor): COLORREF;
+begin
+ Result := Color
+end;
+{$ENDIF}
+
+{Sets a pixel for grayscale and palette pngs}
+procedure SetByteArrayPixel(const png: TPngObject; const X, Y: Integer;
+ const Value: TColor);
+const
+ ClearFlag: Array[1..8] of Integer = (1, 3, 0, 15, 0, 0, 0, $FF);
+var
+ ByteData: pByte;
+ DataDepth: Byte;
+ ValEntry: Byte;
+begin
+ with png.Header do
+ begin
+ {Map into a palette entry}
+ ValEntry := GetNearestPaletteIndex(Png.Palette, ColorToRGB(Value));
+
+ {16 bits grayscale extra bits are discarted}
+ DataDepth := BitDepth;
+ if DataDepth > 8 then DataDepth := 8;
+ {Gets a pointer to the byte we intend to change}
+ ByteData := @pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)];
+ {Clears the old pixel data}
+ ByteData^ := ByteData^ and not (ClearFlag[DataDepth] shl ((8 - DataDepth) -
+ (X mod (8 div DataDepth)) * DataDepth));
+
+ {Setting the new pixel}
+ ByteData^ := ByteData^ or (ValEntry shl ((8 - DataDepth) - (X mod (8 div DataDepth)) * DataDepth));
+ end {with png.Header}
+end;
+
+{Returns pixel when png uses RGB}
+function GetRGBLinePixel(const png: TPngObject;
+ const X, Y: Integer): TColor;
+begin
+ with pRGBLine(png.Scanline[Y])^[X] do
+ Result := RGB(rgbtRed, rgbtGreen, rgbtBlue)
+end;
+
+{Sets pixel when png uses RGB}
+procedure SetRGBLinePixel(const png: TPngObject;
+ const X, Y: Integer; Value: TColor);
+begin
+ with pRGBLine(png.Scanline[Y])^[X] do
+ begin
+ rgbtRed := GetRValue(Value);
+ rgbtGreen := GetGValue(Value);
+ rgbtBlue := GetBValue(Value)
+ end
+end;
+
+{Sets a pixel}
+procedure TPngObject.SetPixels(const X, Y: Integer; const Value: TColor);
+begin
+ if (X in [0..Width - 1]) and (Y in [0..Height - 1]) then
+ with Header do
+ begin
+ if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
+ SetByteArrayPixel(Self, X, Y, Value)
+ else
+ SetRGBLinePixel(Self, X, Y, Value)
+ end {with}
+end;
+
+{Returns a pixel}
+function TPngObject.GetPixels(const X, Y: Integer): TColor;
+begin
+ if (X in [0..Width - 1]) and (Y in [0..Height - 1]) then
+ with Header do
+ begin
+ if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
+ Result := GetByteArrayPixel(Self, X, Y)
+ else
+ Result := GetRGBLinePixel(Self, X, Y)
+ end {with}
+ else Result := 0
+end;
+
+{Returns the image palette}
+function TPngObject.GetPalette: HPALETTE;
+var
+ LogPalette: TMaxLogPalette;
+ i: Integer;
+begin
+ {Palette is avaliable for COLOR_PALETTE and COLOR_GRAYSCALE modes}
+ if (Header.ColorType in [COLOR_PALETTE, COLOR_GRAYSCALE]) then
+ begin
+ {In case the pal}
+ if TempPalette = 0 then
+ with LogPalette do
+ begin
+ {Prepares the new palette}
+ palVersion := $300;
+ palNumEntries := 256;
+ {Copy entries}
+ for i := 0 to LogPalette.palNumEntries - 1 do
+ begin
+ palPalEntry[i].peRed := Header.BitmapInfo.bmiColors[i].rgbRed;
+ palPalEntry[i].peGreen := Header.BitmapInfo.bmiColors[i].rgbGreen;
+ palPalEntry[i].peBlue := Header.BitmapInfo.bmiColors[i].rgbBlue;
+ palPalEntry[i].peFlags := 0;
+ end {for i};
+ {Creates the palette}
+ TempPalette := CreatePalette(pLogPalette(@LogPalette)^);
+ end {with LogPalette, if Temppalette = 0}
+ end {if Header.ColorType in ...};
+ Result := TempPalette;
+end;
+
+initialization
+ {Initialize}
+ ChunkClasses := nil;
+ {crc table has not being computed yet}
+ crc_table_computed := FALSE;
+ {Register the necessary chunks for png}
+ RegisterCommonChunks;
+ {Registers TPNGObject to use with TPicture}
+ {$IFDEF UseDelphi}{$IFDEF RegisterGraphic}
+ TPicture.RegisterFileFormat('PNG', 'Portable Network Graphics', TPNGObject);
+ {$ENDIF}{$ENDIF}
+finalization
+ {$IFDEF UseDelphi}{$IFDEF RegisterGraphic}
+ TPicture.UnregisterGraphicClass(TPNGObject);
+ {$ENDIF}{$ENDIF}
+ {Free chunk classes}
+ FreeChunkClassList;
+end.
+
+
diff --git a/Game/Code/lib/PngImage/pnglang.pas b/Game/Code/lib/PngImage/pnglang.pas new file mode 100644 index 00000000..7a9c5078 --- /dev/null +++ b/Game/Code/lib/PngImage/pnglang.pas @@ -0,0 +1,301 @@ +{Portable Network Graphics Delphi Language Info (24 July 2002)}
+
+{Feel free to change the text bellow to adapt to your language}
+{Also if you have a translation to other languages and want to}
+{share it, send me: gubadaud@terra.com.br }
+unit pnglang;
+
+interface
+
+{$DEFINE English}
+{.$DEFINE Portuguese}
+{.$DEFINE German}
+{.$DEFINE French}
+{.$DEFINE Slovenian}
+
+{Language strings for english}
+resourcestring
+ {$IFDEF English}
+ EPngInvalidCRCText = 'This "Portable Network Graphics" image is not valid ' +
+ 'because it contains invalid pieces of data (crc error)';
+ EPNGInvalidIHDRText = 'The "Portable Network Graphics" image could not be ' +
+ 'loaded because one of its main piece of data (ihdr) might be corrupted';
+ EPNGMissingMultipleIDATText = 'This "Portable Network Graphics" image is ' +
+ 'invalid because it has missing image parts.';
+ EPNGZLIBErrorText = 'Could not decompress the image because it contains ' +
+ 'invalid compressed data.'#13#10 + ' Description: ';
+ EPNGInvalidPaletteText = 'The "Portable Network Graphics" image contains ' +
+ 'an invalid palette.';
+ EPNGInvalidFileHeaderText = 'The file being readed is not a valid '+
+ '"Portable Network Graphics" image because it contains an invalid header.' +
+ ' This file may be corruped, try obtaining it again.';
+ EPNGIHDRNotFirstText = 'This "Portable Network Graphics" image is not ' +
+ 'supported or it might be invalid.'#13#10 + '(IHDR chunk is not the first)';
+ EPNGNotExistsText = 'The png file could not be loaded because it does not ' +
+ 'exists.';
+ EPNGSizeExceedsText = 'This "Portable Network Graphics" image is not ' +
+ 'supported because either it''s width or height exceeds the maximum ' +
+ 'size, which is 65535 pixels length.';
+ EPNGUnknownPalEntryText = 'There is no such palette entry.';
+ EPNGMissingPaletteText = 'This "Portable Network Graphics" could not be ' +
+ 'loaded because it uses a color table which is missing.';
+ EPNGUnknownCriticalChunkText = 'This "Portable Network Graphics" image ' +
+ 'contains an unknown critical part which could not be decoded.';
+ EPNGUnknownCompressionText = 'This "Portable Network Graphics" image is ' +
+ 'encoded with an unknown compression scheme which could not be decoded.';
+ EPNGUnknownInterlaceText = 'This "Portable Network Graphics" image uses ' +
+ 'an unknown interlace scheme which could not be decoded.';
+ EPNGCannotAssignChunkText = 'The chunks must be compatible to be assigned.';
+ EPNGUnexpectedEndText = 'This "Portable Network Graphics" image is invalid ' +
+ 'because the decoder found an unexpected end of the file.';
+ EPNGNoImageDataText = 'This "Portable Network Graphics" image contains no ' +
+ 'data.';
+ EPNGCannotChangeSizeText = 'The "Portable Network Graphics" image can not ' +
+ 'be resize by changing width and height properties. Try assigning the ' +
+ 'image from a bitmap.';
+ EPNGCannotAddChunkText = 'The program tried to add a existent critical ' +
+ 'chunk to the current image which is not allowed.';
+ EPNGCannotAddInvalidImageText = 'It''s not allowed to add a new chunk ' +
+ 'because the current image is invalid.';
+ EPNGCouldNotLoadResourceText = 'The png image could not be loaded from the ' +
+ 'resource ID.';
+ EPNGOutMemoryText = 'Some operation could not be performed because the ' +
+ 'system is out of resources. Close some windows and try again.';
+ EPNGCannotChangeTransparentText = 'Setting bit transparency color is not ' +
+ 'allowed for png images containing alpha value for each pixel ' +
+ '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'This operation is not valid because the ' +
+ 'current image contains no valid header.';
+ {$ENDIF}
+ {$IFDEF Portuguese}
+ EPngInvalidCRCText = 'Essa imagem "Portable Network Graphics" năo é válida ' +
+ 'porque contém chunks inválidos de dados (erro crc)';
+ EPNGInvalidIHDRText = 'A imagem "Portable Network Graphics" năo pode ser ' +
+ 'carregada porque um dos seus chunks importantes (ihdr) pode estar '+
+ 'inválido';
+ EPNGMissingMultipleIDATText = 'Essa imagem "Portable Network Graphics" é ' +
+ 'inválida porque tem chunks de dados faltando.';
+ EPNGZLIBErrorText = 'Năo foi possível descomprimir os dados da imagem ' +
+ 'porque ela contém dados inválidos.'#13#10 + ' Descriçăo: ';
+ EPNGInvalidPaletteText = 'A imagem "Portable Network Graphics" contém ' +
+ 'uma paleta inválida.';
+ EPNGInvalidFileHeaderText = 'O arquivo sendo lido năo é uma imagem '+
+ '"Portable Network Graphics" válida porque contém um cabeçalho inválido.' +
+ ' O arquivo pode estar corrompida, tente obter ela novamente.';
+ EPNGIHDRNotFirstText = 'Essa imagem "Portable Network Graphics" năo é ' +
+ 'suportada ou pode ser inválida.'#13#10 + '(O chunk IHDR năo é o ' +
+ 'primeiro)';
+ EPNGNotExistsText = 'A imagem png năo pode ser carregada porque ela năo ' +
+ 'existe.';
+ EPNGSizeExceedsText = 'Essa imagem "Portable Network Graphics" năo é ' +
+ 'suportada porque a largura ou a altura ultrapassam o tamanho máximo, ' +
+ 'que é de 65535 pixels de diâmetro.';
+ EPNGUnknownPalEntryText = 'Năo existe essa entrada de paleta.';
+ EPNGMissingPaletteText = 'Essa imagem "Portable Network Graphics" năo pode ' +
+ 'ser carregada porque usa uma paleta que está faltando.';
+ EPNGUnknownCriticalChunkText = 'Essa imagem "Portable Network Graphics" ' +
+ 'contém um chunk crítico desconheçido que năo pode ser decodificado.';
+ EPNGUnknownCompressionText = 'Essa imagem "Portable Network Graphics" está ' +
+ 'codificada com um esquema de compressăo desconheçido e năo pode ser ' +
+ 'decodificada.';
+ EPNGUnknownInterlaceText = 'Essa imagem "Portable Network Graphics" usa um ' +
+ 'um esquema de interlace que năo pode ser decodificado.';
+ EPNGCannotAssignChunkText = 'Os chunk devem ser compatíveis para serem ' +
+ 'copiados.';
+ EPNGUnexpectedEndText = 'Essa imagem "Portable Network Graphics" é ' +
+ 'inválida porque o decodificador encontrou um fim inesperado.';
+ EPNGNoImageDataText = 'Essa imagem "Portable Network Graphics" năo contém ' +
+ 'dados.';
+ EPNGCannotChangeSizeText = 'A imagem "Portable Network Graphics" năo pode ' +
+ 'ser redimensionada mudando as propriedades width e height. Tente ' +
+ 'copiar a imagem de um bitmap usando a funçăo assign.';
+ EPNGCannotAddChunkText = 'O programa tentou adicionar um chunk crítico ' +
+ 'já existente para a imagem atual, oque năo é permitido.';
+ EPNGCannotAddInvalidImageText = 'Năo é permitido adicionar um chunk novo ' +
+ 'porque a imagem atual é inválida.';
+ EPNGCouldNotLoadResourceText = 'A imagem png năo pode ser carregada apartir' +
+ ' do resource.';
+ EPNGOutMemoryText = 'Uma operaçăo năo pode ser completada porque o sistema ' +
+ 'está sem recursos. Fecha algumas janelas e tente novamente.';
+ EPNGCannotChangeTransparentText = 'Definir transparęncia booleana năo é ' +
+ 'permitido para imagens png contendo informaçăo alpha para cada pixel ' +
+ '(COLOR_RGBALPHA e COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Essa operaçăo năo é válida porque a ' +
+ 'imagem atual năo contém um cabeçalho válido.';
+ {$ENDIF}
+ {Language strings for German}
+ {$IFDEF German}
+ EPngInvalidCRCText = 'Dieses "Portable Network Graphics" Image ist ' +
+ 'ungültig, weil Teile der Daten ungültig sind (CRC-Fehler).';
+ EPNGInvalidIHDRText = 'Dieses "Portable Network Graphics" Image konnte ' +
+ 'nicht geladen werden, weil eine der Hauptdaten (IHDR) beschädigt ' +
+ 'sein könnte.';
+ EPNGMissingMultipleIDATText = 'Dieses "Portable Network Graphics" Image ' +
+ 'ist ungültig, weil Grafikdaten fehlen.';
+ EPNGZLIBErrorText = 'Die Grafik konnte nicht entpackt werden, weil sie ' +
+ 'fehlerhafte komprimierte Daten enthält.'#13#10 + ' Beschreibung: ';
+ EPNGInvalidPaletteText = 'Das "Portable Network Graphics" Image enthält ' +
+ 'eine ungültige Palette.';
+ EPNGInvalidFileHeaderText = 'Die Datei, die gelesen wird, ist kein ' +
+ 'gültiges "Portable Network Graphics" Image, da es keinen gültigen ' +
+ 'Header enthält. Die Datei könnte beschädigt sein, versuchen Sie, ' +
+ 'eine neue Kopie zu bekommen.';
+ EPNGIHDRNotFirstText = 'Dieses "Portable Network Graphics" Image wird ' +
+ 'nicht unterstützt bzw. es könnte ungültig sein.'#13#10 +
+ '(Der IHDR-Chunk ist nicht der erste Chunk in der Datei).';
+ EPNGNotExistsText = 'Die PNG Datei konnte nicht geladen werden, da sie ' +
+ 'nicht existiert.';
+ EPNGSizeExceedsText = 'Dieses "Portable Network Graphics" Image wird nicht ' +
+ 'unterstützt, weil entweder seine Breite oder seine Höhe das Maximum von ' +
+ '65535 Pixeln überschreitet.';
+ EPNGUnknownPalEntryText = 'Es gibt keinen solchen Palettenwert.';
+ EPNGMissingPaletteText = 'Dieses "Portable Network Graphics" Image konnte ' +
+ 'nicht geladen werden, weil die benötigte Farbtabelle fehlt.';
+ EPNGUnknownCriticalChunkText = 'Dieses "Portable Network Graphics" Image ' +
+ 'enhält einen unbekannten kritischen Teil, welcher nicht entschlüsselt ' +
+ 'werden kann.';
+ EPNGUnknownCompressionText = 'Dieses "Portable Network Graphics" Image ' +
+ 'wurde mit einem unbekannten Komprimierungsalgorithmus kodiert, welcher ' +
+ 'nicht entschlüsselt werden kann.';
+ EPNGUnknownInterlaceText = 'Dieses "Portable Network Graphics" Image ' +
+ 'benutzt ein unbekanntes Interlace-Schema, welcher nicht entschlüsselt ' +
+ 'werden kann.';
+ EPNGCannotAssignChunkText = 'Die Chunks müssen kompatibel sein, um ' +
+ 'zugewiesen werden zu können.';
+ EPNGUnexpectedEndText = 'Dieses "Portable Network Graphics" Image ist ' +
+ 'ungültig, der Dekoder stieß unerwarteterweise auf das Ende der Datei.';
+ EPNGNoImageDataText = 'Dieses "Portable Network Graphics" Image enthält ' +
+ 'keine Daten.';
+ EPNGCannotChangeSizeText = 'Das "Portable Network Graphics" Image kann ' +
+ 'nicht durch Ändern der Eigenschaften Width und Height in seinen ' +
+ 'Abmessungen geändert werden. Versuchen Sie das Image von einer Bitmap ' +
+ 'aus zuzuweisen.';
+ EPNGCannotAddChunkText = 'Das Programm versucht einen existierenden ' +
+ 'kritischen Chunk zum aktuellen Image hinzuzufügen. Dies ist nicht ' +
+ 'zulässig.';
+ EPNGCannotAddInvalidImageText = 'Es ist nicht zulässig, dem aktuellen ' +
+ 'Image einen neuen Chunk hinzuzufügen, da es ungültig ist.';
+ EPNGCouldNotLoadResourceText = 'Das PNG Image konnte nicht von den ' +
+ 'Resourcendaten geladen werden.';
+ EPNGOutMemoryText = 'Es stehen nicht genügend Resourcen im System zur ' +
+ 'Verfügung, um die Operation auszuführen. Schließen Sie einige Fenster '+
+ 'und versuchen Sie es erneut.';
+ EPNGCannotChangeTransparentText = 'Das Setzen der Bit-' +
+ 'Transparent-Farbe ist fuer PNG-Images die Alpha-Werte fuer jedes ' +
+ 'Pixel enthalten (COLOR_RGBALPHA und COLOR_GRAYSCALEALPHA) nicht ' +
+ 'zulaessig';
+ EPNGHeaderNotPresentText = 'Die Datei, die gelesen wird, ist kein ' +
+ 'gültiges "Portable Network Graphics" Image, da es keinen gültigen ' +
+ 'Header enthält.';
+ {$ENDIF}
+ {Language strings for French}
+ {$IFDEF French}
+ EPngInvalidCRCText = 'Cette image "Portable Network Graphics" n''est pas valide ' +
+ 'car elle contient des données invalides (erreur crc)';
+ EPNGInvalidIHDRText = 'Cette image "Portable Network Graphics" n''a pu ętre ' +
+ 'chargée car l''une de ses principale donnée (ihdr) doit ętre corrompue';
+ EPNGMissingMultipleIDATText = 'Cette image "Portable Network Graphics" est ' +
+ 'invalide car elle contient des parties d''image manquantes.';
+ EPNGZLIBErrorText = 'Impossible de décompresser l''image car elle contient ' +
+ 'des données compressées invalides.'#13#10 + ' Description: ';
+ EPNGInvalidPaletteText = 'L''image "Portable Network Graphics" contient ' +
+ 'une palette invalide.';
+ EPNGInvalidFileHeaderText = 'Le fichier actuellement lu est une image '+
+ '"Portable Network Graphics" invalide car elle contient un en-tęte invalide.' +
+ ' Ce fichier doit ętre corrompu, essayer de l''obtenir ŕ nouveau.';
+ EPNGIHDRNotFirstText = 'Cette image "Portable Network Graphics" n''est pas ' +
+ 'supportée ou doit ętre invalide.'#13#10 + '(la partie IHDR n''est pas la premičre)';
+ EPNGNotExistsText = 'Le fichier png n''a pu ętre chargé car il n''éxiste pas.';
+ EPNGSizeExceedsText = 'Cette image "Portable Network Graphics" n''est pas supportée ' +
+ 'car sa longueur ou sa largeur excčde la taille maximale, qui est de 65535 pixels.';
+ EPNGUnknownPalEntryText = 'Il n''y a aucune entrée pour cette palette.';
+ EPNGMissingPaletteText = 'Cette image "Portable Network Graphics" n''a pu ętre ' +
+ 'chargée car elle utilise une table de couleur manquante.';
+ EPNGUnknownCriticalChunkText = 'Cette image "Portable Network Graphics" ' +
+ 'contient une partie critique inconnue qui n'' pu ętre décodée.';
+ EPNGUnknownCompressionText = 'Cette image "Portable Network Graphics" est ' +
+ 'encodée ŕ l''aide d''un schémas de compression inconnu qui ne peut ętre décodé.';
+ EPNGUnknownInterlaceText = 'Cette image "Portable Network Graphics" utilise ' +
+ 'un schémas d''entrelacement inconnu qui ne peut ętre décodé.';
+ EPNGCannotAssignChunkText = 'Ce morceau doit ętre compatible pour ętre assigné.';
+ EPNGUnexpectedEndText = 'Cette image "Portable Network Graphics" est invalide ' +
+ 'car le decodeur est arrivé ŕ une fin de fichier non attendue.';
+ EPNGNoImageDataText = 'Cette image "Portable Network Graphics" ne contient pas de ' +
+ 'données.';
+ EPNGCannotChangeSizeText = 'Cette image "Portable Network Graphics" ne peut pas ' +
+ 'ętre retaillée en changeant ses propriétés width et height. Essayer d''assigner l''image depuis ' +
+ 'un bitmap.';
+ EPNGCannotAddChunkText = 'Le programme a essayé d''ajouter un morceau critique existant ' +
+ 'ŕ l''image actuelle, ce qui n''est pas autorisé.';
+ EPNGCannotAddInvalidImageText = 'Il n''est pas permis d''ajouter un nouveau morceau ' +
+ 'car l''image actuelle est invalide.';
+ EPNGCouldNotLoadResourceText = 'L''image png n''a pu ętre chargée depuis ' +
+ 'l''ID ressource.';
+ EPNGOutMemoryText = 'Certaines opérations n''ont pu ętre effectuée car le ' +
+ 'systčme n''a plus de ressources. Fermez quelques fenętres et essayez ŕ nouveau.';
+ EPNGCannotChangeTransparentText = 'Définir le bit de transparence n''est pas ' +
+ 'permis pour des images png qui contiennent une valeur alpha pour chaque pixel ' +
+ '(COLOR_RGBALPHA et COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Cette opération n''est pas valide car l''image ' +
+ 'actuelle ne contient pas de header valide.';
+ EPNGAlphaNotSupportedText = 'Le type de couleur de l''image "Portable Network Graphics" actuelle ' +
+ 'contient déjŕ des informations alpha ou il ne peut ętre converti.';
+ {$ENDIF}
+ {Language strings for slovenian}
+ {$IFDEF Slovenian}
+ EPngInvalidCRCText = 'Ta "Portable Network Graphics" slika je neveljavna, ' +
+ 'ker vsebuje neveljavne dele podatkov (CRC napaka).';
+ EPNGInvalidIHDRText = 'Slike "Portable Network Graphics" ni bilo možno ' +
+ 'naložiti, ker je eden od glavnih delov podatkov (IHDR) verjetno pokvarjen.';
+ EPNGMissingMultipleIDATText = 'Ta "Portable Network Graphics" slika je ' +
+ 'naveljavna, ker manjkajo deli slike.';
+ EPNGZLIBErrorText = 'Ne morem raztegniti slike, ker vsebuje ' +
+ 'neveljavne stisnjene podatke.'#13#10 + ' Opis: ';
+ EPNGInvalidPaletteText = 'Slika "Portable Network Graphics" vsebuje ' +
+ 'neveljavno barvno paleto.';
+ EPNGInvalidFileHeaderText = 'Datoteka za branje ni veljavna '+
+ '"Portable Network Graphics" slika, ker vsebuje neveljavno glavo.' +
+ ' Datoteka je verjetno pokvarjena, poskusite jo ponovno naložiti.';
+ EPNGIHDRNotFirstText = 'Ta "Portable Network Graphics" slika ni ' +
+ 'podprta ali pa je neveljavna.'#13#10 + '(IHDR del datoteke ni prvi).';
+ EPNGNotExistsText = 'Ne morem naložiti png datoteke, ker ta ne ' +
+ 'obstaja.';
+ EPNGSizeExceedsText = 'Ta "Portable Network Graphics" slika ni ' +
+ 'podprta, ker ali njena širina ali višina presega najvecjo možno vrednost ' +
+ '65535 pik.';
+ EPNGUnknownPalEntryText = 'Slika nima vnešene take barvne palete.';
+ EPNGMissingPaletteText = 'Te "Portable Network Graphics" ne morem ' +
+ 'naložiti, ker uporablja manjkajoco barvno paleto.';
+ EPNGUnknownCriticalChunkText = 'Ta "Portable Network Graphics" slika ' +
+ 'vsebuje neznan kriticni del podatkov, ki ga ne morem prebrati.';
+ EPNGUnknownCompressionText = 'Ta "Portable Network Graphics" slika je ' +
+ 'kodirana z neznano kompresijsko shemo, ki je ne morem prebrati.';
+ EPNGUnknownInterlaceText = 'Ta "Portable Network Graphics" slika uporablja ' +
+ 'neznano shemo za preliv, ki je ne morem prebrati.';
+ EPNGCannotAssignChunkText = Košcki morajo biti med seboj kompatibilni za prireditev vrednosti.';
+ EPNGUnexpectedEndText = 'Ta "Portable Network Graphics" slika je neveljavna, ' +
+ 'ker je bralnik prišel do nepricakovanega konca datoteke.';
+ EPNGNoImageDataText = 'Ta "Portable Network Graphics" ne vsebuje nobenih ' +
+ 'podatkov.';
+ EPNGCannotChangeSizeText = 'Te "Portable Network Graphics" sliki ne morem ' +
+ 'spremeniti velikosti s spremembo lastnosti višine in širine. Poskusite ' +
+ 'sliko prirediti v bitno sliko.';
+ EPNGCannotAddChunkText = 'Program je poskusil dodati obstojeci kriticni ' +
+ 'kos podatkov k trenutni sliki, kar ni dovoljeno.';
+ EPNGCannotAddInvalidImageText = 'Ni dovoljeno dodati nov kos podatkov, ' +
+ 'ker trenutna slika ni veljavna.';
+ EPNGCouldNotLoadResourceText = 'Ne morem naložiti png slike iz ' +
+ 'skladišca.';
+ EPNGOutMemoryText = 'Ne morem izvesti operacije, ker je ' +
+ 'sistem ostal brez resorjev. Zaprite nekaj oken in poskusite znova.';
+ EPNGCannotChangeTransparentText = 'Ni dovoljeno nastaviti prosojnosti posamezne barve ' +
+ 'za png slike, ki vsebujejo alfa prosojno vrednost za vsako piko ' +
+ '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)';
+ EPNGHeaderNotPresentText = 'Ta operacija ni veljavna, ker ' +
+ 'izbrana slika ne vsebuje veljavne glave.';
+ {$ENDIF}
+
+
+implementation
+
+end.
diff --git a/Game/Code/lib/PngImage/pngzlib.pas b/Game/Code/lib/PngImage/pngzlib.pas new file mode 100644 index 00000000..3155946a --- /dev/null +++ b/Game/Code/lib/PngImage/pngzlib.pas @@ -0,0 +1,172 @@ +{Portable Network Graphics Delphi ZLIB linking (16 May 2002) }
+
+{This unit links ZLIB to pngimage unit in order to implement }
+{the library. It's now using the new ZLIB version, 1.1.4 }
+{Note: The .obj files must be located in the subdirectory \obj}
+
+unit pngzlib;
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+type
+
+ TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
+ TFree = procedure (AppData, Block: Pointer);
+
+ // Internal structure. Ignore.
+ TZStreamRec = packed record
+ next_in: PChar; // next input byte
+ avail_in: Integer; // number of bytes available at next_in
+ total_in: Integer; // total nb of input bytes read so far
+
+ next_out: PChar; // next output byte should be put here
+ avail_out: Integer; // remaining free space at next_out
+ total_out: Integer; // total nb of bytes output so far
+
+ msg: PChar; // last error message, NULL if no error
+ internal: Pointer; // not visible by applications
+
+ zalloc: TAlloc; // used to allocate the internal state
+ zfree: TFree; // used to free the internal state
+ AppData: Pointer; // private data object passed to zalloc and zfree
+
+ data_type: Integer; // best guess about the data type: ascii or binary
+ adler: Integer; // adler32 value of the uncompressed data
+ reserved: Integer; // reserved for future use
+ end;
+
+function inflateInit_(var strm: TZStreamRec; version: PChar; recsize: Integer): Integer; // forward;
+function inflate(var strm: TZStreamRec; flush: Integer): Integer; //forward;
+function inflateEnd(var strm: TZStreamRec): Integer; //forward;
+function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar; recsize: Integer): Integer; //forward;
+function deflate(var strm: TZStreamRec; flush: Integer): Integer; //forward;
+function deflateEnd(var strm: TZStreamRec): Integer; //forward;
+
+const
+ zlib_version = '1.1.4';
+
+function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
+
+
+const
+ Z_NO_FLUSH = 0;
+ Z_PARTIAL_FLUSH = 1;
+ Z_SYNC_FLUSH = 2;
+ Z_FULL_FLUSH = 3;
+ Z_FINISH = 4;
+
+ Z_OK = 0;
+ Z_STREAM_END = 1;
+ Z_NEED_DICT = 2;
+ Z_ERRNO = (-1);
+ Z_STREAM_ERROR = (-2);
+ Z_DATA_ERROR = (-3);
+ Z_MEM_ERROR = (-4);
+ Z_BUF_ERROR = (-5);
+ Z_VERSION_ERROR = (-6);
+
+ Z_NO_COMPRESSION = 0;
+ Z_BEST_SPEED = 1;
+ Z_BEST_COMPRESSION = 9;
+ Z_DEFAULT_COMPRESSION = (-1);
+
+ Z_FILTERED = 1;
+ Z_HUFFMAN_ONLY = 2;
+ Z_DEFAULT_STRATEGY = 0;
+
+ Z_BINARY = 0;
+ Z_ASCII = 1;
+ Z_UNKNOWN = 2;
+
+ Z_DEFLATED = 8;
+
+ _z_errmsg: array[0..9] of PChar = (
+ 'need dictionary', // Z_NEED_DICT (2)
+ 'stream end', // Z_STREAM_END (1)
+ '', // Z_OK (0)
+ 'file error', // Z_ERRNO (-1)
+ 'stream error', // Z_STREAM_ERROR (-2)
+ 'data error', // Z_DATA_ERROR (-3)
+ 'insufficient memory', // Z_MEM_ERROR (-4)
+ 'buffer error', // Z_BUF_ERROR (-5)
+ 'incompatible version', // Z_VERSION_ERROR (-6)
+ ''
+ );
+
+implementation
+
+{$IFNDef FPC}
+ {$L obj\deflate.obj}
+ {$L obj\trees.obj}
+ {$L obj\inflate.obj}
+ {$L obj\inftrees.obj}
+ {$L obj\adler32.obj}
+ {$L obj\infblock.obj}
+ {$L obj\infcodes.obj}
+ {$L obj\infutil.obj}
+ {$L obj\inffast.obj}
+{$ENDIF}
+
+procedure _tr_init; external;
+procedure _tr_tally; external;
+procedure _tr_flush_block; external;
+procedure _tr_align; external;
+procedure _tr_stored_block; external;
+function adler32; external;
+procedure inflate_blocks_new; external;
+procedure inflate_blocks; external;
+procedure inflate_blocks_reset; external;
+procedure inflate_blocks_free; external;
+procedure inflate_set_dictionary; external;
+procedure inflate_trees_bits; external;
+procedure inflate_trees_dynamic; external;
+procedure inflate_trees_fixed; external;
+procedure inflate_codes_new; external;
+procedure inflate_codes; external;
+procedure inflate_codes_free; external;
+procedure _inflate_mask; external;
+procedure inflate_flush; external;
+procedure inflate_fast; external;
+
+procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
+begin
+ FillChar(P^, count, B);
+end;
+
+procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
+begin
+ Move(source^, dest^, count);
+end;
+
+
+// deflate compresses data
+function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
+ recsize: Integer): Integer; external;
+function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function deflateEnd(var strm: TZStreamRec): Integer; external;
+
+// inflate decompresses data
+function inflateInit_(var strm: TZStreamRec; version: PChar; recsize: Integer): Integer; external;
+function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function inflateEnd(var strm: TZStreamRec): Integer; external;
+function inflateReset(var strm: TZStreamRec): Integer; external;
+
+
+function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
+begin
+ GetMem(Result, Items*Size);
+end;
+
+procedure zcfree(AppData, Block: Pointer);
+begin
+ FreeMem(Block);
+end;
+
+end.
+
+
+
diff --git a/Game/Code/lib/SQLite/SQLite3.pas b/Game/Code/lib/SQLite/SQLite3.pas new file mode 100644 index 00000000..b7f9d375 --- /dev/null +++ b/Game/Code/lib/SQLite/SQLite3.pas @@ -0,0 +1,189 @@ +unit SQLite3;
+
+{
+ Simplified interface for SQLite.
+ Updated for Sqlite 3 by Tim Anderson (tim@itwriting.com)
+ Note: NOT COMPLETE for version 3, just minimal functionality
+ Adapted from file created by Pablo Pissanetzky (pablo@myhtpc.net)
+ which was based on SQLite.pas by Ben Hochstrasser (bhoc@surfeu.ch)
+}
+
+interface
+
+const
+
+ SQLiteDLL = 'sqlite3.dll';
+
+// Return values for sqlite3_exec() and sqlite3_step()
+
+ SQLITE_OK = 0; // Successful result
+ SQLITE_ERROR = 1; // SQL error or missing database
+ SQLITE_INTERNAL = 2; // An internal logic error in SQLite
+ SQLITE_PERM = 3; // Access permission denied
+ SQLITE_ABORT = 4; // Callback routine requested an abort
+ SQLITE_BUSY = 5; // The database file is locked
+ SQLITE_LOCKED = 6; // A table in the database is locked
+ SQLITE_NOMEM = 7; // A malloc() failed
+ SQLITE_READONLY = 8; // Attempt to write a readonly database
+ SQLITE_INTERRUPT = 9; // Operation terminated by sqlite3_interrupt()
+ SQLITE_IOERR = 10; // Some kind of disk I/O error occurred
+ SQLITE_CORRUPT = 11; // The database disk image is malformed
+ SQLITE_NOTFOUND = 12; // (Internal Only) Table or record not found
+ SQLITE_FULL = 13; // Insertion failed because database is full
+ SQLITE_CANTOPEN = 14; // Unable to open the database file
+ SQLITE_PROTOCOL = 15; // Database lock protocol error
+ SQLITE_EMPTY = 16; // Database is empty
+ SQLITE_SCHEMA = 17; // The database schema changed
+ SQLITE_TOOBIG = 18; // Too much data for one row of a table
+ SQLITE_CONSTRAINT = 19; // Abort due to contraint violation
+ SQLITE_MISMATCH = 20; // Data type mismatch
+ SQLITE_MISUSE = 21; // Library used incorrectly
+ SQLITE_NOLFS = 22; // Uses OS features not supported on host
+ SQLITE_AUTH = 23; // Authorization denied
+ SQLITE_FORMAT = 24; // Auxiliary database format error
+ SQLITE_RANGE = 25; // 2nd parameter to sqlite3_bind out of range
+ SQLITE_NOTADB = 26; // File opened that is not a database file
+ SQLITE_ROW = 100; // sqlite3_step() has another row ready
+ SQLITE_DONE = 101; // sqlite3_step() has finished executing
+
+ SQLITE_INTEGER = 1;
+ SQLITE_FLOAT = 2;
+ SQLITE_TEXT = 3;
+ SQLITE_BLOB = 4;
+ SQLITE_NULL = 5;
+
+type
+ TSQLiteDB = Pointer;
+ TSQLiteResult = ^PChar;
+ TSQLiteStmt = Pointer;
+
+function SQLite3_Open(dbname: PChar; var db: TSqliteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_open';
+function SQLite3_Close(db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_close';
+function SQLite3_Exec(db: TSQLiteDB; SQLStatement: PChar; CallbackPtr: Pointer; Sender: TObject; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_exec';
+function SQLite3_Version(): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_libversion';
+function SQLite3_ErrMsg(db: TSQLiteDB): PChar; cdecl; external 'sqlite3.dll' name 'sqlite3_errmsg';
+function SQLite3_ErrCode(db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_errcode';
+procedure SQlite3_Free(P: PChar); cdecl; external 'sqlite3.dll' name 'sqlite3_free';
+function SQLite3_GetTable(db: TSQLiteDB; SQLStatement: PChar; var ResultPtr: TSQLiteResult; var RowCount: Cardinal; var ColCount: Cardinal; var ErrMsg: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_get_table';
+procedure SQLite3_FreeTable(Table: TSQLiteResult); cdecl; external 'sqlite3.dll' name 'sqlite3_free_table';
+function SQLite3_Complete(P: PChar): boolean; cdecl; external 'sqlite3.dll' name 'sqlite3_complete';
+function SQLite3_LastInsertRowID(db: TSQLiteDB): int64; cdecl; external 'sqlite3.dll' name 'sqlite3_last_insert_rowid';
+procedure SQLite3_Interrupt(db: TSQLiteDB); cdecl; external 'sqlite3.dll' name 'sqlite3_interrupt';
+procedure SQLite3_BusyHandler(db: TSQLiteDB; CallbackPtr: Pointer; Sender: TObject); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_handler';
+procedure SQLite3_BusyTimeout(db: TSQLiteDB; TimeOut: integer); cdecl; external 'sqlite3.dll' name 'sqlite3_busy_timeout';
+function SQLite3_Changes(db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_changes';
+function SQLite3_TotalChanges(db: TSQLiteDB): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_total_changes';
+function SQLite3_Prepare(db: TSQLiteDB; SQLStatement: PChar; nBytes: integer; var hStmt: TSqliteStmt; var pzTail: PChar): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_prepare';
+function SQLite3_ColumnCount(hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_count';
+function Sqlite3_ColumnName(hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_name';
+function Sqlite3_ColumnDeclType(hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_decltype';
+function Sqlite3_Step(hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_step';
+function SQLite3_DataCount(hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_data_count';
+
+function Sqlite3_ColumnBlob(hStmt: TSqliteStmt; ColNum: integer): pointer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_blob';
+function Sqlite3_ColumnBytes(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_bytes';
+function Sqlite3_ColumnDouble(hStmt: TSqliteStmt; ColNum: integer): double; cdecl; external 'sqlite3.dll' name 'sqlite3_column_double';
+function Sqlite3_ColumnInt(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int';
+function Sqlite3_ColumnText(hStmt: TSqliteStmt; ColNum: integer): pchar; cdecl; external 'sqlite3.dll' name 'sqlite3_column_text';
+function Sqlite3_ColumnType(hStmt: TSqliteStmt; ColNum: integer): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_column_type';
+function Sqlite3_ColumnInt64(hStmt: TSqliteStmt; ColNum: integer): Int64; cdecl; external 'sqlite3.dll' name 'sqlite3_column_int64';
+function SQLite3_Finalize(hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_finalize';
+function SQLite3_Reset(hStmt: TSqliteStmt): integer; cdecl; external 'sqlite3.dll' name 'sqlite3_reset';
+
+//
+// In the SQL strings input to sqlite3_prepare() and sqlite3_prepare16(),
+// one or more literals can be replace by a wildcard "?" or ":N:" where
+// N is an integer. These value of these wildcard literals can be set
+// using the routines listed below.
+//
+// In every case, the first parameter is a pointer to the sqlite3_stmt
+// structure returned from sqlite3_prepare(). The second parameter is the
+// index of the wildcard. The first "?" has an index of 1. ":N:" wildcards
+// use the index N.
+//
+ // The fifth parameter to sqlite3_bind_blob(), sqlite3_bind_text(), and
+ //sqlite3_bind_text16() is a destructor used to dispose of the BLOB or
+//text after SQLite has finished with it. If the fifth argument is the
+// special value SQLITE_STATIC, then the library assumes that the information
+// is in static, unmanaged space and does not need to be freed. If the
+// fifth argument has the value SQLITE_TRANSIENT, then SQLite makes its
+// own private copy of the data.
+//
+// The sqlite3_bind_* routine must be called before sqlite3_step() after
+// an sqlite3_prepare() or sqlite3_reset(). Unbound wildcards are interpreted
+// as NULL.
+//
+
+function SQLite3_BindBlob(hStmt: TSqliteStmt; ParamNum: integer;
+ ptrData: pointer; numBytes: integer; ptrDestructor: pointer): integer;
+cdecl; external 'sqlite3.dll' name 'sqlite3_bind_blob';
+
+function SQLiteFieldType(SQLiteFieldTypeCode: Integer): AnsiString;
+function SQLiteErrorStr(SQLiteErrorCode: Integer): AnsiString;
+
+implementation
+
+uses
+ SysUtils;
+
+function SQLiteFieldType(SQLiteFieldTypeCode: Integer): AnsiString;
+begin
+ case SQLiteFieldTypeCode of
+ SQLITE_INTEGER: Result := 'Integer';
+ SQLITE_FLOAT: Result := 'Float';
+ SQLITE_TEXT: Result := 'Text';
+ SQLITE_BLOB: Result := 'Blob';
+ SQLITE_NULL: Result := 'Null';
+ else
+ Result := 'Unknown SQLite Field Type Code "' + IntToStr(SQLiteFieldTypeCode) + '"';
+ end;
+end;
+
+function SQLiteErrorStr(SQLiteErrorCode: Integer): AnsiString;
+begin
+ case SQLiteErrorCode of
+ SQLITE_OK: Result := 'Successful result';
+ SQLITE_ERROR: Result := 'SQL error or missing database';
+ SQLITE_INTERNAL: Result := 'An internal logic error in SQLite';
+ SQLITE_PERM: Result := 'Access permission denied';
+ SQLITE_ABORT: Result := 'Callback routine requested an abort';
+ SQLITE_BUSY: Result := 'The database file is locked';
+ SQLITE_LOCKED: Result := 'A table in the database is locked';
+ SQLITE_NOMEM: Result := 'A malloc() failed';
+ SQLITE_READONLY: Result := 'Attempt to write a readonly database';
+ SQLITE_INTERRUPT: Result := 'Operation terminated by sqlite3_interrupt()';
+ SQLITE_IOERR: Result := 'Some kind of disk I/O error occurred';
+ SQLITE_CORRUPT: Result := 'The database disk image is malformed';
+ SQLITE_NOTFOUND: Result := '(Internal Only) Table or record not found';
+ SQLITE_FULL: Result := 'Insertion failed because database is full';
+ SQLITE_CANTOPEN: Result := 'Unable to open the database file';
+ SQLITE_PROTOCOL: Result := 'Database lock protocol error';
+ SQLITE_EMPTY: Result := 'Database is empty';
+ SQLITE_SCHEMA: Result := 'The database schema changed';
+ SQLITE_TOOBIG: Result := 'Too much data for one row of a table';
+ SQLITE_CONSTRAINT: Result := 'Abort due to contraint violation';
+ SQLITE_MISMATCH: Result := 'Data type mismatch';
+ SQLITE_MISUSE: Result := 'Library used incorrectly';
+ SQLITE_NOLFS: Result := 'Uses OS features not supported on host';
+ SQLITE_AUTH: Result := 'Authorization denied';
+ SQLITE_FORMAT: Result := 'Auxiliary database format error';
+ SQLITE_RANGE: Result := '2nd parameter to sqlite3_bind out of range';
+ SQLITE_NOTADB: Result := 'File opened that is not a database file';
+ SQLITE_ROW: Result := 'sqlite3_step() has another row ready';
+ SQLITE_DONE: Result := 'sqlite3_step() has finished executing';
+ else
+ Result := 'Unknown SQLite Error Code "' + IntToStr(SQLiteErrorCode) + '"';
+ end;
+end;
+
+function ColValueToStr(Value: PChar): AnsiString;
+begin
+ if (Value = nil) then
+ Result := 'NULL'
+ else
+ Result := Value;
+end;
+
+
+end.
+
diff --git a/Game/Code/lib/SQLite/SQLiteTable3.pas b/Game/Code/lib/SQLite/SQLiteTable3.pas new file mode 100644 index 00000000..05fbd573 --- /dev/null +++ b/Game/Code/lib/SQLite/SQLiteTable3.pas @@ -0,0 +1,770 @@ +unit SQLiteTable3; + +{ + Simple classes for using SQLite's exec and get_table. + + TSQLiteDatabase wraps the calls to open and close an SQLite database. + It also wraps SQLite_exec for queries that do not return a result set + + TSQLiteTable wraps sqlite_get_table. + It allows accessing fields by name as well as index and can step through a + result set with the Next procedure. + + Adapted by Tim Anderson (tim@itwriting.com) + Originally created by Pablo Pissanetzky (pablo@myhtpc.net) + Modified and enhanced by Lukas Gebauer +} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses + {$ifdef win32} + Windows, + {$endif} + SQLite3, + Classes, + SysUtils; + +const + + dtInt = 1; + dtNumeric = 2; + dtStr = 3; + dtBlob = 4; + dtNull = 5; + +type + + ESQLiteException = class(Exception) + end; + + TSQLiteTable = class; + + TSQLiteDatabase = class + private + fDB: TSQLiteDB; + fInTrans: boolean; + procedure RaiseError(s: string; SQL: string); + public + constructor Create(const FileName: string); + destructor Destroy; override; + function GetTable(const SQL: string): TSQLiteTable; + procedure ExecSQL(const SQL: string); + function GetTableValue(const SQL: string): int64; + function GetTableString(const SQL: string): string; + procedure UpdateBlob(const SQL: string; BlobData: TStream); + procedure BeginTransaction; + procedure Commit; + procedure Rollback; + function TableExists(TableName: string): boolean; + function GetLastInsertRowID: int64; + procedure SetTimeout(Value: integer); + function version: string; + published + property isTransactionOpen: boolean read fInTrans; + end; + + TSQLiteTable = class + private + fResults: TList; + fRowCount: cardinal; + fColCount: cardinal; + fCols: TStringList; + fColTypes: TList; + fRow: cardinal; + function GetFields(I: cardinal): string; + function GetEOF: boolean; + function GetBOF: boolean; + function GetColumns(I: integer): string; + function GetFieldByName(FieldName: string): string; + function GetFieldIndex(FieldName: string): integer; + function GetCount: integer; + function GetCountResult: integer; + public + constructor Create(DB: TSQLiteDatabase; const SQL: string); + destructor Destroy; override; + function FieldAsInteger(I: cardinal): int64; + function FieldAsBlob(I: cardinal): TMemoryStream; + function FieldAsBlobText(I: cardinal): string; + function FieldIsNull(I: cardinal): boolean; + function FieldAsString(I: cardinal): string; + function FieldAsDouble(I: cardinal): double; + function Next: boolean; + function Previous: boolean; + property EOF: boolean read GetEOF; + property BOF: boolean read GetBOF; + property Fields[I: cardinal]: string read GetFields; + property FieldByName[FieldName: string]: string read GetFieldByName; + property FieldIndex[FieldName: string]: integer read GetFieldIndex; + property Columns[I: integer]: string read GetColumns; + property ColCount: cardinal read fColCount; + property RowCount: cardinal read fRowCount; + property Row: cardinal read fRow; + function MoveFirst: boolean; + function MoveLast: boolean; + property Count: integer read GetCount; + // The property CountResult is used when you execute count(*) queries. + // It returns 0 if the result set is empty or the value of the + // first field as an integer. + property CountResult: integer read GetCountResult; + end; + +procedure DisposePointer(ptr: pointer); cdecl; + + +implementation + +procedure DisposePointer(ptr: pointer); cdecl; +begin + if assigned(ptr) then + freemem(ptr); +end; + +//------------------------------------------------------------------------------ +// TSQLiteDatabase +//------------------------------------------------------------------------------ + +constructor TSQLiteDatabase.Create(const FileName: string); +var + Msg: pchar; + iResult: integer; +begin + inherited Create; + + self.fInTrans := False; + + Msg := nil; + try + iResult := SQLite3_Open(PChar(FileName), Fdb); + + if iResult <> SQLITE_OK then + if Assigned(Fdb) then + begin + Msg := Sqlite3_ErrMsg(Fdb); + raise ESqliteException.CreateFmt('Failed to open database "%s" : %s', + [FileName, Msg]); + end + else + raise ESqliteException.CreateFmt('Failed to open database "%s" : unknown error', + [FileName]); + + //set a few configs + self.ExecSQL('PRAGMA SYNCHRONOUS=NORMAL;'); +// self.ExecSQL('PRAGMA full_column_names = 1;'); + self.ExecSQL('PRAGMA temp_store = MEMORY;'); + + finally + if Assigned(Msg) then + SQLite3_Free(Msg); + end; + +end; + + +//.............................................................................. + +destructor TSQLiteDatabase.Destroy; +begin + + if self.fInTrans then + self.ExecSQL('ROLLBACK;'); //assume rollback + + if Assigned(fDB) then + SQLite3_Close(fDB); + + inherited; +end; + +function TSQLiteDatabase.GetLastInsertRowID: int64; +begin + Result := Sqlite3_LastInsertRowID(self.fDB); +end; + +//.............................................................................. + +procedure TSQLiteDatabase.RaiseError(s: string; SQL: string); +//look up last error and raise an exception with an appropriate message +var + Msg: PChar; +begin + + Msg := nil; + + if sqlite3_errcode(self.fDB) <> SQLITE_OK then + Msg := sqlite3_errmsg(self.fDB); + + if Msg <> nil then + raise ESqliteException.CreateFmt(s + ' "%s" : %s', [SQL, Msg]) + else + raise ESqliteException.CreateFmt(s, [SQL, 'No message']); + +end; + +procedure TSQLiteDatabase.ExecSQL(const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; +begin + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> + SQLITE_OK then + RaiseError('Error executing SQL', SQL); + + if (Stmt = nil) then + RaiseError('Could not prepare SQL statement', SQL); + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + RaiseError('Error executing SQL statement', SQL); + + finally + + if Assigned(Stmt) then + Sqlite3_Finalize(stmt); + + end; +end; + +procedure TSQLiteDatabase.UpdateBlob(const SQL: string; BlobData: TStream); +var + iSize: integer; + ptr: pointer; + Stmt: TSQLiteStmt; + Msg: Pchar; + NextSQLStatement: Pchar; + iStepResult: integer; + iBindResult: integer; +begin + //expects SQL of the form 'UPDATE MYTABLE SET MYFIELD = ? WHERE MYKEY = 1' + + if pos('?', SQL) = 0 then + RaiseError('SQL must include a ? parameter', SQL); + + Msg := nil; + try + + if Sqlite3_Prepare(self.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> + SQLITE_OK then + RaiseError('Could not prepare SQL statement', SQL); + + if (Stmt = nil) then + RaiseError('Could not prepare SQL statement', SQL); + + //now bind the blob data + iSize := BlobData.size; + + GetMem(ptr, iSize); + + if (ptr = nil) then + raise ESqliteException.CreateFmt('Error getting memory to save blob', + [SQL, 'Error']); + + BlobData.position := 0; + BlobData.Read(ptr^, iSize); + + iBindResult := SQLite3_BindBlob(stmt, 1, ptr, iSize, @DisposePointer); + + if iBindResult <> SQLITE_OK then + RaiseError('Error binding blob to database', SQL); + + iStepResult := Sqlite3_step(Stmt); + + if (iStepResult <> SQLITE_DONE) then + RaiseError('Error executing SQL statement', SQL); + + finally + + if Assigned(Stmt) then + Sqlite3_Finalize(stmt); + + if Assigned(Msg) then + SQLite3_Free(Msg); + end; + +end; + +//.............................................................................. + +function TSQLiteDatabase.GetTable(const SQL: string): TSQLiteTable; +begin + Result := TSQLiteTable.Create(Self, SQL); +end; + +function TSQLiteDatabase.GetTableValue(const SQL: string): int64; +var + Table: TSQLiteTable; +begin + Table := self.GetTable(SQL); + try + Result := Table.FieldAsInteger(0); + finally + Table.Free; + end; +end; + +function TSQLiteDatabase.GetTableString(const SQL: string): string; +var + Table: TSQLiteTable; +begin + Table := self.GetTable(SQL); + try + Result := Table.FieldAsString(0); + finally + Table.Free; + end; +end; + + +procedure TSQLiteDatabase.BeginTransaction; +begin + if not self.fInTrans then + begin + self.ExecSQL('BEGIN TRANSACTION;'); + self.fInTrans := True; + end + else + raise ESqliteException.Create('Transaction already open'); +end; + +procedure TSQLiteDatabase.Commit; +begin + self.ExecSQL('COMMIT;'); + self.fInTrans := False; +end; + +procedure TSQLiteDatabase.Rollback; +begin + self.ExecSQL('ROLLBACK;'); + self.fInTrans := False; +end; + +function TSQLiteDatabase.TableExists(TableName: string): boolean; +var + sql: string; + ds: TSqliteTable; +begin + //returns true if table exists in the database + sql := 'select [sql] from sqlite_master where [type] = ''table'' and lower(name) = ''' + + lowercase(TableName) + ''' '; + ds := self.GetTable(sql); + try + Result := (ds.Count > 0); + finally + ds.Free; + end; +end; + +procedure TSQLiteDatabase.SetTimeout(Value: integer); +begin + SQLite3_BusyTimeout(self.fDB, Value); +end; + +function TSQLiteDatabase.version: string; +begin + Result := SQLite3_Version; +end; + + +//------------------------------------------------------------------------------ +// TSQLiteTable +//------------------------------------------------------------------------------ + +constructor TSQLiteTable.Create(DB: TSQLiteDatabase; const SQL: string); +var + Stmt: TSQLiteStmt; + NextSQLStatement: Pchar; + iStepResult: integer; + ptr: pointer; + iNumBytes: integer; + thisBlobValue: TMemoryStream; + thisStringValue: pstring; + thisDoubleValue: pDouble; + thisIntValue: pInt64; + thisColType: pInteger; + i: integer; + DeclaredColType: Pchar; + ActualColType: integer; + ptrValue: Pchar; +begin + try + self.fRowCount := 0; + self.fColCount := 0; + //if there are several SQL statements in SQL, NextSQLStatment points to the + //beginning of the next one. Prepare only prepares the first SQL statement. + if Sqlite3_Prepare(DB.fDB, PChar(SQL), -1, Stmt, NextSQLStatement) <> SQLITE_OK then + DB.RaiseError('Error executing SQL', SQL); + if (Stmt = nil) then + DB.RaiseError('Could not prepare SQL statement', SQL); + iStepResult := Sqlite3_step(Stmt); + while (iStepResult <> SQLITE_DONE) do + begin + case iStepResult of + SQLITE_ROW: + begin + Inc(fRowCount); + if (fRowCount = 1) then + begin + //get data types + fCols := TStringList.Create; + fColTypes := TList.Create; + fColCount := SQLite3_ColumnCount(stmt); + for i := 0 to Pred(fColCount) do + fCols.Add(AnsiUpperCase(Sqlite3_ColumnName(stmt, i))); + for i := 0 to Pred(fColCount) do + begin + new(thisColType); + DeclaredColType := Sqlite3_ColumnDeclType(stmt, i); + if DeclaredColType = nil then + thisColType^ := Sqlite3_ColumnType(stmt, i) //use the actual column type instead + //seems to be needed for last_insert_rowid + else + if (DeclaredColType = 'INTEGER') or (DeclaredColType = 'BOOLEAN') then + thisColType^ := dtInt + else + if (DeclaredColType = 'NUMERIC') or + (DeclaredColType = 'FLOAT') or + (DeclaredColType = 'DOUBLE') or + (DeclaredColType = 'REAL') then + thisColType^ := dtNumeric + else + if DeclaredColType = 'BLOB' then + thisColType^ := dtBlob + else + thisColType^ := dtStr; + fColTypes.Add(thiscoltype); + end; + fResults := TList.Create; + end; + + //get column values + for i := 0 to Pred(ColCount) do + begin + ActualColType := Sqlite3_ColumnType(stmt, i); + if (ActualColType = SQLITE_NULL) then + fResults.Add(nil) + else + if pInteger(fColTypes[i])^ = dtInt then + begin + new(thisintvalue); + thisintvalue^ := Sqlite3_ColumnInt64(stmt, i); + fResults.Add(thisintvalue); + end + else + if pInteger(fColTypes[i])^ = dtNumeric then + begin + new(thisdoublevalue); + thisdoublevalue^ := Sqlite3_ColumnDouble(stmt, i); + fResults.Add(thisdoublevalue); + end + else + if pInteger(fColTypes[i])^ = dtBlob then + begin + iNumBytes := Sqlite3_ColumnBytes(stmt, i); + if iNumBytes = 0 then + thisblobvalue := nil + else + begin + thisblobvalue := TMemoryStream.Create; + thisblobvalue.position := 0; + ptr := Sqlite3_ColumnBlob(stmt, i); + thisblobvalue.writebuffer(ptr^, iNumBytes); + end; + fResults.Add(thisblobvalue); + end + else + begin + new(thisstringvalue); + ptrValue := Sqlite3_ColumnText(stmt, i); + setstring(thisstringvalue^, ptrvalue, strlen(ptrvalue)); + fResults.Add(thisstringvalue); + end; + end; + end; + SQLITE_BUSY: + raise ESqliteException.CreateFmt('Could not prepare SQL statement', + [SQL, 'SQLite is Busy']); + else + DB.RaiseError('Could not retrieve data', SQL); + end; + iStepResult := Sqlite3_step(Stmt); + end; + fRow := 0; + finally + if Assigned(Stmt) then + Sqlite3_Finalize(stmt); + end; +end; + +//.............................................................................. + +destructor TSQLiteTable.Destroy; +var + i: cardinal; + iColNo: integer; +begin + if Assigned(fResults) then + begin + for i := 0 to fResults.Count - 1 do + begin + //check for blob type + iColNo := (i mod fColCount); + case pInteger(self.fColTypes[iColNo])^ of + dtBlob: + TMemoryStream(fResults[i]).Free; + dtStr: + if fResults[i] <> nil then + begin + setstring(string(fResults[i]^), nil, 0); + dispose(fResults[i]); + end; + else + dispose(fResults[i]); + end; + end; + fResults.Free; + end; + if Assigned(fCols) then + fCols.Free; + if Assigned(fColTypes) then + for i := 0 to fColTypes.Count - 1 do + dispose(fColTypes[i]); + fColTypes.Free; + inherited; +end; + +//.............................................................................. + +function TSQLiteTable.GetColumns(I: integer): string; +begin + Result := fCols[I]; +end; + +//.............................................................................. + +function TSQLiteTable.GetCountResult: integer; +begin + if not EOF then + Result := StrToInt(Fields[0]) + else + Result := 0; +end; + +function TSQLiteTable.GetCount: integer; +begin + Result := FRowCount; +end; + +//.............................................................................. + +function TSQLiteTable.GetEOF: boolean; +begin + Result := fRow >= fRowCount; +end; + +function TSQLiteTable.GetBOF: boolean; +begin + Result := fRow <= 0; +end; + +//.............................................................................. + +function TSQLiteTable.GetFieldByName(FieldName: string): string; +begin + Result := GetFields(self.GetFieldIndex(FieldName)); +end; + +function TSQLiteTable.GetFieldIndex(FieldName: string): integer; +begin + + if (fCols = nil) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + if (fCols.count = 0) then + begin + raise ESqliteException.Create('Field ' + fieldname + ' Not found. Empty dataset'); + exit; + end; + + Result := fCols.IndexOf(AnsiUpperCase(FieldName)); + + if (result < 0) then + begin raise ESqliteException.Create('Field not found in dataset: ' + fieldname) end; + +end; + +//.............................................................................. + +function TSQLiteTable.GetFields(I: cardinal): string; +var + thisvalue: pstring; + thistype: integer; +begin + Result := ''; + if EOF then + raise ESqliteException.Create('Table is at End of File'); + //integer types are not stored in the resultset + //as strings, so they should be retrieved using the type-specific + //methods + thistype := pInteger(self.fColTypes[I])^; + + case thistype of + dtStr: + begin + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + if (thisvalue <> nil) then + Result := thisvalue^ + else + Result := ''; + end; + dtInt: + Result := IntToStr(self.FieldAsInteger(I)); + dtNumeric: + Result := FloatToStr(self.FieldAsDouble(I)); + dtBlob: + Result := self.FieldAsBlobText(I); + else + Result := ''; + end; +end; + +function TSqliteTable.FieldAsBlob(I: cardinal): TMemoryStream; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := nil + else + if pInteger(self.fColTypes[I])^ = dtBlob then + Result := TMemoryStream(self.fResults[(self.frow * self.fColCount) + I]) + else + raise ESqliteException.Create('Not a Blob field'); +end; + +function TSqliteTable.FieldAsBlobText(I: cardinal): string; +var + MemStream: TMemoryStream; + Buffer: PChar; +begin + Result := ''; + MemStream := self.FieldAsBlob(I); + if MemStream <> nil then + if MemStream.Size > 0 then + begin + MemStream.position := 0; + Buffer := stralloc(MemStream.Size + 1); + MemStream.readbuffer(Buffer[0], MemStream.Size); + (Buffer + MemStream.Size)^ := chr(0); + SetString(Result, Buffer, MemStream.size); + strdispose(Buffer); + end; +end; + + +function TSqliteTable.FieldAsInteger(I: cardinal): int64; +begin + if EOF then + //raise ESqliteException.Create('Table is at End of File'); + Result := 0 + else if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := 0 + else + if pInteger(self.fColTypes[I])^ = dtInt then + Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^ + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + Result := trunc(strtofloat(pString(self.fResults[(self.frow * self.fColCount) + I])^)) + else + raise ESqliteException.Create('Not an integer or numeric field'); +end; + +function TSqliteTable.FieldAsDouble(I: cardinal): double; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := 0 + else + if pInteger(self.fColTypes[I])^ = dtInt then + Result := pInt64(self.fResults[(self.frow * self.fColCount) + I])^ + else + if pInteger(self.fColTypes[I])^ = dtNumeric then + Result := pDouble(self.fResults[(self.frow * self.fColCount) + I])^ + else + raise ESqliteException.Create('Not an integer or numeric field'); +end; + +function TSqliteTable.FieldAsString(I: cardinal): string; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + if (self.fResults[(self.frow * self.fColCount) + I] = nil) then + Result := '' + else + Result := self.GetFields(I); +end; + +function TSqliteTable.FieldIsNull(I: cardinal): boolean; +var + thisvalue: pointer; +begin + if EOF then + raise ESqliteException.Create('Table is at End of File'); + thisvalue := self.fResults[(self.frow * self.fColCount) + I]; + Result := (thisvalue = nil); +end; + +//.............................................................................. + +function TSQLiteTable.Next: boolean; +begin + Result := False; + if not EOF then + begin + Inc(fRow); + Result := True; + end; +end; + +function TSQLiteTable.Previous: boolean; +begin + Result := False; + if not BOF then + begin + Dec(fRow); + Result := True; + end; +end; + +function TSQLiteTable.MoveFirst: boolean; +begin + Result := False; + if self.fRowCount > 0 then + begin + fRow := 0; + Result := True; + end; +end; + +function TSQLiteTable.MoveLast: boolean; +begin + Result := False; + if self.fRowCount > 0 then + begin + fRow := fRowCount - 1; + Result := True; + end; +end; + + +end. + diff --git a/Game/Code/lib/SQLite/readme.txt b/Game/Code/lib/SQLite/readme.txt new file mode 100644 index 00000000..80e5b3a1 --- /dev/null +++ b/Game/Code/lib/SQLite/readme.txt @@ -0,0 +1,82 @@ +14 Aug 2005
+
+The following changes were made by Lukas Gebauer (geby@volny.cz). In addition, some changes from a previous D5-compatible version were merged, and the supplied sqlite3.dll is updated to version 3.2.2
+
+Notes from Lukas:
+
+- added support for delphi 4+
+
+- datatype constants matches SQlite datatypes contants. (otherwise in some situations you got bad column datatype!)
+
+- removed dependency on strutils
+
+- code is reformated to better look (official borland formationg
+rules)
+
+- added some pragma's after database is open (temp is in memory)
+
+- TSQLiteDatabase.GetTableValue(const SQL: string): int64 for easy call of SQL commands what returning one number only. (like select
+count(*)...)
+
+- TSQLiteDatabase.GetTableString(const SQL: string): String for easy call of SQL commands what returning one string only. (like PRAGMA
+integrity_check)
+
+- TSQLiteDatabase.SetTimeout(Value: integer); you can set timeout for accessing to some table. Good for database sharing!
+
+- TSQLiteDatabase.version: string; returns SQLITE version string
+
+- removed bool fieldtype (it is not natural SQLite3 type)
+
+- fild type detection by Sqite3_columnType knows REAL too.
+
+- integer filedtype is based on Int64
+
+- GetFields can get data from any supported fieldtype
+
+- changed some integers to cardinal for avoid signed and unsigned mismatch
+
+- TSqliteTable.FieldAsInteger(I: cardinal): int64; returns int64
+
+
+3 May 2005 Fixed bug where strupper called on column type before checking for nil
+
+2 May 2005 Add extra check for nil in TSqliteTable.Destroy, thanks to Tim Maddrell
+
+22 Apr 2005 Revise TSqliteTable.Destroy to fix memory leak with dtStr type (thanks to
+Jose Brito)
+
+21 Apr 2005 Quick revision to fix case sensitivity in detecting column type,
+and remove PRAGMA full_column_names = 1 which is deprecated. Warning: may break code. Fix your SQL code so that all column names in a result set are unique.
+
+21 Feb 2005 Sqlite DLL now 3.1.3
+
+19 Feb 2005 Revised for Sqlite 3.1.2
+
+21 Dec 2004 First public release
+
+The following notice appears in the Sqlite source code:
+
+* +** 2001 September 15 +** +**
+** The author disclaims copyright to this source code. In place of +
+** a legal notice, here is a blessing:
+ +** + May you do good and not evil.
+ +** May you find forgiveness for yourself and forgive others.
+ +** May you share freely, never taking more than you give. +
+
+For more information about SQLite, see http://www.sqlite.org
+
+For more information about this simple wrapper, see http://www.itwriting.com/sqlitesimple.php
+
+
+
+ +
diff --git a/Game/Code/lib/bass/bass.chm b/Game/Code/lib/bass/bass.chm Binary files differnew file mode 100644 index 00000000..1e8c5076 --- /dev/null +++ b/Game/Code/lib/bass/bass.chm diff --git a/Game/Code/lib/bass/bass.txt b/Game/Code/lib/bass/bass.txt new file mode 100644 index 00000000..c60b6594 --- /dev/null +++ b/Game/Code/lib/bass/bass.txt @@ -0,0 +1,1546 @@ +BASS 2.3 - Copyright (c) 1999-2007 Ian Luck. All rights reserved.
+
+Files that you should have found in the BASS "package"
+======================================================
+Win32 version
+-------------
+BASS.TXT This file
+BASS.DLL The BASS module
+BASS.CHM BASS documentation
+MP3-FREE
+ BASS.DLL BASS module using the Windows MP3 decoder
+C\ C/C++ API and samples...
+ BASS.H BASS C/C++ header file
+ BASS.LIB BASS import library
+ BASS.DSW Visual C++ workspace for examples
+ MAKEFILE Makefile for all examples
+ MAKEFILE.IN Makefile helper macros
+ 3DTEST\ 3D/EAX example
+ 3DTEST.C
+ 3DTEST.RC
+ 3DTEST.DSP
+ MAKEFILE
+ BASSTEST\ Simple playback example
+ BASSTEST.C
+ BASSTEST.RC
+ BASSTEST.H
+ BASSTEST.DSP
+ MAKEFILE
+ CONTEST\ Console example
+ CONTEST.C
+ CONTEST.DSP
+ MAKEFILE
+ CUSTLOOP\ Custom looping example
+ CUSTLOOP.C
+ CUSTLOOP.DSP
+ MAKEFILE
+ DSPTEST\ DSP example
+ DSPTEST.C
+ DSPTEST.RC
+ DSPTEST.DSP
+ MAKEFILE
+ FXTEST\ DX8 effect example
+ FXTEST.C
+ FXTEST.RC
+ FXTEST.DSP
+ MAKEFILE
+ LIVEFX\ Full-duplex example
+ LIVEFX.C
+ LIVEFX.RC
+ LIVEFX.DSP
+ MAKEFILE
+ LIVESPEC\ "Live" version of spectrum analyser example
+ LIVESPEC.C
+ LIVESPEC.DSP
+ MAKEFILE
+ LOADNGET\ LoadLibrary/GetProcAddress example
+ LOADNGET.C
+ LOADNGET.RC
+ LOADNGET.DSP
+ MAKEFILE
+ MULTI\ Multiple device example
+ MULTI.C
+ MULTI.RC
+ MULTI.DSP
+ MAKEFILE
+ NETRADIO\ Internet streaming example
+ NETRADIO.C
+ NETRADIO.RC
+ NETRADIO.DSP
+ MAKEFILE
+ PLUGINS\ Plugins example
+ PLUGINS.C
+ PLUGINS.RC
+ PLUGINS.DSP
+ MAKEFILE
+ RECTEST\ Recording example
+ RECTEST.C
+ RECTEST.RC
+ RECTEST.DSP
+ MAKEFILE
+ SPEAKERS\ Multi-speaker example
+ SPEAKERS.C
+ SPEAKERS.RC
+ SPEAKERS.DSP
+ MAKEFILE
+ SPECTRUM\ Spectrum analyser example
+ SPECTRUM.C
+ SPECTRUM.DSP
+ MAKEFILE
+ SYNTH\ Synth example
+ SYNTH.C
+ SYNTH.DSP
+ MAKEFILE
+ WRITEWAV\ WAVE writer example
+ WRITEWAV.C
+ WRITEWAV.DSP
+ MAKEFILE
+ BIN\ Precompiled examples
+ 3DTEST.EXE
+ BASSTEST.EXE
+ CONTEST.EXE
+ CUSTLOOP.EXE
+ DSPTEST.EXE
+ FXTEST.EXE
+ LIVEFX.EXE
+ LIVESPEC.EXE
+ LOADNGET.EXE
+ MULTI.EXE
+ NETRADIO.EXE
+ RECTEST.EXE
+ SPEAKERS.EXE
+ SPECTRUM.EXE
+ SYNTH.EXE
+ WRITEWAV.EXE
+VB\ Visual Basic API and samples...
+ BASS.BAS BASS Visual Basic module file
+ 3DTEST\ 3D/EAX example
+ PRJ3DTEST.VBP
+ PRJ3DTEST.FRM
+ PRJDEVICE.FRM
+ BASSTEST\ Simple playback example
+ PRJBASSTEST.VBP
+ FRMBASSTEST.FRM
+ CUSTLOOP\ Custom looping example
+ PRJCUSTLOOP.VBP
+ FRMCUSTLOOP.FRM
+ MODCUSTLOOP.BAS
+ DSPTEST\ DSP example
+ PRJDSPTEST.VBP
+ FRMDSPTEST.FRM
+ MODDSPTEST.BAS
+ FXTEST\ DX8 effect example
+ PRJFXTEST.VBP
+ FRMFXTEST.FRM
+ LIVEFX\ Full-duplex example
+ PRJLIVEFX.VBP
+ FRMLIVEFX.FRM
+ MODLIVEFX.BAS
+ LIVESPEC\ "Live" version of spectrum analyser example
+ PRJLIVESPEC.VBP
+ FRMLIVESPEC.FRM
+ MODLIVESPEC.BAS
+ MULTI\ Multiple device example
+ PRJMULTI.VBP
+ PRJMULTI.FRM
+ PRJDEVICE.FRM
+ NETRADIO\ Internet streaming example
+ PRJNETRADIO.VBP
+ FRMNETRADIO.FRM
+ MODNETRADIO.BAS
+ CLSFILEIO.CLS
+ PLUGINS\ Plugins example
+ PRJPLUGINS.VBP
+ FRMPLUGINS.FRM
+ RECTEST\ Recording example
+ PRJRECTEST.VBP
+ FRMRECTEST.FRM
+ MODRECTEST.BAS
+ SPEAKERS\ Multi-speaker example
+ PRJSPEAKERS.VBP
+ FRMSPEAKERS.FRM
+ SPECTRUM\ Spectrum analyser example
+ PRJSPECTRUM.VBP
+ FRMSPECTRUM.FRM
+ MODSPECTRUM.BAS
+ SYNTH\ Synth example
+ PRJSYNTH.VBP
+ FRMSYNTH.FRM
+ MODSYNTH.BAS
+ WRITEWAV\ WAVE writer example
+ PRJWRITEWAVE.VBP
+ PRJWRITEWAVE.FRM
+ MEMORY\ Playing from memory example by Jobnik
+ PRJMEMORY.VBP
+ FRMMEMORY.FRM
+ SYNCTEST.BAS
+ CBASS_TIME.CLS
+DELPHI\ Delphi API and samples...
+ BASS.PAS BASS Delphi unit
+ 3DTEST\ 3D/EAX example
+ D3TEST.DPR
+ DTMAIN.PAS
+ DTMAIN.DFM
+ DTSELECT.PAS
+ DTSELECT.DFM
+ BASSTEST\ Simple playback example
+ BASSTEST.DPR
+ BTMAIN.PAS
+ BTMAIN.DFM
+ CONTEST\ Console example
+ CONTEST.DPR
+ CUSTLOOP\ Custom looping example
+ CUSTLOOP.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ DSPTEST\ DSP example
+ DSPTEST.DPR
+ DTMAIN.PAS
+ DTMAIN.DFM
+ FXTEST\ DX8 effect example
+ FXTEST.DPR
+ TEST.PAS
+ TEST.DFM
+ LIVEFX\ Full-duplex example
+ LIVEFX.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ MULTI\ Multiple device example
+ MULTI.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ UNIT2.PAS
+ UNIT2.DFM
+ NETRADIO\ Internet streaming example
+ NETRADIO.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ PLUGINS\ Plugins example
+ PLUGINS.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ RECORDTEST\ Recording example
+ RECORDTEST.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ SAMPLEVIS\ Visualisation example
+ SAMPLEVIS.DPR
+ MAIN.PAS
+ MAIN.DFM
+ SPECTRUM_VIS.PAS
+ CIRCLE_VIS.PAS
+ OSC_VIS.PAS
+ COMMONTYPES.PAS
+ SPEAKERS\ Multi-speaker example
+ SPEAKERS.DPR
+ UNIT1.PAS
+ UNIT1.DFM
+ STREAMTEST\ User stream example
+ STREAMTEST.DPR
+ STMAIN.PAS
+ STMAIN.DFM
+ WRITEWAV\ WAVE writer example
+ WRITEWAV.DPR
+ UNITMAIN.PAS
+ UNITMAIN.DFM
+ DYNAMIC\ Dynamic-loading Delphi API
+ DYNAMIC_BASS.PAS Dynamic-loading Delphi unit
+MASM\ MASM API and samples...
+ BASS.INC BASS MASM include file
+ PLAYER\ Example MOD player
+ PLAYER.EXE
+ PLAYER.ASM
+ RSRC.RC
+ TOOLBAR.BMP
+ COMPILE.BAT
+
+NOTE: To run the sample EXEs, first you'll have to copy BASS.DLL into the
+ same directory as the EXEs.
+
+NOTE: To avoid unnecessary bloatage, the BASS DLLs are not digitally signed.
+ Signed versions are available on request (email: bass@un4seen.com).
+
+MacOSX version
+--------------
+BASS.TXT This file
+LIBBASS.DYLIB The BASS module
+BASS.CHM BASS documentation
+CHMOX.APP CHM file viewer
+BASS.H BASS C/C++ header file
+MAKEFILE Makefile for all examples
+MAKEFILE.IN Makefile helper macros
+MP3-FREE
+ LIBBASS.DYLIB BASS module using the OSX MP3 decoder
+3DTEST\ 3D example
+ 3DTEST.C
+ MAKEFILE
+ 3DTEST.NIB
+BASSTEST\ Simple playback example
+ BASSTEST.C
+ MAKEFILE
+ BASSTEST.NIB
+CONTEST\ Console example
+ CONTEST.C
+ MAKEFILE
+CUSTLOOP\ Custom looping example
+ CUSTLOOP.C
+ MAKEFILE
+DSPTEST\ DSP example
+ DSPTEST.C
+ DSPTEST.RC
+ MAKEFILE
+ DSPTEST.NIB
+LIVESPEC\ "Live" version of spectrum analyser example
+ LIVESPEC.C
+ MAKEFILE
+MULTI\ Multiple device example
+ MULTI.C
+ MAKEFILE
+ MULTI.NIB
+NETRADIO\ Internet streaming example
+ NETRADIO.C
+ MAKEFILE
+ NETRADIO.NIB
+PLUGINS\ Plugins example
+ PLUGINS.C
+ MAKEFILE
+ PLUGINS.NIB
+RECTEST\ Recording example
+ RECTEST.C
+ MAKEFILE
+ RECTEST.NIB
+SPEAKERS\ Multi-speaker example
+ SPEAKERS.C
+ MAKEFILE
+ SPEAKERS.NIB
+SPECTRUM\ Spectrum analyser example
+ SPECTRUM.C
+ MAKEFILE
+WRITEWAV\ WAVE writer example
+ WRITEWAV.C
+ MAKEFILE
+
+
+What's the point?
+=================
+BASS is an audio library for use in Windows and MacOSX software. Its
+purpose is to provide the most powerful and efficient (yet easy to use),
+sample, stream, MOD music, and recording functions. All in a tiny DLL,
+under 100KB in size.
+
+See the documentation for descriptions of all the BASS functions. You
+should also look at the included example program source-codes for some
+examples of how to use BASS in your own programs.
+
+
+Requirements
+============
+Win32 version
+-------------
+BASS requires DirectX 3 or above for output. BASS does not require that a
+soundcard with DirectSound/DirectSound3D hardware accelerated drivers is
+installed, but it does improve performance if there is one. BASS also takes
+advantage of MMX, which improves the performance of the MOD music playback.
+
+MacOSX version
+--------------
+OSX 10.3 or above is recommended. BASS uses CoreAudio for output, so there
+are no special library/driver requirements. BASS supports both PowerPC and
+Intel Macs.
+
+
+Main Features
+=============
+* Samples
+- supports WAV/AIFF/MP3/MP2/MP1/OGG and custom generated samples
+
+* Sample streams
+- stream any sample data in 8/16/32 bit
+
+* File streams
+- MP3/MP2/MP1/OGG/WAV/AIFF file streaming
+
+* Internet file streaming
+- stream MP3/MP2/MP1/OGG/WAV/AIFF files from the internet (inc. Shout/Icecast)
+
+* User file streaming
+- stream MP3/MP2/MP1/OGG/WAV/AIFF files from anywhere using any delivery method
+
+* Multi-channel streaming
+- support for more than plain stereo, including multi-channel OGG/WAV/AIFF files
+
+* MOD music
+- uses the same engine as XMPlay = best accuracy, speed and quality
+
+* MO3 music
+- MP3/OGG compressed MOD music
+
+* Add-on system
+- support for more formats is available via add-ons (aka plugins)
+
+* Multiple outputs
+- simultaneously use multiple soundcards, and move channels between them
+
+* Recording
+- flexible recording system, with support for multiple devices
+
+* Decode without playback
+- streams and musics can be outputted in any way you want
+
+* Speaker assignment
+- assign streams and musics to specific speakers
+
+* High precision synchronization
+- synchronize events in your software to the music
+
+* DirectX 8 effects
+- chorus/compressor/distortion/echo/flanger/gargle/parameq/reverb
+
+* User defined DSP functions
+- custom effects may be applied to musics and streams
+
+* 32 bit floating-point decoding and processing
+- floating-point stream/music decoding, DSP, FX, and recording
+
+* 3D sound
+- play samples/streams/musics in any 3D position, with EAX support
+
+* Expandable
+- underlying DirectSound object interfaces are accessible
+
+* Small
+- BASS is under 100KB (on Windows), so won't bloat your distribution
+
+
+Using BASS
+==========
+There is no guarantee that all future BASS versions will be compatible
+with all previous versions, so your program should use BASS_GetVersion
+to check the version that is loaded. This also means that you should
+put the BASS module in the same directory as your executable (not just
+somewhere in the path), to avoid the possibility of a wrong version being
+loaded.
+
+If you are updating your software from a previous BASS version, then
+you should check the "History" section (below), to see if any of the
+functions that you are using have been affected by a change.
+
+Win32 version
+-------------
+C/C++, Visual Basic, Delphi and MASM APIs are provided, to use BASS with
+another language you'll first have to convert the header file. Or, as a
+last resort, you could use LoadLibrary and GetProcAddress.
+
+One benefit of the LoadLibrary method is that it allows you to look for
+the correct BASS version, because you can load and unload BASS.DLL at
+any time. This also allows those who'd prefer not to have a separate
+DLL to store it with the program (eg. in a resource), write it to disk,
+load it, use it, free it and delete it.
+
+The downside is that you have to manually import each function that you
+use, with the GetProcAddress function. But it has been made a lot simpler
+to import BASS this way by the use of the BASSDEF #define. Here's a small
+example:
+
+#define BASSDEF(f) (WINAPI *f) // define the functions as pointers
+#include "bass.h"
+...
+HINSTANCE bass=LoadLibrary("BASS.DLL"); // load BASS
+BASS_Init=GetProcAddress(bass,"BASS_Init"); // get BASS_Init
+BASS_Init(-1,44100,0,hWnd,NULL); // call BASS_Init
+
+See the LOADNGET.C file for a more complete example.
+
+To use BASS with Borland C++ Builder, you'll first have to create a
+Borland C++ Builder import library for it. This is done by using the
+IMPLIB tool that comes with Borland C++ Builder. Simply execute this:
+
+ IMPLIB BASSBCB.LIB BASS.DLL
+
+... and then use BASSBCB.LIB in your projects to import BASS.
+
+To use BASS with LCC-Win32, you'll first have to create a compatible
+import library for it. This is done by using the PEDUMP and BUILDLIB
+tools that come with LCC-Win32. Run these 2 commands:
+
+ PEDUMP /EXP BASS.LIB > BASSLCC.EXP
+ BUILDLIB BASSLCC.EXP BASSLCC.LIB
+
+... and then use BASSLCC.LIB in your projects to import BASS.
+
+For the BASS functions that return strings (char*), VB users should use
+the VBStrFromAnsiPtr function to convert the returned pointer into a VB
+string.
+
+MacOSX version
+--------------
+A separate "LIB" file is not required for OSX. Using XCode, you can simply
+add the DYLIB file to the project. Or using a makefile, you can build your
+programs like this, for example:
+
+ gcc yoursource -L. -lbass -o yourprog
+
+The LIBBASS.DYLIB file must be put in the same directory as the executable
+(it can't just be somewhere in the path). See the example makefiles.
+
+LIBBASS.DYLIB is a universal binary, with support for both PowerPC and
+Intel Macs. If you want PowerPC-only or Intel-only versions, the included
+makefile can create them for you, by typing "make ppc" or "make i386". It
+will also process any BASS add-ons placed in the same directory.
+
+
+Latest Version
+==============
+The latest version of BASS can always be found at the BASS website:
+
+ www.un4seen.com
+
+
+Copyright, disclaimer, and all that other jazz
+==============================================
+The BASS library is free for non-commercial use. If you are a non-
+commercial entity (eg. an individual) and are not charging for your
+product, and the product has no other commercial purpose, then you
+can use BASS in it for free. If you wish to use BASS in commercial
+products, then please also see the next section.
+
+TO THE MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW, BASS IS PROVIDED
+"AS IS", WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
+INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY
+AND/OR FITNESS FOR A PARTICULAR PURPOSE. THE AUTHORS SHALL NOT BE HELD
+LIABLE FOR ANY DAMAGE THAT MAY RESULT FROM THE USE OF BASS. BASICALLY,
+YOU USE BASS ENTIRELY AT YOUR OWN RISK.
+
+Usage of BASS indicates that you agree to the above conditions.
+
+All trademarks and other registered names contained in the BASS
+package are the property of their respective owners.
+
+
+BASS in commercial products?
+============================
+BASS is available for use in your commercial products. The licence
+types available are as follows:
+
+SHAREWARE: Allows the usage of BASS in an unlimited number of your
+shareware products, which must sell for no more than 40 Euros each.
+If you're an individual making and selling your own software (and
+its price is within the limit), this is the licence for you.
+
+SINGLE COMMERCIAL: Allows the usage of BASS in a single commercial
+product.
+
+UNLIMITED COMMERCIAL: Allows the usage of BASS in an unlimited number
+of your commercial products. This licence is on a per site basis. So
+if your company has two sites that use BASS, then two licences are
+required.
+
+Please note the products must be end-user products, eg. not components
+used by other products.
+
+These licences only cover your own software. not the publishing of
+other's software. If you publish other's software, its developers (or
+the software itself) will need to be licensed to use BASS.
+
+These licences are on a per-platform basis, with reductions available
+when licensing for both platforms. In all cases there are no royalties
+to pay, and you can use future BASS updates without further cost. One
+licence covers one person or entity and is not transferable.
+
+These licences do not allow reselling/sublicensing of BASS. For example,
+if a product is a development system, the users of said product are not
+licensed to use BASS in their productions - they will need their own
+licences.
+
+If the standard licences do not meet your requirements, or if you have
+any questions, please get in touch (email: bass@un4seen.com).
+
+Visit the BASS website for the latest pricing:
+
+ www.un4seen.com
+
+
+MP3
+===
+MP3 technology is patented, and Thomson license the use of their and
+Fraunhofer's patents. The inclusion of an MP3 decoder (eg. BASS) in a
+commercial product requires an MP3 patent licence. Contact Thomson for
+details:
+
+ www.mp3licensing.com
+
+Alternatively, the "MP3-FREE" BASS version doesn't include its own MP3
+decoder but instead makes use of the operating system's already licensed
+decoder.
+
+NOTE: When using the OS's MP3 decoder, BASS still does the file handling
+ so all the usual features are still supported, including streaming,
+ tag reading, pre-scanning, gapless playback, etc...
+
+
+History
+=======
+These are the major (and not so major) changes at each version stage.
+There are of course bug fixes and other little improvements made along
+the way too! To make upgrading simpler, all functions affected by a
+change to the BASS interface are listed.
+
+2.3.0.3 - 30/7/2007
+-------------------
+* FX state resetting
+ BASS_FXReset
+* PLS/M3U playlist URL processing
+ BASS_CONFIG_NET_PLAYLIST
+ NETRADIO example updated
+* Internet stream connection status retrieval
+ BASS_FILEPOS_CONNECTED (BASS_StreamGetFilePosition mode)
+* Lyrics3v2 tags
+ BASS_TAG_LYRICS3 (BASS_ChannelGetTags type)
+* IT virtual channel configuration
+ BASS_CONFIG_MUSIC_VIRTUAL
+* Accurate speaker detection on Vista
+ BASS_INFO (speakers member)
+* Device output/input rate retrieval on Vista
+ BASS_INFO (freq member)
+ BASS_RECORDINFO (freq member)
+* Syncing upon position changes
+ BASS_SYNC_SETPOS (BASS_ChannelSetSync type)
+* Improved stall handling
+ BASS_SYNC_STALL
+* Invalid decoding channel flags produce an error instead of being ignored
+ BASS_StreamCreate/File/User/Url
+ BASS_MusicLoad
+
+2.3.0.2 - 22/1/2007
+-------------------
+* Retrieval of a sample's existing channel handles
+ BASS_SampleGetChannels
+* 8192 sample FFT
+ BASS_DATA_FFT8192 (BASS_ChannelGetData flag)
+* Adjustable recording buffer
+ BASS_CONFIG_REC_BUFFER (BASS_SetConfig option)
+* Stopping decoding channels before the end
+ BASS_ChannelStop
+* Sample channels created paused to prevent overriding before playback
+ BASS_SampleGetChannel
+* Separate "MP3-FREE" version using Windows/OSX MP3 decoder
+ BASS_CONFIG_MP3_CODEC *removed*
+
+2.3.0.1 - 12/6/2006
+-------------------
+* Ability to move a channel to another device
+ BASS_ChannelSetDevice
+ MULTI example updated
+* Support for ID3v2.4 tags at end of file
+ BASS_TAG_ID3V2 (BASS_ChannelGetTags type)
+
+2.3 - 21/5/2006
+---------------
+* MOD message/instrument/sample text retrieval, merged with stream tag retrieval function
+ BASS_ChannelGetTags
+ BASS_TAG_MUSIC_NAME/MESSAGE/INST/SAMPLE (BASS_ChannelGetTags types)
+ BASS_MusicGetName *removed*
+ BASS_StreamGetTags *removed*
+* Plugin information retrieval
+ BASS_PluginGetInfo
+ BASS_PLUGININFO/FORM structures
+ BASS_CHANNELINFO (plugin member)
+ PLUGINS example updated
+* RIFF/WAVE "INFO" tag retrieval
+ BASS_TAG_RIFF_INFO (BASS_StreamGetTags type)
+* More specific WAVE format information
+ BASS_CTYPE_STREAM_WAV_PCM/FLOAT (channel types)
+ BASS_CTYPE_STREAM_WAV (channel type flag)
+* Proxy server configuration
+ BASS_CONFIG_NET_PROXY (BASS_SetConfig option)
+ BASS_CONFIG_NET_NOPROXY *removed*
+ NETRADIO example updated
+* Passive FTP mode
+ BASS_CONFIG_NET_PASSIVE (BASS_SetConfig option)
+* Agent changes take immediate effect
+ BASS_CONFIG_NET_AGENT (BASS_SetConfig option)
+* Minimum time gap between creating new sample channels
+ BASS_SAMPLE (mingap member)
+ BASS_SampleGetChannel
+* Support for Unicode plugin filenames
+ BASS_PluginLoad
+* Device output/input rate retrieval (MacOSX only)
+ BASS_INFO (freq member)
+ BASS_RECORDINFO (freq member)
+* Extended version info (minor revision)
+ BASS_GetVersion
+* Unsupported codec error code
+ BASS_ERROR_CODEC
+* Optional use of the Windows MP3 codec
+ BASS_CONFIG_MP3_CODEC (BASS_SetConfig option)
+* 3D support for MacOSX
+ BASS_Set3DFactors
+ BASS_Get3DFactors
+ BASS_Set3DPosition
+ BASS_Get3DPosition
+ BASS_Apply3D
+ BASS_ChannelSet3DAttributes
+ BASS_ChannelGet3DAttributes
+ BASS_ChannelSet3DPosition
+ BASS_ChannelGet3DPosition
+ 3DTEST example added (Win32 example also updated)
+* VB version of SYNTH example added
+
+2.2 - 2/10/2005
+---------------
+* Add-on plugin system
+ BASS_PluginLoad
+ BASS_PluginFree
+ BASS_StreamCreateFile/User/Url
+ BASS_SampleLoad
+ PLUGINS example added
+* MOD position & syncing in bytes
+ BASS_ChannelSetPosition
+ BASS_ChannelGetPosition
+ BASS_MusicGetOrderPosition added for orders position
+ BASS_SYNC_MUSICPOS added for orders syncing
+ MAKEMUSICPOS macro/define
+ CUSTLOOP example updated
+* Stream/MOD "length" functions combined (also works with samples), new MOD orders length function
+ BASS_ChannelGetLength
+ BASS_MusicGetOrders
+ BASS_StreamGetLength *removed*
+ BASS_MusicGetLength *removed*
+* Support for AIFF files
+ BASS_StreamCreateFile/User/Url
+ BASS_SampleLoad
+* Support for 24 and 32-bit (integer) WAV files
+ BASS_StreamCreateFile/User/Url
+ BASS_SampleLoad
+* WAV files are no longer converted to the "device" resolution
+ BASS_StreamCreateFile/User/Url
+* Recording master control
+ BASS_RecordGetInput
+ BASS_RecordSetInput
+* Adjustable prebuffering
+ BASS_ChannelPreBuf
+* Floating-point data retrieval
+ BASS_DATA_FLOAT (BASS_ChannelGetData flag)
+* Support for floating-point samples
+ BASS_SampleLoad
+ BASS_SampleCreate
+* Multi-channel samples
+ BASS_SampleLoad/Create
+ BASS_SAMPLE (chans member)
+* Sample lengths given in bytes
+ BASS_SampleCreate
+ BASS_SAMPLE (length member)
+* MOD music 8-bit resolution option
+ BASS_MusicLoad
+* OGG vendor tag retrieval
+ BASS_TAG_VENDOR (BASS_StreamGetTags type)
+* Configurable "User-Agent" header for internet streams
+ BASS_CONFIG_NET_AGENT (BASS_SetConfig option)
+* Shoutcast metadata is now requested automatically
+ BASS_STREAM_META flag *removed*
+* Download callbacks receive all data from start of file/stream (including any non-audio data)
+ DOWNLOADPROC
+* Length when streaming in blocks is unavailable (BASS_ERROR_NOTAVAIL, not just 0)
+ BASS_ChannelGetLength
+* Support for growing custom file streams
+ BASS_FILE_LEN (STREAMFILEPROC action)
+* Query file action removed
+ BASS_FILE_QUERY *removed*
+* Recording channel syncing
+ BASS_ChannelSetSync
+* Info structure "size" members removed
+ BASS_INFO structure
+ BASS_RECORDINFO structure
+* Little bit of flag reshuffling
+ BASS_MP3_SETPOS renamed to BASS_STREAM_PRESCAN
+ BASS_MUSIC_CALCLEN value changed and renamed to BASS_MUSIC_PRESCAN
+ BASS_MUSIC_POSRESET value changed
+* Add-on API enhancements
+* MacOSX port introduced
+
+2.1 - 28/11/2004
+----------------
+* Improved "mixtime" sync system, allowing custom looping
+ SYNCPROC
+ CUSTLOOP example added
+* FX can now be in the DSP chain, so can be prioritized and applied in floating-point
+ BASS_ChannelSetFX
+ BASS_CONFIG_FLOATDSP (BASS_SetConfig option)
+* Ability to set channel flags (eg. looping) independent of playback
+ BASS_ChannelSetFlags
+ SPEAKERS example updated
+* Stream/MOD "play" and channel "resume" functions combined
+ BASS_ChannelPlay
+ BASS_StreamPlay *removed*
+ BASS_MusicPlay *removed*
+ BASS_MusicPlayEx *removed*
+ BASS_ChannelResume *removed*
+* Stream/MOD prebuffering functions combined
+ BASS_ChannelPreBuf
+ BASS_StreamPreBuf *removed*
+ BASS_MusicPreBuf *removed*
+* MOD attribute functions combined, with added BPM/speed/globalvolume options
+ BASS_MusicSetAttribute
+ BASS_MusicGetAttribute
+ BASS_MUSIC_ATTRIB_AMPLIFY
+ BASS_MUSIC_ATTRIB_PANSEP
+ BASS_MUSIC_ATTRIB_PSCALER
+ BASS_MUSIC_ATTRIB_BPM
+ BASS_MUSIC_ATTRIB_SPEED
+ BASS_MUSIC_ATTRIB_VOL_GLOBAL
+ BASS_MUSIC_ATTRIB_VOL_CHAN
+ BASS_MUSIC_ATTRIB_VOL_INST
+ BASS_MusicSetAmplify *removed*
+ BASS_MusicSetPanSep *removed*
+ BASS_MusicSetPositionScaler *removed*
+ BASS_MusicSetVolume *removed*
+ BASS_MusicGetVolume *removed*
+* Flag to reset bpm/etc as well as notes when seeking in MOD musics
+ BASS_MUSIC_POSRESETEX (BASS_MusicLoad & BASS_ChannelSetFlags flag)
+* More flexible and concise sample channel creation system
+ BASS_SampleGetChannel
+ BASS_SamplePlay *removed*
+ BASS_SamplePlayEx *removed*
+ BASS_SamplePlay3D *removed*
+ BASS_SamplePlay3DEx *removed*
+* Support for up to 30 speakers
+ BASS_SPEAKER_N macro/define
+* More precise level measurement
+ BASS_ChannelGetLevel
+* Level can now be retrieved from decoding channels
+ BASS_ChannelGetLevel
+* Retrieval of a sample/channel's original sample resolution
+ BASS_SAMPLE (origres member)
+ BASS_CHANNELINFO (origres member)
+* Support for streaming WAV files in "blocks"
+ BASS_StreamCreateURL
+ BASS_StreamCreateFileUser
+* Status info (HTTP/ICY tags) available during connection to server
+ BASS_STREAM_STATUS (BASS_StreamCreateURL flag)
+ DOWNLOADPROC
+ NETRADIO example updated (Delphi version also added)
+* Adjustable internet stream prebuffering
+ BASS_CONFIG_NET_PREBUF (BASS_SetConfig option)
+* Option to bypass proxy server
+ BASS_CONFIG_NET_NOPROXY (BASS_SetConfig option)
+* Option whether to allow channels to be played after BASS_Pause
+ BASS_CONFIG_PAUSE_NOPLAY (BASS_SetConfig option)
+* Recording channel count now a separate parameter
+ BASS_RecordStart (chans parameter)
+* Synchronizer for when a channel is freed
+ BASS_SYNC_FREE (BASS_ChannelSetSync type)
+* Data start file position retrieval
+ BASS_FILEPOS_START (BASS_StreamGetFilePosition mode)
+* Performance improvements
+ MP2 decoding ~20% faster
+ MP3/MP1 decoding & FFT processing all up to 10% faster
+ OGG decoding ~3% faster
+* C/C++ examples reorganised, with makefiles & VC++ projects
+* Add-on API enhancements
+* More DLL shrinkage :)
+
+2.0 - 31/10/2003
+----------------
+* Multiple output device support
+ BASS_Init (device number changes)
+ BASS_SetDevice
+ BASS_GetDevice
+ BASS_ChannelGetDevice
+ MULTI example updated (VB version also added)
+* Multiple recording device support
+ BASS_RecordSetDevice
+ BASS_RecordGetDevice
+ BASS_RecordStart
+ BASS_ChannelGetDevice
+ HRECORD handle
+ RECORDPROC (handle parameter)
+* Recording with DSP/FX
+ BASS_ChannelSetDSP
+ BASS_ChannelSetFX
+* Recording position retrieval
+ BASS_ChannelGetPosition
+* Start recording paused
+ BASS_RECORD_PAUSE (BASS_RecordStart flag)
+* Multi-channel streams, inc. support for multichannel OGG & WAV files
+ BASS_StreamCreate
+ BASS_StreamCreateFile/User/Url
+* FFT for individual channels, inc. multi-channel streams
+ BASS_DATA_FFT_INDIVIDUAL (BASS_ChannelGetData flag)
+ BASS_DATA_FFT512S/1024S/2048S/4096S *removed*
+* DSP prioritizing
+ BASS_ChannelSetDSP
+ DSPTEST example updated
+* Seeking in internet streamed files
+ BASS_ChannelSetPosition
+* Enhanced custom file stream systems
+ BASS_StreamCreateFileUser
+ BASS_FILE_SEEK (STREAMFILEPROC action)
+ BASS_STREAM_FILEPROC flag *removed*
+* Enhanced custom stream system with automatic stalling/resuming
+ STREAMPROC
+ BASS_STREAMPROC_END (STREAMPROC flag)
+* Synchronizer for stalled/resumed playback
+ BASS_SYNC_STALL (BASS_ChannelSetSync type)
+* Synchronizer for completed download
+ BASS_SYNC_DOWNLOAD (BASS_ChannelSetSync type)
+* End sync support for custom streams
+ BASS_SYNC_END (BASS_ChannelSetSync type)
+* Synchronizer support for decoding channels
+ BASS_ChannelSetSync
+* Unified configuration function
+ BASS_SetConfig
+ BASS_GetConfig
+ BASS_SetBufferLength *removed*
+ BASS_SetNetConfig *removed*
+ BASS_SetGlobalVolumes *removed*
+ BASS_GetGlobalVolumes *removed*
+ BASS_SetLogCurves *removed*
+ BASS_Set3DAlgorithm *removed*
+ BASS_DEVICE_FLOATDSP flag *removed*
+* Internet stream saving to disk replaced by more flexible callback
+ BASS_StreamCreateURL
+ DOWNLOADPROC
+ VB NETRADIO example updated
+* Buffer length retrieval when "streaming in blocks"
+ BASS_FILEPOS_END (BASS_StreamGetFilePosition mode)
+* Individual sample rate setting for MOD musics
+ BASS_MusicLoad
+* Channel type and default sample rate retrieval
+ BASS_ChannelGetInfo (replaces BASS_ChannelGetFlags)
+ BASS_CHANNELINFO
+* MOD music flag retrieval
+ BASS_CHANNELINFO (flags member)
+* Adjustable instrument volumes in MOD musics
+ BASS_MusicSetVolume (replaces BASS_MusicSetChannelVol)
+ BASS_MusicGetVolume (replaces BASS_MusicGetChannelVol)
+* Automatically free a MOD music when it stops or ends
+ BASS_MUSIC_AUTOFREE (BASS_MusicLoad flag)
+* Class GUID added to initialization parameters
+ BASS_Init
+ BASS_SetCLSID *removed*
+* Update period adjustable at any time
+ BASS_CONFIG_UPDATEPERIOD (BASS_SetConfig option)
+ BASS_DEVICE_NOTHREAD flag *removed*
+* Customizable maximum volume setting
+ BASS_CONFIG_MAXVOL (BASS_SetConfig option)
+ BASS_DEVICE_VOL1000 flag *removed*
+* Device volume is now always left as it is during init/freeing
+ BASS_DEVICE_LEAVEVOL flag *removed*
+* Device driver name retrieval
+ BASS_INFO (driver member)
+ BASS_RECORDINFO (driver member)
+* Error codes are local to the current thread
+ BASS_ErrorGetCode
+* Performance improvements
+ MP2 decoding 15-20% faster
+ MP3 decoding ~5% faster
+* Built-in CD functions removed (replaced in BASSCD)
+ BASS_CDDoor *removed*
+ BASS_CDFree *removed*
+ BASS_CDGetID *removed*
+ BASS_CDGetTrackLength *removed*
+ BASS_CDGetTracks *removed*
+ BASS_CDInDrive *removed*
+ BASS_CDInit *removed*
+ BASS_CDPlay *removed*
+* Force channels to use software mixing
+ BASS_SAMPLE_SOFTWARE (BASS_StreamCreate/File/User/URL & BASS_MusicLoad flag)
+* Support for high-pass filter and forward/reverse (S9E/F) IT/MPT effects
+* BASS_MUSIC flags rearranged to mirror BASS_SAMPLE/STREAM counterparts
+* Output automatically started during initialization
+* BASS_ChannelGetData once again accepts any "length" param
+* All function comments have been removed from the API headers to avoid
+ outdated/incorrect information - the BASS.CHM documentation should be used.
+* TMT Pascal API removed from main distribution - now available on the website
+* A few more 'K' knocked off the DLL size :)
+
+1.8a - 18/6/2003
+----------------
+* Tweaks 'n' fixes, including...
+ Fixed seeking bug on 32-bit OGG streams
+ Fixed seeking on a decoding channel after it has reached the end
+ Low FPU precision (eg. when using Direct3D) issue addressed
+ Improved speakers (BASS_INFO) detection
+ BASS_ChannelSeconds2Bytes return value is rounded down to nearest sample
+ BASS_ChannelGetData "length" param must equal a whole number of samples
+ Slide syncs are triggered by "-2" volume slides on "autofree" streams
+* Support for UNICODE filenames
+ BASS_UNICODE (BASS_SampleLoad/BASS_StreamCreateFile/BASS_MusicLoad flag)
+* 4096 sample FFT
+ BASS_DATA_FFT4096/S (BASS_ChannelGetData flags)
+* Another 'K' knocked off the DLL size
+
+1.8 - 9/3/2003
+--------------
+* 32-bit floating-point channels
+ BASS_SAMPLE_FLOAT (BASS_StreamCreate/URL/File flag)
+ BASS_MUSIC_FLOAT (BASS_MusicLoad flag)
+ BASS_SAMPLE_FLOAT (BASS_RecordStart flag)
+ BASS_DEVICE_FLOATDSP (BASS_Init flag)
+ DSPTEST example updated
+* Support for 32-bit floating-point (type 3) WAV files
+ BASS_StreamCreateFile/URL
+ BASS_SampleLoad
+* Channel speaker assignment
+ BASS_SPEAKER_FRONT (BASS_MusicLoad/BASS_StreamCreate/File/URL flag)
+ BASS_SPEAKER_REAR "
+ BASS_SPEAKER_CENLFE "
+ BASS_SPEAKER_REAR2 "
+ BASS_SPEAKER_FRONTLEFT "
+ BASS_SPEAKER_FRONTRIGHT "
+ BASS_SPEAKER_REARLEFT "
+ BASS_SPEAKER_REARRIGHT "
+ BASS_SPEAKER_CENTER "
+ BASS_SPEAKER_LFE "
+ BASS_SPEAKER_REAR2LEFT "
+ BASS_SPEAKER_REAR2RIGHT "
+ BASS_INFO (speakers member)
+ BASS_DEVICE_SPEAKERS (BASS_Init flag)
+ 4SPEAKER example replaced by SPEAKERS example
+* Recording input type retrieval
+ BASS_INPUT_TYPE_xxx (BASS_RecordGetInput)
+ RECTEST example updated
+* Non-interpolated MOD mixing
+ BASS_MUSIC_NONINTER (BASS_MusicLoad/PlayEx flag)
+* Performance improvements
+ FFT up to 100% faster!
+ MP3(MPEG2/2.5) decoding up to 60% faster
+ MMX mixers 5-10% faster
+ MP3(MPEG1)/MP2/MP1/OGG decoding all ~5% faster
+* Optional disabling of FFT windowing
+ BASS_DATA_FFT_NOWINDOW (BASS_ChannelGetData flag)
+* BASS_ERROR_FILEFORM - error code to distinguish between file and sample format
+ BASS_MusicLoad
+ BASS_SampleLoad
+ BASS_StreamCreate/File/URL
+* BASS_StreamGetFilePosition mode flags added
+ BASS_FILEPOS_DECODE/DOWNLOAD/END
+* DirectX 9 detection
+ BASS_INFO (dsver member)
+* Initialization flags retrieval
+ BASS_INFO (initflags member)
+* Half-rate MP3 playback option removed
+ BASS_MP3_HALFRATE flag *removed*
+* New internal "plugin" system - BASSWMA is further integrated as a result
+* Improved documentation - integrated with BASSWMA, search option added
+* VB version of DSPTEST example added
+* Delphi RECORDTEST example added
+* Guess what... reduced DLL size again :)
+
+1.7 - 27/10/2002
+----------------
+* New alternative DX8 (DMO) effects implementation
+ BASS_StreamCreate/File/URL
+ BASS_MusicLoad
+ BASS_ChannelSetFX
+ SYNTH example updated
+* User file streaming
+ BASS_STREAM_FILEPROC (BASS_StreamCreate flag)
+ STREAMFILEPROC
+* DSP & FX support for decoding channels
+ BASS_ChannelSetDSP
+ BASS_ChannelSetFX
+* Support for DX8 (DMO) effects in IT/XM/MO3 files
+ BASS_MusicLoad
+* Support for chained OGG streaming (and syncing)
+ BASS_StreamCreateURL
+ BASS_SYNC_META (BASS_ChannelSetSync type)
+* Attribute (volume/frequency/pan) sliding
+ BASS_ChannelSlideAttributes
+ BASS_ChannelIsSliding
+ BASS_SYNC_SLIDE (BASS_ChannelSetSync type)
+* Recording without a callback function
+ BASS_RecordStart
+ LIVEFX example added
+* Query a channel's buffered data
+ BASS_DATA_AVAILABLE (BASS_ChannelGetData flag)
+* Discard data from the recording buffer
+ BASS_ChannelGetData
+* Adjustable internet stream config (timeout/buffer lengths)
+ BASS_SetNetConfig
+* Recommended minimum buffer length
+ BASS_INFO (minbuf member)
+* MOD music flags adjustment without changing playback position
+ BASS_MusicPlayEx
+ PLAYER (MASM) example updated
+* More functions are now useable in MOD music "mixtime" syncs
+ SYNCPROC
+ BASS_ChannelSetPosition
+ BASS_MusicPlayEx
+ BASS_MusicSetAmplify
+ BASS_MusicSetPanSep
+* Maximum buffer length increased to 5 seconds
+ BASS_SetBufferLength
+* Support for extended filter range in IT files
+ BASS_MusicLoad
+* Speedier MOD music file verification
+ BASS_MusicLoad
+* Delphi 3DTEST example fixed
+* Magically reduced DLL size again :)
+
+1.6a - 25/8/2002
+----------------
+* OGG support updated to 1.0
+* Stereo FFT
+ BASS_DATA_FFT512S/1024S/2048S (BASS_ChannelGetData flags)
+* Support for "Invert Loop" (EFx) MOD effect
+* Reduced DLL size
+* New Delphi examples
+ WRITEWAV - WAVE writer example
+ SAMPLEVIS - Visualisation example
+
+1.6 - 13/6/2002
+---------------
+* 64-bit stream lengths and positions
+ BASS_StreamGetLength
+ BASS_ChannelBytes2Seconds
+ BASS_ChannelSeconds2Bytes
+ BASS_ChannelGetPosition
+ BASS_ChannelSetPosition
+ BASS_ChannelSetSync
+* Recording input selection
+ BASS_RECORDINFO (inputs & singlein members)
+ BASS_RecordGetInputName
+ BASS_RecordGetInput
+ BASS_RecordSetInput
+* Adjustable recording update period
+ BASS_RecordStart
+* Load OGG files as samples
+ BASS_SampleLoad
+* CD drive door opening & closing
+ BASS_CDDoor
+* CDDB2 ID retrieval
+ BASS_CDID_CDDB2 (BASS_CDGetID flag)
+* Streaming beyond initial file length
+ BASS_StreamCreateFile
+* Recording position bytes<->seconds translation
+ BASS_ChannelBytes2Seconds
+ BASS_ChannelSeconds2Bytes
+* Improved multi-threaded support (play from any thread)
+ BASS_MusicPlay/Ex
+ BASS_SamplePlay/3D/Ex
+ BASS_StreamPlay
+ BASS_DEVICE_NOSYNC flag *removed*
+* Paused channel status
+ BASS_ACTIVE_PAUSED (BASS_ChannelIsActive)
+* Integrated WMA stream freeing
+ BASS_StreamFree
+ BASS_Free
+* Pin-point accurate OGG seeking without BASS_MP3_SETPOS flag
+* Win2k DS buffer bug fix
+
+1.5a - 14/4/2002
+----------------
+* NT4 fix (also enables "nosound" device without DX installed)
+ BASS_ERROR_DX error code
+* MOD music loading without the samples
+ BASS_MUSIC_NOSAMPLE (BASS_MusicLoad flag)
+* Custom decoding channels
+ BASS_STREAM_DECODE (BASS_StreamCreate flag)
+* 5 second HTTP connection timeout
+ BASS_ERROR_TIMEOUT (BASS_StreamCreateURL error code)
+
+1.5 - 31/3/2002
+---------------
+* Improved performance
+ MMX mixers lot faster (over 50% faster in some cases!)
+ OGG decoding 15-20% faster
+ MP3 decoding 5-10% faster
+* Recording
+ BASS_RecordGetDeviceDescription
+ BASS_RecordInit
+ BASS_RecordFree
+ BASS_RecordGetInfo
+ BASS_RecordStart
+* OGG support built-in (OGG/VORBIS DLLs not required)
+ BASS_DEVICE_OGG flag *removed*
+* MOD music seeking in seconds
+ BASS_MusicPlayEx
+ BASS_ChannelSetPosition
+* Shoutcast metadata retrieval
+ BASS_STREAM_META (BASS_StreamCreateURL flag)
+ BASS_TAG_META (BASS_StreamGetTags type)
+ BASS_SYNC_META (BASS_ChannelSetSync type)
+* 1000 volume levels
+ BASS_DEVICE_VOL1000 (BASS_Init/CDInit flag)
+* CDDB ID retrieval
+ BASS_CDID_CDDB (BASS_CDGetID flag)
+* Leave the CD volume as it is during init/closing
+ BASS_DEVICE_LEAVEVOL (BASS_CDInit flag)
+* FFT enabled on decoding channels
+ BASS_ChannelGetData
+* Left level duplicated on right for mono channels
+ BASS_ChannelGetLevel
+* Improved MPEG length estimation without BASS_MP3_SETPOS flag
+ BASS_StreamGetLength
+* Support for Modplug/ADPCM compressed files
+ BASS_MusicLoad
+* Device description function parameter change
+ BASS_GetDeviceDescription
+* MASM API
+
+1.4 - 30/1/2002
+---------------
+* Channel decoding without playback
+ BASS_MUSIC_DECODE (BASS_MusicLoad flag)
+ BASS_STREAM_DECODE (BASS_StreamCreateFile/URL flag)
+ BASS_ChannelGetData
+* Windows message sync callbacks
+ BASS_SYNC_MESSAGE (BASS_ChannelSetSync flag)
+* Adjustable channel volumes in MOD musics
+ BASS_MusicSetChannelVol
+ BASS_MusicGetChannelVol
+* Customizable DirectSound initialization object
+ BASS_SetCLSID
+* Retrieve HMUSIC/HSTREAM/HCHANNEL IDirectSoundBuffer interfaces
+ BASS_GetDSoundObject
+* A3D functions removed (use BASS_SetCLSID/BASS_GetDSoundObject to access A3D)
+ BASS_DEVICE_A3D (BASS_Init flag)
+ BASS_SetA3DResManager
+ BASS_GetA3DResManager
+ BASS_SetA3DHFAbsorbtion
+ BASS_GetA3DHFAbsorbtion
+* Callback functions now work in VB6
+ DSPPROC
+ STREAMPROC
+ SYNCPROC
+* Improved PCM WAVE streaming performance
+ BASS_StreamCreateFile
+ BASS_StreamCreateURL
+* OGG modules updated to RC3
+* Stereo sample support in MO3 format
+* MO3 encoder now distributed separately from BASS
+
+1.3 - 17/11/2001
+----------------
+* Manual buffer updating
+ BASS_DEVICE_NOTHREAD (BASS_Init flag)
+ BASS_Update
+* Adjustable buffer update period (allows small buffer sizes)
+ BASS_Init
+* Output device latency retrieval
+ BASS_INFO (latency member)
+* MPEG/OGG seeking without BASS_MP3_SETPOS flag
+ BASS_ChannelSetPosition
+* Internet file streaming from offsets
+ BASS_StreamCreateURL
+* File stream tag/comment retrieval (ID3/ID3v2/OGG/HTTP/ICY tags)
+ BASS_StreamGetTags
+* Byte<->time position translation
+ BASS_ChannelBytes2Seconds
+ BASS_ChannelSeconds2Bytes
+* UMX (Unreal/Tournament music package) format support
+ BASS_MusicLoad
+* S3M/IT sync fx changed to S2x (S0x conflicted with S00)
+ BASS_SYNC_MUSICFX
+* Stereo sample support in IT/XM/S3M formats
+* MO3: OGG compression supported
+
+1.2 - 25/9/2001
+---------------
+* OGG (Ogg Vorbis) stream support
+ BASS_DEVICE_OGG (BASS_Init flag)
+ BASS_StreamCreateFile
+ BASS_StreamCreateURL
+* Channel linking (start/stop/pause/resume channels together)
+ BASS_ChannelSetLink
+ BASS_ChannelRemoveLink
+* MOD music playback length calculation
+ BASS_MUSIC_CALCLEN (BASS_MusicLoad flag)
+ BASS_MusicGetLength
+* Pre-buffering
+ BASS_MusicPreBuf
+ BASS_StreamPreBuf
+* Samples with single simultaneous playbacks have same HSAMPLE/HCHANNEL handle
+ BASS_SamplePlay/Ex
+* Stopping a custom stream flushes its buffer contents
+ BASS_ChannelStop
+
+1.1a - 31/8/2001
+----------------
+* NT4 bug fixed
+* XM Wxx effect syncing
+ BASS_SYNC_MUSICFX
+* MP3/2/1 rewinding without BASS_MP3_SETPOS
+ BASS_ChannelSetPosition
+
+1.1 - 11/8/2001
+---------------
+* DX8 (DMO) effects
+ BASS_SAMPLE_FX (BASS_StreamCreate/File/URL flag)
+ BASS_MUSIC_FX (BASS_MusicLoad flag)
+ BASS_ChannelSetFX
+ BASS_ChannelRemoveFX
+ BASS_FXSetParameters
+ BASS_FXGetParameters
+ BASS_FXCHORUS structure
+ BASS_FXCOMPRESSOR structure
+ BASS_FXDISTORTION structure
+ BASS_FXECHO structure
+ BASS_FXFLANGER structure
+ BASS_FXGARGLE structure
+ BASS_FXI3DL2REVERB structure
+ BASS_FXPARAMEQ structure
+ BASS_FXREVERB structure
+* Internet file streaming in blocks (inc. Shoutcast/Icecast stream support)
+ BASS_STREAM_BLOCK (BASS_StreamCreateURL flag)
+* 512/1024/2048 sample FFT
+ BASS_DATA_FFT512/1024/2048 (BASS_ChannelGetData flags)
+* CD identification
+ BASS_CDGetID
+* Improved DX version detection
+ BASS_INFO (dsver member)
+
+1.0 - 20/6/2001
+---------------
+* Load MP3/MP2/MP1 files as samples
+ BASS_SampleLoad
+* Internet file streaming from FTP servers
+ BASS_StreamCreateURL
+* Save a local copy of internet file streams
+ BASS_StreamCreateURL
+* Sample accurate file stream seeking
+ BASS_ChannelSetPosition
+ BASS_StreamGetBlockLength *removed*
+* Stream position synchronizer
+ BASS_SYNC_POS
+* Increased synchronizer precision
+* Improved MPEG file detection and error detection
+* Stop MOD musics on a backwards jump effect
+ BASS_MUSIC_STOPBACK (BASS_MusicLoad/PlayEx flag)
+* Leave the volume as it is during closing (as well as initialization)
+ BASS_DEVICE_LEAVEVOL (BASS_Init flag)
+* Optional automatic use of foreground window handle during initialization
+ BASS_Init
+* Reduced DLL size
+* VB API fixes
+
+0.9 - 18/4/2001
+---------------
+* Internet file streaming
+ BASS_StreamCreateURL
+* MP1 & MP2 (MPEG layer 1 & 2) support
+ BASS_StreamCreateFile/URL
+* MPEG 2.5 support (12000/11025/8000hz sample rates)
+ BASS_StreamCreateFile/URL
+* Decoding/download/end file stream position retrieval
+ BASS_StreamGetFilePosition
+* XMPlay surround sound for MOD musics
+ BASS_MUSIC_SURROUND (BASS_MusicLoad/PlayEx flag)
+ BASS_MUSIC_SURROUND2 (BASS_MusicLoad/PlayEx flag)
+* Restrict the download rate of internet file streams
+ BASS_STREAM_RESTRATE (BASS_StreamCreateURL flag)
+* Check if an internet file stream is stalled
+ BASS_ChannelIsActive
+* Automatically free a stream when it stops or ends
+ BASS_STREAM_AUTOFREE (BASS_StreamCreate/File/URL flag)
+* Leave the volume as it is during initialization
+ BASS_DEVICE_LEAVEVOL (BASS_Init flag)
+* Number of CD tracks retrieval
+ BASS_CDGetTracks
+* CD track length retrieval
+ BASS_CDGetTrackLength
+* Exact stream length set after whole file is streamed
+ BASS_StreamGetLength
+* TMT Pascal API and samples
+* Dynamic-loading Delphi API
+
+0.8a - 28/2/2000
+----------------
+* Updated Delphi API and samples
+
+0.8 - 24/1/2000
+---------------
+* Improved MP3 performance on P2/K6 and above CPUs - fast!
+* User DSP functions on streams and MOD musics
+ BASS_ChannelSetDSP
+ BASS_ChannelRemoveDSP
+* DX7 voice allocation & management
+ BASS_SAMPLE_VAM (BASS_SampleLoad/Create flag)
+ BASS_VAM_xxx flags
+ BASS_SAMPLE (vam & priority members)
+* DX7 software 3D algorithm selection
+ BASS_Set3DAlgorithm
+* DirectSound interface retrieval
+ BASS_GetDSoundObject
+* Log/linear volume & panning curves
+ BASS_SetLogCurves
+* User data passed to callback functions
+ STREAMPROC - BASS_StreamCreate
+ SYNCPROC - BASS_ChannelSetSync
+* New synchronizer
+ BASS_SYNC_MUSICFX
+* New synchronizer flag
+ BASS_SYNC_MIXTIME
+* Disable synchronizers option - saves a little CPU time
+ BASS_DEVICE_NOSYNC (BASS_Init flag)
+* Hi-res floating-point CPU usage monitoring
+ BASS_GetCPU
+* Wait for playback to start when playing a CD
+ BASS_CDPlay
+* DirectSound (dsound.dll) version retrieval
+ BASS_INFO (dsver member)
+* Removed volume sliding functions (they were fairly pointless)
+ BASS_SlideVolume
+ BASS_IsSliding
+* MO3: read/write encoder settings
+* MO3: remove inst/samp/message texts now optional
+* MO3: LAME encoder settings
+
+0.7 - 3/10/1999
+---------------
+* MO3 (MP3 compressed MODs)
+* A3D functions
+ BASS_DEVICE_A3D (BASS_Init flag)
+ BASS_INFO (a3d member)
+ BASS_SetA3DResManager
+ BASS_GetA3DResManager
+ BASS_SetA3DHFAbsorbtion
+ BASS_GetA3DHFAbsorbtion
+* Music/stream immediate sample data retrieval
+ BASS_ChannelGetData
+* File stream (WAV/MP3) length retrieval
+ BASS_StreamGetLength
+ BASS_StreamGetBlockLength
+* File stream seeking
+ BASS_ChannelSetPosition
+* Mono MP3 option (lower CPU usage)
+ BASS_StreamCreateFile
+* Music length retrieval
+ BASS_MusicGetLength
+* Music name retrieval
+ BASS_MusicGetName
+* Stop notes when moving MOD music position
+ BASS_MUSIC_POSRESET (BASS_MusicLoad/BASS_MusicPlayEx flag)
+* BASS_ERROR_FREQ - invalid sample rate error code
+ BASS_SampleCreate
+ BASS_SamplePlayEx
+ BASS_SamplePlay3DEx
+ BASS_StreamCreate
+ BASS_ChannelSetAttributes
+* Delphi and VB APIs
+
+0.6a - 26/7/1999
+----------------
+* Half rate MP3 option (lower CPU usage)
+ BASS_MP3_HALFRATE
+* Loading/streaming from file offsets
+ BASS_MusicLoad
+ BASS_SampleLoad
+ BASS_StreamCreateFile
+* Global music/sample/stream volume levels
+ BASS_SetGlobalVolumes
+ BASS_GetGlobalVolumes
+* Other new function
+ BASS_SampleStop
+* New synchronizer
+ BASS_SYNC_END
+* New sample overrider
+ BASS_SAMPLE_OVER_DIST
+* LoadLibrary/GetProcAddress instructions and example
+
+0.5 - 4/7/1999
+--------------
+* Documentation!
+* File streaming (MP3 and WAV)
+ BASS_StreamCreateFile
+* Custom generated samples
+ BASS_SampleCreate
+ BASS_SampleCreateDone
+* Other new function
+ BASS_MusicSetPositionScaler
+* Renamed function
+ BASS_ChannelClearSync -> BASS_ChannelRemoveSync
+* Alterations made to
+ BASS_ChannelGetPosition
+ BASS_SampleLoad
+ BASS_StreamPlay
+
+0.4 - 30/3/1999
+---------------
+* Compressed WAV samples support (using audio CODECs)
+* Updated CD volume handling - now works with SB Live
+* More linear channel volume/pan scales (were slightly off before)
+* "no sound" device option
+* 3D sound functions
+ BASS_Set3DFactors
+ BASS_Get3DFactors
+ BASS_Set3DPosition
+ BASS_Get3DPosition
+ BASS_Apply3D
+ BASS_SamplePlay3D
+ BASS_SamplePlay3DEx
+ BASS_ChannelSet3DAttributes
+ BASS_ChannelGet3DAttributes
+ BASS_ChannelSet3DPosition
+ BASS_ChannelGet3DPosition
+* EAX functions
+ BASS_SetEAXParameters
+ BASS_GetEAXParameters
+ BASS_ChannelSetEAXMix
+ BASS_ChannelGetEAXMix
+* Other new functions
+ BASS_GetDeviceDescription
+ BASS_SetBufferLen
+ BASS_ChannelGetFlags
+ BASS_ChannelPause
+ BASS_ChannelResume
+ BASS_ChannelSetPosition
+* Replaced function
+ BASS_CDResume -> BASS_ChannelResume
+* Alterations made to
+ BASS_Init
+ BASS_CDInit
+ BASS_SampleLoad
+ BASS_StreamPlay
+ BASS_INFO structure
+ BASS_SAMPLE structure
+ BASS_DEVICE_xxx flags
+ BASS_SAMPLE_xxx flags
+
+0.3 - 8/3/1999
+--------------
+* Synchronization functions
+ BASS_ChannelSetSync
+ BASS_ChannelClearSync
+* Other new functions
+ BASS_GetVersion
+ BASS_ChannelGetPosition
+ BASS_ChannelGetLevel
+ BASS_ChannelGetAttributes
+ BASS_ChannelSetAttributes
+* Replaced functions
+ BASS_MusicStop -> BASS_ChannelStop
+ BASS_MusicSetVolume -> BASS_ChannelSetAttributes
+ BASS_CDStop -> BASS_ChannelStop
+ BASS_CDSetVolume -> BASS_ChannelSetAttributes
+ BASS_CDGetVolume -> BASS_ChannelGetAttributes
+ BASS_ChannelUpdate -> BASS_ChannelSetAttributes
+* Alterations made to
+ BASS_MusicPlayEx
+ BASS_StreamPlay
+ BASS_INFO structure
+
+0.2 - 28/2/1999
+---------------
+* First public release
+
+
+Credits - API/Sample Contributors
+=================================
+Visual Basic - Adam Hoult, Hendrik Knaepen, Arthur Aminov,
+ Peter Hebels
+Delphi - Titus Miloi, Rogier Timmermans, Alessandro Cappellozza,
+ Jesse Naranjo, Chris Troesken
+MASM - Octavian Chis
+
+CHMOX is (c)2004 Stéphane Boisson, http://chmox.sourceforge.net/
+
+
+Bug reports, Suggestions, Comments, Enquiries, etc...
+=====================================================
+If you have any of the aforementioned please see the BASS forum (at
+the website). If you can't find an answer there, you can email:
+
+ bass@un4seen.com
+
diff --git a/Game/Code/lib/bass/delphi/bass.bpg b/Game/Code/lib/bass/delphi/bass.bpg new file mode 100644 index 00000000..55c2e004 --- /dev/null +++ b/Game/Code/lib/bass/delphi/bass.bpg @@ -0,0 +1,64 @@ +#------------------------------------------------------------------------------
+VERSION = BWS.01
+#------------------------------------------------------------------------------
+!ifndef ROOT
+ROOT = $(MAKEDIR)\..
+!endif
+#------------------------------------------------------------------------------
+MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
+DCC = $(ROOT)\bin\dcc32.exe $**
+BRCC = $(ROOT)\bin\brcc32.exe $**
+#------------------------------------------------------------------------------
+PROJECTS = D3Test.exe BassTest.exe ConTest.exe custloop.exe DspTest.exe \
+ FXtest.exe livefx.exe Multi.exe netradio.exe plugins.exe RecordTest.exe \
+ samplevis.exe Speakers.exe StreamTest.exe writewav.exe
+#------------------------------------------------------------------------------
+default: $(PROJECTS)
+#------------------------------------------------------------------------------
+
+D3Test.exe: 3dTest\D3Test.dpr
+ $(DCC)
+
+BassTest.exe: BassTest\BassTest.dpr
+ $(DCC)
+
+ConTest.exe: ConTest\ConTest.dpr
+ $(DCC)
+
+custloop.exe: custloop\custloop.dpr
+ $(DCC)
+
+DspTest.exe: DspTest\DspTest.dpr
+ $(DCC)
+
+FXtest.exe: fxtest\FXtest.dpr
+ $(DCC)
+
+livefx.exe: livefx\livefx.dpr
+ $(DCC)
+
+Multi.exe: multi\Multi.dpr
+ $(DCC)
+
+netradio.exe: netradio\netradio.dpr
+ $(DCC)
+
+plugins.exe: plugins\plugins.dpr
+ $(DCC)
+
+RecordTest.exe: RecordTest\RecordTest.dpr
+ $(DCC)
+
+samplevis.exe: SampleVis\samplevis.dpr
+ $(DCC)
+
+Speakers.exe: Speakers\Speakers.dpr
+ $(DCC)
+
+StreamTest.exe: StreamTest\StreamTest.dpr
+ $(DCC)
+
+writewav.exe: writewav\writewav.dpr
+ $(DCC)
+
+
diff --git a/Game/Code/lib/bass/delphi/bass.pas b/Game/Code/lib/bass/delphi/bass.pas new file mode 100644 index 00000000..ba661699 --- /dev/null +++ b/Game/Code/lib/bass/delphi/bass.pas @@ -0,0 +1,968 @@ +{
+ BASS 2.3 Audio Library, (c) 1999-2007 Ian Luck.
+ Please report bugs/suggestions/etc... to bass@un4seen.com
+
+ See the BASS.CHM file for more complete documentation
+
+
+ How to install
+ ----------------
+ Copy BASS.PAS to the \LIB subdirectory of your Delphi path or your project dir
+}
+unit Bass;
+
+interface
+
+uses
+ Windows;
+
+const
+ BASSVERSION = $203; // API version
+
+ // Use these to test for error from functions that return a DWORD or QWORD
+ DW_ERROR = Cardinal(-1); // -1 (DWORD)
+ QW_ERROR = Int64(-1); // -1 (QWORD)
+
+ // Error codes returned by BASS_GetErrorCode()
+ BASS_OK = 0; // all is OK
+ BASS_ERROR_MEM = 1; // memory error
+ BASS_ERROR_FILEOPEN = 2; // can't open the file
+ BASS_ERROR_DRIVER = 3; // can't find a free sound driver
+ BASS_ERROR_BUFLOST = 4; // the sample buffer was lost - please report this!
+ BASS_ERROR_HANDLE = 5; // invalid handle
+ BASS_ERROR_FORMAT = 6; // unsupported sample format
+ BASS_ERROR_POSITION = 7; // invalid playback position
+ BASS_ERROR_INIT = 8; // BASS_Init has not been successfully called
+ BASS_ERROR_START = 9; // BASS_Start has not been successfully called
+ BASS_ERROR_ALREADY = 14; // already initialized/paused/whatever
+ BASS_ERROR_NOPAUSE = 16; // not paused
+ BASS_ERROR_NOCHAN = 18; // can't get a free channel
+ BASS_ERROR_ILLTYPE = 19; // an illegal type was specified
+ BASS_ERROR_ILLPARAM = 20; // an illegal parameter was specified
+ BASS_ERROR_NO3D = 21; // no 3D support
+ BASS_ERROR_NOEAX = 22; // no EAX support
+ BASS_ERROR_DEVICE = 23; // illegal device number
+ BASS_ERROR_NOPLAY = 24; // not playing
+ BASS_ERROR_FREQ = 25; // illegal sample rate
+ BASS_ERROR_NOTFILE = 27; // the stream is not a file stream
+ BASS_ERROR_NOHW = 29; // no hardware voices available
+ BASS_ERROR_EMPTY = 31; // the MOD music has no sequence data
+ BASS_ERROR_NONET = 32; // no internet connection could be opened
+ BASS_ERROR_CREATE = 33; // couldn't create the file
+ BASS_ERROR_NOFX = 34; // effects are not enabled
+ BASS_ERROR_PLAYING = 35; // the channel is playing
+ BASS_ERROR_NOTAVAIL = 37; // requested data is not available
+ BASS_ERROR_DECODE = 38; // the channel is a "decoding channel"
+ BASS_ERROR_DX = 39; // a sufficient DirectX version is not installed
+ BASS_ERROR_TIMEOUT = 40; // connection timedout
+ BASS_ERROR_FILEFORM = 41; // unsupported file format
+ BASS_ERROR_SPEAKER = 42; // unavailable speaker
+ BASS_ERROR_VERSION = 43; // invalid BASS version (used by add-ons)
+ BASS_ERROR_CODEC = 44; // codec is not available/supported
+ BASS_ERROR_UNKNOWN = -1; // some other mystery error
+
+ // Initialization flags
+ BASS_DEVICE_8BITS = 1; // use 8 bit resolution, else 16 bit
+ BASS_DEVICE_MONO = 2; // use mono, else stereo
+ BASS_DEVICE_3D = 4; // enable 3D functionality
+ {
+ If the BASS_DEVICE_3D flag is not specified when
+ initilizing BASS, then the 3D flags (BASS_SAMPLE_3D
+ and BASS_MUSIC_3D) are ignored when loading/creating
+ a sample/stream/music.
+ }
+ BASS_DEVICE_LATENCY = 256; // calculate device latency (BASS_INFO struct)
+ BASS_DEVICE_SPEAKERS = 2048; // force enabling of speaker assignment
+ BASS_DEVICE_NOSPEAKER = 4096; // ignore speaker arrangement
+
+ // DirectSound interfaces (for use with BASS_GetDSoundObject)
+ BASS_OBJECT_DS = 1; // IDirectSound
+ BASS_OBJECT_DS3DL = 2; // IDirectSound3DListener
+
+ // BASS_INFO flags (from DSOUND.H)
+ DSCAPS_CONTINUOUSRATE = $00000010;
+ { supports all sample rates between min/maxrate }
+ DSCAPS_EMULDRIVER = $00000020;
+ { device does NOT have hardware DirectSound support }
+ DSCAPS_CERTIFIED = $00000040;
+ { device driver has been certified by Microsoft }
+ {
+ The following flags tell what type of samples are
+ supported by HARDWARE mixing, all these formats are
+ supported by SOFTWARE mixing
+ }
+ DSCAPS_SECONDARYMONO = $00000100; // mono
+ DSCAPS_SECONDARYSTEREO = $00000200; // stereo
+ DSCAPS_SECONDARY8BIT = $00000400; // 8 bit
+ DSCAPS_SECONDARY16BIT = $00000800; // 16 bit
+
+ // BASS_RECORDINFO flags (from DSOUND.H)
+ DSCCAPS_EMULDRIVER = DSCAPS_EMULDRIVER;
+ { device does NOT have hardware DirectSound recording support }
+ DSCCAPS_CERTIFIED = DSCAPS_CERTIFIED;
+ { device driver has been certified by Microsoft }
+
+ // defines for formats field of BASS_RECORDINFO (from MMSYSTEM.H)
+ WAVE_FORMAT_1M08 = $00000001; // 11.025 kHz, Mono, 8-bit
+ WAVE_FORMAT_1S08 = $00000002; // 11.025 kHz, Stereo, 8-bit
+ WAVE_FORMAT_1M16 = $00000004; // 11.025 kHz, Mono, 16-bit
+ WAVE_FORMAT_1S16 = $00000008; // 11.025 kHz, Stereo, 16-bit
+ WAVE_FORMAT_2M08 = $00000010; // 22.05 kHz, Mono, 8-bit
+ WAVE_FORMAT_2S08 = $00000020; // 22.05 kHz, Stereo, 8-bit
+ WAVE_FORMAT_2M16 = $00000040; // 22.05 kHz, Mono, 16-bit
+ WAVE_FORMAT_2S16 = $00000080; // 22.05 kHz, Stereo, 16-bit
+ WAVE_FORMAT_4M08 = $00000100; // 44.1 kHz, Mono, 8-bit
+ WAVE_FORMAT_4S08 = $00000200; // 44.1 kHz, Stereo, 8-bit
+ WAVE_FORMAT_4M16 = $00000400; // 44.1 kHz, Mono, 16-bit
+ WAVE_FORMAT_4S16 = $00000800; // 44.1 kHz, Stereo, 16-bit
+
+ // Sample info flags
+ BASS_SAMPLE_8BITS = 1; // 8 bit
+ BASS_SAMPLE_FLOAT = 256; // 32-bit floating-point
+ BASS_SAMPLE_MONO = 2; // mono, else stereo
+ BASS_SAMPLE_LOOP = 4; // looped
+ BASS_SAMPLE_3D = 8; // 3D functionality enabled
+ BASS_SAMPLE_SOFTWARE = 16; // it's NOT using hardware mixing
+ BASS_SAMPLE_MUTEMAX = 32; // muted at max distance (3D only)
+ BASS_SAMPLE_VAM = 64; // uses the DX7 voice allocation & management
+ BASS_SAMPLE_FX = 128; // old implementation of DX8 effects are enabled
+ BASS_SAMPLE_OVER_VOL = $10000; // override lowest volume
+ BASS_SAMPLE_OVER_POS = $20000; // override longest playing
+ BASS_SAMPLE_OVER_DIST = $30000; // override furthest from listener (3D only)
+
+ BASS_STREAM_PRESCAN = $20000; // enable pin-point seeking (MP3/MP2/MP1)
+ BASS_MP3_SETPOS = BASS_STREAM_PRESCAN;
+ BASS_STREAM_AUTOFREE = $40000; // automatically free the stream when it stop/ends
+ BASS_STREAM_RESTRATE = $80000; // restrict the download rate of internet file streams
+ BASS_STREAM_BLOCK = $100000;// download/play internet file stream in small blocks
+ BASS_STREAM_DECODE = $200000;// don't play the stream, only decode (BASS_ChannelGetData)
+ BASS_STREAM_STATUS = $800000;// give server status info (HTTP/ICY tags) in DOWNLOADPROC
+
+ BASS_MUSIC_FLOAT = BASS_SAMPLE_FLOAT; // 32-bit floating-point
+ BASS_MUSIC_MONO = BASS_SAMPLE_MONO; // force mono mixing (less CPU usage)
+ BASS_MUSIC_LOOP = BASS_SAMPLE_LOOP; // loop music
+ BASS_MUSIC_3D = BASS_SAMPLE_3D; // enable 3D functionality
+ BASS_MUSIC_FX = BASS_SAMPLE_FX; // enable old implementation of DX8 effects
+ BASS_MUSIC_AUTOFREE = BASS_STREAM_AUTOFREE; // automatically free the music when it stop/ends
+ BASS_MUSIC_DECODE = BASS_STREAM_DECODE; // don't play the music, only decode (BASS_ChannelGetData)
+ BASS_MUSIC_PRESCAN = BASS_STREAM_PRESCAN; // calculate playback length
+ BASS_MUSIC_CALCLEN = BASS_MUSIC_PRESCAN;
+ BASS_MUSIC_RAMP = $200; // normal ramping
+ BASS_MUSIC_RAMPS = $400; // sensitive ramping
+ BASS_MUSIC_SURROUND = $800; // surround sound
+ BASS_MUSIC_SURROUND2 = $1000; // surround sound (mode 2)
+ BASS_MUSIC_FT2MOD = $2000; // play .MOD as FastTracker 2 does
+ BASS_MUSIC_PT1MOD = $4000; // play .MOD as ProTracker 1 does
+ BASS_MUSIC_NONINTER = $10000; // non-interpolated mixing
+ BASS_MUSIC_POSRESET = $8000; // stop all notes when moving position
+ BASS_MUSIC_POSRESETEX = $400000; // stop all notes and reset bmp/etc when moving position
+ BASS_MUSIC_STOPBACK = $80000; // stop the music on a backwards jump effect
+ BASS_MUSIC_NOSAMPLE = $100000; // don't load the samples
+
+ // Speaker assignment flags
+ BASS_SPEAKER_FRONT = $1000000; // front speakers
+ BASS_SPEAKER_REAR = $2000000; // rear/side speakers
+ BASS_SPEAKER_CENLFE = $3000000; // center & LFE speakers (5.1)
+ BASS_SPEAKER_REAR2 = $4000000; // rear center speakers (7.1)
+ BASS_SPEAKER_LEFT = $10000000; // modifier: left
+ BASS_SPEAKER_RIGHT = $20000000; // modifier: right
+ BASS_SPEAKER_FRONTLEFT = BASS_SPEAKER_FRONT or BASS_SPEAKER_LEFT;
+ BASS_SPEAKER_FRONTRIGHT = BASS_SPEAKER_FRONT or BASS_SPEAKER_RIGHT;
+ BASS_SPEAKER_REARLEFT = BASS_SPEAKER_REAR or BASS_SPEAKER_LEFT;
+ BASS_SPEAKER_REARRIGHT = BASS_SPEAKER_REAR or BASS_SPEAKER_RIGHT;
+ BASS_SPEAKER_CENTER = BASS_SPEAKER_CENLFE or BASS_SPEAKER_LEFT;
+ BASS_SPEAKER_LFE = BASS_SPEAKER_CENLFE or BASS_SPEAKER_RIGHT;
+ BASS_SPEAKER_REAR2LEFT = BASS_SPEAKER_REAR2 or BASS_SPEAKER_LEFT;
+ BASS_SPEAKER_REAR2RIGHT = BASS_SPEAKER_REAR2 or BASS_SPEAKER_RIGHT;
+
+ BASS_UNICODE = $80000000;
+
+ BASS_RECORD_PAUSE = $8000; // start recording paused
+
+ // DX7 voice allocation flags
+ BASS_VAM_HARDWARE = 1;
+ {
+ Play the sample in hardware. If no hardware voices are available then
+ the "play" call will fail
+ }
+ BASS_VAM_SOFTWARE = 2;
+ {
+ Play the sample in software (ie. non-accelerated). No other VAM flags
+ may be used together with this flag.
+ }
+
+ // DX7 voice management flags
+ {
+ These flags enable hardware resource stealing... if the hardware has no
+ available voices, a currently playing buffer will be stopped to make room
+ for the new buffer. NOTE: only samples loaded/created with the
+ BASS_SAMPLE_VAM flag are considered for termination by the DX7 voice
+ management.
+ }
+ BASS_VAM_TERM_TIME = 4;
+ {
+ If there are no free hardware voices, the buffer to be terminated will be
+ the one with the least time left to play.
+ }
+ BASS_VAM_TERM_DIST = 8;
+ {
+ If there are no free hardware voices, the buffer to be terminated will be
+ one that was loaded/created with the BASS_SAMPLE_MUTEMAX flag and is
+ beyond
+ it's max distance. If there are no buffers that match this criteria, then
+ the "play" call will fail.
+ }
+ BASS_VAM_TERM_PRIO = 16;
+ {
+ If there are no free hardware voices, the buffer to be terminated will be
+ the one with the lowest priority.
+ }
+
+ // BASS_CHANNELINFO types
+ BASS_CTYPE_SAMPLE = 1;
+ BASS_CTYPE_RECORD = 2;
+ BASS_CTYPE_STREAM = $10000;
+ BASS_CTYPE_STREAM_OGG = $10002;
+ BASS_CTYPE_STREAM_MP1 = $10003;
+ BASS_CTYPE_STREAM_MP2 = $10004;
+ BASS_CTYPE_STREAM_MP3 = $10005;
+ BASS_CTYPE_STREAM_AIFF = $10006;
+ BASS_CTYPE_STREAM_WAV = $40000; // WAVE flag, LOWORD=codec
+ BASS_CTYPE_STREAM_WAV_PCM = $50001;
+ BASS_CTYPE_STREAM_WAV_FLOAT = $50003;
+ BASS_CTYPE_MUSIC_MOD = $20000;
+ BASS_CTYPE_MUSIC_MTM = $20001;
+ BASS_CTYPE_MUSIC_S3M = $20002;
+ BASS_CTYPE_MUSIC_XM = $20003;
+ BASS_CTYPE_MUSIC_IT = $20004;
+ BASS_CTYPE_MUSIC_MO3 = $00100; // MO3 flag
+
+ // 3D channel modes
+ BASS_3DMODE_NORMAL = 0;
+ { normal 3D processing }
+ BASS_3DMODE_RELATIVE = 1;
+ {
+ The channel's 3D position (position/velocity/
+ orientation) are relative to the listener. When the
+ listener's position/velocity/orientation is changed
+ with BASS_Set3DPosition, the channel's position
+ relative to the listener does not change.
+ }
+ BASS_3DMODE_OFF = 2;
+ {
+ Turn off 3D processing on the channel, the sound will
+ be played in the center.
+ }
+
+ // EAX environments, use with BASS_SetEAXParameters
+ EAX_ENVIRONMENT_GENERIC = 0;
+ EAX_ENVIRONMENT_PADDEDCELL = 1;
+ EAX_ENVIRONMENT_ROOM = 2;
+ EAX_ENVIRONMENT_BATHROOM = 3;
+ EAX_ENVIRONMENT_LIVINGROOM = 4;
+ EAX_ENVIRONMENT_STONEROOM = 5;
+ EAX_ENVIRONMENT_AUDITORIUM = 6;
+ EAX_ENVIRONMENT_CONCERTHALL = 7;
+ EAX_ENVIRONMENT_CAVE = 8;
+ EAX_ENVIRONMENT_ARENA = 9;
+ EAX_ENVIRONMENT_HANGAR = 10;
+ EAX_ENVIRONMENT_CARPETEDHALLWAY = 11;
+ EAX_ENVIRONMENT_HALLWAY = 12;
+ EAX_ENVIRONMENT_STONECORRIDOR = 13;
+ EAX_ENVIRONMENT_ALLEY = 14;
+ EAX_ENVIRONMENT_FOREST = 15;
+ EAX_ENVIRONMENT_CITY = 16;
+ EAX_ENVIRONMENT_MOUNTAINS = 17;
+ EAX_ENVIRONMENT_QUARRY = 18;
+ EAX_ENVIRONMENT_PLAIN = 19;
+ EAX_ENVIRONMENT_PARKINGLOT = 20;
+ EAX_ENVIRONMENT_SEWERPIPE = 21;
+ EAX_ENVIRONMENT_UNDERWATER = 22;
+ EAX_ENVIRONMENT_DRUGGED = 23;
+ EAX_ENVIRONMENT_DIZZY = 24;
+ EAX_ENVIRONMENT_PSYCHOTIC = 25;
+ // total number of environments
+ EAX_ENVIRONMENT_COUNT = 26;
+
+ // software 3D mixing algorithm modes (used with BASS_Set3DAlgorithm)
+ BASS_3DALG_DEFAULT = 0;
+ {
+ default algorithm (currently translates to BASS_3DALG_OFF)
+ }
+ BASS_3DALG_OFF = 1;
+ {
+ Uses normal left and right panning. The vertical axis is ignored except
+ for scaling of volume due to distance. Doppler shift and volume scaling
+ are still applied, but the 3D filtering is not performed. This is the
+ most CPU efficient software implementation, but provides no virtual 3D
+ audio effect. Head Related Transfer Function processing will not be done.
+ Since only normal stereo panning is used, a channel using this algorithm
+ may be accelerated by a 2D hardware voice if no free 3D hardware voices
+ are available.
+ }
+ BASS_3DALG_FULL = 2;
+ {
+ This algorithm gives the highest quality 3D audio effect, but uses more
+ CPU. Requires Windows 98 2nd Edition or Windows 2000 that uses WDM
+ drivers, if this mode is not available then BASS_3DALG_OFF will be used
+ instead.
+ }
+ BASS_3DALG_LIGHT = 3;
+ {
+ This algorithm gives a good 3D audio effect, and uses less CPU than the
+ FULL mode. Requires Windows 98 2nd Edition or Windows 2000 that uses WDM
+ drivers, if this mode is not available then BASS_3DALG_OFF will be used
+ instead.
+ }
+
+ {
+ Sync types (with BASS_ChannelSetSync() "param" and
+ SYNCPROC "data" definitions) & flags.
+ }
+ BASS_SYNC_POS = 0;
+ {
+ Sync when a channel reaches a position.
+ param: position in bytes
+ data : not used
+ }
+ BASS_SYNC_END = 2;
+ {
+ Sync when a channel reaches the end.
+ param: not used
+ data : not used
+ }
+ BASS_SYNC_META = 4;
+ {
+ Sync when metadata is received in a stream.
+ param: not used
+ data : pointer to the metadata
+ }
+ BASS_SYNC_SLIDE = 5;
+ {
+ Sync when an attribute slide is completed.
+ param: not used
+ data : the type of slide completed (one of the BASS_SLIDE_xxx values)
+ }
+ BASS_SYNC_STALL = 6;
+ {
+ Sync when playback has stalled.
+ param: not used
+ data : 0=stalled, 1=resumed
+ }
+ BASS_SYNC_DOWNLOAD = 7;
+ {
+ Sync when downloading of an internet (or "buffered" user file) stream has ended.
+ param: not used
+ data : not used
+ }
+ BASS_SYNC_FREE = 8;
+ {
+ Sync when a channel is freed.
+ param: not used
+ data : not used
+ }
+ BASS_SYNC_SETPOS = 11;
+ {
+ Sync when a channel's position is set.
+ param: not used
+ data : 0 = playback buffer not flushed, 1 = playback buffer flushed
+ }
+ BASS_SYNC_MUSICPOS = 10;
+ {
+ Sync when a MOD music reaches an order:row position.
+ param: LOWORD=order (0=first, -1=all) HIWORD=row (0=first, -1=all)
+ data : LOWORD=order HIWORD=row
+ }
+ BASS_SYNC_MUSICINST = 1;
+ {
+ Sync when an instrument (sample for the non-instrument based formats)
+ is played in a MOD music (not including retrigs).
+ param: LOWORD=instrument (1=first) HIWORD=note (0=c0...119=b9, -1=all)
+ data : LOWORD=note HIWORD=volume (0-64)
+ }
+ BASS_SYNC_MUSICFX = 3;
+ {
+ Sync when the "sync" effect (XM/MTM/MOD: E8x/Wxx, IT/S3M: S2x) is used.
+ param: 0:data=pos, 1:data="x" value
+ data : param=0: LOWORD=order HIWORD=row, param=1: "x" value
+ }
+ BASS_SYNC_MESSAGE = $20000000;
+ { FLAG: post a Windows message (instead of callback)
+ When using a window message "callback", the message to post is given in the "proc"
+ parameter of BASS_ChannelSetSync, and is posted to the window specified in the BASS_Init
+ call. The message parameters are: WPARAM = data, LPARAM = user.
+ }
+ BASS_SYNC_MIXTIME = $40000000;
+ { FLAG: sync at mixtime, else at playtime }
+ BASS_SYNC_ONETIME = $80000000;
+ { FLAG: sync only once, else continuously }
+
+ // BASS_ChannelIsActive return values
+ BASS_ACTIVE_STOPPED = 0;
+ BASS_ACTIVE_PLAYING = 1;
+ BASS_ACTIVE_STALLED = 2;
+ BASS_ACTIVE_PAUSED = 3;
+
+ // BASS_ChannelIsSliding return flags
+ BASS_SLIDE_FREQ = 1;
+ BASS_SLIDE_VOL = 2;
+ BASS_SLIDE_PAN = 4;
+
+ // BASS_ChannelGetData flags
+ BASS_DATA_AVAILABLE = 0; // query how much data is buffered
+ BASS_DATA_FLOAT = $40000000; // flag: return floating-point sample data
+ BASS_DATA_FFT512 = $80000000; // 512 sample FFT
+ BASS_DATA_FFT1024 = $80000001; // 1024 FFT
+ BASS_DATA_FFT2048 = $80000002; // 2048 FFT
+ BASS_DATA_FFT4096 = $80000003; // 4096 FFT
+ BASS_DATA_FFT8192 = $80000004; // 8192 FFT
+ BASS_DATA_FFT_INDIVIDUAL = $10; // FFT flag: FFT for each channel, else all combined
+ BASS_DATA_FFT_NOWINDOW = $20; // FFT flag: no Hanning window
+
+ // BASS_ChannelGetTags types : what's returned
+ BASS_TAG_ID3 = 0; // ID3v1 tags : 128 byte block
+ BASS_TAG_ID3V2 = 1; // ID3v2 tags : variable length block
+ BASS_TAG_OGG = 2; // OGG comments : array of null-terminated strings
+ BASS_TAG_HTTP = 3; // HTTP headers : array of null-terminated strings
+ BASS_TAG_ICY = 4; // ICY headers : array of null-terminated strings
+ BASS_TAG_META = 5; // ICY metadata : null-terminated string
+ BASS_TAG_VENDOR = 9; // OGG encoder : null-terminated string
+ BASS_TAG_LYRICS3 = 10; // Lyric3v2 tag : ASCII string
+ BASS_TAG_RIFF_INFO = $100; // RIFF/WAVE tags : array of null-terminated ANSI strings
+ BASS_TAG_MUSIC_NAME = $10000; // MOD music name : ANSI string
+ BASS_TAG_MUSIC_MESSAGE = $10001; // MOD message : ANSI string
+ BASS_TAG_MUSIC_INST = $10100; // + instrument #, MOD instrument name : ANSI string
+ BASS_TAG_MUSIC_SAMPLE = $10300; // + sample #, MOD sample name : ANSI string
+
+ BASS_FX_CHORUS = 0; // GUID_DSFX_STANDARD_CHORUS
+ BASS_FX_COMPRESSOR = 1; // GUID_DSFX_STANDARD_COMPRESSOR
+ BASS_FX_DISTORTION = 2; // GUID_DSFX_STANDARD_DISTORTION
+ BASS_FX_ECHO = 3; // GUID_DSFX_STANDARD_ECHO
+ BASS_FX_FLANGER = 4; // GUID_DSFX_STANDARD_FLANGER
+ BASS_FX_GARGLE = 5; // GUID_DSFX_STANDARD_GARGLE
+ BASS_FX_I3DL2REVERB = 6; // GUID_DSFX_STANDARD_I3DL2REVERB
+ BASS_FX_PARAMEQ = 7; // GUID_DSFX_STANDARD_PARAMEQ
+ BASS_FX_REVERB = 8; // GUID_DSFX_WAVES_REVERB
+
+ BASS_FX_PHASE_NEG_180 = 0;
+ BASS_FX_PHASE_NEG_90 = 1;
+ BASS_FX_PHASE_ZERO = 2;
+ BASS_FX_PHASE_90 = 3;
+ BASS_FX_PHASE_180 = 4;
+
+ // BASS_RecordSetInput flags
+ BASS_INPUT_OFF = $10000;
+ BASS_INPUT_ON = $20000;
+ BASS_INPUT_LEVEL = $40000;
+
+ BASS_INPUT_TYPE_MASK = $ff000000;
+ BASS_INPUT_TYPE_UNDEF = $00000000;
+ BASS_INPUT_TYPE_DIGITAL = $01000000;
+ BASS_INPUT_TYPE_LINE = $02000000;
+ BASS_INPUT_TYPE_MIC = $03000000;
+ BASS_INPUT_TYPE_SYNTH = $04000000;
+ BASS_INPUT_TYPE_CD = $05000000;
+ BASS_INPUT_TYPE_PHONE = $06000000;
+ BASS_INPUT_TYPE_SPEAKER = $07000000;
+ BASS_INPUT_TYPE_WAVE = $08000000;
+ BASS_INPUT_TYPE_AUX = $09000000;
+ BASS_INPUT_TYPE_ANALOG = $0a000000;
+
+ // BASS_SetNetConfig flags
+ BASS_NET_TIMEOUT = 0;
+ BASS_NET_BUFFER = 1;
+
+ // BASS_StreamGetFilePosition modes
+ BASS_FILEPOS_CURRENT = 0;
+ BASS_FILEPOS_DECODE = BASS_FILEPOS_CURRENT;
+ BASS_FILEPOS_DOWNLOAD = 1;
+ BASS_FILEPOS_END = 2;
+ BASS_FILEPOS_START = 3;
+ BASS_FILEPOS_CONNECTED = 4;
+
+ // STREAMFILEPROC actions
+ BASS_FILE_CLOSE = 0;
+ BASS_FILE_READ = 1;
+ BASS_FILE_LEN = 3;
+ BASS_FILE_SEEK = 4;
+
+ BASS_STREAMPROC_END = $80000000; // end of user stream flag
+
+ // BASS_MusicSet/GetAttribute options
+ BASS_MUSIC_ATTRIB_AMPLIFY = 0;
+ BASS_MUSIC_ATTRIB_PANSEP = 1;
+ BASS_MUSIC_ATTRIB_PSCALER = 2;
+ BASS_MUSIC_ATTRIB_BPM = 3;
+ BASS_MUSIC_ATTRIB_SPEED = 4;
+ BASS_MUSIC_ATTRIB_VOL_GLOBAL = 5;
+ BASS_MUSIC_ATTRIB_VOL_CHAN = $100; // + channel #
+ BASS_MUSIC_ATTRIB_VOL_INST = $200; // + instrument #
+
+ // BASS_Set/GetConfig options
+ BASS_CONFIG_BUFFER = 0;
+ BASS_CONFIG_UPDATEPERIOD = 1;
+ BASS_CONFIG_MAXVOL = 3;
+ BASS_CONFIG_GVOL_SAMPLE = 4;
+ BASS_CONFIG_GVOL_STREAM = 5;
+ BASS_CONFIG_GVOL_MUSIC = 6;
+ BASS_CONFIG_CURVE_VOL = 7;
+ BASS_CONFIG_CURVE_PAN = 8;
+ BASS_CONFIG_FLOATDSP = 9;
+ BASS_CONFIG_3DALGORITHM = 10;
+ BASS_CONFIG_NET_TIMEOUT = 11;
+ BASS_CONFIG_NET_BUFFER = 12;
+ BASS_CONFIG_PAUSE_NOPLAY = 13;
+ BASS_CONFIG_NET_PREBUF = 15;
+ BASS_CONFIG_NET_AGENT = 16;
+ BASS_CONFIG_NET_PROXY = 17;
+ BASS_CONFIG_NET_PASSIVE = 18;
+ BASS_CONFIG_REC_BUFFER = 19;
+ BASS_CONFIG_NET_PLAYLIST = 21;
+ BASS_CONFIG_MUSIC_VIRTUAL = 22;
+
+type
+ DWORD = cardinal;
+ BOOL = LongBool;
+ FLOAT = Single;
+ QWORD = int64; // 64-bit (replace "int64" with "comp" if using Delphi 3)
+
+ HMUSIC = DWORD; // MOD music handle
+ HSAMPLE = DWORD; // sample handle
+ HCHANNEL = DWORD; // playing sample's channel handle
+ HSTREAM = DWORD; // sample stream handle
+ HRECORD = DWORD; // recording handle
+ HSYNC = DWORD; // synchronizer handle
+ HDSP = DWORD; // DSP handle
+ HFX = DWORD; // DX8 effect handle
+ HPLUGIN = DWORD; // Plugin handle
+
+ BASS_INFO = record
+ flags: DWORD; // device capabilities (DSCAPS_xxx flags)
+ hwsize: DWORD; // size of total device hardware memory
+ hwfree: DWORD; // size of free device hardware memory
+ freesam: DWORD; // number of free sample slots in the hardware
+ free3d: DWORD; // number of free 3D sample slots in the hardware
+ minrate: DWORD; // min sample rate supported by the hardware
+ maxrate: DWORD; // max sample rate supported by the hardware
+ eax: BOOL; // device supports EAX? (always FALSE if BASS_DEVICE_3D was not used)
+ minbuf: DWORD; // recommended minimum buffer length in ms (requires BASS_DEVICE_LATENCY)
+ dsver: DWORD; // DirectSound version
+ latency: DWORD; // delay (in ms) before start of playback (requires BASS_DEVICE_LATENCY)
+ initflags: DWORD; // "flags" parameter of BASS_Init call
+ speakers: DWORD; // number of speakers available
+ driver: PChar; // driver
+ freq: DWORD; // current output rate (OSX only)
+ end;
+
+ BASS_RECORDINFO = record
+ flags: DWORD; // device capabilities (DSCCAPS_xxx flags)
+ formats: DWORD; // supported standard formats (WAVE_FORMAT_xxx flags)
+ inputs: DWORD; // number of inputs
+ singlein: BOOL; // only 1 input can be set at a time
+ driver: PChar; // driver
+ freq: DWORD; // current input rate (OSX only)
+ end;
+
+ BASS_CHANNELINFO = record
+ freq: DWORD; // default playback rate
+ chans: DWORD; // channels
+ flags: DWORD; // BASS_SAMPLE/STREAM/MUSIC/SPEAKER flags
+ ctype: DWORD; // type of channel
+ origres: DWORD; // original resolution
+ plugin: HPLUGIN; // plugin
+ end;
+
+ BASS_PLUGINFORM = record
+ ctype: DWORD; // channel type
+ name: PChar; // format description
+ exts: PChar; // file extension filter (*.ext1;*.ext2;etc...)
+ end;
+ PBASS_PLUGINFORMS = ^TBASS_PLUGINFORMS;
+ TBASS_PLUGINFORMS = array[0..maxInt div sizeOf(BASS_PLUGINFORM) - 1] of BASS_PLUGINFORM;
+
+ BASS_PLUGININFO = record
+ version: DWORD; // version (same form as BASS_GetVersion)
+ formatc: DWORD; // number of formats
+ formats: PBASS_PLUGINFORMS; // the array of formats
+ end;
+ PBASS_PLUGININFO = ^BASS_PLUGININFO;
+
+ // Sample info structure
+ BASS_SAMPLE = record
+ freq: DWORD; // default playback rate
+ volume: DWORD; // default volume (0-100)
+ pan: Integer; // default pan (-100=left, 0=middle, 100=right)
+ flags: DWORD; // BASS_SAMPLE_xxx flags
+ length: DWORD; // length (in samples, not bytes)
+ max: DWORD; // maximum simultaneous playbacks
+ origres: DWORD; // original resolution
+ chans: DWORD; // number of channels
+ mingap: DWORD; // minimum gap (ms) between creating channels
+ {
+ The following are the sample's default 3D attributes
+ (if the sample is 3D, BASS_SAMPLE_3D is in flags)
+ see BASS_ChannelSet3DAttributes
+ }
+ mode3d: DWORD; // BASS_3DMODE_xxx mode
+ mindist: FLOAT; // minimum distance
+ maxdist: FLOAT; // maximum distance
+ iangle: DWORD; // angle of inside projection cone
+ oangle: DWORD; // angle of outside projection cone
+ outvol: DWORD; // delta-volume outside the projection cone
+ {
+ The following are the defaults used if the sample uses the DirectX 7
+ voice allocation/management features.
+ }
+ vam: DWORD; // voice allocation/management flags (BASS_VAM_xxx)
+ priority: DWORD; // priority (0=lowest, $ffffffff=highest)
+ end;
+
+ // 3D vector (for 3D positions/velocities/orientations)
+ BASS_3DVECTOR = record
+ x: FLOAT; // +=right, -=left
+ y: FLOAT; // +=up, -=down
+ z: FLOAT; // +=front, -=behind
+ end;
+
+ BASS_FXCHORUS = record
+ fWetDryMix: FLOAT;
+ fDepth: FLOAT;
+ fFeedback: FLOAT;
+ fFrequency: FLOAT;
+ lWaveform: DWORD; // 0=triangle, 1=sine
+ fDelay: FLOAT;
+ lPhase: DWORD; // BASS_FX_PHASE_xxx
+ end;
+
+ BASS_FXCOMPRESSOR = record
+ fGain: FLOAT;
+ fAttack: FLOAT;
+ fRelease: FLOAT;
+ fThreshold: FLOAT;
+ fRatio: FLOAT;
+ fPredelay: FLOAT;
+ end;
+
+ BASS_FXDISTORTION = record
+ fGain: FLOAT;
+ fEdge: FLOAT;
+ fPostEQCenterFrequency: FLOAT;
+ fPostEQBandwidth: FLOAT;
+ fPreLowpassCutoff: FLOAT;
+ end;
+
+ BASS_FXECHO = record
+ fWetDryMix: FLOAT;
+ fFeedback: FLOAT;
+ fLeftDelay: FLOAT;
+ fRightDelay: FLOAT;
+ lPanDelay: BOOL;
+ end;
+
+ BASS_FXFLANGER = record
+ fWetDryMix: FLOAT;
+ fDepth: FLOAT;
+ fFeedback: FLOAT;
+ fFrequency: FLOAT;
+ lWaveform: DWORD; // 0=triangle, 1=sine
+ fDelay: FLOAT;
+ lPhase: DWORD; // BASS_FX_PHASE_xxx
+ end;
+
+ BASS_FXGARGLE = record
+ dwRateHz: DWORD; // Rate of modulation in hz
+ dwWaveShape: DWORD; // 0=triangle, 1=square
+ end;
+
+ BASS_FXI3DL2REVERB = record
+ lRoom: Longint; // [-10000, 0] default: -1000 mB
+ lRoomHF: Longint; // [-10000, 0] default: 0 mB
+ flRoomRolloffFactor: FLOAT; // [0.0, 10.0] default: 0.0
+ flDecayTime: FLOAT; // [0.1, 20.0] default: 1.49s
+ flDecayHFRatio: FLOAT; // [0.1, 2.0] default: 0.83
+ lReflections: Longint; // [-10000, 1000] default: -2602 mB
+ flReflectionsDelay: FLOAT; // [0.0, 0.3] default: 0.007 s
+ lReverb: Longint; // [-10000, 2000] default: 200 mB
+ flReverbDelay: FLOAT; // [0.0, 0.1] default: 0.011 s
+ flDiffusion: FLOAT; // [0.0, 100.0] default: 100.0 %
+ flDensity: FLOAT; // [0.0, 100.0] default: 100.0 %
+ flHFReference: FLOAT; // [20.0, 20000.0] default: 5000.0 Hz
+ end;
+
+ BASS_FXPARAMEQ = record
+ fCenter: FLOAT;
+ fBandwidth: FLOAT;
+ fGain: FLOAT;
+ end;
+
+ BASS_FXREVERB = record
+ fInGain: FLOAT; // [-96.0,0.0] default: 0.0 dB
+ fReverbMix: FLOAT; // [-96.0,0.0] default: 0.0 db
+ fReverbTime: FLOAT; // [0.001,3000.0] default: 1000.0 ms
+ fHighFreqRTRatio: FLOAT; // [0.001,0.999] default: 0.001
+ end;
+
+ // callback function types
+ STREAMPROC = function(handle: HSTREAM; buffer: Pointer; length: DWORD; user: DWORD): DWORD; stdcall;
+ {
+ User stream callback function. NOTE: A stream function should obviously be as
+ quick as possible, other streams (and MOD musics) can't be mixed until
+ it's finished.
+ handle : The stream that needs writing
+ buffer : Buffer to write the samples in
+ length : Number of bytes to write
+ user : The 'user' parameter value given when calling BASS_StreamCreate
+ RETURN : Number of bytes written. Set the BASS_STREAMPROC_END flag to end
+ the stream.
+ }
+
+ STREAMFILEPROC = function(action, param1, param2, user: DWORD): DWORD; stdcall;
+ {
+ User file stream callback function.
+ action : The action to perform, one of BASS_FILE_xxx values.
+ param1 : Depends on "action"
+ param2 : Depends on "action"
+ user : The 'user' parameter value given when calling BASS_StreamCreate
+ RETURN : Depends on "action"
+ }
+
+ DOWNLOADPROC = procedure(buffer: Pointer; length: DWORD; user: DWORD); stdcall;
+ {
+ Internet stream download callback function.
+ buffer : Buffer containing the downloaded data... NULL=end of download
+ length : Number of bytes in the buffer
+ user : The 'user' parameter value given when calling BASS_StreamCreateURL
+ }
+
+ SYNCPROC = procedure(handle: HSYNC; channel, data: DWORD; user: DWORD); stdcall;
+ {
+ Sync callback function. NOTE: a sync callback function should be very
+ quick as other syncs cannot be processed until it has finished. If the
+ sync is a "mixtime" sync, then other streams and MOD musics can not be
+ mixed until it's finished either.
+ handle : The sync that has occured
+ channel: Channel that the sync occured in
+ data : Additional data associated with the sync's occurance
+ user : The 'user' parameter given when calling BASS_ChannelSetSync
+ }
+
+ DSPPROC = procedure(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: DWORD); stdcall;
+ {
+ DSP callback function. NOTE: A DSP function should obviously be as quick
+ as possible... other DSP functions, streams and MOD musics can not be
+ processed until it's finished.
+ handle : The DSP handle
+ channel: Channel that the DSP is being applied to
+ buffer : Buffer to apply the DSP to
+ length : Number of bytes in the buffer
+ user : The 'user' parameter given when calling BASS_ChannelSetDSP
+ }
+
+ RECORDPROC = function(handle: HRECORD; buffer: Pointer; length: DWORD; user: DWORD): BOOL; stdcall;
+ {
+ Recording callback function.
+ handle : The recording handle
+ buffer : Buffer containing the recorded sample data
+ length : Number of bytes
+ user : The 'user' parameter value given when calling BASS_RecordStart
+ RETURN : TRUE = continue recording, FALSE = stop
+ }
+
+
+// Functions
+const
+ bassdll = 'bass.dll';
+
+function BASS_SetConfig(option, value: DWORD): DWORD; stdcall; external bassdll;
+function BASS_GetConfig(option: DWORD): DWORD; stdcall; external bassdll;
+function BASS_GetVersion: DWORD; stdcall; external bassdll;
+function BASS_GetDeviceDescription(device: DWORD): PChar; stdcall; external bassdll;
+function BASS_ErrorGetCode: Integer; stdcall; external bassdll;
+function BASS_Init(device: Integer; freq, flags: DWORD; win: HWND; clsid: PGUID): BOOL; stdcall; external bassdll;
+function BASS_SetDevice(device: DWORD): BOOL; stdcall; external bassdll;
+function BASS_GetDevice: DWORD; stdcall; external bassdll;
+function BASS_Free: BOOL; stdcall; external bassdll;
+function BASS_GetDSoundObject(obj: DWORD): Pointer; stdcall; external bassdll;
+function BASS_GetInfo(var info: BASS_INFO): BOOL; stdcall; external bassdll;
+function BASS_Update: BOOL; stdcall; external bassdll;
+function BASS_GetCPU: FLOAT; stdcall; external bassdll;
+function BASS_Start: BOOL; stdcall; external bassdll;
+function BASS_Stop: BOOL; stdcall; external bassdll;
+function BASS_Pause: BOOL; stdcall; external bassdll;
+function BASS_SetVolume(volume: DWORD): BOOL; stdcall; external bassdll;
+function BASS_GetVolume: Integer; stdcall; external bassdll;
+
+function BASS_PluginLoad(filename: PChar; flags: DWORD): HPLUGIN; stdcall; external bassdll;
+function BASS_PluginFree(handle: HPLUGIN): BOOL; stdcall; external bassdll;
+function BASS_PluginGetInfo(handle: HPLUGIN): PBASS_PLUGININFO; stdcall; external bassdll;
+
+function BASS_Set3DFactors(distf, rollf, doppf: FLOAT): BOOL; stdcall; external bassdll;
+function BASS_Get3DFactors(var distf, rollf, doppf: FLOAT): BOOL; stdcall; external bassdll;
+function BASS_Set3DPosition(var pos, vel, front, top: BASS_3DVECTOR): BOOL; stdcall; external bassdll;
+function BASS_Get3DPosition(var pos, vel, front, top: BASS_3DVECTOR): BOOL; stdcall; external bassdll;
+procedure BASS_Apply3D; stdcall; external bassdll;
+function BASS_SetEAXParameters(env: Integer; vol, decay, damp: FLOAT): BOOL; stdcall; external bassdll;
+function BASS_GetEAXParameters(var env: DWORD; var vol, decay, damp: FLOAT): BOOL; stdcall; external bassdll;
+
+function BASS_MusicLoad(mem: BOOL; f: Pointer; offset, length, flags, freq: DWORD): HMUSIC; stdcall; external bassdll;
+function BASS_MusicFree(handle: HMUSIC): BOOL; stdcall; external bassdll;
+function BASS_MusicSetAttribute(handle: HMUSIC; attrib,value: DWORD): DWORD; stdcall; external bassdll;
+function BASS_MusicGetAttribute(handle: HMUSIC; attrib: DWORD): DWORD; stdcall; external bassdll;
+function BASS_MusicGetOrders(handle: HMUSIC): DWORD; stdcall; external bassdll;
+function BASS_MusicGetOrderPosition(handle: HMUSIC): DWORD; stdcall; external bassdll;
+
+function BASS_SampleLoad(mem: BOOL; f: Pointer; offset, length, max, flags: DWORD): HSAMPLE; stdcall; external bassdll;
+function BASS_SampleCreate(length, freq, chans, max, flags: DWORD): Pointer; stdcall; external bassdll;
+function BASS_SampleCreateDone: HSAMPLE; stdcall; external bassdll;
+function BASS_SampleFree(handle: HSAMPLE): BOOL; stdcall; external bassdll;
+function BASS_SampleGetInfo(handle: HSAMPLE; var info: BASS_SAMPLE): BOOL; stdcall; external bassdll;
+function BASS_SampleSetInfo(handle: HSAMPLE; var info: BASS_SAMPLE): BOOL; stdcall; external bassdll;
+function BASS_SampleGetChannel(handle: HSAMPLE; onlynew: BOOL): HCHANNEL; stdcall; external bassdll;
+function BASS_SampleGetChannels(handle: HSAMPLE; channels: Pointer): DWORD; stdcall; external bassdll;
+function BASS_SampleStop(handle: HSAMPLE): BOOL; stdcall; external bassdll;
+
+function BASS_StreamCreate(freq, chans, flags: DWORD; proc: Pointer; user: DWORD): HSTREAM; stdcall; external bassdll;
+function BASS_StreamCreateFile(mem: BOOL; f: Pointer; offset, length, flags: DWORD): HSTREAM; stdcall; external bassdll;
+function BASS_StreamCreateURL(url: PChar; offset: DWORD; flags: DWORD; proc: DOWNLOADPROC; user: DWORD):HSTREAM; stdcall; external bassdll;
+function BASS_StreamCreateFileUser(buffered: BOOL; flags: DWORD; proc: STREAMFILEPROC; user: DWORD): HSTREAM; stdcall; external bassdll;
+function BASS_StreamFree(handle: HSTREAM): BOOL; stdcall; external bassdll;
+function BASS_StreamGetFilePosition(handle:HSTREAM; mode:DWORD) : DWORD;stdcall;external bassdll;
+
+function BASS_RecordGetDeviceDescription(devnum: DWORD):PChar;stdcall;external bassdll;
+function BASS_RecordInit(device: Integer):BOOL;stdcall;external bassdll;
+function BASS_RecordSetDevice(device: DWORD): BOOL; stdcall; external bassdll;
+function BASS_RecordGetDevice: DWORD; stdcall; external bassdll;
+function BASS_RecordFree:BOOL;stdcall;external bassdll;
+function BASS_RecordGetInfo(var info:BASS_RECORDINFO):BOOL;stdcall;external bassdll;
+function BASS_RecordGetInputName(input:Integer):PChar;stdcall;external bassdll;
+function BASS_RecordSetInput(input:Integer; setting:DWORD):BOOL;stdcall;external bassdll;
+function BASS_RecordGetInput(input:Integer):DWORD;stdcall;external bassdll;
+function BASS_RecordStart(freq,chans,flags:DWORD; proc:RECORDPROC; user:DWORD):HRECORD;stdcall;external bassdll;
+
+function BASS_ChannelBytes2Seconds(handle: DWORD; pos: QWORD): FLOAT; stdcall;external bassdll;
+function BASS_ChannelSeconds2Bytes(handle: DWORD; pos: FLOAT): QWORD; stdcall;external bassdll;
+function BASS_ChannelGetDevice(handle: DWORD): DWORD; stdcall; external bassdll;
+function BASS_ChannelSetDevice(handle, device: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelIsActive(handle: DWORD): DWORD; stdcall;external bassdll;
+function BASS_ChannelGetInfo(handle: DWORD; var info:BASS_CHANNELINFO):BOOL;stdcall;external bassdll;
+function BASS_ChannelGetTags(handle: HSTREAM; tags : DWORD): PChar; stdcall; external bassdll;
+function BASS_ChannelSetFlags(handle, flags: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelPreBuf(handle, length: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelPlay(handle: DWORD; restart: BOOL): BOOL; stdcall; external bassdll;
+function BASS_ChannelStop(handle: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelPause(handle: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelSetAttributes(handle: DWORD; freq, volume, pan: Integer): BOOL; stdcall; external bassdll;
+function BASS_ChannelGetAttributes(handle: DWORD; var freq, volume: DWORD; var pan: Integer): BOOL; stdcall; external bassdll;
+function BASS_ChannelSlideAttributes(handle: DWORD; freq, volume, pan: Integer; time: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelIsSliding(handle: DWORD): DWORD; stdcall;external bassdll;
+function BASS_ChannelSet3DAttributes(handle: DWORD; mode: Integer; min, max: FLOAT; iangle, oangle, outvol: Integer): BOOL; stdcall; external bassdll;
+function BASS_ChannelGet3DAttributes(handle: DWORD; var mode: DWORD; var min, max: FLOAT; var iangle, oangle, outvol: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelSet3DPosition(handle: DWORD; var pos, orient, vel: BASS_3DVECTOR): BOOL; stdcall; external bassdll;
+function BASS_ChannelGet3DPosition(handle: DWORD; var pos, orient, vel: BASS_3DVECTOR): BOOL; stdcall; external bassdll;
+function BASS_ChannelGetLength(handle: DWORD): QWORD; stdcall; external bassdll;
+function BASS_ChannelSetPosition(handle: DWORD; pos: QWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelGetPosition(handle: DWORD): QWORD; stdcall; external bassdll;
+function BASS_ChannelGetLevel(handle: DWORD): DWORD; stdcall; external bassdll;
+function BASS_ChannelGetData(handle: DWORD; buffer: Pointer; length: DWORD): DWORD; stdcall; external bassdll;
+function BASS_ChannelSetSync(handle: DWORD; stype: DWORD; param: QWORD; proc: SYNCPROC; user: DWORD): HSYNC; stdcall; external bassdll;
+function BASS_ChannelRemoveSync(handle: DWORD; sync: HSYNC): BOOL; stdcall; external bassdll;
+function BASS_ChannelSetDSP(handle: DWORD; proc: DSPPROC; user: DWORD; priority: Integer): HDSP; stdcall; external bassdll;
+function BASS_ChannelRemoveDSP(handle: DWORD; dsp: HDSP): BOOL; stdcall; external bassdll;
+function BASS_ChannelSetEAXMix(handle: DWORD; mix: FLOAT): BOOL; stdcall; external bassdll;
+function BASS_ChannelGetEAXMix(handle: DWORD; var mix: FLOAT): BOOL; stdcall; external bassdll;
+function BASS_ChannelSetLink(handle, chan: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelRemoveLink(handle, chan: DWORD): BOOL; stdcall; external bassdll;
+function BASS_ChannelSetFX(handle, etype: DWORD; priority: Integer): HFX; stdcall; external bassdll;
+function BASS_ChannelRemoveFX(handle: DWORD; fx: HFX): BOOL; stdcall; external bassdll;
+
+function BASS_FXSetParameters(handle: HFX; par: Pointer): BOOL; stdcall; external bassdll;
+function BASS_FXGetParameters(handle: HFX; par: Pointer): BOOL; stdcall; external bassdll;
+function BASS_FXReset(handle: HFX): BOOL; stdcall; external bassdll;
+
+
+function BASS_SPEAKER_N(n: DWORD): DWORD;
+function MAKEMUSICPOS(order,row: DWORD): DWORD;
+function BASS_SetEAXPreset(env: Integer): BOOL;
+{
+ This function is defined in the implementation part of this unit.
+ It is not part of BASS.DLL but an extra function which makes it easier
+ to set the predefined EAX environments.
+ env : a EAX_ENVIRONMENT_xxx constant
+}
+
+
+implementation
+
+function BASS_SPEAKER_N(n: DWORD): DWORD;
+begin
+ Result := n shl 24;
+end;
+
+function MAKEMUSICPOS(order,row: DWORD): DWORD;
+begin
+ Result := $80000000 or DWORD(MAKELONG(order,row));
+end;
+
+function BASS_SetEAXPreset(env: Integer): BOOL;
+begin
+ case (env) of
+ EAX_ENVIRONMENT_GENERIC:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_GENERIC, 0.5, 1.493, 0.5);
+ EAX_ENVIRONMENT_PADDEDCELL:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PADDEDCELL, 0.25, 0.1, 0);
+ EAX_ENVIRONMENT_ROOM:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_ROOM, 0.417, 0.4, 0.666);
+ EAX_ENVIRONMENT_BATHROOM:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_BATHROOM, 0.653, 1.499, 0.166);
+ EAX_ENVIRONMENT_LIVINGROOM:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_LIVINGROOM, 0.208, 0.478, 0);
+ EAX_ENVIRONMENT_STONEROOM:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_STONEROOM, 0.5, 2.309, 0.888);
+ EAX_ENVIRONMENT_AUDITORIUM:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_AUDITORIUM, 0.403, 4.279, 0.5);
+ EAX_ENVIRONMENT_CONCERTHALL:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CONCERTHALL, 0.5, 3.961, 0.5);
+ EAX_ENVIRONMENT_CAVE:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CAVE, 0.5, 2.886, 1.304);
+ EAX_ENVIRONMENT_ARENA:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_ARENA, 0.361, 7.284, 0.332);
+ EAX_ENVIRONMENT_HANGAR:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_HANGAR, 0.5, 10.0, 0.3);
+ EAX_ENVIRONMENT_CARPETEDHALLWAY:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CARPETEDHALLWAY, 0.153, 0.259, 2.0);
+ EAX_ENVIRONMENT_HALLWAY:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_HALLWAY, 0.361, 1.493, 0);
+ EAX_ENVIRONMENT_STONECORRIDOR:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_STONECORRIDOR, 0.444, 2.697, 0.638);
+ EAX_ENVIRONMENT_ALLEY:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_ALLEY, 0.25, 1.752, 0.776);
+ EAX_ENVIRONMENT_FOREST:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_FOREST, 0.111, 3.145, 0.472);
+ EAX_ENVIRONMENT_CITY:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_CITY, 0.111, 2.767, 0.224);
+ EAX_ENVIRONMENT_MOUNTAINS:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_MOUNTAINS, 0.194, 7.841, 0.472);
+ EAX_ENVIRONMENT_QUARRY:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_QUARRY, 1, 1.499, 0.5);
+ EAX_ENVIRONMENT_PLAIN:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PLAIN, 0.097, 2.767, 0.224);
+ EAX_ENVIRONMENT_PARKINGLOT:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PARKINGLOT, 0.208, 1.652, 1.5);
+ EAX_ENVIRONMENT_SEWERPIPE:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_SEWERPIPE, 0.652, 2.886, 0.25);
+ EAX_ENVIRONMENT_UNDERWATER:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_UNDERWATER, 1, 1.499, 0);
+ EAX_ENVIRONMENT_DRUGGED:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_DRUGGED, 0.875, 8.392, 1.388);
+ EAX_ENVIRONMENT_DIZZY:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_DIZZY, 0.139, 17.234, 0.666);
+ EAX_ENVIRONMENT_PSYCHOTIC:
+ Result := BASS_SetEAXParameters(EAX_ENVIRONMENT_PSYCHOTIC, 0.486, 7.563, 0.806);
+ else
+ Result := FALSE;
+ end;
+end;
+
+end.
+// END OF FILE /////////////////////////////////////////////////////////////////
+
diff --git a/Game/Code/lib/ffmpeg/MATHEMATICS.pas b/Game/Code/lib/ffmpeg/MATHEMATICS.pas new file mode 100644 index 00000000..83121899 --- /dev/null +++ b/Game/Code/lib/ffmpeg/MATHEMATICS.pas @@ -0,0 +1,66 @@ +unit MATHEMATICS; + +interface + +(* + * copyright (c) 2005 Michael Niedermayer <michaelni@gmx.at> + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + *) + +(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows. +For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT +in the source codes *) + +{$MODE DELPHI} (* CAT *) +{$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *) +{$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *) + +uses + rational; (* CAT *) + +const + av__util = 'libavutil.49'; (* CAT *) + +type + TAVRounding = ( + AV_ROUND_ZERO = 0, ///< round toward zero + AV_ROUND_INF = 1, ///< round away from zero + AV_ROUND_DOWN = 2, ///< round toward -infinity + AV_ROUND_UP = 3, ///< round toward +infinity + AV_ROUND_NEAR_INF = 5, ///< round to nearest and halfway cases away from zero + AV_ROUND_FUCKING = $FFFFFF + ); + +(** * rescale a 64bit integer with rounding to nearest. + * a simple a*b/c isn't possible as it can overflow *) +function av_rescale (a, b, c: int64): int64; + cdecl; external av__util; + +(** + * rescale a 64bit integer with specified rounding. + * a simple a*b/c isn't possible as it can overflow *) +function av_rescale_rnd (a, b, c: int64; enum: TAVRounding): int64; + cdecl; external av__util; + +(** + * rescale a 64bit integer by 2 rational numbers. *) +function av_rescale_q (a: int64; bq, cq: TAVRational): int64; + cdecl; external av__util; + +implementation + +end. + diff --git a/Game/Code/lib/ffmpeg/acm_unit.pas b/Game/Code/lib/ffmpeg/acm_unit.pas new file mode 100644 index 00000000..307fb479 --- /dev/null +++ b/Game/Code/lib/ffmpeg/acm_unit.pas @@ -0,0 +1,197 @@ +unit acm_unit;
+
+interface
+
+uses
+ windows, mmsystem;
+ (*
+ ******************************************************************************
+ * číňĺđôĺéń ę MS Audio Compression Manager
+ ******************************************************************************
+ *)
+type
+ PWaveFilter = ^TWaveFilter;
+ // Defined in mmreg.h
+ WAVEFILTER = packed record
+ cbStruct: DWORD; // Size of the filter in bytes
+ dwFilterTag: DWORD; // filter type
+ fdwFilter: DWORD; // Flags for the filter (Universal Dfns)
+ dwReserved: array [0..4] of DWORD; // Reserved for system use
+ end;
+ TWaveFilter = WAVEFILTER;
+
+ HACMDRIVERID__ = record
+ Unused: Integer;
+ end;
+ {$EXTERNALSYM HACMDRIVERID__}
+ HACMDRIVERID = ^HACMDRIVERID__;
+ {$EXTERNALSYM HACMDRIVERID}
+ PHACMDRIVERID = ^HACMDRIVERID;
+ {$EXTERNALSYM PHACMDRIVERID}
+ LPHACMDRIVERID = ^HACMDRIVERID;
+ {$EXTERNALSYM LPHACMDRIVERID}
+
+ HACMDRIVER__ = record
+ Unused: Integer;
+ end;
+
+ {$EXTERNALSYM HACMDRIVER__}
+ HACMDRIVER = ^HACMDRIVER__;
+ {$EXTERNALSYM HACMDRIVER}
+ PHACMDRIVER = ^HACMDRIVER;
+ {$EXTERNALSYM PHACMDRIVER}
+ LPHACMDRIVER = ^HACMDRIVER;
+ {$EXTERNALSYM LPHACMDRIVER}
+
+ HACMSTREAM__ = record
+ Unused: Integer;
+ end;
+
+ {$EXTERNALSYM HACMSTREAM__}
+ HACMSTREAM = ^HACMSTREAM__;
+ {$EXTERNALSYM HACMSTREAM}
+ PHACMSTREAM = ^HACMSTREAM;
+ {$EXTERNALSYM PHACMSTREAM}
+ LPHACMSTREAM = ^HACMSTREAM;
+ {$EXTERNALSYM LPHACMSTREAM}
+
+ PAcmStreamHeader = ^TAcmStreamHeader;
+ ACMSTREAMHEADER = packed record
+ cbStruct: DWORD;
+ fdwStatus: DWORD;
+ dwUser: DWORD;
+ pbSrc: PBYTE;
+ cbSrcLength: DWORD;
+ cbSrcLengthUsed: DWORD;
+ dwSrcUser: DWORD;
+ pbDst: PBYTE;
+ cbDstLength: DWORD;
+ cbDstLengthUsed: DWORD;
+ dwDstUser: DWORD;
+ dwReservedDriver: array [0..10 - 1] of DWORD;
+ end;
+ {$EXTERNALSYM tACMSTREAMHEADER}
+ TAcmStreamHeader = ACMSTREAMHEADER;
+
+const
+ ACMSTREAMHEADER_STATUSF_DONE = $00010000;
+ {$EXTERNALSYM ACMSTREAMHEADER_STATUSF_DONE}
+ ACMSTREAMHEADER_STATUSF_PREPARED = $00020000;
+ {$EXTERNALSYM ACMSTREAMHEADER_STATUSF_PREPARED}
+ ACMSTREAMHEADER_STATUSF_INQUEUE = $00100000;
+ {$EXTERNALSYM ACMSTREAMHEADER_STATUSF_INQUEUE}
+
+function acmStreamOpen(var phas: HACMSTREAM; had: HACMDRIVER; var pwfxSrc: TWAVEFORMATEX;
+ var pwfxDst: TWAVEFORMATEX; pwfltr: PWAVEFILTER; dwCallback: DWORD; dwInstance: DWORD;
+ fdwOpen: DWORD): MMRESULT; stdcall;
+{$EXTERNALSYM acmStreamOpen}
+
+const
+ ACM_STREAMOPENF_QUERY = $00000001;
+ {$EXTERNALSYM ACM_STREAMOPENF_QUERY}
+ ACM_STREAMOPENF_ASYNC = $00000002;
+ {$EXTERNALSYM ACM_STREAMOPENF_ASYNC}
+ ACM_STREAMOPENF_NONREALTIME = $00000004;
+ {$EXTERNALSYM ACM_STREAMOPENF_NONREALTIME}
+
+function acmStreamSize(has: HACMSTREAM; cbInput: DWORD; var pdwOutputBytes: DWORD;
+ fdwSize: DWORD): MMRESULT; stdcall;
+{$EXTERNALSYM acmStreamSize}
+
+const
+ ACM_STREAMSIZEF_SOURCE = $00000000;
+ {$EXTERNALSYM ACM_STREAMSIZEF_SOURCE}
+ ACM_STREAMSIZEF_DESTINATION = $00000001;
+ {$EXTERNALSYM ACM_STREAMSIZEF_DESTINATION}
+ ACM_STREAMSIZEF_QUERYMASK = $0000000F;
+ {$EXTERNALSYM ACM_STREAMSIZEF_QUERYMASK}
+
+function acmStreamConvert(has: HACMSTREAM; var pash: TAcmStreamHeader;
+ fdwConvert: DWORD): MMRESULT; stdcall;
+{$EXTERNALSYM acmStreamConvert}
+
+const
+ ACM_STREAMCONVERTF_BLOCKALIGN = $00000004;
+ {$EXTERNALSYM ACM_STREAMCONVERTF_BLOCKALIGN}
+ ACM_STREAMCONVERTF_START = $00000010;
+ {$EXTERNALSYM ACM_STREAMCONVERTF_START}
+ ACM_STREAMCONVERTF_END = $00000020;
+ {$EXTERNALSYM ACM_STREAMCONVERTF_END}
+
+function acmStreamPrepareHeader(has: HACMSTREAM; var pash: TAcmStreamHeader;
+ fdwPrepare: DWORD): MMRESULT; stdcall;
+{$EXTERNALSYM acmStreamPrepareHeader}
+
+function acmStreamUnprepareHeader(has: HACMSTREAM; var pash: TAcmStreamHeader;
+ fdwUnprepare: DWORD): MMRESULT; stdcall;
+{$EXTERNALSYM acmStreamUnprepareHeader}
+
+function acmStreamClose(has: HACMSTREAM; fdwClose: DWORD): MMRESULT; stdcall;
+{$EXTERNALSYM acmStreamClose}
+ (*
+ ******************************************************************************
+ * číňĺđôĺéń ę MS Audio Compression Manager
+ ******************************************************************************
+ *)
+
+implementation
+
+const
+ msacm32 = 'msacm32.dll';
+
+(*function acmGetVersion; external msacm32 name 'acmGetVersion';
+function acmMetrics; external msacm32 name 'acmMetrics';
+function acmDriverEnum; external msacm32 name 'acmDriverEnum';
+function acmDriverID; external msacm32 name 'acmDriverID';
+function acmDriverAddA; external msacm32 name 'acmDriverAddA';
+function acmDriverAddW; external msacm32 name 'acmDriverAddW';
+function acmDriverAdd; external msacm32 name 'acmDriverAddA';
+function acmDriverRemove; external msacm32 name 'acmDriverRemove';
+function acmDriverOpen; external msacm32 name 'acmDriverOpen';
+function acmDriverClose; external msacm32 name 'acmDriverClose';
+function acmDriverMessage; external msacm32 name 'acmDriverMessage';
+function acmDriverPriority; external msacm32 name 'acmDriverPriority';
+function acmDriverDetailsA; external msacm32 name 'acmDriverDetailsA';
+function acmDriverDetailsW; external msacm32 name 'acmDriverDetailsW';
+function acmDriverDetails; external msacm32 name 'acmDriverDetailsA';
+function acmFormatTagDetailsA; external msacm32 name 'acmFormatTagDetailsA';
+function acmFormatTagDetailsW; external msacm32 name 'acmFormatTagDetailsW';
+function acmFormatTagDetails; external msacm32 name 'acmFormatTagDetailsA';
+function acmFormatDetailsA; external msacm32 name 'acmFormatDetailsA';
+function acmFormatDetailsW; external msacm32 name 'acmFormatDetailsW';
+function acmFormatDetails; external msacm32 name 'acmFormatDetailsA';
+function acmFormatChooseA; external msacm32 name 'acmFormatChooseA';
+function acmFormatChooseW; external msacm32 name 'acmFormatChooseW';
+function acmFormatChoose; external msacm32 name 'acmFormatChooseA';
+function acmFormatEnumA; external msacm32 name 'acmFormatEnumA';
+function acmFormatEnumW; external msacm32 name 'acmFormatEnumW';
+function acmFormatEnum; external msacm32 name 'acmFormatEnumA';
+function acmFormatTagEnumA; external msacm32 name 'acmFormatTagEnumA';
+function acmFormatTagEnumW; external msacm32 name 'acmFormatTagEnumW';
+function acmFormatTagEnum; external msacm32 name 'acmFormatTagEnumA';
+function acmFormatSuggest; external msacm32 name 'acmFormatSuggest';
+function acmFilterTagDetailsA; external msacm32 name 'acmFilterTagDetailsA';
+function acmFilterTagDetailsW; external msacm32 name 'acmFilterTagDetailsW';
+function acmFilterTagDetails; external msacm32 name 'acmFilterTagDetailsA';
+function acmFilterTagEnumA; external msacm32 name 'acmFilterTagEnumA';
+function acmFilterTagEnumW; external msacm32 name 'acmFilterTagEnumW';
+function acmFilterTagEnum; external msacm32 name 'acmFilterTagEnumA';
+function acmFilterDetailsA; external msacm32 name 'acmFilterDetailsA';
+function acmFilterDetailsW; external msacm32 name 'acmFilterDetailsW';
+function acmFilterDetails; external msacm32 name 'acmFilterDetailsA';
+function acmFilterEnumA; external msacm32 name 'acmFilterEnumA';
+function acmFilterEnumW; external msacm32 name 'acmFilterEnumW';
+function acmFilterEnum; external msacm32 name 'acmFilterEnumA';
+function acmFilterChooseA; external msacm32 name 'acmFilterChooseA';
+function acmFilterChooseW; external msacm32 name 'acmFilterChooseW';
+function acmFilterChoose; external msacm32 name 'acmFilterChooseA'; *)
+function acmStreamOpen; external msacm32 name 'acmStreamOpen';
+function acmStreamClose; external msacm32 name 'acmStreamClose';
+function acmStreamSize; external msacm32 name 'acmStreamSize';
+//function acmStreamReset; external msacm32 name 'acmStreamReset';
+//function acmStreamMessage; external msacm32 name 'acmStreamMessage';
+function acmStreamConvert; external msacm32 name 'acmStreamConvert';
+function acmStreamPrepareHeader; external msacm32 name 'acmStreamPrepareHeader';
+function acmStreamUnprepareHeader; external msacm32 name 'acmStreamUnprepareHeader';
+
+end.
diff --git a/Game/Code/lib/ffmpeg/avcodec.pas b/Game/Code/lib/ffmpeg/avcodec.pas new file mode 100644 index 00000000..bcfe9809 --- /dev/null +++ b/Game/Code/lib/ffmpeg/avcodec.pas @@ -0,0 +1,2043 @@ + (*
+ * copyright (c) 2001 Fabrice Bellard
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows.
+For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT
+in the source codes *)
+
+unit avcodec;
+
+{$IFDEF FPC}
+ {$IFNDEF win32}
+ {$LINKLIB libavutil}
+ {$LINKLIB libavcodec}
+ {$ENDIF}
+ {$MODE DELPHI } (* CAT *)
+ {$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *)
+ {$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *)
+{$ENDIF}
+
+interface
+
+uses
+ avutil, rational, opt; // CAT
+
+const
+{$IFDEF win32}
+ av__format = 'avformat-50.dll';
+{$ELSE}
+ av__format = 'libavformat.so'; // .0d
+// av__format = 'libavformat.51';
+{$ENDIF}
+
+
+ LIBAVUTIL_VERSION_INT = ((51 shl 16) + (12 shl 8) + 1);
+ LIBAVUTIL_VERSION = '51.12.1';
+ LIBAVUTIL_BUILD = LIBAVUTIL_VERSION_INT;
+
+ AV_NOPTS_VALUE: int64 = $8000000000000000;
+ AV_TIME_BASE = 1000000;
+ AV_TIME_BASE_Q : TAVRational = (num:1; den:AV_TIME_BASE); (* added by CAT *)
+
+type
+ TCodecID = (
+ CODEC_ID_NONE, CODEC_ID_MPEG1VIDEO,
+ CODEC_ID_MPEG2VIDEO, //* prefered ID for MPEG Video 1 or 2 decoding */
+ CODEC_ID_MPEG2VIDEO_XVMC, CODEC_ID_H261, CODEC_ID_H263, CODEC_ID_RV10,
+ CODEC_ID_RV20, CODEC_ID_MJPEG, CODEC_ID_MJPEGB, CODEC_ID_LJPEG,
+ CODEC_ID_SP5X, CODEC_ID_JPEGLS, CODEC_ID_MPEG4, CODEC_ID_RAWVIDEO,
+ CODEC_ID_MSMPEG4V1, CODEC_ID_MSMPEG4V2, CODEC_ID_MSMPEG4V3,
+ CODEC_ID_WMV1, CODEC_ID_WMV2, CODEC_ID_H263P,
+ CODEC_ID_H263I, CODEC_ID_FLV1, CODEC_ID_SVQ1, CODEC_ID_SVQ3,
+ CODEC_ID_DVVIDEO, CODEC_ID_HUFFYUV, CODEC_ID_CYUV, CODEC_ID_H264,
+ CODEC_ID_INDEO3, CODEC_ID_VP3, CODEC_ID_THEORA, CODEC_ID_ASV1,
+ CODEC_ID_ASV2, CODEC_ID_FFV1, CODEC_ID_4XM, CODEC_ID_VCR1,
+ CODEC_ID_CLJR, CODEC_ID_MDEC, CODEC_ID_ROQ, CODEC_ID_INTERPLAY_VIDEO,
+ CODEC_ID_XAN_WC3, CODEC_ID_XAN_WC4, CODEC_ID_RPZA, CODEC_ID_CINEPAK,
+ CODEC_ID_WS_VQA, CODEC_ID_MSRLE, CODEC_ID_MSVIDEO1, CODEC_ID_IDCIN,
+ CODEC_ID_8BPS, CODEC_ID_SMC, CODEC_ID_FLIC, CODEC_ID_TRUEMOTION1,
+ CODEC_ID_VMDVIDEO, CODEC_ID_MSZH, CODEC_ID_ZLIB, CODEC_ID_QTRLE,
+ CODEC_ID_SNOW, CODEC_ID_TSCC, CODEC_ID_ULTI, CODEC_ID_QDRAW,
+ CODEC_ID_VIXL, CODEC_ID_QPEG, CODEC_ID_XVID, CODEC_ID_PNG,
+ CODEC_ID_PPM, CODEC_ID_PBM, CODEC_ID_PGM, CODEC_ID_PGMYUV,
+ CODEC_ID_PAM, CODEC_ID_FFVHUFF, CODEC_ID_RV30, CODEC_ID_RV40,
+ CODEC_ID_VC1, CODEC_ID_WMV3, CODEC_ID_LOCO, CODEC_ID_WNV1,
+ CODEC_ID_AASC, CODEC_ID_INDEO2, CODEC_ID_FRAPS, CODEC_ID_TRUEMOTION2,
+ CODEC_ID_BMP, CODEC_ID_CSCD, CODEC_ID_MMVIDEO, CODEC_ID_ZMBV,
+ CODEC_ID_AVS, CODEC_ID_SMACKVIDEO, CODEC_ID_NUV, CODEC_ID_KMVC,
+ CODEC_ID_FLASHSV, CODEC_ID_CAVS, CODEC_ID_JPEG2000, CODEC_ID_VMNC,
+ CODEC_ID_VP5, CODEC_ID_VP6, CODEC_ID_VP6F,
+
+ //* various pcm "codecs" */
+ CODEC_ID_PCM_S16LE= $10000, CODEC_ID_PCM_S16BE, CODEC_ID_PCM_U16LE,
+ CODEC_ID_PCM_U16BE, CODEC_ID_PCM_S8, CODEC_ID_PCM_U8, CODEC_ID_PCM_MULAW,
+ CODEC_ID_PCM_ALAW, CODEC_ID_PCM_S32LE, CODEC_ID_PCM_S32BE, CODEC_ID_PCM_U32LE,
+ CODEC_ID_PCM_U32BE, CODEC_ID_PCM_S24LE, CODEC_ID_PCM_S24BE, CODEC_ID_PCM_U24LE,
+ CODEC_ID_PCM_U24BE, CODEC_ID_PCM_S24DAUD,
+ //* various adpcm codecs */
+ CODEC_ID_ADPCM_IMA_QT= $11000, CODEC_ID_ADPCM_IMA_WAV, CODEC_ID_ADPCM_IMA_DK3,
+ CODEC_ID_ADPCM_IMA_DK4, CODEC_ID_ADPCM_IMA_WS, CODEC_ID_ADPCM_IMA_SMJPEG,
+ CODEC_ID_ADPCM_MS, CODEC_ID_ADPCM_4XM, CODEC_ID_ADPCM_XA, CODEC_ID_ADPCM_ADX,
+ CODEC_ID_ADPCM_EA, CODEC_ID_ADPCM_G726, CODEC_ID_ADPCM_CT, CODEC_ID_ADPCM_SWF,
+ CODEC_ID_ADPCM_YAMAHA, CODEC_ID_ADPCM_SBPRO_4, CODEC_ID_ADPCM_SBPRO_3,
+ CODEC_ID_ADPCM_SBPRO_2,
+ //* AMR */
+ CODEC_ID_AMR_NB= $12000, CODEC_ID_AMR_WB,
+ //* RealAudio codecs*/
+ CODEC_ID_RA_144= $13000, CODEC_ID_RA_288,
+ //* various DPCM codecs */
+ CODEC_ID_ROQ_DPCM= $14000, CODEC_ID_INTERPLAY_DPCM, CODEC_ID_XAN_DPCM,
+ CODEC_ID_SOL_DPCM, CODEC_ID_MP2= $15000,
+ CODEC_ID_MP3, //* prefered ID for MPEG Audio layer 1, 2 or3 decoding */
+ CODEC_ID_AAC, CODEC_ID_MPEG4AAC, CODEC_ID_AC3, CODEC_ID_DTS, CODEC_ID_VORBIS,
+ CODEC_ID_DVAUDIO, CODEC_ID_WMAV1, CODEC_ID_WMAV2, CODEC_ID_MACE3,
+ CODEC_ID_MACE6, CODEC_ID_VMDAUDIO, CODEC_ID_SONIC, CODEC_ID_SONIC_LS,
+ CODEC_ID_FLAC, CODEC_ID_MP3ADU, CODEC_ID_MP3ON4, CODEC_ID_SHORTEN,
+ CODEC_ID_ALAC, CODEC_ID_WESTWOOD_SND1, CODEC_ID_GSM, CODEC_ID_QDM2,
+ CODEC_ID_COOK, CODEC_ID_TRUESPEECH, CODEC_ID_TTA, CODEC_ID_SMACKAUDIO,
+ CODEC_ID_QCELP, CODEC_ID_WAVPACK,
+ //* subtitle codecs */
+ CODEC_ID_DVD_SUBTITLE= $17000, CODEC_ID_DVB_SUBTITLE,
+
+ CODEC_ID_MPEG2TS= $20000 //* _FAKE_ codec to indicate a raw MPEG2 transport
+ // stream (only used by libavformat) */
+ );
+
+//* CODEC_ID_MP3LAME is absolete */
+const
+ CODEC_ID_MP3LAME = CODEC_ID_MP3;
+
+ AVPALETTE_SIZE = 1024;
+ AVPALETTE_COUNT = 256;
+
+type
+ TCodecType = (
+ CODEC_TYPE_UNKNOWN = -1,
+ CODEC_TYPE_VIDEO,
+ CODEC_TYPE_AUDIO,
+ CODEC_TYPE_DATA,
+ CODEC_TYPE_SUBTITLE,
+ CODEC_TYPE_NB (* CAT#3 *)
+ );
+
+//* currently unused, may be used if 24/32 bits samples ever supported */
+//* all in native endian */
+ TSampleFormat = (
+ SAMPLE_FMT_NONE = -1,
+ SAMPLE_FMT_U8, ///< unsigned 8 bits
+ SAMPLE_FMT_S16, ///< signed 16 bits
+ SAMPLE_FMT_S24, ///< signed 24 bits
+ SAMPLE_FMT_S32, ///< signed 32 bits
+ SAMPLE_FMT_FLT ///< float
+ );
+
+const
+//* in bytes */
+ AVCODEC_MAX_AUDIO_FRAME_SIZE = 192000; // 1 second of 48khz 32bit audio
+
+(**
+ * Required number of additionally allocated bytes at the end of the input bitstream for decoding.
+ * this is mainly needed because some optimized bitstream readers read
+ * 32 or 64 bit at once and could read over the end<br>
+ * Note, if the first 23 bits of the additional bytes are not 0 then damaged
+ * MPEG bitstreams could cause overread and segfault
+ *)
+ FF_INPUT_BUFFER_PADDING_SIZE = 8;
+
+(**
+ * minimum encoding buffer size.
+ * used to avoid some checks during header writing
+ *)
+ FF_MIN_BUFFER_SIZE = 16384;
+
+type
+//* motion estimation type, EPZS by default */
+ TMotion_Est_ID = (
+ ME_ZERO = 1,
+ ME_FULL,
+ ME_LOG,
+ ME_PHODS,
+ ME_EPZS,
+ ME_X1,
+ ME_HEX,
+ ME_UMH,
+ ME_ITER
+ );
+
+ TAVDiscard = (
+//we leave some space between them for extensions (drop some keyframes for intra only or drop just some bidir frames)
+ AVDISCARD_NONE = -16, ///< discard nothing
+ AVDISCARD_DEFAULT= 0, ///< discard useless packets like 0 size packets in avi
+ AVDISCARD_NONREF = 8, ///< discard all non reference
+ AVDISCARD_BIDIR = 16, ///< discard all bidirectional frames
+ AVDISCARD_NONKEY = 32, ///< discard all frames except keyframes
+ AVDISCARD_ALL = 48, ///< discard all
+ AVDISCARD_FUCK = $FFFFFF
+ );
+
+ PRcOverride = ^TRcOverride;
+ TRcOverride = record {16}
+ start_frame: integer;
+ end_frame: integer;
+ qscale: integer; // if this is 0 then quality_factor will be used instead
+ quality_factor: single;
+ end;
+
+const
+ FF_MAX_B_FRAMES = 16;
+
+(* encoding support
+ these flags can be passed in AVCodecContext.flags before initing
+ Note: not everything is supported yet.
+*)
+
+ CODEC_FLAG_QSCALE = $0002; ///< use fixed qscale
+ CODEC_FLAG_4MV = $0004; ///< 4 MV per MB allowed / Advanced prediction for H263
+ CODEC_FLAG_QPEL = $0010; ///< use qpel MC
+ CODEC_FLAG_GMC = $0020; ///< use GMC
+ CODEC_FLAG_MV0 = $0040; ///< always try a MB with MV=<0,0>
+ CODEC_FLAG_PART = $0080; ///< use data partitioning
+//* parent program gurantees that the input for b-frame containing streams is not written to
+// for at least s->max_b_frames+1 frames, if this is not set than the input will be copied */
+ CODEC_FLAG_INPUT_PRESERVED = $0100;
+ CODEC_FLAG_PASS1 = $0200; ///< use internal 2pass ratecontrol in first pass mode
+ CODEC_FLAG_PASS2 = $0400; ///< use internal 2pass ratecontrol in second pass mode
+ CODEC_FLAG_EXTERN_HUFF = $1000; ///< use external huffman table (for mjpeg)
+ CODEC_FLAG_GRAY = $2000; ///< only decode/encode grayscale
+ CODEC_FLAG_EMU_EDGE = $4000; ///< don't draw edges
+ CODEC_FLAG_PSNR = $8000; ///< error[?] variables will be set during encoding
+ CODEC_FLAG_TRUNCATED = $00010000; //** input bitstream might be truncated at a random location instead
+ // of only at frame boundaries */
+ CODEC_FLAG_NORMALIZE_AQP = $00020000; ///< normalize adaptive quantization
+ CODEC_FLAG_INTERLACED_DCT = $00040000; ///< use interlaced dct
+ CODEC_FLAG_LOW_DELAY = $00080000; ///< force low delay
+ CODEC_FLAG_ALT_SCAN = $00100000; ///< use alternate scan
+ CODEC_FLAG_TRELLIS_QUANT = $00200000; ///< use trellis quantization
+ CODEC_FLAG_GLOBAL_HEADER = $00400000; ///< place global headers in extradata instead of every keyframe
+ CODEC_FLAG_BITEXACT = $00800000; ///< use only bitexact stuff (except (i)dct)
+//* Fx : Flag for h263+ extra options */
+ CODEC_FLAG_H263P_AIC = $01000000; ///< H263 Advanced intra coding / MPEG4 AC prediction (remove this)
+ CODEC_FLAG_AC_PRED = $01000000; ///< H263 Advanced intra coding / MPEG4 AC prediction
+ CODEC_FLAG_H263P_UMV = $02000000; ///< Unlimited motion vector
+ CODEC_FLAG_CBP_RD = $04000000; ///< use rate distortion optimization for cbp
+ CODEC_FLAG_QP_RD = $08000000; ///< use rate distortion optimization for qp selectioon
+ CODEC_FLAG_H263P_AIV = $00000008; ///< H263 Alternative inter vlc
+ CODEC_FLAG_OBMC = $00000001; ///< OBMC
+ CODEC_FLAG_LOOP_FILTER = $00000800; ///< loop filter
+ CODEC_FLAG_H263P_SLICE_STRUCT = $10000000;
+ CODEC_FLAG_INTERLACED_ME = $20000000; ///< interlaced motion estimation
+ CODEC_FLAG_SVCD_SCAN_OFFSET = $40000000; ///< will reserve space for SVCD scan offset user data
+ CODEC_FLAG_CLOSED_GOP = $80000000;
+ CODEC_FLAG2_FAST = $00000001; ///< allow non spec compliant speedup tricks
+ CODEC_FLAG2_STRICT_GOP = $00000002; ///< strictly enforce GOP size
+ CODEC_FLAG2_NO_OUTPUT = $00000004; ///< skip bitstream encoding
+ CODEC_FLAG2_LOCAL_HEADER = $00000008; ///< place global headers at every keyframe instead of in extradata
+ CODEC_FLAG2_BPYRAMID = $00000010; ///< H.264 allow b-frames to be used as references
+ CODEC_FLAG2_WPRED = $00000020; ///< H.264 weighted biprediction for b-frames
+ CODEC_FLAG2_MIXED_REFS = $00000040; ///< H.264 multiple references per partition
+ CODEC_FLAG2_8X8DCT = $00000080; ///< H.264 high profile 8x8 transform
+ CODEC_FLAG2_FASTPSKIP = $00000100; ///< H.264 fast pskip
+ CODEC_FLAG2_AUD = $00000200; ///< H.264 access unit delimiters
+ CODEC_FLAG2_BRDO = $00000400; ///< b-frame rate-distortion optimization
+ CODEC_FLAG2_INTRA_VLC = $00000800; ///< use MPEG-2 intra VLC table
+ CODEC_FLAG2_MEMC_ONLY = $00001000; ///< only do ME/MC (I frames -> ref, P frame -> ME+MC)
+
+(* Unsupported options :
+ * Syntax Arithmetic coding (SAC)
+ * Reference Picture Selection
+ * Independant Segment Decoding */
+/* /Fx */
+/* codec capabilities *)
+
+const
+ CODEC_CAP_DRAW_HORIZ_BAND = $001; ///< decoder can use draw_horiz_band callback
+(**
+ * Codec uses get_buffer() for allocating buffers.
+ * direct rendering method 1 *)
+ CODEC_CAP_DR1 = $002;
+(* if 'parse_only' field is true, then avcodec_parse_frame() can be used *)
+ CODEC_CAP_PARSE_ONLY = $004;
+ CODEC_CAP_TRUNCATED = $008;
+//* codec can export data for HW decoding (XvMC) */
+ CODEC_CAP_HWACCEL = $010;
+
+(**
+ * codec has a non zero delay and needs to be feeded with NULL at the end to get the delayed data.
+ * if this is not set, the codec is guranteed to never be feeded with NULL data *)
+ CODEC_CAP_DELAY = $0020;
+(**
+ * Codec can be fed a final frame with a smaller size.
+ * This can be used to prevent truncation of the last audio samples. *)
+ CODEC_CAP_SMALL_LAST_FRAME = $0040;
+
+//the following defines may change, don't expect compatibility if you use them
+ MB_TYPE_INTRA4x4 = $001;
+ MB_TYPE_INTRA16x16 = $002; //FIXME h264 specific
+ MB_TYPE_INTRA_PCM = $004; //FIXME h264 specific
+ MB_TYPE_16x16 = $008;
+ MB_TYPE_16x8 = $010;
+ MB_TYPE_8x16 = $020;
+ MB_TYPE_8x8 = $040;
+ MB_TYPE_INTERLACED = $080;
+ MB_TYPE_DIRECT2 = $100; //FIXME
+ MB_TYPE_ACPRED = $200;
+ MB_TYPE_GMC = $400;
+ MB_TYPE_SKIP = $800;
+ MB_TYPE_P0L0 = $1000;
+ MB_TYPE_P1L0 = $2000;
+ MB_TYPE_P0L1 = $4000;
+ MB_TYPE_P1L1 = $8000;
+ MB_TYPE_L0 = (MB_TYPE_P0L0 or MB_TYPE_P1L0);
+ MB_TYPE_L1 = (MB_TYPE_P0L1 or MB_TYPE_P1L1);
+ MB_TYPE_L0L1 = (MB_TYPE_L0 or MB_TYPE_L1);
+ MB_TYPE_QUANT = $0010000;
+ MB_TYPE_CBP = $0020000;
+//Note bits 24-31 are reserved for codec specific use (h264 ref0, mpeg1 0mv, ...)
+
+type
+(**
+ * Pan Scan area.
+ * this specifies the area which should be displayed. Note there may be multiple such areas for one frame *)
+ PAVPanScan = ^TAVPanScan;
+ TAVPanScan = record {24}
+ (*** id.
+ * - encoding: set by user.
+ * - decoding: set by lavc *)
+ id: integer;
+
+ (*** width and height in 1/16 pel
+ * - encoding: set by user.
+ * - decoding: set by lavc *)
+ width: integer;
+ height: integer;
+
+ (*** position of the top left corner in 1/16 pel for up to 3 fields/frames.
+ * - encoding: set by user.
+ * - decoding: set by lavc *)
+ position: array [0..2] of array [0..1] of smallint;
+ end;
+
+const
+ FF_QSCALE_TYPE_MPEG1 = 0;
+ FF_QSCALE_TYPE_MPEG2 = 1;
+
+ FF_BUFFER_TYPE_INTERNAL = 1;
+ FF_BUFFER_TYPE_USER = 2; ///< Direct rendering buffers (image is (de)allocated by user)
+ FF_BUFFER_TYPE_SHARED = 4; ///< buffer from somewhere else, don't dealloc image (data/base), all other tables are not shared
+ FF_BUFFER_TYPE_COPY = 8; ///< just a (modified) copy of some other buffer, don't dealloc anything
+
+
+ FF_I_TYPE = 1; // Intra
+ FF_P_TYPE = 2; // Predicted
+ FF_B_TYPE = 3; // Bi-dir predicted
+ FF_S_TYPE = 4; // S(GMC)-VOP MPEG4
+ FF_SI_TYPE = 5;
+ FF_SP_TYPE = 6;
+
+ FF_BUFFER_HINTS_VALID = $01; // Buffer hints value is meaningful (if 0 ignore)
+ FF_BUFFER_HINTS_READABLE = $02; // Codec will read from buffer
+ FF_BUFFER_HINTS_PRESERVE = $04; // User must not alter buffer content
+ FF_BUFFER_HINTS_REUSABLE = $08; // Codec will reuse the buffer (update)
+
+type
+ (*** Audio Video Frame. *)
+ PAVFrame = ^TAVFrame;
+ TAVFrame = record {200}
+ (*** pointer to the picture planes.
+ * this might be different from the first allocated byte *)
+ data: array [0..3] of pbyte;
+ linesize: array [0..3] of integer;
+ (*** pointer to the first allocated byte of the picture. can be used in get_buffer/release_buffer
+ * this isn't used by lavc unless the default get/release_buffer() is used*)
+ base: array [0..3] of pbyte;
+ (*** 1 -> keyframe, 0-> not *)
+ key_frame: integer;
+ (*** picture type of the frame, see ?_TYPE below.*)
+ pict_type: integer;
+ (*** presentation timestamp in time_base units (time when frame should be shown to user)
+ * if AV_NOPTS_VALUE then frame_rate = 1/time_base will be assumed*)
+ pts: int64;
+ (*** picture number in bitstream order.*)
+ coded_picture_number: integer;
+ (*** picture number in display order.*)
+ display_picture_number: integer;
+ (*** quality (between 1 (good) and FF_LAMBDA_MAX (bad)) *)
+ quality: integer;
+ (*** buffer age (1->was last buffer and dint change, 2->..., ...).*)
+ age: integer;
+ (*** is this picture used as reference*)
+ reference: integer;
+ (*** QP table*)
+ qscale_table: pchar;
+ (*** QP store stride*)
+ qstride: integer;
+ (*** mbskip_table[mb]>=1 if MB didnt change*)
+ mbskip_table: pbyte;
+ (**
+ * Motion vector table.
+ * @code
+ * example:
+ * int mv_sample_log2= 4 - motion_subsample_log2;
+ * int mb_width= (width+15)>>4;
+ * int mv_stride= (mb_width << mv_sample_log2) + 1;
+ * motion_val[direction][x + y*mv_stride][0->mv_x, 1->mv_y];
+ * @endcode
+ * - encoding: set by user
+ * - decoding: set by lavc *)
+ motion_val: array [0..1] of pointer;
+ (*** Macroblock type table
+ * mb_type_base + mb_width + 2 *)
+ mb_type: PCardinal;
+ (*** log2 of the size of the block which a single vector in motion_val represents:
+ * (4->16x16, 3->8x8, 2-> 4x4, 1-> 2x2)*)
+ motion_subsample_log2: byte;
+ (*** for some private data of the user*)
+ opaque: pointer;
+ (*** error*)
+ error: array [0..3] of int64;
+ (*** type of the buffer (to keep track of who has to dealloc data[*])
+ * Note: user allocated (direct rendering) & internal buffers can not coexist currently*)
+ _type: integer;
+ (*** when decoding, this signal how much the picture must be delayed.
+ * extra_delay = repeat_pict / (2*fps)*)
+ repeat_pict: integer;
+ qscale_type: integer;
+ (*** The content of the picture is interlaced.*)
+ interlaced_frame: integer;
+ (*** if the content is interlaced, is top field displayed first.*)
+ top_field_first: integer;
+ (*** Pan scan.*)
+ pan_scan: PAVPanScan;
+ (*** tell user application that palette has changed from previous frame.*)
+ palette_has_changed: integer;
+ (*** Codec suggestion on buffer type if != 0
+ * - decoding: set by lavc (before get_buffer() call))*)
+ buffer_hints: integer;
+ (*** DCT coeffitients*)
+ dct_coeff: PsmallInt;
+ (*** Motion referece frame index*)
+ ref_index: array [0..1] of pshortint;
+ end;
+
+const
+ DEFAULT_FRAME_RATE_BASE = 1001000;
+
+ FF_BUG_AUTODETECT = 1; ///< autodetection
+ FF_BUG_OLD_MSMPEG4 = 2;
+ FF_BUG_XVID_ILACE = 4;
+ FF_BUG_UMP4 = 8;
+ FF_BUG_NO_PADDING = 16;
+ FF_BUG_AMV = 32;
+ FF_BUG_AC_VLC = 0; ///< will be removed, libavcodec can now handle these non compliant files by default
+ FF_BUG_QPEL_CHROMA = 64;
+ FF_BUG_STD_QPEL = 128;
+ FF_BUG_QPEL_CHROMA2 = 256;
+ FF_BUG_DIRECT_BLOCKSIZE = 512;
+ FF_BUG_EDGE = 1024;
+ FF_BUG_HPEL_CHROMA = 2048;
+ FF_BUG_DC_CLIP = 4096;
+ FF_BUG_MS = 8192; ///< workaround various bugs in microsofts broken decoders
+
+ FF_COMPLIANCE_VERY_STRICT = 2; ///< strictly conform to a older more strict version of the spec or reference software
+ FF_COMPLIANCE_STRICT = 1; ///< strictly conform to all the things in the spec no matter what consequences
+ FF_COMPLIANCE_NORMAL = 0;
+ FF_COMPLIANCE_INOFFICIAL = -1; ///< allow inofficial extensions
+ FF_COMPLIANCE_EXPERIMENTAL = -2; ///< allow non standarized experimental things
+
+ FF_ER_CAREFUL = 1;
+ FF_ER_COMPLIANT = 2;
+ FF_ER_AGGRESSIVE = 3;
+ FF_ER_VERY_AGGRESSIVE = 4;
+
+ FF_DCT_AUTO = 0;
+ FF_DCT_FASTINT = 1;
+ FF_DCT_INT = 2;
+ FF_DCT_MMX = 3;
+ FF_DCT_MLIB = 4;
+ FF_DCT_ALTIVEC = 5;
+ FF_DCT_FAAN = 6;
+
+ FF_IDCT_AUTO = 0;
+ FF_IDCT_INT = 1;
+ FF_IDCT_SIMPLE = 2;
+ FF_IDCT_SIMPLEMMX = 3;
+ FF_IDCT_LIBMPEG2MMX = 4;
+ FF_IDCT_PS2 = 5;
+ FF_IDCT_MLIB = 6;
+ FF_IDCT_ARM = 7;
+ FF_IDCT_ALTIVEC = 8;
+ FF_IDCT_SH4 = 9;
+ FF_IDCT_SIMPLEARM = 10;
+ FF_IDCT_H264 = 11;
+ FF_IDCT_VP3 = 12;
+ FF_IDCT_IPP = 13;
+ FF_IDCT_XVIDMMX = 14;
+
+ FF_EC_GUESS_MVS = 1;
+ FF_EC_DEBLOCK = 2;
+
+ FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *)
+ (* lower 16 bits - CPU features *)
+
+ FF_MM_MMX = $0001; (* standard MMX *)
+ FF_MM_3DNOW = $0004; (* AMD 3DNOW *)
+ FF_MM_MMXEXT = $0002; (* SSE integer functions or AMD MMX ext *)
+ FF_MM_SSE = $0008; (* SSE functions *)
+ FF_MM_SSE2 = $0010; (* PIV SSE2 functions *)
+ FF_MM_3DNOWEXT = $0020; (* AMD 3DNowExt *)
+ FF_MM_IWMMXT = $0100; (* XScale IWMMXT *)
+
+ FF_PRED_LEFT = 0;
+ FF_PRED_PLANE = 1;
+ FF_PRED_MEDIAN = 2;
+
+ FF_DEBUG_PICT_INFO = 1;
+ FF_DEBUG_RC = 2;
+ FF_DEBUG_BITSTREAM = 4;
+ FF_DEBUG_MB_TYPE = 8;
+ FF_DEBUG_QP = 16;
+ FF_DEBUG_MV = 32;
+ FF_DEBUG_DCT_COEFF = $00000040;
+ FF_DEBUG_SKIP = $00000080;
+ FF_DEBUG_STARTCODE = $00000100;
+ FF_DEBUG_PTS = $00000200;
+ FF_DEBUG_ER = $00000400;
+ FF_DEBUG_MMCO = $00000800;
+ FF_DEBUG_BUGS = $00001000;
+ FF_DEBUG_VIS_QP = $00002000;
+ FF_DEBUG_VIS_MB_TYPE = $00004000;
+
+ FF_DEBUG_VIS_MV_P_FOR = $00000001; //visualize forward predicted MVs of P frames
+ FF_DEBUG_VIS_MV_B_FOR = $00000002; //visualize forward predicted MVs of B frames
+ FF_DEBUG_VIS_MV_B_BACK = $00000004; //visualize backward predicted MVs of B frames
+
+ FF_CMP_SAD = 0;
+ FF_CMP_SSE = 1;
+ FF_CMP_SATD = 2;
+ FF_CMP_DCT = 3;
+ FF_CMP_PSNR = 4;
+ FF_CMP_BIT = 5;
+ FF_CMP_RD = 6;
+ FF_CMP_ZERO = 7;
+ FF_CMP_VSAD = 8;
+ FF_CMP_VSSE = 9;
+ FF_CMP_NSSE = 10;
+ FF_CMP_W53 = 11;
+ FF_CMP_W97 = 12;
+ FF_CMP_DCTMAX = 13;
+ FF_CMP_CHROMA = 256;
+
+ FF_DTG_AFD_SAME = 8;
+ FF_DTG_AFD_4_3 = 9;
+ FF_DTG_AFD_16_9 = 10;
+ FF_DTG_AFD_14_9 = 11;
+ FF_DTG_AFD_4_3_SP_14_9 = 13;
+ FF_DTG_AFD_16_9_SP_14_9 = 14;
+ FF_DTG_AFD_SP_4_3 = 15;
+
+ FF_DEFAULT_QUANT_BIAS = 999999;
+
+ FF_LAMBDA_SHIFT = 7;
+ FF_LAMBDA_SCALE = (1 shl FF_LAMBDA_SHIFT);
+ FF_QP2LAMBDA = 118; ///< factor to convert from H.263 QP to lambda
+ FF_LAMBDA_MAX = (256 * 128 - 1);
+
+ FF_QUALITY_SCALE = FF_LAMBDA_SCALE; //FIXME maybe remove
+
+ FF_CODER_TYPE_VLC = 0;
+ FF_CODER_TYPE_AC = 1;
+
+ SLICE_FLAG_CODED_ORDER = $0001; ///< draw_horiz_band() is called in coded order instead of display
+ SLICE_FLAG_ALLOW_FIELD = $0002; ///< allow draw_horiz_band() with field slices (MPEG2 field pics)
+ SLICE_FLAG_ALLOW_PLANE = $0004; ///< allow draw_horiz_band() with 1 component at a time (SVQ1)
+
+ FF_MB_DECISION_SIMPLE = 0; ///< uses mb_cmp
+ FF_MB_DECISION_BITS = 1; ///< chooses the one which needs the fewest bits
+ FF_MB_DECISION_RD = 2; ///< rate distoration
+
+ FF_AA_AUTO = 0;
+ FF_AA_FASTINT = 1; //not implemented yet
+ FF_AA_INT = 2;
+ FF_AA_FLOAT = 3;
+
+ FF_PROFILE_UNKNOWN = -99;
+
+ FF_LEVEL_UNKNOWN = -99;
+
+ X264_PART_I4X4 = $001; (* Analyse i4x4 *)
+ X264_PART_I8X8 = $002; (* Analyse i8x8 (requires 8x8 transform) *)
+ X264_PART_P8X8 = $010; (* Analyse p16x8, p8x16 and p8x8 *)
+ X264_PART_P4X4 = $020; (* Analyse p8x4, p4x8, p4x4 *)
+ X264_PART_B8X8 = $100; (* Analyse b16x8, b8x16 and b8x8 *)
+
+type
+ PAVClass = ^TAVClass;
+ PAVCodecContext = ^TAVCodecContext;
+ PAVCodec = ^TAVCodec;
+ PAVPaletteControl = ^TAVPaletteControl;
+
+ TAVclass = record {12}
+ class_name: pchar;
+ (* actually passing a pointer to an AVCodecContext
+ or AVFormatContext, which begin with an AVClass.
+ Needed because av_log is in libavcodec and has no visibility
+ of AVIn/OutputFormat *)
+ item_name: function (): pchar; cdecl;
+ option: PAVOption;
+ end;
+
+ TAVCodecContext = record {720}
+ (*** Info on struct for av_log
+ * - set by avcodec_alloc_context *)
+ av_class: PAVClass;
+ (*** the average bitrate.
+ * - encoding: set by user. unused for constant quantizer encoding
+ * - decoding: set by lavc. 0 or some bitrate if this info is available in the stream *)
+ bit_rate: integer;
+ (*** number of bits the bitstream is allowed to diverge from the reference.
+ * the reference can be CBR (for CBR pass1) or VBR (for pass2)
+ * - encoding: set by user. unused for constant quantizer encoding
+ * - decoding: unused *)
+ bit_rate_tolerance: integer;
+ (*** CODEC_FLAG_*.
+ * - encoding: set by user.
+ * - decoding: set by user. *)
+ flags: integer;
+ (*** some codecs needs additionnal format info. It is stored here
+ * - encoding: set by user.
+ * - decoding: set by lavc. (FIXME is this ok?) *)
+ sub_id: integer;
+
+ (**
+ * motion estimation algorithm used for video coding.
+ * 1 (zero), 2 (full), 3 (log), 4 (phods), 5 (epzs), 6 (x1), 7 (hex),
+ * 8 (umh), 9 (iter) [7, 8 are x264 specific, 9 is snow specific]
+ * - encoding: MUST be set by user.
+ * - decoding: unused *)
+ me_method: integer;
+
+ (**
+ * some codecs need / can use extra-data like huffman tables.
+ * mjpeg: huffman tables
+ * rv10: additional flags
+ * mpeg4: global headers (they can be in the bitstream or here)
+ * the allocated memory should be FF_INPUT_BUFFER_PADDING_SIZE bytes larger
+ * then extradata_size to avoid prolems if its read with the bitstream reader
+ * the bytewise contents of extradata must not depend on the architecture or cpu endianness
+ * - encoding: set/allocated/freed by lavc.
+ * - decoding: set/allocated/freed by user.
+ *)
+ extradata: pbyte;
+ extradata_size: integer;
+
+ (**
+ * this is the fundamental unit of time (in seconds) in terms
+ * of which frame timestamps are represented. for fixed-fps content,
+ * timebase should be 1/framerate and timestamp increments should be
+ * identically 1.
+ * - encoding: MUST be set by user
+ * - decoding: set by lavc. *)
+ time_base: TAVRational;
+
+ (* video only *)
+ (*** picture width / height.
+ * - encoding: MUST be set by user.
+ * - decoding: set by lavc.
+ * Note, for compatibility its possible to set this instead of
+ * coded_width/height before decoding *)
+ width, height: integer;
+ (*** the number of pictures in a group of pitures, or 0 for intra_only.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ gop_size: integer;
+ (*** pixel format, see PIX_FMT_xxx.
+ * - encoding: set by user.
+ * - decoding: set by lavc. *)
+ pix_fmt: TAVPixelFormat;
+ (*** Frame rate emulation. If not zero lower layer (i.e. format handler)
+ * has to read frames at native frame rate.
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ rate_emu: integer;
+ (*** if non NULL, 'draw_horiz_band' is called by the libavcodec
+ * decoder to draw an horizontal band. It improve cache usage. Not
+ * all codecs can do that. You must check the codec capabilities
+ * before
+ * - encoding: unused
+ * - decoding: set by user.
+ * @param height the height of the slice
+ * @param y the y position of the slice
+ * @param type 1->top field, 2->bottom field, 3->frame
+ * @param offset offset into the AVFrame.data from which the slice should be read *)
+ draw_horiz_band: procedure (s: PAVCodecContext;
+ const src: PAVFrame; offset: PInteger;
+ y: integer; _type: integer; height: integer); cdecl;
+
+ (* audio only *)
+ sample_rate: integer; ///< samples per sec
+ channels: integer;
+ (*** audio sample format.
+ * - encoding: set by user.
+ * - decoding: set by lavc. *)
+ sample_fmt: TSampleFormat; ///< sample format, currenly unused
+
+ (* the following data should not be initialized *)
+ (*** samples per packet. initialized when calling 'init' *)
+ frame_size: integer;
+ frame_number: integer; ///< audio or video frame number
+ real_pict_num: integer; ///< returns the real picture number of previous encoded frame
+
+ (*** number of frames the decoded output will be delayed relative to
+ * the encoded input.
+ * - encoding: set by lavc.
+ * - decoding: unused *)
+ delay: integer;
+
+ (* - encoding parameters *)
+ qcompress: single; ///< amount of qscale change between easy & hard scenes (0.0-1.0)
+ qblur: single; ///< amount of qscale smoothing over time (0.0-1.0)
+
+ (*** minimum quantizer.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ qmin: integer;
+
+ (*** maximum quantizer.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ qmax: integer;
+
+ (*** maximum quantizer difference etween frames.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ max_qdiff: integer;
+
+ (*** maximum number of b frames between non b frames.
+ * note: the output will be delayed by max_b_frames+1 relative to the input
+ * - encoding: set by user.
+ * - decoding: unused *)
+ max_b_frames: integer;
+
+ (*** qscale factor between ip and b frames.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ b_quant_factor: single;
+
+ (** obsolete FIXME remove *)
+ rc_strategy: integer;
+ b_frame_strategy: integer;
+
+ (*** hurry up amount.
+ * deprecated in favor of skip_idct and skip_frame
+ * - encoding: unused
+ * - decoding: set by user. 1-> skip b frames, 2-> skip idct/dequant too, 5-> skip everything except header *)
+ hurry_up: integer;
+
+ codec: PAVCodec;
+
+ priv_data: pointer;
+
+ (* unused, FIXME remove*)
+ rtp_mode: integer;
+
+ rtp_payload_size: integer; (* The size of the RTP payload: the coder will *)
+ (* do it's best to deliver a chunk with size *)
+ (* below rtp_payload_size, the chunk will start *)
+ (* with a start code on some codecs like H.263 *)
+ (* This doesn't take account of any particular *)
+ (* headers inside the transmited RTP payload *)
+
+
+ (* The RTP callback: This function is called *)
+ (* every time the encoder has a packet to send *)
+ (* Depends on the encoder if the data starts *)
+ (* with a Start Code (it should) H.263 does. *)
+ (* mb_nb contains the number of macroblocks *)
+ (* encoded in the RTP payload *)
+ rtp_callback: procedure (avctx: PAVCodecContext; data: pointer;
+ size: integer; mb_nb: integer); cdecl;
+
+ (* statistics, used for 2-pass encoding *)
+ mv_bits: integer;
+ header_bits: integer;
+ i_tex_bits: integer;
+ p_tex_bits: integer;
+ i_count: integer;
+ p_count: integer;
+ skip_count: integer;
+ misc_bits: integer;
+
+ (*** number of bits used for the previously encoded frame.
+ * - encoding: set by lavc
+ * - decoding: unused *)
+ frame_bits: integer;
+
+ (*** private data of the user, can be used to carry app specific stuff.
+ * - encoding: set by user
+ * - decoding: set by user *)
+ opaque: pointer;
+
+ codec_name: array [0..31] of char;
+ codec_type: TCodecType; (* see CODEC_TYPE_xxx *)
+ codec_id: TCodecID; (* see CODEC_ID_xxx *)
+
+ (*** fourcc (LSB first, so "ABCD" -> ('D'<<24) + ('C'<<16) + ('B'<<8) + 'A').
+ * this is used to workaround some encoder bugs
+ * - encoding: set by user, if not then the default based on codec_id will be used
+ * - decoding: set by user, will be converted to upper case by lavc during init *)
+ codec_tag: cardinal; // ěîćíî array [0..3] of char - ňîăäŕ âčäíî FOURCC
+// codec_tag: array [0..3] of char;
+
+ (*** workaround bugs in encoders which sometimes cannot be detected automatically.
+ * - encoding: set by user
+ * - decoding: set by user *)
+ workaround_bugs: integer;
+
+ (*** luma single coeff elimination threshold.
+ * - encoding: set by user
+ * - decoding: unused *)
+ luma_elim_threshold: integer;
+
+ (*** chroma single coeff elimination threshold.
+ * - encoding: set by user
+ * - decoding: unused *)
+ chroma_elim_threshold: integer;
+
+ (*** strictly follow the std (MPEG4, ...).
+ * - encoding: set by user
+ * - decoding: unused *)
+ strict_std_compliance: integer;
+
+ (*** qscale offset between ip and b frames.
+ * if > 0 then the last p frame quantizer will be used (q= lastp_q*factor+offset)
+ * if < 0 then normal ratecontrol will be done (q= -normal_q*factor+offset)
+ * - encoding: set by user.
+ * - decoding: unused *)
+ b_quant_offset: single;
+
+ (*** error resilience higher values will detect more errors but may missdetect
+ * some more or less valid parts as errors.
+ * - encoding: unused
+ * - decoding: set by user *)
+ error_resilience: integer;
+
+ (*** called at the beginning of each frame to get a buffer for it.
+ * if pic.reference is set then the frame will be read later by lavc
+ * avcodec_align_dimensions() should be used to find the required width and
+ * height, as they normally need to be rounded up to the next multiple of 16
+ * - encoding: unused
+ * - decoding: set by lavc, user can override *)
+ get_buffer: function (c: PAVCodecContext; pic: PAVFrame): integer; cdecl;
+
+ (*** called to release buffers which where allocated with get_buffer.
+ * a released buffer can be reused in get_buffer()
+ * pic.data[*] must be set to NULL
+ * - encoding: unused
+ * - decoding: set by lavc, user can override *)
+ release_buffer: procedure (c: PAVCodecContext; pic: PAVFrame); cdecl;
+
+ (*** if 1 the stream has a 1 frame delay during decoding.
+ * - encoding: set by lavc
+ * - decoding: set by lavc *)
+ has_b_frames: integer;
+
+ (*** number of bytes per packet if constant and known or 0
+ * used by some WAV based audio codecs *)
+ block_align: integer;
+
+ parse_only: integer; (* - decoding only: if true, only parsing is done
+ (function avcodec_parse_frame()). The frame
+ data is returned. Only MPEG codecs support this now. *)
+
+ (*** 0-> h263 quant 1-> mpeg quant.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ mpeg_quant: integer;
+
+ (*** pass1 encoding statistics output buffer.
+ * - encoding: set by lavc
+ * - decoding: unused *)
+ stats_out: pchar;
+
+ (*** pass2 encoding statistics input buffer.
+ * concatenated stuff from stats_out of pass1 should be placed here
+ * - encoding: allocated/set/freed by user
+ * - decoding: unused *)
+ stats_in: pchar;
+
+ (*** ratecontrol qmin qmax limiting method.
+ * 0-> clipping, 1-> use a nice continous function to limit qscale wthin qmin/qmax
+ * - encoding: set by user.
+ * - decoding: unused *)
+ rc_qsquish: single;
+
+ rc_qmod_amp: single;
+ rc_qmod_freq: integer;
+
+ (*** ratecontrol override, see RcOverride.
+ * - encoding: allocated/set/freed by user.
+ * - decoding: unused *)
+ rc_override: PRcOverride;
+ rc_override_count: integer;
+
+ (*** rate control equation.
+ * - encoding: set by user
+ * - decoding: unused *)
+ rc_eq: pchar;
+
+ (*** maximum bitrate.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ rc_max_rate: integer;
+
+ (*** minimum bitrate.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ rc_min_rate: integer;
+
+ (*** decoder bitstream buffer size.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ rc_buffer_size: integer;
+ rc_buffer_aggressivity: single;
+
+ (*** qscale factor between p and i frames.
+ * if > 0 then the last p frame quantizer will be used (q= lastp_q*factor+offset)
+ * if < 0 then normal ratecontrol will be done (q= -normal_q*factor+offset)
+ * - encoding: set by user.
+ * - decoding: unused *)
+ i_quant_factor: single;
+
+ (*** qscale offset between p and i frames.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ i_quant_offset: single;
+
+ (*** initial complexity for pass1 ratecontrol.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ rc_initial_cplx: single;
+
+ (*** dct algorithm, see FF_DCT_* below.
+ * - encoding: set by user
+ * - decoding: unused *)
+ dct_algo: integer;
+
+ (*** luminance masking (0-> disabled).
+ * - encoding: set by user
+ * - decoding: unused *)
+ lumi_masking: single;
+
+ (*** temporary complexity masking (0-> disabled).
+ * - encoding: set by user
+ * - decoding: unused *)
+ temporal_cplx_masking: single;
+
+ (*** spatial complexity masking (0-> disabled).
+ * - encoding: set by user
+ * - decoding: unused *)
+ spatial_cplx_masking: single;
+
+ (** * p block masking (0-> disabled).
+ * - encoding: set by user
+ * - decoding: unused *)
+ p_masking: single;
+
+ (*** darkness masking (0-> disabled).
+ * - encoding: set by user
+ * - decoding: unused *)
+ dark_masking: single;
+
+ (* for binary compatibility *)
+ unused: integer;
+
+ (*** idct algorithm, see FF_IDCT_* below.
+ * - encoding: set by user
+ * - decoding: set by user *)
+ idct_algo: integer;
+
+ (*** slice count.
+ * - encoding: set by lavc
+ * - decoding: set by user (or 0) *)
+ slice_count: integer;
+
+ (*** slice offsets in the frame in bytes.
+ * - encoding: set/allocated by lavc
+ * - decoding: set/allocated by user (or NULL) *)
+ slice_offset: Pinteger;
+
+ (*** error concealment flags.
+ * - encoding: unused
+ * - decoding: set by user *)
+ error_concealment: integer;
+
+ (*** dsp_mask could be add used to disable unwanted CPU features
+ * CPU features (i.e. MMX, SSE. ...)
+ *
+ * with FORCE flag you may instead enable given CPU features
+ * (Dangerous: usable in case of misdetection, improper usage however will
+ * result into program crash) *)
+ dsp_mask: cardinal;
+
+ (*** bits per sample/pixel from the demuxer (needed for huffyuv).
+ * - encoding: set by lavc
+ * - decoding: set by user *)
+ bits_per_sample: integer;
+
+ (*** prediction method (needed for huffyuv).
+ * - encoding: set by user
+ * - decoding: unused *)
+ prediction_method: integer;
+
+ (*** sample aspect ratio (0 if unknown).
+ * numerator and denominator must be relative prime and smaller then 256 for some video standards
+ * - encoding: set by user.
+ * - decoding: set by lavc. *)
+ sample_aspect_ratio: TAVRational;
+
+ (*** the picture in the bitstream.
+ * - encoding: set by lavc
+ * - decoding: set by lavc *)
+ coded_frame: PAVFrame;
+
+ (*** debug.
+ * - encoding: set by user.
+ * - decoding: set by user. *)
+ debug: integer;
+
+ (*** debug.
+ * - encoding: set by user.
+ * - decoding: set by user. *)
+ debug_mv: integer;
+
+ (** error.
+ * - encoding: set by lavc if flags&CODEC_FLAG_PSNR
+ * - decoding: unused *)
+ error: array [0..3] of int64;
+
+ (*** minimum MB quantizer.
+ * - encoding: unused
+ * - decoding: unused *)
+ mb_qmin: integer;
+
+ (*** maximum MB quantizer.
+ * - encoding: unused
+ * - decoding: unused *)
+ mb_qmax: integer;
+
+ (*** motion estimation compare function.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ me_cmp: integer;
+
+ (*** subpixel motion estimation compare function.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ me_sub_cmp: integer;
+ (*** macroblock compare function (not supported yet).
+ * - encoding: set by user.
+ * - decoding: unused *)
+ mb_cmp: integer;
+ (*** interlaced dct compare function
+ * - encoding: set by user.
+ * - decoding: unused *)
+ ildct_cmp: integer;
+ (*** ME diamond size & shape.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ dia_size: integer;
+
+ (*** amount of previous MV predictors (2a+1 x 2a+1 square).
+ * - encoding: set by user.
+ * - decoding: unused *)
+ last_predictor_count: integer;
+
+ (*** pre pass for motion estimation.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ pre_me: integer;
+
+ (*** motion estimation pre pass compare function.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ me_pre_cmp: integer;
+
+ (*** ME pre pass diamond size & shape.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ pre_dia_size: integer;
+
+ (*** subpel ME quality.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ me_subpel_quality: integer;
+
+ (*** callback to negotiate the pixelFormat.
+ * @param fmt is the list of formats which are supported by the codec,
+ * its terminated by -1 as 0 is a valid format, the formats are ordered by quality
+ * the first is allways the native one
+ * @return the choosen format
+ * - encoding: unused
+ * - decoding: set by user, if not set then the native format will always be choosen
+ *)
+ get_format: function (s: PAVCodecContext; const fmt: PAVPixelFormat): TAVPixelFormat; cdecl;
+
+ (*** DTG active format information (additionnal aspect ratio
+ * information only used in DVB MPEG2 transport streams). 0 if
+ * not set.
+ * - encoding: unused.
+ * - decoding: set by decoder *)
+ dtg_active_format: integer;
+
+ (*** Maximum motion estimation search range in subpel units.
+ * if 0 then no limit
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ me_range: integer;
+
+ (*** intra quantizer bias.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ intra_quant_bias: integer;
+
+ (*** inter quantizer bias.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ inter_quant_bias: integer;
+
+ (*** color table ID.
+ * - encoding: unused.
+ * - decoding: which clrtable should be used for 8bit RGB images
+ * table have to be stored somewhere FIXME *)
+ color_table_id: integer;
+
+ (*** internal_buffer count.
+ * Don't touch, used by lavc default_get_buffer() *)
+ internal_buffer_count: integer;
+
+ (*** internal_buffers.
+ * Don't touch, used by lavc default_get_buffer() *)
+ internal_buffer: pointer;
+
+ (*** global quality for codecs which cannot change it per frame.
+ * this should be proportional to MPEG1/2/4 qscale.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ global_quality: integer;
+
+ (*** coder type
+ * - encoding: set by user.
+ * - decoding: unused *)
+ coder_type: integer;
+
+ (*** context model
+ * - encoding: set by user.
+ * - decoding: unused *)
+ context_model: integer;
+
+ (*** slice flags
+ * - encoding: unused
+ * - decoding: set by user. *)
+ slice_flags: integer;
+
+ (*** XVideo Motion Acceleration
+ * - encoding: forbidden
+ * - decoding: set by decoder *)
+ xvmc_acceleration: integer;
+
+ (*** macroblock decision mode
+ * - encoding: set by user.
+ * - decoding: unused *)
+ mb_decision: integer;
+
+ (*** custom intra quantization matrix
+ * - encoding: set by user, can be NULL
+ * - decoding: set by lavc *)
+ intra_matrix: Pword;
+
+ (*** custom inter quantization matrix
+ * - encoding: set by user, can be NULL
+ * - decoding: set by lavc *)
+ inter_matrix: Pword;
+
+ (*** fourcc from the AVI stream header (LSB first, so "ABCD" -> ('D'<<24) + ('C'<<16) + ('B'<<8) + 'A').
+ * this is used to workaround some encoder bugs
+ * - encoding: unused
+ * - decoding: set by user, will be converted to upper case by lavc during init *)
+ stream_codec_tag: array [0..3] of char; //cardinal;
+
+ (*** scene change detection threshold.
+ * 0 is default, larger means fewer detected scene changes
+ * - encoding: set by user.
+ * - decoding: unused *)
+ scenechange_threshold: integer;
+
+ (*** minimum lagrange multipler
+ * - encoding: set by user.
+ * - decoding: unused *)
+ lmin: integer;
+
+ (*** maximum lagrange multipler
+ * - encoding: set by user.
+ * - decoding: unused *)
+ lmax: integer;
+
+ (*** Palette control structure
+ * - encoding: ??? (no palette-enabled encoder yet)
+ * - decoding: set by user. *)
+ palctrl: PAVPaletteControl;
+
+ (*** noise reduction strength
+ * - encoding: set by user.
+ * - decoding: unused *)
+ noise_reduction: integer;
+
+ (*** called at the beginning of a frame to get cr buffer for it.
+ * buffer type (size, hints) must be the same. lavc won't check it.
+ * lavc will pass previous buffer in pic, function should return
+ * same buffer or new buffer with old frame "painted" into it.
+ * if pic.data[0] == NULL must behave like get_buffer().
+ * - encoding: unused
+ * - decoding: set by lavc, user can override *)
+ reget_buffer: function (c: PAVCodecContext; pic: PAVFrame): integer; cdecl;
+
+ (*** number of bits which should be loaded into the rc buffer before decoding starts
+ * - encoding: set by user.
+ * - decoding: unused *)
+ rc_initial_buffer_occupancy: integer;
+ inter_threshold: integer;
+
+ (*** CODEC_FLAG2_*.
+ * - encoding: set by user.
+ * - decoding: set by user. *)
+ flags2: integer;
+
+ (*** simulates errors in the bitstream to test error concealment.
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ error_rate: integer;
+
+ (*** MP3 antialias algorithm, see FF_AA_* below.
+ * - encoding: unused
+ * - decoding: set by user *)
+ antialias_algo: integer;
+
+ (*** Quantizer noise shaping.
+ * - encoding: set by user
+ * - decoding: unused *)
+ quantizer_noise_shaping: integer;
+
+ (*** Thread count.
+ * is used to decide how many independant tasks should be passed to execute()
+ * - encoding: set by user
+ * - decoding: set by user *)
+ thread_count: integer;
+
+ (*** the codec may call this to execute several independant things. it will return only after
+ * finishing all tasks, the user may replace this with some multithreaded implementation, the
+ * default implementation will execute the parts serially
+ * @param count the number of things to execute
+ * - encoding: set by lavc, user can override
+ * - decoding: set by lavc, user can override *)
+ execute: function (c: PAVCodecContext; func: pointer; arg: PPointer; ret: PInteger; count: integer): integer; cdecl;
+
+ (*** Thread opaque.
+ * can be used by execute() to store some per AVCodecContext stuff.
+ * - encoding: set by execute()
+ * - decoding: set by execute() *)
+ thread_opaque: pointer;
+
+ (*** Motion estimation threshold. under which no motion estimation is
+ * performed, but instead the user specified motion vectors are used
+ * - encoding: set by user
+ * - decoding: unused *)
+ me_threshold: integer;
+
+ (*** Macroblock threshold. under which the user specified macroblock types will be used
+ * - encoding: set by user
+ * - decoding: unused *)
+ mb_threshold: integer;
+
+ (*** precision of the intra dc coefficient - 8.
+ * - encoding: set by user
+ * - decoding: unused *)
+ intra_dc_precision: integer;
+
+ (*** noise vs. sse weight for the nsse comparsion function.
+ * - encoding: set by user
+ * - decoding: unused *)
+ nsse_weight: integer;
+
+ (*** number of macroblock rows at the top which are skipped.
+ * - encoding: unused
+ * - decoding: set by user *)
+ skip_top: integer;
+
+ (*** number of macroblock rows at the bottom which are skipped.
+ * - encoding: unused
+ * - decoding: set by user *)
+ skip_bottom: integer;
+
+ (*** profile
+ * - encoding: set by user
+ * - decoding: set by lavc *)
+ profile: integer;
+
+ (*** level
+ * - encoding: set by user
+ * - decoding: set by lavc *)
+ level: integer;
+
+ (*** low resolution decoding. 1-> 1/2 size, 2->1/4 size
+ * - encoding: unused
+ * - decoding: set by user *)
+ lowres: integer;
+
+ (*** bitsream width / height. may be different from width/height if lowres
+ * or other things are used
+ * - encoding: unused
+ * - decoding: set by user before init if known, codec should override / dynamically change if needed *)
+ coded_width, coded_height: integer;
+
+ (*** frame skip threshold
+ * - encoding: set by user
+ * - decoding: unused *)
+ frame_skip_threshold: integer;
+
+ (*** frame skip factor
+ * - encoding: set by user
+ * - decoding: unused *)
+ frame_skip_factor: integer;
+
+ (*** frame skip exponent
+ * - encoding: set by user
+ * - decoding: unused *)
+ frame_skip_exp: integer;
+
+ (*** frame skip comparission function
+ * - encoding: set by user.
+ * - decoding: unused *)
+ frame_skip_cmp: integer;
+
+ (*** border processing masking. raises the quantizer for mbs on the borders
+ * of the picture.
+ * - encoding: set by user
+ * - decoding: unused *)
+ border_masking: single;
+
+ (*** minimum MB lagrange multipler.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ mb_lmin: integer;
+
+ (*** maximum MB lagrange multipler.
+ * - encoding: set by user.
+ * - decoding: unused *)
+ mb_lmax: integer;
+
+ (***
+ * - encoding: set by user.
+ * - decoding: unused *)
+ me_penalty_compensation: integer;
+
+ (***
+ * - encoding: unused
+ * - decoding: set by user. *)
+ skip_loop_filter: TAVDiscard;
+
+ (** *
+ * - encoding: unused
+ * - decoding: set by user. *)
+ skip_idct: TAVDiscard;
+
+ (** *
+ * - encoding: unused
+ * - decoding: set by user. *)
+ skip_frame: TAVDiscard;
+
+ (** *
+ * - encoding: set by user.
+ * - decoding: unused *)
+ bidir_refine: integer;
+
+ (** *
+ * - encoding: set by user.
+ * - decoding: unused *)
+ brd_scale: integer;
+
+ (**
+ * constant rate factor - quality-based VBR - values ~correspond to qps
+ * - encoding: set by user.
+ * - decoding: unused *)
+ crf: integer;
+
+ (**
+ * constant quantization parameter rate control method
+ * - encoding: set by user.
+ * - decoding: unused *)
+ cqp: integer;
+
+ (**
+ * minimum gop size
+ * - encoding: set by user.
+ * - decoding: unused *)
+ keyint_min: integer;
+
+ (**
+ * number of reference frames
+ * - encoding: set by user.
+ * - decoding: unused *)
+ refs: integer;
+
+ (**
+ * chroma qp offset from luma
+ * - encoding: set by user.
+ * - decoding: unused *)
+ chromaoffset: integer;
+
+ (**
+ * influences how often b-frames are used
+ * - encoding: set by user.
+ * - decoding: unused *)
+ bframebias: integer;
+
+ (**
+ * trellis RD quantization
+ * - encoding: set by user.
+ * - decoding: unused *)
+ trellis: integer;
+
+ (**
+ * reduce fluctuations in qp (before curve compression)
+ * - encoding: set by user.
+ * - decoding: unused *)
+ complexityblur: single;
+
+ (**
+ * in-loop deblocking filter alphac0 parameter
+ * alpha is in the range -6...6
+ * - encoding: set by user.
+ * - decoding: unused *)
+ deblockalpha: integer;
+
+ (**
+ * in-loop deblocking filter beta parameter
+ * beta is in the range -6...6
+ * - encoding: set by user.
+ * - decoding: unused *)
+ deblockbeta: integer;
+
+ (**
+ * macroblock subpartition sizes to consider - p8x8, p4x4, b8x8, i8x8, i4x4
+ * - encoding: set by user.
+ * - decoding: unused *)
+ partitions: integer;
+
+ (**
+ * direct mv prediction mode - 0 (none), 1 (spatial), 2 (temporal)
+ * - encoding: set by user.
+ * - decoding: unused *)
+ directpred: integer;
+
+ (**
+ * audio cutoff bandwidth (0 means "automatic") . Currently used only by FAAC
+ * - encoding: set by user.
+ * - decoding: unused *)
+ cutoff: integer;
+
+ (**
+ * multiplied by qscale for each frame and added to scene_change_score
+ * - encoding: set by user.
+ * - decoding: unused *)
+ scenechange_factor: integer;
+
+ (** *
+ * note: value depends upon the compare functin used for fullpel ME
+ * - encoding: set by user.
+ * - decoding: unused *)
+ mv0_threshold: integer;
+
+ (**
+ * adjusts sensitivity of b_frame_strategy 1
+ * - encoding: set by user.
+ * - decoding: unused *)
+ b_sensitivity: integer;
+
+ (**
+ * - encoding: set by user.
+ * - decoding: unused *)
+ compression_level: integer;
+
+ (**
+ * sets whether to use LPC mode - used by FLAC encoder
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ use_lpc: integer;
+
+ (**
+ * LPC coefficient precision - used by FLAC encoder
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ lpc_coeff_precision: integer;
+
+ (**
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ min_prediction_order: integer;
+
+ (**
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ max_prediction_order: integer;
+
+ (**
+ * search method for selecting prediction order
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ prediction_order_method: integer;
+
+ (**
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ min_partition_order: integer;
+
+ (**
+ * - encoding: set by user.
+ * - decoding: unused. *)
+ max_partition_order: integer;
+ end;
+
+(**
+ * AVCodec.
+ *)
+ TAVCodec = record
+ name: pchar;
+ _type: TCodecType;
+ id: TCodecID;
+ priv_data_size: integer;
+ init: function (avctx: PAVCodecContext): integer; cdecl; (* typo corretion by the Creative CAT *)
+ encode: function (avctx: PAVCodecContext; buf: pchar; buf_size: integer; data: pointer): integer; cdecl;
+ close: function (avctx: PAVCodecContext): integer; cdecl;
+ decode: function (avctx: PAVCodecContext; outdata: pointer; outdata_size: PInteger;
+ buf: pchar; buf_size: integer): integer; cdecl;
+ capabilities: integer;
+// todo: check this ->
+// void *dummy; // FIXME remove next time we break binary compatibility
+ next: PAVCodec;
+ flush: procedure (avctx: PAVCodecContext); cdecl;
+ supported_framerates: PAVRational; ///array of supported framerates, or NULL if any, array is terminated by {0,0}
+ pix_fmts: PAVPixelFormat; ///array of supported pixel formats, or NULL if unknown, array is terminanted by -1
+ end;
+
+(**
+ * four components are given, that's all.
+ * the last component is alpha
+ *)
+ PAVPicture = ^TAVPicture;
+ TAVPicture = record
+ data: array [0..3] of pchar;
+ linesize: array [0..3] of integer; ///< number of bytes per line
+ end;
+
+(**
+ * AVPaletteControl
+ * This structure defines a method for communicating palette changes
+ * between and demuxer and a decoder.
+ * this is totally broken, palette changes should be sent as AVPackets
+ *)
+ TAVPaletteControl = record
+ (* demuxer sets this to 1 to indicate the palette has changed;
+ * decoder resets to 0 *)
+ palette_changed: integer;
+
+ (* 4-byte ARGB palette entries, stored in native byte order; note that
+ * the individual palette components should be on a 8-bit scale; if
+ * the palette data comes from a IBM VGA native format, the component
+ * data is probably 6 bits in size and needs to be scaled *)
+ palette: array [0..AVPALETTE_COUNT - 1] of cardinal;
+ end;
+
+ PAVSubtitleRect = ^TAVSubtitleRect;
+ TAVSubtitleRect = record
+ x: word;
+ y: word;
+ w: word;
+ h: word;
+ nb_colors: word;
+ linesize: integer;
+ rgba_palette: PCardinal;
+ bitmap: pchar;
+ end;
+
+ PAVSubtitle = ^TAVSubtitle;
+ TAVSubtitle = record {20}
+ format: word; (* 0 = graphics *)
+ start_display_time: cardinal; (* relative to packet pts, in ms *)
+ end_display_time: cardinal; (* relative to packet pts, in ms *)
+ num_rects: cardinal;
+ rects: PAVSubtitleRect;
+ end;
+
+
+(* resample.c *)
+
+ PReSampleContext = pointer;
+ PAVResampleContext = pointer;
+ PImgReSampleContext = pointer;
+
+function audio_resample_init (output_channels: integer; input_channels: integer;
+ output_rate: integer; input_rate: integer): PReSampleContext;
+ cdecl; external av__codec;
+
+function audio_resample (s: PReSampleContext; output: PWord; input: PWord; nb_samples: integer): integer;
+ cdecl; external av__codec;
+
+procedure audio_resample_close (s: PReSampleContext);
+ cdecl; external av__codec;
+
+
+function av_resample_init (out_rate: integer; in_rate: integer; filter_length: integer;
+ log2_phase_count: integer; linear: integer; cutoff: double): PAVResampleContext;
+ cdecl; external av__codec;
+
+function av_resample (c: PAVResampleContext; dst: PWord; src: PWord; consumed: PInteger;
+ src_size: integer; dst_size: integer; update_ctx: integer): integer;
+ cdecl; external av__codec;
+
+procedure av_resample_compensate (c: PAVResampleContext; sample_delta: integer;
+ compensation_distance: integer);
+ cdecl; external av__codec;
+
+procedure av_resample_close (c: PAVResampleContext);
+ cdecl; external av__codec;
+
+
+(* YUV420 format is assumed ! *)
+
+ function img_resample_init (output_width: integer; output_height: integer;
+ input_width: integer; input_height: integer): PImgReSampleContext;
+ cdecl; external av__codec;
+
+ function img_resample_full_init (owidth: integer; oheight: integer;
+ iwidth: integer; iheight: integer;
+ topBand: integer; bottomBand: integer;
+ leftBand: integer; rightBand: integer;
+ padtop: integer; padbottom: integer;
+ padleft: integer; padright: integer): PImgReSampleContext;
+ cdecl; external av__codec;
+
+ procedure img_resample (s: PImgReSampleContext; output: PAVPicture; const input: PAVPicture);
+ cdecl; external av__codec;
+
+ procedure img_resample_close (s: PImgReSampleContext);
+ cdecl; external av__codec;
+
+(**
+ * Allocate memory for a picture. Call avpicture_free to free it.
+ *
+ * @param picture the picture to be filled in.
+ * @param pix_fmt the format of the picture.
+ * @param width the width of the picture.
+ * @param height the height of the picture.
+ * @return 0 if successful, -1 if not.
+ *)
+ function avpicture_alloc (picture: PAVPicture; pix_fmt: TAVPixelFormat;
+ width: integer; height: integer): integer;
+ cdecl; external av__codec;
+
+
+(* Free a picture previously allocated by avpicture_alloc. *)
+ procedure avpicture_free (picture: PAVPicture);
+ cdecl; external av__codec;
+
+ function avpicture_fill (picture: PAVPicture; ptr: pointer;
+ pix_fmt: TAVPixelFormat; width: integer; height: integer): integer;
+ cdecl; external av__codec;
+
+ function avpicture_layout (const src: PAVPicture; pix_fmt: TAVPixelFormat;
+ width: integer; height: integer;
+ dest: pchar; dest_size: integer): integer;
+ cdecl; external av__codec;
+
+ function avpicture_get_size (pix_fmt: TAVPixelFormat; width: integer; height: integer): integer;
+ cdecl; external av__codec;
+
+ procedure avcodec_get_chroma_sub_sample (pix_fmt: TAVPixelFormat; h_shift: Pinteger; v_shift: pinteger);
+ cdecl; external av__codec;
+
+ function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): pchar;
+ cdecl; external av__codec;
+
+ procedure avcodec_set_dimensions(s: PAVCodecContext; width: integer; height: integer);
+ cdecl; external av__codec;
+
+ function avcodec_get_pix_fmt(const name: pchar): TAVPixelFormat;
+ cdecl; external av__codec;
+
+ function avcodec_pix_fmt_to_codec_tag(p: TAVPixelFormat): cardinal;
+ cdecl; external av__codec;
+
+ function avcodec_get_pix_fmt_loss (dst_pix_fmt: TAVPixelFormat; src_pix_fmt: TAVPixelFormat;
+ has_alpha: integer): integer;
+ cdecl; external av__codec;
+
+ function avcodec_find_best_pix_fmt (pix_fmt_mask: integer; src_pix_fmt: TAVPixelFormat;
+ has_alpha: integer; loss_ptr: pinteger): integer;
+ cdecl; external av__codec;
+
+ function img_get_alpha_info (const src: PAVPicture;
+ pix_fmt: TAVPixelFormat;
+ width: integer; height: integer): integer;
+ cdecl; external av__codec;
+
+
+(* convert among pixel formats *)
+ function img_convert (dst: PAVPicture; dst_pix_fmt: TAVPixelFormat;
+ const src: PAVPicture; pix_fmt: TAVPixelFormat;
+ width: integer; height: integer): integer;
+ cdecl; external av__codec;
+
+(* deinterlace a picture *)
+ function avpicture_deinterlace (dst: PAVPicture; const src: PAVPicture;
+ pix_fmt: TAVPixelFormat; width: integer; height: integer): integer;
+ cdecl; external av__codec;
+
+(* returns LIBAVCODEC_VERSION_INT constant *)
+ function avcodec_version (): cardinal;
+ cdecl; external av__codec;
+
+(* returns LIBAVCODEC_BUILD constant *)
+ function avcodec_build (): cardinal;
+ cdecl; external av__codec;
+
+ procedure avcodec_init ();
+ cdecl; external av__codec;
+
+ procedure register_avcodec (format: PAVCodec);
+ cdecl; external av__codec;
+
+ function avcodec_find_encoder (id: TCodecID): PAVCodec;
+ cdecl; external av__codec;
+ function avcodec_find_encoder_by_name (name: pchar): PAVCodec;
+ cdecl; external av__codec;
+ function avcodec_find_decoder(id: TCodecID): PAVCodec;
+ cdecl; external av__codec;
+ function avcodec_find_decoder_by_name (name: pchar): PAVCodec;
+ cdecl; external av__codec;
+ procedure avcodec_string(buf: pchar; buf_size: integer; enc: PAVCodecContext; encode: integer);
+ cdecl; external av__codec;
+
+ procedure avcodec_get_context_defaults (s: PAVCodecContext);
+ cdecl; external av__codec;
+ function avcodec_alloc_context : PAVCodecContext;
+ cdecl; external av__codec;
+(* favourite of The Creative CAT
+ function avcodec_alloc_context (): PAVCodecContext;
+ cdecl; external av__codec; *)
+ procedure avcodec_get_frame_defaults (pic: PAVFrame);
+ cdecl; external av__codec;
+ function avcodec_alloc_frame : PAVFrame;
+ cdecl; external av__codec;
+(* favourite of The Creative CAT
+ function avcodec_alloc_frame (): PAVFrame;
+ cdecl; external av__codec; *)
+
+ function avcodec_default_get_buffer (s: PAVCodecContext; pic: PAVFrame): integer;
+ cdecl; external av__codec;
+ procedure avcodec_default_release_buffer (s: PAVCodecContext; pic: PAVFrame);
+ cdecl; external av__codec;
+ function avcodec_default_reget_buffer (s: PAVCodecContext; pic: PAVFrame): integer;
+ cdecl; external av__codec;
+ procedure avcodec_align_dimensions(s: PAVCodecContext; width: Pinteger; height: PInteger);
+ cdecl; external av__codec;
+ function avcodec_check_dimensions (av_log_ctx: pointer; w: cardinal; h: cardinal): integer;
+ cdecl; external av__codec;
+ function avcodec_default_get_format(s: PAVCodecContext; const fmt: PAVPixelFormat): TAVPixelFormat;
+ cdecl; external av__codec;
+
+ function avcodec_thread_init (s: PAVCodecContext; thread_count: integer): integer;
+ cdecl; external av__codec;
+ procedure avcodec_thread_free (s: PAVCodecContext);
+ cdecl; external av__codec;
+ function avcodec_thread_execute (s: PAVCodecContext; func: pointer; arg: PPointer; ret: Pinteger; count: integer): integer;
+ cdecl; external av__codec;
+ function avcodec_default_execute (s: PAVCodecContext; func: pointer; arg: PPointer; ret: Pinteger; count: integer): integer;
+ cdecl; external av__codec;
+
+
+//FIXME func typedef
+
+(**
+ * opens / inits the AVCodecContext.
+ * not thread save!
+ *)
+ function avcodec_open (avctx: PAVCodecContext; codec: PAVCodec): integer;
+ cdecl; external av__codec;
+
+
+(**
+ * Decode an audio frame.
+ *
+ * @param avctx the codec context.
+ * @param samples output buffer, 16 byte aligned
+ * @param frame_size_ptr the output buffer size in bytes, zero if no frame could be compressed
+ * @param buf input buffer, 16 byte aligned
+ * @param buf_size the input buffer size
+ * @return 0 if successful, -1 if not.
+ *)
+
+(** This comment was added by the Creative CAT. frame_size_ptr was changed to
+ variable refference.
+
+ * @deprecated Use avcodec_decode_audio2() instead.
+ *)
+
+ function avcodec_decode_audio (avctx: PAVCodecContext; samples: Pword;
+ var frame_size_ptr: integer;
+ buf: pchar; buf_size: integer): integer;
+ cdecl; external av__codec;
+(* decode a frame.
+ * @param buf bitstream buffer, must be FF_INPUT_BUFFER_PADDING_SIZE larger then the actual read bytes
+ * because some optimized bitstream readers read 32 or 64 bit at once and could read over the end
+ * @param buf_size the size of the buffer in bytes
+ * @param got_picture_ptr zero if no frame could be decompressed, Otherwise, it is non zero
+ * @return -1 if error, otherwise return the number of
+ * bytes used. *)
+
+ function avcodec_decode_audio2(avctx : PAVCodecContext; samples : PWord;
+ var frame_size_ptr : integer;
+ buf: pchar; buf_size: integer): integer;
+ cdecl; external av__codec;
+(* Added by The Creative CAT
+/**
+ * Decodes a video frame from \p buf into \p picture.
+ * The avcodec_decode_video() function decodes a video frame from the input
+ * buffer \p buf of size \p buf_size. To decode it, it makes use of the
+ * video codec which was coupled with \p avctx using avcodec_open(). The
+ * resulting decoded frame is stored in \p picture.
+ *
+ * @warning The input buffer must be \c FF_INPUT_BUFFER_PADDING_SIZE larger than
+ * the actual read bytes because some optimized bitstream readers read 32 or 64
+ * bits at once and could read over the end.
+ *
+ * @warning The end of the input buffer \p buf should be set to 0 to ensure that
+ * no overreading happens for damaged MPEG streams.
+ *
+ * @note You might have to align the input buffer \p buf and output buffer \p
+ * samples. The alignment requirements depend on the CPU: on some CPUs it isn't
+ * necessary at all, on others it won't work at all if not aligned and on others
+ * it will work but it will have an impact on performance. In practice, the
+ * bitstream should have 4 byte alignment at minimum and all sample data should
+ * be 16 byte aligned unless the CPU doesn't need it (AltiVec and SSE do). If
+ * the linesize is not a multiple of 16 then there's no sense in aligning the
+ * start of the buffer to 16.
+ *
+ * @param avctx the codec context
+ * @param[out] picture The AVFrame in which the decoded video frame will be stored.
+ * @param[in] buf the input buffer
+ * @param[in] buf_size the size of the input buffer in bytes
+ * @param[in,out] got_picture_ptr Zero if no frame could be decompressed, otherwise, it is nonzero.
+ * @return On error a negative value is returned, otherwise the number of bytes
+ * used or zero if no frame could be decompressed.
+ */
+*)
+
+ function avcodec_decode_video (avctx: PAVCodecContext; picture: PAVFrame;
+ var got_picture_ptr: integer; (* favour of The Creative CAT *)
+ buf: PByte; buf_size: integer): integer;
+ cdecl; external av__codec;
+
+ function avcodec_decode_subtitle (avctx: PAVCodecContext; sub: PAVSubtitle;
+ got_sub_ptr: pinteger;
+ const buf: pchar; buf_size: integer): integer;
+ cdecl; external av__codec;
+ function avcodec_parse_frame (avctx: PAVCodecContext; pdata: PPointer;
+ data_size_ptr: pinteger;
+ buf: pchar; buf_size: integer): integer;
+ cdecl; external av__codec;
+
+ function avcodec_encode_audio (avctx: PAVCodecContext; buf: PByte;
+ buf_size: integer; const samples: PWord): integer;
+ cdecl; external av__codec;
+
+ (* avcodec_encode_video: -1 if error *)
+ (* type of the second argument is changed by The Creative CAT *)
+ function avcodec_encode_video (avctx: PAVCodecContext; buf: PByte;
+ buf_size: integer; pict: PAVFrame): integer;
+ cdecl; external av__codec;
+ function avcodec_encode_subtitle (avctx: PAVCodecContext; buf: pchar;
+ buf_size: integer; const sub: PAVSubtitle): integer;
+ cdecl; external av__codec;
+ function avcodec_close (avctx: PAVCodecContext): integer;
+ cdecl; external av__codec;
+
+ procedure avcodec_register_all ();
+ cdecl; external av__codec;
+
+ procedure avcodec_flush_buffers (avctx: PAVCodecContext);
+ cdecl; external av__codec;
+ procedure avcodec_default_free_buffers (s: PAVCodecContext);
+ cdecl; external av__codec;
+
+(* misc usefull functions *)
+
+(**
+ * returns a single letter to describe the picture type
+ *)
+ function av_get_pict_type_char (pict_type: integer): char;
+ cdecl; external av__codec;
+
+
+(**
+ * returns codec bits per sample
+ *)
+function av_get_bits_per_sample (codec_id: TCodecID): integer;
+ cdecl; external av__codec;
+
+const
+ AV_PARSER_PTS_NB = 4;
+ PARSER_FLAG_COMPLETE_FRAMES = $0001;
+
+type
+ PAVCodecParserContext = ^TAVCodecParserContext;
+ PAVCodecParser = ^TAVCodecParser;
+
+ TAVCodecParserContext = record
+ priv_data: pointer;
+ parser: PAVCodecParser;
+ frame_offset: int64; (* offset of the current frame *)
+ cur_offset: int64; (* current offset (incremented by each av_parser_parse()) *)
+ last_frame_offset: int64; (* offset of the last frame *)
+ (* video info *)
+ pict_type: integer; (* XXX: put it back in AVCodecContext *)
+ repeat_pict: integer; (* XXX: put it back in AVCodecContext *)
+ pts: int64; (* pts of the current frame *)
+ dts: int64; (* dts of the current frame *)
+
+ (* private data *)
+ last_pts: int64;
+ last_dts: int64;
+ fetch_timestamp: integer;
+
+ cur_frame_start_index: integer;
+ cur_frame_offset: array [0..AV_PARSER_PTS_NB - 1] of int64;
+ cur_frame_pts: array [0..AV_PARSER_PTS_NB - 1] of int64;
+ cur_frame_dts: array [0..AV_PARSER_PTS_NB - 1] of int64;
+
+ flags: integer;
+ end;
+
+ TAVCodecParser = record
+ codec_ids: array [0..4] of integer; (* several codec IDs are permitted *)
+ priv_data_size: integer;
+ parser_init: function (s: PAVCodecParserContext): integer; cdecl;
+ parser_parse: function (s: PAVCodecParserContext; avctx: PAVCodecContext;
+ poutbuf: PPointer; poutbuf_size: PInteger;
+ const buf: pchar; buf_size: integer): integer; cdecl;
+ parser_close: procedure (s: PAVCodecParserContext); cdecl;
+ split: function (avctx: PAVCodecContext; const buf: pchar;
+ buf_size: integer): integer; cdecl;
+ next: PAVCodecParser;
+ end;
+
+ procedure av_register_codec_parser (parser: PAVCodecParser); cdecl;
+ cdecl; external av__codec;
+
+ function av_parser_init (codec_id: integer): PAVCodecParserContext;
+ cdecl; external av__codec;
+
+ function av_parser_parse (s: PAVCodecParserContext;
+ avctx: PAVCodecContext;
+ poutbuf: PPointer; poutbuf_size: pinteger;
+ const buf: pchar; buf_size: integer;
+ pts: int64; dts: int64): integer;
+ cdecl; external av__codec;
+ function av_parser_change (s: PAVCodecParserContext;
+ avctx: PAVCodecContext;
+ poutbuf: PPointer; poutbuf_size: PInteger;
+ const buf: pchar; buf_size: integer; keyframe: integer): integer;
+ cdecl; external av__codec;
+ procedure av_parser_close (s: PAVCodecParserContext);
+ cdecl; external av__codec;
+
+type
+ PAVBitStreamFilterContext = ^TAVBitStreamFilterContext;
+ PAVBitStreamFilter = ^TAVBitStreamFilter;
+
+ TAVBitStreamFilterContext = record
+ priv_data: pointer;
+ filter: PAVBitStreamFilter;
+ parser: PAVCodecParserContext;
+ next: PAVBitStreamFilterContext;
+ end;
+
+ TAVBitStreamFilter = record
+ name: pchar;
+ priv_data_size: integer;
+ filter: function (bsfc: PAVBitStreamFilterContext;
+ avctx: PAVCodecContext; args: pchar;
+ poutbuf: PPointer; poutbuf_size: PInteger;
+ buf: PByte; buf_size: integer; keyframe: integer): integer; cdecl;
+ next: PAVBitStreamFilter;
+ end;
+
+procedure av_register_bitstream_filter (bsf: PAVBitStreamFilter);
+ cdecl; external av__codec;
+
+function av_bitstream_filter_init (name: pchar): PAVBitStreamFilterContext;
+ cdecl; external av__codec;
+
+function av_bitstream_filter_filter (bsfc: PAVBitStreamFilterContext;
+ avctx: PAVCodecContext; args: pchar;
+ poutbuf: PPointer; poutbuf_size: PInteger;
+ buf: PByte; buf_size: integer; keyframe: integer): integer;
+ cdecl; external av__codec;
+procedure av_bitstream_filter_close (bsf: PAVBitStreamFilterContext);
+ cdecl; external av__codec;
+
+
+(* memory *)
+ procedure av_fast_realloc (ptr: pointer; size: PCardinal; min_size: Cardinal);
+ cdecl; external av__codec;
+(* for static data only *)
+(* call av_free_static to release all staticaly allocated tables *)
+ procedure av_free_static ();
+ cdecl; external av__codec;
+
+ procedure av_mallocz_static(size: cardinal);
+ cdecl; external av__codec;
+
+ procedure av_realloc_static(ptr: pointer; size: Cardinal);
+ cdecl; external av__codec;
+
+ procedure img_copy (dst: PAVPicture; const src: PAVPicture;
+ pix_fmt: TAVPixelFormat; width: integer; height: integer);
+ cdecl; external av__codec;
+
+ function img_crop (dst: PAVPicture; const src: PAVPicture;
+ pix_fmt: TAVPixelFormat; top_band, left_band: integer): integer;
+ cdecl; external av__codec;
+
+ function img_pad (dst: PAVPicture; const src: PAVPicture; height, width: integer;
+ pix_fmt: TAVPixelFormat; padtop, padbottom, padleft, padright: integer;
+ color: PInteger): integer;
+ cdecl; external av__codec;
+
+implementation
+
+end.
diff --git a/Game/Code/lib/ffmpeg/avformat.pas b/Game/Code/lib/ffmpeg/avformat.pas new file mode 100644 index 00000000..aa74043b --- /dev/null +++ b/Game/Code/lib/ffmpeg/avformat.pas @@ -0,0 +1,701 @@ + (* + * copyright (c) 2001 Fabrice Bellard + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + *) + +(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows. +For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT +in the source codes *) + +unit avformat; + +{$IFDEF FPC} + {$IFNDEF win32} + {$LINKLIB libavutil}
+ {$LINKLIB libavformat} + {$ENDIF}
+ + {$MODE DELPHI } (* CAT *) + {$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *) + {$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *) +{$ENDIF} + +interface + +uses + avcodec, + avio, + rational, + avutil; (* CAT *) + +const + + +{$IFDEF win32} + av__format = 'avformat-50.dll';
+{$ELSE}
+ av__format = 'libavformat.so'; // .0d
+ //av__format = 'libavformat.51'; (* CAT *)
+{$ENDIF} + + LIBAVUTIL_VERSION_INT = ((51 shl 16) + (12 shl 8) + 1); + LIBAVUTIL_VERSION = '51.12.1'; + LIBAVUTIL_BUILD = LIBAVUTIL_VERSION_INT; + + MAXINT64 = $7fffffffffffffff; + MININT64 = $8000000000000000; + + PKT_FLAG_KEY = $0001; + +(*************************************************) +(* input/output formats *) + + AVPROBE_SCORE_MAX = 100; ///< max score, half of that is used for file extension based detection + AVPROBE_PADDING_SIZE = 32; ///< extra allocated bytes at the end of the probe buffer + +//! demuxer will use url_fopen, no opened file should be provided by the caller + AVFMT_NOFILE = $0001; + AVFMT_NEEDNUMBER = $0002; (**< needs '%d' in filename *) + AVFMT_SHOW_IDS = $0008; (**< show format stream IDs numbers *) + AVFMT_RAWPICTURE = $0020; (**< format wants AVPicture structure for + raw picture data *) + AVFMT_GLOBALHEADER = $0040; (**< format wants global header *) + AVFMT_NOTIMESTAMPS = $0080; (**< format does not need / have any timestamps *) + AVFMT_GENERIC_INDEX = $0100; (**< use generic index building code *) + + AVINDEX_KEYFRAME = $0001; + + MAX_REORDER_DELAY = 4; + + AVFMTCTX_NOHEADER = $0001; (**< signal that no header is present + (streams are added dynamically) *) + MAX_STREAMS = 20; + AVFMT_NOOUTPUTLOOP = -1; + AVFMT_INFINITEOUTPUTLOOP = 0; + AVFMT_FLAG_GENPTS = $0001; ///< generate pts if missing even if it requires parsing future frames + AVFMT_FLAG_IGNIDX = $0002; ///< ignore index + AVFMT_FLAG_NONBLOCK = $0004; ///< do not block when reading packets from input + +type + HFILE = THandle; /// (* CAT *) + int = integer; + + PAVPacket = ^TAVPacket; + PAVImageFormat = ^TAVImageFormat; + PAVFormatContext = ^TAVFormatContext; + PAVFormatParameters = ^TAVFormatParameters; + PAVOutputFormat = ^TAVOutputFormat; + PAVProbeData = ^TAVProbeData; + PAVInputFormat = ^TAVInputFormat; + PAVIndexEntry = ^TAVIndexEntry; + PAVStream = ^TAVStream; + PAVPacketList = ^TAVPacketList; + PAVImageInfo = ^TAVImageInfo; + + TAVPacket = record {56} + pts: int64; ///< presentation time stamp in time_base units + dts: int64; ///< decompression time stamp in time_base units + data: PByte; + size: integer; + stream_index: integer; + flags: integer; + duration: integer; ///< presentation duration in time_base units (0 if not available) + destruct: procedure (p: PAVPacket); (* This cannot be var : TAVPacket. + because TAVPacket is not completely defined yet *) + priv: pointer; + pos: int64 ///< byte position in stream, -1 if unknown + end; + +(*************************************************) +(* fractional numbers for exact pts handling *) + +(* the exact value of the fractional number is: 'val + num / den'. num + is assumed to be such as 0 <= num < den *) + PAVFrac = ^TAVFrac; + TAVFrac = record + val, num, den: int64; + end; + +(* this structure contains the data a format has to probe a file *) + TAVProbeData = record {12} + filename: pchar; + buf: pchar; + buf_size: integer; + end; + + TAVFormatParameters = record {56} + time_base: TAVRational; (* 8 bytes *) + sample_rate: integer; + channels: integer; + width: integer; + height: integer; + pix_fmt: TAVPixelFormat; +{ image_format: PAVImageFormat; (* 4 bytes *)} (* CAT#3 *) + channel: integer; (* used to select dv channel *) + device: pchar; (* video, audio or DV device, if LIBAVFORMAT_VERSION_INT < (52<<16) *) + standard: pchar; (* tv standard, NTSC, PAL, SECAM *) +// int mpeg2ts_raw:1; (* force raw MPEG2 transport stream output, if possible *) +// int mpeg2ts_compute_pcr:1; (* compute exact PCR for each transport +// stream packet (only meaningful if +// mpeg2ts_raw is TRUE *) +// int initial_pause:1; (* do not begin to play the stream +// immediately (RTSP only) *) +// int prealloced_context:1; + dummy: byte; + video_codec_id: TCodecID; + audio_codec_id: TCodecID; + end; + + TAVOutputFormat = record {56} + name: pchar; + long_name: pchar; + mime_type: pchar; + extensions: pchar; (* comma separated extensions *) + (* size of private data so that it can be allocated in the wrapper *) + priv_data_size: integer; + (* output support *) + audio_codec: TCodecID; (* default audio codec *) + video_codec: TCodecID; (* default video codec *) + write_header: function (c: PAVFormatContext): integer; cdecl; + write_packet: function (c: PAVFormatContext; var pkt: TAVPacket): integer; cdecl; (* CAT#2 *) + write_trailer: function (c: PAVFormatContext): integer; cdecl; + (* can use flags: AVFMT_NOFILE, AVFMT_NEEDNUMBER, AVFMT_GLOBALHEADER *) + flags: integer; + (* currently only used to set pixel format if not YUV420P *) + set_parameters: function (c: PAVFormatContext; f: PAVFormatParameters): integer; cdecl; + interleave_packet: function (s: PAVFormatContext; _out: PAVPacket; _in: PAVPacket; flush: integer): integer; cdecl; + + (** + * list of supported codec_id-codec_tag pairs, ordered by "better choice first" + * the arrays are all CODEC_ID_NONE terminated + *) + //const struct AVCodecTag **codec_tag; + + (* private fields *) + next: PAVOutputFormat; + end; + + TAVInputFormat = record {60} + name: pchar; + long_name: pchar; + (* size of private data so that it can be allocated in the wrapper *) + priv_data_size: integer; + (* tell if a given file has a chance of being parsing by this format *) + read_probe: function (p: PAVProbeData): integer; cdecl; + (* read the format header and initialize the AVFormatContext + structure. Return 0 if OK. 'ap' if non NULL contains + additionnal paramters. Only used in raw format right + now. 'av_new_stream' should be called to create new streams. *) + read_header: function (c: PAVFormatContext; ap: PAVFormatParameters): integer; cdecl; + (* read one packet and put it in 'pkt'. pts and flags are also + set. 'av_new_stream' can be called only if the flag + AVFMTCTX_NOHEADER is used. *) + read_packet: function (c: PAVFormatContext; var pkt: TAVPacket): integer; cdecl; + (* close the stream. The AVFormatContext and AVStreams are not + freed by this function *) + read_close: function (c: PAVFormatContext): integer; cdecl; + (*** seek to a given timestamp relative to the frames in + * stream component stream_index + * @param stream_index must not be -1 + * @param flags selects which direction should be preferred if no exact + * match is available *) + read_seek: function (c: PAVFormatContext; stream_index: integer; + timestamp: int64; flags: integer): integer; cdecl; + (*** gets the next timestamp in AV_TIME_BASE units. *) + read_timestamp: function (s: PAVFormatContext; stream_index: integer; + pos: pint64; pos_limit: int64): integer; cdecl; + (* can use flags: AVFMT_NOFILE, AVFMT_NEEDNUMBER *) + flags: integer; + (* if extensions are defined, then no probe is done. You should + usually not use extension format guessing because it is not + reliable enough *) + extensions: pchar; + (* general purpose read only value that the format can use *) + value: integer; + + (* start/resume playing - only meaningful if using a network based format (RTSP) *) + read_play: function (c: PAVFormatContext): integer; cdecl; + + (* pause playing - only meaningful if using a network based format (RTSP) *) + read_pause: function (c: PAVFormatContext): integer; cdecl; + + //const struct AVCodecTag **codec_tag; + + (* private fields *) + next: PAVInputFormat; + end; + + TAVStreamParseType = ( + AVSTREAM_PARSE_NONE, + AVSTREAM_PARSE_FULL, (**< full parsing and repack *) + AVSTREAM_PARSE_HEADERS, (**< only parse headers, don't repack *) + AVSTREAM_PARSE_TIMESTAMPS (**< full parsing and interpolation of timestamps for frames not starting on packet boundary *) + ); + + TAVIndexEntry = record {24} + pos: int64; + timestamp: int64; +(* the following 2 flags indicate that the next/prev keyframe is known, and scaning for it isnt needed *) + flags: integer; +// int flags:2; +// int size:30; //Yeah, trying to keep the size of this small to reduce memory requirements (it is 24 vs 32 byte due to possible 8byte align). + min_distance: integer; (* min distance between this and the previous keyframe, used to avoid unneeded searching *) + end; + + TAVStream = record {168} + index: integer; (* stream index in AVFormatContext *) {4-4} + id: integer; (* format specific stream id *) {4-8} + codec: PAVCodecContext; (* codec context *) {4-12} + (*** real base frame rate of the stream. + * for example if the timebase is 1/90000 and all frames have either + * approximately 3600 or 1800 timer ticks then r_frame_rate will be 50/1 *) + r_frame_rate: TAVRational; {4*2=8-20} + priv_data: pointer; {4-24} + (* internal data used in av_find_stream_info() *) + codec_info_duration: int64; (* #if LIBAVFORMAT_VERSION_INT < (52<<16) *) {8-32} + codec_info_nb_frames: integer; (* #if LIBAVFORMAT_VERSION_INT < (52<<16) *) {4-38} + (* encoding: PTS generation when outputing stream *) + pts: TAVFrac; {8*3=24-62} + + (*** this is the fundamental unit of time (in seconds) in terms + * of which frame timestamps are represented. for fixed-fps content, + * timebase should be 1/framerate and timestamp increments should be + * identically 1. *) + time_base: TAVRational; {4*2=8-70} + pts_wrap_bits: integer; (* number of bits in pts (used for wrapping control) *) {4-74} + (* ffmpeg.c private use *) + stream_copy: integer; (* if TRUE, just copy stream *) {4-78} + discard: TAVDiscard; ///< selects which packets can be discarded at will and dont need to be demuxed {4-82} + //FIXME move stuff to a flags field? + (* quality, as it has been removed from AVCodecContext and put in AVVideoFrame + * MN:dunno if thats the right place, for it *) + quality: single; {4-86} + (* decoding: position of the first frame of the component, in AV_TIME_BASE fractional seconds. *) + start_time: int64; {8-92} + (* decoding: duration of the stream, in stream time base. *) + duration: int64; {8-100} + + language: array [0..3] of char; (* ISO 639 3-letter language code (empty string if undefined) *)(* 101 th byte - 1 base *) {4-104} + + (* av_read_frame() support *) + need_parsing: TAVStreamParseType;//CAT#3 ///< 1->full parsing needed, 2->only parse headers dont repack + parser: PAVCodecParserContext; + + cur_dts: int64; + last_IP_duration: integer; + last_IP_pts: int64; + (* av_seek_frame() support *) + index_entries: PAVIndexEntry; (* only used if the format does not support seeking natively *) + nb_index_entries: integer; + index_entries_allocated_size: cardinal; (* CAT#3 *) + + nb_frames: int64; ///< number of frames in this stream if known or 0 + pts_buffer: array [0..MAX_REORDER_DELAY] of int64 + end; + +(* format I/O context *) + TAVFormatContext = record {3960} + av_class: PAVClass; (* set by av_alloc_format_context *) + (* can only be iformat or oformat, not both at the same time *) + iformat: PAVInputFormat; + oformat: PAVOutputFormat; + priv_data: pointer; + pb: TByteIOContext; + nb_streams: cardinal; (* CAT#3 *) + streams: array [0..MAX_STREAMS - 1] of PAVStream; + filename: array [0..1023] of char; (* input or output filename *) + (* stream info *) + timestamp: int64; + title: array [0..511] of char; + author: array [0..511] of char; + copyright: array [0..511] of char; + comment: array [0..511] of char; + album: array [0..511] of char; + year: integer; (* ID3 year, 0 if none *) + track: integer; (* track number, 0 if none *) + genre: array [0..31] of char; (* ID3 genre *) + + ctx_flags: integer; (* format specific flags, see AVFMTCTX_xx *) + (* private data for pts handling (do not modify directly) *) + (* This buffer is only needed when packets were already buffered but + not decoded, for example to get the codec parameters in mpeg + streams *) + packet_buffer: PAVPacketList; + + (* decoding: position of the first frame of the component, in + AV_TIME_BASE fractional seconds. NEVER set this value directly: + it is deduced from the AVStream values. *) + start_time: int64; + (* decoding: duration of the stream, in AV_TIME_BASE fractional + seconds. NEVER set this value directly: it is deduced from the + AVStream values. *) + duration: int64; + (* decoding: total file size. 0 if unknown *) + file_size: int64; + (* decoding: total stream bitrate in bit/s, 0 if not + available. Never set it directly if the file_size and the + duration are known as ffmpeg can compute it automatically. *) + bit_rate: integer; + + (* av_read_frame() support *) + cur_st: PAVStream; + cur_ptr: pbyte; + cur_len: integer; + cur_pkt: TAVPacket; + + (* av_seek_frame() support *) + data_offset: int64; (* offset of the first packet *) + index_built: integer; + + mux_rate: integer; + packet_size: integer; + preload: integer; + max_delay: integer; + + (* number of times to loop output in formats that support it *) + loop_output: integer; + + flags: integer; + loop_input: integer; + (* decoding: size of data to probe; encoding unused *) + probesize: cardinal; + + (** + * maximum duration in AV_TIME_BASE units over which the input should be analyzed in av_find_stream_info() + *) + max_analyze_duration: integer; + + key: pbyte; + keylen : integer + end; + + TAVPacketList = record {64} + pkt: TAVPacket; + next: PAVPacketList; + end; + +(* still image support *) + PAVInputImageContext = pointer; // attribute_deprecated; +// PAVInputImageContext = pointer; //AVInputImageContext attribute_deprecated; + +(* still image support *) + TAVImageInfo = record {48} + pix_fmt: TAVPixelFormat; (* requested pixel format *) + width: integer; (* requested width *) + height: integer; (* requested height *) + interleaved: integer; (* image is interleaved (e.g. interleaved GIF) *) + pict: TAVPicture; (* returned allocated image *) + end; + + TAVImageFormat = record {32} + name: pchar; + extensions: pchar; + (* tell if a given file has a chance of being parsing by this format *) + img_probe: function (d: PAVProbeData): integer; cdecl; + (* read a whole image. 'alloc_cb' is called when the image size is + known so that the caller can allocate the image. If 'allo_cb' + returns non zero, then the parsing is aborted. Return '0' if + OK. *) + img_read: function (b: PByteIOContext; alloc_cb: pointer; ptr: pointer): integer; cdecl; + (* write the image *) + supported_pixel_formats: integer; (* mask of supported formats for output *) + img_write: function (b: PByteIOContext; i: PAVImageInfo): integer; cdecl; + flags: integer; + next: PAVImageFormat; + end; + +procedure av_destruct_packet_nofree (var pkt: TAVPacket); (* CAT#2 *) + cdecl; external av__format; +procedure av_destruct_packet (var pkt: TAVPacket); (* CAT#2 *) + cdecl; external av__format; + +(* initialize optional fields of a packet *) +procedure av_init_packet (var pkt: TAVPacket); (* CAT#2 *) + +function av_new_packet(var pkt: TAVPacket; size: integer): integer; (* CAT#2 *) + cdecl; external av__format; + +function av_get_packet (s: PByteIOContext; var pkt: TAVPacket; size: integer): integer; (* CAT#2 *) + cdecl; external av__format; + +function av_dup_packet (pkt: PAVPacket): integer; + cdecl; external av__format; + +(** * Free a packet + * + * @param pkt packet to free *) +procedure av_free_packet (var pkt: TAVPacket); (* CAT#2 *) + +procedure av_register_image_format (img_fmt: PAVImageFormat); + cdecl; external av__format; + +function av_probe_image_format (pd: PAVProbeData): PAVImageFormat; + cdecl; external av__format; + +function guess_image_format (filename: pchar): PAVImageFormat; + cdecl; external av__format; + +function av_guess_image2_codec(filename: pchar): TCodecID; + cdecl; external av__format; + +function av_read_image (pb: PByteIOContext; filename: pchar; + fmt: PAVImageFormat; + alloc_cb: pointer; opaque: pointer): integer; + cdecl; external av__format; + +function av_write_image(pb: PByteIOContext; fmt: PAVImageFormat; img: PAVImageInfo): integer; + cdecl; external av__format; + +(* XXX: use automatic init with either ELF sections or C file parser *) +(* modules *) + +//#include "rtp.h" + +//#include "rtsp.h" + +(* utils.c *) + procedure av_register_input_format (format: PAVInputFormat); + cdecl; external av__format; + + procedure av_register_output_format (format: PAVOutputFormat); + cdecl; external av__format; + + function guess_stream_format (short_name: pchar; filename: pchar; mime_type: pchar): PAVOutputFormat; + cdecl; external av__format; + + function guess_format(short_name: pchar; filename: pchar; mime_type: pchar): PAVOutputFormat; + cdecl; external av__format; + + function av_guess_codec(fmt: PAVOutputFormat; short_name: pchar; + filename: pchar; mime_type: pchar; _type: TCodecType): TCodecID; + cdecl; external av__format; + + procedure av_hex_dump (f: HFILE; buf: pchar; size: integer); + cdecl; external av__format; + procedure av_pkt_dump(f: HFILE; var pkt: TAVPacket; dump_payload: integer); (* CAT#2 *) + cdecl; external av__format; + + procedure av_register_all (); + cdecl; external av__format; + + +(* media file input *) + function av_find_input_format (short_name: pchar): PAVInputFormat; + cdecl; external av__format; + function av_probe_input_format (pd: PAVProbeData; is_opened: integer): PAVInputFormat; + cdecl; external av__format; + function av_open_input_stream (ic_ptr: PAVFormatContext; + pb: PByteIOContext; filename: pchar; + fmt: PAVInputFormat; ap: PAVFormatParameters): integer; + cdecl; external av__format; +(*** Open a media file as input. The codec are not opened. Only the file + * header (if present) is read. + * + * @param ic_ptr the opened media file handle is put here + * @param filename filename to open. + * @param fmt if non NULL, force the file format to use + * @param buf_size optional buffer size (zero if default is OK) + * @param ap additionnal parameters needed when opening the file (NULL if default) + * @return 0 if OK. AVERROR_xxx otherwise. *) + + function av_open_input_file (var ic_ptr: PAVFormatContext; filename: pchar; + fmt: PAVInputFormat; buf_size: integer; + ap: PAVFormatParameters): integer; + cdecl; external av__format; + + (* no av_open for output, so applications will need this: *) + function av_alloc_format_context (): PAVFormatContext; + cdecl; external av__format; + +const + AVERROR_UNKNOWN =(-1); (* unknown error *) + AVERROR_IO =(-2); (* i/o error *) + AVERROR_NUMEXPECTED =(-3); (* number syntax expected in filename *) + AVERROR_INVALIDDATA =(-4); (* invalid data found *) + AVERROR_NOMEM =(-5); (* not enough memory *) + AVERROR_NOFMT =(-6); (* unknown format *) + AVERROR_NOTSUPP =(-7); (* operation not supported *) + +(*** Read the beginning of a media file to get stream information. This + * is useful for file formats with no headers such as MPEG. This + * function also compute the real frame rate in case of mpeg2 repeat + * frame mode. + * + * @param ic media file handle + * @return >=0 if OK. AVERROR_xxx if error. + * @todo let user decide somehow what information is needed so we dont waste time geting stuff the user doesnt need *) + + function av_find_stream_info (ic: PAVFormatContext): integer; + cdecl; external av__format; + function av_read_packet (s: PAVFormatContext; var pkt: TAVPacket): integer; (* CAT#2 *) + cdecl; external av__format; +(*** Return the next frame of a stream. + * + * The returned packet is valid + * until the next av_read_frame() or until av_close_input_file() and + * must be freed with av_free_packet. For video, the packet contains + * exactly one frame. For audio, it contains an integer number of + * frames if each frame has a known fixed size (e.g. PCM or ADPCM + * data). If the audio frames have a variable size (e.g. MPEG audio), + * then it contains one frame. + * + * pkt->pts, pkt->dts and pkt->duration are always set to correct + * values in AV_TIME_BASE unit (and guessed if the format cannot + * provided them). pkt->pts can be AV_NOPTS_VALUE if the video format + * has B frames, so it is better to rely on pkt->dts if you do not + * decompress the payload. + * + * @return 0 if OK, < 0 if error or end of file. *) + + function av_read_frame (s: PAVFormatContext; var pkt: TAVPacket): integer; (* CAT#2 *) + cdecl; external av__format; + function av_seek_frame (s: PAVFormatContext; stream_index: integer; timestamp: int64; flags: integer): integer; + cdecl; external av__format; + function av_read_play (s: PAVFormatContext): integer; + cdecl; external av__format; + function av_read_pause (s: PAVFormatContext): integer; + cdecl; external av__format; + procedure av_close_input_file (s: PAVFormatContext); + cdecl; external av__format; + function av_new_stream (s: PAVFormatContext; id: integer): PAVStream; + cdecl; external av__format; + procedure av_set_pts_info (s: PAVStream; pts_wrap_bits: integer; + pts_num: integer; pts_den: integer); + cdecl; external av__format; + +const + AVSEEK_FLAG_BACKWARD =1; ///< seek backward + AVSEEK_FLAG_BYTE =2; ///< seeking based on position in bytes + AVSEEK_FLAG_ANY =4; ///< seek to any frame, even non keyframes + + function av_find_default_stream_index (s: PAVFormatContext): integer; + cdecl; external av__format; + function av_index_search_timestamp (st: PAVStream; timestamp: int64; flags: integer): integer; + cdecl; external av__format; + function av_add_index_entry (st: PAVStream; pos: int64; timestamp: int64; + distance: integer; flags: integer): integer; + cdecl; external av__format; + function av_seek_frame_binary (s: PAVFormatContext; stream_index: integer; + target_ts: int64; flags: integer): integer; + cdecl; external av__format; + + procedure av_update_cur_dts (s: PAVFormatContext; ref_st: PAVStream; + timestamp: int64); + cdecl; external av__format; + +(* media file output *) + function av_set_parameters (s: PAVFormatContext; ap: PAVFormatParameters): integer; + cdecl; external av__format; + + function av_write_header (s: PAVFormatContext): integer; + cdecl; external av__format; + + function av_write_frame(s: PAVFormatContext; var pkt: TAVPacket): integer; + cdecl; external av__format; (* CAT#2 *) + + function av_interleaved_write_frame (s: PAVFormatContext; var pkt: TAVPacket): integer; + cdecl; external av__format; (* CAT#2 *) + + function av_interleave_packet_per_dts(s: PAVFormatContext; _out: PAVPacket; + pkt: PAVPacket; flush: integer): integer; + cdecl; external av__format; + function av_write_trailer(s: pAVFormatContext): integer; + cdecl; external av__format; + + procedure dump_format(ic: PAVFormatContext; index: integer; url: pchar; + is_output: integer); + cdecl; external av__format; + + function parse_image_size(width_ptr: PInteger; height_ptr: PInteger; str: pchar): integer; + cdecl; external av__format; + function parse_frame_rate (frame_rate: PInteger; frame_rate_base: PInteger; arg: pchar): integer; + cdecl; external av__format; + function parse_date(datestr: pchar; duration: integer): int64; + cdecl; external av__format; + function av_gettime (): int64; + cdecl; external av__format; + +(* ffm specific for ffserver *) +const + FFM_PACKET_SIZE = 4096; + + function ffm_read_write_index (fd: integer): int64; + cdecl; external av__format; + + procedure ffm_write_write_index(fd: integer; pos: int64); + cdecl; external av__format; + + procedure ffm_set_write_index (s: PAVFormatContext; pos: int64; file_size: int64); + cdecl; external av__format; + + function find_info_tag (arg: pchar; arg_size: integer; tag1: pchar; info: pchar): integer; + cdecl; external av__format; + + function get_frame_filename(buf: pchar; buf_size: integer; + path: pchar; number: integer): integer; + cdecl; external av__format; + function filename_number_test (filename: pchar): integer; + cdecl; external av__format; + + +(* grab specific *) + function video_grab_init (): integer; + cdecl; external av__format; + function audio_init (): integer; + cdecl; external av__format; + +(* DV1394 *) + function dv1394_init (): integer; + cdecl; external av__format; + function dc1394_init (): integer; + cdecl; external av__format; + + function strstart(str: pchar; val: pchar; ptr: PPointer): integer; + cdecl; external av__format; + function stristart(str: pchar; val: pchar; ptr: PPointer): integer; + cdecl; external av__format; + procedure pstrcpy(buf: pchar; buf_size: integer; str: pchar); + cdecl; external av__format; + function pstrcat(buf: pchar; buf_size: integer; s: pchar): pchar; + cdecl; external av__format; + + procedure __dynarray_add (tab_ptr: PPointer; nb_ptr: PInteger; elem: cardinal); + cdecl; external av__format; + + +implementation + +procedure av_init_packet (var pkt: TAVPacket); (* CAT#2 + bug fix *) +begin + with pkt do begin + pts := AV_NOPTS_VALUE; + dts := AV_NOPTS_VALUE; + pos := -1; + duration := 0; + flags := 0; + stream_index := 0; + destruct := @av_destruct_packet_nofree + end +end; + +procedure av_free_packet (var pkt: TAVPacket); (* CAT#2 *) +begin + if @pkt.destruct <> nil then pkt.destruct (@pkt) +{ if (pkt <> nil) and (@pkt^.destruct <> nil) then + pkt^.destruct (pkt)} +end; + +end. diff --git a/Game/Code/lib/ffmpeg/avio.pas b/Game/Code/lib/ffmpeg/avio.pas new file mode 100644 index 00000000..5e40bd4e --- /dev/null +++ b/Game/Code/lib/ffmpeg/avio.pas @@ -0,0 +1,256 @@ + (* + * unbuffered io for ffmpeg system + * copyright (c) 2001 Fabrice Bellard + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + *) + +(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows. +For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT +in the source codes *) + +unit avio; +{$IFDEF FPC} + {$MODE DELPHI } (* CAT *) + {$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *) + {$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *) +{$ENDIF} + +interface (* Widows unit is deleted by CAT *) + +const +(* version numbers are changed by The Creative CAT *) + +{$IFDEF win32} + av__format = 'avformat-50.dll';
+{$ELSE}
+ av__format = 'libavformat.so'; // .0d
+//av__format = 'libavformat.51';
+{$ENDIF} + + + URL_RDONLY = 0; + URL_WRONLY = 1; + URL_RDWR = 2; + +(* output byte stream handling *) + +type + offset_t = int64; + int = integer; + +(* unbuffered I/O *) + PURLProtocol = ^TURLProtocol; + PURLContext = ^TURLContext; + TURLContext = record + prot: PURLProtocol; + flags: int; + is_streamed: int; //* true if streamed (no seek possible), default = false */ + max_packet_size: int; //* if non zero, the stream is packetized with this max packet size */ + priv_data: pointer; + filename: array [0..0] of char; (* specified filename *) + end; + + PURLPollEntry = ^TURLPollEntry; + TURLPollEntry = record + handle: PURLContext; + events: integer; + revents: integer; + end; + + TURLProtocol = record + name: pchar; + url_open: function (h: PURLContext; const filename: pchar; flags: integer): integer; cdecl; + url_read: function (h: PURLContext; buf: pchar; size: integer): integer; cdecl; + url_write: function (h: PURLContext; buf: pchar; size: integer): integer; cdecl; + url_seek: function (h: PURLContext; pos: int64; whence: integer): int64; cdecl; + url_close: function (h: PURLContext): integer; cdecl; + next: PURLProtocol; + end; + + PByteIOContext = ^TByteIOContext; + TByteIOContext = record + buffer: pchar; + buffer_size: integer; + buf_ptr: pchar; + buf_end: pchar; + opaque: pointer; + read_packet: function (opaque: pointer; buf: pchar; buf_size: integer): integer; cdecl; + write_packet: function (opaque: pointer; buf: pchar; buf_size: integer): integer; cdecl; + seek: function (opaque: pointer; offset: int64; whence: integer): int64; cdecl; + pos: int64; (* position in the file of the current buffer *) + must_flush: integer; (* true if the next seek should flush *) + eof_reached: integer; (* true if eof reached *) + write_flag: integer; (* true if open for writing *) + is_streamed: integer; + max_packet_size: integer; + checksum: longword; + checksum_ptr: pchar; + update_checksum: function (checksum: cardinal; const buf: pchar; size: cardinal): LongWord; cdecl; + error: integer; ///< contains the error code or 0 if no error happened + end; + + function url_open(h: PPointer; const filename: pchar; flags: integer): integer; + cdecl; external av__format; + function url_read (h: PURLContext; buf: pchar; size: integer): integer; + cdecl; external av__format; + function url_write (h: PURLContext; buf: pchar; size: integer): integer; + cdecl; external av__format; + function url_seek (h: PURLContext; pos: int64; whence: integer): int64; + cdecl; external av__format; + function url_close (h: PURLContext): integer; + cdecl; external av__format; + function url_exist(const filename: pchar): integer; + cdecl; external av__format; + function url_filesize (h: PURLContext): int64; + cdecl; external av__format; + function url_get_max_packet_size(h: PURLContext): integer; + cdecl; external av__format; + procedure url_get_filename(h: PURLContext; buf: pchar; buf_size: integer); + cdecl; external av__format; + +(* the callback is called in blocking functions to test regulary if + asynchronous interruption is needed. -EINTR is returned in this + case by the interrupted function. 'NULL' means no interrupt + callback is given. *) + procedure url_set_interrupt_cb (interrupt_cb: pinteger); + cdecl; external av__format; + +(* not implemented *) +//int url_poll(URLPollEntry *poll_table, int n, int timeout); + + function register_protocol (protocol: PURLProtocol): integer; + cdecl; external av__format; + + function init_put_byte(s: PByteIOContext; + buffer: pchar; + buffer_size: integer; write_flag: integer; + opaque: pointer; + read_packet: pointer; //int (*read_packet)(void *opaque, uint8_t *buf, int buf_size), + write_packet: pointer; //int (*write_packet)(void *opaque, uint8_t *buf, int buf_size), + seek: pointer //offset_t (*seek)(void *opaque, offset_t offset, int whence) + ): integer; + cdecl; external av__format; + procedure put_byte(s: PByteIOContext; b: integer); + cdecl; external av__format; + procedure put_buffer (s: PByteIOContext; const buf: pchar; size: integer); + cdecl; external av__format; + procedure put_le64(s: PByteIOContext; val: int64); + cdecl; external av__format; + procedure put_be64(s: PByteIOContext; val: int64); + cdecl; external av__format; + procedure put_le32(s: PByteIOContext; val: cardinal); + cdecl; external av__format; + procedure put_be32(s: PByteIOContext; val: cardinal); + cdecl; external av__format; + procedure put_be24(s: PByteIOContext; val: cardinal); + cdecl; external av__format; + procedure put_le16(s: PByteIOContext; val: cardinal); + cdecl; external av__format; + procedure put_be16(s: PByteIOContext; val: cardinal); + cdecl; external av__format; + procedure put_tag(s: PByteIOContext; const tag: pchar); + cdecl; external av__format; + + procedure put_strz(s: PByteIOContext; const buf: pchar); + cdecl; external av__format; + + function url_fseek(s: PByteIOContext; offset: int64; whence: integer): int64; + cdecl; external av__format; + procedure url_fskip(s: PByteIOContext; offset: int64); + cdecl; external av__format; + function url_ftell(s: PByteIOContext): int64; + cdecl; external av__format; + function url_fsize(s: PByteIOContext): int64; + cdecl; external av__format; + function url_feof(s: PByteIOContext): integer; + cdecl; external av__format; + function url_ferror(s: PByteIOContext): integer; + cdecl; external av__format; + + procedure put_flush_packet (s: PByteIOContext); + cdecl; external av__format; + function get_buffer(s: PByteIOContext; buf: pchar; size: integer): integer; + cdecl; external av__format; + function get_partial_buffer(s: PByteIOContext; buf: pchar; size: integer): integer; + cdecl; external av__format; + function get_byte(s: PByteIOContext): integer; + cdecl; external av__format; + function get_le32(s: PByteIOContext): cardinal; + cdecl; external av__format; + function get_le64(s: PByteIOContext): int64; + cdecl; external av__format; + function get_le16(s: PByteIOContext): cardinal; + cdecl; external av__format; + + function get_strz(s: PByteIOContext; buf: pchar; maxlen: integer): pchar; + cdecl; external av__format; + function get_be16(s: PByteIOContext): cardinal; + cdecl; external av__format; + function get_be24(s: PByteIOContext): cardinal; + cdecl; external av__format; + function get_be32(s: PByteIOContext): cardinal; + cdecl; external av__format; + function get_be64(s: PByteIOContext): int64; + cdecl; external av__format; + + function url_is_streamed(s: PByteIOContext): integer; + + function url_fdopen (s: PByteIOContext; h: PURLContext): integer; + cdecl; external av__format; + function url_setbufsize (s: PByteIOContext; buf_size: integer): integer; + cdecl; external av__format; + function url_fopen(s: PByteIOContext; const filename: pchar; flags: integer): integer; + cdecl; external av__format; + function url_fclose(s: PByteIOContext): integer; + cdecl; external av__format; + + function url_fileno(s: PByteIOContext): PURLContext; + cdecl; external av__format; + function url_fget_max_packet_size (s: PByteIOContext): integer; + cdecl; external av__format; + function url_open_buf(s: PByteIOContext; buf: pchar; buf_size: integer; flags: integer): integer; + cdecl; external av__format; + function url_close_buf(s: PByteIOContext): integer; + cdecl; external av__format; + + function url_open_dyn_buf(s: PByteIOContext): integer; + cdecl; external av__format; + function url_open_dyn_packet_buf(s: PByteIOContext; max_packet_size: integer): integer; + cdecl; external av__format; + function url_close_dyn_buf(s: PByteIOContext; pbuffer:PPointer): integer; + cdecl; external av__format; + + function get_checksum(s: PByteIOContext): cardinal; + cdecl; external av__format; + + procedure init_checksum (s: PByteIOContext; update_checksum: pointer; checksum: cardinal); + cdecl; external av__format; + + function udp_set_remote_url(h: PURLContext; const uri: pchar): integer; + cdecl; external av__format; + function udp_get_local_port(h: PURLContext): integer; + cdecl; external av__format; + function udp_get_file_handle(h: PURLContext): integer; + cdecl; external av__format; + +implementation + +function url_is_streamed(s: PByteIOContext): integer; +begin + Result := s^.is_streamed; +end; + +end. diff --git a/Game/Code/lib/ffmpeg/avutil.pas b/Game/Code/lib/ffmpeg/avutil.pas new file mode 100644 index 00000000..0a2078dc --- /dev/null +++ b/Game/Code/lib/ffmpeg/avutil.pas @@ -0,0 +1,146 @@ + (*
+ * copyright (c) 2006 Michael Niedermayer <michaelni@gmx.at>
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows.
+For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT
+in the source codes *)
+
+unit avutil;
+{$IFDEF FPC}
+ {$MODE DELPHI}
+ {$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *)
+ {$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *)
+{$ENDIF}
+
+interface
+
+const
+{$IFDEF win32}
+ av__util = 'avutil-49.dll';
+{$ELSE}
+ av__util = 'libavutil.so'; // .0d
+// av__util = 'libavutil.49';
+{$ENDIF}
+
+
+ LIBAVUTIL_VERSION_INT = ((49 shl 16) + (4 shl 8) + 1);
+ LIBAVUTIL_VERSION = '49.4.1';
+ LIBAVUTIL_BUILD = LIBAVUTIL_VERSION_INT;
+
+type
+(**
+ * Pixel format. Notes:
+ *
+ * PIX_FMT_RGB32 is handled in an endian-specific manner. A RGBA
+ * color is put together as:
+ * (A << 24) | (R << 16) | (G << 8) | B
+ * This is stored as BGRA on little endian CPU architectures and ARGB on
+ * big endian CPUs.
+ *
+ * When the pixel format is palettized RGB (PIX_FMT_PAL8), the palettized
+ * image data is stored in AVFrame.data[0]. The palette is transported in
+ * AVFrame.data[1] and, is 1024 bytes long (256 4-byte entries) and is
+ * formatted the same as in PIX_FMT_RGB32 described above (i.e., it is
+ * also endian-specific). Note also that the individual RGB palette
+ * components stored in AVFrame.data[1] should be in the range 0..255.
+ * This is important as many custom PAL8 video codecs that were designed
+ * to run on the IBM VGA graphics adapter use 6-bit palette components.
+ *)
+
+ PAVPixelFormat = ^TAVPixelFormat;
+ TAVPixelFormat = (
+ PIX_FMT_NONE= -1,
+ PIX_FMT_YUV420P, ///< Planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples)
+ PIX_FMT_YUYV422, ///< Packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr
+ PIX_FMT_RGB24, ///< Packed RGB 8:8:8, 24bpp, RGBRGB...
+ PIX_FMT_BGR24, ///< Packed RGB 8:8:8, 24bpp, BGRBGR...
+ PIX_FMT_YUV422P, ///< Planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples)
+ PIX_FMT_YUV444P, ///< Planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples)
+ PIX_FMT_RGB32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in cpu endianness
+ PIX_FMT_YUV410P, ///< Planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples)
+ PIX_FMT_YUV411P, ///< Planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples)
+ PIX_FMT_RGB565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in cpu endianness
+ PIX_FMT_RGB555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in cpu endianness most significant bit to 1
+ PIX_FMT_GRAY8, ///< Y , 8bpp
+ PIX_FMT_MONOWHITE, ///< Y , 1bpp, 1 is white
+ PIX_FMT_MONOBLACK, ///< Y , 1bpp, 0 is black
+ PIX_FMT_PAL8, ///< 8 bit with PIX_FMT_RGB32 palette
+ PIX_FMT_YUVJ420P, ///< Planar YUV 4:2:0, 12bpp, full scale (jpeg)
+ PIX_FMT_YUVJ422P, ///< Planar YUV 4:2:2, 16bpp, full scale (jpeg)
+ PIX_FMT_YUVJ444P, ///< Planar YUV 4:4:4, 24bpp, full scale (jpeg)
+ PIX_FMT_XVMC_MPEG2_MC,///< XVideo Motion Acceleration via common packet passing(xvmc_render.h)
+ PIX_FMT_XVMC_MPEG2_IDCT,
+ PIX_FMT_UYVY422, ///< Packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1
+ PIX_FMT_UYYVYY411, ///< Packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3
+ PIX_FMT_BGR32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in cpu endianness
+ PIX_FMT_BGR565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in cpu endianness
+ PIX_FMT_BGR555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in cpu endianness most significant bit to 1
+ PIX_FMT_BGR8, ///< Packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb)
+ PIX_FMT_BGR4, ///< Packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb)
+ PIX_FMT_BGR4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb)
+ PIX_FMT_RGB8, ///< Packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb)
+ PIX_FMT_RGB4, ///< Packed RGB 1:2:1, 4bpp, (msb)2R 3G 3B(lsb)
+ PIX_FMT_RGB4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)2R 3G 3B(lsb)
+ PIX_FMT_NV12, ///< Planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV
+ PIX_FMT_NV21, ///< as above, but U and V bytes are swapped
+
+ PIX_FMT_RGB32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in cpu endianness
+ PIX_FMT_BGR32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in cpu endianness
+
+ PIX_FMT_NB, ///< number of pixel formats, DO NOT USE THIS if you want to link with shared libav* because the number of formats might differ between versions
+ PIX_FMT_FACKED = $FFFFF
+ );
+
+const
+{$ifdef WORDS_BIGENDIAN}
+ PIX_FMT_RGBA = PIX_FMT_RGB32_1;
+ PIX_FMT_BGRA = PIX_FMT_BGR32_1;
+ PIX_FMT_ARGB = PIX_FMT_RGB32;
+ PIX_FMT_ABGR = PIX_FMT_BGR32;
+{$else}
+ PIX_FMT_RGBA = PIX_FMT_BGR32;
+ PIX_FMT_BGRA = PIX_FMT_RGB32;
+ PIX_FMT_ARGB = PIX_FMT_BGR32_1;
+ PIX_FMT_ABGR = PIX_FMT_RGB32_1;
+{$endif}
+
+ PIX_FMT_UYVY411 = PIX_FMT_UYYVYY411;
+ PIX_FMT_RGBA32 = PIX_FMT_RGB32;
+ PIX_FMT_YUV422 = PIX_FMT_YUYV422;
+
+(* memory *)
+function av_malloc (size: cardinal): pointer;
+ cdecl; external av__util;
+
+function av_realloc (ptr: pointer; size: cardinal): pointer;
+ cdecl; external av__util;
+
+procedure av_free (ptr: pointer);
+ cdecl; external av__util;
+
+function av_mallocz (size: cardinal): pointer;
+ cdecl; external av__util;
+
+function av_strdup(const s: pchar): pchar;
+ cdecl; external av__util;
+
+procedure av_freep (ptr: pointer);
+ cdecl; external av__util;
+
+implementation
+
+end.
diff --git a/Game/Code/lib/ffmpeg/mmreg.pas b/Game/Code/lib/ffmpeg/mmreg.pas new file mode 100644 index 00000000..05e24eb0 --- /dev/null +++ b/Game/Code/lib/ffmpeg/mmreg.pas @@ -0,0 +1,1446 @@ +unit mmreg;
+
+interface
+
+uses
+ windows, mmsystem;
+
+(*++
+
+Copyright 1991-1998 Microsoft Corporation
+
+Module Name:
+
+ mmreg.h
+
+Abstract:
+
+ Multimedia Registration
+
+Revision History:
+
+ Translated to .pas - Zinetz Victor, Dec. 2005
+ mail@zinetz.info
+
+--*)
+
+// Define the following to skip definitions
+//
+// NOMMIDS Multimedia IDs are not defined
+// NONEWWAVE No new waveform types are defined except WAVEFORMATEX
+// NONEWRIFF No new RIFF forms are defined
+// NOJPEGDIB No JPEG DIB definitions
+// NONEWIC No new Image Compressor types are defined
+// NOBITMAP No extended bitmap info header definition
+
+(* manufacturer IDs *)
+const
+ MM_MICROSOFT = 1; //* Microsoft Corporation */
+ MM_CREATIVE = 2; //* Creative Labs, Inc */
+ MM_MEDIAVISION = 3; (* Media Vision, Inc. *)
+ MM_FUJITSU = 4; (* Fujitsu Corp. *)
+ MM_ARTISOFT = 20; (* Artisoft, Inc. *)
+ MM_TURTLE_BEACH = 21; (* Turtle Beach, Inc. *)
+ MM_IBM = 22; (* IBM Corporation *)
+ MM_VOCALTEC = 23; (* Vocaltec LTD. *)
+ MM_ROLAND = 24; (* Roland *)
+ MM_DSP_SOLUTIONS = 25; (* DSP Solutions, Inc. *)
+ MM_NEC = 26; (* NEC *)
+ MM_ATI = 27; (* ATI *)
+ MM_WANGLABS = 28; (* Wang Laboratories, Inc *)
+ MM_TANDY = 29; (* Tandy Corporation *)
+ MM_VOYETRA = 30; (* Voyetra *)
+ MM_ANTEX = 31; (* Antex Electronics Corporation *)
+ MM_ICL_PS = 32; (* ICL Personal Systems *)
+ MM_INTEL = 33; (* Intel Corporation *)
+ MM_GRAVIS = 34; (* Advanced Gravis *)
+ MM_VAL = 35; (* Video Associates Labs, Inc. *)
+ MM_INTERACTIVE = 36; (* InterActive Inc *)
+ MM_YAMAHA = 37; (* Yamaha Corporation of America *)
+ MM_EVEREX = 38; (* Everex Systems, Inc *)
+ MM_ECHO = 39; (* Echo Speech Corporation *)
+ MM_SIERRA = 40; (* Sierra Semiconductor Corp *)
+ MM_CAT = 41; (* Computer Aided Technologies *)
+ MM_APPS = 42; (* APPS Software International *)
+ MM_DSP_GROUP = 43; (* DSP Group, Inc *)
+ MM_MELABS = 44; (* microEngineering Labs *)
+ MM_COMPUTER_FRIENDS = 45; (* Computer Friends, Inc. *)
+ MM_ESS = 46; (* ESS Technology *)
+ MM_AUDIOFILE = 47; (* Audio, Inc. *)
+ MM_MOTOROLA = 48; (* Motorola, Inc. *)
+ MM_CANOPUS = 49; (* Canopus, co., Ltd. *)
+ MM_EPSON = 50; (* Seiko Epson Corporation *)
+ MM_TRUEVISION = 51; (* Truevision *)
+ MM_AZTECH = 52; (* Aztech Labs, Inc. *)
+ MM_VIDEOLOGIC = 53; (* Videologic *)
+ MM_SCALACS = 54; (* SCALACS *)
+ MM_KORG = 55; (* Korg Inc. *)
+ MM_APT = 56; (* Audio Processing Technology *)
+ MM_ICS = 57; (* Integrated Circuit Systems, Inc. *)
+ MM_ITERATEDSYS = 58; (* Iterated Systems, Inc. *)
+ MM_METHEUS = 59; (* Metheus *)
+ MM_LOGITECH = 60; (* Logitech, Inc. *)
+ MM_WINNOV = 61; (* Winnov, Inc. *)
+ MM_NCR = 62; (* NCR Corporation *)
+ MM_EXAN = 63; (* EXAN *)
+ MM_AST = 64; (* AST Research Inc. *)
+ MM_WILLOWPOND = 65; (* Willow Pond Corporation *)
+ MM_SONICFOUNDRY = 66; (* Sonic Foundry *)
+ MM_VITEC = 67; (* Vitec Multimedia *)
+ MM_MOSCOM = 68; (* MOSCOM Corporation *)
+ MM_SILICONSOFT = 69; (* Silicon Soft, Inc. *)
+ MM_SUPERMAC = 73; (* Supermac *)
+ MM_AUDIOPT = 74; (* Audio Processing Technology *)
+ MM_SPEECHCOMP = 76; (* Speech Compression *)
+ MM_AHEAD = 77; (* Ahead, Inc. *)
+ MM_DOLBY = 78; (* Dolby Laboratories *)
+ MM_OKI = 79; (* OKI *)
+ MM_AURAVISION = 80; (* AuraVision Corporation *)
+ MM_OLIVETTI = 81; (* Ing C. Olivetti & C., S.p.A. *)
+ MM_IOMAGIC = 82; (* I/O Magic Corporation *)
+ MM_MATSUSHITA = 83; (* Matsushita Electric Industrial Co., LTD. *)
+ MM_CONTROLRES = 84; (* Control Resources Limited *)
+ MM_XEBEC = 85; (* Xebec Multimedia Solutions Limited *)
+ MM_NEWMEDIA = 86; (* New Media Corporation *)
+ MM_NMS = 87; (* Natural MicroSystems *)
+ MM_LYRRUS = 88; (* Lyrrus Inc. *)
+ MM_COMPUSIC = 89; (* Compusic *)
+ MM_OPTI = 90; (* OPTi Computers Inc. *)
+ MM_ADLACC = 91; (* Adlib Accessories Inc. *)
+ MM_COMPAQ = 92; (* Compaq Computer Corp. *)
+ MM_DIALOGIC = 93; (* Dialogic Corporation *)
+ MM_INSOFT = 94; (* InSoft, Inc. *)
+ MM_MPTUS = 95; (* M.P. Technologies, Inc. *)
+ MM_WEITEK = 96; (* Weitek *)
+ MM_LERNOUT_AND_HAUSPIE = 97; (* Lernout & Hauspie *)
+ MM_QCIAR = 98; (* Quanta Computer Inc. *)
+ MM_APPLE = 99; (* Apple Computer, Inc. *)
+ MM_DIGITAL = 100; (* Digital Equipment Corporation *)
+ MM_MOTU = 101; (* Mark of the Unicorn *)
+ MM_WORKBIT = 102; (* Workbit Corporation *)
+ MM_OSITECH = 103; (* Ositech Communications Inc. *)
+ MM_MIRO = 104; (* miro Computer Products AG *)
+ MM_CIRRUSLOGIC = 105; (* Cirrus Logic *)
+ MM_ISOLUTION = 106; (* ISOLUTION B.V. *)
+ MM_HORIZONS = 107; (* Horizons Technology, Inc *)
+ MM_CONCEPTS = 108; (* Computer Concepts Ltd *)
+ MM_VTG = 109; (* Voice Technologies Group, Inc. *)
+ MM_RADIUS = 110; (* Radius *)
+ MM_ROCKWELL = 111; (* Rockwell International *)
+ MM_XYz = 112; (* Co. XYZ for testing *)
+ MM_OPCODE = 113; (* Opcode Systems *)
+ MM_VOXWARE = 114; (* Voxware Inc *)
+ MM_NORTHERN_TELECOM = 115; (* Northern Telecom Limited *)
+ MM_APICOM = 116; (* APICOM *)
+ MM_GRANDE = 117; (* Grande Software *)
+ MM_ADDX = 118; (* ADDX *)
+ MM_WILDCAT = 119; (* Wildcat Canyon Software *)
+ MM_RHETOREX = 120; (* Rhetorex Inc *)
+ MM_BROOKTREE = 121; (* Brooktree Corporation *)
+ MM_ENSONIQ = 125; (* ENSONIQ Corporation *)
+ MM_FAST = 126; (* ///FAST Multimedia AG *)
+ MM_NVIDIA = 127; (* NVidia Corporation *)
+ MM_OKSORI = 128; (* OKSORI Co., Ltd. *)
+ MM_DIACOUSTICS = 129; (* DiAcoustics, Inc. *)
+ MM_GULBRANSEN = 130; (* Gulbransen, Inc. *)
+ MM_KAY_ELEMETRICS = 131; (* Kay Elemetrics, Inc. *)
+ MM_CRYSTAL = 132; (* Crystal Semiconductor Corporation *)
+ MM_SPLASH_STUDIOS = 133; (* Splash Studios *)
+ MM_QUARTERDECK = 134; (* Quarterdeck Corporation *)
+ MM_TDK = 135; (* TDK Corporation *)
+ MM_DIGITAL_AUDIO_LABS = 136; (* Digital Audio Labs, Inc. *)
+ MM_SEERSYS = 137; (* Seer Systems, Inc. *)
+ MM_PICTURETEL = 138; (* PictureTel Corporation *)
+ MM_ATT_MICROELECTRONICS = 139; (* AT&T Microelectronics *)
+ MM_OSPREY = 140; (* Osprey Technologies, Inc. *)
+ MM_MEDIATRIX = 141; (* Mediatrix Peripherals *)
+ MM_SOUNDESIGNS = 142; (* SounDesignS M.C.S. Ltd. *)
+ MM_ALDIGITAL = 143; (* A.L. Digital Ltd. *)
+ MM_SPECTRUM_SIGNAL_PROCESSING= 144; (* Spectrum Signal Processing, Inc. *)
+ MM_ECS = 145; (* Electronic Courseware Systems, Inc. *)
+ MM_AMD = 146; (* AMD *)
+ MM_COREDYNAMICS = 147; (* Core Dynamics *)
+ MM_CANAM = 148; (* CANAM Computers *)
+ MM_SOFTSOUND = 149; (* Softsound, Ltd. *)
+ MM_NORRIS = 150; (* Norris Communications, Inc. *)
+ MM_DDD = 151; (* Danka Data Devices *)
+ MM_EUPHONICS = 152; (* EuPhonics *)
+ MM_PRECEPT = 153; (* Precept Software, Inc. *)
+ MM_CRYSTAL_NET = 154; (* Crystal Net Corporation *)
+ MM_CHROMATIC = 155; (* Chromatic Research, Inc *)
+ MM_VOICEINFO = 156; (* Voice Information Systems, Inc *)
+ MM_VIENNASYS = 157; (* Vienna Systems *)
+ MM_CONNECTIX = 158; (* Connectix Corporation *)
+ MM_GADGETLABS = 159; (* Gadget Labs LLC *)
+ MM_FRONTIER = 160; (* Frontier Design Group LLC *)
+ MM_VIONA = 161; (* Viona Development GmbH *)
+ MM_CASIO = 162; (* Casio Computer Co., LTD *)
+ MM_DIAMONDMM = 163; (* Diamond Multimedia *)
+ MM_S3 = 164; (* S3 *)
+ MM_FRAUNHOFER_IIS = 172; (* Fraunhofer *)
+
+(* MM_MICROSOFT product IDs *)
+
+ MM_MIDI_MAPPER = 1; (* Midi Mapper *)
+ MM_WAVE_MAPPER = 2; (* Wave Mapper *)
+ MM_SNDBLST_MIDIOUT = 3; (* Sound Blaster MIDI output port *)
+ MM_SNDBLST_MIDIIN = 4; (* Sound Blaster MIDI input port *)
+ MM_SNDBLST_SYNTH = 5; (* Sound Blaster internal synth *)
+ MM_SNDBLST_WAVEOUT = 6; (* Sound Blaster waveform output *)
+ MM_SNDBLST_WAVEIN = 7; (* Sound Blaster waveform input *)
+ MM_ADLIB = 9; (* Ad Lib Compatible synth *)
+ MM_MPU401_MIDIOUT = 10; (* MPU 401 compatible MIDI output port *)
+ MM_MPU401_MIDIIN = 11; (* MPU 401 compatible MIDI input port *)
+ MM_PC_JOYSTICK = 12; (* Joystick adapter *)
+
+ MM_PCSPEAKER_WAVEOUT = 13; (* PC speaker waveform output *)
+ MM_MSFT_WSS_WAVEIN = 14; (* MS Audio Board waveform input *)
+ MM_MSFT_WSS_WAVEOUT = 15; (* MS Audio Board waveform output *)
+ MM_MSFT_WSS_FMSYNTH_STEREO = 16; (* MS Audio Board Stereo FM synth *)
+ MM_MSFT_WSS_MIXER = 17; (* MS Audio Board Mixer Driver *)
+ MM_MSFT_WSS_OEM_WAVEIN = 18; (* MS OEM Audio Board waveform input *)
+ MM_MSFT_WSS_OEM_WAVEOUT = 19; (* MS OEM Audio Board waveform output *)
+ MM_MSFT_WSS_OEM_FMSYNTH_STEREO = 20; (* MS OEM Audio Board Stereo FM Synth *)
+ MM_MSFT_WSS_AUX = 21; (* MS Audio Board Aux. Port *)
+ MM_MSFT_WSS_OEM_AUX = 22; (* MS OEM Audio Aux Port *)
+ MM_MSFT_GENERIC_WAVEIN = 23; (* MS Vanilla driver waveform input *)
+ MM_MSFT_GENERIC_WAVEOUT = 24; (* MS Vanilla driver wavefrom output *)
+ MM_MSFT_GENERIC_MIDIIN = 25; (* MS Vanilla driver MIDI in *)
+ MM_MSFT_GENERIC_MIDIOUT = 26; (* MS Vanilla driver MIDI external out *)
+ MM_MSFT_GENERIC_MIDISYNTH = 27; (* MS Vanilla driver MIDI synthesizer *)
+ MM_MSFT_GENERIC_AUX_LINE = 28; (* MS Vanilla driver aux (line in) *)
+ MM_MSFT_GENERIC_AUX_MIC = 29; (* MS Vanilla driver aux (mic) *)
+ MM_MSFT_GENERIC_AUX_CD = 30; (* MS Vanilla driver aux (CD) *)
+ MM_MSFT_WSS_OEM_MIXER = 31; (* MS OEM Audio Board Mixer Driver *)
+ MM_MSFT_MSACM = 32; (* MS Audio Compression Manager *)
+ MM_MSFT_ACM_MSADPCM = 33; (* MS ADPCM Codec *)
+ MM_MSFT_ACM_IMAADPCM = 34; (* IMA ADPCM Codec *)
+ MM_MSFT_ACM_MSFILTER = 35; (* MS Filter *)
+ MM_MSFT_ACM_GSM610 = 36; (* GSM 610 codec *)
+ MM_MSFT_ACM_G711 = 37; (* G.711 codec *)
+ MM_MSFT_ACM_PCM = 38; (* PCM converter *)
+
+ // Microsoft Windows Sound System drivers
+
+ MM_WSS_SB16_WAVEIN = 39; (* Sound Blaster 16 waveform input *)
+ MM_WSS_SB16_WAVEOUT = 40; (* Sound Blaster 16 waveform output *)
+ MM_WSS_SB16_MIDIIN = 41; (* Sound Blaster 16 midi-in *)
+ MM_WSS_SB16_MIDIOUT = 42; (* Sound Blaster 16 midi out *)
+ MM_WSS_SB16_SYNTH = 43; (* Sound Blaster 16 FM Synthesis *)
+ MM_WSS_SB16_AUX_LINE = 44; (* Sound Blaster 16 aux (line in) *)
+ MM_WSS_SB16_AUX_CD = 45; (* Sound Blaster 16 aux (CD) *)
+ MM_WSS_SB16_MIXER = 46; (* Sound Blaster 16 mixer device *)
+ MM_WSS_SBPRO_WAVEIN = 47; (* Sound Blaster Pro waveform input *)
+ MM_WSS_SBPRO_WAVEOUT = 48; (* Sound Blaster Pro waveform output *)
+ MM_WSS_SBPRO_MIDIIN = 49; (* Sound Blaster Pro midi in *)
+ MM_WSS_SBPRO_MIDIOUT = 50; (* Sound Blaster Pro midi out *)
+ MM_WSS_SBPRO_SYNTH = 51; (* Sound Blaster Pro FM synthesis *)
+ MM_WSS_SBPRO_AUX_LINE = 52; (* Sound Blaster Pro aux (line in ) *)
+ MM_WSS_SBPRO_AUX_CD = 53; (* Sound Blaster Pro aux (CD) *)
+ MM_WSS_SBPRO_MIXER = 54; (* Sound Blaster Pro mixer *)
+
+ MM_MSFT_WSS_NT_WAVEIN = 55; (* WSS NT wave in *)
+ MM_MSFT_WSS_NT_WAVEOUT = 56; (* WSS NT wave out *)
+ MM_MSFT_WSS_NT_FMSYNTH_STEREO = 57; (* WSS NT FM synth *)
+ MM_MSFT_WSS_NT_MIXER = 58; (* WSS NT mixer *)
+ MM_MSFT_WSS_NT_AUX = 59; (* WSS NT aux *)
+
+ MM_MSFT_SB16_WAVEIN = 60; (* Sound Blaster 16 waveform input *)
+ MM_MSFT_SB16_WAVEOUT = 61; (* Sound Blaster 16 waveform output *)
+ MM_MSFT_SB16_MIDIIN = 62; (* Sound Blaster 16 midi-in *)
+ MM_MSFT_SB16_MIDIOUT = 63; (* Sound Blaster 16 midi out *)
+ MM_MSFT_SB16_SYNTH = 64; (* Sound Blaster 16 FM Synthesis *)
+ MM_MSFT_SB16_AUX_LINE = 65; (* Sound Blaster 16 aux (line in) *)
+ MM_MSFT_SB16_AUX_CD = 66; (* Sound Blaster 16 aux (CD) *)
+ MM_MSFT_SB16_MIXER = 67; (* Sound Blaster 16 mixer device *)
+ MM_MSFT_SBPRO_WAVEIN = 68; (* Sound Blaster Pro waveform input *)
+ MM_MSFT_SBPRO_WAVEOUT = 69; (* Sound Blaster Pro waveform output *)
+ MM_MSFT_SBPRO_MIDIIN = 70; (* Sound Blaster Pro midi in *)
+ MM_MSFT_SBPRO_MIDIOUT = 71; (* Sound Blaster Pro midi out *)
+ MM_MSFT_SBPRO_SYNTH = 72; (* Sound Blaster Pro FM synthesis *)
+ MM_MSFT_SBPRO_AUX_LINE = 73; (* Sound Blaster Pro aux (line in ) *)
+ MM_MSFT_SBPRO_AUX_CD = 74; (* Sound Blaster Pro aux (CD) *)
+ MM_MSFT_SBPRO_MIXER = 75; (* Sound Blaster Pro mixer *)
+
+ MM_MSFT_MSOPL_SYNTH = 76; (* Yamaha OPL2/OPL3 compatible FM synthesis *)
+
+ MM_MSFT_VMDMS_LINE_WAVEIN = 80; (* Voice Modem Serial Line Wave Input *)
+ MM_MSFT_VMDMS_LINE_WAVEOUT = 81; (* Voice Modem Serial Line Wave Output *)
+ MM_MSFT_VMDMS_HANDSET_WAVEIN = 82; (* Voice Modem Serial Handset Wave Input *)
+ MM_MSFT_VMDMS_HANDSET_WAVEOUT = 83; (* Voice Modem Serial Handset Wave Output *)
+ MM_MSFT_VMDMW_LINE_WAVEIN = 84; (* Voice Modem Wrapper Line Wave Input *)
+ MM_MSFT_VMDMW_LINE_WAVEOUT = 85; (* Voice Modem Wrapper Line Wave Output *)
+ MM_MSFT_VMDMW_HANDSET_WAVEIN = 86; (* Voice Modem Wrapper Handset Wave Input *)
+ MM_MSFT_VMDMW_HANDSET_WAVEOUT = 87; (* Voice Modem Wrapper Handset Wave Output *)
+ MM_MSFT_VMDMW_MIXER = 88; (* Voice Modem Wrapper Mixer *)
+ MM_MSFT_VMDM_GAME_WAVEOUT = 89; (* Voice Modem Game Compatible Wave Device *)
+ MM_MSFT_VMDM_GAME_WAVEIN = 90; (* Voice Modem Game Compatible Wave Device *)
+
+ MM_MSFT_ACM_MSNAUDIO = 91; (* *)
+ MM_MSFT_ACM_MSG723 = 92; (* *)
+
+ MM_MSFT_WDMAUDIO_WAVEOUT = 100; (* Generic id for WDM Audio drivers *)
+ MM_MSFT_WDMAUDIO_WAVEIN = 101; (* Generic id for WDM Audio drivers *)
+ MM_MSFT_WDMAUDIO_MIDIOUT = 102; (* Generic id for WDM Audio drivers *)
+ MM_MSFT_WDMAUDIO_MIDIIN = 103; (* Generic id for WDM Audio drivers *)
+ MM_MSFT_WDMAUDIO_MIXER = 104; (* Generic id for WDM Audio drivers *)
+
+
+(* MM_CREATIVE product IDs *)
+ MM_CREATIVE_SB15_WAVEIN = 1; (* SB (r) 1.5 waveform input *)
+ MM_CREATIVE_SB20_WAVEIN = 2;
+ MM_CREATIVE_SBPRO_WAVEIN = 3;
+ MM_CREATIVE_SBP16_WAVEIN = 4;
+ MM_CREATIVE_PHNBLST_WAVEIN = 5;
+ MM_CREATIVE_SB15_WAVEOUT = 101;
+ MM_CREATIVE_SB20_WAVEOUT = 102;
+ MM_CREATIVE_SBPRO_WAVEOUT = 103;
+ MM_CREATIVE_SBP16_WAVEOUT = 104;
+ MM_CREATIVE_PHNBLST_WAVEOUT = 105;
+ MM_CREATIVE_MIDIOUT = 201; (* SB (r) *)
+ MM_CREATIVE_MIDIIN = 202; (* SB (r) *)
+ MM_CREATIVE_FMSYNTH_MONO = 301; (* SB (r) *)
+ MM_CREATIVE_FMSYNTH_STEREO = 302; (* SB Pro (r) stereo synthesizer *)
+ MM_CREATIVE_MIDI_AWE32 = 303;
+ MM_CREATIVE_AUX_CD = 401; (* SB Pro (r) aux (CD) *)
+ MM_CREATIVE_AUX_LINE = 402; (* SB Pro (r) aux (Line in ) *)
+ MM_CREATIVE_AUX_MIC = 403; (* SB Pro (r) aux (mic) *)
+ MM_CREATIVE_AUX_MASTER = 404;
+ MM_CREATIVE_AUX_PCSPK = 405;
+ MM_CREATIVE_AUX_WAVE = 406;
+ MM_CREATIVE_AUX_MIDI = 407;
+ MM_CREATIVE_SBPRO_MIXER = 408;
+ MM_CREATIVE_SB16_MIXER = 409;
+
+(* MM_MEDIAVISION product IDs *)
+
+// Pro Audio Spectrum
+ MM_MEDIAVISION_PROAUDIO = $10;
+ MM_PROAUD_MIDIOUT = (MM_MEDIAVISION_PROAUDIO+1);
+ MM_PROAUD_MIDIIN = (MM_MEDIAVISION_PROAUDIO+2);
+ MM_PROAUD_SYNTH = (MM_MEDIAVISION_PROAUDIO+3);
+ MM_PROAUD_WAVEOUT = (MM_MEDIAVISION_PROAUDIO+4);
+ MM_PROAUD_WAVEIN = (MM_MEDIAVISION_PROAUDIO+5);
+ MM_PROAUD_MIXER = (MM_MEDIAVISION_PROAUDIO+6);
+ MM_PROAUD_AUX = (MM_MEDIAVISION_PROAUDIO+7);
+
+// Thunder Board
+ MM_MEDIAVISION_THUNDER = $20;
+ MM_THUNDER_SYNTH = (MM_MEDIAVISION_THUNDER+3);
+ MM_THUNDER_WAVEOUT = (MM_MEDIAVISION_THUNDER+4);
+ MM_THUNDER_WAVEIN = (MM_MEDIAVISION_THUNDER+5);
+ MM_THUNDER_AUX = (MM_MEDIAVISION_THUNDER+7);
+
+// Audio Port
+ MM_MEDIAVISION_TPORT = $40;
+ MM_TPORT_WAVEOUT = (MM_MEDIAVISION_TPORT+1);
+ MM_TPORT_WAVEIN = (MM_MEDIAVISION_TPORT+2);
+ MM_TPORT_SYNTH = (MM_MEDIAVISION_TPORT+3);
+
+// Pro Audio Spectrum Plus
+ MM_MEDIAVISION_PROAUDIO_PLUS = $50;
+ MM_PROAUD_PLUS_MIDIOUT = (MM_MEDIAVISION_PROAUDIO_PLUS+1);
+ MM_PROAUD_PLUS_MIDIIN = (MM_MEDIAVISION_PROAUDIO_PLUS+2);
+ MM_PROAUD_PLUS_SYNTH = (MM_MEDIAVISION_PROAUDIO_PLUS+3);
+ MM_PROAUD_PLUS_WAVEOUT = (MM_MEDIAVISION_PROAUDIO_PLUS+4);
+ MM_PROAUD_PLUS_WAVEIN = (MM_MEDIAVISION_PROAUDIO_PLUS+5);
+ MM_PROAUD_PLUS_MIXER = (MM_MEDIAVISION_PROAUDIO_PLUS+6);
+ MM_PROAUD_PLUS_AUX = (MM_MEDIAVISION_PROAUDIO_PLUS+7);
+
+// Pro Audio Spectrum 16
+ MM_MEDIAVISION_PROAUDIO_16 = $60;
+ MM_PROAUD_16_MIDIOUT = (MM_MEDIAVISION_PROAUDIO_16+1);
+ MM_PROAUD_16_MIDIIN = (MM_MEDIAVISION_PROAUDIO_16+2);
+ MM_PROAUD_16_SYNTH = (MM_MEDIAVISION_PROAUDIO_16+3);
+ MM_PROAUD_16_WAVEOUT = (MM_MEDIAVISION_PROAUDIO_16+4);
+ MM_PROAUD_16_WAVEIN = (MM_MEDIAVISION_PROAUDIO_16+5);
+ MM_PROAUD_16_MIXER = (MM_MEDIAVISION_PROAUDIO_16+6);
+ MM_PROAUD_16_AUX = (MM_MEDIAVISION_PROAUDIO_16+7);
+
+// Pro Audio Studio 16
+ MM_MEDIAVISION_PROSTUDIO_16 = $60;
+ MM_STUDIO_16_MIDIOUT = (MM_MEDIAVISION_PROSTUDIO_16+1);
+ MM_STUDIO_16_MIDIIN = (MM_MEDIAVISION_PROSTUDIO_16+2);
+ MM_STUDIO_16_SYNTH = (MM_MEDIAVISION_PROSTUDIO_16+3);
+ MM_STUDIO_16_WAVEOUT = (MM_MEDIAVISION_PROSTUDIO_16+4);
+ MM_STUDIO_16_WAVEIN = (MM_MEDIAVISION_PROSTUDIO_16+5);
+ MM_STUDIO_16_MIXER = (MM_MEDIAVISION_PROSTUDIO_16+6);
+ MM_STUDIO_16_AUX = (MM_MEDIAVISION_PROSTUDIO_16+7);
+
+// CDPC
+ MM_MEDIAVISION_CDPC = $70;
+ MM_CDPC_MIDIOUT = (MM_MEDIAVISION_CDPC+1);
+ MM_CDPC_MIDIIN = (MM_MEDIAVISION_CDPC+2);
+ MM_CDPC_SYNTH = (MM_MEDIAVISION_CDPC+3);
+ MM_CDPC_WAVEOUT = (MM_MEDIAVISION_CDPC+4);
+ MM_CDPC_WAVEIN = (MM_MEDIAVISION_CDPC+5);
+ MM_CDPC_MIXER = (MM_MEDIAVISION_CDPC+6);
+ MM_CDPC_AUX = (MM_MEDIAVISION_CDPC+7);
+
+// Opus MV 1208 Chipsent
+ MM_MEDIAVISION_OPUS1208 = $80;
+ MM_OPUS401_MIDIOUT = (MM_MEDIAVISION_OPUS1208+1);
+ MM_OPUS401_MIDIIN = (MM_MEDIAVISION_OPUS1208+2);
+ MM_OPUS1208_SYNTH = (MM_MEDIAVISION_OPUS1208+3);
+ MM_OPUS1208_WAVEOUT = (MM_MEDIAVISION_OPUS1208+4);
+ MM_OPUS1208_WAVEIN = (MM_MEDIAVISION_OPUS1208+5);
+ MM_OPUS1208_MIXER = (MM_MEDIAVISION_OPUS1208+6);
+ MM_OPUS1208_AUX = (MM_MEDIAVISION_OPUS1208+7);
+
+// Opus MV 1216 chipset
+ MM_MEDIAVISION_OPUS1216 = $90;
+ MM_OPUS1216_MIDIOUT = (MM_MEDIAVISION_OPUS1216+1);
+ MM_OPUS1216_MIDIIN = (MM_MEDIAVISION_OPUS1216+2);
+ MM_OPUS1216_SYNTH = (MM_MEDIAVISION_OPUS1216+3);
+ MM_OPUS1216_WAVEOUT = (MM_MEDIAVISION_OPUS1216+4);
+ MM_OPUS1216_WAVEIN = (MM_MEDIAVISION_OPUS1216+5);
+ MM_OPUS1216_MIXER = (MM_MEDIAVISION_OPUS1216+6);
+ MM_OPUS1216_AUX = (MM_MEDIAVISION_OPUS1216+7);
+
+(* MM_ARTISOFT product IDs *)
+ MM_ARTISOFT_SBWAVEIN = 1; (* Artisoft sounding Board waveform input *)
+ MM_ARTISOFT_SBWAVEOUT = 2; (* Artisoft sounding Board waveform output *)
+
+(* MM_IBM product IDs *)
+ MM_MMOTION_WAVEAUX = 1; (* IBM M-Motion Auxiliary Device *)
+ MM_MMOTION_WAVEOUT = 2; (* IBM M-Motion Waveform output *)
+ MM_MMOTION_WAVEIN = 3; (* IBM M-Motion Waveform Input *)
+ MM_IBM_PCMCIA_WAVEIN = 11; (* IBM waveform input *)
+ MM_IBM_PCMCIA_WAVEOUT = 12; (* IBM Waveform output *)
+ MM_IBM_PCMCIA_SYNTH = 13; (* IBM Midi Synthesis *)
+ MM_IBM_PCMCIA_MIDIIN = 14; (* IBM external MIDI in *)
+ MM_IBM_PCMCIA_MIDIOUT = 15; (* IBM external MIDI out *)
+ MM_IBM_PCMCIA_AUX = 16; (* IBM auxiliary control *)
+ MM_IBM_THINKPAD200 = 17;
+ MM_IBM_MWAVE_WAVEIN = 18;
+ MM_IBM_MWAVE_WAVEOUT = 19;
+ MM_IBM_MWAVE_MIXER = 20;
+ MM_IBM_MWAVE_MIDIIN = 21;
+ MM_IBM_MWAVE_MIDIOUT = 22;
+ MM_IBM_MWAVE_AUX = 23;
+ MM_IBM_WC_MIDIOUT = 30;
+ MM_IBM_WC_WAVEOUT = 31;
+ MM_IBM_WC_MIXEROUT = 33;
+
+(* MM_VOCALTEC product IDs *)
+ MM_VOCALTEC_WAVEOUT = 1;
+ MM_VOCALTEC_WAVEIN = 2;
+
+(* MM_ROLAND product IDs *)
+ MM_ROLAND_RAP10_MIDIOUT = 10; (* MM_ROLAND_RAP10 *)
+ MM_ROLAND_RAP10_MIDIIN = 11; (* MM_ROLAND_RAP10 *)
+ MM_ROLAND_RAP10_SYNTH = 12; (* MM_ROLAND_RAP10 *)
+ MM_ROLAND_RAP10_WAVEOUT = 13; (* MM_ROLAND_RAP10 *)
+ MM_ROLAND_RAP10_WAVEIN = 14; (* MM_ROLAND_RAP10 *)
+ MM_ROLAND_MPU401_MIDIOUT = 15;
+ MM_ROLAND_MPU401_MIDIIN = 16;
+ MM_ROLAND_SMPU_MIDIOUTA = 17;
+ MM_ROLAND_SMPU_MIDIOUTB = 18;
+ MM_ROLAND_SMPU_MIDIINA = 19;
+ MM_ROLAND_SMPU_MIDIINB = 20;
+ MM_ROLAND_SC7_MIDIOUT = 21;
+ MM_ROLAND_SC7_MIDIIN = 22;
+ MM_ROLAND_SERIAL_MIDIOUT = 23;
+ MM_ROLAND_SERIAL_MIDIIN = 24;
+ MM_ROLAND_SCP_MIDIOUT = 38;
+ MM_ROLAND_SCP_MIDIIN = 39;
+ MM_ROLAND_SCP_WAVEOUT = 40;
+ MM_ROLAND_SCP_WAVEIN = 41;
+ MM_ROLAND_SCP_MIXER = 42;
+ MM_ROLAND_SCP_AUX = 48;
+
+(* MM_DSP_SOLUTIONS product IDs *)
+ MM_DSP_SOLUTIONS_WAVEOUT = 1;
+ MM_DSP_SOLUTIONS_WAVEIN = 2;
+ MM_DSP_SOLUTIONS_SYNTH = 3;
+ MM_DSP_SOLUTIONS_AUX = 4;
+
+(* MM_WANGLABS product IDs *)
+ MM_WANGLABS_WAVEIN1 = 1; (* Input audio wave on CPU board models: Exec 4010, 4030, 3450; PC 251/25c, pc 461/25s , pc 461/33c *)
+ MM_WANGLABS_WAVEOUT1 = 2;
+
+(* MM_TANDY product IDs *)
+ MM_TANDY_VISWAVEIN = 1;
+ MM_TANDY_VISWAVEOUT = 2;
+ MM_TANDY_VISBIOSSYNTH = 3;
+ MM_TANDY_SENS_MMAWAVEIN = 4;
+ MM_TANDY_SENS_MMAWAVEOUT = 5;
+ MM_TANDY_SENS_MMAMIDIIN = 6;
+ MM_TANDY_SENS_MMAMIDIOUT = 7;
+ MM_TANDY_SENS_VISWAVEOUT = 8;
+ MM_TANDY_PSSJWAVEIN = 9;
+ MM_TANDY_PSSJWAVEOUT = 10;
+
+(* product IDs *)
+ MM_INTELOPD_WAVEIN = 1; (* HID2 WaveAudio Driver *)
+ MM_INTELOPD_WAVEOUT = 101; (* HID2 *)
+ MM_INTELOPD_AUX = 401; (* HID2 for mixing *)
+ MM_INTEL_NSPMODEMLINE = 501;
+
+(* MM_INTERACTIVE product IDs *)
+ MM_INTERACTIVE_WAVEIN = $45;
+ MM_INTERACTIVE_WAVEOUT = $45;
+
+(* MM_YAMAHA product IDs *)
+ MM_YAMAHA_GSS_SYNTH = $01;
+ MM_YAMAHA_GSS_WAVEOUT = $02;
+ MM_YAMAHA_GSS_WAVEIN = $03;
+ MM_YAMAHA_GSS_MIDIOUT = $04;
+ MM_YAMAHA_GSS_MIDIIN = $05;
+ MM_YAMAHA_GSS_AUX = $06;
+ MM_YAMAHA_SERIAL_MIDIOUT = $07;
+ MM_YAMAHA_SERIAL_MIDIIN = $08;
+ MM_YAMAHA_OPL3SA_WAVEOUT = $10;
+ MM_YAMAHA_OPL3SA_WAVEIN = $11;
+ MM_YAMAHA_OPL3SA_FMSYNTH = $12;
+ MM_YAMAHA_OPL3SA_YSYNTH = $13;
+ MM_YAMAHA_OPL3SA_MIDIOUT = $14;
+ MM_YAMAHA_OPL3SA_MIDIIN = $15;
+ MM_YAMAHA_OPL3SA_MIXER = $17;
+ MM_YAMAHA_OPL3SA_JOYSTICK = $18;
+
+(* MM_EVEREX product IDs *)
+ MM_EVEREX_CARRIER = $01;
+
+(* MM_ECHO product IDs *)
+ MM_ECHO_SYNTH = $01;
+ MM_ECHO_WAVEOUT = $02;
+ MM_ECHO_WAVEIN = $03;
+ MM_ECHO_MIDIOUT = $04;
+ MM_ECHO_MIDIIN = $05;
+ MM_ECHO_AUX = $06;
+
+(* MM_SIERRA product IDs *)
+ MM_SIERRA_ARIA_MIDIOUT = $14;
+ MM_SIERRA_ARIA_MIDIIN = $15;
+ MM_SIERRA_ARIA_SYNTH = $16;
+ MM_SIERRA_ARIA_WAVEOUT = $17;
+ MM_SIERRA_ARIA_WAVEIN = $18;
+ MM_SIERRA_ARIA_AUX = $19;
+ MM_SIERRA_ARIA_AUX2 = $20;
+ MM_SIERRA_QUARTET_WAVEIN = $50;
+ MM_SIERRA_QUARTET_WAVEOUT = $51;
+ MM_SIERRA_QUARTET_MIDIIN = $52;
+ MM_SIERRA_QUARTET_MIDIOUT = $53;
+ MM_SIERRA_QUARTET_SYNTH = $54;
+ MM_SIERRA_QUARTET_AUX_CD = $55;
+ MM_SIERRA_QUARTET_AUX_LINE = $56;
+ MM_SIERRA_QUARTET_AUX_MODEM = $57;
+ MM_SIERRA_QUARTET_MIXER = $58;
+
+(* MM_CAT product IDs *)
+ MM_CAT_WAVEOUT = 1;
+
+(* MM_DSP_GROUP product IDs *)
+ MM_DSP_GROUP_TRUESPEECH = $01;
+
+(* MM_MELABS product IDs *)
+ MM_MELABS_MIDI2GO = $01;
+
+(* MM_ESS product IDs *)
+ MM_ESS_AMWAVEOUT = $01;
+ MM_ESS_AMWAVEIN = $02;
+ MM_ESS_AMAUX = $03;
+ MM_ESS_AMSYNTH = $04;
+ MM_ESS_AMMIDIOUT = $05;
+ MM_ESS_AMMIDIIN = $06;
+ MM_ESS_MIXER = $07;
+ MM_ESS_AUX_CD = $08;
+ MM_ESS_MPU401_MIDIOUT = $09;
+ MM_ESS_MPU401_MIDIIN = $0A;
+ MM_ESS_ES488_WAVEOUT = $10;
+ MM_ESS_ES488_WAVEIN = $11;
+ MM_ESS_ES488_MIXER = $12;
+ MM_ESS_ES688_WAVEOUT = $13;
+ MM_ESS_ES688_WAVEIN = $14;
+ MM_ESS_ES688_MIXER = $15;
+ MM_ESS_ES1488_WAVEOUT = $16;
+ MM_ESS_ES1488_WAVEIN = $17;
+ MM_ESS_ES1488_MIXER = $18;
+ MM_ESS_ES1688_WAVEOUT = $19;
+ MM_ESS_ES1688_WAVEIN = $1A;
+ MM_ESS_ES1688_MIXER = $1B;
+ MM_ESS_ES1788_WAVEOUT = $1C;
+ MM_ESS_ES1788_WAVEIN = $1D;
+ MM_ESS_ES1788_MIXER = $1E;
+ MM_ESS_ES1888_WAVEOUT = $1F;
+ MM_ESS_ES1888_WAVEIN = $20;
+ MM_ESS_ES1888_MIXER = $21;
+ MM_ESS_ES1868_WAVEOUT = $22;
+ MM_ESS_ES1868_WAVEIN = $23;
+ MM_ESS_ES1868_MIXER = $24;
+ MM_ESS_ES1878_WAVEOUT = $25;
+ MM_ESS_ES1878_WAVEIN = $26;
+ MM_ESS_ES1878_MIXER = $27;
+
+(* product IDs *)
+ MM_EPS_FMSND = 1;
+
+(* MM_TRUEVISION product IDs *)
+ MM_TRUEVISION_WAVEIN1 = 1;
+ MM_TRUEVISION_WAVEOUT1 = 2;
+
+(* MM_AZTECH product IDs *)
+ MM_AZTECH_MIDIOUT = 3;
+ MM_AZTECH_MIDIIN = 4;
+ MM_AZTECH_WAVEIN = 17;
+ MM_AZTECH_WAVEOUT = 18;
+ MM_AZTECH_FMSYNTH = 20;
+ MM_AZTECH_MIXER = 21;
+ MM_AZTECH_PRO16_WAVEIN = 33;
+ MM_AZTECH_PRO16_WAVEOUT = 34;
+ MM_AZTECH_PRO16_FMSYNTH = 38;
+ MM_AZTECH_DSP16_WAVEIN = 65;
+ MM_AZTECH_DSP16_WAVEOUT = 66;
+ MM_AZTECH_DSP16_FMSYNTH = 68;
+ MM_AZTECH_DSP16_WAVESYNTH = 70;
+ MM_AZTECH_NOVA16_WAVEIN = 71;
+ MM_AZTECH_NOVA16_WAVEOUT = 72;
+ MM_AZTECH_NOVA16_MIXER = 73;
+ MM_AZTECH_WASH16_WAVEIN = 74;
+ MM_AZTECH_WASH16_WAVEOUT = 75;
+ MM_AZTECH_WASH16_MIXER = 76;
+ MM_AZTECH_AUX_CD = 401;
+ MM_AZTECH_AUX_LINE = 402;
+ MM_AZTECH_AUX_MIC = 403;
+ MM_AZTECH_AUX = 404;
+
+(* MM_VIDEOLOGIC product IDs *)
+ MM_VIDEOLOGIC_MSWAVEIN = 1;
+ MM_VIDEOLOGIC_MSWAVEOUT = 2;
+
+(* MM_KORG product IDs *)
+ MM_KORG_PCIF_MIDIOUT = 1;
+ MM_KORG_PCIF_MIDIIN = 2;
+
+(* MM_APT product IDs *)
+ MM_APT_ACE100CD = 1;
+
+(* MM_ICS product IDs *)
+ MM_ICS_WAVEDECK_WAVEOUT = 1; (* MS WSS compatible card and driver *)
+ MM_ICS_WAVEDECK_WAVEIN = 2;
+ MM_ICS_WAVEDECK_MIXER = 3;
+ MM_ICS_WAVEDECK_AUX = 4;
+ MM_ICS_WAVEDECK_SYNTH = 5;
+ MM_ICS_WAVEDEC_SB_WAVEOUT = 6;
+ MM_ICS_WAVEDEC_SB_WAVEIN = 7;
+ MM_ICS_WAVEDEC_SB_FM_MIDIOUT = 8;
+ MM_ICS_WAVEDEC_SB_MPU401_MIDIOUT = 9;
+ MM_ICS_WAVEDEC_SB_MPU401_MIDIIN = 10;
+ MM_ICS_WAVEDEC_SB_MIXER = 11;
+ MM_ICS_WAVEDEC_SB_AUX = 12;
+ MM_ICS_2115_LITE_MIDIOUT = 13;
+ MM_ICS_2120_LITE_MIDIOUT = 14;
+
+(* MM_ITERATEDSYS product IDs *)
+ MM_ITERATEDSYS_FUFCODEC = 1;
+
+(* MM_METHEUS product IDs *)
+ MM_METHEUS_ZIPPER = 1;
+
+(* MM_WINNOV product IDs *)
+ MM_WINNOV_CAVIAR_WAVEIN = 1;
+ MM_WINNOV_CAVIAR_WAVEOUT = 2;
+ MM_WINNOV_CAVIAR_VIDC = 3;
+ MM_WINNOV_CAVIAR_CHAMPAGNE = 4; (* Fourcc is CHAM *)
+ MM_WINNOV_CAVIAR_YUV8 = 5; (* Fourcc is YUV8 *)
+
+(* MM_NCR product IDs *)
+ MM_NCR_BA_WAVEIN = 1;
+ MM_NCR_BA_WAVEOUT = 2;
+ MM_NCR_BA_SYNTH = 3;
+ MM_NCR_BA_AUX = 4;
+ MM_NCR_BA_MIXER = 5;
+
+(* MM_VITEC product IDs *)
+ MM_VITEC_VMAKER = 1;
+ MM_VITEC_VMPRO = 2;
+
+(* MM_MOSCOM product IDs *)
+ MM_MOSCOM_VPC2400_IN = 1; (* Four Port Voice Processing / Voice Recognition Board *)
+ MM_MOSCOM_VPC2400_OUT = 2; (* VPC2400 *)
+
+(* MM_SILICONSOFT product IDs *)
+ MM_SILICONSOFT_SC1_WAVEIN = 1; (* Waveform in , high sample rate *)
+ MM_SILICONSOFT_SC1_WAVEOUT = 2; (* Waveform out , high sample rate *)
+ MM_SILICONSOFT_SC2_WAVEIN = 3; (* Waveform in 2 channels, high sample rate *)
+ MM_SILICONSOFT_SC2_WAVEOUT = 4; (* Waveform out 2 channels, high sample rate *)
+ MM_SILICONSOFT_SOUNDJR2_WAVEOUT = 5; (* Waveform out, self powered, efficient *)
+ MM_SILICONSOFT_SOUNDJR2PR_WAVEIN = 6; (* Waveform in, self powered, efficient *)
+ MM_SILICONSOFT_SOUNDJR2PR_WAVEOUT = 7; (* Waveform out 2 channels, self powered, efficient *)
+ MM_SILICONSOFT_SOUNDJR3_WAVEOUT = 8; (* Waveform in 2 channels, self powered, efficient *)
+
+(* MM_OLIVETTI product IDs *)
+ MM_OLIVETTI_WAVEIN = 1;
+ MM_OLIVETTI_WAVEOUT = 2;
+ MM_OLIVETTI_MIXER = 3;
+ MM_OLIVETTI_AUX = 4;
+ MM_OLIVETTI_MIDIIN = 5;
+ MM_OLIVETTI_MIDIOUT = 6;
+ MM_OLIVETTI_SYNTH = 7;
+ MM_OLIVETTI_JOYSTICK = 8;
+ MM_OLIVETTI_ACM_GSM = 9;
+ MM_OLIVETTI_ACM_ADPCM = 10;
+ MM_OLIVETTI_ACM_CELP = 11;
+ MM_OLIVETTI_ACM_SBC = 12;
+ MM_OLIVETTI_ACM_OPR = 13;
+
+(* MM_IOMAGIC product IDs *)
+
+(* The I/O Magic Tempo is a PCMCIA Type 2 audio card featuring wave audio
+ record and playback, FM synthesizer, and MIDI output. The I/O Magic
+ Tempo WaveOut device supports mono and stereo PCM playback at rates
+ of 7350, 11025, 22050, and 44100 samples *)
+
+ MM_IOMAGIC_TEMPO_WAVEOUT = 1;
+ MM_IOMAGIC_TEMPO_WAVEIN = 2;
+ MM_IOMAGIC_TEMPO_SYNTH = 3;
+ MM_IOMAGIC_TEMPO_MIDIOUT = 4;
+ MM_IOMAGIC_TEMPO_MXDOUT = 5;
+ MM_IOMAGIC_TEMPO_AUXOUT = 6;
+
+(* MM_MATSUSHITA product IDs *)
+ MM_MATSUSHITA_WAVEIN = 1;
+ MM_MATSUSHITA_WAVEOUT = 2;
+ MM_MATSUSHITA_FMSYNTH_STEREO = 3;
+ MM_MATSUSHITA_MIXER = 4;
+ MM_MATSUSHITA_AUX = 5;
+
+(* MM_NEWMEDIA product IDs *)
+ MM_NEWMEDIA_WAVJAMMER = 1; (* WSS Compatible sound card. *)
+
+(* MM_LYRRUS product IDs *)
+
+(* Bridge is a MIDI driver that allows the the Lyrrus G-VOX hardware to
+ communicate with Windows base transcription and sequencer applications.
+ The driver also provides a mechanism for the user to configure the system
+ to their personal playing style. *)
+
+ MM_LYRRUS_BRIDGE_GUITAR = 1;
+
+(* MM_OPTI product IDs *)
+ MM_OPTI_M16_FMSYNTH_STEREO = $0001;
+ MM_OPTI_M16_MIDIIN = $0002;
+ MM_OPTI_M16_MIDIOUT = $0003;
+ MM_OPTI_M16_WAVEIN = $0004;
+ MM_OPTI_M16_WAVEOUT = $0005;
+ MM_OPTI_M16_MIXER = $0006;
+ MM_OPTI_M16_AUX = $0007;
+ MM_OPTI_P16_FMSYNTH_STEREO = $0010;
+ MM_OPTI_P16_MIDIIN = $0011;
+ MM_OPTI_P16_MIDIOUT = $0012;
+ MM_OPTI_P16_WAVEIN = $0013;
+ MM_OPTI_P16_WAVEOUT = $0014;
+ MM_OPTI_P16_MIXER = $0015;
+ MM_OPTI_P16_AUX = $0016;
+ MM_OPTI_M32_WAVEIN = $0020;
+ MM_OPTI_M32_WAVEOUT = $0021;
+ MM_OPTI_M32_MIDIIN = $0022;
+ MM_OPTI_M32_MIDIOUT = $0023;
+ MM_OPTI_M32_SYNTH_STEREO = $0024;
+ MM_OPTI_M32_MIXER = $0025;
+ MM_OPTI_M32_AUX = $0026;
+
+(* Product IDs for MM_ADDX - ADDX *)
+ MM_ADDX_PCTV_DIGITALMIX = 1; (* MM_ADDX_PCTV_DIGITALMIX *)
+ MM_ADDX_PCTV_WAVEIN = 2; (* MM_ADDX_PCTV_WAVEIN *)
+ MM_ADDX_PCTV_WAVEOUT = 3; (* MM_ADDX_PCTV_WAVEOUT *)
+ MM_ADDX_PCTV_MIXER = 4; (* MM_ADDX_PCTV_MIXER *)
+ MM_ADDX_PCTV_AUX_CD = 5; (* MM_ADDX_PCTV_AUX_CD *)
+ MM_ADDX_PCTV_AUX_LINE = 6; (* MM_ADDX_PCTV_AUX_LINE *)
+
+(* Product IDs for MM_AHEAD - Ahead, Inc. *)
+ MM_AHEAD_MULTISOUND = 1;
+ MM_AHEAD_SOUNDBLASTER = 2;
+ MM_AHEAD_PROAUDIO = 3;
+ MM_AHEAD_GENERIC = 4;
+
+(* Product IDs for MM_AMD - AMD *)
+ MM_AMD_INTERWAVE_WAVEIN = 1;
+ MM_AMD_INTERWAVE_WAVEOUT = 2;
+ MM_AMD_INTERWAVE_SYNTH = 3;
+ MM_AMD_INTERWAVE_MIXER1 = 4;
+ MM_AMD_INTERWAVE_MIXER2 = 5;
+ MM_AMD_INTERWAVE_JOYSTICK = 6;
+ MM_AMD_INTERWAVE_EX_CD = 7;
+ MM_AMD_INTERWAVE_MIDIIN = 8;
+ MM_AMD_INTERWAVE_MIDIOUT = 9;
+ MM_AMD_INTERWAVE_AUX1 = 10;
+ MM_AMD_INTERWAVE_AUX2 = 11;
+ MM_AMD_INTERWAVE_AUX_MIC = 12;
+ MM_AMD_INTERWAVE_AUX_CD = 13;
+ MM_AMD_INTERWAVE_MONO_IN = 14;
+ MM_AMD_INTERWAVE_MONO_OUT = 15;
+ MM_AMD_INTERWAVE_EX_TELEPHONY = 16;
+ MM_AMD_INTERWAVE_WAVEOUT_BASE = 17;
+ MM_AMD_INTERWAVE_WAVEOUT_TREBLE = 18;
+ MM_AMD_INTERWAVE_STEREO_ENHANCED = 19;
+
+(* Product IDs for MM_AST - AST Research Inc. *)
+ MM_AST_MODEMWAVE_WAVEIN = 13;
+ MM_AST_MODEMWAVE_WAVEOUT = 14;
+
+(* Product IDs for MM_BROOKTREE - Brooktree Corporation *)
+ MM_BTV_WAVEIN = 1; (* Brooktree PCM Wave Audio In *)
+ MM_BTV_WAVEOUT = 2; (* Brooktree PCM Wave Audio Out *)
+ MM_BTV_MIDIIN = 3; (* Brooktree MIDI In *)
+ MM_BTV_MIDIOUT = 4; (* Brooktree MIDI out *)
+ MM_BTV_MIDISYNTH = 5; (* Brooktree MIDI FM synth *)
+ MM_BTV_AUX_LINE = 6; (* Brooktree Line Input *)
+ MM_BTV_AUX_MIC = 7; (* Brooktree Microphone Input *)
+ MM_BTV_AUX_CD = 8; (* Brooktree CD Input *)
+ MM_BTV_DIGITALIN = 9; (* Brooktree PCM Wave in with subcode information *)
+ MM_BTV_DIGITALOUT = 10; (* Brooktree PCM Wave out with subcode information *)
+ MM_BTV_MIDIWAVESTREAM = 11; (* Brooktree WaveStream *)
+ MM_BTV_MIXER = 12; (* Brooktree WSS Mixer driver *)
+
+(* Product IDs for MM_CANAM - CANAM Computers *)
+ MM_CANAM_CBXWAVEOUT = 1;
+ MM_CANAM_CBXWAVEIN = 2;
+
+(* Product IDs for MM_CASIO - Casio Computer Co., LTD *)
+ MM_CASIO_WP150_MIDIOUT = 1; (* wp150 *)
+ MM_CASIO_WP150_MIDIIN = 2;
+
+(* Product IDs for MM_COMPAQ - Compaq Computer Corp. *)
+ MM_COMPAQ_BB_WAVEIN = 1;
+ MM_COMPAQ_BB_WAVEOUT = 2;
+ MM_COMPAQ_BB_WAVEAUX = 3;
+
+(* Product IDs for MM_COREDYNAMICS - Core Dynamics *)
+ MM_COREDYNAMICS_DYNAMIXHR = 1; (* DynaMax Hi-Rez *)
+ MM_COREDYNAMICS_DYNASONIX_SYNTH = 2; (* DynaSonix *)
+ MM_COREDYNAMICS_DYNASONIX_MIDI_IN = 3;
+ MM_COREDYNAMICS_DYNASONIX_MIDI_OUT= 4;
+ MM_COREDYNAMICS_DYNASONIX_WAVE_IN = 5;
+ MM_COREDYNAMICS_DYNASONIX_WAVE_OUT= 6;
+ MM_COREDYNAMICS_DYNASONIX_AUDIO_IN= 7;
+ MM_COREDYNAMICS_DYNASONIX_AUDIO_OUT = 8;
+ MM_COREDYNAMICS_DYNAGRAFX_VGA = 9; (* DynaGrfx *)
+ MM_COREDYNAMICS_DYNAGRAFX_WAVE_IN = 10;
+ MM_COREDYNAMICS_DYNAGRAFX_WAVE_OUT= 11;
+
+(* Product IDs for MM_CRYSTAL - Crystal Semiconductor Corporation *)
+ MM_CRYSTAL_CS4232_WAVEIN = 1;
+ MM_CRYSTAL_CS4232_WAVEOUT = 2;
+ MM_CRYSTAL_CS4232_WAVEMIXER = 3;
+ MM_CRYSTAL_CS4232_WAVEAUX_AUX1 = 4;
+ MM_CRYSTAL_CS4232_WAVEAUX_AUX2 = 5;
+ MM_CRYSTAL_CS4232_WAVEAUX_LINE = 6;
+ MM_CRYSTAL_CS4232_WAVEAUX_MONO = 7;
+ MM_CRYSTAL_CS4232_WAVEAUX_MASTER = 8;
+ MM_CRYSTAL_CS4232_MIDIIN = 9;
+ MM_CRYSTAL_CS4232_MIDIOUT = 10;
+ MM_CRYSTAL_CS4232_INPUTGAIN_AUX1 = 13;
+ MM_CRYSTAL_CS4232_INPUTGAIN_LOOP = 14;
+
+(* Product IDs for MM_DDD - Danka Data Devices *)
+ MM_DDD_MIDILINK_MIDIIN = 1;
+ MM_DDD_MIDILINK_MIDIOUT = 2;
+
+(* Product IDs for MM_DIACOUSTICS - DiAcoustics, Inc. *)
+ MM_DIACOUSTICS_DRUM_ACTION = 1; (* Drum Action *)
+
+(* Product IDs for MM_DIAMONDMM - Diamond Multimedia *)
+ MM_DIMD_PLATFORM = 0; (* Freedom Audio *)
+ MM_DIMD_DIRSOUND = 1;
+ MM_DIMD_VIRTMPU = 2;
+ MM_DIMD_VIRTSB = 3;
+ MM_DIMD_VIRTJOY = 4;
+ MM_DIMD_WAVEIN = 5;
+ MM_DIMD_WAVEOUT = 6;
+ MM_DIMD_MIDIIN = 7;
+ MM_DIMD_MIDIOUT = 8;
+ MM_DIMD_AUX_LINE = 9;
+ MM_DIMD_MIXER = 10;
+
+(* Product IDs for MM_DIGITAL_AUDIO_LABS - Digital Audio Labs, Inc. *)
+ MM_DIGITAL_AUDIO_LABS_V8 = $10;
+ MM_DIGITAL_AUDIO_LABS_CPRO = $11;
+
+(* Product IDs for MM_DIGITAL - Digital Equipment Corporation *)
+ MM_DIGITAL_AV320_WAVEIN = 1; (* Digital Audio Video Compression Board *)
+ MM_DIGITAL_AV320_WAVEOUT = 2; (* Digital Audio Video Compression Board *)
+
+(* Product IDs for MM_ECS - Electronic Courseware Systems, Inc. *)
+ MM_ECS_AADF_MIDI_IN = 10;
+ MM_ECS_AADF_MIDI_OUT = 11;
+ MM_ECS_AADF_WAVE2MIDI_IN = 12;
+
+(* Product IDs for MM_ENSONIQ - ENSONIQ Corporation *)
+ MM_ENSONIQ_SOUNDSCAPE = $10; (* ENSONIQ Soundscape *)
+ MM_SOUNDSCAPE_WAVEOUT = MM_ENSONIQ_SOUNDSCAPE+1;
+ MM_SOUNDSCAPE_WAVEOUT_AUX = MM_ENSONIQ_SOUNDSCAPE+2;
+ MM_SOUNDSCAPE_WAVEIN = MM_ENSONIQ_SOUNDSCAPE+3;
+ MM_SOUNDSCAPE_MIDIOUT = MM_ENSONIQ_SOUNDSCAPE+4;
+ MM_SOUNDSCAPE_MIDIIN = MM_ENSONIQ_SOUNDSCAPE+5;
+ MM_SOUNDSCAPE_SYNTH = MM_ENSONIQ_SOUNDSCAPE+6;
+ MM_SOUNDSCAPE_MIXER = MM_ENSONIQ_SOUNDSCAPE+7;
+ MM_SOUNDSCAPE_AUX = MM_ENSONIQ_SOUNDSCAPE+8;
+
+(* Product IDs for MM_FRONTIER - Frontier Design Group LLC *)
+ MM_FRONTIER_WAVECENTER_MIDIIN = 1; (* WaveCenter *)
+ MM_FRONTIER_WAVECENTER_MIDIOUT = 2;
+ MM_FRONTIER_WAVECENTER_WAVEIN = 3;
+ MM_FRONTIER_WAVECENTER_WAVEOUT = 4;
+
+(* Product IDs for MM_GADGETLABS - Gadget Labs LLC *)
+ MM_GADGETLABS_WAVE44_WAVEIN = 1;
+ MM_GADGETLABS_WAVE44_WAVEOUT = 2;
+ MM_GADGETLABS_WAVE42_WAVEIN = 3;
+ MM_GADGETLABS_WAVE42_WAVEOUT = 4;
+ MM_GADGETLABS_WAVE4_MIDIIN = 5;
+ MM_GADGETLABS_WAVE4_MIDIOUT = 6;
+
+(* Product IDs for MM_KAY_ELEMETRICS - Kay Elemetrics, Inc. *)
+ MM_KAY_ELEMETRICS_CSL = $4300;
+ MM_KAY_ELEMETRICS_CSL_DAT = $4308;
+ MM_KAY_ELEMETRICS_CSL_4CHANNEL = $4309;
+
+(* Product IDs for MM_LERNOUT_AND_HAUSPIE - Lernout & Hauspie *)
+ MM_LERNOUT_ANDHAUSPIE_LHCODECACM = 1;
+
+(* Product IDs for MM_MPTUS - M.P. Technologies, Inc. *)
+ MM_MPTUS_SPWAVEOUT = 1; (* Sound Pallette *)
+
+(* Product IDs for MM_MOTU - Mark of the Unicorn *)
+ MM_MOTU_MTP_MIDIOUT_ALL = 100;
+ MM_MOTU_MTP_MIDIIN_1 = 101;
+ MM_MOTU_MTP_MIDIOUT_1 = 101;
+ MM_MOTU_MTP_MIDIIN_2 = 102;
+ MM_MOTU_MTP_MIDIOUT_2 = 102;
+ MM_MOTU_MTP_MIDIIN_3 = 103;
+ MM_MOTU_MTP_MIDIOUT_3 = 103;
+ MM_MOTU_MTP_MIDIIN_4 = 104;
+ MM_MOTU_MTP_MIDIOUT_4 = 104;
+ MM_MOTU_MTP_MIDIIN_5 = 105;
+ MM_MOTU_MTP_MIDIOUT_5 = 105;
+ MM_MOTU_MTP_MIDIIN_6 = 106;
+ MM_MOTU_MTP_MIDIOUT_6 = 106;
+ MM_MOTU_MTP_MIDIIN_7 = 107;
+ MM_MOTU_MTP_MIDIOUT_7 = 107;
+ MM_MOTU_MTP_MIDIIN_8 = 108;
+ MM_MOTU_MTP_MIDIOUT_8 = 108;
+
+ MM_MOTU_MTPII_MIDIOUT_ALL = 200;
+ MM_MOTU_MTPII_MIDIIN_SYNC = 200;
+ MM_MOTU_MTPII_MIDIIN_1 = 201;
+ MM_MOTU_MTPII_MIDIOUT_1 = 201;
+ MM_MOTU_MTPII_MIDIIN_2 = 202;
+ MM_MOTU_MTPII_MIDIOUT_2 = 202;
+ MM_MOTU_MTPII_MIDIIN_3 = 203;
+ MM_MOTU_MTPII_MIDIOUT_3 = 203;
+ MM_MOTU_MTPII_MIDIIN_4 = 204;
+ MM_MOTU_MTPII_MIDIOUT_4 = 204;
+ MM_MOTU_MTPII_MIDIIN_5 = 205;
+ MM_MOTU_MTPII_MIDIOUT_5 = 205;
+ MM_MOTU_MTPII_MIDIIN_6 = 206;
+ MM_MOTU_MTPII_MIDIOUT_6 = 206;
+ MM_MOTU_MTPII_MIDIIN_7 = 207;
+ MM_MOTU_MTPII_MIDIOUT_7 = 207;
+ MM_MOTU_MTPII_MIDIIN_8 = 208;
+ MM_MOTU_MTPII_MIDIOUT_8 = 208;
+ MM_MOTU_MTPII_NET_MIDIIN_1 = 209;
+ MM_MOTU_MTPII_NET_MIDIOUT_1 = 209;
+ MM_MOTU_MTPII_NET_MIDIIN_2 = 210;
+ MM_MOTU_MTPII_NET_MIDIOUT_2 = 210;
+ MM_MOTU_MTPII_NET_MIDIIN_3 = 211;
+ MM_MOTU_MTPII_NET_MIDIOUT_3 = 211;
+ MM_MOTU_MTPII_NET_MIDIIN_4 = 212;
+ MM_MOTU_MTPII_NET_MIDIOUT_4 = 212;
+ MM_MOTU_MTPII_NET_MIDIIN_5 = 213;
+ MM_MOTU_MTPII_NET_MIDIOUT_5 = 213;
+ MM_MOTU_MTPII_NET_MIDIIN_6 = 214;
+ MM_MOTU_MTPII_NET_MIDIOUT_6 = 214;
+ MM_MOTU_MTPII_NET_MIDIIN_7 = 215;
+ MM_MOTU_MTPII_NET_MIDIOUT_7 = 215;
+ MM_MOTU_MTPII_NET_MIDIIN_8 = 216;
+ MM_MOTU_MTPII_NET_MIDIOUT_8 = 216;
+
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_ALL = 300;
+ MM_MOTU_MXP_MIDIIN_SYNC = 300;
+ MM_MOTU_MXP_MIDIIN_MIDIIN_1 = 301;
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_1 = 301;
+ MM_MOTU_MXP_MIDIIN_MIDIIN_2 = 302;
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_2 = 302;
+ MM_MOTU_MXP_MIDIIN_MIDIIN_3 = 303;
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_3 = 303;
+ MM_MOTU_MXP_MIDIIN_MIDIIN_4 = 304;
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_4 = 304;
+ MM_MOTU_MXP_MIDIIN_MIDIIN_5 = 305;
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_5 = 305;
+ MM_MOTU_MXP_MIDIIN_MIDIIN_6 = 306;
+ MM_MOTU_MXP_MIDIIN_MIDIOUT_6 = 306;
+
+ MM_MOTU_MXPMPU_MIDIOUT_ALL = 400;
+ MM_MOTU_MXPMPU_MIDIIN_SYNC = 400;
+ MM_MOTU_MXPMPU_MIDIIN_1 = 401;
+ MM_MOTU_MXPMPU_MIDIOUT_1 = 401;
+ MM_MOTU_MXPMPU_MIDIIN_2 = 402;
+ MM_MOTU_MXPMPU_MIDIOUT_2 = 402;
+ MM_MOTU_MXPMPU_MIDIIN_3 = 403;
+ MM_MOTU_MXPMPU_MIDIOUT_3 = 403;
+ MM_MOTU_MXPMPU_MIDIIN_4 = 404;
+ MM_MOTU_MXPMPU_MIDIOUT_4 = 404;
+ MM_MOTU_MXPMPU_MIDIIN_5 = 405;
+ MM_MOTU_MXPMPU_MIDIOUT_5 = 405;
+ MM_MOTU_MXPMPU_MIDIIN_6 = 406;
+ MM_MOTU_MXPMPU_MIDIOUT_6 = 406;
+
+ MM_MOTU_MXN_MIDIOUT_ALL = 500;
+ MM_MOTU_MXN_MIDIIN_SYNC = 500;
+ MM_MOTU_MXN_MIDIIN_1 = 501;
+ MM_MOTU_MXN_MIDIOUT_1 = 501;
+ MM_MOTU_MXN_MIDIIN_2 = 502;
+ MM_MOTU_MXN_MIDIOUT_2 = 502;
+ MM_MOTU_MXN_MIDIIN_3 = 503;
+ MM_MOTU_MXN_MIDIOUT_3 = 503;
+ MM_MOTU_MXN_MIDIIN_4 = 504;
+ MM_MOTU_MXN_MIDIOUT_4 = 504;
+
+ MM_MOTU_FLYER_MIDI_IN_SYNC = 600;
+ MM_MOTU_FLYER_MIDI_IN_A = 601;
+ MM_MOTU_FLYER_MIDI_OUT_A = 601;
+ MM_MOTU_FLYER_MIDI_IN_B = 602;
+ MM_MOTU_FLYER_MIDI_OUT_B = 602;
+
+ MM_MOTU_PKX_MIDI_IN_SYNC = 700;
+ MM_MOTU_PKX_MIDI_IN_A = 701;
+ MM_MOTU_PKX_MIDI_OUT_A = 701;
+ MM_MOTU_PKX_MIDI_IN_B = 702;
+ MM_MOTU_PKX_MIDI_OUT_B = 702;
+
+ MM_MOTU_DTX_MIDI_IN_SYNC = 800;
+ MM_MOTU_DTX_MIDI_IN_A = 801;
+ MM_MOTU_DTX_MIDI_OUT_A = 801;
+ MM_MOTU_DTX_MIDI_IN_B = 802;
+ MM_MOTU_DTX_MIDI_OUT_B = 802;
+
+ MM_MOTU_MTPAV_MIDIOUT_ALL = 900;
+ MM_MOTU_MTPAV_MIDIIN_SYNC = 900;
+ MM_MOTU_MTPAV_MIDIIN_1 = 901;
+ MM_MOTU_MTPAV_MIDIOUT_1 = 901;
+ MM_MOTU_MTPAV_MIDIIN_2 = 902;
+ MM_MOTU_MTPAV_MIDIOUT_2 = 902;
+ MM_MOTU_MTPAV_MIDIIN_3 = 903;
+ MM_MOTU_MTPAV_MIDIOUT_3 = 903;
+ MM_MOTU_MTPAV_MIDIIN_4 = 904;
+ MM_MOTU_MTPAV_MIDIOUT_4 = 904;
+ MM_MOTU_MTPAV_MIDIIN_5 = 905;
+ MM_MOTU_MTPAV_MIDIOUT_5 = 905;
+ MM_MOTU_MTPAV_MIDIIN_6 = 906;
+ MM_MOTU_MTPAV_MIDIOUT_6 = 906;
+ MM_MOTU_MTPAV_MIDIIN_7 = 907;
+ MM_MOTU_MTPAV_MIDIOUT_7 = 907;
+ MM_MOTU_MTPAV_MIDIIN_8 = 908;
+ MM_MOTU_MTPAV_MIDIOUT_8 = 908;
+ MM_MOTU_MTPAV_NET_MIDIIN_1 = 909;
+ MM_MOTU_MTPAV_NET_MIDIOUT_1 = 909;
+ MM_MOTU_MTPAV_NET_MIDIIN_2 = 910;
+ MM_MOTU_MTPAV_NET_MIDIOUT_2 = 910;
+ MM_MOTU_MTPAV_NET_MIDIIN_3 = 911;
+ MM_MOTU_MTPAV_NET_MIDIOUT_3 = 911;
+ MM_MOTU_MTPAV_NET_MIDIIN_4 = 912;
+ MM_MOTU_MTPAV_NET_MIDIOUT_4 = 912;
+ MM_MOTU_MTPAV_NET_MIDIIN_5 = 913;
+ MM_MOTU_MTPAV_NET_MIDIOUT_5 = 913;
+ MM_MOTU_MTPAV_NET_MIDIIN_6 = 914;
+ MM_MOTU_MTPAV_NET_MIDIOUT_6 = 914;
+ MM_MOTU_MTPAV_NET_MIDIIN_7 = 915;
+ MM_MOTU_MTPAV_NET_MIDIOUT_7 = 915;
+ MM_MOTU_MTPAV_NET_MIDIIN_8 = 916;
+ MM_MOTU_MTPAV_NET_MIDIOUT_8 = 916;
+ MM_MOTU_MTPAV_MIDIIN_ADAT = 917;
+ MM_MOTU_MTPAV_MIDIOUT_ADAT = 917;
+
+
+(* Product IDs for MM_MIRO - miro Computer Products AG *)
+ MM_MIRO_MOVIEPRO = 1; (* miroMOVIE pro *)
+ MM_MIRO_VIDEOD1 = 2; (* miroVIDEO D1 *)
+ MM_MIRO_VIDEODC1TV = 3; (* miroVIDEO DC1 tv *)
+ MM_MIRO_VIDEOTD = 4; (* miroVIDEO 10/20 TD *)
+ MM_MIRO_DC30_WAVEOUT = 5;
+ MM_MIRO_DC30_WAVEIN = 6;
+ MM_MIRO_DC30_MIX = 7;
+
+(* Product IDs for MM_NEC - NEC *)
+ MM_NEC_73_86_SYNTH = 5;
+ MM_NEC_73_86_WAVEOUT = 6;
+ MM_NEC_73_86_WAVEIN = 7;
+ MM_NEC_26_SYNTH = 9;
+ MM_NEC_MPU401_MIDIOUT = 10;
+ MM_NEC_MPU401_MIDIIN = 11;
+ MM_NEC_JOYSTICK = 12;
+
+(* Product IDs for MM_NORRIS - Norris Communications, Inc. *)
+ MM_NORRIS_VOICELINK = 1;
+
+(* Product IDs for MM_NORTHERN_TELECOM - Northern Telecom Limited *)
+ MM_NORTEL_MPXAC_WAVEIN = 1; (* MPX Audio Card Wave Input Device *)
+ MM_NORTEL_MPXAC_WAVEOUT = 2; (* MPX Audio Card Wave Output Device *)
+
+(* Product IDs for MM_NVIDIA - NVidia Corporation *)
+ MM_NVIDIA_WAVEOUT = 1;
+ MM_NVIDIA_WAVEIN = 2;
+ MM_NVIDIA_MIDIOUT = 3;
+ MM_NVIDIA_MIDIIN = 4;
+ MM_NVIDIA_GAMEPORT = 5;
+ MM_NVIDIA_MIXER = 6;
+ MM_NVIDIA_AUX = 7;
+
+(* Product IDs for MM_OKSORI - OKSORI Co., Ltd. *)
+ MM_OKSORI_BASE = 0; (* Oksori Base *)
+ MM_OKSORI_OSR8_WAVEOUT = MM_OKSORI_BASE+1; (* Oksori 8bit Wave out *)
+ MM_OKSORI_OSR8_WAVEIN = MM_OKSORI_BASE+2; (* Oksori 8bit Wave in *)
+ MM_OKSORI_OSR16_WAVEOUT = MM_OKSORI_BASE+3; (* Oksori 16 bit Wave out *)
+ MM_OKSORI_OSR16_WAVEIN = MM_OKSORI_BASE+4; (* Oksori 16 bit Wave in *)
+ MM_OKSORI_FM_OPL4 = MM_OKSORI_BASE+5; (* Oksori FM Synth Yamaha OPL4 *)
+ MM_OKSORI_MIX_MASTER = MM_OKSORI_BASE+6; (* Oksori DSP Mixer - Master Volume *)
+ MM_OKSORI_MIX_WAVE = MM_OKSORI_BASE+7; (* Oksori DSP Mixer - Wave Volume *)
+ MM_OKSORI_MIX_FM = MM_OKSORI_BASE+8; (* Oksori DSP Mixer - FM Volume *)
+ MM_OKSORI_MIX_LINE = MM_OKSORI_BASE+9; (* Oksori DSP Mixer - Line Volume *)
+ MM_OKSORI_MIX_CD = MM_OKSORI_BASE+10; (* Oksori DSP Mixer - CD Volume *)
+ MM_OKSORI_MIX_MIC = MM_OKSORI_BASE+11; (* Oksori DSP Mixer - MIC Volume *)
+ MM_OKSORI_MIX_ECHO = MM_OKSORI_BASE+12; (* Oksori DSP Mixer - Echo Volume *)
+ MM_OKSORI_MIX_AUX1 = MM_OKSORI_BASE+13; (* Oksori AD1848 - AUX1 Volume *)
+ MM_OKSORI_MIX_LINE1 = MM_OKSORI_BASE+14; (* Oksori AD1848 - LINE1 Volume *)
+ MM_OKSORI_EXT_MIC1 = MM_OKSORI_BASE+15; (* Oksori External - One Mic Connect *)
+ MM_OKSORI_EXT_MIC2 = MM_OKSORI_BASE+16; (* Oksori External - Two Mic Connect *)
+ MM_OKSORI_MIDIOUT = MM_OKSORI_BASE+17; (* Oksori MIDI Out Device *)
+ MM_OKSORI_MIDIIN = MM_OKSORI_BASE+18; (* Oksori MIDI In Device *)
+ MM_OKSORI_MPEG_CDVISION = MM_OKSORI_BASE+19; (* Oksori CD-Vision MPEG Decoder *)
+
+(* Product IDs for MM_OSITECH - Ositech Communications Inc. *)
+ MM_OSITECH_TRUMPCARD = 1; (* Trumpcard *)
+
+(* Product IDs for MM_OSPREY - Osprey Technologies, Inc. *)
+ MM_OSPREY_1000WAVEIN = 1;
+ MM_OSPREY_1000WAVEOUT = 2;
+
+(* Product IDs for MM_QUARTERDECK - Quarterdeck Corporation *)
+ MM_QUARTERDECK_LHWAVEIN = 0; (* Quarterdeck L&H Codec Wave In *)
+ MM_QUARTERDECK_LHWAVEOUT = 1; (* Quarterdeck L&H Codec Wave Out *)
+
+(* Product IDs for MM_RHETOREX - Rhetorex Inc *)
+ MM_RHETOREX_WAVEIN = 1;
+ MM_RHETOREX_WAVEOUT = 2;
+
+(* Product IDs for MM_ROCKWELL - Rockwell International *)
+ MM_VOICEMIXER = 1;
+ ROCKWELL_WA1_WAVEIN = 100;
+ ROCKWELL_WA1_WAVEOUT = 101;
+ ROCKWELL_WA1_SYNTH = 102;
+ ROCKWELL_WA1_MIXER = 103;
+ ROCKWELL_WA1_MPU401_IN = 104;
+ ROCKWELL_WA1_MPU401_OUT = 105;
+ ROCKWELL_WA2_WAVEIN = 200;
+ ROCKWELL_WA2_WAVEOUT = 201;
+ ROCKWELL_WA2_SYNTH = 202;
+ ROCKWELL_WA2_MIXER = 203;
+ ROCKWELL_WA2_MPU401_IN = 204;
+ ROCKWELL_WA2_MPU401_OUT = 205;
+
+(* Product IDs for MM_S3 - S3 *)
+ MM_S3_WAVEOUT = $1;
+ MM_S3_WAVEIN = $2;
+ MM_S3_MIDIOUT = $3;
+ MM_S3_MIDIIN = $4;
+ MM_S3_FMSYNTH = $5;
+ MM_S3_MIXER = $6;
+ MM_S3_AUX = $7;
+
+(* Product IDs for MM_SEERSYS - Seer Systems, Inc. *)
+ MM_SEERSYS_SEERSYNTH = 1;
+ MM_SEERSYS_SEERWAVE = 2;
+ MM_SEERSYS_SEERMIX = 3;
+
+(* Product IDs for MM_SOFTSOUND - Softsound, Ltd. *)
+ MM_SOFTSOUND_CODEC = 1;
+
+(* Product IDs for MM_SOUNDESIGNS - SounDesignS M.C.S. Ltd. *)
+ MM_SOUNDESIGNS_WAVEIN = 1;
+ MM_SOUNDESIGNS_WAVEOUT = 2;
+
+(* Product IDs for MM_SPECTRUM_SIGNAL_PROCESSING - Spectrum Signal Processing, Inc. *)
+ MM_SSP_SNDFESWAVEIN = 1; (* Sound Festa Wave In Device *)
+ MM_SSP_SNDFESWAVEOUT = 2; (* Sound Festa Wave Out Device *)
+ MM_SSP_SNDFESMIDIIN = 3; (* Sound Festa MIDI In Device *)
+ MM_SSP_SNDFESMIDIOUT = 4; (* Sound Festa MIDI Out Device *)
+ MM_SSP_SNDFESSYNTH = 5; (* Sound Festa MIDI Synth Device *)
+ MM_SSP_SNDFESMIX = 6; (* Sound Festa Mixer Device *)
+ MM_SSP_SNDFESAUX = 7; (* Sound Festa Auxilliary Device *)
+
+(* Product IDs for MM_TDK - TDK Corporation *)
+ MM_TDK_MW_MIDI_SYNTH = 1;
+ MM_TDK_MW_MIDI_IN = 2;
+ MM_TDK_MW_MIDI_OUT = 3;
+ MM_TDK_MW_WAVE_IN = 4;
+ MM_TDK_MW_WAVE_OUT = 5;
+ MM_TDK_MW_AUX = 6;
+ MM_TDK_MW_MIXER = 10;
+ MM_TDK_MW_AUX_MASTER = 100;
+ MM_TDK_MW_AUX_BASS = 101;
+ MM_TDK_MW_AUX_TREBLE = 102;
+ MM_TDK_MW_AUX_MIDI_VOL = 103;
+ MM_TDK_MW_AUX_WAVE_VOL = 104;
+ MM_TDK_MW_AUX_WAVE_RVB = 105;
+ MM_TDK_MW_AUX_WAVE_CHR = 106;
+ MM_TDK_MW_AUX_VOL = 107;
+ MM_TDK_MW_AUX_RVB = 108;
+ MM_TDK_MW_AUX_CHR = 109;
+
+(* Product IDs for MM_TURTLE_BEACH - Turtle Beach, Inc. *)
+ MM_TBS_TROPEZ_WAVEIN = 37;
+ MM_TBS_TROPEZ_WAVEOUT = 38;
+ MM_TBS_TROPEZ_AUX1 = 39;
+ MM_TBS_TROPEZ_AUX2 = 40;
+ MM_TBS_TROPEZ_LINE = 41;
+
+(* Product IDs for MM_VIENNASYS - Vienna Systems *)
+ MM_VIENNASYS_TSP_WAVE_DRIVER = 1;
+
+(* Product IDs for MM_VIONA - Viona Development GmbH *)
+ MM_VIONA_QVINPCI_MIXER = 1; (* Q-Motion PCI II/Bravado 2000 *)
+ MM_VIONA_QVINPCI_WAVEIN = 2;
+ MM_VIONAQVINPCI_WAVEOUT = 3;
+ MM_VIONA_BUSTER_MIXER = 4; (* Buster *)
+ MM_VIONA_CINEMASTER_MIXER = 5; (* Cinemaster *)
+ MM_VIONA_CONCERTO_MIXER = 6; (* Concerto *)
+
+(* Product IDs for MM_WILDCAT - Wildcat Canyon Software *)
+ MM_WILDCAT_AUTOSCOREMIDIIN = 1; (* Autoscore *)
+
+(* Product IDs for MM_WILLOWPOND - Willow Pond Corporation *)
+ MM_WILLOWPOND_FMSYNTH_STEREO = 20;
+ MM_WILLOWPOND_SNDPORT_WAVEIN = 100;
+ MM_WILLOWPOND_SNDPORT_WAVEOUT = 101;
+ MM_WILLOWPOND_SNDPORT_MIXER = 102;
+ MM_WILLOWPOND_SNDPORT_AUX = 103;
+ MM_WILLOWPOND_PH_WAVEIN = 104;
+ MM_WILLOWPOND_PH_WAVEOUT = 105;
+ MM_WILLOWPOND_PH_MIXER = 106;
+ MM_WILLOWPOND_PH_AUX = 107;
+
+(* Product IDs for MM_WORKBIT - Workbit Corporation *)
+ MM_WORKBIT_MIXER = 1; (* Harmony Mixer *)
+ MM_WORKBIT_WAVEOUT = 2; (* Harmony Mixer *)
+ MM_WORKBIT_WAVEIN = 3; (* Harmony Mixer *)
+ MM_WORKBIT_MIDIIN = 4; (* Harmony Mixer *)
+ MM_WORKBIT_MIDIOUT = 5; (* Harmony Mixer *)
+ MM_WORKBIT_FMSYNTH = 6; (* Harmony Mixer *)
+ MM_WORKBIT_AUX = 7; (* Harmony Mixer *)
+ MM_WORKBIT_JOYSTICK = 8;
+
+(* Product IDs for MM_FRAUNHOFER_IIS - Fraunhofer *)
+ MM_FHGIIS_MPEGLAYER3 = 10;
+
+{(*)///////////////////////////////////////////////////////////////////////// *)
+
+(* INFO LIST CHUNKS (from the Multimedia Programmer's Reference
+ plus new ones) *)
+ RIFFINFO_IARL = mmioFOURCC ('I', 'A', 'R', 'L'); (*Archival location *)
+#define RIFFINFO_IART mmioFOURCC ('I', 'A', 'R', 'T') (*Artist *)
+#define RIFFINFO_ICMS mmioFOURCC ('I', 'C', 'M', 'S') (*Commissioned *)
+#define RIFFINFO_ICMT mmioFOURCC ('I', 'C', 'M', 'T') (*Comments *)
+#define RIFFINFO_ICOP mmioFOURCC ('I', 'C', 'O', 'P') (*Copyright *)
+#define RIFFINFO_ICRD mmioFOURCC ('I', 'C', 'R', 'D') (*Creation date of subject *)
+#define RIFFINFO_ICRP mmioFOURCC ('I', 'C', 'R', 'P') (*Cropped *)
+#define RIFFINFO_IDIM mmioFOURCC ('I', 'D', 'I', 'M') (*Dimensions *)
+#define RIFFINFO_IDPI mmioFOURCC ('I', 'D', 'P', 'I') (*Dots per inch *)
+#define RIFFINFO_IENG mmioFOURCC ('I', 'E', 'N', 'G') (*Engineer *)
+#define RIFFINFO_IGNR mmioFOURCC ('I', 'G', 'N', 'R') (*Genre *)
+#define RIFFINFO_IKEY mmioFOURCC ('I', 'K', 'E', 'Y') (*Keywords *)
+#define RIFFINFO_ILGT mmioFOURCC ('I', 'L', 'G', 'T') (*Lightness settings *)
+#define RIFFINFO_IMED mmioFOURCC ('I', 'M', 'E', 'D') (*Medium *)
+#define RIFFINFO_INAM mmioFOURCC ('I', 'N', 'A', 'M') (*Name of subject *)
+#define RIFFINFO_IPLT mmioFOURCC ('I', 'P', 'L', 'T') (*Palette Settings. No. of colors requested. *)
+#define RIFFINFO_IPRD mmioFOURCC ('I', 'P', 'R', 'D') (*Product *)
+#define RIFFINFO_ISBJ mmioFOURCC ('I', 'S', 'B', 'J') (*Subject description *)
+#define RIFFINFO_ISFT mmioFOURCC ('I', 'S', 'F', 'T') (*Software. Name of package used to create file. *)
+#define RIFFINFO_ISHP mmioFOURCC ('I', 'S', 'H', 'P') (*Sharpness. *)
+#define RIFFINFO_ISRC mmioFOURCC ('I', 'S', 'R', 'C') (*Source. *)
+#define RIFFINFO_ISRF mmioFOURCC ('I', 'S', 'R', 'F') (*Source Form. ie slide, paper *)
+#define RIFFINFO_ITCH mmioFOURCC ('I', 'T', 'C', 'H') (*Technician who digitized the subject. *)
+
+(* New INFO Chunks as of August 30, 1993: *)
+#define RIFFINFO_ISMP mmioFOURCC ('I', 'S', 'M', 'P') (*SMPTE time code *)
+(* ISMP: SMPTE time code of digitization start point expressed as a NULL terminated
+ text string "HH:MM:SS:FF". If performing MCI capture in AVICAP, this
+ chunk will be automatically set based on the MCI start time.
+*)
+#define RIFFINFO_IDIT mmioFOURCC ('I', 'D', 'I', 'T') (*Digitization Time *)
+(* IDIT: "Digitization Time" Specifies the time and date that the digitization commenced.
+ The digitization time is contained in an ASCII string which
+ contains exactly 26 characters and is in the format
+ "Wed Jan 02 02:03:55 1990\n\0".
+ The ctime(), asctime(), functions can be used to create strings
+ in this format. This chunk is automatically added to the capture
+ file based on the current system time at the moment capture is initiated.
+*)
+
+(*Template line for new additions*)
+(*#define RIFFINFO_I mmioFOURCC ('I', '', '', '') *) }
+
+
+(* WAVE form wFormatTag IDs *)
+ WAVE_FORMAT_UNKNOWN =$0000; (* Microsoft Corporation *)
+ WAVE_FORMAT_ADPCM =$0002; (* Microsoft Corporation *)
+ WAVE_FORMAT_IEEE_FLOAT =$0003; (* Microsoft Corporation *)
+ (* IEEE754: range (+1, -1] *)
+ (* 32-bit/64-bit format as defined by *)
+ (* MSVC++ float/double type *)
+ WAVE_FORMAT_IBM_CVSD =$0005; (* IBM Corporation *)
+ WAVE_FORMAT_ALAW =$0006; (* Microsoft Corporation *)
+ WAVE_FORMAT_MULAW =$0007; (* Microsoft Corporation *)
+ WAVE_FORMAT_OKI_ADPCM =$0010; (* OKI *)
+ WAVE_FORMAT_DVI_ADPCM =$0011; (* Intel Corporation *)
+ WAVE_FORMAT_IMA_ADPCM =(WAVE_FORMAT_DVI_ADPCM); (* Intel Corporation *)
+ WAVE_FORMAT_MEDIASPACE_ADPCM =$0012; (* Videologic *)
+ WAVE_FORMAT_SIERRA_ADPCM =$0013; (* Sierra Semiconductor Corp *)
+ WAVE_FORMAT_G723_ADPCM =$0014; (* Antex Electronics Corporation *)
+ WAVE_FORMAT_DIGISTD =$0015; (* DSP Solutions, Inc. *)
+ WAVE_FORMAT_DIGIFIX =$0016; (* DSP Solutions, Inc. *)
+ WAVE_FORMAT_DIALOGIC_OKI_ADPCM =$0017; (* Dialogic Corporation *)
+ WAVE_FORMAT_MEDIAVISION_ADPCM =$0018; (* Media Vision, Inc. *)
+ WAVE_FORMAT_YAMAHA_ADPCM =$0020; (* Yamaha Corporation of America *)
+ WAVE_FORMAT_SONARC =$0021; (* Speech Compression *)
+ WAVE_FORMAT_DSPGROUP_TRUESPEECH =$0022; (* DSP Group, Inc *)
+ WAVE_FORMAT_ECHOSC1 =$0023; (* Echo Speech Corporation *)
+ WAVE_FORMAT_AUDIOFILE_AF36 =$0024; (* *)
+ WAVE_FORMAT_APTX =$0025; (* Audio Processing Technology *)
+ WAVE_FORMAT_AUDIOFILE_AF10 =$0026; (* *)
+ WAVE_FORMAT_DOLBY_AC2 =$0030; (* Dolby Laboratories *)
+ WAVE_FORMAT_GSM610 =$0031; (* Microsoft Corporation *)
+ WAVE_FORMAT_MSNAUDIO =$0032; (* Microsoft Corporation *)
+ WAVE_FORMAT_ANTEX_ADPCME =$0033; (* Antex Electronics Corporation *)
+ WAVE_FORMAT_CONTROL_RES_VQLPC =$0034; (* Control Resources Limited *)
+ WAVE_FORMAT_DIGIREAL =$0035; (* DSP Solutions, Inc. *)
+ WAVE_FORMAT_DIGIADPCM =$0036; (* DSP Solutions, Inc. *)
+ WAVE_FORMAT_CONTROL_RES_CR10 =$0037; (* Control Resources Limited *)
+ WAVE_FORMAT_NMS_VBXADPCM =$0038; (* Natural MicroSystems *)
+ WAVE_FORMAT_CS_IMAADPCM =$0039; (* Crystal Semiconductor IMA ADPCM *)
+ WAVE_FORMAT_ECHOSC3 =$003A; (* Echo Speech Corporation *)
+ WAVE_FORMAT_ROCKWELL_ADPCM =$003B; (* Rockwell International *)
+ WAVE_FORMAT_ROCKWELL_DIGITALK =$003C; (* Rockwell International *)
+ WAVE_FORMAT_XEBEC =$003D; (* Xebec Multimedia Solutions Limited *)
+ WAVE_FORMAT_G721_ADPCM =$0040; (* Antex Electronics Corporation *)
+ WAVE_FORMAT_G728_CELP =$0041; (* Antex Electronics Corporation *)
+ WAVE_FORMAT_MPEG =$0050; (* Microsoft Corporation *)
+ WAVE_FORMAT_MPEGLAYER3 =$0055; (* ISO/MPEG Layer3 Format Tag *)
+ WAVE_FORMAT_CIRRUS =$0060; (* Cirrus Logic *)
+ WAVE_FORMAT_ESPCM =$0061; (* ESS Technology *)
+ WAVE_FORMAT_VOXWARE =$0062; (* Voxware Inc *)
+ WAVEFORMAT_CANOPUS_ATRAC =$0063; (* Canopus, co., Ltd. *)
+ WAVE_FORMAT_G726_ADPCM =$0064; (* APICOM *)
+ WAVE_FORMAT_G722_ADPCM =$0065; (* APICOM *)
+ WAVE_FORMAT_DSAT =$0066; (* Microsoft Corporation *)
+ WAVE_FORMAT_DSAT_DISPLAY =$0067; (* Microsoft Corporation *)
+ WAVE_FORMAT_SOFTSOUND =$0080; (* Softsound, Ltd. *)
+ WAVE_FORMAT_RHETOREX_ADPCM =$0100; (* Rhetorex Inc *)
+ WAVE_FORMAT_CREATIVE_ADPCM =$0200; (* Creative Labs, Inc *)
+ WAVE_FORMAT_CREATIVE_FASTSPEECH8 =$0202; (* Creative Labs, Inc *)
+ WAVE_FORMAT_CREATIVE_FASTSPEECH10 =$0203; (* Creative Labs, Inc *)
+ WAVE_FORMAT_QUARTERDECK =$0220; (* Quarterdeck Corporation *)
+ WAVE_FORMAT_FM_TOWNS_SND =$0300; (* Fujitsu Corp. *)
+ WAVE_FORMAT_BTV_DIGITAL =$0400; (* Brooktree Corporation *)
+ WAVE_FORMAT_OLIGSM =$1000; (* Ing C. Olivetti & C., S.p.A. *)
+ WAVE_FORMAT_OLIADPCM =$1001; (* Ing C. Olivetti & C., S.p.A. *)
+ WAVE_FORMAT_OLICELP =$1002; (* Ing C. Olivetti & C., S.p.A. *)
+ WAVE_FORMAT_OLISBC =$1003; (* Ing C. Olivetti & C., S.p.A. *)
+ WAVE_FORMAT_OLIOPR =$1004; (* Ing C. Olivetti & C., S.p.A. *)
+ WAVE_FORMAT_LH_CODEC =$1100; (* Lernout & Hauspie *)
+ WAVE_FORMAT_NORRIS =$1400; (* Norris Communications, Inc. *)
+
+//
+// the WAVE_FORMAT_DEVELOPMENT format tag can be used during the
+// development phase of a new wave format. Before shipping, you MUST
+// acquire an official format tag from Microsoft.
+//
+ WAVE_FORMAT_DEVELOPMENT = ($FFFF);
+
+
+ ACM_MPEG_LAYER1 =($0001);
+ ACM_MPEG_LAYER2 =($0002);
+ ACM_MPEG_LAYER3 =($0004);
+ ACM_MPEG_STEREO =($0001);
+ ACM_MPEG_JOINTSTEREO =($0002);
+ ACM_MPEG_DUALCHANNEL =($0004);
+ ACM_MPEG_SINGLECHANNEL =($0008);
+ ACM_MPEG_PRIVATEBIT =($0001);
+ ACM_MPEG_COPYRIGHT =($0002);
+ ACM_MPEG_ORIGINALHOME =($0004);
+ ACM_MPEG_PROTECTIONBIT =($0008);
+ ACM_MPEG_ID_MPEG1 =($0010);
+
+//
+// MPEG Layer3 WAVEFORMATEX structure
+// for WAVE_FORMAT_MPEGLAYER3 ($0055)
+//
+ MPEGLAYER3_WFX_EXTRA_BYTES = 12;
+
+ MPEGLAYER3_ID_UNKNOWN = 0;
+ MPEGLAYER3_ID_MPEG = 1;
+ MPEGLAYER3_ID_CONSTANTFRAMESIZE = 2;
+
+ MPEGLAYER3_FLAG_PADDING_ISO = $00000000;
+ MPEGLAYER3_FLAG_PADDING_ON = $00000001;
+ MPEGLAYER3_FLAG_PADDING_OFF = $00000002;
+
+ WAVE_FILTER_UNKNOWN = $0000;
+ WAVE_FILTER_DEVELOPMENT =($FFFF);
+
+ WAVE_FILTER_VOLUME = $0001;
+ WAVE_FILTER_ECHO = $0002;
+
+ BI_BITFIELDS = 3;
+
+ QUERYDIBSUPPORT = 3073;
+ QDI_SETDIBITS = $0001;
+ QDI_GETDIBITS = $0002;
+ QDI_DIBTOSCREEN = $0004;
+ QDI_STRETCHDIB = $0008;
+
+ JPEG_PROCESS_BASELINE = 0; (* Baseline DCT *)
+
+
+(*
+//
+// Microsoft MPEG audio WAV definition
+//
+ MPEG-1 audio wave format (audio layer only). (0x0050) *)
+type
+ PMPEG1WAVEFORMAT = ^MPEG1WAVEFORMAT;
+ mpeg1waveformat_tag = record
+ wfx: tWAVEFORMATEX;
+ fwHeadLayer: word;
+ dwHeadBitrate: dword;
+ fwHeadMode: word;
+ fwHeadModeExt: word;
+ wHeadEmphasis: word;
+ fwHeadFlags: word;
+ dwPTSLow: dword;
+ dwPTSHigh: dword;
+ end;
+ MPEG1WAVEFORMAT = mpeg1waveformat_tag;
+
+(*
+// MPEG Layer3 WAVEFORMATEX structure
+// for WAVE_FORMAT_MPEGLAYER3 (0x0055)
+//
+#define MPEGLAYER3_WFX_EXTRA_BYTES 12
+
+// WAVE_FORMAT_MPEGLAYER3 format sructure *)
+ PMPEGLAYER3WAVEFORMAT = ^MPEGLAYER3WAVEFORMAT;
+ mpeglayer3waveformat_tag = record
+ wfx: tWAVEFORMATEX;
+ wID: word;
+ fdwFlags: dword;
+ nBlockSize: word;
+ nFramesPerBlock: word;
+ nCodecDelay: word;
+ end;
+ MPEGLAYER3WAVEFORMAT = mpeglayer3waveformat_tag;
+
+implementation
+
+end.
diff --git a/Game/Code/lib/ffmpeg/opt.pas b/Game/Code/lib/ffmpeg/opt.pas new file mode 100644 index 00000000..e70d77ad --- /dev/null +++ b/Game/Code/lib/ffmpeg/opt.pas @@ -0,0 +1,117 @@ +(* + * AVOptions + * copyright (c) 2005 Michael Niedermayer <michaelni@gmx.at> + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +*) +(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows. +For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT +in the source codes *) + +unit opt; +{$IFDEF FPC} + {$MODE DELPHI} (* CAT *) + {$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *) + {$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *) +{$ENDIF} + +interface + +uses + rational; (* CAT *) + +type + TAVOptionType = ( + FF_OPT_TYPE_FLAGS, + FF_OPT_TYPE_INT, + FF_OPT_TYPE_INT64, + FF_OPT_TYPE_DOUBLE, + FF_OPT_TYPE_FLOAT, + FF_OPT_TYPE_STRING, + FF_OPT_TYPE_RATIONAL, + FF_OPT_TYPE_CONST = 128 + ); + +const + +{$IFDEF win32} + av__codec = 'avcodec-51.dll';
+{$ELSE}
+ av__codec = 'avcodec.so'; // .0d
+ // av__codec = 'libavcodec.51';
+{$ENDIF}
+ + + AV_OPT_FLAG_ENCODING_PARAM = 1; ///< a generic parameter which can be set by the user for muxing or encoding + AV_OPT_FLAG_DECODING_PARAM = 2; ///< a generic parameter which can be set by the user for demuxing or decoding + AV_OPT_FLAG_METADATA = 4; ///< some data extracted or inserted into the file like title, comment, ... + AV_OPT_FLAG_AUDIO_PARAM = 8; + AV_OPT_FLAG_VIDEO_PARAM = 16; + AV_OPT_FLAG_SUBTITLE_PARAM = 32; + +type + PAVOption = ^TAVOption; + TAVOption = record + name: pchar; + help: pchar; + offset: integer; ///< offset to context structure where the parsed value should be stored + _type: TAVOptionType; + + default_val: double; + min: double; + max: double; + + flags: integer; +//FIXME think about enc-audio, ... style flags + _unit: pchar; + end; + + +function av_set_string (obj: pointer; name: pchar; val: pchar): PAVOption; + cdecl; external av__codec; + +function av_set_double (obj: pointer; name: pchar; n: double): PAVOption; + cdecl; external av__codec; + +function av_set_q (obj: pointer; name: pchar; n: TAVRational): PAVOption; + cdecl; external av__codec; + +function av_set_int (obj: pointer; name: pchar; n: int64): PAVOption; + cdecl; external av__codec; + +function av_get_double (obj: pointer; name: pchar; o_out: PPointer): double; + cdecl; external av__codec; + +function av_get_q (obj: pointer; name: pchar; o_out: PPointer): TAVRational; + cdecl; external av__codec; + +function av_get_int (obj: pointer; name: pchar; o_out: PPointer): int64; + cdecl; external av__codec; + +function av_get_string (obj: pointer; name: pchar; o_out: PPOinter; buf: pchar; buf_len: integer): pchar; + cdecl; external av__codec; + +function av_next_option (obj: pointer; last: PAVOption): PAVOption; + cdecl; external av__codec; + +function av_opt_show (obj: pointer; av_log_obj: pointer): integer; + cdecl; external av__codec; + +procedure av_opt_set_defaults (s: pointer); + cdecl; external av__codec; + +implementation + +end. diff --git a/Game/Code/lib/ffmpeg/rational.pas b/Game/Code/lib/ffmpeg/rational.pas new file mode 100644 index 00000000..8fb3cbd8 --- /dev/null +++ b/Game/Code/lib/ffmpeg/rational.pas @@ -0,0 +1,96 @@ +(* + * Rational numbers + * Copyright (c) 2003 Michael Niedermayer <michaelni@gmx.at> + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library 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. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + *) +(* This is a part of Pascal porting of ffmpeg. Originally by Victor Zinetz for Delphi and Free Pascal on Windows. +For Mac OS X, some modifications were made by The Creative CAT, denoted as CAT +in the source codes *) + +unit rational; +{$IFDEF FPC} + {$MODE DELPHI} (* CAT *) + {$PACKENUM 4} (* every enum type variables uses 4 bytes, CAT *) + {$PACKRECORDS C} (* GCC compatible, Record Packing, CAT *) +{$ENDIF} + +interface (* unit windows is deleted by CAT *) + +const + {$IFDEF win32} + av__util = 'avutil-49.dll';
+ {$ELSE}
+ av__util = 'libavutil.so'; // .0d
+// av__util = 'libavutil.49';
+ {$ENDIF} +type + +(* + * Rational number num/den. *) + PAVRational = ^TAVRational; + TAVRational = record + num: integer; ///< numerator + den: integer; ///< denominator + end; + +(** + * returns 0 if a==b, 1 if a>b and -1 if a<b. + *) +function av_cmp_q(a: TAVRational; b: TAVRational): integer; + +(** + * converts the given AVRational to a double. + *) +function av_q2d(a: TAVRational): double; + +(** + * reduce a fraction. + * this is usefull for framerate calculations + * @param max the maximum allowed for dst_nom & dst_den + * @return 1 if exact, 0 otherwise + *) +function av_reduce(dst_nom: pinteger; dst_den: PInteger; nom: int64; den: int64; max: int64): integer; + cdecl; external av__util; + +function av_mul_q(b: TAVRational; c: TAVRational): TAVRational; + cdecl; external av__util; +function av_div_q(b: TAVRational; c: TAVRational): TAVRational; + cdecl; external av__util; +function av_add_q(b: TAVRational; c: TAVRational): TAVRational; + cdecl; external av__util; +function av_sub_q(b: TAVRational; c: TAVRational): TAVRational; + cdecl; external av__util; +function av_d2q(d: double; max: integer): TAVRational; + cdecl; external av__util; + +implementation + +function av_cmp_q (a: TAVRational; b: TAVRational): integer; +var + tmp: int64; +begin + tmp := a.num * b.den - b.num * a.den; + + if tmp <> 0 then Result := (tmp shr 63) or 1 (* fixed by CAT *) + else Result := 0 +end; + +function av_q2d(a: TAVRational): double; +begin + Result := a.num / a.den; +end; + +end. diff --git a/Game/Code/lib/midi/CIRCBUF.PAS b/Game/Code/lib/midi/CIRCBUF.PAS new file mode 100644 index 00000000..e84fc2c4 --- /dev/null +++ b/Game/Code/lib/midi/CIRCBUF.PAS @@ -0,0 +1,192 @@ +{ $Header: /MidiComp/CIRCBUF.PAS 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+
+{ A First-In First-Out circular buffer.
+ Port of circbuf.c from Microsoft's Windows MIDI monitor example.
+ I did do a version of this as an object (see Rev 1.1) but it was getting too
+ complicated and I couldn't see any real benefits to it so I dumped it
+ for an ordinary memory buffer with pointers.
+
+ This unit is a bit C-like, everything is done with pointers and extensive
+ use is made of the undocumented feature of the Inc() function that
+ increments pointers by the size of the object pointed to.
+ All of this could probably be done using Pascal array notation with
+ range-checking turned off, but I'm not sure it's worth it.
+}
+
+Unit Circbuf;
+
+interface
+
+Uses Wintypes, WinProcs, MMSystem;
+
+type
+ {$IFNDEF WIN32}
+ { API types not defined in Delphi 1 }
+ DWORD = Longint;
+ HGLOBAL = THandle;
+ UINT = Word;
+ TFNTimeCallBack = procedure(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);
+ {$ENDIF}
+
+ { MIDI input event }
+ TMidiBufferItem = record
+ timestamp: DWORD; { Timestamp in milliseconds after midiInStart }
+ data: DWORD; { MIDI message received }
+ sysex: PMidiHdr; { Pointer to sysex MIDIHDR, nil if not sysex }
+ end;
+ PMidiBufferItem = ^TMidiBufferItem;
+
+ { MIDI input buffer }
+ TCircularBuffer = record
+ RecordHandle: HGLOBAL; { Windows memory handle for this record }
+ BufferHandle: HGLOBAL; { Windows memory handle for the buffer }
+ pStart: PMidiBufferItem; { ptr to start of buffer }
+ pEnd: PMidiBufferItem; { ptr to end of buffer }
+ pNextPut: PMidiBufferItem; { next location to fill }
+ pNextGet: PMidiBufferItem; { next location to empty }
+ Error: Word; { error code from MMSYSTEM functions }
+ Capacity: Word; { buffer size (in TMidiBufferItems) }
+ EventCount: Word; { Number of events in buffer }
+ end;
+
+ PCircularBuffer = ^TCircularBuffer;
+
+function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
+procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
+
+function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+procedure CircbufFree( PBuffer: PCircularBuffer );
+function CircbufRemoveEvent( PBuffer: PCircularBuffer ): Boolean;
+function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
+{ Note: The PutEvent function is in the DLL }
+
+implementation
+
+{ Allocates in global shared memory, returns pointer and handle }
+function GlobalSharedLockedAlloc( Capacity: Word; var hMem: HGLOBAL ): Pointer;
+var
+ ptr: Pointer;
+begin
+ { Allocate the buffer memory }
+ hMem := GlobalAlloc(GMEM_SHARE Or GMEM_MOVEABLE Or GMEM_ZEROINIT, Capacity );
+
+ if (hMem = 0) then
+ ptr := Nil
+ else
+ begin
+ ptr := GlobalLock(hMem);
+ if (ptr = Nil) then
+ GlobalFree(hMem);
+ end;
+
+{$IFNDEF WIN32}
+ if (ptr <> Nil) then
+ GlobalPageLock(HIWORD(DWORD(ptr)));
+{$ENDIF}
+ GlobalSharedLockedAlloc := Ptr;
+end;
+
+procedure GlobalSharedLockedFree( hMem: HGLOBAL; ptr: Pointer );
+begin
+{$IFNDEF WIN32}
+ if (ptr <> Nil) then
+ GlobalPageUnlock(HIWORD(DWORD(ptr)));
+{$ENDIF}
+ if (hMem <> 0) then
+ begin
+ GlobalUnlock(hMem);
+ GlobalFree(hMem);
+ end;
+end;
+
+function CircbufAlloc( Capacity: Word ): PCircularBuffer;
+var
+ NewCircularBuffer: PCircularBuffer;
+ NewMIDIBuffer: PMidiBufferItem;
+ hMem: HGLOBAL;
+begin
+ { TODO: Validate circbuf size, <64K }
+ NewCircularBuffer :=
+ GlobalSharedLockedAlloc( Sizeof(TCircularBuffer), hMem );
+ if (NewCircularBuffer <> Nil) then
+ begin
+ NewCircularBuffer^.RecordHandle := hMem;
+ NewMIDIBuffer :=
+ GlobalSharedLockedAlloc( Capacity * Sizeof(TMidiBufferItem), hMem );
+ if (NewMIDIBuffer = Nil) then
+ begin
+ { TODO: Exception here? }
+ GlobalSharedLockedFree( NewCircularBuffer^.RecordHandle,
+ NewCircularBuffer );
+ NewCircularBuffer := Nil;
+ end
+ else
+ begin
+ NewCircularBuffer^.pStart := NewMidiBuffer;
+ { Point to item at end of buffer }
+ NewCircularBuffer^.pEnd := NewMidiBuffer;
+ Inc(NewCircularBuffer^.pEnd, Capacity);
+ { Start off the get and put pointers in the same position. These
+ will get out of sync as the interrupts start rolling in }
+ NewCircularBuffer^.pNextPut := NewMidiBuffer;
+ NewCircularBuffer^.pNextGet := NewMidiBuffer;
+ NewCircularBuffer^.Error := 0;
+ NewCircularBuffer^.Capacity := Capacity;
+ NewCircularBuffer^.EventCount := 0;
+ end;
+ end;
+ CircbufAlloc := NewCircularBuffer;
+end;
+
+procedure CircbufFree( pBuffer: PCircularBuffer );
+begin
+ if (pBuffer <> Nil) then
+ begin
+ GlobalSharedLockedFree(pBuffer^.BufferHandle, pBuffer^.pStart);
+ GlobalSharedLockedFree(pBuffer^.RecordHandle, pBuffer);
+ end;
+end;
+
+{ Reads first event in queue without removing it.
+ Returns true if successful, False if no events in queue }
+function CircbufReadEvent( PBuffer: PCircularBuffer; PEvent: PMidiBufferItem ): Boolean;
+var
+ PCurrentEvent: PMidiBufferItem;
+begin
+ if (PBuffer^.EventCount <= 0) then
+ CircbufReadEvent := False
+ else
+ begin
+ PCurrentEvent := PBuffer^.PNextget;
+
+ { Copy the object from the "tail" of the buffer to the caller's object }
+ PEvent^.Timestamp := PCurrentEvent^.Timestamp;
+ PEvent^.Data := PCurrentEvent^.Data;
+ PEvent^.Sysex := PCurrentEvent^.Sysex;
+ CircbufReadEvent := True;
+ end;
+end;
+
+{ Remove current event from the queue }
+function CircbufRemoveEvent(PBuffer: PCircularBuffer): Boolean;
+begin
+ if (PBuffer^.EventCount > 0) then
+ begin
+ Dec( Pbuffer^.EventCount);
+
+ { Advance the buffer pointer, with wrap }
+ Inc( Pbuffer^.PNextGet );
+ If (PBuffer^.PNextGet = PBuffer^.PEnd) then
+ PBuffer^.PNextGet := PBuffer^.PStart;
+
+ CircbufRemoveEvent := True;
+ end
+ else
+ CircbufRemoveEvent := False;
+end;
+
+end.
diff --git a/Game/Code/lib/midi/DELPHMCB.PAS b/Game/Code/lib/midi/DELPHMCB.PAS new file mode 100644 index 00000000..23ce0e1a --- /dev/null +++ b/Game/Code/lib/midi/DELPHMCB.PAS @@ -0,0 +1,140 @@ +{ $Header: /MidiComp/DELPHMCB.PAS 2 10/06/97 7:33 Davec $ }
+
+{MIDI callback for Delphi, was DLL for Delphi 1}
+
+unit Delphmcb;
+
+{ These segment options required for the MIDI callback functions }
+{$C PRELOAD FIXED PERMANENT}
+
+interface
+
+uses WinProcs, WinTypes, MMsystem, Circbuf, MidiDefs, MidiCons;
+
+{$IFDEF WIN32}
+procedure midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: UINT;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD); stdcall export;
+function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; stdcall; export;
+{$ELSE}
+procedure midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: Word;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD); export;
+function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean; export;
+{$ENDIF}
+
+implementation
+
+{ Add an event to the circular input buffer. }
+function CircbufPutEvent(PBuffer: PCircularBuffer; PTheEvent: PMidiBufferItem): Boolean;
+begin
+ If (PBuffer^.EventCount < PBuffer^.Capacity) Then
+ begin
+ Inc(Pbuffer^.EventCount);
+
+ { Todo: better way of copying this record }
+ with PBuffer^.PNextput^ do
+ begin
+ Timestamp := PTheEvent^.Timestamp;
+ Data := PTheEvent^.Data;
+ Sysex := PTheEvent^.Sysex;
+ end;
+
+ { Move to next put location, with wrap }
+ Inc(Pbuffer^.PNextPut);
+ If (PBuffer^.PNextPut = PBuffer^.PEnd) then
+ PBuffer^.PNextPut := PBuffer^.PStart;
+
+ CircbufPutEvent := True;
+ end
+ else
+ CircbufPutEvent := False;
+end;
+
+{ This is the callback function specified when the MIDI device was opened
+ by midiInOpen. It's called at interrupt time when MIDI input is seen
+ by the MIDI device driver(s). See the docs for midiInOpen for restrictions
+ on the Windows functions that can be called in this interrupt. }
+procedure midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: UINT;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD);
+
+var
+ thisEvent: TMidiBufferItem;
+ thisCtlInfo: PMidiCtlInfo;
+ thisBuffer: PCircularBuffer;
+
+Begin
+ case wMsg of
+
+ mim_Open: {nothing};
+
+ mim_Error: {TODO: handle (message to trigger exception?) };
+
+ mim_Data, mim_Longdata, mim_Longerror:
+ { Note: mim_Longerror included because there's a bug in the Maui
+ input driver that sends MIM_LONGERROR for subsequent buffers when
+ the input buffer is smaller than the sysex block being received }
+
+ begin
+ { TODO: Make filtered messages customisable, I'm sure someone wants to
+ do something with MTC! }
+ if (dwParam1 <> MIDI_ACTIVESENSING) and
+ (dwParam1 <> MIDI_TIMINGCLOCK) then
+ begin
+
+ { The device driver passes us the instance data pointer we
+ specified for midiInOpen. Use this to get the buffer address
+ and window handle for the MIDI control }
+ thisCtlInfo := PMidiCtlInfo(dwInstance);
+ thisBuffer := thisCtlInfo^.PBuffer;
+
+ { Screen out short messages if we've been asked to }
+ if ((wMsg <> mim_Data) or (thisCtlInfo^.SysexOnly = False))
+ and (thisCtlInfo <> Nil) and (thisBuffer <> Nil) then
+ begin
+ with thisEvent do
+ begin
+ timestamp := dwParam2;
+ if (wMsg = mim_Longdata) or
+ (wMsg = mim_Longerror) then
+ begin
+ data := 0;
+ sysex := PMidiHdr(dwParam1);
+ end
+ else
+ begin
+ data := dwParam1;
+ sysex := Nil;
+ end;
+ end;
+ if CircbufPutEvent( thisBuffer, @thisEvent ) then
+ { Send a message to the control to say input's arrived }
+ PostMessage(thisCtlInfo^.hWindow, mim_Data, 0, 0)
+ else
+ { Buffer overflow }
+ PostMessage(thisCtlInfo^.hWindow, mim_Overflow, 0, 0);
+ end;
+ end;
+ end;
+
+ mom_Done: { Sysex output complete, dwParam1 is pointer to MIDIHDR }
+ begin
+ { Notify the control that its sysex output is finished.
+ The control should call midiOutUnprepareHeader before freeing the buffer }
+ PostMessage(PMidiCtlInfo(dwInstance)^.hWindow, mom_Done, 0, dwParam1);
+ end;
+
+ end; { Case }
+end;
+
+end.
diff --git a/Game/Code/lib/midi/MIDIDEFS.PAS b/Game/Code/lib/midi/MIDIDEFS.PAS new file mode 100644 index 00000000..4024c547 --- /dev/null +++ b/Game/Code/lib/midi/MIDIDEFS.PAS @@ -0,0 +1,47 @@ +{ $Header: /MidiComp/MIDIDEFS.PAS 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+
+{ Common definitions used by DELPHMID.DPR and the MIDI components.
+ This must be a separate unit to prevent large chunks of the VCL being
+ linked into the DLL. }
+unit Mididefs;
+
+interface
+
+uses WinProcs, WinTypes, MMsystem, Circbuf;
+
+type
+
+ {-------------------------------------------------------------------}
+ { This is the information about the control that must be accessed by
+ the MIDI input callback function in the DLL at interrupt time }
+ PMidiCtlInfo = ^TMidiCtlInfo;
+ TMidiCtlInfo = record
+ hMem: THandle; { Memory handle for this record }
+ PBuffer: PCircularBuffer; { Pointer to the MIDI input data buffer }
+ hWindow: HWnd; { Control's window handle }
+ SysexOnly: Boolean; { Only process System Exclusive input }
+ end;
+
+ { Information for the output timer callback function, also required at
+ interrupt time. }
+ PMidiOutTimerInfo = ^TMidiOutTimerInfo;
+ TMidiOutTimerInfo = record
+ hMem: THandle; { Memory handle for this record }
+ PBuffer: PCircularBuffer; { Pointer to MIDI output data buffer }
+ hWindow: HWnd; { Control's window handle }
+ TimeToNextEvent: DWORD; { Delay to next event after timer set }
+ MIDIHandle: HMidiOut; { MIDI handle to send output to
+ (copy of component's FMidiHandle property) }
+ PeriodMin: Word; { Multimedia timer minimum period supported }
+ PeriodMax: Word; { Multimedia timer maximum period supported }
+ TimerId: Word; { Multimedia timer ID of current event }
+ end;
+
+implementation
+
+
+end.
diff --git a/Game/Code/lib/midi/MIDITYPE.PAS b/Game/Code/lib/midi/MIDITYPE.PAS new file mode 100644 index 00000000..0aa9cec3 --- /dev/null +++ b/Game/Code/lib/midi/MIDITYPE.PAS @@ -0,0 +1,79 @@ +{ $Header: /MidiComp/MIDITYPE.PAS 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+
+unit Miditype;
+
+interface
+
+uses Classes, Wintypes, Messages, MMSystem, MidiDefs, Circbuf;
+
+type
+ {-------------------------------------------------------------------}
+ { A MIDI input/output event }
+ TMyMidiEvent = class(TPersistent)
+ public
+ MidiMessage: Byte; { MIDI message status byte }
+ Data1: Byte; { MIDI message data 1 byte }
+ Data2: Byte; { MIDI message data 2 byte }
+ Time: DWORD; { Time in ms since midiInOpen }
+ SysexLength: Word; { Length of sysex data (0 if none) }
+ Sysex: PChar; { Pointer to sysex data buffer }
+ destructor Destroy; override; { Frees sysex data buffer if nec. }
+ end;
+ PMyMidiEvent = ^TMyMidiEvent;
+
+ {-------------------------------------------------------------------}
+ { Encapsulates the MIDIHDR with its memory handle and sysex buffer }
+ PMyMidiHdr = ^TMyMidiHdr;
+ TMyMidiHdr = class(TObject)
+ public
+ hdrHandle: THandle;
+ hdrPointer: PMIDIHDR;
+ sysexHandle: THandle;
+ sysexPointer: Pointer;
+ constructor Create(BufferSize: Word);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+{-------------------------------------------------------------------}
+{ Free any sysex buffer associated with the event }
+destructor TMyMidiEvent.Destroy;
+begin
+ if (Sysex <> Nil) then
+ Freemem(Sysex, SysexLength);
+
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------}
+{ Allocate memory for the sysex header and buffer }
+constructor TMyMidiHdr.Create(BufferSize:Word);
+begin
+ inherited Create;
+
+ if BufferSize > 0 then
+ begin
+ hdrPointer := GlobalSharedLockedAlloc(sizeof(TMIDIHDR), hdrHandle);
+ sysexPointer := GlobalSharedLockedAlloc(BufferSize, sysexHandle);
+
+ hdrPointer^.lpData := sysexPointer;
+ hdrPointer^.dwBufferLength := BufferSize;
+ end;
+end;
+
+{-------------------------------------------------------------------}
+destructor TMyMidiHdr.Destroy;
+begin
+ GlobalSharedLockedFree( hdrHandle, hdrPointer );
+ GlobalSharedLockedFree( sysexHandle, sysexPointer );
+ inherited Destroy;
+end;
+
+
+
+end.
diff --git a/Game/Code/lib/midi/MidiFile.pas b/Game/Code/lib/midi/MidiFile.pas new file mode 100644 index 00000000..10b64a80 --- /dev/null +++ b/Game/Code/lib/midi/MidiFile.pas @@ -0,0 +1,956 @@ +{
+ Load a midifile and get access to tracks and events
+ I did build this component to convert midifiles to wave files
+ or play the files on a software synthesizer which I'm currenly
+ building.
+
+ version 1.0 first release
+
+ version 1.1
+ added some function
+ function KeyToStr(key : integer) : string;
+ function MyTimeToStr(val : integer) : string;
+ Bpm can be set to change speed
+
+ version 1.2
+ added some functions
+ function GetTrackLength:integer;
+ function Ready: boolean;
+
+ version 1.3
+ update by Chulwoong,
+ He knows how to use the MM timer, the timing is much better now, thank you
+
+ for comments/bugs
+ F.Bouwmans
+ fbouwmans@spiditel.nl
+
+ if you think this component is nice and you use it, sent me a short email.
+ I've seen that other of my components have been downloaded a lot, but I've
+ got no clue wether they are actually used.
+ Don't worry because you are free to use these components
+
+ Timing has improved, however because the messages are handled by the normal
+ windows message loop (of the main window) it is still influenced by actions
+ done on the window (minimize/maximize ..).
+ Use of a second thread with higher priority which only handles the
+ timer message should increase performance. If somebody knows such a component
+ which is freeware please let me know.
+
+ interface description:
+
+ procedure ReadFile:
+ actually read the file which is set in Filename
+
+ function GetTrack(index: integer) : TMidiTrack;
+
+ property Filename
+ set/read filename of midifile
+
+ property NumberOfTracks
+ read number of tracks in current file
+
+ property TicksPerQuarter: integer
+ ticks per quarter, tells how to interpret the time value in midi events
+
+ property FileFormat: TFileFormat
+ tells the format of the current midifile
+
+ property Bpm:integer
+ tells Beats per minut
+
+ property OnMidiEvent:TOnMidiEvent
+ called while playing for each midi event
+
+ procedure StartPlaying;
+ start playing the current loaded midifile from the beginning
+
+ procedure StopPlaying;
+ stop playing the current midifile
+
+ procedure PlayToTime(time : integer);
+ if playing yourself then events from last time to this time are produced
+
+
+ function KeyToStr(key : integer) : string;
+ give note string on key value: e.g. C4
+
+ function MyTimeToStr(val : integer) : string;
+ give time string from msec time
+
+ function GetTrackLength:integer;
+ gives the track lenght in msec (assuming the bpm at the start oof the file)
+
+ function Ready: boolean;
+ now you can check wether the playback is finished
+
+}
+
+unit MidiFile;
+
+interface
+
+uses
+ Windows,
+ Messages,
+ SysUtils,
+ Classes,
+ Graphics,
+ Controls,
+ Forms,
+ stdctrls,
+ ExtCtrls,
+ WinProcs;
+
+type
+ TChunkType = (illegal, header, track);
+ TFileFormat = (single, multi_synch, multi_asynch);
+ PByte = ^byte;
+
+ TMidiEvent = record
+ event: byte;
+ data1: byte;
+ data2: byte;
+ str: string;
+ dticks: integer;
+ time: integer;
+ mtime: integer;
+ len: integer;
+ end;
+ PMidiEvent = ^TMidiEvent;
+
+ TOnMidiEvent = procedure(event: PMidiEvent) of object;
+ TEvent = procedure of object;
+
+ TMidiTrack = class(TObject)
+ protected
+ events: TList;
+ name: string;
+ instrument: string;
+ currentTime: integer;
+ currentPos: integer;
+ ready: boolean;
+ trackLenght: integer;
+ procedure checkReady;
+ public
+ OnMidiEvent: TOnMidiEvent;
+ OnTrackReady: TEvent;
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure Rewind(pos: integer);
+ procedure PlayUntil(pos: integer);
+ procedure GoUntil(pos: integer);
+
+ procedure putEvent(event: PMidiEvent);
+ function getEvent(index: integer): PMidiEvent;
+ function getName: string;
+ function getInstrument: string;
+ function getEventCount: integer;
+ function getCurrentTime: integer;
+ function getTrackLength: integer;
+ function isReady:boolean;
+ end;
+
+ TMidiFile = class(TComponent)
+ private
+ { Private declarations }
+ procedure MidiTimer(sender : TObject);
+ procedure WndProc(var Msg : TMessage);
+ protected
+ { Protected declarations }
+ midiFile: file of byte;
+ chunkType: TChunkType;
+ chunkLength: integer;
+ chunkData: PByte;
+ chunkIndex: PByte;
+ chunkEnd: PByte;
+ FPriority: DWORD;
+
+ // midi file attributes
+ FFileFormat: TFileFormat;
+ numberTracks: integer;
+ deltaTicks: integer;
+ FBpm: integer;
+ FBeatsPerMeasure: integer;
+ FusPerTick: double;
+ FFilename: string;
+
+ Tracks: TList;
+ currentTrack: TMidiTrack;
+ FOnMidiEvent: TOnMidiEvent;
+ FOnUpdateEvent: TNotifyEvent;
+
+ // playing attributes
+ playing: boolean;
+ PlayStartTime: integer;
+ currentTime: integer; // Current playtime in msec
+ currentPos: Double; // Current Position in ticks
+
+ procedure OnTrackReady;
+ procedure setFilename(val: string);
+ procedure ReadChunkHeader;
+ procedure ReadChunkContent;
+ procedure ReadChunk;
+ procedure ProcessHeaderChunk;
+ procedure ProcessTrackChunk;
+ function ReadVarLength: integer;
+ function ReadString(l: integer): string;
+ procedure SetOnMidiEvent(handler: TOnMidiEvent);
+ procedure SetBpm(val: integer);
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ procedure ReadFile;
+ function GetTrack(index: integer): TMidiTrack;
+
+ procedure StartPlaying;
+ procedure StopPlaying;
+ procedure ContinuePlaying;
+
+ procedure PlayToTime(time: integer);
+ procedure GoToTime(time: integer);
+ function GetCurrentTime: integer;
+ function GetFusPerTick : Double;
+ function GetTrackLength:integer;
+ function Ready: boolean;
+ published
+ { Published declarations }
+ property Filename: string read FFilename write setFilename;
+ property NumberOfTracks: integer read numberTracks;
+ property TicksPerQuarter: integer read deltaTicks;
+ property FileFormat: TFileFormat read FFileFormat;
+ property Bpm: integer read FBpm write SetBpm;
+ property OnMidiEvent: TOnMidiEvent read FOnMidiEvent write SetOnMidiEvent;
+ property OnUpdateEvent: TNotifyEvent read FOnUpdateEvent write FOnUpdateEvent;
+ end;
+
+function KeyToStr(key: integer): string;
+function MyTimeToStr(val: integer): string;
+procedure Register;
+
+implementation
+
+uses mmsystem;
+
+type TTimerProc=procedure(uTimerID,uMsg: Integer; dwUser,dwParam1,dwParam2:DWORD);stdcall;
+
+const TIMER_RESOLUTION=10;
+const WM_MULTIMEDIA_TIMER=WM_USER+127;
+
+var MIDIFileHandle : HWND;
+ TimerProc : TTimerProc;
+ MIDITimerID : Integer;
+ TimerPeriod : Integer;
+
+procedure TimerCallBackProc(uTimerID,uMsg: Integer; dwUser,dwParam1,dwParam2:DWORD);stdcall;
+begin
+ PostMessage(HWND(dwUser),WM_MULTIMEDIA_TIMER,0,0);
+end;
+
+procedure SetMIDITimer;
+ var TimeCaps : TTimeCaps ;
+begin
+ timeGetDevCaps(@TimeCaps,SizeOf(TimeCaps));
+ if TIMER_RESOLUTION < TimeCaps.wPeriodMin then
+ TimerPeriod:=TimeCaps.wPeriodMin
+ else if TIMER_RESOLUTION > TimeCaps.wPeriodMax then
+ TimerPeriod:=TimeCaps.wPeriodMax
+ else
+ TimerPeriod:=TIMER_RESOLUTION;
+
+ timeBeginPeriod(TimerPeriod);
+ MIDITimerID:=timeSetEvent(TimerPeriod,TimerPeriod,@TimerProc,
+ DWORD(MIDIFileHandle),TIME_PERIODIC);
+ if MIDITimerID=0 then
+ timeEndPeriod(TimerPeriod);
+end;
+
+procedure KillMIDITimer;
+begin
+ timeKillEvent(MIDITimerID);
+ timeEndPeriod(TimerPeriod);
+end;
+
+constructor TMidiTrack.Create;
+begin
+ inherited Create;
+ events := TList.Create;
+ currentTime := 0;
+ currentPos := 0;
+end;
+
+destructor TMidiTrack.Destroy;
+var
+ i: integer;
+begin
+ for i := 0 to events.count - 1 do
+ Dispose(PMidiEvent(events.items[i]));
+ events.Free;
+ inherited Destroy;
+end;
+
+procedure TMidiTRack.putEvent(event: PMidiEvent);
+var
+ command: integer;
+ i: integer;
+ pevent: PMidiEvent;
+begin
+ if (event.event = $FF) then
+ begin
+ if (event.data1 = 3) then
+ name := event.str;
+ if (event.data1 = 4) then
+ instrument := event.str;
+ end;
+ currentTime := currentTime + event.dticks;
+ event.time := currentTime; // for the moment just add dticks
+ event.len := 0;
+ events.add(TObject(event));
+ command := event.event and $F0;
+
+ if ((command = $80) // note off
+ or ((command = $90) and (event.data2 = 0))) //note on with speed 0
+ then
+ begin
+ // this is a note off, try to find the accompanion note on
+ command := event.event or $90;
+ i := events.count - 2;
+ while i >= 0 do
+ begin
+ pevent := PMidiEvent(events[i]);
+ if (pevent.event = command) and
+ (pevent.data1 = event.data1)
+ then
+ begin
+ pevent.len := currentTIme - pevent.time;
+ i := 0;
+ event.len := -1;
+ end;
+ dec(i);
+ end;
+ end;
+end;
+
+function TMidiTrack.getName: string;
+begin
+ result := name;
+end;
+
+function TMidiTrack.getInstrument: string;
+begin
+ result := instrument;
+end;
+
+function TMiditrack.getEventCount: integer;
+begin
+ result := events.count;
+end;
+
+function TMiditrack.getEvent(index: integer): PMidiEvent;
+begin
+ if ((index < events.count) and (index >= 0)) then
+ result := events[index]
+ else
+ result := nil;
+end;
+
+function TMiditrack.getCurrentTime: integer;
+begin
+ result := currentTime;
+end;
+
+procedure TMiditrack.Rewind(pos: integer);
+begin
+ if currentPos = events.count then
+ dec(currentPos);
+ while ((currentPos > 0) and
+ (PMidiEvent(events[currentPos]).time > pos))
+ do
+ begin
+ dec(currentPos);
+ end;
+ checkReady;
+end;
+
+procedure TMiditrack.PlayUntil(pos: integer);
+begin
+ if assigned(OnMidiEvent) then
+ begin
+ while ((currentPos < events.count) and
+ (PMidiEvent(events[currentPos]).time < pos)) do
+ begin
+ OnMidiEvent(PMidiEvent(events[currentPos]));
+ inc(currentPos);
+ end;
+ end;
+ checkReady;
+end;
+
+procedure TMidiTrack.GoUntil(pos: integer);
+begin
+ while ((currentPos < events.count) and
+ (PMidiEvent(events[currentPos]).time < pos)) do
+ begin
+ inc(currentPos);
+ end;
+ checkReady;
+end;
+
+procedure TMidiTrack.checkReady;
+begin
+ if currentPos >= events.count then
+ begin
+ ready := true;
+ if assigned(OnTrackReady) then
+ OnTrackReady;
+ end
+ else
+ ready := false;
+end;
+
+function TMidiTrack.getTrackLength: integer;
+begin
+ result := PMidiEvent(events[events.count-1]).time
+end;
+
+function TMidiTrack.isReady: boolean;
+begin
+ result := ready;
+end;
+
+constructor TMidifile.Create(AOwner: TComponent);
+begin
+ inherited Create(AOWner);
+ MIDIFileHandle:=AllocateHWnd(WndProc);
+ chunkData := nil;
+ chunkType := illegal;
+ Tracks := TList.Create;
+ TimerProc:=TimerCallBackProc;
+ FPriority:=GetPriorityClass(MIDIFileHandle);
+end;
+
+destructor TMidifile.Destroy;
+var
+ i: integer;
+begin
+ if not (chunkData = nil) then FreeMem(chunkData);
+ for i := 0 to Tracks.Count - 1 do
+ TMidiTrack(Tracks.Items[i]).Free;
+ Tracks.Free;
+ SetPriorityClass(MIDIFileHandle,FPriority);
+
+ if MIDITimerID<>0 then KillMIDITimer;
+
+ DeallocateHWnd(MIDIFileHandle);
+
+ inherited Destroy;
+end;
+
+function TMidiFile.GetTrack(index: integer): TMidiTrack;
+begin
+ result := Tracks.Items[index];
+end;
+
+procedure TMidifile.setFilename(val: string);
+begin
+ FFilename := val;
+// ReadFile;
+end;
+
+procedure TMidifile.SetOnMidiEvent(handler: TOnMidiEvent);
+var
+ i: integer;
+begin
+// if not (FOnMidiEvent = handler) then
+// begin
+ FOnMidiEvent := handler;
+ for i := 0 to tracks.count - 1 do
+ TMidiTrack(tracks.items[i]).OnMidiEvent := handler;
+// end;
+end;
+
+procedure TMidifile.MidiTimer(Sender: TObject);
+begin
+ if playing then
+ begin
+ PlayToTime(GetTickCount - PlayStartTime);
+ if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
+ end;
+end;
+
+procedure TMidifile.StartPlaying;
+var
+ i: integer;
+begin
+ for i := 0 to tracks.count - 1 do
+ TMidiTrack(tracks[i]).Rewind(0);
+ playStartTime := getTickCount;
+ playing := true;
+
+ SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
+
+ SetMIDITimer;
+ currentPos := 0.0;
+ currentTime := 0;
+end;
+
+procedure TMidifile.ContinuePlaying;
+begin
+ PlayStartTime := GetTickCount - currentTime;
+ playing := true;
+
+ SetPriorityClass(MIDIFileHandle,REALTIME_PRIORITY_CLASS);
+
+ SetMIDITimer;
+end;
+
+procedure TMidifile.StopPlaying;
+begin
+ playing := false;
+ KillMIDITimer;
+ SetPriorityClass(MIDIFileHandle,FPriority);
+end;
+
+function TMidiFile.GetCurrentTime: integer;
+begin
+ Result := currentTime;
+end;
+
+procedure TMidifile.PlayToTime(time: integer);
+var
+ i: integer;
+ track: TMidiTrack;
+ pos: integer;
+ deltaTime: integer;
+begin
+ // calculate the pos in the file.
+ // pos is actually tick
+ // Current FusPerTick is uses to determine the actual pos
+
+ deltaTime := time - currentTime;
+ currentPos := currentPos + (deltaTime * 1000) / FusPerTick;
+ pos := round(currentPos);
+
+ for i := 0 to tracks.count - 1 do
+ begin
+ TMidiTrack(tracks.items[i]).PlayUntil(pos);
+ end;
+ currentTime := time;
+end;
+
+procedure TMidifile.GoToTime(time: integer);
+var
+ i: integer;
+ track: TMidiTrack;
+ pos: integer;
+begin
+ // this function should be changed because FusPerTick might not be constant
+ pos := round((time * 1000) / FusPerTick);
+ for i := 0 to tracks.count - 1 do
+ begin
+ TMidiTrack(tracks.items[i]).Rewind(0);
+ TMidiTrack(tracks.items[i]).GoUntil(pos);
+ end;
+end;
+
+procedure TMidifile.SetBpm(val: integer);
+var
+ us_per_quarter: integer;
+begin
+ if not (val = FBpm) then
+ begin
+ us_per_quarter := 60000000 div val;
+
+ FBpm := 60000000 div us_per_quarter;
+ FusPerTick := us_per_quarter / deltaTicks;
+ end;
+end;
+
+procedure TMidifile.ReadChunkHeader;
+var
+ theByte: array[0..7] of byte;
+begin
+ BlockRead(midiFile, theByte, 8);
+ if (theByte[0] = $4D) and (theByte[1] = $54) then
+ begin
+ if (theByte[2] = $68) and (theByte[3] = $64) then
+ chunkType := header
+ else if (theByte[2] = $72) and (theByte[3] = $6B) then
+ chunkType := track
+ else
+ chunkType := illegal;
+ end
+ else
+ begin
+ chunkType := illegal;
+ end;
+ chunkLength := theByte[7] + theByte[6] * $100 + theByte[5] * $10000 + theByte[4] * $1000000;
+end;
+
+procedure TMidifile.ReadChunkContent;
+begin
+ if not (chunkData = nil) then
+ FreeMem(chunkData);
+ GetMem(chunkData, chunkLength + 10);
+ BlockRead(midiFile, chunkData^, chunkLength);
+ chunkIndex := chunkData;
+ chunkEnd := PByte(integer(chunkIndex) + integer(chunkLength) - 1);
+end;
+
+procedure TMidifile.ReadChunk;
+begin
+ ReadChunkHeader;
+ ReadChunkContent;
+ case chunkType of
+ header:
+ ProcessHeaderChunk;
+ track:
+ ProcessTrackCHunk;
+ end;
+end;
+
+procedure TMidifile.ProcessHeaderChunk;
+begin
+ chunkIndex := chunkData;
+ inc(chunkIndex);
+ if chunkType = header then
+ begin
+ case chunkIndex^ of
+ 0: FfileFormat := single;
+ 1: FfileFormat := multi_synch;
+ 2: FfileFormat := multi_asynch;
+ end;
+ inc(chunkIndex);
+ numberTracks := chunkIndex^ * $100;
+ inc(chunkIndex);
+ numberTracks := numberTracks + chunkIndex^;
+ inc(chunkIndex);
+ deltaTicks := chunkIndex^ * $100;
+ inc(chunkIndex);
+ deltaTicks := deltaTicks + chunkIndex^;
+ end;
+end;
+
+procedure TMidifile.ProcessTrackChunk;
+var
+ dTime: integer;
+ event: integer;
+ len: integer;
+ str: string;
+ midiEvent: PMidiEvent;
+ i: integer;
+ us_per_quarter: integer;
+begin
+ chunkIndex := chunkData;
+// inc(chunkIndex);
+ event := 0;
+ if chunkType = track then
+ begin
+ currentTrack := TMidiTrack.Create;
+ currentTrack.OnMidiEvent := FOnMidiEvent;
+ Tracks.add(currentTrack);
+ while integer(chunkIndex) < integer(chunkEnd) do
+ begin
+ // each event starts with var length delta time
+ dTime := ReadVarLength;
+ if chunkIndex^ >= $80 then
+ begin
+ event := chunkIndex^;
+ inc(chunkIndex);
+ end;
+ // else it is a running status event (just the same event as before)
+
+ if event = $FF then
+ begin
+{ case chunkIndex^ of
+ $00: // sequence number, not implemented jet
+ begin
+ inc(chunkIndex); // $02
+ inc(chunkIndex);
+ end;
+ $01 .. $0f: // text events FF ty len text
+ begin
+ New(midiEvent);
+ midiEvent.event := $FF;
+ midiEvent.data1 := chunkIndex^; // type is stored in data1
+ midiEvent.dticks := dtime;
+
+ inc(chunkIndex);
+ len := ReadVarLength;
+ midiEvent.str := ReadString(len);
+
+ currentTrack.putEvent(midiEvent);
+ end;
+ $20: // Midi channel prefix FF 20 01 cc
+ begin
+ inc(chunkIndex); // $01
+ inc(chunkIndex); // channel
+ inc(chunkIndex);
+ end;
+ $2F: // End of track FF 2F 00
+ begin
+ inc(chunkIndex); // $00
+ inc(chunkIndex);
+ end;
+ $51: // Set Tempo FF 51 03 tttttt
+ begin
+ inc(chunkIndex); // $03
+ inc(chunkIndex); // tt
+ inc(chunkIndex); // tt
+ inc(chunkIndex); // tt
+ inc(chunkIndex);
+ end;
+ $54: // SMPTE offset FF 54 05 hr mn se fr ff
+ begin
+ inc(chunkIndex); // $05
+ inc(chunkIndex); // hr
+ inc(chunkIndex); // mn
+ inc(chunkIndex); // se
+ inc(chunkIndex); // fr
+ inc(chunkIndex); // ff
+ inc(chunkIndex);
+ end;
+ $58: // Time signature FF 58 04 nn dd cc bb
+ begin
+ inc(chunkIndex); // $04
+ inc(chunkIndex); // nn
+ inc(chunkIndex); // dd
+ inc(chunkIndex); // cc
+ inc(chunkIndex); // bb
+ inc(chunkIndex);
+ end;
+ $59: // Key signature FF 59 02 df mi
+ begin
+ inc(chunkIndex); // $02
+ inc(chunkIndex); // df
+ inc(chunkIndex); // mi
+ inc(chunkIndex);
+ end;
+ $7F: // Sequence specific Meta-event
+ begin
+ inc(chunkIndex);
+ len := ReadVarLength;
+ str := ReadString(len);
+ end;
+ else // unknown meta event
+ }
+ begin
+ New(midiEvent);
+ midiEvent.event := $FF;
+ midiEvent.data1 := chunkIndex^; // type is stored in data1
+ midiEvent.dticks := dtime;
+
+ inc(chunkIndex);
+ len := ReadVarLength;
+ midiEvent.str := ReadString(len);
+ currentTrack.putEvent(midiEvent);
+
+ case midiEvent.data1 of
+ $51:
+ begin
+ us_per_quarter :=
+ (integer(byte(midiEvent.str[1])) shl 16 +
+ integer(byte(midiEvent.str[2])) shl 8 +
+ integer(byte(midiEvent.str[3])));
+ FBpm := 60000000 div us_per_quarter;
+ FusPerTick := us_per_quarter / deltaTicks;
+ end;
+ end;
+ end;
+// end;
+ end
+ else
+ begin
+ // these are all midi events
+ New(midiEvent);
+ midiEvent.event := event;
+ midiEvent.dticks := dtime;
+// inc(chunkIndex);
+ case event of
+ $80..$8F, // note off
+ $90..$9F, // note on
+ $A0..$AF, // key aftertouch
+ $B0..$BF, // control change
+ $E0..$EF: // pitch wheel change
+ begin
+ midiEvent.data1 := chunkIndex^; inc(chunkIndex);
+ midiEvent.data2 := chunkIndex^; inc(chunkIndex);
+ end;
+ $C0..$CF, // program change
+ $D0..$DF: // channel aftertouch
+ begin
+ midiEvent.data1 := chunkIndex^; inc(chunkIndex);
+ end;
+ else
+ // error
+ end;
+ currentTrack.putEvent(midiEvent);
+ end;
+ end;
+ end;
+end;
+
+
+function TMidifile.ReadVarLength: integer;
+var
+ i: integer;
+ b: byte;
+begin
+ b := 128;
+ i := 0;
+ while b > 127 do
+ begin
+ i := i shl 7;
+ b := chunkIndex^;
+ i := i + b and $7F;
+ inc(chunkIndex);
+ end;
+ result := i;
+end;
+
+function TMidifile.ReadString(l: integer): string;
+var
+ s: PChar;
+ i: integer;
+begin
+ GetMem(s, l + 1); ;
+ s[l] := chr(0);
+ for i := 0 to l - 1 do
+ begin
+ s[i] := Chr(chunkIndex^);
+ inc(chunkIndex);
+ end;
+ result := string(s);
+end;
+
+procedure TMidifile.ReadFile;
+var
+ i: integer;
+begin
+ for i := 0 to Tracks.Count - 1 do
+ TMidiTrack(Tracks.Items[i]).Free;
+ Tracks.Clear;
+ chunkType := illegal;
+
+ AssignFile(midiFile, FFilename);
+ FileMode := 0;
+ Reset(midiFile);
+ while not eof(midiFile) do
+ ReadChunk;
+ CloseFile(midiFile);
+ numberTracks := Tracks.Count;
+end;
+
+function KeyToStr(key: integer): string;
+var
+ n: integer;
+ str: string;
+begin
+ n := key mod 12;
+ case n of
+ 0: str := 'C';
+ 1: str := 'C#';
+ 2: str := 'D';
+ 3: str := 'D#';
+ 4: str := 'E';
+ 5: str := 'F';
+ 6: str := 'F#';
+ 7: str := 'G';
+ 8: str := 'G#';
+ 9: str := 'A';
+ 10: str := 'A#';
+ 11: str := 'B';
+ end;
+ Result := str + IntToStr(key div 12);
+end;
+
+function IntToLenStr(val: integer; len: integer): string;
+var
+ str: string;
+begin
+ str := IntToStr(val);
+ while Length(str) < len do
+ str := '0' + str;
+ Result := str;
+end;
+
+function MyTimeToStr(val: integer): string;
+ var
+ hour: integer;
+ min: integer;
+ sec: integer;
+ msec: integer;
+begin
+ msec := val mod 1000;
+ sec := val div 1000;
+ min := sec div 60;
+ sec := sec mod 60;
+ hour := min div 60;
+ min := min mod 60;
+ Result := IntToStr(hour) + ':' + IntToLenStr(min, 2) + ':' + IntToLenStr(sec, 2) + '.' + IntToLenStr(msec, 3);
+end;
+
+function TMidiFIle.GetFusPerTick : Double;
+begin
+ Result := FusPerTick;
+end;
+
+function TMidiFIle.GetTrackLength:integer;
+var i,length : integer;
+ time : extended;
+begin
+ length := 0;
+ for i := 0 to Tracks.Count - 1 do
+ if TMidiTrack(Tracks.Items[i]).getTrackLength > length then
+ length := TMidiTrack(Tracks.Items[i]).getTrackLength;
+ time := length * FusPerTick;
+ time := time / 1000.0;
+ result := round(time);
+end;
+
+function TMidiFIle.Ready: boolean;
+var i : integer;
+begin
+ result := true;
+ for i := 0 to Tracks.Count - 1 do
+ if not TMidiTrack(Tracks.Items[i]).isready then
+ result := false;
+end;
+
+procedure TMidiFile.OnTrackReady;
+begin
+ if ready then
+ if assigned(FOnUpdateEvent) then FOnUpdateEvent(self);
+end;
+
+procedure TMidiFile.WndProc(var Msg : TMessage);
+begin
+ with MSG do
+ begin
+ case Msg of
+ WM_MULTIMEDIA_TIMER:
+ begin
+ try
+ MidiTimer(self);
+ except
+ Application.HandleException(Self);
+ end;
+ end;
+ else
+ begin
+ Result := DefWindowProc(MIDIFileHandle, Msg, wParam, lParam);
+ end;
+ end;
+ end;
+end;
+
+procedure Register;
+begin
+ RegisterComponents('Synth', [TMidiFile]);
+end;
+
+end.
+
diff --git a/Game/Code/lib/midi/MidiScope.pas b/Game/Code/lib/midi/MidiScope.pas new file mode 100644 index 00000000..0caa430f --- /dev/null +++ b/Game/Code/lib/midi/MidiScope.pas @@ -0,0 +1,193 @@ +{
+ Shows a large black area where midi note/controller events are shown
+ just to monitor midi activity (for the MidiPlayer)
+
+ version 1.0 first release
+
+ for comments/bugs
+ F.Bouwmans
+ fbouwmans@spiditel.nl
+
+ if you think this component is nice and you use it, sent me a short email.
+ I've seen that other of my components have been downloaded a lot, but I've
+ got no clue wether they are actually used.
+ Don't worry because you are free to use these components
+}
+
+unit MidiScope;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
+
+type
+ TMidiScope = class(TGraphicControl)
+ private
+ { Private declarations }
+ protected
+ { Protected declarations }
+ notes : array[0..15,0..127] of integer;
+ controllers : array[0..15,0..17] of integer;
+ aftertouch : array[0..15,0..127] of integer;
+
+ selectedChannel : integer;
+
+ procedure PaintSlide(ch,pos,val: integer);
+
+ procedure NoteOn(channel, note, speed : integer);
+ procedure Controller(channel,number,value : integer);
+ procedure AfterTch(channel, note, value : integer);
+
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ procedure MidiEvent(event,data1,data2 : integer);
+ procedure Paint; override;
+ published
+ { Published declarations }
+ end;
+
+
+procedure Register;
+
+const
+ BarHeight = 16;
+ BarHeightInc = BarHeight+2;
+ BarWidth = 3;
+ BarWidthInc = BarWidth+1;
+ HeightDiv = 128 div BarHeight;
+
+implementation
+
+uses Midicons;
+
+procedure Register;
+begin
+ RegisterComponents('Synth', [TMidiScope]);
+end;
+
+constructor TMidiScope.Create(AOwner: TComponent);
+var
+ i,j : integer;
+begin
+ inherited Create(AOwner);
+ Height := BarHeightinc * 16 + 4;
+ Width := 147*BarWidthInc + 4 + 20; // for channel number
+ for i := 0 to 15 do
+ begin
+ for j := 0 to 127 do
+ begin
+ notes[i,j] := 0;
+ aftertouch[i,j] := 0;
+ end;
+ end;
+ for i := 0 to 17 do
+ begin
+ for j := 0 to 15 do
+ controllers[i,j] := 0;
+ end;
+end;
+
+procedure TMidiScope.PaintSlide(ch,pos,val: integer);
+var x,y:integer;
+begin
+ Canvas.Brush.Color := clBlack;
+ Canvas.Pen.color := clBlack;
+ x := pos * BarWidthInc + 2;
+ y := 2 + ch * BarHeightInc;
+ Canvas.Rectangle(x, y, x+BarWidthInc, y+BarHeightInc);
+ Canvas.Brush.Color := clGreen;
+ Canvas.Pen.Color := clGreen;
+ Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv )), x + BarWidth, y + BarHeight)
+end;
+
+procedure TMidiScope.Paint;
+var i,j : integer;
+x : integer;
+begin
+ Canvas.Brush.color := clBlack;
+ Canvas.Rectangle(0,0,Width,Height);
+ Canvas.Pen.Color := clGreen;
+ x := 128*BarWidthInc+2;
+ Canvas.MoveTo(x,0);
+ Canvas.LineTo(x,Height);
+ x := 148*BarWIdthInc+2;
+ canvas.Font.Color := clGreen;
+ for i := 0 to 15 do
+ Canvas.TextOut(x,((i+1)*BarHeightInc) - Canvas.font.size-3,IntToStr(i+1));
+ canvas.Pen.color := clBlack;
+ begin
+ for j := 0 to 127 do
+ begin
+ PaintSlide(i,j,notes[i,j]);
+ end;
+ for j := 0 to 17 do
+ begin
+ PaintSlide(i,j+129,controllers[i,j]);
+ end;
+ end;
+end;
+procedure TMidiScope.NoteOn(channel, note, speed : integer);
+begin
+ notes[channel,note] := speed;
+ PaintSlide(channel,note,notes[channel,note]);
+end;
+procedure TMidiScope.AfterTch(channel, note, value : integer);
+begin
+ aftertouch[channel,note] := value;
+end;
+
+procedure TMidiScope.Controller(channel,number,value : integer);
+var i : integer;
+begin
+ if number < 18 then
+ begin
+ controllers[channel,number] := value;
+ PaintSlide(channel,number+129,value);
+ end
+ else if number >= $7B then
+ begin
+ // all notes of for channel
+ for i := 0 to 127 do
+ begin
+ if notes[channel,i] > 0 then
+ begin
+ notes[channel,i] := 0;
+ PaintSlide(channel,i,0);
+ end;
+ end;
+ end;
+end;
+
+procedure TMidiScope.MidiEvent(event,data1,data2 : integer);
+begin
+ case (event AND $F0) of
+ MIDI_NOTEON :
+ begin
+ NoteOn((event AND $F),data1,data2);
+ end;
+ MIDI_NOTEOFF:
+ begin
+ NoteOn((event AND $F),data1,0);
+ end;
+ MIDI_CONTROLCHANGE :
+ begin
+ Controller((event AND $F),data1,data2);
+ end;
+ MIDI_CHANAFTERTOUCH:
+ begin
+ Controller((Event AND $F),16,Data1);
+ end;
+ MIDI_PITCHBEND:
+ begin
+ begin
+ Controller((Event AND $F),17,data2);
+ end;
+ end;
+ MIDI_KEYAFTERTOUCH:
+ begin
+ end;
+ end;
+end;
+end.
diff --git a/Game/Code/lib/midi/Midicons.pas b/Game/Code/lib/midi/Midicons.pas new file mode 100644 index 00000000..41dda9e1 --- /dev/null +++ b/Game/Code/lib/midi/Midicons.pas @@ -0,0 +1,42 @@ +{ $Header: /MidiComp/MIDICONS.PAS 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+
+{ MIDI Constants }
+unit Midicons;
+
+interface
+
+uses Messages;
+
+const
+ MIDI_ALLNOTESOFF = $7B;
+ MIDI_NOTEON = $90;
+ MIDI_NOTEOFF = $80;
+ MIDI_KEYAFTERTOUCH = $a0;
+ MIDI_CONTROLCHANGE = $b0;
+ MIDI_PROGRAMCHANGE = $c0;
+ MIDI_CHANAFTERTOUCH = $d0;
+ MIDI_PITCHBEND = $e0;
+ MIDI_SYSTEMMESSAGE = $f0;
+ MIDI_BEGINSYSEX = $f0;
+ MIDI_MTCQUARTERFRAME = $f1;
+ MIDI_SONGPOSPTR = $f2;
+ MIDI_SONGSELECT = $f3;
+ MIDI_ENDSYSEX = $F7;
+ MIDI_TIMINGCLOCK = $F8;
+ MIDI_START = $FA;
+ MIDI_CONTINUE = $FB;
+ MIDI_STOP = $FC;
+ MIDI_ACTIVESENSING = $FE;
+ MIDI_SYSTEMRESET = $FF;
+
+ MIM_OVERFLOW = WM_USER; { Input buffer overflow }
+ MOM_PLAYBACK_DONE = WM_USER+1; { Timed playback complete }
+
+
+implementation
+
+end.
diff --git a/Game/Code/lib/midi/Midiin.pas b/Game/Code/lib/midi/Midiin.pas new file mode 100644 index 00000000..32a17c51 --- /dev/null +++ b/Game/Code/lib/midi/Midiin.pas @@ -0,0 +1,712 @@ +{ $Header: /MidiComp/Midiin.pas 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+unit MidiIn;
+
+{
+ Properties:
+ DeviceID: Windows numeric device ID for the MIDI input device.
+ Between 0 and NumDevs-1.
+ Read-only while device is open, exception when changed while open
+
+ MIDIHandle: The input handle to the MIDI device.
+ 0 when device is not open
+ Read-only, runtime-only
+
+ MessageCount: Number of input messages waiting in input buffer
+
+ Capacity: Number of messages input buffer can hold
+ Defaults to 1024
+ Limited to (64K/event size)
+ Read-only when device is open (exception when changed while open)
+
+ SysexBufferSize: Size in bytes of each sysex buffer
+ Defaults to 10K
+ Minimum 0K (no buffers), Maximum 64K-1
+
+ SysexBufferCount: Number of sysex buffers
+ Defaults to 16
+ Minimum 0 (no buffers), Maximum (avail mem/SysexBufferSize)
+ Check where these buffers are allocated?
+
+ SysexOnly: True to ignore all non-sysex input events. May be changed while
+ device is open. Handy for patch editors where you have lots of short MIDI
+ events on the wire which you are always going to ignore anyway.
+
+ DriverVersion: Version number of MIDI device driver. High-order byte is
+ major version, low-order byte is minor version.
+
+ ProductName: Name of product (e.g. 'MPU 401 In')
+
+ MID and PID: Manufacturer ID and Product ID, see
+ "Manufacturer and Product IDs" in MMSYSTEM.HLP for list of possible values.
+
+ Methods:
+ GetMidiEvent: Read Midi event at the head of the FIFO input buffer.
+ Returns a TMyMidiEvent object containing MIDI message data, timestamp,
+ and sysex data if applicable.
+ This method automatically removes the event from the input buffer.
+ It makes a copy of the received sysex buffer and puts the buffer back
+ on the input device.
+ The TMyMidiEvent object must be freed by calling MyMidiEvent.Free.
+
+ Open: Opens device. Note no input will appear until you call the Start
+ method.
+
+ Close: Closes device. Any pending system exclusive output will be cancelled.
+
+ Start: Starts receiving MIDI input.
+
+ Stop: Stops receiving MIDI input.
+
+ Events:
+ OnMidiInput: Called when MIDI input data arrives. Use the GetMidiEvent to
+ get the MIDI input data.
+
+ OnOverflow: Called if the MIDI input buffer overflows. The caller must
+ clear the buffer before any more MIDI input can be received.
+
+ Notes:
+ Buffering: Uses a circular buffer, separate pointers for next location
+ to fill and next location to empty because a MIDI input interrupt may
+ be adding data to the buffer while the buffer is being read. Buffer
+ pointers wrap around from end to start of buffer automatically. If
+ buffer overflows then the OnBufferOverflow event is triggered and no
+ further input will be received until the buffer is emptied by calls
+ to GetMidiEvent.
+
+ Sysex buffers: There are (SysexBufferCount) buffers on the input device.
+ When sysex events arrive these buffers are removed from the input device and
+ added to the circular buffer by the interrupt handler in the DLL. When the sysex events
+ are removed from the circular buffer by the GetMidiEvent method the buffers are
+ put back on the input. If all the buffers are used up there will be no
+ more sysex input until at least one sysex event is removed from the input buffer.
+ In other words if you're expecting lots of sysex input you need to set the
+ SysexBufferCount property high enough so that you won't run out of
+ input buffers before you get a chance to read them with GetMidiEvent.
+
+ If the synth sends a block of sysex that's longer than SysexBufferSize it
+ will be received as separate events.
+ TODO: Component derived from this one that handles >64K sysex blocks cleanly
+ and can stream them to disk.
+
+ Midi Time Code (MTC) and Active Sensing: The DLL is currently hardcoded
+ to filter these short events out, so that we don't spend all our time
+ processing them.
+ TODO: implement a filter property to select the events that will be filtered
+ out.
+}
+
+interface
+
+uses
+ Classes, SysUtils, WinTypes, Messages, WinProcs, MMSystem, MidiDefs, MidiType,
+ MidiCons, Circbuf, Delphmcb;
+
+type
+ MidiInputState = (misOpen, misClosed, misCreating, misDestroying);
+ EMidiInputError = class(Exception);
+
+ {-------------------------------------------------------------------}
+ TMidiInput = class(TComponent)
+ private
+ Handle: THandle; { Window handle used for callback notification }
+ FDeviceID: Word; { MIDI device ID }
+ FMIDIHandle: HMIDIIn; { Handle to input device }
+ FState: MidiInputState; { Current device state }
+
+ FError: Word;
+ FSysexOnly: Boolean;
+
+ { Stuff from MIDIINCAPS }
+ FDriverVersion: Version;
+ FProductName: string;
+ FMID: Word; { Manufacturer ID }
+ FPID: Word; { Product ID }
+
+ { Queue }
+ FCapacity: Word; { Buffer capacity }
+ PBuffer: PCircularBuffer; { Low-level MIDI input buffer created by Open method }
+ FNumdevs: Word; { Number of input devices on system }
+
+ { Events }
+ FOnMIDIInput: TNotifyEvent; { MIDI Input arrived }
+ FOnOverflow: TNotifyEvent; { Input buffer overflow }
+ { TODO: Some sort of error handling event for MIM_ERROR }
+
+ { Sysex }
+ FSysexBufferSize: Word;
+ FSysexBufferCount: Word;
+ MidiHdrs: Tlist;
+
+ PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
+
+ protected
+ procedure Prepareheaders;
+ procedure UnprepareHeaders;
+ procedure AddBuffers;
+ procedure SetDeviceID(DeviceID: Word);
+ procedure SetProductName(NewProductName: string);
+ function GetEventCount: Word;
+ procedure SetSysexBufferSize(BufferSize: Word);
+ procedure SetSysexBufferCount(BufferCount: Word);
+ procedure SetSysexOnly(bSysexOnly: Boolean);
+ function MidiInErrorString(WError: Word): string;
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ property MIDIHandle: HMIDIIn read FMIDIHandle;
+
+ property DriverVersion: Version read FDriverVersion;
+ property MID: Word read FMID; { Manufacturer ID }
+ property PID: Word read FPID; { Product ID }
+
+ property Numdevs: Word read FNumdevs;
+
+ property MessageCount: Word read GetEventCount;
+ { TODO: property to select which incoming messages get filtered out }
+
+ procedure Open;
+ procedure Close;
+ procedure Start;
+ procedure Stop;
+ { Get first message in input queue }
+ function GetMidiEvent: TMyMidiEvent;
+ procedure MidiInput(var Message: TMessage);
+
+ { Some functions to decode and classify incoming messages would be good }
+
+ published
+
+ { TODO: Property editor with dropdown list of product names }
+ property ProductName: string read FProductName write SetProductName;
+
+ property DeviceID: Word read FDeviceID write SetDeviceID default 0;
+ property Capacity: Word read FCapacity write FCapacity default 1024;
+ property Error: Word read FError;
+ property SysexBufferSize: Word
+ read FSysexBufferSize
+ write SetSysexBufferSize
+ default 10000;
+ property SysexBufferCount: Word
+ read FSysexBufferCount
+ write SetSysexBufferCount
+ default 16;
+ property SysexOnly: Boolean
+ read FSysexOnly
+ write SetSysexOnly
+ default False;
+
+ { Events }
+ property OnMidiInput: TNotifyEvent read FOnMidiInput write FOnMidiInput;
+ property OnOverflow: TNotifyEvent read FOnOverflow write FOnOverflow;
+
+ end;
+
+procedure Register;
+
+{====================================================================}
+implementation
+
+uses Controls,
+ Forms,
+ Graphics;
+
+(* Not used in Delphi 3
+{ This is the callback procedure in the external DLL.
+ It's used when midiInOpen is called by the Open method.
+ There are special requirements and restrictions for this callback
+ procedure (see midiInOpen in MMSYSTEM.HLP) so it's impractical to
+ make it an object method }
+{$IFDEF WIN32}
+function midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: UINT;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
+{$ELSE}
+procedure midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: Word;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD); far; external 'DELPHMID';
+{$ENDIF}
+*)
+{-------------------------------------------------------------------}
+
+constructor TMidiInput.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FState := misCreating;
+
+ FSysexOnly := False;
+ FNumDevs := midiInGetNumDevs;
+ MidiHdrs := nil;
+
+ { Set defaults }
+ if (FNumDevs > 0) then
+ SetDeviceID(0);
+ FCapacity := 1024;
+ FSysexBufferSize := 4096;
+ FSysexBufferCount := 16;
+
+ { Create the window for callback notification }
+ if not (csDesigning in ComponentState) then
+ begin
+ Handle := AllocateHwnd(MidiInput);
+ end;
+
+ FState := misClosed;
+
+end;
+
+{-------------------------------------------------------------------}
+{ Close the device if it's open }
+
+destructor TMidiInput.Destroy;
+begin
+ if (FMidiHandle <> 0) then
+ begin
+ Close;
+ FMidiHandle := 0;
+ end;
+
+ if (PCtlInfo <> nil) then
+ GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
+
+ DeallocateHwnd(Handle);
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------}
+{ Convert the numeric return code from an MMSYSTEM function to a string
+ using midiInGetErrorText. TODO: These errors aren't very helpful
+ (e.g. "an invalid parameter was passed to a system function") so
+ sort out some proper error strings. }
+
+function TMidiInput.MidiInErrorString(WError: Word): string;
+var
+ errorDesc: PChar;
+begin
+ errorDesc := nil;
+ try
+ errorDesc := StrAlloc(MAXERRORLENGTH);
+ if midiInGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
+ result := StrPas(errorDesc)
+ else
+ result := 'Specified error number is out of range';
+ finally
+ if errorDesc <> nil then StrDispose(errorDesc);
+ end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the sysex buffer size, fail if device is already open }
+
+procedure TMidiInput.SetSysexBufferSize(BufferSize: Word);
+begin
+ if FState = misOpen then
+ raise EMidiInputError.Create('Change to SysexBufferSize while device was open')
+ else
+ { TODO: Validate the sysex buffer size. Is this necessary for WIN32? }
+ FSysexBufferSize := BufferSize;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the sysex buffer count, fail if device is already open }
+
+procedure TMidiInput.SetSysexBuffercount(Buffercount: Word);
+begin
+ if FState = misOpen then
+ raise EMidiInputError.Create('Change to SysexBuffercount while device was open')
+ else
+ { TODO: Validate the sysex buffer count }
+ FSysexBuffercount := Buffercount;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the Sysex Only flag to eliminate unwanted short MIDI input messages }
+
+procedure TMidiInput.SetSysexOnly(bSysexOnly: Boolean);
+begin
+ FSysexOnly := bSysexOnly;
+ { Update the interrupt handler's copy of this property }
+ if PCtlInfo <> nil then
+ PCtlInfo^.SysexOnly := bSysexOnly;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the Device ID to select a new MIDI input device
+ Note: If no MIDI devices are installed, throws an 'Invalid Device ID' exception }
+
+procedure TMidiInput.SetDeviceID(DeviceID: Word);
+var
+ MidiInCaps: TMidiInCaps;
+begin
+ if FState = misOpen then
+ raise EMidiInputError.Create('Change to DeviceID while device was open')
+ else
+ if (DeviceID >= midiInGetNumDevs) then
+ raise EMidiInputError.Create('Invalid device ID')
+ else
+ begin
+ FDeviceID := DeviceID;
+
+ { Set the name and other MIDIINCAPS properties to match the ID }
+ FError :=
+ midiInGetDevCaps(DeviceID, @MidiInCaps, sizeof(TMidiInCaps));
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+
+ FProductName := StrPas(MidiInCaps.szPname);
+ FDriverVersion := MidiInCaps.vDriverVersion;
+ FMID := MidiInCaps.wMID;
+ FPID := MidiInCaps.wPID;
+
+ end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the product name and put the matching input device number in FDeviceID.
+ This is handy if you want to save a configured input/output device
+ by device name instead of device number, because device numbers may
+ change if users add or remove MIDI devices.
+ Exception if input device with matching name not found,
+ or if input device is open }
+
+procedure TMidiInput.SetProductName(NewProductName: string);
+var
+ MidiInCaps: TMidiInCaps;
+ testDeviceID: Word;
+ testProductName: string;
+begin
+ if FState = misOpen then
+ raise EMidiInputError.Create('Change to ProductName while device was open')
+ else
+ { Don't set the name if the component is reading properties because
+ the saved Productname will be from the machine the application was compiled
+ on, which may not be the same for the corresponding DeviceID on the user's
+ machine. The FProductname property will still be set by SetDeviceID }
+ if not (csLoading in ComponentState) then
+ begin
+ begin
+ for testDeviceID := 0 to (midiInGetNumDevs - 1) do
+ begin
+ FError :=
+ midiInGetDevCaps(testDeviceID, @MidiInCaps, sizeof(TMidiInCaps));
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+ testProductName := StrPas(MidiInCaps.szPname);
+ if testProductName = NewProductName then
+ begin
+ FProductName := NewProductName;
+ Break;
+ end;
+ end;
+ if FProductName <> NewProductName then
+ raise EMidiInputError.Create('MIDI Input Device ' +
+ NewProductName + ' not installed ')
+ else
+ SetDeviceID(testDeviceID);
+ end;
+ end;
+end;
+
+
+{-------------------------------------------------------------------}
+{ Get the sysex buffers ready }
+
+procedure TMidiInput.PrepareHeaders;
+var
+ ctr: Word;
+ MyMidiHdr: TMyMidiHdr;
+begin
+ if (FSysexBufferCount > 0) and (FSysexBufferSize > 0)
+ and (FMidiHandle <> 0) then
+ begin
+ Midihdrs := TList.Create;
+ for ctr := 1 to FSysexBufferCount do
+ begin
+ { Initialize the header and allocate buffer memory }
+ MyMidiHdr := TMyMidiHdr.Create(FSysexBufferSize);
+
+ { Store the address of the MyMidiHdr object in the contained MIDIHDR
+ structure so we can get back to the object when a pointer to the
+ MIDIHDR is received.
+ E.g. see TMidiOutput.Output method }
+ MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
+
+ { Get MMSYSTEM's blessing for this header }
+ FError := midiInPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
+ sizeof(TMIDIHDR));
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+
+ { Save it in our list }
+ MidiHdrs.Add(MyMidiHdr);
+ end;
+ end;
+
+end;
+
+{-------------------------------------------------------------------}
+{ Clean up from PrepareHeaders }
+
+procedure TMidiInput.UnprepareHeaders;
+var
+ ctr: Word;
+begin
+ if (MidiHdrs <> nil) then { will be Nil if 0 sysex buffers }
+ begin
+ for ctr := 0 to MidiHdrs.Count - 1 do
+ begin
+ FError := midiInUnprepareHeader(FMidiHandle,
+ TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
+ sizeof(TMIDIHDR));
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+ TMyMidiHdr(MidiHdrs.Items[ctr]).Free;
+ end;
+ MidiHdrs.Free;
+ MidiHdrs := nil;
+ end;
+end;
+
+{-------------------------------------------------------------------}
+{ Add sysex buffers, if required, to input device }
+
+procedure TMidiInput.AddBuffers;
+var
+ ctr: Word;
+begin
+ if MidiHdrs <> nil then { will be Nil if 0 sysex buffers }
+ begin
+ if MidiHdrs.Count > 0 then
+ begin
+ for ctr := 0 to MidiHdrs.Count - 1 do
+ begin
+ FError := midiInAddBuffer(FMidiHandle,
+ TMyMidiHdr(MidiHdrs.Items[ctr]).hdrPointer,
+ sizeof(TMIDIHDR));
+ if FError <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+ end;
+ end;
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiInput.Open;
+var
+ hMem: THandle;
+begin
+ try
+ { Create the buffer for the MIDI input messages }
+ if (PBuffer = nil) then
+ PBuffer := CircBufAlloc(FCapacity);
+
+ { Create the control info for the DLL }
+ if (PCtlInfo = nil) then
+ begin
+ PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
+ PctlInfo^.hMem := hMem;
+ end;
+ PctlInfo^.pBuffer := PBuffer;
+ Pctlinfo^.hWindow := Handle; { Control's window handle }
+ PCtlInfo^.SysexOnly := FSysexOnly;
+ FError := midiInOpen(@FMidiHandle, FDeviceId,
+ DWORD(@midiHandler),
+ DWORD(PCtlInfo),
+ CALLBACK_FUNCTION);
+
+ if (FError <> MMSYSERR_NOERROR) then
+ { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+
+ { Get sysex buffers ready }
+ PrepareHeaders;
+
+ { Add them to the input }
+ AddBuffers;
+
+ FState := misOpen;
+
+ except
+ if PBuffer <> nil then
+ begin
+ CircBufFree(PBuffer);
+ PBuffer := nil;
+ end;
+
+ if PCtlInfo <> nil then
+ begin
+ GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
+ PCtlInfo := nil;
+ end;
+
+ end;
+
+end;
+
+{-------------------------------------------------------------------}
+
+function TMidiInput.GetMidiEvent: TMyMidiEvent;
+var
+ thisItem: TMidiBufferItem;
+begin
+ if (FState = misOpen) and
+ CircBufReadEvent(PBuffer, @thisItem) then
+ begin
+ Result := TMyMidiEvent.Create;
+ with thisItem do
+ begin
+ Result.Time := Timestamp;
+ if (Sysex = nil) then
+ begin
+ { Short message }
+ Result.MidiMessage := LoByte(LoWord(Data));
+ Result.Data1 := HiByte(LoWord(Data));
+ Result.Data2 := LoByte(HiWord(Data));
+ Result.Sysex := nil;
+ Result.SysexLength := 0;
+ end
+ else
+ { Long Sysex message }
+ begin
+ Result.MidiMessage := MIDI_BEGINSYSEX;
+ Result.Data1 := 0;
+ Result.Data2 := 0;
+ Result.SysexLength := Sysex^.dwBytesRecorded;
+ if Sysex^.dwBytesRecorded <> 0 then
+ begin
+ { Put a copy of the sysex buffer in the object }
+ GetMem(Result.Sysex, Sysex^.dwBytesRecorded);
+ StrMove(Result.Sysex, Sysex^.lpData, Sysex^.dwBytesRecorded);
+ end;
+
+ { Put the header back on the input buffer }
+ FError := midiInPrepareHeader(FMidiHandle, Sysex,
+ sizeof(TMIDIHDR));
+ if Ferror = 0 then
+ FError := midiInAddBuffer(FMidiHandle,
+ Sysex, sizeof(TMIDIHDR));
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+ end;
+ end;
+ CircbufRemoveEvent(PBuffer);
+ end
+ else
+ { Device isn't open, return a nil event }
+ Result := nil;
+end;
+
+{-------------------------------------------------------------------}
+
+function TMidiInput.GetEventCount: Word;
+begin
+ if FState = misOpen then
+ Result := PBuffer^.EventCount
+ else
+ Result := 0;
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiInput.Close;
+begin
+ if FState = misOpen then
+ begin
+ FState := misClosed;
+
+ { MidiInReset cancels any pending output.
+ Note that midiInReset causes an MIM_LONGDATA callback for each sysex
+ buffer on the input, so the callback function and Midi input buffer
+ should still be viable at this stage.
+ All the resulting MIM_LONGDATA callbacks will be completed by the time
+ MidiInReset returns, though. }
+ FError := MidiInReset(FMidiHandle);
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+
+ { Remove sysex buffers from input device and free them }
+ UnPrepareHeaders;
+
+ { Close the device (finally!) }
+ FError := MidiInClose(FMidiHandle);
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+
+ FMidiHandle := 0;
+
+ if (PBuffer <> nil) then
+ begin
+ CircBufFree(PBuffer);
+ PBuffer := nil;
+ end;
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiInput.Start;
+begin
+ if FState = misOpen then
+ begin
+ FError := MidiInStart(FMidiHandle);
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiInput.Stop;
+begin
+ if FState = misOpen then
+ begin
+ FError := MidiInStop(FMidiHandle);
+ if Ferror <> MMSYSERR_NOERROR then
+ raise EMidiInputError.Create(MidiInErrorString(FError));
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiInput.MidiInput(var Message: TMessage);
+{ Triggered by incoming message from DLL.
+ Note DLL has already put the message in the queue }
+begin
+ case Message.Msg of
+ mim_data:
+ { Trigger the user's MIDI input event, if they've specified one and
+ we're not in the process of closing the device. The check for
+ GetEventCount > 0 prevents unnecessary event calls where the user has
+ already cleared all the events from the input buffer using a GetMidiEvent
+ loop in the OnMidiInput event handler }
+ if Assigned(FOnMIDIInput) and (FState = misOpen)
+ and (GetEventCount > 0) then
+ FOnMIDIInput(Self);
+
+ mim_Overflow: { input circular buffer overflow }
+ if Assigned(FOnOverflow) and (FState = misOpen) then
+ FOnOverflow(Self);
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Register;
+begin
+ RegisterComponents('Synth', [TMIDIInput]);
+end;
+
+end.
+
diff --git a/Game/Code/lib/midi/Midiout.pas b/Game/Code/lib/midi/Midiout.pas new file mode 100644 index 00000000..91b75073 --- /dev/null +++ b/Game/Code/lib/midi/Midiout.pas @@ -0,0 +1,600 @@ +{ $Header: /MidiComp/MidiOut.pas 2 10/06/97 7:33 Davec $ }
+
+{ Written by David Churcher <dchurcher@cix.compulink.co.uk>,
+ released to the public domain. }
+
+{ Thanks very much to Fred Kohler for the Technology code. }
+
+unit MidiOut;
+
+{
+ MIDI Output component.
+
+ Properties:
+ DeviceID: Windows numeric device ID for the MIDI output device.
+ Between 0 and (midioutGetNumDevs-1), or MIDI_MAPPER (-1).
+ Special value MIDI_MAPPER specifies output to the Windows MIDI mapper
+ Read-only while device is open, exception if changed while open
+
+ MIDIHandle: The output handle to the MIDI device.
+ 0 when device is not open
+ Read-only, runtime-only
+
+ ProductName: Name of the output device product that corresponds to the
+ DeviceID property (e.g. 'MPU 401 out').
+ You can write to this while the device is closed to select a particular
+ output device by name (the DeviceID property will change to match).
+ Exception if this property is changed while the device is open.
+
+ Numdevs: Number of MIDI output devices installed on the system. This
+ is the value returned by midiOutGetNumDevs. It's included for
+ completeness.
+
+ Technology: Type of technology used by the MIDI device. You can set this
+ property to one of the values listed for OutportTech (below) and the component
+ will find an appropriate MIDI device. For example:
+ MidiOutput.Technology := opt_FMSynth;
+ will set MidiInput.DeviceID to the MIDI device ID of the FM synth, if one
+ is installed. If no such device is available an exception is raised,
+ see MidiOutput.SetTechnology.
+
+ See the MIDIOUTCAPS entry in MMSYSTEM.HLP for descriptions of the
+ following properties:
+ DriverVersion
+ Voices
+ Notes
+ ChannelMask
+ Support
+
+ Error: The error code for the last MMSYSTEM error. See the MMSYSERR_
+ entries in MMSYSTEM.INT for possible values.
+
+ Methods:
+ Open: Open MIDI device specified by DeviceID property for output
+
+ Close: Close device
+
+ PutMidiEvent(Event:TMyMidiEvent): Output a note or sysex message to the
+ device. This method takes a TMyMidiEvent object and transmits it.
+ Notes:
+ 1. If the object contains a sysex event the OnMidiOutput event will
+ be triggered when the sysex transmission is complete.
+ 2. You can queue up multiple blocks of system exclusive data for
+ transmission by chucking them at this method; they will be
+ transmitted as quickly as the device can manage.
+ 3. This method will not free the TMyMidiEvent object, the caller
+ must do that. Any sysex data in the TMyMidiEvent is copied before
+ transmission so you can free the TMyMidiEvent immediately after
+ calling PutMidiEvent, even if output has not yet finished.
+
+ PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte): Output a short
+ MIDI message. Handy when you can't be bothered to build a TMyMidiEvent.
+ If the message you're sending doesn't use Data1 or Data2, set them to 0.
+
+ PutLong(TheSysex: Pointer; msgLength: Word): Output sysex data.
+ SysexPointer: Pointer to sysex data to send
+ msgLength: Length of sysex data.
+ This is handy when you don't have a TMyMidiEvent.
+
+ SetVolume(Left: Word, Right: Word): Set the volume of the
+ left and right channels on the output device (only on internal devices?).
+ 0xFFFF is maximum volume. If the device doesn't support separate
+ left/right volume control, the value of the Left parameter will be used.
+ Check the Support property to see whether the device supports volume
+ control. See also other notes on volume control under midiOutSetVolume()
+ in MMSYSTEM.HLP.
+
+ Events:
+ OnMidiOutput: Procedure called when output of a system exclusive block
+ is completed.
+
+ Notes:
+ I haven't implemented any methods for midiOutCachePatches and
+ midiOutCacheDrumpatches, mainly 'cause I don't have any way of testing
+ them. Does anyone really use these?
+}
+
+interface
+
+uses
+ SysUtils, WinTypes, WinProcs, Messages, Classes, Controls, Forms,
+ MMSystem, Circbuf, MidiType, MidiDefs, Delphmcb;
+
+type
+ midioutputState = (mosOpen, mosClosed);
+ EmidioutputError = class(Exception);
+
+ { These are the equivalent of constants prefixed with mod_
+ as defined in MMSystem. See SetTechnology }
+ OutPortTech = (
+ opt_None, { none }
+ opt_MidiPort, { output port }
+ opt_Synth, { generic internal synth }
+ opt_SQSynth, { square wave internal synth }
+ opt_FMSynth, { FM internal synth }
+ opt_Mapper); { MIDI mapper }
+ TechNameMap = array[OutPortTech] of string[18];
+
+
+const
+ TechName: TechNameMap = (
+ 'None', 'MIDI Port', 'Generic Synth', 'Square Wave Synth',
+ 'FM Synth', 'MIDI Mapper');
+
+{-------------------------------------------------------------------}
+type
+ TMidiOutput = class(TComponent)
+ protected
+ Handle: THandle; { Window handle used for callback notification }
+ FDeviceID: Integer; { MIDI device ID }
+ FMIDIHandle: Hmidiout; { Handle to output device }
+ FState: midioutputState; { Current device state }
+ PCtlInfo: PMidiCtlInfo; { Pointer to control info for DLL }
+
+ PBuffer: PCircularBuffer; { Output queue for PutTimedEvent, set by Open }
+
+ FError: Word; { Last MMSYSTEM error }
+
+ { Stuff from midioutCAPS }
+ FDriverVersion: Version; { Driver version from midioutGetDevCaps }
+ FProductName: string; { product name }
+ FTechnology: OutPortTech; { Type of MIDI output device }
+ FVoices: Word; { Number of voices (internal synth) }
+ FNotes: Word; { Number of notes (internal synth) }
+ FChannelMask: Word; { Bit set for each MIDI channels that the
+ device responds to (internal synth) }
+ FSupport: DWORD; { Technology supported (volume control,
+ patch caching etc. }
+ FNumdevs: Word; { Number of MIDI output devices on system }
+
+
+ FOnMIDIOutput: TNotifyEvent; { Sysex output finished }
+
+ procedure MidiOutput(var Message: TMessage);
+ procedure SetDeviceID(DeviceID: Integer);
+ procedure SetProductName(NewProductName: string);
+ procedure SetTechnology(NewTechnology: OutPortTech);
+ function midioutErrorString(WError: Word): string;
+
+ public
+ { Properties }
+ property MIDIHandle: Hmidiout read FMIDIHandle;
+ property DriverVersion: Version { Driver version from midioutGetDevCaps }
+ read FDriverVersion;
+ property Technology: OutPortTech { Type of MIDI output device }
+ read FTechnology
+ write SetTechnology
+ default opt_Synth;
+ property Voices: Word { Number of voices (internal synth) }
+ read FVoices;
+ property Notes: Word { Number of notes (internal synth) }
+ read FNotes;
+ property ChannelMask: Word { Bit set for each MIDI channels that the }
+ read FChannelMask; { device responds to (internal synth) }
+ property Support: DWORD { Technology supported (volume control, }
+ read FSupport; { patch caching etc. }
+ property Error: Word read FError;
+ property Numdevs: Word read FNumdevs;
+
+ { Methods }
+ function Open: Boolean; virtual;
+ function Close: Boolean; virtual;
+ procedure PutMidiEvent(theEvent: TMyMidiEvent); virtual;
+ procedure PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte); virtual;
+ procedure PutLong(TheSysex: Pointer; msgLength: Word); virtual;
+ procedure SetVolume(Left: Word; Right: Word);
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ { Some functions to decode and classify incoming messages would be nice }
+
+ published
+ { TODO: Property editor with dropdown list of product names }
+ property ProductName: string read FProductName write SetProductName;
+
+ property DeviceID: Integer read FDeviceID write SetDeviceID default 0;
+ { TODO: midiOutGetVolume? Or two properties for Left and Right volume?
+ Is it worth it??
+ midiOutMessage?? Does anyone use this? }
+
+ { Events }
+ property Onmidioutput: TNotifyEvent
+ read FOnmidioutput
+ write FOnmidioutput;
+ end;
+
+procedure Register;
+
+{-------------------------------------------------------------------}
+implementation
+
+(* Not used in Delphi 3
+
+{ This is the callback procedure in the external DLL.
+ It's used when midioutOpen is called by the Open method.
+ There are special requirements and restrictions for this callback
+ procedure (see midioutOpen in MMSYSTEM.HLP) so it's impractical to
+ make it an object method }
+{$IFDEF WIN32}
+function midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: UINT;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD): Boolean; stdcall; external 'DELMID32.DLL';
+{$ELSE}
+function midiHandler(
+ hMidiIn: HMidiIn;
+ wMsg: Word;
+ dwInstance: DWORD;
+ dwParam1: DWORD;
+ dwParam2: DWORD): Boolean; far; external 'DELPHMID.DLL';
+{$ENDIF}
+*)
+
+{-------------------------------------------------------------------}
+
+constructor Tmidioutput.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FState := mosClosed;
+ FNumdevs := midiOutGetNumDevs;
+
+ { Create the window for callback notification }
+ if not (csDesigning in ComponentState) then
+ begin
+ Handle := AllocateHwnd(MidiOutput);
+ end;
+
+end;
+
+{-------------------------------------------------------------------}
+
+destructor Tmidioutput.Destroy;
+begin
+ if FState = mosOpen then
+ Close;
+ if (PCtlInfo <> nil) then
+ GlobalSharedLockedFree(PCtlinfo^.hMem, PCtlInfo);
+ DeallocateHwnd(Handle);
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------}
+{ Convert the numeric return code from an MMSYSTEM function to a string
+ using midioutGetErrorText. TODO: These errors aren't very helpful
+ (e.g. "an invalid parameter was passed to a system function") so
+ some proper error strings would be nice. }
+
+
+function Tmidioutput.midioutErrorString(WError: Word): string;
+var
+ errorDesc: PChar;
+begin
+ errorDesc := nil;
+ try
+ errorDesc := StrAlloc(MAXERRORLENGTH);
+ if midioutGetErrorText(WError, errorDesc, MAXERRORLENGTH) = 0 then
+ result := StrPas(errorDesc)
+ else
+ result := 'Specified error number is out of range';
+ finally
+ if errorDesc <> nil then StrDispose(errorDesc);
+ end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the output device ID and change the other properties to match }
+
+procedure Tmidioutput.SetDeviceID(DeviceID: Integer);
+var
+ midioutCaps: TmidioutCaps;
+begin
+ if FState = mosOpen then
+ raise EmidioutputError.Create('Change to DeviceID while device was open')
+ else
+ if (DeviceID >= midioutGetNumDevs) and (DeviceID <> MIDI_MAPPER) then
+ raise EmidioutputError.Create('Invalid device ID')
+ else
+ begin
+ FDeviceID := DeviceID;
+
+ { Set the name and other midioutCAPS properties to match the ID }
+ FError :=
+ midioutGetDevCaps(DeviceID, @midioutCaps, sizeof(TmidioutCaps));
+ if Ferror > 0 then
+ raise EmidioutputError.Create(midioutErrorString(FError));
+
+ with midiOutCaps do
+ begin
+ FProductName := StrPas(szPname);
+ FDriverVersion := vDriverVersion;
+ FTechnology := OutPortTech(wTechnology);
+ FVoices := wVoices;
+ FNotes := wNotes;
+ FChannelMask := wChannelMask;
+ FSupport := dwSupport;
+ end;
+
+ end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the product name property and put the matching output device number
+ in FDeviceID.
+ This is handy if you want to save a configured output/output device
+ by device name instead of device number, because device numbers may
+ change if users install or remove MIDI devices.
+ Exception if output device with matching name not found,
+ or if output device is open }
+
+procedure Tmidioutput.SetProductName(NewProductName: string);
+var
+ midioutCaps: TmidioutCaps;
+ testDeviceID: Integer;
+ testProductName: string;
+begin
+ if FState = mosOpen then
+ raise EmidioutputError.Create('Change to ProductName while device was open')
+ else
+ { Don't set the name if the component is reading properties because
+ the saved Productname will be from the machine the application was compiled
+ on, which may not be the same for the corresponding DeviceID on the user's
+ machine. The FProductname property will still be set by SetDeviceID }
+ if not (csLoading in ComponentState) then
+ begin
+ { Loop uses -1 to test for MIDI_MAPPER as well }
+ for testDeviceID := -1 to (midioutGetNumDevs - 1) do
+ begin
+ FError :=
+ midioutGetDevCaps(testDeviceID, @midioutCaps, sizeof(TmidioutCaps));
+ if Ferror > 0 then
+ raise EmidioutputError.Create(midioutErrorString(FError));
+ testProductName := StrPas(midioutCaps.szPname);
+ if testProductName = NewProductName then
+ begin
+ FProductName := NewProductName;
+ Break;
+ end;
+ end;
+ if FProductName <> NewProductName then
+ raise EmidioutputError.Create('MIDI output Device ' +
+ NewProductName + ' not installed')
+ else
+ SetDeviceID(testDeviceID);
+ end;
+end;
+
+{-------------------------------------------------------------------}
+{ Set the output technology property and put the matching output device
+ number in FDeviceID.
+ This is handy, for example, if you want to be able to switch between a
+ sound card and a MIDI port }
+
+procedure TMidiOutput.SetTechnology(NewTechnology: OutPortTech);
+var
+ midiOutCaps: TMidiOutCaps;
+ testDeviceID: Integer;
+ testTechnology: OutPortTech;
+begin
+ if FState = mosOpen then
+ raise EMidiOutputError.Create(
+ 'Change to Product Technology while device was open')
+ else
+ begin
+ { Loop uses -1 to test for MIDI_MAPPER as well }
+ for testDeviceID := -1 to (midiOutGetNumDevs - 1) do
+ begin
+ FError :=
+ midiOutGetDevCaps(testDeviceID,
+ @midiOutCaps, sizeof(TMidiOutCaps));
+ if Ferror > 0 then
+ raise EMidiOutputError.Create(MidiOutErrorString(FError));
+ testTechnology := OutPortTech(midiOutCaps.wTechnology);
+ if testTechnology = NewTechnology then
+ begin
+ FTechnology := NewTechnology;
+ Break;
+ end;
+ end;
+ if FTechnology <> NewTechnology then
+ raise EMidiOutputError.Create('MIDI output technology ' +
+ TechName[NewTechnology] + ' not installed')
+ else
+ SetDeviceID(testDeviceID);
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+function Tmidioutput.Open: Boolean;
+var
+ hMem: THandle;
+begin
+ Result := False;
+ try
+ { Create the control info for the DLL }
+ if (PCtlInfo = nil) then
+ begin
+ PCtlInfo := GlobalSharedLockedAlloc(Sizeof(TMidiCtlInfo), hMem);
+ PctlInfo^.hMem := hMem;
+ end;
+
+ Pctlinfo^.hWindow := Handle; { Control's window handle }
+
+ FError := midioutOpen(@FMidiHandle, FDeviceId,
+ DWORD(@midiHandler),
+ DWORD(PCtlInfo),
+ CALLBACK_FUNCTION);
+{ FError := midioutOpen(@FMidiHandle, FDeviceId,
+ Handle,
+ DWORD(PCtlInfo),
+ CALLBACK_WINDOW); }
+ if (FError <> 0) then
+ { TODO: use CreateFmtHelp to add MIDI device name/ID to message }
+ raise EmidioutputError.Create(midioutErrorString(FError))
+ else
+ begin
+ Result := True;
+ FState := mosOpen;
+ end;
+
+ except
+ if PCtlInfo <> nil then
+ begin
+ GlobalSharedLockedFree(PCtlInfo^.hMem, PCtlInfo);
+ PCtlInfo := nil;
+ end;
+ end;
+
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiOutput.PutShort(MidiMessage: Byte; Data1: Byte; Data2: Byte);
+var
+ thisMsg: DWORD;
+begin
+ thisMsg := DWORD(MidiMessage) or
+ (DWORD(Data1) shl 8) or
+ (DWORD(Data2) shl 16);
+
+ FError := midiOutShortMsg(FMidiHandle, thisMsg);
+ if Ferror > 0 then
+ raise EmidioutputError.Create(midioutErrorString(FError));
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiOutput.PutLong(TheSysex: Pointer; msgLength: Word);
+{ Notes: This works asynchronously; you send your sysex output by
+calling this function, which returns immediately. When the MIDI device
+driver has finished sending the data the MidiOutPut function in this
+component is called, which will in turn call the OnMidiOutput method
+if the component user has defined one. }
+{ TODO: Combine common functions with PutTimedLong into subroutine }
+
+var
+ MyMidiHdr: TMyMidiHdr;
+begin
+ { Initialize the header and allocate buffer memory }
+ MyMidiHdr := TMyMidiHdr.Create(msgLength);
+
+ { Copy the data over to the MidiHdr buffer
+ We can't just use the caller's PChar because the buffer memory
+ has to be global, shareable, and locked. }
+ StrMove(MyMidiHdr.SysexPointer, TheSysex, msgLength);
+
+ { Store the MyMidiHdr address in the header so we can find it again quickly
+ (see the MidiOutput proc) }
+ MyMidiHdr.hdrPointer^.dwUser := DWORD(MyMidiHdr);
+
+ { Get MMSYSTEM's blessing for this header }
+ FError := midiOutPrepareHeader(FMidiHandle, MyMidiHdr.hdrPointer,
+ sizeof(TMIDIHDR));
+ if Ferror > 0 then
+ raise EMidiOutputError.Create(MidiOutErrorString(FError));
+
+ { Send it }
+ FError := midiOutLongMsg(FMidiHandle, MyMidiHdr.hdrPointer,
+ sizeof(TMIDIHDR));
+ if Ferror > 0 then
+ raise EMidiOutputError.Create(MidiOutErrorString(FError));
+
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Tmidioutput.PutMidiEvent(theEvent: TMyMidiEvent);
+begin
+ if FState <> mosOpen then
+ raise EMidiOutputError.Create('MIDI Output device not open');
+
+ with theEvent do
+ begin
+ if Sysex = nil then
+ begin
+ PutShort(MidiMessage, Data1, Data2)
+ end
+ else
+ PutLong(Sysex, SysexLength);
+ end;
+end;
+
+{-------------------------------------------------------------------}
+
+function Tmidioutput.Close: Boolean;
+begin
+ Result := False;
+ if FState = mosOpen then
+ begin
+
+ { Note this sends a lot of fast control change messages which some synths can't handle.
+ TODO: Make this optional. }
+{ FError := midioutReset(FMidiHandle);
+ if Ferror <> 0 then
+ raise EMidiOutputError.Create(MidiOutErrorString(FError)); }
+
+ FError := midioutClose(FMidiHandle);
+ if Ferror <> 0 then
+ raise EMidiOutputError.Create(MidiOutErrorString(FError))
+ else
+ Result := True;
+ end;
+
+ FMidiHandle := 0;
+ FState := mosClosed;
+
+end;
+
+{-------------------------------------------------------------------}
+
+procedure TMidiOutput.SetVolume(Left: Word; Right: Word);
+var
+ dwVolume: DWORD;
+begin
+ dwVolume := (DWORD(Left) shl 16) or Right;
+ FError := midiOutSetVolume(DeviceID, dwVolume);
+ if Ferror <> 0 then
+ raise EMidiOutputError.Create(MidiOutErrorString(FError));
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Tmidioutput.midioutput(var Message: TMessage);
+{ Triggered when sysex output from PutLong is complete }
+var
+ MyMidiHdr: TMyMidiHdr;
+ thisHdr: PMidiHdr;
+begin
+ if Message.Msg = Mom_Done then
+ begin
+ { Find the MIDIHDR we used for the output. Message.lParam is its address }
+ thisHdr := PMidiHdr(Message.lParam);
+
+ { Remove it from the output device }
+ midiOutUnprepareHeader(FMidiHandle, thisHdr, sizeof(TMIDIHDR));
+
+ { Get the address of the MyMidiHdr object containing this MIDIHDR structure.
+ We stored this address in the PutLong procedure }
+ MyMidiHdr := TMyMidiHdr(thisHdr^.dwUser);
+
+ { Header and copy of sysex data no longer required since output is complete }
+ MyMidiHdr.Free;
+
+ { Call the user's event handler if any }
+ if Assigned(FOnmidioutput) then
+ FOnmidioutput(Self);
+ end;
+ { TODO: Case for MOM_PLAYBACK_DONE }
+end;
+
+{-------------------------------------------------------------------}
+
+procedure Register;
+begin
+ RegisterComponents('Synth', [Tmidioutput]);
+end;
+
+end.
+
diff --git a/Game/Code/lib/midi/midiComp.cfg b/Game/Code/lib/midi/midiComp.cfg new file mode 100644 index 00000000..2ee4ea3a --- /dev/null +++ b/Game/Code/lib/midi/midiComp.cfg @@ -0,0 +1,35 @@ +-$A+
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J+
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$Y-
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-LE"d:\program files\borland\delphi5\Projects\Bpl"
+-LN"d:\program files\borland\delphi5\Projects\Bpl"
diff --git a/Game/Code/lib/midi/midiComp.dpk b/Game/Code/lib/midi/midiComp.dpk new file mode 100644 index 00000000..7c403eae --- /dev/null +++ b/Game/Code/lib/midi/midiComp.dpk @@ -0,0 +1,45 @@ +package midiComp;
+
+{$R *.RES}
+{$R 'MidiFile.dcr'}
+{$R 'Midiin.dcr'}
+{$R 'Midiout.dcr'}
+{$R 'MidiScope.dcr'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO OFF}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'Midi related components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+ vcl50;
+
+contains
+ Miditype in 'Miditype.pas',
+ Mididefs in 'Mididefs.pas',
+ MidiFile in 'MidiFile.pas',
+ Midiin in 'Midiin.pas',
+ Midiout in 'Midiout.pas',
+ MidiScope in 'MidiScope.pas',
+ Midicons in 'Midicons.pas';
+
+end.
diff --git a/Game/Code/lib/midi/midiComp.res b/Game/Code/lib/midi/midiComp.res Binary files differnew file mode 100644 index 00000000..91fb756e --- /dev/null +++ b/Game/Code/lib/midi/midiComp.res diff --git a/Game/Code/lib/midi/readme.txt b/Game/Code/lib/midi/readme.txt new file mode 100644 index 00000000..5e4207f6 --- /dev/null +++ b/Game/Code/lib/midi/readme.txt @@ -0,0 +1,60 @@ +
+Midi components
+ TMidiFile, TMidiScope
+ TMidiIn and TMidiOut of david Churcher are included because they are used in
+ the demo application
+
+Freeware.
+
+100% source code, demo application.
+
+Included Components/Classes
+
+TMidiFile, read a midifile and have the contents available in memory
+ list of Tracks, track is list of events
+
+
+TMidiScope, show all activity on a midi device
+
+TMidiIn and TMidiOut of David Churcher are included because they are used
+in the demo application
+
+Midiplayer is a demo application which plays a midifile on a midi output
+ it is build fairly simple with the included components. The timer is used
+ to time the midievents. The timing is therefor as good as the windows timer.
+
+
+ The header of midifile,midiscope contains help information on the properties/functions
+ The example Midiplayer gives a good idea how to use the components
+
+Installation
+ open midiComp.dpk with file/open
+ compile and install the package
+ make sure that the directory where the files are located is in the library path
+ (tools/environment options/library)
+
+to run the demo
+ open project1.dpr in the demo directory and press run.
+
+
+
+history
+1.0 18-1-1999 first release
+
+1.1 5-3-1999 update
+ added some functions for display purposes
+ improved demo to include event viewer
+ bpm can be changed
+
+1.2 24-2-2000 update
+ added some functions to see the length of a song and ready function to know when playback is ready
+
+for comments/bugs in these components:
+
+Frans Bouwmans
+fbouwmans@spiditel.nl
+
+I'm busy building a software music synthesizer, which will be available in source
+to the public. If you are interrested in helping me with certain soundmodules
+(effects, filters, sound generators) just sent me an email.
+
diff --git a/Game/Code/lib/requirements.txt b/Game/Code/lib/requirements.txt new file mode 100644 index 00000000..ebaffea7 --- /dev/null +++ b/Game/Code/lib/requirements.txt @@ -0,0 +1,48 @@ +Not Included in SVN ( to many potential updates )
+---------------------------------------------------------------------------
+
+Jedi-sdl
+ http://sourceforge.net/projects/jedi-sdl
+ Make sure to download VERSION 1, beta...
+ not version 0.5
+
+
+Included in SVN ..
+---------------------------------------------------------------------------
+
+pngImage
+ http://pngdelphi.sourceforge.net/
+
+BASS.pas
+ http://www.un4seen.com/download.php?bass23
+
+zlportio
+ http://www.specosoft.com/en/download.html
+
+ffmpeg
+ http://www.iversenit.dk/dev/ffmpeg-headers/
+
+SQLLite Wrapper
+ http://www.itwriting.com/sqlitesimple.php
+
+======================================
+For LINUX build
+======================================
+On top of the above pas files, you will need development libraries for them.
+
+here are the instructions needed to compile on ubunty ( 7.04 )
+
+ffmpeg :
+ sudo apt-get install libavcodec-dev libavformat-dev
+
+sqlite :
+ sudo apt-get install libsqlite3-dev
+
+sdl development libraries :
+ sudo apt-get install libsdl-ttf2.0-dev libsdl-image1.2-dev
+ THERE WILL be more of them... oops I forgot to list them :P
+
+For the Lazy... who use Debian or Ubuntu.... here is a single line
+ sudo apt-get install libavcodec-dev libavformat-dev libsqlite3-dev libsdl-ttf2.0-dev libsdl-image1.2-dev
+
+
\ No newline at end of file diff --git a/Game/Code/lib/zlportio/README.TXT b/Game/Code/lib/zlportio/README.TXT new file mode 100644 index 00000000..137f5c07 --- /dev/null +++ b/Game/Code/lib/zlportio/README.TXT @@ -0,0 +1,27 @@ +
+ZLPortIO
+Copyright (C) 2001 Zloba Alexander
+http://www.specosoft.com
+Description
+-----------
+ This unit allow your application direct access port input and output under
+ all versions of Microsoft Windows,
+
+Terms of Use
+------------
+
+This software is provided "as is", without any guarantee made
+as to its suitability or fitness for any particular use. It may
+contain bugs, so use of this tool is at your own risk. We take
+no responsilbity for any damage that may unintentionally be caused
+through its use.
+
+Reporting Problems
+------------------
+
+If you encounter problems, please visit http://www.specosoft.com
+and download the latest version to see if the issue has been resolved.
+If not, please send a bug report to:
+
+ zal@specosoft.com
+
diff --git a/Game/Code/lib/zlportio/Sys/zlportio.sys b/Game/Code/lib/zlportio/Sys/zlportio.sys Binary files differnew file mode 100644 index 00000000..a897a020 --- /dev/null +++ b/Game/Code/lib/zlportio/Sys/zlportio.sys diff --git a/Game/Code/lib/zlportio/ddkint.pas b/Game/Code/lib/zlportio/ddkint.pas new file mode 100644 index 00000000..2b70ee54 --- /dev/null +++ b/Game/Code/lib/zlportio/ddkint.pas @@ -0,0 +1,253 @@ +{ -----------------------------------------------------------------------------}
+{ Copyright 2000-2001, Zloba Alexander. All Rights Reserved. }
+{ This unit can be freely used and distributed in commercial and private }
+{ environments, provided this notice is not modified in any way. }
+{ -----------------------------------------------------------------------------}
+{ Feel free to contact me if you have any questions, comments or suggestions at}
+{ zal@specosoft.com (Zloba Alexander) }
+{ You can always find the latest version of this unit at: }
+{ http://www.specosoft.com }
+
+{ -----------------------------------------------------------------------------}
+{ Date last modified: 08/10/2001 }
+{ -----------------------------------------------------------------------------}
+{ Description: }
+{ This unit include service function to work with NT drivers and some }
+{ constant from ntddk.h }
+{------------------------------------------------------------------------------}
+{ Revision History: }
+{ 1.00: + First public release }
+{ 1.10: + added compiler directives for correct compilation }
+{ 1.20: + optimized code }
+{ 1.30: + added constant for compatibility with delphi 3.0 }
+{------------------------------------------------------------------------------}
+
+{$A-,H-}
+unit ddkint;
+
+interface
+uses
+ windows,
+ winsvc;
+
+function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;
+
+const
+ FILE_DEVICE_BEEP = $00000001;
+ FILE_DEVICE_CD_ROM = $00000002;
+ FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003;
+ FILE_DEVICE_CONTROLLER = $00000004;
+ FILE_DEVICE_DATALINK = $00000005;
+ FILE_DEVICE_DFS = $00000006;
+ FILE_DEVICE_DISK = $00000007;
+ FILE_DEVICE_DISK_FILE_SYSTEM = $00000008;
+ FILE_DEVICE_FILE_SYSTEM = $00000009;
+ FILE_DEVICE_INPORT_PORT = $0000000a;
+ FILE_DEVICE_KEYBOARD = $0000000b;
+ FILE_DEVICE_MAILSLOT = $0000000c;
+ FILE_DEVICE_MIDI_IN = $0000000d;
+ FILE_DEVICE_MIDI_OUT = $0000000e;
+ FILE_DEVICE_MOUSE = $0000000f;
+ FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010;
+ FILE_DEVICE_NAMED_PIPE = $00000011;
+ FILE_DEVICE_NETWORK = $00000012;
+ FILE_DEVICE_NETWORK_BROWSER = $00000013;
+ FILE_DEVICE_NETWORK_FILE_SYSTEM= $00000014;
+ FILE_DEVICE_NULL = $00000015;
+ FILE_DEVICE_PARALLEL_PORT = $00000016;
+ FILE_DEVICE_PHYSICAL_NETCARD = $00000017;
+ FILE_DEVICE_PRINTER = $00000018;
+ FILE_DEVICE_SCANNER = $00000019;
+ FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a;
+ FILE_DEVICE_SERIAL_PORT = $0000001b;
+ FILE_DEVICE_SCREEN = $0000001c;
+ FILE_DEVICE_SOUND = $0000001d;
+ FILE_DEVICE_STREAMS = $0000001e;
+ FILE_DEVICE_TAPE = $0000001f;
+ FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020;
+ FILE_DEVICE_TRANSPORT = $00000021;
+ FILE_DEVICE_UNKNOWN = $00000022;
+ FILE_DEVICE_VIDEO = $00000023;
+ FILE_DEVICE_VIRTUAL_DISK = $00000024;
+ FILE_DEVICE_WAVE_IN = $00000025;
+ FILE_DEVICE_WAVE_OUT = $00000026;
+ FILE_DEVICE_8042_PORT = $00000027;
+ FILE_DEVICE_NETWORK_REDIRECTOR = $00000028;
+ FILE_DEVICE_BATTERY = $00000029;
+ FILE_DEVICE_BUS_EXTENDER = $0000002a;
+ FILE_DEVICE_MODEM = $0000002b;
+ FILE_DEVICE_VDM = $0000002c;
+ FILE_DEVICE_MASS_STORAGE = $0000002d;
+ FILE_DEVICE_SMB = $0000002e;
+ FILE_DEVICE_KS = $0000002f;
+ FILE_DEVICE_CHANGER = $00000030;
+ FILE_DEVICE_SMARTCARD = $00000031;
+ FILE_DEVICE_ACPI = $00000032;
+ FILE_DEVICE_DVD = $00000033;
+ FILE_DEVICE_FULLSCREEN_VIDEO = $00000034;
+ FILE_DEVICE_DFS_FILE_SYSTEM = $00000035;
+ FILE_DEVICE_DFS_VOLUME = $00000036;
+ FILE_DEVICE_SERENUM = $00000037;
+ FILE_DEVICE_TERMSRV = $00000038;
+ FILE_DEVICE_KSEC = $00000039;
+
+ FILE_DEVICE_KRNLDRVR = $80ff;
+
+ METHOD_BUFFERED = 0;
+ METHOD_IN_DIRECT = 1;
+ METHOD_OUT_DIRECT = 2;
+ METHOD_NEITHER = 3;
+
+ FILE_ANY_ACCESS = 0;
+ FILE_SPECIAL_ACCESS = (FILE_ANY_ACCESS);
+ FILE_READ_ACCESS = ( $0001 ); // file & pipe
+ FILE_WRITE_ACCESS = ( $0002 ); // file & pipe
+
+ {$IFDEF VER100 or VER110}
+ // for compatibilty with delphi 3.0
+const
+ SERVICE_KERNEL_DRIVER = $00000001;
+ SERVICE_DEMAND_START = $00000003;
+ SERVICE_ERROR_NORMAL = $00000001;
+
+{$ENDIF}
+
+function driverstart(const name:pchar):integer;
+function driverstop(const name:pchar):integer;
+
+// for this function must have Administrators or Power users rigths
+function driverinstall(const path,name:pchar):integer;
+function driverremove(const name:pchar):integer;
+
+
+// exlpanation function
+function messagestring(const error:integer):string;
+
+implementation
+
+function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;
+begin
+ Result := DeviceType shl 16 or Access shl 14 or Func shl 2 or Method;
+end;
+
+
+function driverinstall(const path,name:pchar):integer;
+var hService: SC_HANDLE;
+ hSCMan : SC_HANDLE;
+begin
+
+ Result := 0;
+
+ hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
+ if hSCMan = 0 then begin
+ result := getlasterror;
+ exit;
+ end;
+
+ hService := CreateService(hSCMan, name,name,
+ SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,
+ SERVICE_ERROR_NORMAL, path,
+ nil, nil, nil, nil, nil);
+
+ if (hService = 0) then begin
+ result := getlasterror;
+ CloseServiceHandle(hSCMan);
+ exit;
+ end
+ else
+ CloseServiceHandle(hService);
+ CloseServiceHandle(hSCMan);
+end;
+
+function driverstart(const name:pchar):integer;
+var
+ hService: SC_HANDLE;
+ hSCMan : SC_HANDLE;
+ args:pchar;
+begin
+
+ hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
+ if hSCMan = 0 then begin
+ result := getlasterror;
+ exit;
+ end;
+
+ // get a handle to the service
+ hService := OpenService(hSCMan, name, SERVICE_START);
+ if hService <> 0 then Begin
+ // start the driver
+ args := nil;
+ Result := 0;
+ if integer(StartService(hService, 0, args ))=0 then
+ result := getlasterror;
+ CloseServiceHandle(hService);
+ end
+ else
+ result := getlasterror;
+ CloseServiceHandle(hSCMan);
+end;
+
+function driverstop(const name:pchar):integer;
+Var
+ serviceStatus: TServiceStatus;
+ hService: SC_HANDLE;
+ hSCMan : SC_HANDLE;
+begin
+
+ hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
+ if hSCMan = 0 then begin
+ result := getlasterror;
+ exit;
+ end;
+
+ // get a handle to the service
+ hService := OpenService(hSCMan, Name, SERVICE_STOP);
+ if hService <> 0 then Begin
+ // start the driver
+ Result := 0;
+ if integer(ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus))=0 then
+ result := getlasterror;
+ CloseServiceHandle(hService);
+ end
+ else
+ result := getlasterror;
+ CloseServiceHandle(hSCMan);
+end;
+
+function driverremove(const name:pchar):integer;
+Var
+ hService: SC_HANDLE;
+ hSCMan : SC_HANDLE;
+begin
+
+ hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
+ if hSCMan = 0 then begin
+ result := getlasterror;
+ exit;
+ end;
+
+ // get a handle to the service
+ hService := OpenService(hSCMan, Name, SERVICE_ALL_ACCESS);
+ if hService <> 0 then Begin
+ // remove driver description from the registry
+ Result := 0;
+ if integer(DeleteService(hService)) = 0 then
+ result := getlasterror;
+ CloseServiceHandle(hService);
+ end
+ else
+ result := getlasterror;
+ CloseServiceHandle(hSCMan);
+end;
+
+function messagestring(const error:integer):string;
+var p:pchar;
+begin
+ GetMem(p, 200);
+ FillChar(p^, 200, 0);
+ formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,0,p,199,nil);
+ Result := p;
+ freemem(p,200);
+end;
+
+end.
diff --git a/Game/Code/lib/zlportio/zlportio.pas b/Game/Code/lib/zlportio/zlportio.pas new file mode 100644 index 00000000..2cf57334 --- /dev/null +++ b/Game/Code/lib/zlportio/zlportio.pas @@ -0,0 +1,285 @@ +{ -----------------------------------------------------------------------------}
+{ Copyright 2000-2001, Zloba Alexander. All Rights Reserved. }
+{ This unit can be freely used and distributed in commercial and private }
+{ environments, provided this notice is not modified in any way. }
+{ -----------------------------------------------------------------------------}
+{ Feel free to contact me if you have any questions, comments or suggestions at}
+{ zal@specosoft.com (Zloba Alexander) }
+{ You can always find the latest version of this unit at: }
+{ http://www.specosoft.com }
+
+{ -----------------------------------------------------------------------------}
+{ Date last modified: 08/10/2001 }
+{ -----------------------------------------------------------------------------}
+{ ZLPortIO driver interface unit v1.20 }
+{ -----------------------------------------------------------------------------}
+{ Description: }
+{ This unit allow your application direct access port input and output under }
+{ all versions of Microsoft Windows® }
+{ Depends: }
+{ zlportio.sys ddkint.pas }
+{ You must distribute zlportio.sys with your application }
+{ Procedures and functions: }
+{ procedure zlioportread( const Port,DataType:dword ):dword; }
+{ procedure zlioportwrite( const Port,DataType,Data:dword ); }
+{ }
+{ function portreadb( const Port:dword ):byte; }
+{ function portreadw( const Port:dword ):word; }
+{ function portreadl( const Port:dword ):dword; }
+{ }
+{ procedure portwriteb( const Port:Dword;const Data:byte ); }
+{ procedure portwritew( const Port:dword;const Data:word ); }
+{ procedure portwritel( const Port,Data:dword ); }
+{ }
+{ Examples: }
+{ // get data bits from LPT port }
+{ databits := portreadb( $378 ) }
+{ // set data bits from LPT port }
+{ portwriteb( $378, databits ) }
+{ // The second parameter determine the databus length for operation }
+{ -----------------------------------------------------------------------------}
+{ Revision History: }
+{ 1.00: + First public release }
+{ 1.10: + Added new functions (portreadX,portwriteX) for convenience of usage }
+{ 1.20: + Added new function (zliosetiopm) for enabling direct access to ports}
+{ 1.30: + added compiler directives for correct compilation }
+{ 1.40: + added opportunity to run multiply instances client to driver }
+{ 1.50: - fixed bug with work under win98 }
+{------------------------------------------------------------------------------}
+
+{$A-,H-}
+unit zlportio;
+
+interface
+
+uses windows,
+ sysutils,
+ ddkint;
+
+Const
+ ZLIO_BYTE = 0;
+ ZLIO_WORD = 1;
+ ZLIO_DWORD = 2;
+
+var
+
+// if TRUE then driver was started
+// in other case something wrong
+// We start driver in initialization section of unit.
+
+ ZlIOStarted:boolean = false;
+
+// if TRUE then we can use asm IN,OUT under NT/2000
+// see zliosetiopm for more details
+ ZlIODirect:boolean = false;
+
+// handle to opened driver
+
+ HZLIO:THandle;
+
+
+function portreadb( const Port:dword ):byte;
+function portreadw( const Port:dword ):word;
+function portreadl( const Port:dword ):dword;
+
+procedure portwriteb( const Port:Dword;const Data:byte );
+procedure portwritew( const Port:dword;const Data:word );
+procedure portwritel( const Port,Data:dword );
+
+
+procedure zlioportwrite( const Port,DataType,Data:dword );
+function zlioportread( const Port,DataType:dword ):dword;
+
+// if you need the best perfomance for your IO operations
+// call zliosetiopm(TRUE). This allow your application
+// to use asm command IN,OUT directly in your code.
+
+procedure zliosetiopm( const Direct:boolean );
+
+// internal
+
+function zliostart:boolean;
+procedure zliostop;
+
+
+implementation
+
+const
+ ZLIODriverName='zlportio';
+
+var
+ IOCTL_ZLUNI_PORT_READ:cardinal;
+ IOCTL_ZLUNI_PORT_WRITE:cardinal;
+ IOCTL_ZLUNI_IOPM_ON:cardinal;
+ IOCTL_ZLUNI_IOPM_OFF:cardinal;
+
+type
+TzlIOData = record
+ Port,DataType,Data:dword;
+end;
+
+
+procedure zlioportwrite( const Port,DataType,Data:dword );
+var resdata:TZLIOData;
+ cBR:cardinal;
+begin
+ if (not ZLIODirect) then begin
+ resdata.Port := Port;
+ resdata.Data := Data;
+ resdata.DataType := DataType;
+ if ZLIOStarted then
+ DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_WRITE,@resdata,sizeof(resdata),nil,0,cBR,nil );
+ end
+ else begin
+ Case DataType of
+ ZLIO_BYTE : asm mov edx,Port;mov eax,data;out dx,al; end;
+ ZLIO_WORD : asm mov edx,Port;mov eax,data;out dx,ax; end;
+ ZLIO_DWORD: asm mov edx,Port;mov eax,data;out dx,eax; end;
+ end;
+ end;
+end;
+
+function zlioportread(const Port,DataType:dword):dword;
+var resdata:TZLIOData;
+ cBR:cardinal;i:dword;
+begin
+ if (not ZLIODirect) then begin
+ resdata.Port := Port;
+ resdata.DataType := DataType;
+ if ZLIOStarted then
+ DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_READ,@resdata,sizeof(resdata),@i,sizeof(dword),cBR,nil );
+ end
+ else begin
+ Case DataType of
+ ZLIO_BYTE : asm mov edx,Port;xor eax,eax;in al,dx;mov i,eax; end;
+ ZLIO_WORD : asm mov edx,Port;xor eax,eax;in ax,dx;mov i,eax; end;
+ ZLIO_DWORD: asm mov edx,Port;xor eax,eax;in eax,dx;mov i,eax end;
+ end;
+ end;
+ result := i;
+end;
+
+function portreadb( const Port:dword ):byte;
+begin
+ Result := zlioportread(Port,ZLIO_BYTE);
+end;
+
+function portreadw( const Port:dword ):word;
+begin
+ Result := zlioportread(Port,ZLIO_WORD);
+end;
+
+function portreadl( const Port:dword ):dword;
+begin
+ Result := zlioportread(Port,ZLIO_DWORD);
+end;
+
+procedure portwriteb( const Port:Dword;const Data:byte );
+begin
+ zlioportwrite(Port,ZLIO_BYTE,Data);
+end;
+
+procedure portwritew( const Port:dword;const Data:word );
+begin
+ zlioportwrite(Port,ZLIO_WORD,Data);
+end;
+
+procedure portwritel( const Port,Data:dword );
+begin
+ zlioportwrite(Port,ZLIO_DWORD,Data);
+end;
+
+procedure zliosetiopm( const Direct:boolean );
+var cBR:cardinal;
+begin
+ if Win32Platform=VER_PLATFORM_WIN32_NT then
+ if ZLIOStarted then begin
+ if Direct then
+ DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_ON,nil,0,nil,0,cBR,nil )
+ else
+ DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_OFF,nil,0,nil,0,cBR,nil );
+ ZLIODirect := Direct;
+ end
+end;
+
+
+
+
+function zliostart;
+var dir:shortstring;
+begin
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
+ result := true;
+ exit;
+ end;
+// Result := false;
+ zliostop;
+ dir := ExtractFileDir(ParamStr(0))+'\'+ZLIODriverName+'.sys'#0;
+ driverinstall(pchar(@dir[1]),ZLIODriverName+#0);
+ Result := driverstart(ZLIODriverName) = 0;
+end;
+
+procedure zliostop;
+begin
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then
+ exit;
+ driverstop(ZLIODriverName);
+ driverremove(ZLIODriverName);
+end;
+
+function zlioopen( var Handle:thandle):boolean;
+var cERR:integer;
+ s:string;
+begin
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
+ result := true;
+ exit;
+ end;
+ Result := false;
+ Handle := THandle(-1);
+ Handle := createFile('\\.\ZLPORTIO',
+ GENERIC_READ or GENERIC_WRITE,
+ 0,
+ nil,
+ OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL,
+ 0 );
+ cERR := getlasterror;
+ s := messagestring( cerr);
+ if (cERR = ERROR_ALREADY_EXISTS)or(cERR = ERROR_SUCCESS) then Result := True;
+end;
+
+procedure zlioclose( const Handle:thandle);
+begin
+ if (Win32Platform=VER_PLATFORM_WIN32_NT) then
+ closehandle(Handle);
+end;
+
+
+initialization
+
+IOCTL_ZLUNI_PORT_READ := CTL_CODE(FILE_DEVICE_KRNLDRVR, 1, METHOD_BUFFERED, FILE_ANY_ACCESS);
+IOCTL_ZLUNI_PORT_WRITE := CTL_CODE(FILE_DEVICE_KRNLDRVR, 2, METHOD_BUFFERED, FILE_ANY_ACCESS);
+IOCTL_ZLUNI_IOPM_ON := CTL_CODE(FILE_DEVICE_KRNLDRVR, 3, METHOD_BUFFERED, FILE_ANY_ACCESS);
+IOCTL_ZLUNI_IOPM_OFF := CTL_CODE(FILE_DEVICE_KRNLDRVR, 4, METHOD_BUFFERED, FILE_ANY_ACCESS);
+
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
+ zliostarted := true;
+ zliodirect := true;
+ end
+ else begin
+ if not zlioopen(HZLIO) then begin
+ if zliostart then
+ ZLIOStarted := zlioopen(HZLIO) or (Win32Platform<>VER_PLATFORM_WIN32_NT);
+ end
+ else
+ ZLIOStarted := true;
+ end;
+finalization
+
+if ZLIOStarted then
+ zliostop;
+
+
+
+end.
|