Delphi/Delphi-OpenCV
1
0
Fork 0
mirror of https://github.com/Laex/Delphi-OpenCV.git synced 2024-11-15 07:45:53 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Added ffmpeg sdl2 sample

Browse Source 
Signed-off-by: Laentir Valetov <laex@bk.ru>
This commit is contained in:
Laentir Valetov 2014-07-31 03:21:05 +04:00
parent 3cd4d605c4
commit 562a25f50e
23 changed files with 12311 additions and 293 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
samples/FFMpeg/decoding_encoding/decoding_encoding.dpr
View File

@ -51,7 +51,8 @@ uses
ffm.mathematics,
ffm.avutil,
ffm.opt,
ffm.imgutils;
ffm.imgutils,
ffm.log;
Const
INBUF_SIZE = 4096;
@ -447,7 +448,7 @@ begin
WriteLn('Could not allocate raw picture buffer');
Exit;
end;
// got_output:=0;
// got_output:=0;
(* encode 1 second of video *)
for i := 0 to 24 do
begin
@ -500,14 +501,14 @@ begin
BlockWrite(f, pkt.data^, pkt.size);
av_free_packet(pkt);
end;
Inc(i);
inc(i);
end;
(* add sequence end code to have a real mpeg file *)
BlockWrite(f, endcode, sizeof(endcode));
Close(f);
// avcodec_close(c);
// avcodec_close(c);
av_free(c);
// av_freep(frame^.data[0]);
// av_freep(frame^.data[0]);
av_frame_free(frame);
end;
@ -552,7 +553,7 @@ begin
else
WriteLn(format('Saving frame %3d', [frame_count]));
(* the picture is allocated by the decoder, no need to free it *)
pgm_save(frame^.data[0], frame^.linesize[0], avctx^.width, avctx^.height, Format(outfilename, [frame_count]));
pgm_save(frame^.data[0], frame^.linesize[0], avctx^.width, avctx^.height, format(outfilename, [frame_count]));
inc(frame_count);
end;
if Assigned(pkt^.data) then
@ -650,11 +651,24 @@ begin
av_frame_free(frame);
end;
procedure avlog(ptr: Pointer; level: Integer; fmt: PAnsiChar; vl: pva_list); cdecl;
Var
line: array [0 .. 1023] of AnsiChar;
print_prefix: Integer;
A:AnsiString;
begin
print_prefix := 1;
av_log_format_line(ptr, level, fmt, vl, @line, sizeof(line), print_prefix);
A:=Trim(AnsiString(line));
Writeln(A);
end;
Var
output_type: String;
begin
try
av_log_set_callback(avlog);
(* register all the codecs *)
avcodec_register_all();
if ParamCount = 0 then

1
samples/FFMpeg/decoding_encoding/decoding_encoding.dproj
View File

@ -76,6 +76,7 @@
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<Debugger_RunParams>h264</Debugger_RunParams>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>

14
samples/FFMpeg/ffm_SDL2_VCL_player/ffm_SDL2_VCL_player.dpr Normal file
View File

@ -0,0 +1,14 @@
program ffm_SDL2_VCL_player;
uses
Vcl.Forms,
uMainForm in 'uMainForm.pas' {MainForm};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

131
samples/FFMpeg/ffm_SDL2_VCL_player/ffm_SDL2_VCL_player.dproj Normal file
View File

@ -0,0 +1,131 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{400A9D75-6BD4-4E27-A2F0-25E5DB6EBC97}</ProjectGuid>
<ProjectVersion>15.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>ffm_SDL2_VCL_player.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<VerInfo_Locale>1049</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<SanitizedProjectName>ffm_SDL2_VCL_player</SanitizedProjectName>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>..\..\..\bin\$(Platform)</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<DCC_UsePackage>dxSkinOffice2007BlackRS19;JvGlobus;JvMM;JvManagedThreads;dxSkinLiquidSkyRS19;cxBarEditItemRS19;OverbyteIcsDXE5Run;FireDACPgDriver;dxWizardControlRS19;JvCrypt;dxPScxCommonRS19;dxThemeRS19;tmswizdXE5;XiButtonXE4;cxGridRS19;dxPScxExtCommonRS19;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;JvNet;cxSchedulerRS19;JvDotNetCtrls;DbxCommonDriver;vclimg;dbxcds;dxFlowChartRS19;DatasnapConnectorsFreePascal;JvXPCtrls;dxdbtrRS19;dxSkinSpringTimeRS19;vcldb;dxdborRS19;dxDockingRS19;dxSkinsdxDLPainterRS19;cxSpreadSheetRS19;dxtrmdRS19;dxSpellCheckerRS19;CustomIPTransport;dxTileControlRS19;dsnap;IndyIPServer;dxPSCoreRS19;dxSkinFoggyRS19;IndyCore;cxSchedulerGridRS19;cxPivotGridOLAPRS19;dxSkinStardustRS19;CloudService;FmxTeeUI;FireDACIBDriver;dxSkinXmas2008BlueRS19;JvDB;JvRuntimeDesign;dxSkinValentineRS19;dsnapxml;dxPScxSchedulerLnkRS19;JclDeveloperTools;FireDACDb2Driver;dxSkinDarkSideRS19;dxSkinLondonLiquidSkyRS19;dxBarExtDBItemsRS19;dxTabbedMDIRS19;OpenCV200;dxSkinOffice2013WhiteRS19;dxSkinSharpRS19;bindcompfmx;dxSkinBlueprintRS19;dxSkinOffice2007PinkRS19;vcldbx;cxExportRS19;FireDACODBCDriver;RESTBackendComponents;dxSkinCoffeeRS19;dbrtl;FireDACCommon;bindcomp;inetdb;JvPluginSystem;dxSkinBlueRS19;dxServerModeRS19;DBXOdbcDriver;JvCmp;vclFireDAC;dxSkinMoneyTwinsRS19;JvTimeFramework;xmlrtl;cxPivotGridChartRS19;ibxpress;dxSkiniMaginaryRS19;dxSkinOffice2007GreenRS19;FireDACCommonDriver;bindengine;vclactnband;soaprtl;FMXTee;dxRibbonRS19;bindcompvcl;dxADOServerModeRS19;Jcl;vclie;dxPSdxLCLnkRS19;dxSkinBlackRS19;dxSkinOffice2010BlackRS19;dxSkinSevenClassicRS19;FireDACMSSQLDriver;DBXInformixDriver;Intraweb;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;dxSkinscxSchedulerPainterRS19;inet;dxPSdxFCLnkRS19;dxSkinsdxNavBarPainterRS19;JvPascalInterpreter;FireDACMySQLDriver;soapmidas;vclx;dxPSPrVwRibbonRS19;dxPSDBTeeChartRS19;DBXSybaseASADriver;RESTComponents;dxSkinLilianRS19;dxSkinscxPCPainterRS19;dbexpress;JvBDE;IndyIPClient;dxSkinSharpPlusRS19;cxSchedulerTreeBrowserRS19;dxPScxSSLnkRS19;dxPScxPivotGridLnkRS19;tmsdXE5;FireDACSqliteDriver;FireDACDSDriver;ZComponent;DBXSqliteDriver;dxPSdxDBTVLnkRS19;dxSkinOffice2007BlueRS19;cxDataRS19;cxLibraryRS19;fmx;JvDlgs;IndySystem;TeeDB;tethering;dxPsPrVwAdvRS19;dxSkinHighContrastRS19;inetdbbde;vclib;DataSnapClient;DataSnapProviderClient;DBXSybaseASEDriver;dxmdsRS19;dxSkinOffice2010SilverRS19;dxSkinsdxBarPainterRS19;MetropolisUILiveTile;dxPSdxOCLnkRS19;vcldsnap;fmxFireDAC;DBXDb2Driver;dxSkinDevExpressDarkStyleRS19;DBXOracleDriver;dxBarDBNavRS19;JvCore;vclribbon;dxSkinSilverRS19;dxSkinVS2010RS19;fmxase;vcl;dxPSdxDBOCLnkRS19;DBXMSSQLDriver;IndyIPCommon;CodeSiteExpressPkg;cxTreeListdxBarPopupMenuRS19;dxBarRS19;DataSnapFireDAC;FireDACDBXDriver;JvAppFrm;soapserver;dxFireDACServerModeRS19;inetdbxpress;pkgAdobe;cxEditorsRS19;dxSkinMcSkinRS19;FireDACInfxDriver;JvDocking;adortl;dxSkinOffice2007SilverRS19;JvWizards;FireDACASADriver;dxSkinSevenRS19;JvHMI;dxDBXServerModeRS19;dxLayoutControlRS19;dxPSTeeChartRS19;dxSkinWhiteprintRS19;JvBands;cxPageControlRS19;ZDbc;rtl;dcldxSkinsCoreRS19;DbxClientDriver;dxPScxGridLnkRS19;ZPlain;Tee;JclContainers;cxVerticalGridRS19;cxPageControldxBarPopupMenuRS19;CPortLibDXE;JvSystem;DataSnapNativeClient;svnui;dxSkinsdxRibbonPainterRS19;JvControls;cxPivotGridRS19;dxComnRS19;IndyProtocols;DBXMySQLDriver;dxSkinSummer2008RS19;dxSkinTheAsphaltWorldRS19;viTimeLineDPK;dxPSLnksRS19;tmsxlsdXE5;bindcompdbx;TeeUI;JvJans;JvPrintPreview;JvPageComps;dxSkinDarkRoomRS19;JvStdCtrls;JvCustom;dxSkinPumpkinRS19;dxBarExtItemsRS19;FireDACADSDriver;vcltouch;dxNavBarRS19;ZCore;VclSmp;FireDAC;VCLRESTComponents;dxGDIPlusRS19;DataSnapConnectors;dxCoreRS19;dxPScxVGridLnkRS19;dxPScxTLLnkRS19;dxSkinsCoreRS19;fmxobj;dxSkinGlassOceansRS19;JclVcl;ZParseSql;dxPScxPCProdRS19;svn;dxSkinOffice2010BlueRS19;tmsexdXE5;FireDACOracleDriver;fmxdae;dxorgcRS19;bdertl;cxTreeListRS19;FireDACMSAccDriver;DataSnapIndy10ServerTransport;dxSkinDevExpressStyleRS19;dxSkinCaramelRS19;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>dxSkinOffice2007BlackRS19;dxSkinLiquidSkyRS19;cxBarEditItemRS19;OverbyteIcsDXE5Run;FireDACPgDriver;DBXInterBaseDriver;DataSnapServer;DataSnapCommon;cxSchedulerRS19;DbxCommonDriver;vclimg;dbxcds;dxFlowChartRS19;DatasnapConnectorsFreePascal;dxdbtrRS19;dxSkinSpringTimeRS19;vcldb;dxdborRS19;dxDockingRS19;dxSkinsdxDLPainterRS19;cxSpreadSheetRS19;dxtrmdRS19;dxSpellCheckerRS19;CustomIPTransport;dxTileControlRS19;dsnap;IndyIPServer;dxSkinFoggyRS19;IndyCore;cxSchedulerGridRS19;cxPivotGridOLAPRS19;dxSkinStardustRS19;CloudService;FmxTeeUI;FireDACIBDriver;dxSkinXmas2008BlueRS19;dxSkinValentineRS19;dsnapxml;dxPScxSchedulerLnkRS19;FireDACDb2Driver;dxSkinDarkSideRS19;dxSkinLondonLiquidSkyRS19;dxBarExtDBItemsRS19;dxTabbedMDIRS19;OpenCV200;dxSkinOffice2013WhiteRS19;dxSkinSharpRS19;bindcompfmx;dxSkinBlueprintRS19;dxSkinOffice2007PinkRS19;cxExportRS19;FireDACODBCDriver;RESTBackendComponents;dxSkinCoffeeRS19;dbrtl;FireDACCommon;bindcomp;inetdb;dxSkinBlueRS19;dxServerModeRS19;DBXOdbcDriver;vclFireDAC;dxSkinMoneyTwinsRS19;xmlrtl;cxPivotGridChartRS19;ibxpress;dxSkiniMaginaryRS19;dxSkinOffice2007GreenRS19;FireDACCommonDriver;bindengine;vclactnband;soaprtl;FMXTee;bindcompvcl;dxADOServerModeRS19;vclie;dxSkinBlackRS19;dxSkinOffice2010BlackRS19;dxSkinSevenClassicRS19;FireDACMSSQLDriver;DBXInformixDriver;Intraweb;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;dxSkinscxSchedulerPainterRS19;inet;dxPSdxFCLnkRS19;dxSkinsdxNavBarPainterRS19;FireDACMySQLDriver;soapmidas;vclx;dxPSPrVwRibbonRS19;DBXSybaseASADriver;RESTComponents;dxSkinLilianRS19;dxSkinscxPCPainterRS19;dbexpress;IndyIPClient;dxSkinSharpPlusRS19;cxSchedulerTreeBrowserRS19;dxPScxSSLnkRS19;dxPScxPivotGridLnkRS19;tmsdXE5;FireDACSqliteDriver;FireDACDSDriver;ZComponent;DBXSqliteDriver;dxPSdxDBTVLnkRS19;dxSkinOffice2007BlueRS19;cxDataRS19;fmx;IndySystem;TeeDB;tethering;dxPsPrVwAdvRS19;dxSkinHighContrastRS19;vclib;DataSnapClient;DataSnapProviderClient;DBXSybaseASEDriver;dxmdsRS19;dxSkinOffice2010SilverRS19;dxSkinsdxBarPainterRS19;MetropolisUILiveTile;dxPSdxOCLnkRS19;vcldsnap;fmxFireDAC;DBXDb2Driver;dxSkinDevExpressDarkStyleRS19;DBXOracleDriver;dxBarDBNavRS19;vclribbon;dxSkinSilverRS19;dxSkinVS2010RS19;fmxase;vcl;DBXMSSQLDriver;IndyIPCommon;cxTreeListdxBarPopupMenuRS19;dxBarRS19;DataSnapFireDAC;FireDACDBXDriver;soapserver;dxFireDACServerModeRS19;inetdbxpress;cxEditorsRS19;dxSkinMcSkinRS19;FireDACInfxDriver;adortl;dxSkinOffice2007SilverRS19;FireDACASADriver;dxSkinSevenRS19;dxDBXServerModeRS19;dxLayoutControlRS19;dxSkinWhiteprintRS19;ZDbc;rtl;dcldxSkinsCoreRS19;DbxClientDriver;ZPlain;Tee;cxVerticalGridRS19;cxPageControldxBarPopupMenuRS19;DataSnapNativeClient;dxSkinsdxRibbonPainterRS19;cxPivotGridRS19;dxComnRS19;IndyProtocols;DBXMySQLDriver;dxSkinSummer2008RS19;dxSkinTheAsphaltWorldRS19;tmsxlsdXE5;bindcompdbx;TeeUI;dxSkinDarkRoomRS19;dxSkinPumpkinRS19;dxBarExtItemsRS19;FireDACADSDriver;vcltouch;ZCore;VclSmp;FireDAC;VCLRESTComponents;dxGDIPlusRS19;DataSnapConnectors;dxPScxVGridLnkRS19;dxPScxTLLnkRS19;dxSkinsCoreRS19;fmxobj;dxSkinGlassOceansRS19;ZParseSql;dxPScxPCProdRS19;dxSkinOffice2010BlueRS19;tmsexdXE5;FireDACOracleDriver;fmxdae;cxTreeListRS19;FireDACMSAccDriver;DataSnapIndy10ServerTransport;dxSkinDevExpressStyleRS19;dxSkinCaramelRS19;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;LastCompiledTime=31.07.2014 3:17:54</VerInfo_Keys>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="uMainForm.pas">
<Form>MainForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">ffm_SDL2_VCL_player.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k200.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp200.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment/>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
samples/FFMpeg/ffm_SDL2_VCL_player/ffm_SDL2_VCL_player.res Normal file
View File

Binary file not shown.

196
samples/FFMpeg/ffm_SDL2_VCL_player/ffmpeg_sample_player.dpr Normal file
View File

@ -0,0 +1,196 @@
program ffmpeg_sample_player;
{ .$APPTYPE CONSOLE }
{$R *.res}
{$i ffmpeg.inc}
uses
Winapi.Windows,
System.SysUtils,
System.Classes,
SDL,
ffm.lib,
ffm.ctypes,
ffm.avformat,
ffm.avio,
ffm.avutil,
ffm.buffer,
ffm.dict,
ffm.frame,
ffm.log,
ffm.opt,
ffm.pixfmt,
ffm.rational,
ffm.samplefmt,
ffm.parseutils,
ffm.swscale,
ffm.pixdesc,
ffm.imgutils,
ffm.mem,
ffm.error,
ffm.avfilter,
ffm.buffersink,
ffm.mathematics,
ffm.libavcodec.avcodec,
ffm.buffersrc,
ffm.errno,
uResourcePaths;
var
err: Integer;
filename: AnsiString;
format_context: pAVFormatContext = nil;
video_stream: Integer;
codec_context: pAVCodecContext;
codec: pAVCodec;
screen: pSDL_Surface;
bmp: pSDL_Overlay;
img_convert_context: pSwsContext;
frame: pAVFrame;
packet: TAVPacket;
frame_finished: Integer;
pict: TAVPicture;
rect: TSDL_Rect;
event: TSDL_Event;
const
std_filename = cResourceMedia + 'trailer.avi';
begin
try
if (ParamCount < 1) then
filename := std_filename
else
filename := ParamStr(1);
// Register all available file formats and codecs
av_register_all();
avformat_network_init();
// Init SDL with video support
err := SDL_Init(SDL_INIT_VIDEO);
if (err < 0) then
begin
WriteLn(Format('Unable to init SDL: %s', [SDL_GetError()]));
Halt(1);
end;
// Open video file
err := avformat_open_input(format_context, PAnsiChar(filename), nil, nil);
if (err < 0) then
begin
WriteLn('ffmpeg: Unable to open input file');
Halt(1);
end;
// Retrieve stream information
err := avformat_find_stream_info(format_context, nil);
if (err < 0) then
begin
WriteLn('ffmpeg: Unable to find stream info');
Halt(1);
end;
// Dump information about file onto standard error
av_dump_format(format_context, 0, PAnsiChar(filename), 0);
// Find the first video stream
for video_stream := 0 to format_context^.nb_streams - 1 do
if (format_context^.streams[video_stream]^.codec^.codec_type = AVMEDIA_TYPE_VIDEO) then
break;
if (video_stream = format_context^.nb_streams) then
begin
WriteLn('ffmpeg: Unable to find video stream');
Halt(1);
end;
codec_context := format_context^.streams[video_stream]^.codec;
codec := avcodec_find_decoder(codec_context^.codec_id);
err := avcodec_open2(codec_context, codec, nil);
if (err < 0) then
begin
WriteLn('ffmpeg: Unable to open codec');
Halt(1);
end;
screen := SDL_SetVideoMode(codec_context^.width, codec_context^.height, 0, 0 { SDL_FULLSCREEN } );
if (screen = nil) then
begin
WriteLn('Couldn''t set video mode');
Halt(1);
end;
bmp := SDL_CreateYUVOverlay(codec_context^.width, codec_context^.height, SDL_YV12_OVERLAY, screen);
img_convert_context := sws_getCachedContext(nil, codec_context^.width, codec_context^.height, codec_context^.pix_fmt, codec_context^.width, codec_context^.height, AV_PIX_FMT_YUV420P, SWS_BICUBIC,
nil, nil, nil);
if (img_convert_context = nil) then
begin
WriteLn('Cannot initialize the conversion context');
Halt(1);
end;
frame := avcodec_alloc_frame();
while (av_read_frame(format_context, packet) >= 0) do
begin
if (packet.stream_index = video_stream) then
begin
// Video stream packet
avcodec_decode_video2(codec_context, frame, frame_finished, @packet);
if (frame_finished <> 0) then
begin
SDL_LockYUVOverlay(bmp);
// Convert frame to YV12 pixel format for display in SDL overlay
pByte(pict.data[0]) := pByte(bmp^.pixels[0]);
pByte(pict.data[1]) := pByte(bmp^.pixels[2]); // it's because YV12
pByte(pict.data[2]) := pByte(bmp^.pixels[1]);
pict.linesize[0] := bmp^.pitches[0];
pict.linesize[1] := bmp^.pitches[2];
pict.linesize[2] := bmp^.pitches[1];
sws_scale(img_convert_context, @frame^.data, @frame^.linesize, 0, codec_context^.height, @pict.data, @pict.linesize);
SDL_UnlockYUVOverlay(bmp);
rect.x := 0;
rect.y := 0;
rect.w := codec_context^.width;
rect.h := codec_context^.height;
SDL_DisplayYUVOverlay(bmp, @rect);
end;
end;
// Free the packet that was allocated by av_read_frame
av_free_packet(packet);
// Handling SDL events there
if SDL_PollEvent(@event) <> 0 then
if (event.type_ = SDL_QUITEV) then
break;
end;
sws_freeContext(img_convert_context);
// Free the YUV frame
av_free(frame);
// Close the codec
avcodec_close(codec_context);
// Close the video file
avformat_close_input(&format_context);
avformat_network_deinit;
// Quit SDL
SDL_QUIT();
except
on E: Exception do
WriteLn(E.ClassName, ': ', E.Message);
end;
end.

121
samples/FFMpeg/ffm_SDL2_VCL_player/ffmpeg_sample_player.dproj Normal file
View File

@ -0,0 +1,121 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{036F28BC-83B0-471A-B04B-5E5296551153}</ProjectGuid>
<MainSource>ffmpeg_sample_player.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Console</AppType>
<FrameworkType>None</FrameworkType>
<ProjectVersion>15.4</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_ExeOutput>..\..\..\bin\$(Platform)</DCC_ExeOutput>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<Manifest_File>None</Manifest_File>
<DCC_E>false</DCC_E>
<VerInfo_Locale>1049</VerInfo_Locale>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<DCC_N>false</DCC_N>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_K>false</DCC_K>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=</VerInfo_Keys>
<SanitizedProjectName>ffmpeg_sample_player</SanitizedProjectName>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">ffmpeg_sample_player.dpr</Source>
</Source>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k200.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp200.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Platforms>
<Platform value="OSX32">False</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

BIN
samples/FFMpeg/ffm_SDL2_VCL_player/ffmpeg_sample_player.res Normal file
View File

Binary file not shown.

20
samples/FFMpeg/ffm_SDL2_VCL_player/uMainForm.dfm Normal file
View File

@ -0,0 +1,20 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'MainForm'
ClientHeight = 437
ClientWidth = 589
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
end

182
samples/FFMpeg/ffm_SDL2_VCL_player/uMainForm.pas Normal file
View File

@ -0,0 +1,182 @@
unit uMainForm;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;
Const
WM_PLAYVIDEO = WM_USER + 100;
type
TMainForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure WMPlayVideo(var Message: TMessage); message WM_PLAYVIDEO;
procedure Decode;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
Uses
SDL2,
ffm.avformat,
ffm.avutil,
ffm.frame,
ffm.swscale,
ffm.libavcodec.avcodec,
uResourcePaths;
const
std_filename = cResourceMedia + 'trailer.avi';
pixel_format = SDL_PIXELFORMAT_YV12;
Var
sdlWnd: PSDL_Window;
renderer: PSDL_Renderer;
MooseTexture: pSDL_Texture;
format_context: pAVFormatContext = nil;
video_stream: Integer;
codec_context: pAVCodecContext;
img_convert_context: pSwsContext;
codec: pAVCodec;
pFrame, frame: pAVFrame;
packet: TAVPacket;
frame_finished: Integer;
ImgBufferSize: Integer;
ImgBuffer: PByte;
pict: TAVPicture;
procedure TMainForm.FormActivate(Sender: TObject);
begin
PostMessage(Handle, WM_PLAYVIDEO, 0, 0);
end;
procedure TMainForm.FormCreate(Sender: TObject);
Var
err: Integer;
begin
if (SDL_Init(SDL_INIT_VIDEO or SDL_INIT_NOPARACHUTE) < 0) then
FatalAppExit(0, PChar('Couldn''t initialize SDL: ' + SDL_GetError()));
// SDL_InitSubSystem(SDL_INIT_VIDEO);
sdlWnd := SDL_CreateWindowFrom(Pointer(Handle));
renderer := SDL_CreateRenderer(sdlWnd, -1, SDL_RENDERER_ACCELERATED or SDL_RENDERER_PRESENTVSYNC);
if not Assigned(renderer) then
FatalAppExit(0, PChar('SDL_CreateRenderer Error: ' + SDL_GetError()));
// Register all available file formats and codecs
av_register_all();
avformat_network_init();
// Open video file
Assert(avformat_open_input(format_context, std_filename, nil, nil) >= 0);
// Retrieve stream information
Assert(avformat_find_stream_info(format_context, nil) >= 0);
// Dump information about file onto standard error
av_dump_format(format_context, 0, std_filename, 0);
// Find the first video stream
for video_stream := 0 to format_context^.nb_streams - 1 do
if (format_context^.streams[video_stream]^.codec^.codec_type = AVMEDIA_TYPE_VIDEO) then
break;
Assert(video_stream < format_context^.nb_streams);
codec_context := format_context^.streams[video_stream]^.codec;
codec := avcodec_find_decoder(codec_context^.codec_id);
Assert(avcodec_open2(codec_context, codec, nil) >= 0);
SDL_SetRenderDrawColor(renderer, 0, 0, 0, 255); // Set default colour to black.
Assert(SDL_RenderClear(renderer) >= 0);
MooseTexture := SDL_CreateTexture(renderer, pixel_format, Integer(SDL_TEXTUREACCESS_STREAMING), codec_context^.width,
codec_context^.height);
Assert(Assigned(MooseTexture));
img_convert_context := sws_getCachedContext(nil, codec_context^.width, codec_context^.height, codec_context^.pix_fmt,
codec_context^.width, codec_context^.height, codec_context^.pix_fmt, SWS_BICUBIC, nil, nil, nil);
Assert(Assigned(img_convert_context));
pFrame := avcodec_alloc_frame();
frame := avcodec_alloc_frame();
ImgBufferSize := avpicture_get_size(codec_context^.pix_fmt, codec_context^.width, codec_context^.height);
ImgBuffer := AllocMem(ImgBufferSize);
avpicture_fill(pAVPicture(frame), ImgBuffer, codec_context^.pix_fmt, codec_context^.width, codec_context^.height);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
{TODO: destroy ffmpeg objects}
SDL_DestroyRenderer(renderer);
SDL_DestroyWindow(sdlWnd);
SDL_Quit();
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
SDL_RenderSetViewport(renderer, nil);
end;
procedure TMainForm.WMPlayVideo(var Message: TMessage);
begin
Decode;
end;
procedure TMainForm.Decode;
Var
Next: Boolean;
R: TSDL_Rect;
begin
frame_finished := 1;
repeat
if av_read_frame(format_context, packet) >= 0 then
begin
if (packet.stream_index = video_stream) then
begin
// Video stream packet
avcodec_decode_video2(codec_context, pFrame, frame_finished, @packet);
if (frame_finished <> 0) then
begin
pict.data[0] := frame^.data[0];
pict.data[1] := frame^.data[2];
pict.data[2] := frame^.data[1];
pict.linesize[0] := frame^.linesize[0];
pict.linesize[1] := frame^.linesize[2];
pict.linesize[2] := frame^.linesize[1];
sws_scale(img_convert_context, @pFrame^.data, @pFrame^.linesize, 0, codec_context^.height, @pict.data,
@pict.linesize);
SDL_UpdateTexture(MooseTexture, nil, ImgBuffer, codec_context^.width * SDL_BYTESPERPIXEL(pixel_format));
SDL_RenderClear(renderer);
R.x := ClientRect.Left;
R.y := ClientRect.Top;
R.w := ClientRect.width;
R.h := ClientRect.height;
SDL_RenderCopy(renderer, MooseTexture, nil, @R);
SDL_RenderPresent(renderer);
av_frame_unref(pFrame);
avcodec_get_frame_defaults(pFrame);
end;
end;
av_free_packet(packet);
end;
until frame_finished <> 0;
PostMessage(Handle, WM_PLAYVIDEO, 0, 0);
end;
end.

44
samples/MultiDemo/CameraCaptureFindContours/CameraCaptureAndFindContours.dpr
View File

@ -1,25 +1,25 @@
//*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
//*******************************************************************
// *****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
// *******************************************************************
program CameraCaptureAndFindContours;

44
samples/MultiDemo/HandsDetect/HandsDetect.dpr
View File

@ -1,25 +1,25 @@
//*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Mikhail Grigorev
// email: sleuthhound@gmail.com
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
//*******************************************************************
// *****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Mikhail Grigorev
// email: sleuthhound@gmail.com
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
// *******************************************************************
program HandsDetect;

53
samples/MultiDemo/Squares/Squares.dpr
View File

@ -1,25 +1,25 @@
//*****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
//*******************************************************************
// *****************************************************************
// Delphi-OpenCV Demo
// Copyright (C) 2013 Project Delphi-OpenCV
// ****************************************************************
// Contributor:
// Laentir Valetov
// email:laex@bk.ru
// ****************************************************************
// You may retrieve the latest version of this file at the GitHub,
// located at git://github.com/Laex/Delphi-OpenCV.git
// ****************************************************************
// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1_1Final.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
// *******************************************************************
program Squares;
@ -36,7 +36,7 @@ uses
uResourcePaths;
const
filename = cResourceMedia + 'matchshapes.jpg';
filename = cResourceMedia + 'pic2.bmp';
// pic1.bmp...pic6.bmp
wndname = 'Squares';
@ -81,7 +81,7 @@ begin
sz := cvSize((img^.width AND -2), (img^.height AND -2));
timg := cvCloneImage(img); // make a copy of input image
gray := cvCreateImage(sz, 8, 1);
pyr := cvCreateImage(cvSize(sz.width div 2, sz.height div 2), 8, 3);
pyr := cvCreateImage(cvSize(sz.width div 2, sz.height div 2), timg^.depth, timg^.nChannels);
// create empty sequence that will contain points -
// 4 points per square (the square's vertices)
@ -89,7 +89,8 @@ begin
// select the maximum ROI in the image
// with the width and height divisible by 2
cvSetImageROI(timg, cvRect(0, 0, sz.width, sz.height));
// cvSetImageROI(timg, cvRect(0, 0, sz.width, sz.height));
cvResetImageROI(timg);
// down-scale and upscale the image to filter out the noise
cvPyrDown(timg, pyr, 7);
@ -97,7 +98,7 @@ begin
tgray := cvCreateImage(sz, 8, 1);
// find squares in every color plane of the image
for c := 0 to 2 do
for c := 0 to timg^.nChannels-1 do
begin
// extract the c-th color plane
cvSetImageCOI(timg, c + 1);

19
source/component/ocv.comp.Source.pas
View File

@ -202,6 +202,7 @@ type
FUserName: String;
FURI: string;
FOnNotifyFFMpegPacket: TOnNotifyFFMpegPacket;
FProtocol: TocvIPProtocol;
protected
function GetIPCamTarget: AnsiString;
procedure SetEnabled(Value: Boolean); override;
@ -215,6 +216,7 @@ type
property IP: string read FIP write FIP;
property URI: string read FURI write FURI; { TODO: Need rename }
property Port: Word read FPort write FPort default 554;
property Protocol: TocvIPProtocol read FProtocol write FProtocol default ippRTSP;
property OnFFMpegPacket: TOnNotifyFFMpegPacket read FOnNotifyFFMpegPacket write FOnNotifyFFMpegPacket;
end;
@ -229,6 +231,13 @@ uses
ffm.swscale,
ffm.pixfmt;
const
IPProtocolString: array [TocvIPProtocol] of AnsiString = ( //
'http://', //
'https://', //
'rtsp://' //
);
Type
TocvCaptureThread = class(TocvCustomSourceThread)
private
@ -561,13 +570,6 @@ begin
end;
function TocvIPCamSource.GetIPCamTarget: AnsiString;
const
IPProtocolString: array [TocvIPProtocol] of AnsiString = ( //
'http://', //
'https://', //
'rtsp://' //
);
begin
Result := IPProtocolString[FProtocol];
if Length(Trim(UserName)) <> 0 then
@ -648,6 +650,7 @@ constructor TocvFFMpegIPCamSource.Create(AOwner: TComponent);
begin
inherited;
FPort := 554;
FProtocol := ippRTSP;
if not(csDesigning in ComponentState) then
begin
FSourceThread := TocvFFMpegIPCamSourceThread.Create(Self);
@ -665,7 +668,7 @@ end;
function TocvFFMpegIPCamSource.GetIPCamTarget: AnsiString;
begin
Result := 'rtsp://';
Result := IPProtocolString[FProtocol];
if Length(Trim(UserName)) <> 0 then
Result := Result + AnsiString(Trim(UserName)) + ':' + AnsiString(Trim(Password)) + '@';
Result := Result + AnsiString(IP) + ':' + AnsiString(IntToStr(Port));

410
source/ffmpeg/ffm.log.pas
View File

@ -1,3 +1,22 @@
(*
// * copyright (c) 2006 Michael Niedermayer <michaelni@gmx.at>
// *
// * This file is part of ffm.
// *
// * FFmpeg 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.1 of the License, or (at your option) any later version.
// *
// * FFmpeg 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 FFmpeg; if not, write to the Free Software
// * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*)
unit ffm.log;
{$i ffmpeg.inc}
@ -7,43 +26,23 @@ interface
uses
ffm.opt;
/// *
// * copyright (c) 2006 Michael Niedermayer <michaelni@gmx.at>
// *
// * This file is part of ffm.
// *
// * FFmpeg 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.1 of the License, or (at your option) any later version.
// *
// * FFmpeg 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 FFmpeg; if not, write to the Free Software
// * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
// */
//
// #include <stdarg.h>
// #include "avutil.h"
// #include "attributes.h"
//
Type
TAVClassCategory = (AV_CLASS_CATEGORY_NA = 0, AV_CLASS_CATEGORY_INPUT, AV_CLASS_CATEGORY_OUTPUT, AV_CLASS_CATEGORY_MUXER,
AV_CLASS_CATEGORY_DEMUXER, AV_CLASS_CATEGORY_ENCODER, AV_CLASS_CATEGORY_DECODER, AV_CLASS_CATEGORY_FILTER,
AV_CLASS_CATEGORY_BITSTREAM_FILTER, AV_CLASS_CATEGORY_SWSCALER, AV_CLASS_CATEGORY_SWRESAMPLER, AV_CLASS_CATEGORY_NB);
/// < not part of ABI/API
PVA_LIST = ^VA_LIST;
VA_LIST = array [0 .. 0] of Pointer;
TAVClassCategory = (AV_CLASS_CATEGORY_NA = 0, AV_CLASS_CATEGORY_INPUT, AV_CLASS_CATEGORY_OUTPUT,
AV_CLASS_CATEGORY_MUXER, AV_CLASS_CATEGORY_DEMUXER, AV_CLASS_CATEGORY_ENCODER, AV_CLASS_CATEGORY_DECODER,
AV_CLASS_CATEGORY_FILTER, AV_CLASS_CATEGORY_BITSTREAM_FILTER, AV_CLASS_CATEGORY_SWSCALER,
AV_CLASS_CATEGORY_SWRESAMPLER, AV_CLASS_CATEGORY_NB);
// struct AVOptionRanges;
/// **
// * Describe the class of an AVClass context structure. That is an
// * arbitrary struct of which the first field is a pointer to an
// * AVClass struct (e.g. AVCodecContext, AVFormatContext etc.).
// */
(*
// * Describe the class of an AVClass context structure. That is an
// * arbitrary struct of which the first field is a pointer to an
// * AVClass struct (e.g. AVCodecContext, AVFormatContext etc.).
*)
pAVClass = ^TAVClass;
TItem_name = function(ctx: Pointer): PAnsiChar; cdecl;
@ -52,7 +51,7 @@ Type
TGet_category = function(ctx: Pointer): TAVClassCategory; cdecl;
TQuery_ranges = function(av_ranges: ppAVOptionRanges; obj: Pointer; key: PAnsiChar; flag: Integer): Integer; cdecl;
TAVClass = { packed } record
TAVClass = record
(*
* The name of the class; usually it is the same name as the
* context structure type to which the AVClass is associated.
@ -125,194 +124,187 @@ Type
end;
const
/// **
// * @addtogroup lavu_log
// *
// * @{
// *
// * @defgroup lavu_log_constants Logging Constants
// *
// * @{
// */
//
/// **
// * Print no output.
// */
(* Print no output. *)
AV_LOG_QUIET = -8;
//
/// **
// * Something went really wrong and we will crash now.
// */
(* Something went really wrong and we will crash now. *)
AV_LOG_PANIC = 0;
//
/// **
// * Something went wrong and recovery is not possible.
// * For example, no header was found for a format which depends
// * on headers or an illegal combination of parameters is used.
// */
AV_LOG_FATAL = 8;
//
/// **
// * Something went wrong and cannot losslessly be recovered.
// * However, not all future data is affected.
// */
AV_LOG_ERROR = 16;
//
/// **
// * Something somehow does not look correct. This may or may not
// * lead to problems. An example would be the use of '-vstrict -2'.
// */
AV_LOG_WARNING = 24;
//
/// **
// * Standard information.
// */
AV_LOG_INFO = 32;
//
/// **
// * Detailed information.
// */
AV_LOG_VERBOSE = 40;
//
/// **
// * Stuff which is only useful for libav* developers.
// */
AV_LOG_DEBUG = 48;
//
AV_LOG_MAX_OFFSET = (AV_LOG_DEBUG - AV_LOG_QUIET);
//
/// **
// * @}
// */
//
/// **
// * Send the specified message to the log if the level is less than or equal
// * to the current av_log_level. By default, all logging messages are sent to
// * stderr. This behavior can be altered by setting a different logging callback
// * function.
// * @see av_log_set_callback
// *
// * @param avcl A pointer to an arbitrary struct of which the first field is a
// * pointer to an AVClass struct.
// * @param level The importance level of the message expressed using a @ref
// * lavu_log_constants "Logging Constant".
// * @param fmt The format string (printf-compatible) that specifies how
// * subsequent arguments are converted to output.
// */
// void av_log(void *avcl, int level, const char *fmt, ...) av_printf_format(3, 4);
//
//
/// **
// * Send the specified message to the log if the level is less than or equal
// * to the current av_log_level. By default, all logging messages are sent to
// * stderr. This behavior can be altered by setting a different logging callback
// * function.
// * @see av_log_set_callback
// *
// * @param avcl A pointer to an arbitrary struct of which the first field is a
// * pointer to an AVClass struct.
// * @param level The importance level of the message expressed using a @ref
// * lavu_log_constants "Logging Constant".
// * @param fmt The format string (printf-compatible) that specifies how
// * subsequent arguments are converted to output.
// * @param vl The arguments referenced by the format string.
// */
// void av_vlog(void *avcl, int level, const char *fmt, va_list vl);
//
/// **
// * Get the current log level
// *
// * @see lavu_log_constants
// *
// * @return Current log level
// */
// int av_log_get_level(void);
//
/// **
// * Set the log level
// *
// * @see lavu_log_constants
// *
// * @param level Logging level
// */
// void av_log_set_level(int level);
//
/// **
// * Set the logging callback
// *
// * @note The callback must be thread safe, even if the application does not use
// * threads itself as some codecs are multithreaded.
// *
// * @see av_log_default_callback
// *
// * @param callback A logging function with a compatible signature.
// */
// void av_log_set_callback(void (*callback)(void*, int, const char*, va_list));
//
/// **
// * Default logging callback
// *
// * It prints the message to stderr, optionally colorizing it.
// *
// * @param avcl A pointer to an arbitrary struct of which the first field is a
// * pointer to an AVClass struct.
// * @param level The importance level of the message expressed using a @ref
// * lavu_log_constants "Logging Constant".
// * @param fmt The format string (printf-compatible) that specifies how
// * subsequent arguments are converted to output.
// * @param ap The arguments referenced by the format string.
// */
// void av_log_default_callback(void* ptr, int level, const char* fmt, va_list vl);
//
/// **
// * Return the context name
// *
// * @param ctx The AVClass context
// *
// * @return The AVClass class_name
// */
// const char* av_default_item_name(void* ctx);
// AVClassCategory av_default_get_category(void *ptr);
//
/// **
// * Format a line of log the same way as the default callback.
// * @param line buffer to receive the formated line
// * @param line_size size of the buffer
// * @param print_prefix used to store whether the prefix must be printed;
// * must point to a persistent integer initially set to 1
// */
// void av_log_format_line(void *ptr, int level, const char *fmt, va_list vl,
// char *line, int line_size, int *print_prefix);
//
/// **
// * av_dlog macros
// * Useful to print debug messages that shouldn't get compiled in normally.
// */
//
// #ifdef DEBUG
// # define av_dlog(pctx, ...) av_log(pctx, AV_LOG_DEBUG, __VA_ARGS__)
// #else
// # define av_dlog(pctx, ...) do { if (0) av_log(pctx, AV_LOG_DEBUG, __VA_ARGS__); } while (0)
// #endif
//
(*
* Skip repeated messages, this requires the user app to use av_log() instead of
* (f)printf as the 2 would otherwise interfere and lead to
* "Last message repeated x times" messages below (f)printf messages with some
* bad luck.
* Also to receive the last, "last repeated" line if any, the user app must
* call av_log(NULL, AV_LOG_QUIET, "%s", ""); at the end
* Something went wrong and recovery is not possible.
* For example, no header was found for a format which depends
* on headers or an illegal combination of parameters is used.
*)
AV_LOG_FATAL = 8;
(*
* Something went wrong and cannot losslessly be recovered.
* However, not all future data is affected.
*)
AV_LOG_ERROR = 16;
(*
* Something somehow does not look correct. This may or may not
* lead to problems. An example would be the use of '-vstrict -2'.
*)
AV_LOG_WARNING = 24;
(*
* Standard information.
*)
AV_LOG_INFO = 32;
(*
* Detailed information.
*)
AV_LOG_VERBOSE = 40;
(*
* Stuff which is only useful for libav* developers.
*)
AV_LOG_DEBUG = 48;
AV_LOG_MAX_OFFSET = (AV_LOG_DEBUG - AV_LOG_QUIET);
(*
* Send the specified message to the log if the level is less than or equal
* to the current av_log_level. By default, all logging messages are sent to
* stderr. This behavior can be altered by setting a different logging callback
* function.
* @see av_log_set_callback
*
* @param avcl A pointer to an arbitrary struct of which the first field is a
* pointer to an AVClass struct.
* @param level The importance level of the message expressed using a @ref
* lavu_log_constants "Logging Constant".
* @param fmt The format string (printf-compatible) that specifies how
* subsequent arguments are converted to output.
*)
// void av_log(void *avcl, int level, const char *fmt, ...) av_printf_format(3, 4);
(*
* Send the specified message to the log if the level is less than or equal
* to the current av_log_level. By default, all logging messages are sent to
* stderr. This behavior can be altered by setting a different logging callback
* function.
* @see av_log_set_callback
*
* @param avcl A pointer to an arbitrary struct of which the first field is a
* pointer to an AVClass struct.
* @param level The importance level of the message expressed using a @ref
* lavu_log_constants "Logging Constant".
* @param fmt The format string (printf-compatible) that specifies how
* subsequent arguments are converted to output.
* @param vl The arguments referenced by the format string.
*)
// void av_vlog(void *avcl, int level, const char *fmt, va_list vl);
(*
* Get the current log level
*
* @see lavu_log_constants
*
* @return Current log level
*)
// int av_log_get_level(void);
function av_log_get_level: Integer; cdecl;
(*
* Set the log level
*
* @see lavu_log_constants
*
* @param level Logging level
*)
// void av_log_set_level(int level);
procedure av_log_set_level(level: Integer); cdecl;
(*
* Set the logging callback
*
* @note The callback must be thread safe, even if the application does not use
* threads itself as some codecs are multithreaded.
*
* @see av_log_default_callback
*
* @param callback A logging function with a compatible signature.
*)
// void av_log_set_callback(void (*callback)(void*, int, const char*, va_list));
Type
Tav_log_set_callback = procedure(prt: Pointer; level: Integer; fmt: PAnsiChar; vl: PVA_LIST);
cdecl varargs;
procedure av_log_set_callback(callbackproc: Tav_log_set_callback); cdecl;
(*
* Default logging callback
*
* It prints the message to stderr, optionally colorizing it.
*
* @param avcl A pointer to an arbitrary struct of which the first field is a
* pointer to an AVClass struct.
* @param level The importance level of the message expressed using a @ref
* lavu_log_constants "Logging Constant".
* @param fmt The format string (printf-compatible) that specifies how
* subsequent arguments are converted to output.
* @param ap The arguments referenced by the format string.
*)
// void av_log_default_callback(void* ptr, int level, const char* fmt, va_list vl);
(*
* Return the context name
*
* @param ctx The AVClass context
*
* @return The AVClass class_name
*)
// const char* av_default_item_name(void* ctx);
function av_default_item_name(clx: Pointer): PAnsiChar; cdecl;
// AVClassCategory av_default_get_category(void *ptr);
function av_default_get_category(ptr: Pointer): TAVClassCategory; cdecl;
(*
* Format a line of log the same way as the default callback.
* @param line buffer to receive the formated line
* @param line_size size of the buffer
* @param print_prefix used to store whether the prefix must be printed;
* must point to a persistent integer initially set to 1
*)
// void av_log_format_line(void *ptr, int level, const char *fmt, va_list vl,
// char *line, int line_size, int *print_prefix);
procedure av_log_format_line(ptr: Pointer; level: Integer; const fmt: PAnsiChar; vl: PVA_LIST; line: PAnsiChar;
line_size: Integer; Var print_prefix: Integer); cdecl;
(*
* av_dlog macros
* Useful to print debug messages that shouldn't get compiled in normally.
*)
// #ifdef DEBUG
// # define av_dlog(pctx, ...) av_log(pctx, AV_LOG_DEBUG, __VA_ARGS__)
// #else
// # define av_dlog(pctx, ...) do { if (0) av_log(pctx, AV_LOG_DEBUG, __VA_ARGS__); } while (0)
// #endif
(*
* Skip repeated messages, this requires the user app to use av_log() instead of
* (f)printf as the 2 would otherwise interfere and lead to
* "Last message repeated x times" messages below (f)printf messages with some
* bad luck.
* Also to receive the last, "last repeated" line if any, the user app must
* call av_log(NULL, AV_LOG_QUIET, "%s", ""); at the end
*)
const
AV_LOG_SKIP_REPEATED = 1;
AV_LOG_PRINT_LEVEL = 2;
// void av_log_set_flags(int arg);
procedure av_log_set_flags(arg: Integer); cdecl;
// int av_log_get_flags(void);
function av_log_get_flags: Integer; cdecl;
implementation
uses ffm.lib;
procedure av_log_set_flags; external avutil_dll;
function av_log_get_level; external avutil_dll;
procedure av_log_set_level; external avutil_dll;
function av_default_item_name; external avutil_dll;
function av_default_get_category; external avutil_dll;
function av_log_get_flags; external avutil_dll;
procedure av_log_set_callback; external avutil_dll;
procedure av_log_format_line; external avutil_dll;
end.

9045
source/sdl2/SDL2.pas Normal file
View File

File diff suppressed because it is too large Load Diff

35
source/sdl2/SDL2Frame/SDL2Frame.dpk Normal file
View File

@ -0,0 +1,35 @@
package SDL2Frame;
{$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 OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$IMPLICITBUILD ON}
requires
rtl,
vcl;
contains
SDL2_Frame in 'SDL2_frame.pas',
SDL2;
end.

187
source/sdl2/SDL2Frame/SDL2Frame.dproj Normal file
View File

@ -0,0 +1,187 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{02535AAD-46B8-44EE-90B6-8DBF49273592}</ProjectGuid>
<MainSource>SDL2Frame.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>15.3</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<AppType>Package</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android' and '$(Base)'=='true') or '$(Base_Android)'!=''">
<Base_Android>true</Base_Android>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice' and '$(Base)'=='true') or '$(Base_iOSDevice)'!=''">
<Base_iOSDevice>true</Base_iOSDevice>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSSimulator' and '$(Base)'=='true') or '$(Base_iOSSimulator)'!=''">
<Base_iOSSimulator>true</Base_iOSSimulator>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<VerInfo_Locale>3082</VerInfo_Locale>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=;CFBundleDisplayName=;UIDeviceFamily=;CFBundleIdentifier=;CFBundleVersion=;CFBundlePackageType=;CFBundleSignature=;CFBundleAllowMixedLocalizations=;UISupportedInterfaceOrientations=;CFBundleExecutable=;CFBundleResourceSpecification=;LSRequiresIPhoneOS=;CFBundleInfoDictionaryVersion=;CFBundleDevelopmentRegion=</VerInfo_Keys>
<GenDll>true</GenDll>
<GenPackage>true</GenPackage>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_F>false</DCC_F>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android)'!=''">
<VerInfo_Keys>package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=preferExternal;largeHeap=False;theme=TitleBar</VerInfo_Keys>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSDevice)'!=''">
<DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSSimulator)'!=''">
<DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>rtl;vcl;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>rtl;vcl;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="SDL2_frame.pas"/>
<DCCReference Include="..\SDL2.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">SDL2Frame.dpk</Source>
</Source>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">3082</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
<VersionInfoKeys Name="CFBundleName"/>
<VersionInfoKeys Name="CFBundleDisplayName"/>
<VersionInfoKeys Name="UIDeviceFamily"/>
<VersionInfoKeys Name="CFBundleIdentifier"/>
<VersionInfoKeys Name="CFBundleVersion"/>
<VersionInfoKeys Name="CFBundlePackageType"/>
<VersionInfoKeys Name="CFBundleSignature"/>
<VersionInfoKeys Name="CFBundleAllowMixedLocalizations"/>
<VersionInfoKeys Name="UISupportedInterfaceOrientations"/>
<VersionInfoKeys Name="CFBundleExecutable"/>
<VersionInfoKeys Name="CFBundleResourceSpecification"/>
<VersionInfoKeys Name="LSRequiresIPhoneOS"/>
<VersionInfoKeys Name="CFBundleInfoDictionaryVersion"/>
<VersionInfoKeys Name="CFBundleDevelopmentRegion"/>
</VersionInfoKeys>
</Delphi.Personality>
<Platforms>
<Platform value="Android">False</Platform>
<Platform value="iOSDevice">False</Platform>
<Platform value="iOSSimulator">False</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

118
source/sdl2/SDL2Frame/SDL2_Frame.pas Normal file
View File

@ -0,0 +1,118 @@
{
================================================================================
== ==
== ATENCIÓN: NO CARGAR LOS GRÁFICOS EN EL ONCREATE NI ONSHOW PORQUE EL ==
== COMPONENTE SDL2FRAME AUN NO ESTA COMPLETADO Y NO FUNCIONA ==
== ==
================================================================================
}
unit SDL2_Frame;
interface
uses
Winapi.Windows,
VCL.Dialogs,
SysUtils,
Classes,
Controls,
ExtCtrls,
SDL2;
type
TSDL2Frame = class(TPanel)
private
FSDLPantalla : PSDLPantalla;
FFlags : UInt32;
FRenderInfo : PSDL_RendererInfo;
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
public
procedure Finalize;
property SDLPantalla : PSDLPantalla read FSDLPantalla;
published
property Flags: UInt32 read FFlags write FFlags;
end;
procedure Register;
implementation
uses
forms;
//******************************************************************************
procedure Register;
begin
RegisterComponents('SDL2', [TSDL2Frame]);
end;
//******************************************************************************
procedure TSDL2Frame.CreateWnd;
begin
inherited;
if SDL_WasInit(SDL_INIT_VIDEO) <> SDL_INIT_VIDEO then
SDL_InitSubSystem(SDL_INIT_VIDEO);
New(FSDLPantalla);
FSDLPantalla.Window := SDL_CreateWindowFrom(Pointer(WindowHandle));
if FSDLPantalla.Window <> nil then
begin
FSDLPantalla.Renderer := SDL_CreateRenderer(FSDLPantalla.Window, -1, 0 ); // no forzamos ningún tipo de render (0) para que el sistema coja el que pueda Hard-Soft
if FSDLPantalla.Renderer <> nil then
begin
New(FRenderInfo);
if SDL_GetRendererInfo(FSDLPantalla.Renderer, FRenderInfo) = 0 then
begin
FSDLPantalla.max_texture_width := FRenderInfo.max_texture_width;
FSDLPantalla.max_texture_height := FRenderInfo.max_texture_height;
FSDLPantalla.hardware := ((FRenderInfo.flags and SDL_RENDERER_ACCELERATED) > 0);
FSDLPantalla.render_name := PAnsiChar(FRenderInfo.name);
SDL_ShowWindow(FSDLPantalla.Window);
if SDL_SetRenderDrawColor(FSDLPantalla.Renderer, 0, 0, 0, SDL_ALPHA_OPAQUE ) = 0 then
begin
if SDL_RenderFillRect(FSDLPantalla.Renderer, nil) = 0 then
FFlags := SDL_GetWindowFlags(FSDLPantalla.Window)
else
ShowMessage('Error clearing render context');
end else
ShowMessage('Error setting render draw color');
end else
ShowMessage('Error getting information about rendering context');
end else
ShowMessage('Error crearting SDL2 Render');
end else
ShowMessage('Error creating SDL2 Window.')
end;
//******************************************************************************
procedure TSDL2Frame.Finalize;
begin
if FSDLPantalla.Renderer <> nil then
begin
SDL_DestroyRenderer(FSDLPantalla.Renderer);
FSDLPantalla.Renderer := nil;
end;
if FSDLPantalla.Window <> nil then
begin
SDL_DestroyWindow(FSDLPantalla.Window);
FSDLPantalla.Window := nil;
end;
Dispose(FSDLPantalla);
end;
//******************************************************************************
procedure TSDL2Frame.DestroyWnd;
begin
Finalize;
inherited;
end;
end.

256
source/sdl2/SDL2_Image.pas Normal file
View File

@ -0,0 +1,256 @@
unit SDL2_Image;
{*******************************************************************************
SDL2_Image.pas v1.0 29/07/2013 first version for DelphiXE
v1.1 27/08/2013 add MACOS compability
v1.2 31/05/2014 delete sdl2.inc
Simple DirectMedia Layer
Copyright (C) 1997-2013 Sam Lantinga <slouken@libsdl.org>
Pascal-Header-Conversion SDL from the JEDI-Team written by Domenique Louis and others.
convert SDL/SDL2 to SDL2 for DelphiXE by Kotai 2013/2014 www.remakesonline.com
The initial developer of this Pascal code was :
Dominqiue Louis <Dominique@SavageSoftware.com.au>
*******************************************************************************}
interface
uses
SDL2;
const
{$IFDEF MSWINDOWS}
SDL_ImageLibName = 'SDL2_Image.dll';
{$ENDIF}
{$IFDEF ANDROID}
SDL_ImageLibName = 'libSDL2_image.so';
{$ENDIF}
{$IFDEF MACOS}
{$IFDEF IOS}
SDL_ImageLibName = 'libSDL2_image.a';
{$ELSE}
SDL_ImageLibName = 'SDL2_image';
// SDL_ImageLibName = '../Frameworks/SDL2_image.framework/Versions/A/SDL2_image';
{$ENDIF}
{$ENDIF}
{* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
SDL_IMAGE_MAJOR_VERSION = 2;
SDL_IMAGE_MINOR_VERSION = 0;
SDL_IMAGE_PATCHLEVEL = 0;
{* This macro can be used to fill a version structure with the compile-time
* version of the SDL_image library.
*}
procedure SDL_IMAGE_VERSION(var X: TSDL_Version);
{* This function gets the version of the dynamically linked SDL_image library.
it should NOT be used to fill a version structure, instead you should
use the SDL_IMAGE_VERSION() macro.
*}
function IMG_Linked_Version(): TSDL_Version;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_Linked_Version' {$ENDIF} {$ENDIF};
const
IMG_INIT_JPG = $00000001;
IMG_INIT_PNG = $00000002;
IMG_INIT_TIF = $00000004;
IMG_INIT_WEBP = $00000008;
type
TIMG_InitFlags = DWord;
{* Loads dynamic libraries and prepares them for use. Flags should be
one or more flags from IMG_InitFlags OR'd together.
It returns the flags successfully initialized, or 0 on failure.
*}
function IMG_Init(flags: SInt32): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_Init' {$ENDIF} {$ENDIF};
{* Unloads libraries loaded with IMG_Init *}
procedure IMG_Quit();
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_Quit' {$ENDIF} {$ENDIF};
{* Load an image from an SDL data source.
The 'type' may be one of: "BMP", "GIF", "PNG", etc.
If the image format supports a transparent pixel, SDL will set the
colorkey for the surface. You can enable RLE acceleration on the
surface afterwards by calling:
SDL_SetColorKey(image, SDL_RLEACCEL, image->format->colorkey);
*}
function IMG_LoadTyped_RW(src: PSDL_RWops; freesrc: SInt32; _type: PChar): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadTyped_RW' {$ENDIF} {$ENDIF};
{* Convenience functions *}
function IMG_Load(_file: PChar): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_Load' {$ENDIF} {$ENDIF};
function IMG_Load_RW(src: PSDL_RWops; freesrc: SInt32): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_Load_RW' {$ENDIF} {$ENDIF};
{* Load an image directly into a render texture. *}
function IMG_LoadTexture(renderer: PSDL_Renderer; _file: PChar): PSDL_Texture;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadTexture' {$ENDIF} {$ENDIF};
function IMG_LoadTexture_RW(renderer: PSDL_Renderer; src: PSDL_RWops; freesrc: SInt32): PSDL_Texture;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadTexture_RW' {$ENDIF} {$ENDIF};
function IMG_LoadTextureTyped_RW(renderer: PSDL_Renderer; src: PSDL_RWops; freesrc: SInt32; _type: PChar): PSDL_Texture;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadTextureTyped_RW' {$ENDIF} {$ENDIF};
{* Functions to detect a file type, given a seekable source *}
function IMG_isICO(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isICO' {$ENDIF} {$ENDIF};
function IMG_isCUR(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isCUR' {$ENDIF} {$ENDIF};
function IMG_isBMP(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isBMP' {$ENDIF} {$ENDIF};
function IMG_isGIF(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isGIF' {$ENDIF} {$ENDIF};
function IMG_isJPG(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isJPG' {$ENDIF} {$ENDIF};
function IMG_isLBM(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isLBM' {$ENDIF} {$ENDIF};
function IMG_isPCX(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isPCX' {$ENDIF} {$ENDIF};
function IMG_isPNG(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isPNG' {$ENDIF} {$ENDIF};
function IMG_isPNM(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isPNM' {$ENDIF} {$ENDIF};
function IMG_isTIF(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isTIF' {$ENDIF} {$ENDIF};
function IMG_isXCF(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '-IMG_isXCF' {$ENDIF} {$ENDIF};
function IMG_isXPM(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isXPM' {$ENDIF} {$ENDIF};
function IMG_isXV(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isXV' {$ENDIF} {$ENDIF};
function IMG_isWEBP(src: PSDL_RWops): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_isWEBP' {$ENDIF} {$ENDIF};
{* Individual loading functions *}
function IMG_LoadICO_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadICO_RW' {$ENDIF} {$ENDIF};
function IMG_LoadCUR_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadCUR_RW' {$ENDIF} {$ENDIF};
function IMG_LoadBMP_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadBMP_RW' {$ENDIF} {$ENDIF};
function IMG_LoadGIF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadGIF_RW' {$ENDIF} {$ENDIF};
function IMG_LoadJPG_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadJPG_RW' {$ENDIF} {$ENDIF};
function IMG_LoadLBM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadLBM_RW' {$ENDIF} {$ENDIF};
function IMG_LoadPCX_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadPCX_RW' {$ENDIF} {$ENDIF};
function IMG_LoadPNG_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadPNG_RW' {$ENDIF} {$ENDIF};
function IMG_LoadPNM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadPNM_RW' {$ENDIF} {$ENDIF};
function IMG_LoadTGA_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadTGA_RW' {$ENDIF} {$ENDIF};
function IMG_LoadTIF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadTIF_RW' {$ENDIF} {$ENDIF};
function IMG_LoadXCF_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadXCF_RW' {$ENDIF} {$ENDIF};
function IMG_LoadXPM_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadXMP_RW' {$ENDIF} {$ENDIF};
function IMG_LoadXV_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadXV_RW' {$ENDIF} {$ENDIF};
function IMG_LoadWEBP_RW(src: PSDL_RWops): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_LoadWEBP_RW' {$ENDIF} {$ENDIF};
function IMG_ReadXPMFromArray(xpm: PPChar): PSDL_Surface;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_ReadXPMFromArray' {$ENDIF} {$ENDIF};
{* Individual saving functions *}
function IMG_SavePNG(surface: PSDL_Surface; const _file: PChar): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_SavePNG' {$ENDIF} {$ENDIF};
function IMG_SavePNG_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: SInt32): SInt32;
cdecl; external SDL_ImageLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_IMG_SavePNG_RW' {$ENDIF} {$ENDIF};
{* We'll use SDL for reporting errors *}
function IMG_SetError(fmt: PChar): SInt32;
function IMG_GetError: PChar;
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
implementation
//******************************************************************************
procedure SDL_IMAGE_VERSION(var X: TSDL_Version);
begin
X.major := SDL_IMAGE_MAJOR_VERSION;
X.minor := SDL_IMAGE_MINOR_VERSION;
X.patch := SDL_IMAGE_PATCHLEVEL;
end;
//******************************************************************************
function IMG_SetError(fmt: PChar): SInt32;
begin
Result := SDL_SetError(fmt);
end;
//******************************************************************************
function IMG_GetError: PChar;
begin
Result := SDL_GetError;
end;
end.

806
source/sdl2/SDL2_Mixer.pas Normal file
View File

@ -0,0 +1,806 @@
unit SDL2_Mixer;
{*******************************************************************************
SDL2_Mixer.pas v1.0 29/07/2013 first version for DelphiXE
v1.1 27/08/2013 add MACOS compability
v1.2 31/05/2014 delete sdl2.inc
Simple DirectMedia Layer
Copyright (C) 1997-2013 Sam Lantinga <slouken@libsdl.org>
Pascal-Header-Conversion SDL from the JEDI-Team written by Domenique Louis and others.
convert SDL/SDL2 to SDL2 for DelphiXE by Kotai 2013/2014 www.remakesonline.com
The initial developer of this Pascal code was :
Dominqiue Louis <Dominique@SavageSoftware.com.au>
*******************************************************************************}
interface
uses
SDL2;
const
{$IFDEF MSWINDOWS}
SDL_MixerLibName = 'SDL2_mixer.dll';
{$ENDIF}
{$IFDEF ANDROID}
SDL_MixerLibName = 'libSDL2_mixer.so';
{$ENDIF}
{$IFDEF MACOS}
{$IFDEF IOS}
SDL_MixerLibName = 'libSDL2_mixer.a';
{$ELSE}
SDL_MixerLibName = 'SDL2_mixer';
// SDL_MixerLibName = '../Frameworks/SDL2_mixer.framework/Versions/A/SDL2_mixer';
{$ENDIF}
{$ENDIF}
{* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
const
SDL_MIXER_MAJOR_VERSION = 2;
SDL_MIXER_MINOR_VERSION = 0;
SDL_MIXER_PATCHLEVEL = 0;
{* This macro can be used to fill a version structure with the compile-time
* version of the SDL_mixer library.
*}
procedure SDL_MIXER_VERSION(X: PSDL_Version);
{* Backwards compatibility *}
const
MIX_MAJOR_VERSION = SDL_MIXER_MAJOR_VERSION;
MIX_MINOR_VERSION = SDL_MIXER_MINOR_VERSION;
MIX_PATCHLEVEL = SDL_MIXER_PATCHLEVEL;
procedure MIX_VERSION(X: PSDL_Version);
{* This function gets the version of the dynamically linked SDL_mixer library.
it should NOT be used to fill a version structure, instead you should
use the SDL_MIXER_VERSION() macro.
*}
function Mix_Linked_Version(): PSDL_Version;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Linked_Version' {$ENDIF} {$ENDIF};
const
MIX_INIT_FLAC = $00000001;
MIX_INIT_MOD = $00000002;
MIX_INIT_MODPLUG = $00000004;
MIX_INIT_MP3 = $00000008;
MIX_INIT_OGG = $00000010;
MIX_INIT_FLUIDSYNTH = $00000020;
type
TMIX_InitFlags = Byte;
{* Loads dynamic libraries and prepares them for use. Flags should be
one or more flags from MIX_InitFlags OR'd together.
It returns the flags successfully initialized, or 0 on failure.
*}
function Mix_Init(flags: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Init' {$ENDIF} {$ENDIF};
{* Unloads libraries loaded with Mix_Init *}
procedure Mix_Quit();
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Quit' {$ENDIF} {$ENDIF};
{* The default mixer has 8 simultaneous mixing channels *}
{$IFNDEF MIX_CHANNELS}
const
MIX_CHANNELS = 8;
{$ENDIF}
{* Good default values for a PC soundcard *}
const
MIX_DEFAULT_FREQUENCY = 22050;
MIX_DEFAULT_FORMAT = AUDIO_S16LSB;
MIX_DEFAULT_CHANNELS = 2;
MIX_MAX_VOLUME = 128; {* Volume of a chunk *}
{* The internal format for an audio chunk *}
type
PMix_Chunk = ^TMix_Chunk;
TMix_Chunk = record
allocated: Integer;
abuf: PUInt8;
alen: UInt32;
volume: UInt8; {* Per-sample volume, 0-128 *}
end;
{* The different fading types supported *}
type
TMix_Fading = (MIX_NO_FADING, MIX_FADING_OUT, MIX_FADING_IN);
TMix_MusicType = (MUS_NONE,
MUS_CMD,
MUS_WAV,
MUS_MOD,
MUS_MID,
MUS_OGG,
MUS_MP3,
MUS_MP3_MAD,
MUS_FLAC,
MUS_MODPLUG);
{* The internal format for a music chunk interpreted via mikmod *}
PMix_Music = ^TMix_Music;
TMix_Music = record end;
{* Open the mixer with a certain audio format *}
function Mix_OpenAudio(frequency: Integer; format: UInt16; channels: Integer; chunksize: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_OpenAudio' {$ENDIF} {$ENDIF};
{* Dynamically change the number of channels managed by the mixer.
If decreasing the number of channels, the upper channels are
stopped.
This function returns the new number of allocated channels.
*}
function Mix_AllocateChannels(numchans: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_AllocateChannels' {$ENDIF} {$ENDIF};
{* Find out what the actual audio device parameters are.
This function returns 1 if the audio has been opened, 0 otherwise.
*}
function Mix_QuerySpec(frequency: PInt; format: PUInt16; channels: PInt): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_QuerySpec' {$ENDIF} {$ENDIF};
{* Load a wave file or a music (.mod .s3m .it .xm) file *}
function Mix_LoadWAV_RW(src: PSDL_RWops; freesrc: Integer): PMix_Chunk;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_LoadWAV_RW' {$ENDIF} {$ENDIF};
function Mix_LoadWAV(_file: PChar): PMix_Chunk;
function Mix_LoadMUS(_file: PChar): PMix_Music;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_LoadMUS' {$ENDIF} {$ENDIF};
{* Load a music file from an SDL_RWop object (Ogg and MikMod specific currently)
Matt Campbell (matt@campbellhome.dhs.org) April 2000 *}
function Mix_LoadMUS_RW(src: PSDL_RWops; freesrc: Integer): PMix_Music;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_LoadMUS_RW' {$ENDIF} {$ENDIF};
{* Load a music file from an SDL_RWop object assuming a specific format *}
function Mix_LoadMUSType_RW(src: PSDL_RWops; _type: TMix_MusicType; freesrc: Integer): PMix_Music;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_LoadMUSType_RW' {$ENDIF} {$ENDIF};
{* Load a wave file of the mixer format from a memory buffer *}
function Mix_QuickLoad_WAV(mem: PUInt8): PMix_Chunk;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_QuickLoad_WAV' {$ENDIF} {$ENDIF};
{* Load raw audio data of the mixer format from a memory buffer *}
function Mix_QuickLoad_RAW(mem: PUInt8; len: UInt32): PMix_Chunk;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_QuickLoad_RAW' {$ENDIF} {$ENDIF};
{* Free an audio chunk previously loaded *}
procedure Mix_FreeChunk(chunk: PMix_Chunk);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FreeChunk' {$ENDIF} {$ENDIF};
procedure Mix_FreeMusic(music: PMix_Music);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FreeMusic' {$ENDIF} {$ENDIF};
{* Get a list of chunk/music decoders that this build of SDL_mixer provides.
This list can change between builds AND runs of the program, if external
libraries that add functionality become available.
You must successfully call Mix_OpenAudio() before calling these functions.
This API is only available in SDL_mixer 1.2.9 and later.
// usage...
int i;
const int total = Mix_GetNumChunkDecoders();
for (i = 0; i < total; i++)
printf("Supported chunk decoder: [%s]\n", Mix_GetChunkDecoder(i));
Appearing in this list doesn't promise your specific audio file will
decode...but it's handy to know if you have, say, a functioning Timidity
install.
These return values are static, read-only data; do not modify or free it.
The pointers remain valid until you call Mix_CloseAudio().
*}
function Mix_GetNumChunkDecoders: Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetNumChunkDecoders' {$ENDIF} {$ENDIF};
function Mix_GetChunkDecoder(index: Integer): PChar;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetChunkDecoder' {$ENDIF} {$ENDIF};
function Mix_GetNumMusicDecoders: Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetNumMusicDecoders' {$ENDIF} {$ENDIF};
function Mix_GetMusicDecoder(index: Integer): PChar;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetMusicDecoder' {$ENDIF} {$ENDIF};
{* Find out the music format of a mixer music, or the currently playing
music, if 'music' is NULL.
*}
function Mix_GetMusicType(music: TMix_Music): TMix_MusicType;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetMusicType' {$ENDIF} {$ENDIF};
{* Set a function that is called after all mixing is performed.
This can be used to provide real-time visual display of the audio stream
or add a custom mixer filter for the stream data.
*}
type
TMix_Func = procedure(udata: Pointer; stream: PUInt8; len: Integer);
procedure Mix_SetPostMix(func: TMix_Func; arg: Pointer);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetPostMix' {$ENDIF} {$ENDIF};
{* Add your own music player or additional mixer function.
If 'mix_func' is NULL, the default music player is re-enabled.
*}
procedure Mix_HookMusic(func: TMix_Func; arg: Pointer);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_HookMusic' {$ENDIF} {$ENDIF};
{* Add your own callback when the music has finished playing.
This callback is only called if the music finishes naturally.
*}
type
PMix_Music_Finished = ^TMix_Music_Finished;
TMix_Music_Finished = procedure();
procedure Mix_HookMusicFinished(music_finished: PMix_Music_Finished);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_HookMusicFinished' {$ENDIF} {$ENDIF};
{* Get a pointer to the user data for the current music hook *}
function Mix_GetMusicHookData(): Pointer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetMusicHookData' {$ENDIF} {$ENDIF};
{*
* Add your own callback when a channel has finished playing. NULL
* to disable callback. The callback may be called from the mixer's audio
* callback or it could be called as a result of Mix_HaltChannel(), etc.
* do not call SDL_LockAudio() from this callback; you will either be
* inside the audio callback, or SDL_mixer will explicitly lock the audio
* before calling your callback.
*}
type
TMix_Channel_Finished = procedure(channel: Integer);
procedure Mix_ChannelFinished(channel_finished: TMix_Channel_Finished);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_ChannelFinished' {$ENDIF} {$ENDIF};
{* Special Effects API by ryan c. gordon. (icculus@icculus.org) *}
const
MIX_CHANNEL_POST = -2;
{* This is the format of a special effect callback:
*
* myeffect(int chan, void *stream, int len, void *udata);
*
* (chan) is the channel number that your effect is affecting. (stream) is
* the buffer of data to work upon. (len) is the size of (stream), and
* (udata) is a user-defined bit of data, which you pass as the last arg of
* Mix_RegisterEffect(), and is passed back unmolested to your callback.
* Your effect changes the contents of (stream) based on whatever parameters
* are significant, or just leaves it be, if you prefer. You can do whatever
* you like to the buffer, though, and it will continue in its changed state
* down the mixing pipeline, through any other effect functions, then finally
* to be mixed with the rest of the channels and music for the final output
* stream.
*
* DO NOT EVER call SDL_LockAudio() from your callback function!
*}
type
TMix_EffectFunc_t = procedure(chan: Integer; stream: Pointer; len: Integer; udata: Pointer);
{*
* This is a callback that signifies that a channel has finished all its
* loops and has completed playback. This gets called if the buffer
* plays out normally, or if you call Mix_HaltChannel(), implicitly stop
* a channel via Mix_AllocateChannels(), or unregister a callback while
* it's still playing.
*
* DO NOT EVER call SDL_LockAudio() from your callback function!
*}
type
TMix_EffectDone_t = procedure(chan: Integer; udata: Pointer);
{* Register a special effect function. At mixing time, the channel data is
* copied into a buffer and passed through each registered effect function.
* After it passes through all the functions, it is mixed into the final
* output stream. The copy to buffer is performed once, then each effect
* function performs on the output of the previous effect. Understand that
* this extra copy to a buffer is not performed if there are no effects
* registered for a given chunk, which saves CPU cycles, and any given
* effect will be extra cycles, too, so it is crucial that your code run
* fast. Also note that the data that your function is given is in the
* format of the sound device, and not the format you gave to Mix_OpenAudio(),
* although they may in reality be the same. This is an unfortunate but
* necessary speed concern. Use Mix_QuerySpec() to determine if you can
* handle the data before you register your effect, and take appropriate
* actions.
* You may also specify a callback (Mix_EffectDone_t) that is called when
* the channel finishes playing. This gives you a more fine-grained control
* than Mix_ChannelFinished(), in case you need to free effect-specific
* resources, etc. If you don't need this, you can specify NULL.
* You may set the callbacks before or after calling Mix_PlayChannel().
* Things like Mix_SetPanning() are just internal special effect functions,
* so if you are using that, you've already incurred the overhead of a copy
* to a separate buffer, and that these effects will be in the queue with
* any functions you've registered. The list of registered effects for a
* channel is reset when a chunk finishes playing, so you need to explicitly
* set them with each call to Mix_PlayChannel*().
* You may also register a special effect function that is to be run after
* final mixing occurs. The rules for these callbacks are identical to those
* in Mix_RegisterEffect, but they are run after all the channels and the
* music have been mixed into a single stream, whereas channel-specific
* effects run on a given channel before any other mixing occurs. These
* global effect callbacks are call "posteffects". Posteffects only have
* their Mix_EffectDone_t function called when they are unregistered (since
* the main output stream is never "done" in the same sense as a channel).
* You must unregister them manually when you've had enough. Your callback
* will be told that the channel being mixed is (MIX_CHANNEL_POST) if the
* processing is considered a posteffect.
*
* After all these effects have finished processing, the callback registered
* through Mix_SetPostMix() runs, and then the stream goes to the audio
* device.
*
* DO NOT EVER call SDL_LockAudio() from your callback function!
*
* returns zero if error (no such channel), nonzero if added.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_RegisterEffect(chan: Integer; f: TMix_EffectFunc_t; d: TMix_EffectDone_t; arg: Pointer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_RegisterEffect' {$ENDIF} {$ENDIF};
{* You may not need to call this explicitly, unless you need to stop an
* effect from processing in the middle of a chunk's playback.
* Posteffects are never implicitly unregistered as they are for channels,
* but they may be explicitly unregistered through this function by
* specifying MIX_CHANNEL_POST for a channel.
* returns zero if error (no such channel or effect), nonzero if removed.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_UnregisterEffect(channel: Integer; f: TMix_EffectFunc_t): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_UnregisterEffect' {$ENDIF} {$ENDIF};
{* You may not need to call this explicitly, unless you need to stop all
* effects from processing in the middle of a chunk's playback. Note that
* this will also shut off some internal effect processing, since
* Mix_SetPanning() and others may use this API under the hood. This is
* called internally when a channel completes playback.
* Posteffects are never implicitly unregistered as they are for channels,
* but they may be explicitly unregistered through this function by
* specifying MIX_CHANNEL_POST for a channel.
* returns zero if error (no such channel), nonzero if all effects removed.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_UnregisterAllEffects(channel: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_UnregisterEffects' {$ENDIF} {$ENDIF};
const
MIX_EFFECTSMAXSPEED = 'MIX_EFFECTSMAXSPEED';
{*
* These are the internally-defined mixing effects. They use the same API that
* effects defined in the application use, but are provided here as a
* convenience. Some effects can reduce their quality or use more memory in
* the name of speed; to enable this, make sure the environment variable
* MIX_EFFECTSMAXSPEED (see above) is defined before you call
* Mix_OpenAudio().
*}
{* Set the panning of a channel. The left and right channels are specified
* as integers between 0 and 255, quietest to loudest, respectively.
*
* Technically, this is just individual volume control for a sample with
* two (stereo) channels, so it can be used for more than just panning.
* If you want real panning, call it like this:
*
* Mix_SetPanning(channel, left, 255 - left);
*
* ...which isn't so hard.
*
* Setting (channel) to MIX_CHANNEL_POST registers this as a posteffect, and
* the panning will be done to the final mixed stream before passing it on
* to the audio device.
*
* This uses the Mix_RegisterEffect() API internally, and returns without
* registering the effect function if the audio device is not configured
* for stereo output. Setting both (left) and (right) to 255 causes this
* effect to be unregistered, since that is the data's normal state.
*
* returns zero if error (no such channel or Mix_RegisterEffect() fails),
* nonzero if panning effect enabled. Note that an audio device in mono
* mode is a no-op, but this call will return successful in that case.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_SetPanning(channel: Integer; left: UInt8; right: UInt8): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetPanning' {$ENDIF} {$ENDIF};
{* Set the position of a channel. (angle) is an integer from 0 to 360, that
* specifies the location of the sound in relation to the listener. (angle)
* will be reduced as neccesary (540 becomes 180 degrees, -100 becomes 260).
* Angle 0 is due north, and rotates clockwise as the value increases.
* For efficiency, the precision of this effect may be limited (angles 1
* through 7 might all produce the same effect, 8 through 15 are equal, etc).
* (distance) is an integer between 0 and 255 that specifies the space
* between the sound and the listener. The larger the number, the further
* away the sound is. Using 255 does not guarantee that the channel will be
* culled from the mixing process or be completely silent. For efficiency,
* the precision of this effect may be limited (distance 0 through 5 might
* all produce the same effect, 6 through 10 are equal, etc). Setting (angle)
* and (distance) to 0 unregisters this effect, since the data would be
* unchanged.
*
* If you need more precise positional audio, consider using OpenAL for
* spatialized effects instead of SDL_mixer. This is only meant to be a
* basic effect for simple "3D" games.
*
* If the audio device is configured for mono output, then you won't get
* any effectiveness from the angle; however, distance attenuation on the
* channel will still occur. While this effect will function with stereo
* voices, it makes more sense to use voices with only one channel of sound,
* so when they are mixed through this effect, the positioning will sound
* correct. You can convert them to mono through SDL before giving them to
* the mixer in the first place if you like.
*
* Setting (channel) to MIX_CHANNEL_POST registers this as a posteffect, and
* the positioning will be done to the final mixed stream before passing it
* on to the audio device.
*
* This is a convenience wrapper over Mix_SetDistance() and Mix_SetPanning().
*
* returns zero if error (no such channel or Mix_RegisterEffect() fails),
* nonzero if position effect is enabled.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_SetPosition(channel: Integer; angle: SInt16; distance: UInt8): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetPosition' {$ENDIF} {$ENDIF};
{* Set the "distance" of a channel. (distance) is an integer from 0 to 255
* that specifies the location of the sound in relation to the listener.
* Distance 0 is overlapping the listener, and 255 is as far away as possible
* A distance of 255 does not guarantee silence; in such a case, you might
* want to try changing the chunk's volume, or just cull the sample from the
* mixing process with Mix_HaltChannel().
* For efficiency, the precision of this effect may be limited (distances 1
* through 7 might all produce the same effect, 8 through 15 are equal, etc).
* (distance) is an integer between 0 and 255 that specifies the space
* between the sound and the listener. The larger the number, the further
* away the sound is.
* Setting (distance) to 0 unregisters this effect, since the data would be
* unchanged.
* If you need more precise positional audio, consider using OpenAL for
* spatialized effects instead of SDL_mixer. This is only meant to be a
* basic effect for simple "3D" games.
*
* Setting (channel) to MIX_CHANNEL_POST registers this as a posteffect, and
* the distance attenuation will be done to the final mixed stream before
* passing it on to the audio device.
*
* This uses the Mix_RegisterEffect() API internally.
*
* returns zero if error (no such channel or Mix_RegisterEffect() fails),
* nonzero if position effect is enabled.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_SetDistance(channel: Integer; distance: UInt8): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetDistance' {$ENDIF} {$ENDIF};
{*
* !!! FIXME : Haven't implemented, since the effect goes past the
* end of the sound buffer. Will have to think about this.
* --ryan.
*}
//#if 0
{* Causes an echo effect to be mixed into a sound. (echo) is the amount
* of echo to mix. 0 is no echo, 255 is infinite (and probably not
* what you want).
*
* Setting (channel) to MIX_CHANNEL_POST registers this as a posteffect, and
* the reverbing will be done to the final mixed stream before passing it on
* to the audio device.
*
* This uses the Mix_RegisterEffect() API internally. If you specify an echo
* of zero, the effect is unregistered, as the data is already in that state.
*
* returns zero if error (no such channel or Mix_RegisterEffect() fails),
* nonzero if reversing effect is enabled.
* Error messages can be retrieved from Mix_GetError().
*}
//extern no_parse_DECLSPEC int SDLCALL Mix_SetReverb(int channel, Uint8 echo);
//#endif
{* Causes a channel to reverse its stereo. This is handy if the user has his
* speakers hooked up backwards, or you would like to have a minor bit of
* psychedelia in your sound code. :) Calling this function with (flip)
* set to non-zero reverses the chunks's usual channels. If (flip) is zero,
* the effect is unregistered.
*
* This uses the Mix_RegisterEffect() API internally, and thus is probably
* more CPU intensive than having the user just plug in his speakers
* correctly. Mix_SetReverseStereo() returns without registering the effect
* function if the audio device is not configured for stereo output.
*
* If you specify MIX_CHANNEL_POST for (channel), then this the effect is used
* on the final mixed stream before sending it on to the audio device (a
* posteffect).
*
* returns zero if error (no such channel or Mix_RegisterEffect() fails),
* nonzero if reversing effect is enabled. Note that an audio device in mono
* mode is a no-op, but this call will return successful in that case.
* Error messages can be retrieved from Mix_GetError().
*}
function Mix_SetReverseStereo(channel: Integer; flip: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetReverseStereo' {$ENDIF} {$ENDIF};
{* end of effects API. --ryan. *}
{* Reserve the first channels (0 -> n-1) for the application, i.e. don't allocate
them dynamically to the next sample if requested with a -1 value below.
Returns the number of reserved channels.
*}
function Mix_ReserveChannels(num: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_ReverseChannels' {$ENDIF} {$ENDIF};
{* Channel grouping functions *}
{* Attach a tag to a channel. A tag can be assigned to several mixer
channels, to form groups of channels.
If 'tag' is -1, the tag is removed (actually -1 is the tag used to
represent the group of all the channels).
Returns true if everything was OK.
*}
function Mix_GroupChannel(which: Integer; tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GroupChannel' {$ENDIF} {$ENDIF};
{* Assign several consecutive channels to a group *}
function Mix_GroupChannels(from: Integer; _to: Integer; tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GroupChannels' {$ENDIF} {$ENDIF};
{* Finds the first available channel in a group of channels,
returning -1 if none are available.
*}
function Mix_GroupAvailable(tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GroupAvailable' {$ENDIF} {$ENDIF};
{* Returns the number of channels in a group. This is also a subtle
way to get the total number of channels when 'tag' is -1
*}
function Mix_GroupCount(tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GroupCount' {$ENDIF} {$ENDIF};
{* Finds the "oldest" sample playing in a group of channels *}
function Mix_GroupOldest(tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GroupOldest' {$ENDIF} {$ENDIF};
{* Finds the "most recent" (i.e. last) sample playing in a group of channels *}
function Mix_GroupNewer(tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GroupNewer' {$ENDIF} {$ENDIF};
{* Play an audio chunk on a specific channel.
If the specified channel is -1, play on the first free channel.
If 'loops' is greater than zero, loop the sound that many times.
If 'loops' is -1, loop inifinitely (~65000 times).
Returns which channel was used to play the sound.
*}
function Mix_PlayChannel(channel: Integer; chunk: PMix_Chunk; loops: Integer): Integer;
{* The same as above, but the sound is played at most 'ticks' milliseconds *}
function Mix_PlayChannelTimed(channel: Integer; chunk: PMix_Chunk; loops: Integer; ticks: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_PlayChannelTimed' {$ENDIF} {$ENDIF};
function Mix_PlayMusic(music: PMix_Music; loops: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_PlayMusic' {$ENDIF} {$ENDIF};
{* Fade in music or a channel over "ms" milliseconds, same semantics as the "Play" functions *}
function Mix_FadeInMusic(music: PMix_Music; loops: Integer; ms: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadeInMusic' {$ENDIF} {$ENDIF};
function Mix_FadeInMusicPos(music: PMix_Music; loops: Integer; ms: Integer; position: Double): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadeInMusicPos' {$ENDIF} {$ENDIF};
function Mix_FadeInChannel(channel: Integer; chunk: PMix_Chunk; loops: Integer; ms: Integer): Integer;
function Mix_FadeInChannelTimed(channel: Integer; chunk: PMix_Chunk; loops: Integer; ms: Integer; ticks: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadeInChannelTimed' {$ENDIF} {$ENDIF};
{* Set the volume in the range of 0-128 of a specific channel or chunk.
If the specified channel is -1, set volume for all channels.
Returns the original volume.
If the specified volume is -1, just return the current volume.
*}
function Mix_Volume(channel: Integer; volume: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Volume' {$ENDIF} {$ENDIF};
function Mix_VolumeChunk(chunk: PMix_Chunk; volume: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_VolumeChunk' {$ENDIF} {$ENDIF};
function Mix_VolumeMusic(volume: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_VolumeMusic' {$ENDIF} {$ENDIF};
{* Halt playing of a particular channel *}
function Mix_HaltChannel(channel: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_HaltChannel' {$ENDIF} {$ENDIF};
function Mix_HaltGroup(tag: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_HaltGroup' {$ENDIF} {$ENDIF};
function Mix_HaltMusic(): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_HaltMusic' {$ENDIF} {$ENDIF};
{* Change the expiration delay for a particular channel.
The sample will stop playing after the 'ticks' milliseconds have elapsed,
or remove the expiration if 'ticks' is -1
*}
function Mix_ExpireChannel(channel: Integer; ticks: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_ExpireChannel' {$ENDIF} {$ENDIF};
{* Halt a channel, fading it out progressively till it's silent
The ms parameter indicates the number of milliseconds the fading
will take.
*}
function Mix_FadeOutChannel(which: Integer; ms: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadeOutChannel' {$ENDIF} {$ENDIF};
function Mix_FadeOutGroup(tag: Integer; ms: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadeOutGroup' {$ENDIF} {$ENDIF};
function Mix_FadeOutMusic(ms: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadeOutMusic' {$ENDIF} {$ENDIF};
{* Query the fading status of a channel *}
function Mix_FadingMusic(): TMix_Fading;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadingMusic' {$ENDIF} {$ENDIF};
function Mix_FadingChannel(which: Integer): TMix_Fading;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_FadingChannel' {$ENDIF} {$ENDIF};
{* Pause/Resume a particular channel *}
procedure Mix_Pause(channel: Integer);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Pause' {$ENDIF} {$ENDIF};
procedure Mix_Resume(channel: Integer);
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Resume' {$ENDIF} {$ENDIF};
function Mix_Paused(channel: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Paused' {$ENDIF} {$ENDIF};
{* Pause/Resume the music stream *}
procedure Mix_PauseMusic();
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_PauseMusic' {$ENDIF} {$ENDIF};
procedure Mix_ResumeMusic();
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_ResumeMusic' {$ENDIF} {$ENDIF};
procedure Mix_RewindMusic();
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_RewindMusic' {$ENDIF} {$ENDIF};
function Mix_PausedMusic(): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_PausedMusic' {$ENDIF} {$ENDIF};
{* Set the current position in the music stream.
This returns 0 if successful, or -1 if it failed or isn't implemented.
This function is only implemented for MOD music formats (set pattern
order number) and for OGG, FLAC, MP3_MAD, and MODPLUG music (set
position in seconds), at the moment.
*}
function Mix_SetMusicPosition(position: Double): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetMusicPosition' {$ENDIF} {$ENDIF};
{* Check the status of a specific channel.
If the specified channel is -1, check all channels.
*}
function Mix_Playing(channel: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_Playing' {$ENDIF} {$ENDIF};
function Mix_PlayingMusic(): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_PlayingMusic' {$ENDIF} {$ENDIF};
{* Stop music and set external music playback command *}
function Mix_SetMusicCMD(command: PChar): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetMusicCMD' {$ENDIF} {$ENDIF};
{* Synchro value is set by MikMod from modules while playing *}
function Mix_SetSynchroValue(value: Integer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetSynchroValue' {$ENDIF} {$ENDIF};
function Mix_GetSynchroValue(): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetSynchroValue' {$ENDIF} {$ENDIF};
{* Set/Get/Iterate SoundFonts paths to use by supported MIDI backends *}
function Mix_SetSoundFonts(paths: PChar): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_SetSoundFonts' {$ENDIF} {$ENDIF};
function Mix_GetSoundFonts(): PChar;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetSoundFonts' {$ENDIF} {$ENDIF};
type
TMix_SoundFunc = function(c: PChar; p: Pointer): Integer;
function Mix_EachSoundFont(func: TMix_SoundFunc; data: Pointer): Integer;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_EachSoundFont' {$ENDIF} {$ENDIF};
{* Get the Mix_Chunk currently associated with a mixer channel
Returns NULL if it's an invalid channel, or there's no chunk associated.
*}
function Mix_GetChunk(channel: Integer): PMix_Chunk;
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_GetChunk' {$ENDIF} {$ENDIF};
{* Close the mixer, halting all playing audio *}
procedure Mix_CloseAudio();
cdecl; external SDL_MixerLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_MIX_CloseAudio' {$ENDIF} {$ENDIF};
{* We'll use SDL for reporting errors *}
function Mix_SetError(const fmt: PChar): SInt32;
function Mix_GetError: PChar;
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
implementation
//******************************************************************************
procedure SDL_MIXER_VERSION(X: PSDL_Version);
begin
X.major := SDL_MIXER_MAJOR_VERSION;
X.minor := SDL_MIXER_MINOR_VERSION;
X.patch := SDL_MIXER_PATCHLEVEL;
end;
//******************************************************************************
procedure MIX_VERSION(X: PSDL_Version);
begin
SDL_MIXER_VERSION(X);
end;
//******************************************************************************
function Mix_FadeInChannel(channel: Integer; chunk: PMix_Chunk; loops: Integer; ms: Integer): Integer;
begin
Result := Mix_FadeInChannelTimed(channel, chunk, loops, ms, -1);
end;
//******************************************************************************
function Mix_PlayChannel(channel: Integer; chunk: PMix_Chunk; loops: Integer): Integer;
begin
Result := Mix_PlayChannelTimed(channel, chunk, loops, -1);
end;
//******************************************************************************
function Mix_LoadWAV(_file: PChar): PMix_Chunk;
begin
Result := Mix_LoadWAV_RW(SDL_RWFromFile(_file, 'rb'), 1);
end;
//******************************************************************************
function Mix_SetError(const fmt: PChar): SInt32;
begin
Result := SDL_SetError(fmt);
end;
//******************************************************************************
function Mix_GetError: PChar;
begin
Result := SDL_GetError;
end;
end.

528
source/sdl2/SDL2_Net.pas Normal file
View File

@ -0,0 +1,528 @@
unit SDL2_Net;
{*******************************************************************************
SDL2_Net.pas v1.0 29/07/2013 first version for DelphiXE
v1.1 27/08/2013 add MACOS compability
v1.2 31/05/2014 delete sdl2.inc
Simple DirectMedia Layer
Copyright (C) 1997-2013 Sam Lantinga <slouken@libsdl.org>
Pascal-Header-Conversion SDL from the JEDI-Team written by Domenique Louis and others.
convert SDL/SDL2 to SDL2 for DelphiXE by Kotai 2013/2014 www.remakesonline.com
The initial developer of this Pascal code was :
Dominqiue Louis <Dominique@SavageSoftware.com.au>
*******************************************************************************}
interface
uses
{$IFDEF MSWINDOWS}
Winapi.Windows,
{$ENDIF}
SDL2;
const
{$IFDEF MSWINDOWS}
SDL_NetLibName = 'SDL2_net.dll';
{$ENDIF}
{$IFDEF ANDROID}
SDL_NetLibName = 'libSDL2_net.so';
{$ENDIF}
{$IFDEF MACOS}
{$IFDEF IOS}
SDL_NetLibName = 'libSDL2_net.a';
{$ELSE}
SDL_NetLibName = 'SDL2_net';
// SDL_NetLibName = '../Frameworks/SDL2_net.framework/Versions/A/SDL2_net';
{$ENDIF}
{$ENDIF}
{* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
SDL_NET_MAJOR_VERSION = 1;
{$EXTERNALSYM SDL_NET_MAJOR_VERSION}
SDL_NET_MINOR_VERSION = 2;
{$EXTERNALSYM SDL_NET_MINOR_VERSION}
SDL_NET_PATCHLEVEL = 7;
{$EXTERNALSYM SDL_NET_PATCHLEVEL}
// SDL_Net.h constants
{* Resolve a host name and port to an IP address in network form.
If the function succeeds, it will return 0.
If the host couldn't be resolved, the host portion of the returned
address will be INADDR_NONE, and the function will return -1.
If 'host' is NULL, the resolved host will be set to INADDR_ANY.
*}
INADDR_ANY = $00000000;
{$EXTERNALSYM INADDR_ANY}
INADDR_NONE = $FFFFFFFF;
{$EXTERNALSYM INADDR_NONE}
{***********************************************************************}
{* UDP network API *}
{***********************************************************************}
{* The maximum channels on a a UDP socket *}
SDLNET_MAX_UDPCHANNELS = 32;
{$EXTERNALSYM SDLNET_MAX_UDPCHANNELS}
{* The maximum addresses bound to a single UDP socket channel *}
SDLNET_MAX_UDPADDRESSES = 4;
{$EXTERNALSYM SDLNET_MAX_UDPADDRESSES}
type
// SDL_net.h types
{***********************************************************************}
{* IPv4 hostname resolution API *}
{***********************************************************************}
PIPAddress = ^TIPAddress;
TIPAddress = record
host : Uint32; // 32-bit IPv4 host address */
port : Uint16; // 16-bit protocol port */
end;
{***********************************************************************}
{* TCP network API *}
{***********************************************************************}
PTCPSocket = ^TTCPSocket;
TTCPSocket = record
ready : integer;
//{$IFDEF MSWINDOWS}
channel : integer;
//{$ENDIF}
remoteAddress : TIPaddress;
localAddress : TIPaddress;
sflag : integer;
end;
{***********************************************************************}
{* UDP network API *}
{***********************************************************************}
PUDP_Channel = ^TUDP_Channel;
TUDP_Channel = record
numbound : integer;
address : array[ 0..SDLNET_MAX_UDPADDRESSES - 1 ] of TIPAddress;
end;
PUDPSocket = ^TUDPSocket;
TUDPSocket = record
ready : integer;
//{$IFDEF MSWINDOWS}
channel : integer;
//{$ENDIF}
address : TIPAddress;
binding : array[ 0..SDLNET_MAX_UDPCHANNELS - 1 ] of TUDP_Channel;
end;
PUDPpacket = ^TUDPpacket;
PPUDPpacket = ^PUDPpacket;
TUDPpacket = record
channel : integer; {* The src/dst channel of the packet *}
data : PUint8; {* The packet data *}
len : integer; {* The length of the packet data *}
maxlen : integer; {* The size of the data buffer *}
status : integer; {* packet status after sending *}
address : TIPAddress; {* The source/dest address of an incoming/outgoing packet *}
end;
{***********************************************************************}
{* Hooks for checking sockets for available data *}
{***********************************************************************}
PSDLNet_Socket = ^TSDLNet_Socket;
TSDLNet_Socket = record
ready : integer;
//{$IFDEF MSWINDOWS}
channel : integer;
//{$ENDIF}
end;
PSDLNet_SocketSet = ^TSDLNet_SocketSet;
TSDLNet_SocketSet = record
numsockets : integer;
maxsockets : integer;
sockets : PSDLNet_Socket;
end;
{* Any network socket can be safely cast to this socket type *}
PSDLNet_GenericSocket = ^TSDLNet_GenericSocket;
TSDLNet_GenericSocket = record
ready : integer;
end;
{ This macro can be used to fill a version structure with the compile-time
version of the SDL_net library. }
procedure SDL_NET_VERSION( var X : TSDL_version );
{* Initialize/Cleanup the network API
SDL must be initialized before calls to functions in this library,
because this library uses utility functions from the SDL library.
*}
function SDLNet_Init() : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_Init' {$ENDIF} {$ENDIF};
procedure SDLNet_Quit();
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_Quit' {$ENDIF} {$ENDIF};
{* Resolve a host name and port to an IP address in network form.
If the function succeeds, it will return 0.
If the host couldn't be resolved, the host portion of the returned
address will be INADDR_NONE, and the function will return -1.
If 'host' is NULL, the resolved host will be set to INADDR_ANY.
*}
function SDLNet_ResolveHost( var address : TIPaddress; host : PChar; port : Uint16 ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_ResolveHost' {$ENDIF} {$ENDIF};
{* Resolve an ip address to a host name in canonical form.
If the ip couldn't be resolved, this function returns NULL,
otherwise a pointer to a static buffer containing the hostname
is returned. Note that this function is not thread-safe.
*}
function SDLNet_ResolveIP( var ip : TIPaddress ) : PChar;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_ResolveIP' {$ENDIF} {$ENDIF};
{***********************************************************************}
{* TCP network API *}
{***********************************************************************}
{* Open a TCP network socket
If ip.host is INADDR_NONE, this creates a local server socket on the
given port, otherwise a TCP connection to the remote host and port is
attempted. The address passed in should already be swapped to network
byte order (addresses returned from SDLNet_ResolveHost() are already
in the correct form).
The newly created socket is returned, or NULL if there was an error.
*}
function SDLNet_TCP_Open( var ip : TIPaddress ) : PTCPSocket;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_TCP_Open' {$ENDIF} {$ENDIF};
{* Accept an incoming connection on the given server socket.
The newly created socket is returned, or NULL if there was an error.
*}
function SDLNet_TCP_Accept( server : PTCPsocket ) : PTCPSocket;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_TCP_Accept' {$ENDIF} {$ENDIF};
{* Get the IP address of the remote system associated with the socket.
If the socket is a server socket, this function returns NULL.
*}
function SDLNet_TCP_GetPeerAddress( sock : PTCPsocket ) : PIPAddress;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_TCP_GetPeerAddress' {$ENDIF} {$ENDIF};
{* Send 'len' bytes of 'data' over the non-server socket 'sock'
This function returns the actual amount of data sent. If the return value
is less than the amount of data sent, then either the remote connection was
closed, or an unknown socket error occurred.
*}
function SDLNet_TCP_Send( sock : PTCPsocket; data : Pointer; len : integer ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_TCP_Send' {$ENDIF} {$ENDIF};
{* Receive up to 'maxlen' bytes of data over the non-server socket 'sock',
and store them in the buffer pointed to by 'data'.
This function returns the actual amount of data received. If the return
value is less than or equal to zero, then either the remote connection was
closed, or an unknown socket error occurred.
*}
function SDLNet_TCP_Recv( sock : PTCPsocket; data : Pointer; maxlen : integer ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_TCP_Recv' {$ENDIF} {$ENDIF};
{* Close a TCP network socket *}
procedure SDLNet_TCP_Close( sock : PTCPsocket );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_TCP_Close' {$ENDIF} {$ENDIF};
{***********************************************************************}
{* UDP network API *}
{***********************************************************************}
{* Allocate/resize/free a single UDP packet 'size' bytes long.
The new packet is returned, or NULL if the function ran out of memory.
*}
function SDLNet_AllocPacket( size : integer ) : PUDPpacket;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_AllocPacket' {$ENDIF} {$ENDIF};
function SDLNet_ResizePacket( packet : PUDPpacket; newsize : integer ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_ResizePacket' {$ENDIF} {$ENDIF};
procedure SDLNet_FreePacket( packet : PUDPpacket );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_FreePacket' {$ENDIF} {$ENDIF};
{* Allocate/Free a UDP packet vector (array of packets) of 'howmany' packets,
each 'size' bytes long.
A pointer to the first packet in the array is returned, or NULL if the
function ran out of memory.
*}
function SDLNet_AllocPacketV( howmany : integer; size : integer ) : PUDPpacket;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_AllocPacketV' {$ENDIF} {$ENDIF};
procedure SDLNet_FreePacketV( packetV : PUDPpacket );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_FreePacketV' {$ENDIF} {$ENDIF};
{* Open a UDP network socket
If 'port' is non-zero, the UDP socket is bound to a local port.
This allows other systems to send to this socket via a known port.
*}
function SDLNet_UDP_Open( port : Uint16 ) : PUDPsocket;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_Open' {$ENDIF} {$ENDIF};
{* Bind the address 'address' to the requested channel on the UDP socket.
If the channel is -1, then the first unbound channel will be bound with
the given address as it's primary address.
If the channel is already bound, this new address will be added to the
list of valid source addresses for packets arriving on the channel.
If the channel is not already bound, then the address becomes the primary
address, to which all outbound packets on the channel are sent.
This function returns the channel which was bound, or -1 on error.
*}
function SDLNet_UDP_Bind( sock : PUDPsocket; channel : integer; var address : TIPaddress ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_Bind' {$ENDIF} {$ENDIF};
{* Unbind all addresses from the given channel *}
procedure SDLNet_UDP_Unbind( sock : PUDPsocket; channel : integer );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_Unbind' {$ENDIF} {$ENDIF};
{* Get the primary IP address of the remote system associated with the
socket and channel. If the channel is -1, then the primary IP port
of the UDP socket is returned -- this is only meaningful for sockets
opened with a specific port.
If the channel is not bound and not -1, this function returns NULL.
*}
function SDLNet_UDP_GetPeerAddress( sock : PUDPsocket; channel : integer ) : PIPAddress;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_GetPeerAddress' {$ENDIF} {$ENDIF};
{* Send a vector of packets to the the channels specified within the packet.
If the channel specified in the packet is -1, the packet will be sent to
the address in the 'src' member of the packet.
Each packet will be updated with the status of the packet after it has
been sent, -1 if the packet send failed.
This function returns the number of packets sent.
*}
function SDLNet_UDP_SendV( sock : PUDPsocket; packets : PPUDPpacket; npackets : integer ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_SendV' {$ENDIF} {$ENDIF};
{* Send a single packet to the specified channel.
If the channel specified in the packet is -1, the packet will be sent to
the address in the 'src' member of the packet.
The packet will be updated with the status of the packet after it has
been sent.
This function returns 1 if the packet was sent, or 0 on error.
*}
function SDLNet_UDP_Send( sock : PUDPsocket; channel : integer; packet : PUDPpacket ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_Send' {$ENDIF} {$ENDIF};
{* Receive a vector of pending packets from the UDP socket.
The returned packets contain the source address and the channel they arrived
on. If they did not arrive on a bound channel, the the channel will be set
to -1.
The channels are checked in highest to lowest order, so if an address is
bound to multiple channels, the highest channel with the source address
bound will be returned.
This function returns the number of packets read from the network, or -1
on error. This function does not block, so can return 0 packets pending.
*}
function SDLNet_UDP_RecvV( sock : PUDPsocket; packets : PPUDPpacket ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_RecvV' {$ENDIF} {$ENDIF};
{* Receive a single packet from the UDP socket.
The returned packet contains the source address and the channel it arrived
on. If it did not arrive on a bound channel, the the channel will be set
to -1.
The channels are checked in highest to lowest order, so if an address is
bound to multiple channels, the highest channel with the source address
bound will be returned.
This function returns the number of packets read from the network, or -1
on error. This function does not block, so can return 0 packets pending.
*}
function SDLNet_UDP_Recv( sock : PUDPsocket; packet : PUDPpacket ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_Recv' {$ENDIF} {$ENDIF};
{* Close a UDP network socket *}
procedure SDLNet_UDP_Close( sock : PUDPsocket );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_UDP_Close' {$ENDIF} {$ENDIF};
{***********************************************************************}
{* Hooks for checking sockets for available data *}
{***********************************************************************}
{* Allocate a socket set for use with SDLNet_CheckSockets()
This returns a socket set for up to 'maxsockets' sockets, or NULL if
the function ran out of memory.
*}
function SDLNet_AllocSocketSet( maxsockets : integer ) : PSDLNet_SocketSet;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_AllocSocketSet' {$ENDIF} {$ENDIF};
{* Add a socket to a set of sockets to be checked for available data *}
function SDLNet_AddSocket( set_ : PSDLNet_SocketSet; sock : PSDLNet_GenericSocket ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_AddSocket' {$ENDIF} {$ENDIF};
function SDLNet_TCP_AddSocket( set_ : PSDLNet_SocketSet; sock : PTCPSocket ) : integer;
function SDLNet_UDP_AddSocket( set_ : PSDLNet_SocketSet; sock : PUDPSocket ) : integer;
{* Remove a socket from a set of sockets to be checked for available data *}
function SDLNet_DelSocket( set_ : PSDLNet_SocketSet; sock : PSDLNet_GenericSocket ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_DelSocket' {$ENDIF} {$ENDIF};
function SDLNet_TCP_DelSocket( set_ : PSDLNet_SocketSet; sock : PTCPSocket ) : integer;
function SDLNet_UDP_DelSocket( set_ : PSDLNet_SocketSet; sock : PUDPSocket ) : integer;
{* This function checks to see if data is available for reading on the
given set of sockets. If 'timeout' is 0, it performs a quick poll,
otherwise the function returns when either data is available for
reading, or the timeout in milliseconds has elapsed, which ever occurs
first. This function returns the number of sockets ready for reading,
or -1 if there was an error with the select() system call.
*}
function SDLNet_CheckSockets( set_ : PSDLNet_SocketSet; timeout : Sint32 ) : integer;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_CheckSockets' {$ENDIF} {$ENDIF};
{* After calling SDLNet_CheckSockets(), you can use this function on a
socket that was in the socket set, to find out if data is available
for reading.
*}
function SDLNet_SocketReady( sock : PSDLNet_GenericSocket ) : boolean;
{* Free a set of sockets allocated by SDL_NetAllocSocketSet() *}
procedure SDLNet_FreeSocketSet( set_ : PSDLNet_SocketSet );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_FreeSocketSet' {$ENDIF} {$ENDIF};
{***********************************************************************}
{* Platform-independent data conversion functions *}
{***********************************************************************}
{* Write a 16/32 bit value to network packet buffer *}
procedure SDLNet_Write16( value : Uint16; area : Pointer );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_Write16' {$ENDIF} {$ENDIF};
procedure SDLNet_Write32( value : Uint32; area : Pointer );
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_Write32' {$ENDIF} {$ENDIF};
{* Read a 16/32 bit value from network packet buffer *}
function SDLNet_Read16( area : Pointer ) : Uint16;
//{$IFNDEF CPUARM}
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_Read16' {$ENDIF} {$ENDIF};
//{$ENDIF}
function SDLNet_Read32( area : Pointer ) : Uint32;
//{$IFNDEF CPUARM}
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_Read32' {$ENDIF} {$ENDIF};
//{$ENDIF}
{***********************************************************************}
{* Error reporting functions *}
{***********************************************************************}
{* We'll use SDL's functions for error reporting *}
procedure SDLNet_SetError( fmt : PChar );
function SDLNet_GetError() : PChar;
(* I'm eventually going to try to disentangle SDL_net from SDL, thus making
SDL_net an independent X-platform networking toolkit. Not today though....
proceudre SDLNet_SetError(const char *fmt, ...);
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_SetError' {$ENDIF} {$ENDIF};
function SDLNet_GetError() : PChar;
cdecl; external SDL_NetLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_SDLNet_GetError' {$ENDIF} {$ENDIF};
*)
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
implementation
//******************************************************************************
procedure SDL_NET_VERSION( var X : TSDL_version );
begin
X.major := SDL_NET_MAJOR_VERSION;
X.minor := SDL_NET_MINOR_VERSION;
X.patch := SDL_NET_PATCHLEVEL;
end;
//******************************************************************************
function SDLNet_TCP_AddSocket( set_ : PSDLNet_SocketSet; sock : PTCPSocket ) : integer;
begin
result := SDLNet_AddSocket( set_, PSDLNet_GenericSocket( sock ) );
end;
//******************************************************************************
function SDLNet_UDP_AddSocket( set_ : PSDLNet_SocketSet; sock : PUDPSocket ) : integer;
begin
result := SDLNet_AddSocket( set_, PSDLNet_GenericSocket( sock ) );
end;
//******************************************************************************
function SDLNet_TCP_DelSocket( set_ : PSDLNet_SocketSet; sock : PTCPSocket ) : integer;
begin
result := SDLNet_DelSocket( set_, PSDLNet_GenericSocket( sock ) );
end;
//******************************************************************************
function SDLNet_UDP_DelSocket( set_ : PSDLNet_SocketSet; sock : PUDPSocket ) : integer;
begin
result := SDLNet_DelSocket( set_, PSDLNet_GenericSocket( sock ) );
end;
//******************************************************************************
{* After calling SDLNet_CheckSockets(), you can use this function on a
socket that was in the socket set, to find out if data is available
for reading.
*}
function SDLNet_SocketReady( sock : PSDLNet_GenericSocket ) : boolean;
begin
result := ( ( sock <> nil ) and ( sock^.ready = 1 ) );
end;
//******************************************************************************
procedure SDLNet_SetError( fmt : PChar );
begin
SDL_SetError( fmt );
end;
//******************************************************************************
function SDLNet_GetError() : PChar;
begin
result := SDL_GetError;
end;
//******************************************************************************
//{$IFDEF CPUARM}
//function SDLNet_Read16( area : Pointer ) : Uint16;
//begin
// result := ((PUint8(area)^ shl 8) or (PUint8(area+1)^ shl 0));
//end;
//******************************************************************************
//function SDLNet_Read32( area : Pointer ) : Uint32;
//begin
// result := ((PUint8(area)^ shl 24) or (PUint8(area+1)^ shl 16) or (PUint8(area+2)^ shl 8) or (PUint8(area+3)^ shl 0) );
//end;
//{$ENDIF}
end.

368
source/sdl2/SDL2_Ttf.pas Normal file
View File

@ -0,0 +1,368 @@
unit SDL2_Ttf;
{*******************************************************************************
SDL2_Ttf.pas v1.0 29/07/2013 first version for DelphiXE
v1.1 27/08/2013 add MACOS compability
v1.2 31/05/2014 delete sdl2.inc
Simple DirectMedia Layer
Copyright (C) 1997-2013 Sam Lantinga <slouken@libsdl.org>
Pascal-Header-Conversion SDL from the JEDI-Team written by Domenique Louis and others.
convert SDL/SDL2 to SDL2 for DelphiXE by Kotai 2013/2014 www.remakesonline.com
The initial developer of this Pascal code was :
Dominqiue Louis <Dominique@SavageSoftware.com.au>
*******************************************************************************}
interface
uses
{$IFDEF MSWINDOWS}
Winapi.Windows,
{$ENDIF}
SDL2;
const
{$IFDEF MSWINDOWS}
SDL_ttfLibName = 'SDL2_ttf.dll';
{$ENDIF}
{$IFDEF ANDROID}
SDL_ttfLibName = 'libSDL2_ttf.so';
{$ENDIF}
{$IFDEF MACOS}
{$IFDEF IOS}
SDL_ttfLibName = 'libSDL2_ttf.a';
{$ELSE}
SDL_ttfLibName = 'SDL2_ttf';
// SDL_ttfLibName = '../Frameworks/SDL2_ttf.framework/Versions/A/SDL2_ttf';
{$ENDIF}
{$ENDIF}
{* Set up for C function definitions, even when using C++ *}
{* Printable format: "%d.%d.%d", MAJOR, MINOR, PATCHLEVEL *}
const
SDL_TTF_MAJOR_VERSION = 2;
SDL_TTF_MINOR_VERSION = 0;
SDL_TTF_PATCHLEVEL = 12;
{* Backwards compatibility *}
const
TTF_MAJOR_VERSION = SDL_TTF_MAJOR_VERSION;
TTF_MINOR_VERSION = SDL_TTF_MINOR_VERSION;
TTF_PATCHLEVEL = SDL_TTF_PATCHLEVEL;
//TTF_VERSION(X) = SDL_TTF_VERSION(X);
{* This function gets the version of the dynamically linked SDL_ttf library.
it should NOT be used to fill a version structure, instead you should
use the SDL_TTF_VERSION() macro.
*}
function TTF_Linked_Version(): TSDL_Version;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_Linked_Version' {$ENDIF} {$ENDIF};
{* ZERO WIDTH NO-BREAKSPACE (Unicode byte order mark) *}
const
UNICODE_BOM_NATIVE = $FEFF;
UNICODE_BOM_SWAPPED = $FFFE;
{* This function tells the library whether UNICODE text is generally
byteswapped. A UNICODE BOM character in a string will override
this setting for the remainder of that string.
*}
procedure TTF_ByteSwappedUNICODE(swapped: Integer);
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_ByteSwappedUNICODE' {$ENDIF} {$ENDIF};
{* The internal structure containing font information *}
type
PTTF_Font = ^TTTF_Font;
TTTF_Font = record end; //todo?
{* Initialize the TTF engine - returns 0 if successful, -1 on error *}
function TTF_Init(): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_Init' {$ENDIF} {$ENDIF};
{* Open a font file and create a font of the specified point size.
* Some .fon fonts will have several sizes embedded in the file, so the
* point size becomes the index of choosing which size. If the value
* is too high, the last indexed size will be the default. *}
function TTF_OpenFont(_file: PChar; ptsize: Integer): PTTF_Font;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_OpenFont' {$ENDIF} {$ENDIF};
function TTF_OpenFontIndex(_file: PChar; ptsize: Integer; index: LongInt): PTTF_Font;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_OpenFontIndex' {$ENDIF} {$ENDIF};
function TTF_OpenFontRW(src: PSDL_RWops; freesrc: Integer; ptsize: LongInt): PTTF_Font;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_OpenFontRW' {$ENDIF} {$ENDIF};
function TTF_OpenFontIndexRW(src: PSDL_RWops; freesrc: Integer; ptsize: Integer; index: LongInt): PTTF_Font;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_OpenFontIndexRW' {$ENDIF} {$ENDIF};
{* Set and retrieve the font style *}
const
TTF_STYLE_NORMAL = $00;
TTF_STYLE_BOLD = $01;
TTF_STYLE_ITALIC = $02;
TTF_STYLE_UNDERLINE = $04;
TTF_STYLE_STRIKETHROUGH = $08;
function TTF_GetFontStyle(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GetFontStyle' {$ENDIF} {$ENDIF};
procedure TTF_SetFontStyle(font: PTTF_Font; style: Integer);
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SetFontStyle' {$ENDIF} {$ENDIF};
function TTF_GetFontOutline(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GetFontOutline' {$ENDIF} {$ENDIF};
procedure TTF_SetFontOutline(font: PTTF_Font; outline: Integer);
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SetFontOutline' {$ENDIF} {$ENDIF};
{* Set and retrieve FreeType hinter settings *}
const
TTF_HINTING_NORMAL = 0;
TTF_HINTING_LIGHT = 1;
TTF_HINTING_MONO = 2;
TTF_HINTING_NONE = 3;
function TTF_GetFontHinting(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GetFontHinting' {$ENDIF} {$ENDIF};
procedure TTF_SetFontHinting(font: PTTF_Font; hinting: Integer);
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SetFontHinting' {$ENDIF} {$ENDIF};
{* Get the total height of the font - usually equal to point size *}
function TTF_FontHeight(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontHeight' {$ENDIF} {$ENDIF};
{* Get the offset from the baseline to the top of the font
This is a positive value, relative to the baseline.
*}
function TTF_FontAscent(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontAscent' {$ENDIF} {$ENDIF};
{* Get the offset from the baseline to the bottom of the font
This is a negative value, relative to the baseline.
*}
function TTF_FontDescent(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontDescent' {$ENDIF} {$ENDIF};
{* Get the recommended spacing between lines of text for this font *}
function TTF_FontLineSkip(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontLineSkip' {$ENDIF} {$ENDIF};
{* Get/Set whether or not kerning is allowed for this font *}
function TTF_GetFontKerning(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GetFontKerning' {$ENDIF} {$ENDIF};
procedure TTF_SetFontKerning(font: PTTF_Font; allowed: Integer);
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SetFontKerning' {$ENDIF} {$ENDIF};
{* Get the number of faces of the font *}
function TTF_FontFaces(font: PTTF_Font): LongInt;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontFaces' {$ENDIF} {$ENDIF};
{* Get the font face attributes, if any *}
function TTF_FontFaceIsFixedWidth(font: PTTF_Font): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontFaceIsFixedWidth' {$ENDIF} {$ENDIF};
function TTF_FontFaceFamilyName(font: PTTF_Font): PChar;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontFaceFamilyName' {$ENDIF} {$ENDIF};
function TTF_FontFaceStyleName(font: PTTF_Font): PChar;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_FontFaceStyleName' {$ENDIF} {$ENDIF};
{* Check wether a glyph is provided by the font or not *}
function TTF_GlyphIsProvided(font: PTTF_Font; ch: UInt16): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GlyphIsProvided' {$ENDIF} {$ENDIF};
{* Get the metrics (dimensions) of a glyph
To understand what these metrics mean, here is a useful link:
http://freetype.sourceforge.net/freetype2/docs/tutorial/step2.html
*}
function TTF_GlyphMetrics(font: PTTF_Font; ch: UInt16; minx, maxx: PInt; miny, maxy: PInt; advance: PInt): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GlyphMetrics' {$ENDIF} {$ENDIF};
{* Get the dimensions of a rendered string of text *}
function TTF_SizeText(font: PTTF_Font; text: PChar; w, h: PInt): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SizeText' {$ENDIF} {$ENDIF};
function TTF_SizeUTF8(font: PTTF_Font; text: PChar; w, h: PInt): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SizeUTF8' {$ENDIF} {$ENDIF};
function TTF_SizeUNICODE(font: PTTF_Font; text: PUInt16; w, h: PInt): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_SizeUNICODE' {$ENDIF} {$ENDIF};
{* Create an 8-bit palettized surface and render the given text at
fast quality with the given font and color. The 0 pixel is the
colorkey, giving a transparent background, and the 1 pixel is set
to the text color.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderText_Solid(font: PTTF_Font; text: PChar; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderText_Solid' {$ENDIF} {$ENDIF};
function TTF_RenderUTF8_Solid(font: PTTF_Font; text: PChar; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUTF8_Solid' {$ENDIF} {$ENDIF};
function TTF_RenderUNICODE_Solid(font: PTTF_Font; text: PUInt16; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUNICODE_Solid' {$ENDIF} {$ENDIF};
{* Create an 8-bit palettized surface and render the given glyph at
fast quality with the given font and color. The 0 pixel is the
colorkey, giving a transparent background, and the 1 pixel is set
to the text color. The glyph is rendered without any padding or
centering in the X direction, and aligned normally in the Y direction.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderGlyph_Solid(font: PTTF_Font; ch: UInt16; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderGlyph_Solid' {$ENDIF} {$ENDIF};
{* Create an 8-bit palettized surface and render the given text at
high quality with the given font and colors. The 0 pixel is background,
while other pixels have varying degrees of the foreground color.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderText_Shaded(font: PTTF_Font; text: PChar; fg, bg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderText_Shaded' {$ENDIF} {$ENDIF};
function TTF_RenderUTF8_Shaded(font: PTTF_Font; text: PChar; fg, bg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUTF8_Shaded' {$ENDIF} {$ENDIF};
function TTF_RenderUNICODE_Shaded(font: PTTF_Font; text: PUInt16; fg, bg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUNICODE_Shaded' {$ENDIF} {$ENDIF};
{* Create an 8-bit palettized surface and render the given glyph at
high quality with the given font and colors. The 0 pixel is background,
while other pixels have varying degrees of the foreground color.
The glyph is rendered without any padding or centering in the X
direction, and aligned normally in the Y direction.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderGlyph_Shaded(font: PTTF_Font; ch: UInt16; fg, bg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderGlyph_Shaded' {$ENDIF} {$ENDIF};
{* Create a 32-bit ARGB surface and render the given text at high quality,
using alpha blending to dither the font with the given color.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderText_Blended(font: PTTF_Font; text: PChar; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderText_Blended' {$ENDIF} {$ENDIF};
function TTF_RenderUTF8_Blended(font: PTTF_Font; text: PChar; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUTF8_Blended' {$ENDIF} {$ENDIF};
function TTF_RenderUNICODE_Blended(font: PTTF_Font; text: UInt16; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUNICODE_Blended' {$ENDIF} {$ENDIF};
{* Create a 32-bit ARGB surface and render the given text at high quality,
using alpha blending to dither the font with the given color.
Text is wrapped to multiple lines on line endings and on word boundaries
if it extends beyond wrapLength in pixels.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderText_Blended_Wrapped(font: PTTF_Font; text: PChar; fg: TSDL_Color; wrapLength: UInt32): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderText_Blended_Wrapped' {$ENDIF} {$ENDIF};
function TTF_RenderUTF8_Blended_Wrapped(font: PTTF_Font; text: PChar; fg: TSDL_Color; wrapLength: UInt32): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUTF8_Blended_Wrapped' {$ENDIF} {$ENDIF};
function TTF_RenderUNICODE_Blended_Wrapped(font: PTTF_Font; text: PUInt16; fg: TSDL_Color; wrapLength: UInt32): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderUNICODE_Blended_Wrapped' {$ENDIF} {$ENDIF};
{* Create a 32-bit ARGB surface and render the given glyph at high quality,
using alpha blending to dither the font with the given color.
The glyph is rendered without any padding or centering in the X
direction, and aligned normally in the Y direction.
This function returns the new surface, or NULL if there was an error.
*}
function TTF_RenderGlyph_Blended(font: PTTF_Font; ch: UInt16; fg: TSDL_Color): PSDL_Surface;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_RenderGlyph_Blended' {$ENDIF} {$ENDIF};
{* For compatibility with previous versions, here are the old functions *}
function TTF_RenderText(font: PTTF_Font; text: PChar; fg, bg: TSDL_Color): PSDL_Surface;
function TTF_RenderUTF8(font: PTTF_Font; text: PChar; fg, bg: TSDL_Color): PSDL_Surface;
function TTF_RenderUNICODE(font: PTTF_Font; text: PUInt16; fg, bg: TSDL_Color): PSDL_Surface;
{* Close an opened font file *}
procedure TTF_CloseFont(font: PTTF_Font);
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_CloseFont' {$ENDIF} {$ENDIF};
{* De-initialize the TTF engine *}
procedure TTF_Quit();
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_Quit' {$ENDIF} {$ENDIF};
{* Check if the TTF engine is initialized *}
function TTF_WasInit(): Boolean;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_WasInit' {$ENDIF} {$ENDIF};
{* Get the kerning size of two glyphs *}
function TTF_GetFontKerningSize(font: PTTF_Font; prev_index, index: Integer): Integer;
cdecl; external SDL_ttfLibName {$IFDEF MACOS} {$IFNDEF IOS} name '_TTF_GetFontKerningSize' {$ENDIF} {$ENDIF};
{* We'll use SDL for reporting errors *}
function TTF_SetError(const fmt: PChar): SInt32;
function TTF_GetError: PChar;
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
implementation
//******************************************************************************
function TTF_SetError(const fmt: PChar): SInt32;
begin
Result := SDL_SetError(fmt);
end;
//******************************************************************************
function TTF_GetError: PChar;
begin
Result := SDL_GetError;
end;
//******************************************************************************
function TTF_RenderText(font: PTTF_Font; text: PChar; fg, bg: TSDL_Color): PSDL_Surface;
begin
Result := TTF_RenderText_Shaded(font, text, fg, bg);
end;
//******************************************************************************
function TTF_RenderUTF8(font: PTTF_Font; text: PChar; fg, bg: TSDL_Color): PSDL_Surface;
begin
Result := TTF_RenderUTF8_Shaded(font, text, fg, bg);
end;
//******************************************************************************
function TTF_RenderUNICODE(font: PTTF_Font; text: PUInt16; fg, bg: TSDL_Color): PSDL_Surface;
begin
Result := TTF_RenderUNICODE_Shaded(font, text, fg, bg);
end;
end.