Subversion Repositories spacemission

Compare Revisions

No changes between revisions

Regard whitespace Rev 3 → Rev 4

/VCL_DELPHIX_D6/DXReg_original.pas
File deleted
/VCL_DELPHIX_D6/DirectX.txt
File deleted
/VCL_DELPHIX_D6/Wave.pas
File deleted
/VCL_DELPHIX_D6/DXTexImg.pas
File deleted
/VCL_DELPHIX_D6/Colli3DX.dcr
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/Colli3DX.pas
0,0 → 1,2383
unit colli3DX;
 
{$include DelphiXcfg.inc}
 
 
//*************************************************************************
//* *
//* TCollisionTester3DX vs 1.3 *
//* *
//*************************************************************************
//
// This Delphi 4, 5, 6 component is CopyRight:
//
// Henrik Fabricius, August 1999, March 2000, June 2002
// http://users.cybercity.dk/~bbl6194/delphi3dx.htm
// E-mail: henrik_og_bodil@vip.cybercity.dk
//
// You may use this component for free on the following conditions:
// 1) this text must remain part of the unit.
// 2) Any proposals for changes or improvements should be addressed directly to
// the copyright owner Henrik Fabricius
// 3) The use of this component is on your own risk. The software is provided
// as is without any garanties and warranty. The CopyRight Owner is not
// responsible for any damage or losses of any kind caused by the use of this
// software or the software it is intended to be used with.
//
// To place a link for down-loads of this component on your homepage
// please place a link to the Delphi3DX page where the latest version
// is available.
//
// To use this component you must have
// 1) Delphi 4, 5 or 6
// 2) MS-DirectX 6.0 or higher
// 3) the DelphiX components from Hori in Japan
//
// MS-DirectX is a trademark of the Microsoft Corporation
// Delphi 4, 5 and 6 is a trademark of the Inprise Corporation
//
// Use this component to check for collisions between 3D objects in
// Direct3D games.
// Place your 3D-objects in a world described by :
// - DXDrawUsed -
//
// Group the 3D-objects in series with different material
// or functional properties
// The 3D-object series are named by the property:
// - Indexof3DSeries -
// 3D-objects are named by the property :
// - Indexof3Dobject -
// A 3D-object consist of one or more 3D-elements named by the property :
// - Indexof3DElement -
//
// Surround each of your 3D elements by at least one collision object
// which must be a member of the following primitives :
// - box3D - sphere3D - ellipsoid3D - cylinder3D - conus3D -
// available CollOrientations are :
// - Symmetric_X - Symmetric_Y - Symmetric_Z -
// available material properties are :
// - solid3D - water3D - air3D
// the size of the small end of the conus is described by the property
// - PercentLeftatTop -
// a negative value means that the top is downwards
// available functional properties are :
// - Pickable - Shootable - Fixed3DObject
// Add each object by specifying :
// - FrameSeries - NextAddMesh - CoverWholeMesh -
// - IndexOf3DSeries - IndexOf3DObject - IndexOf3DElement -
// if coverWholeMesh is false then specify a box containing the part of the
// 3D object which should be covered by the coll object by the commands
// - BoxPartMin(x,y,z) - BoxPartMax(x,y,z) -
// Finally add the collision object by executing the command
// - AddCollisionObject -
//
// Bullets are described by the following properties :
// - BulletRadius - BulletRange - BulletFrame - LongShots -
// LongShots moves with a unlimited speed reaching the objects immediately
//
// The actor is described by :
// - FrontDistance - HeadRadius -
//
// The camera-frame and the bullet-frames move each time the move command
// is used in the main program.
// Execute the following commands prior to each move command :
// - GetOldEyePos - GetOldBulletPos -
// The collisionTester needs this information to test for a possible collision
// in between the starting and the ending points of the Eye/bullet
//
// Test for collision with the following function calls :
// - if CollisionTester3DX1.Collision then ..
// - if CollisionTester3DX1.BulletCollision then ..
// On collision read the HitLinkNr and the properties of the collision object
//
// Destroy 3D collisionObjects by specifying :
// - NextDestroyNr - IndexOf3DSeries -
// and the executing command DestroyCollisionObject
//
// Initialize the collisionTester with the command :
// - CollisionTester3DX1.ZeroSetIt -
// This must always be done when DXDraw is initialized
//
// To install the component:
// 1) place this unit and the dcr file in the same directory as DelphiX
// 2) In Delphi you must click on Component - Install Component
// 3) Select the colli3DX.pas file and choose the Samples package to install it
// 4) Rebuild the library
// 5) Look for a new icon with a bomb on the page named DelphiX
//
// Tutorial programs are available for down-load at
// http://users.cybercity.dk/~bbl6194/delphi3dx.htm
//
// Good Luck
// Henrik Fabricius
//
//
//****************************************************************************
 
 
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DXClass, DXDraws,
{$IfDef StandardDX}
DirectDraw, Direct3D, Direct3DRM;
{$Else}
DirectX;
{$EndIf}
 
Type
Tshapes3D = (box3D, sphere3D, ellipsoid3D, cylinder3D, conus3D);
Tmaterials3D = (solid3D, water3D, air3D);
TOrientation3D = (symmetric_x, symmetric_y, symmetric_z);
TFrames3D = Array of Array of IDirect3DRMFrame;
 
TCollisionTester3DX = class(TComponent)
private
{private declarations}
FDXDrawUsed : TDXDraw;
FFrameSeries : TFrames3D;
FNextAddMesh : IDirect3DRMMesh;
FBulletFrame : IDirect3DRMFrame;
FBoxPartMin : TD3DVector;
FBoxPartMax : TD3DVector;
FOldBulletPosition: TD3DVector;
FOldEyePosition : TD3DVector;
 
FNrOfSeries : integer;
FSeriesIndex : integer;
FSeriesNr : integer;
FOrientation3D : TOrientation3D;
Fshape3D : Tshapes3D;
Fmaterial3D : Tmaterials3D;
FPercentLeftAtTop : integer;
Fbullet_hitLinknr : integer;
FIndexOf3DObject : integer;
FIndexOf3DElement : integer;
FNextDestroyNr : integer;
FNextAllOfMesh : Boolean;
FFrontDistance : integer;
FBulletRange : integer;
FBulletRadius : integer;
FHeadRadius : integer;
FFixed3DObject : Boolean;
FShootable : Boolean;
FLongShots : Boolean;
FPickable : Boolean;
FCheckAllCollObj : Boolean;
 
Fcoll_Nr_Objects : Array of integer;
FSeriesIndex_for_SeriesNr : Array of integer;
 
FNrinFrameSeries : Array of Array of integer;
Fcoll_orientation : Array of Array of TOrientation3D;
Fcoll_shape : Array of Array of Tshapes3D;
Fcoll_material : Array of Array of Tmaterials3D;
Fcoll_box_min : Array of Array of TD3DVector;
Fcoll_box_max : Array of Array of TD3DVector;
Fcoll_radius : Array of Array of TD3DValue;
Fcoll_frac_at_top : Array of Array of TD3DValue;
Fcoll_shootable : Array of Array of boolean;
Fcoll_Pickable : Array of Array of boolean;
Fcoll_Fixed3D : Array of Array of boolean;
Fcoll_objectNr : Array of Array of integer;
 
procedure SetOrientation3D(Value : TOrientation3D);
procedure SetShape3D(Value: TShapes3D);
procedure SetMaterial3D(Value: Tmaterials3D);
procedure SetPercentLeftatTop(Value: integer);
procedure SetIndexOf3DObject(Value : integer);
procedure SetIndexOf3DElement(Value : integer);
procedure SetIndexOf3DSeries(Value : integer);
procedure SetNextDestroyNr(Value : Integer);
procedure SetBulletRadius(Value : Integer);
procedure SetHeadRadius(Value : Integer);
procedure SetFrontDistance(Value : Integer);
procedure SetBulletRange(Value : Integer);
function add_space_for_one_more : boolean;
procedure GetTheBox;
procedure AddBox;
procedure AddSphere;
procedure AddCylinder;
procedure AddConus;
procedure AddEllipsoid;
 
procedure MakeNewSeries;
procedure Destroy_empty_series(SeriesNr : integer);
function GetSeriesNr(Nr : integer): integer;
procedure remove_collision_object(seriesNr, Value : integer);
function CheckForSeriesIndex(indexnow : integer): boolean;
procedure ListDataForCollObject;
function coll_test_box(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
function coll_test_cylinder(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
function coll_test_sphere(coll_nr : byte;
old_attacker_position,
attacker_position : TD3DVector;
bullet_radius : TD3Dvalue; longshot : boolean): boolean;
function coll_test_ellipsoid(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
function coll_test_conus(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
 
protected
 
public
Constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
 
property DXDrawUsed : TDXDraw write FDXDrawUsed stored false;
property FrameSeries : TFrames3D write FFrameSeries stored false;
property NextAddMesh : IDirect3DRMMesh write FNextAddMesh stored false;
property BulletFrame : IDirect3DRMFrame write FBulletFrame stored false;
 
procedure ZeroSetIt;
procedure BoxPartMin(xval, yval, zval: TD3DValue);
procedure BoxPartMax(xval, yval, zval: TD3DValue);
procedure GetOldBulletPos;
procedure GetOldEyePos;
 
function HitLinkNr: integer;
function DestroyCollisionObject: boolean;
procedure AddCollisionObject;
function Collision: boolean;
function Bulletcollision: boolean;
function BulletDead : boolean;
 
 
published
 
property BulletRadius : Integer read FBulletRadius write SetBulletRadius
default 0;
property BulletRange : Integer read FbulletRange write SetBulletRange
Default 100;
property CollisionCheckAll: Boolean read FCheckAllCollObj
write FCheckAllCollObj Default true;
property CollOrientation : TOrientation3D read FOrientation3D
write SetOrientation3D default symmetric_y;
property CollObjectType : Tshapes3D read Fshape3D write SetShape3D
default box3D;
property CollObjMaterial : Tmaterials3D read Fmaterial3D write SetMaterial3D
default solid3D;
property CoverWholeMesh : boolean read FNextAllOfMesh
write FNextAllOfMesh default true;
Property Fixed3DObject : boolean read FFixed3DObject
write FFixed3DObject default true;
property FrontDistance : Integer read FFrontDistance
write SetFrontDistance default 0;
property HeadRadius : integer read FHeadRadius write SetHeadRadius
default 0;
property IndexOf3DSeries : integer read FSeriesIndex
write SetIndexOf3DSeries default 0;
property IndexOf3DObject : integer read FIndexOf3DObject
write SetIndexOf3DObject default 0;
property IndexOf3DElement : integer read FIndexOf3DElement
write SetIndexOf3DElement default 0;
property NextDestroyNr : Integer read FNextDestroyNr
write SetNextDestroyNr default 0;
Property PercentLeftAtTop : integer read FPercentLeftAtTop
write SetPercentLeftAtTop default 0;
Property Pickable : Boolean read FPickable write FPickable
default false;
Property Shootable : boolean read FShootable write FShootable
Default false;
Property LongShots : boolean read FLongShots write FLongShots
Default false;
 
 
end; //end of Class
 
 
 
//Registering of the Component
Procedure Register;
 
 
implementation
 
 
 
procedure Register;
begin
//Register the component together with the DelphiX components from Hori
RegisterComponents('DelphiX', [TCollisionTester3DX]);
end; //end of Register
 
 
constructor TCollisionTester3DX.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
//The constructor always clears the storage it allocates for a new object
//Hence there is no need to initialize fields except to nonzero or nonempty
//values
FDXDrawUsed := nil;
FFrameSeries := nil;
FNextAddMesh := nil;
FBulletFrame := nil;
 
FOrientation3D := symmetric_y;
FShape3D := box3D;
FMaterial3D := solid3D;
FBulletRange := 100;
FNrOfSeries := 0;
setlength(FSeriesIndex_for_SeriesNr, 0);
setlength(FColl_nr_objects, 0);
setlength(FNrinFrameSeries, 0);
setlength(Fcoll_shape, 0);
setlength(Fcoll_box_min, 0);
setlength(Fcoll_box_max, 0);
setlength(Fcoll_radius, 0);
setlength(Fcoll_frac_at_top, 0);
setlength(Fcoll_objectnr, 0);
setlength(Fcoll_shootable, 0);
setlength(Fcoll_pickable, 0);
setlength(Fcoll_orientation, 0);
setlength(Fcoll_material, 0);
setlength(Fcoll_Fixed3D, 0);
 
end; //end of creation
 
 
 
 
 
 
 
destructor TCollisionTester3DX.Destroy;
begin
//destroy any embedded objects and free resources allocated by the objects
FnrinFrameSeries := nil;
Fcoll_shape := nil;
Fcoll_box_min := nil;
Fcoll_box_max := nil;
Fcoll_radius := nil;
Fcoll_frac_at_top := nil;
Fcoll_objectnr := nil;
Fcoll_shootable := nil;
Fcoll_pickable := nil;
Fcoll_orientation := nil;
Fcoll_material := nil;
Fcoll_Fixed3D := nil;
FSeriesIndex_for_SeriesNr := nil;
Fcoll_nr_objects := nil;
 
inherited Destroy;
end; //end of Destroy
 
 
 
 
procedure TCollisionTester3DX.ZeroSetIt;
begin
//initialises the dynamic arrays
FnrinFrameSeries := nil;
Fcoll_shape := nil;
Fcoll_box_min := nil;
Fcoll_box_max := nil;
Fcoll_radius := nil;
Fcoll_frac_at_top := nil;
Fcoll_objectnr := nil;
Fcoll_shootable := nil;
Fcoll_pickable := nil;
Fcoll_orientation := nil;
Fcoll_material := nil;
Fcoll_Fixed3D := nil;
FSeriesIndex_for_SeriesNr := nil;
Fcoll_nr_objects := nil;
 
FDXDrawUsed := nil;
FFrameSeries := nil;
FNextAddMesh := nil;
FBulletFrame := nil;
 
FOrientation3D := symmetric_y;
FShape3D := box3D;
FMaterial3D := solid3D;
FBulletRange := 100;
FNrOfSeries := 0;
setlength(FSeriesIndex_for_SeriesNr, 0);
setlength(FColl_nr_objects, 0);
setlength(FNrinFrameSeries, 0);
setlength(Fcoll_shape, 0);
setlength(Fcoll_box_min, 0);
setlength(Fcoll_box_max, 0);
setlength(Fcoll_radius, 0);
setlength(Fcoll_frac_at_top, 0);
setlength(Fcoll_objectnr, 0);
setlength(Fcoll_shootable, 0);
setlength(Fcoll_pickable, 0);
setlength(Fcoll_orientation, 0);
setlength(Fcoll_material, 0);
setlength(Fcoll_Fixed3D, 0);
 
end; //end of ZeroSetIt
 
 
 
 
function TcollisionTester3DX.HitLinkNr: integer;
begin
result := Fbullet_hitlinknr;
end; //end of HitLinkNr
 
 
 
procedure TCollisionTester3DX.ListDataForCollObject;
var
Nr : integer;
begin
Nr := FBullet_HitLinkNr;
 
CollObjectType := Fcoll_shape[FSeriesNr, Nr];
CollObjMaterial := Fcoll_material[FSeriesNr, Nr];
Fixed3DObject := Fcoll_Fixed3D[FSeriesNr, Nr];
CollOrientation := Fcoll_orientation[FSeriesNr, Nr];
IndexOf3DObject := Fcoll_objectNr[FSeriesNr, Nr];
IndexOf3DSeries := FSeriesIndex;
IndexOf3DElement := FNrinFrameSeries[FSeriesNr, Nr];
Pickable := Fcoll_pickable[FSeriesNr, Nr];
Shootable := Fcoll_shootable[FseriesNr, Nr];
 
end; //end of ListDataForCollObject
 
 
 
 
procedure TcollisionTester3DX.SetPercentLeftAtTop(Value : Integer);
begin
//value can not be negative
if (FPercentLeftAtTop <> Value) and (Value >= 0)
then
FPercentLeftAtTop := value;
end; //end of SetPercentLeftAtTop
 
 
 
 
procedure TcollisionTester3DX.SetOrientation3D(Value : TOrientation3D);
begin
if FOrientation3D <> Value
then
FOrientation3D := Value;
end; //end setorientation3D
 
 
procedure TcollisionTester3DX.SetShape3D(Value : Tshapes3D);
begin
if Fshape3D <> Value
then
Fshape3D := Value;
end; //end setshapes3D
 
 
 
procedure TcollisionTester3DX.SetMaterial3D(Value : Tmaterials3D);
begin
if Fmaterial3D <> Value
then
Fmaterial3D := Value;
end; //end setshapes3D
 
 
 
procedure TCollisionTester3DX.SetIndexOf3DObject(Value : integer);
begin
//Index can not be negative
if (FIndexOf3DObject <> Value) and (Value >= 0)
then
FIndexOf3DObject := value;
end; //end setIndexOf3DObject
 
 
procedure TCollisionTester3DX.SetIndexOf3DElement(Value : integer);
begin
//Index can not be negative
if (FIndexOf3DElement <> Value) and (Value >= 0)
then
FIndexOf3DElement := value;
end; //end setIndexOf3DElement
 
 
 
procedure TCollisionTester3DX.SetIndexOf3DSeries(Value : integer);
begin
//Index can not be negative
if (FSeriesIndex <> Value) and (Value >= 0)
then
FSeriesIndex := value;
end; //end of SetIndexOf3DSeries
 
 
 
 
procedure TCollisionTester3DX.SetNextDestroyNr(Value : integer);
begin
//Index can not be negative
if (FNextDestroyNr <> Value) and (Value >= 0)
then
FNextDestroyNr := value;
end; //end of SetNextDestroyNr
 
 
 
 
procedure TCollisionTester3DX.SetBulletRadius(Value : Integer);
begin
//Radius can not be negative
if (FBulletRadius <> Value) and (Value >= 0)
then
FBulletRadius := value;
end; //end of SetBulletRadius
 
 
 
procedure TCollisionTester3DX.SetHeadRadius(Value : Integer);
begin
//Radius can not be negative
if (FHeadRadius <> Value) and (Value >= 0)
then
FHeadRadius := value;
end; //end of SetHeadRadius
 
 
 
 
procedure TCollisionTester3DX.SetFrontDistance(Value : Integer);
begin
//FrontDistance can not be negative
if (FFrontDistance <> Value) and (Value >= 0)
then
FFrontDistance := value;
end; //end of SetFrontDistance
 
 
 
 
procedure TCollisionTester3DX.SetBulletRange(Value : Integer);
begin
//BulletRange can not be negative
if (FBulletRange <> Value) and (Value >= 0)
then
FBulletRange := value;
end; //end of SetBulletRange
 
 
 
 
function TcollisionTester3DX.Add_Space_For_One_More: boolean;
var
NewNr : integer;
begin
//add space for one more element in the present series
 
//length of Fcoll_nr_objects and FSeries_nIndex_for_SeriesNr are unchanged
NewNr := Fcoll_nr_objects[FseriesNr] + 1;
 
result := true;
 
try
SetLength(FNrinFrameSeries[FSeriesNr], NewNr);
SetLength(Fcoll_shape[FSeriesNr], NewNr);
SetLength(Fcoll_box_min[FSeriesNr], NewNr);
SetLength(Fcoll_box_max[FSeriesNr], NewNr);
SetLength(Fcoll_radius[FSeriesNr], NewNr);
SetLength(Fcoll_frac_at_top[FSeriesNr], NewNr);
SetLength(Fcoll_objectnr[FSeriesNr], NewNr);
SetLength(Fcoll_shootable[FSeriesNr], NewNr);
SetLength(Fcoll_pickable[FSeriesNr], NewNr);
SetLength(Fcoll_orientation[FSeriesNr], NewNr);
SetLength(Fcoll_material[FSeriesNr], NewNr);
SetLength(Fcoll_Fixed3D[FSeriesNr], NewNr);
 
except
on EOutOfMemory do
begin
//There is not enough memory available. Free some memory
dec(NewNr);
 
copy(FNrinFrameSeries[FseriesNr], 0, NewNr);
copy(Fcoll_shape[FseriesNr], 0, NewNr);
copy(Fcoll_box_min[FSeriesNr], 0, NewNr);
copy(Fcoll_box_max[FSeriesNr], 0, NewNr);
copy(Fcoll_radius[FSeriesNr], 0, NewNr);
copy(Fcoll_frac_at_top[FSeriesNr], 0, NewNr);
copy(Fcoll_objectnr[FSeriesNr], 0, NewNr);
copy(Fcoll_shootable[FSeriesNr], 0, NewNr);
copy(Fcoll_pickable[FSeriesNr], 0, NewNr);
copy(Fcoll_orientation[FSeriesNr], 0, NewNr);
copy(Fcoll_material[FSeriesNr], 0, NewNr);
copy(Fcoll_Fixed3D[FSeriesNr], 0, NewNr);
 
result := false;
end;
end;
 
//update count of objects in series
Fcoll_nr_objects[FseriesNr] := NewNr;
 
end; //end of Add_Space_For_One_More
 
 
 
 
procedure TcollisionTester3DX.MakeNewSeries;
begin
inc(FNrOfSeries);
 
SetLength(FSeriesIndex_for_SeriesNr, FNrOfSeries);
FSeriesIndex_for_SeriesNr[FNrOfSeries-1] := FSeriesIndex;
 
SetLength(Fcoll_nr_objects, FNrOfSeries);
Fcoll_nr_objects[FNrOfSeries-1] := 0;
 
SetLength(FNrinFrameSeries, FNrOfSeries);
SetLength(Fcoll_shape, FNrOfSeries);
SetLength(Fcoll_box_min, FNrOfSeries);
SetLength(Fcoll_box_max, FNrOfSeries);
SetLength(Fcoll_radius, FNrOfSeries);
SetLength(Fcoll_frac_at_top, FNrOfSeries);
SetLength(Fcoll_objectnr, FNrOfSeries);
SetLength(Fcoll_shootable, FNrOfSeries);
SetLength(Fcoll_pickable, FNrOfSeries);
SetLength(Fcoll_orientation, FNrOfSeries);
SetLength(Fcoll_material, FNrOfSeries);
SetLength(Fcoll_Fixed3D, FNrOfSeries);
end; //end of MakeNewSeries
 
 
 
 
procedure TcollisionTester3DX.Destroy_Empty_Series(SeriesNr : integer);
var
i, j : integer;
begin
if seriesNr < (FNrOfSeries - 1)
then
begin
for i := SeriesNr to (FNrOfSeries - 2) do
begin
FSeriesIndex_for_SeriesNr[i] := FSeriesIndex_for_SeriesNr[i+1];
 
SetLength(FNrinFrameSeries[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
FNrinFrameSeries[i, j] := FNrinFrameSeries[(i+1), j];
 
SetLength(Fcoll_shape[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_shape[i, j] := Fcoll_shape[(i+1), j];
 
SetLength(Fcoll_box_min[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_box_min[i, j] := Fcoll_box_min[(i+1), j];
 
SetLength(Fcoll_box_max[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_box_max[i, j] := Fcoll_box_max[(i+1), j];
 
SetLength(Fcoll_radius[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_radius[i, j] := Fcoll_radius[(i+1), j];
 
SetLength(Fcoll_frac_at_top[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_frac_at_top[i, j] := Fcoll_frac_at_top[(i+1), j];
 
SetLength(Fcoll_objectnr[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_objectNr[i, j] := Fcoll_objectNr[(i+1), j];
 
SetLength(Fcoll_shootable[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_shootable[i, j] := Fcoll_shootable[(i+1), j];
 
SetLength(Fcoll_pickable[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_pickable[i, j] := Fcoll_pickable[(i+1), j];
 
SetLength(Fcoll_orientation[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_orientation[i, j] := Fcoll_orientation[(i+1), j];
 
SetLength(Fcoll_material[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_material[i, j] := Fcoll_material[(i+1), j];
 
SetLength(Fcoll_Fixed3D[i], Fcoll_Nr_objects[i+1]);
for j := 0 to (Fcoll_Nr_objects[i+1] - 1) do
Fcoll_Fixed3D[i, j] := Fcoll_Fixed3D[(i+1), j];
 
Fcoll_nr_objects[i] := Fcoll_nr_objects[i+1];
 
end;
end;
 
dec(FNrOfSeries);
 
FSeriesIndex_For_SeriesNr := copy(FSeriesIndex_for_SeriesNr, 0, FNrOfSeries);
Fcoll_Nr_Objects := copy(Fcoll_Nr_Objects, 0, FNrOfSeries);
FNrinFrameSeries := copy(FNrinFrameSeries, 0, FNrOfSeries);
Fcoll_Shape := copy(Fcoll_Shape, 0, FNrOfSeries);
Fcoll_Box_Min := copy(Fcoll_Box_Min, 0, FNrOfSeries);
Fcoll_Box_Max := copy(Fcoll_Box_Max, 0, FNrOfSeries);
Fcoll_Radius := copy(Fcoll_Radius, 0, FNrOfSeries);
Fcoll_Frac_At_Top := copy(Fcoll_Frac_At_Top, 0, FNrOfSeries);
Fcoll_ObjectNr := copy(Fcoll_ObjectNr, 0, FNrOfSeries);
Fcoll_Shootable := copy(Fcoll_Shootable, 0, FNrOfSeries);
Fcoll_Pickable := copy(Fcoll_Pickable, 0, FNrOfSeries);
Fcoll_orientation := copy(Fcoll_orientation, 0, FNrOfSeries);
Fcoll_Material := copy(Fcoll_Material, 0, FNrOfSeries);
Fcoll_Fixed3D := copy(Fcoll_Fixed3D, 0, FNrOfSeries);
end; //end of Destroy_Empty_Series
 
 
 
 
 
 
 
procedure TcollisionTester3DX.Remove_Collision_Object(SeriesNr, Value : integer);
var
i : integer;
begin
//Elements in the series which have a higher index than the one removed
//gets a smaller index which is correct when the main program removes the object
for i := 0 to (FColl_nr_objects[SeriesNr] - 1) do
begin
if FNrinFrameSeries[SeriesNr, i] >= value
then
dec(FNrinFrameSeries[SeriesNr, i]);
end;
 
for i := Value to (Fcoll_nr_objects[SeriesNr] - 2) do
begin
FNrinFrameSeries[SeriesNr, i] := FNrinFrameSeries[SeriesNr, (i+1)];
Fcoll_shape[SeriesNr, i] := Fcoll_shape[SeriesNr, (i+1)];
Fcoll_box_min[SeriesNr, i] := Fcoll_box_min[SeriesNr, (i+1)];
Fcoll_box_max[SeriesNr, i] := Fcoll_box_max[SeriesNr, (i+1)];
Fcoll_radius[seriesNr, i] := Fcoll_radius[SeriesNr, (i+1)];
Fcoll_frac_at_top[SeriesNr, i] := Fcoll_frac_at_top[SeriesNr, (i+1)];
Fcoll_objectnr[SeriesNr, i] := Fcoll_objectnr[SeriesNr, (i+1)];
Fcoll_shootable[SeriesNr, i] := Fcoll_shootable[SeriesNr, (i+1)];
Fcoll_Pickable[SeriesNr, i] := Fcoll_Pickable[SeriesNr, (i+1)];
Fcoll_orientation[SeriesNr, i] := Fcoll_orientation[SeriesNr, (i+1)];
Fcoll_material[SeriesNr, i] := Fcoll_material[SeriesNr, (i+1)];
Fcoll_Fixed3D[SeriesNr, i] := Fcoll_Fixed3D[SeriesNr, (i+1)];
end;
 
dec(Fcoll_nr_objects[SeriesNr]);
 
//remember to reduce the length of Fcoll_frame
FNrinFrameSeries[SeriesNr] := copy(FNrinFrameSeries[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_shape[SeriesNr] := copy(Fcoll_shape[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_box_min[SeriesNr] := copy(Fcoll_box_min[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_box_max[SeriesNr] := copy(Fcoll_box_max[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_radius[SeriesNr] := copy(Fcoll_radius[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_frac_at_top[SeriesNr] := copy(Fcoll_frac_at_top[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_objectnr[SeriesNr] := copy(Fcoll_objectnr[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_shootable[SeriesNr] := copy(Fcoll_shootable[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_pickable[SeriesNr] := copy(Fcoll_pickable[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
Fcoll_material[SeriesNr] := copy(Fcoll_material[SeriesNr], 0,
Fcoll_nr_objects[FSeriesNr]);
Fcoll_orientation[SeriesNr] := copy(Fcoll_orientation[SeriesNr], 0,
Fcoll_nr_objects[FSeriesNr]);
Fcoll_fixed3D[SeriesNr] := copy(Fcoll_fixed3D[SeriesNr], 0,
Fcoll_nr_objects[SeriesNr]);
 
end; //end of Remove_Collision_Object
 
 
 
 
 
 
 
procedure TCollisionTester3DX.GetTheBox;
var
box: TD3DRMBOX;
begin
if FNextAllOfMesh
then
begin
FNextAddMesh.GetBox(box);
FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := box.min;
FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := box.max;
end
else
begin
FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FBoxPartMin;
FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FBoxPartMax;
end;
 
end; //end of GetTheBox
 
 
 
procedure TCollisionTester3DX.BoxPartMin(xval, yval, zval : TD3DValue);
begin
FBoxPartMin.x := xval;
FBoxPartMin.y := yval;
FBoxPartMin.z := zval;
end; //end of BoxPartMin
 
 
 
 
procedure TCollisionTester3DX.BoxPartMax(xval, yval, zval : TD3DValue);
begin
FBoxPartMax.x := xval;
FBoxPartMax.y := yval;
FBoxPartMax.z := zval;
end; //end of BoxPartMax
 
 
 
 
 
procedure TCollisionTester3DX.AddBox;
begin
if add_space_for_one_more
then
begin
GetTheBox;
 
Fcoll_objectnr[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexOf3DObject;
Fcoll_shape[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := box3D;
FNrinFrameSeries[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexof3Delement;
Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := 0; //not used
Fcoll_frac_at_top[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := 0; //not used
Fcoll_material[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fmaterial3D;
Fcoll_orientation[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Forientation3D;
Fcoll_shootable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] -1)] := Fshootable;
Fcoll_Pickable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fpickable;
Fcoll_fixed3D[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FFixed3DObject;
end;
end; //end of AddBox
 
 
 
 
procedure TCollisionTester3DX.AddSphere;
begin
if add_space_for_one_more
then
begin
GetTheBox;
Fcoll_objectnr[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexOf3DObject;
Fcoll_shape[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := sphere3D;
FNrinFrameSeries[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexof3Delement;
Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] :=
(FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].x
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].x
+ FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].y
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].y
+ FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FseriesNr] - 1)].z)/2/3;
Fcoll_frac_at_top[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := 0; //not used
Fcoll_orientation[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Forientation3D;
Fcoll_material[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fmaterial3D;
Fcoll_shootable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fshootable;
Fcoll_Pickable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fpickable;
Fcoll_fixed3D[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FFixed3DObject;
end;
 
end; //end of AddSphere
 
 
 
 
 
procedure TCollisionTester3DX.Addcylinder;
begin
//the sphere cowers whole of the 3D-object
if add_space_for_one_more
then
begin
GetTheBox;
 
Fcoll_objectnr[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexOf3DObject;
Fcoll_shape[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := cylinder3D;
FNrinFrameSeries[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexof3Delement;
case Forientation3D of
symmetric_x : Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] :=
(FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].y
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FseriesNr] - 1)].y
+ FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z)/2/2;
symmetric_y : Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] :=
(FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].x
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FseriesNr] - 1)].x
+ FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z)/2/2;
symmetric_z : Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] :=
(FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].x
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FseriesNr] - 1)].x
+ FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].y
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].y)/2/2;
end;
 
Fcoll_frac_at_top[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := 0; //not used
Fcoll_orientation[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Forientation3D;
Fcoll_material[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fmaterial3D;
Fcoll_shootable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fshootable;
Fcoll_Pickable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fpickable;
Fcoll_fixed3D[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FFixed3DObject;
end;
end; //end of Addcylinder
 
 
 
 
procedure TCollisionTester3DX.Addconus;
begin
//the conus cowers whole of or part of the 3D-object
//fraction_left_at_top = 0 if sharp tip
if add_space_for_one_more
then
begin
GettheBox;
 
Fcoll_objectnr[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexOf3DObject;
Fcoll_shape[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := conus3D;
FNrinFrameSeries[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexof3Delement;
Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] :=
(FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].x
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].x
+ FColl_box_max[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z
- FColl_box_min[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)].z)/2/2;
Fcoll_frac_at_top[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FPercentLeftAtTop/100;
Fcoll_orientation[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Forientation3D;
Fcoll_material[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fmaterial3D;
Fcoll_shootable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] -1)] := Fshootable;
Fcoll_Pickable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fpickable;
Fcoll_fixed3D[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FFixed3DObject;
end;
end; //end of Addconus
 
 
 
 
procedure TCollisionTester3DX.AddEllipsoid;
begin
if add_space_for_one_more
then
begin
GetTheBox;
Fcoll_objectnr[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexOf3DObject;
Fcoll_shape[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Ellipsoid3D;
FNrinFrameSeries[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FIndexof3Delement;
Fcoll_radius[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := 0; //not used
Fcoll_frac_at_top[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := 0; //not used
Fcoll_orientation[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Forientation3D;
Fcoll_material[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fmaterial3D;
Fcoll_shootable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fshootable;
Fcoll_Pickable[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := Fpickable;
Fcoll_fixed3D[FSeriesNr, (Fcoll_Nr_objects[FSeriesNr] - 1)] := FFixed3DObject;
end;
end; //end of AddEllipsoid
 
 
 
 
 
 
 
function TcollisionTester3DX.GetSeriesNr(Nr : integer): integer;
var
NrNow, i : integer;
begin
 
if FNrOfSeries = 0
then
NrNow := 0
else
begin
NrNow := -1;
for i := 0 to (FNrOfSeries - 1) do
begin
if Nr = FSeriesIndex_for_SeriesNr[i]
then
NrNow := i;
end;
 
if NrNow = -1
then
NrNow := FNrOfSeries; //make new series
end;
 
if NrNow = FNrOfSeries
then
MakeNewSeries;
 
 
result := NrNow;
 
 
end; //end of GetSeriesNr
 
 
 
 
 
function TcollisionTester3DX.CheckForSeriesIndex(indexnow : integer): boolean;
var
i : integer;
begin
 
if FNrOfSeries = 0
then
result := false
else
begin
FSeriesNr := -1;
for i := 0 to (FNrOfSeries - 1) do
begin
if indexnow = FSeriesIndex_for_SeriesNr[i]
then
FSeriesNr := i;
end;
 
result := (FSeriesNr <> -1);
end;
 
end; //end of CheckForSeriesIndex
 
 
 
 
 
procedure TcollisionTester3DX.AddCollisionObject;
begin
FSeriesNr := GetSeriesNr(FSeriesIndex);
 
case Fshape3D of
box3D : AddBox;
sphere3D : AddSphere;
cylinder3D : AddCylinder;
ellipsoid3D: AddEllipsoid;
Conus3D : AddConus;
end;
 
end; //end of AddCollisionObject
 
 
 
 
 
function TCollisionTester3DX.DestroyCollisionObject: boolean;
var
test_nr : integer;
begin
//remove all collision objects connected with the 3D-object
//with the index FnextDestroyNr
 
//Check whether series index exists
if CheckForSeriesIndex(FSeriesIndex)
then
begin
//FSeriesNr was found
test_nr := 0;
 
while (test_nr <= (Fcoll_nr_objects[FSeriesNr] - 1)) do
begin
if Fcoll_objectnr[FSeriesNr, test_nr] = FnextDestroyNr
then
remove_collision_object(FSeriesNr, FnextDestroyNr)
else
inc(test_nr);
end; //end of while loop
 
//now we have to decrement all Fcoll_objectnr values larger than object_nr
//because the main program does a similar decrementation when the 3D-object
//is removed
 
if Fcoll_nr_objects[FSeriesNr] > 0
then
begin
//the series is not empty
for test_nr := 0 to (Fcoll_nr_objects[FSeriesNr] - 1) do
begin
if Fcoll_objectnr[FSeriesNr, test_nr] > FNextDestroyNr
then
dec(Fcoll_objectnr[FSeriesNr, test_nr]);
end;
end
else
destroy_empty_Series(FSeriesNr);
 
 
result := true; //collision object was destroyed
 
end //end of CheckForSeriesIndex...
else
result := false; //unable to destroy
 
end; //end of DestroyCollisionObject
 
 
 
 
 
 
function TcollisionTester3DX.coll_test_sphere(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
var
new_eye, old_eye : TD3DVector;
dstep, step, center : TD3DVector;
radius, d0, d1, d2, rod, rod2, t1, t2 : TD3DValue;
begin
result := false;
//Get the coordinates of the old eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(old_eye, old_attacker_position);
 
//Get the coordinates of the eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(new_eye, attacker_position);
 
center.x := (Fcoll_box_max[FSeriesNr, coll_nr].x
+ Fcoll_box_min[FSeriesNr, coll_nr].x)/2;
center.y := (Fcoll_box_max[FSeriesNr, coll_nr].y
+ Fcoll_box_min[FSeriesNr, coll_nr].y)/2;
center.z := (Fcoll_box_max[FSeriesNr, coll_nr].z
+ Fcoll_box_min[FSeriesNr, coll_nr].z)/2;
 
//radius of sphere enlarged with the radius of the bullet
//to cover the space where a collision may occure
radius := Fcoll_radius[FSeriesNr, coll_nr] + bullet_radius;
 
//eye to center distance
dstep.x := old_eye.x - center.x;
dstep.y := old_eye.y - center.y;
dstep.z := old_eye.z - center.z;
 
//step in eye position
step.x := new_eye.x - old_eye.x;
step.y := new_eye.y - old_eye.y;
step.z := new_eye.z - old_eye.z;
 
//collision is only possible when something moves
if (abs(step.x) < 1e-3) and (abs(step.y) < 1e-3) and (abs(step.z) < 1e-3)
then
begin
result := false;
exit;
end;
 
 
//factors
d0 := sqr(dstep.x) + sqr(dstep.y) + sqr(dstep.z) - sqr(radius);
d1 := 2 * (step.x * dstep.x + step.y * dstep.y + step.z * dstep.z);
d2 := sqr(step.x) + sqr(step.y) + sqr(step.z);
 
//solving an equation of the second degree
rod := sqr(d1) - 4 * d2 * d0;
 
//d2 is never zero
if rod > 0
then
begin
rod2 := sqrt(rod);
t1 := (-d1 - rod2)/2/d2;
t2 := (-d1 + rod2)/2/d2;
 
// if longshot then look into all future
if longshot
then
result := (t1 >= 0) or (t2 >= 0)
else
begin
//collision in between the starting and the ending point if
result := ((t1 >= 0) and (t1 <= 1))
or ((t2 >= 0) and (t2 <= 1));
end;
end;
 
end; //end of coll_test_sphere
 
 
 
 
function TcollisionTester3DX.coll_test_ellipsoid(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
var
new_eye, old_eye : TD3DVector;
dstep, step, center : TD3DVector;
d0, d1, d2, rod, rod2, t1, t2, a, b, c : TD3DValue;
begin
result := false;
 
//Get the coordinates of the old eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(old_eye, old_attacker_position);
 
//Get the coordinates of the eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(new_eye, attacker_position);
 
center.x := (Fcoll_box_max[FSeriesNr, coll_nr].x
+ Fcoll_box_min[FSeriesNr, coll_nr].x)/2;
center.y := (Fcoll_box_max[FSeriesNr, coll_nr].y
+ Fcoll_box_min[FSeriesNr, coll_nr].y)/2;
center.z := (Fcoll_box_max[FSeriesNr, coll_nr].z
+ Fcoll_box_min[FSeriesNr, coll_nr].z)/2;
 
//x, y and z radius of ellipsoid enlarged with the radius of the bullet
//to cover the space where a collision may occure
a := (Fcoll_box_max[FSeriesNr, coll_nr].x
- Fcoll_box_min[FSeriesNr, coll_nr].x)/2 + bullet_radius;
b := (Fcoll_box_max[FSeriesNr, coll_nr].y
- Fcoll_box_min[FSeriesNr, coll_nr].y)/2 + bullet_radius;
c := (Fcoll_box_max[FSeriesNr, coll_nr].z
- Fcoll_box_min[FSeriesNr, coll_nr].z)/2 + bullet_radius;
 
//eye to center distance
dstep.x := old_eye.x - center.x;
dstep.y := old_eye.y - center.y;
dstep.z := old_eye.z - center.z;
 
//step in eye position
step.x := new_eye.x - old_eye.x;
step.y := new_eye.y - old_eye.y;
step.z := new_eye.z - old_eye.z;
 
//collision is only possible when something moves
if (abs(step.x) < 1e-3) and (abs(step.y) < 1e-3) and (abs(step.z) < 1e-3)
then
begin
result := false;
exit;
end;
 
 
//factors
d0 := sqr(b * c * dstep.x) + sqr(a * c * dstep.y) + sqr(a * b * dstep.z)
- sqr(a * b * c);
d1 := 2 * (sqr(b * c) * step.x * dstep.x + sqr(a * c) * step.y * dstep.y
+ sqr(a * b) * step.z * dstep.z);
d2 := sqr(b * c * step.x) + sqr(a * c * step.y) + sqr(a * b * step.z);
 
//solving an equation of the second degree
rod := sqr(d1) - 4 * d2 * d0;
 
//d2 is never zero
if rod > 0
then
begin
rod2 := sqrt(rod);
t1 := (-d1 - rod2)/2/d2;
t2 := (-d1 + rod2)/2/d2;
 
// if longshot then look into all future
if longshot
then
result := (t1 >= 0) or (t2 >= 0)
else
begin
//collision in between the starting and the ending point if
result := ((t1 >= 0) and (t1 <= 1))
or ((t2 >= 0) and (t2 <= 1));
end;
end;
 
end; //end of coll_test_ellipsoid
 
 
 
 
 
function TcollisionTester3DX.coll_test_cylinder(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
var
distance : TD3DValue;
new_eye, old_eye : TD3DVector;
dstep, step, center : TD3DVector;
radius, d0, d1, d2, rod, rod2, t1, t2, xc1, yc1, zc1, xc2, yc2, zc2 : TD3DValue;
begin
result := false;
 
 
//Get the coordinates of the old eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(old_eye, old_attacker_position);
 
//Get the coordinates of the eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(new_eye, attacker_position);
 
center.x := (Fcoll_box_max[FSeriesNr, coll_nr].x
+ Fcoll_box_min[FSeriesNr, coll_nr].x)/2;
center.y := (Fcoll_box_max[FSeriesNr, coll_nr].y
+ Fcoll_box_min[FSeriesNr, coll_nr].y)/2;
center.z := (Fcoll_box_max[FSeriesNr, coll_nr].z
+ Fcoll_box_min[FSeriesNr, coll_nr].z)/2;
 
//radius of sphere enlarged with the radius of the bullet
//to cover the space where a collision may occure
radius := Fcoll_radius[FSeriesNr, coll_nr] + bullet_radius;
 
//eye to center distance
dstep.x := old_eye.x - center.x;
dstep.y := old_eye.y - center.y;
dstep.z := old_eye.z - center.z;
 
//step in eye position
step.x := new_eye.x - old_eye.x;
step.y := new_eye.y - old_eye.y;
step.z := new_eye.z - old_eye.z;
 
//collision is only possible when something moves
if (abs(step.x) < 1e-3) and (abs(step.y) < 1e-3) and (abs(step.z) < 1e-3)
then
begin
result := false;
exit;
end;
 
d0 := 1; //just to avoid warnings
d1 := 1;
d2 := 1;
 
 
//The cylinder is alined parallel to the x, y or z axis
case FOrientation3D of
symmetric_x :
begin
//factors
d0 := sqr(dstep.y) + sqr(dstep.z) - sqr(radius);
d1 := 2 * (step.y * dstep.y + step.z * dstep.z);
d2 := sqr(step.y) + sqr(step.z);
end;
symmetric_y :
begin
//factors
d0 := sqr(dstep.x) + sqr(dstep.z) - sqr(radius);
d1 := 2 * (step.x * dstep.x + step.z * dstep.z);
d2 := sqr(step.x) + sqr(step.z);
end;
symmetric_z :
begin
//factors
d0 := sqr(dstep.x) + sqr(dstep.y) - sqr(radius);
d1 := 2 * (step.x * dstep.x + step.y * dstep.y);
d2 := sqr(step.x) + sqr(step.y);
end;
end; //end of case FOrientation3D of
 
 
//solving an equation of the second degree
rod := sqr(d1) - 4 * d2 * d0;
 
//d2 is never zero
if rod >= 0
then
begin
//only then is the collision possible
rod2 := sqrt(rod);
t1 := (-d1 - rod2)/2/d2;
t2 := (-d1 + rod2)/2/d2;
 
// if longshot then look into all future
if longshot
then
result := (t1 >= 0) or (t2 >= 0)
else
begin
//collision in between the starting and the ending point if
result := ((t1 >= 0) and (t1 <= 1))
or ((t2 >= 0) and (t2 <= 1));
end;
 
// however the collision also affords that we are within the length of the cylinder
if result then
begin
case FOrientation3D of
symmetric_x :
begin
xc1 := old_eye.x + t1 * step.x;
xc2 := old_eye.x + t2 * step.x;
 
 
if longshot
then
result :=
(result and (t1 >= 0) and
(xc1 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc1 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) )
or
(result and (t2 >= 0) and
(xc2 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc2 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) )
else
result :=
(result and (t1 >= 0) and (t1 <= 1) and
(xc1 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc1 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) )
or
(result and (t2 >= 0) and (t2 <= 1) and
(xc2 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc2 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) );
 
//if collision detected then exit now
if result then exit;
 
end;
symmetric_y :
begin
yc1 := old_eye.y + t1 * step.y;
yc2 := old_eye.y + t2 * step.y;
 
 
if longshot
then
result :=
(result and (t1 >= 0) and
(yc1 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc1 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) )
or
(result and (t2 >= 0) and
(yc2 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc2 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) )
else
result :=
(result and (t1 >= 0) and (t1 <= 1) and
(yc1 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc1 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) )
or
(result and (t2 >= 0) and (t2 <= 1) and
(yc2 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc2 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) );
 
//if collision detected then exit now
if result then exit;
 
 
end;
symmetric_z :
begin
zc1 := old_eye.z + t1 * step.z;
zc2 := old_eye.z + t2 * step.z;
 
 
if longshot
then
result :=
(result and (t1 >= 0) and
(zc1 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc1 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) )
or
(result and (t2 >= 0) and
(zc2 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc2 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) )
else
result :=
(result and (t1 >= 0) and (t1 <= 1) and
(zc1 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc1 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) )
or
(result and (t2 >= 0) and (t2 <= 1) and
(zc2 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc2 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) );
 
//if collision detected then exit now
if result then exit;
end;
 
end; //end of case
end;
 
//exit if a collision occured
if result then exit;
end;
 
 
//the collision may also occur with the end surfaces of the cylinder
case FOrientation3D of
symmetric_x :
begin
if step.x > 1e-6
then
begin
//1st end surface
t1 := (Fcoll_box_min[FseriesNr, coll_Nr].x - old_eye.x)/step.x;
yc1 := old_eye.y + t1 * step.y;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(yc1 - center.y) + sqr(zc1 - center.z) );
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
 
//2nd end surface
t1 := (Fcoll_box_max[FseriesNr, coll_Nr].x - old_eye.x)/step.x;
yc1 := old_eye.y + t1 * step.y;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(yc1 - center.y) + sqr(zc1 - center.z) );
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
end;
end;
symmetric_y :
begin
if step.y > 1e-6
then
begin
//1st end surface
t1 := (Fcoll_box_min[FseriesNr, coll_Nr].y - old_eye.y)/step.y;
xc1 := old_eye.x + t1 * step.x;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(zc1 - center.z) );
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
 
//2nd end surface
t1 := (Fcoll_box_max[FseriesNr, coll_Nr].y - old_eye.y)/step.y;
xc1 := old_eye.x + t1 * step.x;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(zc1 - center.z) );
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
end;
 
end;
symmetric_z :
begin
if step.z > 1e-6
then
begin
//1st end surface
t1 := (Fcoll_box_min[FseriesNr, coll_Nr].z - old_eye.z)/step.z;
xc1 := old_eye.x + t1 * step.x;
yc1 := old_eye.y + t1 * step.y;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(yc1 - center.y) );
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
 
//2nd end surface
t1 := (Fcoll_box_max[FseriesNr, coll_Nr].z - old_eye.z)/step.z;
xc1 := old_eye.x + t1 * step.x;
yc1 := old_eye.y + t1 * step.y;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(yc1 - center.y) );
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
end;
 
end;
 
 
end; //end of case
 
end; //end of coll_test_cylinder
 
 
 
 
 
function TcollisionTester3DX.coll_test_conus(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
var
height3D, width3D : TD3DValue;
distance : TD3DValue;
new_eye, old_eye : TD3DVector;
dstep, step, center : TD3DVector;
radius, d0, d1, d2, rod, rod2, t1, t2, xc1, yc1, zc1, xc2, yc2, zc2 : TD3DValue;
xc, yc, zc, conusfact : TD3DValue;
begin
result := false;
 
//Get the coordinates of the old eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(old_eye, old_attacker_position);
 
//Get the coordinates of the eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(new_eye, attacker_position);
 
center.x := (Fcoll_box_max[FSeriesNr, coll_nr].x
+ Fcoll_box_min[FSeriesNr, coll_nr].x)/2;
center.y := (Fcoll_box_max[FSeriesNr, coll_nr].y
+ Fcoll_box_min[FSeriesNr, coll_nr].y)/2;
center.z := (Fcoll_box_max[FSeriesNr, coll_nr].z
+ Fcoll_box_min[FSeriesNr, coll_nr].z)/2;
 
 
//step in eye position
step.x := new_eye.x - old_eye.x;
step.y := new_eye.y - old_eye.y;
step.z := new_eye.z - old_eye.z;
 
//collision is only possible when something moves
if (abs(step.x) < 1e-3) and (abs(step.y) < 1e-3) and (abs(step.z) < 1e-3)
then
begin
result := false;
exit;
end;
 
//if FPercentLeftatTop is positiv then the conus is largest at the bottom
xc := center.x;
yc := center.y;
zc := center.z;
 
width3D := 10; //just to avoid warnings
height3D := 10;
 
case FOrientation3D of
symmetric_x :
begin
height3D := Fcoll_box_max[FSeriesNr, coll_nr].x
- Fcoll_box_min[FSeriesNr, coll_nr].x;
width3D := (Fcoll_box_max[FSeriesNr, coll_Nr].y
- Fcoll_box_min[FSeriesNr, coll_nr].y
+ Fcoll_box_max[FSeriesNr, coll_nr].z
- Fcoll_box_min[FSeriesNr, coll_nr].z)/2;
 
//the top of the conus is maller than the bottom of it
if FPercentLeftatTop >= 0
then
xc := center.x - height3D/2 + 100 * height3D/(100 - FpercentLeftatTop)
else
xc := center.x + height3D/2 - 100 * height3D/(100 + FpercentLeftatTop);
end; //end of symmetric_x
symmetric_y :
begin
height3D := Fcoll_box_max[FSeriesNr, coll_nr].y
- Fcoll_box_min[FSeriesNr, coll_nr].y;
width3D := (Fcoll_box_max[FSeriesNr, coll_Nr].x
- Fcoll_box_min[FSeriesNr, coll_nr].x
+ Fcoll_box_max[FSeriesNr, coll_nr].z
- Fcoll_box_min[FSeriesNr, coll_nr].z)/2;
 
//the top of the conus is maller than the bottom of it
if FPercentLeftatTop >= 0
then
yc := center.y - height3D/2 + 100 * height3D/(100 - FpercentLeftatTop)
else
yc := center.y + height3D/2 - 100 * height3D/(100 + FpercentLeftatTop);
end; //end of symmetric_y
symmetric_z :
begin
height3D := Fcoll_box_max[FSeriesNr, coll_nr].z
- Fcoll_box_min[FSeriesNr, coll_nr].z;
width3D := (Fcoll_box_max[FSeriesNr, coll_Nr].x
- Fcoll_box_min[FSeriesNr, coll_nr].x
+ Fcoll_box_max[FSeriesNr, coll_nr].y
- Fcoll_box_min[FSeriesNr, coll_nr].y)/2;
 
//the top of the conus is maller than the bottom of it
if FPercentLeftatTop >= 0
then
zc := center.z - height3D/2 + 100 * height3D/(100 - FpercentLeftatTop)
else
zc := center.z + height3D/2 - 100 * height3D/(100 + FpercentLeftatTop);
end; //end of symmetric_z
end; //end of case
 
//mathematically we need the conusfact describing the ratio between the radius of
//the large end of the conus and the height of the conus
if width3D > 0
then
conusfact := height3D/2/width3D
else
conusfact := 1e9;
 
//eye to the fictive tip of the conus distance
dstep.x := old_eye.x - xc;
dstep.y := old_eye.y - yc;
dstep.z := old_eye.z - zc;
 
d0 := 1; //just to avoid warnings
d1 := 1;
d2 := 1;
 
//The conus is aligned parallel to the x, y or z axis
case FOrientation3D of
symmetric_x :
begin
//factors
d0 := sqr(dstep.y) + sqr(dstep.z) - sqr(dstep.x * conusfact);
d1 := 2 * (step.y * dstep.y + step.z * dstep.z
- sqr(conusfact) * step.x * dstep.x);
d2 := sqr(step.y) + sqr(step.z) - sqr(conusfact * step.x);
end;
symmetric_y :
begin
//factors
d0 := sqr(dstep.x) + sqr(dstep.z) - sqr(dstep.y * conusfact);
d1 := 2 * (step.x * dstep.x + step.z * dstep.z
- sqr(conusfact) * step.y * dstep.y);
d2 := sqr(step.x) + sqr(step.z) - sqr(conusfact * step.y);
end;
symmetric_z :
begin
//factors
d0 := sqr(dstep.x) + sqr(dstep.y) - sqr(dstep.z * conusfact);
d1 := 2 * (step.x * dstep.x + step.y * dstep.y
- sqr(conusfact) * step.z * dstep.z);
d2 := sqr(step.x) + sqr(step.y) - sqr(conusfact * step.z);
end;
end; //end of case FOrientation3D of
 
 
//solving an equation of the second degree
rod := sqr(d1) - 4 * d2 * d0;
 
//d2 is never zero
if rod >= 0
then
begin
//only then is the collision possible
rod2 := sqrt(rod);
t1 := (-d1 - rod2)/2/d2;
t2 := (-d1 + rod2)/2/d2;
 
// if longshot then look into all future
if longshot
then
result := (t1 >= 0) or (t2 >= 0)
else
begin
//collision in between the starting and the ending point if
result := ((t1 >= 0) and (t1 <= 1))
or ((t2 >= 0) and (t2 <= 1));
end;
 
// however the collision also affords that we are within the length of the conus
if result then
begin
case FOrientation3D of
symmetric_x :
begin
xc1 := old_eye.x + t1 * step.x;
xc2 := old_eye.x + t2 * step.x;
 
 
if longshot
then
result :=
(result and (t1 >= 0) and
(xc1 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc1 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) )
or
(result and (t2 >= 0) and
(xc2 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc2 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) )
else
result :=
(result and (t1 >= 0) and (t1 <= 1) and
(xc1 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc1 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) )
or
(result and (t2 >= 0) and (t2 <= 1) and
(xc2 >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc2 <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) );
 
//if collision detected then exit now
if result then exit;
 
end;
symmetric_y :
begin
yc1 := old_eye.y + t1 * step.y;
yc2 := old_eye.y + t2 * step.y;
 
 
if longshot
then
result :=
(result and (t1 >= 0) and
(yc1 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc1 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) )
or
(result and (t2 >= 0) and
(yc2 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc2 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) )
else
result :=
(result and (t1 >= 0) and (t1 <= 1) and
(yc1 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc1 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) )
or
(result and (t2 >= 0) and (t2 <= 1) and
(yc2 >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc2 <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius)) );
 
//if collision detected then exit now
if result then exit;
 
 
end;
symmetric_z :
begin
zc1 := old_eye.z + t1 * step.z;
zc2 := old_eye.z + t2 * step.z;
 
 
if longshot
then
result :=
(result and (t1 >= 0) and
(zc1 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc1 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) )
or
(result and (t2 >= 0) and
(zc2 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc2 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) )
else
result :=
(result and (t1 >= 0) and (t1 <= 1) and
(zc1 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc1 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) )
or
(result and (t2 >= 0) and (t2 <= 1) and
(zc2 >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc2 <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) );
 
//if collision detected then exit now
if result then exit;
end;
 
end; //end of case
end;
 
//exit if a collision occured
if result then exit;
end;
 
 
//the collision may also occur with the end surfaces of the cylinder
case FOrientation3D of
symmetric_x :
begin
if step.x > 1e-6
then
begin
//1st end surface
t1 := (Fcoll_box_min[FseriesNr, coll_Nr].x - old_eye.x)/step.x;
yc1 := old_eye.y + t1 * step.y;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(yc1 - center.y) + sqr(zc1 - center.z) );
 
if FPercentLeftatTop >= 0
then
radius := width3D/2 //the large end of the conus is down
else
radius := -width3D/2 * FPercentLeftatTop;
 
radius := radius + bullet_radius;
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
 
//2nd end surface
t1 := (Fcoll_box_max[FseriesNr, coll_Nr].x - old_eye.x)/step.x;
yc1 := old_eye.y + t1 * step.y;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(yc1 - center.y) + sqr(zc1 - center.z) );
 
if FPercentLeftatTop >= 0
then
radius := width3D/2 * FPercentLeftatTop //the small end of the conus is upwards
else
radius := width3D/2;
 
radius := radius + bullet_radius;
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
end;
end;
symmetric_y :
begin
if step.y > 1e-6
then
begin
//1st end surface
t1 := (Fcoll_box_min[FseriesNr, coll_Nr].y - old_eye.y)/step.y;
xc1 := old_eye.x + t1 * step.x;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(zc1 - center.z) );
 
if FPercentLeftatTop >= 0
then
radius := width3D/2 //the large end of the conus is down
else
radius := -width3D/2 * FPercentLeftatTop;
 
radius := radius + bullet_radius;
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
 
//2nd end surface
t1 := (Fcoll_box_max[FseriesNr, coll_Nr].y - old_eye.y)/step.y;
xc1 := old_eye.x + t1 * step.x;
zc1 := old_eye.z + t1 * step.z;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(zc1 - center.z) );
 
if FPercentLeftatTop >= 0
then
radius := width3D/2 * FPercentLeftatTop //the small end of the conus is upwards
else
radius := width3D/2;
 
radius := radius + bullet_radius;
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
end;
 
end;
symmetric_z :
begin
if step.z > 1e-6
then
begin
//1st end surface
t1 := (Fcoll_box_min[FseriesNr, coll_Nr].z - old_eye.z)/step.z;
xc1 := old_eye.x + t1 * step.x;
yc1 := old_eye.y + t1 * step.y;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(yc1 - center.y) );
 
if FPercentLeftatTop >= 0
then
radius := width3D/2 //the large end of the conus is down
else
radius := width3D/2 * FPercentLeftatTop;
 
radius := radius + bullet_radius;
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
 
//2nd end surface
t1 := (Fcoll_box_max[FseriesNr, coll_Nr].z - old_eye.z)/step.z;
xc1 := old_eye.x + t1 * step.x;
yc1 := old_eye.y + t1 * step.y;
 
distance := sqrt( sqr(xc1 - center.x) + sqr(yc1 - center.y) );
 
if FPercentLeftatTop >= 0
then
radius := -width3D/2 * FPercentLeftatTop //the small end of the conus is upwards
else
radius := width3D/2;
 
radius := radius + bullet_radius;
 
result := (distance < radius) and (t1 >= 0);
if not longshot then result := result and (t1 <= 1);
if result then exit;
end;
 
end;
 
 
end; //end of case
 
 
end; //end of coll_test_conus
 
 
 
 
function TcollisionTester3DX.coll_test_box(coll_nr : byte;
old_attacker_position, attacker_position : TD3DVector;
bullet_radius : TD3DValue; longshot : boolean): boolean;
var
new_eye, old_eye : TD3DVector;
step : TD3DVector;
t1, xc, yc, zc : TD3DValue;
begin
result := false;
 
//Get the coordinates of the old eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(old_eye, old_attacker_position);
 
//Get the coordinates of the eye_position in the actual coll frame
FFrameSeries[FSeriesIndex, FNrinFrameSeries[FSeriesNr, coll_nr]].InverseTransform
(new_eye, attacker_position);
 
//step in eye position
step.x := new_eye.x - old_eye.x;
step.y := new_eye.y - old_eye.y;
step.z := new_eye.z - old_eye.z;
 
//collision is only possible when something moves
if (abs(step.x) < 1e-3) and (abs(step.y) < 1e-3) and (abs(step.z) < 1e-3)
then
begin
result := false;
exit;
end;
 
//check the surfaces which are normal to the x-axis
if abs(step.x) >= 1E-6
then
begin
//test 1st surface
t1 := (Fcoll_box_min[FseriesNr, coll_nr].x - old_eye.x)/step.x;
//collision point
zc := old_eye.z + t1 * step.z;
yc := old_eye.y + t1 * step.y;
 
//collision if the collision point is close enough to the surface
result :=
(zc >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) and
(yc >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius));
 
if longshot
then result := result and (t1 >= 0)
else result := result and (t1 >= 0) and (t1 <= 1);
 
//if collision detected then exit now
if result then exit;
 
//test 2nd surface
t1 := (Fcoll_box_max[FseriesNr, coll_nr].x - old_eye.x)/step.x;
//collision point
zc := old_eye.z + t1 * step.z;
yc := old_eye.y + t1 * step.y;
 
//collision if the collision point is close enough to the surface
result :=
(zc >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius)) and
(yc >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius));
 
if longshot
then result := result and (t1 >= 0)
else result := result and (t1 >= 0) and (t1 <= 1);
 
//if collision detected then exit now
if result then exit;
 
end; //end of step.x <> 0
 
 
//check the surfaces which are normal to the y-axis
if abs(step.y) >= 1E-6
then
begin
//test 1st surface
t1 := (Fcoll_box_min[FseriesNr, coll_nr].y - old_eye.y)/step.y;
//collision point
xc := old_eye.x + t1 * step.x;
zc := old_eye.z + t1 * step.z;
 
//collision if the collision point is close enough to the surface
result :=
(xc >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) and
(zc >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius));
 
if longshot
then result := result and (t1 >= 0)
else result := result and (t1 >= 0) and (t1 <= 1);
 
//if collision detected then exit now
if result then exit;
 
//test 2nd surface
t1 := (Fcoll_box_max[FseriesNr, coll_nr].y - old_eye.y)/step.y;
//collision point
xc := old_eye.x + t1 * step.x;
zc := old_eye.z + t1 * step.z;
 
//collision if the collision point is close enough to the surface
result :=
(xc >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) and
(zc >= (Fcoll_box_min[FseriesNr, coll_nr].z - bullet_radius)) and
(zc <= (Fcoll_box_max[FseriesNr, coll_nr].z + bullet_radius));
 
if longshot
then result := result and (t1 >= 0)
else result := result and (t1 >= 0) and (t1 <= 1);
 
//if collision detected then exit now
if result then exit;
 
end; //end of step.y <> 0
 
 
 
//check the surfaces which are normal to the z-axis
if abs(step.z) >= 1E-6
then
begin
//test 1st surface
t1 := (Fcoll_box_min[FseriesNr, coll_nr].z - old_eye.z)/step.z;
//collision point
xc := old_eye.x + t1 * step.x;
yc := old_eye.y + t1 * step.y;
 
//collision if the collision point is close enough to the surface
result :=
(xc >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) and
(yc >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius));
 
if longshot
then result := result and (t1 >= 0)
else result := result and (t1 >= 0) and (t1 <= 1);
 
//if collision detected then exit now
if result then exit;
 
//test 2nd surface
t1 := (Fcoll_box_max[FseriesNr, coll_nr].z - old_eye.z)/step.z;
//collision point
xc := old_eye.x + t1 * step.x;
yc := old_eye.y + t1 * step.y;
 
//collision if the collision point is close enough to the surface
result :=
(xc >= (Fcoll_box_min[FseriesNr, coll_nr].x - bullet_radius)) and
(xc <= (Fcoll_box_max[FseriesNr, coll_nr].x + bullet_radius)) and
(yc >= (Fcoll_box_min[FseriesNr, coll_nr].y - bullet_radius)) and
(yc <= (Fcoll_box_max[FseriesNr, coll_nr].y + bullet_radius));
 
if longshot
then result := result and (t1 >= 0)
else result := result and (t1 >= 0) and (t1 <= 1);
 
//if collision detected then exit now
if result then exit;
 
end; //end of step.z <> 0
 
 
end; //end of coll_test_box
 
 
 
 
 
 
function TCollisionTester3DX.BulletDead:boolean;
var
camera_position, bullet_position : TD3DVector;
Distance : TD3DValue;
begin
FBulletFrame.GetPosition(FDXDrawUsed.Scene, bullet_position);
FDXDrawUsed.Camera.GetPosition(FDXDrawUsed.Scene, camera_position);
 
Distance := sqr(Bullet_position.x - camera_position.x)
+ sqr(Bullet_position.y - camera_position.y)
+ sqr(Bullet_position.z - camera_position.z);
 
//remove the bullet if it is beyond the bulletrange or if it is a longshot
result := (sqrt(Distance) > FBulletRange) or FLongShots;
 
end; //end of BulletDead
 
 
 
 
//use this function to check whether the camera or an object in a distance of
// -from camera- from the camera collides with any collision object
function TCollisionTester3DX.collision: boolean;
var
i : integer;
camera_position, camera_direction, camera_up : TD3DVECTOR;
eye_position : TD3DVector;
begin
Result := false;
FBullet_HitlinkNr := -1;
 
if CheckForSeriesIndex(FSeriesIndex)
then
begin
//The series exists
if Fcoll_Nr_objects[FSeriesNr] > 0
then
begin
//The series is not empty
 
//Get the position of the camera
FDXDrawUsed.Camera.GetPosition(FDXDrawUsed.Scene, camera_position);
FDXDrawUsed.camera.GetOrientation(FDXDrawUsed.scene, camera_direction, camera_up);
//calculate the eye position
eye_position.x := camera_position.x + FFrontDistance * camera_direction.x;
eye_position.y := camera_position.y + FFrontDistance * camera_direction.y;
eye_position.z := camera_position.z + FFrontDistance * camera_direction.z;
 
//test whether the eye collides with any of the collision objects
i := 0;
while (not result) and (i < Fcoll_nr_objects[FSeriesNr]) do //0..
begin
case Fcoll_shape[FSeriesNr, i] of
box3D : Result := coll_test_box(i, FOldEyePosition,
eye_position, FHeadRadius, false);
sphere3D : Result := coll_test_sphere(i, FOldEyePosition,
eye_position, FHeadRadius, false);
cylinder3D : Result := coll_test_cylinder(i, FOldEyePosition,
eye_position, FHeadRadius, false);
ellipsoid3D: Result := coll_test_ellipsoid(i, FOldEyePosition,
eye_position, FHeadRadius, false);
conus3D : Result := coll_test_conus(i, FOldEyePosition,
eye_position, FHeadRadius, false);
end;
 
if result then Fbullet_hitLinkNr := Fcoll_objectnr[FseriesNr, i];
inc(i);
end;
end;
end; //end of if checkforseriesIndex
 
if result
then
ListDataForCollObject;
 
end; //end of collision
 
 
 
 
 
 
 
//use this function to check whether an object sent from the camera collides
//with any collision object
function TCollisionTester3DX.BulletCollision: boolean;
var
i: integer;
bullet_position : TD3DVector;
begin
Result := false;
FBullet_HitLinkNr := -1;
 
if checkForSeriesIndex(FSeriesIndex)
then
begin
//Series exists
 
//test whether eye collides with any of the collision objects
if Fcoll_Nr_objects[FSeriesNr] > 0
then
begin
//Get position of the bullet
FBulletFrame.GetPosition(FDXDrawUsed.Scene, bullet_position);
i := 0;
 
while (not result) and (i < Fcoll_Nr_objects[FSeriesNr]) do //0..
begin
if FColl_Shootable[FseriesNr, i] or
(FColl_material[FSeriesNr, i] = solid3D)
then
begin
case Fcoll_shape[FSeriesNr, i] of
box3D : result := coll_test_box(i, FOldBulletPosition,
bullet_position,
FBulletRadius, FLongShots);
sphere3D : result := coll_test_sphere(i, FOldBulletPosition,
bullet_position,
FBulletRadius, FLongShots);
cylinder3D : result := coll_test_cylinder(i, FOldBulletPosition,
bullet_position,
FBulletRadius, FLongShots);
ellipsoid3D: result := coll_test_ellipsoid(i, FOldBulletPosition,
bullet_position,
FBulletRadius, FLongShots);
conus3D : result := coll_test_conus(i, FOldBulletPosition,
bullet_position,
FBulletRadius, FLongShots);
end; //end case
end; //end of if..
 
if result
then
FBullet_HitLinkNr := Fcoll_ObjectNr[FSeriesNr, i];
 
inc(i);
end; //end of while
 
if result
then
ListDataForCollObject;
 
end; //end if Fcoll_Nr_ob....
end; //end if checkForSeriesIndex...
 
end; //end of bullet_collision
 
 
 
 
procedure TCollisionTester3DX.GetOldBulletPos;
begin
FbulletFrame.GetPosition(FDXDrawUsed.Scene, FOldBulletPosition);
end; //end of GetOldBulletPos
 
 
procedure TCollisionTester3DX.GetOldEyePos;
var
OldPos, camera_direction, camera_up : TD3DVector;
begin
FDXDrawUsed.Camera.GetPosition(FDXDrawUsed.Scene, OldPos);
FDXDrawUsed.Camera.GetOrientation(FDXDrawUsed.Scene, camera_direction, camera_up);
 
FOldEyePosition.x := OldPos.x + FFrontDistance * camera_direction.x;
FOldEyePosition.y := OldPos.y + FFrontDistance * camera_direction.y;
FOldEyePosition.z := OldPos.z + FFrontDistance * camera_direction.z;
 
end; //end of GetOldEyePos
 
 
 
 
 
 
end.
/VCL_DELPHIX_D6/D3DUtils.pas
0,0 → 1,1317
unit D3DUtils;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Math,
{$IFDEF StandardDX}
{$IFDEF VER14UP} DXTypes, {$ENDIF} Direct3D, DirectDraw;
{$ELSE}
DirectX;
{$ENDIF}
 
const
g_PI = 3.14159265358979323846; // Pi
g_Uhel = g_PI / 180;
g_2_PI = 6.28318530717958623200; // 2 * Pi
g_PI_DIV_2 = 1.57079632679489655800; // Pi / 2
g_PI_DIV_4 = 0.78539816339744827900; // Pi / 4
g_INV_PI = 0.31830988618379069122; // 1 / Pi
g_DEGTORAD = 0.01745329251994329547; // Degrees to Radians
g_RADTODEG = 57.29577951308232286465; // Radians to Degrees
g_HUGE = 1.0E+38; // Huge number for FLOAT
g_EPSILON = 1.0E-5; // Tolerance for FLOATs
 
type
TD2DVector = packed record
X, Y: Single;
end;
TD3DHVector = packed record
X, Y, Z, W: Single;
end;
TQuaternion = packed record
case Integer of
0: (X, Y, Z, W: Single); //like TD3DHVector
1: (
V: TD3DVector;
);
end;
function ProjectionMatrix(near_plane, far_plane, fov_horiz, fov_vert: real): TD3DMatrix; {$IFDEF VER9UP}inline; {$ENDIF}
//--------------------------
// 3D Vector
//--------------------------
function MakeD3DVector(x, y, z: TD3DValue): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD2DVector(x, y: TD3DValue): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD3DVertex(hv, nv: TD3DVector; tu, tv: TD3DValue): TD3DVertex; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD3DVertex(hx, hy, hz, nx, ny, nz, tu, tv: TD3DValue): TD3DVertex; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD3DLVertex(hv: TD3DVector; col, sp: DWORD; tu, tv: TD3DValue): TD3DLVertex; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD3DLVertex(hx, hy, hz: TD3DValue; col, sp: DWORD; tu, tv: TD3DValue): TD3DLVertex; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD3DTLVertex(hx, hy, hz, rhw: TD3DValue; col, sp: DWORD; tu, tv: TD3DValue): TD3DTLVERTEX; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function MakeD3DTLVertex(hv: TD3DVector; rhw: TD3DValue; col, sp: DWORD; tu, tv: TD3DValue): TD3DTLVERTEX; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function Vector2RGBA(const v: TD3DVector; fHeight: Single): DWord; {$IFDEF VER9UP}inline; {$ENDIF}
function VectorToRGB(NormalVector: TD3DVector): DWORD; {$IFDEF VER9UP}inline; {$ENDIF}
//--------------------------
// 3D Vector
//--------------------------
function Quaternion(_w, _x, _y, _z: Single): TQuaternion;
function QuaternionLength(const a: TQuaternion): Single;
function QuaternionNormalize(const a: TQuaternion): TQuaternion;
 
function D3DMath_VecNormalize(const v: TD3DVector): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VecViewScreenize(const v: TD3DHVector): TD3DHVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VecHeterogenize(const hv: TD3DHVector; _div: Boolean{$IFDEF VER4UP} = False{$ENDIF}): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VecHomogenize(const v: TD3DVector): TD3DHVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VecTransform(const a: TD3DHVector; const m: TD3DMATRIX): TD3DHVector; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VecTransform(const a: TD3DVector; const m: TD3DMATRIX): TD3DVector; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Length(const v: TD3DVector): TD3DValue; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3LengthSq(const v: TD3DVector): TD3DValue; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Dot(const v1, v2: TD3DVector): TD3DValue; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Cross(const v1, v2: TD3DVector): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Add(const v1, v2: TD3DVector): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Subtract(const v1, v2: TD3DVector): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Minimize(const v1, v2: TD3DVector): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Maximize(const v1, v2: TD3DVector): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Scale(const v: TD3DVector; const s: TD3DValue): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_Vec3Lerp(out vOut: TD3DVector; const v1, v2: TD3DVector; const s: TD3DValue): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
 
function D3DMath_IsZero(a: Double; fTol: Double { = g_EPSILON}): Boolean; {$IFDEF VER9UP}inline; {$ENDIF}
 
procedure D3DMath_QuaternionFromRotation(var x, y, z, w: Double; const v: TD3DVector; fTheta: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_QuaternionFromRotation(const axis: TD3DVector; const r: Double): TQuaternion; overload; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DMath_RotationFromQuaternion(var v: TD3DVector; var fTheta: Double; x, y, z, w: Double); {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DMath_QuaternionFromAngles(var x, y, z, w: Double; fYaw, fPitch, fRoll: Double); {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DMath_MatrixFromQuaternion(var mat: TD3DMatrix; x, y, z, w: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_MatrixFromQuaternion(q: TQuaternion): TD3DMatrix; overload; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DMath_QuaternionFromMatrix(var x, y, z, w: Double; var mat: TD3DMatrix); {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DMath_QuaternionMultiply(var Qx, Qy, Qz, Qw: Double; Ax, Ay, Az, Aw, Bx, By, Bz, Bw: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_QuaternionMultiply(a, b: TQuaternion): TQuaternion; overload; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DMath_QuaternionSlerp(var Qx, Qy, Qz, Qw: Double; Ax, Ay, Az, Aw, Bx, By, Bz, Bw, fAlpha: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_QuaternionSlerp(A, B: TQuaternion; fAlpha: Double): TQuaternion; overload; {$IFDEF VER9UP}inline; {$ENDIF}
 
procedure D3DUtil_InitSurfaceDesc(var ddsd: TDDSurfaceDesc2; dwFlags, dwCaps: DWORD); {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_InitMaterial(var mtrl: TD3DMaterial7; r, g, b, a: Double); {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_InitLight(var light: TD3DLight7; ltType: TD3DLightType; x, y, z: Double); {$IFDEF VER9UP}inline; {$ENDIF}
 
procedure D3DMath_MatrixMultiply(var q: TD3DMatrix; const a, b: TD3DMatrix); overload;
function D3DMath_MatrixMultiply(const a, b: TD3DMatrix): TD3DMatrix; overload;
function D3DMath_MatrixInvert(var q: TD3DMatrix; const a: TD3DMatrix): HResult; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_MatrixInvert(const a: TD3DMatrix): TD3DMatrix; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VectorMatrixMultiply(var vDest: TD3DVector; const vSrc: TD3DVector; const mat: TD3DMatrix): HResult; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DMath_VertexMatrixMultiply(var vDest: TD3DVertex; const vSrc: TD3DVertex; const mat: TD3DMatrix): HResult; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_SetIdentityMatrix(out m: TD3DMatrix); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetIdentityMatrix: TD3DMatrix; overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetScaleMatrix(const x, y, z: Single): TD3DMatrix; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetViewMatrix(var mat: TD3DMatrix; const vFrom, vAt, vWorldUp: TD3DVector): HResult; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetProjectionMatrix(var mat: TD3DMatrix; fFOV, fAspect, fNearPlane, fFarPlane: Double): HResult; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_SetRotateXMatrix(var mat: TD3DMatrix; fRads: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetRotateXMatrix(fRads: Double): TD3DMatrix; overload; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_SetRotateYMatrix(var mat: TD3DMatrix; fRads: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetRotateYMatrix(fRads: Double): TD3DMatrix; overload; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_SetRotateZMatrix(var mat: TD3DMatrix; fRads: Double); overload; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetRotateZMatrix(fRads: Double): TD3DMatrix; overload; {$IFDEF VER9UP}inline; {$ENDIF}
procedure D3DUtil_SetRotationMatrix(var mat: TD3DMatrix; var vDir: TD3DVector; fRads: Double); {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetRotationMatrixByX(const a: TD3DVector; const r: Double): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetRotationMatrixByY(const a: TD3DVector; const r: Double): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DUtil_SetRotationMatrixByZ(const a: TD3DVector; const r: Double): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
 
function D3DCOLOR_ARGB(a, r, g, b: Cardinal): TD3DColor; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DCOLOR_RGBA(r, g, b, a: Cardinal): TD3DColor; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DCOLOR_XRGB(r, g, b: Cardinal): TD3DColor; {$IFDEF VER9UP}inline; {$ENDIF}
function D3DCOLOR_COLORVALUE(r, g, b, a: Single): TD3DColor; {$IFDEF VER9UP}inline; {$ENDIF}
 
// simple D2D operation
 
function D2DMath_VecAdd(const a: TD2DVector; const b: TD2DVector): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecSub(const a: TD2DVector; const b: TD2DVector): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecDotProduct(const a, b: TD2DVector): Single; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecDistance(const a, b: TD2DVector): Single; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecLength(const a: TD2DVector): Single; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecNormalize(const a: TD2DVector): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecToAngle(const a: TD2DVector): Double; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecRot(const a: TD2DVector; const angle: Double): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecScale(const a: TD2DVector; const scale: Double): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecChangeLength(const a: TD2DVector; const k: Single): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecLookAt(const pos: TD2DVector; const target: TD2DVector; const k: Single): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
function D2DMath_VecRandom2D(const k: Single): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
 
function D2DMath_VecLerp(const a: TD2DVector; const b: TD2DVector; const rate: Single): TD2DVector; {$IFDEF VER9UP}inline; {$ENDIF}
 
implementation
 
//function RSin(val: Integer): Double; {$IFDEF VER9UP}inline; {$ENDIF}
//begin
// Result := Sin(val / 2048.0 * Pi);
//end;
//
//function RCos(val: Integer): Double; {$IFDEF VER9UP}inline; {$ENDIF}
//begin
// Result := Cos(val / 2048.0 * Pi);
//end;
 
function Quaternion(_w, _x, _y, _z: Single): TQuaternion;
begin
Result.W := _w;
Result.X := _x;
Result.Y := _y;
Result.Z := _z;
end;
 
function QuaternionLength(const a: TQuaternion): Single;
begin
Result := Sqrt(a.w * a.w + a.x * a.x + a.y * a.y + a.z * a.z);
end;
 
function QuaternionNormalize(const a: TQuaternion): TQuaternion;
var
len: Single;
begin
len := QuaternionLength(a);
if len = 0.0 then
begin
Result := Quaternion(1, 0, 0, 0);
Exit;
end;
Result.x := a.X / len;
Result.y := a.Y / len;
Result.z := a.Z / len;
Result.w := a.W / len;
end;
 
function GetMatrixFromQuaternion(const a: TQuaternion): TD3DMatrix;
begin
 
end;
 
 
function D3DCOLOR_ARGB(a, r, g, b: Cardinal): TD3DColor;
begin
Result := (a shl 24) or (r shl 16) or (g shl 8) or b;
end;
 
function D3DCOLOR_RGBA(r, g, b, a: Cardinal): TD3DColor;
begin
Result := D3DCOLOR_ARGB(a, r, g, b);
end;
 
function D3DCOLOR_XRGB(r, g, b: Cardinal): TD3DColor;
begin
Result := D3DCOLOR_ARGB($FF, r, g, b);
end;
 
function D3DCOLOR_COLORVALUE(r, g, b, a: Single): TD3DColor;
begin
Result := D3DCOLOR_RGBA(Byte(Round(r * 255)), Byte(Round(g * 255)), Byte(Round(b * 255)), Byte(Round(a * 255)))
end;
 
function MakeD3DVector(x, y, z: TD3DValue): TD3DVector;
begin
Result.x := x;
Result.y := y;
Result.z := z;
end;
 
function MakeD2DVector(x, y: TD3DValue): TD2DVector;
begin
Result.x := x;
Result.y := y;
end;
 
function MakeD3DVertex(hv, nv: TD3DVector; tu, tv: TD3DValue): TD3DVertex;
begin
Result.x := hv.x;
Result.y := hv.y;
Result.z := hv.z;
Result.nx := nv.x;
Result.ny := nv.y;
Result.nz := nv.z;
Result.tu := tu;
Result.tv := tv;
end;
 
function MakeD3DVertex(hx, hy, hz, nx, ny, nz, tu, tv: TD3DValue): TD3DVertex;
begin
Result.x := hx;
Result.y := hy;
Result.z := hz;
Result.nx := nx;
Result.ny := ny;
Result.nz := nz;
Result.tu := tu;
Result.tv := tv;
end;
 
function MakeD3DLVertex(hv: TD3DVector; col, sp: DWORD; tu, tv: TD3DValue): TD3DLVertex;
begin
FillChar(Result, SizeOf(Result), 0);
Result.x := hv.x;
Result.y := hv.y;
Result.z := hv.z;
Result.color := col;
Result.specular := sp;
Result.tu := tu;
Result.tv := tv;
end;
 
function MakeD3DLVertex(hx, hy, hz: TD3DValue; col, sp: DWORD; tu, tv: TD3DValue): TD3DLVertex;
begin
FillChar(Result, SizeOf(Result), 0);
Result.x := hx;
Result.y := hy;
Result.z := hz;
Result.color := col;
Result.specular := sp;
Result.tu := tu;
Result.tv := tv;
end;
 
function MakeD3DTLVertex(hx, hy, hz, rhw: TD3DValue; col, sp: DWORD; tu, tv: TD3DValue): TD3DTLVERTEX;
begin
Result.sx := hx;
Result.sy := hy;
Result.sz := hz;
Result.dvRHW := rhw;
Result.color := col;
Result.specular := sp;
Result.tu := tu;
Result.tv := tv;
end;
 
function MakeD3DTLVertex(hv: TD3DVector; rhw: TD3DValue; col, sp: DWORD; tu, tv: TD3DValue): TD3DTLVERTEX;
begin
Result.sx := hv.x;
Result.sy := hv.y;
Result.sz := hv.z;
Result.dvRHW := rhw;
Result.color := col;
Result.specular := sp;
Result.tu := tu;
Result.tv := tv;
end;
 
function Vector2RGBA(const v: TD3DVector; fHeight: Single): DWord;
var
r, g, b, a: DWord;
begin
r := Round(127.0 * v.x + 128.0);
g := Round(127.0 * v.y + 128.0);
b := Round(127.0 * v.z + 128.0);
a := Round(255.0 * fHeight);
Result := ((a shl 24) + (r shl 16) + (g shl 8) + (b shl 0));
end;
 
function VectorToRGB(NormalVector: TD3DVector): DWORD;
var dwR, dwG, dwB: DWORD;
begin
dwR := Round(127 * NormalVector.x + 128);
dwG := Round(127 * NormalVector.y + 128);
dwB := Round(127 * NormalVector.z + 128);
Result := $FF000000 + dwR shl 16 + dwG shl 8 + dwB;
end;
 
function ProjectionMatrix(near_plane, // distance to near clipping plane
far_plane, // distance to far clipping plane
fov_horiz, // horizontal field of view angle, in radians
fov_vert: real): TD3DMatrix; // vertical field of view angle, in radians
var h, w, Q: real;
begin
Fov_horiz := g_Uhel * Fov_horiz;
Fov_Vert := g_Uhel * Fov_Vert;
 
w := cotan(fov_horiz * 0.5);
h := cotan(fov_vert * 0.5);
Q := far_plane / (far_plane - near_plane);
 
result._11 := w;
result._22 := h;
result._33 := Q;
result._43 := -Q * near_plane;
result._34 := 1;
end;
// end of ProjectionMatrix()
 
//--------------------------
// 3D Vector
//--------------------------
 
function D3DMath_VecNormalize(const v: TD3DVector): TD3DVector;
var
len: Single;
begin
len := D3DMath_Vec3Length(v);
if len = 0 then
FillChar(Result, SizeOf(Result), 0)
else
begin
Result.X := v.X / len;
Result.Y := v.Y / len;
Result.Z := v.Z / len;
end;
end;
 
function D3DMath_VecViewScreenize(const v: TD3DHVector): TD3DHVector;
begin
with Result do
begin
if v.W <> 0.0 then
begin
W := 1.0 / v.W;
X := v.X * W;
Y := v.Y * W;
Z := v.Z * W;
end;
end;
end;
 
function D3DMath_VecHeterogenize(const hv: TD3DHVector; _div: Boolean): TD3DVector;
var
d: Single;
begin
if not _div then
begin
Result.x := hv.X;
Result.y := hv.Y;
Result.z := hv.Z;
end
else
begin
d := 1.0 / hv.w;
Result.x := hv.x * d;
Result.y := hv.y * d;
Result.z := hv.z * d;
end;
end;
 
function D3DMath_VecHomogenize(const v: TD3DVector): TD3DHVector;
begin
Move(v, result, Sizeof(TD3DVector));
result.W := 1.0;
end;
 
function D3DMath_VecTransform(const a: TD3DHVector; const m: TD3DMATRIX): TD3DHVector;
begin
result.X := a.X * m._11 + a.Y * m._21 + a.Z * m._31 + a.W * m._41;
result.Y := a.X * m._12 + a.Y * m._22 + a.Z * m._32 + a.W * m._42;
result.Z := a.X * m._13 + a.Y * m._23 + a.Z * m._33 + a.W * m._43;
result.W := a.X * m._14 + a.Y * m._24 + a.Z * m._34 + a.W * m._44;
end;
 
function D3DMath_VecTransform(const a: TD3DVector; const m: TD3DMATRIX): TD3DVector;
begin
result.X := a.X * m._11 + a.Y * m._21 + a.Z * m._31 + m._41;
result.Y := a.X * m._12 + a.Y * m._22 + a.Z * m._32 + m._42;
result.Z := a.X * m._13 + a.Y * m._23 + a.Z * m._33 + m._43;
end;
 
function D3DMath_Vec3Length(const v: TD3DVector): TD3DValue;
begin
with v do Result := Sqrt(Sqr(x) + Sqr(y) + Sqr(z));
end;
 
function D3DMath_Vec3LengthSq(const v: TD3DVector): TD3DValue;
begin
with v do Result := Sqr(x) + Sqr(y) + Sqr(z);
end;
 
function D3DMath_Vec3Dot(const v1, v2: TD3DVector): TD3DValue;
begin
Result := v1.x * v2.x + v1.y * v2.y + v1.z * v2.z;
end;
 
function D3DMath_Vec3Cross(const v1, v2: TD3DVector): TD3DVector;
begin
Result.x := v1.y * v2.z - v1.z * v2.y;
Result.y := v1.z * v2.x - v1.x * v2.z;
Result.z := v1.x * v2.y - v1.y * v2.x;
end;
 
function D3DMath_Vec3Add(const v1, v2: TD3DVector): TD3DVector;
begin
Result.x := v1.x + v2.x;
Result.y := v1.y + v2.y;
Result.z := v1.z + v2.z;
end;
 
function D3DMath_Vec3Subtract(const v1, v2: TD3DVector): TD3DVector;
begin
Result.x := v1.x - v2.x;
Result.y := v1.y - v2.y;
Result.z := v1.z - v2.z;
end;
 
// Minimize each component. x = min(x1, x2), y = min(y1, y2)
 
function D3DMath_Vec3Minimize(const v1, v2: TD3DVector): TD3DVector;
begin
if v1.x < v2.x then Result.x := v1.x else Result.x := v2.x;
if v1.y < v2.y then Result.y := v1.y else Result.y := v2.y;
if v1.z < v2.z then Result.z := v1.z else Result.z := v2.z;
end;
 
// Maximize each component. x = max(x1, x2), y = max(y1, y2)
 
function D3DMath_Vec3Maximize(const v1, v2: TD3DVector): TD3DVector;
begin
if v1.x > v2.x then Result.x := v1.x else Result.x := v2.x;
if v1.y > v2.y then Result.y := v1.y else Result.y := v2.y;
if v1.z > v2.z then Result.z := v1.z else Result.z := v2.z;
end;
 
function D3DMath_Vec3Scale(const v: TD3DVector; const s: TD3DValue): TD3DVector;
begin
Result.x := v.x * s;
Result.y := v.y * s;
Result.z := v.z * s;
end;
 
// Linear interpolation. V1 + s(V2-V1)
 
function D3DMath_Vec3Lerp(out vOut: TD3DVector; const v1, v2: TD3DVector; const s: TD3DValue): TD3DVector;
begin
Result.x := v1.x + s * (v2.x - v1.x);
Result.y := v1.y + s * (v2.y - v1.y);
Result.z := v1.z + s * (v2.z - v1.z);
end;
 
//-----------------------------------------------------------------------------
// File: D3DMath.cpp
//
// Desc: Shortcut macros and functions for using DX objects
//
// Copyright (c) 1997-1999 Microsoft Corporation. All rights reserved
//-----------------------------------------------------------------------------
 
function D3DMath_IsZero(a: Double; fTol: Double { = g_EPSILON}): Boolean;
begin
if a < 0 then
Result := a >= -fTol
else
Result := a <= fTol;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_MatrixMultiply()
// Desc: Does the matrix operation: [Q] = [A] * [B]. Note that the order of
// this operation was changed from the previous version of the DXSDK.
//-----------------------------------------------------------------------------
 
procedure D3DMath_MatrixMultiply(var q: TD3DMatrix; const a, b: TD3DMatrix);
type
PArrayD3DValue = ^TArrayD3DValue;
TArrayD3DValue = array[0..15] of TD3DValue;
var
pA, pB, pQ: PArrayD3DValue;
i, j, k: Integer;
qq: TD3DMatrix;
begin
FillChar(qq, SizeOf(qq), 0);
 
pA := @a;
pB := @b;
pQ := @qq;
for i := 0 to 3 do
for j := 0 to 3 do
for k := 0 to 3 do
pQ[4 * i + j] := pQ[4 * i + j] + pA[4 * i + k] * pB[4 * k + j];
q := qq; {== protect of recurrence}
end;
 
function D3DMath_MatrixMultiply(const a, b: TD3DMatrix): TD3DMatrix;
begin
D3DMath_MatrixMultiply(Result, a, b);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_MatrixInvert()
// Desc: Does the matrix operation: [Q] = inv[A]. Note: this function only
// works for matrices with [0 0 0 1] for the 4th column.
//-----------------------------------------------------------------------------
 
function D3DMath_MatrixInvert(var q: TD3DMatrix; const a: TD3DMatrix): HResult;
var
fDetInv: Double;
begin
if (abs(a._44 - 1.0) > 0.001) or (abs(a._14) > 0.001) or (abs(a._24) > 0.001) or (abs(a._34) > 0.001) then
begin
Result := E_INVALIDARG;
Exit;
end;
 
fDetInv := 1.0 / (a._11 * (a._22 * a._33 - a._23 * a._32) -
a._12 * (a._21 * a._33 - a._23 * a._31) +
a._13 * (a._21 * a._32 - a._22 * a._31));
 
q._11 := fDetInv * (a._22 * a._33 - a._23 * a._32);
q._12 := -fDetInv * (a._12 * a._33 - a._13 * a._32);
q._13 := fDetInv * (a._12 * a._23 - a._13 * a._22);
q._14 := 0.0;
 
q._21 := -fDetInv * (a._21 * a._33 - a._23 * a._31);
q._22 := fDetInv * (a._11 * a._33 - a._13 * a._31);
q._23 := -fDetInv * (a._11 * a._23 - a._13 * a._21);
q._24 := 0.0;
 
q._31 := fDetInv * (a._21 * a._32 - a._22 * a._31);
q._32 := -fDetInv * (a._11 * a._32 - a._12 * a._31);
q._33 := fDetInv * (a._11 * a._22 - a._12 * a._21);
q._34 := 0.0;
 
q._41 := -(a._41 * q._11 + a._42 * q._21 + a._43 * q._31);
q._42 := -(a._41 * q._12 + a._42 * q._22 + a._43 * q._32);
q._43 := -(a._41 * q._13 + a._42 * q._23 + a._43 * q._33);
q._44 := 1.0;
 
Result := S_OK;
end;
 
function D3DMath_MatrixInvert(const a: TD3DMatrix): TD3DMatrix;
begin
if D3DMath_MatrixInvert(Result, a) <> S_OK then
FillChar(Result, SizeOf(Result), 0);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_VectorMatrixMultiply()
// Desc: Multiplies a vector by a matrix
//-----------------------------------------------------------------------------
 
function D3DMath_VectorMatrixMultiply(var vDest: TD3DVector; const vSrc: TD3DVector;
const mat: TD3DMatrix): HResult;
var
x, y, z, w: Double;
begin
x := vSrc.x * mat._11 + vSrc.y * mat._21 + vSrc.z * mat._31 + mat._41;
y := vSrc.x * mat._12 + vSrc.y * mat._22 + vSrc.z * mat._32 + mat._42;
z := vSrc.x * mat._13 + vSrc.y * mat._23 + vSrc.z * mat._33 + mat._43;
w := vSrc.x * mat._14 + vSrc.y * mat._24 + vSrc.z * mat._34 + mat._44;
 
if abs(w) < g_EPSILON then
begin
Result := E_INVALIDARG;
Exit;
end;
 
vDest.x := x / w;
vDest.y := y / w;
vDest.z := z / w;
 
Result := S_OK;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_VertexMatrixMultiply()
// Desc: Multiplies a vertex by a matrix
//-----------------------------------------------------------------------------
 
function D3DMath_VertexMatrixMultiply(var vDest: TD3DVertex; const vSrc: TD3DVertex;
const mat: TD3DMatrix): HResult;
var
pSrcVec, pDestVec: PD3DVector;
begin
pSrcVec := @vSrc.x;
pDestVec := @vDest.x;
 
Result := D3DMath_VectorMatrixMultiply(pDestVec^, pSrcVec^, mat);
if SUCCEEDED(Result) then
begin
pSrcVec := @vSrc.nx;
pDestVec := @vDest.nx;
Result := D3DMath_VectorMatrixMultiply(pDestVec^, pSrcVec^, mat);
end;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_QuaternionFromRotation()
// Desc: Converts a normalized axis and angle to a unit quaternion.
//-----------------------------------------------------------------------------
 
procedure D3DMath_QuaternionFromRotation(var x, y, z, w: Double;
const v: TD3DVector; fTheta: Double);
begin
x := sin(fTheta / 2.0) * v.x;
y := sin(fTheta / 2.0) * v.y;
z := sin(fTheta / 2.0) * v.z;
w := cos(fTheta / 2.0);
end;
 
function D3DMath_QuaternionFromRotation(const axis: TD3DVector; const r: Double): TQuaternion;
var
// r: Integer;
a: TD3DVector;
begin
// r := (t div 2) and $FFF;
a := VectorNormalize(axis);
Result.X := a.X * Sin(R);
Result.Y := a.Y * Sin(R);
Result.Z := a.Z * Sin(R);
Result.W := Cos(R);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_RotationFromQuaternion()
// Desc: Converts a normalized axis and angle to a unit quaternion.
//-----------------------------------------------------------------------------
 
procedure D3DMath_RotationFromQuaternion(var v: TD3DVector; var fTheta: Double;
x, y, z, w: Double);
begin
fTheta := ArcCos(w) * 2.0;
v.x := x / sin(fTheta / 2.0);
v.y := y / sin(fTheta / 2.0);
v.z := z / sin(fTheta / 2.0);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_QuaternionFromAngles()
// Desc: Converts euler angles to a unit quaternion.
//-----------------------------------------------------------------------------
 
procedure D3DMath_QuaternionFromAngles(var x, y, z, w: Double; fYaw, fPitch, fRoll: Double);
var
fSinYaw, fSinPitch, fSinRoll, fCosYaw, fCosPitch, fCosRoll: Double;
begin
fSinYaw := sin(fYaw / 2.0);
fSinPitch := sin(fPitch / 2.0);
fSinRoll := sin(fRoll / 2.0);
fCosYaw := cos(fYaw / 2.0);
fCosPitch := cos(fPitch / 2.0);
fCosRoll := cos(fRoll / 2.0);
 
x := fSinRoll * fCosPitch * fCosYaw - fCosRoll * fSinPitch * fSinYaw;
y := fCosRoll * fSinPitch * fCosYaw + fSinRoll * fCosPitch * fSinYaw;
z := fCosRoll * fCosPitch * fSinYaw - fSinRoll * fSinPitch * fCosYaw;
w := fCosRoll * fCosPitch * fCosYaw + fSinRoll * fSinPitch * fSinYaw;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_MatrixFromQuaternion()
// Desc: Converts a unit quaternion into a rotation matrix.
//-----------------------------------------------------------------------------
 
procedure D3DMath_MatrixFromQuaternion(var mat: TD3DMatrix; x, y, z, w: Double);
var
xx, yy, zz, xy, xz, yz, wx, wy, wz: Double;
begin
xx := x * x; yy := y * y; zz := z * z;
xy := x * y; xz := x * z; yz := y * z;
wx := w * x; wy := w * y; wz := w * z;
 
mat._11 := 1 - 2 * (yy + zz);
mat._12 := 2 * (xy - wz);
mat._13 := 2 * (xz + wy);
 
mat._21 := 2 * (xy + wz);
mat._22 := 1 - 2 * (xx + zz);
mat._23 := 2 * (yz - wx);
 
mat._31 := 2 * (xz - wy);
mat._32 := 2 * (yz + wx);
mat._33 := 1 - 2 * (xx + yy);
 
mat._14 := 0.0; mat._24 := 0.0; mat._34 := 0.0;
mat._41 := 0.0; mat._42 := 0.0; mat._43 := 0.0;
mat._44 := 1.0;
end;
 
function D3DMath_MatrixFromQuaternion(q: TQuaternion): TD3DMatrix;
begin
D3DMath_MatrixFromQuaternion(Result, q.X, q.Y, q.Z, q.W)
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_QuaternionFromMatrix()
// Desc: Converts a rotation matrix into a unit quaternion.
//-----------------------------------------------------------------------------
 
procedure D3DMath_QuaternionFromMatrix(var x, y, z, w: Double; var mat: TD3DMatrix);
var
s: Double;
xx, yy, zz, xy, xz, yz, wx, wy, wz: Double;
begin
if (mat._11 + mat._22 + mat._33 > 0.0) then
begin
s := sqrt(mat._11 + mat._22 + mat._33 + mat._44);
 
x := (mat._23 - mat._32) / (2 * s);
y := (mat._31 - mat._13) / (2 * s);
z := (mat._12 - mat._21) / (2 * s);
w := 0.5 * s;
end;
 
xx := x * x; yy := y * y; zz := z * z;
xy := x * y; xz := x * z; yz := y * z;
wx := w * x; wy := w * y; wz := w * z;
 
mat._11 := 1 - 2 * (yy + zz);
mat._12 := 2 * (xy - wz);
mat._13 := 2 * (xz + wy);
 
mat._21 := 2 * (xy + wz);
mat._22 := 1 - 2 * (xx + zz);
mat._23 := 2 * (yz - wx);
 
mat._31 := 2 * (xz - wy);
mat._32 := 2 * (yz + wx);
mat._33 := 1 - 2 * (xx + yy);
 
mat._14 := 0.0; mat._24 := 0.0; mat._34 := 0.0;
mat._41 := 0.0; mat._42 := 0.0; mat._43 := 0.0;
mat._44 := 1.0;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_QuaternionMultiply()
// Desc: Mulitples two quaternions together as in {Q} = {A} * {B}.
//-----------------------------------------------------------------------------
 
procedure D3DMath_QuaternionMultiply(var Qx, Qy, Qz, Qw: Double;
Ax, Ay, Az, Aw, Bx, By, Bz, Bw: Double);
var
Dx, Dy, Dz, Dw: Double;
begin
Dx := Ax * Bw + Ay * Bz - Az * By + Aw * Bx;
Dy := -Ax * Bz + Ay * Bw + Az * Bx + Aw * By;
Dz := Ax * By - Ay * Bx + Az * Bw + Aw * Bz;
Dw := -Ax * Bx - Ay * By - Az * Bz + Aw * Bw;
 
Qx := Dx; Qy := Dy; Qz := Dz; Qw := Dw;
end;
 
function D3DMath_QuaternionMultiply(a, b: TQuaternion): TQuaternion;
var
Qx, Qy, Qz, Qw: Double;
begin
D3DMath_QuaternionMultiply(Qx, Qy, Qz, Qw, A.x, A.y, A.z, A.w, B.x, B.y, B.z, B.w);
Result.X := Qx;
Result.Y := Qy;
Result.Z := Qz;
Result.W := Qw;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DMath_SlerpQuaternions()
// Desc: Compute a quaternion which is the spherical linear interpolation
// between two other quaternions by dvFraction.
//-----------------------------------------------------------------------------
 
procedure D3DMath_QuaternionSlerp(var Qx, Qy, Qz, Qw: Double;
Ax, Ay, Az, Aw, Bx, By, Bz, Bw, fAlpha: Double);
var
fCosTheta: Double;
fBeta: Double;
fTheta: Double;
begin
// Compute dot product (equal to cosine of the angle between quaternions)
fCosTheta := Ax * Bx + Ay * By + Az * Bz + Aw * Bw;
 
// Check angle to see if quaternions are in opposite hemispheres
if fCosTheta < 0.0 then
begin
// If so, flip one of the quaterions
fCosTheta := -fCosTheta;
Bx := -Bx; By := -By; Bz := -Bz; Bw := -Bw;
end;
 
// Set factors to do linear interpolation, as a special case where the
// quaternions are close together.
fBeta := 1.0 - fAlpha;
 
// If the quaternions aren't close, proceed with spherical interpolation
if 1.0 - fCosTheta > 0.001 then
begin
fTheta := arccos(fCosTheta);
 
fBeta := sin(fTheta * fBeta) / sin(fTheta);
fAlpha := sin(fTheta * fAlpha) / sin(fTheta);
end;
 
// Do the interpolation
Qx := fBeta * Ax + fAlpha * Bx;
Qy := fBeta * Ay + fAlpha * By;
Qz := fBeta * Az + fAlpha * Bz;
Qw := fBeta * Aw + fAlpha * Bw;
end;
 
function D3DMath_QuaternionSlerp(A, B: TQuaternion; fAlpha: Double): TQuaternion;
var
Qx, Qy, Qz, Qw: Double;
begin
D3DMath_QuaternionSlerp(Qx, Qy, Qz, Qw, A.x, A.y, A.z, A.w, B.x, B.y, B.z, B.w, fAlpha);
Result.X := Qx;
Result.Y := Qy;
Result.Z := Qz;
Result.W := Qw;
end;
 
//-----------------------------------------------------------------------------
// File: D3DUtil.cpp
//
// Desc: Shortcut macros and functions for using DX objects
//
//
// Copyright (c) 1997-1999 Microsoft Corporation. All rights reserved
//-----------------------------------------------------------------------------
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_InitSurfaceDesc()
// Desc: Helper function called to build a DDSURFACEDESC2 structure,
// typically before calling CreateSurface() or GetSurfaceDesc()
//-----------------------------------------------------------------------------
 
procedure D3DUtil_InitSurfaceDesc(var ddsd: TDDSurfaceDesc2; dwFlags, dwCaps: DWORD);
begin
FillChar(ddsd, SizeOf(ddsd), 0);
ddsd.dwSize := SizeOf(ddsd);
ddsd.dwFlags := dwFlags;
ddsd.ddsCaps.dwCaps := dwCaps;
ddsd.ddpfPixelFormat.dwSize := SizeOf(ddsd.ddpfPixelFormat);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_InitMaterial()
// Desc: Helper function called to build a D3DMATERIAL7 structure
//-----------------------------------------------------------------------------
 
procedure D3DUtil_InitMaterial(var mtrl: TD3DMaterial7; r, g, b, a: Double);
begin
FillChar(mtrl, SizeOf(mtrl), 0);
mtrl.dcvDiffuse.r := r; mtrl.dcvAmbient.r := r;
mtrl.dcvDiffuse.g := g; mtrl.dcvAmbient.g := g;
mtrl.dcvDiffuse.b := b; mtrl.dcvAmbient.b := b;
mtrl.dcvDiffuse.a := a; mtrl.dcvAmbient.a := a;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_InitLight()
// Desc: Initializes a D3DLIGHT7 structure
//-----------------------------------------------------------------------------
 
procedure D3DUtil_InitLight(var light: TD3DLight7; ltType: TD3DLightType; x, y, z: Double);
begin
FillChar(light, SizeOf(light), 0);
light.dltType := ltType;
light.dcvDiffuse.r := 1.0;
light.dcvDiffuse.g := 1.0;
light.dcvDiffuse.b := 1.0;
light.dcvSpecular := light.dcvDiffuse;
light.dvPosition.x := x; light.dvDirection.x := x;
light.dvPosition.y := y; light.dvDirection.y := y;
light.dvPosition.z := z; light.dvDirection.z := z;
light.dvAttenuation0 := 1.0;
light.dvRange := D3DLIGHT_RANGE_MAX;
end;
 
procedure D3DUtil_SetIdentityMatrix(out m: TD3DMatrix);
begin
m._12 := 0; m._13 := 0; m._14 := 0; m._21 := 0; m._23 := 0; m._24 := 0;
m._31 := 0; m._32 := 0; m._34 := 0; m._41 := 0; m._42 := 0; m._43 := 0;
m._11 := 1; m._22 := 1; m._33 := 1; m._44 := 1;
end;
 
function D3DUtil_SetIdentityMatrix: TD3DMatrix;
begin
D3DUtil_SetIdentityMatrix(Result);
end;
 
function D3DUtil_SetScaleMatrix(const x, y, z: Single): TD3DMatrix;
begin
with Result do
begin
_11 := x; _12 := 0; _13 := 0; _14 := 0;
_21 := 0; _22 := y; _23 := 0; _24 := 0;
_31 := 0; _32 := 0; _33 := z; _34 := 0;
_41 := 0; _42 := 0; _43 := 0; _44 := 1;
end;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_SetViewMatrix()
// Desc: Given an eye point, a lookat point, and an up vector, this
// function builds a 4x4 view matrix.
//-----------------------------------------------------------------------------
 
function D3DUtil_SetViewMatrix(var mat: TD3DMatrix; const vFrom, vAt, vWorldUp: TD3DVector): HResult;
var
vView: TD3DVector;
fLength: Double;
fDotProduct: Double;
vUp: TD3DVector;
vRight: TD3DVector;
begin
// Get the z basis vector, which points straight ahead. This is the
// difference from the eyepoint to the lookat point.
vView := VectorSub(vAt, vFrom);
 
fLength := VectorMagnitude(vView);
if fLength < 0.1E-6 then
begin
Result := E_INVALIDARG;
Exit;
end;
 
// Normalize the z basis vector
vView := VectorDivS(vView, fLength);
 
// Get the dot product, and calculate the projection of the z basis
// vector onto the up vector. The projection is the y basis vector.
fDotProduct := VectorDotProduct(vWorldUp, vView);
 
vUp := VectorSub(vWorldUp, VectorMulS(vView, fDotProduct));
 
// If this vector has near-zero length because the input specified a
// bogus up vector, let's try a default up vector
fLength := VectorMagnitude(vUp);
if 1E-6 > fLength then
begin
vUp := VectorSub(MakeD3DVector(0, 1, 0), VectorMulS(vView, vView.y));
 
// If we still have near-zero length, resort to a different axis.
fLength := VectorMagnitude(vUp);
if 1E-6 > fLength then
begin
vUp := VectorSub(MakeD3DVector(0, 0, 1), VectorMulS(vView, vView.z));
 
fLength := VectorMagnitude(vUp);
if 1E-6 > fLength then
begin
Result := E_INVALIDARG;
Exit;
end;
end;
end;
 
// Normalize the y basis vector
vUp := VectorDivS(vUp, fLength);
 
// The x basis vector is found simply with the cross product of the y
// and z basis vectors
vRight := VectorCrossProduct(vUp, vView);
 
// Start building the matrix. The first three rows contains the basis
// vectors used to rotate the view to point at the lookat point
D3DUtil_SetIdentityMatrix(mat);
mat._11 := vRight.x; mat._12 := vUp.x; mat._13 := vView.x;
mat._21 := vRight.y; mat._22 := vUp.y; mat._23 := vView.y;
mat._31 := vRight.z; mat._32 := vUp.z; mat._33 := vView.z;
 
// Do the translation values (rotations are still about the eyepoint)
mat._41 := -VectorDotProduct(vFrom, vRight);
mat._42 := -VectorDotProduct(vFrom, vUp);
mat._43 := -VectorDotProduct(vFrom, vView);
 
Result := S_OK;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_SetProjectionMatrix()
// Desc: Sets the passed in 4x4 matrix to a perpsective projection matrix built
// from the field-of-view (fov, in y), aspect ratio, near plane (D),
// and far plane (F). Note that the projection matrix is normalized for
// element [3][4] to be 1.0. This is performed so that W-based range fog
// will work correctly.
//-----------------------------------------------------------------------------
 
function D3DUtil_SetProjectionMatrix(var mat: TD3DMatrix; fFOV, fAspect, fNearPlane, fFarPlane: Double): HResult;
var
w, h, Q: Double;
begin
if (abs(fFarPlane - fNearPlane) < 0.01) or (abs(sin(fFOV / 2)) < 0.01) then
begin
Result := E_INVALIDARG;
Exit;
end;
 
w := fAspect * (cos(fFOV / 2) / sin(fFOV / 2));
h := 1.0 * (cos(fFOV / 2) / sin(fFOV / 2));
Q := fFarPlane / (fFarPlane - fNearPlane);
 
FillChar(mat, SizeOf(mat), 0);
mat._11 := w;
mat._22 := h;
mat._33 := Q;
mat._34 := 1.0;
mat._43 := -Q * fNearPlane;
 
Result := S_OK;
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_SetRotateXMatrix()
// Desc: Create Rotation matrix about X axis
//-----------------------------------------------------------------------------
 
procedure D3DUtil_SetRotateXMatrix(var mat: TD3DMatrix; fRads: Double);
begin
D3DUtil_SetIdentityMatrix(mat);
mat._22 := cos(fRads);
mat._23 := sin(fRads);
mat._32 := -sin(fRads);
mat._33 := cos(fRads);
end;
 
function D3DUtil_SetRotateXMatrix(fRads: Double): TD3DMatrix;
begin
D3DUtil_SetRotateXMatrix(Result, fRads);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_SetRotateYMatrix()
// Desc: Create Rotation matrix about Y axis
//-----------------------------------------------------------------------------
 
procedure D3DUtil_SetRotateYMatrix(var mat: TD3DMatrix; fRads: Double);
begin
D3DUtil_SetIdentityMatrix(mat);
mat._11 := cos(fRads);
mat._13 := -sin(fRads);
mat._31 := sin(fRads);
mat._33 := cos(fRads);
end;
 
function D3DUtil_SetRotateYMatrix(fRads: Double): TD3DMatrix;
begin
D3DUtil_SetRotateYMatrix(Result, fRads);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_SetRotateZMatrix()
// Desc: Create Rotation matrix about Z axis
//-----------------------------------------------------------------------------
 
procedure D3DUtil_SetRotateZMatrix(var mat: TD3DMatrix; fRads: Double);
begin
D3DUtil_SetIdentityMatrix(mat);
mat._11 := cos(fRads);
mat._12 := sin(fRads);
mat._21 := -sin(fRads);
mat._22 := cos(fRads);
end;
 
function D3DUtil_SetRotateZMatrix(fRads: Double): TD3DMatrix;
begin
D3DUtil_SetRotateZMatrix(Result, fRads);
end;
 
//-----------------------------------------------------------------------------
// Name: D3DUtil_SetRotationMatrix
// Desc: Create a Rotation matrix about vector direction
//-----------------------------------------------------------------------------
 
procedure D3DUtil_SetRotationMatrix(var mat: TD3DMatrix; var vDir: TD3DVector; fRads: Double);
var
fCos, fSin: Double;
v: TD3DVector;
begin
fCos := cos(fRads);
fSin := sin(fRads);
v := VectorNormalize(vDir);
 
mat._11 := (v.x * v.x) * (1.0 - fCos) + fCos;
mat._12 := (v.x * v.y) * (1.0 - fCos) - (v.z * fSin);
mat._13 := (v.x * v.z) * (1.0 - fCos) + (v.y * fSin);
 
mat._21 := (v.y * v.x) * (1.0 - fCos) + (v.z * fSin);
mat._22 := (v.y * v.y) * (1.0 - fCos) + fCos;
mat._23 := (v.y * v.z) * (1.0 - fCos) - (v.x * fSin);
 
mat._31 := (v.z * v.x) * (1.0 - fCos) - (v.y * fSin);
mat._32 := (v.z * v.y) * (1.0 - fCos) + (v.x * fSin);
mat._33 := (v.z * v.z) * (1.0 - fCos) + fCos;
 
mat._14 := 0; mat._24 := 0; mat._34 := 0;
mat._41 := 0; mat._42 := 0; mat._43 := 0;
mat._44 := 1.0;
end;
 
function D3DUtil_SetRotationMatrixByX(const a: TD3DVector; const r: Double): TD3DVector;
begin
Result.X := a.X;
Result.Y := a.Y * Cos(r) + a.Z * Sin(r);
Result.Z := -a.Y * Sin(r) + a.Z * Cos(r);
end;
 
function D3DUtil_SetRotationMatrixByY(const a: TD3DVector; const r: Double): TD3DVector;
begin
Result.X := a.X * Cos(r) - a.Z * Sin(r);
Result.Y := a.Y;
Result.Z := a.X * Sin(r) + a.Z * Cos(r);
end;
 
function D3DUtil_SetRotationMatrixByZ(const a: TD3DVector; const r: Double): TD3DVector;
begin
Result.X := a.X * Cos(r) + a.Y * Sin(r);
Result.Y := -a.X * Sin(r) + a.Y * Cos(r);
Result.Z := a.Z;
end;
 
// simple D2D operation
 
function D2DMath_VecAdd(const a: TD2DVector; const b: TD2DVector): TD2DVector;
begin
Result.X := a.X + b.X;
Result.Y := a.Y + b.Y;
end;
 
function D2DMath_VecSub(const a: TD2DVector; const b: TD2DVector): TD2DVector;
begin
Result.X := a.X - b.X;
Result.Y := a.Y - b.Y;
end;
 
function D2DMath_VecDotProduct(const a, b: TD2DVector): Single;
begin
Result := a.X * b.X + a.Y * b.Y;
end;
 
function D2DMath_VecDistance(const a, b: TD2DVector): Single;
begin
Result := sqrt(SQR(a.X - b.X) + SQR(a.Y - b.Y));
end;
 
function D2DMath_VecLength(const a: TD2DVector): Single;
begin
Result := sqrt(SQR(a.X) + SQR(a.Y));
end;
 
function D2DMath_VecNormalize(const a: TD2DVector): TD2DVector;
var
len: Single;
begin
len := D2DMath_VecLength(a);
if len = 0 then
begin
result := MakeD2DVector(0, 0);
Exit;
end;
 
result.X := a.X / len;
result.Y := a.Y / len;
end;
 
function D2DMath_VecToAngle(const a: TD2DVector): Double;
var
v: TD2DVector;
sg: Integer;
hi, lo, mid: Integer;
begin
Result := 0.0;
 
v := D2DMath_VecNormalize(a);
 
if (v.y > 0) then
begin
if v.x > 0 then
sg := 1
else
begin
sg := 2;
v.x := -v.x;
end;
end
else
if (v.y < 0) then
begin
if v.x >= 0 then
sg := 4
else
begin
sg := 3;
v.x := -v.x;
end;
end
else
begin
if v.x >= 0 then
sg := 1
else
begin
sg := 3;
v.x := -v.x;
end;
end;
 
 
hi := 1023;
lo := 0;
mid := 511;
 
while hi > lo do
begin
if Cos(mid / 2048.0 * Pi) > v.x then
lo := mid + 1
else
hi := mid;
mid := (hi + lo) shr 1;
end;
 
case sg of
1: result := mid;
2: result := 2047 - mid;
3: result := 2048 + mid;
4: result := 4095 - mid;
end;
 
// to radians
Result := Result * Pi / 2048.0;
end;
 
function D2DMath_VecRot(const a: TD2DVector; const angle: Double): TD2DVector;
begin
Result.X := a.X * Cos(angle) - a.Y * Sin(angle);
Result.Y := a.X * Sin(angle) + a.Y * Cos(angle);
end;
 
 
function D2DMath_VecScale(const a: TD2DVector; const scale: Double): TD2DVector;
begin
Result.X := a.X * scale;
Result.Y := a.Y * scale;
end;
 
function D2DMath_VecChangeLength(const a: TD2DVector; const k: Single): TD2DVector;
var
len: Single;
begin
len := D2DMath_VecLength(a);
if len = 0 then
begin
Result := MakeD2DVector(0, 0);
Exit;
end;
 
Result.X := a.X * k / len;
Result.Y := a.Y * k / len;
end;
 
function D2DMath_VecLookAt(const pos: TD2DVector; const target: TD2DVector; const k: Single): TD2DVector;
var
sub: TD2DVector;
len: Single;
begin
sub := D2DMath_VecSub(target, pos);
len := D2DMath_VecLength(sub);
if len = 0 then
begin
Result := MakeD2DVector(0, 0);
Exit;
end;
 
Result.X := sub.X * k / len;
Result.Y := sub.Y * k / len;
end;
 
function D2DMath_VecRandom2D(const k: Single): TD2DVector;
begin
Result := D2DMath_VecChangeLength(MakeD2DVector(Random - 0.5, Random - 0.5), k);
end;
 
function D2DMath_VecLerp(const a: TD2DVector; const b: TD2DVector; const rate: Single): TD2DVector;
begin
Result.x := rate * b.x + (1.0 - rate) * a.x;
Result.y := rate * b.y + (1.0 - rate) * a.y;
end;
 
 
end.
 
/VCL_DELPHIX_D6/DAnim.pas
22,7 → 22,9
 
{$Z4}
{$A+}
{$IfNDef D7UP}
{$WEAKPACKAGEUNIT}
{$EndIf}
 
uses Windows, ActiveX, DirectX, DShow;
 
1109,18 → 1111,18
out lplpDDClipper: IDirectDrawClipper; pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette(dwFlags: DWORD; lpColorTable: PPaletteEntry;
out lplpDDPalette: IDirectDrawPalette; pUnkOuter: IUnknown): HResult;stdcall;
function CreateSurface(const lpDDSurfaceDesc: DDSURFACEDESC;
function CreateSurface(const lpDDSurfaceDesc: TDDSURFACEDESC;
out lplpDDSurface: IDirectDrawSurface; pUnkOuter: IUnknown): HResult; stdcall;
function DuplicateSurface(lpDDSurface: IDirectDrawSurface;
out lplpDupDDSurface: IDirectDrawSurface): HResult; stdcall;
function EnumDisplayModes(dwFlags: DWORD;
const lpDDSurfaceDesc: DDSURFACEDESC; lpContext: Pointer;
lpEnumModesCallback: LPDDENUMMODESCALLBACK): HResult; stdcall;
function EnumSurfaces(dwFlags: DWORD; const lpDDSD: DDSURFACEDESC;
lpContext: Pointer; lpEnumCallback: LPDDENUMSURFACESCALLBACK): HResult; stdcall;
const lpDDSurfaceDesc: TDDSURFACEDESC; lpContext: Pointer;
lpEnumModesCallback: {LPDDENUMMODESCALLBACK}TDDEnumModesCallback): HResult; stdcall;
function EnumSurfaces(dwFlags: DWORD; const lpDDSD: TDDSURFACEDESC;
lpContext: Pointer; lpEnumCallback: {LPDDENUMSURFACESCALLBACK}TDDEnumSurfacesCallback): HResult; stdcall;
function FlipToGDISurface: HResult; stdcall;
function GetCaps(var lpDDDriverCaps: DDCAPS; var lpDDHELCaps: DDCAPS): HResult; stdcall;
function GetDisplayMode(var lpDDSurfaceDesc: DDSURFACEDESC): HResult; stdcall;
function GetCaps(var lpDDDriverCaps: TDDCAPS; var lpDDHELCaps: TDDCAPS): HResult; stdcall;
function GetDisplayMode(var lpDDSurfaceDesc: TDDSURFACEDESC): HResult; stdcall;
function GetFourCCCodes(var lpNumCodes, lpCodes: DWORD): HResult; stdcall;
function GetGDISurface(out lplpGDIDDSSurface: IDirectDrawSurface): HResult; stdcall;
function GetMonitorFrequency(var lpdwFrequency: DWORD): HResult; stdcall;
1133,7 → 1135,7
dwFlags: DWORD): HResult; stdcall;
function WaitForVerticalBlank(dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
// IDirectDraw2 methods
function GetAvailableVidMem(var lpDDSCaps: DDSCAPS;
function GetAvailableVidMem(var lpDDSCaps: TDDSCAPS;
var lpdwTotal, lpdwFree: DWORD): HResult; stdcall;
// IDirectDraw3 methods
function GetSurfaceFromDC(hdc: HDC; out ppSurface: IDirectDrawSurface): HResult; stdcall;
/VCL_DELPHIX_D6/DIB.pas
1,13 → 1,40
{*******************************************************}
{ }
{ DIB and PAINTBOX componets }
{ }
{ Copyright (C) 1997-2000 Hiroyuki Hori }
{ base components and effects }
{ Copyright (C) 2000 Keith Murray }
{ supernova effect }
{ Copyright (C) 2000 Michel Hibon }
{ new special effects added for DIB }
{ Copyright (C) 2001 Joakim Back }
{ conFusion effects (as DxFusion) }
{ Copyright (C) 2003 Babak Sateli }
{ 24-bit DIB effect as supplement ones }
{ Copyright (C) 2004-2012 Jaro Benes }
{ 32-bit DIB effect with alphachannel }
{ direct works with texture buffer }
{ modified and adapted all adopted functions }
{ }
{*******************************************************}
 
unit DIB;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
{$DEFINE USE_SCANLINE}
 
uses
Windows, SysUtils, Classes, Graphics, Controls;
Windows, SysUtils, Classes, Graphics, Controls,
{$IFDEF VER17UP} Types, UITypes,{$ENDIF}
Math;
 
type
TColorLineStyle = (csSolid, csGradient, csRainbow);
TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular);
PRGBQuads = ^TRGBQuads;
TRGBQuads = array[0..255] of TRGBQuad;
 
TPaletteEntries = array[0..255] of TPaletteEntry;
17,6 → 44,16
B, G, R: Byte;
end;
 
{ Added this type for New SPecial Effect }
TFilter = array[0..2, 0..2] of SmallInt;
TLines = array[0..0] of TBGR;
PLines = ^TLines;
TBytes = array[0..0] of Byte;
PBytes = ^TBytes;
TPBytes = array[0..0] of PBytes;
PPBytes = ^TPBytes;
{ End of type's }
 
PArrayBGR = ^TArrayBGR;
TArrayBGR = array[0..10000] of TBGR;
 
29,7 → 66,7
PArrayDWord = ^TArrayDWord;
TArrayDWord = array[0..10000] of DWord;
 
{ TDIB }
{ TDIBPixelFormat }
 
TDIBPixelFormat = record
RBitMask, GBitMask, BBitMask: DWORD;
38,6 → 75,8
RBitCount2, GBitCount2, BBitCount2: DWORD;
end;
 
{ TDIBSharedImage }
 
TDIBSharedImage = class(TSharedImage)
private
FBitCount: Integer;
64,7 → 103,7
constructor Create;
procedure NewImage(AWidth, AHeight, ABitCount: Integer;
const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
procedure Compress(Source: TDIBSharedImage);
procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
procedure ReadData(Stream: TStream; MemoryImage: Boolean);
76,6 → 115,33
destructor Destroy; override;
end;
 
{ TFilterTypeResample }
 
TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline,
ftrLanczos3, ftrMitchell);
 
TDistortType = (dtFast, dtSlow);
{DXFusion effect type}
TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75);
 
{ TLightSource }
 
TLightSource = record
X, Y: Integer;
Size1, Size2: Integer;
Color: TColor;
end;
 
{ TLightArray }
 
TLightArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TLightsource;
 
{ TMatrixSetting }
 
TMatrixSetting = array[0..9] of Integer;
 
{ TDIB }
 
TDIB = class(TGraphic)
private
FCanvas: TCanvas;
96,6 → 162,10
FTopPBits: Pointer;
FWidth: Integer;
FWidthBytes: Integer;
FLUTDist: array[0..255, 0..255] of Integer;
LG_COUNT: Integer;
LG_DETAIL: Integer;
FFreeList: TList;
procedure AllocHandle;
procedure CanvasChanging(Sender: TObject);
procedure Changing(MemoryImage: Boolean);
113,15 → 183,28
function GetTopPBits: Pointer;
function GetTopPBitsReadOnly: Pointer;
procedure SetBitCount(Value: Integer);
procedure SetImage(Value: TDIBSharedImage);
procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF}
procedure SetNowPixelFormat(const Value: TDIBPixelFormat);
procedure SetPixel(X, Y: Integer; Value: DWORD);
procedure StartProgress(const Name: string);
procedure EndProgress;
procedure UpdateProgress(PercentY: Integer);
 
{ Added these 3 functions for New Specials Effects }
function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
{ End of 3 functions for New Special Effect }
 
procedure Darkness(Amount: Integer);
function GetAlphaChannel: TDIB;
procedure SetAlphaChannel(const Value: TDIB);
function GetClientRect: TRect;
function GetRGBChannel: TDIB;
procedure SetRGBChannel(const Value: TDIB);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
function GetEmpty: Boolean; override;
function GetHeight: Integer; override;
function GetPalette: HPalette; override;
141,6 → 224,9
procedure Compress;
procedure Decompress;
procedure FreeHandle;
function HasAlphaChannel: Boolean;
function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
procedure RetAlphaChannel(out oDIB: TDIB);
procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
APalette: HPALETTE); override;
procedure LoadFromStream(Stream: TStream); override;
147,7 → 233,7
procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
var APalette: HPALETTE); override;
procedure SaveToStream(Stream: TStream); override;
procedure SetSize(AWidth, AHeight, ABitCount: Integer);
procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
procedure UpdatePalette;
{ Special effect }
procedure Blur(ABitCount: Integer; Radius: Integer);
155,6 → 241,160
procedure Mirror(MirrorX, MirrorY: Boolean);
procedure Negative;
 
{ Added New Special Effect }
procedure Spray(Amount: Integer);
procedure Emboss;
procedure AddMonoNoise(Amount: Integer);
procedure AddGradiantNoise(Amount: byte);
function Twist(bmp: TDIB; Amount: byte): Boolean;
function FishEye(bmp: TDIB): Boolean;
function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
procedure Lightness(Amount: Integer);
procedure Saturation(Amount: Integer);
procedure Contrast(Amount: Integer);
procedure AddRGB(aR, aG, aB: Byte);
function Filter(Dest: TDIB; Filter: TFilter): Boolean;
procedure Sharpen(Amount: Integer);
function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF}
function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
procedure SplitBlur(Amount: Integer);
procedure GaussianBlur(Bmp: TDIB; Amount: Integer);
{ End of New Special Effect }
{
New effect for TDIB
with Some Effects like AntiAlias, Contrast,
Lightness, Saturation, GaussianBlur, Mosaic,
Twist, Splitlight, Trace, Emboss, etc.
Works with 24bit color DIBs.
 
This component is based on TProEffectImage component version 1.0 by
Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com)
 
and modified by (c) 2004 Jaro Benes
for DelphiX use.
 
Demo was modified into DXForm with function like original
 
DISCLAIMER
This component is provided AS-IS without any warranty of any kind, either express or
implied. This component is freeware and can be used in any software product.
}
procedure DoInvert;
procedure DoAddColorNoise(Amount: Integer);
procedure DoAddMonoNoise(Amount: Integer);
procedure DoAntiAlias;
procedure DoContrast(Amount: Integer);
procedure DoFishEye(Amount: Integer);
procedure DoGrayScale;
procedure DoLightness(Amount: Integer);
procedure DoDarkness(Amount: Integer);
procedure DoSaturation(Amount: Integer);
procedure DoSplitBlur(Amount: Integer);
procedure DoGaussianBlur(Amount: Integer);
procedure DoMosaic(Size: Integer);
procedure DoTwist(Amount: Integer);
procedure DoSplitlight(Amount: Integer);
procedure DoTile(Amount: Integer);
procedure DoSpotLight(Amount: Integer; Spot: TRect);
procedure DoTrace(Amount: Integer);
procedure DoEmboss;
procedure DoSolorize(Amount: Integer);
procedure DoPosterize(Amount: Integer);
procedure DoBrightness(Amount: Integer);
procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
{rotate}
procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
procedure DoColorize(ForeColor, BackColor: TColor);
{Simple explosion spoke effect}
procedure DoNovaEffect(sr, sg, sb, cx, cy, radius,
nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
 
{Simple Mandelbrot-set drawing}
procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double);
 
{Sephia effect}
procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
 
{Simple blend pixel}
procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
{Line in polar system}
procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended;
Color: cardinal);
 
{special version Dark/Light procedure in percent}
procedure Darker(Percent: Integer);
procedure Lighter(Percent: Integer);
 
{Simple graphical crypt}
procedure EncryptDecrypt(const Key: Integer);
 
{ Standalone DXFusion }
{--- c o n F u s i o n ---}
{By Joakim Back, www.back.mine.nu}
{Huge thanks to Ilkka Tuomioja for helping out with the project.}
 
{
modified by (c) 2005 Jaro Benes for DelphiX use.
}
 
procedure CreateDIBFromBitmap(const Bitmap: TBitmap);
{Drawing Methods.}
procedure DrawOn(Dest: TRect; DestCanvas: TCanvas;
Xsrc, Ysrc: Integer);
procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX,
SourceY: Integer);
procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
FilterMode: TFilterMode);
procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
Alpha: Byte);
procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
Frame: Integer);
procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF};
Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF});
procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor;
FilterMode: TFilterMode);
procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor);
procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
SourceY: Integer; const Color: TColor);
procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
SourceY, Alpha: Integer; const Color: TColor);
procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width,
Height, SourceX, SourceY: Integer);
procedure DrawAntialias(SrcDIB: TDIB);
procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
{One-color Filters.}
procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor;
FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
{ Lightsource. }
procedure InitLight(Count, Detail: Integer);
procedure DrawLights(FLight: TLightArray; AmbientLight: TColor);
//
// effect for special purpose
//
procedure FadeOut(DIB2: TDIB; Step: Byte);
procedure DoZoom(DIB2: TDIB; ZoomRatio: Real);
procedure DoBlur(DIB2: TDIB);
procedure FadeIn(DIB2: TDIB; Step: Byte);
procedure FillDIB8(Color: Byte);
procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
// lines
procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF}
function GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
FromPoint, ToPoint: Extended): TColor;
procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry;
iRadius: WORD);
// standard property
property BitCount: Integer read FBitCount write SetBitCount;
property BitmapInfo: PBitmapInfo read GetBitmapInfo;
property BitmapInfoSize: Integer read GetBitmapInfoSize;
174,8 → 414,15
property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly;
property Width: Integer read FWidth write SetWidth;
property WidthBytes: Integer read FWidthBytes;
property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel;
property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel;
function CreateBitmapFromDIB: TBitmap;
procedure Fill(aColor: TColor);
property ClientRect: TRect read GetClientRect;
end;
 
{ TDIBitmap }
 
TDIBitmap = class(TDIB) end;
 
{ TCustomDXDIB }
235,10 → 482,10
 
TDXPaintBox = class(TCustomDXPaintBox)
published
{$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF}
{$IFDEF VER4UP}property Anchors; {$ENDIF}
property AutoStretch;
property Center;
{$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF}
{$IFDEF VER4UP}property Constraints; {$ENDIF}
property DIB;
property KeepAspect;
property Stretch;
261,34 → 508,105
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{$IFDEF VER9UP}property OnMouseWheel; {$ENDIF}
{$IFDEF VER9UP}property OnResize; {$ENDIF}
{$IFDEF VER9UP}property OnCanResize; {$ENDIF}
{$IFDEF VER9UP}property OnContextPopup; {$ENDIF}
property OnStartDrag;
end;
 
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD;
procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte);
function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
const
DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2);
 
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF}
procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
 
function GreyscaleColorTable: TRGBQuads;
 
function RGBQuad(R, G, B: Byte): TRGBQuad;
function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad;
function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads;
function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry;
function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries;
function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF}
function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF}
function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF}
 
function PosValue(Value: Integer): Integer;
 
type
TOC = 0..511;
function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
 
{ Added Constants for TFilter Type }
const
EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1));
StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100));
Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100));
LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40));
GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100));
SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2));
{ End of constants }
 
{ Added Constants for DXFusion Type }
const
{ 3x3 Matrix Presets. }
msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6);
msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8);
msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16);
msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7);
msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1);
 
{Proportionaly scale of size, for recountin image sizes}
function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF}
 
procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF}
procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF}
 
implementation
 
uses DXConsts;
uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg;
 
function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;
var
XScale, YScale: Single;
begin
XScale := 1;
YScale := 1;
if TargetWidth < SourceWidth then
XScale := TargetWidth / SourceWidth;
if TargetHeight < SourceHeight then
YScale := TargetHeight / SourceHeight;
Result := XScale;
if YScale < Result then
Result := YScale;
end;
 
{$IFNDEF VER4UP}
function Max(B1, B2: Integer): Integer;
begin
if B1>=B2 then Result := B1 else Result := B2;
end;
 
function Min(B1, B2: Integer): Integer;
begin
if B1 <= B2 then Result := B1 else Result := B2;
end;
{$ENDIF}
 
function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
begin
Result := sin(((c * 360) / 511) * Pi / 180);
end;
 
function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
begin
Result := cos(((c * 360) / 511) * Pi / 180);
end;
 
function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
begin
Result.RBitMask := ((1 shl RBitCount)-1) shl (GBitCount+BBitCount);
305,9 → 623,7
Result.BShift := 8-BBitCount;
end;
 
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
 
function GetBitCount(b: Integer): Integer;
function GetBitCount(b: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
var
i: Integer;
begin
322,6 → 638,7
end;
end;
 
function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
begin
Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask),
GetBitCount(BBitMask));
352,7 → 669,7
with PixelFormat do
begin
Result := (Color and RBitMask) shr RShift;
Result := Result or (Result shr RBitCount);
Result := Result or (Result shr RBitCount2);
end;
end;
 
361,7 → 678,7
with PixelFormat do
begin
Result := (Color and GBitMask) shr GShift;
Result := Result or (Result shr GBitCount);
Result := Result or (Result shr GBitCount2);
end;
end;
 
370,7 → 687,7
with PixelFormat do
begin
Result := (Color and BBitMask) shl BShift;
Result := Result or (Result shr BBitCount);
Result := Result or (Result shr BBitCount2);
end;
end;
 
447,6 → 764,8
RBitMask, GBitMask, BBitMask: DWORD;
end;
 
{ TPaletteItem }
 
TPaletteItem = class(TCollectionItem)
private
ID: Integer;
456,9 → 775,11
ColorTableCount: Integer;
destructor Destroy; override;
procedure AddRef;
procedure Release;
procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF}
end;
 
{ TPaletteManager }
 
TPaletteManager = class
private
FList: TCollection;
468,6 → 789,8
procedure DeletePalette(var Palette: HPalette);
end;
 
{ TPaletteItem }
 
destructor TPaletteItem.Destroy;
begin
DeleteObject(Palette);
485,6 → 808,8
if RefCount<=0 then Free;
end;
 
{ TPaletteManager }
 
constructor TPaletteManager.Create;
begin
inherited Create;
577,6 → 902,8
Result := FPaletteManager;
end;
 
{ TDIBSharedImage }
 
constructor TDIBSharedImage.Create;
begin
inherited Create;
592,8 → 919,10
InfoOfs: Integer;
UsePixelFormat: Boolean;
begin
{$IFNDEF D17UP}
{self recreation is not allowed here}
Create;
 
{$ENDIF}
{ Pixel format check }
case ABitCount of
1 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
602,16 → 931,19
raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
8 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
16: begin
16:
begin
if not (((PixelFormat.RBitMask=$7C00) and (PixelFormat.GBitMask=$03E0) and (PixelFormat.BBitMask=$001F)) or
((PixelFormat.RBitMask=$F800) and (PixelFormat.GBitMask=$07E0) and (PixelFormat.BBitMask=$001F))) then
raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
end;
24: begin
24:
begin
if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
end;
32: begin
32:
begin
if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then
raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
end;
696,7 → 1028,8
FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize));
if FPBits=nil then
OutOfMemoryError;
end else
end
else
begin
FDC := CreateCompatibleDC(0);
 
713,11 → 1046,17
 
procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
begin
if Source = nil then Exit; //no source
if Source.FSize=0 then
begin
{$IFNDEF D17UP}
{self recreation is not allowed here}
Create;
{$ENDIF}
FMemoryImage := MemoryImage;
end else
end
else
begin
NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed);
726,7 → 1065,8
FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage;
GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage);
Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
end else
end
else
begin
Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
end;
789,7 → 1129,8
 
AllocByte^ := B1;
AllocByte^ := B2;
end else
end
else
if (Source.FWidth-x>5) and ((GetPixel(x)<>GetPixel(x+2)) or (GetPixel(x+1)<>GetPixel(x+3))) and
((GetPixel(x+2)=GetPixel(x+4)) and (GetPixel(x+3)=GetPixel(x+5))) then
begin
797,7 → 1138,8
AllocByte^ := 2;
AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1);
Inc(x, 2);
end else
end
else
begin
if (Source.FWidth-x<4) then
begin
815,7 → 1157,8
AllocByte^ := GetPixel(x) shl 4;
Inc(x);
end;
end else
end
else
begin
{ Absolute mode }
PB1 := Size; AllocByte;
904,7 → 1247,8
 
AllocByte^ := B1;
AllocByte^ := B2;
end else
end
else
if (Source.FWidth-x>2) and (Src^<>PByte(Integer(Src)+1)^) and (PByte(Integer(Src)+1)^=PByte(Integer(Src)+2)^) then
begin
{ Encoding mode }
911,7 → 1255,8
AllocByte^ := 1;
AllocByte^ := Src^; Inc(Src);
Inc(x);
end else
end
else
begin
if (Source.FWidth-x<4) then
begin
924,13 → 1269,15
AllocByte^ := 1;
AllocByte^ := Src^; Inc(Src);
Inc(x, 2);
end else
end
else
begin
AllocByte^ := 1;
AllocByte^ := Src^; Inc(Src);
Inc(x);
end;
end else
end
else
begin
{ Absolute mode }
PB1 := Size; AllocByte;
979,7 → 1326,8
begin
if Source.FCompressed then
Duplicate(Source, Source.FMemoryImage)
else begin
else
begin
NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
Source.FPixelFormat, Source.FColorTable, True, True);
case FBitmapInfo.bmiHeader.biCompression of
1030,7 → 1378,8
if i and 1=0 then
begin
C := Src^; Inc(Src);
end else
end
else
begin
C := C shl 4;
end;
1044,7 → 1393,8
Inc(X);
end;
end;
end else
end
else
begin
{ Encoding mode }
Dest := Pointer(Longint(FPBits)+Y*FWidthBytes);
1101,7 → 1451,8
{ Absolute mode }
Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
end;
end else
end
else
begin
{ Encoding mode }
FillChar(Dest^, B1, B2); Inc(Dest, B1);
1115,7 → 1466,8
begin
if not Source.FCompressed then
Duplicate(Source, MemoryImage)
else begin
else
begin
NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
Source.FPixelFormat, Source.FColorTable, MemoryImage, False);
case Source.FBitmapInfo.bmiHeader.biCompression of
1136,6 → 1488,7
procedure LoadRLE4;
begin
FSize := BI.biSizeImage;
//GetMem(FPBits, FSize);
FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
FBitmapInfo.bmiHeader.biSizeImage := FSize;
Stream.ReadBuffer(FPBits^, FSize);
1144,6 → 1497,7
procedure LoadRLE8;
begin
FSize := BI.biSizeImage;
//GetMem(FPBits, FSize);
FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
FBitmapInfo.bmiHeader.biSizeImage := FSize;
Stream.ReadBuffer(FPBits^, FSize);
1157,7 → 1511,8
begin
for y:=0 to Abs(BI.biHeight)-1 do
Stream.ReadBuffer(Pointer(Integer(FTopPBits)+y*FNextLine)^, FWidthBytes);
end else
end
else
begin
Stream.ReadBuffer(FPBits^, FSize);
end;
1170,12 → 1525,17
AColorTable: TRGBQuads;
APixelFormat: TDIBPixelFormat;
begin
if not Assigned(Stream) then Exit;
{ Header size reading }
i := Stream.Read(BI.biSize, 4);
 
if i=0 then
begin
{$IFNDEF D17UP}
{self recreation is not allowed here}
Create;
{$ENDIF}
Exit;
end;
if i<>4 then
1216,7 → 1576,8
Stream.ReadBuffer(Localpf, SizeOf(Localpf));
with Localpf do
APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask);
end else
end
else
begin
if BI.biBitCount=16 then
APixelFormat := MakeDIBPixelFormat(5, 5, 5)
1243,13 → 1604,14
with BCRGB[i] do
AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue);
end;
end else
end
else
begin
{ Windows type }
Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad)*PalCount);
end;
 
{ DIB ì¬ }
{ DIB compilation }
NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable,
MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]);
 
1270,7 → 1632,9
begin
if FOldHandle<>0 then SelectObject(FDC, FOldHandle);
DeleteObject(FHandle);
end else
end
else
// GlobalFree(THandle(FPBits));
begin
if FPBits<>nil then
GlobalFreePtr(FPBits);
1333,12 → 1697,26
begin
inherited Create;
SetImage(EmptyDIBImage);
 
FFreeList := TList.Create;
end;
 
destructor TDIB.Destroy;
var
D: TDIB;
begin
SetImage(EmptyDIBImage);
FCanvas.Free;
 
while FFreeList.Count > 0 do
try
D := TDIB(FFreeList[0]);
FFreeList.Remove(D);
D.Free;
except
end;
FFreeList.Free;
 
inherited Destroy;
end;
 
1372,12 → 1750,14
if DIBSectionRec^.dsBm.bmBitsPixel>=24 then
begin
PixelFormat := MakeDIBPixelFormat(8, 8, 8);
end else
end
else
if DIBSectionRec^.dsBm.bmBitsPixel>8 then
begin
PixelFormat := MakeDIBPixelFormat(DIBSectionRec^.dsBitfields[0],
PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks
DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]);
end else
end
else
begin
PixelFormat := MakeDIBPixelFormat(8, 8, 8);
end;
1393,14 → 1773,64
end;
 
procedure AssignGraphic(Source: TGraphic);
{$IFDEF PNG_GRAPHICS}
var
alpha: TDIB;
png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF};
i, j: Integer;
q: pByteArray;
{$ENDIF}
begin
{$IFDEF PNG_GRAPHICS}
if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then
begin
alpha := TDIB.Create;
try
{png image}
png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create;
try
png.Assign(Source);
if png.TransparencyMode = ptmPartial then
begin
Alpha.SetSize(png.Width, png.Height, 8);
{separate alpha}
for i := 0 to png.Height - 1 do
begin
q := png.AlphaScanline[i];
for j := 0 to png.Width - 1 do
alpha.Pixels[j,i] := q[j];
end;
end;
SetSize(png.Width, png.Height, 32);
FillChar(PBits^, Size, 0);
Canvas.Draw(0, 0, png);
Transparent := png.Transparent;
finally
png.Free;
end;
if not alpha.Empty then
AssignAlphaChannel(alpha);
finally
alpha.Free;
end;
end
else
{$ENDIF}
if Source is TBitmap then
AssignBitmap(TBitmap(Source))
else
begin
SetSize(Source.Width, Source.Height, 32);
FillChar(PBits^, Size, 0);
Canvas.Draw(0, 0, Source);
Transparent := Source.Transparent;
if not HasAlphaChannel then
begin
SetSize(Source.Width, Source.Height, 24);
FillChar(PBits^, Size, 0);
Canvas.Draw(0, 0, Source);
Transparent := Source.Transparent;
end
end;
end;
 
1425,7 → 1855,7
inherited Assign(Source);
end;
 
procedure TDIB.Draw(ACanvas: TCanvas; const Rect: TRect);
procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect);
var
OldPalette: HPalette;
OldMode: Integer;
1436,7 → 1866,8
begin
OldPalette := SelectPalette(ACanvas.Handle, Palette, False);
RealizePalette(ACanvas.Handle);
end else
end
else
OldPalette := 0;
try
OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR);
1444,14 → 1875,18
GdiFlush;
if FImage.FMemoryImage then
begin
with Rect do
StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
0, 0, Width, Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS , ACanvas.CopyMode);
end else
with ARect do
begin
with Rect do
if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
0, 0, Self.Width, Self.Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS, ACanvas.CopyMode) = 0 then
MessageBeep(1);
end;
end
else
begin
with ARect do
StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
FImage.FDC, 0, 0, Width, Height, ACanvas.CopyMode);
FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode);
end;
finally
SetStretchBltMode(ACanvas.Handle, OldMode);
1557,6 → 1992,161
end;
end;
 
type
PRGBA = ^TRGBA;
TRGBA = array[0..0] of Windows.TRGBQuad;
 
function TDIB.HasAlphaChannel: Boolean;
{give that DIB contain the alphachannel}
var
p: PRGBA;
X, Y: Integer;
begin
Result := True;
if BitCount = 32 then
for Y := 0 to Height - 1 do
begin
p := ScanLine[Y];
for X := 0 to Width - 1 do
begin
if p[X].rgbReserved <> $0 then Exit;
end
end;
Result := False;
end;
 
function TDIB.AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
{copy alphachannel from other DIB or add from DIB8}
var
p32_0, p32_1: PRGBA;
p24: Pointer;
pB: PArrayByte;
X, Y: Integer;
tmpDIB, qAlpha: TDIB;
begin
Result := False;
if GetEmpty then Exit;
{Alphachannel can be copy into 32bit DIB only!}
if BitCount <> 32 then
begin
tmpDIB := TDIB.Create;
try
tmpDIB.Assign(Self);
Clear;
SetSize(tmpDIB.Width, tmpDIB.Height, 32);
Canvas.Draw(0, 0, tmpDIB);
finally
tmpDIB.Free;
end;
end;
qAlpha := TDIB.Create;
try
if not Assigned(Alpha) then Exit;
if ForceResize then
begin
{create temp}
tmpDIB := TDIB.Create;
try
{picture}
tmpDIB.Assign(ALPHA);
{resample size}
tmpDIB.DoResample(Width, Height, ftrBSpline);
{convert to greyscale}
tmpDIB.Greyscale(8);
{return picture to qAlpha}
qAlpha.Assign(tmpDIB);
finally
tmpDIB.Free;
end;
end
else
{Must be the same size!}
if not ((Width = ALPHA.Width) and (Height = ALPHA.Height)) then Exit
else qAlpha.Assign(ALPHA);
{It works now with qAlpha only}
case qAlpha.BitCount of
24:
begin
for Y := 0 to Height - 1 do
begin
p32_0 := ScanLine[Y];
p24 := qAlpha.ScanLine[Y];
for X := 0 to Width - 1 do with PBGR(p24)^ do
begin
p32_0[X].rgbReserved := Round(0.30 * R + 0.59 * G + 0.11 * B);
end
end;
end;
32:
begin
for Y := 0 to Height - 1 do
begin
p32_0 := ScanLine[Y];
p32_1 := qAlpha.ScanLine[Y];
for X := 0 to Width - 1 do
begin
p32_0[X].rgbReserved := p32_1[X].rgbReserved;
end
end;
end;
8:
begin
for Y := 0 to Height - 1 do
begin
p32_0 := ScanLine[Y];
pB := qAlpha.ScanLine[Y];
for X := 0 to Width - 1 do
begin
p32_0[X].rgbReserved := pB[X];
end
end;
end;
1:
begin
for Y := 0 to Height - 1 do
begin
p32_0 := ScanLine[Y];
pB := qAlpha.ScanLine[Y];
for X := 0 to Width - 1 do
begin
if pB[X] = 0 then
p32_0[X].rgbReserved := $FF
else
p32_0[X].rgbReserved := 0
end
end;
end;
else
Exit;
end;
Result := True;
finally
qAlpha.Free;
end;
end;
 
procedure TDIB.RetAlphaChannel(out oDIB: TDIB);
{Store alphachannel information into DIB8}
var
p0: PRGBA;
pB: PArrayByte;
X, Y: Integer;
begin
oDIB := nil;
if not HasAlphaChannel then exit;
oDIB := TDIB.Create;
oDIB.SetSize(Width, Height, 8);
for Y := 0 to Height - 1 do
begin
p0 := ScanLine[Y];
pB := oDIB.ScanLine[Y];
for X := 0 to Width - 1 do
begin
pB[X] := p0[X].rgbReserved;
end
end;
end;
 
function TDIB.GetBitmapInfo: PBitmapInfo;
begin
Result := FImage.FBitmapInfo;
1683,7 → 2273,7
begin
case FBitCount of
1 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
4 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1];
4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]);
8 : Result := PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X];
16: Result := PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X];
24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do
1693,6 → 2283,17
end;
end;
 
function TDIB.GetRGBChannel: TDIB;
{Store RGB channel information into DIB24}
begin
Result := nil;
if Self.Empty then Exit;
Result := TDIB.Create;
Result.SetSize(Width, Height, 24);
Self.DrawOn(Bounds(0,0, Self.Width, Self.Height), Result.Canvas, 0, 0);
FFreeList.Add(Result);
end;
 
procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD);
var
P: PByte;
1707,8 → 2308,8
P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]);
end;
4 : begin
P := @PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3];
P^ := (P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]);
P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]);
P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]));
end;
8 : PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X] := Value;
16: PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value;
1723,6 → 2324,23
end;
end;
procedure TDIB.SetRGBChannel(const Value: TDIB);
var
alpha: TDIB;
begin
if Self.HasAlphaChannel then
try
RetAlphaChannel(alpha);
Self.SetSize(Value.Width, Value.Height, 32);
Value.DrawOn(Bounds(0,0,Value.Width, Value.Height), Self.Canvas, 0, 0);
Self.AssignAlphaChannel(alpha, True);
finally
alpha.Free;
end
else
Self.Assign(Value);
end;
 
procedure TDIB.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
1731,6 → 2349,8
end;
 
type
{ TGlobalMemoryStream }
 
TGlobalMemoryStream = class(TMemoryStream)
private
FHandle: THandle;
1773,6 → 2393,7
var
BF: TBitmapFileHeader;
i: Integer;
ImageJPEG: TJPEGImage;
begin
{ File header reading }
i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
1780,6 → 2401,30
if i<>SizeOf(TBitmapFileHeader) then
raise EInvalidGraphic.Create(SInvalidDIB);
 
{ Is the head jpeg ?}
 
if BF.bfType = $D8FF then
begin
ImageJPEG := TJPEGImage.Create;
try
try
Stream.Position := 0;
ImageJPEG.LoadFromStream(Stream);
except
on EInvalidGraphic do ImageJPEG := nil;
end;
if ImageJPEG <> nil then
begin
{set size and bitcount in natural units of jpeg}
SetSize(ImageJPEG.Width, ImageJPEG.Height, 24);
Canvas.Draw(0, 0, ImageJPEG);
Exit
end;
finally
ImageJPEG.Free;
end;
end
else
{ Is the head 'BM'? }
if BF.bfType<>BitmapFileType then
raise EInvalidGraphic.Create(SInvalidDIB);
1864,7 → 2509,8
if Empty then
begin
SetSize(Max(Width, 1), Max(Height, 1), Value)
end else
end
else
begin
ConvertBitCount(Value);
end;
2031,13 → 2677,16
for x:=0 to Width-1 do
begin
case Temp.BitCount of
1 : begin
1:
begin
i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
end;
4 : begin
4:
begin
i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1];
end;
8 : begin
8:
begin
i := PByte(SrcP)^;
Inc(PByte(SrcP));
end;
2044,15 → 2693,18
end;
 
case BitCount of
1 : begin
1:
begin
P := @PArrayByte(DestP)[X shr 3];
P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]);
end;
4 : begin
4:
begin
P := @PArrayByte(DestP)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]);
end;
8 : begin
8:
begin
PByte(DestP)^ := i;
Inc(PByte(DestP));
end;
2079,7 → 2731,8
for x:=0 to Width-1 do
begin
case Temp.BitCount of
1 : begin
1:
begin
with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
begin
cR := rgbRed;
2087,7 → 2740,8
cB := rgbBlue;
end;
end;
4 : begin
4:
begin
with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
begin
cR := rgbRed;
2095,7 → 2749,8
cB := rgbBlue;
end;
end;
8 : begin
8:
begin
with Temp.ColorTable[PByte(SrcP)^] do
begin
cR := rgbRed;
2104,11 → 2759,13
end;
Inc(PByte(SrcP));
end;
16: begin
16:
begin
pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB);
Inc(PWord(SrcP));
end;
24: begin
24:
begin
with PBGR(SrcP)^ do
begin
cR := R;
2118,7 → 2775,8
 
Inc(PBGR(SrcP));
end;
32: begin
32:
begin
pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB);
Inc(PDWORD(SrcP));
end;
2125,11 → 2783,13
end;
 
case BitCount of
16: begin
16:
begin
PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
Inc(PWord(DestP));
end;
24: begin
24:
begin
with PBGR(DestP)^ do
begin
R := cR;
2138,7 → 2798,8
end;
Inc(PBGR(DestP));
end;
32: begin
32:
begin
PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
Inc(PDWORD(DestP));
end;
2163,7 → 2824,8
if Temp.BitCount<=BitCount then
begin
PaletteToPalette_Inc;
end else
end
else
begin
case BitCount of
1: begin
2177,12 → 2839,14
 
Canvas.Draw(0, 0, Temp);
end;
end else
end
else
if (Temp.BitCount<=8) and (BitCount>8) then
begin
{ The image is converted from the palette color image into the rgb color image. }
PaletteToRGB_or_RGBToRGB;
end else
end
else
if (Temp.BitCount>8) and (BitCount<=8) then
begin
{ The image is converted from the rgb color image into the palette color image. }
2197,7 → 2861,8
UpdatePalette;
 
Canvas.Draw(0, 0, Temp);
end else
end
else
if (Temp.BitCount>8) and (BitCount>8) then
begin
{ The image is converted from the rgb color image into the rgb color image. }
2251,6 → 2916,211
Inc(FProgressY);
end;
 
procedure TDIB.Mirror(MirrorX, MirrorY: Boolean);
var
x, y, Width2, c: Integer;
P1, P2, TempBuf: Pointer;
begin
if Empty then Exit;
if (not MirrorX) and (not MirrorY) then Exit;
 
if (not MirrorX) and (MirrorY) then
begin
GetMem(TempBuf, WidthBytes);
try
StartProgress('Mirror');
try
for y := 0 to Height shr 1 - 1 do
begin
P1 := ScanLine[y];
P2 := ScanLine[Height - y - 1];
 
Move(P1^, TempBuf^, WidthBytes);
Move(P2^, P1^, WidthBytes);
Move(TempBuf^, P2^, WidthBytes);
 
UpdateProgress(y * 2);
end;
finally
EndProgress;
end;
finally
FreeMem(TempBuf, WidthBytes);
end;
end
else
if (MirrorX) and (not MirrorY) then
begin
Width2 := Width shr 1;
 
StartProgress('Mirror');
try
for y := 0 to Height - 1 do
begin
P1 := ScanLine[y];
 
case BitCount of
1:
begin
for x := 0 to Width2 - 1 do
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width - x - 1, y];
Pixels[Width - x - 1, y] := c;
end;
end;
4:
begin
for x := 0 to Width2 - 1 do
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width - x - 1, y];
Pixels[Width - x - 1, y] := c;
end;
end;
8:
begin
P2 := Pointer(Integer(P1) + Width - 1);
for x := 0 to Width2 - 1 do
begin
PByte(@c)^ := PByte(P1)^;
PByte(P1)^ := PByte(P2)^;
PByte(P2)^ := PByte(@c)^;
Inc(PByte(P1));
Dec(PByte(P2));
end;
end;
16:
begin
P2 := Pointer(Integer(P1) + (Width - 1) * 2);
for x := 0 to Width2 - 1 do
begin
PWord(@c)^ := PWord(P1)^;
PWord(P1)^ := PWord(P2)^;
PWord(P2)^ := PWord(@c)^;
Inc(PWord(P1));
Dec(PWord(P2));
end;
end;
24:
begin
P2 := Pointer(Integer(P1) + (Width - 1) * 3);
for x := 0 to Width2 - 1 do
begin
PBGR(@c)^ := PBGR(P1)^;
PBGR(P1)^ := PBGR(P2)^;
PBGR(P2)^ := PBGR(@c)^;
Inc(PBGR(P1));
Dec(PBGR(P2));
end;
end;
32:
begin
P2 := Pointer(Integer(P1) + (Width - 1) * 4);
for x := 0 to Width2 - 1 do
begin
PDWORD(@c)^ := PDWORD(P1)^;
PDWORD(P1)^ := PDWORD(P2)^;
PDWORD(P2)^ := PDWORD(@c)^;
Inc(PDWORD(P1));
Dec(PDWORD(P2));
end;
end;
end;
 
UpdateProgress(y);
end;
finally
EndProgress;
end;
end
else
if (MirrorX) and (MirrorY) then
begin
StartProgress('Mirror');
try
for y := 0 to Height shr 1 - 1 do
begin
P1 := ScanLine[y];
P2 := ScanLine[Height - y - 1];
 
case BitCount of
1:
begin
for x := 0 to Width - 1 do
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
Pixels[Width - x - 1, Height - y - 1] := c;
end;
end;
4:
begin
for x := 0 to Width - 1 do
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
Pixels[Width - x - 1, Height - y - 1] := c;
end;
end;
8:
begin
P2 := Pointer(Integer(P2) + Width - 1);
for x := 0 to Width - 1 do
begin
PByte(@c)^ := PByte(P1)^;
PByte(P1)^ := PByte(P2)^;
PByte(P2)^ := PByte(@c)^;
Inc(PByte(P1));
Dec(PByte(P2));
end;
end;
16:
begin
P2 := Pointer(Integer(P2) + (Width - 1) * 2);
for x := 0 to Width - 1 do
begin
PWord(@c)^ := PWord(P1)^;
PWord(P1)^ := PWord(P2)^;
PWord(P2)^ := PWord(@c)^;
Inc(PWord(P1));
Dec(PWord(P2));
end;
end;
24:
begin
P2 := Pointer(Integer(P2) + (Width - 1) * 3);
for x := 0 to Width - 1 do
begin
PBGR(@c)^ := PBGR(P1)^;
PBGR(P1)^ := PBGR(P2)^;
PBGR(P2)^ := PBGR(@c)^;
Inc(PBGR(P1));
Dec(PBGR(P2));
end;
end;
32:
begin
P2 := Pointer(Integer(P2) + (Width - 1) * 4);
for x := 0 to Width - 1 do
begin
PDWORD(@c)^ := PDWORD(P1)^;
PDWORD(P1)^ := PDWORD(P2)^;
PDWORD(P2)^ := PDWORD(@c)^;
Inc(PDWORD(P1));
Dec(PDWORD(P2));
end;
end;
end;
 
UpdateProgress(y * 2);
end;
finally
EndProgress;
end;
end;
end;
 
procedure TDIB.Blur(ABitCount: Integer; Radius: Integer);
type
TAve = record
2270,7 → 3140,8
R, G, B: Byte;
begin
case Temp.BitCount of
1 : begin
1:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2285,7 → 3156,8
Inc(AveP);
end;
end;
4 : begin
4:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2300,7 → 3172,8
Inc(AveP);
end;
end;
8 : begin
8:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2316,7 → 3189,8
Inc(AveP);
end;
end;
16: begin
16:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2333,7 → 3207,8
Inc(AveP);
end;
end;
24: begin
24:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2349,7 → 3224,8
Inc(AveP);
end;
end;
32: begin
32:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2377,7 → 3253,8
R, G, B: Byte;
begin
case Temp.BitCount of
1 : begin
1:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2392,7 → 3269,8
Inc(AveP);
end;
end;
4 : begin
4:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2407,7 → 3285,8
Inc(AveP);
end;
end;
8 : begin
8:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2423,7 → 3302,8
Inc(AveP);
end;
end;
16: begin
16:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2440,7 → 3320,8
Inc(AveP);
end;
end;
24: begin
24:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2456,7 → 3337,8
Inc(AveP);
end;
end;
32: begin
32:
begin
SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine);
AveP := @Ave;
for x:=0 to XCount-1 do
2579,27 → 3461,32
 
{ The average is written. }
case BitCount of
1 : begin
1:
begin
P := @PArrayByte(DestP)[X shr 3];
with Ave do
P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR+cG+cB) div c) div 3>127)) shl Shift1[X and 7]);
end;
4 : begin
4:
begin
P := @PArrayByte(DestP)[X shr 1];
with Ave do
P^ := (P^ and Mask4n[X and 1]) or (((((cR+cG+cB) div c) div 3) shr 4) shl Shift4[X and 1]);
end;
8 : begin
8:
begin
with Ave do
PByte(DestP)^ := ((cR+cG+cB) div c) div 3;
Inc(PByte(DestP));
end;
16: begin
16:
begin
with Ave do
PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c);
Inc(PWORD(DestP));
end;
24: begin
24:
begin
with PBGR(DestP)^, Ave do
begin
R := cR div c;
2608,7 → 3495,8
end;
Inc(PBGR(DestP));
end;
32: begin
32:
begin
with Ave do
PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c);
Inc(PDWORD(DestP));
2658,6 → 3546,64
end;
end;
 
procedure TDIB.Negative;
var
i, i2: Integer;
P: Pointer;
begin
if Empty then exit;
 
if BitCount <= 8 then
begin
for i := 0 to 255 do
with ColorTable[i] do
begin
rgbRed := 255 - rgbRed;
rgbGreen := 255 - rgbGreen;
rgbBlue := 255 - rgbBlue;
end;
UpdatePalette;
end else
begin
P := PBits;
i2 := Size;
asm
mov ecx,i2
mov eax,P
mov edx,ecx
 
{ Unit of DWORD. }
@@qword_skip:
shr ecx,2
jz @@dword_skip
 
dec ecx
@@dword_loop:
not dword ptr [eax+ecx*4]
dec ecx
jnl @@dword_loop
 
mov ecx,edx
shr ecx,2
add eax,ecx*4
 
{ Unit of Byte. }
@@dword_skip:
mov ecx,edx
and ecx,3
jz @@byte_skip
 
dec ecx
@@loop_byte:
not byte ptr [eax+ecx]
dec ecx
jnl @@loop_byte
 
@@byte_skip:
end;
end;
end;
 
procedure TDIB.Greyscale(ABitCount: Integer);
var
YTblR, YTblG, YTblB: array[0..255] of Byte;
2668,7 → 3614,7
DestP, SrcP: Pointer;
P: PByte;
begin
if Empty then exit;
if Empty then Exit;
 
Temp := TDIB.Create;
try
2706,30 → 3652,36
for x:=0 to Width-1 do
begin
case Temp.BitCount of
1 : begin
1:
begin
with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue];
end;
4 : begin
4:
begin
with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue];
end;
8 : begin
8:
begin
with Temp.ColorTable[PByte(SrcP)^] do
c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue];
Inc(PByte(SrcP));
end;
16: begin
16:
begin
pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
c := YTblR[R]+YTblR[G]+YTblR[B];
Inc(PWord(SrcP));
end;
24: begin
24:
begin
with PBGR(SrcP)^ do
c := YTblR[R]+YTblG[G]+YTblB[B];
Inc(PBGR(SrcP));
end;
32: begin
32:
begin
pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
c := YTblR[R]+YTblR[G]+YTblR[B];
Inc(PDWORD(SrcP));
2737,23 → 3689,28
end;
 
case BitCount of
1 : begin
1:
begin
P := @PArrayByte(DestP)[X shr 3];
P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c>127)) shl Shift1[X and 7]);
end;
4 : begin
4:
begin
P := @PArrayByte(DestP)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]);
end;
8 : begin
8:
begin
PByte(DestP)^ := c;
Inc(PByte(DestP));
end;
16: begin
16:
begin
PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c);
Inc(PWord(DestP));
end;
24: begin
24:
begin
with PBGR(DestP)^ do
begin
R := c;
2762,7 → 3719,8
end;
Inc(PBGR(DestP));
end;
32: begin
32:
begin
PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c);
Inc(PDWORD(DestP));
end;
2779,253 → 3737,1574
end;
end;
 
procedure TDIB.Mirror(MirrorX, MirrorY: Boolean);
var
x, y, Width2, c: Integer;
P1, P2, TempBuf: Pointer;
//--------------------------------------------------------------------------------------------------
// Version : 0.1 - 26/06/2000 //
// Version : 0.2 - 04/07/2000 //
// At someone's request, i have added 3 news effects : //
// 1 - Rotate //
// 2 - SplitBlur //
// 3 - GaussianBlur //
//--------------------------------------------------------------------------------------------------
// - NEW SPECIAL EFFECT - (English) //
//--------------------------------------------------------------------------------------------------
// At the start, my idea was to create a component derived from TCustomDXDraw. Unfortunately, //
// it's impossible to run a graphic component (derived from TCustomDXDraw) in a conception's //
// mode (i don't success, but perhaps, somebody know how doing ! In that case, please help me !!!)//
// Then, i'm used the DIB's unit for my work, but this unit is poor in special effect. Knowing a //
// library with more effect, i'm undertaked to import this library in DIB's unit. You can see the //
// FastLib library at : //
// //
// -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody //
// //
// It was very difficult, because implementation's graphic was very different that DIB's unit. //
// Sometimes, i'm deserted the possibility of original effect, particularly in conversion of DIB //
// whith 256, 16 and 2 colors. If someone can implement this fonctionnality, thanks to tell me //
// how this miracle is possible !!! //
// All these procedures are translated and adapted by : //
// //
// -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org //
// //
// IMPORTANT : These procedures don't modify the DIB's unit structure //
// Nota Bene : I don't implement these type of graphics (32 and 16 bit per pixels), //
// for one reason : I haven't bitmaps of this type !!! //
//--------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------
// - NOUVEAUX EFFETS SPECIAUX - (Français) //
//--------------------------------------------------------------------------------------------------
// Au commencement, mon idée était de dériver un composant de TCustomDXDraw. Malheureusement, //
// c'est impossible de faire fonctionner un composant graphique (derivé de TCustomDXDraw) en mode //
// conception (je n'y suis pas parvenu, mais peut-être, que quelqu'un sait comment faire ! Dans //
// ce cas, vous seriez aimable de m'aider !!!) //
// Alors, j'ai utilisé l'unité DIB pour mon travail,mais celle-ci est pauvre en effet spéciaux. //
// Connaissant une librairie avec beaucoup plus d'effets spéciaux, j'ai entrepris d'importer //
// cette librairie dans l'unité DIB. Vous pouvez voir la librairie FastLib à : //
// //
// -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody //
// //
// C'était très difficile car l'implémentation graphique est très différente de l'unité DIB. //
// Parfois, j'ai abandonné les possibilités de l'effet original, particulièrement dans la //
// conversion des DIB avec 256, 16 et 2 couleurs. Si quelqu'un arrive à implémenter ces //
// fonctionnalités, merci de me dire comment ce miracle est possible !!! //
// Toutes ces procédures ont été traduites et adaptées par: //
// //
// -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org //
// //
// IMPORTANT : Ces procédures ne modifient pas la structure de l'unité DIB //
// Nota Bene : Je n'ai pas implémenté ces types de graphiques (32 et 16 bit par pixels), //
// pour une raison : je n'ai pas de bitmap de ce type !!! //
//--------------------------------------------------------------------------------------------------
 
function TDIB.IntToColor(i: Integer): TBGR;
begin
if Empty then exit;
if (not MirrorX) and (not MirrorY) then Exit;
Result.b := i shr 16;
Result.g := i shr 8;
Result.r := i;
end;
 
if (not MirrorX) and (MirrorY) then
function TDIB.Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer;
begin
GetMem(TempBuf, WidthBytes);
try
StartProgress('Mirror');
try
for y:=0 to Height shr 1-1 do
if iMark then
begin
P1 := ScanLine[y];
P2 := ScanLine[Height-y-1];
if iValue < iMin then
Result := iMin
else
if iValue > iMax then
Result := iMax
else
Result := iValue;
end
else
begin
if iValue < iMin then
Result := iMin
else
if iValue > iMax then
Result := iMin
else
Result := iValue;
end;
end;
 
Move(P1^, TempBuf^, WidthBytes);
Move(P2^, P1^, WidthBytes);
Move(TempBuf^, P2^, WidthBytes);
procedure TDIB.Contrast(Amount: Integer);
var
x, y: Integer;
Table1: array[0..255] of Byte;
i: Byte;
S, D: pointer;
Temp1: TDIB;
color: DWORD;
P: PByte;
R, G, B: Byte;
begin
D := nil;
S := nil;
Temp1 := nil;
for i := 0 to 126 do
begin
y := (Abs(128 - i) * Amount) div 256;
Table1[i] := IntToByte(i - y);
end;
for i := 127 to 255 do
begin
y := (Abs(128 - i) * Amount) div 256;
Table1[i] := IntToByte(i + y);
end;
case BitCount of
32: Exit; // I haven't bitmap of this type ! Sorry
24: ; // nothing to do
16: ; // I have an artificial bitmap for this type ! i don't sure that it works
8, 4:
begin
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, BitCount);
for i := 0 to 255 do
begin
with ColorTable[i] do
begin
rgbRed := IntToByte(Table1[rgbRed]);
rgbGreen := IntToByte(Table1[rgbGreen]);
rgbBlue := IntToByte(Table1[rgbBlue]);
end;
end;
UpdatePalette;
end;
else
// if the number of pixel is equal to 1 then exit of procedure
Exit;
end;
for y := 0 to Pred(Height) do
begin
case BitCount of
24, 16: D := ScanLine[y];
8, 4:
begin
D := Temp1.ScanLine[y];
S := Temp1.ScanLine[y];
end;
else
end;
for x := 0 to Pred(Width) do
begin
case BitCount of
32: ;
24:
begin
PBGR(D)^.B := Table1[PBGR(D)^.B];
PBGR(D)^.G := Table1[PBGR(D)^.G];
PBGR(D)^.R := Table1[PBGR(D)^.R];
Inc(PBGR(D));
end;
16:
begin
pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
PWord(D)^ := Table1[R] + Table1[G] + Table1[B];
Inc(PWord(D));
end;
8:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
PByte(D)^ := color;
Inc(PByte(D));
end;
4:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
P := @PArrayByte(D)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
end;
else
end;
end;
end;
case BitCount of
8, 4: Temp1.Free;
else
end;
end;
 
UpdateProgress(y*2);
procedure TDIB.Saturation(Amount: Integer);
var
Grays: array[0..767] of Integer;
Alpha: array[0..255] of Word;
Gray, x, y: Integer;
i: Byte;
S, D: pointer;
Temp1: TDIB;
color: DWORD;
P: PByte;
R, G, B: Byte;
begin
D := nil;
S := nil;
Temp1 := nil;
for i := 0 to 255 do
Alpha[i] := (i * Amount) shr 8;
x := 0;
for i := 0 to 255 do
begin
Gray := i - Alpha[i];
Grays[x] := Gray;
Inc(x);
Grays[x] := Gray;
Inc(x);
Grays[x] := Gray;
Inc(x);
end;
finally
EndProgress;
case BitCount of
32: Exit; // I haven't bitmap of this type ! Sorry
24: ; // nothing to do
16: ; // I have an artificial bitmap for this type ! i don't sure that it works
8, 4:
begin
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, BitCount);
for i := 0 to 255 do
begin
with ColorTable[i] do
begin
Gray := Grays[rgbRed + rgbGreen + rgbBlue];
rgbRed := IntToByte(Gray + Alpha[rgbRed]);
rgbGreen := IntToByte(Gray + Alpha[rgbGreen]);
rgbBlue := IntToByte(Gray + Alpha[rgbBlue]);
end;
finally
FreeMem(TempBuf, WidthBytes);
end;
end else if (MirrorX) and (not MirrorY) then
UpdatePalette;
end;
else
// if the number of pixel is equal to 1 then exit of procedure
Exit;
end;
for y := 0 to Pred(Height) do
begin
Width2 := Width shr 1;
case BitCount of
24, 16: D := ScanLine[y];
8, 4:
begin
D := Temp1.ScanLine[y];
S := Temp1.ScanLine[y];
end;
else
end;
for x := 0 to Pred(Width) do
begin
case BitCount of
32: ;
24:
begin
Gray := Grays[PBGR(D)^.R + PBGR(D)^.G + PBGR(D)^.B];
PBGR(D)^.B := IntToByte(Gray + Alpha[PBGR(D)^.B]);
PBGR(D)^.G := IntToByte(Gray + Alpha[PBGR(D)^.G]);
PBGR(D)^.R := IntToByte(Gray + Alpha[PBGR(D)^.R]);
Inc(PBGR(D));
end;
16:
begin
pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
PWord(D)^ := IntToByte(Gray + Alpha[B]) + IntToByte(Gray + Alpha[G]) +
IntToByte(Gray + Alpha[R]);
Inc(PWord(D));
end;
8:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
PByte(D)^ := color;
Inc(PByte(D));
end;
4:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
P := @PArrayByte(D)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
end;
else
end;
end;
end;
case BitCount of
8, 4: Temp1.Free;
else
end;
end;
 
StartProgress('Mirror');
try
for y:=0 to Height-1 do
procedure TDIB.Lightness(Amount: Integer);
var
x, y: Integer;
Table1: array[0..255] of Byte;
i: Byte;
S, D: pointer;
Temp1: TDIB;
color: DWORD;
P: PByte;
R, G, B: Byte;
begin
P1 := ScanLine[y];
 
D := nil;
S := nil;
Temp1 := nil;
if Amount < 0 then
begin
Amount := -Amount;
for i := 0 to 255 do
Table1[i] := IntToByte(i - ((Amount * i) shr 8));
end
else
for i := 0 to 255 do
Table1[i] := IntToByte(i + ((Amount * (i xor 255)) shr 8));
case BitCount of
1 : begin
for x:=0 to Width2-1 do
32: Exit; // I haven't bitmap of this type ! Sorry
24: ; // nothing to do
16: ; // I have an artificial bitmap for this type ! i don't sure that it works
8, 4:
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width-x-1, y];
Pixels[Width-x-1, y] := c;
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, BitCount);
for i := 0 to 255 do
begin
with ColorTable[i] do
begin
rgbRed := IntToByte(Table1[rgbRed]);
rgbGreen := IntToByte(Table1[rgbGreen]);
rgbBlue := IntToByte(Table1[rgbBlue]);
end;
end;
4 : begin
for x:=0 to Width2-1 do
UpdatePalette;
end;
else
// if the number of pixel is equal to 1 then exit of procedure
Exit;
end;
for y := 0 to Pred(Height) do
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width-x-1, y];
Pixels[Width-x-1, y] := c;
case BitCount of
24, 16: D := ScanLine[y];
8, 4:
begin
D := Temp1.ScanLine[y];
S := Temp1.ScanLine[y];
end;
else
end;
8 : begin
P2 := Pointer(Integer(P1)+Width-1);
for x:=0 to Width2-1 do
for x := 0 to Pred(Width) do
begin
PByte(@c)^ := PByte(P1)^;
PByte(P1)^ := PByte(P2)^;
PByte(P2)^ := PByte(@c)^;
Inc(PByte(P1));
Dec(PByte(P2));
case BitCount of
32: ;
24:
begin
PBGR(D)^.B := Table1[PBGR(D)^.B];
PBGR(D)^.G := Table1[PBGR(D)^.G];
PBGR(D)^.R := Table1[PBGR(D)^.R];
Inc(PBGR(D));
end;
16:
begin
pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
PWord(D)^ := Table1[R] + Table1[G] + Table1[B];
Inc(PWord(D));
end;
16: begin
P2 := Pointer(Integer(P1)+(Width-1)*2);
for x:=0 to Width2-1 do
8:
begin
PWord(@c)^ := PWord(P1)^;
PWord(P1)^ := PWord(P2)^;
PWord(P2)^ := PWord(@c)^;
Inc(PWord(P1));
Dec(PWord(P2));
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
PByte(D)^ := color;
Inc(PByte(D));
end;
4:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
P := @PArrayByte(D)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
end;
24: begin
P2 := Pointer(Integer(P1)+(Width-1)*3);
for x:=0 to Width2-1 do
else
end;
end;
end;
case BitCount of
8, 4: Temp1.Free;
else
end;
end;
 
procedure TDIB.AddRGB(aR, aG, aB: Byte);
var
Table: array[0..255] of TBGR;
x, y: Integer;
i: Byte;
D: pointer;
P: PByte;
color: DWORD;
Temp1: TDIB;
R, G, B: Byte;
begin
PBGR(@c)^ := PBGR(P1)^;
PBGR(P1)^ := PBGR(P2)^;
PBGR(P2)^ := PBGR(@c)^;
Inc(PBGR(P1));
Dec(PBGR(P2));
color := 0;
D := nil;
Temp1 := nil;
case BitCount of
32: Exit; // I haven't bitmap of this type ! Sorry
24, 16:
begin
for i := 0 to 255 do
begin
Table[i].b := IntToByte(i + aB);
Table[i].g := IntToByte(i + aG);
Table[i].r := IntToByte(i + aR);
end;
end;
32: begin
P2 := Pointer(Integer(P1)+(Width-1)*4);
for x:=0 to Width2-1 do
8, 4:
begin
PDWORD(@c)^ := PDWORD(P1)^;
PDWORD(P1)^ := PDWORD(P2)^;
PDWORD(P2)^ := PDWORD(@c)^;
Inc(PDWORD(P1));
Dec(PDWORD(P2));
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, BitCount);
for i := 0 to 255 do
begin
with ColorTable[i] do
begin
rgbRed := IntToByte(rgbRed + aR);
rgbGreen := IntToByte(rgbGreen + aG);
rgbBlue := IntToByte(rgbBlue + aB);
end;
end;
UpdatePalette;
end;
else
// if the number of pixel is equal to 1 then exit of procedure
Exit;
end;
for y := 0 to Pred(Height) do
begin
case BitCount of
24, 16: D := ScanLine[y];
8, 4:
begin
D := Temp1.ScanLine[y];
end;
else
end;
for x := 0 to Pred(Width) do
begin
case BitCount of
32: ; // I haven't bitmap of this type ! Sorry
24:
begin
PBGR(D)^.B := Table[PBGR(D)^.B].b;
PBGR(D)^.G := Table[PBGR(D)^.G].g;
PBGR(D)^.R := Table[PBGR(D)^.R].r;
Inc(PBGR(D));
end;
16:
begin
pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
PWord(D)^ := Table[R].r + Table[G].g + Table[B].b;
Inc(PWord(D));
end;
8:
begin
Inc(PByte(D));
end;
4:
begin
P := @PArrayByte(D)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
end;
else
end;
end;
end;
case BitCount of
8, 4: Temp1.Free;
else
end;
end;
 
UpdateProgress(y);
function TDIB.Filter(Dest: TDIB; Filter: TFilter): Boolean;
var
Sum, r, g, b, x, y: Integer;
a, i, j: byte;
tmp: TBGR;
Col: PBGR;
D: Pointer;
begin
Result := True;
Sum := Filter[0, 0] + Filter[1, 0] + Filter[2, 0] +
Filter[0, 1] + Filter[1, 1] + Filter[2, 1] +
Filter[0, 2] + Filter[1, 2] + Filter[2, 2];
if Sum = 0 then
Sum := 1;
Col := PBits;
for y := 0 to Pred(Height) do
begin
D := Dest.ScanLine[y];
for x := 0 to Pred(Width) do
begin
r := 0; g := 0; b := 0;
case BitCount of
32, 16, 4, 1:
begin
Result := False;
Exit;
end;
finally
EndProgress;
24:
begin
for i := 0 to 2 do
begin
for j := 0 to 2 do
begin
Tmp := IntToColor(Pixels[Interval(0, Pred(Width), x + Pred(i), True),
Interval(0, Pred(Height), y + Pred(j), True)]);
Inc(b, Filter[i, j] * Tmp.b);
Inc(g, Filter[i, j] * Tmp.g);
Inc(r, Filter[i, j] * Tmp.r);
end;
end else if (MirrorX) and (MirrorY) then
end;
Col.b := IntToByte(b div Sum);
Col.g := IntToByte(g div Sum);
Col.r := IntToByte(r div Sum);
Dest.Pixels[x, y] := rgb(Col.r, Col.g, Col.b);
end;
8:
begin
StartProgress('Mirror');
try
for y:=0 to Height shr 1-1 do
for i := 0 to 2 do
begin
P1 := ScanLine[y];
P2 := ScanLine[Height-y-1];
for j := 0 to 2 do
begin
a := (Pixels[Interval(0, Pred(Width), x + Pred(i), True),
Interval(0, Pred(Height), y + Pred(j), True)]);
tmp.r := ColorTable[a].rgbRed;
tmp.g := ColorTable[a].rgbGreen;
tmp.b := ColorTable[a].rgbBlue;
Inc(b, Filter[i, j] * Tmp.b);
Inc(g, Filter[i, j] * Tmp.g);
Inc(r, Filter[i, j] * Tmp.r);
end;
end;
Col.b := IntToByte(b div Sum);
Col.g := IntToByte(g div Sum);
Col.r := IntToByte(r div Sum);
PByte(D)^ := rgb(Col.r, Col.g, Col.b);
Inc(PByte(D));
end;
end;
end;
end;
end;
 
procedure TDIB.Spray(Amount: Integer);
var
value, x, y: Integer;
D: Pointer;
color: DWORD;
P: PByte;
begin
for y := Pred(Height) downto 0 do
begin
D := ScanLine[y];
for x := 0 to Pred(Width) do
begin
value := Random(Amount);
color := Pixels[Interval(0, Pred(Width), x + (value - Random(value * 2)), True),
Interval(0, Pred(Height), y + (value - Random(value * 2)), True)];
case BitCount of
1 : begin
for x:=0 to Width-1 do
32:
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width-x-1, Height-y-1];
Pixels[Width-x-1, Height-y-1] := c;
PDWord(D)^ := color;
Inc(PDWord(D));
end;
24:
begin
PBGR(D)^ := IntToColor(color);
Inc(PBGR(D));
end;
4 : begin
for x:=0 to Width-1 do
16:
begin
c := Pixels[x, y];
Pixels[x, y] := Pixels[Width-x-1, Height-y-1];
Pixels[Width-x-1, Height-y-1] := c;
PWord(D)^ := color;
Inc(PWord(D));
end;
8:
begin
PByte(D)^ := color;
Inc(PByte(D));
end;
8 : begin
P2 := Pointer(Integer(P2)+Width-1);
for x:=0 to Width-1 do
4:
begin
PByte(@c)^ := PByte(P1)^;
PByte(P1)^ := PByte(P2)^;
PByte(P2)^ := PByte(@c)^;
Inc(PByte(P1));
Dec(PByte(P2));
P := @PArrayByte(D)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
end;
1:
begin
P := @PArrayByte(D)[X shr 3];
P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
end;
16: begin
P2 := Pointer(Integer(P2)+(Width-1)*2);
for x:=0 to Width-1 do
else
end;
end;
end;
end;
 
procedure TDIB.Sharpen(Amount: Integer);
var
Lin0, Lin1, Lin2: PLines;
pc: PBGR;
cx, x, y: Integer;
Buf: array[0..8] of TBGR;
D: pointer;
c: DWORD;
i: byte;
P1: PByte;
Temp1: TDIB;
 
begin
PWord(@c)^ := PWord(P1)^;
PWord(P1)^ := PWord(P2)^;
PWord(P2)^ := PWord(@c)^;
Inc(PWord(P1));
Dec(PWord(P2));
D := nil;
GetMem(pc, SizeOf(TBGR));
c := 0;
Temp1 := nil;
case Bitcount of
32, 16, 1: Exit;
24:
begin
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, bitCount);
end;
8:
begin
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, bitCount);
for i := 0 to 255 do
begin
with Temp1.ColorTable[i] do
begin
Buf[0].B := ColorTable[i - Amount].rgbBlue;
Buf[0].G := ColorTable[i - Amount].rgbGreen;
Buf[0].R := ColorTable[i - Amount].rgbRed;
Buf[1].B := ColorTable[i].rgbBlue;
Buf[1].G := ColorTable[i].rgbGreen;
Buf[1].R := ColorTable[i].rgbRed;
Buf[2].B := ColorTable[i + Amount].rgbBlue;
Buf[2].G := ColorTable[i + Amount].rgbGreen;
Buf[2].R := ColorTable[i + Amount].rgbRed;
Buf[3].B := ColorTable[i - Amount].rgbBlue;
Buf[3].G := ColorTable[i - Amount].rgbGreen;
Buf[3].R := ColorTable[i - Amount].rgbRed;
Buf[4].B := ColorTable[i].rgbBlue;
Buf[4].G := ColorTable[i].rgbGreen;
Buf[4].R := ColorTable[i].rgbRed;
Buf[5].B := ColorTable[i + Amount].rgbBlue;
Buf[5].G := ColorTable[i + Amount].rgbGreen;
Buf[5].R := ColorTable[i + Amount].rgbRed;
Buf[6].B := ColorTable[i - Amount].rgbBlue;
Buf[6].G := ColorTable[i - Amount].rgbGreen;
Buf[6].R := ColorTable[i - Amount].rgbRed;
Buf[7].B := ColorTable[i].rgbBlue;
Buf[7].G := ColorTable[i].rgbGreen;
Buf[7].R := ColorTable[i].rgbRed;
Buf[8].B := ColorTable[i + Amount].rgbBlue;
Buf[8].G := ColorTable[i + Amount].rgbGreen;
Buf[8].R := ColorTable[i + Amount].rgbRed;
Temp1.colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
Temp1.colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
Temp1.colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
 
end;
24: begin
P2 := Pointer(Integer(P2)+(Width-1)*3);
for x:=0 to Width-1 do
end;
Temp1.UpdatePalette;
end;
4:
begin
PBGR(@c)^ := PBGR(P1)^;
PBGR(P1)^ := PBGR(P2)^;
PBGR(P2)^ := PBGR(@c)^;
Inc(PBGR(P1));
Dec(PBGR(P2));
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, bitCount);
for i := 0 to 255 do
begin
with Temp1.ColorTable[i] do
begin
Buf[0].B := ColorTable[i - Amount].rgbBlue;
Buf[0].G := ColorTable[i - Amount].rgbGreen;
Buf[0].R := ColorTable[i - Amount].rgbRed;
Buf[1].B := ColorTable[i].rgbBlue;
Buf[1].G := ColorTable[i].rgbGreen;
Buf[1].R := ColorTable[i].rgbRed;
Buf[2].B := ColorTable[i + Amount].rgbBlue;
Buf[2].G := ColorTable[i + Amount].rgbGreen;
Buf[2].R := ColorTable[i + Amount].rgbRed;
Buf[3].B := ColorTable[i - Amount].rgbBlue;
Buf[3].G := ColorTable[i - Amount].rgbGreen;
Buf[3].R := ColorTable[i - Amount].rgbRed;
Buf[4].B := ColorTable[i].rgbBlue;
Buf[4].G := ColorTable[i].rgbGreen;
Buf[4].R := ColorTable[i].rgbRed;
Buf[5].B := ColorTable[i + Amount].rgbBlue;
Buf[5].G := ColorTable[i + Amount].rgbGreen;
Buf[5].R := ColorTable[i + Amount].rgbRed;
Buf[6].B := ColorTable[i - Amount].rgbBlue;
Buf[6].G := ColorTable[i - Amount].rgbGreen;
Buf[6].R := ColorTable[i - Amount].rgbRed;
Buf[7].B := ColorTable[i].rgbBlue;
Buf[7].G := ColorTable[i].rgbGreen;
Buf[7].R := ColorTable[i].rgbRed;
Buf[8].B := ColorTable[i + Amount].rgbBlue;
Buf[8].G := ColorTable[i + Amount].rgbGreen;
Buf[8].R := ColorTable[i + Amount].rgbRed;
colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
end;
end;
32: begin
P2 := Pointer(Integer(P2)+(Width-1)*4);
for x:=0 to Width-1 do
UpdatePalette;
end;
end;
for y := 0 to Pred(Height) do
begin
PDWORD(@c)^ := PDWORD(P1)^;
PDWORD(P1)^ := PDWORD(P2)^;
PDWORD(P2)^ := PDWORD(@c)^;
Inc(PDWORD(P1));
Dec(PDWORD(P2));
Lin0 := ScanLine[Interval(0, Pred(Height), y - Amount, True)];
Lin1 := ScanLine[y];
Lin2 := ScanLine[Interval(0, Pred(Height), y + Amount, True)];
case Bitcount of
24, 8, 4: D := Temp1.ScanLine[y];
end;
for x := 0 to Pred(Width) do
begin
case BitCount of
24:
begin
cx := Interval(0, Pred(Width), x - Amount, True);
Buf[0] := Lin0[cx];
Buf[1] := Lin1[cx];
Buf[2] := Lin2[cx];
Buf[3] := Lin0[x];
Buf[4] := Lin1[x];
Buf[5] := Lin2[x];
cx := Interval(0, Pred(Width), x + Amount, true);
Buf[6] := Lin0[cx];
Buf[7] := Lin1[cx];
Buf[8] := Lin0[cx];
pc.b := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
pc.g := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
pc.r := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
PBGR(D)^.B := pc.b;
PBGR(D)^.G := pc.g;
PBGR(D)^.R := pc.r;
Inc(PBGR(D));
end;
8:
begin
Inc(PByte(D));
end;
4:
begin
P1 := @PArrayByte(D)[X shr 1];
P1^ := ((P1^ and Mask4n[X and 1]) or ((c shl Shift4[X and 1])));
end;
end;
end;
end;
case BitCount of
24, 8:
begin
Assign(Temp1);
Temp1.Free;
end;
4: Temp1.Free;
end;
FreeMem(pc, SizeOf(TBGR));
end;
 
UpdateProgress(y*2);
procedure TDIB.Emboss;
var
x, y: longint;
D, D1, P: pointer;
color: TBGR;
c: DWORD;
P1: PByte;
 
begin
D := nil;
D1 := nil;
P := nil;
case BitCount of
32, 16, 1: Exit;
24:
begin
D := PBits;
D1 := Ptr(Integer(D) + 3);
end;
finally
EndProgress;
else
end;
for y := 0 to Pred(Height) do
begin
case Bitcount of
8, 4:
begin
P := ScanLine[y];
end;
end;
for x := 0 to Pred(Width) do
begin
case BitCount of
24:
begin
PBGR(D)^.B := ((PBGR(D)^.B + (PBGR(D1)^.B xor $FF)) shr 1);
PBGR(D)^.G := ((PBGR(D)^.G + (PBGR(D1)^.G xor $FF)) shr 1);
PBGR(D)^.R := ((PBGR(D)^.R + (PBGR(D1)^.R xor $FF)) shr 1);
Inc(PBGR(D));
if (y < Height - 2) and (x < Width - 2) then
Inc(PBGR(D1));
end;
8:
begin
color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
c := (color.R + color.G + color.B) shr 1;
PByte(P)^ := c;
Inc(PByte(P));
end;
4:
begin
color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3;
color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) - 1) shr 1) + 30) div 3;
color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3;
c := (color.R + color.G + color.B) shr 1;
if c > 64 then
c := c - 8;
P1 := @PArrayByte(P)[X shr 1];
P1^ := (P1^ and Mask4n[X and 1]) or ((c) shl Shift4[X and 1]);
end;
else
end;
end;
case BitCount of
24:
begin
D := Ptr(Integer(D1));
if y < Height - 2 then
D1 := Ptr(Integer(D1) + 6)
else
D1 := Ptr(Integer(ScanLine[Pred(Height)]) + 3);
end;
else
end;
end;
end;
 
procedure TDIB.Negative;
procedure TDIB.AddMonoNoise(Amount: Integer);
var
i, i2: Integer;
P: Pointer;
value: cardinal;
x, y: longint;
a: byte;
D: pointer;
color: DWORD;
P: PByte;
begin
if Empty then exit;
for y := 0 to Pred(Height) do
begin
D := ScanLine[y];
for x := 0 to Pred(Width) do
begin
case BitCount of
32: Exit; // I haven't bitmap of this type ! Sorry
24:
begin
value := Random(Amount) - (Amount shr 1);
PBGR(D)^.B := IntToByte(PBGR(D)^.B + value);
PBGR(D)^.G := IntToByte(PBGR(D)^.G + value);
PBGR(D)^.R := IntToByte(PBGR(D)^.R + value);
Inc(PBGR(D));
end;
16: Exit; // I haven't bitmap of this type ! Sorry
8:
begin
a := ((Random(Amount shr 1) - (Amount div 4))) div 8;
color := Interval(0, 255, (pixels[x, y] - a), True);
PByte(D)^ := color;
Inc(PByte(D));
end;
4:
begin
a := ((Random(Amount shr 1) - (Amount div 4))) div 16;
color := Interval(0, 15, (pixels[x, y] - a), True);
P := @PArrayByte(D)[X shr 1];
P^ := ((P^ and Mask4n[X and 1]) or ((color shl Shift4[X and 1])));
end;
1:
begin
a := ((Random(Amount shr 1) - (Amount div 4))) div 32;
color := Interval(0, 1, (pixels[x, y] - a), True);
P := @PArrayByte(D)[X shr 3];
P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
end;
else
end;
end;
end;
end;
 
if BitCount<=8 then
procedure TDIB.AddGradiantNoise(Amount: byte);
var
a, i: byte;
x, y: Integer;
Table: array[0..255] of TBGR;
S, D: pointer;
color: DWORD;
Temp1: TDIB;
P: PByte;
 
begin
D := nil;
S := nil;
Temp1 := nil;
case BitCount of
32: Exit; // I haven't bitmap of this type ! Sorry
24:
begin
for i:=0 to 255 do
begin
a := Random(Amount);
Table[i].b := IntToByte(i + a);
Table[i].g := IntToByte(i + a);
Table[i].r := IntToByte(i + a);
end;
end;
16: Exit; // I haven't bitmap of this type ! Sorry
8, 4:
begin
Temp1 := TDIB.Create;
Temp1.Assign(self);
Temp1.SetSize(Width, Height, BitCount);
for i := 0 to 255 do
begin
with ColorTable[i] do
begin
rgbRed := 255-rgbRed;
rgbGreen := 255-rgbGreen;
rgbBlue := 255-rgbBlue;
a := Random(Amount);
rgbRed := IntToByte(rgbRed + a);
rgbGreen := IntToByte(rgbGreen + a);
rgbBlue := IntToByte(rgbBlue + a);
end;
end;
UpdatePalette;
end else
end;
else
// if the number of pixel is equal to 1 then exit of procedure
Exit;
end;
for y := 0 to Pred(Height) do
begin
P := PBits;
i2 := Size;
asm
mov ecx,i2
mov eax,P
mov edx,ecx
case BitCount of
24: D := ScanLine[y];
8, 4:
begin
D := Temp1.ScanLine[y];
S := Temp1.ScanLine[y];
end;
else
end;
for x := 0 to Pred(Width) do
begin
case BitCount of
32: ; // I haven't bitmap of this type ! Sorry
24:
begin
PBGR(D)^.B := Table[PBGR(D)^.B].b;
PBGR(D)^.G := Table[PBGR(D)^.G].g;
PBGR(D)^.R := Table[PBGR(D)^.R].r;
Inc(PBGR(D));
end;
16: ; // I haven't bitmap of this type ! Sorry
8:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
PByte(D)^ := color;
Inc(PByte(D));
end;
4:
begin
with Temp1.ColorTable[PByte(S)^] do
color := rgbRed + rgbGreen + rgbBlue;
Inc(PByte(S));
P := @PArrayByte(D)[X shr 1];
P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
end;
else
end;
end;
end;
case BitCount of
8, 4: Temp1.Free;
else
end;
end;
 
{ Unit of DWORD. }
@@qword_skip:
shr ecx,2
jz @@dword_skip
function TDIB.FishEye(bmp: TDIB): Boolean;
var
weight, xmid, ymid, fx, fy, r1, r2, dx, dy, rmax: Double;
Amount, ifx, ify, ty, tx, new_red, new_green, new_blue, ix, iy: Integer;
weight_x, weight_y: array[0..1] of Double;
total_red, total_green, total_blue: Double;
sli, slo: PLines;
D: Pointer;
begin
Result := True;
case BitCount of
32, 16, 8, 4, 1:
begin
Result := False;
Exit;
end;
end;
Amount := 1;
xmid := Width / 2;
ymid := Height / 2;
rmax := Max(Bmp.Width, Bmp.Height) * Amount;
for ty := 0 to Pred(Height) do
begin
for tx := 0 to Pred(Width) do
begin
dx := tx - xmid;
dy := ty - ymid;
r1 := Sqrt(Sqr(dx) + Sqr(dy));
if r1 <> 0 then
begin
r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
fx := dx * r2 / r1 + xmid;
fy := dy * r2 / r1 + ymid;
end
else
begin
fx := xmid;
fy := ymid;
end;
ify := Trunc(fy);
ifx := Trunc(fx);
if fy >= 0 then
begin
weight_y[1] := fy - ify;
weight_y[0] := 1 - weight_y[1];
end
else
begin
weight_y[0] := -(fy - ify);
weight_y[1] := 1 - weight_y[0];
end;
if fx >= 0 then
begin
weight_x[1] := fx - ifx;
weight_x[0] := 1 - weight_x[1];
end
else
begin
weight_x[0] := -(fx - ifx);
Weight_x[1] := 1 - weight_x[0];
end;
if ifx < 0 then
ifx := Pred(Width) - (-ifx mod Width)
else
if ifx > Pred(Width) then
ifx := ifx mod Width;
if ify < 0 then
ify := Pred(Height) - (-ify mod Height)
else
if ify > Pred(Height) then
ify := ify mod Height;
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do
begin
for iy := 0 to 1 do
begin
if ify + iy < Height then
sli := ScanLine[ify + iy]
else
sli := ScanLine[Height - ify - iy];
if ifx + ix < Width then
begin
new_red := sli^[ifx + ix].r;
new_green := sli^[ifx + ix].g;
new_blue := sli^[ifx + ix].b;
end
else
begin
new_red := sli^[Width - ifx - ix].r;
new_green := sli^[Width - ifx - ix].g;
new_blue := sli^[Width - ifx - ix].b;
end;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
case bitCount of
24:
begin
slo := Bmp.ScanLine[ty];
slo^[tx].r := Round(total_red);
slo^[tx].g := Round(total_green);
slo^[tx].b := Round(total_blue);
end;
else
// You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
Exit;
end;
end;
end;
end;
 
dec ecx
@@dword_loop:
not dword ptr [eax+ecx*4]
dec ecx
jnl @@dword_loop
function TDIB.SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
var
weight, Theta, cosTheta, sinTheta, sfrom_y, sfrom_x: Double;
ifrom_y, ifrom_x, xDiff, yDiff, to_y, to_x: Integer;
weight_x, weight_y: array[0..1] of Double;
ix, iy, new_red, new_green, new_blue: Integer;
total_red, total_green, total_blue: Double;
sli, slo: PLines;
begin
Result := True;
case BitCount of
32, 16, 8, 4, 1:
begin
Result := False;
Exit;
end;
end;
Theta := -Degree * Pi / 180;
sinTheta := Sin(Theta);
cosTheta := Cos(Theta);
xDiff := (Bmp.Width - Width) div 2;
yDiff := (Bmp.Height - Height) div 2;
for to_y := 0 to Pred(Bmp.Height) do
begin
for to_x := 0 to Pred(Bmp.Width) do
begin
sfrom_x := (cx + (to_x - cx) * cosTheta - (to_y - cy) * sinTheta) - xDiff;
ifrom_x := Trunc(sfrom_x);
sfrom_y := (cy + (to_x - cx) * sinTheta + (to_y - cy) * cosTheta) - yDiff;
ifrom_y := Trunc(sfrom_y);
if sfrom_y >= 0 then
begin
weight_y[1] := sfrom_y - ifrom_y;
weight_y[0] := 1 - weight_y[1];
end
else
begin
weight_y[0] := -(sfrom_y - ifrom_y);
weight_y[1] := 1 - weight_y[0];
end;
if sfrom_x >= 0 then
begin
weight_x[1] := sfrom_x - ifrom_x;
weight_x[0] := 1 - weight_x[1];
end
else
begin
weight_x[0] := -(sfrom_x - ifrom_x);
Weight_x[1] := 1 - weight_x[0];
end;
if ifrom_x < 0 then
ifrom_x := Pred(Width) - (-ifrom_x mod Width)
else
if ifrom_x > Pred(Width) then
ifrom_x := ifrom_x mod Width;
if ifrom_y < 0 then
ifrom_y := Pred(Height) - (-ifrom_y mod Height)
else
if ifrom_y > Pred(Height) then
ifrom_y := ifrom_y mod Height;
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do
begin
for iy := 0 to 1 do
begin
if ifrom_y + iy < Height then
sli := ScanLine[ifrom_y + iy]
else
sli := ScanLine[Height - ifrom_y - iy];
if ifrom_x + ix < Width then
begin
new_red := sli^[ifrom_x + ix].r;
new_green := sli^[ifrom_x + ix].g;
new_blue := sli^[ifrom_x + ix].b;
end
else
begin
new_red := sli^[Width - ifrom_x - ix].r;
new_green := sli^[Width - ifrom_x - ix].g;
new_blue := sli^[Width - ifrom_x - ix].b;
end;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
case bitCount of
24:
begin
slo := Bmp.ScanLine[to_y];
slo^[to_x].r := Round(total_red);
slo^[to_x].g := Round(total_green);
slo^[to_x].b := Round(total_blue);
end;
else
// You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
Exit;
end;
end;
end;
end;
 
mov ecx,edx
shr ecx,2
add eax,ecx*4
function TDIB.Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
var
x, y, dx, dy, sdx, sdy, xDiff, yDiff, isinTheta, icosTheta: Integer;
D, S: Pointer;
sinTheta, cosTheta, Theta: Double;
Col: TBGR;
i: byte;
color: DWORD;
P: PByte;
begin
D := nil;
S := nil;
Result := True;
dst.SetSize(Width, Height, Bitcount);
dst.Canvas.Brush.Color := clBlack;
Dst.Canvas.FillRect(Bounds(0, 0, Width, Height));
case BitCount of
32, 16:
begin
Result := False;
Exit;
end;
8, 4, 1:
begin
for i := 0 to 255 do
Dst.ColorTable[i] := ColorTable[i];
Dst.UpdatePalette;
end;
end;
Theta := -Angle * Pi / 180;
sinTheta := Sin(Theta);
cosTheta := Cos(Theta);
xDiff := (Dst.Width - Width) div 2;
yDiff := (Dst.Height - Height) div 2;
isinTheta := Round(sinTheta * $10000);
icosTheta := Round(cosTheta * $10000);
for y := 0 to Pred(Dst.Height) do
begin
case BitCount of
4, 1:
begin
D := Dst.ScanLine[y];
S := ScanLine[y];
end;
else
end;
sdx := Round(((cx + (-cx) * cosTheta - (y - cy) * sinTheta) - xDiff) * $10000);
sdy := Round(((cy + (-cy) * sinTheta + (y - cy) * cosTheta) - yDiff) * $10000);
for x := 0 to Pred(Dst.Width) do
begin
dx := (sdx shr 16);
dy := (sdy shr 16);
if (dx > -1) and (dx < Width) and (dy > -1) and (dy < Height) then
begin
case bitcount of
8, 24: Dst.pixels[x, y] := Pixels[dx, dy];
4:
begin
pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b);
color := col.r + col.g + col.b;
Inc(PByte(S));
P := @PArrayByte(D)[x shr 1];
P^ := (P^ and Mask4n[x and 1]) or (color shl Shift4[x and 1]);
end;
1:
begin
pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b);
color := col.r + col.g + col.b;
Inc(PByte(S));
P := @PArrayByte(D)[X shr 3];
P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
end;
end;
end;
Inc(sdx, icosTheta);
Inc(sdy, isinTheta);
end;
end;
end;
 
{ Unit of Byte. }
@@dword_skip:
mov ecx,edx
and ecx,3
jz @@byte_skip
procedure TDIB.GaussianBlur(Bmp: TDIB; Amount: Integer);
var
i: Integer;
begin
for i := 1 to Amount do
Bmp.SplitBlur(i);
end;
 
dec ecx
@@loop_byte:
not byte ptr [eax+ecx]
dec ecx
jnl @@loop_byte
procedure TDIB.SplitBlur(Amount: Integer);
var
Lin1, Lin2: PLines;
cx, x, y: Integer;
Buf: array[0..3] of TBGR;
D: Pointer;
 
@@byte_skip:
begin
case Bitcount of
32, 16, 8, 4, 1: Exit;
end;
for y := 0 to Pred(Height) do
begin
Lin1 := ScanLine[TrimInt(y + Amount, 0, Pred(Height))];
Lin2 := ScanLine[TrimInt(y - Amount, 0, Pred(Height))];
D := ScanLine[y];
for x := 0 to Pred(Width) do
begin
cx := TrimInt(x + Amount, 0, Pred(Width));
Buf[0] := Lin1[cx];
Buf[1] := Lin2[cx];
cx := TrimInt(x - Amount, 0, Pred(Width));
Buf[2] := Lin1[cx];
Buf[3] := Lin2[cx];
PBGR(D)^.b := (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b) shr 2;
PBGR(D)^.g := (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g) shr 2;
PBGR(D)^.r := (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r) shr 2;
Inc(PBGR(D));
end;
end;
end;
 
function TDIB.Twist(bmp: TDIB; Amount: byte): Boolean;
var
fxmid, fymid: Single;
txmid, tymid: Single;
fx, fy: Single;
tx2, ty2: Single;
r: Single;
theta: Single;
ifx, ify: Integer;
dx, dy: Single;
OFFSET: Single;
ty, tx, ix, iy: Integer;
weight_x, weight_y: array[0..1] of Single;
weight: Single;
new_red, new_green, new_blue: Integer;
total_red, total_green, total_blue: Single;
sli, slo: PLines;
 
function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if xt = 0 then
if yt > 0 then
Result := Pi / 2
else
Result := -(Pi / 2)
else
begin
Result := ArcTan(yt / xt);
if xt < 0 then
Result := Pi + ArcTan(yt / xt);
end;
end;
 
begin
Result := True;
case BitCount of
32, 16, 8, 4, 1:
begin
Result := False;
Exit;
end;
end;
if Amount = 0 then
Amount := 1;
OFFSET := -(Pi / 2);
dx := Pred(Width);
dy := Pred(Height);
r := Sqrt(dx * dx + dy * dy);
tx2 := r;
ty2 := r;
txmid := (Pred(Width)) / 2;
tymid := (Pred(Height)) / 2;
fxmid := (Pred(Width)) / 2;
fymid := (Pred(Height)) / 2;
if tx2 >= Width then
tx2 := Pred(Width);
if ty2 >= Height then
ty2 := Pred(Height);
for ty := 0 to Round(ty2) do
begin
for tx := 0 to Round(tx2) do
begin
dx := tx - txmid;
dy := ty - tymid;
r := Sqrt(dx * dx + dy * dy);
if r = 0 then
begin
fx := 0;
fy := 0;
end
else
begin
theta := ArcTan2(dx, dy) - r / Amount - OFFSET;
fx := r * Cos(theta);
fy := r * Sin(theta);
end;
fx := fx + fxmid;
fy := fy + fymid;
ify := Trunc(fy);
ifx := Trunc(fx);
if fy >= 0 then
begin
weight_y[1] := fy - ify;
weight_y[0] := 1 - weight_y[1];
end
else
begin
weight_y[0] := -(fy - ify);
weight_y[1] := 1 - weight_y[0];
end;
if fx >= 0 then
begin
weight_x[1] := fx - ifx;
weight_x[0] := 1 - weight_x[1];
end
else
begin
weight_x[0] := -(fx - ifx);
Weight_x[1] := 1 - weight_x[0];
end;
if ifx < 0 then
ifx := Pred(Width) - (-ifx mod Width)
else
if ifx > Pred(Width) then
ifx := ifx mod Width;
if ify < 0 then
ify := Pred(Height) - (-ify mod Height)
else
if ify > Pred(Height) then
ify := ify mod Height;
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do
begin
for iy := 0 to 1 do
begin
if ify + iy < Height then
sli := ScanLine[ify + iy]
else
sli := ScanLine[Height - ify - iy];
if ifx + ix < Width then
begin
new_red := sli^[ifx + ix].r;
new_green := sli^[ifx + ix].g;
new_blue := sli^[ifx + ix].b;
end
else
begin
new_red := sli^[Width - ifx - ix].r;
new_green := sli^[Width - ifx - ix].g;
new_blue := sli^[Width - ifx - ix].b;
end;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
case bitCount of
24:
begin
slo := bmp.ScanLine[ty];
slo^[tx].r := Round(total_red);
slo^[tx].g := Round(total_green);
slo^[tx].b := Round(total_blue);
end;
else
// You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
Exit;
end;
end;
end;
end;
 
function TDIB.TrimInt(i, Min, Max: Integer): Integer;
begin
if i > Max then
Result := Max
else
if i < Min then
Result := Min
else
Result := i;
end;
 
function TDIB.IntToByte(i: Integer): Byte;
begin
if i > 255 then
Result := 255
else
if i < 0 then
Result := 0
else
Result := i;
end;
 
//--------------------------------------------------------------------------------------------------
// End of these New Special Effect //
// Please contributes to add effects and filters to this collection //
// Please, work to implement 32,16,8,4,2 BitCount's DIB //
// Have fun - Mickey - Good job //
//--------------------------------------------------------------------------------------------------
 
function TDIB.GetAlphaChannel: TDIB;
begin
RetAlphaChannel(Result);
 
FFreeList.Add(Result);
end;
 
procedure TDIB.SetAlphaChannel(const Value: TDIB);
begin
if not AssignAlphaChannel(Value{$IFNDEF VER4UP}, False{$ENDIF}) then
Exception.Create('Cannot set alphachannel from DIB.');
end;
 
procedure TDIB.Fill(aColor: TColor);
begin
Canvas.Brush.Color := aColor;
Canvas.FillRect(ClientRect);
end;
 
function TDIB.GetClientRect: TRect;
begin
Result := Bounds(0, 0, Width, Height);
end;
 
{ TCustomDXDIB }
 
constructor TCustomDXDIB.Create(AOnwer: TComponent);
3078,17 → 5357,20
begin
inherited Canvas.StretchDraw(Bounds(-(Width-ClientWidth) div 2,
-(Height-ClientHeight) div 2, Width, Height), FDIB);
end else
end
else
begin
inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB);
end;
end else
end
else
begin
if FCenter then
begin
inherited Canvas.Draw(-(Width-ClientWidth) div 2, -(Height-ClientHeight) div 2,
FDIB);
end else
end
else
begin
inherited Canvas.Draw(0, 0, FDIB);
end;
3128,11 → 5410,14
if r>r2 then
r := r2;
Draw2(Round(r*ClientWidth), Round(r*ClientHeight));
end else
end
else
Draw2(ViewWidth2, ViewHeight2);
end else
end
else
Draw2(ViewWidth2, ViewHeight2);
end else
end
else
begin
if FAutoStretch then
begin
3143,9 → 5428,11
if r>r2 then
r := r2;
Draw2(Round(r*FDIB.Width), Round(r*FDIB.Height));
end else
end
else
Draw2(FDIB.Width, FDIB.Height);
end else
end
else
if FStretch then
begin
if FKeepAspect then
3155,9 → 5442,11
if r>r2 then
r := r2;
Draw2(Round(r*FDIB.Width), Round(r*FDIB.Height));
end else
end
else
Draw2(ClientWidth, ClientHeight);
end else
end
else
Draw2(FDIB.Width, FDIB.Height);
end;
end;
3228,6 → 5517,4382
end;
end;
 
{ DXFusion -> }
 
function PosValue(Value: Integer): Integer;
begin
if Value < 0 then result := 0 else result := Value;
end;
 
procedure TDIB.CreateDIBFromBitmap(const Bitmap: TBitmap);
var
pf: Integer;
begin
if Bitmap.PixelFormat = pf32bit then pf := 32 else pf := 24;
SetSize(Bitmap.Width, Bitmap.Height, pf); {always >=24}
Canvas.Draw(0, 0, Bitmap);
end;
 
function TDIB.CreateBitmapFromDIB: TBitmap;
//var
// X, Y: Integer;
begin
Result := TBitmap.Create;
if BitCount = 32 then
Result.PixelFormat := pf32bit
else if BitCount = 24 then
Result.PixelFormat := pf24bit
else if BitCount = 16 then
Result.PixelFormat := pf16bit
else if BitCount = 8 then
Result.PixelFormat := pf8bit
else Result.PixelFormat := pf24bit;
Result.Width := Width;
Result.Height := Height;
Result.Canvas.Draw(0, 0, Self);
// for Y := 0 to Height - 1 do
// for X := 0 to Width - 1 do
// Result.Canvas.Pixels[X, Y] := Canvas.Pixels[X, Y];
end;
 
procedure TDIB.DrawTo(SrcDIB: TDIB; X, Y, Width, Height,
SourceX, SourceY: Integer);
begin
SrcDIB.DrawOn(Rect(X, Y, Width, Height), Self.Canvas, SourceX, SourceY);
end;
 
procedure TDIB.DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor);
var
i, j: Integer;
k1, k2: Integer;
n: Integer;
p1, p2: PByteArray;
 
Startk1, Startk2: Integer;
 
StartY: Integer;
EndY: Integer;
 
DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
Startk1 := 3 * SourceX;
Startk2 := 3 * X;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (StartY + DestStartY < 0) then
StartY := -DestStartY;
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (StartY < 0) then
StartY := 0;
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
for j := StartY to EndY - 1 do
begin
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
 
for i := SourceX to SourceX + Width - 1 do
begin
n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
 
if not (n = Color) then
begin
p1[k2] := p2[k1];
p1[k2 + 1] := p2[k1 + 1];
p1[k2 + 2] := p2[k1 + 2];
end;
 
k1 := k1 + 3;
k2 := k2 + 3;
end;
end;
end;
 
procedure TDIB.DrawShadow(SrcDIB: TDIB; X, Y, Width, Height,
Frame: Integer; FilterMode: TFilterMode);
var
i, j: Integer;
p1, p2: PByte;
FW: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
FW := Frame * Width;
for i := 1 to Height - 1 do
begin
p1 := Self.Scanline[i + Y];
p2 := SrcDIB.Scanline[i];
Inc(p1, 3 * (X + 1));
Inc(p2, 3 * (FW + 1));
for j := 1 to Width - 1 do
begin
if (p2^ = 0) then
begin
case FilterMode of
fmNormal, fmMix50:
begin
p1^ := p1^ shr 1; // Blue
Inc(p1);
p1^ := p1^ shr 1; // Green
Inc(p1);
p1^ := p1^ shr 1; // Red
Inc(p1);
end;
fmMix25:
begin
p1^ := p1^ - p1^ shr 2; // Blue
Inc(p1);
p1^ := p1^ - p1^ shr 2; // Green
Inc(p1);
p1^ := p1^ - p1^ shr 2; // Red
Inc(p1);
end;
fmMix75:
begin
p1^ := p1^ shr 2; // Blue
Inc(p1);
p1^ := p1^ shr 2; // Green
Inc(p1);
p1^ := p1^ shr 2; // Red
Inc(p1);
end;
end;
end
else
Inc(p1, 3); // Not in the loop...
Inc(p2, 3);
end;
end;
end;
 
procedure TDIB.DrawShadows(SrcDIB: TDIB; X, Y, Width, Height,
Frame: Integer; Alpha: Byte);
{plynule nastavovani stiny dle alpha}
type
P3ByteArray = ^T3ByteArray;
T3ByteArray = array[0..32767] of TBGR;
var
i, j, l1, l2: Integer;
p1, p2: P3ByteArray;
FW: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
FW := Frame * Width;
for i := 0 to Height - 1 do
begin
p1 := Self.Scanline[i + Y];
p2 := SrcDIB.Scanline[i];
l1 := X;
l2 := FW;
for j := 0 to Width - 1 do
begin
if (p2[j + l2].B = 0) and (p2[j + l2].G = 0) and (p2[j + l2].R = 0) then
begin
p1[J + l1].B := Round(p1[J + l1].B / $FF * Alpha);
p1[J + l1].G := Round(p1[J + l1].G / $FF * Alpha);
p1[J + l1].R := Round(p1[J + l1].R / $FF * Alpha);
end
end;
end;
end;
 
procedure TDIB.DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
Frame: Integer);
var
frameoffset, i, j: Integer;
p1, p2: pByte;
XOffset: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
frameoffset := 3 * (Frame * Width) + 3;
XOffset := 3 * X + 3;
for i := 1 to Height - 1 do
begin
p1 := Self.Scanline[i + Y];
p2 := SrcDIB.Scanline[i];
inc(p1, XOffset);
inc(p2, frameoffset);
for j := 1 to Width - 1 do
begin
p1^ := (p2^ * p1^) shr 8; // R
inc(p1);
inc(p2);
p1^ := (p2^ * p1^) shr 8; // G
inc(p1);
inc(p2);
p1^ := (p2^ * p1^) shr 8; // B
inc(p1);
inc(p2);
end;
end;
end;
 
procedure TDIB.DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor; FilterMode: TFilterMode);
var
i, j: Integer;
k1, k2: Integer;
n: Integer;
p1, p2: PByteArray;
BitSwitch1, BitSwitch2: Boolean;
 
Startk1, Startk2: Integer;
StartY: Integer;
EndY: Integer;
 
DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
Startk1 := 3 * SourceX;
Startk2 := 3 * X;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (StartY + DestStartY < 0) then
StartY := -DestStartY;
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (StartY < 0) then
StartY := 0;
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
if Odd(Y) then BitSwitch1 := true else BitSwitch1 := false;
if Odd(X) then BitSwitch2 := true else BitSwitch2 := false;
 
for j := StartY to EndY - 1 do
begin
BitSwitch1 := not BitSwitch1;
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
 
for i := SourceX to SourceX + Width - 1 do
begin
BitSwitch2 := not BitSwitch2;
 
n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
 
case FilterMode of
fmNormal, fmMix50: if not (n = Color) and (BitSwitch1 xor BitSwitch2) then
begin
p1[k2] := p2[k1];
p1[k2 + 1] := p2[k1 + 1];
p1[k2 + 2] := p2[k1 + 2];
end;
fmMix25: if not (n = Color) and (BitSwitch1 and BitSwitch2) then
begin
p1[k2] := p2[k1];
p1[k2 + 1] := p2[k1 + 1];
p1[k2 + 2] := p2[k1 + 2];
end;
fmMix75: if not (n = Color) and (BitSwitch1 or BitSwitch2) then
begin
p1[k2] := p2[k1];
p1[k2 + 1] := p2[k1 + 1];
p1[k2 + 2] := p2[k1 + 2];
end;
end;
 
k1 := k1 + 3;
k2 := k2 + 3;
end;
end;
end;
 
procedure TDIB.DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height, Alpha, Frame:
Integer);
var
frameoffset, i, j, Wid: Integer;
p1, p2: pByte;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
if (Alpha < 1) or (Alpha > 256) then Exit;
Wid := Width shl 1 + Width;
frameoffset := Wid * Frame;
for i := 1 to Height - 1 do
begin
if (i + Y) > (Self.Height - 1) then Break; //add 25.5.2004 JB.
p1 := Self.Scanline[i + Y];
p2 := SrcDIB.Scanline[i];
inc(p1, X shl 1 + X + 3);
inc(p2, frameoffset + 3);
for j := 3 to Wid - 4 do
begin
inc(p1^, (Alpha - p1^) * p2^ shr 8);
inc(p1);
inc(p2);
end;
end;
end;
 
procedure TDIB.DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor);
var
i, j: Integer;
k1, k2: Integer;
n: Integer;
p1, p2: PByteArray;
 
Startk1, Startk2: Integer;
StartY: Integer;
EndY: Integer;
 
DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
Startk1 := 3 * SourceX;
Startk2 := 3 * X;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (StartY + DestStartY < 0) then
StartY := -DestStartY;
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (StartY < 0) then
StartY := 0;
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
for j := StartY to EndY - 1 do
begin
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
 
for i := SourceX to SourceX + Width - 1 do
begin
n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
 
if not (n = Color) then
begin
p1[k2] := (p1[k2] + p2[k1]) shr 1;
p1[k2 + 1] := (p1[k2 + 1] + p2[k1 + 1]) shr 1;
p1[k2 + 2] := (p1[k2 + 2] + p2[k1 + 2]) shr 1;
end;
 
k1 := k1 + 3;
k2 := k2 + 3;
end;
end;
end;
 
procedure TDIB.DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY, Alpha: Integer; const Color: TColor);
var
i, j: Integer;
k1, k2: Integer;
n: Integer;
p1, p2: PByteArray;
 
Startk1, Startk2: Integer;
StartY: Integer;
EndY: Integer;
 
DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
Startk1 := 3 * SourceX;
Startk2 := 3 * x;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
if (StartY < 0) then
StartY := 0;
 
if (StartY + DestStartY < 0) then
StartY := DestStartY;
 
for j := StartY to EndY - 1 do
begin
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
 
for i := SourceX to SourceX + Width - 1 do
begin
n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
 
if not (n = Color) then
begin
p1[k2] := (p1[k2] * (256 - Alpha) + p2[k1] * Alpha) shr 8;
p1[k2 + 1] := (p1[k2 + 1] * (256 - Alpha) + p2[k1 + 1] * Alpha) shr 8;
p1[k2 + 2] := (p1[k2 + 2] * (256 - Alpha) + p2[k1 + 2] * Alpha) shr 8;
end;
 
k1 := k1 + 3;
k2 := k2 + 3;
end;
end;
end;
 
procedure TDIB.DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y,
Width, Height, SourceX, SourceY: Integer);
var
i, j: Integer;
k1, k2, k3: Integer;
p1, p2, p3: PByteArray;
 
Startk1, Startk2: Integer;
StartY: Integer;
EndY: Integer;
 
DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
Startk1 := 3 * SourceX;
Startk2 := 3 * x;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
if (StartY < 0) then
StartY := 0;
 
if (StartY + DestStartY < 0) then
StartY := DestStartY;
 
for j := StartY to EndY - 1 do
begin
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
p3 := MaskDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
k3 := 0;
 
for i := SourceX to SourceX + Width - 1 do
begin
p1[k2] := (p1[k2] * (256 - p3[k3]) + p2[k1] * p3[k3]) shr 8;
p1[k2 + 1] := (p1[k2 + 1] * (256 - p3[k3]) + p2[k1 + 1] * p3[k3]) shr 8;
p1[k2 + 2] := (p1[k2 + 2] * (256 - p3[k3]) + p2[k1 + 2] * p3[k3]) shr 8;
 
k1 := k1 + 3;
k2 := k2 + 3;
k3 := k3 + 3;
end;
end;
end;
 
procedure TDIB.DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const Color: TColor);
var
i, j, r, g, b: Integer;
k1, k2: Integer;
n: Integer;
p1, p2: PByteArray;
 
Startk1, Startk2: Integer;
StartY: Integer;
EndY: Integer;
 
DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
Startk1 := 3 * SourceX;
Startk2 := 3 * x;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
if (StartY < 0) then
StartY := 0;
 
if (StartY + DestStartY < 0) then
StartY := DestStartY;
 
r := 0;
g := 0;
b := 0;
 
for j := StartY to EndY - 1 do
begin
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
 
for i := SourceX to SourceX + Width - 1 do
begin
n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
 
if Random(100) < 50 then
begin
b := p1[k2];
g := p1[k2 + 1];
r := p1[k2 + 2];
end;
 
if not (n = Color) then
begin
p1[k2] := b;
p1[k2 + 1] := g;
p1[k2 + 2] := r;
end;
 
k1 := k1 + 3;
k2 := k2 + 3;
end;
end;
end;
 
procedure TDIB.DrawMono(SrcDIB: TDIB; const X, Y, Width, Height,
SourceX, SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
var
i, j, r1, g1, b1, r2, g2, b2: Integer;
k1, k2: Integer;
n: Integer;
p1, p2: PByteArray;
Startk1, Startk2, StartY, EndY, DestStartY: Integer;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
Startk1 := 3 * SourceX;
Startk2 := 3 * x;
 
DestStartY := Y - SourceY;
 
StartY := SourceY;
EndY := SourceY + Height;
 
if (EndY + DestStartY > Self.Height) then
EndY := Self.Height - DestStartY;
 
if (EndY > SrcDIB.Height) then
EndY := SrcDIB.Height;
 
if (StartY < 0) then
StartY := 0;
 
if (StartY + DestStartY < 0) then
StartY := DestStartY;
 
r1 := GetRValue(BackColor);
g1 := GetGValue(BackColor);
b1 := GetBValue(BackColor);
 
r2 := GetRValue(ForeColor);
g2 := GetGValue(ForeColor);
b2 := GetBValue(ForeColor);
 
 
for j := StartY to EndY - 1 do
begin
p1 := Self.Scanline[j + DestStartY];
p2 := SrcDIB.Scanline[j];
 
k1 := Startk1;
k2 := Startk2;
 
for i := SourceX to SourceX + Width - 1 do
begin
n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
 
if (n = TransColor) then
begin
p1[k2] := b1;
p1[k2 + 1] := g1;
p1[k2 + 2] := r1;
end
else
begin
p1[k2] := b2;
p1[k2 + 1] := g2;
p1[k2 + 2] := r2;
end;
 
k1 := k1 + 3;
k2 := k2 + 3;
end;
end;
end;
 
procedure TDIB.Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
var i, j, k: Integer;
p1, p2, p3, p4: PByteArray;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
for i := 1 to SrcDIB.Height - 2 do
begin
p1 := SrcDIB.ScanLine[i - 1];
p2 := SrcDIB.ScanLine[i];
p3 := SrcDIB.ScanLine[i + 1];
p4 := Self.ScanLine[i];
for j := 3 to 3 * SrcDIB.Width - 4 do
begin
k := (p1[j - 3] * Setting[0] + p1[j] * Setting[1] + p1[j + 3] * Setting[2] +
p2[j - 3] * Setting[3] + p2[j] * Setting[4] + p2[j + 3] * Setting[5] +
p3[j - 3] * Setting[6] + p3[j] * Setting[7] + p3[j + 3] * Setting[8])
div Setting[9];
if k < 0 then k := 0;
if k > 255 then k := 255;
p4[j] := k;
end;
end;
end;
 
procedure TDIB.DrawAntialias(SrcDIB: TDIB);
var i, j, k, l, m: Integer;
p1, p2, p3: PByteArray;
begin
if Self.BitCount <> 24 then Exit;
if SrcDIB.BitCount <> 24 then Exit;
 
for i := 1 to Self.Height - 1 do
begin
k := i shl 1;
p1 := SrcDIB.Scanline[k];
p2 := SrcDIB.Scanline[k + 1];
p3 := Self.Scanline[i];
for j := 1 to Self.Width - 1 do
begin
m := 3 * j;
l := m shl 1;
p3[m] := (p1[l] + p1[l + 3] + p2[l] + p2[l + 3]) shr 2;
p3[m + 1] := (p1[l + 1] + p1[l + 4] + p2[l + 1] + p2[l + 4]) shr 2;
p3[m + 2] := (p1[l + 2] + p1[l + 5] + p2[l + 2] + p2[l + 5]) shr 2;
end;
end;
end;
 
procedure TDIB.FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
FilterMode: TFilterMode);
var
i, j: Integer;
t: TColor;
r1, g1, b1, r2, g2, b2: Integer;
begin
j := ROUND(Sqrt(Sqr(ABS(X2 - X1)) + Sqr(ABS(Y2 - Y1))));
if j < 1 then Exit;
 
r1 := GetRValue(Color);
g1 := GetGValue(Color);
b1 := GetBValue(Color);
 
for i := 0 to j do
begin
t := Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)];
r2 := GetRValue(t);
g2 := GetGValue(t);
b2 := GetBValue(t);
case FilterMode of
fmNormal: t := RGB(r1 + (((256 - r1) * r2) shr 8),
g1 + (((256 - g1) * g2) shr 8),
b1 + (((256 - b1) * b2) shr 8));
fmMix25: t := RGB((r1 + r2 * 3) shr 2, (g1 + g2 * 3) shr 2, (b1 + b2 * 3) shr 2);
fmMix50: t := RGB((r1 + r2) shr 1, (g1 + g2) shr 1, (b1 + b2) shr 1);
fmMix75: t := RGB((r1 * 3 + r2) shr 2, (g1 * 3 + g2) shr 2, (b1 * 3 + b2) shr 2);
end;
Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)] := t;
end;
end;
 
procedure TDIB.FilterRect(X, Y, Width, Height: Integer;
Color: TColor; FilterMode: TFilterMode);
var
i, j, r, g, b, C1: Integer;
p1, p2, p3: pByte;
begin
if Self.BitCount <> 24 then Exit;
 
r := GetRValue(Color);
g := GetGValue(Color);
b := GetBValue(Color);
 
for i := 0 to Height - 1 do
begin
p1 := Self.Scanline[i + Y];
Inc(p1, (3 * X));
for j := 0 to Width - 1 do
begin
case FilterMode of
fmNormal:
begin
p2 := p1;
Inc(p2);
p3 := p2;
Inc(p3);
C1 := (p1^ + p2^ + p3^) div 3;
 
p1^ := (C1 * b) shr 8;
Inc(p1);
p1^ := (C1 * g) shr 8;
Inc(p1);
p1^ := (C1 * r) shr 8;
Inc(p1);
end;
fmMix25:
begin
p1^ := (3 * p1^ + b) shr 2;
Inc(p1);
p1^ := (3 * p1^ + g) shr 2;
Inc(p1);
p1^ := (3 * p1^ + r) shr 2;
Inc(p1);
end;
fmMix50:
begin
p1^ := (p1^ + b) shr 1;
Inc(p1);
p1^ := (p1^ + g) shr 1;
Inc(p1);
p1^ := (p1^ + r) shr 1;
Inc(p1);
end;
fmMix75:
begin
p1^ := (p1^ + 3 * b) shr 2;
Inc(p1);
p1^ := (p1^ + 3 * g) shr 2;
Inc(p1);
p1^ := (p1^ + 3 * r) shr 2;
Inc(p1);
end;
end;
end;
end;
end;
 
procedure TDIB.InitLight(Count, Detail: Integer);
var
i, j: Integer;
begin
LG_COUNT := Count;
LG_DETAIL := Detail;
 
for i := 0 to 255 do // Build Lightning LUT
for j := 0 to 255 do
FLUTDist[i, j] := ROUND(Sqrt(Sqr(i * 10) + Sqr(j * 10)));
end;
 
procedure TDIB.DrawLights(FLight: TLightArray;
AmbientLight: TColor);
var
i, j, l, m, n, o, q, D1, D2, R, G, B, AR, AG, AB: Integer;
P: array{$IFNDEF VER4UP} [0..4096]{$ENDIF} of PByteArray;
begin
if Self.BitCount <> 24 then Exit;
 
{$IFDEF VER4UP}
SetLength(P, LG_DETAIL);
{$ENDIF}
AR := GetRValue(AmbientLight);
AG := GetGValue(AmbientLight);
AB := GetBValue(AmbientLight);
 
for i := (Self.Height div (LG_DETAIL + 1)) downto 1 do
begin
for o := 0 to LG_DETAIL do
P[o] := Self.Scanline[(LG_DETAIL + 1) * i - o];
 
for j := (Self.Width div (LG_DETAIL + 1)) downto 1 do
begin
R := AR;
G := AG;
B := AB;
 
for l := LG_COUNT - 1 downto 0 do // Check the lightsources
begin
D1 := ABS(j * (LG_DETAIL + 1) - FLight[l].X) div FLight[l].Size1;
D2 := ABS(i * (LG_DETAIL + 1) - FLight[l].Y) div FLight[l].Size2;
if D1 > 255 then D1 := 255;
if D2 > 255 then D2 := 255;
 
m := 255 - FLUTDist[D1, D2];
if m < 0 then m := 0;
 
Inc(R, (PosValue(GetRValue(FLight[l].Color) - R) * m shr 8));
Inc(G, (PosValue(GetGValue(FLight[l].Color) - G) * m shr 8));
Inc(B, (PosValue(GetBValue(FLight[l].Color) - B) * m shr 8));
end;
 
for q := LG_DETAIL downto 0 do
begin
n := 3 * (j * (LG_DETAIL + 1) - q);
 
for o := LG_DETAIL downto 0 do
begin
P[o][n] := (P[o][n] * B) shr 8;
P[o][n + 1] := (P[o][n + 1] * G) shr 8;
P[o][n + 2] := (P[o][n + 2] * R) shr 8;
end;
end;
end;
end;
{$IFDEF VER4UP}
SetLength(P, 0);
{$ENDIF}
end;
 
procedure TDIB.DrawOn(Dest: TRect; DestCanvas: TCanvas; Xsrc, Ysrc: Integer);
{procedure is supplement of original TDIBUltra function}
begin
//if not AsSigned(SrcCanvas) then Exit;
if (Xsrc < 0) then
begin
Dec(Dest.Left, Xsrc);
Inc(Dest.Right {Width }, Xsrc);
Xsrc := 0
end;
if (Ysrc < 0) then
begin
Dec(Dest.Top, Ysrc);
Inc(Dest.Bottom {Height}, Ysrc);
Ysrc := 0
end;
BitBlt(DestCanvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom, Self.Canvas.Handle, Xsrc, Ysrc, SRCCOPY);
end;
 
{ DXFusion <- }
 
{ added effect for DIB }
 
function IntToByte(i: Integer): Byte;
begin
if i > 255 then Result := 255
else if i < 0 then Result := 0
else Result := i;
end;
 
{standalone routine}
 
procedure TDIB.Darker(Percent: Integer);
{color to dark in percent}
var
p0: pbytearray;
r, g, b, x, y: Integer;
begin
if Self.BitCount <> 24 then Exit;
for y := 0 to Self.Height - 1 do
begin
p0 := Self.ScanLine[y];
for x := 0 to Self.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
p0[x * 3] := Round(R * Percent / 100);
p0[x * 3 + 1] := Round(G * Percent / 100);
p0[x * 3 + 2] := Round(B * Percent / 100);
end;
end;
end;
 
procedure TDIB.Lighter(Percent: Integer);
var
p0: pbytearray;
r, g, b, x, y: Integer;
begin
if Self.BitCount <> 24 then Exit;
for y := 0 to Self.Height - 1 do
begin
p0 := Self.ScanLine[y];
for x := 0 to Self.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
p0[x * 3] := Round(R * Percent / 100) + Round(255 - Percent / 100 * 255);
p0[x * 3 + 1] := Round(G * Percent / 100) + Round(255 - Percent / 100 * 255);
p0[x * 3 + 2] := Round(B * Percent / 100) + Round(255 - Percent / 100 * 255);
end;
end;
end;
 
procedure TDIB.Darkness(Amount: Integer);
var
p0: pbytearray;
r, g, b, x, y: Integer;
begin
if Self.BitCount <> 24 then Exit;
for y := 0 to Self.Height - 1 do
begin
p0 := Self.ScanLine[y];
for x := 0 to Self.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
p0[x * 3] := IntToByte(r - ((r) * Amount) div 255);
p0[x * 3 + 1] := IntToByte(g - ((g) * Amount) div 255);
p0[x * 3 + 2] := IntToByte(b - ((b) * Amount) div 255);
end;
end;
end;
 
function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if i > Max then Result := Max
else if i < Min then Result := Min
else Result := i;
end;
 
procedure TDIB.DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
var
Top, Bottom, Left, Right, eww, nsw, fx, fy, wx, wy: Extended;
cAngle, sAngle: Double;
xDiff, yDiff, ifx, ify, px, py, ix, iy, x, y: Integer;
nw, ne, sw, se: TBGR;
P1, P2, P3: Pbytearray;
begin
Angle := angle;
Angle := -Angle * Pi / 180;
sAngle := Sin(Angle);
cAngle := Cos(Angle);
xDiff := (Self.Width - Src.Width) div 2;
yDiff := (Self.Height - Src.Height) div 2;
for y := 0 to Self.Height - 1 do
begin
P3 := Self.scanline[y];
py := 2 * (y - cy) + 1;
for x := 0 to Self.Width - 1 do
begin
px := 2 * (x - cx) + 1;
fx := (((px * cAngle - py * sAngle) - 1) / 2 + cx) - xDiff;
fy := (((px * sAngle + py * cAngle) - 1) / 2 + cy) - yDiff;
ifx := Round(fx);
ify := Round(fy);
 
if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then
begin
eww := fx - ifx;
nsw := fy - ify;
iy := TrimInt(ify + 1, 0, Src.Height - 1);
ix := TrimInt(ifx + 1, 0, Src.Width - 1);
P1 := Src.scanline[ify];
P2 := Src.scanline[iy];
nw.r := P1[ifx * 3];
nw.g := P1[ifx * 3 + 1];
nw.b := P1[ifx * 3 + 2];
ne.r := P1[ix * 3];
ne.g := P1[ix * 3 + 1];
ne.b := P1[ix * 3 + 2];
sw.r := P2[ifx * 3];
sw.g := P2[ifx * 3 + 1];
sw.b := P2[ifx * 3 + 2];
se.r := P2[ix * 3];
se.g := P2[ix * 3 + 1];
se.b := P2[ix * 3 + 2];
 
Top := nw.b + eww * (ne.b - nw.b);
Bottom := sw.b + eww * (se.b - sw.b);
P3[x * 3 + 2] := IntToByte(Round(Top + nsw * (Bottom - Top)));
 
Top := nw.g + eww * (ne.g - nw.g);
Bottom := sw.g + eww * (se.g - sw.g);
P3[x * 3 + 1] := IntToByte(Round(Top + nsw * (Bottom - Top)));
 
Top := nw.r + eww * (ne.r - nw.r);
Bottom := sw.r + eww * (se.r - sw.r);
P3[x * 3] := IntToByte(Round(Top + nsw * (Bottom - Top)));
end;
end;
end;
end;
 
//----------------------
//--- 24 bit count routines ----------------------
//----------------------
 
procedure TDIB.DoInvert;
procedure PicInvert(src: TDIB);
var w, h, x, y: Integer;
p: pbytearray;
begin
w := src.width;
h := src.height;
src.BitCount := 24;
for y := 0 to h - 1 do
begin
p := src.scanline[y];
for x := 0 to w - 1 do
begin
p[x * 3] := not p[x * 3];
p[x * 3 + 1] := not p[x * 3 + 1];
p[x * 3 + 2] := not p[x * 3 + 2];
end;
end;
end;
begin
PicInvert(Self);
end;
 
procedure TDIB.DoAddColorNoise(Amount: Integer);
procedure AddColorNoise(var clip: TDIB; Amount: Integer);
var
p0: pbytearray;
x, y, r, g, b: Integer;
begin
for y := 0 to clip.Height - 1 do
begin
p0 := clip.ScanLine[y];
for x := 0 to clip.Width - 1 do
begin
r := p0[x * 3] + (Random(Amount) - (Amount shr 1));
g := p0[x * 3 + 1] + (Random(Amount) - (Amount shr 1));
b := p0[x * 3 + 2] + (Random(Amount) - (Amount shr 1));
p0[x * 3] := IntToByte(r);
p0[x * 3 + 1] := IntToByte(g);
p0[x * 3 + 2] := IntToByte(b);
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
AddColorNoise(bb, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoAddMonoNoise(Amount: Integer);
procedure _AddMonoNoise(var clip: TDIB; Amount: Integer);
var
p0: pbytearray;
x, y, a, r, g, b: Integer;
begin
for y := 0 to clip.Height - 1 do
begin
p0 := clip.scanline[y];
for x := 0 to clip.Width - 1 do
begin
a := Random(Amount) - (Amount shr 1);
r := p0[x * 3] + a;
g := p0[x * 3 + 1] + a;
b := p0[x * 3 + 2] + a;
p0[x * 3] := IntToByte(r);
p0[x * 3 + 1] := IntToByte(g);
p0[x * 3 + 2] := IntToByte(b);
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
_AddMonoNoise(bb, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoAntiAlias;
procedure AntiAlias(clip: TDIB);
procedure AntiAliasRect(clip: TDIB; XOrigin, YOrigin, XFinal, YFinal: Integer);
var Memo, x, y: Integer; (* Composantes primaires des points environnants *)
p0, p1, p2: pbytearray;
begin
if XFinal < XOrigin then begin Memo := XOrigin; XOrigin := XFinal; XFinal := Memo; end; (* Inversion des valeurs *)
if YFinal < YOrigin then begin Memo := YOrigin; YOrigin := YFinal; YFinal := Memo; end; (* si diff‚rence n‚gative*)
XOrigin := max(1, XOrigin);
YOrigin := max(1, YOrigin);
XFinal := min(clip.width - 2, XFinal);
YFinal := min(clip.height - 2, YFinal);
clip.BitCount := 24;
for y := YOrigin to YFinal do
begin
p0 := clip.ScanLine[y - 1];
p1 := clip.scanline[y];
p2 := clip.ScanLine[y + 1];
for x := XOrigin to XFinal do
begin
p1[x * 3] := (p0[x * 3] + p2[x * 3] + p1[(x - 1) * 3] + p1[(x + 1) * 3]) div 4;
p1[x * 3 + 1] := (p0[x * 3 + 1] + p2[x * 3 + 1] + p1[(x - 1) * 3 + 1] + p1[(x + 1) * 3 + 1]) div 4;
p1[x * 3 + 2] := (p0[x * 3 + 2] + p2[x * 3 + 2] + p1[(x - 1) * 3 + 2] + p1[(x + 1) * 3 + 2]) div 4;
end;
end;
end;
begin
AntiAliasRect(clip, 0, 0, clip.width, clip.height);
end;
begin
AntiAlias(Self);
end;
 
procedure TDIB.DoContrast(Amount: Integer);
procedure _Contrast(var clip: TDIB; Amount: Integer);
var
p0: pbytearray;
rg, gg, bg, r, g, b, x, y: Integer;
begin
for y := 0 to clip.Height - 1 do
begin
p0 := clip.scanline[y];
for x := 0 to clip.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
rg := (Abs(127 - r) * Amount) div 255;
gg := (Abs(127 - g) * Amount) div 255;
bg := (Abs(127 - b) * Amount) div 255;
if r > 127 then r := r + rg else r := r - rg;
if g > 127 then g := g + gg else g := g - gg;
if b > 127 then b := b + bg else b := b - bg;
p0[x * 3] := IntToByte(r);
p0[x * 3 + 1] := IntToByte(g);
p0[x * 3 + 2] := IntToByte(b);
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
_Contrast(bb, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoFishEye(Amount: Integer);
procedure _FishEye(var Bmp, Dst: TDIB; Amount: Extended);
var
xmid, ymid: Single;
fx, fy: Single;
r1, r2: Single;
ifx, ify: Integer;
dx, dy: Single;
rmax: Single;
ty, tx: Integer;
weight_x, weight_y: array[0..1] of Single;
weight: Single;
new_red, new_green: Integer;
new_blue: Integer;
total_red, total_green: Single;
total_blue: Single;
ix, iy: Integer;
sli, slo: PByteArray;
begin
xmid := Bmp.Width / 2;
ymid := Bmp.Height / 2;
rmax := Dst.Width * Amount;
 
for ty := 0 to Dst.Height - 1 do
begin
for tx := 0 to Dst.Width - 1 do
begin
dx := tx - xmid;
dy := ty - ymid;
r1 := Sqrt(dx * dx + dy * dy);
if r1 = 0 then
begin
fx := xmid;
fy := ymid;
end
else
begin
r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
fx := dx * r2 / r1 + xmid;
fy := dy * r2 / r1 + ymid;
end;
ify := Trunc(fy);
ifx := Trunc(fx);
// Calculate the weights.
if fy >= 0 then
begin
weight_y[1] := fy - ify;
weight_y[0] := 1 - weight_y[1];
end
else
begin
weight_y[0] := -(fy - ify);
weight_y[1] := 1 - weight_y[0];
end;
if fx >= 0 then
begin
weight_x[1] := fx - ifx;
weight_x[0] := 1 - weight_x[1];
end
else
begin
weight_x[0] := -(fx - ifx);
Weight_x[1] := 1 - weight_x[0];
end;
 
if ifx < 0 then
ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
else if ifx > Bmp.Width - 1 then
ifx := ifx mod Bmp.Width;
if ify < 0 then
ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
else if ify > Bmp.Height - 1 then
ify := ify mod Bmp.Height;
 
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do
begin
for iy := 0 to 1 do
begin
if ify + iy < Bmp.Height then
sli := Bmp.scanline[ify + iy]
else
sli := Bmp.scanline[Bmp.Height - ify - iy];
if ifx + ix < Bmp.Width then
begin
new_red := sli[(ifx + ix) * 3];
new_green := sli[(ifx + ix) * 3 + 1];
new_blue := sli[(ifx + ix) * 3 + 2];
end
else
begin
new_red := sli[(Bmp.Width - ifx - ix) * 3];
new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1];
new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2];
end;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
slo := Dst.scanline[ty];
slo[tx * 3] := Round(total_red);
slo[tx * 3 + 1] := Round(total_green);
slo[tx * 3 + 2] := Round(total_blue);
 
end;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
_FishEye(BB1, BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoGrayScale;
procedure GrayScale(var clip: TDIB);
var
p0: pbytearray;
Gray, x, y: Integer;
begin
for y := 0 to clip.Height - 1 do
begin
p0 := clip.scanline[y];
for x := 0 to clip.Width - 1 do
begin
Gray := Round(p0[x * 3] * 0.3 + p0[x * 3 + 1] * 0.59 + p0[x * 3 + 2] * 0.11);
p0[x * 3] := Gray;
p0[x * 3 + 1] := Gray;
p0[x * 3 + 2] := Gray;
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
GrayScale(BB);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoLightness(Amount: Integer);
procedure _Lightness(var clip: TDIB; Amount: Integer);
var
p0: pbytearray;
r, g, b, x, y: Integer;
begin
for y := 0 to clip.Height - 1 do
begin
p0 := clip.scanline[y];
for x := 0 to clip.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
p0[x * 3] := IntToByte(r + ((255 - r) * Amount) div 255);
p0[x * 3 + 1] := IntToByte(g + ((255 - g) * Amount) div 255);
p0[x * 3 + 2] := IntToByte(b + ((255 - b) * Amount) div 255);
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
_Lightness(BB, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoDarkness(Amount: Integer);
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
BB.Darkness(Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoSaturation(Amount: Integer);
procedure _Saturation(var clip: TDIB; Amount: Integer);
var
p0: pbytearray;
Gray, r, g, b, x, y: Integer;
begin
for y := 0 to clip.Height - 1 do
begin
p0 := clip.scanline[y];
for x := 0 to clip.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
Gray := (r + g + b) div 3;
p0[x * 3] := IntToByte(Gray + (((r - Gray) * Amount) div 255));
p0[x * 3 + 1] := IntToByte(Gray + (((g - Gray) * Amount) div 255));
p0[x * 3 + 2] := IntToByte(Gray + (((b - Gray) * Amount) div 255));
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
_Saturation(BB, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoSplitBlur(Amount: Integer);
{NOTE: For a gaussian blur is amount 3}
procedure _SplitBlur(var clip: TDIB; Amount: Integer);
var
p0, p1, p2: pbytearray;
cx, x, y: Integer;
Buf: array[0..3, 0..2] of byte;
begin
if Amount = 0 then Exit;
for y := 0 to clip.Height - 1 do
begin
p0 := clip.scanline[y];
if y - Amount < 0 then p1 := clip.scanline[y]
else {y-Amount>0} p1 := clip.ScanLine[y - Amount];
if y + Amount < clip.Height then p2 := clip.ScanLine[y + Amount]
else {y+Amount>=Height} p2 := clip.ScanLine[clip.Height - y];
 
for x := 0 to clip.Width - 1 do
begin
if x - Amount < 0 then cx := x
else {x-Amount>0} cx := x - Amount;
Buf[0, 0] := p1[cx * 3];
Buf[0, 1] := p1[cx * 3 + 1];
Buf[0, 2] := p1[cx * 3 + 2];
Buf[1, 0] := p2[cx * 3];
Buf[1, 1] := p2[cx * 3 + 1];
Buf[1, 2] := p2[cx * 3 + 2];
if x + Amount < clip.Width then cx := x + Amount
else {x+Amount>=Width} cx := clip.Width - x;
Buf[2, 0] := p1[cx * 3];
Buf[2, 1] := p1[cx * 3 + 1];
Buf[2, 2] := p1[cx * 3 + 2];
Buf[3, 0] := p2[cx * 3];
Buf[3, 1] := p2[cx * 3 + 1];
Buf[3, 2] := p2[cx * 3 + 2];
p0[x * 3] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2;
p0[x * 3 + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2;
p0[x * 3 + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2;
end;
end;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
_SplitBlur(BB, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoGaussianBlur(Amount: Integer);
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.BitCount := 24;
BB.Assign(Self);
GaussianBlur(BB, Amount);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoMosaic(Size: Integer);
procedure Mosaic(var Bm: TDIB; size: Integer);
var
x, y, i, j: Integer;
p1, p2: pbytearray;
r, g, b: byte;
begin
y := 0;
repeat
p1 := bm.scanline[y];
repeat
j := 1;
repeat
p2 := bm.scanline[y];
x := 0;
repeat
r := p1[x * 3];
g := p1[x * 3 + 1];
b := p1[x * 3 + 2];
i := 1;
repeat
p2[x * 3] := r;
p2[x * 3 + 1] := g;
p2[x * 3 + 2] := b;
inc(x);
inc(i);
until (x >= bm.width) or (i > size);
until x >= bm.width;
inc(j);
inc(y);
until (y >= bm.height) or (j > size);
until (y >= bm.height) or (x >= bm.width);
until y >= bm.height;
end;
var BB: TDIB;
begin
BB := TDIB.Create;
BB.BitCount := 24;
BB.Assign(Self);
Mosaic(BB, Size);
Self.Assign(BB);
BB.Free;
end;
 
procedure TDIB.DoTwist(Amount: Integer);
procedure _Twist(var Bmp, Dst: TDIB; Amount: Integer);
var
fxmid, fymid: Single;
txmid, tymid: Single;
fx, fy: Single;
tx2, ty2: Single;
r: Single;
theta: Single;
ifx, ify: Integer;
dx, dy: Single;
OFFSET: Single;
ty, tx: Integer;
weight_x, weight_y: array[0..1] of Single;
weight: Single;
new_red, new_green: Integer;
new_blue: Integer;
total_red, total_green: Single;
total_blue: Single;
ix, iy: Integer;
sli, slo: PBytearray;
 
function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if xt = 0 then
if yt > 0 then
Result := Pi / 2
else
Result := -(Pi / 2)
else
begin
Result := ArcTan(yt / xt);
if xt < 0 then
Result := Pi + ArcTan(yt / xt);
end;
end;
 
begin
OFFSET := -(Pi / 2);
dx := Bmp.Width - 1;
dy := Bmp.Height - 1;
r := Sqrt(dx * dx + dy * dy);
tx2 := r;
ty2 := r;
txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation
tymid := (Bmp.Height - 1) / 2; //Adjust these to move ......
fxmid := (Bmp.Width - 1) / 2;
fymid := (Bmp.Height - 1) / 2;
if tx2 >= Bmp.Width then tx2 := Bmp.Width - 1;
if ty2 >= Bmp.Height then ty2 := Bmp.Height - 1;
 
for ty := 0 to Round(ty2) do
begin
for tx := 0 to Round(tx2) do
begin
dx := tx - txmid;
dy := ty - tymid;
r := Sqrt(dx * dx + dy * dy);
if r = 0 then
begin
fx := 0;
fy := 0;
end
else
begin
theta := ArcTan2(dx, dy) - r / Amount - OFFSET;
fx := r * Cos(theta);
fy := r * Sin(theta);
end;
fx := fx + fxmid;
fy := fy + fymid;
 
ify := Trunc(fy);
ifx := Trunc(fx);
// Calculate the weights.
if fy >= 0 then
begin
weight_y[1] := fy - ify;
weight_y[0] := 1 - weight_y[1];
end
else
begin
weight_y[0] := -(fy - ify);
weight_y[1] := 1 - weight_y[0];
end;
if fx >= 0 then
begin
weight_x[1] := fx - ifx;
weight_x[0] := 1 - weight_x[1];
end
else
begin
weight_x[0] := -(fx - ifx);
Weight_x[1] := 1 - weight_x[0];
end;
 
if ifx < 0 then
ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
else if ifx > Bmp.Width - 1 then
ifx := ifx mod Bmp.Width;
if ify < 0 then
ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
else if ify > Bmp.Height - 1 then
ify := ify mod Bmp.Height;
 
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do
begin
for iy := 0 to 1 do
begin
if ify + iy < Bmp.Height then
sli := Bmp.scanline[ify + iy]
else
sli := Bmp.scanline[Bmp.Height - ify - iy];
if ifx + ix < Bmp.Width then
begin
new_red := sli[(ifx + ix) * 3];
new_green := sli[(ifx + ix) * 3 + 1];
new_blue := sli[(ifx + ix) * 3 + 2];
end
else
begin
new_red := sli[(Bmp.Width - ifx - ix) * 3];
new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1];
new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2];
end;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
slo := Dst.scanline[ty];
slo[tx * 3] := Round(total_red);
slo[tx * 3 + 1] := Round(total_green);
slo[tx * 3 + 2] := Round(total_blue);
end;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
_Twist(BB1, BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoTrace(Amount: Integer);
procedure Trace(src: TDIB; intensity: Integer);
var
x, y, i: Integer;
P1, P2, P3, P4: PByteArray;
tb, TraceB: byte;
hasb: Boolean;
bitmap: TDIB;
begin
bitmap := TDIB.create;
bitmap.width := src.width;
bitmap.height := src.height;
bitmap.canvas.draw(0, 0, src);
bitmap.BitCount := 8;
src.BitCount := 24;
hasb := false;
TraceB := $00; tb := 0;
for i := 1 to Intensity do
begin
for y := 0 to BitMap.height - 2 do
begin
P1 := BitMap.ScanLine[y];
P2 := BitMap.scanline[y + 1];
P3 := src.scanline[y];
P4 := src.scanline[y + 1];
x := 0;
repeat
if p1[x] <> p1[x + 1] then
begin
if not hasb then
begin
tb := p1[x + 1];
hasb := true;
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
if p1[x] <> tb then
begin
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
p3[(x + 1) * 3] := TraceB;
p3[(x + 1) * 3 + 1] := TraceB;
p3[(x + 1) * 3 + 1] := TraceB;
end;
end;
end;
if p1[x] <> p2[x] then
begin
if not hasb then
begin
tb := p2[x];
hasb := true;
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
if p1[x] <> tb then
begin
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
p4[x * 3] := TraceB;
p4[x * 3 + 1] := TraceB;
p4[x * 3 + 2] := TraceB;
end;
end;
end;
inc(x);
until x >= (BitMap.width - 2);
end;
if i > 1 then
for y := BitMap.height - 1 downto 1 do
begin
P1 := BitMap.ScanLine[y];
P2 := BitMap.scanline[y - 1];
P3 := src.scanline[y];
P4 := src.scanline[y - 1];
x := Bitmap.width - 1;
repeat
if p1[x] <> p1[x - 1] then
begin
if not hasb then
begin
tb := p1[x - 1];
hasb := true;
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
if p1[x] <> tb then
begin
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
p3[(x - 1) * 3] := TraceB;
p3[(x - 1) * 3 + 1] := TraceB;
p3[(x - 1) * 3 + 2] := TraceB;
end;
end;
end;
if p1[x] <> p2[x] then
begin
if not hasb then
begin
tb := p2[x];
hasb := true;
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
if p1[x] <> tb then
begin
p3[x * 3] := TraceB;
p3[x * 3 + 1] := TraceB;
p3[x * 3 + 2] := TraceB;
end
else
begin
p4[x * 3] := TraceB;
p4[x * 3 + 1] := TraceB;
p4[x * 3 + 2] := TraceB;
end;
end;
end;
dec(x);
until x <= 1;
end;
end;
bitmap.free;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
Trace(BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoSplitlight(Amount: Integer);
procedure Splitlight(var clip: TDIB; amount: Integer);
var
x, y, i: Integer;
p1: pbytearray;
 
function sinpixs(a: Integer): Integer;
begin
result := variant(sin(a / 255 * pi / 2) * 255);
end;
begin
for i := 1 to amount do
for y := 0 to clip.height - 1 do
begin
p1 := clip.scanline[y];
for x := 0 to clip.width - 1 do
begin
p1[x * 3] := sinpixs(p1[x * 3]);
p1[x * 3 + 1] := sinpixs(p1[x * 3 + 1]);
p1[x * 3 + 2] := sinpixs(p1[x * 3 + 2]);
end;
end;
end;
var BB1 {,BB2}: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
// BB2 := TDIB.Create;
// BB2.BitCount := 24;
// BB2.Assign (BB1);
Splitlight(BB1, Amount);
Self.Assign(BB1);
BB1.Free;
// BB2.Free;
end;
 
procedure TDIB.DoTile(Amount: Integer);
procedure SmoothResize(var Src, Dst: TDIB);
var
x, y, xP, yP,
yP2, xP2: Integer;
Read, Read2: PByteArray;
t, z, z2, iz2: Integer;
pc: PBytearray;
w1, w2, w3, w4: Integer;
Col1r, col1g, col1b, Col2r, col2g, col2b: byte;
begin
xP2 := ((src.Width - 1) shl 15) div Dst.Width;
yP2 := ((src.Height - 1) shl 15) div Dst.Height;
yP := 0;
for y := 0 to Dst.Height - 1 do
begin
xP := 0;
Read := src.ScanLine[yP shr 15];
if yP shr 16 < src.Height - 1 then
Read2 := src.ScanLine[yP shr 15 + 1]
else
Read2 := src.ScanLine[yP shr 15];
pc := Dst.scanline[y];
z2 := yP and $7FFF;
iz2 := $8000 - z2;
for x := 0 to Dst.Width - 1 do
begin
t := xP shr 15;
Col1r := Read[t * 3];
Col1g := Read[t * 3 + 1];
Col1b := Read[t * 3 + 2];
Col2r := Read2[t * 3];
Col2g := Read2[t * 3 + 1];
Col2b := Read2[t * 3 + 2];
z := xP and $7FFF;
w2 := (z * iz2) shr 15;
w1 := iz2 - w2;
w4 := (z * z2) shr 15;
w3 := z2 - w4;
pc[x * 3 + 2] :=
(Col1b * w1 + Read[(t + 1) * 3 + 2] * w2 +
Col2b * w3 + Read2[(t + 1) * 3 + 2] * w4) shr 15;
pc[x * 3 + 1] :=
(Col1g * w1 + Read[(t + 1) * 3 + 1] * w2 +
Col2g * w3 + Read2[(t + 1) * 3 + 1] * w4) shr 15;
pc[x * 3] :=
(Col1r * w1 + Read2[(t + 1) * 3] * w2 +
Col2r * w3 + Read2[(t + 1) * 3] * w4) shr 15;
Inc(xP, xP2);
end;
Inc(yP, yP2);
end;
end;
procedure Tile(src, dst: TDIB; amount: Integer);
var
w, h, w2, h2, i, j: Integer;
bm: TDIB;
begin
w := src.width;
h := src.height;
dst.width := w;
dst.height := h;
dst.Canvas.draw(0, 0, src);
if (amount <= 0) or ((w div amount) < 5) or ((h div amount) < 5) then exit;
h2 := h div amount;
w2 := w div amount;
bm := TDIB.create;
bm.width := w2;
bm.height := h2;
bm.BitCount := 24;
smoothresize(src, bm);
for j := 0 to amount - 1 do
for i := 0 to amount - 1 do
dst.canvas.Draw(i * w2, j * h2, bm);
bm.free;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
Tile(BB1, BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoSpotLight(Amount: Integer; Spot: TRect);
procedure SpotLight(var src: TDIB; Amount: Integer; Spot: TRect);
var
bm, z: TDIB;
w, h: Integer;
begin
z := TDIB.Create;
try
z.SetSize(src.Width, src.Height, 24);
z.DrawTo(src, 0, 0, src.Width, src.Height, 0, 0);
w := z.Width;
h := z.Height;
bm := TDIB.create;
try
bm.Width := w;
bm.Height := h;
bm.Canvas.Brush.color := clblack;
bm.Canvas.FillRect(rect(0, 0, w, h));
bm.Canvas.Brush.Color := clwhite;
bm.Canvas.Ellipse(Spot.left, spot.top, spot.right, spot.bottom);
bm.Transparent := true;
z.Canvas.CopyMode := cmSrcAnd; {as transparentcolor for white}
z.Canvas.Draw(0, 0, src);
z.Canvas.Draw(0, 0, bm);
src.Darkness(Amount);
src.Canvas.CopyMode := cmSrcPaint;
src.DrawTransparent(z, 0, 0, z.Width, z.Height, 0, 0, clBlack);
finally
bm.Free;
end;
finally
z.Free
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
SpotLight(BB2, Amount, Spot);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoEmboss;
procedure Emboss(var Bmp: TDIB);
var
x, y: Integer;
p1, p2: Pbytearray;
begin
for y := 0 to Bmp.Height - 2 do
begin
p1 := bmp.scanline[y];
p2 := bmp.scanline[y + 1];
for x := 0 to Bmp.Width - 4 do
begin
p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1;
p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
p1[x * 3 + 2] := (p1[x * 3 + 2] + (p2[(x + 3) * 3 + 2] xor $FF)) shr 1;
end;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
Emboss(BB2);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoSolorize(Amount: Integer);
procedure Solorize(src, dst: TDIB; amount: Integer);
var
w, h, x, y: Integer;
ps, pd: pbytearray;
c: Integer;
begin
w := src.width;
h := src.height;
src.BitCount := 24;
dst.BitCount := 24;
for y := 0 to h - 1 do
begin
ps := src.scanline[y];
pd := dst.scanline[y];
for x := 0 to w - 1 do
begin
c := (ps[x * 3] + ps[x * 3 + 1] + ps[x * 3 + 2]) div 3;
if c > amount then
begin
pd[x * 3] := 255 - ps[x * 3];
pd[x * 3 + 1] := 255 - ps[x * 3 + 1];
pd[x * 3 + 2] := 255 - ps[x * 3 + 2];
end
else
begin
pd[x * 3] := ps[x * 3];
pd[x * 3 + 1] := ps[x * 3 + 1];
pd[x * 3 + 2] := ps[x * 3 + 2];
end;
end;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
Solorize(BB1, BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoPosterize(Amount: Integer);
procedure Posterize(src, dst: TDIB; amount: Integer);
var
w, h, x, y: Integer;
ps, pd: pbytearray;
begin
w := src.width;
h := src.height;
src.BitCount := 24;
dst.BitCount := 24;
for y := 0 to h - 1 do
begin
ps := src.scanline[y];
pd := dst.scanline[y];
for x := 0 to w - 1 do
begin
pd[x * 3] := round(ps[x * 3] / amount) * amount;
pd[x * 3 + 1] := round(ps[x * 3 + 1] / amount) * amount;
pd[x * 3 + 2] := round(ps[x * 3 + 2] / amount) * amount;
end;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
Posterize(BB1, BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoBrightness(Amount: Integer);
procedure Brightness(src, dst: TDIB; level: Integer);
const
MaxPixelCount = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
var
i, j, value: Integer;
OrigRow, DestRow: pRGBArray;
begin
// get brightness increment value
value := level;
src.BitCount := 24;
dst.BitCount := 24;
// for each row of pixels
for i := 0 to src.Height - 1 do
begin
OrigRow := src.ScanLine[i];
DestRow := dst.ScanLine[i];
// for each pixel in row
for j := 0 to src.Width - 1 do
begin
// add brightness value to pixel's RGB values
if value > 0 then
begin
// RGB values must be less than 256
DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
end
else
begin
// RGB values must be greater or equal than 0
DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
end;
end;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.BitCount := 24;
BB2.Assign(BB1);
Brightness(BB1, BB2, Amount);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
procedure Resample(Src, Dst: TDIB; filtertype: TFilterTypeResample; fwidth: single);
// -----------------------------------------------------------------------------
//
// Filter functions
//
// -----------------------------------------------------------------------------
 
// Hermite filter
function HermiteFilter(Value: Single): Single;
begin
// f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1
if (Value < 0.0) then
Value := -Value;
if (Value < 1.0) then
Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0
else
Result := 0.0;
end;
 
// Box filter
// a.k.a. "Nearest Neighbour" filter
// anme: I have not been able to get acceptable
// results with this filter for subsampling.
function BoxFilter(Value: Single): Single;
begin
if (Value > -0.5) and (Value <= 0.5) then
Result := 1.0
else
Result := 0.0;
end;
 
// Triangle filter
// a.k.a. "Linear" or "Bilinear" filter
function TriangleFilter(Value: Single): Single;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 1.0) then
Result := 1.0 - Value
else
Result := 0.0;
end;
 
// Bell filter
function BellFilter(Value: Single): Single;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 0.5) then
Result := 0.75 - Sqr(Value)
else
if (Value < 1.5) then
begin
Value := Value - 1.5;
Result := 0.5 * Sqr(Value);
end
else
Result := 0.0;
end;
 
// B-spline filter
function SplineFilter(Value: Single): Single;
var
tt: single;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 1.0) then
begin
tt := Sqr(Value);
Result := 0.5 * tt * Value - tt + 2.0 / 3.0;
end
else
if (Value < 2.0) then
begin
Value := 2.0 - Value;
Result := 1.0 / 6.0 * Sqr(Value) * Value;
end
else
Result := 0.0;
end;
 
// Lanczos3 filter
function Lanczos3Filter(Value: Single): Single;
function SinC(Value: Single): Single;
begin
if (Value <> 0.0) then
begin
Value := Value * Pi;
Result := sin(Value) / Value
end
else
Result := 1.0;
end;
begin
if (Value < 0.0) then
Value := -Value;
if (Value < 3.0) then
Result := SinC(Value) * SinC(Value / 3.0)
else
Result := 0.0;
end;
 
function MitchellFilter(Value: Single): Single;
const
B = (1.0 / 3.0);
C = (1.0 / 3.0);
var
tt: single;
begin
if (Value < 0.0) then
Value := -Value;
tt := Sqr(Value);
if (Value < 1.0) then
begin
Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt))
+ ((-18.0 + 12.0 * B + 6.0 * C) * tt)
+ (6.0 - 2 * B));
Result := Value / 6.0;
end
else
if (Value < 2.0) then
begin
Value := (((-1.0 * B - 6.0 * C) * (Value * tt))
+ ((6.0 * B + 30.0 * C) * tt)
+ ((-12.0 * B - 48.0 * C) * Value)
+ (8.0 * B + 24 * C));
Result := Value / 6.0;
end
else
Result := 0.0;
end;
 
// -----------------------------------------------------------------------------
//
// Interpolator
//
// -----------------------------------------------------------------------------
type
// Contributor for a pixel
TContributor = record
pixel: Integer; // Source pixel
weight: single; // Pixel weight
end;
 
TContributorList = array[0..0] of TContributor;
PContributorList = ^TContributorList;
 
// List of source pixels contributing to a destination pixel
TCList = record
n: Integer;
p: PContributorList;
end;
 
TCListList = array[0..0] of TCList;
PCListList = ^TCListList;
 
TRGB = packed record
r, g, b: single;
end;
 
// Physical bitmap pixel
TColorRGB = packed record
r, g, b: BYTE;
end;
PColorRGB = ^TColorRGB;
 
// Physical bitmap scanline (row)
TRGBList = packed array[0..0] of TColorRGB;
PRGBList = ^TRGBList;
 
var
xscale, yscale: single; // Zoom scale factors
i, j, k: Integer; // Loop variables
center: single; // Filter calculation variables
width, fscale, weight: single; // Filter calculation variables
left, right: Integer; // Filter calculation variables
n: Integer; // Pixel number
Work: TDIB;
contrib: PCListList;
rgb: TRGB;
color: TColorRGB;
{$IFDEF USE_SCANLINE}
SourceLine,
DestLine: PRGBList;
SourcePixel,
DestPixel: PColorRGB;
Delta,
DestDelta: Integer;
{$ENDIF}
SrcWidth,
SrcHeight,
DstWidth,
DstHeight: Integer;
 
function Color2RGB(Color: TColor): TColorRGB;
begin
Result.r := Color and $000000FF;
Result.g := (Color and $0000FF00) shr 8;
Result.b := (Color and $00FF0000) shr 16;
end;
 
function RGB2Color(Color: TColorRGB): TColor;
begin
Result := Color.r or (Color.g shl 8) or (Color.b shl 16);
end;
 
begin
DstWidth := Dst.Width;
DstHeight := Dst.Height;
SrcWidth := Src.Width;
SrcHeight := Src.Height;
if (SrcWidth < 1) or (SrcHeight < 1) then
raise Exception.Create('Source bitmap too small');
 
// Create intermediate image to hold horizontal zoom
Work := TDIB.Create;
try
Work.Height := SrcHeight;
Work.Width := DstWidth;
// xscale := DstWidth / SrcWidth;
// yscale := DstHeight / SrcHeight;
// Improvement suggested by David Ullrich:
if (SrcWidth = 1) then
xscale := DstWidth / SrcWidth
else
xscale := (DstWidth - 1) / (SrcWidth - 1);
if (SrcHeight = 1) then
yscale := DstHeight / SrcHeight
else
yscale := (DstHeight - 1) / (SrcHeight - 1);
// This implementation only works on 24-bit images because it uses
// TDIB.Scanline
{$IFDEF USE_SCANLINE}
//Src.PixelFormat := pf24bit;
Src.BitCount := 24;
//Dst.PixelFormat := Src.PixelFormat;
dst.BitCount := 24;
//Work.PixelFormat := Src.PixelFormat;
work.BitCount := 24;
{$ENDIF}
 
// --------------------------------------------
// Pre-calculate filter contributions for a row
// -----------------------------------------------
GetMem(contrib, DstWidth * sizeof(TCList));
// Horizontal sub-sampling
// Scales from bigger to smaller width
if (xscale < 1.0) then
begin
width := fwidth / xscale;
fscale := 1.0 / xscale;
for i := 0 to DstWidth - 1 do
begin
contrib^[i].n := 0;
GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
center := i / xscale;
// Original code:
// left := ceil(center - width);
// right := floor(center + width);
left := floor(center - width);
right := ceil(center + width);
for j := left to right do
begin
case filtertype of
ftrBox: weight := boxfilter((center - j) / fscale) / fscale;
ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale;
ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale;
ftrBell: weight := bellfilter((center - j) / fscale) / fscale;
ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale;
ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale;
ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale;
else
weight := 0
end;
if (weight = 0.0) then
continue;
if (j < 0) then
n := -j
else if (j >= SrcWidth) then
n := SrcWidth - j + SrcWidth - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end;
end
else
// Horizontal super-sampling
// Scales from smaller to bigger width
begin
for i := 0 to DstWidth - 1 do
begin
contrib^[i].n := 0;
GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
center := i / xscale;
// Original code:
// left := ceil(center - fwidth);
// right := floor(center + fwidth);
left := floor(center - fwidth);
right := ceil(center + fwidth);
for j := left to right do
begin
case filtertype of
ftrBox: weight := boxfilter(center - j);
ftrTriangle: weight := trianglefilter(center - j);
ftrHermite: weight := hermitefilter(center - j);
ftrBell: weight := bellfilter(center - j);
ftrBSpline: weight := splinefilter(center - j);
ftrLanczos3: weight := Lanczos3filter(center - j);
ftrMitchell: weight := Mitchellfilter(center - j);
else
weight := 0
end;
if (weight = 0.0) then
continue;
if (j < 0) then
n := -j
else if (j >= SrcWidth) then
n := SrcWidth - j + SrcWidth - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end;
end;
 
// ----------------------------------------------------
// Apply filter to sample horizontally from Src to Work
// ----------------------------------------------------
for k := 0 to SrcHeight - 1 do
begin
{$IFDEF USE_SCANLINE}
SourceLine := Src.ScanLine[k];
DestPixel := Work.ScanLine[k];
{$ENDIF}
for i := 0 to DstWidth - 1 do
begin
rgb.r := 0.0;
rgb.g := 0.0;
rgb.b := 0.0;
for j := 0 to contrib^[i].n - 1 do
begin
{$IFDEF USE_SCANLINE}
color := SourceLine^[contrib^[i].p^[j].pixel];
{$ELSE}
color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]);
{$ENDIF}
weight := contrib^[i].p^[j].weight;
if (weight = 0.0) then
continue;
rgb.r := rgb.r + color.r * weight;
rgb.g := rgb.g + color.g * weight;
rgb.b := rgb.b + color.b * weight;
end;
if (rgb.r > 255.0) then
color.r := 255
else if (rgb.r < 0.0) then
color.r := 0
else
color.r := round(rgb.r);
if (rgb.g > 255.0) then
color.g := 255
else if (rgb.g < 0.0) then
color.g := 0
else
color.g := round(rgb.g);
if (rgb.b > 255.0) then
color.b := 255
else if (rgb.b < 0.0) then
color.b := 0
else
color.b := round(rgb.b);
{$IFDEF USE_SCANLINE}
// Set new pixel value
DestPixel^ := color;
// Move on to next column
inc(DestPixel);
{$ELSE}
Work.Canvas.Pixels[i, k] := RGB2Color(color);
{$ENDIF}
end;
end;
 
// Free the memory allocated for horizontal filter weights
for i := 0 to DstWidth - 1 do
FreeMem(contrib^[i].p);
 
FreeMem(contrib);
 
// -----------------------------------------------
// Pre-calculate filter contributions for a column
// -----------------------------------------------
GetMem(contrib, DstHeight * sizeof(TCList));
// Vertical sub-sampling
// Scales from bigger to smaller height
if (yscale < 1.0) then
begin
width := fwidth / yscale;
fscale := 1.0 / yscale;
for i := 0 to DstHeight - 1 do
begin
contrib^[i].n := 0;
GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
center := i / yscale;
// Original code:
// left := ceil(center - width);
// right := floor(center + width);
left := floor(center - width);
right := ceil(center + width);
for j := left to right do
begin
case filtertype of
ftrBox: weight := boxfilter((center - j) / fscale) / fscale;
ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale;
ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale;
ftrBell: weight := bellfilter((center - j) / fscale) / fscale;
ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale;
ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale;
ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale;
else
weight := 0
end;
if (weight = 0.0) then
continue;
if (j < 0) then
n := -j
else if (j >= SrcHeight) then
n := SrcHeight - j + SrcHeight - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end
end
else
// Vertical super-sampling
// Scales from smaller to bigger height
begin
for i := 0 to DstHeight - 1 do
begin
contrib^[i].n := 0;
GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
center := i / yscale;
// Original code:
// left := ceil(center - fwidth);
// right := floor(center + fwidth);
left := floor(center - fwidth);
right := ceil(center + fwidth);
for j := left to right do
begin
case filtertype of
ftrBox: weight := boxfilter(center - j);
ftrTriangle: weight := trianglefilter(center - j);
ftrHermite: weight := hermitefilter(center - j);
ftrBell: weight := bellfilter(center - j);
ftrBSpline: weight := splinefilter(center - j);
ftrLanczos3: weight := Lanczos3filter(center - j);
ftrMitchell: weight := Mitchellfilter(center - j);
else
weight := 0
end;
if (weight = 0.0) then
continue;
if (j < 0) then
n := -j
else if (j >= SrcHeight) then
n := SrcHeight - j + SrcHeight - 1
else
n := j;
k := contrib^[i].n;
contrib^[i].n := contrib^[i].n + 1;
contrib^[i].p^[k].pixel := n;
contrib^[i].p^[k].weight := weight;
end;
end;
end;
 
// --------------------------------------------------
// Apply filter to sample vertically from Work to Dst
// --------------------------------------------------
{$IFDEF USE_SCANLINE}
SourceLine := Work.ScanLine[0];
Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine);
DestLine := Dst.ScanLine[0];
DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine);
{$ENDIF}
for k := 0 to DstWidth - 1 do
begin
{$IFDEF USE_SCANLINE}
DestPixel := pointer(DestLine);
{$ENDIF}
for i := 0 to DstHeight - 1 do
begin
rgb.r := 0;
rgb.g := 0;
rgb.b := 0;
// weight := 0.0;
for j := 0 to contrib^[i].n - 1 do
begin
{$IFDEF USE_SCANLINE}
color := PColorRGB(Integer(SourceLine) + contrib^[i].p^[j].pixel * Delta)^;
{$ELSE}
color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]);
{$ENDIF}
weight := contrib^[i].p^[j].weight;
if (weight = 0.0) then
continue;
rgb.r := rgb.r + color.r * weight;
rgb.g := rgb.g + color.g * weight;
rgb.b := rgb.b + color.b * weight;
end;
if (rgb.r > 255.0) then
color.r := 255
else if (rgb.r < 0.0) then
color.r := 0
else
color.r := round(rgb.r);
if (rgb.g > 255.0) then
color.g := 255
else if (rgb.g < 0.0) then
color.g := 0
else
color.g := round(rgb.g);
if (rgb.b > 255.0) then
color.b := 255
else if (rgb.b < 0.0) then
color.b := 0
else
color.b := round(rgb.b);
{$IFDEF USE_SCANLINE}
DestPixel^ := color;
inc(Integer(DestPixel), DestDelta);
{$ELSE}
Dst.Canvas.Pixels[k, i] := RGB2Color(color);
{$ENDIF}
end;
{$IFDEF USE_SCANLINE}
Inc(SourceLine, 1);
Inc(DestLine, 1);
{$ENDIF}
end;
 
// Free the memory allocated for vertical filter weights
for i := 0 to DstHeight - 1 do
FreeMem(contrib^[i].p);
 
FreeMem(contrib);
 
finally
Work.Free;
end;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
BB2.SetSize(AmountX, AmountY, 24);
Resample(BB1, BB2, TypeResample, DefaultFilterRadius[TypeResample]);
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
procedure TDIB.DoColorize(ForeColor, BackColor: TColor);
procedure Colorize(src, dst: TDIB; iForeColor, iBackColor: TColor; iDither: Boolean{$IFDEF VER4UP} = False{$ENDIF});
{for monochromatic picture change colors}
procedure InvertBitmap(Bmp: TDIB);
begin
Bmp.Canvas.CopyMode := cmDstInvert;
Bmp.Canvas.CopyRect(rect(0, 0, Bmp.Width, Bmp.Height),
Bmp.Canvas, rect(0, 0, Bmp.Width, Bmp.Height));
end;
var
fForeColor: TColor;
fForeDither: Boolean;
lTempBitmap: TDIB;
lTempBitmap2: TDIB;
lDitherBitmap: TDIB;
lCRect: TRect;
x, y, w, h: Integer;
begin
{--}
//fColor := iBackColor; ;
fForeColor := iForeColor;
fForeDither := iDither;
w := src.Width;
h := src.Height;
lDitherBitmap := nil;
lTempBitmap := TDIB.Create;
lTempBitmap.SetSize(w, h, 24);
lTempBitmap2 := TDIB.Create;
lTempBitmap2.SetSize(w, h, 24);
lCRect := rect(0, 0, w, h);
with lTempBitmap.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := iBackColor;
FillRect(lCRect);
CopyMode := cmSrcInvert;
CopyRect(lCRect, src.Canvas, lCRect);
InvertBitmap(src);
CopyMode := cmSrcPaint;
CopyRect(lCRect, src.Canvas, lCRect);
InvertBitmap(lTempBitmap);
CopyMode := cmSrcInvert;
CopyRect(lCRect, src.Canvas, lCRect);
InvertBitmap(src);
end;
with lTempBitmap2.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clBlack;
FillRect(lCRect);
if fForeDither then
begin
InvertBitmap(src);
lDitherBitmap := TDIB.Create;
lDitherBitmap.SetSize(8, 8, 24);
with lDitherBitmap.Canvas do
begin
for x := 0 to 7 do
for y := 0 to 7 do
if ((x mod 2 = 0) and (y mod 2 > 0)) or ((x mod 2 > 0) and (y mod 2 = 0)) then
pixels[x, y] := fForeColor
else
pixels[x, y] := iBackColor;
end;
Brush.Bitmap.Assign(lDitherBitmap);
end
else
begin
Brush.Style := bsSolid;
Brush.Color := fForeColor;
end;
if not fForeDither then
InvertBitmap(src);
CopyMode := cmPatPaint;
CopyRect(lCRect, src.Canvas, lCRect);
if fForeDither then
if Assigned(lDitherBitmap) then
lDitherBitmap.Free;
CopyMode := cmSrcInvert;
CopyRect(lCRect, src.Canvas, lCRect);
end;
lTempBitmap.Canvas.CopyMode := cmSrcInvert;
lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect);
InvertBitmap(src);
lTempBitmap.Canvas.CopyMode := cmSrcErase;
lTempBitmap.Canvas.Copyrect(lCRect, src.Canvas, lCRect);
InvertBitmap(src);
lTempBitmap.Canvas.CopyMode := cmSrcInvert;
lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect);
InvertBitmap(lTempBitmap);
InvertBitmap(src);
dst.Assign(lTempBitmap);
lTempBitmap.Free;
end;
var BB1, BB2: TDIB;
begin
BB1 := TDIB.Create;
BB1.BitCount := 24;
BB1.Assign(Self);
BB2 := TDIB.Create;
Colorize(BB1, BB2, ForeColor, BackColor{$IFNDEF VER4UP}, False{$ENDIF});
Self.Assign(BB2);
BB1.Free;
BB2.Free;
end;
 
{ procedure for special purpose }
 
procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte);
var
P1, P2: PByteArray;
W, H: Integer;
begin
P1 := ScanLine[DIB2.Height - 1];
P2 := DIB2.ScanLine[DIB2.Height - 1];
W := WidthBytes;
H := Height;
asm
PUSH ESI
PUSH EDI
MOV ESI, P1
MOV EDI, P2
MOV EDX, W
MOV EAX, H
IMUL EDX
MOV ECX, EAX
@@1:
MOV AL, Step
MOV AH, [ESI]
CMP AL, AH
JA @@2
MOV AL, AH
@@2:
MOV [EDI], AL
INC ESI
INC EDI
DEC ECX
JNZ @@1
POP EDI
POP ESI
end;
end;
 
procedure TDIB.DoZoom(DIB2: TDIB; ZoomRatio: Real);
var
P1, P2: PByteArray;
W, H: Integer;
x, y: Integer;
xr, yr, xstep, ystep: real;
xstart: real;
begin
W := WidthBytes;
H := Height;
xstart := (W - (W * ZoomRatio)) / 2;
 
xr := xstart;
yr := (H - (H * ZoomRatio)) / 2;
xstep := ZoomRatio;
ystep := ZoomRatio;
 
for y := 1 to Height - 1 do
begin
P2 := DIB2.ScanLine[y];
if (yr >= 0) and (yr <= H) then
begin
P1 := ScanLine[Trunc(yr)];
for x := 1 to Width - 1 do
begin
if (xr >= 0) and (xr <= W) then
begin
P2[x] := P1[Trunc(xr)];
end
else
begin
P2[x] := 0;
end;
xr := xr + xstep;
end;
end
else
begin
for x := 1 to Width - 1 do
begin
P2[x] := 0;
end;
end;
xr := xstart;
yr := yr + ystep;
end;
end;
 
procedure TDIB.DoBlur(DIB2: TDIB);
var
P1, P2: PByteArray;
W: Integer;
x, y: Integer;
begin
W := WidthBytes;
for y := 1 to Height - 1 do
begin
P1 := ScanLine[y];
P2 := DIB2.ScanLine[y];
for x := 1 to Width - 1 do
begin
P2[x] := (P1[x] + P1[x - 1] + P1[x + 1] + P1[x + W] + P1[x - W]) div 5;
end;
end;
end;
 
procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte);
var
P1, P2: PByteArray;
W, H: Integer;
begin
P1 := ScanLine[DIB2.Height - 1];
P2 := DIB2.ScanLine[DIB2.Height - 1];
W := WidthBytes;
H := Height;
asm
PUSH ESI
PUSH EDI
MOV ESI, P1
MOV EDI, P2
MOV EDX, W
MOV EAX, H
IMUL EDX
MOV ECX, EAX
@@1:
MOV AL, Step
MOV AH, [ESI]
CMP AL, AH
JB @@2
MOV AL, AH
@@2:
MOV [EDI], AL
INC ESI
INC EDI
DEC ECX
JNZ @@1
POP EDI
POP ESI
end;
end;
 
procedure TDIB.FillDIB8(Color: Byte);
var
P: PByteArray;
W, H: Integer;
begin
P := ScanLine[Height - 1];
W := WidthBytes;
H := Height;
asm
PUSH ESI
MOV ESI, P
MOV EDX, W
MOV EAX, H
IMUL EDX
MOV ECX, EAX
MOV AL, Color
@@1:
MOV [ESI], AL
INC ESI
DEC ECX
JNZ @@1
POP ESI
end;
end;
 
procedure TDIB.DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
type
T3Byte = array[0..2] of Byte;
P3ByteArray = ^T3ByteArray;
T3ByteArray = array[0..32767] of T3Byte;
PLongArray = ^TLongArray;
TLongArray = array[0..32767] of LongInt;
var
p, p2: PByteArray;
x, y, x2, y2, angled: Integer;
cosy, siny: real;
begin
angled := 384 + Angle;
for y := 0 to Height - 1 do
begin
p := DIB1.ScanLine[y];
cosy := (y - cY) * dcos(angled and $1FF);
siny := (y - cY) * dsin(angled and $1FF);
for x := 0 to Width - 1 do
begin
x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX;
y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY;
case bitcount of
8:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
p2 := ScanLine[y2];
p[x] := p2[Width - x2];
end
else
begin
if p[x] > 4 then
p[x] := p[x] - 4
else
p[x] := 0;
end;
end;
16:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
PWordArray(p2) := ScanLine[y2];
PWordArray(p)[x] := PWordArray(p2)[Width - x2];
end
else
begin
if PWordArray(p)[x] > 4 then
PWordArray(p)[x] := PWordArray(p)[x] - 4
else
PWordArray(p)[x] := 0;
end;
end;
24:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
P3ByteArray(p2) := ScanLine[y2];
P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2];
end
else
begin
if P3ByteArray(p)[x][0] > 4 then
P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 4
else if P3ByteArray(p)[x][1] > 4 then
P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 4
else if P3ByteArray(p)[x][2] > 4 then
P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 4
else
begin
P3ByteArray(p)[x][0] := 0;
P3ByteArray(p)[x][1] := 0;
P3ByteArray(p)[x][2] := 0;
end;
end;
end;
32: begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
plongarray(p2) := ScanLine[y2];
plongarray(p)[x] := plongarray(p2)[Width - x2];
end
else
begin
if plongarray(p)[x] > 4 then
plongarray(p)[x] := plongarray(p)[x] - 4
else
plongarray(p)[x] := 0;
end;
end;
end
end;
end;
end;
 
function TDIB.Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
type
T3Byte = array[0..2] of Byte;
P3ByteArray = ^T3ByteArray;
T3ByteArray = array[0..32767] of T3Byte;
PLongArray = ^TLongArray;
TLongArray = array[0..32767] of LongInt;
function ColorToRGBTriple(const Color: TColor): TRGBTriple;
begin
with RESULT do
begin
rgbtRed := GetRValue(Color);
rgbtGreen := GetGValue(Color);
rgbtBlue := GetBValue(Color)
end
end {ColorToRGBTriple};
 
function TestQuad(T: T3Byte; Color: Integer): Boolean;
begin
Result := (T[0] > GetRValue(Color)) and
(T[1] > GetGValue(Color)) and
(T[2] > GetBValue(Color))
end;
var
p0, p, p2: PByteArray;
x, y, c: Integer;
z: Integer;
begin
if SprayInit then
begin
DIB.Assign(Self);
{ Spray seeds }
for c := 0 to AmountSpray do
begin
DIB.Pixels[Random(Width - 1), Random(Height - 1)] := 0;
end;
end;
Result := True; {all is black}
for y := 0 to DIB.Height - 1 do
begin
p := DIB.ScanLine[y];
for x := 0 to DIB.Width - 1 do
begin
case bitcount of
8:
begin
if p[x] < 16 then
begin
if p[x] > 0 then Result := False;
if y > 0 then
begin
p0 := DIB.ScanLine[y - 1];
if p0[x] > 4 then
p0[x] := p0[x] - 4
else
p0[x] := 0;
if x > 0 then
if p0[x - 1] > 2 then
p0[x - 1] := p0[x - 1] - 2
else
p0[x - 1] := 0;
if x < (DIB.Width - 1) then
if p0[x + 1] > 2 then
p0[x + 1] := p0[x + 1] - 2
else
p0[x + 1] := 0;
end;
if y < (DIB.Height - 1) then
begin
p2 := DIB.ScanLine[y + 1];
if p2[x] > 4 then
p2[x] := p2[x] - 4
else
p2[x] := 0;
if x > 0 then
if p2[x - 1] > 2 then
p2[x - 1] := p2[x - 1] - 2
else
p2[x - 1] := 0;
if x < (DIB.Width - 1) then
if p2[x + 1] > 2 then
p2[x + 1] := p2[x + 1] - 2
else
p2[x + 1] := 0;
end;
if p[x] > 8 then
p[x] := p[x] - 8
else
p[x] := 0;
if x > 0 then
if p[x - 1] > 4 then
p[x - 1] := p[x - 1] - 4
else
p[x - 1] := 0;
if x < (DIB.Width - 1) then
if p[x + 1] > 4 then
p[x + 1] := p[x + 1] - 4
else
p[x + 1] := 0;
end;
end;
16:
begin
if pwordarray(p)[x] < 16 then
begin
if pwordarray(p)[x] > 0 then Result := False;
if y > 0 then
begin
pwordarray(p0) := DIB.ScanLine[y - 1];
if pwordarray(p0)[x] > 4 then
pwordarray(p0)[x] := pwordarray(p0)[x] - 4
else
pwordarray(p0)[x] := 0;
if x > 0 then
if pwordarray(p0)[x - 1] > 2 then
pwordarray(p0)[x - 1] := pwordarray(p0)[x - 1] - 2
else
pwordarray(p0)[x - 1] := 0;
if x < (DIB.Width - 1) then
if pwordarray(p0)[x + 1] > 2 then
pwordarray(p0)[x + 1] := pwordarray(p0)[x + 1] - 2
else
pwordarray(p0)[x + 1] := 0;
end;
if y < (DIB.Height - 1) then
begin
pwordarray(p2) := DIB.ScanLine[y + 1];
if pwordarray(p2)[x] > 4 then
pwordarray(p2)[x] := pwordarray(p2)[x] - 4
else
pwordarray(p2)[x] := 0;
if x > 0 then
if pwordarray(p2)[x - 1] > 2 then
pwordarray(p2)[x - 1] := pwordarray(p2)[x - 1] - 2
else
pwordarray(p2)[x - 1] := 0;
if x < (DIB.Width - 1) then
if pwordarray(p2)[x + 1] > 2 then
pwordarray(p2)[x + 1] := pwordarray(p2)[x + 1] - 2
else
pwordarray(p2)[x + 1] := 0;
end;
if pwordarray(p)[x] > 8 then
pwordarray(p)[x] := pwordarray(p)[x] - 8
else
pwordarray(p)[x] := 0;
if x > 0 then
if pwordarray(p)[x - 1] > 4 then
pwordarray(p)[x - 1] := pwordarray(p)[x - 1] - 4
else
pwordarray(p)[x - 1] := 0;
if x < (DIB.Width - 1) then
if pwordarray(p)[x + 1] > 4 then
pwordarray(p)[x + 1] := pwordarray(p)[x + 1] - 4
else
pwordarray(p)[x + 1] := 0;
end;
end;
24:
begin
if not TestQuad(P3ByteArray(p)[x], 16) then
begin
if TestQuad(P3ByteArray(p)[x], 0) then Result := False;
if y > 0 then
begin
P3ByteArray(p0) := DIB.ScanLine[y - 1];
if TestQuad(P3ByteArray(p0)[x], 4) then
begin
for z := 0 to 2 do
if P3ByteArray(p0)[x][z] > 4 then
P3ByteArray(p0)[x][z] := P3ByteArray(p0)[x][z] - 4
end
else
for z := 0 to 2 do
P3ByteArray(p0)[x][z] := 0;
if x > 0 then
if TestQuad(P3ByteArray(p0)[x - 1], 2) then
begin
for z := 0 to 2 do
if P3ByteArray(p0)[x - 1][z] > 2 then
P3ByteArray(p0)[x - 1][z] := P3ByteArray(p0)[x - 1][z] - 2
end
else
for z := 0 to 2 do
P3ByteArray(p0)[x - 1][z] := 0;
if x < (DIB.Width - 1) then
if TestQuad(P3ByteArray(p0)[x + 1], 2) then
begin
for z := 0 to 2 do
if P3ByteArray(p0)[x + 1][z] > 2 then
P3ByteArray(p0)[x + 1][z] := P3ByteArray(p0)[x + 1][z] - 2
end
else
for z := 0 to 2 do
P3ByteArray(p0)[x + 1][z] := 0;
end;
if y < (DIB.Height - 1) then
begin
P3ByteArray(p2) := DIB.ScanLine[y + 1];
if TestQuad(P3ByteArray(p2)[x], 4) then
begin
for z := 0 to 2 do
if P3ByteArray(p2)[x][z] > 4 then
P3ByteArray(p2)[x][z] := P3ByteArray(p2)[x][z] - 4
end
else
for z := 0 to 2 do
P3ByteArray(p2)[x][z] := 0;
if x > 0 then
if TestQuad(P3ByteArray(p2)[x - 1], 2) then
begin
for z := 0 to 2 do
if P3ByteArray(p2)[x - 1][z] > 2 then
P3ByteArray(p2)[x - 1][z] := P3ByteArray(p2)[x - 1][z] - 2
end
else
for z := 0 to 2 do
P3ByteArray(p2)[x - 1][z] := 0;
if x < (DIB.Width - 1) then
if TestQuad(P3ByteArray(p2)[x + 1], 2) then
begin
for z := 0 to 2 do
if P3ByteArray(p2)[x + 1][z] > 2 then
P3ByteArray(p2)[x + 1][z] := P3ByteArray(p2)[x + 1][z] - 2
end
else
for z := 0 to 2 do
P3ByteArray(p2)[x + 1][z] := 0;
end;
if TestQuad(P3ByteArray(p)[x], 8) then
begin
for z := 0 to 2 do
if P3ByteArray(p)[x][z] > 8 then
P3ByteArray(p)[x][z] := P3ByteArray(p)[x][z] - 8
end
else
for z := 0 to 2 do
P3ByteArray(p)[x][z] := 0;
if x > 0 then
if TestQuad(P3ByteArray(p)[x - 1], 4) then
begin
for z := 0 to 2 do
if P3ByteArray(p)[x - 1][z] > 4 then
P3ByteArray(p)[x - 1][z] := P3ByteArray(p)[x - 1][z] - 4
end
else
for z := 0 to 2 do
P3ByteArray(p)[x - 1][z] := 0;
if x < (DIB.Width - 1) then
if TestQuad(P3ByteArray(p)[x + 1], 4) then
begin
for z := 0 to 2 do
if P3ByteArray(p)[x + 1][z] > 4 then
P3ByteArray(p)[x + 1][z] := P3ByteArray(p)[x + 1][z] - 4
end
else
for z := 0 to 2 do
P3ByteArray(p)[x + 1][z] := 0;
end;
end;
32:
begin
if plongarray(p)[x] < 16 then
begin
if plongarray(p)[x] > 0 then Result := False;
if y > 0 then
begin
plongarray(p0) := DIB.ScanLine[y - 1];
if plongarray(p0)[x] > 4 then
plongarray(p0)[x] := plongarray(p0)[x] - 4
else
plongarray(p0)[x] := 0;
if x > 0 then
if plongarray(p0)[x - 1] > 2 then
plongarray(p0)[x - 1] := plongarray(p0)[x - 1] - 2
else
plongarray(p0)[x - 1] := 0;
if x < (DIB.Width - 1) then
if plongarray(p0)[x + 1] > 2 then
plongarray(p0)[x + 1] := plongarray(p0)[x + 1] - 2
else
plongarray(p0)[x + 1] := 0;
end;
if y < (DIB.Height - 1) then
begin
plongarray(p2) := DIB.ScanLine[y + 1];
if plongarray(p2)[x] > 4 then
plongarray(p2)[x] := plongarray(p2)[x] - 4
else
plongarray(p2)[x] := 0;
if x > 0 then
if plongarray(p2)[x - 1] > 2 then
plongarray(p2)[x - 1] := plongarray(p2)[x - 1] - 2
else
plongarray(p2)[x - 1] := 0;
if x < (DIB.Width - 1) then
if plongarray(p2)[x + 1] > 2 then
plongarray(p2)[x + 1] := plongarray(p2)[x + 1] - 2
else
plongarray(p2)[x + 1] := 0;
end;
if plongarray(p)[x] > 8 then
plongarray(p)[x] := plongarray(p)[x] - 8
else
plongarray(p)[x] := 0;
if x > 0 then
if plongarray(p)[x - 1] > 4 then
plongarray(p)[x - 1] := plongarray(p)[x - 1] - 4
else
plongarray(p)[x - 1] := 0;
if x < (DIB.Width - 1) then
if plongarray(p)[x + 1] > 4 then
plongarray(p)[x + 1] := plongarray(p)[x + 1] - 4
else
plongarray(p)[x + 1] := 0;
end;
end;
end {case};
end;
end;
end;
 
procedure TDIB.Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
type
T3Byte = array[0..2] of Byte;
P3ByteArray = ^T3ByteArray;
T3ByteArray = array[0..32767] of T3Byte;
PLongArray = ^TLongArray;
TLongArray = array[0..32767] of LongInt;
var
p, p2: PByteArray;
x, y, x2, y2, angled, ysqr: Integer;
actdist, dist, cosy, siny: real;
begin
dist := Factor * sqrt(sqr(cX) + sqr(cY));
for y := 0 to DIB1.Height - 1 do
begin
p := DIB1.ScanLine[y];
ysqr := sqr(y - cY);
for x := 0 to (DIB1.Width) - 1 do
begin
actdist := (sqrt((sqr(x - cX) + ysqr)) / dist);
if dt = dtSlow then
actdist := dsin((Trunc(actdist * 1024)) and $1FF);
angled := 384 + Trunc((actdist) * Angle);
 
cosy := (y - cY) * dcos(angled and $1FF);
siny := (y - cY) * dsin(angled and $1FF);
 
x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX;
y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY;
case bitcount of
8:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
p2 := ScanLine[y2];
p[x] := p2[Width - x2];
end
else
begin
if p[x] > 2 then
p[x] := p[x] - 2
else
p[x] := 0;
end;
end;
16:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
pwordarray(p2) := ScanLine[y2];
pwordarray(p)[x] := pwordarray(p2)[Width - x2];
end
else
begin
if pwordarray(p)[x] > 2 then
pwordarray(p)[x] := pwordarray(p)[x] - 2
else
pwordarray(p)[x] := 0;
end;
end;
24:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
P3ByteArray(p2) := ScanLine[y2];
P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2];
end
else
begin
if P3ByteArray(p)[x][0] > 2 then
P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 2
else if P3ByteArray(p)[x][1] > 2 then
P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 2
else if P3ByteArray(p)[x][2] > 2 then
P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 2
else
begin
P3ByteArray(p)[x][0] := 0;
P3ByteArray(p)[x][1] := 0;
P3ByteArray(p)[x][2] := 0;
end;
end;
end;
32:
begin
if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
begin
plongarray(p2) := ScanLine[y2];
plongarray(p)[x] := plongarray(p2)[Width - x2];
end
else
begin
if p[x] > 2 then
plongarray(p)[x] := plongarray(p)[x] - 2
else
plongarray(p)[x] := 0;
end;
end;
end {case}
end;
end;
end;
 
procedure TDIB.AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor);
//anti-aliased line using the Wu algorithm by Peter Bone
var
dX, dY, X, Y, start, finish: Integer;
LM, LR: Integer;
dxi, dyi, dydxi: Integer;
P: PLines;
R, G, B: byte;
begin
R := GetRValue(Color);
G := GetGValue(Color);
B := GetBValue(Color);
dX := abs(x2 - x1); // Calculate deltax and deltay for initialisation
dY := abs(y2 - y1);
if (dX = 0) or (dY = 0) then
begin
Canvas.Pen.Color := (B shl 16) + (G shl 8) + R;
Canvas.MoveTo(x1, y1);
Canvas.LineTo(x2, y2);
exit;
end;
if dX > dY then
begin // horizontal or vertical
if y2 > y1 then // determine rise and run
dydxi := -dY shl 16 div dX
else
dydxi := dY shl 16 div dX;
if x2 < x1 then
begin
start := x2; // right to left
finish := x1;
dyi := y2 shl 16;
end
else
begin
start := x1; // left to right
finish := x2;
dyi := y1 shl 16;
dydxi := -dydxi; // inverse slope
end;
if finish >= Width then finish := Width - 1;
for X := start to finish do
begin
Y := dyi shr 16;
if (X < 0) or (Y < 0) or (Y > Height - 2) then
begin
Inc(dyi, dydxi);
Continue;
end;
LM := dyi - Y shl 16; // fractional part of dyi - in fixed-point
LR := 65536 - LM;
P := Scanline[Y];
P^[X].B := (B * LR + P^[X].B * LM) shr 16;
P^[X].G := (G * LR + P^[X].G * LM) shr 16;
P^[X].R := (R * LR + P^[X].R * LM) shr 16;
//Inc(Y);
P^[X].B := (B * LM + P^[X].B * LR) shr 16;
P^[X].G := (G * LM + P^[X].G * LR) shr 16;
P^[X].R := (R * LM + P^[X].R * LR) shr 16;
Inc(dyi, dydxi); // next point
end;
end
else
begin
if x2 > x1 then // determine rise and run
dydxi := -dX shl 16 div dY
else
dydxi := dX shl 16 div dY;
if y2 < y1 then
begin
start := y2; // right to left
finish := y1;
dxi := x2 shl 16;
end
else
begin
start := y1; // left to right
finish := y2;
dxi := x1 shl 16;
dydxi := -dydxi; // inverse slope
end;
if finish >= Height then finish := Height - 1;
for Y := start to finish do
begin
X := dxi shr 16;
if (Y < 0) or (X < 0) or (X > Width - 2) then
begin
Inc(dxi, dydxi);
Continue;
end;
LM := dxi - X shl 16;
LR := 65536 - LM;
P := Scanline[Y];
P^[X].B := (B * LR + P^[X].B * LM) shr 16;
P^[X].G := (G * LR + P^[X].G * LM) shr 16;
P^[X].R := (R * LR + P^[X].R * LM) shr 16;
Inc(X);
P^[X].B := (B * LM + P^[X].B * LR) shr 16;
P^[X].G := (G * LM + P^[X].G * LR) shr 16;
P^[X].R := (R * LM + P^[X].R * LR) shr 16;
Inc(dxi, dydxi); // next point
end;
end;
end;
 
function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
FromPoint, ToPoint: Extended): TColor;
var F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;
function CalcColorBytes(fb1, fb2: Byte): Byte;
begin
result := fb1;
if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1));
if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2));
end;
begin
if Pointvalue <= FromPoint then
begin
result := StartColor;
exit;
end;
if Pointvalue >= ToPoint then
begin
result := EndColor;
exit;
end;
F := (Pointvalue - FromPoint) / (ToPoint - FromPoint);
asm
mov EAX, Startcolor
cmp EAX, EndColor
je @@exit //when equal then exit
mov r1, AL
shr EAX,8
mov g1, AL
shr EAX,8
mov b1, AL
mov EAX, Endcolor
mov r2, AL
shr EAX,8
mov g2, AL
shr EAX,8
mov b2, AL
push ebp
mov AL, r1
mov DL, r2
call CalcColorBytes
pop ECX
push EBP
Mov r3, AL
mov DL, g2
mov AL, g1
call CalcColorBytes
pop ECX
push EBP
mov g3, Al
mov DL, B2
mov Al, B1
call CalcColorBytes
pop ECX
mov b3, AL
XOR EAX,EAX
mov AL, B3
shl EAX,8
mov AL, G3
shl EAX,8
mov AL, R3
@@Exit:
mov @result, EAX
end;
end;
 
procedure TDIB.ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; iRadius: Word);
var
tempColor: TColor;
const
WavelengthMinimum = 380;
WavelengthMaximum = 780;
 
procedure SetColor(Color: TColor);
begin
Canvas.Pen.Color := Color;
Canvas.Brush.Color := Color;
tempColor := Color
end {SetColor};
 
function WL2RGB(const Wavelength: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
const
Gamma = 0.80;
IntensityMax = 255;
var
Red, Blue, Green, Factor: Double;
 
function Adjust(const Color, Factor: Double): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if Color = 0.0 then Result := 0
else Result := Round(IntensityMax * Power(Color * Factor, Gamma))
end {Adjust};
begin
case Trunc(Wavelength) of
380..439:
begin
Red := -(Wavelength - 440) / (440 - 380);
Green := 0.0;
Blue := 1.0
end;
440..489:
begin
Red := 0.0;
Green := (Wavelength - 440) / (490 - 440);
Blue := 1.0
end;
490..509:
begin
Red := 0.0;
Green := 1.0;
Blue := -(Wavelength - 510) / (510 - 490)
end;
510..579:
begin
Red := (Wavelength - 510) / (580 - 510);
Green := 1.0;
Blue := 0.0
end;
580..644:
begin
Red := 1.0;
Green := -(Wavelength - 645) / (645 - 580);
Blue := 0.0
end;
645..780:
begin
Red := 1.0;
Green := 0.0;
Blue := 0.0
end;
else
Red := 0.0;
Green := 0.0;
Blue := 0.0
end;
case Trunc(Wavelength) of
380..419: factor := 0.3 + 0.7 * (Wavelength - 380) / (420 - 380);
420..700: factor := 1.0;
701..780: factor := 0.3 + 0.7 * (780 - Wavelength) / (780 - 700)
else
factor := 0.0
end;
Result := RGB(Adjust(Red, Factor), Adjust(Green, Factor), Adjust(Blue, Factor));
end;
 
function Rainbow(const fraction: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if (fraction < 0.0) or (fraction > 1.0) then Result := clBlack
else
Result := WL2RGB(WavelengthMinimum + Fraction * (WavelengthMaximum - WavelengthMinimum))
end {Raindbow};
 
function ColorInterpolate(const fraction: Double; const Color1, Color2: TColor): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
var
complement: Double;
R1, R2, G1, G2, B1, B2: BYTE;
begin
if fraction <= 0 then Result := Color1
else
if fraction >= 1.0 then Result := Color2
else
begin
R1 := GetRValue(Color1);
G1 := GetGValue(Color1);
B1 := GetBValue(Color1);
R2 := GetRValue(Color2);
G2 := GetGValue(Color2);
B2 := GetBValue(Color2);
complement := 1.0 - fraction;
Result := RGB(Round(complement * R1 + fraction * R2),
Round(complement * G1 + fraction * G2),
Round(complement * B1 + fraction * B2))
end
end {ColorInterpolate};
 
// Conversion utility routines
function ColorToRGBTriple(const Color: TColor): TRGBTriple; {$IFDEF VER9UP}inline;{$ENDIF}
begin
with Result do
begin
rgbtRed := GetRValue(Color);
rgbtGreen := GetGValue(Color);
rgbtBlue := GetBValue(Color)
end
end {ColorToRGBTriple};
 
function RGBTripleToColor(const Triple: TRGBTriple): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
begin
Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue)
end {RGBTripleToColor};
// Bresenham's Line Algorithm. Byte, March 1988, pp. 249-253.
var
a, b, d, diag_inc, dXdg, dXndg, dYdg, dYndg, i, nDginc, nDswap, x, y: Integer;
begin {DrawLine}
x := iStart.X;
y := iStart.Y;
a := iEnd.X - iStart.X;
b := iEnd.Y - iStart.Y;
if a < 0 then
begin
a := -a;
dXdg := -1
end
else dXdg := 1;
if b < 0 then
begin
b := -b;
dYdg := -1
end
else dYdg := 1;
if a < b then
begin
nDswap := a;
a := b;
b := nDswap;
dXndg := 0;
dYndg := dYdg
end
else
begin
dXndg := dXdg;
dYndg := 0
end;
d := b + b - a;
nDginc := b + b;
diag_inc := b + b - a - a;
for i := 0 to a do
begin
case iPixelGeometry of
pgPoint:
case iColorStyle of
csSolid:
Canvas.Pixels[x, y] := tempColor;
csGradient:
Canvas.Pixels[x, y] := ColorInterpolate(i / a, iGradientFrom, iGradientTo);
csRainbow:
Canvas.Pixels[x, y] := Rainbow(i / a)
end;
pgCircular:
begin
case iColorStyle of
csSolid: ;
csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo));
csRainbow: SetColor(Rainbow(i / a))
end;
Canvas.Ellipse(x - iRadius, y - iRadius, x + iRadius, y + iRadius)
end;
pgRectangular:
begin
case iColorStyle of
csSolid: ;
csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo));
csRainbow: SetColor(Rainbow(i / a))
end;
Canvas.Rectangle(x - iRadius, y - iRadius, x + iRadius, y + iRadius)
end
end;
if d < 0 then
begin
Inc(x, dXndg);
Inc(y, dYndg);
Inc(d, nDginc);
end
else
begin
Inc(x, dXdg);
Inc(y, dYdg);
Inc(d, diag_inc);
end
end
end {Line};
 
procedure TDIB.DoNovaEffect(sr, sg, sb, cx, cy, radius,
nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
// Copyright (c) 2000 by Keith Murray (kmurray@hotfreeware.com)
// All rights reserved.
// Adapted for DIB by JB.
type
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
PDoubleArray = ^TDoubleArray;
TDoubleArray = array[0..32767] of Double;
PIntegerArray = ^TIntegerArray;
TIntegerArray = array[0..32767] of Integer;
type
TProgressEvent = procedure(progress: Integer; message: string;
var cancel: Boolean) of object;
const
M_PI = 3.14159265358979323846;
RAND_MAX = 2147483647;
 
function Gauss: double;
const magnitude = 6;
var
sum: double;
i: Integer;
begin
sum := 0;
for i := 1 to magnitude do
sum := sum + (randgauss / 2147483647);
result := sum / magnitude;
end;
 
function Clamp(i, l, h: double): double; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if i < l then
result := l
else
if i > h then
result := h
else
result := i;
end;
 
function IClamp(i, l, h: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if i < l then
result := l
else if i > h then
result := h
else result := i;
end;
 
procedure rgb_to_hsl(r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF}
{$IFNDEF VER4UP}
function Max(a, b: Double): Double;
begin
Result := a; if b > a then Result := b;
end;
function Min(a, b: Double): Double;
begin
Result := a; if b < a then Result := b;
end;
{$ENDIF}
var
v, m, vm: Double;
r2, g2, b2: Double;
begin
h := 0;
s := 0;
l := 0;
v := Max(r, g);
v := Max(v, b);
m := Min(r, g);
m := Min(m, b);
l := (m + v) / 2.0;
if l <= 0.0 then
exit;
vm := v - m;
s := vm;
if s > 0.0 then
begin
if l <= 0.5 then
s := s / (v + m)
else s := s / (2.0 - v - m);
end
else exit;
r2 := (v - 4) / vm;
g2 := (v - g) / vm;
b2 := (v - b) / vm;
if r = v then
begin
if g = m then
h := b2 + 5.0
else h := 1.0 - g2;
end
else if g = v then
begin
if b = m then
h := 1.0 + r2
else h := 3.0 - b2;
end
else
begin
if r = m then
h := 3.0 + g2
else h := 5.0 - r2;
end;
h := h / 6;
end;
 
procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF}
var
v: Double;
m, sv: Double;
sextant: Integer;
fract, vsf, mid1, mid2: Double;
begin
if l <= 0.5 then
v := l * (1.0 + sl)
else v := l + sl - l * sl;
if v <= 0 then
begin
r := 0.0;
g := 0.0;
b := 0.0;
end
else
begin
m := l + l - v;
sv := (v - m) / v;
h := h * 6.0;
sextant := Trunc(h);
fract := h - sextant;
vsf := v * sv * fract;
mid1 := m + vsf;
mid2 := v - vsf;
case sextant of
0:
begin
r := v; g := mid1; b := m;
end;
1:
begin
r := mid2; g := v; b := m;
end;
2:
begin
r := m; g := v; b := mid1;
end;
3:
begin
r := m; g := mid2; b := v;
end;
4:
begin
r := mid1; g := m; b := v;
end;
5:
begin
r := v; g := m; b := mid2;
end;
end;
end;
end;
 
var
src_row, dest_row: PByte;
src, dest: PByteArray;
color, colors: array[0..3] of Integer;
SpokeColor: PIntegerArray;
spoke: PDoubleArray;
x1, y1, x2, y2, row, col, x, y, alpha, has_alpha, bpp, progress, max_progress, xc, yc, i, j: Integer;
u, v, l, l0, w, w1, c, nova_alpha, src_alpha, new_alpha, compl_ratio, ratio, r, g, b, h, s, lu, SpokeCol: Double;
dstDIB: TDIB;
begin
colors[0] := sr;
colors[1] := sg;
colors[2] := sb;
new_alpha := 0;
 
GetMem(spoke, NSpokes * sizeof(Double));
GetMem(spokecolor, NSpokes * sizeof(Integer) * 3);
dstDIB := TDIB.Create;
dstDIB.Assign(Self);
dstDIB.Canvas.Brush.Color := clBlack;
dstDIB.Canvas.FillRect(dstDIB.Canvas.ClipRect);
try
rgb_to_hsl(colors[0] / 255.0, colors[1] / 255.0, colors[2] / 255.0, h, s, lu);
 
for i := 0 to NSpokes - 1 do
begin
spoke[i] := gauss;
h := h + randomhue / 360.0 * ({Random(RAND_MAX)}RandomSpok / RAND_MAX - 0.5);
if h < 0 then
h := h + 1.0
else if h > 1.0 then
h := h - 1.0;
hsl_to_rgb(h, s, lu, r, g, b);
spokecolor[3 * i + 0] := Trunc(255 * r);
spokecolor[3 * i + 1] := Trunc(255 * g);
spokecolor[3 * i + 2] := Trunc(255 * b);
end;
 
xc := cx;
yc := cy;
l0 := (x2 - xc) / 4 + 1;
bpp := Self.BitCount div 8;
has_alpha := 0;
alpha := bpp;
y := 0;
for row := 0 to Self.Height - 1 do begin
src_row := Self.ScanLine[row];
dest_row := dstDIB.ScanLine[row];
src := Pointer(src_row);
dest := Pointer(dest_row);
x := 0;
for col := 0 to Self.Width - 1 do begin
u := (x - xc) / radius;
v := (y - yc) / radius;
l := sqrt((u * u) + (v * v));
c := (arctan2(u, v) / (2 * M_PI) + 0.51) * NSpokes;
i := floor(c);
c := c - i;
i := i mod NSpokes;
w1 := spoke[i] * (1 - c) + spoke[(i + 1) mod NSpokes] * c;
w1 := w1 * w1;
w := 1 / (l + 0.001) * 0.9;
nova_alpha := Clamp(w, 0.0, 1.0);
ratio := nova_alpha;
compl_ratio := 1.0 - ratio;
for j := 0 to alpha - 1 do
begin
spokecol := spokecolor[3 * i + j] * (1.0 - c) + spokecolor[3 * ((i + 1) mod nspokes) + j] * c;
if w > 1.0 then
color[j] := IClamp(Trunc(spokecol * w), 0, 255)
else
color[j] := Trunc(src[j] * compl_ratio + spokecol * ratio);
color[j] := Trunc(color[j] + 255 * Clamp(w1 * w, 0.0, 1.0));
dest[j] := IClamp(color[j], 0, 255);
end;
inc(Integer(src), bpp);
inc(Integer(dest), bpp);
inc(x);
end;
inc(y);
end;
finally
Self.Assign(dstDIB);
dstDIB.Free;
FreeMem(Spoke);
FreeMem(SpokeColor);
end;
end;
 
procedure TDIB.DrawMandelbrot(ao, au: Integer; bo, bu: Double);
var
c1, c2, z1, z2, tmp: Double;
i, j, Count: Integer;
dstDIB: TDIB;
X, Y: Double;
X2, Y2: Integer;
begin
dstDIB := TDIB.Create;
dstDIB.Assign(Self);
X2 := dstDIB.FWidth;
Y2 := dstDIB.FHeight;
{as Example
ao := 1;
au := -2;
bo := 1.5;
bu := -1.5;
}
X := (ao - au) / dstDIB.FWidth;
Y := (bo - bu) / dstDIB.FHeight;
try
c2 := bu;
for i := 10 to X2 do
begin
c1 := au;
for j := 0 to Y2 do
begin
z1 := 0;
z2 := 0;
Count := 0;
{count is deep of iteration of the mandelbrot set
if |z| >=2 then z is not a member of a mandelset}
while (((z1 * z1 + z2 * z2 < 4) and (Count <= 90))) do
begin
tmp := z1;
z1 := z1 * z1 - z2 * z2 + c1;
z2 := 2 * tmp * z2 + c2;
Inc(Count);
end;
//the color-palette depends on TColor(n*count mod t)
dstDIB.Canvas.Pixels[j, i] := (16 * Count mod 255);
c1 := c1 + X;
end;
c2 := c2 + Y;
end;
finally
Self.Assign(dstDIB);
dstDIB.Free;
end;
end;
 
procedure TDIB.SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
{Note: when depth parameter set to 0 will produce black and white picture only}
var
color, color2: longint;
r, g, b, rr, gg: byte;
h, w: Integer;
p0: pbytearray;
x, y: Integer;
begin
if Self.BitCount = 24 then
begin
Self.DoGrayScale;
for y := 0 to Self.Height - 1 do
begin
p0 := Self.ScanLine[y];
for x := 0 to Self.Width - 1 do
begin
r := p0[x * 3];
g := p0[x * 3 + 1];
b := p0[x * 3 + 2];
rr := r + (depth * 2);
gg := g + depth;
if rr <= ((depth * 2) - 1) then
rr := 255;
if gg <= (depth - 1) then
gg := 255;
p0[x * 3] := rr;
p0[x * 3 + 1] := gg;
p0[x * 3 + 2] := b;
end;
end;
Exit
end;
{this alogorithm is slower because does not use scanline property}
for h := 0 to Self.Height-1 do
begin
for w := 0 to Self.Width-1 do
begin
//first convert the bitmap to greyscale
color := ColorToRGB(Self.Canvas.Pixels[w, h]);
r := GetRValue(color);
g := GetGValue(color);
b := GetBValue(color);
color2 := (r + g + b) div 3;
Self.Canvas.Pixels[w, h] := RGB(color2, color2, color2);
//then convert it to sepia
color := ColorToRGB(Self.Canvas.Pixels[w, h]);
r := GetRValue(color);
g := GetGValue(color);
b := GetBValue(color);
rr := r + (depth * 2);
gg := g + depth;
if rr <= ((depth * 2) - 1) then
rr := 255;
if gg <= (depth - 1) then
gg := 255;
Self.Canvas.Pixels[w, h] := RGB(rr, gg, b);
end;
end;
 
end;
 
procedure TDIB.EncryptDecrypt(const Key: Integer);
{for decript call it again}
var
BytesPorScan: Integer;
w, h: Integer;
p: pByteArray;
begin
try
BytesPorScan := Abs(Integer(Self.ScanLine[1]) -
Integer(Self.ScanLine[0]));
except
raise Exception.Create('Error ');
end;
RandSeed := Key;
for h := 0 to Self.Height - 1 do
begin
P := Self.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
P^[w] := P^[w] xor Random(256);
end;
end;
 
procedure TDIB.LinePolar(x, y: Integer; AngleInDegree, Length: extended; Color: cardinal);
var
xp, yp: Integer;
begin
xp := Round(Sin(AngleInDegree * Pi / 180) * Length) + x;
yp := Round(Cos(AngleInDegree * Pi / 180) * Length) + y;
AntialiasedLine(x, y, xp, yp, Color);
end;
 
//y = 0.299*g + 0.587*b + 0.114*r;
 
procedure TDIB.BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: byte);
var
cR, cG, cB: byte;
aR, aG, aB: byte;
dColor: Cardinal;
begin
aR := GetRValue(aColor);
aG := GetGValue(aColor);
aB := GetBValue(aColor);
dColor := Self.Canvas.Pixels[x, y];
cR := GetRValue(dColor);
cG := GetGValue(dColor);
cB := GetBValue(dColor);
Canvas.Pixels[x, y] := RGB((Alpha * (aR - cR) shr 8) + cR, // R alpha
(Alpha * (aG - cG) shr 8) + cG, // G alpha
(Alpha * (aB - cB) shr 8) + cB); // B alpha
end;
 
 
procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP} overload; {$ENDIF}
begin
DIB := TDIB.Create;
DIB.SetSize(iWidth, iHeight, iBitCount);
DIB.Fill(iFillColor);
end;
 
procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDib2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP} overload; {$ENDIF}
begin
DIB := TDIB.Create;
if Assigned(iBitmap) then
DIB.CreateDIBFromBitmap(iBitmap)
else
DIB.Fill(clBlack);
end;
 
initialization
TPicture.RegisterClipBoardFormat(CF_DIB, TDIB);
TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB);
/VCL_DELPHIX_D6/DShow.pas
22,7 → 22,9
 
{$Z4}
{$A+}
{$IfNDef D7UP}
{$WEAKPACKAGEUNIT}
{$EndIf}
 
uses Windows, ActiveX, DirectX, MMSystem;
 
1887,10 → 1889,10
 
IDirectDrawMediaStream = interface(IMediaStream)
['{F4104FCE-9A70-11d0-8FDE-00C04FD9189D}']
function GetFormat(var pDDSDCurrent: DDSURFACEDESC;
function GetFormat(var pDDSDCurrent: TDDSURFACEDESC;
out ppDirectDrawPalette: IDirectDrawPalette;
var pDDSDDesired: DDSURFACEDESC; var pdwFlags: DWORD): HResult; stdcall;
function SetFormat(const pDDSurfaceDesc: DDSURFACEDESC;
var pDDSDDesired: TDDSURFACEDESC; var pdwFlags: DWORD): HResult; stdcall;
function SetFormat(const pDDSurfaceDesc: TDDSURFACEDESC;
pDirectDrawPalette: IDirectDrawPalette): HResult; stdcall;
function GetDirectDraw(out ppDirectDraw: IDirectDraw): HResult; stdcall;
function SetDirectDraw(pDirectDraw: IDirectDraw): HResult; stdcall;
2620,9 → 2622,9
// IDirectDrawVideo methods
function GetSwitches(var pSwitches: DWORD): HResult; stdcall;
function SetSwitches(pSwitches: DWORD): HResult; stdcall;
function GetCaps(var pCaps: DDCAPS): HResult; stdcall;
function GetEmulatedCaps(var pCaps: DDCAPS): HResult; stdcall;
function GetSurfaceDesc(var pSurfaceDesc: DDSURFACEDESC): HResult; stdcall;
function GetCaps(var pCaps: TDDCAPS): HResult; stdcall;
function GetEmulatedCaps(var pCaps: TDDCAPS): HResult; stdcall;
function GetSurfaceDesc(var pSurfaceDesc: TDDSURFACEDESC): HResult; stdcall;
function GetFourCCCodes(var pCount, pCodes: DWORD): HResult; stdcall;
function SetDirectDraw(pDirectDraw: IDirectDraw): HResult; stdcall;
function GetDirectDraw(out ppDirectDraw: IDirectDraw): HResult; stdcall;
3001,23 → 3003,23
// of structures. If the pointer to the array is NULL, first parameter
// returns the total number of formats supported.
function GetVideoFormats(var lpNumFormats: DWORD;
const lpddpfFormats: DDPIXELFORMAT): HResult; stdcall;
const lpddpfFormats: TDDPIXELFORMAT): HResult; stdcall;
 
// retrives maximum pixels per second rate expected for a given
// format and a given scaling factor. If decoder does not support
// those scaling factors, then it gives the rate and the nearest
// scaling factors.
function GetMaxPixelRate(const ddpfFormat: DDPIXELFORMAT;
function GetMaxPixelRate(const ddpfFormat: TDDPIXELFORMAT;
lpdwZoomHeight, lpdwZoomWidth: DWORD;
var lpdwMaxPixelsPerSecond: DWORD): HResult; stdcall;
 
// retrives various properties of the decoder for a given format
function GetVideoSignalInfo(const ddpfFormat: DDPIXELFORMAT;
function GetVideoSignalInfo(const ddpfFormat: TDDPIXELFORMAT;
var lpAMVideoSignalInfo: TAMVideoSignalInfo): HResult; stdcall;
 
// asks the decoder to ouput in this format. Return value should give
// appropriate error code
function SetVideoFormat(const ddpfFormat: DDPIXELFORMAT): HResult; stdcall;
function SetVideoFormat(const ddpfFormat: TDDPIXELFORMAT): HResult; stdcall;
 
// asks the decoder to treat even fields like odd fields and visa versa
function SetInvertPolarity: HResult; stdcall;
3185,13 → 3187,13
 
// informs the callee of the videoformats supported by the videoport
function InformVPInputFormats(dwNumFormats: DWORD;
const pDDPixelFormats: DDPIXELFORMAT): HResult; stdcall;
const pDDPixelFormats: TDDPIXELFORMAT): HResult; stdcall;
 
// gets the various formats supported by the decoder in an array
// of structures. If the pointer to the array is NULL, first parameter
// returns the total number of formats supported.
function GetVideoFormats(var pdwNumFormats: DWORD;
var pddPixelFormats: DDPIXELFORMAT): HResult; stdcall;
var pddPixelFormats: TDDPIXELFORMAT): HResult; stdcall;
 
// sets the format entry chosen (0, 1, .. ,(dwNumProposedEntries-1))
function SetVideoFormat(dwChosenEntry: DWORD): HResult; stdcall;
3269,10 → 3271,10
// this function gets the overlay surface that the mixer is using
function GetOverlaySurface(out ppOverlaySurface: IDirectDrawSurface): HResult; stdcall;
// this functions sets the color-controls, if the chip supports it.
function SetColorControls(const pColorControl: DDCOLORCONTROL): HResult; stdcall;
function SetColorControls(const pColorControl: TDDCOLORCONTROL): HResult; stdcall;
// this functions also returns the capability of the hardware in the dwFlags
// value of the struct.
function GetColorControls(var pColorControl: DDCOLORCONTROL): HResult; stdcall;
function GetColorControls(var pColorControl: TDDCOLORCONTROL): HResult; stdcall;
end;
 
// interface IVPVBINotify
/VCL_DELPHIX_D6/DXClass.pas
5,7 → 5,15
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem, DirectX;
Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem, Graphics, {$IFDEF _DMO_}MultiMon,{$ENDIF}
{$IfDef StandardDX}
{$IfDef DX9}
Direct3D, DirectInput,
{$EndIf}
DirectDraw, DirectSound;
{$Else}
DirectX;
{$EndIf}
 
type
 
50,6 → 58,46
property Drivers[Index: Integer]: TDirectXDriver read GetDriver; default;
end;
 
{$IFDEF _DMO_}
{ TDirectXDriverEx }
 
TDirectXDriverEx = class(TCollectionItem)
private
FGUID: PGUID;
FGUID2: TGUID;
FDescription: string;
FDriverName: string;
FMonitor: HMonitor;
FMonitorInfo: TMonitorInfo;
procedure SetGUID(Value: PGUID);
function ConvertHMonitor(iMonitor: HMonitor): TMonitorInfo;
function GetMonitorInfo: TMonitorInfo;
function GetFlags: DWORD;
function GetTempSpace: TRect;
function GetWorkSpace: TRect;
public
property GUID: PGUID read FGUID write SetGUID;
property Monitor: HMonitor read FMonitor write FMonitor;
property MonitorInfo: TMonitorInfo read GetMonitorInfo;
published
property Description: string read FDescription write FDescription;
property DriverName: string read FDriverName write FDriverName;
property WorkSpace: TRect read GetWorkSpace;
property TempSpace: TRect read GetTempSpace;
property Flags: DWORD read GetFlags;
end;
 
{ TDirectXDriversEx }
 
TDirectXDriversEx = class(TCollection)
private
function GetDriver(Index: Integer): TDirectXDriverEx;
public
constructor Create;
property Drivers[Index: Integer]: TDirectXDriverEx read GetDriver; default;
end;
{$ENDIF}
{ TDXForm }
 
TDXForm = class(TForm)
170,20 → 218,137
function IndexOf(const Name: string): Integer;
end;
 
function Max(Val1, Val2: Integer): Integer;
function Min(Val1, Val2: Integer): Integer;
{Addapted from RXLib.PicClip}
 
{ TPicClip }
TCellRange = 1..MaxInt;
 
TDXPictureClip = class(TComponent)
private
FPicture: TPicture;
FRows: TCellRange;
FCols: TCellRange;
FBitmap: TBitmap;
FMasked: Boolean;
FMaskColor: TColor;
FOnChange: TNotifyEvent;
procedure CheckIndex(Index: Integer);
function GetCell(Col, Row: Cardinal): TBitmap;
function GetGraphicCell(Index: Integer): TBitmap;
function GetDefaultMaskColor: TColor;
function GetIsEmpty: Boolean;
function GetCount: Integer;
function GetHeight: Integer;
function GetWidth: Integer;
function IsMaskStored: Boolean;
procedure PictureChanged(Sender: TObject);
procedure SetHeight(Value: Integer);
procedure SetPicture(Value: TPicture);
procedure SetWidth(Value: Integer);
procedure SetMaskColor(Value: TColor);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure Changed; dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function GetIndex(Col, Row: Cardinal): Integer;
procedure Draw(Canvas: TCanvas; X, Y, Index: Integer);
procedure DrawCenter(Canvas: TCanvas; Rect: TRect; Index: Integer);
property Cells[Col, Row: Cardinal]: TBitmap read GetCell;
property GraphicCell[Index: Integer]: TBitmap read GetGraphicCell;
property IsEmpty: Boolean read GetIsEmpty;
property Count: Integer read GetCount;
published
property Cols: TCellRange read FCols write FCols default 1;
property Height: Integer read GetHeight write SetHeight stored False;
property Masked: Boolean read FMasked write FMasked default True;
property Rows: TCellRange read FRows write FRows default 1;
property Picture: TPicture read FPicture write SetPicture;
property MaskColor: TColor read FMaskColor write SetMaskColor stored IsMaskStored;
property Width: Integer read GetWidth write SetWidth stored False;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
 
function Max(Val1, Val2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
function Min(Val1, Val2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
 
function Cos256(i: Integer): Double;
function Sin256(i: Integer): Double;
 
function PointInRect(const Point: TPoint; const Rect: TRect): Boolean;
function RectInRect(const Rect1, Rect2: TRect): Boolean;
function OverlapRect(const Rect1, Rect2: TRect): Boolean;
function PointInRect(const Point: TPoint; const Rect: TRect): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function RectInRect(const Rect1, Rect2: TRect): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function OverlapRect(const Rect1, Rect2: TRect): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
function WideRect(ALeft, ATop, AWidth, AHeight: Integer): TRect;
function WideRect(ALeft, ATop, AWidth, AHeight: Integer): TRect; {$IFDEF VER9UP}inline;{$ENDIF}
 
{ Transformations routines}
 
const
L_Curve = 0;//The left curve
R_Curve = 1;//The right curve
 
C_Add = 0;//Increase (BTC)
C_Dec = 1;//Decrease (ETC)
 
Type
TDblPoint = packed record
X, Y: Double;
end;
TSngPoint = packed record //SinglePoint
X, Y: Single;
end;
 
 
//Transformation matrix
T2DRowCol = Array[1..3] of Array[1..3] of Double;
T2DVector = Array[1..3] of Double;
//Distance between 2 points
function Get2PointRange(a,b: TDblPoint):Double;
//From vector angular calculation
function Get256(dX,dY: Double):Double;
//The angular calculation of the A from B
function GetARadFromB(A,B: TDblPoint):Double;
 
//It calculates the TDblPoint
function DblPoint(a,b:Double):TDblPoint;
//It converts the TDboPoint to the TPoint
function TruncDblPoint(DblPos: TDblPoint): TPoint;
 
function GetPointFromRangeAndAngle(SP: TDblPoint; Range,Angle: Double): TDblPoint;
 
function Ini2DRowCol: T2DRowCol;
function Trans2DRowCol(x,y:double):T2DRowCol;
function Scale2DRowCol(x,y:double):T2DRowCol;
function Rotate2DRowCol(Theta:double):T2DRowCol;
function RotateIntoX2DRowCol(x,y: double):T2DRowCol;
function Multiply2DRowCol(A,B:T2DRowCol):T2DRowCol;
function ScaleAt2DRowCol(x,y,Sx,Sy:double):T2DRowCol;
function ReflectAcross2DRowCol(x,y,dx,dy:Double): T2DRowCol;
function Apply2DVector(V:T2DVector; M:T2DRowCol): T2DVector;
function RotateAround2DRowCol(x,y,Theta:Double): T2DRowCol;
 
//Collision decision
function PointInCircle(PPos,CPos: TPoint; R: integer): Boolean;
function CircleInCircle(C1Pos,C2Pos: TPoint; R1,R2:Integer): Boolean;
function SegmentInCircle(SPos,EPos,CPos: TPoint; R: Integer): Boolean;
 
//If A is closer than B from starting point S, the True is returned.
function CheckNearAThanB(S,A,B: TDblPoint): Boolean;
 
//The Angle of 256 period is returned
function Angle256(Angle: Single): Single;
 
{ Support functions }
 
procedure ReleaseCom(out Com);
function DXLoadLibrary(const FileName, FuncName: string): TFarProc;
 
{ Simple helper }
 
procedure Log(const Co: string; const FName: string{$IFDEF VER4UP} = 'c:\logerr.txt'{$ENDIF});
 
implementation
 
uses DXConsts;
690,8 → 855,763
Result := -1;
end;
 
{ TDXPictureClip }
 
constructor TDXPictureClip.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FBitmap := TBitmap.Create;
FRows := 1;
FCols := 1;
FMaskColor := GetDefaultMaskColor;
FMasked := True;
end;
 
destructor TDXPictureClip.Destroy;
begin
FOnChange := nil;
FPicture.OnChange := nil;
FBitmap.Free;
FPicture.Free;
inherited Destroy;
end;
 
procedure TDXPictureClip.Assign(Source: TPersistent);
begin
if Source is TDXPictureClip then begin
with TDXPictureClip(Source) do begin
Self.FRows := Rows;
Self.FCols := Cols;
Self.FMasked := Masked;
Self.FMaskColor := MaskColor;
Self.FPicture.Assign(FPicture);
end;
end
else if (Source is TPicture) or (Source is TGraphic) then
FPicture.Assign(Source)
else inherited Assign(Source);
end;
 
type
THack = class(TImageList);
 
procedure TDXPictureClip.AssignTo(Dest: TPersistent);
var
I: Integer;
SaveChange: TNotifyEvent;
begin
if (Dest is TPicture) then Dest.Assign(FPicture)
else if (Dest is TImageList) and not IsEmpty then begin
with TImageList(Dest) do begin
SaveChange := OnChange;
try
OnChange := nil;
Clear;
Width := Self.Width;
Height := Self.Height;
for I := 0 to Self.Count - 1 do begin
if Self.Masked and (MaskColor <> clNone) then
TImageList(Dest).AddMasked(GraphicCell[I], MaskColor)
else TImageList(Dest).Add(GraphicCell[I], nil);
end;
Masked := Self.Masked;
finally
OnChange := SaveChange;
end;
THack(Dest).Change;
end;
end
else inherited AssignTo(Dest);
end;
 
procedure TDXPictureClip.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
 
function TDXPictureClip.GetIsEmpty: Boolean;
begin
Result := not Assigned(Picture) or Picture.Graphic.Empty;
end;
 
function TDXPictureClip.GetCount: Integer;
begin
if IsEmpty then Result := 0
else Result := Cols * Rows;
end;
const
{ TBitmap.GetTransparentColor from GRAPHICS.PAS uses this value }
PaletteMask = $02000000;
 
procedure TDXPictureClip.Draw(Canvas: TCanvas; X, Y, Index: Integer);
 
function PaletteColor(Color: TColor): Longint;
begin
Result := ColorToRGB(Color) or PaletteMask;
end;
procedure StretchBltTransparent(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; Palette: HPalette;
TransparentColor: TColorRef);
var
Color: TColorRef;
bmAndBack, bmAndObject, bmAndMem, bmSave: HBitmap;
bmBackOld, bmObjectOld, bmMemOld, bmSaveOld: HBitmap;
MemDC, BackDC, ObjectDC, SaveDC: HDC;
palDst, palMem, palSave, palObj: HPalette;
begin
{ Create some DCs to hold temporary data }
BackDC := CreateCompatibleDC(DstDC);
ObjectDC := CreateCompatibleDC(DstDC);
MemDC := CreateCompatibleDC(DstDC);
SaveDC := CreateCompatibleDC(DstDC);
{ Create a bitmap for each DC }
bmAndObject := CreateBitmap(SrcW, SrcH, 1, 1, nil);
bmAndBack := CreateBitmap(SrcW, SrcH, 1, 1, nil);
bmAndMem := CreateCompatibleBitmap(DstDC, DstW, DstH);
bmSave := CreateCompatibleBitmap(DstDC, SrcW, SrcH);
{ Each DC must select a bitmap object to store pixel data }
bmBackOld := SelectObject(BackDC, bmAndBack);
bmObjectOld := SelectObject(ObjectDC, bmAndObject);
bmMemOld := SelectObject(MemDC, bmAndMem);
bmSaveOld := SelectObject(SaveDC, bmSave);
{ Select palette }
palDst := 0; palMem := 0; palSave := 0; palObj := 0;
if Palette <> 0 then begin
palDst := SelectPalette(DstDC, Palette, True);
RealizePalette(DstDC);
palSave := SelectPalette(SaveDC, Palette, False);
RealizePalette(SaveDC);
palObj := SelectPalette(ObjectDC, Palette, False);
RealizePalette(ObjectDC);
palMem := SelectPalette(MemDC, Palette, True);
RealizePalette(MemDC);
end;
{ Set proper mapping mode }
SetMapMode(SrcDC, GetMapMode(DstDC));
SetMapMode(SaveDC, GetMapMode(DstDC));
{ Save the bitmap sent here }
BitBlt(SaveDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SRCCOPY);
{ Set the background color of the source DC to the color, }
{ contained in the parts of the bitmap that should be transparent }
Color := SetBkColor(SaveDC, PaletteColor(TransparentColor));
{ Create the object mask for the bitmap by performing a BitBlt() }
{ from the source bitmap to a monochrome bitmap }
BitBlt(ObjectDC, 0, 0, SrcW, SrcH, SaveDC, 0, 0, SRCCOPY);
{ Set the background color of the source DC back to the original }
SetBkColor(SaveDC, Color);
{ Create the inverse of the object mask }
BitBlt(BackDC, 0, 0, SrcW, SrcH, ObjectDC, 0, 0, NOTSRCCOPY);
{ Copy the background of the main DC to the destination }
BitBlt(MemDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, SRCCOPY);
{ Mask out the places where the bitmap will be placed }
StretchBlt(MemDC, 0, 0, DstW, DstH, ObjectDC, 0, 0, SrcW, SrcH, SRCAND);
{ Mask out the transparent colored pixels on the bitmap }
BitBlt(SaveDC, 0, 0, SrcW, SrcH, BackDC, 0, 0, SRCAND);
{ XOR the bitmap with the background on the destination DC }
StretchBlt(MemDC, 0, 0, DstW, DstH, SaveDC, 0, 0, SrcW, SrcH, SRCPAINT);
{ Copy the destination to the screen }
BitBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0,
SRCCOPY);
{ Restore palette }
if Palette <> 0 then begin
SelectPalette(MemDC, palMem, False);
SelectPalette(ObjectDC, palObj, False);
SelectPalette(SaveDC, palSave, False);
SelectPalette(DstDC, palDst, True);
end;
{ Delete the memory bitmaps }
DeleteObject(SelectObject(BackDC, bmBackOld));
DeleteObject(SelectObject(ObjectDC, bmObjectOld));
DeleteObject(SelectObject(MemDC, bmMemOld));
DeleteObject(SelectObject(SaveDC, bmSaveOld));
{ Delete the memory DCs }
DeleteDC(MemDC);
DeleteDC(BackDC);
DeleteDC(ObjectDC);
DeleteDC(SaveDC);
end;
procedure StretchBitmapTransparent(Dest: TCanvas; Bitmap: TBitmap;
TransparentColor: TColor; DstX, DstY, DstW, DstH, SrcX, SrcY,
SrcW, SrcH: Integer);
var
CanvasChanging: TNotifyEvent;
begin
if DstW <= 0 then DstW := Bitmap.Width;
if DstH <= 0 then DstH := Bitmap.Height;
if (SrcW <= 0) or (SrcH <= 0) then begin
SrcX := 0; SrcY := 0;
SrcW := Bitmap.Width;
SrcH := Bitmap.Height;
end;
if not Bitmap.Monochrome then
SetStretchBltMode(Dest.Handle, STRETCH_DELETESCANS);
CanvasChanging := Bitmap.Canvas.OnChanging;
Bitmap.Canvas.Lock;
try
Bitmap.Canvas.OnChanging := nil;
if TransparentColor = clNone then begin
StretchBlt(Dest.Handle, DstX, DstY, DstW, DstH, Bitmap.Canvas.Handle,
SrcX, SrcY, SrcW, SrcH, Dest.CopyMode);
end
else begin
if TransparentColor = clDefault then
TransparentColor := Bitmap.Canvas.Pixels[0, Bitmap.Height - 1];
if Bitmap.Monochrome then TransparentColor := clWhite
else TransparentColor := ColorToRGB(TransparentColor);
StretchBltTransparent(Dest.Handle, DstX, DstY, DstW, DstH,
Bitmap.Canvas.Handle, SrcX, SrcY, SrcW, SrcH, Bitmap.Palette,
TransparentColor);
end;
finally
Bitmap.Canvas.OnChanging := CanvasChanging;
Bitmap.Canvas.Unlock;
end;
end;
procedure DrawBitmapTransparent(Dest: TCanvas; DstX, DstY: Integer;
Bitmap: TBitmap; TransparentColor: TColor);
begin
StretchBitmapTransparent(Dest, Bitmap, TransparentColor, DstX, DstY,
Bitmap.Width, Bitmap.Height, 0, 0, Bitmap.Width, Bitmap.Height);
end;
var
Image: TGraphic;
begin
if Index < 0 then Image := Picture.Graphic
else Image := GraphicCell[Index];
if (Image <> nil) and not Image.Empty then begin
if FMasked and (FMaskColor <> clNone) and
(Picture.Graphic is TBitmap) then
DrawBitmapTransparent(Canvas, X, Y, TBitmap(Image), FMaskColor)
else Canvas.Draw(X, Y, Image);
end;
end;
 
procedure TDXPictureClip.DrawCenter(Canvas: TCanvas; Rect: TRect; Index: Integer);
var
X, Y: Integer;
begin
X := (Rect.Left + Rect.Right - Width) div 2;
Y := (Rect.Bottom + Rect.Top - Height) div 2;
Draw(Canvas, X, Y, Index);
end;
 
procedure TDXPictureClip.CheckIndex(Index: Integer);
begin
if (Index >= Cols * Rows) or (Index < 0) then
raise EListError.CreateFmt('%s (%d)', ['Load list error', Index]);
end;
 
function TDXPictureClip.GetIndex(Col, Row: Cardinal): Integer;
begin
Result := Col + (Row * Cols);
if (Result >= Cols * Rows) or IsEmpty then Result := -1;
end;
 
function TDXPictureClip.GetCell(Col, Row: Cardinal): TBitmap;
begin
Result := GetGraphicCell(GetIndex(Col, Row));
end;
 
function TDXPictureClip.GetGraphicCell(Index: Integer): TBitmap;
procedure AssignBitmapCell(Source: TGraphic; Dest: TBitmap; Cols, Rows,
Index: Integer);
var
CellWidth, CellHeight: Integer;
begin
if (Source <> nil) and (Dest <> nil) then begin
if Cols <= 0 then Cols := 1;
if Rows <= 0 then Rows := 1;
if Index < 0 then Index := 0;
CellWidth := Source.Width div Cols;
CellHeight := Source.Height div Rows;
with Dest do begin
Width := CellWidth; Height := CellHeight;
end;
if Source is TBitmap then begin
Dest.Canvas.CopyRect(Bounds(0, 0, CellWidth, CellHeight),
TBitmap(Source).Canvas, Bounds((Index mod Cols) * CellWidth,
(Index div Cols) * CellHeight, CellWidth, CellHeight));
Dest.TransparentColor := TBitmap(Source).TransparentColor;
end
else begin
Dest.Canvas.Brush.Color := clSilver;
Dest.Canvas.FillRect(Bounds(0, 0, CellWidth, CellHeight));
Dest.Canvas.Draw(-(Index mod Cols) * CellWidth,
-(Index div Cols) * CellHeight, Source);
end;
Dest.Transparent := Source.Transparent;
end;
end;
begin
CheckIndex(Index);
AssignBitmapCell(Picture.Graphic, FBitmap, Cols, Rows, Index);
if Picture.Graphic is TBitmap then
if FBitmap.PixelFormat <> pfDevice then
FBitmap.PixelFormat := TBitmap(Picture.Graphic).PixelFormat;
FBitmap.TransparentColor := FMaskColor or PaletteMask;
FBitmap.Transparent := (FMaskColor <> clNone) and Masked;
Result := FBitmap;
end;
 
function TDXPictureClip.GetDefaultMaskColor: TColor;
begin
Result := clOlive;
if (Picture.Graphic <> nil) and (Picture.Graphic is TBitmap) then
Result := TBitmap(Picture.Graphic).TransparentColor and
not PaletteMask;
end;
 
function TDXPictureClip.GetHeight: Integer;
begin
Result := Picture.Height div FRows;
end;
 
function TDXPictureClip.GetWidth: Integer;
begin
Result := Picture.Width div FCols;
end;
 
function TDXPictureClip.IsMaskStored: Boolean;
begin
Result := MaskColor <> GetDefaultMaskColor;
end;
 
procedure TDXPictureClip.SetMaskColor(Value: TColor);
begin
if Value <> FMaskColor then begin
FMaskColor := Value;
Changed;
end;
end;
 
procedure TDXPictureClip.PictureChanged(Sender: TObject);
begin
FMaskColor := GetDefaultMaskColor;
if not (csReading in ComponentState) then Changed;
end;
 
procedure TDXPictureClip.SetHeight(Value: Integer);
begin
if (Value > 0) and (Picture.Height div Value > 0) then
Rows := Picture.Height div Value;
end;
 
procedure TDXPictureClip.SetWidth(Value: Integer);
begin
if (Value > 0) and (Picture.Width div Value > 0) then
Cols := Picture.Width div Value;
end;
 
procedure TDXPictureClip.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;
 
{ Transformations routines }
{ Authorisation: Mr. Takanori Kawasaki}
 
//Distance between 2 points is calculated
function Get2PointRange(a,b: TDblPoint):Double;
var
x,y: Double;
begin
x := a.X - b.X;
y := a.Y - b.Y;
Result := Sqrt(x*x+y*y);
end;
 
//Direction angle in the coordinate A which was seen from coordinate B is calculated
function GetARadFromB(A,B: TDblPoint):Double;
var
dX,dY: Double;
begin
dX := A.X - B.X;
dY := A.Y - B.Y;
Result := Get256(dX,dY);
end;
 
//Direction angle is returned with 0 - 255.
function Get256(dX,dY:Double):Double;
begin
Result := 0;
if dX > 0 then
begin//0-63
if dY > 0 then Result := ArcTan(dY / dX) // 0 < Res < 90
else//0
if dY = 0 then Result := 0 // 0
else//192-255
if dY < 0 then Result := 2*Pi + ArcTan(dY / dX) // 270 < Res < 360
end else
if dX = 0 then
begin//64
if dY > 0 then Result := 1 / 2 * Pi // 90
else//0
if dY = 0 then Result := 0 // 0
else//192
if dY < 0 then Result := 3 / 2 * Pi // 270
end else
if dX < 0 then
begin//64-127
if dY > 0 then Result := Pi + ArcTan(dY / dX) // 90 < Res < 180
else//128
if dY = 0 then Result := Pi // 180
else//128-191
if dY < 0 then Result := Pi + ArcTan(dY / dX) // 180 < Res < 270
end;
Result := 256 * Result / (2*Pi);
end;
 
//From the coordinate SP the Range it calculates the point which leaves with the angular Angle
function GetPointFromRangeAndAngle(SP: TDblPoint; Range,Angle: Double): TDblPoint;
begin
Result.X := SP.X + Range * Cos(Angle);
Result.Y := SP.Y + Range * Sin(Angle);
end;
 
//* As for coordinate transformation coordinate for mathematics is used
//Identity matrix for the 2d is returned.
function Ini2DRowCol: T2DRowCol;
var
i,ii:integer;
begin
for i := 1 to 3 do
for ii := 1 to 3 do
if i = ii then Result[i,ii] := 1 else Result[i,ii] := 0;
end;
 
//Transformation matrix of the portable quantity
//where the one for 2d is appointed is returned.
function Trans2DRowCol(x,y:double):T2DRowCol;
begin
Result := Ini2DRowCol;
Result[3,1] := x;
Result[3,2] := y;
end;
 
//Conversion coordinate of the expansion and contraction
//quantity where the one for 2d is appointed is returned.
function Scale2DRowCol(x,y:double):T2DRowCol;
begin
Result := Ini2DRowCol;
Result[1,1] := x;
Result[2,2] := y;
end;
 
//Coordinate transformation of the rotary quantity
//where the one for 2d is appointed is returned.
function Rotate2DRowCol(Theta:double):T2DRowCol;
begin
Result := Ini2DRowCol;
Result[1,1] := Cos256(Trunc(Theta));
Result[1,2] := Sin256(Trunc(Theta));
Result[2,1] := -1 * Result[1,2];
Result[2,2] := Result[1,1];
end;
 
//You apply two conversion coordinates and adjust.
function Multiply2DRowCol(A,B:T2DRowCol):T2DRowCol;
begin
Result[1,1] := A[1,1] * B[1,1] + A[1,2] * B[2,1];
Result[1,2] := A[1,1] * B[1,2] + A[1,2] * B[2,2];
Result[1,3] := 0;
Result[2,1] := A[2,1] * B[1,1] + A[2,2] * B[2,1];
Result[2,2] := A[2,1] * B[1,2] + A[2,2] * B[2,2];
Result[2,3] := 0;
Result[3,1] := A[3,1] * B[1,1] + A[3,2] * B[2,1] + B[3,1];
Result[3,2] := A[3,1] * B[1,2] + A[3,2] * B[2,2] + B[3,2];
Result[3,3] := 1;
end;
 
//Until coordinate (the X and the Y) comes on the X axis,
//the conversion coordinate which turns the position
//of the point is returned.
function RotateIntoX2DRowCol(x,y: double):T2DRowCol;
var
d: double;
begin
Result := Ini2DRowCol;
d := sqrt(x*x+y*y);
Result[1,1] := x / d;
Result[1,2] := y / d;
Result[2,1] := -1 * Result[1,2];
Result[2,2] := Result[1,1];
end;
 
//Coordinate (the X and the Y) as a center, the conversion
//coordinate which does the scaling of the magnification ratio
//which is appointed with the Sx and the Sy is returned.
function ScaleAt2DRowCol(x,y,Sx,Sy:double):T2DRowCol;
var
T,S,TInv,M:T2DRowCol;
begin
T := Trans2DRowCol(-x,-y);
TInv := Trans2DRowCol(x,y);
S := Scale2DRowCol(Sx,Sy);
M := Multiply2DRowCol(T,S);
Result := Multiply2DRowCol(M,T);
end;
 
//Coordinate (the X and the Y) it passes, comes hard and
//(DX and the dy) with the direction which is shown it
//returns the transformation matrix which does the reflected
//image conversion which centers the line which faces.
function ReflectAcross2DRowCol(x,y,dx,dy:Double): T2DRowCol;
var
T,R,S,RInv,TInv,M1,M2,M3: T2DRowCol;
begin
T := Trans2DRowCol(-x,-y);
TInv := Trans2DRowCol(x,y);
R := RotateIntoX2DRowCol(dx,dy);
RInv := RotateIntoX2DRowCol(dx,-dy);
S := Scale2DRowCol(1,-1);
M1 := Multiply2DRowCol(T,R);
M2 := Multiply2DRowCol(S,RInv);
M3 := Multiply2DRowCol(M1,M2);
Result := Multiply2DRowCol(M3,TInv);
end;
 
//Coordinate focusing on (the X and the Y) the transformation
//matrix which turns the position of the point with angle Theta is returned.
function RotateAround2DRowCol(x,y,Theta:Double): T2DRowCol;
var
T,R,TInv,M: T2DRowCol;
begin
T := Trans2DRowCol(-x,-y);
TInv := Trans2DRowCol(x,y);
R := Rotate2DRowCol(Theta);
M := Multiply2DRowCol(T,R);
Result := Multiply2DRowCol(M,TInv);
end;
 
//Transformation matrix is applied to the point.
function Apply2DVector(V:T2DVector; M:T2DRowCol): T2DVector;
begin
Result[1] := V[1] * M[1,1] + V[2] * M[2,1] + M[3,1];
Result[2] := V[1] * M[1,2] + V[2] * M[2,2] + M[3,2];
Result[3] := 1;
end;
 
//The TDblPoint is returned
function DblPoint(a,b:Double):TDblPoint;
begin
Result.X := a;
Result.Y := b;
end;
 
function TruncDblPoint(DblPos: TDblPoint): TPoint;
begin
Result.X := Trunc(DblPos.X);
Result.Y := Trunc(DblPos.Y);
end;
{
+-----------------------------------------------------------------------------+
|Collision decision |
+-----------------------------------------------------------------------------+}
 
//Point and circle
function PointInCircle(PPos,CPos: TPoint; R: integer): Boolean;
begin
Result := (PPos.X - CPos.X)*(PPos.X - CPos.X)+(PPos.Y - CPos.Y)*(PPos.Y - CPos.Y)<= R*R;
end;
 
//Circle and circle
function CircleInCircle(C1Pos,C2Pos: TPoint; R1,R2:Integer): Boolean;
begin
Result := (C1Pos.X - C2Pos.X)*(C1Pos.X - C2Pos.X)+(C1Pos.Y - C2Pos.Y)*(C1Pos.Y - C2Pos.Y) <= (R1+R2)*(R1+R2);
end;
 
//Circle and line segment
function SegmentInCircle(SPos,EPos,CPos: TPoint; R: Integer): Boolean;
var
V,C: TPoint;
VC,VV,CC:integer;
begin
Result := False;
V.X := EPos.X - SPos.X; V.Y := EPos.Y - SPos.Y;
C.X := CPos.X - SPos.X; C.Y := CPos.Y - SPos.Y;
VC := V.X * C.X + V.Y * C.Y;
if VC < 0 then
begin
Result := (C.X * C.X + C.Y * C.Y) <= R*R;
end
else
begin
VV := V.X * V.X + V.Y * V.Y;
if VC >= VV then
begin
Result := (EPos.X - CPos.X)*(EPos.X - CPos.X)+(EPos.Y - CPos.Y)*(EPos.Y - CPos.Y) <= R * R;
end
else
if VC < VV then
begin
CC := C.X * C.X + C.Y * C.Y;
Result := CC - (VC div VV)* VC <= R*R;
end;
end;
end;
 
//Angle recalc
function Angle256(Angle: Single): Single;
begin
Result := Angle;
While Result < 0 do Result := Result + 256;
While Result >= 256 do Result := Result -256;
end;
 
//If A is closer than B from starting point S, the True is returned.
function CheckNearAThanB(S,A,B: TDblPoint): Boolean;
begin
Result := (S.X-A.X)*(S.X-A.X)+(S.Y-A.Y)*(S.Y-A.Y) <= (S.X-B.X)*(S.X-B.X)+(S.Y-B.Y)*(S.Y-B.Y);
end;
 
function CircumCenter3Pt(const x1, y1, x2, y2, x3, y3: Single; out Px, Py: Single): Boolean;
var
A,B,C,D,E,F,G: Single;
begin
A := x2 - x1;
B := y2 - y1;
C := x3 - x1;
D := y3 - y1;
E := A * (x1 + x2) + B * (y1 + y2);
F := C * (x1 + x3) + D * (y1 + y3);
G := 2.0 * (A * (y3 - y2) - B * (x3 - x2));
Result := G <> 0.0;
if Result then begin
Px := (D * E - B * F) / G;
Py := (A * F - C * E) / G;
end;
end;
 
function Distance(const x1, y1, x2, y2: Double): Double;
begin
Result := Sqrt(Sqr(y2 - y1) + Sqr(x2 - x1));
end;
 
procedure InCenter(const x1, y1, x2, y2, x3, y3: Double; out Px, Py: Double);
var
Perim: Double;
Side12: Double;
Side23: Double;
Side31: Double;
begin
Side12 := Distance(x1, y1, x2, y2);
Side23 := Distance(x2, y2, x3, y3);
Side31 := Distance(x3, y3, x1, y1);
{ Using Heron's S=UR }
Perim := 1.0 / (Side12 + Side23 + Side31);
Px := (Side23 * x1 + Side31 * x2 + Side12 * x3) * Perim;
Py := (Side23 * y1 + Side31 * y2 + Side12 * y3) * Perim;
end;
 
function PointInTriangle(const Px, Py, x1, y1, x2, y2, x3, y3: Double): Boolean;
function Orientation(const x1, y1, x2, y2, Px, Py: Double): Integer;
var
Orin: Double;
begin
(* Linear determinant of the 3 points *)
Orin := (x2 - x1) * (py - y1) - (px - x1) * (y2 - y1);
 
if Orin > 0.0 then
Result := +1 (* Orientaion is to the right-hand side *)
else if Orin < 0.0 then
Result := -1 (* Orientaion is to the left-hand side *)
else
Result := 0; (* Orientaion is neutral aka collinear *)
end;
var
Or1, Or2, Or3: Integer;
begin
Or1 := Orientation(x1, y1, x2, y2, Px, Py);
Or2 := Orientation(x2, y2, x3, y3, Px, Py);
Or3 := Orientation(x3, y3, x1, y1, Px, Py);
 
if (Or1 = Or2) and (Or2 = Or3) then
Result := True
else if Or1 = 0 then
Result := (Or2 = 0) or (Or3 = 0)
else if Or2 = 0 then
Result := (Or1 = 0) or (Or3 = 0)
else if Or3 = 0 then
Result := (Or2 = 0) or (Or1 = 0)
else
Result := False;
end;
 
procedure Log(const Co: string; const FName: string);
var F: Text; D: TDateTime;
Hour, Minute, Second, MSec: Word;
begin
AsSignFile(F, FName);
if FileExists(FName) then Append(F)
else ReWrite(F);
try
D := Now;
DecodeTime(D, Hour, Minute, Second, MSec);
WriteLn(F, DateToStr(D) + ' ' + IntToStr(Hour)+':'+IntToStr(Minute)+':'+IntToStr(Second)+ '.'+IntToStr(MSec) +' ' + Co);
finally
CloseFile(F);
end;
end;
 
{$IFDEF _DMO_}
 
{ TDirectXDriverEx }
 
function TDirectXDriverEx.ConvertHMonitor(iMonitor: HMonitor): TMonitorInfo;
begin
ZeroMemory(@Result, sizeof(Result));
Result.cbSize := SizeOf(Result);
MultiMon.GetMonitorInfo(iMonitor, @Result);
end;
 
function TDirectXDriverEx.GetFlags: DWORD;
begin
Result := ConvertHMonitor(FMonitor).dwFlags;
end;
 
function TDirectXDriverEx.GetMonitorInfo: TMonitorInfo;
begin
Result:= ConvertHMonitor(FMonitor);
end;
 
function TDirectXDriverEx.GetTempSpace: TRect;
begin
Result := ConvertHMonitor(FMonitor).rcWork
end;
 
function TDirectXDriverEx.GetWorkSpace: TRect;
begin
Result := ConvertHMonitor(FMonitor).rcMonitor
end;
 
procedure TDirectXDriverEx.SetGUID(Value: PGUID);
begin
if not IsBadHugeReadPtr(Value, SizeOf(TGUID)) then
begin
FGUID2 := Value^;
FGUID := @FGUID2;
end else
FGUID := Value;
end;
 
{ TDirectXDriversEx }
 
constructor TDirectXDriversEx.Create;
begin
inherited Create(TDirectXDriverEx);
end;
 
function TDirectXDriversEx.GetDriver(Index: Integer): TDirectXDriverEx;
begin
Result := (inherited Items[Index]) as TDirectXDriverEx;
end;
 
{$ENDIF}
 
initialization
InitCosinTable;
finalization
FreeLibList;
end.
end.
/VCL_DELPHIX_D6/DXConsts.pas
22,7 → 22,7
SSession = 'Session';
 
SNotMade = '%s not made';
SStreamNotOpend = 'Stream not opend';
SStreamNotOpend = 'Stream not opened';
SWaveStreamNotSet = 'WaveStream not set';
SCannotMade = '%s cannot be made';
SCannotInitialized = '%s cannot be initialized';
29,7 → 29,7
SCannotChanged = '%s cannot be changed';
SCannotLock = '%s cannot be locked';
SCannotOpened = '%s cannot be opened';
SDLLNotLoaded = '%s not loaded';
SDLLNotLoaded = '%s is not loaded';
SImageNotFound = 'Image ''%s'' not found';
SWaveNotFound = 'Wave ''%s'' not found';
SEffectNotFound = 'Effect ''%s'' not found';
36,32 → 36,32
SListIndexError = 'Index of the list exceeds the range. (%d)';
SScanline = 'Index of the scanning line exceeded the range. (%d)';
SNoForm = 'Form not found';
SSinceDirectX5 = 'Necessary since DirectX 5';
SSinceDirectX6 = 'Necessary since DirectX 6';
SSinceDirectX7 = 'Necessary since DirectX 7';
SSinceDirectX5 = 'Requires DirectX 5.0 or later';
SSinceDirectX6 = 'Requires DirectX 6.0 or later';
SSinceDirectX7 = 'Requires DirectX 7.0 or later';
S3DDeviceNotFound = '3D device not found';
SDisplayModeChange = 'Display mode cannot be changed (%dx%d %dbit)';
SDisplayModeCannotAcquired = 'A present display mode cannot be acquired';
SDisplayModeCannotAcquired = 'Display mode cannot be acquired';
SInvalidDIB = 'DIB is invalid';
SInvalidDIBBitCount = 'Bitcount in invalid (%d)';
SInvalidDIBPixelFormat = 'PixelFormat in invalid';
SInvalidWave = 'Wave is invalid';
SInvalidDisplayBitCount = 'It should be either of 8 or 16 or 24 or 32';
SInvalidDisplayBitCount = 'Display requires 8, 16, 24 or 32 bits';
SInvalidWaveFormat = 'Format is invalid';
SNotSupported = '%s not supported';
SStreamOpend = 'Stream has already been opened';
SNecessaryDirectInputUseMouse = 'DirectInput is necessary to use the mouse';
SStreamOpend = 'Stream is already open';
SNecessaryDirectInputUseMouse = 'DirectInput is required for mouse support';
 
{ DirectPlay }
SDXPlayNotConnectedNow = 'TDXPlay component is not connected now.';
SDXPlayNotConnectedNow = 'TDXPlay component is disconnected.';
SDXPlayProviderNotFound = 'Provider ''%s'' not found';
SDXPlayProviderSpecifiedGUIDNotFound = 'Provider of specified GUID is not found';
SDXPlayProviderSpecifiedGUIDNotFound = 'Provider''s specified GUID is not found';
SDXPlayModemListCannotBeAcquired = 'Modem list cannot be acquired';
SDXPlaySessionListCannotBeAcquired = 'Session list cannot be acquired';
SDXPlaySessionNotFound = 'Session ''%s'' not found';
SDXPlaySessionCannotOpened = 'Session %s cannot be opened';
SDXPlayPlayerNotFound = 'The player of specified ID is not found';
SDXPlayMessageIllegal = 'The message form is illegal';
SDXPlayPlayerNotFound = 'Player''s specified ID is not found';
SDXPlayMessageIllegal = 'Illegal message form';
SDXPlayPlayerNameIsNotSpecified = 'Player name is not specified';
SDXPlaySessionNameIsNotSpecified = 'Session name is not specified';
 
69,12 → 69,11
DXPlayFormComplete = 'Complete';
 
 
SNotSupportGraphicFile = 'Graphic format not suported';
SInvalidDXTFile = 'DXT file is invalid';
SCannotLoadGraphic = 'Can not load graphic';
SOverlay = 'Surface overlay not possible';
SNotSupportGraphicFile = 'This format graphic not suported';
SInvalidDXTFile = 'This DXT file is invalid';
SCannotLoadGraphic = 'Can''t Load this Graphic';
SOverlay = 'Not posible Overlay Surface';
 
const
SDIBSize = '(%dx%d)';
SDIBColor = '%d color';
/VCL_DELPHIX_D6/DXDIBEffectEdit.dfm
0,0 → 1,476
object TDelphiXDIBEffectEditForm: TTDelphiXDIBEffectEditForm
Left = 293
Top = 183
BorderStyle = bsDialog
Caption = 'Special effect'
ClientHeight = 368
ClientWidth = 504
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Bevel3: TBevel
Left = 8
Top = 8
Width = 489
Height = 321
Shape = bsFrame
end
object Panel1: TPanel
Left = 16
Top = 16
Width = 473
Height = 305
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 1
object Bevel1: TBevel
Left = 8
Top = 39
Width = 258
Height = 258
end
object Image1: TImage
Left = 9
Top = 40
Width = 32
Height = 32
AutoSize = True
end
object LSpokes: TLabel
Left = 8
Top = 8
Width = 36
Height = 13
Caption = 'Spokes'
FocusControl = Spokes
end
object LRaHUE: TLabel
Left = 160
Top = 8
Width = 66
Height = 13
Caption = 'Random HUE'
FocusControl = RaHUE
end
object LCentr: TLabel
Left = 312
Top = 8
Width = 57
Height = 13
Caption = 'Nova radius'
FocusControl = Centr
end
object Label4: TLabel
Left = 276
Top = 44
Width = 11
Height = 13
Caption = 'R:'
end
object Label5: TLabel
Left = 276
Top = 76
Width = 11
Height = 13
Caption = 'G:'
end
object Label6: TLabel
Left = 276
Top = 108
Width = 10
Height = 13
Caption = 'B:'
end
object Label7: TLabel
Left = 274
Top = 140
Width = 13
Height = 13
Hint = 'Random spoke...'
Caption = 'rS:'
FocusControl = randSpok
ParentShowHint = False
ShowHint = True
end
object Label8: TLabel
Left = 274
Top = 164
Width = 14
Height = 13
Hint = 'Random gauss...'
Caption = 'rG:'
FocusControl = RandGauss
ParentShowHint = False
ShowHint = True
end
object rS_max: TSpeedButton
Left = 334
Top = 136
Width = 36
Height = 21
Caption = 'max'
Spacing = -1
OnClick = rS_maxClick
end
object rG_max: TSpeedButton
Left = 334
Top = 160
Width = 36
Height = 21
Caption = 'max'
Spacing = -1
OnClick = rG_maxClick
end
object Bevel2: TBevel
Left = 272
Top = 187
Width = 192
Height = 65
end
object SpokesPlus: TSpeedButton
Left = 124
Top = 5
Width = 17
Height = 17
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
700077777777777770007777700077777000777770C077777000777770C07777
7000770000C000077000770CCCCCCC077000770000C000077000777770C07777
7000777770C07777700077777000777770007777777777777000777777777777
7000}
OnClick = SpokesPlusClick
end
object SpokesMinus: TSpeedButton
Left = 140
Top = 5
Width = 17
Height = 17
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777777777700077777777777770007777777777777000777777777777
70007700000000077000770CCCCCCC0770007700000000077000777777777777
7000777777777777700077777777777770007777777777777000777777777777
7000}
OnClick = SpokesMinusClick
end
object RaHUEPlus: TSpeedButton
Left = 276
Top = 5
Width = 17
Height = 17
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
700077777777777770007777700077777000777770C077777000777770C07777
7000770000C000077000770CCCCCCC077000770000C000077000777770C07777
7000777770C07777700077777000777770007777777777777000777777777777
7000}
OnClick = RaHUEPlusClick
end
object RaHUEMinus: TSpeedButton
Left = 292
Top = 5
Width = 17
Height = 17
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777777777700077777777777770007777777777777000777777777777
70007700000000077000770CCCCCCC0770007700000000077000777777777777
7000777777777777700077777777777770007777777777777000777777777777
7000}
OnClick = RaHUEMinusClick
end
object CentrPlus: TSpeedButton
Left = 428
Top = 5
Width = 17
Height = 17
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
700077777777777770007777700077777000777770C077777000777770C07777
7000770000C000077000770CCCCCCC077000770000C000077000777770C07777
7000777770C07777700077777000777770007777777777777000777777777777
7000}
OnClick = CentrPlusClick
end
object CentrMinus: TSpeedButton
Left = 444
Top = 5
Width = 17
Height = 17
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777777777700077777777777770007777777777777000777777777777
70007700000000077000770CCCCCCC0770007700000000077000777777777777
7000777777777777700077777777777770007777777777777000777777777777
7000}
OnClick = CentrMinusClick
end
object LName: TLabel
Left = 283
Top = 200
Width = 112
Height = 13
Caption = 'Picture name (required):'
FocusControl = eName
Font.Charset = DEFAULT_CHARSET
Font.Color = clPurple
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = [fsUnderline]
ParentFont = False
end
object eR: TEdit
Left = 289
Top = 40
Width = 35
Height = 21
TabOrder = 0
Text = '16'
OnChange = ImageChange
end
object eG: TEdit
Left = 289
Top = 72
Width = 35
Height = 21
TabOrder = 1
Text = '48'
OnChange = ImageChange
end
object eB: TEdit
Left = 289
Top = 104
Width = 35
Height = 21
TabOrder = 2
Text = '255'
OnChange = ImageChange
end
object randSpok: TEdit
Left = 289
Top = 136
Width = 44
Height = 21
TabOrder = 3
end
object RandGauss: TEdit
Left = 289
Top = 160
Width = 44
Height = 21
TabOrder = 4
end
object PictSize: TRadioGroup
Left = 385
Top = 44
Width = 73
Height = 121
Caption = ' Size: '
ItemIndex = 0
Items.Strings = (
'256x256'
'128x128'
'64x64'
'32x62'
'16x16'
'8x8')
TabOrder = 5
OnClick = ImageChange
end
object R_updown: TSpinButton
Left = 326
Top = 41
Width = 20
Height = 20
DownGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000008080000080800000808000000000000080800000808000008080000080
8000008080000080800000808000000000000000000000000000008080000080
8000008080000080800000808000000000000000000000000000000000000000
0000008080000080800000808000000000000000000000000000000000000000
0000000000000000000000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
TabOrder = 6
UpGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000000000000000000000000000000000000000000000000000000000000080
8000008080000080800000000000000000000000000000000000000000000080
8000008080000080800000808000008080000000000000000000000000000080
8000008080000080800000808000008080000080800000808000000000000080
8000008080000080800000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
OnDownClick = R_updownDownClick
OnUpClick = R_updownUpClick
end
object G_updown: TSpinButton
Left = 326
Top = 73
Width = 20
Height = 20
DownGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000008080000080800000808000000000000080800000808000008080000080
8000008080000080800000808000000000000000000000000000008080000080
8000008080000080800000808000000000000000000000000000000000000000
0000008080000080800000808000000000000000000000000000000000000000
0000000000000000000000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
TabOrder = 8
UpGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000000000000000000000000000000000000000000000000000000000000080
8000008080000080800000000000000000000000000000000000000000000080
8000008080000080800000808000008080000000000000000000000000000080
8000008080000080800000808000008080000080800000808000000000000080
8000008080000080800000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
OnDownClick = G_updownDownClick
OnUpClick = G_updownUpClick
end
object B_updown: TSpinButton
Left = 326
Top = 105
Width = 20
Height = 20
DownGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000008080000080800000808000000000000080800000808000008080000080
8000008080000080800000808000000000000000000000000000008080000080
8000008080000080800000808000000000000000000000000000000000000000
0000008080000080800000808000000000000000000000000000000000000000
0000000000000000000000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
TabOrder = 7
UpGlyph.Data = {
0E010000424D0E01000000000000360000002800000009000000060000000100
200000000000D800000000000000000000000000000000000000008080000080
8000008080000080800000808000008080000080800000808000008080000080
8000000000000000000000000000000000000000000000000000000000000080
8000008080000080800000000000000000000000000000000000000000000080
8000008080000080800000808000008080000000000000000000000000000080
8000008080000080800000808000008080000080800000808000000000000080
8000008080000080800000808000008080000080800000808000008080000080
800000808000008080000080800000808000}
OnDownClick = B_updownDownClick
OnUpClick = B_updownUpClick
end
object Spokes: TProgressBar
Left = 8
Top = 24
Width = 150
Height = 9
Min = 1
Max = 1024
Position = 255
TabOrder = 9
OnMouseMove = SpokesMouseMove
end
object RaHUE: TProgressBar
Left = 160
Top = 24
Width = 150
Height = 9
Min = 0
Max = 360
TabOrder = 10
OnMouseMove = RaHUEMouseMove
end
object Centr: TProgressBar
Left = 312
Top = 24
Width = 150
Height = 9
Min = 1
Max = 100
Position = 1
TabOrder = 11
OnMouseMove = CentrMouseMove
end
object eName: TEdit
Left = 283
Top = 216
Width = 161
Height = 21
TabOrder = 12
end
end
object Button1: TButton
Left = 264
Top = 336
Width = 75
Height = 25
Caption = 'Save as...'
TabOrder = 0
OnClick = Button1Click
end
object btnOK: TButton
Left = 344
Top = 336
Width = 75
Height = 25
Caption = 'OK'
ModalResult = 1
TabOrder = 2
OnClick = btnOKClick
end
object btnCancel: TButton
Left = 421
Top = 336
Width = 75
Height = 25
Caption = 'Cancel'
ModalResult = 2
TabOrder = 3
OnClick = btnCancelClick
end
object SavePictureDialog1: TSavePictureDialog
DefaultExt = '.bmp'
Filter =
'All (*.dib;*.jpg;*.jpeg;*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf)|*.' +
'dib;*.jpg;*.jpeg;*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf|Device Ind' +
'ependent Bitmap (*.dib)|*.dib|JPEG Image File (*.jpg)|*.jpg|JPEG' +
' Image File (*.jpeg)|*.jpeg|JPEG Image File (*.jpg)|*.jpg|JPEG I' +
'mage File (*.jpeg)|*.jpeg|Bitmaps (*.bmp)|*.bmp|Icons (*.ico)|*.' +
'ico|Enhanced Metafiles (*.emf)|*.emf|Metafiles (*.wmf)|*.wmf'
Title = 'Save NOVA picture effect'
Left = 160
Top = 304
end
end
/VCL_DELPHIX_D6/DXDIBEffectEdit.pas
0,0 → 1,373
unit DXDIBEffectEdit;
//(c)2007 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) create effect for store into dximagelist.
 
}
interface
 
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DIB, ExtCtrls, Math, ComCtrls, Buttons, ExtDlgs, Spin;
 
type
{injected class}
EInvalidTypeConvert = class(Exception);
TEdit = class(StdCtrls.TEdit)
private
procedure SetAsInteger(Value: Integer);
function GetAsInteger: Integer;
public
property AsInteger: Integer read GetAsInteger write SetAsInteger;
end;
TTDelphiXDIBEffectEditForm = class(TForm)
Button1: TButton;
Image1: TImage;
LSpokes: TLabel;
LRaHUE: TLabel;
LCentr: TLabel;
eR: TEdit;
eG: TEdit;
eB: TEdit;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
randSpok: TEdit;
Label7: TLabel;
RandGauss: TEdit;
Label8: TLabel;
rS_max: TSpeedButton;
rG_max: TSpeedButton;
Bevel1: TBevel;
PictSize: TRadioGroup;
SavePictureDialog1: TSavePictureDialog;
Bevel2: TBevel;
R_updown: TSpinButton;
G_updown: TSpinButton;
B_updown: TSpinButton;
btnOK: TButton;
btnCancel: TButton;
Panel1: TPanel;
Bevel3: TBevel;
Spokes: TProgressBar;
RaHUE: TProgressBar;
Centr: TProgressBar;
SpokesPlus: TSpeedButton;
SpokesMinus: TSpeedButton;
RaHUEPlus: TSpeedButton;
RaHUEMinus: TSpeedButton;
CentrPlus: TSpeedButton;
CentrMinus: TSpeedButton;
LName: TLabel;
eName: TEdit;
procedure CentrMinusClick(Sender: TObject);
procedure CentrPlusClick(Sender: TObject);
procedure RaHUEMinusClick(Sender: TObject);
procedure RaHUEPlusClick(Sender: TObject);
procedure SpokesMinusClick(Sender: TObject);
procedure SpokesPlusClick(Sender: TObject);
procedure CentrMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure RaHUEMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpokesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormDestroy(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ImageChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rS_maxClick(Sender: TObject);
procedure rG_maxClick(Sender: TObject);
procedure R_updownUpClick(Sender: TObject);
procedure R_updownDownClick(Sender: TObject);
procedure G_updownUpClick(Sender: TObject);
procedure G_updownDownClick(Sender: TObject);
procedure B_updownUpClick(Sender: TObject);
procedure B_updownDownClick(Sender: TObject);
private
{ Private declarations }
FSpokes: Integer;
FRaHUE: Integer;
FCentr: Integer;
procedure Calculate;
public
{ Public declarations }
ResultDIB: TDIB;
end;
 
var
DelphiXDIBEffectEditForm: TTDelphiXDIBEffectEditForm;
 
implementation
 
{$R *.DFM}
 
{ TEdit }
 
{injected class functionality like in jbEdit.TPubEdit component}
 
procedure TEdit.SetAsInteger(Value: Integer);
begin
Text := IntToStr(Value)
end;
 
function TEdit.GetAsInteger: Integer;
begin
Result := 0;
if Text = '' then
Exit;
try
Result := StrToInt(Text);
except
raise EInvalidTypeConvert.Create('Expected integer value !');
end
end;
 
{ TTDelphiXDIBEffectEditForm }
 
procedure TTDelphiXDIBEffectEditForm.Calculate;
const
wSize: array[0..5] of Word = (256, 128, 64, 32, 16, 8);
begin
// call this
// cx,cy : center x and y
// radius : 1-100
// spokes : 1-1024
// randomhue : 0-360
ResultDIB.Clear;
ResultDIB.SetSize(wSize[PictSize.ItemIndex], wSize[PictSize.ItemIndex], 24);
ResultDIB.Canvas.Brush.Color := clBlack;
ResultDIB.Canvas.FillRect(ResultDIB.Canvas.ClipRect);
 
LSpokes.Caption := Format('Spokes (%d)', [FSpokes]);
LRaHUE.Caption := Format('Random HUE (%d)', [FRaHUE]);
LCentr.Caption := Format('Nova radius (%d)', [FCentr]);
 
ResultDIB.DoNovaEffect(eR.AsInteger, eG.AsInteger, eB.AsInteger, ResultDIB.Width div 2,
ResultDIB.Height div 2, FCentr, FSpokes, FRaHUE,
randSpok.AsInteger, randGauss.AsInteger, nil);
 
Image1.Picture.Assign(ResultDIB);
end;
 
procedure TTDelphiXDIBEffectEditForm.Button1Click(Sender: TObject);
begin
Calculate;
if SavePictureDialog1.Execute then
ResultDIB.SaveToFile(SavePictureDialog1.FileName);
end;
 
procedure TTDelphiXDIBEffectEditForm.FormCreate(Sender: TObject);
begin
Tag := 0;
ResultDIB := TDIB.Create;
Randomize;
randspok.AsInteger := Random(MAXSHORT);
randgauss.AsInteger := Random(MAXSHORT);
FSpokes := 255; Spokes.Position := FSpokes; {$IFDEF VER4UP} Spokes.Smooth := True; {$ENDIF}
FRaHUE := 1; RaHUE.Position := FRaHUE; {$IFDEF VER4UP} RaHUE.Smooth := True; {$ENDIF}
FCentr := 18; Centr.Position := FCentr; {$IFDEF VER4UP} Centr.Smooth := True; {$ENDIF}
LSpokes.Caption := Format('Spokes (%d)', [FSpokes]);
LRaHUE.Caption := Format('Random HUE (%d)', [FRaHUE]);
LCentr.Caption := Format('Nova radius (%d)', [FCentr]);
Calculate;
randSpok.OnChange := ImageChange;
randgauss.OnChange := ImageChange;
{$IFDEF VER4UP}
Spokes.Smooth := True;
RaHUE.Smooth := True;
Centr.Smooth := True;
{$ENDIF}
end;
 
procedure TTDelphiXDIBEffectEditForm.rS_maxClick(Sender: TObject);
begin
RandSpok.AsInteger := maxint;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.rG_maxClick(Sender: TObject);
begin
RandGauss.AsInteger := maxint;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.R_updownUpClick(Sender: TObject);
begin
if eR.AsInteger < 255 then eR.AsInteger := eR.AsInteger + 1;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.R_updownDownClick(Sender: TObject);
begin
if eR.AsInteger > 0 then eR.AsInteger := eR.AsInteger - 1;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.G_updownUpClick(Sender: TObject);
begin
if eG.AsInteger < 255 then eG.AsInteger := eG.AsInteger + 1;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.G_updownDownClick(Sender: TObject);
begin
if eG.AsInteger > 0 then eG.AsInteger := eG.AsInteger - 1;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.B_updownUpClick(Sender: TObject);
begin
if eB.AsInteger < 255 then eB.AsInteger := eB.AsInteger + 1;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.B_updownDownClick(Sender: TObject);
begin
if eB.AsInteger > 0 then eB.AsInteger := eB.AsInteger - 1;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.btnCancelClick(Sender: TObject);
begin
Close;
end;
 
procedure TTDelphiXDIBEffectEditForm.btnOKClick(Sender: TObject);
begin
if eName.Text <> '' then begin
Tag := 1;
Close;
end
else
MessageDlg('Image name required!', mtWarning, [mbOK], 0);;
end;
 
procedure TTDelphiXDIBEffectEditForm.FormDestroy(Sender: TObject);
begin
ResultDIB.Free;
end;
 
procedure TTDelphiXDIBEffectEditForm.ImageChange(Sender: TObject);
begin
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.SpokesMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
newPosition: integer;
begin
with Sender as TProgressBar do begin
if ssLeft in Shift then
begin
Cursor := crHSplit;
newPosition := Round(x * Max / ClientWidth);
Position := newPosition;
end
else
begin
Cursor := crDefault;
end;
FSpokes := Position;
LSpokes.Caption := Format('Spokes (%d)', [FSpokes]);
if ssLeft in Shift then Calculate;
end;
end;
 
procedure TTDelphiXDIBEffectEditForm.RaHUEMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
newPosition: integer;
begin
with Sender as TProgressBar do begin
if ssLeft in Shift then
begin
Cursor := crHSplit;
newPosition := Round(x * Max / ClientWidth);
Position := newPosition;
end
else
begin
Cursor := crDefault;
end;
FRaHUE := Position;
LRaHUE.Caption := Format('Random HUE (%d)', [FRaHUE]);
if ssLeft in Shift then Calculate;
end;
end;
 
procedure TTDelphiXDIBEffectEditForm.CentrMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
newPosition: integer;
begin
with Sender as TProgressBar do begin
if ssLeft in Shift then
begin
Cursor := crHSplit;
newPosition := Round(x * Max / ClientWidth);
Position := newPosition;
end
else
begin
Cursor := crDefault;
end;
FCentr := Position;
LCentr.Caption := Format('Nova radius (%d)', [FCentr]);
if ssLeft in Shift then Calculate;
end;
end;
 
procedure TTDelphiXDIBEffectEditForm.SpokesPlusClick(Sender: TObject);
begin
Inc(FSpokes); if FSpokes > 1024 then FSpokes := 1024;
Spokes.Position := FSpokes;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.SpokesMinusClick(Sender: TObject);
begin
Dec(FSpokes); if FSpokes < 1 then FSpokes := 1;
Spokes.Position := FSpokes;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.RaHUEPlusClick(Sender: TObject);
begin
Inc(FRaHUE); if FRaHUE > 360 then FRaHUE := 360;
RaHUE.Position := FRaHUE;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.RaHUEMinusClick(Sender: TObject);
begin
Dec(FRaHUE); if FRaHUE < 0 then FRaHUE := 0;
RaHUE.Position := FRaHUE;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.CentrPlusClick(Sender: TObject);
begin
Inc(FCentr); if FCentr > 100 then FCentr := 100;
Centr.Position := FCentr;
Calculate;
end;
 
procedure TTDelphiXDIBEffectEditForm.CentrMinusClick(Sender: TObject);
begin
Dec(FCentr); if FCentr < 1 then FCentr := 1;
Centr.Position := FCentr;
Calculate;
end;
 
end.
/VCL_DELPHIX_D6/DXDraws.pas
1,3 → 1,95
(*******************************************************************************
EXTEND UNIT DXDRAWS FROM DELPHIX PACK
 
* Copyright (c) 2004-2010 Jaro Benes
* All Rights Reserved
* Version 1.09
* D2D Hardware module
* web site: www.micrel.cz/Dx
* e-mail: delphix_d2d@micrel.cz
 
* Enhanced by User137
 
* DISCLAIMER:
This software is provided "as is" and is without warranty of any kind.
The author of this software does not warrant, guarantee or make any
representations regarding the use or results of use of this software
in terms of reliability, accuracy or fitness for purpose. You assume
the entire risk of direct or indirect, consequential or inconsequential
results from the correct or incorrect usage of this software even if the
author has been informed of the possibilities of such damage. Neither
the author nor anybody connected to this software in any way can assume
any responsibility.
 
Tested in Delphi 4, 5, 6, 7 and Delphi 2005/2006/2007/2009/2010
 
* FEATURES:
a) Implement Hardware acceleration for critical function like DrawAlpha {Blend},
DrawSub and DrawAdd for both way DXIMAGELIST and DIRECTDRAWSURFACE with rotation too.
b) Automatic adjustement for texture size different 2^n.
c) Minimum current source code change, all accelerated code added into:
DXDraw.BeginScene;
//code here
DXDraw.EndScene;
d) DelphiX facade continues using still.
 
* HOW TO USE
a) Design code like as DelphiX and drawing routine put into
DXDraw.BeginScene;
//code here
DXDraw.EndScene;
b) setup options in code or property for turn-on acceleration like:
DXDraw.Finalize; {done DXDraw}
If HardwareSwitch Then
{hardware}
Begin
if NOT (doDirectX7Mode in DXDraw.Options) then
DXDraw.Options := DXDraw.Options + [doDirectX7Mode];
if NOT (doHardware in DXDraw.Options) then
DXDraw.Options := DXDraw.Options + [doHardware];
if NOT (do3D in DXDraw.Options) then
DXDraw.Options := DXDraw.Options + [do3D];
if doSystemMemory in DXDraw.Options then
DXDraw.Options := DXDraw.Options - [doSystemMemory];
End
Else
{software}
Begin
if doDirectX7Mode in DXDraw.Options then
DXDraw.Options := DXDraw.Options - [doDirectX7Mode];
if do3D in DXDraw.Options then
DXDraw.Options := DXDraw.Options - [do3D];
if doHardware in DXDraw.Options then
DXDraw.Options := DXDraw.Options - [doHardware];
if NOT (doSystemMemory in DXDraw.Options) then
DXDraw.Options := DXDraw.Options + [doSystemMemory];
End;
{to fullscreen}
if doFullScreen in DXDraw.Options then
begin
RestoreWindow;
DXDraw.Cursor := crDefault;
BorderStyle := bsSingle;
DXDraw.Options := DXDraw.Options - [doFullScreen];
DXDraw.Options := DXDraw.Options + [doFlip];
end else
begin
StoreWindow;
DXDraw.Cursor := crNone;
BorderStyle := bsNone;
DXDraw.Options := DXDraw.Options + [doFullScreen];
DXDraw.Options := DXDraw.Options - [doFlip];
end;
DXDraw1.Initialize; {up DXDraw now}
 
* NOTE Main form has to declare like:
TForm1 = class(TDXForm)
 
* KNOWN BUGS OR RESTRICTION:
1/ Cannot be use DirectDrawSurface other from DXDraw.Surface in HW mode.
2/ New functions was not tested for two and more DXDraws on form. Sorry.
 
******************************************************************************)
unit DXDraws;
 
interface
6,10 → 98,56
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
DXClass, DIB, DXTexImg, DirectX;
{$IFDEF VER14UP}
DXTypes,
{$ENDIF}
{$IFDEF VER17UP}System.Types, System.UITypes,{$ENDIF}
{$IFDEF DXTextureImage_UseZLIB}
ZLIB,
{$ENDIF}
DXClass, DIB,
{$IFDEF StandardDX}
DirectDraw, DirectSound,
{$IFDEF DX7}
{$IFDEF D3DRM}
Direct3DRM,
{$ENDIF}
Direct3D;
{$ENDIF}
{$IFDEF DX9}
Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8;
{$ENDIF}
{$ELSE}
DirectX;
{$ENDIF}
 
const
maxTexBlock = 2048; {maximum textures}
maxVideoBlockSize: Integer = 2048; {maximum size block of one texture}
SurfaceDivWidth: Integer = 2048;
SurfaceDivHeight: Integer = 2048;
{This conditional is for force set square texture when use it alphachannel from DIB32}
{$DEFINE FORCE_SQUARE}
DXTextureImageGroupType_Normal = 0; // Normal group
DXTextureImageGroupType_Mipmap = 1; // Mipmap group
 
Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ"at 0123456789<>=()-''!_+\/{}^&%.=$#ÅÖÄ?*';
PowerAlphabet = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ`1234567890-=~!@#$%^&*()_+[];'',./\{}:"<>?|©®™ ';
ccDefaultSpecular = $FFFFFFFF;
 
ZeroRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
 
type
 
{ TRenderType }
 
TRenderType = (rtDraw, rtBlend, rtAdd, rtSub);
 
{ TRenderMirrorFlip }
 
TRenderMirrorFlip = (rmfMirror, rmfFlip);
TRenderMirrorFlipSet = set of TRenderMirrorFlip;
 
{ EDirectDrawError }
 
EDirectDrawError = class(EDirectXError);
25,8 → 163,10
 
TDirectDraw = class(TDirectX)
private
{$IFDEF D3D_deprecated}
FIDDraw: IDirectDraw;
FIDDraw4: IDirectDraw4;
{$ENDIF}
FIDDraw7: IDirectDraw7;
FDriverCaps: TDDCaps;
FHELCaps: TDDCaps;
35,12 → 175,16
FSurfaces: TList;
function GetClipper(Index: Integer): TDirectDrawClipper;
function GetClipperCount: Integer;
function GetDisplayMode: TDDSurfaceDesc;
function GetDisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
{$IFDEF D3D_deprecated}
function GetIDDraw: IDirectDraw;
function GetIDDraw4: IDirectDraw4;
{$ENDIF}
function GetIDDraw7: IDirectDraw7;
{$IFDEF D3D_deprecated}
function GetIDraw: IDirectDraw;
function GetIDraw4: IDirectDraw4;
{$ENDIF}
function GetIDraw7: IDirectDraw7;
function GetPalette(Index: Integer): TDirectDrawPalette;
function GetPaletteCount: Integer;
51,16 → 195,21
constructor CreateEx(GUID: PGUID; DirectX7Mode: Boolean);
destructor Destroy; override;
class function Drivers: TDirectXDrivers;
{$IFDEF _DMO_}class function DriversEx: TDirectXDriversEx;{$ENDIF}
property ClipperCount: Integer read GetClipperCount;
property Clippers[Index: Integer]: TDirectDrawClipper read GetClipper;
property DisplayMode: TDDSurfaceDesc read GetDisplayMode;
property DisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF} read GetDisplayMode;
property DriverCaps: TDDCaps read FDriverCaps;
property HELCaps: TDDCaps read FHELCaps;
{$IFDEF D3D_deprecated}
property IDDraw: IDirectDraw read GetIDDraw;
property IDDraw4: IDirectDraw4 read GetIDDraw4;
{$ENDIF}
property IDDraw7: IDirectDraw7 read GetIDDraw7;
{$IFDEF D3D_deprecated}
property IDraw: IDirectDraw read GetIDraw;
property IDraw4: IDirectDraw4 read GetIDraw4;
{$ENDIF}
property IDraw7: IDirectDraw7 read GetIDraw7;
property PaletteCount: Integer read GetPaletteCount;
property Palettes[Index: Integer]: TDirectDrawPalette read GetPalette;
135,35 → 284,63
FCanvas: TDirectDrawSurfaceCanvas;
FHasClipper: Boolean;
FDDraw: TDirectDraw;
{$IFDEF D3D_deprecated}
FIDDSurface: IDirectDrawSurface;
FIDDSurface4: IDirectDrawSurface4;
{$ENDIF}
FIDDSurface7: IDirectDrawSurface7;
FSystemMemory: Boolean;
FStretchDrawClipper: IDirectDrawClipper;
FSurfaceDesc: TDDSurfaceDesc;
FSurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
FGammaControl: IDirectDrawGammaControl;
FLockSurfaceDesc: TDDSurfaceDesc;
FLockSurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
FLockCount: Integer;
FIsLocked: Boolean;
FModified: Boolean;
FCaption: TCaption;
DIB_COLMATCH: TDIB;
function GetBitCount: Integer;
function GetCanvas: TDirectDrawSurfaceCanvas;
function GetClientRect: TRect;
function GetHeight: Integer;
function GetIDDSurface: IDirectDrawSurface;
function GetIDDSurface4: IDirectDrawSurface4;
function GetIDDSurface7: IDirectDrawSurface7;
{$IFDEF D3D_deprecated}
function GetIDDSurface: IDirectDrawSurface; {$IFDEF VER9UP}inline;{$ENDIF}
function GetIDDSurface4: IDirectDrawSurface4; {$IFDEF VER9UP}inline;{$ENDIF}
{$ENDIF}
function GetIDDSurface7: IDirectDrawSurface7; {$IFDEF VER9UP}inline;{$ENDIF}
{$IFDEF D3D_deprecated}
function GetISurface: IDirectDrawSurface;
function GetISurface4: IDirectDrawSurface4;
{$ENDIF}
function GetISurface7: IDirectDrawSurface7;
function GetPixel(X, Y: Integer): Longint;
function GetWidth: Integer;
procedure SetClipper(Value: TDirectDrawClipper);
procedure SetColorKey(Flags: DWORD; const Value: TDDColorKey);
{$IFDEF D3D_deprecated}
procedure SetIDDSurface(Value: IDirectDrawSurface);
procedure SetIDDSurface4(Value: IDirectDrawSurface4);
{$ENDIF}
procedure SetIDDSurface7(Value: IDirectDrawSurface7);
procedure SetPalette(Value: TDirectDrawPalette);
procedure SetPixel(X, Y: Integer; Value: Longint);
procedure SetTransparentColor(Col: Longint);
{support RGB routines}
procedure LoadRGB(Color: cardinal; var R, G, B: Byte);
function SaveRGB(const R, G, B: Byte): cardinal;
{asm routine for direct surface by pixel}
{no clipping}
function GetPixel16(x, y: Integer): Integer; register;
function GetPixel24(x, y: Integer): Integer; register;
function GetPixel32(x, y: Integer): Integer; register;
function GetPixel8(x, y: Integer): Integer; register;
procedure PutPixel16(x, y, color: Integer); register;
procedure PutPixel24(x, y, color: Integer); register;
procedure PutPixel32(x, y, color: Integer); register;
procedure PutPixel8(x, y, color: Integer); register;
{routines calls asm pixel routine}
function Peek(X, Y: Integer): LongInt; {$IFDEF VER9UP} inline; {$ENDIF}
procedure Poke(X, Y: Integer; const Value: LongInt); {$IFDEF VER9UP} inline; {$ENDIF}
public
constructor Create(ADirectDraw: TDirectDraw);
destructor Destroy; override;
170,17 → 347,22
procedure Assign(Source: TPersistent); override;
procedure AssignTo(Dest: TPersistent); override;
function Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean;
const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function BltFast(X, Y: Integer; const SrcRect: TRect;
Flags: DWORD; Source: TDirectDrawSurface): Boolean;
function ColorMatch(Col: TColor): Integer;
{$IFDEF DelphiX_Spt4}
function CreateSurface(const SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
function CreateSurface(const SurfaceDesc: TDDSurfaceDesc2): Boolean; overload;
Flags: DWORD; Source: TDirectDrawSurface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function ColorMatch(Col: TColor): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
{$IFDEF VER4UP}
{$IFDEF D3D_deprecated}
function CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
{$ENDIF}
function CreateSurface(SurfaceDesc: TDDSurfaceDesc2): Boolean; overload;
{$ELSE}
function CreateSurface(const SurfaceDesc: TDDSurfaceDesc): Boolean;
function CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean;
{$ENDIF}
{$IFDEF DelphiX_Spt4}
 
procedure MirrorFlip(Value: TRenderMirrorFlipSet);
 
{$IFDEF VER4UP}
procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean=True); overload;
procedure Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean=True); overload;
procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
194,38 → 376,94
Transparent: Boolean);
{$ENDIF}
procedure DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Transparent: Boolean; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Alpha: Integer);
procedure DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Transparent: Boolean; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
 
procedure DrawAddCol(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Color, Alpha: Integer);
procedure DrawAlphaCol(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Color, Alpha: Integer);
procedure DrawSubCol(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Color, Alpha: Integer);
 
{Rotate}
procedure DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer);
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single);
procedure DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
Alpha: Integer);
procedure DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
 
procedure DrawRotateAddCol(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; CenterX,
CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateAlphaCol(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; CenterX,
CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double;
Transparent: Boolean; Angle: Single; Color: Integer);
procedure DrawRotateSubCol(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; CenterX,
CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{WaveX}
procedure DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
procedure DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
Alpha: Integer);
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{WaveY}
procedure DrawWaveY(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
procedure DrawWaveYAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveYAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveYSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{Poke function}
procedure PokeLine(X1, Y1, X2, Y2: Integer; Color: cardinal); {$IFDEF VER9UP} inline; {$ENDIF}
procedure PokeLinePolar(x, y: Integer; angle, length: extended;
Color: cardinal); {$IFDEF VER9UP} inline; {$ENDIF}
procedure PokeBox(xs, ys, xd, yd: Integer; Color: cardinal);
procedure PokeBlendPixel(const X, Y: Integer; aColor: cardinal;
Alpha: byte);
procedure PokeWuLine(X1, Y1, X2, Y2, aColor: Integer);
procedure Noise(Oblast: TRect; Density: Byte);
procedure Blur;
procedure DoRotate(cent1, cent2, angle: Integer; coord1, coord2: Real;
color: word);
procedure PokeCircle(X, Y, Radius, Color: Integer);
procedure PokeEllipse(exc, eyc, ea, eb, angle, color: Integer);
procedure PokeFilledEllipse(exc, eyc, ea, eb, color: Integer);
procedure PokeVLine(x, y1, y2: Integer; Color: cardinal);
{Fill}
procedure Fill(DevColor: Longint);
procedure FillRect(const Rect: TRect; DevColor: Longint);
procedure FillRectAdd(const DestRect: TRect; Color: TColor);
procedure FillRectAdd(const DestRect: TRect; Color: TColor; Alpha: Byte{$IFDEF VER4UP} = 128{$ENDIF});
procedure FillRectAlpha(const DestRect: TRect; Color: TColor; Alpha: Integer);
procedure FillRectSub(const DestRect: TRect; Color: TColor);
procedure FillRectSub(const DestRect: TRect; Color: TColor; Alpha: Byte{$IFDEF VER4UP} = 128{$ENDIF});
{Load}
procedure LoadFromDIB(DIB: TDIB);
procedure LoadFromDIBRect(DIB: TDIB; AWidth, AHeight: Integer; const SrcRect: TRect);
procedure LoadFromGraphic(Graphic: TGraphic);
232,15 → 470,19
procedure LoadFromGraphicRect(Graphic: TGraphic; AWidth, AHeight: Integer; const SrcRect: TRect);
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
{$IFDEF DelphiX_Spt4}
function Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
function Lock(var SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
{$IFDEF VER4UP}
function Lock(const Rect: TRect; var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean; overload;
function Lock(var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean; overload;
function Lock: Boolean; overload;
{$ELSE}
function LockSurface: Boolean;
function Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean;
{$ENDIF}
procedure UnLock;
function Restore: Boolean;
property IsLocked: Boolean read FIsLocked;
procedure SetSize(AWidth, AHeight: Integer);
property Modified: Boolean read FModified write FModified;
property BitCount: Integer read GetBitCount;
property Canvas: TDirectDrawSurfaceCanvas read GetCanvas;
property ClientRect: TRect read GetClientRect;
249,18 → 491,24
property DDraw: TDirectDraw read FDDraw;
property GammaControl: IDirectDrawGammaControl read FGammaControl;
property Height: Integer read GetHeight;
{$IFDEF D3D_deprecated}
property IDDSurface: IDirectDrawSurface read GetIDDSurface write SetIDDSurface;
property IDDSurface4: IDirectDrawSurface4 read GetIDDSurface4 write SetIDDSurface4;
{$ENDIF}
property IDDSurface7: IDirectDrawSurface7 read GetIDDSurface7 write SetIDDSurface7;
{$IFDEF D3D_deprecated}
property ISurface: IDirectDrawSurface read GetISurface;
property ISurface4: IDirectDrawSurface4 read GetISurface4;
{$ENDIF}
property ISurface7: IDirectDrawSurface7 read GetISurface7;
property Palette: TDirectDrawPalette write SetPalette;
property Pixels[X, Y: Integer]: Longint read GetPixel write SetPixel;
property SurfaceDesc: TDDSurfaceDesc read FSurfaceDesc;
property Pixel[X, Y: Integer]: LongInt read Peek write Poke;
property SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF} read FSurfaceDesc;
property SystemMemory: Boolean read FSystemMemory write FSystemMemory;
property TransparentColor: Longint write SetTransparentColor;
property Width: Integer read GetWidth;
property Caption: TCaption read FCaption write FCaption;
end;
 
{ TDXDrawDisplay }
297,7 → 545,7
procedure SetBitCount(Value: Integer);
procedure SetHeight(Value: Integer);
procedure SetWidth(Value: Integer);
function SetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
function SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF}: Integer): Boolean;
function DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
public
constructor Create(ADXDraw: TCustomDXDraw);
308,7 → 556,7
property Mode: TDXDrawDisplayMode read GetMode;
property Modes[Index: Integer]: TDXDrawDisplayMode read GetMode2; default;
published
property BitCount: Integer read FBitCount write SetBitCount default 8;
property BitCount: Integer read FBitCount write SetBitCount default 16;
property FixedBitCount: Boolean read FFixedBitCount write FFixedBitCount;
property FixedRatio: Boolean read FFixedRatio write FFixedRatio;
property FixedSize: Boolean read FFixedSize write FFixedSize;
323,11 → 571,23
 
EDXDrawError = class(Exception);
 
{ TD2D HW acceleration}
 
TD2D = class;
 
{ TTracerCollection }
 
TTraces = class;
 
{ TCustomDXDraw }
 
TD2DTextureFilter = (D2D_POINT, D2D_LINEAR, D2D_FLATCUBIC, D2D_GAUSSIANCUBIC, D2D_ANISOTROPIC);
 
 
TDXDrawOption = (doFullScreen, doNoWindowChange, doAllowReboot, doWaitVBlank,
doAllowPalette256, doSystemMemory, doStretch, doCenter, doFlip,
do3D, doDirectX7Mode, doRetainedMode, doHardware, doSelectDriver, doZBuffer);
{$IFDEF D3D_deprecated}do3D, doDirectX7Mode,{$ENDIF} {$IFDEF D3DRM} doRetainedMode,{$ENDIF}
doHardware, doSelectDriver, doZBuffer);
 
TDXDrawOptions = set of TDXDrawOption;
 
336,6 → 596,16
 
TDXDrawNotifyEvent = procedure(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType) of object;
 
TD2DTextures = class;
TOnUpdateTextures = procedure(const Sender: TD2DTextures; var Changed: Boolean) of object;
 
TPictureCollectionItem = class;
 
{$IFNDEF D3D_deprecated}
TD3DDeviceType = (dtTnLHAL, dtHAL,dtMMX,dtRGB,dtRamp,dtRef);
TD3DDeviceTypeSet = Set of TD3DDeviceType;
{$ENDIF}
 
TCustomDXDraw = class(TCustomControl)
private
FAutoInitialize: Boolean;
364,6 → 634,9
FDriverGUID: TGUID;
FDDraw: TDirectDraw;
FDisplay: TDXDrawDisplay;
{$IFNDEF D3D_deprecated}
FDeviceTypeSet: TD3DDeviceTypeSet;{$ENDIF}
{$IFDEF _DMO_}FAdapters: TDirectXDriversEx;{$ENDIF}
FClipper: TDirectDrawClipper;
FPalette: TDirectDrawPalette;
FPrimary: TDirectDrawSurface;
371,14 → 644,19
FSurfaceWidth: Integer;
FSurfaceHeight: Integer;
{ Direct3D }
{$IFDEF D3D_deprecated}
FD3D: IDirect3D;
FD3D2: IDirect3D2;
FD3D3: IDirect3D3;
{$ENDIF}
FD3D7: IDirect3D7;
{$IFDEF D3D_deprecated}
FD3DDevice: IDirect3DDevice;
FD3DDevice2: IDirect3DDevice2;
FD3DDevice3: IDirect3DDevice3;
{$ENDIF}
FD3DDevice7: IDirect3DDevice7;
{$IFDEF D3DRM}
FD3DRM: IDirect3DRM;
FD3DRM2: IDirect3DRM2;
FD3DRM3: IDirect3DRM3;
388,14 → 666,18
FCamera: IDirect3DRMFrame;
FScene: IDirect3DRMFrame;
FViewport: IDirect3DRMViewport;
{$ENDIF}
FZBuffer: TDirectDrawSurface;
FD2D: TD2D;
FOnUpdateTextures: TOnUpdateTextures;
FTraces: TTraces;
FOnRender: TNotifyEvent;
procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
function GetCanDraw: Boolean;
function GetCanDraw: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function GetCanPaletteAnimation: Boolean;
function GetSurfaceHeight: Integer;
function GetSurfaceWidth: Integer;
procedure NotifyEventList(NotifyType: TDXDrawNotifyType);
procedure SetAutoSize(Value: Boolean);
procedure SetColorTable(const ColorTable: TRGBQuads);
procedure SetCooperativeLevel;
procedure SetDisplay(Value: TDXDrawDisplay);
405,6 → 687,11
procedure SetSurfaceWidth(Value: Integer);
function TryRestore: Boolean;
procedure WMCreate(var Message: TMessage); message WM_CREATE;
function Fade2Color(colorfrom, colorto: Integer): LongInt;
function Grey2Fade(shadefrom, shadeto: Integer): Integer;
procedure SetTraces(const Value: TTraces);
function CheckD3: Boolean;
function CheckD3D(Dest: TDirectDrawSurface): Boolean;
protected
procedure DoFinalize; virtual;
procedure DoFinalizeSurface; virtual;
416,38 → 703,68
procedure Paint; override;
function PaletteChanged(Foreground: Boolean): Boolean; override;
procedure SetParent(AParent: TWinControl); override;
procedure SetAutoSize(Value: Boolean); {$IFDEF D6UP} override; {$ENDIF}
property OnUpdateTextures: TOnUpdateTextures read FOnUpdateTextures write FOnUpdateTextures;
property OnRender: TNotifyEvent read FOnRender write FOnRender;
public
ColorTable: TRGBQuads;
DefColorTable: TRGBQuads;
//
function Fade2Black(colorfrom: Integer): Longint;
function Fade2White(colorfrom: Integer): Longint;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
class function Drivers: TDirectXDrivers;
{$IFDEF _DMO_}class function DriversEx: TDirectXDriversEx;{$ENDIF}
procedure Finalize;
procedure Flip;
procedure Initialize;
procedure Render;
procedure Render(LagCount: Integer{$IFDEF VER4UP} = 0{$ENDIF});
procedure Restore;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
procedure BeginScene;
procedure EndScene;
procedure TextureFilter(Grade: TD2DTextureFilter);
procedure AntialiasFilter(Grade: TD3DAntialiasMode);
procedure MirrorFlip(Value: TRenderMirrorFlipSet);
procedure SaveTextures(path: string);
procedure ClearStack;
procedure UpdateTextures;
{grab images}
procedure PasteImage(sdib: TDIB; x, y: Integer);
procedure GrabImage(iX, iY, iWidth, iHeight: Integer; ddib: TDIB);
{fades}
function Black2Screen(oldcolor: Integer): Longint;
function Fade2Screen(oldcolor, newcolour: Integer): LongInt;
function White2Screen(oldcolor: Integer): LongInt;
function FadeGrey2Screen(oldcolor, newcolour: LongInt): LongInt;
procedure UpdatePalette;
procedure RegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
procedure UnRegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
 
property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize;
property AutoSize: Boolean read FAutoSize write SetAutoSize;
property Camera: IDirect3DRMFrame read FCamera;
{$IFDEF D3DRM}property Camera: IDirect3DRMFrame read FCamera; {$ENDIF}
property CanDraw: Boolean read GetCanDraw;
property CanPaletteAnimation: Boolean read GetCanPaletteAnimation;
property Clipper: TDirectDrawClipper read FClipper;
property Color;
{$IFDEF D3D_deprecated}
property D3D: IDirect3D read FD3D;
property D3D2: IDirect3D2 read FD3D2;
property D3D3: IDirect3D3 read FD3D3;
{$ENDIF}
property D3D7: IDirect3D7 read FD3D7;
{$IFDEF D3D_deprecated}
property D3DDevice: IDirect3DDevice read FD3DDevice;
property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
{$ENDIF}
property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
{$IFNDEF D3D_deprecated}
property D3DDeviceTypeSet: TD3DDeviceTypeSet read FDeviceTypeSet;{$ENDIF}
{$IFDEF D3DRM}
property D3DRM: IDirect3DRM read FD3DRM;
property D3DRM2: IDirect3DRM2 read FD3DRM2;
property D3DRM3: IDirect3DRM3 read FD3DRM3;
454,8 → 771,10
property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
{$ENDIF}
property DDraw: TDirectDraw read FDDraw;
property Display: TDXDrawDisplay read FDisplay write SetDisplay;
{$IFDEF _DMO_}property Adapter: TDirectXDriversEx read FAdapters write FAdapters;{$ENDIF}
property Driver: PGUID read FDriver write SetDriver;
property Initialized: Boolean read FInitialized;
property NowOptions: TDXDrawOptions read FNowOptions;
468,12 → 787,14
property Options: TDXDrawOptions read FOptions write SetOptions;
property Palette: TDirectDrawPalette read FPalette;
property Primary: TDirectDrawSurface read FPrimary;
property Scene: IDirect3DRMFrame read FScene;
{$IFDEF D3DRM}property Scene: IDirect3DRMFrame read FScene; {$ENDIF}
property Surface: TDirectDrawSurface read FSurface;
property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
property Viewport: IDirect3DRMViewport read FViewport;
{$IFDEF D3DRM}property Viewport: IDirect3DRMViewport read FViewport; {$ENDIF}
property ZBuffer: TDirectDrawSurface read FZBuffer;
property D2D1: TD2D read FD2D; {public object is here}
property Traces: TTraces read FTraces write SetTraces;
end;
 
{ TDXDraw }
480,6 → 801,7
 
TDXDraw = class(TCustomDXDraw)
published
{$IFDEF _DMO_}property Adapter;{$ENDIF}
property AutoInitialize;
property AutoSize;
property Color;
493,10 → 815,12
property OnInitializeSurface;
property OnInitializing;
property OnRestoreSurface;
property OnUpdateTextures;
property OnRender;
 
property Align;
{$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF}
{$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF}
{$IFDEF VER4UP}property Anchors; {$ENDIF}
{$IFDEF VER4UP}property Constraints; {$ENDIF}
property DragCursor;
property DragMode;
property Enabled;
505,6 → 829,7
property ShowHint;
property TabOrder;
property TabStop;
property Traces;
property Visible;
property OnClick;
property OnDblClick;
519,7 → 844,12
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
{$IFDEF DelphiX_Spt4}property OnResize;{$ENDIF}
{$IFDEF VER9UP}
property OnMouseWheel;
property OnMouseWheelUp;
property OnMouseWheelDown;
{$ENDIF}
{$IFDEF VER4UP}property OnResize; {$ENDIF}
property OnStartDrag;
end;
 
527,6 → 857,314
 
EDX3DError = class(Exception);
 
{ DxTracer }
 
EDXTracerError = class(Exception);
EDXBlitError = class(Exception);
 
TTracePointsType = (tptDot, tptLine, tptCircle, tptCurve);
 
TBlitMoveEvent = procedure(Sender: TObject; LagCount: Integer; var MoveIt: Boolean) of object;
TWaveType = (wtWaveNone, wtWaveX, wtWaveY);
TBlitRec = packed record
FCollisioned: Boolean;
FMoved: Boolean;
FVisible: Boolean;
FX: Double;
FY: Double;
FZ: Integer;
FWidth: Integer;
FHeight: Integer;
//--
FAnimCount: Integer;
FAnimLooped: Boolean;
FAnimPos: Double;
FAnimSpeed: Double;
FAnimStart: Integer;
//FTile: Boolean;
FAngle: Single;
FAlpha: Integer;
FCenterX: Double;
FCenterY: Double;
FScale: Double;
FBlendMode: TRenderType;
FAmplitude: Integer;
FAmpLength: Integer;
FPhase: Integer;
FWaveType: TWaveType;
FSpeedX, FSpeedY: Single;
FGravityX, FGravityY: Single;
FEnergy: Single;
FBlurImage: Boolean;
FMirror: Boolean;
FFlip: Boolean;
FTextureFilter: TD2DTextureFilter;
end;
TBlurImageProp = packed record
eActive: Boolean;
eX, eY: Integer;
ePatternIndex: Integer; {when animated or 0 always}
eAngle: Single; //angle can be saved too
eBlendMode: TRenderType; //blend mode
eIntensity: Byte; {intensity of Blur/Add/Sub}
end;
 
TPath = packed record
X, Y, Z: Single;
StayOn: Integer; {in milisecond}
Reserved: string[28]; {for future use}
Tag: Integer;
end;
TPathArr = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TPath;
{$IFNDEF VER4UP}
PPathArr = ^TPathArr;
{$ENDIF}
TBlit = class;
 
TOnRender = procedure(Sender: TBlit) of object;
 
TBlurImageArr = array[0..7] of TBlurImageProp;
TBlit = class(TPersistent)
private
FPathArr: {$IFNDEF VER4UP}PPathArr{$ELSE}TPathArr{$ENDIF};
{$IFNDEF VER4UP}
FPathLen: Integer;
{$ENDIF}
FParent: TBlit;
FBlitRec: TBlitRec;
FBlurImageArr: TBlurImageArr;
FActive: Boolean;
//--
FImage: TPictureCollectionItem;
FOnMove: TBlitMoveEvent;
FOnDraw: TNotifyEvent;
FOnCollision: TNotifyEvent;
FOnGetImage: TNotifyEvent;
FEngine: TCustomDXDraw;
FMovingRepeatly: Boolean;
FBustrofedon: Boolean;
FOnRender: TOnRender;
function GetWorldX: Double;
function GetWorldY: Double;
function GetDrawImageIndex: Integer;
function GetAlpha: Byte;
function GetAmpLength: Integer;
function GetAmplitude: Integer;
function GetAngle: Single;
function GetAnimCount: Integer;
function GetAnimLooped: Boolean;
function GetAnimPos: Double;
function GetAnimSpeed: Double;
function GetAnimStart: Integer;
function GetBlendMode: TRenderType;
function GetBlurImage: Boolean;
function GetCenterX: Double;
function GetCenterY: Double;
function GetCollisioned: Boolean;
function GetEnergy: Single;
function GetFlip: Boolean;
function GetGravityX: Single;
function GetGravityY: Single;
function GetHeight: Integer;
function GetMirror: Boolean;
function GetMoved: Boolean;
function GetPhase: Integer;
function GetScale: Double;
function GetSpeedX: Single;
function GetSpeedY: Single;
function GetVisible: Boolean;
function GetWaveType: TWaveType;
function GetWidth: Integer;
function GetX: Double;
function GetY: Double;
function GetZ: Integer;
procedure SetAlpha(const Value: Byte);
procedure SetAmpLength(const Value: Integer);
procedure SetAmplitude(const Value: Integer);
procedure SetAngle(const Value: Single);
procedure SetAnimCount(const Value: Integer);
procedure SetAnimLooped(const Value: Boolean);
procedure SetAnimPos(const Value: Double);
procedure SetAnimSpeed(const Value: Double);
procedure SetAnimStart(const Value: Integer);
procedure SetBlendMode(const Value: TRenderType);
procedure SetBlurImage(const Value: Boolean);
procedure SetCenterX(const Value: Double);
procedure SetCenterY(const Value: Double);
procedure SetCollisioned(const Value: Boolean);
procedure SetEnergy(const Value: Single);
procedure SetFlip(const Value: Boolean);
procedure SetGravityX(const Value: Single);
procedure SetGravityY(const Value: Single);
procedure SetHeight(const Value: Integer);
procedure SetMirror(const Value: Boolean);
procedure SetMoved(const Value: Boolean);
procedure SetPhase(const Value: Integer);
procedure SetScale(const Value: Double);
procedure SetSpeedX(const Value: Single);
procedure SetSpeedY(const Value: Single);
procedure SetVisible(const Value: Boolean);
procedure SetWaveType(const Value: TWaveType);
procedure SetWidth(const Value: Integer);
procedure SetX(const Value: Double);
procedure SetY(const Value: Double);
procedure SetZ(const Value: Integer);
function StoreAngle: Boolean;
function StoreAnimPos: Boolean;
function StoreAnimSpeed: Boolean;
function StoreCenterX: Boolean;
function StoreCenterY: Boolean;
function StoreEnergy: Boolean;
function StoreGravityX: Boolean;
function StoreGravityY: Boolean;
function StoreScale: Boolean;
function StoreSpeedX: Boolean;
function StoreSpeedY: Boolean;
function GetBoundsRect: TRect;
function GetClientRect: TRect;
function GetPath(index: Integer): TPath;
procedure SetPath(index: Integer; const Value: TPath);
procedure ReadPaths(Stream: TStream);
procedure WritePaths(Stream: TStream);
function GetMovingRepeatly: Boolean;
procedure SetMovingRepeatly(const Value: Boolean);
function GetBustrofedon: Boolean;
procedure SetBustrofedon(const Value: Boolean);
function GetTextureFilter: TD2DTextureFilter;
procedure SetTextureFilter(const Value: TD2DTextureFilter);
protected
procedure DoDraw; virtual;
procedure DoMove(LagCount: Integer);
function DoCollision: TBlit; virtual;
procedure DoGetImage; virtual;
procedure DefineProperties(Filer: TFiler); override;
public
FCurrentPosition, FCurrentTime: Integer;
FCurrentDirection: Boolean;
constructor Create(AParent: TObject); virtual;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property Engine: TCustomDXDraw read FEngine write FEngine;
property Parent: TBlit read FParent;
property WorldX: Double read GetWorldX;
property WorldY: Double read GetWorldY;
procedure ReAnimate(MoveCount: Integer); virtual;
property Image: TPictureCollectionItem read FImage write FImage;
property BoundsRect: TRect read GetBoundsRect;
property ClientRect: TRect read GetClientRect;
procedure SetPathLen(Len: Integer);
function IsPathEmpty: Boolean;
function GetPathCount: Integer;
function GetBlitAt(X, Y: Integer): TBlit;
property Path[index: Integer]: TPath read GetPath write SetPath; default;
published
property Active: Boolean read FActive write FActive default False;
//--
property Collisioned: Boolean read GetCollisioned write SetCollisioned default True;
property Moved: Boolean read GetMoved write SetMoved default True;
property Visible: Boolean read GetVisible write SetVisible default True;
property X: Double read GetX write SetX;
property Y: Double read GetY write SetY;
property Z: Integer read GetZ write SetZ;
property Width: Integer read GetWidth write SetWidth;
property Height: Integer read GetHeight write SetHeight;
property MovingRepeatly: Boolean read GetMovingRepeatly write SetMovingRepeatly default True;
property Bustrofedon: Boolean read GetBustrofedon write SetBustrofedon default False;
//--
property AnimCount: Integer read GetAnimCount write SetAnimCount default 0;
property AnimLooped: Boolean read GetAnimLooped write SetAnimLooped default False;
property AnimPos: Double read GetAnimPos write SetAnimPos stored StoreAnimPos;
property AnimSpeed: Double read GetAnimSpeed write SetAnimSpeed stored StoreAnimSpeed;
property AnimStart: Integer read GetAnimStart write SetAnimStart default 0;
property Angle: Single read GetAngle write SetAngle stored StoreAngle;
property Alpha: Byte read GetAlpha write SetAlpha default $FF;
property CenterX: Double read GetCenterX write SetCenterX stored StoreCenterX;
property CenterY: Double read GetCenterY write SetCenterY stored StoreCenterY;
property Scale: Double read GetScale write SetScale stored StoreScale;
property BlendMode: TRenderType read GetBlendMode write SetBlendMode default rtDraw;
property Amplitude: Integer read GetAmplitude write SetAmplitude default 0;
property AmpLength: Integer read GetAmpLength write SetAmpLength default 0;
property Phase: Integer read GetPhase write SetPhase default 0;
property WaveType: TWaveType read GetWaveType write SetWaveType default wtWaveNone;
property SpeedX: Single read GetSpeedX write SetSpeedX stored StoreSpeedX;
property SpeedY: Single read GetSpeedY write SetSpeedY stored StoreSpeedY;
property GravityX: Single read GetGravityX write SetGravityX stored StoreGravityX;
property GravityY: Single read GetGravityY write SetGravityY stored StoreGravityY;
property Energy: Single read GetEnergy write SetEnergy stored StoreEnergy;
property BlurImage: Boolean read GetBlurImage write SetBlurImage default False;
property Mirror: Boolean read GetMirror write SetMirror default False;
property Flip: Boolean read GetFlip write SetFlip default False;
property TextureFilter: TD2DTextureFilter read GetTextureFilter write SetTextureFilter default D2D_POINT;
 
property OnGetImage: TNotifyEvent read FOnGetImage write FOnGetImage;
property OnMove: TBlitMoveEvent read FOnMove write FOnMove;
property OnDraw: TNotifyEvent read FOnDraw write FOnDraw;
property OnCollision: TNotifyEvent read FOnCollision write FOnCollision;
property OnRender: TOnRender read FOnRender write FOnRender;
end;
 
TTrace = class(THashCollectionItem)
private
FActualized: Boolean;
FTag: Integer;
FBlit: TBlit;
function GetTraces: TTraces;
function GetOnCollision: TNotifyEvent;
function GetOnDraw: TNotifyEvent;
function GetOnGetImage: TNotifyEvent;
function GetOnMove: TBlitMoveEvent;
procedure SetOnCollision(const Value: TNotifyEvent);
procedure SetOnDraw(const Value: TNotifyEvent);
procedure SetOnGetImage(const Value: TNotifyEvent);
procedure SetOnMove(const Value: TBlitMoveEvent);
function GetActive: Boolean;
procedure SetActive(const Value: Boolean);
function GetOnRender: TOnRender;
procedure SetOnRender(const Value: TOnRender);
protected
function GetDisplayName: string; override;
procedure SetDisplayName(const Value: string); override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Render(const LagCount: Integer);
function IsActualized: Boolean;
procedure Assign(Source: TPersistent); override;
property Traces: TTraces read GetTraces;
function Clone(NewName: string; OffsetX: Integer{$IFDEF VER4UP} = 0{$ENDIF}; OffsetY: Integer{$IFDEF VER4UP} = 0{$ENDIF}; Angle: Single{$IFDEF VER4UP} = 0{$ENDIF}): TTrace;
published
property Active: Boolean read GetActive write SetActive;
property Tag: Integer read FTag write FTag;
property Blit: TBlit read FBlit write FBlit;
{events}
property OnGetImage: TNotifyEvent read GetOnGetImage write SetOnGetImage;
property OnMove: TBlitMoveEvent read GetOnMove write SetOnMove;
property OnDraw: TNotifyEvent read GetOnDraw write SetOnDraw;
property OnCollision: TNotifyEvent read GetOnCollision write SetOnCollision;
property OnRender: TOnRender read GetOnRender write SetOnRender;
end;
 
TTraces = class(THashCollection)
private
FOwner: TPersistent;
function GetItem(Index: Integer): TTrace;
procedure SetItem(Index: Integer; Value: TTrace);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TComponent);
function Add: TTrace;
function Find(const Name: string): TTrace;
{$IFDEF VER4UP}
function Insert(Index: Integer): TTrace;
{$ENDIF}
procedure Update(Item: TCollectionItem); override;
property Items[Index: Integer]: TTrace read GetItem write SetItem;
destructor Destroy; override;
end;
 
{$IFDEF DX3D_deprecated}
 
{ TCustomDX3D }
 
TDX3DOption = (toRetainedMode, toSystemMemory, toHardware, toSelectDriver, toZBuffer);
536,15 → 1174,20
TCustomDX3D = class(TComponent)
private
FAutoSize: Boolean;
FCamera: IDirect3DRMFrame;
{$IFDEF D3DRM}FCamera: IDirect3DRMFrame; {$ENDIF}
{$IFDEF D3D_deprecated}
FD3D: IDirect3D;
FD3D2: IDirect3D2;
FD3D3: IDirect3D3;
{$ENDIF}
FD3D7: IDirect3D7;
{$IFDEF D3D_deprecated}
FD3DDevice: IDirect3DDevice;
FD3DDevice2: IDirect3DDevice2;
FD3DDevice3: IDirect3DDevice3;
{$ENDIF}
FD3DDevice7: IDirect3DDevice7;
{$IFDEF D3DRM}
FD3DRM: IDirect3DRM;
FD3DRM2: IDirect3DRM2;
FD3DRM3: IDirect3DRM3;
551,6 → 1194,7
FD3DRMDevice: IDirect3DRMDevice;
FD3DRMDevice2: IDirect3DRMDevice2;
FD3DRMDevice3: IDirect3DRMDevice3;
{$ENDIF}
FDXDraw: TCustomDXDraw;
FInitFlag: Boolean;
FInitialized: Boolean;
558,11 → 1202,11
FOnFinalize: TNotifyEvent;
FOnInitialize: TNotifyEvent;
FOptions: TDX3DOptions;
FScene: IDirect3DRMFrame;
{$IFDEF D3DRM}FScene: IDirect3DRMFrame; {$ENDIF}
FSurface: TDirectDrawSurface;
FSurfaceHeight: Integer;
FSurfaceWidth: Integer;
FViewport: IDirect3DRMViewport;
{$IFDEF D3DRM}FViewport: IDirect3DRMViewport; {$ENDIF}
FZBuffer: TDirectDrawSurface;
procedure Finalize;
procedure Initialize;
572,7 → 1216,7
function GetSurfaceWidth: Integer;
procedure SetAutoSize(Value: Boolean);
procedure SetDXDraw(Value: TCustomDXDraw);
procedure SetOptions(Value: TDX3DOptions);
procedure SetOptions(Value: TDX3DOptions); virtual; {TridenT}
procedure SetSurfaceHeight(Value: Integer);
procedure SetSurfaceWidth(Value: Integer);
protected
585,16 → 1229,19
procedure Render;
procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
property AutoSize: Boolean read FAutoSize write SetAutoSize;
property Camera: IDirect3DRMFrame read FCamera;
{$IFDEF D3DRM}property Camera: IDirect3DRMFrame read FCamera; {$ENDIF}
property CanDraw: Boolean read GetCanDraw;
property D3D: IDirect3D read FD3D;
property D3D2: IDirect3D2 read FD3D2;
property D3D3: IDirect3D3 read FD3D3;
property D3D7: IDirect3D7 read FD3D7;
{$IFDEF D3D_deprecated}
property D3DDevice: IDirect3DDevice read FD3DDevice;
property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
{$ENDIF}
property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
{$IFDEF D3DRM}
property D3DRM: IDirect3DRM read FD3DRM;
property D3DRM2: IDirect3DRM2 read FD3DRM2;
property D3DRM3: IDirect3DRM3 read FD3DRM3;
601,6 → 1248,7
property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
{$ENDIF}
property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
property Initialized: Boolean read FInitialized;
property NowOptions: TDX3DOptions read FNowOptions;
607,11 → 1255,11
property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
property Options: TDX3DOptions read FOptions write SetOptions;
property Scene: IDirect3DRMFrame read FScene;
{$IFDEF D3DRM}property Scene: IDirect3DRMFrame read FScene; {$ENDIF}
property Surface: TDirectDrawSurface read FSurface;
property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
property Viewport: IDirect3DRMViewport read FViewport;
{$IFDEF D3DRM}property Viewport: IDirect3DRMViewport read FViewport; {$ENDIF}
property ZBuffer: TDirectDrawSurface read FZBuffer;
end;
 
627,6 → 1275,7
property OnFinalize;
property OnInitialize;
end;
{$ENDIF}
 
{ EDirect3DTextureError }
 
644,13 → 1293,13
FHandle: TD3DTextureHandle;
FPaletteEntries: TPaletteEntries;
FSurface: TDirectDrawSurface;
FTexture: IDirect3DTexture;
FTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
FTransparentColor: TColor;
procedure Clear;
procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
function GetHandle: TD3DTextureHandle;
function GetSurface: TDirectDrawSurface;
function GetTexture: IDirect3DTexture;
function GetTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
procedure SetTransparentColor(Value: TColor);
public
constructor Create(Graphic: TGraphic; DXDraw: TComponent);
659,9 → 1308,133
property Handle: TD3DTextureHandle read GetHandle;
property Surface: TDirectDrawSurface read GetSurface;
property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
property Texture: IDirect3DTexture read GetTexture;
property Texture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF} read GetTexture;
end;
 
{ EDXTextureImageError }
 
EDXTextureImageError = class(Exception);
 
{ channel structure }
 
TDXTextureImageChannel = record
Mask: DWORD;
BitCount: Integer;
 
{ Internal use }
_Mask2: DWORD;
_rshift: Integer;
_lshift: Integer;
_BitCount2: Integer;
end;
 
TDXTextureImage_PaletteEntries = array[0..255] of TPaletteEntry;
 
TDXTextureImageType = (
DXTextureImageType_PaletteIndexedColor,
DXTextureImageType_RGBColor
);
 
TDXTextureImageFileCompressType = (
DXTextureImageFileCompressType_None,
DXTextureImageFileCompressType_ZLIB
);
 
{forward}
 
TDXTextureImage = class;
 
{ TDXTextureImageLoadFunc }
 
TDXTextureImageLoadFunc = procedure(Stream: TStream; Image: TDXTextureImage);
 
{ TDXTextureImageProgressEvent }
 
TDXTextureImageProgressEvent = procedure(Sender: TObject; Progress, ProgressCount: Integer) of object;
 
{ TDXTextureImage }
 
TDXTextureImage = class
private
FOwner: TDXTextureImage;
FFileCompressType: TDXTextureImageFileCompressType;
FOnSaveProgress: TDXTextureImageProgressEvent;
FSubImage: TList;
FImageType: TDXTextureImageType;
FWidth: Integer;
FHeight: Integer;
FPBits: Pointer;
FBitCount: Integer;
FPackedPixelOrder: Boolean;
FWidthBytes: Integer;
FNextLine: Integer;
FSize: Integer;
FTopPBits: Pointer;
FTransparent: Boolean;
FTransparentColor: DWORD;
FImageGroupType: DWORD;
FImageID: DWORD;
FImageName: string;
FAutoFreeImage: Boolean;
procedure ClearImage;
function GetPixel(x, y: Integer): DWORD;
procedure SetPixel(x, y: Integer; c: DWORD);
function GetScanLine(y: Integer): Pointer;
function GetSubGroupImageCount(GroupTypeID: DWORD): Integer;
function GetSubGroupImage(GroupTypeID: DWORD; Index: Integer): TDXTextureImage;
function GetSubImageCount: Integer;
function GetSubImage(Index: Integer): TDXTextureImage;
protected
procedure DoSaveProgress(Progress, ProgressCount: Integer); virtual;
public
idx_index: TDXTextureImageChannel;
idx_alpha: TDXTextureImageChannel;
idx_palette: TDXTextureImage_PaletteEntries;
rgb_red: TDXTextureImageChannel;
rgb_green: TDXTextureImageChannel;
rgb_blue: TDXTextureImageChannel;
rgb_alpha: TDXTextureImageChannel;
constructor Create;
constructor CreateSub(AOwner: TDXTextureImage);
destructor Destroy; override;
procedure Assign(Source: TDXTextureImage);
procedure Clear;
procedure SetImage(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes, NextLine: Integer;
PBits, TopPBits: Pointer; Size: Integer; AutoFree: Boolean);
procedure SetSize(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes: Integer);
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
function EncodeColor(R, G, B, A: Byte): DWORD;
function PaletteIndex(R, G, B: Byte): DWORD;
class procedure RegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
class procedure UnRegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
property BitCount: Integer read FBitCount;
property PackedPixelOrder: Boolean read FPackedPixelOrder write FPackedPixelOrder;
property Height: Integer read FHeight;
property ImageType: TDXTextureImageType read FImageType;
property ImageGroupType: DWORD read FImageGroupType write FImageGroupType;
property ImageID: DWORD read FImageID write FImageID;
property ImageName: string read FImageName write FImageName;
property NextLine: Integer read FNextLine;
property PBits: Pointer read FPBits;
property Pixels[x, y: Integer]: DWORD read GetPixel write SetPixel;
property ScanLine[y: Integer]: Pointer read GetScanLine;
property Size: Integer read FSize;
property SubGroupImageCount[GroupTypeID: DWORD]: Integer read GetSubGroupImageCount;
property SubGroupImages[GroupTypeID: DWORD; Index: Integer]: TDXTextureImage read GetSubGroupImage;
property SubImageCount: Integer read GetSubImageCount;
property SubImages[Index: Integer]: TDXTextureImage read GetSubImage;
property TopPBits: Pointer read FTopPBits;
property Transparent: Boolean read FTransparent write FTransparent;
property TransparentColor: DWORD read FTransparentColor write FTransparentColor;
property Width: Integer read FWidth;
property WidthBytes: Integer read FWidthBytes;
property FileCompressType: TDXTextureImageFileCompressType read FFileCompressType write FFileCompressType;
property OnSaveProgress: TDXTextureImageProgressEvent read FOnSaveProgress write FOnSaveProgress;
end;
 
{ TDirect3DTexture2 }
 
TDirect3DTexture2 = class
684,18 → 1457,20
FD3DDevDesc: TD3DDeviceDesc;
procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
procedure SetDXDraw(ADXDraw: TCustomDXDraw);
procedure LoadSubTexture(Dest: IDirectDrawSurface4; SrcImage: TDXTextureImage);
procedure LoadSubTexture(Dest: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF}; SrcImage: TDXTextureImage);
procedure SetColorKey;
procedure SetDIB(DIB: TDIB);
function GetIsMipmap: Boolean;
function GetSurface: TDirectDrawSurface;
function GetTransparent: Boolean;
procedure SetTransparent(Value: Boolean);
procedure SetTransparentColor(Value: TColorRef);
function GetIsMipmap: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function GetSurface: TDirectDrawSurface; {$IFDEF VER9UP}inline;{$ENDIF}
function GetTransparent: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
procedure SetTransparent(Value: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
procedure SetTransparentColor(Value: TColorRef); {$IFDEF VER9UP}inline;{$ENDIF}
function GetHeight: Integer;
function GetWidth: Integer;
protected
procedure DoRestoreSurface; virtual;
public
constructor Create(ADXDraw: TCustomDXDraw; Graphic: TObject; AutoFreeGraphic: Boolean);
constructor Create(ADXDraw: TCustomDXDraw; Graphic: TObject; AutoFreeGraphic: Boolean{$IFDEF VER4UP} = False{$ENDIF});
constructor CreateFromFile(ADXDraw: TCustomDXDraw; const FileName: string);
constructor CreateVideoTexture(ADXDraw: TCustomDXDraw);
destructor Destroy; override;
702,6 → 1477,8
procedure Finalize;
procedure Load;
procedure Initialize;
property Height: Integer read GetHeight;
property Width: Integer read GetWidth;
property IsMipmap: Boolean read GetIsMipmap;
property Surface: TDirectDrawSurface read GetSurface;
property TextureFormat: TDDSurfaceDesc2 read FTextureFormat write FTextureFormat;
710,6 → 1487,103
property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
end;
 
{ EDXTBaseError }
 
EDXTBaseError = class(Exception);
 
{ parameters for DXT generator }
 
TDXTImageChannel = (rgbNone, rgbRed, rgbGreen, rgbBlue, rgbAlpha, yuvY);
TDXTImageChannels = set of TDXTImageChannel;
 
TDXTImageChannelInfo = packed record
Image: TDXTextureImage;
BitCount: Integer;
end;
 
TDXTImageFormat = packed record
ImageType: TDXTextureImageType;
Width: Integer;
Height: Integer;
Bits: Pointer;
BitCount: Integer;
WidthBytes: Integer;
{transparent}
Transparent: Boolean;
TransparentColor: TColorRef;
{texture channels}
idx_index: TDXTextureImageChannel;
idx_alpha: TDXTextureImageChannel;
idx_palette: TDXTextureImage_PaletteEntries;
rgb_red: TDXTextureImageChannel;
rgb_green: TDXTextureImageChannel;
rgb_blue: TDXTextureImageChannel;
rgb_alpha: TDXTextureImageChannel;
{compress level}
Compress: TDXTextureImageFileCompressType;
MipmapCount: Integer;
Name: string;
end;
 
{ TDXTBase }
 
{Note JB.}
{Class for DXT generation files, primary use for load bitmap 32 with alphachannel}
{recoded and class created by JB.}
TDXTBase = class
private
FHasChannels: TDXTImageChannels;
FHasChannelImages: array[TDXTImageChannel] of TDXTImageChannelInfo;
FChannelChangeTable: array[TDXTImageChannel] of TDXTImageChannel;
FHasImageList: TList;
FParamsFormat: TDXTImageFormat;
FStrImageFileName: string;
FDIB: TDIB;
function GetCompression: TDXTextureImageFileCompressType;
function GetHeight: Integer;
function GetMipmap: Integer;
function GetTransparentColor: TColorRef;
function GetWidth: Integer;
procedure SetCompression(const Value: TDXTextureImageFileCompressType);
procedure SetHeight(const Value: Integer);
procedure SetMipmap(const Value: Integer);
procedure SetTransparentColor(const Value: TColorRef);
procedure SetWidth(const Value: Integer);
procedure SetTransparentColorIndexed(const Value: TColorRef);
function GetTexture: TDXTextureImage;
procedure Resize(Image: TDXTextureImage; NewWidth, NewHeight: Integer;
FilterTypeResample: TFilterTypeResample);
procedure EvaluateChannels(const CheckChannelUsed: TDXTImageChannels;
const CheckChannelChanged, CheckBitCountForChannel: string);
function GetPicture: TDXTextureImage;
protected
procedure CalcOutputBitFormat;
procedure BuildImage(Image: TDXTextureImage);
public
constructor Create;
destructor Destroy; override;
procedure SetChannelR(T: TDIB);
procedure SetChannelG(T: TDIB);
procedure SetChannelB(T: TDIB);
procedure SetChannelA(T: TDIB);
procedure LoadChannelAFromFile(const FileName: string);
procedure SetChannelY(T: TDIB);
procedure SetChannelRGB(T: TDIB);
procedure LoadChannelRGBFromFile(const FileName: string);
procedure SetChannelRGBA(T: TDIB);
procedure LoadChannelRGBAFromFile(const FileName: string);
procedure SaveToFile(iFilename: string {$IFDEF VER4UP} = ''{$ENDIF});
function LoadFromFile(iFilename: string): Boolean;
property TransparentColor: TColorRef read GetTransparentColor write SetTransparentColor;
property TransparentColorIndexed: TColorRef read GetTransparentColor write SetTransparentColorIndexed;
property Width: Integer read GetWidth write SetWidth;
property Height: Integer read GetHeight write SetHeight;
property Compression: TDXTextureImageFileCompressType read GetCompression write SetCompression;
property Mipmap: Integer read GetMipmap write SetMipmap;
property Texture: TDXTextureImage read GetTexture;
end;
 
{$IFDEF D3DRM}
{ EDirect3DRMUserVisualError }
 
EDirect3DRMUserVisualError = class(Exception);
727,6 → 1601,7
destructor Destroy; override;
property UserVisual: IDirect3DRMUserVisual read FUserVisual;
end;
{$ENDIF}
 
{ EPictureCollectionError }
 
756,7 → 1631,7
function GetPictureCollection: TPictureCollection;
function GetPatternRect(Index: Integer): TRect;
function GetPatternSurface(Index: Integer): TDirectDrawSurface;
function GetPatternCount: Integer;
function GetPatternCount: Integer; {$IFDEF VER9UP}inline;{$ENDIF}
function GetWidth: Integer;
procedure SetPicture(Value: TPicture);
procedure SetTransparentColor(Value: TColor);
763,34 → 1638,82
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure UpdateTag;
procedure Assign(Source: TPersistent); override;
procedure Draw(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
// Modifier par MKost d'Uk@Team tous droit réservé.
// 22:02 04/11/2005
// Ajouté :
// Dans TPictureCollectionItem
// procedure DrawFlipH(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
// -Effectue un flip Horizontale de l'image
// procedure DrawFlipHV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
// -Effectue un flip Oblique de l'image
// procedure DrawFlipV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
// -Effectue un flip Verticale de l'image
procedure DrawFlipH(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
procedure DrawFlipHV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
procedure DrawFlipV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
procedure StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
procedure DrawAdd(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawAddCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Alpha: Integer);
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawAlphaCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawSub(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawSubCol(Dest: TDirectDrawSurface; const DestRect: TRect;
PatternIndex, Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{Rotate}
procedure DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: Integer);
CenterX, CenterY: Double; Angle: single);
procedure DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
CenterX, CenterY: Double; Angle: single;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateAddCol(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: single;
Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: Integer;
Alpha: Integer);
CenterX, CenterY: Double; Angle: single;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateAlphaCol(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: single;
Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: Integer;
Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
CenterX, CenterY: Double; Angle: single;
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRotateSubCol(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
CenterX, CenterY: Double; Angle: single;
Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{WaveX}
procedure DrawWaveX(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
amp, Len, ph: Integer);
procedure DrawWaveXAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
amp, Len, ph: Integer; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveXAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
amp, Len, ph: Integer; Alpha: Integer);
amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveXSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
amp, Len, ph: Integer; Alpha: Integer{$IFDEF DelphiX_Spt4}=255{$ENDIF});
amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{WaveY}
procedure DrawWaveY(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
amp, Len, ph: Integer);
procedure DrawWaveYAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveYAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawWaveYSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
{SpecialDraw}
procedure DrawCol(Dest: TDirectDrawSurface; const DestRect, SourceRect: TRect;
PatternIndex: Integer; Faded: Boolean; RenderType: TRenderType; Color,
Specular: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure DrawRect(Dest: TDirectDrawSurface;
const DestRect, SourceRect: TRect; PatternIndex: Integer;
RenderType: TRenderType; Transparent: Boolean{$IFDEF VER4UP} = True{$ENDIF};
Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
procedure Restore;
property Height: Integer read GetHeight;
property Initialized: Boolean read FInitialized;
830,6 → 1753,7
function Find(const Name: string): TPictureCollectionItem;
procedure Finalize;
procedure Initialize(DXDraw: TCustomDXDraw);
procedure InitializeImages(DXDraw: TCustomDXDraw; Id : Integer);
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure MakeColorTable;
891,7 → 1815,7
constructor CreateWindowed(WindowHandle: HWND);
destructor Destroy; override;
procedure Finalize;
procedure Initialize(const SurfaceDesc: TDDSurfaceDesc);
procedure Initialize(const SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF});
procedure Flip;
property OverlayColorKey: TColor read FOverlayColorKey write SetOverlayColorKey;
property OverlayRect: TRect read FOverlayRect write SetOverlayRect;
900,27 → 1824,542
property Visible: Boolean read FVisible write SetVisible;
end;
 
{
Modified by Michael Wilson 2/05/2001
- re-added redundant assignment to Offset
Modified by Marcus Knight 19/12/2000
- replaces all referaces to 'pos' with 'AnsiPos' <- faster
- replaces all referaces to 'uppercase' with 'Ansiuppercase' <- faster
- Now only uppercases outside the loop
- Fixed the non-virtual contructor
- renamed & moved Offset to private(fOffSet), and added the property OffSet
- Commented out the redundant assignment to Offset<- not needed, as Offset is now a readonly property
- Added the Notification method to catch when the image list is destroyed
- removed DXclasses from used list
}
 
TDXFont = class(TComponent)
private
FDXImageList: TDXImageList;
FFont: string;
FFontIndex: Integer;
FOffset: Integer; // renamed from Offset -> fOffset
procedure SetFont(const Value: string);
procedure SetFontIndex(const Value: Integer);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override; // added
public
constructor Create(AOwner: TComponent); override; // Modified
destructor Destroy; override;
procedure TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string);
property Offset: Integer read FOffset write FOffset; // added
published
property Font: string read FFont write SetFont;
property FontIndex: Integer read FFontIndex write SetFontIndex;
property DXImageList: TDXImageList read FDXImageList write FDXImageList;
end;
 
(*******************************************************************************
* Unit Name: DXPowerFont.pas
* Information: Writed By Ramin.S.Zaghi (Based On Wilson's DXFont Unit)
* Last Changes: Dec 25 2000;
* Unit Information:
* This unit includes a VCL-Component for DelphiX. This component draws the
* Character-Strings on a TDirectDrawSurface. This component helps the
* progarmmers to using custom fonts and printing texts easily such as
* TCanvas.TextOut function...
* Includes:
* 1. TDXPowerFontTextOutEffect ==> The kinds of drawing effects.
* - teNormal: Uses the Draw function. (Normal output)
* - teRotat: Uses the DrawRotate function. (Rotates each character)
* - teAlphaBlend: Uses DrawAlpha function. (Blends each character)
* - teWaveX: Uses DrawWaveX function. (Adds a Wave effect to the each character)
*
* 2. TDXPowerFontTextOutType ==> The kinds of each caracter.
* - ttUpperCase: Uppers all characters automaticaly.
* - ttLowerCase: Lowers all characters automaticaly.
* - ttNormal: Uses all characters with out any converting.
*
* 3. TDXPowerFontEffectsParameters ==> Includes the parameters for adding effects to the characters.
* - (CenterX, CenterY): The rotating center point.
* - (Width, Height): The new size of each character.
* - Angle: The angle of rotate.
* - AlphaValue: The value of Alpha-Chanel.
* - WAmplitude: The Amplitude of Wave function. (See The Help Of DelphiX)
* - WLenght: The Lenght Of Wave function. (See The Help Of DelphiX)
* - WPhase: The Phase Of Wave function. (See The Help Of DelphiX)
*
* 4. TDXPowerFontBeforeTextOutEvent ==> This is an event that occures before
* drawing texts on to TDirectDrawSurface object.
* - Sender: Retrieves the event caller object.
* - Text: Retrieves the text sended text for drawing.
* (NOTE: The changes will have effect)
* - DoTextOut: The False value means that the TextOut function must be stopped.
* (NOTE: The changes will have effect)
*
* 5. TDXPowerFontAfterTextOutEvent ==> This is an event that occures after
* drawing texts on to TDirectDrawSurface object.
* - Sender: Retrieves the event caller object.
* - Text: Retrieves the text sended text for drawing.
* (NOTE: The changes will not have any effects)
*
* 6. TDXPowerFont ==> I sthe main class of PowerFont VCL-Component.
* - property Font: string; The name of custom-font's image in the TDXImageList items.
* - property FontIndex: Integer; The index of custom-font's image in the TDXImageList items.
* - property DXImageList: TDXImageList; The TDXImageList that includes the image of custom-fonts.
* - property UseEnterChar: Boolean; When the value of this property is True, The component caculates Enter character.
* - property EnterCharacter: String;
*==> Note that TDXPowerFont calculates tow kinds of enter character:
*==> E1. The Enter character that draws the characters after it self in a new line and after last drawed character, ONLY.
*==> E2. The Enter character that draws the characters after it self in a new line such as #13#10 enter code in delphi.
*==> Imporatant::
*==> (E1) TDXPowerFont uses the first caracter of EnterCharacter string as the first enter caracter (Default value is '|').
*==> (E2) and uses the second character as the scond enter caracter (Default value is '<')
* - property BeforeTextOut: TDXPowerFontBeforeTextOutEvent; See TDXPowerFontBeforeTextOutEvent.
* - property AfterTextOut: TDXPowerFontAfterTextOutEvent; See TDXPowerFontAfterTextOutEvent.
* - property Alphabets: string; TDXPowerFont uses this character-string for retrieving the pattern number of each character.
* - property TextOutType: TDXPowerFontTextOutType; See TDXPowerFontTextOutType.
* - property TextOutEffect: TDXPowerFontTextOutEffect; See TDXPowerFontTextOutEffect.
* - property EffectsParameters: TDXPowerFontEffectsParameters; See TDXPowerFontEffectsParameters.
*
* - function TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
* This function draws/prints the given text on the given TDirectDrawSurface.
* - DirectDrawSurface: The surface for drawing text (character-string).
* - (X , Y): The first point of outputed text. (Such as X,Y parameters in TCanvas.TextOut function)
* - Text: The text for printing.
* Return values: This function returns False when an error occured or...
* - function TextOutFast(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
* This function works such as TextOut function but,
* with out calculating any Parameters/Effects/Enter-Characters/etc...
* This function calculates the TextOutType, ONLY.
*
* Ramin.S.Zaghi (ramin_zaghi@yahoo.com)
* (Based on wilson's code for TDXFont VCL-Component/Add-On)
* (wilson@no2games.com)
*
* For more information visit:
* www.no2games.com
* turbo.gamedev.net
******************************************************************************)
 
{ DXPowerFont types }
 
TDXPowerFontTextOutEffect = (teNormal, teRotat, teAlphaBlend, teWaveX);
TDXPowerFontTextOutType = (ttUpperCase, ttLowerCase, ttNormal);
TDXPowerFontBeforeTextOutEvent = procedure(Sender: TObject; var Text: string; var DoTextOut: Boolean) of object;
TDXPowerFontAfterTextOutEvent = procedure(Sender: TObject; Text: string) of object;
 
{ TDXPowerFontEffectsParameters }
 
TDXPowerFontEffectsParameters = class(TPersistent)
private
FCenterX: Integer;
FCenterY: Integer;
FHeight: Integer;
FWidth: Integer;
FAngle: Integer;
FAlphaValue: Integer;
FWPhase: Integer;
FWAmplitude: Integer;
FWLenght: Integer;
procedure SetAngle(const Value: Integer);
procedure SetCenterX(const Value: Integer);
procedure SetCenterY(const Value: Integer);
procedure SetHeight(const Value: Integer);
procedure SetWidth(const Value: Integer);
procedure SetAlphaValue(const Value: Integer);
procedure SetWAmplitude(const Value: Integer);
procedure SetWLenght(const Value: Integer);
procedure SetWPhase(const Value: Integer);
published
property CenterX: Integer read FCenterX write SetCenterX;
property CenterY: Integer read FCenterY write SetCenterY;
property Width: Integer read FWidth write SetWidth;
property Height: Integer read FHeight write SetHeight;
property Angle: Integer read FAngle write SetAngle;
property AlphaValue: Integer read FAlphaValue write SetAlphaValue;
property WAmplitude: Integer read FWAmplitude write SetWAmplitude;
property WLenght: Integer read FWLenght write SetWLenght;
property WPhase: Integer read FWPhase write SetWPhase;
end;
 
{ TDXPowerFont }
 
TDXPowerFont = class(TComponent)
private
FDXImageList: TDXImageList;
FFont: string;
FFontIndex: Integer;
FUseEnterChar: Boolean;
FEnterCharacter: string;
FAfterTextOut: TDXPowerFontAfterTextOutEvent;
FBeforeTextOut: TDXPowerFontBeforeTextOutEvent;
FAlphabets: string;
FTextOutType: TDXPowerFontTextOutType;
FTextOutEffect: TDXPowerFontTextOutEffect;
FEffectsParameters: TDXPowerFontEffectsParameters;
procedure SetFont(const Value: string);
procedure SetFontIndex(const Value: Integer);
procedure SetUseEnterChar(const Value: Boolean);
procedure SetEnterCharacter(const Value: string);
procedure SetAlphabets(const Value: string);
procedure SetTextOutType(const Value: TDXPowerFontTextOutType);
procedure SetTextOutEffect(const Value: TDXPowerFontTextOutEffect);
procedure SetEffectsParameters(const Value: TDXPowerFontEffectsParameters);
published
property Font: string read FFont write SetFont;
property FontIndex: Integer read FFontIndex write SetFontIndex;
property DXImageList: TDXImageList read FDXImageList write FDXImageList;
property UseEnterChar: Boolean read FUseEnterChar write SetUseEnterChar;
property EnterCharacter: string read FEnterCharacter write SetEnterCharacter;
property BeforeTextOut: TDXPowerFontBeforeTextOutEvent read FBeforeTextOut write FBeforeTextOut;
property AfterTextOut: TDXPowerFontAfterTextOutEvent read FAfterTextOut write FAfterTextOut;
property Alphabets: string read FAlphabets write SetAlphabets;
property TextOutType: TDXPowerFontTextOutType read FTextOutType write SetTextOutType;
property TextOutEffect: TDXPowerFontTextOutEffect read FTextOutEffect write SetTextOutEffect;
property EffectsParameters: TDXPowerFontEffectsParameters read FEffectsParameters write SetEffectsParameters;
public
Offset: Integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
function TextOutFast(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
end;
 
{D2D unit for pure HW support
* Copyright (c) 2004-2010 Jaro Benes
* All Rights Reserved
* Version 1.09
* D2D Hardware module - interface part
* web site: www.micrel.cz/Dx
* e-mail: delphix_d2d@micrel.cz
}
 
{supported texture vertex as substitute type from DirectX}
 
{TD2D4Vertex - used with D2DTexturedOn}
 
TD2D4Vertex = array[0..3] of TD3DTLVERTEX;
 
{TD2DTextures - texture storage used with Direct3D}
TTextureRec = packed record
{$IFDEF VIDEOTEX}
VDIB: TDIB;
{$ENDIF}
D2DTexture: TDirect3DTexture2;
FloatX1, FloatY1, FloatX2, FloatY2: Double; //uschov vyrez
Name: string{$IFNDEF VER4UP} [255]{$ENDIF}; //jmeno obrazku pro snadne dohledani
Width, Height: Integer;
AlphaChannel: Boolean; //.06c
end;
PTextureRec = ^TTextureRec;
TTextureArr = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TTextureRec;
{$IFNDEF VER4UP}
PTextureArr = ^TTextureArr;
EMaxTexturesError = class(Exception);
{$ENDIF}
TD2DTextures = class
private
FDDraw: TCustomDXDraw;
{$IFNDEF VER4UP}
TexLen: Integer;
Texture: PTextureArr;
{$ELSE}
Texture: TTextureArr;
{$ENDIF}
function GetD2DMaxTextures: Integer;
procedure SetD2DMaxTextures(const Value: Integer);
procedure D2DPruneTextures;
procedure D2DPruneAllTextures;
procedure SizeAdjust(var DIB: TDIB; var FloatX1, FloatY1, FloatX2,
FloatY2: Double);
function SetTransparentColor(dds: TDirectDrawSurface; PixelColor: Integer;
Transparent: Boolean): Integer;
{$IFDEF VIDEOTEX}
function GetTexLayoutByName(name: string): TDIB;
{$ENDIF}
procedure SaveTextures(path: string);
public
constructor Create(DDraw: TCustomDXDraw);
destructor Destroy; override;
procedure D2DFreeTextures;
function Find(byName: string): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
function GetTextureByName(const byName: string): TDirect3DTexture2;
function GetTextureByIndex(const byIndex: Integer): TDirect3DTexture2;
function GetTextureNameByIndex(const byIndex: Integer): string;
function Count: Integer;
{functions support loading image or DDS}
{$IFDEF VER4UP}
function CanFindTexture(aImage: TPictureCollectionItem): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
function CanFindTexture(const TexName: string): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
function CanFindTexture(const Color: LongInt): Boolean; overload;{$IFDEF VER9UP}inline;{$ENDIF}
function LoadTextures(aImage: TPictureCollectionItem): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
function LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean; overload;
function LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean; TransparentColor: Integer; asTexName: string): Boolean; overload;
function LoadTextures(Color: Integer): Boolean; overload;
{$ELSE}
function CanFindTexture(aImage: TPictureCollectionItem): Boolean;
function CanFindTexture2(const TexName: string): Boolean;
function CanFindTexture3(const Color: LongInt): Boolean;
function LoadTextures(aImage: TPictureCollectionItem): Boolean;
function LoadTextures2(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean;
function LoadTextures3(dds: TDirectDrawSurface; Transparent: Boolean; TransparentColor: Integer; asTexName: string): Boolean;
function LoadTextures4(Color: Integer): Boolean;
{$ENDIF}
{$IFDEF VIDEOTEX}
property TexLayoutByName[name: string]: TDIB read GetTexLayoutByName;
{$ENDIF}
//published
property D2DMaxTextures: Integer read GetD2DMaxTextures write SetD2DMaxTextures;
end;
 
{Main component for HW support}
 
TD2D = class
private
FDDraw: TCustomDXDraw;
FCanUseD2D: Boolean;
FBitCount: Integer;
FMirrorFlipSet: TRenderMirrorFlipSet;
FD2DTextureFilter: TD2DTextureFilter;
FD2DAntialiasFilter: TD3DAntialiasMode;
FVertex: TD2D4Vertex;
FD2DTexture: TD2DTextures;
FDIB: TDIB;
FD3DDevDesc7: TD3DDeviceDesc7;
FInitialized: Boolean;
{ukazuje pocet textur}
procedure D2DUpdateTextures; {$IFDEF VER9UP}inline;{$ENDIF}
 
procedure SetCanUseD2D(const Value: Boolean);
function GetCanUseD2D: Boolean;
{create the component}
constructor Create(DDraw: TCustomDXDraw);
procedure SetD2DTextureFilter(const Value: TD2DTextureFilter);
procedure SetD2DAntialiasFilter(const Value: TD3DAntialiasMode);
procedure D2DEffectSolid; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DEffectAdd; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DEffectSub; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DEffectBlend; {$IFDEF VER9UP}inline;{$ENDIF}// used with alpha
 
{verticies}
procedure InitVertex; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DWhite: Integer; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DVertColor(RenderType: TRenderType; Alpha: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DColoredVertex(C: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
function D2DAlphaVertex(Alpha: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DSpecularVertex(C: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
{Fade used with Add and Sub}
function D2DFade(Alpha: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DFadeColored(C, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
 
function RenderQuad: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
procedure D2DRect(R: TRect); {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DTU(T: TTextureRec); {$IFDEF VER9UP}inline;{$ENDIF}
{low lever version texturing for DDS}
function D2DTexturedOnDDSTex(dds: TDirectDrawSurface; SubPatternRect: TRect;
Transparent: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
{texturing}
function D2DTexturedOn(Image: TPictureCollectionItem; Pattern: Integer; SubPatternRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
function D2DTexturedOnDDS(dds: TDirectDrawSurface; SubPatternRect: TRect; Transparent: Boolean; RenderType: TRenderType; Alpha: Byte): Boolean;
function D2DTexturedOnRect(Rect: TRect; Color: Integer): Boolean;
function D2DTexturedOnSubRect(Image: TPictureCollectionItem; Pattern: Integer; SubPatternRect, SubRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
 
{low level for rotate mesh}
procedure D2DRotate(X, Y, W, H: Integer; Px, Py: Double; Angle: single);
{low lever routine for mesh mapping}
function D2DMeshMapToWave(dds: TDirectDrawSurface; Transparent: Boolean;
TransparentColor: Integer; X, Y, iWidth, iHeight, PatternIndex: Integer;
PatternRect: TRect;
Amp, Len, Ph, Alpha: Integer;
Effect: TRenderType; DoY: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
property D2DTextures: TD2DTextures read FD2DTexture;
public
//added to public
procedure D2DColAlpha(C, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DCol4Alpha(C1, C2, C3, C4, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DFade4Colored(C1, C2, C3, C4, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
function RenderTri: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
procedure D2DMeshMapToRect(R: TRect);
//
{destruction textures and supported objects here}
destructor Destroy; override;
{use before starting rendering}
procedure BeginScene;
{use after all images have been rendered}
procedure EndScene;
{set directly of texture filter}
property TextureFilter: TD2DTextureFilter write SetD2DTextureFilter;
property AntialiasFilter: TD3DAntialiasMode write SetD2DAntialiasFilter;
{indicate using of this object}
property CanUseD2D: Boolean read GetCanUseD2D write SetCanUseD2D;
 
{set property mirror-flip}
property MirrorFlip: TRenderMirrorFlipSet read FMirrorFlipSet write FMirrorFlipSet;
 
{initialize surface}
function D2DInitializeSurface: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
{Render routines}
function D2DRender(Image: TPictureCollectionItem; DestRect: TRect;
Pattern: Integer; SourceRect: TRect; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean;{$IFDEF VER4UP} overload; {$ENDIF}{$IFDEF VER9UP}inline;{$ENDIF}
 
function {$IFDEF VER4UP}D2DRender{$ELSE}D2DRender2{$ENDIF}(Image: TPictureCollectionItem; R: TRect;
Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER4UP} overload; {$ENDIF}{$IFDEF VER9UP}inline;{$ENDIF}
 
function D2DRenderDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect; Transparent: Boolean;
Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
function D2DRenderCol(Image: TPictureCollectionItem; R: TRect;
Pattern, Color: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DRenderColDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect;
Transparent: Boolean; Pattern, Color: Integer; RenderType:
TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
function D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean;
{$IFDEF VER4UP} overload; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
SrcRect: TRect; Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF Ver4UP} = 255{$ENDIF}): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
{$ENDIF}
function D2DRenderDrawXY(Image: TPictureCollectionItem; X, Y: Integer;
Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VEr4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
{Rotate}
function D2DRenderRotate(Image: TPictureCollectionItem; RotX, RotY,
PictWidth, PictHeight, PatternIndex: Integer; RenderType: TRenderType;
CenterX, CenterY: Double; Angle: single; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DRenderRotateDDS(Image: TDirectDrawSurface; SourceRect: TRect; RotX, RotY,
PictWidth, PictHeight: Integer; RenderType: TRenderType;
CenterX, CenterY: Double; Angle: single; Alpha: Byte;
Transparent: Boolean): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
function D2DRenderRotateModeCol(Image: TPictureCollectionItem; RenderType: TRenderType; RotX, RotY,
PictWidth, PictHeight, PatternIndex: Integer; CenterX, CenterY: Double;
Angle: single; Color: Integer; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DRenderRotateModeColDDS(Image: TDirectDrawSurface;
RotX, RotY, PictWidth, PictHeight: Integer; RenderType: TRenderType;
CenterX, CenterY: Double; Angle: Single; Color: Integer; Alpha: Byte;
Transparent: Boolean): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
{WaveX}
function D2DRenderWaveX(Image: TPictureCollectionItem; X, Y, Width, Height,
PatternIndex: Integer; RenderType: TRenderType; Transparent: Boolean;
Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DRenderWaveXDDS(Source: TDirectDrawSurface; X, Y, Width,
Height: Integer; RenderType: TRenderType; Transparent: Boolean;
Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
{WaveY}
function D2DRenderWaveY(Image: TPictureCollectionItem; X, Y, Width, Height,
PatternIndex: Integer; RenderType: TRenderType; Transparent: Boolean;
Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function D2DRenderWaveYDDS(Source: TDirectDrawSurface; X, Y, Width,
Height: Integer; RenderType: TRenderType; Transparent: Boolean;
Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
{Rect}
function D2DRenderFillRect(Rect: TRect; RGBColor: LongInt;
RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
{addmod}
function D2DRenderColoredPartition(Image: TPictureCollectionItem; DestRect: TRect; PatternIndex,
Color, Specular: Integer; Faded: Boolean;
SourceRect: TRect;
RenderType: TRenderType;
Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
 
procedure SaveTextures(path: string);
end;
 
{ Support functions for texturing }
function dxtMakeChannel(Mask: DWORD; indexed: Boolean): TDXTextureImageChannel;
function dxtEncodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
function dxtDecodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
 
{ Single support routine for convert DIB32 to DXT in one line }
procedure dib2dxt(DIBImage: TDIB; out DXTImage: TDXTextureImage{$IFDEF DXTextureImage_UseZLIB}; const Shrink: Boolean = True{$ENDIF});
 
{ One line call drawing with attributes }
{$IFDEF VER4UP}
procedure DXDraw_Draw(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; TextureFilter: TD2DTextureFilter = D2D_POINT;
MirrorFlip: TRenderMirrorFlipSet = [];
BlendMode: TRenderType = rtDraw; Angle: Single = 0; Alpha: Byte = 255;
CenterX: Double = 0.5; CenterY: Double = 0.5;
Scale: Single = 1.0); {$IFDEF VER9UP}inline;{$ENDIF}
procedure DXDraw_Paint(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean = False;
TextureFilter: TD2DTextureFilter = D2D_POINT;
MirrorFlip: TRenderMirrorFlipSet = [];
BlendMode: TRenderType = rtDraw;
Angle: Single = 0;
Alpha: Byte = 255;
CenterX: Double = 0.5; CenterY: Double = 0.5); {$IFDEF VER9UP}inline;{$ENDIF}
procedure DXDraw_Render(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean = False;
TextureFilter: TD2DTextureFilter = D2D_POINT;
MirrorFlip: TRenderMirrorFlipSet = [];
BlendMode: TRenderType = rtDraw;
Angle: Single = 0;
Alpha: Byte = 255;
CenterX: Double = 0.5; CenterY: Double = 0.5;
Scale: Single = 1.0;
WaveType: TWaveType = wtWaveNone;
Amplitude: Integer = 0; AmpLength: Integer = 0; Phase: Integer = 0); {$IFDEF VER9UP}inline;{$ENDIF}
{$ELSE}
procedure DXDraw_Draw(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; TextureFilter: TD2DTextureFilter;
MirrorFlip: TRenderMirrorFlipSet;
BlendMode: TRenderType; Angle: Single; Alpha: Byte;
CenterX: Double; CenterY: Double;
Scale: Single);
procedure DXDraw_Paint(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
TextureFilter: TD2DTextureFilter;
MirrorFlip: TRenderMirrorFlipSet;
BlendMode: TRenderType;
Angle: Single;
Alpha: Byte;
CenterX: Double; CenterY: Double);
procedure DXDraw_Render(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
TextureFilter: TD2DTextureFilter;
MirrorFlip: TRenderMirrorFlipSet;
BlendMode: TRenderType;
Angle: Single;
Alpha: Byte;
CenterX: Double; CenterY: Double;
Scale: Single;
WaveType: TWaveType;
Amplitude: Integer; AmpLength: Integer; Phase: Integer);
{$ENDIF}
 
implementation
 
uses DXConsts, DXRender;
uses DXConsts{$IFDEF DXR_deprecated}, DXRender{$ENDIF}, D3DUtils;
function DXDirectDrawEnumerate(lpCallback: TDDEnumCallbackA;
function DXDirectDrawEnumerate(lpCallback: {$IFDEF UNICODE}TDDEnumCallbackW{$ELSE}TDDEnumCallbackA{$ENDIF};
lpContext: Pointer): HRESULT;
type
TDirectDrawEnumerate = function(lpCallback: TDDEnumCallbackA;
TDirectDrawEnumerate = function(lpCallback: {$IFDEF UNICODE}TDDEnumCallbackW{$ELSE}TDDEnumCallbackA{$ENDIF};
lpContext: Pointer): HRESULT; stdcall;
begin
Result := TDirectDrawEnumerate(DXLoadLibrary('DDraw.dll', 'DirectDrawEnumerateA'))
Result := TDirectDrawEnumerate(DXLoadLibrary('DDraw.dll', {$IFDEF UNICODE}'DirectDrawEnumerateW'{$ELSE}'DirectDrawEnumerateA'{$ENDIF}))
(lpCallback, lpContext);
end;
 
var
DirectDrawDrivers: TDirectXDrivers;
{$IFDEF _DMO_}DirectDrawDriversEx: TDirectXDriversEx;{$ENDIF}
D2D: TD2D = nil; {for internal use only, }
RenderError: Boolean = false;
 
function EnumDirectDrawDrivers: TDirectXDrivers;
 
function DDENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
function DDENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
begin
Result := True;
with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
946,6 → 2385,45
Result := DirectDrawDrivers;
end;
 
{$IFDEF _DMO_}
function EnumDirectDrawDriversEx: TDirectXDriversEx;
 
function DDENUMCALLBACKEX(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
lpDriverName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer; iMonitor: HMonitor): BOOL; stdcall;
var
X: TDirectXDriverEx;
begin
Result := True;
X := TDirectXDriverEx(DirectDrawDriversEx.Add);
with X do
begin
Guid := lpGuid;
Description := lpstrDescription;
Monitor := iMonitor;
DriverName := lpDriverName;
//GetPhysicalMonitorsFromHMONITOR()
end;
end;
 
//var
// DevMode: TDeviceMode;
begin
if DirectDrawDriversEx = nil then DirectDrawDriversEx := TDirectXDriversEx.Create;
if Assigned(DirectDrawDriversEx) then
begin
//FMonitors.Clear;
try
//FillChar(DevMode, SizeOf(TDeviceMode), 0);
if DirectDrawEnumerateEx(@DDENUMCALLBACKEX, nil{DeviceContext}, DDENUM_ATTACHEDSECONDARYDEVICES or DDENUM_DETACHEDSECONDARYDEVICES or DDENUM_NONDISPLAYDEVICES) = DD_OK then;
except
DirectDrawDriversEx.Free; DirectDrawDriversEx := nil;
raise;
end;
end;
Result := DirectDrawDriversEx;
end;
{$ENDIF}
 
function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
begin
with DestRect do
1033,11 → 2511,13
FPalettes := TList.Create;
FSurfaces := TList.Create;
 
{$IFDEF D3D_deprecated}
if DirectX7Mode then
begin
begin {$ENDIF}
{ DirectX 7 }
if TDirectDrawCreateEx(DXLoadLibrary('DDraw.dll', 'DirectDrawCreateEx')) (GUID, FIDDraw7, IID_IDirectDraw7, nil)<>DD_OK then
raise EDirectDrawError.CreateFmt(SCannotInitialized, [SDirectDraw]);
{$IFDEF D3D_deprecated}
try
FIDDraw := FIDDraw7 as IDirectDraw;
FIDDraw4 := FIDDraw7 as IDirectDraw4;
1044,7 → 2524,8
except
raise EDirectDrawError.Create(SSinceDirectX7);
end;
end else
{$ENDIF}
{$IFDEF D3D_deprecated}end else
begin
if TDirectDrawCreate(DXLoadLibrary('DDraw.dll', 'DirectDrawCreate')) (GUID, FIDDraw, nil)<>DD_OK then
raise EDirectDrawError.CreateFmt(SCannotInitialized, [SDirectDraw]);
1053,11 → 2534,11
except
raise EDirectDrawError.Create(SSinceDirectX6);
end;
end;
end;{$ENDIF}
 
FDriverCaps.dwSize := SizeOf(FDriverCaps);
FHELCaps.dwSize := SizeOf(FHELCaps);
FIDDraw.GetCaps(FDriverCaps, FHELCaps);
{$IFDEF D3D_deprecated}FIDDraw{$ELSE}FIDDraw7{$ENDIF}.GetCaps(@FDriverCaps, @FHELCaps);
end;
 
destructor TDirectDraw.Destroy;
1082,6 → 2563,13
Result := EnumDirectDrawDrivers;
end;
 
{$IFDEF _DMO_}
class function TDirectDraw.DriversEx: TDirectXDriversEx;
begin
Result := EnumDirectDrawDriversEx;
end;
{$ENDIF}
 
function TDirectDraw.GetClipper(Index: Integer): TDirectDrawClipper;
begin
Result := FClippers[Index];
1092,14 → 2580,14
Result := FClippers.Count;
end;
 
function TDirectDraw.GetDisplayMode: TDDSurfaceDesc;
function TDirectDraw.GetDisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
Result.dwSize := SizeOf(Result);
DXResult := IDraw.GetDisplayMode(Result);
DXResult := {$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.GetDisplayMode(Result);
if DXResult<>DD_OK then
FillChar(Result, SizeOf(Result), 0);
end;
 
{$IFDEF D3D_deprecated}
function TDirectDraw.GetIDDraw: IDirectDraw;
begin
if Self<>nil then
1115,7 → 2603,7
else
Result := nil;
end;
 
{$ENDIF}
function TDirectDraw.GetIDDraw7: IDirectDraw7;
begin
if Self<>nil then
1123,7 → 2611,7
else
Result := nil;
end;
 
{$IFDEF D3D_deprecated}
function TDirectDraw.GetIDraw: IDirectDraw;
begin
Result := IDDraw;
1137,7 → 2625,7
if Result=nil then
raise EDirectDrawError.CreateFmt(SNotMade, ['IDirectDraw4']);
end;
 
{$ENDIF}
function TDirectDraw.GetIDraw7: IDirectDraw7;
begin
Result := IDDraw7;
1186,7 → 2674,7
begin
IDDPalette := nil;
 
FDDraw.DXResult := FDDraw.IDraw.CreatePalette(Caps, @Entries, TempPalette, nil);
FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.CreatePalette(Caps, @Entries, TempPalette, nil);
FDXResult := FDDraw.DXResult;
Result := FDDraw.DXResult=DD_OK;
if Result then
1288,7 → 2776,7
FDDraw := ADirectDraw;
FDDraw.FClippers.Add(Self);
 
FDDraw.DXResult := FDDraw.IDraw.CreateClipper(0, FIDDClipper, nil);
FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.CreateClipper(0, FIDDClipper, nil);
if FDDraw.DXResult<>DD_OK then
raise EDirectDrawClipperError.CreateFmt(SCannotMade, [SDirectDrawClipper]);
end;
1381,7 → 2869,7
 
procedure TDirectDrawSurfaceCanvas.CreateHandle;
begin
FSurface.DXResult := FSurface.ISurface.GetDC(FDC);
FSurface.DXResult := FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetDC(FDC);
if FSurface.DXResult=DD_OK then
Handle := FDC;
end;
1388,10 → 2876,10
 
procedure TDirectDrawSurfaceCanvas.Release;
begin
if (FSurface.IDDSurface<>nil) and (FDC<>0) then
if (FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (FDC <> 0) then
begin
Handle := 0;
FSurface.IDDSurface.ReleaseDC(FDC);
FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}.ReleaseDC(FDC);
FDC := 0;
end;
end;
1403,16 → 2891,18
inherited Create;
FDDraw := ADirectDraw;
FDDraw.FSurfaces.Add(Self);
DIB_COLMATCH := TDIB.Create;
end;
 
destructor TDirectDrawSurface.Destroy;
begin
DIB_COLMATCH.Free;
FCanvas.Free;
IDDSurface := nil;
{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
FDDraw.FSurfaces.Remove(Self);
inherited Destroy;
end;
 
{$IFDEF D3D_deprecated}
function TDirectDrawSurface.GetIDDSurface: IDirectDrawSurface;
begin
if Self<>nil then
1428,7 → 2918,7
else
Result := nil;
end;
 
{$ENDIF}
function TDirectDrawSurface.GetIDDSurface7: IDirectDrawSurface7;
begin
if Self<>nil then
1436,7 → 2926,7
else
Result := nil;
end;
 
{$IFDEF D3D_deprecated}
function TDirectDrawSurface.GetISurface: IDirectDrawSurface;
begin
Result := IDDSurface;
1450,7 → 2940,7
if Result=nil then
raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface4']);
end;
 
{$ENDIF}
function TDirectDrawSurface.GetISurface7: IDirectDrawSurface7;
begin
Result := IDDSurface7;
1457,7 → 2947,7
if Result=nil then
raise EDirectDrawSurfaceError.CreateFmt(SNotMade, ['IDirectDrawSurface7']);
end;
 
{$IFDEF D3D_deprecated}
procedure TDirectDrawSurface.SetIDDSurface(Value: IDirectDrawSurface);
var
Clipper: IDirectDrawClipper;
1498,21 → 2988,50
else
SetIDDSurface(Value as IDirectDrawSurface);
end;
 
{$ENDIF}
procedure TDirectDrawSurface.SetIDDSurface7(Value: IDirectDrawSurface7);
{$IFNDEF D3D_deprecated}
var
Clipper: IDirectDrawClipper;
{$ENDIF}
begin
{$IFDEF D3D_deprecated}
if Value=nil then
SetIDDSurface(nil)
else
SetIDDSurface(Value as IDirectDrawSurface);
{$ELSE}
if Value = nil then Exit;
if Value as IDirectDrawSurface7 = FIDDSurface7 then Exit;
FIDDSurface7 := nil;
 
FStretchDrawClipper := nil;
FGammaControl := nil;
FHasClipper := False;
FLockCount := 0;
FillChar(FSurfaceDesc, SizeOf(FSurfaceDesc), 0);
 
if Value <> nil then
begin
if FDDraw.FIDDraw7 <> nil then FIDDSurface7 := Value as IDirectDrawSurface7;
 
FHasClipper := (FIDDSurface7.GetClipper(Clipper) = DD_OK) and (Clipper <> nil);
 
FSurfaceDesc.dwSize := SizeOf(FSurfaceDesc);
{$IFDEF D3D_deprecated}FIDDSurface{$ELSE}FIDDSurface7{$ENDIF}.GetSurfaceDesc(FSurfaceDesc);
 
if FDDraw.DriverCaps.dwCaps2 and DDCAPS2_PRIMARYGAMMA <> 0 then
{$IFDEF D3D_deprecated}FIDDSurface{$ELSE}FIDDSurface7{$ENDIF}.QueryInterface(IID_IDirectDrawGammaControl, FGammaControl);
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.Assign(Source: TPersistent);
var
TempSurface: IDirectDrawSurface;
TempSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF};
begin
if Source=nil then
IDDSurface := nil
{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil
else if Source is TGraphic then
LoadFromGraphic(TGraphic(Source))
else if Source is TPicture then
1519,14 → 3038,14
LoadFromGraphic(TPicture(Source).Graphic)
else if Source is TDirectDrawSurface then
begin
if TDirectDrawSurface(Source).IDDSurface=nil then
IDDSurface := nil
if TDirectDrawSurface(Source).{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then
{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil
else begin
FDDraw.DXResult := FDDraw.IDraw.DuplicateSurface(TDirectDrawSurface(Source).IDDSurface,
FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.DuplicateSurface(TDirectDrawSurface(Source).{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF},
TempSurface);
if FDDraw.DXResult=0 then
begin
IDDSurface := TempSurface;
{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := TempSurface;
end;
end;
end else
1535,11 → 3054,31
 
procedure TDirectDrawSurface.AssignTo(Dest: TPersistent);
begin
if Dest is TBitmap then
begin
try
TBitmap(Dest).PixelFormat := pf24bit;
if BitCount >= 24 then {please accept the Alphachannel too}
TBitmap(Dest).PixelFormat := pf32bit;
TBitmap(Dest).Width := Width;
TBitmap(Dest).Height := Height;
TBitmap(Dest).Canvas.CopyRect(Rect(0, 0, TBitmap(Dest).Width, TBitmap(Dest).Height), Canvas, ClientRect);
finally
Canvas.Release;
end
end
else
if Dest is TDIB then
begin
try
if BitCount >= 24 then {please accept the Alphachannel too}
TDIB(Dest).SetSize(Width, Height, BitCount)
else
TDIB(Dest).SetSize(Width, Height, 24);
TDIB(Dest).Canvas.CopyRect(Rect(0, 0, TDIB(Dest).Width, TDIB(Dest).Height), Canvas, ClientRect);
finally
Canvas.Release;
end
end else
inherited AssignTo(Dest);
end;
1547,9 → 3086,9
function TDirectDrawSurface.Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean;
begin
if IDDSurface<>nil then
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
begin
DXResult := ISurface.Blt(DestRect, Source.IDDSurface, SrcRect, DWORD(Flags), DF);
DXResult := {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}.Blt(@DestRect, Source.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}, @SrcRect, DWORD(Flags), @DF);
Result := DXResult=DD_OK;
end else
Result := False;
1558,9 → 3097,9
function TDirectDrawSurface.BltFast(X, Y: Integer; const SrcRect: TRect;
Flags: DWORD; Source: TDirectDrawSurface): Boolean;
begin
if IDDSurface<>nil then
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
begin
DXResult := ISurface.BltFast(X, Y, Source.IDDSurface, SrcRect, DWORD(Flags));
DXResult := {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}.BltFast(X, Y, Source.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF}, @SrcRect, DWORD(Flags));
Result := DXResult=DD_OK;
end else
Result := False;
1568,29 → 3107,25
 
function TDirectDrawSurface.ColorMatch(Col: TColor): Integer;
var
DIB: TDIB;
i, oldc: Integer;
begin
if IDDSurface<>nil then
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
begin
oldc := Pixels[0, 0];
 
DIB := TDIB.Create;
try
i := ColorToRGB(Col);
DIB.SetSize(1, 1, 8);
DIB.ColorTable[0] := RGBQuad(GetRValue(i), GetGValue(i), GetBValue(i));
DIB.UpdatePalette;
DIB.Pixels[0, 0] := 0;
DIB_COLMATCH.SetSize(1, 1, 8);
DIB_COLMATCH.ColorTable[0] := RGBQuad(GetRValue(i), GetGValue(i), GetBValue(i));
DIB_COLMATCH.UpdatePalette;
DIB_COLMATCH.Pixels[0, 0] := 0;
 
with Canvas do
begin
Draw(0, 0, DIB);
try
Draw(0, 0, DIB_COLMATCH);
finally
Release;
end;
finally
DIB.Free;
end;
 
Result := Pixels[0, 0];
Pixels[0, 0] := oldc;
end else
1597,7 → 3132,8
Result := 0;
end;
 
function TDirectDrawSurface.CreateSurface(const SurfaceDesc: TDDSurfaceDesc): Boolean;
{$IFDEF D3D_deprecated}
function TDirectDrawSurface.CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean;
var
TempSurface: IDirectDrawSurface;
begin
1612,19 → 3148,19
TransparentColor := 0;
end;
end;
 
{$IFDEF DelphiX_Spt4}
function TDirectDrawSurface.CreateSurface(const SurfaceDesc: TDDSurfaceDesc2): Boolean;
{$ENDIF}
{$IFDEF VER4UP}
function TDirectDrawSurface.CreateSurface(SurfaceDesc: TDDSurfaceDesc2): Boolean;
var
TempSurface4: IDirectDrawSurface4;
TempSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
begin
IDDSurface := nil;
FDDraw.DXResult := FDDraw.IDraw4.CreateSurface(SurfaceDesc, TempSurface4, nil);
{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
FDDraw.DXResult := FDDraw.{$IFDEF D3D_deprecated}IDraw4{$ELSE}IDraw7{$ENDIF}.CreateSurface(SurfaceDesc, TempSurface, nil);
FDXResult := FDDraw.DXResult;
Result := FDDraw.DXResult=DD_OK;
if Result then
begin
IDDSurface4 := TempSurface4;
{$IFDEF D3D_deprecated}IDDSurface4{$ELSE}IDDSurface7{$ENDIF} := TempSurface;
TransparentColor := 0;
end;
end;
1637,16 → 3173,27
(DDBLTFAST_NOCOLORKEY or DDBLTFAST_WAIT, DDBLTFAST_SRCCOLORKEY or DDBLTFAST_WAIT);
BltFlags: array[Boolean] of Integer =
(DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
var
{$IFDEF DXR_deprecated}var
DestRect: TRect;
DF: TDDBltFX;
Clipper: IDirectDrawClipper;
i: Integer;
i: Integer;{$ENDIF}
begin
if Source<>nil then
begin
if (X>Width) or (Y>Height) then Exit;
 
{$IFDEF DrawHWAcc}
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then
begin
{$IFDEF VER4UP}
D2D.D2DRenderDrawDDSXY(Source, X, Y, SrcRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
{$ELSE}
D2D.D2DRenderDDS(Source, SrcRect, Bounds(X, Y, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top), Transparent, 0, rtDraw, $FF);
{$ENDIF}
Exit;
end;
{$ENDIF DrawHWAcc}
{$IFDEF DXR_deprecated}
if (SrcRect.Left>SrcRect.Right) or (SrcRect.Top>SrcRect.Bottom) then
begin
{ Mirror }
1706,7 → 3253,7
BltFast(DestRect.Left, DestRect.Top, SrcRect, BltFastFlags[Transparent], Source);
if DXResult=DDERR_BLTFASTCANTCLIP then
begin
ISurface.GetClipper(Clipper);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(Clipper);
if Clipper<>nil then FHasClipper := True;
 
DF.dwsize := SizeOf(DF);
1716,10 → 3263,11
end;
end;
end;
{$ENDIF}
end;
end;
 
{$IFDEF DelphiX_Spt4}
{$IFDEF VER4UP}
procedure TDirectDrawSurface.Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean);
const
BltFastFlags: array[Boolean] of Integer =
1728,14 → 3276,20
(DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
var
DestRect, SrcRect: TRect;
DF: TDDBltFX;
Clipper: IDirectDrawClipper;
{$IFDEF DXR_deprecated}DF: TDDBltFX;
Clipper: IDirectDrawClipper;{$ENDIF}
begin
if Source<>nil then
begin
SrcRect := Source.ClientRect;
DestRect := Bounds(X, Y, Source.Width, Source.Height);
 
{$IFDEF DrawHWAcc}
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderDDS(Source, ZeroRect, DestRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
Exit;
end;
{$ENDIF DrawHWAcc}
{$IFDEF DXR_deprecated}
if ClipRect2(DestRect, SrcRect, ClientRect, Source.ClientRect) then
begin
if FHasClipper then
1748,7 → 3302,7
BltFast(DestRect.Left, DestRect.Top, SrcRect, BltFastFlags[Transparent], Source);
if DXResult=DDERR_BLTFASTCANTCLIP then
begin
ISurface.GetClipper(Clipper);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(Clipper);
if Clipper<>nil then FHasClipper := True;
 
DF.dwsize := SizeOf(DF);
1757,6 → 3311,7
end;
end;
end;
{$ENDIF}
end;
end;
{$ENDIF}
1766,16 → 3321,22
const
BltFlags: array[Boolean] of Integer =
(DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
var
{$IFDEF DXR_deprecated}var
DF: TDDBltFX;
OldClipper: IDirectDrawClipper;
Clipper: TDirectDrawClipper;
Clipper: TDirectDrawClipper;{$ENDIF}
begin
if Source<>nil then
begin
if (DestRect.Bottom<=DestRect.Top) or (DestRect.Right<=DestRect.Left) then Exit;
if (SrcRect.Bottom<=SrcRect.Top) or (SrcRect.Right<=SrcRect.Left) then Exit;
 
{$IFDEF DrawHWAcc}
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
Exit;
end;
{$ENDIF DrawHWAcc}
{$IFDEF DXR_deprecated}
if FHasClipper then
begin
DF.dwsize := SizeOf(DF);
1794,27 → 3355,26
end;
end;
 
ISurface.GetClipper(OldClipper);
ISurface.SetClipper(FStretchDrawClipper);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(OldClipper);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(FStretchDrawClipper);
DF.dwsize := SizeOf(DF);
DF.dwDDFX := 0;
Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
ISurface.SetClipper(nil);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(nil);
end;
{$ENDIF}
end;
end;
 
{$IFDEF DelphiX_Spt4}
{$IFDEF VER4UP}
procedure TDirectDrawSurface.StretchDraw(const DestRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean);
const
BltFlags: array[Boolean] of Integer =
 
(DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
BltFlags: array[Boolean] of Integer = (DDBLT_WAIT, DDBLT_KEYSRC or DDBLT_WAIT);
var
DF: TDDBltFX;
{$IFDEF DXR_deprecated}DF: TDDBltFX;
OldClipper: IDirectDrawClipper;
Clipper: TDirectDrawClipper;
Clipper: TDirectDrawClipper;{$ENDIF}
SrcRect: TRect;
begin
if Source<>nil then
1822,7 → 3382,12
if (DestRect.Bottom<=DestRect.Top) or (DestRect.Right<=DestRect.Left) then Exit;
SrcRect := Source.ClientRect;
 
if ISurface.GetClipper(OldClipper)=DD_OK then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderDDS(Source, ZeroRect, DestRect, Transparent, 0, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
Exit;
end;
{$IFDEF DXR_deprecated}
if {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetClipper(OldClipper) = DD_OK then
begin
DF.dwsize := SizeOf(DF);
DF.dwDDFX := 0;
1840,15 → 3405,16
end;
end;
 
ISurface.SetClipper(FStretchDrawClipper);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(FStretchDrawClipper);
try
DF.dwsize := SizeOf(DF);
DF.dwDDFX := 0;
Blt(DestRect, SrcRect, BltFlags[Transparent], df, Source);
finally
ISurface.SetClipper(nil);
{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(nil);
end;
end;
{$ENDIF}
end;
end;
{$ENDIF}
1855,10 → 3421,10
 
procedure TDirectDrawSurface.DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if (Self.Width=0) or (Self.Height=0) then Exit;
if (Width=0) or (Height=0) then Exit;
1867,10 → 3433,15
 
if Alpha<=0 then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtAdd, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
1888,21 → 3459,22
dxrCopyRectBlend(DestSurface, SrcSurface,
DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if (Self.Width=0) or (Self.Height=0) then Exit;
if (Width=0) or (Height=0) then Exit;
1911,10 → 3483,15
 
if Alpha<=0 then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtBlend, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
1932,21 → 3509,22
dxrCopyRectBlend(DestSurface, SrcSurface,
DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
Transparent: Boolean; Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if (Self.Width=0) or (Self.Height=0) then Exit;
if (Width=0) or (Height=0) then Exit;
1955,10 → 3533,15
 
if Alpha<=0 then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderDDS(Source, SrcRect, DestRect, Transparent, 0, rtSub, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
1976,20 → 3559,79
dxrCopyRectBlend(DestSurface, SrcSurface,
DestRect, SrcRect, Blend, Alpha, Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawAlphaCol(const DestRect, SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; Color, Alpha: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if Alpha <= 0 then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderColDDS(Source, SrcRect, DestRect, Transparent, 0, Color, rtBlend, Alpha);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color DrawAlpha
Self.DrawAlpha(DestRect, SrcRect, Source, Transparent, Alpha);
end;
 
procedure TDirectDrawSurface.DrawSubCol(const DestRect, SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; Color, Alpha: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if Alpha <= 0 then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderColDDS(Source, SrcRect, DestRect, Transparent, 0, Color, rtSub, Alpha);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color DrawSub
Self.DrawSub(DestRect, SrcRect, Source, Transparent, Alpha);
end;
 
procedure TDirectDrawSurface.DrawAddCol(const DestRect, SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; Color, Alpha: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if Alpha <= 0 then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderColDDS(Source, SrcRect, DestRect, Transparent, 0, Color, rtAdd, Alpha);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color DrawAdd
Self.DrawAdd(DestRect, SrcRect, Source, Transparent, Alpha);
 
end;
 
procedure TDirectDrawSurface.DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Integer);
var
Src_ddsd: TDDSurfaceDesc;
DestSurface, SrcSurface: TDXR_Surface;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single);
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;{$ENDIF}
begin
if (Self.Width=0) or (Self.Height=0) then Exit;
if (Width=0) or (Height=0) then Exit;
1996,31 → 3638,37
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtDraw, CenterX, CenterY, Angle, $FF, Transparent);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
dxrDrawRotateBlend(DestSurface, SrcSurface,
X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, DXR_BLEND_ONE1, 0,
X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), DXR_BLEND_ONE1, 0,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle, Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single; Alpha: Integer);
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend; {$ENDIF}
begin
if Alpha<=0 then Exit;
 
2029,10 → 3677,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtAdd, CenterX, CenterY, Angle, Alpha, Transparent);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
2048,24 → 3701,25
end;
 
dxrDrawRotateBlend(DestSurface, SrcSurface,
X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, Blend, Alpha,
X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), Blend, Alpha,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle, Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single; Alpha: Integer);
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend; {$ENDIF}
begin
if Alpha<=0 then Exit;
 
2074,10 → 3728,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtBlend, CenterX, CenterY, Angle, Alpha, Transparent);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
2093,24 → 3752,25
end;
 
dxrDrawRotateBlend(DestSurface, SrcSurface,
X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, Blend, Alpha,
X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), Blend, Alpha,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle, Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single; Alpha: Integer);
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if Alpha<=0 then Exit;
 
2119,10 → 3779,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateDDS(Source, SrcRect, X, Y, Width, Height, rtSub, CenterX, CenterY, Angle, Alpha, Transparent);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
2138,23 → 3803,94
end;
 
dxrDrawRotateBlend(DestSurface, SrcSurface,
X, Y, Width, Height, SrcRect, CenterX, CenterY, Angle, Blend, Alpha,
X, Y, Width, Height, SrcRect, CenterX, CenterY, round(Angle), Blend, Alpha,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawRotateCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtDraw, CenterX, CenterY, Angle, Color, $FF, Transparent);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color, moded DrawRotate
Self.DrawRotate(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle);
end;
 
procedure TDirectDrawSurface.DrawRotateAlphaCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color, Alpha: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtBlend, CenterX, CenterY, Angle, Color, Alpha, Transparent);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color, moded DrawRotate
Self.DrawRotateAlpha(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle, Alpha);
end;
 
procedure TDirectDrawSurface.DrawRotateAddCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color, Alpha: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtAdd, CenterX, CenterY, Angle, Color, Alpha, Transparent);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color, moded DrawRotate
Self.DrawRotateAdd(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle, Alpha);
end;
 
procedure TDirectDrawSurface.DrawRotateSubCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: Single; Color, Alpha: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderRotateModeColDDS(Source, X, Y, Width, Height, rtSub, CenterX, CenterY, Angle, Color, Alpha, Transparent);
Exit;
end;
 
// If no hardware acceleration, falls back to non-color, moded DrawRotate
Self.DrawRotateSub(X, Y, Width, Height, SrcRect, Source, CenterX, CenterY, Transparent, Angle, Alpha);
end;
 
//waves
 
procedure TDirectDrawSurface.DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
var
Src_ddsd: TDDSurfaceDesc;
DestSurface, SrcSurface: TDXR_Surface;
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;{$ENDIF}
begin
if (Self.Width=0) or (Self.Height=0) then Exit;
if (Width=0) or (Height=0) then Exit;
2161,10 → 3897,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtDraw, Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
dxrDrawWaveXBlend(DestSurface, SrcSurface,
2171,21 → 3912,22
X, Y, Width, Height, SrcRect, amp, Len, ph, DXR_BLEND_ONE1, 0,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
var
Src_ddsd: TDDSurfaceDesc;
{$IFDEF DXR_deprecated}var
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if Alpha<=0 then Exit;
 
2194,10 → 3936,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtAdd, Transparent, amp, Len, ph, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
2216,21 → 3963,23
X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
{$IFDEF DXR_deprecated}
var
Src_ddsd: TDDSurfaceDesc;
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if Alpha<=0 then Exit;
 
2239,10 → 3988,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtBlend, Transparent, amp, Len, ph, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
2261,21 → 4015,23
X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph, Alpha: Integer);
{$IFDEF DXR_deprecated}
var
Src_ddsd: TDDSurfaceDesc;
Src_ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
DestSurface, SrcSurface: TDXR_Surface;
Blend: TDXR_Blend;
Blend: TDXR_Blend;{$ENDIF}
begin
if Alpha<=0 then Exit;
 
2284,10 → 4040,15
if Source=nil then Exit;
if (Source.Width=0) or (Source.Height=0) then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveXDDS(Source, X, Y, Width, Height, rtSub, Transparent, amp, Len, ph, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
if dxrDDSurfaceLock2(Source.ISurface, Src_ddsd, SrcSurface) then
if dxrDDSurfaceLock2(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, Src_ddsd, SrcSurface) then
begin
try
if DestSurface.ColorType=DXR_COLORTYPE_INDEXED then
2306,15 → 4067,82
X, Y, Width, Height, SrcRect, amp, Len, ph, Blend, Alpha,
Transparent, Src_ddsd.ddckCKSrcBlt.dwColorSpaceLowValue);
finally
dxrDDSurfaceUnLock(Source.ISurface, SrcSurface)
dxrDDSurfaceUnLock(Source.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, SrcSurface)
end;
end;
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
 
procedure TDirectDrawSurface.DrawWaveYSub(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
Len, ph, Alpha: Integer);
begin
if Alpha <= 0 then Exit;
 
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtSub, Transparent, amp, Len, ph, Alpha);
Exit;
end;
end;
 
procedure TDirectDrawSurface.DrawWaveY(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
Len, ph: Integer);
begin
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtDraw, Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
Exit;
end;
end;
 
procedure TDirectDrawSurface.DrawWaveYAdd(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
Len, ph, Alpha: Integer);
begin
if Alpha <= 0 then Exit;
 
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtAdd, Transparent, amp, Len, ph, Alpha);
Exit;
end;
end;
 
procedure TDirectDrawSurface.DrawWaveYAlpha(X, Y, Width, Height: Integer;
const SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean; amp,
Len, ph, Alpha: Integer);
begin
if Alpha <= 0 then Exit;
 
if (Self.Width = 0) or (Self.Height = 0) then Exit;
if (Width = 0) or (Height = 0) then Exit;
if Source = nil then Exit;
if (Source.Width = 0) or (Source.Height = 0) then Exit;
 
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderWaveYDDS(Source, X, Y, Width, Height, rtBlend, Transparent, amp, Len, ph, Alpha);
Exit;
end;
end;
 
procedure TDirectDrawSurface.Fill(DevColor: Longint);
var
DBltEx: TDDBltFX;
2336,9 → 4164,9
Blt(DestRect, TRect(nil^), DDBLT_COLORFILL or DDBLT_WAIT, DBltEx, nil);
end;
 
procedure TDirectDrawSurface.FillRectAdd(const DestRect: TRect; Color: TColor);
var
DestSurface: TDXR_Surface;
procedure TDirectDrawSurface.FillRectAdd(const DestRect: TRect; Color: TColor; Alpha: Byte);
{$IFDEF DXR_deprecated}var
DestSurface: TDXR_Surface;{$ENDIF}
begin
if Color and $FFFFFF=0 then Exit;
if (Self.Width=0) or (Self.Height=0) then Exit;
2345,38 → 4173,49
if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8)<>0 then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderFillRect(DestRect, ColorToRGB(Color), rtAdd, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_ONE1_ADD_ONE2, ColorToRGB(Color));
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;
{$ENDIF}
end;
procedure TDirectDrawSurface.FillRectAlpha(const DestRect: TRect; Color: TColor;
Alpha: Integer);
var
DestSurface: TDXR_Surface;
{$IFDEF DXR_deprecated}var
DestSurface: TDXR_Surface;{$ENDIF}
begin
if (Self.Width=0) or (Self.Height=0) then Exit;
if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8)<>0 then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderFillRect(DestRect, ColorToRGB(Color), rtBlend, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2, ColorToRGB(Color) or (Byte(Alpha) shl 24));
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;{$ENDIF}
end;
end;
 
procedure TDirectDrawSurface.FillRectSub(const DestRect: TRect; Color: TColor);
var
DestSurface: TDXR_Surface;
procedure TDirectDrawSurface.FillRectSub(const DestRect: TRect; Color: TColor; Alpha: Byte);
{$IFDEF DXR_deprecated}var
DestSurface: TDXR_Surface;{$ENDIF}
begin
if Color and $FFFFFF=0 then Exit;
if (Self.Width=0) or (Self.Height=0) then Exit;
2383,15 → 4222,20
if SurfaceDesc.ddpfPixelFormat.dwFlags and (DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
DDPF_PALETTEINDEXED4 or DDPF_PALETTEINDEXED8)<>0 then Exit;
 
if dxrDDSurfaceLock(ISurface, DestSurface) then
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then begin
D2D.D2DRenderFillRect(DestRect, ColorToRGB(Color), rtSub, Alpha);
Exit;
end;
{$IFDEF DXR_deprecated}
if dxrDDSurfaceLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface) then
begin
try
dxrFillRectColorBlend(DestSurface, DestRect, DXR_BLEND_ONE2_SUB_ONE1, ColorToRGB(Color));
finally
dxrDDSurfaceUnLock(ISurface, DestSurface)
dxrDDSurfaceUnLock({$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, DestSurface)
end;
end;{$ENDIF}
end;
end;
 
function TDirectDrawSurface.GetBitCount: Integer;
begin
2423,10 → 4267,10
 
function TDirectDrawSurface.GetPixel(X, Y: Integer): Longint;
var
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
Result := 0;
if (IDDSurface<>nil) and (X>=0) and (X<Width) and (Y>=0) and (Y<Height) then
if ({$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
if Lock(PRect(nil)^, ddsd) then
begin
try
2486,16 → 4330,18
if Graphic is TDIB then
begin
with Canvas do
begin
try
StretchBlt(Handle, 0, 0, AWidth, AHeight, TDIB(Graphic).Canvas.Handle,
Left, Top, Right-Left, Bottom-Top,SRCCOPY);
finally
Release;
end;
end else if (Right-Left=AWidth) and (Bottom-Top=AHeight) then
begin
with Canvas do
begin
try
Draw(-Left, -Top, Graphic);
finally
Release;
end;
end else
2506,8 → 4352,9
Temp.Canvas.Draw(-Left, -Top, Graphic);
 
with Canvas do
begin
try
StretchDraw(Bounds(0, 0, AWidth, AHeight), Temp);
finally
Release;
end;
finally
2543,63 → 4390,81
end;
end;
 
function TDirectDrawSurface.Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean;
function TDirectDrawSurface.Lock(const Rect: TRect; var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean;
begin
Result := False;
if IDDSurface=nil then Exit;
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then Exit;
 
if FLockCount>0 then Exit;
 
FIsLocked := False;
FLockSurfaceDesc.dwSize := SizeOf(FLockSurfaceDesc);
 
if (@Rect<>nil) and ((Rect.Left<>0) or (Rect.Top<>0) or (Rect.Right<>Width) or (Rect.Bottom<>Height)) then
DXResult := ISurface.Lock(@Rect, FLockSurfaceDesc, DDLOCK_WAIT, 0)
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Lock(@Rect, FLockSurfaceDesc, DDLOCK_WAIT, 0)
else
DXResult := ISurface.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
if DXResult<>DD_OK then Exit;
 
Inc(FLockCount);
SurfaceDesc := FLockSurfaceDesc;
 
FIsLocked := True;
Result := True;
end;
{$IFDEF DelphiX_Spt4}
function TDirectDrawSurface.Lock(var SurfaceDesc: TDDSurfaceDesc): Boolean;
{$IFDEF VER4UP}
function TDirectDrawSurface.Lock(var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean;
begin
Result := False;
if IDDSurface=nil then Exit;
FIsLocked := False;
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then Exit;
 
if FLockCount=0 then
begin
FLockSurfaceDesc.dwSize := SizeOf(FLockSurfaceDesc);
DXResult := ISurface.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Lock(nil, FLockSurfaceDesc, DDLOCK_WAIT, 0);
if DXResult<>DD_OK then Exit;
end;
 
Inc(FLockCount);
SurfaceDesc := FLockSurfaceDesc;
FIsLocked := True;
Result := True;
end;
 
function TDirectDrawSurface.Lock: Boolean;
var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
Result := Lock(SurfaceDesc);
end;
 
{$ELSE}
 
function TDirectDrawSurface.LockSurface: Boolean;
var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}; R: TRect;
begin
Result := Lock(R, SurfaceDesc);
end;
{$ENDIF}
 
procedure TDirectDrawSurface.UnLock;
begin
if IDDSurface=nil then Exit;
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} = nil then Exit;
 
if FLockCount>0 then
begin
Dec(FLockCount);
if FLockCount=0 then
DXResult := ISurface.UnLock(FLockSurfaceDesc.lpSurface);
if FLockCount = 0 then begin
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UnLock(FLockSurfaceDesc.lpSurface);
FIsLocked := False;
end;
end;
end;
 
function TDirectDrawSurface.Restore: Boolean;
begin
if IDDSurface<>nil then
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
begin
DXResult := ISurface.Restore;
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}._Restore;
Result := DXResult=DD_OK;
end else
Result := False;
2607,29 → 4472,29
 
procedure TDirectDrawSurface.SetClipper(Value: TDirectDrawClipper);
begin
if IDDSurface<>nil then
DXResult := ISurface.SetClipper(Value.IDDClipper);
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetClipper(Value.IDDClipper);
FHasClipper := (Value<>nil) and (DXResult=DD_OK);
end;
 
procedure TDirectDrawSurface.SetColorKey(Flags: DWORD; const Value: TDDColorKey);
begin
if IDDSurface<>nil then
DXResult := ISurface.SetColorKey(Flags, Value);
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetColorKey(Flags, @Value);
end;
 
procedure TDirectDrawSurface.SetPalette(Value: TDirectDrawPalette);
begin
if IDDSurface<>nil then
DXResult := ISurface.SetPalette(Value.IDDPalette);
if {$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
DXResult := {$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetPalette(Value.IDDPalette);
end;
 
procedure TDirectDrawSurface.SetPixel(X, Y: Integer; Value: Longint);
var
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
P: PByte;
begin
if (IDDSurface<>nil) and (X>=0) and (X<Width) and (Y>=0) and (Y<Height) then
if ({$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
if Lock(PRect(nil)^, ddsd) then
begin
try
2666,14 → 4531,15
 
procedure TDirectDrawSurface.SetSize(AWidth, AHeight: Integer);
var
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
if (AWidth<=0) or (AHeight<=0) then
begin
IDDSurface := nil;
{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
Exit;
end;
 
FillChar(ddsd, SizeOf(ddsd), 0);
with ddsd do
begin
dwSize := SizeOf(ddsd);
2710,6 → 4576,624
ColorKey[DDCKEY_SRCBLT] := ddck;
end;
 
{additional pixel routines like turbopixels}
 
procedure TDirectDrawSurface.PutPixel8(x, y, color: Integer); assembler;
{ on entry: self = eax, x = edx, y = ecx, color = ? }
asm
push esi // must maintain esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface// set to surface
add esi,edx // add x
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.dwwidth] // eax = pitch
mul ecx // eax = pitch * y
add esi,eax // esi = pixel offset
mov ecx, color
mov ds:[esi],cl // set pixel (lo byte of ecx)
pop esi // restore esi
//ret // return
end;
 
procedure TDirectDrawSurface.PutPixel16(x, y, color: Integer); assembler;
{ on entry: self = eax, x = edx, y = ecx, color = ? }
asm
push esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
shl edx,1
add esi,edx
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
mul ecx
add esi,eax
mov ecx, color
mov ds:[esi],cx
pop esi
//ret
end;
 
procedure TDirectDrawSurface.PutPixel24(x, y, color: Integer); assembler;
{ on entry: self = eax, x = edx, y = ecx, color = ? }
asm
push esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
imul edx,3
add esi,edx
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
mul ecx
add esi,eax
mov eax,ds:[esi]
and eax,$FF000000
mov ecx, color
or ecx,eax
mov ds:[esi+1],ecx
pop esi
//ret
end;
 
procedure TDirectDrawSurface.PutPixel32(x, y, color: Integer); assembler;
{ on entry: self = eax, x = edx, y = ecx, color = ? }
asm
push esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
shl edx,2
add esi,edx
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
mul ecx
add esi,eax
mov ecx, color
mov ds:[esi],ecx
pop esi
//ret
end;
 
procedure TDirectDrawSurface.Poke(X, Y: Integer; const Value: LongInt);
begin
if (X < 0) or (X > (Width - 1)) or
(Y < 0) or (Y > (Height - 1)) or not FIsLocked then Exit;
case Bitcount of
8: PutPixel8(x, y, value);
16: PutPixel16(x, y, value);
24: PutPixel24(x, y, value);
32: PutPixel32(x, y, value);
end;
end;
 
function TDirectDrawSurface.GetPixel8(x, y: Integer): Integer; assembler;
{ on entry: self = eax, x = edx, y = ecx, result = eax }
asm
push esi // myst maintain esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface // set to surface
add esi,edx // add x
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch] // eax = pitch
mul ecx // eax = pitch * y
add esi,eax // esi = pixel offset
mov eax,ds:[esi] // eax = color
and eax,$FF // map into 8bit
pop esi // restore esi
//ret // return
end;
 
function TDirectDrawSurface.GetPixel16(x, y: Integer): Integer; assembler;
{ on entry: self = eax, x = edx, y = ecx, result = eax }
asm
push esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
shl edx,1
add esi,edx
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
mul ecx
add esi,eax
mov eax,ds:[esi]
and eax,$FFFF // map into 16bit
pop esi
//ret
end;
 
function TDirectDrawSurface.GetPixel24(x, y: Integer): Integer; assembler;
{ on entry: self = eax, x = edx, y = ecx, result = eax }
asm
push esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
imul edx,3
add esi,edx
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
mul ecx
add esi,eax
mov eax,ds:[esi]
and eax,$FFFFFF // map into 24bit
pop esi
//ret
end;
 
function TDirectDrawSurface.GetPixel32(x, y: Integer): Integer; assembler;
{ on entry: self = eax, x = edx, y = ecx, result = eax }
asm
push esi
mov esi,TDirectDrawSurface[eax].FLockSurfaceDesc.lpSurface
shl edx,2
add esi,edx
mov eax,[TDirectDrawSurface[eax].FLockSurfaceDesc.lpitch]
mul ecx
add esi,eax
mov eax,ds:[esi]
pop esi
//ret
end;
 
function TDirectDrawSurface.Peek(X, Y: Integer): LongInt;
begin
Result := 0;
if (X < 0) or (X > (Width - 1)) or
(Y < 0) or (Y > (Height - 1)) or not FIsLocked then Exit;
case Bitcount of
8: Result := GetPixel8(x, y);
16: Result := GetPixel16(x, y);
24: Result := GetPixel24(x, y);
32: Result := GetPixel32(x, y);
end;
end;
 
procedure TDirectDrawSurface.PokeLine(X1, Y1, X2, Y2: Integer; Color: cardinal);
var
i, deltax, deltay, numpixels,
d, dinc1, dinc2,
x, xinc1, xinc2,
y, yinc1, yinc2: Integer;
begin
if not FIsLocked then {$IFDEF VER4UP}Lock{$ELSE}LockSurface{$ENDIF}; //force lock the surface
{ Calculate deltax and deltay for initialisation }
deltax := abs(x2 - x1);
deltay := abs(y2 - y1);
 
{ Initialise all vars based on which is the independent variable }
if deltax >= deltay then
begin
{ x is independent variable }
numpixels := deltax + 1;
d := (2 * deltay) - deltax;
 
dinc1 := deltay shl 1;
dinc2 := (deltay - deltax) shl 1;
xinc1 := 1;
xinc2 := 1;
yinc1 := 0;
yinc2 := 1;
end
else
begin
{ y is independent variable }
numpixels := deltay + 1;
d := (2 * deltax) - deltay;
dinc1 := deltax shl 1;
dinc2 := (deltax - deltay) shl 1;
xinc1 := 0;
xinc2 := 1;
yinc1 := 1;
yinc2 := 1;
end;
{ Make sure x and y move in the right directions }
if x1 > x2 then
begin
xinc1 := -xinc1;
xinc2 := -xinc2;
end;
if y1 > y2 then
begin
yinc1 := -yinc1;
yinc2 := -yinc2;
end;
x := x1;
y := y1;
{ Draw the pixels }
for i := 1 to numpixels do
begin
if (x > 0) and (x < (Width - 1)) and (y > 0) and (y < (Height - 1)) then
Pixel[x, y] := Color;
if d < 0 then
begin
Inc(d, dinc1);
Inc(x, xinc1);
Inc(y, yinc1);
end
else
begin
Inc(d, dinc2);
Inc(x, xinc2);
Inc(y, yinc2);
end;
end;
end;
 
procedure TDirectDrawSurface.PokeLinePolar(x, y: Integer; angle, length: extended; Color: cardinal);
var
xp, yp: Integer;
begin
xp := round(sin(angle * pi / 180) * length) + x;
yp := round(cos(angle * pi / 180) * length) + y;
PokeLine(x, y, xp, yp, Color);
end;
 
procedure TDirectDrawSurface.PokeBox(xs, ys, xd, yd: Integer; Color: cardinal);
begin
pokeline(xs, ys, xd, ys, color);
pokeline(xs, ys, xs, yd, color);
pokeline(xd, ys, xd, yd, color);
pokeline(xs, yd, xd, yd, color);
end;
 
procedure TDirectDrawSurface.PokeBlendPixel(const X, Y: Integer; aColor: cardinal; Alpha: byte);
var
cr, cg, cb: byte;
ar, ag, ab: byte;
begin
LoadRGB(aColor, ar, ag, ab);
LoadRGB(Pixel[x, y], cr, cg, cb);
Pixel[x, y] := SaveRGB((Alpha * (aR - cr) shr 8) + cr, // R alpha
(Alpha * (aG - cg) shr 8) + cg, // G alpha
(Alpha * (aB - cb) shr 8) + cb); // B alpha
end;
 
function Conv24to16(Color: Integer): Word; register;
asm
mov ecx,eax
shl eax,24
shr eax,27
shl eax,11
mov edx,ecx
shl edx,16
shr edx,26
shl edx,5
or eax,edx
mov edx,ecx
shl edx,8
shr edx,27
or eax,edx
end;
 
procedure TDirectDrawSurface.PokeWuLine(X1, Y1, X2, Y2, aColor: Integer);
var DeltaX, DeltaY, Loop, Start, Finish: Integer;
Dx, Dy, DyDx: Single; // fractional parts
Color16: DWord;
begin
DeltaX := Abs(X2 - X1); // Calculate DeltaX and DeltaY for initialization
DeltaY := Abs(Y2 - Y1);
if (DeltaX = 0) or (DeltaY = 0) then
begin // straight lines
PokeLine(X1, Y1, X2, Y2, aColor);
Exit;
end;
if BitCount = 16 then
Color16 := Conv24to16(aColor)
else
Color16 := aColor;
if DeltaX > DeltaY then // horizontal or vertical
begin
{ determine rise and run }
if Y2 > Y1 then DyDx := -(DeltaY / DeltaX)
else DyDx := DeltaY / DeltaX;
if X2 < X1 then
begin
Start := X2; // right to left
Finish := X1;
Dy := Y2;
end else
begin
Start := X1; // left to right
Finish := X2;
Dy := Y1;
DyDx := -DyDx; // inverse slope
end;
for Loop := Start to Finish do
begin
PokeBlendPixel(Loop, Trunc(Dy), Color16, Trunc((1 - Frac(Dy)) * 255));
PokeBlendPixel(Loop, Trunc(Dy) + 1, Color16, Trunc(Frac(Dy) * 255));
Dy := Dy + DyDx; // next point
end;
end else
begin
{ determine rise and run }
if X2 > X1 then DyDx := -(DeltaX / DeltaY)
else DyDx := DeltaX / DeltaY;
if Y2 < Y1 then
begin
Start := Y2; // right to left
Finish := Y1;
Dx := X2;
end else
begin
Start := Y1; // left to right
Finish := Y2;
Dx := X1;
DyDx := -DyDx; // inverse slope
end;
for Loop := Start to Finish do
begin
PokeBlendPixel(Trunc(Dx), Loop, Color16, Trunc((1 - Frac(Dx)) * 255));
PokeBlendPixel(Trunc(Dx), Loop, Color16, Trunc(Frac(Dx) * 255));
Dx := Dx + DyDx; // next point
end;
end;
end;
 
procedure TDirectDrawSurface.Noise(Oblast: TRect; Density: Byte);
var
dx, dy: Integer;
Dens: byte;
begin
{noise}
case Density of
0..2: Dens := 3;
255: Dens := 254;
else
Dens := Density;
end;
if Dens >= Oblast.Right then
Dens := Oblast.Right div 3;
dy := Oblast.Top;
while dy <= Oblast.Bottom do begin
dx := Oblast.Left;
while dx <= Oblast.Right do begin
inc(dx, random(dens));
if dx <= Oblast.Right then
Pixel[dx, dy] := not Pixel[dx, dy];
end;
inc(dy);
end;
end;
 
function Conv16to24(Color: Word): Integer; register;
asm
xor edx,edx
mov dx,ax
 
mov eax,edx
shl eax,27
shr eax,8
 
mov ecx,edx
shr ecx,5
shl ecx,26
shr ecx,16
or eax,ecx
 
mov ecx,edx
shr ecx,11
shl ecx,27
shr ecx,24
or eax,ecx
end;
 
procedure GetRGB(Color: cardinal; var R, G, B: Byte); {$IFDEF VER9UP}inline; {$ENDIF}
begin
R := Color;
G := Color shr 8;
B := Color shr 16;
end;
 
procedure TDirectDrawSurface.LoadRGB(Color: cardinal; var R, G, B: Byte);
var grB: Byte;
begin
grB := 1;
if FLockSurfaceDesc.ddpfPixelFormat.dwGBitMask = 2016 then grB := 0; // 565
case BitCount of
15, 16: begin
R := (color shr (11 - grB)) shl 3;
if grB = 0 then
G := ((color and 2016) shr 5) shl 2
else
G := ((color and 992) shr 5) shl 3;
B := (color and 31) shl 3;
end;
else
GetRGB(Color, R, G, B);
end;
end;
 
function TDirectDrawSurface.SaveRGB(const R, G, B: Byte): cardinal;
begin
case BitCount of
15, 16: begin
Result := Conv24to16(RGB(R, G, B));
end;
else
Result := RGB(R, G, B);
end;
end;
 
procedure TDirectDrawSurface.Blur;
var
x, y, tr, tg, tb: Integer;
r, g, b: byte;
begin
for y := 1 to GetHeight - 1 do
for x := 1 to GetWidth - 1 do begin
LoadRGB(peek(x, y), r, g, b);
tr := r;
tg := g;
tb := b;
LoadRGB(peek(x, y + 1), r, g, b);
Inc(tr, r);
Inc(tg, g);
Inc(tb, b);
LoadRGB(peek(x, y - 1), r, g, b);
Inc(tr, r);
Inc(tg, g);
Inc(tb, b);
LoadRGB(peek(x - 1, y), r, g, b);
Inc(tr, r);
Inc(tg, g);
Inc(tb, b);
LoadRGB(peek(x + 1, y), r, g, b);
Inc(tr, r);
Inc(tg, g);
Inc(tb, b);
tr := tr shr 2;
tg := tg shr 2;
tb := tb shr 2;
Poke(x, y, savergb(tr, tg, tb));
end;
end;
 
procedure TDirectDrawSurface.PokeCircle(X, Y, Radius, Color: Integer);
var
a, af, b, bf, c,
target, r2: Integer;
begin
Target := 0;
A := Radius;
B := 0;
R2 := Sqr(Radius);
 
while a >= B do
begin
b := Round(Sqrt(R2 - Sqr(A)));
c := target; target := b; b := c;
while B < Target do
begin
Af := (120 * a) div 100;
Bf := (120 * b) div 100;
pixel[x + af, y + b] := color;
pixel[x + bf, y + a] := color;
pixel[x - af, y + b] := color;
pixel[x - bf, y + a] := color;
pixel[x - af, y - b] := color;
pixel[x - bf, y - a] := color;
pixel[x + af, y - b] := color;
pixel[x + bf, y - a] := color;
B := B + 1;
end;
A := A - 1;
end;
end;
 
function RGBToBGR(Color: cardinal): cardinal;
begin
result := (LoByte(LoWord(Color)) shr 3 shl 11) or // Red
(HiByte((Color)) shr 2 shl 5) or // Green
(LoByte(HiWord(Color)) shr 3); // Blue
end;
 
procedure TDirectDrawSurface.PokeVLine(x, y1, y2: Integer; Color: cardinal);
var
y: Integer;
NColor: cardinal;
r, g, b: byte;
begin
if y1 < 0 then y1 := 0;
if y2 >= Height then y2 := Height - 1;
GetRGB(Color, r, g, b);
NColor := RGBToBGR(rgb(r, g, b));
for y := y1 to y2 do
begin
pixel[x, y] := NColor;
end;
end;
 
procedure TDirectDrawSurface.PokeFilledEllipse(exc, eyc, ea, eb, color: Integer);
var x, y: Integer; aa, aa2, bb, bb2, d, dx, dy: LongInt;
begin
x := 0;
y := eb;
aa := LongInt(ea) * ea;
aa2 := 2 * aa;
bb := LongInt(eb) * eb;
bb2 := 2 * bb;
d := bb - aa * eb + aa div 4;
dx := 0;
dy := aa2 * eb;
PokevLine(exc, eyc - y, eyc + y, color);
while (dx < dy) do begin
if (d > 0) then begin
dec(y); dec(dy, aa2); dec(d, dy);
end;
inc(x); inc(dx, bb2); inc(d, bb + dx);
PokevLine(exc - x, eyc - y, eyc + y, color);
PokevLine(exc + x, eyc - y, eyc + y, color);
end;
inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);
while (y >= 0) do begin
if (d < 0) then begin
inc(x); inc(dx, bb2); inc(d, bb + dx);
PokevLine(exc - x, eyc - y, eyc + y, color);
PokevLine(exc + x, eyc - y, eyc + y, color);
end;
dec(y); dec(dy, aa2); inc(d, aa - dy);
end;
end;
 
procedure TDirectDrawSurface.DoRotate(cent1, cent2, angle: Integer; coord1, coord2: Real; Color: word);
var coord1t, coord2t: Real;
c1, c2: Integer;
begin
coord1t := coord1 - cent1;
coord2t := coord2 - cent2;
coord1 := coord1t * cos(angle * pi / 180) - coord2t * sin(angle * pi / 180);
coord2 := coord1t * sin(angle * pi / 180) + coord2t * cos(angle * pi / 180);
coord1 := coord1 + cent1;
coord2 := coord2 + cent2;
c1 := round(coord1);
c2 := round(coord2);
pixel[c1, c2] := Color;
end;
 
procedure TDirectDrawSurface.PokeEllipse(exc, eyc, ea, eb, angle, Color: Integer);
var
elx, ely: Integer;
aa, aa2, bb, bb2, d, dx, dy: LongInt;
x, y: real;
begin
elx := 0;
ely := eb;
aa := LongInt(ea) * ea;
aa2 := 2 * aa;
bb := LongInt(eb) * eb;
bb2 := 2 * bb;
d := bb - aa * eb + aa div 4;
dx := 0;
dy := aa2 * eb;
x := exc;
y := eyc - ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc;
y := eyc + ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc - ea;
y := eyc;
dorotate(exc, eyc, angle, x, y, Color);
x := exc + ea;
y := eyc;
dorotate(exc, eyc, angle, x, y, Color);
while (dx < dy) do begin
if (d > 0) then begin Dec(ely); Dec(dy, aa2); Dec(d, dy); end;
Inc(elx); Inc(dx, bb2); Inc(d, bb + dx);
x := exc + elx; y := eyc + ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc - elx; y := eyc + ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc + elx; y := eyc - ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc - elx; y := eyc - ely;
dorotate(exc, eyc, angle, x, y, Color);
end;
Inc(d, (3 * (aa - bb) div 2 - (dx + dy)) div 2);
while (ely > 0) do begin
if (d < 0) then begin Inc(elx); Inc(dx, bb2); Inc(d, bb + dx); end;
Dec(ely); Dec(dy, aa2); Inc(d, aa - dy);
x := exc + elx; y := eyc + ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc - elx; y := eyc + ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc + elx; y := eyc - ely;
dorotate(exc, eyc, angle, x, y, Color);
x := exc - elx; y := eyc - ely;
dorotate(exc, eyc, angle, x, y, Color);
end;
end;
 
procedure TDirectDrawSurface.MirrorFlip(Value: TRenderMirrorFlipSet);
begin
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Self) then
D2D.MirrorFlip := Value;
end;
 
{ TDXDrawDisplayMode }
 
function TDXDrawDisplayMode.GetBitCount: Integer;
2736,10 → 5220,10
FModes := TCollection.Create(TDXDrawDisplayMode);
FWidth := 640;
FHeight := 480;
FBitCount := 8;
FFixedBitCount := True;
FBitCount := 16;
FFixedBitCount := False; //True;
FFixedRatio := True;
FFixedSize := False;
FFixedSize := True; //False;
end;
 
destructor TDXDrawDisplay.Destroy;
2776,7 → 5260,7
function TDXDrawDisplay.GetMode: TDXDrawDisplayMode;
var
i: Integer;
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
Result := nil;
if FDXDraw.DDraw<>nil then
2840,13 → 5324,16
 
if FDXDraw.DDraw<>nil then
begin
FDXDraw.DDraw.DXResult := FDXDraw.DDraw.IDraw.EnumDisplayModes(0, PDDSurfaceDesc(nil)^,
FDXDraw.DDraw.DXResult := FDXDraw.DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}
.EnumDisplayModes(0, {$IFDEF D3D_deprecated}PDDSurfaceDesc{$ELSE}PDDSurfaceDesc2{$ENDIF}(nil),
FModes, @EnumDisplayModesProc);
end else
begin
DDraw := TDirectDraw.Create(PGUID(FDXDraw.FDriver));
try
DDraw.IDraw.EnumDisplayModes(0, PDDSurfaceDesc(nil)^, FModes, @EnumDisplayModesProc);
DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}
.EnumDisplayModes(0, {$IFDEF D3D_deprecated}PDDSurfaceDesc{$ELSE}PDDSurfaceDesc2{$ENDIF}(nil),
FModes, @EnumDisplayModesProc);
finally
DDraw.Free;
end;
2865,12 → 5352,13
end;
end;
 
function TDXDrawDisplay.SetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
function TDXDrawDisplay.SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF}: Integer): Boolean;
begin
Result := False;
if FDXDraw.DDraw<>nil then
begin
FDXDraw.DDraw.DXResult := FDXDraw.DDraw.IDraw.SetDisplayMode(AWidth, AHeight, ABitCount);
FDXDraw.DDraw.DXResult := FDXDraw.DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}
.SetDisplayMode(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF});
Result := FDXDraw.DDraw.DXResult=DD_OK;
 
if Result then
2884,6 → 5372,13
 
function TDXDrawDisplay.DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
 
{$IFNDEF D3D_deprecated}
function GetDefaultRefreshRate: Integer;
begin
Result := 60;
end;
{$ENDIF}
 
function TestBitCount(BitCount, ABitCount: Integer): Boolean;
begin
if (BitCount>8) and (ABitCount>8) then
2897,7 → 5392,7
 
function SetSize2(Ratio: Boolean): Boolean;
var
DWidth, DHeight, DBitCount, i: Integer;
DWidth, DHeight, DBitCount{$IFNDEF D3D_deprecated}, DRRate, DFlags{$ENDIF}, i: Integer;
Flag: Boolean;
begin
Result := False;
2905,7 → 5400,10
DWidth := Maxint;
DHeight := Maxint;
DBitCount := ABitCount;
 
{$IFNDEF D3D_deprecated}
DRRate := GetDefaultRefreshRate;
DFlags := 0;
{$ENDIF}
Flag := False;
for i:=0 to Count-1 do
with Modes[i] do
2933,7 → 5431,7
DBitCount := ABitCount;
end;
 
Result := SetSize(DWidth, DHeight, DBitCount);
Result := SetSize(DWidth, DHeight, DBitCount{$IFNDEF D3D_deprecated}, DRRate, DFlags{$ENDIF});
end;
end;
 
2943,7 → 5441,7
if (AWidth<=0) or (AHeight<=0) or (not (ABitCount in [8, 16, 24, 32])) then Exit;
 
{ The change is attempted by the size of default. }
if SetSize(AWidth, AHeight, ABitCount) then
if SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, GetDefaultRefreshRate, 0{$ENDIF}) then
begin
Result := True;
Exit;
3003,8 → 5501,8
begin
if ZBuffer<>nil then
begin
if (Surface.IDDSurface<>nil) and (ZBuffer.IDDSurface<>nil) then
Surface.ISurface.DeleteAttachedSurface(0, ZBuffer.IDDSurface);
if (Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and (ZBuffer.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) then
Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.DeleteAttachedSurface(0, ZBuffer.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF});
ZBuffer.Free; ZBuffer := nil;
end;
end;
3011,12 → 5509,12
 
type
TInitializeDirect3DOption = (idoSelectDriver, idoOptimizeDisplayMode,
idoHardware, idoRetainedMode, idoZBuffer);
idoHardware, {$IFDEF D3DRM}idoRetainedMode,{$ENDIF} idoZBuffer);
 
TInitializeDirect3DOptions = set of TInitializeDirect3DOption;
 
procedure Direct3DInitializing(Options: TInitializeDirect3DOptions;
var BitCount: Integer; var Driver: PGUID; var DriverGUID: TGUID);
var BitCount: Integer; var Driver: PGUID; var DriverGUID: TGUID{$IFNDEF D3D_deprecated}; var D3DDeviceTypeSet: TD3DDeviceTypeSet{$ENDIF});
type
PDirect3DInitializingRecord = ^TDirect3DInitializingRecord;
TDirect3DInitializingRecord = record
3028,19 → 5526,29
Flag: Boolean;
DriverCaps: TDDCaps;
HELCaps: TDDCaps;
{$IFDEF D3D_deprecated}
HWDeviceDesc: TD3DDeviceDesc;
HELDeviceDesc: TD3DDeviceDesc;
DeviceDesc: TD3DDeviceDesc;
 
{$ELSE}
DeviceDesc: TD3DDeviceDesc7;
{$ENDIF}
D3DFlag: Boolean;
{$IFDEF D3D_deprecated}
HWDeviceDesc2: TD3DDeviceDesc;
HELDeviceDesc2: TD3DDeviceDesc;
DeviceDesc2: TD3DDeviceDesc;
{$ELSE}
DeviceDesc2: TD3DDeviceDesc7;
{$ENDIF}
end;
 
function EnumDeviceCallBack(const lpGuid: TGUID; lpDeviceDescription, lpDeviceName: PChar;
const lpD3DHWDeviceDesc, lpD3DHELDeviceDesc: TD3DDeviceDesc;
rec: PDirect3DInitializingRecord): HRESULT; stdcall;
{$IFDEF D3D_deprecated}
function EnumDeviceCallBack(lpGuid: PGUID; // nil for the default device
lpDeviceDescription: PAnsiChar; lpDeviceName: PAnsiChar;
var lpD3DHWDeviceDesc: TD3DDeviceDesc;
var lpD3DHELDeviceDesc: TD3DDeviceDesc;
rec: PDirect3DInitializingRecord) : HResult; stdcall;
 
procedure UseThisDevice;
begin
3058,7 → 5566,8
if idoOptimizeDisplayMode in rec.Options then
begin
if (lpD3DHWDeviceDesc.dwDeviceRenderBitDepth and (DDBD_16 or DDBD_24 or DDBD_32))=0 then Exit;
end else
end
else
begin
if (lpD3DHWDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount))=0 then Exit;
end;
3065,12 → 5574,38
 
UseThisDevice;
end;
{$ELSE}
function EnumDeviceCallBack(lpDeviceDescription: PAnsiChar; lpDeviceName: PAnsiChar;
const lpD3DDeviceDesc: TD3DDeviceDesc7; rec: PDirect3DInitializingRecord) : HResult; stdcall;
begin
Result := D3DENUMRET_OK;
 
function EnumDirectDrawDriverCallback(lpGUID: PGUID; lpDriverDescription: LPSTR;
lpDriverName: LPSTR; rec: PDirect3DInitializingRecord): HRESULT; stdcall;
maxVideoBlockSize := Min(lpD3DDeviceDesc.dwMaxTextureWidth, lpD3DDeviceDesc.dwMaxTextureHeight);
SurfaceDivWidth := lpD3DDeviceDesc.dwMaxTextureWidth;
SurfaceDivHeight := lpD3DDeviceDesc.dwMaxTextureHeight;
 
//if lpD3DHWDeviceDesc.dcmColorModel = 0 then Exit;
if idoOptimizeDisplayMode in rec.Options then
begin
if (lpD3DDeviceDesc.dwDeviceRenderBitDepth and (DDBD_16 or DDBD_24 or DDBD_32)) = 0 then Exit;
end
else
begin
if (lpD3DDeviceDesc.dwDeviceRenderBitDepth and BPPToDDBD(rec.BitCount)) = 0 then Exit;
end;
 
rec.D3DFlag := True;
rec.DeviceDesc2 := lpD3DDeviceDesc;
end;
{$ENDIF}
 
function EnumDirectDrawDriverCallback(lpGUID: PGUID; lpDriverDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
lpDriverName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; rec: PDirect3DInitializingRecord): HRESULT; stdcall;
var
DDraw: TDirectDraw;
{$IFDEF D3D_deprecated}
Direct3D: IDirect3D;
{$ENDIF}
Direct3D7: IDirect3D7;
 
function CountBitMask(i: DWORD; const Bits: array of DWORD): DWORD;
3123,7 → 5658,19
begin
{ The Direct3D driver is examined. }
rec.D3DFlag := False;
Direct3D.EnumDevices(@EnumDeviceCallBack, rec);
try
{$IFDEF D3D_deprecated}Direct3D{$ELSE}Direct3D7{$ENDIF}.EnumDevices(@EnumDeviceCallBack, rec) {= DD_OK}
except
on E: Exception do
begin
rec.D3DFlag := False;
// eventually catch exception to automatic log
Log(E.Message {$IFNDEF VER4UP}, ChangefileExt(ParamStr(0), '.log'){$ENDIF});
//and cannot continue !!!
Result := False;
Exit;
end;
end;
Result := rec.D3DFlag;
 
if not Result then Exit;
3131,17 → 5678,20
{ Comparison of DirectDraw driver. }
if not rec.Flag then
begin
{$IFDEF D3D_deprecated}
rec.HWDeviceDesc := rec.HWDeviceDesc2;
rec.HELDeviceDesc := rec.HELDeviceDesc2;
rec.DeviceDesc := rec.DeviceDesc2;
{$ENDIF}
rec.Flag := True;
end else
end
else
begin
{ Comparison of hardware. (One with large number of functions to support is chosen. }
Result := False;
 
if DDraw.DriverCaps.dwVidMemTotal<rec.DriverCaps.dwVidMemTotal then Exit;
 
{$IFDEF D3D_deprecated}
if CompareCountBitMask(DDraw.DriverCaps.ddscaps.dwCaps, rec.DriverCaps.ddscaps.dwCaps, [DDSCAPS_TEXTURE, DDSCAPS_ZBUFFER, DDSCAPS_MIPMAP])+
CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwMiscCaps, rec.HWDeviceDesc2.dpcLineCaps.dwMiscCaps)+
CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwRasterCaps, rec.HWDeviceDesc2.dpcLineCaps.dwRasterCaps)+
3153,7 → 5703,7
CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureFilterCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureFilterCaps)+
CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureBlendCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureBlendCaps)+
CompareCountBit(rec.HWDeviceDesc.dpcLineCaps.dwTextureAddressCaps, rec.HWDeviceDesc2.dpcLineCaps.dwTextureAddressCaps)<0 then Exit;
 
{$ENDIF}
Result := True;
end;
end;
3166,10 → 5716,17
if (DDraw.DriverCaps.dwCaps and DDCAPS_3D<>0) and
(DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE<>0) then
begin
try
if DDraw.IDDraw7<>nil then
Direct3D7 := DDraw.IDraw7 as IDirect3D7
{$IFDEF D3D_deprecated}
else
Direct3D := DDraw.IDraw as IDirect3D;
Direct3D := DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF} as IDirect3D
{$ENDIF};
except
on E: Exception do
log(E.Message {$IFNDEF VER4UP}, ChangefileExt(ParamStr(0), '.log'){$ENDIF});
end;
try
if FindDevice then
begin
3178,13 → 5735,16
 
if lpGUID=nil then
rec.Driver := nil
else begin
else
begin
rec.DriverGUID^ := lpGUID^;
rec.Driver^ := @rec.DriverGUID;
end;
end;
finally
{$IFDEF D3D_deprecated}
Direct3D := nil;
{$ENDIF}
Direct3D7 := nil;
end;
end;
3196,6 → 5756,9
var
rec: TDirect3DInitializingRecord;
DDraw: TDirectDraw;
{$IFNDEF D3D_deprecated}
devGUID: Tguid;
{$ENDIF}
begin
FillChar(rec, SizeOf(rec), 0);
rec.BitCount := BitCount;
3208,8 → 5771,9
rec.Options := Options;
rec.Driver := @Driver;
rec.DriverGUID := @DriverGUID;
DXDirectDrawEnumerate(@EnumDirectDrawDriverCallback, @rec)
end else
DXDirectDrawEnumerate(@EnumDirectDrawDriverCallback, @rec);
end
else
begin
DDraw := TDirectDraw.Create(Driver);
try
3217,10 → 5781,13
rec.HELCaps := DDraw.HELCaps;
 
rec.D3DFlag := False;
(DDraw.IDraw as IDirect3D).EnumDevices(@EnumDeviceCallBack, @rec);
 
(DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF} as IDirect3D).EnumDevices(@EnumDeviceCallBack, @rec);
if rec.D3DFlag then
{$IFDEF D3D_deprecated}
rec.DeviceDesc := rec.DeviceDesc2;
{$ELSE}
rec.DeviceDesc := rec.DeviceDesc2;
{$ENDIF}
finally
DDraw.Free;
end;
3234,7 → 5801,8
begin
if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_16<>0 then
rec.BitCount := 16
else if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_24<>0 then
else
if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_24 <> 0 then
rec.BitCount := 24
else if rec.DeviceDesc.dwDeviceRenderBitDepth and DDBD_32<>0 then
rec.BitCount := 32;
3241,6 → 5809,30
end;
end;
 
{test type of device}
{$IFNDEF D3D_deprecated}
D3DDeviceTypeSet := [];
 
Move(rec.DeviceDesc2.deviceGUID, devGUID, Sizeof(TGUID) );
 
if CompareMem(@devGUID, @IID_IDirect3DTnLHalDevice, Sizeof(TGUID)) then
D3DDeviceTypeSet := D3DDeviceTypeSet + [dtTnLHAL];
 
if CompareMem(@devGUID, @IID_IDirect3DHALDEVICE, Sizeof(TGUID)) then
D3DDeviceTypeSet := D3DDeviceTypeSet + [dtHAL];
 
if CompareMem(@devGUID, @IID_IDirect3DMMXDevice, Sizeof(TGUID)) then
D3DDeviceTypeSet := D3DDeviceTypeSet + [dtMMX];
 
if CompareMem(@devGUID, @IID_IDirect3DRGBDevice, Sizeof(TGUID)) then
D3DDeviceTypeSet := D3DDeviceTypeSet + [dtRGB];
 
if CompareMem(@devGUID, @IID_IDirect3DRampDevice, Sizeof(TGUID)) then
D3DDeviceTypeSet := D3DDeviceTypeSet + [dtRamp];
 
if CompareMem(@devGUID, @IID_IDirect3DRefDevice, Sizeof(TGUID)) then
D3DDeviceTypeSet := D3DDeviceTypeSet + [dtRef];
{$ENDIF}
BitCount := rec.BitCount;
end;
 
3250,14 → 5842,21
BitCount: Integer;
Driver: PGUID;
DriverGUID: TGUID;
{$IFNDEF D3D_deprecated}
D3DDeviceTypeSet: TD3DDeviceTypeSet;
{$ENDIF}
begin
BitCount := DXDraw.Display.BitCount;
Driver := DXDraw.Driver;
Direct3DInitializing(Options, BitCount, Driver, DriverGUID);
Direct3DInitializing(Options, BitCount, Driver, DriverGUID{$IFNDEF D3D_deprecated}, D3DDeviceTypeSet{$ENDIF});
DXDraw.Driver := Driver;
DXDraw.Display.BitCount := BitCount;
{$IFNDEF D3D_deprecated}
DXDraw.FDeviceTypeSet := D3DDeviceTypeSet;
{$ENDIF}
end;
 
{$IFDEF D3D_deprecated}
procedure InitializeDirect3D(Surface: TDirectDrawSurface;
var ZBuffer: TDirectDrawSurface;
out D3D: IDirect3D;
3266,6 → 5865,7
out D3DDevice: IDirect3DDevice;
out D3DDevice2: IDirect3DDevice2;
out D3DDevice3: IDirect3DDevice3;
{$IFDEF D3DRM}
var D3DRM: IDirect3DRM;
var D3DRM2: IDirect3DRM2;
var D3DRM3: IDirect3DRM3;
3275,6 → 5875,7
out Viewport: IDirect3DRMViewport;
var Scene: IDirect3DRMFrame;
var Camera: IDirect3DRMFrame;
{$ENDIF}
var NowOptions: TInitializeDirect3DOptions);
type
TInitializeDirect3DRecord = record
3302,9 → 5903,11
 
if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_16<>0 then
ZBufferBitDepth := 16
else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_24<>0 then
else
if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_24 <> 0 then
ZBufferBitDepth := 24
else if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_32<>0 then
else
if DeviceDesc.dwDeviceZBufferBitDepth and DDBD_32 <> 0 then
ZBufferBitDepth := 32
else
ZBufferBitDepth := 0;
3339,7 → 5942,6
end;
end;
 
 
function EnumDeviceCallBack(const lpGuid: TGUID; lpDeviceDescription, lpDeviceName: PChar;
const lpD3DHWDeviceDesc, lpD3DHELDeviceDesc: TD3DDeviceDesc;
lpUserArg: Pointer): HRESULT; stdcall;
3422,9 → 6024,10
NowOptions := NowOptions + [idoZBuffer];
end;
end;
 
{$IFDEF D3DRM}
type
TDirect3DRMCreate= function(out lplpDirect3DRM: IDirect3DRM): HRESULT; stdcall;
{$ENDIF}
begin
try
Options := NowOptions;
3463,12 → 6066,11
SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_ZENABLE), Ord(ZBuffer<>nil));
SetRenderState(TD3DRenderStateType(D3DRENDERSTATE_ZWRITEENABLE), Ord(ZBuffer<>nil));
end;
 
{$IFDEF D3DRM}
{ Direct3D Retained Mode}
if idoRetainedMode in Options then
begin
NowOptions := NowOptions + [idoRetainedMode];
 
if D3DRM=nil then
begin
if TDirect3DRMCreate(DXLoadLibrary('D3DRM.dll', 'Direct3DRMCreate'))(D3DRM)<>D3DRM_OK then
3513,6 → 6115,7
Surface.Width, Surface.Height, Viewport);
Viewport.SetBack(5000.0);
end;
{$ENDIF}
except
FreeZBufferSurface(Surface, ZBuffer);
D3D := nil;
3521,6 → 6124,7
D3DDevice := nil;
D3DDevice2 := nil;
D3DDevice3 := nil;
{$IFDEF D3DRM}
D3DRM := nil;
D3DRM2 := nil;
D3DRMDevice := nil;
3528,9 → 6132,11
Viewport := nil;
Scene := nil;
Camera := nil;
{$ENDIF}
raise;
end;
end;
{$ENDIF}
 
procedure InitializeDirect3D7(Surface: TDirectDrawSurface;
var ZBuffer: TDirectDrawSurface;
3553,7 → 6159,7
MemPosition: array[Boolean] of Integer = (DDSCAPS_SYSTEMMEMORY, DDSCAPS_VIDEOMEMORY);
var
ZBufferBitDepth: Integer;
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
Result := False;
FreeZBufferSurface(Surface, ZBuffer);
3572,18 → 6178,27
with ddsd do
begin
dwSize := SizeOf(ddsd);
Surface.ISurface.GetSurfaceDesc(ddsd);
Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetSurfaceDesc(ddsd);
dwFlags := DDSD_CAPS or DDSD_WIDTH or DDSD_HEIGHT or DDSD_ZBUFFERBITDEPTH;
ddsCaps.dwCaps := DDSCAPS_ZBUFFER or MemPosition[Hardware];
dwHeight := Surface.Height;
dwWidth := Surface.Width;
{$IFDEF D3D_deprecated}
dwZBufferBitDepth := ZBufferBitDepth;
{$ELSE}
ddpfPixelFormat.dwFlags := DDPF_ZBUFFER;
ddpfPixelFormat.dwZBufferBitDepth := ZBufferBitDepth;
ddpfPixelFormat.dwStencilBitDepth := 0;
ddpfPixelFormat.dwZBitMask := (1 shl ZBufferBitDepth) - 1;
ddpfPixelFormat.dwStencilBitMask := 0;
ddpfPixelFormat.dwLuminanceAlphaBitMask := 0;
{$ENDIF}
end;
 
ZBuffer := TDirectDrawSurface.Create(Surface.DDraw);
if ZBuffer.CreateSurface(ddsd) then
begin
if Surface.ISurface.AddAttachedSurface(ZBuffer.ISurface)<>DD_OK then
if Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.AddAttachedSurface(ZBuffer.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}) <> DD_OK then
begin
ZBuffer.Free; ZBuffer := nil;
Exit;
3671,8 → 6286,9
end;
 
begin
 
try
Options := NowOptions - [idoRetainedMode];
Options := NowOptions {$IFDEF D3DRM}- [idoRetainedMode]{$ENDIF};
NowOptions := [];
 
D3D7 := Surface.DDraw.IDraw7 as IDirect3D7;
3679,11 → 6295,9
 
{ Whether hardware can be used is tested. }
SupportHardware := (Surface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_VIDEOMEMORY<>0) and
(idoHardware in Options) and (Surface.DDraw.DriverCaps.dwCaps and DDCAPS_3D<>0);
(idoHardware in Options) and (Surface.DDraw.DriverCaps.dwCaps and DDCAPS_3D <> 0) and
(Surface.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE <> 0);
 
if Surface.DDraw.DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE=0 then
SupportHardware := False;
 
{ Direct3D }
InitDevice;
 
3703,8 → 6317,8
raise;
end;
end;
type
 
type
{ TDXDrawDriver }
 
TDXDrawDriver = class
3734,6 → 6348,17
procedure Initialize; override;
end;
 
procedure TCustomDXDraw.MirrorFlip(Value: TRenderMirrorFlipSet);
begin
if CheckD3 then
FD2D.MirrorFlip := Value;
end;
 
procedure TCustomDXDraw.SaveTextures(path: string);
begin
if CheckD3 then
FD2D.SaveTextures(path)
end;
{ TDXDrawDriver }
 
constructor TDXDrawDriver.Create(ADXDraw: TCustomDXDraw);
3744,8 → 6369,8
FDXDraw := ADXDraw;
 
{ Driver selection and Display mode optimizationn }
if FDXDraw.FOptions*[doFullScreen, doSystemMemory, do3D, doHardware]=
[doFullScreen, do3D, doHardware] then
if FDXDraw.FOptions * [doFullScreen, doSystemMemory, {$IFDEF D3D_deprecated}do3D,{$ENDIF} doHardware] =
[doFullScreen, {$IFDEF D3D_deprecated}do3D,{$ENDIF} doHardware] then
begin
AOptions := [];
with FDXDraw do
3754,7 → 6379,7
if not FDXDraw.Display.FixedBitCount then AOptions := AOptions + [idoOptimizeDisplayMode];
 
if doHardware in Options then AOptions := AOptions + [idoHardware];
if doRetainedMode in Options then AOptions := AOptions + [idoRetainedMode];
{$IFDEF D3DRM}if doRetainedMode in Options then AOptions := AOptions + [idoRetainedMode];{$ENDIF}
if doZBuffer in Options then AOptions := AOptions + [idoZBuffer];
end;
 
3762,14 → 6387,14
end;
 
if FDXDraw.Options*[doFullScreen, doHardware, doSystemMemory]=[doFullScreen, doHardware] then
FDXDraw.FDDraw := TDirectDraw.CreateEx(PGUID(FDXDraw.FDriver), doDirectX7Mode in FDXDraw.Options)
FDXDraw.FDDraw := TDirectDraw.CreateEx(PGUID(FDXDraw.FDriver), {$IFDEF D3D_deprecated}doDirectX7Mode in FDXDraw.Options{$ELSE}True{$ENDIF})
else
FDXDraw.FDDraw := TDirectDraw.CreateEx(nil, doDirectX7Mode in FDXDraw.Options);
FDXDraw.FDDraw := TDirectDraw.CreateEx(nil, {$IFDEF D3D_deprecated}doDirectX7Mode in FDXDraw.Options{$ELSE}True{$ENDIF});
end;
 
procedure TDXDrawDriver.Initialize3D;
const
DXDrawOptions3D = [doHardware, doRetainedMode, doSelectDriver, doZBuffer];
DXDrawOptions3D = [doHardware, {$IFDEF D3DRM}doRetainedMode,{$ENDIF} doSelectDriver, doZBuffer];
var
AOptions: TInitializeDirect3DOptions;
begin
3777,10 → 6402,10
with FDXDraw do
begin
if doHardware in FOptions then AOptions := AOptions + [idoHardware];
if doRetainedMode in FNowOptions then AOptions := AOptions + [idoRetainedMode];
{$IFDEF D3DRM}if doRetainedMode in FNowOptions then AOptions := AOptions + [idoRetainedMode];{$ENDIF}
if doSelectDriver in FOptions then AOptions := AOptions + [idoSelectDriver];
if doZBuffer in FOptions then AOptions := AOptions + [idoZBuffer];
 
{$IFDEF D3D_deprecated}
if doDirectX7Mode in FOptions then
begin
InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
3787,12 → 6412,17
end else
begin
InitializeDirect3D(FSurface, FZBuffer, FD3D, FD3D2, FD3D3, FD3DDevice, FD3DDevice2, FD3DDevice3,
FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera, AOptions);
{$IFDEF D3DRM}
FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera,
{$ENDIF}
AOptions);
end;
 
{$ELSE}
InitializeDirect3D7(FSurface, FZBuffer, FD3D7, FD3DDevice7, AOptions);
{$ENDIF}
FNowOptions := FNowOptions - DXDrawOptions3D;
if idoHardware in AOptions then FNowOptions := FNowOptions + [doHardware];
if idoRetainedMode in AOptions then FNowOptions := FNowOptions + [doRetainedMode];
{$IFDEF D3DRM}if idoRetainedMode in AOptions then FNowOptions := FNowOptions + [doRetainedMode];{$ENDIF}
if idoSelectDriver in AOptions then FNowOptions := FNowOptions + [doSelectDriver];
if idoZBuffer in AOptions then FNowOptions := FNowOptions + [doZBuffer];
end;
3809,6 → 6439,7
begin
with FDXDraw do
begin
{$IFDEF D3DRM}
FViewport := nil;
FCamera := nil;
FScene := nil;
3816,13 → 6447,21
FD3DRMDevice := nil;
FD3DRMDevice2 := nil;
FD3DRMDevice3 := nil;
FD3DRM3 := nil;
FD3DRM2 := nil;
FD3DRM := nil;
{$ENDIF}
{$IFDEF D3D_deprecated}
FD3DDevice := nil;
FD3DDevice2 := nil;
FD3DDevice3 := nil;
{$ENDIF}
FD3DDevice7 := nil;
{$IFDEF D3D_deprecated}
FD3D := nil;
FD3D2 := nil;
FD3D3 := nil;
{$ENDIF}
FD3D7 := nil;
 
FreeZBufferSurface(FSurface, FZBuffer);
3832,9 → 6471,6
FSurface.Free; FSurface := nil;
FPrimary.Free; FPrimary := nil;
 
FD3DRM3 := nil;
FD3DRM2 := nil;
FD3DRM := nil;
end;
end;
 
3867,8 → 6503,11
if not AllowPalette256 then
begin
dc := GetDC(0);
try
GetSystemPaletteEntries(dc, 0, 256, Entries);
finally
ReleaseDC(0, dc);
end;
 
for i:=0 to 9 do
Result[i] := Entries[i];
3904,8 → 6543,9
end;
 
if doWaitVBlank in FDXDraw.NowOptions then
FDXDraw.FDDraw.DXResult := FDXDraw.FDDraw.IDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
FDXDraw.FDDraw.DXResult := FDXDraw.FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
 
FillChar(DF, SizeOf(DF), 0);
DF.dwsize := SizeOf(DF);
DF.dwDDFX := 0;
 
3913,6 → 6553,7
end;
 
procedure TDXDrawDriverBlt.Initialize;
{$IFDEF D3D_deprecated}
const
PrimaryDesc: TDDSurfaceDesc = (
dwSize: SizeOf(PrimaryDesc);
3919,10 → 6560,20
dwFlags: DDSD_CAPS;
ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE)
);
{$ENDIF}
var
Entries: TPaletteEntries;
PaletteCaps: Integer;
{$IFNDEF D3D_deprecated}
PrimaryDesc: TDDSurfaceDesc2;
{$ENDIF}
begin
{$IFNDEF D3D_deprecated}
FillChar(PrimaryDesc, SizeOf(PrimaryDesc), 0);
PrimaryDesc.dwSize := SizeOf(PrimaryDesc);
PrimaryDesc.dwFlags := DDSD_CAPS;
PrimaryDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
{$ENDIF}
{ Surface making }
FDXDraw.FPrimary := TDirectDrawSurface.Create(FDXDraw.FDDraw);
if not FDXDraw.FPrimary.CreateSurface(PrimaryDesc) then
3952,9 → 6603,9
 
procedure TDXDrawDriverBlt.InitializeSurface;
var
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
FDXDraw.FSurface.IDDSurface := nil;
FDXDraw.FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
 
{ Surface making }
FDXDraw.FNowOptions := FDXDraw.FNowOptions - [doSystemMemory];
3969,7 → 6620,7
ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
if doSystemMemory in FDXDraw.Options then
ddsCaps.dwCaps := ddsCaps.dwCaps or DDSCAPS_SYSTEMMEMORY;
if do3D in FDXDraw.FNowOptions then
{$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
ddsCaps.dwCaps := ddsCaps.dwCaps or DDSCAPS_3DDEVICE;
end;
 
3986,7 → 6637,7
FDXDraw.FSurface.Palette := FDXDraw.Palette;
FDXDraw.FSurface.Fill(0);
 
if do3D in FDXDraw.FNowOptions then
{$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
Initialize3D;
end;
 
4021,12 → 6672,13
procedure TDXDrawDriverFlip.Flip;
begin
if (FDXDraw.FForm<>nil) and (FDXDraw.FForm.Active) then
FDXDraw.FPrimary.DXResult := FDXDraw.FPrimary.ISurface.Flip(nil, DDFLIP_WAIT)
FDXDraw.FPrimary.DXResult := FDXDraw.FPrimary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Flip(nil, DDFLIP_WAIT)
else
FDXDraw.FPrimary.DXResult := 0;
end;
 
procedure TDXDrawDriverFlip.Initialize;
{$IFDEF D3D_deprecated}
const
DefPrimaryDesc: TDDSurfaceDesc = (
dwSize: SizeOf(DefPrimaryDesc);
4035,16 → 6687,29
ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX)
);
BackBufferCaps: TDDSCaps = (dwCaps: DDSCAPS_BACKBUFFER);
{$ENDIF}
var
PrimaryDesc: TDDSurfaceDesc;
PrimaryDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
PaletteCaps: Integer;
Entries: TPaletteEntries;
DDSurface: IDirectDrawSurface;
DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF};
{$IFNDEF D3D_deprecated}
BackBufferCaps: TDDSCaps2;
{$ENDIF}
begin
{ Surface making }
{$IFDEF D3D_deprecated}
PrimaryDesc := DefPrimaryDesc;
 
if do3D in FDXDraw.FNowOptions then
{$ELSE}
FillChar(PrimaryDesc, SizeOf(PrimaryDesc), 0);
PrimaryDesc.dwSize := SizeOf(PrimaryDesc);
PrimaryDesc.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
PrimaryDesc.dwBackBufferCount := 1;
PrimaryDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
FillChar(BackBufferCaps, SizeOf(BackBufferCaps), 0);
BackBufferCaps.dwCaps := DDSCAPS_BACKBUFFER;
{$ENDIF}
{$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
PrimaryDesc.ddsCaps.dwCaps := PrimaryDesc.ddsCaps.dwCaps or DDSCAPS_3DDEVICE;
 
FDXDraw.FPrimary := TDirectDrawSurface.Create(FDXDraw.FDDraw);
4052,8 → 6717,8
raise EDXDrawError.CreateFmt(SCannotMade, [SDirectDrawPrimarySurface]);
 
FDXDraw.FSurface := TDirectDrawSurface.Create(FDXDraw.FDDraw);
if FDXDraw.FPrimary.ISurface.GetAttachedSurface(BackBufferCaps, DDSurface)=DD_OK then
FDXDraw.FSurface.IDDSurface := DDSurface;
if FDXDraw.FPrimary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetAttachedSurface(BackBufferCaps, DDSurface) = DD_OK then
FDXDraw.FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := DDSurface;
 
FDXDraw.FNowOptions := FDXDraw.FNowOptions - [doSystemMemory];
if FDXDraw.FSurface.SurfaceDesc.ddscaps.dwCaps and DDSCAPS_SYSTEMMEMORY<>0 then
4075,8 → 6740,9
FDXDraw.FPrimary.Palette := FDXDraw.Palette;
FDXDraw.FSurface.Palette := FDXDraw.Palette;
 
if do3D in FDXDraw.FNowOptions then
{$IFDEF D3D_deprecated}if do3D in FDXDraw.FNowOptions then{$ENDIF}
Initialize3D;
 
end;
 
constructor TCustomDXDraw.Create(AOwner: TComponent);
4088,14 → 6754,18
inherited Create(AOwner);
FAutoInitialize := True;
FDisplay := TDXDrawDisplay.Create(Self);
{$IFDEF _DMO_}FAdapters := EnumDirectDrawDriversEx;{$ENDIF}
Options := [doAllowReboot, doWaitVBlank, doCenter, {$IFDEF D3D_deprecated}doDirectX7Mode, do3D,{$ENDIF}
doHardware, doSelectDriver];
 
Options := [doAllowReboot, doWaitVBlank, doCenter, doDirectX7Mode, doHardware, doSelectDriver];
 
FAutoSize := True;
 
dc := GetDC(0);
try
GetSystemPaletteEntries(dc, 0, 256, Entries);
finally
ReleaseDC(0, dc);
end;
 
ColorTable := PaletteEntriesToRGBQuads(Entries);
DefColorTable := ColorTable;
4103,7 → 6773,11
Width := 100;
Height := 100;
ParentColor := False;
Color := clBtnFace;
Color := clBlack; //clBtnFace; // FIX
 
FD2D := TD2D.Create(Self);
D2D := FD2D; {as loopback}
FTraces := TTraces.Create(Self);
end;
 
destructor TCustomDXDraw.Destroy;
4111,8 → 6785,13
Finalize;
NotifyEventList(dxntDestroying);
FDisplay.Free;
{$IFDEF _DMO_}FAdapters := nil;{$ENDIF}
FSubClass.Free; FSubClass := nil;
FNotifyEventList.Free;
FD2D.Free;
FD2D := nil;
D2D := nil;
FTraces.Free;
inherited Destroy;
end;
 
4121,6 → 6800,13
Result := EnumDirectDrawDrivers;
end;
 
{$IFDEF _DMO_}
class function TCustomDXDraw.DriversEx: TDirectXDriversEx;
begin
Result := EnumDirectDrawDriversEx;
end;
{$ENDIF}
 
type
PDXDrawNotifyEvent = ^TDXDrawNotifyEvent;
 
4183,7 → 6869,7
procedure FlipToGDISurface;
begin
if Initialized and (FNowOptions*[doFullScreen, doFlip]=[doFullScreen, doFlip]) then
DDraw.IDraw.FlipToGDISurface;
DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.FlipToGDISurface;
end;
 
begin
4205,6 → 6891,23
Exit;
end;
end;
(*
WM_ACTIVATEAPP:
begin
if TWMActivateApp(Message).Active then
begin
FActive := True;
DoActivate;
// PostMessage(FHandle, CM_ACTIVATE, 0, 0)
end
else
begin
FActive := False;
DoDeactivate;
// PostMessage(FHandle, CM_DEACTIVATE, 0, 0);
end;
end;
*)
WM_ACTIVATE:
begin
if TWMActivate(Message).Active=WA_INACTIVE then
4218,7 → 6921,25
begin
Finalize;
end;
WM_ENTERSIZEMOVE:
begin
if not (csLoading in ComponentState) then
Finalize;
end;
WM_EXITSIZEMOVE:
begin
if not (csLoading in ComponentState) then
Initialize;
end;
// SW_RESTORE, SW_MAXIMIZE:
// begin
// {force finalize/initialize loop}
// if not AutoInitialize or not (csLoading in ComponentState) then begin
// Finalize;
// Initialize;
// end;
// end;
end;
DefWindowProc(Message);
end;
 
4234,11 → 6955,26
 
procedure TCustomDXDraw.DoInitialize;
begin
{$IFDEF _DMO_}
{erase items for following refresh}
if Assigned(FAdapters) then FAdapters.Clear;
EnumDirectDrawDriversEx;
{$ENDIF}
if Assigned(FOnInitialize) then FOnInitialize(Self);
{$IFNDEF DXR_deprecated}
{$IFDEF D3D_deprecated}
if not (do3D in Options) then
Options := Options + [do3D];
{$ENDIF}
{$ENDIF}
end;
 
procedure TCustomDXDraw.DoInitializeSurface;
begin
{.06 added for better initialization}
if Assigned(FD2D) then
RenderError := FD2D.D2DInitializeSurface;
 
if Assigned(FOnInitializeSurface) then FOnInitializeSurface(Self);
end;
 
4294,6 → 7030,10
FUpdating := False;
end;
end;
if AsSigned(FD2D) then
FD2D.Free;
FD2D := nil;
D2D := nil
end;
 
procedure TCustomDXDraw.Flip;
4300,14 → 7040,21
begin
if Initialized and (not FUpdating) then
begin
if TryRestore then
if TryRestore and (not RenderError) then
TDXDrawDriver(FDXDrawDriver).Flip;
end;
RenderError := false;
end;
 
function TCustomDXDraw.GetCanDraw: Boolean;
begin
Result := Initialized and (not FUpdating) and (Surface.IDDSurface<>nil) and
{$IFNDEF DXR_deprecated}
{$IFDEF D3D_deprecated}
if not (do3D in Options) then
Options := Options + [do3D];
{$ENDIF}
{$ENDIF}
Result := Initialized and (not FUpdating) and (Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) and
TryRestore;
end;
 
4319,7 → 7066,7
 
function TCustomDXDraw.GetSurfaceHeight: Integer;
begin
if Surface.IDDSurface<>nil then
if Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
Result := Surface.Height
else
Result := FSurfaceHeight;
4327,7 → 7074,7
 
function TCustomDXDraw.GetSurfaceWidth: Integer;
begin
if Surface.IDDSurface<>nil then
if Surface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
Result := Surface.Width
else
Result := FSurfaceWidth;
4417,6 → 7164,11
Dec(FOffNotifyRestore);
end;
 
if not Assigned(FD2D) then begin
FD2D := TD2D.Create(Self);
D2D := FD2D; {as loopback}
end;
 
Restore;
end;
 
4474,9 → 7226,11
Result := False;
end;
 
procedure TCustomDXDraw.Render;
procedure TCustomDXDraw.Render(LagCount: Integer{$IFDEF VER4UP} = 0{$ENDIF});
var I: Integer;
begin
if FInitialized and (do3D in FNowOptions) and (doRetainedMode in FNowOptions) then
{$IFDEF D3DRM}
if FInitialized and {$IFDEF D3D_deprecated}(do3D in FNowOptions) and{$ENDIF} (doRetainedMode in FNowOptions) then
begin
asm FInit end;
FViewport.Clear;
4484,6 → 7238,15
FD3DRMDevice.Update;
asm FInit end;
end;
{$ENDIF}
{traces}
if FTraces.Count > 0 then
for I := 0 to FTraces.Count - 1 do
if FTraces.Items[I].Active then
FTraces.Items[I].Render(LagCount);
{own rendering event}
if Assigned(FOnRender) then
FOnRender(Self);
end;
 
procedure TCustomDXDraw.Restore;
4525,6 → 7288,255
SetSize(AWidth, AHeight);
end;
 
procedure TCustomDXDraw.BeginScene;
begin
if CheckD3 then
FD2D.BeginScene
end;
 
procedure TCustomDXDraw.EndScene;
begin
if CheckD3 then
FD2D.EndScene
end;
 
function TCustomDXDraw.CheckD3: Boolean;
begin
Result := {$IFDEF D3D_deprecated}(do3D in Options) and{$ENDIF} (doHardware in Options) and AsSigned(FD2D);
end;
 
function TCustomDXDraw.CheckD3D(Dest: TDirectDrawSurface): Boolean;
begin
Result := CheckD3 and (FD2D.FDDraw.FSurface = Dest)
end;
 
procedure TCustomDXDraw.ClearStack;
begin
if CheckD3 then
FD2D.D2DTextures.D2DPruneAllTextures;
end;
 
procedure TCustomDXDraw.UpdateTextures;
var Changed: Boolean;
begin
if CheckD3 then begin
if Assigned(FOnUpdateTextures) then begin
Changed := False;
FOnUpdateTextures(FD2D.FD2DTexture, Changed);
if Changed then FD2D.D2DUpdateTextures;
end
end;
end;
 
procedure TCustomDXDraw.TextureFilter(Grade: TD2DTextureFilter);
begin
if CheckD3 then
FD2D.TextureFilter := Grade;
end;
 
procedure TCustomDXDraw.AntialiasFilter(Grade: TD3DAntialiasMode);
begin
if CheckD3 then
FD2D.AntialiasFilter := Grade;
end;
 
// ***** fade effects
// do not use in dxtimer cycle
 
function TCustomDXDraw.Fade2Color(colorfrom, colorto: LongInt): LongInt;
var i, r1, r2, g1, g2, b1, b2: Integer;
begin
r1 := GetRValue(colorfrom);
r2 := GetRValue(colorto);
g1 := GetGValue(colorfrom);
g2 := GetGValue(colorto);
b1 := GetBValue(colorfrom);
b2 := GetBValue(colorto);
if r1 < r2 then
begin
for i := r1 to r2 do
begin
Surface.Fill(RGB(i, g1, b1));
Flip;
end;
end
else
begin
for i := r1 downto r2 do
begin
Surface.Fill(RGB(i, g1, b1));
Flip;
end;
end;
 
if g1 < g2 then
begin
for i := g1 to g2 do
begin
Surface.Fill(RGB(r2, i, b1));
Flip;
end;
end
else
begin
for i := g1 downto g2 do
begin
Surface.Fill(RGB(r2, i, b1));
Flip;
end;
end;
if b1 < b2 then
begin
for i := b1 to b2 do
begin
Surface.Fill(RGB(r2, g2, i));
Flip;
end;
end
else
begin
for i := b1 downto b2 do
begin
Surface.Fill(RGB(r2, g2, i));
Flip;
end;
end;
Result := colorto;
end;
 
function TCustomDXDraw.Fade2Black(colorfrom: LongInt): LongInt;
var i, r, g, b: Integer;
begin
r := GetRValue(colorfrom);
g := GetGValue(colorfrom);
b := GetBValue(colorfrom);
for i := r downto 0 do
begin
Surface.Fill(RGB(i, g, b));
Flip;
end;
for i := g downto 0 do
begin
Surface.Fill(RGB(0, i, b));
Flip;
end;
for i := g downto 0 do
begin
Surface.Fill(RGB(0, 0, i));
Flip;
end;
Result := 0;
end;
 
function TCustomDXDraw.Fade2White(colorfrom: LongInt): LongInt;
var i, r, g, b: Integer;
begin
r := GetRValue(colorfrom);
g := GetGValue(colorfrom);
b := GetBValue(colorfrom);
for i := r to 255 do
begin
Surface.Fill(RGB(i, g, b));
Flip;
end;
for i := g to 255 do
begin
Surface.Fill(RGB(255, i, b));
Flip;
end;
for i := b to 255 do
begin
Surface.Fill(RGB(255, 255, i));
Flip;
end;
Result := RGB(255, 255, 255);
end;
 
function TCustomDXDraw.Grey2Fade(shadefrom, shadeto: Integer): Integer;
var i: Integer;
begin
if shadefrom < shadeto then
begin
for i := shadefrom to shadeto do
begin
Surface.Fill(RGB(i, i, i));
Flip;
end;
end
else
begin
for i := shadefrom downto shadeto do
begin
Surface.Fill(RGB(i, i, i));
Flip;
end;
end;
Result := shadeto;
end;
 
function TCustomDXDraw.FadeGrey2Screen(oldcolor, newcolour: LongInt): LongInt;
begin
result := Grey2Fade(oldcolor, newcolour);
end;
 
function TCustomDXDraw.Fade2Screen(oldcolor, newcolour: LongInt): LongInt;
begin
result := Fade2Color(oldcolor, newcolour);
end;
 
function TCustomDXDraw.White2Screen(oldcolor: Integer): LongInt;
begin
result := Fade2Color(oldcolor, RGB(255, 255, 255));
end;
 
function TCustomDXDraw.Black2Screen(oldcolor: Integer): LongInt;
begin
result := Fade2Color(oldcolor, RGB(0, 0, 0));
end;
 
procedure TCustomDXDraw.GrabImage(iX, iY, iWidth, iHeight: Integer; ddib: TDIB);
var ts, td: trect;
begin
ddib.SetSize(iWidth, iHeight, 24);
ts.left := iX;
ts.top := iY;
ts.right := iX + iWidth - 1;
ts.bottom := iY + iHeight - 1;
td.left := 0;
td.top := 0;
td.right := iWidth;
td.bottom := iHeight;
with Surface.Canvas do
begin
ddib.Canvas.CopyRect(td, Surface.Canvas, ts);
Release;
end;
end;
 
procedure TCustomDXDraw.PasteImage(sdib: TDIB; x, y: Integer);
var
ts, td: trect;
w, h: Integer;
begin
w := sdib.width - 1;
h := sdib.height - 1;
ts.left := 0;
ts.top := 0;
ts.right := w;
ts.bottom := h;
td.left := x;
td.top := y;
td.right := x + w;
td.bottom := y + h;
with Surface.Canvas do
begin
CopyRect(td, sdib.Canvas, ts);
release;
end;
end;
 
// *****
 
procedure TCustomDXDraw.SetColorTable(const ColorTable: TRGBQuads);
var
Entries: TPaletteEntries;
4548,15 → 7560,15
 
if doFullScreen in FNowOptions then
begin
Flags := DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWMODEX;
Flags := DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWMODEX{$IFDEF DXDOUBLEPRECISION} or DDSCL_FPUPRESERVE{$ENDIF};
if doNoWindowChange in FNowOptions then
Flags := Flags or DDSCL_NOWINDOWCHANGES;
if doAllowReboot in FNowOptions then
Flags := Flags or DDSCL_ALLOWREBOOT;
end else
Flags := DDSCL_NORMAL;
Flags := DDSCL_NORMAL{$IFDEF DXDOUBLEPRECISION} or DDSCL_FPUPRESERVE{$ENDIF};
 
DDraw.DXResult := DDraw.IDraw.SetCooperativeLevel(Control.Handle, Flags);
DDraw.DXResult := DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.SetCooperativeLevel(Control.Handle, Flags);
end;
 
procedure TCustomDXDraw.SetDisplay(Value: TDXDrawDisplay);
4576,9 → 7588,10
 
procedure TCustomDXDraw.SetOptions(Value: TDXDrawOptions);
const
InitOptions = [doDirectX7Mode, doFullScreen, doNoWindowChange, doAllowReboot,
doAllowPalette256, doSystemMemory, doFlip, do3D,
doRetainedMode, doHardware, doSelectDriver, doZBuffer];
InitOptions = [doFullScreen, doNoWindowChange, doAllowReboot,
doAllowPalette256, doSystemMemory, doFlip,
{$IFDEF D3D_deprecated}doDirectX7Mode, do3D,{$ENDIF}{$IFDEF D3DRM} doRetainedMode, {$ENDIF}
doHardware, doSelectDriver, doZBuffer];
var
OldOptions: TDXDrawOptions;
begin
4588,9 → 7601,10
begin
OldOptions := FNowOptions;
FNowOptions := FNowOptions*InitOptions+(FOptions-InitOptions);
 
{$IFDEF D3D_deprecated}
if not (do3D in FNowOptions) then
FNowOptions := FNowOptions - [doHardware, doRetainedMode, doSelectDriver, doZBuffer];
FNowOptions := FNowOptions - [doHardware, {$IFDEF D3DRM}doRetainedMode,{$ENDIF} doSelectDriver, doZBuffer];
{$ENDIF}
end else
begin
FNowOptions := FOptions;
4597,16 → 7611,16
 
if not (doFullScreen in FNowOptions) then
FNowOptions := FNowOptions - [doNoWindowChange, doAllowReBoot, doAllowPalette256, doFlip];
 
{$IFDEF D3D_deprecated}
if not (do3D in FNowOptions) then
FNowOptions := FNowOptions - [doDirectX7Mode, doRetainedMode, doHardware, doSelectDriver, doZBuffer];
 
FNowOptions := FNowOptions - [doDirectX7Mode, {$IFDEF D3DRM}doRetainedMode,{$ENDIF} doHardware, doSelectDriver, doZBuffer];
{$ENDIF}
if doSystemMemory in FNowOptions then
FNowOptions := FNowOptions - [doFlip];
 
{$IFDEF D3DRM}
if doDirectX7Mode in FNowOptions then
FNowOptions := FNowOptions - [doRetainedMode];
 
{$ENDIF}
FNowOptions := FNowOptions - [doHardware];
end;
end;
4677,24 → 7691,30
begin
Result := False;
 
if Initialized and (not FUpdating) and (Primary.IDDSurface<>nil) then
if Initialized and (not FUpdating) and (Primary.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil) then
begin
if (Primary.ISurface.IsLost=DDERR_SURFACELOST) or
(Surface.ISurface.IsLost=DDERR_SURFACELOST) then
if (Primary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DDERR_SURFACELOST) or
(Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DDERR_SURFACELOST) then
begin
if Assigned(FD2D) and Assigned(FD2D.FD2DTexture) then FD2D.FD2DTexture.D2DPruneAllTextures;//<-Add Mr.Kawasaki
Restore;
Result := (Primary.ISurface.IsLost=DD_OK) and (Surface.ISurface.IsLost=DD_OK);
Result := (Primary.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DD_OK) and (Surface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DD_OK);
end else
Result := True;
end;
end;
 
procedure TCustomDXDraw.SetTraces(const Value: TTraces);
begin
FTraces.Assign(Value);
end;
 
procedure TCustomDXDraw.UpdatePalette;
begin
if Initialized and (doWaitVBlank in FNowOptions) then
begin
if FDDraw.FDriverCaps.dwPalCaps and DDPCAPS_VSYNC=0 then
FDDraw.IDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
FDDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN, 0);
end;
 
SetColorTable(ColorTable);
4711,6 → 7731,8
end;
end;
 
{$IFDEF DX3D_deprecated}
 
{ TCustomDX3D }
 
constructor TCustomDX3D.Create(AOwner: TComponent);
4751,7 → 7773,7
FInitialized := False;
 
SetOptions(FOptions);
 
{$IFDEF D3DRM}
FViewport := nil;
FCamera := nil;
FScene := nil;
4759,22 → 7781,28
FD3DRMDevice := nil;
FD3DRMDevice2 := nil;
FD3DRMDevice3 := nil;
{$ENDIF}
{$IFDEF D3D_deprecated}
FD3DDevice := nil;
FD3DDevice2 := nil;
FD3DDevice3 := nil;
{$ENDIF}
FD3DDevice7 := nil;
{$IFDEF D3D_deprecated}
FD3D := nil;
FD3D2 := nil;
FD3D3 := nil;
{$ENDIF}
FD3D7 := nil;
 
FreeZBufferSurface(FSurface, FZBuffer);
 
FSurface.Free; FSurface := nil;
 
{$IFDEF D3DRM}
FD3DRM3 := nil;
FD3DRM2 := nil;
FD3DRM := nil;
{$ENDIF}
end;
end;
end;
4821,7 → 7849,8
end else
begin
InitializeDirect3D(FSurface, FZBuffer, FD3D, FD3D2, FD3D3, FD3DDevice, FD3DDevice2, FD3DDevice3,
FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera, AOptions);
{$IFDEF D3DRM}FD3DRM, FD3DRM2, FD3DRM3, FD3DRMDevice, FD3DRMDevice2, FD3DRMDevice3, FViewport, FScene, FCamera, {$ENDIF}
AOptions);
end;
 
FNowOptions := [];
4840,6 → 7869,7
 
procedure TCustomDX3D.Render;
begin
{$IFDEF D3DRM}
if FInitialized and (toRetainedMode in FNowOptions) then
begin
asm FInit end;
4848,6 → 7878,7
FD3DRMDevice.Update;
asm FInit end;
end;
{$ENDIF}
end;
 
function TCustomDX3D.GetCanDraw: Boolean;
5004,6 → 8035,8
end;
end;
 
{$ENDIF}
 
{ TDirect3DTexture }
 
constructor TDirect3DTexture.Create(Graphic: TGraphic; DXDraw: TComponent);
5028,12 → 8061,15
begin
with (FDXDraw as TCustomDXDraw) do
begin
if (not Initialized) or (not (do3D in NowOptions)) then
if (not Initialized) {$IFDEF D3D_deprecated}or (not (do3D in NowOptions)){$ENDIF} then
raise EDirect3DTextureError.CreateFmt(SNotMade, [FDXDraw.ClassName]);
end;
FSurface := TDirectDrawSurface.Create((FDXDraw as TCustomDXDraw).Surface.DDraw);
(FDXDraw as TCustomDXDraw).RegisterNotifyEvent(DXDrawNotifyEvent);
end else if FDXDraw is TCustomDX3D then
end
else
{$IFDEF DX3D_deprecated}
if FDXDraw is TCustomDX3D then
begin
with (FDXDraw as TDX3D) do
begin
5044,6 → 8080,7
FSurface := TDirectDrawSurface.Create((FDXDraw as TCustomDX3D).Surface.DDraw);
(FDXDraw as TCustomDX3D).FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
end else
{$ENDIF}
raise EDirect3DTextureError.CreateFmt(SNotSupported, [FDXDraw.ClassName]);
end;
 
5052,11 → 8089,13
if FDXDraw is TCustomDXDraw then
begin
(FDXDraw as TCustomDXDraw).UnRegisterNotifyEvent(DXDrawNotifyEvent);
end else if FDXDraw is TCustomDX3D then
end
{$IFDEF DX3D_deprecated}
else if FDXDraw is TCustomDX3D then
begin
(FDXDraw as TCustomDX3D).FDXDraw.UnRegisterNotifyEvent(DXDrawNotifyEvent);
end;
 
end
{$ENDIF};
Clear;
FSurface.Free;
inherited Destroy;
5066,7 → 8105,7
begin
FHandle := 0;
FTexture := nil;
FSurface.IDDSurface := nil;
FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := nil;
end;
 
function TDirect3DTexture.GetHandle: TD3DTextureHandle;
5083,7 → 8122,7
Result := FSurface;
end;
 
function TDirect3DTexture.GetTexture: IDirect3DTexture;
function TDirect3DTexture.GetTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
begin
if FTexture=nil then
Restore;
5173,12 → 8212,12
end;
 
var
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
Palette: TDirectDrawPalette;
PaletteCaps: Integer;
TempSurface: TDirectDrawSurface;
Width2, Height2: Integer;
D3DDevice: IDirect3DDevice;
D3DDevice: {$IFDEF D3D_deprecated}IDirect3DDevice{$ELSE}IDirect3DDevice7{$ENDIF};
Hardware: Boolean;
DDraw: TDirectDraw;
begin
5189,14 → 8228,17
if FDXDraw is TCustomDXDraw then
begin
DDraw := (FDXDraw as TCustomDXDraw).DDraw;
D3DDevice := (FDXDraw as TCustomDXDraw).D3DDevice;
D3DDevice := (FDXDraw as TCustomDXDraw).{$IFDEF D3D_deprecated}D3DDevice{$ELSE}D3DDevice7{$ENDIF};
Hardware := doHardware in (FDXDraw as TCustomDXDraw).NowOptions;
end else if FDXDraw is TCustomDX3D then
end
{$IFDEF DX3D_deprecated}
else if FDXDraw is TCustomDX3D then
begin
DDraw := (FDXDraw as TCustomDX3D).Surface.DDraw;
D3DDevice := (FDXDraw as TCustomDX3D).D3DDevice;
Hardware := toHardware in (FDXDraw as TCustomDX3D).NowOptions;
end;
end
{$ENDIF};
 
if (DDraw=nil) or (D3DDevice=nil) then Exit;
 
5284,13 → 8326,13
end;
 
{ Source surface is loaded into surface. }
FTexture := FSurface.ISurface as IDirect3DTexture;
FTexture.Load(TempSurface.ISurface as IDirect3DTexture);
FTexture := FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF} as {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
FTexture.Load(TempSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF} as {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF});
finally
TempSurface.Free;
end;
 
if FTexture.GetHandle(D3DDevice, FHandle)<>D3D_OK then
if FTexture.GetHandle(D3DDevice as {$IFDEF D3D_deprecated}IDirect3DDevice{$ELSE}IDirect3DDevice2{$ENDIF}, FHandle) <> D3D_OK then
raise EDirect3DTextureError.CreateFmt(SCannotMade, [STexture]);
 
FSurface.TransparentColor := FSurface.ColorMatch(FTransparentColor);
5327,9 → 8369,11
 
if FSrcImage is TDXTextureImage then
FImage := TDXTextureImage(FSrcImage)
else if FSrcImage is TDIB then
else
if FSrcImage is TDIB then
SetDIB(TDIB(FSrcImage))
else if FSrcImage is TGraphic then
else
if FSrcImage is TGraphic then
begin
FSrcImage := TDIB.Create;
try
5340,7 → 8384,8
Graphic.Free;
FAutoFreeGraphic := True;
end;
end else
end
else
if FSrcImage is TPicture then
begin
FSrcImage := TDIB.Create;
5352,7 → 8397,8
Graphic.Free;
FAutoFreeGraphic := True;
end;
end else
end
else
raise Exception.CreateFmt(SCannotLoadGraphic, [Graphic.ClassName]);
 
FMipmap := FImage.SubGroupImageCount[DXTextureImageGroupType_Mipmap]>0;
5514,6 → 8560,17
FImage := FImage2;
end;
 
function TDirect3DTexture2.GetHeight: Integer;
begin
if Assigned(FImage) then
Result := FImage.Height
else
if Assigned(FImage2) then
Result := FImage2.Height
else
Result := 0;
end;
 
function TDirect3DTexture2.GetIsMipmap: Boolean;
begin
if FSurface<>nil then
5537,6 → 8594,17
Result := FTransparent;
end;
 
function TDirect3DTexture2.GetWidth: Integer;
begin
if Assigned(FImage) then
Result := FImage.Width
else
if Assigned(FImage2) then
Result := FImage2.Width
else
Result := 0;
end;
 
procedure TDirect3DTexture2.SetTransparent(Value: Boolean);
begin
if FTransparent<>Value then
5722,9 → 8790,9
Width, Height: Integer;
PaletteCaps: DWORD;
Palette: IDirectDrawPalette;
TempD3DDevDesc: TD3DDeviceDesc;
{$IFDEF D3D_deprecated}TempD3DDevDesc: TD3DDeviceDesc;{$ENDIF}
D3DDevDesc7: TD3DDeviceDesc7;
TempSurface: IDirectDrawSurface4;
TempSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
begin
Finalize;
try
5735,12 → 8803,14
FD3DDevDesc.dpcTriCaps.dwTextureCaps := D3DDevDesc7.dpcTriCaps.dwTextureCaps;
FD3DDevDesc.dwMinTextureWidth := D3DDevDesc7.dwMinTextureWidth;
FD3DDevDesc.dwMaxTextureWidth := D3DDevDesc7.dwMaxTextureWidth;
end else
end
{$IFDEF D3D_deprecated}
else
begin
FD3DDevDesc.dwSize := SizeOf(FD3DDevDesc);
TempD3DDevDesc.dwSize := SizeOf(TempD3DDevDesc);
FDXDraw.D3DDevice3.GetCaps(FD3DDevDesc, TempD3DDevDesc);
end;
end{$ENDIF};
 
if FImage<>nil then
begin
5750,7 → 8820,8
{ The size of the texture is only Sqr(n). }
Width := Max(1 shl GetBitCount(FImage.Width), 1);
Height := Max(1 shl GetBitCount(FImage.Height), 1);
end else
end
else
begin
Width := FImage.Width;
Height := FImage.Height;
5779,8 → 8850,8
FEnumTextureFormatFlag := False;
if FDXDraw.D3DDevice7<>nil then
FDXDraw.D3DDevice7.EnumTextureFormats(@EnumTextureFormatCallback, Self)
else
FDXDraw.D3DDevice3.EnumTextureFormats(@EnumTextureFormatCallback, Self);
{$IFDEF D3D_deprecated}else
FDXDraw.D3DDevice3.EnumTextureFormats(@EnumTextureFormatCallback, Self){$ENDIF};
 
if not FEnumTextureFormatFlag then
raise EDirect3DTextureError.CreateFmt(SCannotInitialized, [STexture]);
5814,10 → 8885,10
end;
 
FSurface := TDirectDrawSurface.Create(FDXDraw.DDraw);
FSurface.DDraw.DXResult := FSurface.DDraw.IDraw4.CreateSurface(FTextureFormat, TempSurface, nil);
FSurface.DDraw.DXResult := FSurface.DDraw.{$IFDEF D3D_deprecated}IDraw4{$ELSE}IDraw7{$ENDIF}.CreateSurface(FTextureFormat, TempSurface, nil);
if FSurface.DDraw.DXResult<>DD_OK then
raise EDirect3DTextureError.CreateFmt(SCannotInitialized, [STexture]);
FSurface.IDDSurface4 := TempSurface;
FSurface.{$IFDEF D3D_deprecated}IDDSurface4{$ELSE}IDDSurface7{$ENDIF} := TempSurface;
 
{ Palette making }
if (FImage<>nil) and (FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED<>0) then
5824,11 → 8895,14
begin
if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED8<>0 then
PaletteCaps := DDPCAPS_8BIT or DDPCAPS_ALLOW256
else if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4<>0 then
else
if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED4 <> 0 then
PaletteCaps := DDPCAPS_4BIT
else if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED2<>0 then
else
if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED2 <> 0 then
PaletteCaps := DDPCAPS_2BIT
else if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1<>0 then
else
if FTextureFormat.ddpfPixelFormat.dwFlags and DDPF_PALETTEINDEXED1 <> 0 then
PaletteCaps := DDPCAPS_1BIT
else
PaletteCaps := 0;
5835,10 → 8909,10
 
if PaletteCaps<>0 then
begin
if FDXDraw.DDraw.IDraw.CreatePalette(PaletteCaps, @FImage.idx_palette, Palette, nil)<>0 then
if FDXDraw.DDraw.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.CreatePalette(PaletteCaps, @FImage.idx_palette, Palette, nil) <> 0 then
Exit;
 
FSurface.ISurface.SetPalette(Palette);
FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetPalette(Palette);
end;
end;
 
5853,7 → 8927,7
const
MipmapCaps: TDDSCaps2 = (dwCaps: DDSCAPS_TEXTURE or DDSCAPS_MIPMAP);
var
CurSurface, NextSurface: IDirectDrawSurface4;
CurSurface, NextSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
Index: Integer;
SrcImage: TDXTextureImage;
begin
5861,7 → 8935,7
Initialize;
 
FNeedLoadTexture := False;
if FSurface.ISurface.IsLost=DDERR_SURFACELOST then
if FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.IsLost = DDERR_SURFACELOST then
FSurface.Restore;
 
{ Color key setting. }
5873,7 → 8947,7
if FSrcImage is TDIB then
SetDIB(TDIB(FSrcImage));
 
CurSurface := FSurface.ISurface4;
CurSurface := FSurface.{$IFDEF D3D_deprecated}ISurface4{$ELSE}ISurface7{$ENDIF};
Index := 0;
while CurSurface<>nil do
begin
5894,7 → 8968,8
 
Inc(Index);
end;
end else
end
else
DoRestoreSurface;
end;
 
5913,7 → 8988,8
begin
{ Palette index }
ck.dwColorSpaceLowValue := FTransparentColor and $FF;
end else
end
else
if FImage<>nil then
begin
{ RGB value }
5920,7 → 8996,8
ck.dwColorSpaceLowValue := FImage.PaletteIndex(GetRValue(FTransparentColor), GetGValue(FTransparentColor), GetBValue(FTransparentColor));
end else
Exit;
end else
end
else
begin
if (FImage<>nil) and (FImage.ImageType=DXTextureImageType_PaletteIndexedColor) and (FTransparentColor shr 24=$01) then
begin
5929,7 → 9006,8
dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwRBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peRed) or
dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwGBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peGreen) or
dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwBBitMask, False), FImage.idx_palette[FTransparentColor and $FF].peBlue);
end else
end
else
if FTransparentColor shr 24=$00 then
begin
{ RGB value }
5937,18 → 9015,19
dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwRBitMask, False), GetRValue(FTransparentColor)) or
dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwGBitMask, False), GetGValue(FTransparentColor)) or
dxtEncodeChannel(dxtMakeChannel(FSurface.SurfaceDesc.ddpfPixelFormat.dwBBitMask, False), GetBValue(FTransparentColor));
end else
end
else
Exit;
end;
 
ck.dwColorSpaceHighValue := ck.dwColorSpaceLowValue;
FSurface.ISurface.SetColorKey(DDCKEY_SRCBLT, ck);
FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.SetColorKey(DDCKEY_SRCBLT, @ck);
 
FUseColorKey := True;
end;
end;
 
procedure TDirect3DTexture2.LoadSubTexture(Dest: IDirectDrawSurface4; SrcImage: TDXTextureImage);
procedure TDirect3DTexture2.LoadSubTexture(Dest: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF}; SrcImage: TDXTextureImage);
const
Mask1: array[0..7] of DWORD = (1, 2, 4, 8, 16, 32, 64, 128);
Mask2: array[0..3] of DWORD = (3, 12, 48, 192);
5986,12 → 9065,16
if Dest.Lock(nil, ddsd, DDLOCK_WAIT, 0)=0 then
begin
try
if (SrcImage.idx_index.Mask=DWORD(1 shl ddsd.ddpfPixelFormat.dwRGBBitCount)-1) and (SrcImage.idx_alpha.Mask=0) and
(SrcImage.BitCount=Integer(ddsd.ddpfPixelFormat.dwRGBBitCount)) and (not SrcImage.PackedPixelOrder) then
if (SrcImage.idx_index.Mask = DWORD(1 shl ddsd.ddpfPixelFormat.dwRGBBitCount) - 1) and
(SrcImage.idx_alpha.Mask = 0) and
(SrcImage.BitCount = Integer(ddsd.ddpfPixelFormat.dwRGBBitCount)) and
(not SrcImage.PackedPixelOrder)
then
begin
for y:=0 to ddsd.dwHeight-1 do
Move(SrcImage.ScanLine[y]^, Pointer(Integer(ddsd.lpSurface)+ddsd.lPitch*y)^, (Integer(ddsd.dwWidth)*SrcImage.BitCount+7) div 8);
end else
end
else
begin
for y:=0 to ddsd.dwHeight-1 do
begin
6036,7 → 9119,8
 
SetPixel(ddsd, x, y, c);
end;
end else
end
else
begin
cA := dxtEncodeChannel(dest_alpha_fmt, 255);
 
6077,11 → 9161,13
 
if (dest_red_fmt.Mask=SrcImage.rgb_red.Mask) and (dest_green_fmt.Mask=SrcImage.rgb_green.Mask) and
(dest_blue_fmt.Mask=SrcImage.rgb_blue.Mask) and (dest_alpha_fmt.Mask=SrcImage.rgb_alpha.Mask) and
(Integer(ddsd.ddpfPixelFormat.dwRGBBitCount)=SrcImage.BitCount) and (not SrcImage.PackedPixelOrder) then
(Integer(ddsd.ddpfPixelFormat.dwRGBBitCount) = SrcImage.BitCount) and (not SrcImage.PackedPixelOrder)
then
begin
for y:=0 to ddsd.dwHeight-1 do
Move(SrcImage.ScanLine[y]^, Pointer(Integer(ddsd.lpSurface)+ddsd.lPitch*y)^, (Integer(ddsd.dwWidth)*SrcImage.BitCount+7) div 8);
end else
end
else
if SrcImage.rgb_alpha.mask<>0 then
begin
for y:=0 to ddsd.dwHeight-1 do
6096,7 → 9182,8
 
SetPixel(ddsd, x, y, c);
end;
end else
end
else
begin
cA := dxtEncodeChannel(dest_alpha_fmt, 255);
 
6139,10 → 9226,2147
end;
end;
 
{ Support function }
 
function GetWidthBytes(Width, BitCount: Integer): Integer;
begin
Result := (((Width * BitCount) + 31) div 32) * 4;
end;
 
function dxtEncodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
begin
Result := ((c shl Channel._rshift) shr Channel._lshift) and Channel.Mask;
end;
 
function dxtDecodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
begin
Result := ((c and Channel.Mask) shr Channel._rshift) shl Channel._lshift;
Result := Result or (Result shr Channel._BitCount2);
end;
 
function dxtMakeChannel(Mask: DWORD; indexed: Boolean): TDXTextureImageChannel;
 
function GetMaskBitCount(b: Integer): Integer;
var
i: Integer;
begin
i := 0;
while (i < 31) and (((1 shl i) and b) = 0) do Inc(i);
 
Result := 0;
while ((1 shl i) and b) <> 0 do
begin
Inc(i);
Inc(Result);
end;
end;
 
function GetBitCount2(b: Integer): Integer;
begin
Result := 0;
while (Result < 31) and (((1 shl Result) and b) = 0) do Inc(Result);
end;
 
begin
Result.BitCount := GetMaskBitCount(Mask);
Result.Mask := Mask;
 
if indexed then
begin
Result._rshift := GetBitCount2(Mask);
Result._lshift := 0;
Result._Mask2 := 1 shl Result.BitCount - 1;
Result._BitCount2 := 0;
end
else
begin
Result._rshift := GetBitCount2(Mask) - (8 - Result.BitCount);
if Result._rshift < 0 then
begin
Result._lshift := -Result._rshift;
Result._rshift := 0;
end
else
Result._lshift := 0;
Result._Mask2 := (1 shl Result.BitCount - 1) shl (8 - Result.BitCount);
Result._BitCount2 := 8 - Result.BitCount;
end;
end;
 
{ TDXTextureImage }
 
var
_DXTextureImageLoadFuncList: TList;
 
procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;
procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage); forward;
 
function DXTextureImageLoadFuncList: TList;
begin
if _DXTextureImageLoadFuncList = nil then
begin
_DXTextureImageLoadFuncList := TList.Create;
_DXTextureImageLoadFuncList.Add(@DXTextureImage_LoadDXTextureImageFunc);
_DXTextureImageLoadFuncList.Add(@DXTextureImage_LoadBitmapFunc);
end;
Result := _DXTextureImageLoadFuncList;
end;
 
class procedure TDXTextureImage.RegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
begin
if DXTextureImageLoadFuncList.IndexOf(@LoadFunc) = -1 then
DXTextureImageLoadFuncList.Add(@LoadFunc);
end;
 
class procedure TDXTextureImage.UnRegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
begin
DXTextureImageLoadFuncList.Remove(@LoadFunc);
end;
 
constructor TDXTextureImage.Create;
begin
inherited Create;
FSubImage := TList.Create;
end;
 
constructor TDXTextureImage.CreateSub(AOwner: TDXTextureImage);
begin
Create;
 
FOwner := AOwner;
try
FOwner.FSubImage.Add(Self);
except
FOwner := nil;
raise;
end;
end;
 
destructor TDXTextureImage.Destroy;
begin
Clear;
FSubImage.Free;
if FOwner <> nil then
FOwner.FSubImage.Remove(Self);
inherited Destroy;
end;
 
procedure TDXTextureImage.DoSaveProgress(Progress, ProgressCount: Integer);
begin
if Assigned(FOnSaveProgress) then
FOnSaveProgress(Self, Progress, ProgressCount);
end;
 
procedure TDXTextureImage.Assign(Source: TDXTextureImage);
var
y: Integer;
begin
SetSize(Source.ImageType, Source.Width, Source.Height, Source.BitCount, Source.WidthBytes);
 
idx_index := Source.idx_index;
idx_alpha := Source.idx_alpha;
idx_palette := Source.idx_palette;
 
rgb_red := Source.rgb_red;
rgb_green := Source.rgb_green;
rgb_blue := Source.rgb_blue;
rgb_alpha := Source.rgb_alpha;
 
for y := 0 to Height - 1 do
Move(Source.ScanLine[y]^, ScanLine[y]^, WidthBytes);
 
Transparent := Source.Transparent;
TransparentColor := Source.TransparentColor;
ImageGroupType := Source.ImageGroupType;
ImageID := Source.ImageID;
ImageName := Source.ImageName;
end;
 
procedure TDXTextureImage.ClearImage;
begin
if FAutoFreeImage then
FreeMem(FPBits);
 
FImageType := DXTextureImageType_PaletteIndexedColor;
FWidth := 0;
FHeight := 0;
FBitCount := 0;
FWidthBytes := 0;
FNextLine := 0;
FSize := 0;
FPBits := nil;
FTopPBits := nil;
FAutoFreeImage := False;
end;
 
procedure TDXTextureImage.Clear;
begin
ClearImage;
 
while SubImageCount > 0 do
SubImages[SubImageCount - 1].Free;
 
FImageGroupType := 0;
FImageID := 0;
FImageName := '';
 
FTransparent := False;
FTransparentColor := 0;
 
FillChar(idx_index, SizeOf(idx_index), 0);
FillChar(idx_alpha, SizeOf(idx_alpha), 0);
FillChar(idx_palette, SizeOf(idx_palette), 0);
FillChar(rgb_red, SizeOf(rgb_red), 0);
FillChar(rgb_green, SizeOf(rgb_green), 0);
FillChar(rgb_blue, SizeOf(rgb_blue), 0);
FillChar(rgb_alpha, SizeOf(rgb_alpha), 0);
end;
 
procedure TDXTextureImage.SetImage(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes, NextLine: Integer;
PBits, TopPBits: Pointer; Size: Integer; AutoFree: Boolean);
begin
ClearImage;
 
FAutoFreeImage := AutoFree;
FImageType := ImageType;
FWidth := Width;
FHeight := Height;
FBitCount := BitCount;
FWidthBytes := WidthBytes;
FNextLine := NextLine;
FSize := Size;
FPBits := PBits;
FTopPBits := TopPBits;
end;
 
procedure TDXTextureImage.SetSize(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes: Integer);
var
APBits: Pointer;
begin
ClearImage;
 
if WidthBytes = 0 then
WidthBytes := GetWidthBytes(Width, BitCount);
 
GetMem(APBits, WidthBytes * Height);
SetImage(ImageType, Width, Height, BitCount, WidthBytes,
WidthBytes, APBits, APBits, WidthBytes * Height, True);
end;
 
function TDXTextureImage.GetScanLine(y: Integer): Pointer;
begin
Result := Pointer(Integer(FTopPBits) + FNextLine * y);
end;
 
function TDXTextureImage.GetSubGroupImageCount(GroupTypeID: DWORD): Integer;
var
i: Integer;
begin
Result := 0;
for i := 0 to SubImageCount - 1 do
if SubImages[i].ImageGroupType = GroupTypeID then
Inc(Result);
end;
 
function TDXTextureImage.GetSubGroupImage(GroupTypeID: DWORD; Index: Integer): TDXTextureImage;
var
i, j: Integer;
begin
j := 0;
for i := 0 to SubImageCount - 1 do
if SubImages[i].ImageGroupType = GroupTypeID then
begin
if j = Index then
begin
Result := SubImages[i];
Exit;
end;
 
Inc(j);
end;
 
Result := nil;
SubImages[-1];
end;
 
function TDXTextureImage.GetSubImageCount: Integer;
begin
Result := 0;
if Assigned(FSubImage) then
Result := FSubImage.Count;
end;
 
function TDXTextureImage.GetSubImage(Index: Integer): TDXTextureImage;
begin
Result := FSubImage[Index];
end;
 
function TDXTextureImage.EncodeColor(R, G, B, A: Byte): DWORD;
begin
if ImageType = DXTextureImageType_PaletteIndexedColor then
begin
Result := dxtEncodeChannel(idx_index, PaletteIndex(R, G, B)) or
dxtEncodeChannel(idx_alpha, A);
end
else
begin
Result := dxtEncodeChannel(rgb_red, R) or
dxtEncodeChannel(rgb_green, G) or
dxtEncodeChannel(rgb_blue, B) or
dxtEncodeChannel(rgb_alpha, A);
end;
end;
 
function TDXTextureImage.PaletteIndex(R, G, B: Byte): DWORD;
var
i, d, d2: Integer;
begin
Result := 0;
if ImageType = DXTextureImageType_PaletteIndexedColor then
begin
d := MaxInt;
for i := 0 to (1 shl idx_index.BitCount) - 1 do
with idx_palette[i] do
begin
d2 := Abs((peRed - R)) * Abs((peRed - R)) + Abs((peGreen - G)) * Abs((peGreen - G)) + Abs((peBlue - B)) * Abs((peBlue - B));
if d > d2 then
begin
d := d2;
Result := i;
end;
end;
end;
end;
 
const
Mask1: array[0..7] of DWORD = (1, 2, 4, 8, 16, 32, 64, 128);
Mask2: array[0..3] of DWORD = (3, 12, 48, 192);
Mask4: array[0..1] of DWORD = ($0F, $F0);
 
Shift1: array[0..7] of DWORD = (0, 1, 2, 3, 4, 5, 6, 7);
Shift2: array[0..3] of DWORD = (0, 2, 4, 6);
Shift4: array[0..1] of DWORD = (0, 4);
 
type
PByte3 = ^TByte3;
TByte3 = array[0..2] of Byte;
 
function TDXTextureImage.GetPixel(x, y: Integer): DWORD;
begin
Result := 0;
if (x >= 0) and (x < FWidth) and (y >= 0) and (y < FHeight) then
begin
case FBitCount of
1: begin
if FPackedPixelOrder then
Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 3)^ and Mask1[7 - x and 7]) shr Shift1[7 - x and 7]
else
Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7];
end;
2: begin
if FPackedPixelOrder then
Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 2)^ and Mask2[3 - x and 3]) shr Shift2[3 - x and 3]
else
Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 2)^ and Mask2[x and 3]) shr Shift2[x and 3];
end;
4: begin
if FPackedPixelOrder then
Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 1)^ and Mask4[1 - x and 1]) shr Shift4[1 - x and 1]
else
Result := (PByte(Integer(FTopPBits) + FNextLine * y + x shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1];
end;
8: Result := PByte(Integer(FTopPBits) + FNextLine * y + x)^;
16: Result := PWord(Integer(FTopPBits) + FNextLine * y + x * 2)^;
24: PByte3(@Result)^ := PByte3(Integer(FTopPBits) + FNextLine * y + x * 3)^;
32: Result := PDWORD(Integer(FTopPBits) + FNextLine * y + x * 4)^;
end;
end;
end;
 
procedure TDXTextureImage.SetPixel(x, y: Integer; c: DWORD);
var
P: PByte;
begin
if (x >= 0) and (x < FWidth) and (y >= 0) and (y < FHeight) then
begin
case FBitCount of
1: begin
P := Pointer(Integer(FTopPBits) + FNextLine * y + x shr 3);
if FPackedPixelOrder then
P^ := (P^ and (not Mask1[7 - x and 7])) or ((c and 1) shl Shift1[7 - x and 7])
else
P^ := (P^ and (not Mask1[x and 7])) or ((c and 1) shl Shift1[x and 7]);
end;
2: begin
P := Pointer(Integer(FTopPBits) + FNextLine * y + x shr 2);
if FPackedPixelOrder then
P^ := (P^ and (not Mask2[3 - x and 3])) or ((c and 3) shl Shift2[3 - x and 3])
else
P^ := (P^ and (not Mask2[x and 3])) or ((c and 3) shl Shift2[x and 3]);
end;
4: begin
P := Pointer(Integer(FTopPBits) + FNextLine * y + x shr 1);
if FPackedPixelOrder then
P^ := (P^ and (not Mask4[1 - x and 1])) or ((c and 7) shl Shift4[1 - x and 1])
else
P^ := (P^ and (not Mask4[x and 1])) or ((c and 7) shl Shift4[x and 1]);
end;
8: PByte(Integer(FTopPBits) + FNextLine * y + x)^ := c;
16: PWord(Integer(FTopPBits) + FNextLine * y + x * 2)^ := c;
24: PByte3(Integer(FTopPBits) + FNextLine * y + x * 3)^ := PByte3(@c)^;
32: PDWORD(Integer(FTopPBits) + FNextLine * y + x * 4)^ := c;
end;
end;
end;
 
procedure TDXTextureImage.LoadFromFile(const FileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
 
procedure TDXTextureImage.LoadFromStream(Stream: TStream);
var
i, p: Integer;
begin
Clear;
 
p := Stream.Position;
for i := 0 to DXTextureImageLoadFuncList.Count - 1 do
begin
Stream.Position := p;
try
TDXTextureImageLoadFunc(DXTextureImageLoadFuncList[i])(Stream, Self);
Exit;
except
Clear;
end;
end;
 
raise EDXTextureImageError.Create(SNotSupportGraphicFile);
end;
 
procedure TDXTextureImage.SaveToFile(const FileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
 
procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage); forward;
 
procedure TDXTextureImage.SaveToStream(Stream: TStream);
begin
DXTextureImage_SaveDXTextureImageFunc(Stream, Self);
end;
 
{ DXTextureImage_LoadDXTextureImageFunc }
 
const
DXTextureImageFile_Type = 'dxt:';
DXTextureImageFile_Version = $100;
 
DXTextureImageCompress_None = 0;
DXTextureImageCompress_ZLIB = 1; // ZLIB enabled
 
DXTextureImageFileCategoryType_Image = $100;
 
DXTextureImageFileBlockID_EndFile = 0;
DXTextureImageFileBlockID_EndGroup = 1;
DXTextureImageFileBlockID_StartGroup = 2;
DXTextureImageFileBlockID_Image_Format = DXTextureImageFileCategoryType_Image + 1;
DXTextureImageFileBlockID_Image_PixelData = DXTextureImageFileCategoryType_Image + 2;
DXTextureImageFileBlockID_Image_GroupInfo = DXTextureImageFileCategoryType_Image + 3;
DXTextureImageFileBlockID_Image_Name = DXTextureImageFileCategoryType_Image + 4;
DXTextureImageFileBlockID_Image_TransparentColor = DXTextureImageFileCategoryType_Image + 5;
 
type
TDXTextureImageFileHeader = packed record
FileType: array[0..4] of Char;
ver: DWORD;
end;
 
TDXTextureImageFileBlockHeader = packed record
ID: DWORD;
Size: Integer;
end;
 
TDXTextureImageFileBlockHeader_StartGroup = packed record
CategoryType: DWORD;
end;
 
TDXTextureImageHeader_Image_Format = packed record
ImageType: TDXTextureImageType;
Width: DWORD;
Height: DWORD;
BitCount: DWORD;
WidthBytes: DWORD;
end;
 
TDXTextureImageHeader_Image_Format_Index = packed record
idx_index_Mask: DWORD;
idx_alpha_Mask: DWORD;
idx_palette: array[0..255] of TPaletteEntry;
end;
 
TDXTextureImageHeader_Image_Format_RGB = packed record
rgb_red_Mask: DWORD;
rgb_green_Mask: DWORD;
rgb_blue_Mask: DWORD;
rgb_alpha_Mask: DWORD;
end;
 
TDXTextureImageHeader_Image_GroupInfo = packed record
ImageGroupType: DWORD;
ImageID: DWORD;
end;
 
TDXTextureImageHeader_Image_PixelData = packed record
Compress: DWORD;
end;
 
TDXTextureImageHeader_Image_TransparentColor = packed record
Transparent: Boolean;
TransparentColor: DWORD;
end;
 
procedure DXTextureImage_LoadDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
 
procedure ReadGroup_Image(Image: TDXTextureImage);
var
i: Integer;
BlockHeader: TDXTextureImageFileBlockHeader;
NextPos: Integer;
SubImage: TDXTextureImage;
Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
Header_Image_Format: TDXTextureImageHeader_Image_Format;
Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
Header_Image_PixelData: TDXTextureImageHeader_Image_PixelData;
ImageName: string;
{$IFDEF DXTextureImage_UseZLIB}
Decompression: TDecompressionStream;
{$ENDIF}
begin
while True do
begin
Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
NextPos := Stream.Position + BlockHeader.Size;
 
case BlockHeader.ID of
DXTextureImageFileBlockID_EndGroup:
begin
{ End of group }
Break;
end;
DXTextureImageFileBlockID_StartGroup:
begin
{ Beginning of group }
Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
case Header_StartGroup.CategoryType of
DXTextureImageFileCategoryType_Image:
begin
{ Image group }
SubImage := TDXTextureImage.CreateSub(Image);
try
ReadGroup_Image(SubImage);
except
SubImage.Free;
raise;
end;
end;
end;
end;
DXTextureImageFileBlockID_Image_Format:
begin
{ Image information reading (size etc.) }
Stream.ReadBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
 
if (Header_Image_Format.ImageType <> DXTextureImageType_PaletteIndexedColor) and
(Header_Image_Format.ImageType <> DXTextureImageType_RGBColor)
then
raise EDXTextureImageError.Create(SInvalidDXTFile);
 
Image.SetSize(Header_Image_Format.ImageType, Header_Image_Format.Width, Header_Image_Format.Height,
Header_Image_Format.BitCount, Header_Image_Format.Widthbytes);
 
if Header_Image_Format.ImageType = DXTextureImageType_PaletteIndexedColor then
begin
{ INDEX IMAGE }
Stream.ReadBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
 
Image.idx_index := dxtMakeChannel(Header_Image_Format_Index.idx_index_Mask, True);
Image.idx_alpha := dxtMakeChannel(Header_Image_Format_Index.idx_alpha_Mask, False);
 
for i := 0 to 255 do
Image.idx_palette[i] := Header_Image_Format_Index.idx_palette[i];
end
else
if Header_Image_Format.ImageType = DXTextureImageType_RGBColor then
begin
{ RGB IMAGE }
Stream.ReadBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
 
Image.rgb_red := dxtMakeChannel(Header_Image_Format_RGB.rgb_red_Mask, False);
Image.rgb_green := dxtMakeChannel(Header_Image_Format_RGB.rgb_green_Mask, False);
Image.rgb_blue := dxtMakeChannel(Header_Image_Format_RGB.rgb_blue_Mask, False);
Image.rgb_alpha := dxtMakeChannel(Header_Image_Format_RGB.rgb_alpha_Mask, False);
end;
end;
DXTextureImageFileBlockID_Image_Name:
begin
{ Name reading }
SetLength(ImageName, BlockHeader.Size);
Stream.ReadBuffer(ImageName[1], BlockHeader.Size);
 
Image.ImageName := ImageName;
end;
DXTextureImageFileBlockID_Image_GroupInfo:
begin
{ Image group information reading }
Stream.ReadBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
 
Image.ImageGroupType := Header_Image_GroupInfo.ImageGroupType;
Image.ImageID := Header_Image_GroupInfo.ImageID;
end;
DXTextureImageFileBlockID_Image_TransparentColor:
begin
{ Transparent color information reading }
Stream.ReadBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
 
Image.Transparent := Header_Image_TransparentColor.Transparent;
Image.TransparentColor := Header_Image_TransparentColor.TransparentColor;
end;
DXTextureImageFileBlockID_Image_PixelData:
begin
{ Pixel data reading }
Stream.ReadBuffer(Header_Image_PixelData, SizeOf(Header_Image_PixelData));
 
case Header_Image_PixelData.Compress of
DXTextureImageCompress_None:
begin
{ NO compress }
for i := 0 to Image.Height - 1 do
Stream.ReadBuffer(Image.ScanLine[i]^, Header_Image_Format.Widthbytes);
end;
{$IFDEF DXTextureImage_UseZLIB}
DXTextureImageCompress_ZLIB:
begin
{ ZLIB compress enabled }
Decompression := TDecompressionStream.Create(Stream);
try
for i := 0 to Image.Height - 1 do
Decompression.ReadBuffer(Image.ScanLine[i]^, Header_Image_Format.Widthbytes);
finally
Decompression.Free;
end;
end;
{$ENDIF}
else
raise EDXTextureImageError.CreateFmt('Decompression error (%d)', [Header_Image_PixelData.Compress]);
end;
end;
 
end;
 
Stream.Seek(NextPos, soFromBeginning);
end;
end;
 
var
FileHeader: TDXTextureImageFileHeader;
BlockHeader: TDXTextureImageFileBlockHeader;
Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
NextPos: Integer;
begin
{ File header reading }
Stream.ReadBuffer(FileHeader, SizeOf(FileHeader));
 
if FileHeader.FileType <> DXTextureImageFile_Type then
raise EDXTextureImageError.Create(SInvalidDXTFile);
if FileHeader.ver <> DXTextureImageFile_Version then
raise EDXTextureImageError.Create(SInvalidDXTFile);
 
while True do
begin
Stream.ReadBuffer(BlockHeader, SizeOf(BlockHeader));
NextPos := Stream.Position + BlockHeader.Size;
 
case BlockHeader.ID of
DXTextureImageFileBlockID_EndFile:
begin
{ End of file }
Break;
end;
DXTextureImageFileBlockID_StartGroup:
begin
{ Beginning of group }
Stream.ReadBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
case Header_StartGroup.CategoryType of
DXTextureImageFileCategoryType_Image: ReadGroup_Image(Image);
end;
end;
end;
 
Stream.Seek(NextPos, soFromBeginning);
end;
end;
 
type
PDXTextureImageFileBlockHeaderWriter_BlockInfo = ^TDXTextureImageFileBlockHeaderWriter_BlockInfo;
TDXTextureImageFileBlockHeaderWriter_BlockInfo = record
BlockID: DWORD;
StreamPos: Integer;
end;
 
TDXTextureImageFileBlockHeaderWriter = class
private
FStream: TStream;
FList: TList;
public
constructor Create(Stream: TStream);
destructor Destroy; override;
procedure StartBlock(BlockID: DWORD);
procedure EndBlock;
procedure WriteBlock(BlockID: DWORD);
procedure StartGroup(CategoryType: DWORD);
procedure EndGroup;
end;
 
constructor TDXTextureImageFileBlockHeaderWriter.Create(Stream: TStream);
begin
inherited Create;
FStream := Stream;
FList := TList.Create;
end;
 
destructor TDXTextureImageFileBlockHeaderWriter.Destroy;
var
i: Integer;
begin
for i := 0 to FList.Count - 1 do
Dispose(PDXTextureImageFileBlockHeaderWriter_BlockInfo(FList[i]));
FList.Free;
inherited Destroy;
end;
 
procedure TDXTextureImageFileBlockHeaderWriter.StartBlock(BlockID: DWORD);
var
BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
BlockHeader: TDXTextureImageFileBlockHeader;
begin
New(BlockInfo);
BlockInfo.BlockID := BlockID;
BlockInfo.StreamPos := FStream.Position;
FList.Add(BlockInfo);
 
BlockHeader.ID := BlockID;
BlockHeader.Size := 0;
FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
end;
 
procedure TDXTextureImageFileBlockHeaderWriter.EndBlock;
var
BlockHeader: TDXTextureImageFileBlockHeader;
BlockInfo: PDXTextureImageFileBlockHeaderWriter_BlockInfo;
CurStreamPos: Integer;
begin
CurStreamPos := FStream.Position;
try
BlockInfo := FList[FList.Count - 1];
 
FStream.Position := BlockInfo.StreamPos;
BlockHeader.ID := BlockInfo.BlockID;
BlockHeader.Size := CurStreamPos - (BlockInfo.StreamPos + SizeOf(TDXTextureImageFileBlockHeader));
FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
finally
FStream.Position := CurStreamPos;
 
Dispose(FList[FList.Count - 1]);
FList.Count := FList.Count - 1;
end;
end;
 
procedure TDXTextureImageFileBlockHeaderWriter.WriteBlock(BlockID: DWORD);
var
BlockHeader: TDXTextureImageFileBlockHeader;
begin
BlockHeader.ID := BlockID;
BlockHeader.Size := 0;
FStream.WriteBuffer(BlockHeader, SizeOf(BlockHeader));
end;
 
procedure TDXTextureImageFileBlockHeaderWriter.StartGroup(CategoryType: DWORD);
var
Header_StartGroup: TDXTextureImageFileBlockHeader_StartGroup;
begin
StartBlock(DXTextureImageFileBlockID_StartGroup);
 
Header_StartGroup.CategoryType := CategoryType;
FStream.WriteBuffer(Header_StartGroup, SizeOf(Header_StartGroup));
end;
 
procedure TDXTextureImageFileBlockHeaderWriter.EndGroup;
begin
WriteBlock(DXTextureImageFileBlockID_EndGroup);
EndBlock;
end;
 
procedure DXTextureImage_SaveDXTextureImageFunc(Stream: TStream; Image: TDXTextureImage);
var
Progress: Integer;
ProgressCount: Integer;
BlockHeaderWriter: TDXTextureImageFileBlockHeaderWriter;
 
function CalcProgressCount(Image: TDXTextureImage): Integer;
var
i: Integer;
begin
Result := Image.WidthBytes * Image.Height;
for i := 0 to Image.SubImageCount - 1 do
Inc(Result, CalcProgressCount(Image.SubImages[i]));
end;
 
procedure AddProgress(Count: Integer);
begin
Inc(Progress, Count);
Image.DoSaveProgress(Progress, ProgressCount);
end;
 
procedure WriteGroup_Image(Image: TDXTextureImage);
var
i: Integer;
Header_Image_Format: TDXTextureImageHeader_Image_Format;
Header_Image_Format_Index: TDXTextureImageHeader_Image_Format_Index;
Header_Image_Format_RGB: TDXTextureImageHeader_Image_Format_RGB;
Header_Image_GroupInfo: TDXTextureImageHeader_Image_GroupInfo;
Header_Image_TransparentColor: TDXTextureImageHeader_Image_TransparentColor;
Header_Image_PixelData: TDXTextureImageHeader_Image_PixelData;
{$IFDEF DXTextureImage_UseZLIB}
Compression: TCompressionStream;
{$ENDIF}
begin
BlockHeaderWriter.StartGroup(DXTextureImageFileCategoryType_Image);
try
{ Image format writing }
if Image.Size > 0 then
begin
Header_Image_Format.ImageType := Image.ImageType;
Header_Image_Format.Width := Image.Width;
Header_Image_Format.Height := Image.Height;
Header_Image_Format.BitCount := Image.BitCount;
Header_Image_Format.WidthBytes := Image.WidthBytes;
 
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Format);
try
Stream.WriteBuffer(Header_Image_Format, SizeOf(Header_Image_Format));
 
case Image.ImageType of
DXTextureImageType_PaletteIndexedColor:
begin
{ INDEX IMAGE }
Header_Image_Format_Index.idx_index_Mask := Image.idx_index.Mask;
Header_Image_Format_Index.idx_alpha_Mask := Image.idx_alpha.Mask;
for i := 0 to 255 do
Header_Image_Format_Index.idx_palette[i] := Image.idx_palette[i];
 
Stream.WriteBuffer(Header_Image_Format_Index, SizeOf(Header_Image_Format_Index));
end;
DXTextureImageType_RGBColor:
begin
{ RGB IMAGE }
Header_Image_Format_RGB.rgb_red_Mask := Image.rgb_red.Mask;
Header_Image_Format_RGB.rgb_green_Mask := Image.rgb_green.Mask;
Header_Image_Format_RGB.rgb_blue_Mask := Image.rgb_blue.Mask;
Header_Image_Format_RGB.rgb_alpha_Mask := Image.rgb_alpha.Mask;
 
Stream.WriteBuffer(Header_Image_Format_RGB, SizeOf(Header_Image_Format_RGB));
end;
end;
finally
BlockHeaderWriter.EndBlock;
end;
end;
 
{ Image group information writing }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_GroupInfo);
try
Header_Image_GroupInfo.ImageGroupType := Image.ImageGroupType;
Header_Image_GroupInfo.ImageID := Image.ImageID;
 
Stream.WriteBuffer(Header_Image_GroupInfo, SizeOf(Header_Image_GroupInfo));
finally
BlockHeaderWriter.EndBlock;
end;
 
{ Name writing }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_Name);
try
Stream.WriteBuffer(Image.ImageName[1], Length(Image.ImageName));
finally
BlockHeaderWriter.EndBlock;
end;
 
{ Transparent color writing }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_TransparentColor);
try
Header_Image_TransparentColor.Transparent := Image.Transparent;
Header_Image_TransparentColor.TransparentColor := Image.TransparentColor;
 
Stream.WriteBuffer(Header_Image_TransparentColor, SizeOf(Header_Image_TransparentColor));
finally
BlockHeaderWriter.EndBlock;
end;
 
{ Pixel data writing }
if Image.Size > 0 then
begin
{ Writing start }
BlockHeaderWriter.StartBlock(DXTextureImageFileBlockID_Image_PixelData);
try
{ Scan compress type }
case Image.FileCompressType of
DXTextureImageFileCompressType_None:
begin
Header_Image_PixelData.Compress := DXTextureImageCompress_None;
end;
{$IFDEF DXTextureImage_UseZLIB}
DXTextureImageFileCompressType_ZLIB:
begin
Header_Image_PixelData.Compress := DXTextureImageCompress_ZLIB;
end;
{$ENDIF}
else
Header_Image_PixelData.Compress := DXTextureImageCompress_None;
end;
 
Stream.WriteBuffer(Header_Image_PixelData, SizeOf(Header_Image_PixelData));
 
case Header_Image_PixelData.Compress of
DXTextureImageCompress_None:
begin
for i := 0 to Image.Height - 1 do
begin
Stream.WriteBuffer(Image.ScanLine[i]^, Image.Widthbytes);
AddProgress(Image.Widthbytes);
end;
end;
{$IFDEF DXTextureImage_UseZLIB}
DXTextureImageCompress_ZLIB:
begin
Compression := TCompressionStream.Create(clMax, Stream);
try
for i := 0 to Image.Height - 1 do
begin
Compression.WriteBuffer(Image.ScanLine[i]^, Image.WidthBytes);
AddProgress(Image.Widthbytes);
end;
finally
Compression.Free;
end;
end;
{$ENDIF}
end;
finally
BlockHeaderWriter.EndBlock;
end;
end;
 
{ Sub-image writing }
for i := 0 to Image.SubImageCount - 1 do
WriteGroup_Image(Image.SubImages[i]);
finally
BlockHeaderWriter.EndGroup;
end;
end;
 
var
FileHeader: TDXTextureImageFileHeader;
begin
Progress := 0;
ProgressCount := CalcProgressCount(Image);
 
{ File header writing }
FileHeader.FileType := DXTextureImageFile_Type;
FileHeader.ver := DXTextureImageFile_Version;
Stream.WriteBuffer(FileHeader, SizeOf(FileHeader));
 
{ Image writing }
BlockHeaderWriter := TDXTextureImageFileBlockHeaderWriter.Create(Stream);
try
{ Image writing }
WriteGroup_Image(Image);
 
{ End of file }
BlockHeaderWriter.WriteBlock(DXTextureImageFileBlockID_EndFile);
finally
BlockHeaderWriter.Free;
end;
end;
 
{ DXTextureImage_LoadBitmapFunc }
 
procedure DXTextureImage_LoadBitmapFunc(Stream: TStream; Image: TDXTextureImage);
type
TDIBPixelFormat = packed record
RBitMask, GBitMask, BBitMask: DWORD;
end;
var
TopDown: Boolean;
BF: TBitmapFileHeader;
BI: TBitmapInfoHeader;
 
procedure DecodeRGB;
var
y: Integer;
begin
for y := 0 to Image.Height - 1 do
begin
if TopDown then
Stream.ReadBuffer(Image.ScanLine[y]^, Image.WidthBytes)
else
Stream.ReadBuffer(Image.ScanLine[Image.Height - y - 1]^, Image.WidthBytes);
end;
end;
 
procedure DecodeRLE4;
var
SrcDataP: Pointer;
B1, B2, C: Byte;
Dest, Src, P: PByte;
X, Y, i: Integer;
begin
GetMem(SrcDataP, BI.biSizeImage);
try
Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
 
Dest := Image.TopPBits;
Src := SrcDataP;
X := 0;
Y := 0;
 
while True do
begin
B1 := Src^; Inc(Src);
B2 := Src^; Inc(Src);
 
if B1 = 0 then
begin
case B2 of
0: begin { End of line }
X := 0; Inc(Y);
Dest := Image.ScanLine[Y];
end;
1: Break; { End of bitmap }
2: begin { Difference of coordinates }
Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
Dest := Image.ScanLine[Y];
end;
else
{ Absolute mode }
C := 0;
for i := 0 to B2 - 1 do
begin
if i and 1 = 0 then
begin
C := Src^; Inc(Src);
end
else
begin
C := C shl 4;
end;
 
P := Pointer(Integer(Dest) + X shr 1);
if X and 1 = 0 then
P^ := (P^ and $0F) or (C and $F0)
else
P^ := (P^ and $F0) or ((C and $F0) shr 4);
 
Inc(X);
end;
end;
end
else
begin
{ Encoding mode }
for i := 0 to B1 - 1 do
begin
P := Pointer(Integer(Dest) + X shr 1);
if X and 1 = 0 then
P^ := (P^ and $0F) or (B2 and $F0)
else
P^ := (P^ and $F0) or ((B2 and $F0) shr 4);
 
Inc(X);
 
// Swap nibble
B2 := (B2 shr 4) or (B2 shl 4);
end;
end;
 
{ Word arrangement }
Inc(Src, Longint(Src) and 1);
end;
finally
FreeMem(SrcDataP);
end;
end;
 
procedure DecodeRLE8;
var
SrcDataP: Pointer;
B1, B2: Byte;
Dest, Src: PByte;
X, Y: Integer;
begin
GetMem(SrcDataP, BI.biSizeImage);
try
Stream.ReadBuffer(SrcDataP^, BI.biSizeImage);
 
Dest := Image.TopPBits;
Src := SrcDataP;
X := 0;
Y := 0;
 
while True do
begin
B1 := Src^; Inc(Src);
B2 := Src^; Inc(Src);
 
if B1 = 0 then
begin
case B2 of
0: begin { End of line }
X := 0; Inc(Y);
Dest := Pointer(Longint(Image.TopPBits) + Y * Image.NextLine + X);
end;
1: Break; { End of bitmap }
2: begin { Difference of coordinates }
Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
Dest := Pointer(Longint(Image.TopPBits) + Y * Image.NextLine + X);
end;
else
{ Absolute mode }
Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
end;
end
else
begin
{ Encoding mode }
FillChar(Dest^, B1, B2); Inc(Dest, B1);
end;
 
{ Word arrangement }
Inc(Src, Longint(Src) and 1);
end;
finally
FreeMem(SrcDataP);
end;
end;
 
var
BC: TBitmapCoreHeader;
RGBTriples: array[0..255] of TRGBTriple;
RGBQuads: array[0..255] of TRGBQuad;
i, PalCount, j: Integer;
OS2: Boolean;
PixelFormat: TDIBPixelFormat;
begin
{ File header reading }
i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
if i = 0 then Exit;
if i <> SizeOf(TBitmapFileHeader) then
raise EDXTextureImageError.Create(SInvalidDIB);
 
{ Is the head 'BM'? }
if BF.bfType <> Ord('B') + Ord('M') * $100 then
raise EDXTextureImageError.Create(SInvalidDIB);
 
{ Reading of size of header }
i := Stream.Read(BI.biSize, 4);
if i <> 4 then
raise EDXTextureImageError.Create(SInvalidDIB);
 
{ Kind check of DIB }
OS2 := False;
 
case BI.biSize of
SizeOf(TBitmapCoreHeader):
begin
{ OS/2 type }
Stream.ReadBuffer(Pointer(Integer(@BC) + 4)^, SizeOf(TBitmapCoreHeader) - 4);
 
FilLChar(BI, SizeOf(BI), 0);
with BI do
begin
biClrUsed := 0;
biCompression := BI_RGB;
biBitCount := BC.bcBitCount;
biHeight := BC.bcHeight;
biWidth := BC.bcWidth;
end;
 
OS2 := True;
end;
SizeOf(TBitmapInfoHeader):
begin
{ Windows type }
Stream.ReadBuffer(Pointer(Integer(@BI) + 4)^, SizeOf(TBitmapInfoHeader) - 4);
end;
else
raise EDXTextureImageError.Create(SInvalidDIB);
end;
 
{ Bit mask reading }
if BI.biCompression = BI_BITFIELDS then
begin
Stream.ReadBuffer(PixelFormat, SizeOf(PixelFormat));
end
else
begin
if BI.biBitCount = 16 then
begin
PixelFormat.RBitMask := $7C00;
PixelFormat.GBitMask := $03E0;
PixelFormat.BBitMask := $001F;
end else if (BI.biBitCount = 24) or (BI.biBitCount = 32) then
begin
PixelFormat.RBitMask := $00FF0000;
PixelFormat.GBitMask := $0300FF00;
PixelFormat.BBitMask := $000000FF;
end;
end;
 
{ DIB making }
if BI.biHeight < 0 then
begin
BI.biHeight := -BI.biHeight;
TopDown := True;
end
else
TopDown := False;
 
if BI.biBitCount in [1, 4, 8] then
begin
Image.SetSize(DXTextureImageType_PaletteIndexedColor, BI.biWidth, BI.biHeight, BI.biBitCount,
(((BI.biWidth * BI.biBitCount) + 31) div 32) * 4);
 
Image.idx_index := dxtMakeChannel(1 shl BI.biBitCount - 1, True);
Image.PackedPixelOrder := True;
end
else
begin
Image.SetSize(DXTextureImageType_RGBColor, BI.biWidth, BI.biHeight, BI.biBitCount,
(((BI.biWidth * BI.biBitCount) + 31) div 32) * 4);
 
Image.rgb_red := dxtMakeChannel(PixelFormat.RBitMask, False);
Image.rgb_green := dxtMakeChannel(PixelFormat.GBitMask, False);
Image.rgb_blue := dxtMakeChannel(PixelFormat.BBitMask, False);
 
j := Image.rgb_red.BitCount + Image.rgb_green.BitCount + Image.rgb_blue.BitCount;
if j < BI.biBitCount then
Image.rgb_alpha := dxtMakeChannel((1 shl (BI.biBitCount - j) - 1) shl j, False);
 
Image.PackedPixelOrder := False;
end;
 
{ palette reading }
PalCount := BI.biClrUsed;
if (PalCount = 0) and (BI.biBitCount <= 8) then
PalCount := 1 shl BI.biBitCount;
if PalCount > 256 then PalCount := 256;
 
if OS2 then
begin
{ OS/2 type }
Stream.ReadBuffer(RGBTriples, SizeOf(TRGBTriple) * PalCount);
for i := 0 to PalCount - 1 do
begin
Image.idx_palette[i].peRed := RGBTriples[i].rgbtRed;
Image.idx_palette[i].peGreen := RGBTriples[i].rgbtGreen;
Image.idx_palette[i].peBlue := RGBTriples[i].rgbtBlue;
end;
end
else
begin
{ Windows type }
Stream.ReadBuffer(RGBQuads, SizeOf(TRGBQuad) * PalCount);
for i := 0 to PalCount - 1 do
begin
Image.idx_palette[i].peRed := RGBQuads[i].rgbRed;
Image.idx_palette[i].peGreen := RGBQuads[i].rgbGreen;
Image.idx_palette[i].peBlue := RGBQuads[i].rgbBlue;
end;
end;
 
{ Pixel data reading }
case BI.biCompression of
BI_RGB: DecodeRGB;
BI_BITFIELDS: DecodeRGB;
BI_RLE4: DecodeRLE4;
BI_RLE8: DecodeRLE8;
else
raise EDXTextureImageError.Create(SInvalidDIB);
end;
end;
 
{ TDXTBase }
 
//Note by JB.
//This class is supplement of original Hori's code.
//For use alphablend you can have a bitmap 32 bit RGBA
//when isn't alphachannel present, it works like RGB 24bit
 
//functions required actualized DIB source for works with alphachannel
 
function TDXTBase.GetCompression: TDXTextureImageFileCompressType;
begin
Result := FParamsFormat.Compress;
end;
 
procedure TDXTBase.SetCompression(const Value: TDXTextureImageFileCompressType);
begin
FParamsFormat.Compress := Value;
end;
 
function TDXTBase.GetWidth: Integer;
begin
Result := FParamsFormat.Width;
end;
 
procedure TDXTBase.SetWidth(const Value: Integer);
begin
FParamsFormat.Width := Value;
end;
 
function TDXTBase.GetMipmap: Integer;
begin
Result := FParamsFormat.MipmapCount;
end;
 
procedure TDXTBase.SetMipmap(const Value: Integer);
begin
if Value = -1 then
FParamsFormat.MipmapCount := MaxInt
else
FParamsFormat.MipmapCount := Value;
end;
 
function TDXTBase.GetTransparentColor: TColorRef;
begin
Result := FParamsFormat.TransparentColor;
end;
 
procedure TDXTBase.SetTransparentColor(const Value: TColorRef);
begin
FParamsFormat.Transparent := True;
FParamsFormat.TransparentColor := RGB(Value shr 16, Value shr 8, Value);
end;
 
procedure TDXTBase.SetTransparentColorIndexed(const Value: TColorRef);
begin
FParamsFormat.TransparentColor := PaletteIndex(Value);
end;
 
function TDXTBase.GetHeight: Integer;
begin
Result := FParamsFormat.Height;
end;
 
procedure TDXTBase.SetHeight(const Value: Integer);
begin
FParamsFormat.Height := Value;
end;
 
procedure TDXTBase.SetChannelY(T: TDIB);
begin
 
end;
 
procedure TDXTBase.LoadChannelRGBFromFile(const FileName: string);
begin
FStrImageFileName := FileName;
try
EvaluateChannels([rgbRed, rgbGreen, rgbBlue], '', '');
finally
FStrImageFileName := '';
end;
end;
 
function TDXTBase.LoadFromFile(iFilename: string): Boolean;
begin
Result := FileExists(iFilename);
if Result then
try
Texture.LoadFromFile(iFileName);
except
Result := False;
end;
end;
 
procedure TDXTBase.LoadChannelAFromFile(const FileName: string);
begin
FStrImageFileName := FileName;
try
EvaluateChannels([rgbAlpha], '', '');
finally
FStrImageFileName := '';
end;
end;
 
constructor TDXTBase.Create;
var
Channel: TDXTImageChannel;
begin
FillChar(Channel, SizeOf(Channel), 0);
FilLChar(FParamsFormat, SizeOf(FParamsFormat), 0);
FParamsFormat.Compress := DXTextureImageFileCompressType_None;
FHasImageList := TList.Create;
for Channel := Low(Channel) to High(Channel) do
FChannelChangeTable[Channel] := Channel;
FChannelChangeTable[rgbAlpha] := yuvY;
FDIB := nil;
FStrImageFileName := '';
end;
 
procedure TDXTBase.SetChannelRGBA(T: TDIB);
begin
FDIB := T;
try
EvaluateChannels([rgbRed, rgbGreen, rgbBlue, rgbAlpha], '', '');
finally
FDIB := nil;
end;
end;
 
procedure TDXTBase.BuildImage(Image: TDXTextureImage);
type
TOutputImageChannelInfo2 = record
Image: TDXTextureImage;
Channels: TDXTImageChannels;
end;
var
cR, cG, cB: Byte;
 
function GetChannelVal(const Channel: TDXTextureImageChannel; SrcChannel: TDXTImageChannel): DWORD;
begin
case SrcChannel of
rgbRed: Result := dxtEncodeChannel(Channel, cR);
rgbGreen: Result := dxtEncodeChannel(Channel, cG);
rgbBlue: Result := dxtEncodeChannel(Channel, cB);
yuvY: Result := dxtEncodeChannel(Channel, (cR * 306 + cG * 602 + cB * 116) div 1024);
else Result := 0;
end;
end;
 
var
HasImageChannelList: array[0..Ord(High(TDXTImageChannel)) + 1] of TOutputImageChannelInfo2;
HasImageChannelListCount: Integer;
x, y, i: Integer;
c, c2, c3: DWORD;
Channel: TDXTImageChannel;
Flag: Boolean;
 
SrcImage: TDXTextureImage;
UseChannels: TDXTImageChannels;
begin
HasImageChannelListCount := 0;
for Channel := Low(Channel) to High(Channel) do
if Channel in FHasChannels then
begin
Flag := False;
for i := 0 to HasImageChannelListCount - 1 do
if HasImageChannelList[i].Image = FHasChannelImages[Channel].Image then
begin
HasImageChannelList[i].Channels := HasImageChannelList[i].Channels + [Channel];
Flag := True;
Break;
end;
if not Flag then
begin
HasImageChannelList[HasImageChannelListCount].Image := FHasChannelImages[Channel].Image;
HasImageChannelList[HasImageChannelListCount].Channels := [Channel];
Inc(HasImageChannelListCount);
end;
end;
 
cR := 0;
cG := 0;
cB := 0;
 
if Image.ImageType = DXTextureImageType_PaletteIndexedColor then
begin
{ Index color }
for y := 0 to Image.Height - 1 do
for x := 0 to Image.Width - 1 do
begin
c := 0;
 
for i := 0 to HasImageChannelListCount - 1 do
begin
SrcImage := HasImageChannelList[i].Image;
UseChannels := HasImageChannelList[i].Channels;
 
case SrcImage.ImageType of
DXTextureImageType_PaletteIndexedColor:
begin
c2 := SrcImage.Pixels[x, y];
c3 := dxtDecodeChannel(SrcImage.idx_index, c2);
 
if rgbRed in UseChannels then
c := c or dxtEncodeChannel(Image.idx_index, c3);
 
cR := SrcImage.idx_palette[c3].peRed;
cG := SrcImage.idx_palette[c3].peGreen;
cB := SrcImage.idx_palette[c3].peBlue;
end;
DXTextureImageType_RGBColor:
begin
c2 := SrcImage.Pixels[x, y];
 
cR := dxtDecodeChannel(SrcImage.rgb_red, c2);
cG := dxtDecodeChannel(SrcImage.rgb_green, c2);
cB := dxtDecodeChannel(SrcImage.rgb_blue, c2);
end;
end;
 
if rgbAlpha in UseChannels then
c := c or GetChannelVal(Image.idx_alpha, FChannelChangeTable[rgbAlpha]);
end;
 
Image.Pixels[x, y] := c;
end;
end
else
if Image.ImageType = DXTextureImageType_RGBColor then
begin
{ RGB color }
for y := 0 to Image.Height - 1 do
for x := 0 to Image.Width - 1 do
begin
c := 0;
 
for i := 0 to HasImageChannelListCount - 1 do
begin
SrcImage := HasImageChannelList[i].Image;
UseChannels := HasImageChannelList[i].Channels;
 
case SrcImage.ImageType of
DXTextureImageType_PaletteIndexedColor:
begin
c2 := SrcImage.Pixels[x, y];
c3 := dxtDecodeChannel(SrcImage.idx_index, c2);
 
cR := SrcImage.idx_palette[c3].peRed;
cG := SrcImage.idx_palette[c3].peGreen;
cB := SrcImage.idx_palette[c3].peBlue;
end;
DXTextureImageType_RGBColor:
begin
c2 := SrcImage.Pixels[x, y];
 
cR := dxtDecodeChannel(SrcImage.rgb_red, c2);
cG := dxtDecodeChannel(SrcImage.rgb_green, c2);
cB := dxtDecodeChannel(SrcImage.rgb_blue, c2);
end;
end;
 
if rgbRed in UseChannels then
c := c or GetChannelVal(Image.rgb_red, FChannelChangeTable[rgbRed]);
if rgbGreen in UseChannels then
c := c or GetChannelVal(Image.rgb_green, FChannelChangeTable[rgbGreen]);
if rgbBlue in UseChannels then
c := c or GetChannelVal(Image.rgb_Blue, FChannelChangeTable[rgbBlue]);
if rgbAlpha in UseChannels then
c := c or GetChannelVal(Image.rgb_alpha, FChannelChangeTable[rgbAlpha]);
end;
 
Image.Pixels[x, y] := c;
end;
end;
end;
 
procedure TDXTBase.SetChannelR(T: TDIB);
begin
FDIB := T;
try
EvaluateChannels([rgbRed], '', '');
finally
FDIB := nil;
end;
end;
 
function GetBitCount(b: Integer): Integer;
begin
Result := 32;
while (Result > 0) and (((1 shl (Result - 1)) and b) = 0) do Dec(Result);
end;
 
procedure TDXTBase.CalcOutputBitFormat;
var
BitCount: DWORD;
NewWidth, NewHeight, i, j: Integer;
Channel: TDXTImageChannel;
begin
{ Size calculation }
NewWidth := 1 shl GetBitCount(TDXTextureImage(FHasImageList[0]).Width);
NewHeight := 1 shl GetBitCount(TDXTextureImage(FHasImageList[0]).Height);
NewWidth := Max(NewWidth, NewHeight);
NewHeight := NewWidth;
if Abs(FParamsFormat.Width - NewWidth) > Abs(FParamsFormat.Width - NewWidth div 2) then
NewWidth := NewWidth div 2;
if Abs(FParamsFormat.Height - NewHeight) > Abs(FParamsFormat.Height - NewHeight div 2) then
NewHeight := NewHeight div 2;
 
if FParamsFormat.Width = 0 then FParamsFormat.Width := NewWidth;
if FParamsFormat.Height = 0 then FParamsFormat.Height := NewHeight;
 
{ Other several calculation }
i := Min(FParamsFormat.Width, FParamsFormat.Height);
j := 0;
while i > 1 do
begin
i := i div 2;
Inc(j);
end;
 
FParamsFormat.MipmapCount := Min(j, FParamsFormat.MipmapCount);
 
{ Output type calculation }
if (FHasChannelImages[rgbRed].Image = FHasChannelImages[rgbGreen].Image) and
(FHasChannelImages[rgbRed].Image = FHasChannelImages[rgbBlue].Image) and
(FHasChannelImages[rgbRed].Image <> nil) and
(FHasChannelImages[rgbRed].Image.ImageType = DXTextureImageType_PaletteIndexedColor) and
 
(FHasChannelImages[rgbRed].BitCount = 8) and
(FHasChannelImages[rgbGreen].BitCount = 8) and
(FHasChannelImages[rgbBlue].BitCount = 8) and
 
(FChannelChangeTable[rgbRed] = rgbRed) and
(FChannelChangeTable[rgbGreen] = rgbGreen) and
(FChannelChangeTable[rgbBlue] = rgbBlue) and
 
(FParamsFormat.Width = FHasChannelImages[rgbRed].Image.Width) and
(FParamsFormat.Height = FHasChannelImages[rgbRed].Image.Height) and
 
(FParamsFormat.MipmapCount = 0)
then
begin
FParamsFormat.ImageType := DXTextureImageType_PaletteIndexedColor;
end
else
FParamsFormat.ImageType := DXTextureImageType_RGBColor;
 
{ Bit several calculations }
FParamsFormat.BitCount := 0;
 
for Channel := Low(TDXTImageChannel) to High(TDXTImageChannel) do
if (FHasChannelImages[Channel].Image <> nil) and (FHasChannelImages[Channel].Image.ImageType = DXTextureImageType_PaletteIndexedColor) then
begin
FParamsFormat.idx_palette := FHasChannelImages[Channel].Image.idx_palette;
Break;
end;
 
if FParamsFormat.ImageType = DXTextureImageType_PaletteIndexedColor then
begin
{ Index channel }
if rgbRed in FHasChannels then
begin
BitCount := FHasChannelImages[rgbRed].BitCount;
FParamsFormat.idx_index := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, True);
Inc(FParamsFormat.BitCount, BitCount);
end;
 
{ Alpha channel }
if rgbAlpha in FHasChannels then
begin
BitCount := FHasChannelImages[rgbAlpha].BitCount;
FParamsFormat.idx_alpha := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
Inc(FParamsFormat.BitCount, BitCount);
end;
end
else
begin
{ B channel }
if rgbBlue in FHasChannels then
begin
BitCount := FHasChannelImages[rgbBlue].BitCount;
FParamsFormat.rgb_blue := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
Inc(FParamsFormat.BitCount, BitCount);
end;
 
{ G channel }
if rgbGreen in FHasChannels then
begin
BitCount := FHasChannelImages[rgbGreen].BitCount;
FParamsFormat.rgb_green := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
Inc(FParamsFormat.BitCount, BitCount);
end;
 
{ R channel }
if rgbRed in FHasChannels then
begin
BitCount := FHasChannelImages[rgbRed].BitCount;
FParamsFormat.rgb_red := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
Inc(FParamsFormat.BitCount, BitCount);
end;
 
{ Alpha channel }
if rgbAlpha in FHasChannels then
begin
BitCount := FHasChannelImages[rgbAlpha].BitCount;
FParamsFormat.rgb_alpha := dxtMakeChannel(((1 shl BitCount) - 1) shl FParamsFormat.BitCount, False);
Inc(FParamsFormat.BitCount, BitCount);
end;
end;
 
{ As for the number of bits only either of 1, 2, 4, 8, 16, 24, 32 }
if FParamsFormat.BitCount in [3] then
FParamsFormat.BitCount := 4
else
if FParamsFormat.BitCount in [5..7] then
FParamsFormat.BitCount := 8
else
if FParamsFormat.BitCount in [9..15] then
FParamsFormat.BitCount := 16
else
if FParamsFormat.BitCount in [17..23] then
FParamsFormat.BitCount := 24
else
if FParamsFormat.BitCount in [25..31] then
FParamsFormat.BitCount := 32;
 
{ Transparent color }
if (FParamsFormat.ImageType = DXTextureImageType_RGBColor) and (FParamsFormat.TransparentColor shr 24 = $01) then
begin
FParamsFormat.TransparentColor := RGB(FParamsFormat.idx_palette[Byte(FParamsFormat.TransparentColor)].peRed,
FParamsFormat.idx_palette[Byte(FParamsFormat.TransparentColor)].peGreen,
FParamsFormat.idx_palette[Byte(FParamsFormat.TransparentColor)].peBlue);
end;
end;
 
procedure TDXTBase.LoadChannelRGBAFromFile(const FileName: string);
begin
FStrImageFileName := FileName;
try
EvaluateChannels([rgbRed, rgbGreen, rgbBlue, rgbAlpha], '', '');
finally
FStrImageFileName := '';
end;
end;
 
procedure TDXTBase.SetChannelB(T: TDIB);
begin
FDIB := T;
try
EvaluateChannels([rgbBlue], '', '');
finally
FDIB := nil;
end;
end;
 
procedure TDXTBase.SetChannelRGB(T: TDIB);
begin
FDIB := T;
try
EvaluateChannels([rgbRed, rgbGreen, rgbBlue], '', '');
finally
FDIB := nil;
end;
end;
 
procedure TDXTBase.SaveToFile(iFilename: string {$IFDEF VER4UP} = ''{$ENDIF});
var
Image: TDXTextureImage;
begin
{ Create output stream }
Image := Self.Texture;
if (FHasImageList.Count > 0) and Assigned(Image) then
begin
if iFilename <> '' then
Image.SaveToFile(iFilename)
else
Image.SaveToFile(FParamsFormat.Name + '.dxt');
end;
end;
 
procedure TDXTBase.SetChannelA(T: TDIB);
begin
FDIB := T;
try
EvaluateChannels([rgbAlpha], '', '');
finally
FDIB := nil;
end;
end;
 
procedure TDXTBase.SetChannelG(T: TDIB);
begin
FDIB := T;
try
EvaluateChannels([rgbGreen], '', '');
finally
FDIB := nil;
end;
end;
 
destructor TDXTBase.Destroy;
var I: Integer;
begin
for I := 0 to FHasImageList.Count - 1 do
TDXTextureImage(FHasImageList[I]).Free;
FHasImageList.Free;
inherited Destroy;
end;
 
function TDXTBase.GetPicture: TDXTextureImage;
var
MemoryStream: TMemoryStream;
begin
Result := TDXTextureImage.Create;
try
if (FStrImageFileName <> '') and FileExists(FStrImageFileName) then
begin
Result.LoadFromFile(FStrImageFileName);
Result.FImageName := ExtractFilename(FStrImageFileName);
end
else
if Assigned(FDIB) then
begin
MemoryStream := TMemoryStream.Create;
try
FDIB.SaveToStream(MemoryStream);
MemoryStream.Position := 0; //reading from 0
Result.LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
end;
Result.FImageName := Format('DIB%x', [Integer(Result)]); //supplement name
end;
except
on E: Exception do
begin
EDXTBaseError.Create(E.Message);
end;
end
end;
 
procedure TDXTBase.Resize(Image: TDXTextureImage; NewWidth, NewHeight: Integer;
FilterTypeResample: TFilterTypeResample);
//resize used for Mipmap
var
DIB: TDIB;
x, y: Integer;
c: DWORD;
MemoryStream: TMemoryStream;
begin
{ Exit when no resize }
if (Image.Width = NewWidth) and (Image.Height = NewHeight) then Exit;
{ Supplement for image resizing }
//raise EDXTBaseError.Create('Invalid image size for texture.');
{ No image at start }
DIB := TDIB.Create; //DIB accept
try
DIB.SetSize(Image.Width, Image.Height, Image.BitCount);
{ of type }
for y := 0 to Image.Height - 1 do
for x := 0 to Image.Width - 1 do
begin
if Image.ImageType = DXTextureImageType_PaletteIndexedColor then
begin
c := dxtDecodeChannel(Image.idx_index, Image.Pixels[x, y]);
DIB.Pixels[x, y] := (Image.idx_palette[c].peRed shl 16) or
(Image.idx_palette[c].peGreen shl 8) or
Image.idx_palette[c].peBlue;
end
else begin
c := Image.Pixels[x, y];
DIB.Pixels[x, y] := (dxtDecodeChannel(Image.rgb_red, c) shl 16) or
(dxtDecodeChannel(Image.rgb_green, c) shl 8) or
dxtDecodeChannel(Image.rgb_blue, c);
end;
end;
 
{ Resize for 24 bitcount deep }
Image.SetSize(DXTextureImageType_RGBColor, Width, Height, Image.BitCount, 0);
 
Image.rgb_red := dxtMakeChannel($FF0000, False);
Image.rgb_green := dxtMakeChannel($00FF00, False);
Image.rgb_blue := dxtMakeChannel($0000FF, False);
Image.rgb_alpha := dxtMakeChannel(0, False);
 
{ Resample routine DIB based there }
DIB.DoResample(Width, Height, FilterTypeResample);
 
{Image returned through stream}
Image.ClearImage;
MemoryStream := TMemoryStream.Create;
try
DIB.SaveToStream(MemoryStream);
MemoryStream.Position := 0; //from first byte
Image.LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
end;
finally
DIB.Free;
end;
end;
 
procedure TDXTBase.EvaluateChannels
(const CheckChannelUsed: TDXTImageChannels;
const CheckChannelChanged, CheckBitCountForChannel: string);
var J: Integer;
Channel: TDXTImageChannel;
ChannelBitCount: array[TDXTImageChannel] of Integer;
ChannelParamName: TDXTImageChannels;
Image: TDXTextureImage;
Q: TDXTImageChannel;
begin
Fillchar(ChannelBitCount, SizeOf(ChannelBitCount), 0);
ChannelParamName := [];
{ The channel which you use acquisition }
J := 0;
for Q := rgbRed to rgbAlpha do
begin
if Q in CheckChannelUsed then
begin
Inc(J);
Channel := Q;
if not (Channel in FHasChannels) then
begin
if CheckBitCountForChannel <> '' then
ChannelBitCount[Channel] := StrToInt(Copy(CheckBitCountForChannel, j, 1))
else
ChannelBitCount[Channel] := 8; {poke default value}
if ChannelBitCount[Channel] <> 0 then
ChannelParamName := ChannelParamName + [Channel];
 
if CheckChannelChanged <> '' then
begin
case UpCase(CheckChannelChanged[j]) of
'R': FChannelChangeTable[Channel] := rgbRed;
'G': FChannelChangeTable[Channel] := rgbGreen;
'B': FChannelChangeTable[Channel] := rgbBlue;
'Y': FChannelChangeTable[Channel] := yuvY;
'N': FChannelChangeTable[Channel] := rgbNone;
else
raise EDXTBaseError.CreateFmt('Invalid channel type(%s)', [CheckChannelChanged[j]]);
end;
end;
end;
end;
end;
{ Processing of each }
if ChannelParamName <> [] then
begin
{ Picture load }
Image := nil;
{pokud je image uz nahrany tj. stejneho jmena, pokracuj dale}
for j := 0 to FHasImageList.Count - 1 do
if AnsiCompareFileName(TDXTextureImage(FHasImageList[j]).ImageName, FStrImageFileName) = 0 then
begin
Image := FHasImageList[j];
Break;
end;
{obrazek neexistuje, musi se dotahnout bud z proudu, souboru nebo odjinut}
if Image = nil then
begin
try
Image := GetPicture;
except
if Assigned(Image) then
begin
{$IFNDEF VER5UP}
Image.Free; Image := nil;
{$ELSE}
FreeAndNil(Image);
{$ENDIF}
end;
raise;
end;
FHasImageList.Add(Image);
end;
 
{ Each channel processing }
for Channel := Low(Channel) to High(Channel) do
if Channel in ChannelParamName then
begin
if ChannelBitCount[Channel] >= 0 then
FHasChannelImages[Channel].BitCount := ChannelBitCount[Channel]
else
begin
case Image.ImageType of
DXTextureImageType_PaletteIndexedColor:
begin
case Channel of
rgbRed: FHasChannelImages[Channel].BitCount := 8;
rgbGreen: FHasChannelImages[Channel].BitCount := 8;
rgbBlue: FHasChannelImages[Channel].BitCount := 8;
rgbAlpha: FHasChannelImages[Channel].BitCount := 8;
end;
end;
DXTextureImageType_RGBColor:
begin
case Channel of
rgbRed: FHasChannelImages[Channel].BitCount := Image.rgb_red.BitCount;
rgbGreen: FHasChannelImages[Channel].BitCount := Image.rgb_green.BitCount;
rgbBlue: FHasChannelImages[Channel].BitCount := Image.rgb_blue.BitCount;
rgbAlpha: FHasChannelImages[Channel].BitCount := 8;
end;
end;
end;
end;
if FHasChannelImages[Channel].BitCount = 0 then Continue;
FHasChannels := FHasChannels + [Channel];
FHasChannelImages[Channel].Image := Image;
end;
end;
end;
 
function TDXTBase.GetTexture: TDXTextureImage;
var
i, j: Integer;
SubImage: TDXTextureImage;
CurWidth, CurHeight: Integer;
begin
Result := nil;
if FHasImageList.Count = 0 then
raise EDXTBaseError.Create('No image found');
 
{ Output format calculation }
CalcOutputBitFormat;
Result := TDXTextureImage.Create;
try
Result.SetSize(FParamsFormat.ImageType, FParamsFormat.Width, FParamsFormat.Height, FParamsFormat.BitCount, 0);
 
Result.idx_index := FParamsFormat.idx_index;
Result.idx_alpha := FParamsFormat.idx_alpha;
Result.idx_palette := FParamsFormat.idx_palette;
 
Result.rgb_red := FParamsFormat.rgb_red;
Result.rgb_green := FParamsFormat.rgb_green;
Result.rgb_blue := FParamsFormat.rgb_blue;
Result.rgb_alpha := FParamsFormat.rgb_alpha;
 
Result.ImageName := FParamsFormat.Name;
 
Result.Transparent := FParamsFormat.Transparent;
if FParamsFormat.TransparentColor shr 24 = $01 then
Result.TransparentColor := dxtEncodeChannel(Result.idx_index, PaletteIndex(Byte(FParamsFormat.TransparentColor)))
else
Result.TransparentColor := Result.EncodeColor(GetRValue(FParamsFormat.TransparentColor), GetGValue(FParamsFormat.TransparentColor), GetBValue(FParamsFormat.TransparentColor), 0);
 
BuildImage(Result);
 
if FParamsFormat.ImageType = DXTextureImageType_RGBColor then
begin
BuildImage(Result);
{ Picture information store here }
CurWidth := FParamsFormat.Width;
CurHeight := FParamsFormat.Height;
for i := 0 to FParamsFormat.MipmapCount - 1 do
begin
CurWidth := CurWidth div 2;
CurHeight := CurHeight div 2;
if (CurWidth <= 0) or (CurHeight <= 0) then Break;
{ Resize calc here }
for j := 0 to FHasImageList.Count - 1 do
Resize(FHasImageList[j], CurWidth, CurHeight, ftrTriangle);
 
SubImage := TDXTextureImage.CreateSub(Result);
SubImage.SetSize(FParamsFormat.ImageType, CurWidth, CurHeight, FParamsFormat.BitCount, 0);
 
SubImage.idx_index := FParamsFormat.idx_index;
SubImage.idx_alpha := FParamsFormat.idx_alpha;
SubImage.idx_palette := FParamsFormat.idx_palette;
 
SubImage.rgb_red := FParamsFormat.rgb_red;
SubImage.rgb_green := FParamsFormat.rgb_green;
SubImage.rgb_blue := FParamsFormat.rgb_blue;
SubImage.rgb_alpha := FParamsFormat.rgb_alpha;
 
SubImage.ImageGroupType := DXTextureImageGroupType_Normal;
SubImage.ImageID := i;
SubImage.ImageName := Format('%s - mimap #%d', [Result.ImageName, i + 1]);
 
BuildImage(SubImage);
end;
end;
Result.FileCompressType := FParamsFormat.Compress;
except
on E: Exception do
begin
{$IFNDEF VER5UP}
Result.Free;
Result := nil;
{$ELSE}
FreeAndNil(Result);
{$ENDIF}
raise EDXTBaseError.Create(E.Message);
end;
end;
end;
 
{ DIB2DTX }
 
procedure dib2dxt(DIBImage: TDIB; out DXTImage: TDXTextureImage{$IFDEF DXTextureImage_UseZLIB}; const Shrink: Boolean = True{$ENDIF});
var
TexImage: TDXTBase;
DIB: TDIB;
begin
TexImage := TDXTBase.Create;
try
{$IFDEF DXTextureImage_UseZLIB}
if Shrink then
begin
TexImage.Compression := DXTextureImageFileCompressType_ZLIB;
TexImage.Mipmap := 4;
end;
{$ENDIF}
try
if DIBImage.HasAlphaChannel then
begin
DIB := DIBImage.RGBChannel;
TexImage.SetChannelRGB(DIB);
DIB.Free;
DIB := DIBImage.AlphaChannel;
TexImage.SetChannelA(DIB);
DIB.Free;
end
else
TexImage.SetChannelRGB(DIBImage);
 
DXTImage := TexImage.Texture;
except
if Assigned(DXTImage) then
DXTImage.Free;
DXTImage := nil;
end;
finally
TexImage.Free;
end
end;
 
{$IFDEF D3DRM}
 
{ TDirect3DRMUserVisual }
 
procedure TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK(lpD3DRMobj: IDirect3DRMObject;
lpArg: Pointer); CDECL;
lpArg: Pointer); cdecl;
begin
TDirect3DRMUserVisual(lpArg).Free;
end;
6149,7 → 11373,7
 
function TDirect3DRMUserVisual_D3DRMUSERVISUALCALLBACK(lpD3DRMUV: IDirect3DRMUserVisual;
lpArg: Pointer; lpD3DRMUVreason: TD3DRMUserVisualReason;
lpD3DRMDev: IDirect3DRMDevice; lpD3DRMview: IDirect3DRMViewport): Integer; CDECL;
lpD3DRMDev: IDirect3DRMDevice; lpD3DRMview: IDirect3DRMViewport): Integer; cdecl;
begin
Result := TDirect3DRMUserVisual(lpArg).DoRender(lpD3DRMUVreason, lpD3DRMDev, lpD3DRMview);
end;
6159,7 → 11383,8
inherited Create;
 
if D3DRM.CreateUserVisual(@TDirect3DRMUserVisual_D3DRMUSERVISUALCALLBACK,
Self, FUserVisual)<>D3DRM_OK then
Self, FUserVisual) <> D3DRM_OK
then
raise EDirect3DRMUserVisualError.CreateFmt(SCannotMade, ['IDirect3DRMUserVisual']);
 
FUserVisual.AddDestroyCallback(@TDirect3DRMUserVisual_D3DRMOBJECTCALLBACK, Self);
6178,13 → 11403,10
begin
Result := 0;
end;
{$ENDIF}
 
{ TPictureCollectionItem }
 
const
SurfaceDivWidth = 512;
SurfaceDivHeight = 512;
 
type
TPictureCollectionItemPattern = class(TCollectionItem)
private
6260,6 → 11482,7
function TPictureCollectionItem.GetPatternRect(Index: Integer): TRect;
begin
if (Index>=0) and (index<FPatterns.Count) then
//Result := (FPatterns.Items[Index] as TPictureCollectionItemPattern).FRect
Result := TPictureCollectionItemPattern(FPatterns.Items[Index]).FRect
else
Result := Rect(0, 0, 0, 0);
6279,14 → 11502,14
begin
if FSurfaceList.Count=0 then
begin
if PatternWidth = 0 then PatternWidth := FPicture.Width; //prevent division by zero
XCount := FPicture.Width div (PatternWidth+SkipWidth);
if FPicture.Width-XCount*(PatternWidth+SkipWidth)=PatternWidth then
Inc(XCount);
 
if PatternHeight = 0 then PatternHeight := FPicture.Height; //prevent division by zero
YCount := FPicture.Height div (PatternHeight+SkipHeight);
if FPicture.Height-YCount*(PatternHeight+SkipHeight)=PatternHeight then
Inc(YCount);
 
Result := XCount*YCount;
end else
Result := FPatterns.Count;
6304,15 → 11527,92
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
{$IFDEF DrawHWAcc}
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, Bounds(X, Y, Width, Height), PatternIndex, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF});
end
else
{$ENDIF DrawHWAcc}
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.Draw(X, Y, FRect, FSurface, Transparent);
end;
end;
 
procedure TPictureCollectionItem.DrawFlipHV(Dest: TDirectDrawSurface; X, Y,
PatternIndex: Integer);
var
flrc: trect;
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
begin
flrc.Left := frect.right; flrc.Right := frect.left;
flrc.Top := fpicture.height - frect.top;
flrc.Bottom := fpicture.height - frect.bottom;
Dest.Draw(X, Y, Flrc, FSurface, Transparent);
end;
end;
 
procedure TPictureCollectionItem.DrawFlipH(Dest: TDirectDrawSurface; X, Y,
PatternIndex: Integer);
var
flrc: TRect;
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
begin
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Dest) then
begin
flrc := frect;
Dest.MirrorFlip([rmfMirror]);
end
else
begin
flrc.Left := fpicture.width - frect.left;
flrc.Right := fpicture.width - frect.right;
flrc.Top := frect.Top; flrc.Bottom := frect.Bottom;
end;
Dest.Draw(X, Y, Flrc, FSurface, Transparent);
end;
end;
 
procedure TPictureCollectionItem.DrawFlipV(Dest: TDirectDrawSurface; X, Y,
PatternIndex: Integer);
var
flrc: TRect;
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
begin
if AsSigned(D2D) and D2D.CanUseD2D and (D2D.FDDraw.Surface = Dest) then
begin
flrc := frect;
Dest.MirrorFlip([rmfFlip]);
end
else
begin
flrc.Left := frect.left; flrc.Right := frect.right;
flrc.Top := fpicture.height - frect.top;
flrc.Bottom := fpicture.height - frect.bottom;
end;
Dest.Draw(X, Y, Flrc, FSurface, Transparent);
end;
end;
 
procedure TPictureCollectionItem.StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
{$IFDEF DrawHWAcc}
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtDraw{$IFNDEF VER4UP}, $FF{$ENDIF})
end
else
{$ENDIF DrawHWAcc}
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.StretchDraw(DestRect, FRect, FSurface, Transparent);
end;
6323,16 → 11623,44
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtAdd, Alpha)
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawAdd(DestRect, FRect, FSurface, Transparent, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawAddCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Color: Integer; Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderCol(Self, DestRect, PatternIndex, Color, rtAdd, Alpha)
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawAdd(DestRect, FRect, FSurface, Transparent, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Alpha: Integer);
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtBlend, Alpha)
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
end;
6343,16 → 11671,49
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Self, DestRect, PatternIndex, rtSub, Alpha)
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawSub(DestRect, FRect, FSurface, Transparent, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawSubCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
Color: Integer; Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderCol(Self, DestRect, PatternIndex, Color, rtSub, Alpha)
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawSub(DestRect, FRect, FSurface, Transparent, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
CenterX, CenterY: Double; Angle: Integer);
CenterX, CenterY: Double; Angle: single);
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
//X,Y................ Center of rotation
//Width,Height....... Picture
//PatternIndex....... Piece of picture
//CenterX,CenterY ... Center of rotation on picture
//Angle.............. Angle of rotation
FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtDraw, CenterX, CenterY, Angle{$IFNDEF VER4UP}, $FF{$ENDIF});
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotate(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle);
end;
6359,10 → 11720,16
end;
 
procedure TPictureCollectionItem.DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
CenterX, CenterY: Double; Angle, Alpha: Integer);
CenterX, CenterY: Double; Angle: single; Alpha: Integer);
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtAdd, CenterX, CenterY, Angle, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotateAdd(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
end;
6369,10 → 11736,16
end;
 
procedure TPictureCollectionItem.DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
CenterX, CenterY: Double; Angle, Alpha: Integer);
CenterX, CenterY: Double; Angle: single; Alpha: Integer);
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtBlend, CenterX, CenterY, Angle, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotateAlpha(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
end;
6379,10 → 11752,16
end;
 
procedure TPictureCollectionItem.DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
CenterX, CenterY: Double; Angle, Alpha: Integer);
CenterX, CenterY: Double; Angle: single; Alpha: Integer);
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderRotate(Self, X, Y, Width, Height, PatternIndex, rtSub, CenterX, CenterY, Angle, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotateSub(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
end;
6393,6 → 11772,13
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtDraw,
Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawWaveX(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph);
end;
6403,6 → 11789,13
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtAdd,
Transparent, amp, Len, ph, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawWaveXAdd(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
end;
6413,6 → 11806,13
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtBlend,
Transparent, amp, Len, ph, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawWaveXAlpha(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
end;
6423,11 → 11823,75
begin
if FInitialized and (PatternIndex>=0) and (PatternIndex<FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveX(Self, X, Y, Width, Height, PatternIndex, rtSub,
Transparent, amp, Len, ph, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawWaveXSub(X, Y, Width, Height, FRect, FSurface, Transparent, amp, Len, ph, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawWaveYSub(Dest: TDirectDrawSurface; X, Y,
Width, Height, PatternIndex, amp, Len, ph, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtSub,
Transparent, amp, Len, ph, Alpha);
end
{there is not software version}
end;
end;
 
procedure TPictureCollectionItem.DrawWaveY(Dest: TDirectDrawSurface; X, Y,
Width, Height, PatternIndex, amp, Len, ph: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtDraw,
Transparent, amp, Len, ph{$IFNDEF VER4UP}, $FF{$ENDIF});
end
end;
end;
 
procedure TPictureCollectionItem.DrawWaveYAdd(Dest: TDirectDrawSurface; X, Y,
Width, Height, PatternIndex, amp, Len, ph, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtAdd,
Transparent, amp, Len, ph, Alpha);
end
end;
end;
 
procedure TPictureCollectionItem.DrawWaveYAlpha(Dest: TDirectDrawSurface; X, Y,
Width, Height, PatternIndex, amp, Len, ph, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderWaveY(Self, X, Y, Width, Height, PatternIndex, rtBlend,
Transparent, amp, Len, ph, Alpha);
end
end;
end;
 
procedure TPictureCollectionItem.Finalize;
begin
if FInitialized then
6437,10 → 11901,98
end;
end;
 
procedure TPictureCollectionItem.UpdateTag;
 
function AddSurface(const SrcRect: TRect): TDirectDrawSurface;
begin
Result := TDirectDrawSurface.Create(PictureCollection.DXDraw.DDraw);
FSurfaceList.Add(Result);
 
Result.SystemMemory := FSystemMemory;
Result.LoadFromGraphicRect(FPicture.Graphic, 0, 0, SrcRect);
Result.TransparentColor := Result.ColorMatch(FTransparentColor);
end;
 
var
x, y, x2, y2: Integer;
BlockWidth, BlockHeight, BlockXCount, BlockYCount: Integer;
Width2, Height2: Integer;
TempSurface : TDirectDrawSurface;
begin
if FPicture.Graphic = nil then Exit;
// ClearSurface;
Width2 := Width + SkipWidth;
Height2 := Height + SkipHeight;
 
if (Width = FPicture.Width) and (Height = FPicture.Height) then
begin
with TPictureCollectionItemPattern.Create(FPatterns) do
begin
TempSurface := TDirectDrawSurface.Create(PictureCollection.DXDraw.DDraw);
FSurface := TempSurface;
FRect := Bounds(0, 0, FPicture.Width, FPicture.Height);
TempSurface.LoadFromGraphicRect(FPicture.Graphic, 0, 0, FRect);
TempSurface.SystemMemory := FSystemMemory;
TempSurface.TransparentColor := TempSurface.ColorMatch(FTransparentColor);
FSurfaceList.Add(TempSurface);
end;
end
else
if FSystemMemory then
begin
AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
for y := 0 to (FPicture.Height + SkipHeight) div Height2 - 1 do
for x := 0 to (FPicture.Width + SkipWidth) div Width2 - 1 do
with TPictureCollectionItemPattern.Create(FPatterns) do
begin
FRect := Bounds(x * Width2, y * Height2, Width, Height);
FSurface := TDirectDrawSurface(FSurfaceList[0]);
end;
end
else
begin
{ Load to a video memory with dividing the image. }
BlockWidth := Min(((SurfaceDivWidth + Width2 - 1) div Width2) * Width2,
(FPicture.Width + SkipWidth) div Width2 * Width2);
BlockHeight := Min(((SurfaceDivHeight + Height2 - 1) div Height2) * Height2,
(FPicture.Height + SkipHeight) div Height2 * Height2);
 
if (BlockWidth = 0) or (BlockHeight = 0) then Exit;
 
BlockXCount := (FPicture.Width + BlockWidth - 1) div BlockWidth;
BlockYCount := (FPicture.Height + BlockHeight - 1) div BlockHeight;
 
for y := 0 to BlockYCount - 1 do
for x := 0 to BlockXCount - 1 do
begin
x2 := Min(BlockWidth, Max(FPicture.Width - x * BlockWidth, 0));
if x2 = 0 then x2 := BlockWidth;
 
y2 := Min(BlockHeight, Max(FPicture.Height - y * BlockHeight, 0));
if y2 = 0 then y2 := BlockHeight;
 
AddSurface(Bounds(x * BlockWidth, y * BlockHeight, x2, y2));
end;
 
for y := 0 to (FPicture.Height + SkipHeight) div Height2 - 1 do
for x := 0 to (FPicture.Width + SkipWidth) div Width2 - 1 do
begin
x2 := x * Width2;
y2 := y * Height2;
with TPictureCollectionItemPattern.Create(FPatterns) do
begin
FRect := Bounds(x2 - (x2 div BlockWidth * BlockWidth), y2 - (y2 div BlockHeight * BlockHeight), Width, Height);
FSurface := TDirectDrawSurface(FSurfaceList[(x2 div BlockWidth) + ((y2 div BlockHeight) * BlockXCount)]);
end;
end;
end;
end;
 
procedure TPictureCollectionItem.Initialize;
begin
Finalize;
FInitialized := PictureCollection.Initialized;
UpdateTag;
end;
 
procedure TPictureCollectionItem.Restore;
6482,7 → 12034,9
FRect := Bounds(0, 0, FPicture.Width, FPicture.Height);
FSurface := AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
end;
end else if FSystemMemory then
end
else
if FSystemMemory then
begin
{ Load to a system memory. }
AddSurface(Bounds(0, 0, FPicture.Width, FPicture.Height));
6494,7 → 12048,8
FRect := Bounds(x * Width2, y * Height2, Width, Height);
FSurface := TDirectDrawSurface(FSurfaceList[0]);
end;
end else
end
else
begin
{ Load to a video memory with dividing the image. }
BlockWidth := Min(((SurfaceDivWidth+Width2-1) div Width2)*Width2,
6531,6 → 12086,13
end;
end;
end;
{Code added for better compatibility}
{When is any picture changed, then all textures cleared and list have to reloaded}
with PictureCollection do
{$IFDEF D3D_deprecated}if (do3D in FDXDraw.Options) then{$ENDIF}
if AsSigned(FDXDraw.FD2D) then
if Assigned(FDXDraw.FD2D.D2DTextures) then
FDXDraw.FD2D.D2DTextures.D2DPruneAllTextures;
end;
 
procedure TPictureCollectionItem.SetPicture(Value: TPicture);
6557,6 → 12119,121
end;
end;
 
procedure TPictureCollectionItem.DrawAlphaCol(Dest: TDirectDrawSurface;
const DestRect: TRect; PatternIndex, Color, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderCol(Self, DestRect, PatternIndex, color, rtBlend, Alpha)
end else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawRotateAddCol(Dest: TDirectDrawSurface;
X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY: Double;
Angle: single; Color, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderRotateModeCol(Self, rtAdd, X, Y, Width,
Height, PatternIndex, CenterX, CenterY, Angle, Color, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotateAdd(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawRotateAlphaCol(Dest: TDirectDrawSurface;
X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY: Double;
Angle: single; Color, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderRotateModeCol(Self, rtBlend, X, Y, Width,
Height, PatternIndex, CenterX, CenterY, Angle, Color, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotateAlpha(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawRotateSubCol(Dest: TDirectDrawSurface;
X, Y, Width, Height, PatternIndex: Integer; CenterX, CenterY: Double;
Angle: single; Color, Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderRotateModeCol(Self, rtSub, X, Y, Width,
Height, PatternIndex, CenterX, CenterY, Angle, Color, Alpha);
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawRotateSub(X, Y, Width, Height, FRect, FSurface, CenterX, CenterY, Transparent, Angle, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawCol(Dest: TDirectDrawSurface;
const DestRect, SourceRect: TRect; PatternIndex: Integer; Faded: Boolean;
RenderType: TRenderType; Color, Specular: Integer; Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRenderColoredPartition(Self, DestRect, PatternIndex,
Color, Specular, Faded, SourceRect, RenderType,
Alpha)
end
else
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
Dest.DrawAlpha(DestRect, FRect, FSurface, Transparent, Alpha);
end;
end;
 
procedure TPictureCollectionItem.DrawRect(Dest: TDirectDrawSurface;
const DestRect, SourceRect: TRect; PatternIndex: Integer;
RenderType: TRenderType; Transparent: Boolean; Alpha: Integer);
begin
if FInitialized and (PatternIndex >= 0) and (PatternIndex < FPatterns.Count) then
begin
{$IFDEF DrawHWAcc}
with TPictureCollection(Self.GetPictureCollection) do
if FDXDraw.CheckD3D(Dest) then
begin
FDXDraw.FD2D.D2DRender(Self, DestRect, PatternIndex, SourceRect, RenderType, Alpha);
end
else
{$ENDIF DrawHWAcc}
with TPictureCollectionItemPattern(FPatterns.Items[PatternIndex]) do
begin
case RenderType of
rtDraw: Dest.StretchDraw(DestRect, SourceRect, FSurface, Transparent);
//Dest.Draw(DestRect.Left, DestRect.Top, SourceRect, FSurface, Transparent);
rtBlend: Dest.DrawAlpha(DestRect, SourceRect, FSurface, Transparent, Alpha);
rtAdd: Dest.DrawAdd(DestRect, SourceRect, FSurface, Transparent, Alpha);
rtSub: Dest.DrawSub(DestRect, SourceRect, FSurface, Transparent, Alpha);
end;
end;
end;
end;
 
{ TPictureCollection }
 
constructor TPictureCollection.Create(AOwner: TPersistent);
6603,6 → 12280,22
end;
end;
 
procedure TPictureCollection.InitializeImages(DXDraw: TCustomDXDraw; Id : Integer);
var
i: Integer;
begin
If id = -1 Then
Finalize;
FDXDraw := DXDraw;
 
if not Initialized then
raise EPictureCollectionError.CreateFmt(SCannotInitialized, [ClassName]);
 
for i := 0 to Count - 1 do
If (id = -1) or (id = i) Then
Items[i].Initialize;
end;
 
procedure TPictureCollection.Initialize(DXDraw: TCustomDXDraw);
var
i: Integer;
6861,6 → 12554,7
end;
 
constructor TDirectDrawOverlay.CreateWindowed(WindowHandle: HWND);
{$IFDEF D3D_deprecated}
const
PrimaryDesc: TDDSurfaceDesc = (
dwSize: SizeOf(PrimaryDesc);
6867,12 → 12561,22
dwFlags: DDSD_CAPS;
ddsCaps: (dwCaps: DDSCAPS_PRIMARYSURFACE)
);
{$ELSE}
var
PrimaryDesc: TDDSurfaceDesc2;
{$ENDIF}
begin
FDDraw2 := TDirectDraw.CreateEx(nil, False);
if FDDraw2.IDraw.SetCooperativeLevel(WindowHandle, DDSCL_NORMAL)<>DD_OK then
if FDDraw2.{$IFDEF D3D_deprecated}IDraw{$ELSE}IDraw7{$ENDIF}.SetCooperativeLevel(WindowHandle, DDSCL_NORMAL) <> DD_OK then
raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
 
FTargetSurface2 := TDirectDrawSurface.Create(FDDraw2);
{$IFNDEF D3D_deprecated}
FillChar(PrimaryDesc, SizeOf(PrimaryDesc), 0);
PrimaryDesc.dwSize := SizeOf(PrimaryDesc);
PrimaryDesc.dwFlags := DDSD_CAPS;
PrimaryDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
{$ENDIF}
if not FTargetSurface2.CreateSurface(PrimaryDesc) then
raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
 
6893,11 → 12597,17
FSurface.Free; FSurface := nil;
end;
 
procedure TDirectDrawOverlay.Initialize(const SurfaceDesc: TDDSurfaceDesc);
procedure TDirectDrawOverlay.Initialize(const SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF});
{$IFDEF D3D_deprecated}
const
BackBufferCaps: TDDSCaps = (dwCaps: DDSCAPS_BACKBUFFER);
var
DDSurface: IDirectDrawSurface;
{$ELSE}
var
DDSurface: IDirectDrawSurface7;
BackBufferCaps: TDDSCaps2;
{$ENDIF}
begin
Finalize;
try
6906,18 → 12616,21
raise EDirectDrawOverlayError.CreateFmt(SCannotInitialized, [SOverlay]);
 
FBackSurface := TDirectDrawSurface.Create(FDDraw);
{$IFNDEF D3D_deprecated}
BackBufferCaps.dwCaps := DDSCAPS_BACKBUFFER;
{$ENDIF}
if SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_FLIP<>0 then
begin
if FSurface.ISurface.GetAttachedSurface(BackBufferCaps, DDSurface)=DD_OK then
FBackSurface.IDDSurface := DDSurface;
end else
FBackSurface.IDDSurface := FSurface.IDDSurface;
if FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetAttachedSurface(BackBufferCaps, DDSurface) = DD_OK then
FBackSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := DDSurface;
end
else
FBackSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} := FSurface.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF};
 
if FVisible then
SetOverlayRect(FOverlayRect)
else
FSurface.ISurface.UpdateOverlay(PRect(nil)^, FTargetSurface.ISurface, PRect(nil)^, DDOVER_HIDE, PDDOverlayFX(nil)^);
FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UpdateOverlay(PRect(nil), FTargetSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, PRect(nil), DDOVER_HIDE, PDDOverlayFX(nil));
except
Finalize;
raise;
6929,7 → 12642,7
if FSurface=nil then Exit;
 
if FSurface.SurfaceDesc.ddsCaps.dwCaps and DDSCAPS_FLIP<>0 then
FSurface.ISurface.Flip(nil, DDFLIP_WAIT);
FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.Flip(nil, DDFLIP_WAIT);
end;
 
procedure TDirectDrawOverlay.SetOverlayColorKey(Value: TColor);
6964,26 → 12677,34
XScaleRatio := (DestRect.right - DestRect.left) * 1000 div (SrcRect.right - SrcRect.left);
YScaleRatio := (DestRect.bottom - DestRect.top) * 1000 div (SrcRect.bottom - SrcRect.top);
 
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
(FDDraw.DriverCaps.dwMinOverlayStretch<>0) and (XScaleRatio<Integer(FDDraw.DriverCaps.dwMinOverlayStretch)) then
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
and (FDDraw.DriverCaps.dwMinOverlayStretch <> 0)
and (XScaleRatio < Integer(FDDraw.DriverCaps.dwMinOverlayStretch))
then
begin
DestRect.Right := DestRect.Left + (Integer(FSurface.SurfaceDesc.dwWidth) * (Integer(FDDraw.DriverCaps.dwMinOverlayStretch) + 1)) div 1000;
end;
 
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
(FDDraw.DriverCaps.dwMaxOverlayStretch<>0) and (XScaleRatio>Integer(FDDraw.DriverCaps.dwMaxOverlayStretch)) then
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
and (FDDraw.DriverCaps.dwMaxOverlayStretch <> 0)
and (XScaleRatio > Integer(FDDraw.DriverCaps.dwMaxOverlayStretch))
then
begin
DestRect.Right := DestRect.Left + (Integer(FSurface.SurfaceDesc.dwWidth) * (Integer(FDDraw.DriverCaps.dwMaxOverlayStretch) + 999)) div 1000;
end;
 
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
(FDDraw.DriverCaps.dwMinOverlayStretch<>0) and (YScaleRatio<Integer(FDDraw.DriverCaps.dwMinOverlayStretch)) then
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
and (FDDraw.DriverCaps.dwMinOverlayStretch <> 0)
and (YScaleRatio < Integer(FDDraw.DriverCaps.dwMinOverlayStretch))
then
begin
DestRect.Bottom := DestRect.Top + (Integer(FSurface.SurfaceDesc.dwHeight) * (Integer(FDDraw.DriverCaps.dwMinOverlayStretch) + 1)) div 1000;
end;
 
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH<>0) and
(FDDraw.DriverCaps.dwMaxOverlayStretch<>0) and (YScaleRatio>Integer(FDDraw.DriverCaps.dwMaxOverlayStretch)) then
if (FDDraw.DriverCaps.dwCaps and DDCAPS_OVERLAYSTRETCH <> 0)
and (FDDraw.DriverCaps.dwMaxOverlayStretch <> 0)
and (YScaleRatio > Integer(FDDraw.DriverCaps.dwMaxOverlayStretch))
then
begin
DestRect.Bottom := DestRect.Top + (Integer(FSurface.SurfaceDesc.dwHeight) * (Integer(FDDraw.DriverCaps.dwMaxOverlayStretch) + 999)) div 1000;
end;
7051,7 → 12772,7
OverlayFlags := OverlayFlags or (DDOVER_KEYDESTOVERRIDE or DDOVER_DDFX);
end;
 
FSurface.ISurface.UpdateOverlay(SrcRect, FTargetSurface.ISurface, DestRect, OverlayFlags, OverlayFX);
FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UpdateOverlay(@SrcRect, FTargetSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, @DestRect, OverlayFlags, @OverlayFX);
end;
end;
 
7063,13 → 12784,3614
if FVisible then
SetOverlayRect(FOverlayRect)
else
FSurface.ISurface.UpdateOverlay(PRect(nil)^, FTargetSurface.ISurface, PRect(nil)^, DDOVER_HIDE, PDDOverlayFX(nil)^);
FSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.UpdateOverlay(PRect(nil), FTargetSurface.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}, PRect(nil), DDOVER_HIDE, PDDOverlayFX(nil));
end;
end;
 
{ TDXFont }
 
constructor TDXFont.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
 
destructor TDXFont.Destroy;
begin
inherited Destroy;
end;
 
procedure TDXFont.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FDXImageList) then
begin
FDXImageList := nil;
end;
end; {Notification}
 
procedure TDXFont.SetFont(const Value: string);
begin
FFont := Value;
if assigned(FDXImageList) then
begin
FFontIndex := FDXImageList.items.IndexOf(FFont); { find font once }
fOffset := FDXImageList.Items[FFontIndex].PatternWidth;
end;
end;
 
procedure TDXFont.SetFontIndex(const Value: Integer);
begin
FFontIndex := Value;
if assigned(FDXImageList) then
begin
FFont := FDXImageList.Items[FFontIndex].Name;
fOffset := FDXImageList.Items[FFontIndex].PatternWidth;
end;
end;
 
procedure TDXFont.TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string);
var
loop, letter: Integer;
UpperText: string;
begin
if not assigned(FDXImageList) then
exit;
Offset := FDXImageList.Items[FFontIndex].PatternWidth;
UpperText := AnsiUppercase(text);
for loop := 1 to Length(UpperText) do
begin
letter := AnsiPos(UpperText[loop], Alphabet) - 1;
if letter < 0 then letter := 30;
FDXImageList.items[FFontIndex].Draw(DirectDrawSurface, x + Offset * loop, y, letter);
end; { loop }
end;
 
{ TDXPowerFontEffectsParameters }
 
procedure TDXPowerFontEffectsParameters.SetAlphaValue(
const Value: Integer);
begin
FAlphaValue := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetAngle(const Value: Integer);
begin
FAngle := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetCenterX(const Value: Integer);
begin
FCenterX := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetCenterY(const Value: Integer);
begin
FCenterY := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetHeight(const Value: Integer);
begin
FHeight := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetWAmplitude(
const Value: Integer);
begin
FWAmplitude := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetWidth(const Value: Integer);
begin
FWidth := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetWLenght(const Value: Integer);
begin
FWLenght := Value;
end;
 
procedure TDXPowerFontEffectsParameters.SetWPhase(const Value: Integer);
begin
FWPhase := Value;
end;
 
{ TDXPowerFont }
 
constructor TDXPowerFont.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FUseEnterChar := True;
FEnterCharacter := '|<';
FAlphabets := PowerAlphaBet;
FTextOutType := ttNormal;
FTextOutEffect := teNormal;
FEffectsParameters := TDXPowerFontEffectsParameters.Create;
end;
 
destructor TDXPowerFont.Destroy;
begin
inherited Destroy;
end;
 
procedure TDXPowerFont.SetAlphabets(const Value: string);
begin
if FDXImageList <> nil then
if Length(Value) > FDXImageList.Items[FFontIndex].PatternCount - 1 then Exit;
FAlphabets := Value;
end;
 
procedure TDXPowerFont.SetEnterCharacter(const Value: string);
begin
if Length(Value) >= 2 then Exit;
FEnterCharacter := Value;
end;
 
procedure TDXPowerFont.SetFont(const Value: string);
begin
FFont := Value;
if FDXImageList <> nil then
begin
FFontIndex := FDXImageList.Items.IndexOf(FFont); // Find font once...
Offset := FDXImageList.Items[FFontIndex].PatternWidth;
 
FEffectsParameters.Width := FDXImageList.Items[FFontIndex].PatternWidth;
FEffectsParameters.Height := FDXImageList.Items[FFontIndex].PatternHeight;
end;
end;
 
procedure TDXPowerFont.SetFontIndex(const Value: Integer);
begin
FFontIndex := Value;
if FDXImageList <> nil then
begin
FFont := FDXImageList.Items[FFontIndex].Name;
Offset := FDXImageList.Items[FFontIndex].PatternWidth;
 
FEffectsParameters.Width := FDXImageList.Items[FFontIndex].PatternWidth;
FEffectsParameters.Height := FDXImageList.Items[FFontIndex].PatternHeight;
end;
end;
 
procedure TDXPowerFont.SetEffectsParameters(const Value: TDXPowerFontEffectsParameters);
begin
FEffectsParameters := Value;
end;
 
procedure TDXPowerFont.SetTextOutEffect(const Value: TDXPowerFontTextOutEffect);
begin
FTextOutEffect := Value;
end;
 
procedure TDXPowerFont.SetTextOutType(const Value: TDXPowerFontTextOutType);
begin
FTextOutType := Value;
end;
 
procedure TDXPowerFont.SetUseEnterChar(const Value: Boolean);
begin
FUseEnterChar := Value;
end;
 
function TDXPowerFont.TextOutFast(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
var
Loop, Letter: Integer;
txt: string;
begin
Result := False;
if FDXImageList = nil then Exit;
// modified
case FTextOutType of
ttNormal: Txt := Text;
ttUpperCase: Txt := AnsiUpperCase(Text);
ttLowerCase: Txt := AnsiLowerCase(Text);
end;
Offset := FDXImageList.Items[FFontIndex].PatternWidth;
Loop := 1;
while (Loop <= Length(Text)) do
begin
Letter := AnsiPos(txt[Loop], FAlphabets); // modified
if (Letter > 0) and (Letter < FDXImageList.Items[FFontIndex].PatternCount - 1) then
FDXImageList.Items[FFontIndex].Draw(DirectDrawSurface, X + (Offset * Loop), Y, Letter - 1);
Inc(Loop);
end;
Result := True;
end;
 
function TDXPowerFont.TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
var
Loop, Letter: Integer;
FCalculatedEnters, EnterHeghit, XLoop: Integer;
DoTextOut: Boolean;
Txt: string;
Rect: TRect;
begin
Result := False;
if FDXImageList = nil then Exit;
Txt := Text;
DoTextOut := True;
if Assigned(FBeforeTextOut) then FBeforeTextOut(Self, Txt, DoTextOut);
if not DoTextOut then Exit;
// modified
case FTextOutType of
ttNormal: Txt := Text;
ttUpperCase: Txt := AnsiUpperCase(Text);
ttLowerCase: Txt := AnsiLowerCase(Text);
end;
Offset := FDXImageList.Items[FFontIndex].PatternWidth;
FCalculatedEnters := 0;
EnterHeghit := FDXImageList.Items[FFontIndex].PatternHeight;
XLoop := 0;
Loop := 1;
while (Loop <= Length(Txt)) do
begin
if FUseEnterChar then
begin
if Txt[Loop] = FEnterCharacter[1] then begin Inc(FCalculatedEnters); Inc(Loop); end;
if Txt[Loop] = FEnterCharacter[2] then begin Inc(FCalculatedEnters); XLoop := 0; {-FCalculatedEnters;} Inc(Loop); end;
end;
Letter := AnsiPos(Txt[Loop], FAlphabets); // modified
 
if (Letter > 0) and (Letter < FDXImageList.Items[FFontIndex].PatternCount - 1) then
case FTextOutEffect of
teNormal: FDXImageList.Items[FFontIndex].Draw(DirectDrawSurface, X + (Offset * XLoop), Y + (FCalculatedEnters * EnterHeghit), Letter - 1);
teRotat: FDXImageList.Items[FFontIndex].DrawRotate(DirectDrawSurface, X + (Offset * XLoop), Y + (FCalculatedEnters * EnterHeghit), FEffectsParameters.Width, FEffectsParameters.Height, Letter - 1, FEffectsParameters.CenterX, FEffectsParameters.CenterY, FEffectsParameters.Angle);
teAlphaBlend:
begin
Rect.Left := X + (Offset * XLoop);
Rect.Top := Y + (FCalculatedEnters * EnterHeghit);
Rect.Right := Rect.Left + FEffectsParameters.Width;
Rect.Bottom := Rect.Top + FEffectsParameters.Height;
 
FDXImageList.Items[FFontIndex].DrawAlpha(DirectDrawSurface, Rect, Letter - 1, FEffectsParameters.AlphaValue);
end;
teWaveX: FDXImageList.Items[FFontIndex].DrawWaveX(DirectDrawSurface, X + (Offset * XLoop), Y + (FCalculatedEnters * EnterHeghit), FEffectsParameters.Width, FEffectsParameters.Height, Letter - 1, FEffectsParameters.WAmplitude, FEffectsParameters.WLenght, FEffectsParameters.WPhase);
end;
Inc(Loop);
Inc(XLoop);
end;
if Assigned(FAfterTextOut) then FAfterTextOut(Self, Txt);
Result := True;
end;
 
//---------------------------------------------------------------------------
{
Main code supported hardware acceleration by videoadapteur
* Copyright (c) 2004-2010 Jaro Benes
* All Rights Reserved
* Version 1.09
* D2D Hardware module - main implementation part
* web site: www.micrel.cz/Dx
* e-mail: delphix_d2d@micrel.cz
}
 
constructor TD2DTextures.Create(DDraw: TCustomDXDraw);
begin
//inherited;
FDDraw := DDraw; //reload DDraw
{$IFNDEF VER4UP}
TexLen := 0;
Texture := nil;
{$ELSE}
SetLength(Texture, 0);
{$ENDIF}
end;
 
destructor TD2DTextures.Destroy;
var
I: Integer;
begin
if Assigned(Texture) then
{$IFDEF VER4UP}
for I := Low(Texture) to High(Texture) do
begin
Texture[I].D2DTexture.Free;
{$IFDEF VIDEOTEX}
if Assigned(Texture[I].VDIB) then
Texture[I].VDIB.Free;
{$ENDIF}
end;
{$ELSE}
for I := 0 to TexLen - 1 do
begin
Texture[I].D2DTexture.Free;
{$IFDEF VIDEOTEX}
if Assigned(Texture[I].VDIB) then
Texture[I].VDIB.Free;
{$ENDIF}
end;
{$ENDIF}
inherited;
end;
 
function TD2DTextures.GetD2DMaxTextures: Integer;
begin
Result := {$IFDEF VER4UP}Length(Texture){$ELSE}TexLen{$ENDIF};
end;
 
procedure TD2DTextures.SaveTextures(path: string);
var I: Integer;
begin
if Texture <> nil then
{$IFDEF VER4UP}
if Length(Texture) > 0 then
for I := Low(Texture) to High(Texture) do
{$ELSE}
if TexLen > 0 then
for I := 0 to TexLen - 1 do
{$ENDIF}
Texture[I].D2DTexture.FImage.SaveToFile(path + Texture[I].Name + '.dxt');
end;
 
procedure TD2DTextures.SetD2DMaxTextures(const Value: Integer);
begin
if Value > 0 then
{$IFDEF VER4UP}
SetLength(Texture, Value)
{$ELSE}
Inc(TexLen);
if Texture = nil then
Texture := AllocMem(SizeOf(TTextureRec))
else begin
{alokuj pamet}
ReallocMem(Texture, TexLen * SizeOf(TTextureRec));
end;
{$ENDIF}
end;
 
function TD2DTextures.Find(byName: string): Integer;
var I: Integer;
begin
Result := -1;
if Texture <> nil then
{$IFDEF VER4UP}
if Length(Texture) > 0 then
for I := Low(Texture) to High(Texture) do
if AnsiUpperCase(Texture[I].Name) = AnsiUpperCase(byName) then
begin
Result := I;
Exit;
end;
{$ELSE}
if TexLen > 0 then
for I := 0 to TexLen - 1 do
if AnsiUpperCase(Texture[I].Name) = AnsiUpperCase(byName) then
begin
Result := I;
Exit;
end;
{$ENDIF}
end;
 
function TD2DTextures.GetTextureByName(const byName: string): TDirect3DTexture2;
begin
Result := nil;
if Assigned(Texture) then
Result := Texture[Find(byName)].D2DTexture;
end;
 
function TD2DTextures.GetTextureByIndex(const byIndex: Integer): TDirect3DTexture2;
begin
Result := nil;
{$IFNDEF VER4UP}
if Assigned(Texture) and (byIndex >= 0) and (byIndex <= (TexLen - 1)) then
Result := Texture[byIndex].D2DTexture;
{$ELSE}
if Assigned(Texture) and (byIndex in [0..High(Texture)]) then
Result := Texture[byIndex].D2DTexture;
{$ENDIF}
end;
 
function TD2DTextures.GetTextureNameByIndex(const byIndex: Integer): string;
begin
Result := '';
{$IFNDEF VER4UP}
if Assigned(Texture) and (byIndex >= 0) and (byIndex <= (TexLen - 1)) then
Result := Texture[byIndex].Name;
{$ELSE}
if Assigned(Texture) and (byIndex in [0..High(Texture)]) then
Result := Texture[byIndex].Name;
{$ENDIF}
end;
 
function TD2DTextures.Count: Integer;
begin
Result := 0;
if Assigned(Texture) then
{$IFNDEF VER4UP}
Result := TexLen;
{$ELSE}
Result := High(Texture) + 1;
{$ENDIF}
end;
 
procedure TD2DTextures.D2DPruneAllTextures;
var I: Integer;
begin
if not Assigned(Texture) then Exit;
{$IFDEF VER4UP}
for I := Low(Texture) to High(Texture) do
{$ELSE}
for I := 0 to TexLen - 1 do
{$ENDIF}
begin
Texture[I].D2DTexture.Free;
{$IFDEF VIDEOTEX}
if Assigned(Texture[I].VDIB) then
Texture[I].VDIB.Free;
{$ENDIF}
end;
{$IFDEF VER4UP}
SetLength(Texture, 0);
{$ELSE}
TexLen := 0;
{$ENDIF}
end;
 
procedure TD2DTextures.D2DFreeTextures;
var I: Integer;
begin
if not Assigned(Texture) then Exit;
{$IFDEF VER4UP}
for I := Low(Texture) to High(Texture) do
{$ELSE}
for I := 0 to TexLen - 1 do
{$ENDIF}
begin
Texture[I].D2DTexture.Free;
{$IFDEF VIDEOTEX}
if Assigned(Texture[I].VDIB) then
Texture[I].VDIB.Free;
{$ENDIF}
end;
{$IFNDEF VER4UP}
FreeMem(Texture, TexLen * SizeOf(TTextureRec));
Texture := nil;
{$ENDIF}
end;
 
procedure TD2DTextures.D2DPruneTextures;
begin
if {$IFDEF VER4UP}Length(Texture){$ELSE}TexLen{$ENDIF} > maxTexBlock then
begin
D2DPruneAllTextures
end;
end;
 
procedure TD2DTextures.SizeAdjust(var DIB: TDIB; var FloatX1, FloatY1, FloatX2, FloatY2: Double);
var
X, Y: Integer;
tempDIB: TDIB;
begin {auto-adjust size n^2 for accelerator compatibility}
X := 1;
repeat
X := X * 2;
until DIB.Width <= X;
Y := 1;
repeat
Y := Y * 2
until DIB.Height <= Y;
{$IFDEF FORCE_SQUARE}
X := Max(X, Y);
Y := X;
{$ENDIF}
if (X = DIB.Width) and (Y = DIB.Height) then
begin
if DIB.BitCount = 32 then Exit; {do not touch}
{code for correction a DIB.BitCount to 24 bit only}
tempDIB := TDIB.Create;
try
tempDIB.SetSize(X, Y, 24);
FillChar(tempDIB.PBits^, tempDIB.Size, 0);
tempDIB.Canvas.Draw(0, 0, DIB);
DIB.Assign(tempDIB);
finally
tempDIB.Free;
end;
Exit;
end;
tempDIB := TDIB.Create;
try
if DIB.BitCount = 32 then
begin
tempDIB.SetSize(X, Y, 32);
FillChar(tempDIB.PBits^, tempDIB.Size, 0);
//tempDIB.Canvas.Brush.Color := clBlack;
//tempDIB.Canvas.FillRect(Bounds(0, 0, X, Y));
tempDIB.Canvas.Draw(0, 0, DIB);
// if DIB.HasAlphaChannel then
// tempDIB.AssignAlphaChannel(DIB);
end
else
begin
tempDIB.SetSize(X, Y, 24 {DIB.BitCount}); {bad value for some 16}
FillChar(tempDIB.PBits^, tempDIB.Size, 0);
//tempDIB.Canvas.Brush.Color := clBlack;
//tempDIB.Canvas.FillRect(Bounds(0, 0, X, Y));
tempDIB.Canvas.Draw(0, 0, DIB);
end;
FloatX2 := (1 / tempDIB.Width) * DIB.Width;
FloatY2 := (1 / tempDIB.Height) * DIB.Height;
DIB.Assign(tempDIB);
finally
tempDIB.Free;
end
end;
 
function TD2DTextures.CanFindTexture(aImage: TPictureCollectionItem): Boolean;
var I: Integer;
begin
Result := True;
{$IFDEF VER4UP}
if Length(Texture) > 0 then
{$ELSE}
if TexLen > 0 then
{$ENDIF}
for I := 0 to D2DMaxTextures - 1 do
if Texture[I].Name = aImage.Name then Exit;
Result := False;
end;
 
function TD2DTextures.LoadTextures(aImage: TPictureCollectionItem): Boolean;
var
{$IFNDEF VIDEOTEX}
VDIB: TDIB;
{$ENDIF}
T: TDXTextureImage;
begin
Result := True;
try
D2DPruneTextures; {up to maxTexBlock textures only}
D2DMaxTextures := D2DMaxTextures + 1;
if aImage.Name = '' then // FIX: OPTIMIZED
aImage.Name := aImage.GetNamePath; {this name is supplement name, when wasn't aImage.Name fill}
{$IFDEF VIDEOTEX}Texture[D2DMaxTextures - 1].{$ENDIF}VDIB := TDIB.Create;
try
with Texture[D2DMaxTextures - 1] do
begin
VDIB.Assign(aImage.Picture.Graphic);
VDIB.Transparent := aImage.Transparent;
FloatX1 := 0; FloatY1 := 0; FloatX2 := 1; FloatY2 := 1;
SizeAdjust(VDIB, FloatX1, FloatY1, FloatX2, FloatY2);
Name := aImage.Name;
Width := VDIB.Width;
Height := VDIB.Height;
if VDIB.HasAlphaChannel then
begin
DIB2DXT(VDIB, T);
T.ImageName := aImage.Name;
T.Transparent := aImage.Transparent;
D2DTexture := TDirect3DTexture2.Create(FDDraw, T, False);
D2DTexture.Transparent := aImage.Transparent;
AlphaChannel := True;
//**T.Free; DO NOT FREE - surface is lost ** FIX by JB.
end
else
begin
D2DTexture := TDirect3DTexture2.Create(FDDraw, VDIB, False);
D2DTexture.TransparentColor := DWORD(aImage.TransparentColor);
D2DTexture.Surface.TransparentColor := DWORD(aImage.TransparentColor);
D2DTexture.Transparent := aImage.Transparent;
AlphaChannel := False;
end;
end;
finally
{$IFNDEF VIDEOTEX}
VDIB.Free;
{$ENDIF}
end;
except
D2DMaxTextures := D2DMaxTextures - 1;
Result := False;
end;
end;
 
{$IFDEF VER4UP}
function TD2DTextures.CanFindTexture(const TexName: string): Boolean;
{$ELSE}
function TD2DTextures.CanFindTexture2(const TexName: string): Boolean;
{$ENDIF}
var I: Integer;
begin
Result := True;
{$IFDEF VER4UP}
if Length(Texture) > 0 then
{$ELSE}
if TexLen > 0 then
{$ENDIF}
for I := 0 to D2DMaxTextures - 1 do
if Texture[I].Name = TexName then Exit;
Result := False;
end;
 
function TD2DTextures.SetTransparentColor(dds: TDirectDrawSurface; PixelColor: Integer; Transparent: Boolean): Integer;
{Give a speculative transparent color value from DDS}
var
ddck: TDDColorKey;
CLL: Integer;
begin
Result := 0;
if dds.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
if dds.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetColorKey(DDCKEY_SRCBLT, ddck) = DD_OK then
Result := ddck.dwColorSpaceLowValue;
CLL := PixelColor; {have to pick up color from 0,0 pix of DIB}
if Transparent then {and must be transparent}
if (CLL <> Result) then {when different}
Result := CLL; {use our TransparentColor}
end;
 
{$IFDEF VER4UP}
function TD2DTextures.LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean;
{$ELSE}
function TD2DTextures.LoadTextures2(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean;
{$ENDIF}
var
{$IFNDEF VIDEOTEX}
VDIB: TDIB;
{$ENDIF}
Col: Integer;
T: PTextureRec;
begin
Result := True;
T := nil;
try
if dds.Modified then
begin
{search existing texture and return the pointer}
T := Addr(Texture[Find(asTexName)]);
{$IFNDEF VIDEOTEX}VDIB := TDIB.Create;{$ENDIF}
end
else
begin
D2DPruneTextures; {up to maxTexBlock textures only}
D2DMaxTextures := D2DMaxTextures + 1; {next to new space}
T := Addr(Texture[D2DMaxTextures - 1]); {is new place}
{set name}
T.Name := asTexName;
{and create video-dib object for store the picture periodically changed}
{$IFDEF VIDEOTEX}T.{$ENDIF}VDIB := TDIB.Create;
//T.VDIB.PixelFormat := MakeDIBPixelFormat(8, 8, 8);
end;
try
{the dds assigned here}
{$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Assign(dds);
{with full adjustation}
T.FloatX1 := 0; T.FloatY1 := 0; T.FloatX2 := 1; T.FloatY2 := 1;
SizeAdjust({$IFDEF VIDEOTEX}T.{$ENDIF}VDIB, T.FloatX1, T.FloatY1, T.FloatX2, T.FloatY2);
{and store 'changed' values of size here}
T.Width := {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Width;
T.Height := {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Height;
{and it have to set by dds as transparent, when it set up}
{$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Transparent := Transparent;
{get up transparent color}
Col := SetTransparentColor(dds, {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Pixels[0, 0], Transparent);
if dds.Modified then
T.D2DTexture.Load {for minimize time only load as videotexture}
else
T.D2DTexture := TDirect3DTexture2.Create(FDDraw, {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB, False); {create it}
{don't forget set transparent values on texture!}
T.D2DTexture.TransparentColor := DWORD(COL);
T.D2DTexture.Surface.TransparentColor := DWORD(COL);
T.D2DTexture.Transparent := Transparent;
finally
{$IFNDEF VIDEOTEX}
if Assigned(VDIB) then VDIB.Free;
{$ENDIF}
end;
except
{eh, sorry, when is not the dds modified, roll back and release last the VDIB}
if not dds.Modified then
if T <> nil then
begin
if Assigned({$IFDEF VIDEOTEX}T.{$ENDIF}VDIB) then
{$IFNDEF D5UP}
begin {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB.Free; {$IFDEF VIDEOTEX}T.{$ENDIF}VDIB := nil; end;
{$ELSE}
FreeAndNil({$IFDEF VIDEOTEX}T.{$ENDIF}VDIB);
{$ENDIF}
if Assigned(T.D2DTexture) then
{$IFNDEF D5UP}
begin T.D2DTexture.Free; T.D2DTexture := nil; end;
{$ELSE}
FreeAndNil(T.D2DTexture);
{$ENDIF}
 
D2DMaxTextures := D2DMaxTextures - 1; //go back
end;
Result := False;
end;
dds.Modified := False; {this flag turn off always}
end;
 
{$IFDEF VER4UP}
function TD2DTextures.LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean;
TransparentColor: Integer; asTexName: string): Boolean;
{$ELSE}
function TD2DTextures.LoadTextures3(dds: TDirectDrawSurface; Transparent: Boolean;
TransparentColor: Integer; asTexName: string): Boolean;
{$ENDIF}
function getDDSTransparentColor(DIB: TDIB; dds: TDirectDrawSurface): Integer;
var CLL: Integer; ddck: TDDColorKey;
begin
Result := 0;
if dds.{$IFDEF D3D_deprecated}IDDSurface{$ELSE}IDDSurface7{$ENDIF} <> nil then
if dds.{$IFDEF D3D_deprecated}ISurface{$ELSE}ISurface7{$ENDIF}.GetColorKey(DDCKEY_SRCBLT, ddck) = DD_OK then
Result := ddck.dwColorSpaceLowValue;
CLL := TransparentColor;
if (CLL = -1) or (cardinal(CLL) <> DIB.Pixels[0, 0]) then //when is DDS
CLL := DIB.Pixels[0, 0]; //have to pick up color from 0,0 pix of DIB
if Transparent then //and must be transparent
if CLL <> Result then //when different
Result := CLL; //use TransparentColor
end;
var
{$IFNDEF VIDEOTEX}
VDIB: TDIB;
{$ENDIF}
COL: Integer;
T: TDXTextureImage;
begin
Result := True;
try
D2DPruneTextures; {up to maxTexBlock textures only}
D2DMaxTextures := D2DMaxTextures + 1;
Texture[D2DMaxTextures - 1].Name := asTexName;
{$IFDEF VIDEOTEX}Texture[D2DMaxTextures - 1].{$ENDIF}VDIB := TDIB.Create;
try
with Texture[D2DMaxTextures - 1] do
begin
VDIB.AsSign(dds);
VDIB.Transparent := Transparent;
FloatX1 := 0; FloatY1 := 0; FloatX2 := 1; FloatY2 := 1;
SizeAdjust(VDIB, FloatX1, FloatY1, FloatX2, FloatY2);
Width := VDIB.Width;
Height := VDIB.Height;
if VDIB.HasAlphaChannel then
begin
DIB2DXT(VDIB, T);
T.ImageName := asTexName;
T.Transparent := Transparent;
D2DTexture := TDirect3DTexture2.Create(FDDraw, T, False);
D2DTexture.Transparent := Transparent;
AlphaChannel := True;
//**T.Free; DO NOT FREE - surface is lost ** FIX by JB.
end
else
begin
D2DTexture := TDirect3DTexture2.Create(FDDraw, VDIB, False);
if transparentcolor = -1 then
COL := getDDSTransparentColor(VDIB, DDS)
else
COL := D2DTexture.Surface.ColorMatch(transparentcolor);
D2DTexture.TransparentColor := DWORD(COL); //**
D2DTexture.Surface.TransparentColor := DWORD(COL); //**
D2DTexture.Transparent := Transparent;
AlphaChannel := False;
end;
end
finally
{$IFNDEF VIDEOTEX}
VDIB.Free;
{$ENDIF}
end;
except
D2DMaxTextures := D2DMaxTextures - 1;
Result := False;
end;
end;
 
{$IFDEF VER4UP}
function TD2DTextures.CanFindTexture(const Color: LongInt): Boolean;
{$ELSE}
function TD2DTextures.CanFindTexture3(const Color: LongInt): Boolean;
{$ENDIF}
var I: Integer;
begin
Result := True;
{$IFDEF VER4UP}
if Length(Texture) > 0 then
{$ELSE}
if TexLen > 0 then
{$ENDIF}
for I := 0 to D2DMaxTextures - 1 do
if Texture[I].Name = '$' + IntToStr(Color) then Exit;
Result := False;
end;
 
{$IFDEF VER4UP}
function TD2DTextures.LoadTextures(Color: LongInt): Boolean;
{$ELSE}
function TD2DTextures.LoadTextures4(Color: LongInt): Boolean;
{$ENDIF}
var
S: string;
{$IFNDEF VIDEOTEX}
VDIB: TDIB;
{$ENDIF}
begin
Result := True;
try
D2DPruneTextures; {up to maxTexBlock textures only}
D2DMaxTextures := D2DMaxTextures + 1;
S := '$' + IntToStr(Color); {this name is supplement name}
{$IFDEF VIDEOTEX}Texture[D2DMaxTextures - 1].{$ENDIF}VDIB := TDIB.Create;
try
with Texture[D2DMaxTextures - 1] do
begin
VDIB.SetSize(16, 16, 24); {16x16 good size}
VDIB.Canvas.Brush.Color := Color;
VDIB.Canvas.FillRect(Bounds(0, 0, 16, 16));
 
FloatX1 := 0;
FloatY1 := 0;
FloatX2 := 1;
FloatY2 := 1;
Name := S;
D2DTexture := TDirect3DTexture2.Create(FDDraw, VDIB, False);
D2DTexture.Transparent := False; //cannot be transparent
end;
finally
{$IFNDEF VIDEOTEX}
VDIB.Free;
{$ENDIF}
end;
except
D2DMaxTextures := D2DMaxTextures - 1;
Result := False;
end;
end;
 
{$IFDEF VIDEOTEX}
function TD2DTextures.GetTexLayoutByName(name: string): TDIB;
var
I: Integer;
begin
Result := nil;
I := Find(name);
{$IFDEF VER4UP}
if (I >= Low(Texture)) and (I <= High(Texture)) then
{$ELSE}
if I <> -1 then
{$ENDIF}
Result := Texture[I].VDIB
end;
{$ENDIF}
 
//---------------------------------------------------------------------------
 
constructor TD2D.Create(DDraw: TCustomDXDraw);
begin
inherited Create;
//after inheritance
FDDraw := DDraw;
FD2DTextureFilter := D2D_POINT {D2D_LINEAR};
{$IFNDEF D3D_deprecated}
FD2DTexture := TD2DTextures.Create(FDDraw);
{$ENDIF}
InitVertex;
{internal allocation of texture}
CanUseD2D := {$IFDEF D3D_deprecated}(do3D in FDDraw.Options) and
(doDirectX7Mode in FDDraw.Options) and
(doHardware in FDDraw.Options){$ELSE}True{$ENDIF};
FDIB := TDIB.Create;
FInitialized := False;
end;
 
destructor TD2D.Destroy;
begin
{freeing texture and stop using it}
CanUseD2D := False;
if AsSigned(FD2DTexture) then
begin
FD2DTexture.Free; {add 29.5.2005 Takanori Kawasaki}
FD2DTexture := nil;
end;
FDIB.Free;
inherited Destroy;
end;
 
procedure TD2D.InitVertex;
var i: Integer;
begin
Fillchar(FVertex, SizeOf(FVertex), 0);
for i := 0 to 3 do
begin
FVertex[i].Specular := D3DRGB(1.0, 1.0, 1.0);
FVertex[i].rhw := 1.0;
end;
end;
 
//---------------------------------------------------------------------------
 
procedure TD2D.BeginScene();
begin
asm
FINIT
end;
FDDraw.D3DDevice7.BeginScene();
asm
FINIT
end;
FDDraw.D3DDevice7.Clear(0, nil, D3DCLEAR_TARGET, 0, 0, 0);
end;
 
//---------------------------------------------------------------------------
 
procedure TD2D.EndScene();
begin
asm
FINIT
end;
FDDraw.D3DDevice7.EndScene();
asm
FINIT
end;
end;
 
function TD2D.D2DTexturedOn(Image: TPictureCollectionItem; Pattern: Integer; SubPatternRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
var I: Integer;
SrcX, SrcY, diffX: Double;
R: TRect;
Q: TTextureRec;
begin
Result := False;
FDDraw.D3DDevice7.SetTexture(0, nil);
if not FD2DTexture.CanFindTexture(Image) then {when no texture in list try load it}
if not FD2DTexture.LoadTextures(Image) then {loading is here}
Exit; {on error occurr out}
I := FD2DTexture.Find(Image.Name);
if I = -1 then Exit;
{set pattern as texture}
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
try
RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
case RenderType of
rtDraw: begin D2DEffectSolid; D2DWhite; end;
rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
end;
except
RenderError := True;
FD2DTexture.D2DPruneAllTextures;
Image.Restore;
SetD2DTextureFilter(D2D_LINEAR);
Exit;
end;
{set transparent area}
RenderError := FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent)) <> DD_OK;
{except for Draw when alphachannel exists}
{change for blend drawing but save transparent area still}
if FD2DTexture.Texture[I].AlphaChannel then
{when is Draw selected then}
if RenderType = rtDraw then
begin
D2DEffectBlend;
D2DAlphaVertex($FF);
end;
{pokud je obrazek rozdeleny, nastav oka site}
if (Image.PatternHeight <> 0) or (Image.PatternWidth <> 0) then
begin
{vezmi rect jenom dilku}
R := Image.PatternRects[Pattern];
SrcX := 1 / FD2DTexture.Texture[I].Width;
SrcY := 1 / FD2DTexture.Texture[I].Height;
//namapovani vertexu na texturu
FD2DTexture.Texture[I].FloatX1 := SrcX * R.Left;
FD2DTexture.Texture[I].FloatY1 := SrcY * R.Top;
{for meshed subimage contain one image only can be problem there}
diffX := 0.5; if Image.PatternCount = 1 then diffX := 0;
FD2DTexture.Texture[I].FloatX2 := SrcX * (R.Right - diffX);
FD2DTexture.Texture[I].FloatY2 := SrcY * (R.Bottom - diffX);
if not (
(SubPatternRect.Left = Image.PatternRects[Pattern].Left) and
(SubPatternRect.Top = Image.PatternRects[Pattern].Top) and
(SubPatternRect.Right = Image.PatternRects[Pattern].Right) and
(SubPatternRect.Bottom = Image.PatternRects[Pattern].Bottom))
then
begin
{remaping subtexture via subpattern}
Q.FloatX1 := SrcX * SubPatternRect.Left;
Q.FloatY1 := SrcY * SubPatternRect.Top;
Q.FloatX2 := SrcX * (SubPatternRect.Right - diffX);
Q.FloatY2 := SrcY * (SubPatternRect.Bottom - diffX);
D2DTU(Q); {with mirroring/flipping}
Result := not RenderError;
Exit;
end;
end; {jinak celeho obrazku}
 
{ X1,Y1 X2,Y1
0 +-----------------+ 1
| |
| |
| |
| |
2 +-----------------+ 3
X1,Y2 X2,Y2 }
D2DTU(FD2DTexture.Texture[I]);
Result := not RenderError;
end;
 
function TD2D.D2DTexturedOnDDSTex(dds: TDirectDrawSurface; SubPatternRect: TRect; Transparent: Boolean): Integer;
{special version of map for TDirectDrawSurface only}
{set up transparent color from this surface}
var
TexName: string;
begin
Result := -1;
{pokud je seznam prazdny, nahrej texturu}
if dds.Caption <> '' then TexName := dds.Caption
else TexName := IntToStr(Integer(dds)); {simple but stupid}
if not FD2DTexture.{$IFDEF VER4UP}CanFindTexture{$ELSE}CanFindTexture2{$ENDIF}(TexName) then
begin
{when texture doesn't exists, has to the Modified flag turn off}
if dds.Modified then
dds.Modified := not dds.Modified;
if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures2{$ENDIF}(dds, Transparent, TexName) then
Exit; {nepovede-li se to, pak ven}
end
else
if dds.Modified then
begin {when modifying, load texture allways}
if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures2{$ENDIF}(dds, Transparent, TexName) then
Exit; {nepovede-li se to, pak ven}
end;
Result := FD2DTexture.Find(TexName);
end;
 
function IsNotZero(Z: TRect): Boolean;
begin
Result := ((Z.Right - Z.Left) > 0) and ((Z.Bottom - Z.Top) > 0)
end;
 
function TD2D.D2DTexturedOnDDS(dds: TDirectDrawSurface; SubPatternRect: TRect; Transparent: Boolean; RenderType: TRenderType; Alpha: Byte): Boolean;
var I: Integer;
SrcX, SrcY: Double;
begin
Result := False;
FDDraw.D3DDevice7.SetTexture(0, nil);
{call a low level routine for load DDS texture}
I := D2DTexturedOnDDSTex(dds, SubPatternRect, Transparent);
if I = -1 then Exit;
{set pattern as texture}
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
try
RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
case RenderType of
rtDraw: begin D2DEffectSolid; D2DWhite; end;
rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
end;
except
RenderError := True;
FD2DTexture.D2DPruneAllTextures;
SetD2DTextureFilter(D2D_LINEAR); //default
Exit;
end;
{set transparent area}
RenderError := FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent)) <> DD_OK;
if IsNotZero(SubPatternRect) then
begin
{Set Texture Coordinates}
SrcX := 1 / FD2DTexture.Texture[I].D2DTexture.FImage.Width;
SrcY := 1 / FD2DTexture.Texture[I].D2DTexture.FImage.Height;
//namapovani vertexu na texturu
FD2DTexture.Texture[I].FloatX1 := SrcX * SubPatternRect.Left;
FD2DTexture.Texture[I].FloatY1 := SrcY * SubPatternRect.Top;
FD2DTexture.Texture[I].FloatX2 := SrcX * (SubPatternRect.Right - 0.5 { - 1}); //by Speeeder
FD2DTexture.Texture[I].FloatY2 := SrcY * (SubPatternRect.Bottom - 0.5 { - 1}); //by Speeeder
end;
D2DTU(FD2DTexture.Texture[I]);
Result := not RenderError;
end;
 
//---------------------------------------------------------------------------
 
procedure TD2D.SaveTextures(path: string);
begin
FD2DTexture.SaveTextures(path);
end;
 
procedure TD2D.SetCanUseD2D(const Value: Boolean);
begin
case Value of
False: {prestava se uzivat}
if AsSigned(FD2DTexture) and (Value <> FCanUseD2D) then
begin
FInitialized := False;
end;
True:
if Value <> FCanUseD2D then
begin
{$IFDEF D3D_deprecated}
FD2DTexture := TD2DTextures.Create(FDDraw);
TextureFilter := D2D_LINEAR;
{$ENDIF}
end
end;
FCanUseD2D := Value;
end;
 
function TD2D.GetCanUseD2D: Boolean;
begin
{$IFDEF D3D_deprecated}
{Mode has to do3D, doDirectX7Mode and doHardware}
if (do3D in FDDraw.Options) and
(doDirectX7Mode in FDDraw.Options) and
(doHardware in FDDraw.Options)
then
begin
if not FCanUseD2D then CanUseD2D := True;
end
else
if not (do3D in FDDraw.Options) or
not (doDirectX7Mode in FDDraw.Options) or
not (doHardware in FDDraw.Options)
then
if FCanUseD2D then FCanUseD2D := False; // CanUseD2D -> FCanUseD2D
{$ELSE}
FCanUseD2D := (doHardware in FDDraw.Options);
{$ENDIF}
FBitCount := FDDraw.Surface.SurfaceDesc.ddpfPixelFormat.dwRGBBitCount;
{supported 16 or 32 bitcount deepth only}
{$IFDEF D3D_deprecated}
if not (FBitCount in [16, 32]) then FCanUseD2D := False;
{$ENDIF}
if not FInitialized then
if FCanUseD2D and Assigned(FDDraw.D3DDevice7) then
begin
FDDraw.D3DDevice7.GetCaps(FD3DDevDesc7);
FInitialized := True;
end;
 
Result := FCanUseD2D;
end;
 
procedure TD2D.SetD2DTextureFilter(const Value: TD2DTextureFilter);
begin
FD2DTextureFilter := Value;
if {$IFDEF D3D_deprecated}(do3D in FDDraw.Options) and{$ENDIF} AsSigned(FDDraw.D3DDevice7) then
begin
FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter) + 1));
FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter) + 1));
end;
end;
 
procedure TD2D.SetD2DAntialiasFilter(const Value: TD3DAntialiasMode);
begin
FD2DAntialiasFilter := Value;
if {$IFDEF D3D_deprecated}(do3D in FDDraw.Options) and{$ENDIF} AsSigned(FDDraw.D3DDevice7) then
begin
FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_ANTIALIAS, Ord(Value));
end;
end;
 
procedure TD2D.D2DRect(R: TRect);
begin
FVertex[0].sx := R.Left - 0.5;
FVertex[0].sy := R.Top - 0.5;
FVertex[1].sx := R.Right - 0.5;
FVertex[1].sy := R.Top - 0.5;
FVertex[2].sx := R.Left - 0.5;
FVertex[2].sy := R.Bottom - 0.5;
FVertex[3].sx := R.Right - 0.5;
FVertex[3].sy := R.Bottom - 0.5;
end;
 
procedure TD2D.D2DTU(T: TTextureRec);
begin
if FMirrorFlipSet = [rmfMirror] then
begin
{ X1,Y1 X2,Y1
0 +-----------------+ 1
| |
| |
| |
| |
2 +-----------------+ 3
X1,Y2 X2,Y2 }
FVertex[1].tu := T.FloatX1;
FVertex[1].tv := T.FloatY1;
FVertex[0].tu := T.FloatX2;
FVertex[0].tv := T.FloatY1;
FVertex[3].tu := T.FloatX1;
FVertex[3].tv := T.FloatY2;
FVertex[2].tu := T.FloatX2;
FVertex[2].tv := T.FloatY2;
end
else
if FMirrorFlipSet = [rmfFlip] then
begin
{ X1,Y1 X2,Y1
0 +-----------------+ 1
| |
| |
| |
| |
2 +-----------------+ 3
X1,Y2 X2,Y2 }
FVertex[2].tu := T.FloatX1;
FVertex[2].tv := T.FloatY1;
FVertex[3].tu := T.FloatX2;
FVertex[3].tv := T.FloatY1;
FVertex[0].tu := T.FloatX1;
FVertex[0].tv := T.FloatY2;
FVertex[1].tu := T.FloatX2;
FVertex[1].tv := T.FloatY2;
end
else
if FMirrorFlipSet = [rmfMirror, rmfFlip] then
begin
{ X1,Y1 X2,Y1
0 +-----------------+ 1
| |
| |
| |
| |
2 +-----------------+ 3
X1,Y2 X2,Y2 }
FVertex[3].tu := T.FloatX1;
FVertex[3].tv := T.FloatY1;
FVertex[2].tu := T.FloatX2;
FVertex[2].tv := T.FloatY1;
FVertex[1].tu := T.FloatX1;
FVertex[1].tv := T.FloatY2;
FVertex[0].tu := T.FloatX2;
FVertex[0].tv := T.FloatY2;
end
else
begin
{ X1,Y1 X2,Y1
0 +-----------------+ 1
| |
| |
| |
| |
2 +-----------------+ 3
X1,Y2 X2,Y2 }
FVertex[0].tu := T.FloatX1;
FVertex[0].tv := T.FloatY1;
FVertex[1].tu := T.FloatX2;
FVertex[1].tv := T.FloatY1;
FVertex[2].tu := T.FloatX1;
FVertex[2].tv := T.FloatY2;
FVertex[3].tu := T.FloatX2;
FVertex[3].tv := T.FloatY2;
end;
end;
 
{Final public routines}
 
function TD2D.D2DRender(Image: TPictureCollectionItem; DestRect: TRect;
Pattern: Integer; SourceRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
if D2DTexturedOnSubRect(Image, Pattern, Image.PatternRects[Pattern], SourceRect, RenderType, Alpha) then
begin
D2DRect(DestRect);
Result := RenderQuad;
end;
end;
 
function TD2D.{$IFNDEF VER4UP}D2DRender2{$ELSE}D2DRender{$ENDIF}(Image: TPictureCollectionItem; R: TRect;
Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
if D2DTexturedOn(Image, Pattern, Image.PatternRects[Pattern], RenderType, Alpha) then
begin
D2DRect(R);
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect;
Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
if D2DTexturedOnDDS(Source, SourceRect, Transparent, RenderType, Alpha) then
begin
D2DRect(DestRect);
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderCol(Image: TPictureCollectionItem; R: TRect;
Pattern, Color: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
if D2DTexturedOn(Image, Pattern, Image.PatternRects[Pattern], RenderType, Alpha) then
begin
D2DRect(R);
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderColDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect;
Transparent: Boolean; Pattern, Color: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{Add}
if D2DTexturedOnDDS(Source, SourceRect, Transparent, RenderType, Alpha) then
begin
D2DRect(DestRect);
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderDrawXY(Image: TPictureCollectionItem; X, Y: Integer;
Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
var PWidth, PHeight: Integer;
begin
Result := False; if not CanUseD2D then Exit;
{Draw}
if D2DTexturedOn(Image, Pattern, Image.PatternRects[Pattern], RenderType, Alpha) then
begin
PWidth := Image.PatternWidth; if PWidth = 0 then PWidth := Image.Width;
PHeight := Image.PatternHeight; if PHeight = 0 then PHeight := Image.Height;
D2DRect(Bounds(X, Y, PWidth, PHeight));
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{Draw}
if D2DTexturedOnDDS(Source, ZeroRect, Transparent, RenderType, Alpha) then
begin
D2DRect(Bounds(X, Y, Source.Width, Source.Height));
Result := RenderQuad;
end;
end;
 
{$IFDEF VER4UP}
function TD2D.D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
SrcRect: TRect; Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{Draw}
if D2DTexturedOnDDS(Source, SrcRect, Transparent, RenderType, Alpha) then
begin
D2DRect(Bounds(X, Y, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top));
Result := RenderQuad;
end;
end;
{$ENDIF}
 
{Rotate functions}
 
procedure TD2D.D2DRotate(X, Y, W, H: Integer; Px, Py: Double; Angle: Single);
procedure SinCosS(const Theta: Single; var Sin, Cos: Single); register;
{ EAX contains address of Sin}
{ EDX contains address of Cos}
{ Theta is passed over the stack}
asm
FLD Theta
FSINCOS
FSTP DWORD PTR [EDX] // cosine
FSTP DWORD PTR [EAX] // sine
end;
const PI256 = 2 * PI / 256;
var x1, y1, up, s_angle, c_angle, s_up, c_up: Single;
begin
angle := angle * PI256; up := angle + PI / 2;
x1 := w * px; y1 := h * py;
SinCosS(angle, s_angle, c_angle);
SinCosS(up, s_up, c_up);
FVertex[0].sx := X - x1 * c_angle - y1 * c_up;
FVertex[0].sy := Y - x1 * s_angle - y1 * s_up;
FVertex[1].sx := FVertex[0].sx + W * c_angle;
FVertex[1].sy := FVertex[0].sy + W * s_angle;
FVertex[2].sx := FVertex[0].sx + H * c_up;
FVertex[2].sy := FVertex[0].sy + H * s_up;
FVertex[3].sx := FVertex[2].sx + W * c_angle;
FVertex[3].sy := FVertex[2].sy + W * s_angle;
end;
 
function TD2D.D2DRenderRotate(Image: TPictureCollectionItem; RotX, RotY,
PictWidth, PictHeight, PatternIndex: Integer; RenderType: TRenderType;
CenterX, CenterY: Double;
Angle: single; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{load textures and map it, set of effect}
if D2DTexturedOn(Image, PatternIndex, Image.PatternRects[PatternIndex], RenderType, Alpha) then
begin
{do rotate mesh}
D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
{render it}
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderRotateDDS(Image: TDirectDrawSurface; SourceRect: TRect; RotX, RotY,
PictWidth, PictHeight: Integer; RenderType: TRenderType;
CenterX, CenterY: Double; Angle: single; Alpha: Byte;
Transparent: Boolean): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{load textures and map it, set of effect}
if D2DTexturedOnDDS(Image, SourceRect, Transparent, RenderType, Alpha) then
begin
{do rotate mesh}
D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
{render it}
Result := RenderQuad;
end;
end;
 
{------------------------------------------------------------------------------}
{created 31.1.2005 JB.}
{replacement original Hori's functionality}
{24.4.2006 create WaveY as supplement like WaveX functions}
{14.5.2006 added functionality for tile drawing through PatternIndex}
 
function TD2D.D2DMeshMapToWave(dds: TDirectDrawSurface; Transparent: Boolean;
TransparentColor: Integer; X, Y, iWidth, iHeight, PatternIndex: Integer;
PatternRect: TRect;
Amp, Len, Ph, Alpha: Integer; effect: TRenderType; DoY: Boolean): Boolean;
function D2DTexturedOn(dds: TDirectDrawSurface; Transparent: Boolean; var TexNo: Integer): Boolean;
{special version of mapping for TDirectDrawSurface only}
{set up transparent color from this surface}
var I: Integer;
TexName: string;
begin
Result := False;
TexNo := -1;
RenderError := FDDraw.D3DDevice7.SetTexture(0, nil) <> DD_OK;
{pokud je seznam prazdny, nahrej texturu}
if dds.Caption <> '' then TexName := dds.Caption
else TexName := IntToStr(Integer(dds));
if not FD2DTexture.{$IFDEF VER4UP}CanFindTexture{$ELSE}CanFindTexture2{$ENDIF}(TexName) then
{nepovede-li se to, pak ven}
if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures3{$ENDIF}(dds, Transparent, TransparentColor, TexName) then Exit;
I := FD2DTexture.Find(TexName);
if I = -1 then Exit;
TexNo := I;
{set pattern as texture}
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
try
RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
//Result := True; {not RetderError}
except
RenderError := True;
Result := False;
FD2DTexture.D2DPruneAllTextures;
Exit;
end;
{set transparent area}
RenderError := FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent)) <> DD_OK;
Result := not RenderError;
end;
type
TVertexArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TD3DTLVERTEX;
{$IFNDEF VER4UP}
PVertexArray = ^TVertexArray;
{$ENDIF}
var
SVertex: {$IFDEF VER4UP}TVertexArray{$ELSE}PVertexArray{$ENDIF};
I, maxVertex, maxPix, VStepVx, TexNo, Width, Height: Integer;
VStep, VStepTo, D, Z, FX1, FX2, FY1, FY2, SX, SY, X1, Y1, X2, Y2: Extended;
R: TRect;
clr: DWORD;
begin
Result := False;
{zde uschovano maximum [0..1] po adjustaci textury, ktera nemela nektery rozmer 2^n}
{FD2DTexture.Texture[I].FloatX2;}
{FD2DTexture.Texture[I].FloatY2;}
{napr. pokud byl rozmer 0.7 pak je nutno prepocitat tento interval [0..0.7] na height}
if not D2DTexturedOn(dds, Transparent, TexNo) then Exit;
{musi se prenastavit velikost pokud je PatternIndex <> -1}
Width := iWidth;
Height := iHeight;
{remove into local variabled for multi-picture adjustation}
FX1 := FD2DTexture.Texture[TexNo].FloatX1;
FX2 := FD2DTexture.Texture[TexNo].FloatX2;
FY1 := FD2DTexture.Texture[TexNo].FloatY1;
FY2 := FD2DTexture.Texture[TexNo].FloatY2;
{when pattertindex selected, get real value of subtexture}
if (PatternIndex <> -1) {and (PatternRect <> ZeroRect)} then
begin
R := PatternRect;
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
{scale unit of full new width and height}
SX := 1 / FD2DTexture.Texture[TexNo].Width;
SY := 1 / FD2DTexture.Texture[TexNo].Height;
{remap there}
FX1 := R.Left * SX;
FX2 := R.Right * SX;
FY1 := R.Top * SY;
FY2 := R.Bottom * SY;
end;
{nastavuje se tolik vertexu, kolik je potreba}
{speculative set up of rows for better look how needed}
if not DoY then
begin
maxVertex := 2 * Trunc(Height / Len * 8);
if (maxVertex mod 2) > 0 then {top to limits}
Inc(maxVertex, 2);
if (maxVertex div 2) > Height then {correct to Height}
maxVertex := 2 * Height;
end
else
begin
maxVertex := 2 * Trunc(Width / Len * 8);
if (maxVertex mod 2) > 0 then {top to limits}
Inc(maxVertex, 2);
if (maxVertex div 2) > Width then {correct to Width}
maxVertex := 2 * Width;
end;
 
{pocet pixlu mezi ploskami}
if not DoY then
begin
repeat
if (Height mod (maxVertex div 2)) <> 0 then
Inc(maxVertex, 2);
maxPix := Height div (maxVertex div 2);
until (Height mod (maxVertex div 2)) = 0;
{krok k nastaveni vertexu}
VStep := (FY2 - FY1) / (maxVertex div 2);
end
else
begin
repeat
if (Width mod (maxVertex div 2)) <> 0 then
Inc(maxVertex, 2);
maxPix := Width div (maxVertex div 2);
until (Width mod (maxVertex div 2)) = 0;
{krok k nastaveni vertexu}
VStep := (FX2 - FX1) / (maxVertex div 2);
end;
//prostor
{$IFDEF VER4UP}
SetLength(SVertex, maxVertex);
{$ELSE}
SVertex := AllocMem(maxVertex * SizeOf(TD3DTLVERTEX));
try
{$ENDIF}
//inicializace
VStepVx := 0;
VStepTo := 0;
D := ph / (128 / PI); {shift wave}
Z := (Len / 2) / PI; {wave length to radians}
clr := D2DVertColor(Effect, Alpha); //effect cumulate to one param and one line of code
{vlastni nastaveni vertexu v pasu vertexu}
for I := 0 to maxVertex - 1 do
begin
SVertex[I].Specular := D3DRGB(1.0, 1.0, 1.0);
SVertex[I].rhw := 1.0;
SVertex[I].color := clr;
if not DoY then
case (I + 1) mod 2 of //triangle driver
1: begin
if I <> 0 then Inc(VStepVx, maxPix);
SVertex[I].sx := X + Trunc(amp * Sin((Y + VStepVx) / Z + D)) - 0.5; //levy
SVertex[I].sy := Y + VStepVx - 0.5;
if FMirrorFlipSet = [rmfMirror] then
begin
X1 := FX2; if I <> 0 then VStepTo := VStepTo + VStep;
Y1 := FY1 + VStepTo;
end
else
if FMirrorFlipSet = [rmfFlip] then
begin
X1 := FX1;
Y1 := FY2 - VStepTo;
end
else
if FMirrorFlipSet = [rmfMirror, rmfFlip] then
begin
X1 := FX2;
Y1 := FY2 - VStepTo;
end
else
begin
X1 := FX1; if I <> 0 then VStepTo := VStepTo + VStep;
Y1 := FY1 + VStepTo;
end;
SVertex[I].tu := X1;
SVertex[I].tv := Y1;
end;
0: begin
SVertex[I].sx := X + Width + Trunc(amp * Sin((Y + VStepVx) / Z + D)) - 1; //pravy
SVertex[I].sy := Y + VStepVx;
if FMirrorFlipSet = [rmfMirror] then
begin
X2 := FX1;
Y2 := FY1 + VStepTo;
end
else
if FMirrorFlipSet = [rmfFlip] then
begin
X2 := FX2;
Y2 := FY2 - VStepTo; if I <> 0 then VStepTo := VStepTo + VStep;
end
else
if FMirrorFlipSet = [rmfMirror, rmfFlip] then
begin
X2 := FX1;
Y2 := FY2 - VStepTo; if I <> 0 then VStepTo := VStepTo + VStep;
end
else
begin
X2 := FX2;
Y2 := FY1 + VStepTo;
end;
SVertex[I].tu := X2;
SVertex[I].tv := Y2;
end;
end {case}
else
case (I + 1) mod 2 of //triangle driver
0: begin
if I <> 0 then Inc(VStepVx, maxPix);
SVertex[I].sy := Y + Trunc(amp * Sin((X + VStepVx) / Z + D)) - 0.5; //hore
SVertex[I].sx := X + VStepVx - 0.5;
if FMirrorFlipSet = [rmfMirror] then
begin
Y1 := FY1; if I <> 0 then VStepTo := VStepTo + VStep;
X1 := FX2 - VStepTo;
end
else
if FMirrorFlipSet = [rmfFlip] then
begin
Y1 := FY2; if I <> 0 then VStepTo := VStepTo + VStep;
X1 := FX1 + VStepTo;
end
else
if FMirrorFlipSet = [rmfMirror, rmfFlip] then
begin
Y1 := FY2; if I <> 0 then VStepTo := VStepTo + VStep;
X1 := FX2 - VStepTo;
end
else
begin
Y1 := FY1; if I <> 0 then VStepTo := VStepTo + VStep;
X1 := FX1 + VStepTo;
end;
SVertex[I].tu := X1;
SVertex[I].tv := Y1;
end;
1: begin
SVertex[I].sy := Y + Height + Trunc(amp * Sin((X + VStepVx) / Z + D)) - 1; //dole
SVertex[I].sx := X + VStepVx;
if FMirrorFlipSet = [rmfMirror] then
begin
Y2 := FY2;
X2 := FX2 - VStepTo;
end
else
if FMirrorFlipSet = [rmfFlip] then
begin
Y2 := FY1;
X2 := FX1 + VStepTo;
end
else
if FMirrorFlipSet = [rmfMirror, rmfFlip] then
begin
Y2 := FY1;
X2 := FX2 - VStepTo;
end
else
begin
Y2 := FY2;
X2 := FX1 + VStepTo;
end;
SVertex[I].tu := X2;
SVertex[I].tv := Y2;
end;
end;
end;
{set of effect}
case Effect of
rtDraw: D2DEffectSolid;
rtBlend: D2DEffectBlend;
rtAdd: D2DEffectAdd;
rtSub: D2DEffectSub;
end;
with FDDraw.D3DDevice7 do
begin
{kreslime hned zde}//render now and here
Result := DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, SVertex[0], maxVertex, D3DDP_WAIT) = DD_OK;
//zpet hodnoty
//FIX InitVertex;
FMirrorFlipSet := []; {only for one operation, back to normal position}
{restore device status}
RenderError := SetTextureStageState(1, D3DTSS_COLOROP, Ord(D3DTOP_DISABLE)) <> DD_OK;
RenderError := SetTextureStageState(1, D3DTSS_ALPHAOP, Ord(D3DTOP_DISABLE)) <> DD_OK;
RenderError := SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0) <> DD_OK;
end;
{$IFNDEF VER4UP}
finally
FreeMem(SVertex, maxVertex * SizeOf(TD3DTLVERTEX));
end;
{$ENDIF}
end;
 
function TD2D.D2DRenderWaveX(Image: TPictureCollectionItem; X, Y, Width,
Height, PatternIndex: Integer; RenderType: TRenderType; transparent: Boolean;
amp, Len, ph, Alpha: Integer): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{load textures and map, do make wave mesh and render it}
Result := D2DMeshMapToWave(Image.PatternSurfaces[PatternIndex], transparent,
Image.FTransparentColor, X, Y, Width, Height, PatternIndex,
Image.PatternRects[PatternIndex],
amp, Len, ph, Alpha, RenderType{$IFNDEF VER4UP}, False{$ENDIF});
end;
 
function TD2D.D2DRenderWaveXDDS(Source: TDirectDrawSurface; X, Y, Width,
Height: Integer; RenderType: TRenderType; Transparent: Boolean; Amp, Len, Ph, Alpha: Integer): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{load textures and map, do make wave mesh and render it}
Result := D2DMeshMapToWave(Source, transparent, -1, X, Y, Width, Height, -1,
ZeroRect,
amp, Len, ph, Alpha, RenderType{$IFNDEF VER4UP}, False{$ENDIF});
end;
 
function TD2D.D2DRenderWaveY(Image: TPictureCollectionItem; X, Y, Width,
Height, PatternIndex: Integer; RenderType: TRenderType; Transparent: Boolean;
Amp, Len, Ph, Alpha: Integer): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{load textures and map, do make wave mesh and render it}
Result := D2DMeshMapToWave(Image.PatternSurfaces[PatternIndex], transparent,
Image.FTransparentColor, X, Y, Width, Height, PatternIndex,
Image.PatternRects[PatternIndex],
amp, Len, ph, Alpha, RenderType, True);
end;
 
function TD2D.D2DRenderWaveYDDS(Source: TDirectDrawSurface; X, Y, Width,
Height: Integer; RenderType: TRenderType; Transparent: Boolean;
Amp, Len, Ph, Alpha: Integer): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{load textures and map, do make wave mesh and render it}
Result := D2DMeshMapToWave(Source, transparent, -1, X, Y, Width, Height, -1,
ZeroRect,
amp, Len, ph, Alpha, RenderType, True);
end;
 
function TD2D.D2DTexturedOnRect(Rect: TRect; Color: LongInt): Boolean;
var I: Integer;
begin
Result := False;
FDDraw.D3DDevice7.SetTexture(0, nil);
if not FD2DTexture.{$IFDEF VER4UP}CanFindTexture{$ELSE}CanFindTexture3{$ENDIF}(Color) then {when no texture in list try load it}
if not FD2DTexture.{$IFDEF VER4UP}LoadTextures{$ELSE}LoadTextures4{$ENDIF}(Color) then Exit; {on error occurr go out}
I := FD2DTexture.Find('$' + IntToStr(Color)); //simply .. but stupid
if I = -1 then Exit;
{set pattern as texture}
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
try
RenderError := FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7) <> DD_OK;
except
RenderError := True;
FD2DTexture.D2DPruneAllTextures;
exit;
end;
{set transparent part}
FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, 0); //no transparency
 
D2DTU(FD2DTexture.Texture[I]);
Result := not RenderError;
end;
 
function TD2D.D2DTexturedOnSubRect(Image: TPictureCollectionItem;
Pattern: Integer; SubPatternRect, SubRect: TRect; RenderType: TRenderType;
Alpha: Byte): Boolean;
label
lblHop;
var
I, W, H: Integer;
SrcX, SrcY, diffX: Double;
R, tmpSubRect: TRect;
Q: TTextureRec;
qFloatX1, qFloatX2, qFloatY1, qFloatY2: Double;
begin
Result := False;
FDDraw.D3DDevice7.SetTexture(0, nil);
if not FD2DTexture.CanFindTexture(Image) then {when no texture in list try load it}
if not FD2DTexture.LoadTextures(Image) then {loading is here}
Exit; {on error occurr out}
I := FD2DTexture.Find(Image.Name);
if I = -1 then Exit;
{set pattern as texture}
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MAGFILTER, DWord(Ord(FD2DTextureFilter)+1));
// FDDraw.D3DDevice7.SetTextureStageState(0, D3DTSS_MINFILTER, DWord(Ord(FD2DTextureFilter)+1));
try
FDDraw.D3DDevice7.SetTexture(0, FD2DTexture.Texture[I].D2DTexture.Surface.IDDSurface7);
case RenderType of
rtDraw: begin D2DEffectSolid; D2DWhite; end;
rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
end;
except
RenderError := true;
FD2DTexture.D2DPruneAllTextures;
Image.Restore;
SetD2DTextureFilter(D2D_LINEAR);
Exit;
end;
{set transparent part}
FDDraw.D3DDevice7.SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Ord(FD2DTexture.Texture[I].D2DTexture.Transparent));
{except for Draw when alphachannel exists}
{change for blend drawing but save transparent area still}
if FD2DTexture.Texture[I].AlphaChannel then
{when is Draw selected then}
if RenderType = rtDraw then
begin
D2DEffectBlend; D2DAlphaVertex($FF);
end;
{pokud je obrazek rozdeleny, nastav oka site}
if (Image.PatternHeight <> 0) or (Image.PatternWidth <> 0) then
begin
{vezmi rect jenom dilku}
R := Image.PatternRects[Pattern];
 
if not CompareMem(@SubRect, @ZeroRect, SizeOf(SubRect)) then
begin
{ktere oko site to je?}
W := SubRect.Right - SubRect.Left; {takhle je siroky}
H := SubRect.Bottom - SubRect.Top; {takhle je vysoky}
tmpSubRect := Bounds(R.Left + SubRect.Left, R.Top + SubRect.Top, W, H);
if RectInRect(tmpSubRect, R) then
begin
{pokud je subrect jeste v ramci patternu, musi se posouvat podle patternindex}
Inc(R.Left, SubRect.Left);
Inc(R.Top, SubRect.Top);
if (R.Left + W) < R.Right then R.Right := R.Left + W;
if (R.Top + H) < R.Bottom then R.Bottom := R.Top + H;
goto lblHop;
end;
end;
SrcX := 1 / FD2DTexture.Texture[I].Width;
SrcY := 1 / FD2DTexture.Texture[I].Height;
//namapovani vertexu na texturu
FD2DTexture.Texture[I].FloatX1 := SrcX * R.Left;
FD2DTexture.Texture[I].FloatY1 := SrcY * R.Top;
{for meshed subimage contain one image only can be problem there}
diffX := 0.5; if Image.PatternCount = 1 then diffX := 0;
FD2DTexture.Texture[I].FloatX2 := SrcX * (R.Right - diffX);
FD2DTexture.Texture[I].FloatY2 := SrcY * (R.Bottom - diffX);
if not (
(SubPatternRect.Left = Image.PatternRects[Pattern].Left) and
(SubPatternRect.Top = Image.PatternRects[Pattern].Top) and
(SubPatternRect.Right = Image.PatternRects[Pattern].Right) and
(SubPatternRect.Bottom = Image.PatternRects[Pattern].Bottom))
then
begin
{remaping subtexture via subpattern}
Q.FloatX1 := SrcX * SubPatternRect.Left;
Q.FloatY1 := SrcY * SubPatternRect.Top;
Q.FloatX2 := SrcX * (SubPatternRect.Right - diffX);
Q.FloatY2 := SrcY * (SubPatternRect.Bottom - diffX);
D2DTU(Q); {with mirroring/flipping}
Result := True;
Exit;
end;
end; {jinak celeho obrazku}
 
if not CompareMem(@SubRect, @ZeroRect, SizeOf(SubRect)) then
if RectInRect(SubRect, Bounds(0,0, FD2DTexture.Texture[I].Width, FD2DTexture.Texture[I].Height)) then
begin
R := SubRect;
lblHop:
SrcX := 1 / FD2DTexture.Texture[I].Width;
SrcY := 1 / FD2DTexture.Texture[I].Height;
//namapovani vertexu na texturu
qFloatX1 := FD2DTexture.Texture[I].FloatX1;
qFloatY1 := FD2DTexture.Texture[I].FloatY1;
qFloatX2 := FD2DTexture.Texture[I].FloatX2;
qFloatY2 := FD2DTexture.Texture[I].FloatY2;
try
FD2DTexture.Texture[I].FloatX1 := SrcX * R.Left;
FD2DTexture.Texture[I].FloatY1 := SrcY * R.Top;
{for meshed subimage contain one image only can be problem there}
diffX := 0.5; if Image.PatternCount = 1 then diffX := 0;
FD2DTexture.Texture[I].FloatX2 := SrcX * (R.Right - diffX);
FD2DTexture.Texture[I].FloatY2 := SrcY * (R.Bottom - diffX);
{remaping subtexture via subpattern}
D2DTU(FD2DTexture.Texture[I]); {with mirroring/flipping}
Result := True;
Exit;
finally
FD2DTexture.Texture[I].FloatX1 := qFloatX1;
FD2DTexture.Texture[I].FloatY1 := qFloatY1;
FD2DTexture.Texture[I].FloatX2 := qFloatX2;
FD2DTexture.Texture[I].FloatY2 := qFloatY2;
end;
end;
 
{ X1,Y1 X2,Y1
0 +-----------------+ 1
| |
| |
| |
| |
2 +-----------------+ 3
X1,Y2 X2,Y2 }
D2DTU(FD2DTexture.Texture[I]);
Result := True;
end;
 
function TD2D.D2DRenderColoredPartition(Image: TPictureCollectionItem;
DestRect: TRect;
PatternIndex, Color, Specular: Integer;
Faded: Boolean;
SourceRect: TRect;
RenderType: TRenderType;
Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{set of effect before fade}
case RenderType of
rtDraw: D2DEffectSolid;
rtBlend: D2DEffectBlend;
rtAdd: D2DEffectAdd;
rtSub: D2DEffectSub;
end;
if Faded then D2DFade(Alpha);
 
D2DColoredVertex(Color);
if Specular <> Round(D3DRGB(1.0, 1.0, 1.0)) then
D2DSpecularVertex(Specular);
{load textures and map it}
if D2DTexturedOn(Image, PatternIndex, SourceRect, RenderType, Alpha) then
begin
D2DRect(DestRect);
{render it}
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderFillRect(Rect: TRect; RGBColor: LongInt;
RenderType: TRenderType; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
case RenderType of
rtDraw: begin D2DEffectSolid; D2DColoredVertex(RGBColor); end;
rtBlend: begin D2DEffectBlend; D2DAlphaVertex(Alpha); end;
rtAdd: begin D2DEffectAdd; D2DFade(Alpha); end;
rtSub: begin D2DEffectSub; D2DFade(Alpha); end;
end;
if D2DTexturedOnRect(Rect, RGBColor) then
begin
D2DRect(Rect);
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderRotateModeCol(Image: TPictureCollectionItem;
RenderType: TRenderType;
RotX, RotY, PictWidth, PictHeight, PatternIndex: Integer; CenterX,
CenterY: Double; Angle: single; Color: Integer; Alpha: Byte): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{set of effect before colored}
case RenderType of
rtDraw: D2DEffectSolid;
rtAdd: D2DEffectAdd;
rtSub: D2DEffectSub;
rtBlend: D2DEffectBlend;
end;
D2DFadeColored(Color, Alpha);
{load textures and map it}
if D2DTexturedOn(Image, PatternIndex, Image.PatternRects[PatternIndex], RenderType, Alpha) then
begin
{do rotate mesh}
D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
{render it}
Result := RenderQuad;
end;
end;
 
function TD2D.D2DRenderRotateModeColDDS(Image: TDirectDrawSurface;
RotX, RotY, PictWidth, PictHeight: Integer; RenderType: TRenderType;
CenterX, CenterY: Double; Angle: Single; Color: Integer; Alpha: Byte;
Transparent: Boolean): Boolean;
begin
Result := False; if not CanUseD2D then Exit;
{set of effect}
D2DFadeColored(Color, Alpha);
{load textures and map it}
if D2DTexturedOnDDS(Image, ZeroRect, Transparent, RenderType, Alpha) then
begin
{do rotate mesh}
D2DRotate(RotX, RotY, PictWidth, PictHeight, CenterX, CenterY, Angle);
{render it}
Result := RenderQuad;
end;
end;
 
procedure TD2D.D2DEffectSolid;
begin
with FDDraw.D3DDevice7 do
begin
SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0);
//SetRenderState(D3DRENDERSTATE_FILLMODE, Integer(D3DFILL_SOLID));
SetRenderState(D3DRENDERSTATE_COLORKEYENABLE, Integer(True));
SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_ONE));
end;
end;
 
procedure TD2D.D2DEffectBlend;
begin
with FDDraw.D3DDevice7 do
begin
SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 1);
SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_SRCALPHA));
SetRenderState(D3DRENDERSTATE_DESTBLEND, Integer(D3DBLEND_INVSRCALPHA));
 
SetTextureStageState(0, D3DTSS_COLOROP, Integer(D3DTOP_MODULATE));
SetTextureStageState(0, D3DTSS_COLORARG1, Integer(D3DTA_TEXTURE));
SetTextureStageState(0, D3DTSS_COLORARG2, Integer(D3DTA_CURRENT));
 
SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_BLENDDIFFUSEALPHA));
SetTextureStageState(0, D3DTSS_ALPHAARG1, Integer(D3DTA_TEXTURE));
SetTextureStageState(0, D3DTSS_ALPHAARG2, Integer(D3DTA_CURRENT));
 
SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_MODULATE));
end;
end;
 
procedure TD2D.D2DEffectAdd;
begin
with FDDraw.D3DDevice7 do
begin
SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 1);
SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_ONE));
SetRenderState(D3DRENDERSTATE_DESTBLEND, Integer(D3DBLEND_ONE));
SetTextureStageState(0, D3DTSS_ALPHAOP, Ord(D3DTOP_SELECTARG1));
SetTextureStageState(0, D3DTSS_ALPHAARG1, D3DTA_CURRENT);
SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_MODULATE));
end;
end;
 
procedure TD2D.D2DEffectSub;
begin
with FDDraw.D3DDevice7 do
begin
SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 1);
SetRenderState(D3DRENDERSTATE_SRCBLEND, Integer(D3DBLEND_ZERO));
SetRenderState(D3DRENDERSTATE_DESTBLEND, Integer(D3DBLEND_INVSRCCOLOR));
SetTextureStageState(0, D3DTSS_ALPHAOP, Ord(D3DTOP_SELECTARG1));
SetTextureStageState(0, D3DTSS_ALPHAARG1, D3DTA_CURRENT);
SetTextureStageState(0, D3DTSS_ALPHAOP, Integer(D3DTOP_MODULATE));
end;
end;
 
function TD2D.D2DAlphaVertex(Alpha: Integer): Integer;
begin
Result := RGBA_MAKE($FF, $FF, $FF, Alpha);
FVertex[0].Color := Result;
FVertex[1].Color := Result;
FVertex[2].Color := Result;
FVertex[3].Color := Result;
end;
 
procedure TD2D.D2DColoredVertex(C: Integer);
begin
C := D3DRGB(C and $FF / 255, (C shr 8) and $FF / 255, (C shr 16) and $FF / 255);
FVertex[0].Color := C;
FVertex[1].Color := C;
FVertex[2].Color := C;
FVertex[3].Color := C;
end;
 
procedure TD2D.D2DColAlpha(C, Alpha: Integer);
begin
C := D3DRGBA(C and $FF / 255, (C shr 8) and $FF / 255, (C shr 16) and $FF / 255, Alpha / 255);
FVertex[0].Color := C;
FVertex[1].Color := C;
FVertex[2].Color := C;
FVertex[3].Color := C;
end;
 
procedure TD2D.D2DSpecularVertex(C: Integer);
begin
C := D3DRGB(C and $FF / 255, (C shr 8) and $FF / 255, (C shr 16) and $FF / 255);
FVertex[0].Specular := C;
FVertex[1].Specular := C;
FVertex[2].Specular := C;
FVertex[3].Specular := C;
end;
 
procedure TD2D.D2DCol4Alpha(C1, C2, C3, C4, Alpha: Integer);
begin
FVertex[0].Color := D3DRGBA(C1 and $FF / 255, (C1 shr 8) and $FF / 255,
(C1 shr 16) and $FF / 255, Alpha / 255);
FVertex[1].Color := D3DRGBA(C2 and $FF / 255, (C2 shr 8) and $FF / 255,
(C2 shr 16) and $FF / 255, Alpha / 255);
FVertex[2].Color := D3DRGBA(C3 and $FF / 255, (C3 shr 8) and $FF / 255,
(C3 shr 16) and $FF / 255, Alpha / 255);
FVertex[3].Color := D3DRGBA(C4 and $FF / 255, (C4 shr 8) and $FF / 255,
(C4 shr 16) and $FF / 255, Alpha / 255);
end;
 
function TD2D.D2DVertColor(RenderType: TRenderType; Alpha: Byte): DWORD;
begin
case RenderType of //effect cumulate to one param and four line of code
rtDraw: Result := RGB_MAKE($FF, $FF, $FF);
rtBlend: Result := RGBA_MAKE($FF, $FF, $FF, Alpha);
rtAdd: Result := RGB_MAKE(Alpha, Alpha, Alpha);
rtSub: Result := RGB_MAKE(Alpha, Alpha, Alpha);
else
Result := RGB_MAKE($FF, $FF, $FF);
end;
end;
 
function TD2D.D2DWhite: Integer;
begin
Result := RGB_MAKE($FF, $FF, $FF);
FVertex[0].Color := Result;
FVertex[1].Color := Result;
FVertex[2].Color := Result;
FVertex[3].Color := Result;
end;
 
function TD2D.D2DFade(Alpha: Integer): Integer;
begin
Result := RGB_MAKE(Alpha, Alpha, Alpha);
FVertex[0].Color := Result;
FVertex[1].Color := Result;
FVertex[2].Color := Result;
FVertex[3].Color := Result;
end;
 
procedure TD2D.D2DFadeColored(C, Alpha: Integer);
var mult: single;
begin
mult := Alpha / 65025; //Alpha/255/255;
C := D3DRGB((C and $FF) * mult, ((C shr 8) and $FF) * mult, ((C shr 16) and $FF) * mult);
FVertex[0].Color := C;
FVertex[1].Color := C;
FVertex[2].Color := C;
FVertex[3].Color := C;
end;
 
procedure TD2D.D2DFade4Colored(C1, C2, C3, C4, Alpha: Integer);
var mult: single;
begin
mult := Alpha / 65025; //Alpha/255/255;
FVertex[0].Color := D3DRGB((C1 and $FF) * mult, ((C1 shr 8) and $FF) * mult,
((C1 shr 16) and $FF) * mult);
FVertex[1].Color := D3DRGB((C2 and $FF) * mult, ((C2 shr 8) and $FF) * mult,
((C2 shr 16) and $FF) * mult);
FVertex[2].Color := D3DRGB((C3 and $FF) * mult, ((C3 shr 8) and $FF) * mult,
((C3 shr 16) and $FF) * mult);
FVertex[3].Color := D3DRGB((C4 and $FF) * mult, ((C4 shr 8) and $FF) * mult,
((C4 shr 16) and $FF) * mult);
end;
 
function TD2D.RenderQuad: Boolean;
begin
Result := FDDraw.D3DDevice7.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, FVertex, 4, D3DDP_WAIT) <> DD_OK;
InitVertex;
FMirrorFlipSet := []; {only for one operation, back to normal position}
{restore device status}
with FDDraw.D3DDevice7 do
begin
SetTextureStageState(1, D3DTSS_COLOROP, Ord(D3DTOP_DISABLE));
SetTextureStageState(1, D3DTSS_ALPHAOP, Ord(D3DTOP_DISABLE));
SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0);
end;
end;
 
function TD2D.RenderTri: Boolean;
begin
Result := FDDraw.D3DDevice7.DrawPrimitive(D3DPT_TRIANGLESTRIP, D3DFVF_TLVERTEX, FVertex, 3, D3DDP_WAIT) <> DD_OK;
InitVertex;
FMirrorFlipSet := []; {only for one operation, back to normal position}
{restore device status}
with FDDraw.D3DDevice7 do
begin
SetTextureStageState(1, D3DTSS_COLOROP, Ord(D3DTOP_DISABLE));
SetTextureStageState(1, D3DTSS_ALPHAOP, Ord(D3DTOP_DISABLE));
SetRenderState(D3DRENDERSTATE_ALPHABLENDENABLE, 0);
end;
end;
 
procedure TD2D.D2DMeshMapToRect(R: TRect);
begin
FVertex[0].sx := R.Left - 0.5;
FVertex[0].sy := R.Top - 0.5;
FVertex[1].sx := R.Right - 0.5;
FVertex[1].sy := R.Top - 0.5;
FVertex[2].sx := R.Left - 0.5;
FVertex[2].sy := R.Bottom - 0.5;
FVertex[3].sx := R.Right - 0.5;
FVertex[3].sy := R.Bottom - 0.5;
end;
 
function TD2D.D2DInitializeSurface: Boolean;
begin
Result := False;
if Assigned(FDDraw.D3DDevice7) then
Result := FDDraw.D3DDevice7.SetRenderTarget(FDDraw.Surface.IDDSurface7, 0) = DD_OK;
end;
 
procedure TD2D.D2DUpdateTextures;
var I: Integer;
begin
{$IFDEF VER4UP}
for I := Low(FD2DTexture.Texture) to High(FD2DTexture.Texture) do
{$ELSE}
for I := 0 to FD2DTexture.TexLen - 1 do
{$ENDIF}
begin
FD2DTexture.Texture[I].Width := FD2DTexture.Texture[I].D2DTexture.Surface.Width;
FD2DTexture.Texture[I].Height := FD2DTexture.Texture[I].D2DTexture.Surface.Height;
// FD2DTexture.Texture[I].AlphaChannel := ?
end;
end;
 
{ TTrace }
 
constructor TTrace.Create(Collection: TCollection);
begin
inherited Create(Collection);
FBlit := TBlit.Create(Self);
FBlit.FEngine := TCustomDXDraw(Traces.FOwner);
end;
 
destructor TTrace.Destroy;
begin
FBlit.Free;
inherited Destroy;
end;
 
function TTrace.GetDisplayName: string;
begin
Result := inherited GetDisplayName
end;
 
procedure TTrace.SetDisplayName(const Value: string);
begin
if (Value <> '') and (AnsiCompareText(Value, GetDisplayName) <> 0) and
(Collection is TTraces) and (TTraces(Collection).IndexOf(Value) >= 0) then
raise Exception.Create(Format('Item duplicate name "%s" error', [Value]));
inherited SetDisplayName(Value);
end;
 
function TTrace.GetTraces: TTraces;
begin
if Collection is TTraces then
Result := TTraces(Collection)
else
Result := nil;
end;
 
procedure TTrace.Render(const LagCount: Integer);
begin
FBlit.DoMove(LagCount);
FBlit.DoCollision;
FBlit.DoDraw;
if Assigned(FBlit.FOnRender) then
FBlit.FOnRender(FBlit);
end;
 
function TTrace.IsActualized: Boolean;
begin
Result := FActualized;
end;
 
procedure TTrace.Assign(Source: TPersistent);
begin
if Source is TTrace then begin
//FTracePoints.Assign(TTrace(Source).FTracePoints);
FBlit.Assign(TTrace(Source).FBlit);
FTag := TTrace(Source).FTag;
end
else
inherited Assign(Source);
end;
 
function TTrace.GetActive: Boolean;
begin
Result := FBlit.FActive;
end;
 
procedure TTrace.SetActive(const Value: Boolean);
begin
FBlit.FActive := Value;
end;
 
function TTrace.GetOnCollision: TNotifyEvent;
begin
Result := FBlit.FOnCollision;
end;
 
procedure TTrace.SetOnCollision(const Value: TNotifyEvent);
begin
FBlit.FOnCollision := Value;
end;
 
function TTrace.GetOnGetImage: TNotifyEvent;
begin
Result := FBlit.FOnGetImage;
end;
 
procedure TTrace.SetOnGetImage(const Value: TNotifyEvent);
begin
FBlit.FOnGetImage := Value;
end;
 
function TTrace.GetOnDraw: TNotifyEvent;
begin
Result := FBlit.FOnDraw;
end;
 
procedure TTrace.SetOnDraw(const Value: TNotifyEvent);
begin
FBlit.FOnDraw := Value;
end;
 
function TTrace.GetOnMove: TBlitMoveEvent;
begin
Result := FBlit.FOnMove;
end;
 
procedure TTrace.SetOnMove(const Value: TBlitMoveEvent);
begin
FBlit.FOnMove := Value;
end;
 
function TTrace.Clone(NewName: string; OffsetX, OffsetY: Integer;
Angle: Single): TTrace;
var
NewItem: TTrace;
I: Integer;
begin
NewItem := GetTraces.Add;
NewItem.Assign(Self);
NewItem.Name := NewName;
for I := 0 to NewItem.Blit.GetPathCount - 1 do begin
NewItem.Blit.FPathArr[I].X := NewItem.Blit.FPathArr[I].X + OffsetX;
NewItem.Blit.FPathArr[I].Y := NewItem.Blit.FPathArr[I].Y + OffsetY;
end;
Result := NewItem
end;
 
function TTrace.GetOnRender: TOnRender;
begin
Result := FBlit.FOnRender;
end;
 
procedure TTrace.SetOnRender(const Value: TOnRender);
begin
FBlit.FOnRender := Value;
end;
 
{ TTraces }
 
constructor TTraces.Create(AOwner: TComponent);
begin
inherited Create(TTrace);
FOwner := AOwner;
end;
 
destructor TTraces.Destroy;
begin
inherited Destroy;
end;
 
function TTraces.Add: TTrace;
begin
Result := TTrace(inherited Add);
end;
 
function TTraces.Find(const Name: string): TTrace;
var
i: Integer;
begin
i := IndexOf(Name);
if i = -1 then
raise EDXTracerError.CreateFmt('Tracer item named %s not found', [Name]);
Result := Items[i];
end;
 
function TTraces.GetItem(Index: Integer): TTrace;
begin
Result := TTrace(inherited GetItem(Index));
end;
 
procedure TTraces.SetItem(Index: Integer;
Value: TTrace);
begin
inherited SetItem(Index, Value);
end;
 
procedure TTraces.Update(Item: TCollectionItem);
begin
inherited Update(Item);
end;
 
{$IFDEF VER4UP}
function TTraces.Insert(Index: Integer): TTrace;
begin
Result := TTrace(inherited Insert(Index));
end;
{$ENDIF}
 
function TTraces.GetOwner: TPersistent;
begin
Result := FOwner;
end;
 
{ TBlit }
 
function TBlit.GetWorldX: Double;
begin
if Parent <> nil then
Result := Parent.WorldX + FBlitRec.FX
else
Result := FBlitRec.FX;
end;
 
function TBlit.GetWorldY: Double;
begin
if Parent <> nil then
Result := Parent.WorldY + FBlitRec.FY
else
Result := FBlitRec.FY;
end;
 
procedure TBlit.DoMove(LagCount: Integer);
var
MoveIt: Boolean;
begin
if not FBlitRec.FMoved then Exit;
if AsSigned(FOnMove) then begin
MoveIt := True; {if nothing then reanimate will force}
FOnMove(Self, LagCount, MoveIt); {when returned MoveIt = true still that do not move}
if MoveIt then
ReAnimate(LagCount); //for reanimation
end
else begin
ReAnimate(LagCount);
end;
{there is moving to next foot of the path}
if Active then
if GetPathCount > 0 then begin
Dec(FCurrentTime, LagCount);
if FCurrentTime < 0 then begin
if FBustrofedon then begin
case FCurrentDirection of
True: begin
Inc(FCurrentPosition); //go forward
if FCurrentPosition = (GetPathCount - 1) then
FCurrentDirection := not FCurrentDirection //change direction
end;
False: begin
Dec(FCurrentPosition); //go backward
if FCurrentPosition = 0 then
FCurrentDirection := not FCurrentDirection //change direction
end;
end;
end
else
if FCurrentPosition < (GetPathCount - 1) then begin
Inc(FCurrentPosition) //go forward only
end
else
if FMovingRepeatly then
FCurrentPosition := 0; {return to start}
{get actual new value for showing time}
{must be pick-up there, after change of the current position}
FCurrentTime := Path[FCurrentPosition].StayOn; {cas mezi pohyby}
end;
X := Path[FCurrentPosition].X;
Y := Path[FCurrentPosition].Y;
end;
{}
end;
 
function TBlit.GetDrawImageIndex: Integer;
begin
Result := FBlitRec.FAnimStart + Trunc(FBlitRec.FAnimPos);
end;
 
procedure TBlit.DoDraw;
var
f: TRenderMirrorFlipSet;
r: TRect;
begin
with FBlitRec do begin
if not FVisible then Exit;
if FImage = nil then DoGetImage;
if FImage = nil then Exit;
{owner draw called here}
if AsSigned(FOnDraw) then
FOnDraw(Self)
else
{when is not owner draw then go here}
begin
f := [];
if FMirror then f := f + [rmfMirror];
if FFlip then f := f + [rmfFlip];
r := Bounds(Round(FX), Round(FY), FImage.Width, FImage.Height);
DXDraw_Render(FEngine, FImage, r,
GetDrawImageIndex, FBlurImageArr, FBlurImage, FTextureFilter, f, FBlendMode, FAngle,
FAlpha, FCenterX, FCenterY, FScale, FWaveType, FAmplitude, FAmpLength, FPhase);
end;
end
end;
 
function Mod2f(i: Double; i2: Integer): Double;
begin
if i2 = 0 then
Result := i
else
begin
Result := i - Round(i / i2) * i2;
if Result < 0 then
Result := i2 + Result;
end;
end;
 
procedure TBlit.ReAnimate(MoveCount: Integer);
var I: Integer;
begin
with FBlitRec do begin
FAnimPos := FAnimPos + FAnimSpeed * MoveCount;
 
if FAnimLooped then
begin
if FAnimCount > 0 then
FAnimPos := Mod2f(FAnimPos, FAnimCount)
else
FAnimPos := 0;
end
else
begin
if Round(FAnimPos) >= FAnimCount then
begin
FAnimPos := FAnimCount - 1;
FAnimSpeed := 0;
end;
if FAnimPos < 0 then
begin
FAnimPos := 0;
FAnimSpeed := 0;
end;
end;
{incerease or decrease speed}
if (FEnergy <> 0) then begin
FSpeedX := FSpeedX + FSpeedX * FEnergy;
FSpeedY := FSpeedY + FSpeedY * FEnergy;
end;
{adjust with speed}
if (FSpeedX > 0) or (FSpeedY > 0) then begin
FX := FX + FSpeedX * MoveCount;
FY := FY + FSpeedY * MoveCount;
end;
{and gravity aplicable}
if (FGravityX > 0) or (FGravityY > 0) then begin
FX := FX + FGravityX * MoveCount;
FY := FY + FGravityY * MoveCount;
end;
if FBlurImage then begin
{ale jen jsou-li jine souradnice}
if (FBlurImageArr[High(FBlurImageArr)].eX <> Round(WorldX)) or
(FBlurImageArr[High(FBlurImageArr)].eY <> Round(WorldY)) then begin
for i := Low(FBlurImageArr) + 1 to High(FBlurImageArr) do begin
FBlurImageArr[i - 1] := FBlurImageArr[i];
{adjust the blur intensity}
FBlurImageArr[i - 1].eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * (i - 1);
end;
with FBlurImageArr[High(FBlurImageArr)] do begin
eX := Round(WorldX);
eY := Round(WorldY);
ePatternIndex := GetDrawImageIndex;
eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * High(FBlurImageArr);
eBlendMode := FBlendMode;
eActive := True;
end;
end;
end;
end;
end;
 
function TBlit.DoCollision: TBlit;
var
i, maxzaxis: Integer;
begin
Result := nil;
if not FBlitRec.FCollisioned then Exit;
if AsSigned(FOnCollision) then
FOnCollision(Self)
else begin
{over z axis}
maxzaxis := 0;
for i := 0 to FEngine.Traces.Count - 1 do
maxzaxis := Max(maxzaxis, FEngine.Traces.Items[i].FBlit.Z);
{for all items}
for i := 0 to FEngine.Traces.Count - 1 do
{no self item}
if FEngine.Traces.Items[i].FBlit <> Self then
{through engine}
with FEngine.Traces.Items[i] do
{test overlap}
if OverlapRect(Bounds(Round(FBlit.WorldX), Round(FBlit.WorldY),
FBlit.Width, FBlit.Height), Bounds(Round(WorldX), Round(WorldY), Width, Height)) then
begin
{if any, then return first blit}
Result := FBlit;
{and go out}
Break;
end;
end;
end;
 
procedure TBlit.DoGetImage;
begin
{init image when object come from form}
if FImage = nil then
if AsSigned(FOnGetImage) then begin
FOnGetImage(Self);
if FImage = nil then
raise EDXBlitError.Create('Undefined image file!');
FBlitRec.FWidth := FImage.Width;
FBlitRec.FHeight := FImage.Height;
end;
end;
 
constructor TBlit.Create(AParent: TObject);
begin
inherited Create;
FParent := nil;
if AParent is TBlit then
FParent := TBlit(AParent);
FillChar(FBlitRec, SizeOf(FBlitRec), 0);
with FBlitRec do begin
FCollisioned := True; {can be collisioned}
FMoved := True; {can be moved}
FVisible := True; {can be rendered}
FAnimCount := 0;
FAnimLooped := False;
FAnimPos := 0;
FAnimSpeed := 0;
FAnimStart := 0;
FAngle := 0;
FAlpha := $FF;
FCenterX := 0.5;
FCenterY := 0.5;
FScale := 1;
FBlendMode := rtDraw;
FAmplitude := 0;
FAmpLength := 0;
FPhase := 0;
FWaveType := wtWaveNone;
FSpeedX := 0;
FSpeedY := 0;
FGravityX := 0;
FGravityY := 0;
FEnergy := 0;
FBlurImage := False;
FMirror := False;
FFlip := False;
end;
FillChar(FBlurImageArr, SizeOf(FBlitRec), 0);
FActive := True; {active on}
FMovingRepeatly := True;
{super private}
FCurrentTime := 0;
FCurrentPosition := 0;
FCurrentDirection := True;
end;
 
destructor TBlit.Destroy;
begin
{$IFDEF VER4UP}
SetLength(FPathArr, 0);
{$ELSE}
SetPathLen(0);
{$ENDIF}
inherited;
end;
 
function TBlit.GetMoved: Boolean;
begin
Result := FBlitRec.FMoved;
end;
 
procedure TBlit.SetMoved(const Value: Boolean);
begin
FBlitRec.FMoved := Value;
end;
 
function TBlit.GetWaveType: TWaveType;
begin
Result := FBlitRec.FWaveType;
end;
 
procedure TBlit.SetWaveType(const Value: TWaveType);
begin
FBlitRec.FWaveType := Value;
end;
 
function TBlit.GetAmplitude: Integer;
begin
Result := FBlitRec.FAmplitude;
end;
 
procedure TBlit.SetAmplitude(const Value: Integer);
begin
FBlitRec.FAmplitude := Value;
end;
 
function TBlit.GetAnimStart: Integer;
begin
Result := FBlitRec.FAnimStart;
end;
 
procedure TBlit.SetAnimStart(const Value: Integer);
begin
FBlitRec.FAnimStart := Value;
end;
 
function TBlit.GetAmpLength: Integer;
begin
Result := FBlitRec.FAmpLength;
end;
 
procedure TBlit.SetAmpLength(const Value: Integer);
begin
FBlitRec.FAmpLength := Value;
end;
 
function TBlit.GetWidth: Integer;
begin
Result := FBlitRec.FWidth;
end;
 
procedure TBlit.SetWidth(const Value: Integer);
begin
FBlitRec.FWidth := Value;
end;
 
function TBlit.GetGravityX: Single;
begin
Result := FBlitRec.FGravityX;
end;
 
procedure TBlit.SetGravityX(const Value: Single);
begin
FBlitRec.FGravityX := Value;
end;
 
function TBlit.StoreGravityX: Boolean;
begin
Result := FBlitRec.FGravityX <> 1.0;
end;
 
function TBlit.GetPhase: Integer;
begin
Result := FBlitRec.FPhase;
end;
 
procedure TBlit.SetPhase(const Value: Integer);
begin
FBlitRec.FPhase := Value;
end;
 
function TBlit.GetAnimPos: Double;
begin
Result := FBlitRec.FAnimPos;
end;
 
procedure TBlit.SetAnimPos(const Value: Double);
begin
FBlitRec.FAnimPos := Value;
end;
 
function TBlit.StoreAnimPos: Boolean;
begin
Result := FBlitRec.FAnimPos <> 0;
end;
 
function TBlit.GetFlip: Boolean;
begin
Result := FBlitRec.FFlip;
end;
 
procedure TBlit.SetFlip(const Value: Boolean);
begin
FBlitRec.FFlip := Value;
end;
 
function TBlit.GetGravityY: Single;
begin
Result := FBlitRec.FGravityY;
end;
 
procedure TBlit.SetGravityY(const Value: Single);
begin
FBlitRec.FGravityY := Value;
end;
 
function TBlit.StoreGravityY: Boolean;
begin
Result := FBlitRec.FGravityY <> 1.0;
end;
 
function TBlit.GetSpeedX: Single;
begin
Result := FBlitRec.FSpeedX;
end;
 
procedure TBlit.SetSpeedX(const Value: Single);
begin
FBlitRec.FSpeedX := Value;
end;
 
function TBlit.StoreSpeedX: Boolean;
begin
Result := FBlitRec.FSpeedX <> 0;
end;
 
function TBlit.GetSpeedY: Single;
begin
Result := FBlitRec.FSpeedY;
end;
 
procedure TBlit.SetSpeedY(const Value: Single);
begin
FBlitRec.FSpeedY := Value;
end;
 
function TBlit.StoreSpeedY: Boolean;
begin
Result := FBlitRec.FSpeedY <> 0;
end;
 
function TBlit.GetCenterX: Double;
begin
Result := FBlitRec.FCenterX;
end;
 
procedure TBlit.SetCenterX(const Value: Double);
begin
FBlitRec.FCenterX := Value;
end;
 
function TBlit.StoreCenterX: Boolean;
begin
Result := FBlitRec.FCenterX <> 0.5;
end;
 
function TBlit.GetAngle: Single;
begin
Result := FBlitRec.FAngle;
end;
 
procedure TBlit.SetAngle(const Value: Single);
begin
FBlitRec.FAngle := Value;
end;
 
function TBlit.StoreAngle: Boolean;
begin
Result := FBlitRec.FAngle <> 0;
end;
 
function TBlit.GetBlurImage: Boolean;
begin
Result := FBlitRec.FBlurImage;
end;
 
procedure TBlit.SetBlurImage(const Value: Boolean);
begin
FBlitRec.FBlurImage := Value;
end;
 
function TBlit.GetCenterY: Double;
begin
Result := FBlitRec.FCenterY;
end;
 
procedure TBlit.SetCenterY(const Value: Double);
begin
FBlitRec.FCenterY := Value;
end;
 
function TBlit.StoreCenterY: Boolean;
begin
Result := FBlitRec.FCenterY <> 0.5;
end;
 
function TBlit.GetBlendMode: TRenderType;
begin
Result := FBlitRec.FBlendMode;
end;
 
procedure TBlit.SetBlendMode(const Value: TRenderType);
begin
FBlitRec.FBlendMode := Value;
end;
 
function TBlit.GetAnimSpeed: Double;
begin
Result := FBlitRec.FAnimSpeed;
end;
 
procedure TBlit.SetAnimSpeed(const Value: Double);
begin
FBlitRec.FAnimSpeed := Value;
end;
 
function TBlit.StoreAnimSpeed: Boolean;
begin
Result := FBlitRec.FAnimSpeed <> 0;
end;
 
function TBlit.GetZ: Integer;
begin
Result := FBlitRec.FZ;
end;
 
procedure TBlit.SetZ(const Value: Integer);
begin
FBlitRec.FZ := Value;
end;
 
function TBlit.GetMirror: Boolean;
begin
Result := FBlitRec.FMirror;
end;
 
procedure TBlit.SetMirror(const Value: Boolean);
begin
FBlitRec.FMirror := Value;
end;
 
function TBlit.GetX: Double;
begin
Result := FBlitRec.FX;
end;
 
procedure TBlit.SetX(const Value: Double);
begin
FBlitRec.FX := Value;
end;
 
function TBlit.GetVisible: Boolean;
begin
Result := FBlitRec.FVisible;
end;
 
procedure TBlit.SetVisible(const Value: Boolean);
begin
FBlitRec.FVisible := Value;
end;
 
function TBlit.GetY: Double;
begin
Result := FBlitRec.FY;
end;
 
procedure TBlit.SetY(const Value: Double);
begin
FBlitRec.FY := Value;
end;
 
function TBlit.GetAlpha: Byte;
begin
Result := FBlitRec.FAlpha;
end;
 
procedure TBlit.SetAlpha(const Value: Byte);
begin
FBlitRec.FAlpha := Value;
end;
 
function TBlit.GetEnergy: Single;
begin
Result := FBlitRec.FEnergy;
end;
 
procedure TBlit.SetEnergy(const Value: Single);
begin
FBlitRec.FEnergy := Value;
end;
 
function TBlit.StoreEnergy: Boolean;
begin
Result := FBlitRec.FEnergy <> 0;
end;
 
function TBlit.GetCollisioned: Boolean;
begin
Result := FBlitRec.FCollisioned;
end;
 
procedure TBlit.SetCollisioned(const Value: Boolean);
begin
FBlitRec.FCollisioned := Value;
end;
 
function TBlit.GetAnimLooped: Boolean;
begin
Result := FBlitRec.FAnimLooped;
end;
 
procedure TBlit.SetAnimLooped(const Value: Boolean);
begin
FBlitRec.FAnimLooped := Value;
end;
 
function TBlit.GetHeight: Integer;
begin
Result := FBlitRec.FHeight;
end;
 
procedure TBlit.SetHeight(const Value: Integer);
begin
FBlitRec.FHeight := Value;
end;
 
function TBlit.GetScale: Double;
begin
Result := FBlitRec.FScale;
end;
 
procedure TBlit.SetScale(const Value: Double);
begin
FBlitRec.FScale := Value;
end;
 
function TBlit.StoreScale: Boolean;
begin
Result := FBlitRec.FScale <> 1.0;
end;
 
function TBlit.GetAnimCount: Integer;
begin
Result := FBlitRec.FAnimCount;
end;
 
procedure TBlit.SetAnimCount(const Value: Integer);
begin
FBlitRec.FAnimCount := Value;
end;
 
function TBlit.GetTextureFilter: TD2DTextureFilter;
begin
Result := FBlitRec.FTextureFilter;
end;
 
procedure TBlit.SetTextureFilter(const Value: TD2DTextureFilter);
begin
FBlitRec.FTextureFilter := Value;
end;
 
function TBlit.GetBoundsRect: TRect;
begin
Result := Bounds(Round(WorldX), Round(WorldY), Width, Height);
end;
 
function TBlit.GetClientRect: TRect;
begin
Result := Bounds(0, 0, Width, Height);
end;
 
function TBlit.GetBlitAt(X, Y: Integer): TBlit;
 
procedure BlitAt(X, Y: Double; Blit: TBlit);
var
i: Integer;
X2, Y2: Double;
begin
if Blit.Visible and PointInRect(Point(Round(X), Round(Y)),
Bounds(Round(Blit.X), Round(Blit.Y), Blit.Width, Blit.Width)) then
begin
if (Result = nil) or (Blit.Z > Result.Z) then
Result := Blit; {uniquelly - where will be store last blit}
end;
 
X2 := X - Blit.X;
Y2 := Y - Blit.Y;
for i := 0 to Blit.Engine.FTraces.Count - 1 do
BlitAt(X2, Y2, Blit.Engine.FTraces.Items[i].FBlit);
end;
 
var
i: Integer;
X2, Y2: Double;
begin
Result := nil;
 
X2 := X - Self.X;
Y2 := Y - Self.Y;
for i := 0 to Engine.FTraces.Count - 1 do
BlitAt(X2, Y2, Engine.FTraces.Items[i].FBlit);
end;
 
procedure TBlit.SetPathLen(Len: Integer);
var I, L: Integer;
begin
{$IFDEF VER4UP}
if Length(FPathArr) <> Len then
{$ELSE}
if FPathLen <> Len then
{$ENDIF}
begin
L := Len;
if Len <= 0 then L := 0;
{$IFDEF VER4UP}
SetLength(FPathArr, L);
for I := Low(FPathArr) to High(FPathArr) do begin
FillChar(FPathArr[i], SizeOf(FPathArr), 0);
FPathArr[i].StayOn := 25;
end;
{$ELSE}
FPathLen := L;
if FPathArr = nil then
FPAthArr := AllocMem(FPathLen * SizeOf(TPath))
else
{alokuj pamet}
ReallocMem(FPathArr, FPathLen * SizeOf(TPath));
if Assigned(FPathArr) then begin
FillChar(FPathArr^, FPathLen * SizeOf(TPath), 0);
for I := 0 to FPathLen do
FPathArr[i].StayOn := 25;
end
{$ENDIF}
end;
end;
 
function TBlit.IsPathEmpty: Boolean;
begin
{$IFNDEF VER4UP}
Result := FPathLen = 0;
{$ELSE}
Result := Length(FPathArr) = 0;
{$ENDIF}
end;
 
function TBlit.GetPathCount: Integer;
begin
{$IFNDEF VER4UP}
Result := FPathLen;
{$ELSE}
Result := Length(FPathArr);
{$ENDIF}
end;
 
function TBlit.GetPath(index: Integer): TPath;
begin
{$IFDEF VER4UP}
if (index >= Low(FPathArr)) and (index <= High(FPathArr)) then
{$ELSE}
if (index >= 0) and (index < FPathLen) then
{$ENDIF}
Result := FPathArr[index]
else
raise Exception.Create('Bad path index!');
end;
 
procedure TBlit.SetPath(index: Integer; const Value: TPath);
begin
{$IFDEF VER4UP}
if (index >= Low(FPathArr)) and (index <= High(FPathArr)) then
{$ELSE}
if (index >= 0) and (index < FPathLen) then
{$ENDIF}
FPathArr[index] := Value
else
raise Exception.Create('Bad path index!');
end;
 
procedure TBlit.ReadPaths(Stream: TStream);
var
PathLen: Integer;
begin
{nacti delku}
Stream.ReadBuffer(PathLen, SizeOf(PathLen));
SetPathLen(PathLen);
Stream.ReadBuffer(FPathArr[0], PathLen * SizeOf(TPath));
end;
 
procedure TBlit.WritePaths(Stream: TStream);
var
PathLen: Integer;
begin
PathLen := GetPathCount;
Stream.WriteBuffer(PathLen, SizeOf(PathLen));
Stream.WriteBuffer(FPathArr[0], PathLen * SizeOf(TPath));
end;
 
procedure TBlit.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('Paths', ReadPaths, WritePaths, not IsPathEmpty);
end;
 
procedure TBlit.Assign(Source: TPersistent);
var I: Integer;
begin
if Source is TBlit then
begin
{$IFDEF VER4UP}
I := Length(TBlit(Source).FPathArr);
{$ELSE}
I := FPathLen;
{$ENDIF}
SetPathLen(I);
if I > 0 then
Move(TBlit(Source).FPathArr[0], FPathArr[0], I * SizeOf(TPath));
FBlitRec := TBlit(Source).FBlitRec;
FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0);
FActive := TBlit(Source).FActive;
FMovingRepeatly := TBlit(Source).FMovingRepeatly;
FImage := nil;
FOnMove := TBlit(Source).FOnMove;
FOnDraw := TBlit(Source).FOnDraw;
FOnCollision := TBlit(Source).FOnCollision;
FOnGetImage := TBlit(Source).FOnGetImage;
FEngine := TBlit(Source).FEngine;
end
else
inherited Assign(Source);
end;
 
function TBlit.GetMovingRepeatly: Boolean;
begin
Result := FMovingRepeatly;
end;
 
procedure TBlit.SetMovingRepeatly(const Value: Boolean);
begin
FMovingRepeatly := Value;
end;
 
function TBlit.GetBustrofedon: Boolean;
begin
Result := FBustrofedon;
end;
 
procedure TBlit.SetBustrofedon(const Value: Boolean);
begin
FBustrofedon := Value;
end;
 
{ utility draw }
 
procedure DXDraw_Draw(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; TextureFilter: TD2DTextureFilter;
MirrorFlip: TRenderMirrorFlipSet;
BlendMode: TRenderType; Angle: Single; Alpha: Byte;
CenterX: Double; CenterY: Double;
Scale: Single); {$IFDEF VER9UP}inline;{$ENDIF}
var
// r: TRect;
width, height: Integer;
begin
if not Assigned(DXDraw.Surface) then Exit;
if not Assigned(Image) then Exit;
if Scale <> 1.0 then begin
width := Round(Scale * Image.Width);
height := Round(Scale * Image.Height);
end
else begin
width := Image.Width;
height := Image.Height;
end;
//r := Bounds(X, Y, width, height);
DXDraw.TextureFilter(TextureFilter);
DXDraw.MirrorFlip(MirrorFlip);
case BlendMode of
rtDraw: begin
if Angle = 0 then
Image.StretchDraw(DXDraw.Surface, Rect, Pattern)
else
Image.DrawRotate(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle);
end;
rtBlend: begin
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateAlpha(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
rtAdd: begin
if Angle = 0 then
Image.DrawAdd(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateAdd(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
rtSub: begin
if Angle = 0 then
Image.DrawSub(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateSub(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
end; {case}
end;
 
procedure DXDraw_Paint(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
TextureFilter: TD2DTextureFilter;
MirrorFlip: TRenderMirrorFlipSet;
BlendMode: TRenderType;
Angle: Single;
Alpha: Byte;
CenterX: Double; CenterY: Double); {$IFDEF VER9UP}inline;{$ENDIF}
var
rr: TRect;
i, width, height: Integer;
begin
if not Assigned(DXDraw.Surface) then Exit;
if not Assigned(Image) then Exit;
width := Image.Width;
height := Image.Height;
//rr := Bounds(X, Y, width, height);
//DXDraw.MirrorFlip(MirrorFlip);
DXDraw.TextureFilter(TextureFilter);
case BlendMode of
rtDraw: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, rr, BlurImageArr[i].ePatternIndex, BlurImageArr[i].eIntensity)
else
Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, BlurImageArr[i].ePatternIndex, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.StretchDraw(DXDraw.Surface, Rect, Pattern)
else
Image.DrawRotate(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle);
end;
rtBlend: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
else
Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateAlpha(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
rtAdd: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
if Angle = 0 then
Image.DrawAdd(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
else
Image.DrawRotateAdd(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.DrawAdd(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateAdd(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
rtSub: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Width, Height);
if Angle = 0 then
Image.DrawSub(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
else
Image.DrawRotateSub(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.DrawSub(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateSub(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
end; {case}
end;
 
procedure DXDraw_Render(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
TextureFilter: TD2DTextureFilter; MirrorFlip: TRenderMirrorFlipSet;
BlendMode: TRenderType;
Angle: Single;
Alpha: Byte;
CenterX: Double; CenterY: Double;
Scale: Single;
WaveType: TWaveType;
Amplitude: Integer; AmpLength: Integer; Phase: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
var
rr: TRect;
i, width, height: Integer;
begin
if not Assigned(DXDraw.Surface) then Exit;
if not Assigned(Image) then Exit;
if Scale <> 1.0 then begin
width := Round(Scale * Image.Width);
height := Round(Scale * Image.Height);
end
else begin
width := Image.Width;
height := Image.Height;
end;
//r := Bounds(X, Y, width, height);
DXDraw.TextureFilter(TextureFilter);
DXDraw.MirrorFlip(MirrorFlip);
case BlendMode of
rtDraw:
begin
case WaveType of
wtWaveNone:
begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, rr, BlurImageArr[i].ePatternIndex, BlurImageArr[i].eIntensity)
else
Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, BlurImageArr[i].ePatternIndex, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.StretchDraw(DXDraw.Surface, Rect, Pattern)
else
Image.DrawRotate(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle);
end;
wtWaveX: Image.DrawWaveX(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase);
wtWaveY: Image.DrawWaveY(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase);
end;
end;
rtBlend: begin
case WaveType of
wtWaveNone: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
else
Image.DrawRotateAlpha(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.DrawAlpha(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateAlpha(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
wtWaveX: Image.DrawWaveXAlpha(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
wtWaveY: Image.DrawWaveYAlpha(DXDraw.Surface, Round(Rect.Top), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
end;
end;
rtAdd: begin
case WaveType of
wtWaveNone: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
if Angle = 0 then
Image.DrawAdd(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
else
Image.DrawRotateAdd(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.DrawAdd(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateAdd(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
wtWaveX: Image.DrawWaveXAdd(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
wtWaveY: Image.DrawWaveYAdd(DXDraw.Surface, Round(Rect.Top), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
end;
end;
rtSub: begin
case WaveType of
wtWaveNone: begin
if BlurImage then begin
for i := Low(BlurImageArr) to High(BlurImageArr) do if BlurImageArr[i].eActive then begin
DXDraw.MirrorFlip(MirrorFlip);
rr := Bounds(BlurImageArr[i].eX, BlurImageArr[i].eY, Round(Scale * Width), Round(Scale * Height));
if Angle = 0 then
Image.DrawSub(DXDraw.Surface, rr, Pattern, BlurImageArr[i].eIntensity)
else
Image.DrawRotateSub(DXDraw.Surface, (rr.Left + rr.Right) div 2,
(rr.Top + rr.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, BlurImageArr[i].eAngle, BlurImageArr[i].eIntensity);
if BlurImageArr[i].eIntensity > 0 then Dec(BlurImageArr[i].eIntensity) else FillChar(BlurImageArr[i], SizeOf(BlurImageArr[i]), 0);
end;
end;
DXDraw.MirrorFlip(MirrorFlip);
if Angle = 0 then
Image.DrawSub(DXDraw.Surface, Rect, Pattern, Alpha)
else
Image.DrawRotateSub(DXDraw.Surface, (Rect.Left + Rect.Right) div 2,
(Rect.Top + Rect.Bottom) div 2,
Width, Height, Pattern, CenterX, CenterY, Angle, Alpha);
end;
wtWaveX: Image.DrawWaveXSub(DXDraw.Surface, Round(Rect.Left), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
wtWaveY: Image.DrawWaveYSub(DXDraw.Surface, Round(Rect.Top), Round(Rect.Top), Width, Height, Pattern, Amplitude, AmpLength, Phase, Alpha);
end;
end;
end; {case}
end;
 
initialization
_DXTextureImageLoadFuncList := TList.Create;
TDXTextureImage.RegisterLoadFunc(DXTextureImage_LoadDXTextureImageFunc); //delete Mr.Kawasaki
TDXTextureImage.RegisterLoadFunc(DXTextureImage_LoadBitmapFunc);
finalization
TDXTextureImage.UnRegisterLoadFunc(DXTextureImage_LoadDXTextureImageFunc); //delete Mr.Kawasaki
TDXTextureImage.UnRegisterLoadFunc(DXTextureImage_LoadBitmapFunc);
_DXTextureImageLoadFuncList.Free;
{ driver free }
DirectDrawDrivers.Free;
end.
 
 
{$IFDEF _DMO_}DirectDrawDriversEx.Free;{$ENDIF}
end.
/VCL_DELPHIX_D6/DXETable.pas
5,12 → 5,31
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, SysUtils, DirectX;
Windows, SysUtils,
{$IfDef StandardDX}
{$ifdef DX7}
DirectDraw, Direct3D,DirectInput,DirectPlay,DirectSound;
{$else}
{$IfDef DX9}
DirectDraw, Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8, DirectInput, DirectPlay8, DirectSound;
// {$Else}
// {$IfDef DX81}
// D3DX8, Direct3D8, DirectInput8, DirectXGraphics, DX7toDX8, DirectPlay8;
// {$Else}
// DirectInput, Direct3D, Direct3DRM, DirectPlay;
{$EndIf}
{$EndIf}
{$Else}
DirectX;
{$EndIf}
 
 
function WindowsErrorMsg(ErrorCode: HRESULT): string;
function DDrawErrorMsg(ErrorCode: HRESULT): string;
function D3DErrorMsg(ErrorCode: HRESULT): string;
{$IFDEF D3DRM}
function D3DRMErrorMsg(ErrorCode: HRESULT): string;
{$ENDIF}
function DSoundErrorMsg(ErrorCode: HRESULT): string;
function DInputErrorMsg(ErrorCode: HRESULT): string;
function DPlayErrorMsg(ErrorCode: HRESULT): string;
204,7 → 223,7
Result := WindowsErrorMsg(ErrorCode);
end;
end;
 
{$IFDEF D3DRM}
function D3DRMErrorMsg(ErrorCode: HRESULT): string;
begin
case ErrorCode of
226,7 → 245,7
Result := WindowsErrorMsg(ErrorCode);
end;
end;
 
{$ENDIF}
function DSoundErrorMsg(ErrorCode: HRESULT): string;
begin
case ErrorCode of
271,15 → 290,81
DIERR_INPUTLOST : Result := 'DIERR_INPUTLOST';
DIERR_ACQUIRED : Result := 'DIERR_ACQUIRED';
DIERR_NOTACQUIRED : Result := 'DIERR_NOTACQUIRED';
E_PENDING : Result := 'E_PENDING';
HRESULT(E_PENDING) : Result := 'E_PENDING';
else
Result := WindowsErrorMsg(ErrorCode);
end;
end;
 
{$IfDef DX9}
function DPlayErrorMsg(ErrorCode: HRESULT): string;
begin
case ErrorCode of
DPN_OK : Result := 'DPN_OK';
DPNERR_ALREADYINITIALIZED : Result := 'DPNERR_ALREADYINITIALIZED';
//DPNERR_ACCESSDENIED : Result := 'DPNERR_ACCESSDENIED';
//DPNERR_ACTIVEPLAYERS : Result := 'DPNERR_ACTIVEPLAYERS';
DPNERR_BUFFERTOOSMALL : Result := 'DPNERR_BUFFERTOOSMALL';
//DPNERR_CANTADDPLAYER : Result := 'DPNERR_CANTADDPLAYER';
DPNERR_CANTCREATEGROUP : Result := 'DPNERR_CANTCREATEGROUP';
DPNERR_CANTCREATEPLAYER : Result := 'DPNERR_CANTCREATEPLAYER';
//DPNERR_CANTCREATESESSION : Result := 'DPNERR_CANTCREATESESSION';
//DPNERR_CAPSNOTAVAILABLEYET : Result := 'DPNERR_CAPSNOTAVAILABLEYET';
DPNERR_EXCEPTION : Result := 'DPNERR_EXCEPTION';
DPNERR_GENERIC : Result := 'DPNERR_GENERIC';
DPNERR_INVALIDFLAGS : Result := 'DPNERR_INVALIDFLAGS';
DPNERR_INVALIDOBJECT : Result := 'DPNERR_INVALIDOBJECT';
DPNERR_INVALIDPARAM : Result := 'DPNERR_INVALIDPARAM, DPNERR_INVALIDPARAMS';
DPNERR_INVALIDPLAYER : Result := 'DPNERR_INVALIDPLAYER';
DPNERR_INVALIDGROUP : Result := 'DPNERR_INVALIDGROUP';
DPNERR_NOCAPS : Result := 'DPNERR_NOCAPS';
DPNERR_NOCONNECTION : Result := 'DPNERR_NOCONNECTION';
//DPNERR_NOMEMORY : Result := 'DPNERR_NOMEMORY, DPNERR_OUTOFMEMORY';
//DPNERR_NOMESSAGES : Result := 'DPNERR_NOMESSAGES';
//DPNERR_NONAMESERVERFOUND : Result := 'DPNERR_NONAMESERVERFOUND';
//DPNERR_NOPLAYERS : Result := 'DPNERR_NOPLAYERS';
//DPNERR_NOSESSIONS : Result := 'DPNERR_NOSESSIONS';
DPNERR_PENDING : Result := 'DPNERR_PENDING';
//DPNERR_SENDTOOBIG : Result := 'DPNERR_SENDTOOBIG';
//DPNERR_TIMEOUT : Result := 'DPNERR_TIMEOUT';
//DPNERR_UNAVAILABLE : Result := 'DPNERR_UNAVAILABLE';
DPNERR_UNSUPPORTED : Result := 'DPNERR_UNSUPPORTED';
//DPNERR_BUSY : Result := 'DPNERR_BUSY';
DPNERR_USERCANCEL : Result := 'DPNERR_USERCANCEL';
DPNERR_NOINTERFACE : Result := 'DPNERR_NOINTERFACE';
//DPNERR_CANNOTCREATESERVER : Result := 'DPNERR_CANNOTCREATESERVER';
DPNERR_PLAYERLOST : Result := 'DPNERR_PLAYERLOST';
//DPNERR_SESSIONLOST : Result := 'DPNERR_SESSIONLOST';
DPNERR_UNINITIALIZED : Result := 'DPNERR_UNINITIALIZED';
//DPNERR_NONEWPLAYERS : Result := 'DPNERR_NONEWPLAYERS';
DPNERR_INVALIDPASSWORD : Result := 'DPNERR_INVALIDPASSWORD';
DPNERR_CONNECTING : Result := 'DPNERR_CONNECTING';
//DPNERR_BUFFERTOOLARGE : Result := 'DPNERR_BUFFERTOOLARGE';
//DPNERR_CANTCREATEPROCESS : Result := 'DPNERR_CANTCREATEPROCESS';
//DPNERR_APPNOTSTARTED : Result := 'DPNERR_APPNOTSTARTED';
DPNERR_INVALIDINTERFACE : Result := 'DPNERR_INVALIDINTERFACE';
//DPNERR_NOSERVICEPROVIDER : Result := 'DPNERR_NOSERVICEPROVIDER';
//DPNERR_UNKNOWNAPPLICATION : Result := 'DPNERR_UNKNOWNAPPLICATION';
//DPNERR_NOTLOBBIED : Result := 'DPNERR_NOTLOBBIED';
//DPNERR_SERVICEPROVIDERLOADED : Result := 'DPNERR_SERVICEPROVIDERLOADED';
DPNERR_NOTREGISTERED : Result := 'DPNERR_NOTREGISTERED';
// Security related errors
//DPNERR_AUTHENTICATIONFAILED : Result := 'DPNERR_AUTHENTICATIONFAILED';
//DPNERR_CANTLOADSSPI : Result := 'DPNERR_CANTLOADSSPI';
//DPNERR_ENCRYPTIONFAILED : Result := 'DPNERR_ENCRYPTIONFAILED';
//DPNERR_SIGNFAILED : Result := 'DPNERR_SIGNFAILED';
//DPNERR_CANTLOADSECURITYPACKAGE : Result := 'DPNERR_CANTLOADSECURITYPACKAGE';
//DPNERR_ENCRYPTIONNOTSUPPORTED : Result := 'DPNERR_ENCRYPTIONNOTSUPPORTED';
//DPNERR_CANTLOADCAPI : Result := 'DPNERR_CANTLOADCAPI';
//DPNERR_NOTLOGGEDIN : Result := 'DPNERR_NOTLOGGEDIN';
//DPNERR_LOGONDENIED : Result := 'DPNERR_LOGONDENIED';
else
Result := WindowsErrorMsg(ErrorCode);
end;
end;
{$Else}
function DPlayErrorMsg(ErrorCode: HRESULT): string;
begin
case ErrorCode of
DP_OK : Result := 'DP_OK';
DPERR_ALREADYINITIALIZED : Result := 'DPERR_ALREADYINITIALIZED';
DPERR_ACCESSDENIED : Result := 'DPERR_ACCESSDENIED';
342,5 → 427,5
Result := WindowsErrorMsg(ErrorCode);
end;
end;
 
end.
{$EndIf}
end.
/VCL_DELPHIX_D6/DXFFBEdit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DXGUIDEdit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DXGlueItEdit.dfm
0,0 → 1,4846
object DXGlueItEditor: TDXGlueItEditor
Left = 326
Top = 290
BorderStyle = bsSingle
Caption = 'Glue-It'
ClientHeight = 504
ClientWidth = 659
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Panel5: TPanel
Left = 571
Top = 0
Width = 88
Height = 504
Align = alRight
BevelOuter = bvNone
TabOrder = 0
object Image2: TImage
Left = 0
Top = 416
Width = 88
Height = 88
Align = alBottom
end
object btnExit: TButton
Left = 10
Top = 9
Width = 71
Height = 24
Caption = 'OK'
ModalResult = 1
TabOrder = 0
OnClick = btnExitClick
end
object Button1: TButton
Left = 10
Top = 40
Width = 71
Height = 25
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object mainPageControl: TPageControl
Left = 0
Top = 0
Width = 571
Height = 504
ActivePage = tsGlueIt
Align = alClient
HotTrack = True
TabOrder = 1
OnChange = mainPageControlChange
object tsGlueIt: TTabSheet
Caption = 'Glue-It'
object Panel1: TPanel
Left = 0
Top = 0
Width = 563
Height = 476
Align = alClient
BevelOuter = bvNone
TabOrder = 0
object Splitter2: TSplitter
Left = 359
Top = 0
Width = 4
Height = 476
Cursor = crHSplit
Align = alRight
end
object grManagementOfTheFrames: TGroupBox
Left = 0
Top = 0
Width = 359
Height = 476
Align = alClient
Caption = ' Management of the frames: '
TabOrder = 0
object Panel4: TPanel
Left = 2
Top = 15
Width = 355
Height = 459
Align = alClient
BevelOuter = bvNone
BorderWidth = 5
TabOrder = 0
object LWidthOfImages: TLabel
Left = 158
Top = 366
Width = 81
Height = 13
Caption = 'Width of images:'
Enabled = False
FocusControl = EWidthOfImages
end
object LHeightOfImages: TLabel
Left = 155
Top = 390
Width = 84
Height = 13
Caption = 'Heigth of images:'
Enabled = False
FocusControl = EHeightOfImages
end
object Label8: TLabel
Left = 8
Top = 335
Width = 86
Height = 13
Hint = 'Initial color for background when is transparent option turn on.'
Caption = 'Background color:'
ParentShowHint = False
ShowHint = True
Transparent = True
end
object chbCrop: TCheckBox
Left = 240
Top = 408
Width = 41
Height = 17
Caption = 'Crop'
Enabled = False
TabOrder = 6
end
object chbCentered: TCheckBox
Left = 240
Top = 424
Width = 73
Height = 17
Caption = 'Centered'
Enabled = False
TabOrder = 7
end
object ListBox1: TListBox
Left = 5
Top = 33
Width = 345
Height = 289
Align = alTop
DragMode = dmAutomatic
ExtendedSelect = False
IntegralHeight = True
ItemHeight = 13
Style = lbOwnerDrawVariable
TabOrder = 1
OnDragDrop = ListBox1DragDrop
OnDragOver = ListBox1DragOver
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
OnMouseDown = ListBox1MouseDown
end
object Panel3: TPanel
Left = 5
Top = 5
Width = 345
Height = 28
Align = alTop
BevelOuter = bvLowered
TabOrder = 0
object btnAddImages: TSpeedButton
Left = 2
Top = 2
Width = 24
Height = 24
Action = acAddImages
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF000000000000FF000000FF000000FF000000FF00000000000000FF000000FF
00000000000000FF000000FF000000000000FF00FF00FF00FF0000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00000000008080800000FF000000FF
000000BF000000FF000000FF00000000000000FF000000FF000000000000FF00
FF00FF00FF008080800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF000000BF000000FF000000FF000000FF000000FF000000FF
000000FF000000000000FF00FF00FF00FF0080808000FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF000000BF
000000FF000000FF000000BF000000FF000000BF0000FF00FF00FF00FF008080
8000FFFF0000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF000000BF000000FF000000FF000000BF
0000FFFF00008080800080808000FFFF0000FFFF0000FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF000000BF000000BF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000BFBF0000BF
BF00FFFF0000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF000000BFBF0000FFFF0000FFFF0000BFBF00FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000BFBF0000FFFF0000FF
FF0000BFBF00FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF000000BFBF0000BFBF00FFFF0000FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnDeleteSelected: TSpeedButton
Left = 58
Top = 2
Width = 24
Height = 24
Action = acDeleteOne
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF000000000000FF000000FF000000FF000000FF00000000000000FF000000FF
00000000000000FF000000FF000000000000C0C0C000C0C0C00000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00000000008080800000FF000000FF
000000BF000000FF000000FF00000000000000FF000000FF000000000000C0C0
C000C0C0C0008080800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF000000BF000000FF000000FF000000FF000000FF000000FF
000000FF000000000000C0C0C000C0C0C00080808000FFFF00000000FF00C0C0
C000FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF000000BF
00000000FF00C0C0C00000BF000000FF000000BF0000C0C0C000C0C0C0008080
8000FFFF0000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF00000000FF000000FF000000FF00C0C0C00000BF
0000FFFF00008080800080808000FFFF0000FFFF00000000FF00C0C0C000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF00000000
FF000000FF000000FF00C0C0C000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
00000000FF00C0C0C00000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF00000000FF000000FF000000FF00C0C0
C000FFFF0000FFFF0000FFFF00000000FF000000FF00C0C0C00000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF00000000FF000000FF000000FF00C0C0C000FFFF00000000FF000000
FF00C0C0C000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000FF000000
FF000000FF000000FF000000FF00C0C0C00000BFBF00FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF00000000FF000000FF000000FF00C0C0C00000FF
FF0000BFBF00FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000FF000000
FF000000FF000000FF000000FF00C0C0C000FFFF0000FFFF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FFFF00000000FF000000FF000000FF00C0C0C000FFFF00000000FF00C0C0
C000FFFF0000FFFF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF000000000000000000000000000000FF000000FF000000FF000000FF00C0C0
C0000000000000000000000000000000FF000000FF00C0C0C00000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000FF000000
FF000000FF000000FF00C0C0C000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF000000FF000000FF00C0C0C000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000FF000000FF00C0C0C000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000FF000000FF00C0C0
C000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnClearAll: TSpeedButton
Left = 34
Top = 2
Width = 24
Height = 24
Action = acDeleteAll
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00000000000000000000000000FFFFFF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000000000
000000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FFFFFF00FF00
FF00FF00FF00FF00FF000000000000000000FFFFFF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00000000000000000000000000FFFFFF00FF00FF000000000000000000FFFF
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000000000000000
00000000000000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00000000000000000000000000FFFFFF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000000000000000
00000000000000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00000000000000000000000000FFFFFF00FF00FF0000000000FFFFFF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000000000000000000000000000FFFFFF00FF00
FF00FF00FF00FF00FF000000000000000000FFFFFF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000000000000000
000000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
000000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000FFFFFF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnSave: TSpeedButton
Left = 90
Top = 2
Width = 24
Height = 24
Action = acSaveToFile
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FF00FF008080
8000808080008080800080808000808080008080800080808000808080008080
800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF008080800000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF008080
800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
00000000000000000000FFFFFF00FF00FF000000000000000000000000000000
00000000000000000000FF00FF008080800000000000FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000FFFF0000FF00000000000000FFFFFF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080
800000000000FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FF00000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF00FF0000000000FF00FF00FF00FF000000
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
FF00FFFF0000FFFF0000FF000000FF000000FF00000000FFFF0000FFFF0000FF
FF0000FFFF0000BFBF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFF0000FFFFFF00FFFF0000FFFF0000FFFF0000FF00
0000FF0000008080800000FFFF0000FFFF0000FFFF0000FFFF0000BFBF000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF
0000FFFF0000FFFF0000FFFF000000BF000000BF00008080800000FFFF0000FF
FF000000BF0000BFBF0000FFFF0000000000FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF000000BF000000BF
000000BF000000BF0000FFFFFF0000FFFF000000BF000000BF0000FFFF0000BF
BF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000FFFF0000FFFF000000BF000000BF000000BF000000BF000000BF00000000
BF000000BF000000BF0000FFFF0000BFBF0000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF000000BF000000BF
000000BF000000BF00000000BF000000BF0000FFFF0000000000000000000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF000000BF000000BF000000BF000000BF000000BF00000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FFFF0000FFFF
000000BF000000BF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFF0000FFFF00000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnGlueIt: TSpeedButton
Left = 122
Top = 2
Width = 24
Height = 24
Action = acGlueIt
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF008080800000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000FFFF000080
800000FFFF000080800000FFFF000080800000FFFF000080800000FFFF000080
800000FFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000808000C0C0C0000000000000000000000000000000
000000000000C0C0C0000080800000FFFF000080800000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000FFFF000080
8000C0C0C0000000000000000000000000000000000000000000C0C0C0000080
800000FFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000000000000000
00000000000000000000FFFFFF00FFFFFF00C0C0C00000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FFFF
FF00FFFFFF000000000000000000000000000000000000000000FFFFFF00FFFF
FF00C0C0C00000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFF
FF00FFFFFF0000000000FFFFFF00FFFFFF00C0C0C00000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000C0C0C000FFFF
FF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00C0C0
C0008080800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000C0C0C000FFFFFF00FFFFFF00808080000000
000080808000FFFFFF00C0C0C000C0C0C0000000000080808000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000FFFFFF00FFFFFF00808080000000000080808000C0C0C000000000000000
000080808000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF
FF00FFFFFF00FFFFFF00C0C0C0000000000080808000C0C0C000808080008080
800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0080808000000000000000000000000000000000000000
00000000000000000000000000000000000080808000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00808080000000000080808000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnGlue2Iso: TSpeedButton
Left = 146
Top = 2
Width = 24
Height = 24
Action = acGlueIzonometrics
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000FF00
FF00FF00FF00FF00FF00FF00FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0080808000FFFFFF0000000000FFFFFF0080808000FFFFFF0000000000FFFF
FF0080808000FFFFFF0000000000FFFFFF0080808000FFFFFF0000000000FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FF00FF00FF00FF00FF00FF00FF00FF008000
0000800000008000000080000000800000008000000080000000800000008000
00008000000080000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF008000000000FF000000FF000000FF000000FF
000000FF000000FF000000FF000000FF000080000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008000
000000FF00008000000080000000800000008000000000FF000000FF00008000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF008000000000FF000080000000808080008000
000000FF000000FF000080000000000000000000000080808000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008000
000000FF0000800000008000000000FF000000FF000080000000FF00FF000000
000000000000000000000000000080808000FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF008000000000FF00008000000000FF000000FF
000080000000FF00FF00FF00FF00808080000000000000000000C0C0C0000000
00000000000080808000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008000
000000FF000000FF000000FF000080000000FF00FF00FF00FF00FF00FF00FF00
FF0000000000C0C0C000FFFFFF00FFFFFF00C0C0C0000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF008000000000FF000000FF000080000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF008080800000000000FFFFFF00FFFF
FF00FFFFFF00C0C0C0000000000000000000FF00FF00FF00FF00FF00FF008000
000000FF000080000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000C0C0C000FFFFFF00FFFFFF00C0C0C000000000000080
800000000000FF00FF00FF00FF008000000080000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080800000000000C0C0
C000C0C0C0000000000000FFFF00800000000080800000000000FF00FF008000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00000000000000000000000000FFFFFF0000FFFF0000FF
FF008000000000808000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
000000FFFF00FFFFFF00FFFFFF0000FFFF0000FFFF0080000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000FFFF00FFFFFF00FFFF
FF0000FFFF0000FFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000FFFF00FFFFFF00FFFFFF0000FFFF00}
ParentShowHint = False
ShowHint = True
end
object btnUpSelection: TSpeedButton
Left = 226
Top = 2
Width = 24
Height = 24
Action = acUpSelection
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000000000000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000BFBF0000BFBF0000BFBF000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000BFBF0000BFBF
0000BFBF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000BFBF0000BFBF0000BFBF000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000000000000000000000000000BFBF0000BFBF
0000BFBF000000000000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000BFBF0000BFBF0000BFBF0000BFBF0000BFBF0000BFBF0000BFBF00000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000BFBF0000BFBF0000BFBF
0000BFBF0000BFBF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000BFBF0000BFBF0000BFBF000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000BFBF
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnDownSelection: TSpeedButton
Left = 250
Top = 2
Width = 24
Height = 24
Action = acDownSelection
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000BFBF000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000BFBF0000BFBF
0000BFBF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000BFBF0000BFBF0000BFBF0000BFBF0000BFBF000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000BFBF0000BFBF0000BFBF0000BFBF
0000BFBF0000BFBF0000BFBF000000000000FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000000000
00000000000000000000BFBF0000BFBF0000BFBF000000000000000000000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000BFBF0000BFBF
0000BFBF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000BFBF0000BFBF0000BFBF000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000BFBF0000BFBF
0000BFBF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
end
object chbTransparent: TCheckBox
Left = 224
Top = 328
Width = 97
Height = 17
Caption = 'Transparent'
Checked = True
State = cbChecked
TabOrder = 2
end
object EWidthOfImages: TEdit
Left = 240
Top = 362
Width = 49
Height = 21
Enabled = False
TabOrder = 4
end
object EHeightOfImages: TEdit
Left = 240
Top = 386
Width = 49
Height = 21
Enabled = False
TabOrder = 5
end
object chbForceSize: TCheckBox
Left = 224
Top = 344
Width = 73
Height = 17
Caption = 'Force size'
TabOrder = 3
OnClick = chbForceSizeClick
end
object panBColor: TPanel
Left = 98
Top = 332
Width = 33
Height = 20
BevelOuter = bvLowered
BorderStyle = bsSingle
Caption = 'B'
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 8
OnClick = pnlFGClick
end
end
end
object Panel2: TPanel
Left = 363
Top = 0
Width = 200
Height = 476
Align = alRight
BevelOuter = bvNone
TabOrder = 1
object grPictureAnimationPreview: TGroupBox
Left = 0
Top = 0
Width = 200
Height = 241
Align = alTop
Caption = ' Picture animation preview: '
TabOrder = 0
object DXDraw1: TDXDraw
Left = 2
Top = 43
Width = 196
Height = 196
AutoInitialize = True
AutoSize = True
Color = clBtnFace
Display.FixedBitCount = True
Display.FixedRatio = True
Display.FixedSize = False
Options = [doAllowReboot, doWaitVBlank, doCenter, doHardware, doSelectDriver]
SurfaceHeight = 196
SurfaceWidth = 196
Align = alClient
TabOrder = 1
Traces = <>
OnMouseMove = DXDraw1MouseMove
end
object Panel6: TPanel
Left = 2
Top = 15
Width = 196
Height = 28
Align = alTop
BevelOuter = bvLowered
TabOrder = 0
object btnStop: TSpeedButton
Left = 26
Top = 2
Width = 24
Height = 24
Action = acAnimateStop
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
BF000000BF000000BF000000BF000000BF000000BF000000BF000000BF000000
BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000BF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000BF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000BF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF000000BF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000BF00FF00
FF00FF00FF00FF00FF00FF00FF000000BF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000BF00FF00FF00FF00FF000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000BF00FF00FF000000BF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF000000FF00FFFFFF000000FF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF00FFFFFF000000FF000000FF000000FF000000BF00FF00FF000000BF000000
FF000000FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF000000
FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000FF000000FF000000
FF000000BF00FF00FF000000BF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF00FFFFFF000000
FF00FFFFFF00FFFFFF00FFFFFF000000FF000000BF00FF00FF000000BF000000
FF00FFFFFF000000FF000000FF000000FF000000FF00FFFFFF000000FF000000
FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000
FF000000BF00FF00FF000000BF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF00FFFFFF00FFFFFF00FFFFFF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF00FFFFFF00FFFFFF00FFFFFF000000FF000000BF00FF00FF000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000BF00FF00FF000000BF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000BF00FF00FF00FF00FF000000
BF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
BF00FF00FF00FF00FF00FF00FF00FF00FF000000BF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000BF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000BF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF000000BF000000BF000000BF000000BF000000
BF000000BF000000BF000000BF000000BF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnPlay: TSpeedButton
Left = 2
Top = 2
Width = 24
Height = 24
Action = acAnimateOn
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000FF000000FF000000FF000000FF000000C0C0C000C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00000000000000000000000000C0C0C000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00808080000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000080808000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0
C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C0000000
0000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080
8000000000000000000080808000C0C0C000C0C0C000C0C0C0000000FF000000
FF000000FF00C0C0C00080808000000000000000000080808000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0C000C0C0
C000FF000000FF0000000000FF000000FF000000FF00C0C0C00000000000FFFF
FF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
00000000000000000000C0C0C000C0C0C000FF000000FF0000000000FF000000
FF000000FF00C0C0C000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0C000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C00000000000FFFF
FF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080
8000000000000000000080808000C0C0C000FF000000FF000000FF000000FF00
0000C0C0C000C0C0C00080808000000000000000000080808000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C000C0C0C0000000
0000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00000000000000000000000000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0080808000000000000000000000000000C0C0C000C0C0C000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C00080808000000000000000000080808000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000C0C0C000C0C0C0000000FF000000FF000000FF00C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00000000000000000000000000C0C0C000C0C0C000FF000000FF00
00000000FF000000FF000000FF00C0C0C000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000FF000000FF0000000000FF000000FF000000FF00C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00000000000000000000000000C0C0C000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object LAnimationSpeed: TLabel
Left = 56
Top = 2
Width = 87
Height = 13
Caption = 'Animation Speed :'
FocusControl = pbAnimationSpeed
end
object pbAnimationSpeed: TProgressBar
Left = 56
Top = 16
Width = 137
Height = 9
Min = 0
Max = 200
Smooth = True
TabOrder = 0
OnMouseMove = pbAnimationSpeedMouseMove
end
end
end
object Panel13: TPanel
Left = 0
Top = 241
Width = 200
Height = 28
Align = alTop
BevelOuter = bvLowered
TabOrder = 1
object Label3: TLabel
Left = 8
Top = 6
Width = 59
Height = 13
Caption = 'From image:'
FocusControl = EFromImage
end
object LToImage: TLabel
Left = 110
Top = 6
Width = 47
Height = 13
Caption = 'To image:'
FocusControl = EToImage
end
object EFromImage: TEdit
Left = 72
Top = 3
Width = 30
Height = 21
TabOrder = 0
end
object EToImage: TEdit
Left = 160
Top = 3
Width = 30
Height = 21
TabOrder = 1
end
end
end
end
end
object tsFontGen: TTabSheet
Caption = 'Font-Gen'
ImageIndex = 1
object Panel8: TPanel
Left = 0
Top = 0
Width = 225
Height = 476
Align = alLeft
BevelOuter = bvNone
BorderWidth = 3
TabOrder = 0
object Label16: TLabel
Left = 3
Top = 381
Width = 85
Height = 13
Caption = 'Used characters :'
end
object Label11: TLabel
Left = 3
Top = 232
Width = 178
Height = 13
Caption = 'Source for sizes (copy to your code):'
end
object gbFontSettings: TGroupBox
Left = 3
Top = 3
Width = 219
Height = 78
Align = alTop
Caption = '&Font Settings'
TabOrder = 0
object Label1: TLabel
Left = 12
Top = 24
Width = 27
Height = 13
Caption = '&Name'
end
object Label4: TLabel
Left = 12
Top = 48
Width = 19
Height = 13
Caption = 'Si&ze'
end
object Label10: TLabel
Left = 95
Top = 48
Width = 24
Height = 13
Caption = 'Style'
end
object cbFontName: TComboBox
Left = 52
Top = 20
Width = 154
Height = 19
Hint = 'Font Name|Select font name'
Style = csOwnerDrawFixed
Ctl3D = False
DropDownCount = 10
ItemHeight = 13
ParentCtl3D = False
TabOrder = 0
OnDrawItem = cbFontNameDrawItem
end
object FontSize: TEdit
Left = 52
Top = 44
Width = 37
Height = 21
TabOrder = 1
Text = '10'
end
object Panel20: TPanel
Left = 135
Top = 44
Width = 71
Height = 24
BevelOuter = bvLowered
TabOrder = 2
object btnABold: TSpeedButton
Left = 1
Top = 1
Width = 23
Height = 22
AllowAllUp = True
GroupIndex = 1
Flat = True
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000000000000000000000000000000000000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FF00FF000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FF00FF000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FF00FF000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000000000000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FF00FF000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FF00FF000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000FF00FF000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000000000000000000000000000000000000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
OnClick = btnABoldClick
end
object btnAItalic: TSpeedButton
Left = 24
Top = 1
Width = 23
Height = 22
AllowAllUp = True
GroupIndex = 2
Flat = True
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000000000000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
OnClick = btnAItalicClick
end
object btnAUnderline: TSpeedButton
Left = 47
Top = 1
Width = 23
Height = 22
AllowAllUp = True
GroupIndex = 3
Flat = True
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000000000000000000000000000000000000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00000000000000000000000000000000000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000000000000000000000000000FF00FF00000000000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
OnClick = btnAUnderlineClick
end
end
end
object gbFontEffects: TGroupBox
Left = 3
Top = 81
Width = 219
Height = 80
Align = alTop
Caption = ' Font Effects: '
TabOrder = 1
object Label5: TLabel
Left = 12
Top = 44
Width = 31
Height = 13
Caption = '&Offset'
end
object Label7: TLabel
Left = 107
Top = 44
Width = 37
Height = 13
Caption = 'O&pacity'
end
object eOffset: TEdit
Left = 52
Top = 40
Width = 45
Height = 22
Hint = 'Font Size'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 0
Text = '1'
end
object eOpacity: TEdit
Left = 148
Top = 40
Width = 45
Height = 22
Hint = 'Font Size'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
ParentShowHint = False
ShowHint = True
TabOrder = 1
Text = '100'
end
object CheckBox1: TCheckBox
Left = 8
Top = 16
Width = 113
Height = 17
Caption = 'Enable font effect'
TabOrder = 2
end
end
object gbColorSettings: TGroupBox
Left = 3
Top = 161
Width = 219
Height = 72
Align = alTop
Caption = ' Color Settings:'
TabOrder = 2
object Label14: TLabel
Left = 12
Top = 48
Width = 56
Height = 13
Caption = '&Background'
end
object Label15: TLabel
Left = 12
Top = 24
Width = 56
Height = 13
Caption = '&Foreground'
end
object pnlFG: TPanel
Left = 85
Top = 21
Width = 33
Height = 20
BevelOuter = bvLowered
BorderStyle = bsSingle
Caption = 'FG'
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = pnlFGClick
end
object pnlBG: TPanel
Left = 85
Top = 44
Width = 33
Height = 20
BevelOuter = bvLowered
BorderStyle = bsSingle
Caption = 'BG'
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = pnlFGClick
end
end
object btnFontGenerate: TButton
Left = 3
Top = 354
Width = 94
Height = 25
Caption = 'Gen. Font'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 3
OnClick = btnFontGenerateClick
end
object btnAllChars: TButton
Left = 180
Top = 381
Width = 41
Height = 17
Caption = 'All'
TabOrder = 4
OnClick = btnAllCharsClick
end
object memAlphabet: TMemo
Left = 3
Top = 397
Width = 219
Height = 49
Font.Charset = EASTEUROPE_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Courier'
Font.Style = []
ParentFont = False
TabOrder = 5
end
object cbAntialias: TCheckBox
Left = 3
Top = 449
Width = 97
Height = 17
Caption = 'Antialias text'
Checked = True
State = cbChecked
TabOrder = 6
end
object cbDrawGrid: TCheckBox
Left = 89
Top = 449
Width = 81
Height = 17
Caption = 'Draw grid'
Checked = True
State = cbChecked
TabOrder = 7
Visible = False
end
object Sources: TMemo
Left = 3
Top = 248
Width = 219
Height = 100
TabOrder = 8
end
end
object FontPageControl: TPageControl
Left = 225
Top = 0
Width = 338
Height = 476
ActivePage = tsPreviewFont
Align = alClient
HotTrack = True
Style = tsButtons
TabOrder = 1
object tsFont: TTabSheet
Caption = 'Font'
ImageIndex = 1
object ScrollBox2: TScrollBox
Left = 0
Top = 0
Width = 330
Height = 445
Align = alClient
BorderStyle = bsNone
TabOrder = 0
object imgFont: TImage
Left = 0
Top = 0
Width = 256
Height = 256
AutoSize = True
end
end
end
object tsMask: TTabSheet
Caption = 'Mask'
ImageIndex = 2
object ScrollBox3: TScrollBox
Left = 0
Top = 0
Width = 330
Height = 445
Align = alClient
BorderStyle = bsNone
TabOrder = 0
object imgMask: TImage
Left = 0
Top = 0
Width = 256
Height = 256
AutoSize = True
end
end
end
object tsPreviewFont: TTabSheet
Caption = 'Preview'
ImageIndex = 2
object Splitter1: TSplitter
Left = 0
Top = 117
Width = 330
Height = 4
Cursor = crVSplit
Align = alTop
end
object PreviewMemo: TMemo
Left = 0
Top = 28
Width = 330
Height = 89
Align = alTop
ScrollBars = ssVertical
TabOrder = 0
OnChange = PreviewMemoChange
end
object PreviewDraw: TDXDraw
Left = 0
Top = 121
Width = 330
Height = 324
AutoInitialize = True
AutoSize = True
Color = clBtnFace
Display.FixedBitCount = False
Display.FixedRatio = True
Display.FixedSize = True
Options = [doAllowReboot, doWaitVBlank, doCenter, doHardware, doSelectDriver]
SurfaceHeight = 324
SurfaceWidth = 330
Align = alClient
TabOrder = 1
Traces = <>
end
object Panel9: TPanel
Left = 0
Top = 0
Width = 330
Height = 28
Align = alTop
BevelOuter = bvLowered
TabOrder = 2
object btnFontAnimationStop: TSpeedButton
Left = 26
Top = 2
Width = 24
Height = 24
Action = acAnimeFontOff
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
BF000000BF000000BF000000BF000000BF000000BF000000BF000000BF000000
BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF000000BF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000BF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000BF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF000000BF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000BF00FF00
FF00FF00FF00FF00FF00FF00FF000000BF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000BF00FF00FF00FF00FF000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000BF00FF00FF000000BF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF000000FF00FFFFFF000000FF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF00FFFFFF000000FF000000FF000000FF000000BF00FF00FF000000BF000000
FF000000FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF000000
FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000FF000000FF000000
FF000000BF00FF00FF000000BF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000FF00FFFFFF000000
FF00FFFFFF00FFFFFF00FFFFFF000000FF000000BF00FF00FF000000BF000000
FF00FFFFFF000000FF000000FF000000FF000000FF00FFFFFF000000FF000000
FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000
FF000000BF00FF00FF000000BF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF00FFFFFF00FFFFFF00FFFFFF000000FF00FFFFFF00FFFFFF00FFFFFF000000
FF00FFFFFF00FFFFFF00FFFFFF000000FF000000BF00FF00FF000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000BF00FF00FF000000BF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000BF00FF00FF00FF00FF000000
BF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
BF00FF00FF00FF00FF00FF00FF00FF00FF000000BF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000BF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000BF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000BF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF000000BF000000BF000000BF000000BF000000
BF000000BF000000BF000000BF000000BF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object btnFontAnimationStart: TSpeedButton
Left = 2
Top = 2
Width = 24
Height = 24
Action = acAnimeFontOn
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000FF000000FF000000FF000000FF000000C0C0C000C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00000000000000000000000000C0C0C000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00808080000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000080808000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0
C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C0000000
0000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080
8000000000000000000080808000C0C0C000C0C0C000C0C0C0000000FF000000
FF000000FF00C0C0C00080808000000000000000000080808000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0C000C0C0
C000FF000000FF0000000000FF000000FF000000FF00C0C0C00000000000FFFF
FF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
00000000000000000000C0C0C000C0C0C000FF000000FF0000000000FF000000
FF000000FF00C0C0C000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0C000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C00000000000FFFF
FF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080
8000000000000000000080808000C0C0C000FF000000FF000000FF000000FF00
0000C0C0C000C0C0C00080808000000000000000000080808000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF0000000000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C000C0C0C0000000
0000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00000000000000000000000000C0C0C000C0C0C000C0C0C000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0080808000000000000000000000000000C0C0C000C0C0C000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C00080808000000000000000000080808000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000C0C0C000C0C0C0000000FF000000FF000000FF00C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00000000000000000000000000C0C0C000C0C0C000FF000000FF00
00000000FF000000FF000000FF00C0C0C000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF000000
0000C0C0C000C0C0C000FF000000FF0000000000FF000000FF000000FF00C0C0
C00000000000FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00000000000000000000000000C0C0C000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C000000000000000000000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
end
end
end
end
object tsPreview: TTabSheet
Caption = 'Preview'
ImageIndex = 2
object GroupBox1: TGroupBox
Left = 0
Top = 0
Width = 563
Height = 386
Align = alClient
Caption = ' Preview of glued frames: '
TabOrder = 0
object Panel7: TPanel
Left = 2
Top = 15
Width = 559
Height = 369
Align = alClient
BevelOuter = bvNone
BorderWidth = 5
Caption = 'Panel7'
TabOrder = 0
object ScrollBox1: TScrollBox
Left = 5
Top = 33
Width = 549
Height = 331
Align = alClient
TabOrder = 0
object Image1: TImage
Left = 0
Top = 0
Width = 32
Height = 32
Cursor = crCross
AutoSize = True
PopupMenu = PopupMenu1
OnMouseDown = Image1MouseDown
OnMouseMove = Image1MouseMove
OnMouseUp = Image1MouseUp
end
end
object Panel12: TPanel
Left = 5
Top = 5
Width = 549
Height = 28
Align = alTop
BevelOuter = bvLowered
TabOrder = 1
object SpeedButton1: TSpeedButton
Left = 26
Top = 2
Width = 24
Height = 24
Action = acSaveImage
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FF00FF008080
8000808080008080800080808000808080008080800080808000808080008080
800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFFFF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF008080800000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FF00
FF00FF00FF00FF00FF000000000000000000FF00FF00FF00FF00FF00FF008080
800000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
00000000000000000000FFFFFF00FF00FF000000000000000000000000000000
00000000000000000000FF00FF008080800000000000FF00FF00FF00FF00FF00
FF00FF00FF000000000000000000FFFF0000FF00000000000000FFFFFF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF008080
800000000000FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
0000FF00000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FF00FF0000000000FF00FF00FF00FF000000
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF
FF00FFFF0000FFFF0000FF000000FF000000FF00000000FFFF0000FFFF0000FF
FF0000FFFF0000BFBF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFF0000FFFFFF00FFFF0000FFFF0000FFFF0000FF00
0000FF0000008080800000FFFF0000FFFF0000FFFF0000FFFF0000BFBF000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFF
0000FFFF0000FFFF0000FFFF000000BF000000BF00008080800000FFFF0000FF
FF000000BF0000BFBF0000FFFF0000000000FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF0000000000FFFF0000FFFF0000FFFF000000BF000000BF
000000BF000000BF0000FFFFFF0000FFFF000000BF000000BF0000FFFF0000BF
BF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF000000
0000FFFF0000FFFF000000BF000000BF000000BF000000BF000000BF00000000
BF000000BF000000BF0000FFFF0000BFBF0000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF0000000000FFFF0000FFFF000000BF000000BF
000000BF000000BF00000000BF000000BF0000FFFF0000000000000000000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFF000000BF000000BF000000BF000000BF000000BF00000000
000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000FFFFFF00FFFF0000FFFF
000000BF000000BF000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF0000000000FFFF0000FFFF00000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00000000000000
0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object SpeedButton2: TSpeedButton
Left = 2
Top = 2
Width = 24
Height = 24
Action = acLoadImage
Flat = True
Glyph.Data = {
76060000424D7606000000000000360000002800000014000000140000000100
2000000000004006000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000000000C0C0C00000FF
FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF
FF00C0C0C00000FFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFFFF0000000000C0C0C00000FFFF00C0C0C00000FFFF00C0C0
C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000000000FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000FFFF000000000000FF
FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF
FF00C0C0C00000FFFF00C0C0C00000000000FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFFFF0000FFFF000000000000FFFF00C0C0C00000FFFF00C0C0
C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF000000
0000FF00FF00FF00FF00FF00FF00FF00FF000000000000FFFF00FFFFFF000000
0000C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF
FF00C0C0C00000FFFF00C0C0C00000FFFF0000000000FF00FF00FF00FF00FF00
FF0000000000FFFFFF0000FFFF00FFFFFF000000000000000000000000000000
000000000000C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0
C00000000000FF00FF00FF00FF00FF00FF000000000000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000
000000000000000000000000000000000000FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF0000000000FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF000000000000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF0000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000
00000000000000000000000000000000000000000000FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF0000000000000000000000
00000000000000000000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00
FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00}
ParentShowHint = False
ShowHint = True
end
object Label2: TLabel
Left = 426
Top = 1
Width = 85
Height = 26
Hint =
'Must be strike key SHIFT for change color on image canvas to new' +
' selected transparent color.'
Caption = 'Transparent color'#13#10'for manual fill:'
ParentShowHint = False
ShowHint = True
Transparent = True
end
object btnGetTransparentcolor: TSpeedButton
Left = 58
Top = 2
Width = 24
Height = 24
Hint = 'Get transparent color.'
AllowAllUp = True
GroupIndex = 2
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00DDDDDDDDDDDD
DDDDDDDDDDDDDDDDDDDDDDD00DDDDDDDDDDDDDD0700DDDDDDDDDDDDD0770DDDD
DDDDDDDD07770DDDDDDDDDDDD07770DDDDDDDDDDDD07770D0DDDD0DDDDD07770
0DDDD00DDDDD07000DDDDD00D0DDD00000DDDDD000DD0000000DDDD000DDDDD0
000DDD0000DDDDDD000DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD}
ParentShowHint = False
ShowHint = True
OnClick = btnGetTransparentcolorClick
end
object btnCrop: TSpeedButton
Left = 88
Top = 2
Width = 24
Height = 24
Hint = 'Crop picture.'
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF00C0C0C00000FFFF00FF000000C0C0C000FFFF0000FFFFFF00DADADADADADA
DADAADADA0ADADADADADDADAD00ADADADADAADADA00DADADADADDADAD00ADADA
DADAA00000070000ADADDA0000070000DADAADADA00DAD00ADADDADAD00ADA00
DADAADADA00DAD77ADADDADAD0000000000AADADA00000000000DADADADADA00
DADAADADADADAD00ADADDADADADADA00DADAADADADADADA0ADAD}
Visible = False
end
object btnFill: TSpeedButton
Left = 112
Top = 2
Width = 24
Height = 24
Hint = 'Format.'
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF00C0C0C00000FFFF00FF000000C0C0C000FFFF0000FFFFFF00DADADA00447A
DADAADADADA70F44ADADDADADADA0F444ADAADADADADA0F444ADDADADADAD77F
44DAADAD0DADAD0FF4ADDAD070DADAD0000AAD07770DA5A70B07D0888770D55A
03B008F88877555DA0B0D08F8087755AD700AD080408555DADADDA40848755DA
DADAAD4D0470ADADADADDA4AD40ADADADADAAD7447ADADADADAD}
Visible = False
end
object SpeedButton10: TSpeedButton
Left = 264
Top = 2
Width = 24
Height = 24
Hint = 'Recolorize'
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007000000000000000700000007077770770770AA0700000007007
70770770AA207000000070707777770AA270700000007077077070AA27707000
0000707770770722777070000000707777007777777070000000707777777777
77707000000070777777777337707000000070777777773BB370700000007077
7777773BB3707000000070777777777337707000000070777777777777707000
0000700000000000000070000000777777777777777770000000777777777777
777770000000}
Visible = False
end
object SpeedButton11: TSpeedButton
Left = 312
Top = 2
Width = 24
Height = 24
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF00C0C0C00000FFFF00FF000000C0C0C000FFFF0000FFFFFF00DADADADADADA
DADAAD0DADADADADA0AD0000000000000000AD0DADADADADA0ADDA0ADADADADA
D0DAAD0DADAD0000A0ADDA0ADADA0BB0D0DAAD0DA00D0BB0A0ADDA0A02200BB0
D0DAAD0D02200000A0ADDA0A0220DADAD0DAAD0DA00DADADA0AD000000000000
0000AD0DADADADADA0ADDA0ADADADADAD0DAAD0DADADADADA0AD}
Visible = False
end
object SpeedButton12: TSpeedButton
Left = 240
Top = 2
Width = 24
Height = 24
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
77777000000070000000000000007000000070AAAA0AA0AA077070000000708A
A2AA0AA077807000000070E2AAAAAA0778E07000000070EE2AA2A2778EE07000
000070EEE2AA2E88EEE07000000070EEEE22EEEEEEE07000000070EEEEEEEEEE
EEE07000000070EEEEEEEEE33EE07000000070EEEEEEEE3BB3E07000000070EE
EEEEEE3BB3E07000000070EEEEEEEEE33EE07000000070EEEEEEEEEEEEE07000
0000700000000000000070000000777777777777777770000000777777777777
777770000000}
Visible = False
end
object SpeedButton13: TSpeedButton
Left = 288
Top = 2
Width = 24
Height = 24
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007000000000000000700000007077770770770770700000007007
7077077077007000000070707777770770707000000070770770707707707000
0000707770770700777070000000707777007777777070000000707777777777
7770700000007077777777700770700000007077777777077070700000007077
7777770770707000000070777777777007707000000070777777777777707000
0000700000000000000070000000777777777777777770000000777777777777
777770000000}
Visible = False
end
object btnWand: TSpeedButton
Left = 344
Top = 2
Width = 24
Height = 24
Hint = 'Magic wand.'
Flat = True
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
1800000000000003000000000000000000000000000000000000FF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
FFFF00FF6666CC5674CAFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FF6699CC3366991E2A4BFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF6666
CC3366991E2A4BFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF
00FFFF00FFFF00FFFF00FF6699CC3366991E2A4BFF00FFFF00FFFF00FFFF00FF
FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF6699CC6666CC1E2A
4BFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFB0BEE4FF00FFFF
00FFFF00FF6699CC6699CC1E2A4BFF00FFFF00FFFF00FFFF00FFFF00FFC2CEED
FF00FFFF00FFFF00FF5674CAFF00FFFF00FF0099FF5674CA1E2A4BFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFB0BEE49ADEFBFF00FFFCFDFDFF00FF8C
D0EE9999CC1E2A4BFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
9ADEFB00CCFFCCFFFFD8DEE4CCFFFF00CCFF8CD0EEFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFCCFFFF0066FF66CCFF0066FFCC
FFFFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF9999CC5674CA
FFFFFFFF00FF33FFFF0066FF33CCFFE5E6E6FCFDFD5674CA9999CCFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFCCFFFF0066FF33CCFF0066FFCC
FFFFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF
9ADEFB00CCFFCCFFFFFF00FFCCFFFF00CCFF9ADEFBFF00FFFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFB0BEE49ADEFBFF00FFFEFEFEFF00FF9A
DEFBB0BEE4FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFC2CEED
FF00FFFF00FFFF00FF6699CCFF00FFFF00FFFF00FFC2CEEDFF00FFFF00FFFF00
FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFC2CEEDFF00FFFF
00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF}
Visible = False
end
object btnMask: TSpeedButton
Left = 368
Top = 2
Width = 24
Height = 24
Hint = 'Mask.'
Flat = True
Glyph.Data = {
36030000424D3603000000000000360000002800000010000000100000000100
1800000000000003000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000007F7F7FC7C7C79A9A9AB2B2B2B8B8B8969696C7
C7C7939393C3C3C3A2A2A2A8A8A8C0C0C0939393BBBBBB000000000000C7C7C7
A8A8A8CFCFCFBABABAB5B5B5D1D1D1A4A4A4D2D2D2ABABABC8C8C8C3C3C3AEAE
AED5D5D59393930000000000009A9A9ACFCFCFB2B2B2C2C2C2C6C6C684848400
0000000000B7B7B7B7B7B7BBBBBBCBCBCBAEAEAEC0C0C0000000000000B2B2B2
BABABAC2C2C2969696000000000000909090939393000000000000717171BBBB
BBC3C3C3A8A8A8000000000000B8B8B8B5B5B5C6C6C6000000999999FFFFFFFF
FFFFFFFFFFFFFFFF999999000000B7B7B7C8C8C8A2A2A2000000000000969696
D1D1D1848484000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000B7B7
B7ABABABC3C3C3000000000000C7C7C7A4A4A4000000909090FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFF939393000000D2D2D2939393000000000000939393
D2D2D2000000939393FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF9090900000
00A4A4A4C7C7C7000000000000C3C3C3ABABABB7B7B7000000FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFF000000848484D1D1D1969696000000000000A2A2A2
C8C8C8B7B7B7000000999999FFFFFFFFFFFFFFFFFFFFFFFF999999000000C6C6
C6B5B5B5B8B8B8000000000000A8A8A8C3C3C3BBBBBB71717100000000000093
9393909090000000000000969696C2C2C2BABABAB2B2B2000000000000C0C0C0
AEAEAECBCBCBBBBBBBB7B7B7B7B7B7000000000000848484C6C6C6C2C2C2B2B2
B2CFCFCF9A9A9A000000000000939393D5D5D5AEAEAEC3C3C3C8C8C8ABABABD2
D2D2A4A4A4D1D1D1B5B5B5BABABACFCFCFA8A8A8C7C7C7000000000000BBBBBB
939393C0C0C0A8A8A8A2A2A2C3C3C3939393C7C7C7969696B8B8B8B2B2B29A9A
9AC7C7C77F7F7F00000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000}
Visible = False
end
object panTColor: TPanel
Left = 512
Top = 4
Width = 33
Height = 20
BevelOuter = bvLowered
BorderStyle = bsSingle
Caption = 'T'
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clRed
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 0
OnClick = pnlFGClick
end
end
end
end
object GroupBox4: TGroupBox
Left = 0
Top = 386
Width = 563
Height = 90
Align = alBottom
Caption = ' Image effects: '
TabOrder = 1
object Panel10: TPanel
Left = 2
Top = 15
Width = 265
Height = 73
Align = alLeft
BevelOuter = bvNone
TabOrder = 0
object LDuration: TLabel
Left = 4
Top = 1
Width = 45
Height = 13
Caption = 'Duration:'
FocusControl = pbDuration
end
object Label6: TLabel
Left = 4
Top = 27
Width = 66
Height = 13
Caption = 'Image effect:'
FocusControl = cbEffectsList
end
object pbDuration: TProgressBar
Left = 4
Top = 15
Width = 256
Height = 9
Min = 0
Max = 100
Smooth = True
TabOrder = 0
OnMouseDown = pbDurationMouseDown
OnMouseMove = pbDurationMouseMove
OnMouseUp = pbDurationMouseUp
end
object cbEffectsList: TComboBox
Left = 4
Top = 43
Width = 129
Height = 21
Style = csDropDownList
ItemHeight = 13
Items.Strings = (
'Gaussian Blur'
'Split Blur'
'Add Color Noise'
'Add Mono Noise'
'Antialias'
'Contrast'
'Fisheye'
'Lightness'
'Darkness'
'Saturation'
'Mosaic'
'Twist'
'Split Light'
'Tile'
'Spot Light'
'Trace'
'Emboss'
'Solorize'
'Posterize'
'Grayscale'
'Invert'
'Brightness'
'Colorize'
'Resample [Box]'
'Resample [Triangle]'
'Resample [Hermite] '
'Resample [Bell]'
'Resample [BSpline]'
'Resample [Lanczos3]'
'Resample [Mitchell]')
TabOrder = 1
OnChange = cbEffectsListChange
end
object btnApply: TButton
Left = 138
Top = 39
Width = 49
Height = 25
Caption = 'Apply'
TabOrder = 2
OnClick = btnApplyClick
end
object chbAutoAply: TCheckBox
Left = 191
Top = 43
Width = 70
Height = 17
Caption = 'Auto apply'
TabOrder = 3
OnClick = chbAutoAplyClick
end
end
object Panel11: TPanel
Left = 267
Top = 15
Width = 294
Height = 73
Align = alClient
BevelOuter = bvNone
TabOrder = 1
object grSubimages: TGroupBox
Left = 0
Top = 0
Width = 143
Height = 73
Align = alClient
Caption = ' Subimages:'
TabOrder = 0
object LPatternWidth: TLabel
Left = 5
Top = 22
Width = 32
Height = 13
Caption = 'Width:'
end
object LPatternHeight: TLabel
Left = 71
Top = 22
Width = 35
Height = 13
Caption = 'Height:'
end
object ePatternWidth: TEdit
Left = 39
Top = 18
Width = 30
Height = 21
TabOrder = 0
Text = '4096'
end
object ePatternHeight: TEdit
Left = 108
Top = 18
Width = 30
Height = 21
TabOrder = 1
Text = '4096'
end
object btnResize: TButton
Left = 15
Top = 43
Width = 59
Height = 25
Hint =
'All subimages will be resized to new size from width and height ' +
'boxes.'
Caption = 'Resize'
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = btnResizeClick
end
object btnReplace: TButton
Left = 79
Top = 43
Width = 59
Height = 25
Hint =
'All subimages will be replaced under maximum size of texture (20' +
'48x2048 px).'
Caption = 'Replace'
ParentShowHint = False
ShowHint = True
TabOrder = 3
OnClick = btnReplaceClick
end
end
object GroupBox2: TGroupBox
Left = 143
Top = 0
Width = 151
Height = 73
Align = alRight
Caption = ' Zoom factor '
TabOrder = 1
object Label13: TLabel
Left = 36
Top = 48
Width = 14
Height = 13
Caption = '2 x'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label17: TLabel
Left = 67
Top = 48
Width = 14
Height = 13
Caption = '4 x'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label18: TLabel
Left = 98
Top = 48
Width = 14
Height = 13
Caption = '6 x'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label19: TLabel
Left = 129
Top = 48
Width = 14
Height = 13
Caption = '8 x'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Slider: TTrackBar
Left = 33
Top = 16
Width = 115
Height = 33
Max = 4
Min = 1
Orientation = trHorizontal
PageSize = 1
Frequency = 1
Position = 1
SelEnd = 0
SelStart = 0
TabOrder = 0
ThumbLength = 20
TickMarks = tmBottomRight
TickStyle = tsAuto
end
object chbZoomOut: TCheckBox
Left = 5
Top = 19
Width = 31
Height = 17
Caption = 'On'
Checked = True
State = cbChecked
TabOrder = 1
OnClick = chbZoomOutClick
end
end
end
end
end
end
object OpenDialog1: TOpenDialog
DefaultExt = '.bmp'
Filter =
'All (*.dib;*.jpg;*.jpeg;*.bmp;*.ico)|*.dib;*.jpg;*.jpeg;*.bmp;*.' +
'ico|Device Independent Bitmap (*.dib)|*.dib|JPEG Image File (*.j' +
'pg)|*.jpg|JPEG Image File (*.jpeg)|*.jpeg|Bitmaps (*.bmp)|*.bmp|' +
'Icons (*.ico)|*.ico'
InitialDir = '.'
Options = [ofAllowMultiSelect, ofEnableSizing]
Title = 'Open Image(s) sequence...'
Left = 56
Top = 328
end
object DXTimer1: TDXTimer
ActiveOnly = True
Enabled = False
Interval = 0
OnTimer = DXTimer1Timer
Left = 496
Top = 216
end
object SaveDialog1: TSaveDialog
DefaultExt = '.bmp'
FileName = 'Glue.bmp'
Left = 288
Top = 352
end
object DXImageList1: TDXImageList
DXDraw = DXDraw1
Items = <>
Left = 488
Top = 304
end
object PopupMenu1: TPopupMenu
Left = 80
Top = 80
object LoadImagedirectly1: TMenuItem
Caption = 'Load Image...'
OnClick = LoadImagedirectly1Click
end
end
object PreviewTimer: TDXTimer
ActiveOnly = True
Enabled = False
Interval = 0
OnTimer = PreviewTimerTimer
Left = 240
Top = 88
end
object FontDXImageList: TDXImageList
DXDraw = PreviewDraw
Items = <>
Left = 272
Top = 88
end
object SavePictureDialog: TSavePictureDialog
DefaultExt = 'bmp'
Filter =
'All (*.dib;*.jpg;*.jpeg;*.bmp;*.ico;*.emf;*.wmf)|*.dib;*.jpg;*.j' +
'peg;*.bmp;*.ico;*.emf;*.wmf|Device Independent Bitmap (*.dib)|*.' +
'dib|JPEG Image File (*.jpg)|*.jpg|JPEG Image File (*.jpeg)|*.jpe' +
'g|Bitmaps (*.bmp)|*.bmp|Icons (*.ico)|*.ico|Enhanced Metafiles (' +
'*.emf)|*.emf|Metafiles (*.wmf)|*.wmf'
Left = 88
Top = 344
end
object ColorDialog: TColorDialog
Ctl3D = True
Left = 128
Top = 80
end
object DXDIB1: TDXDIB
DIB.Data = {
280000008000000080000000010018000000000000C000000000000000000000
00000000000000000B202F061B2A132A390D24330B22321128380D24340E2535
122534122330132330182730162129030F1510191D040E150D1A2215242D1B28
3007141C15222A09161E15232914222818282F0E1E250F2029061921000F1A0F
232E0B1F2A0C202B15253112222E0B1C29071825152837041726021627172B3C
12283A13293B0E24360D23350B2133172D3F0E24360B1F3010202D1828340D1D
2A1526331528371227360F23350B213311293B0013251F3749051D2F0A213106
1D2D1229390E27370D263A031E32112B3C0B25360F28380A2333122736122736
1326350B1E2D10212E00101D0415221223300E1F2C0C1E2917262F1020271121
2D081A251929391C314014283A283E50203648263C4E283C4D2135462838482E
3E4E2838452636422D3D4427373D172930273A41192B361F3540253B47253D49
213B49142E3C2D4856132E3C1B3742223E491E3A4517333E223C4A17313F233D
4E1E3849193448213C50152F40183243172E3E2A415121384819314319324619
354D233E581B38531F3241162B3A405564243B4A263D4D294050233A4A243849
1B303F2E41503343502C3A462E3B431A262C1E282F111D230A19222939453443
4C29384133424B22313A1F2F3612222943525B1E2F3819293510222D0F222F15
2B37192F3B1A2D3A3F505D0F202D2738450B1E2D4659681E3243162A3B1A3042
21374943596B304658172D3F304658445A6C243A4C2A3E4F40515E2D3D491A2B
382C3F4C283B4A1A2E3F3F55674A6072294153243C4E2F4759263E502F455722
3949182F3F253D4F354E62233E522C46572741522B44543249593247563B505F
425564182B3A132431192A370A1B281627341D2E3B24354244555E1627301F2F
3B142532455867203445172D3F1D35491F374B475D6F31475914283932445543
566525354532424F38495236484F1A2B342F424A273B46203642394E5D445B6A
2D46561C3545334D5D1E38482D48561C37451A35432C47552D4755233C4C2741
522844552540542E495D2E475B3A5465263D4D2D4454253C4C223A4C2E475B28
425A304B6535526D3F505D4154615265723A505C364B5A3D52613E52633E5263
394E5D475A694758653B4B574B57612F3A42333F452B384032424E3F505D4757
644757643B4B573E4E5A4A5A663E505B5B6D78364A552F424F3147532A3F4E3B
5261415868364D5D485B6A354857304352344859506475344A5C384E60324A5E
445C704E667A41596D364E623F5567455B6D32485A4256673646564253604454
643B4E5D485A6B3C50613B516353697B3D556940586C364E623D556741576941
57693E546651697B455E723E576B486072475F71415868485F6F425766526776
576A793F52612E41503245543245544053624457663447564154613447543B4E
5D30445543596B354D612B4357324A60455D73445C72455C723D5267384E604B
5F7047596A4154633C4C594656623F4F5C4354614255643C5160435768566D7D
435B6D3852633B5566304A5B445E6F466071375161445E6E4A6373476070435D
6E4A65793F5A6F3B566A395266445E6F445B6B344B5B435A6A3B536547607442
5C7449647E3C57721728313B4E560C1E29192C390D202D172C3B172C3B213546
213645152A391D303F2A3B4845535F213039323F4735444D263646374B5C2F41
522D3F503447563144531B2E3D3E51600A1D2C465B6A304455283F4F22384A34
4C5E21394D435B6D203747344859273D4F263C4E30455A253D51435B6F324B5F
2A4157334B5F1C3448253D512E43581D33452036484C6071081B2A4D606D3649
583045543D51622A4151283E502B41531D3549243C50253D51395165273C5126
3C4E2A40522A4052162E422A42542E46582F4656162D3D1930401C3140314655
071A29405362344756233847243948182C3D2C4051243B4B354A592439482D41
52283E50334B5F1C344A1B334929435B233D553B556D213951172E443C546820
3648142A3C3C50610515254454643040513345563C4D60283C4E3C51662D4559
223A502E465C2D455B2F475D1E364C3952662B44583F596A243E4F2842531C37
4B2843582441562E4B6041596F556E82000F214B62720F26362A4052263E521A
324A263F591B36510B1B2249596005141D23343D1C2E392235420E2332324756
283C4D0C21301E31403546533B4C590F1F2B23313D1F303D213547283D523044
563246582E42543B4F61182C3D3D5162081C2E3C5264283E502D4557213A4E42
5B6F2E465C263E541E364A2A42562C4458243D512E465C4A6278475F75395469
2C445C334B611F374D30495D21394D1B33473E5466455C6C102534384D5C3A4E
5F3F5666304658344C5E1A324630485C1B3248233A502940563F576B30455A1B
304523384D293E53162C3E3C526433495B314556112536162B3A293C4B3F5261
061B2A506574293D4E354C5C2F46561830422C44562E46582036482B4355223A
4E344C62122D42213D55142F492E49633A556F3D5872243F59213B5341597119
304631485E3D52670010234353643D4C5F28394C33465B34495F394D66334962
334B63223C541A344C2E48601B354D39536B28425A2843581F3A4F2A455A213C
51233F5726425A334F67455D73546D810014263B51631B2F402036482840542F
475F2B445E1B344E0C181C45535917252B1B2B3221323B1F313C041724405564
1D3142081C2D1A2E3F2C3F4E253847071A272536431D303F1B30453B52683348
5E22374C31465B43586D13293B485E7003182D41566B344C602D4559243C5228
435828425A2B455D1E385028425A223C542F49613F5971536F87465F79375169
26405848627A1F374F243C52354C62253D512B40553B5163021929405969253C
4C40596930485A2840521A324630485C1D344A273E54253C52384F6542576D20
354A23384E455A6F102638354B5D2E42532A3E4F112635162B3A263948394C5B
000E1D4F6473283F4F4860721B3345173044294256334C60082135223B4F324A
60142F440D2941132F4724425B1F3C5745627D36536E17324C1A354F41597111
29412D445A3D52680112274F607328394E2B3E5334495F2137503D526D2E455F
29425C223B55314A642E476119324C28415B304A62243E561731492640582B47
5F2B466039546E415C7646607850687E001226455B6D182C3D1D3143455A6F30
475D1A324A162F49131F21455153222E321422281C2D36182A350E212E455A69
293D4E1A31411D34442438491D3142091E2D213443192D3E23384E3A5167384F
652F465C23384D31465B1C314630455A0E2338354A5F2B42582F465C21395126
3E562F48621C354F203B5528435D2E496326415B536E883B59724B668138536D
25405A29455D1D374F2D485D30485E2C45592F475B344C5E0820324862733048
5A2D4758263F532E475B132B413F576D162E44233B51243A53374D66445A732A
41571E324B384D631C2F44324658384A5B2F41521C2F3E1E31401B2E3D394C5B
0013224B606F2D44543F576928435738556A28455A223F54274054223B4F1B33
49132E43112D4517334B1A385114324B415C7635506A19344E1B36503D556D1B
334B223A503F566C0011263E516622344B293E5430445D253B542D425D283F59
28405C223A562C455F213A54233C562F4862314B6317314928425A28415B2E49
631F3C5735526D3D5872425C74526A800012263E546634485945596B22374C2C
43591129412D46600E1818434D4D1723251524271C2C331829322233403F5463
283C4D1C3343162C3E23394B294050172E3E1F36461B314321364C354C62283F
552C44581D324722374C293E5341566B04192E485D72293E542C43592B415A30
4860223A521D365024415C25425D304D681F3C5739567145627D34516C425F7A
28435E223D572C465E314B63253D5330485E30485C30485C021C2D3A54652E48
59395364243D51213A4E1E364C354D631C344A20384E2137502D435C2F455E38
4E67344861384D63283B502D41533D4F6027394A1225341528370A1D2C3B4E5D
0013224960703D55672F485C3B566B39586F17364D24435A1E394E263F53213C
510823380B263B17334B2C4860203C542E4963334D652F4961223C54273F572C
445A294157374F63000D2240556A192E442D445A344A632A425A3B536B2D445E
28415B233C5627405A2C465E2A445C253F57203A52203A522B445E213C56324D
6823405B415E79415E79435C76566E84001226384E6031455725394B2D425710
273D374F6737506A1119183E48480A16181D292D1F2C3423343D1223304C6170
1B2F40182E40193143233B4D2B4355071F311A3244263C4E2A3F543A4F64283D
522E44563044563246582B3F513A4E600D21333B516333485D30455A2B405630
475D263D53233D553B5873213F5C2D4B682543603856733D5B78516F8C2F4D68
24415C203B553E5870213B53284056324A602840543B5367021B2F2E495D3F58
6C375064253E522740541B32483C536921384E1D344A243A5340566F263B5633
4863283D5840546D2B3E532C40523D51622A3E4F1D303F293C4B1A2D3C364958
061B2A4A61712A42541D384C4663783B5A7114334C15334C254055314A5E1831
45112C40213C50173247233E531934491A344C455D732E465C1F374D1A314725
3D512A42564D6375041A2C455B6D2D425728405431485E243C5240586E2C465E
29435B2B455D28425A2742572A425830485E1F374D263E543D5670223D582F49
672A46643753713E5B76566F894C647C02192F3A5062394D5F2B3F5123384D2B
4258223A52375169131B1A4650501D26291F2B2F23303821323B142532445968
122637172D3F142C3E21394B253D4F0A223420384A1F37491A30422A40522B41
53253B4D1C30423145562D41533C5061061A2C3B4F6125394B2C41562E43582A
3F55273C52263E5636516C2A4865213F5C36547139577443617E4A6885304E69
25425D243F593A546C243E561E364C233B51223A4E41596D0E273B3550642E47
5B364F63253E521B3448243B513B52681B32481D344A2A4059354B64263B5627
3C57253A553B516A1E334820364830445625394A1C2E3F2F4251223544425564
0B202F445B6B284052203B501F3B5327465F36546F082740254055233C501A33
47243D51213C50173246213C501D364A273F55314A5E334B5F233B4F122A3E2E
46583B5163465C6E0B2133364C5E1D35472B43571F384C1A32482843582E495E
142F441E394E1F3A4F2E495D2A4357243E4F243D512A42583C556F304864233D
5B37537135516F47627D526B85526A8200152B586E802C4052172B3D293E5322
3A4E3A526A334D650B13133E484820292C1B272B2330381B2C35172835445968
15293A1C3343172F4121394B1E36480E2638223949193040253C4C384F5F3044
5523374827394A3C4F5E1D2F403649580A1C2D43556622344530445632465822
374C273C51243C52314C662E4B66324F6A39567145627D324F6A4C6984415E79
2A456025405A29435B253F571E364C223A50223A4E3E566A071F3530485E3049
5D3F586C253D5111293D1C3448354D611C3349253C52283E57314760273E5829
405A243B553D556D263D532840542B4153243B4B172B3C2D41521D303F3E5160
0E23324E65751B3345314C6118344C22415A46647F23425B294458365061253F
502A4455445E6F294354102A3B2E46582A42562B4355364C5E263C4E1A30422F
46562E4253405767081F2F324B5B263F4F2C44561C3647223B4F233E522A4559
2C475B264155162F432F495A2B4355223B4B2840521B3448334D65304963324D
683F5A7545607B35506B4F68825C748A051D31475D6F2E425414283A30455A27
3F533149612741590D14173C45481C272B1D292F24303A1E2E3A1C2D3A4A5F6E
1D31421A31411A32441F3749183042142D3D1A3141172E3E1C33431A31411D34
442C40512237463A4D5C2639483144530F2231415463293B4C374B5C2D415321
37492B405521384E38516B2A48611E39543B597246617C47647F3A577238566F
26415B2440581E38502A455A253D532D465A2A42563D55690A21372A42583D56
6A475F732840541C3448172F4331495D2F465C384F65233952364C65283F592F
466019304A354C66243C54273F55223A4E243A4C172E3E2F43541E3140415463
071C2B4A61711830422C445A2541591A38513E5C77304F682D485D253F502942
562C46573F596A253F50122A3C233B4D152D3F1C3446293F5133495B2037472C
43532A3E4F485F6F031C2C3952622C4555213A4A2640512741522B465A2D485C
284357264155213B4C354F60233C4C1D36462D4656253D4F374F672A435D1E36
52415C7746617C4B66803E566E4F677D00152A3D5365213546294050334B5F24
3C523D576F112B430F181C434C501D282C1B292F19283120303C142532354A59
1E32430D2434182F3F1930401930401B32411429381F3646172E3E344C5E2039
492D44542B42523246571C3140374C5B091D2E3347582D4152374B5C20344622
384A2E43581C334928425A1F3B5329425C3D59713E5771435E7825405A37526C
1D36502640582038502E465C253C5230485C30455A40586C132A402D445A3149
5D384D6224394E24394E1B3143253B4D31465B364B601C33492F465C2C445C2C
445C1A334D37506A1C364E223D521C354921394B1930402D41521D303F415463
081D2C4259692D45571931472F496118334D36536E24425B203D521732462944
591C374B314C60193448142D4120394D1830421B3345243C4E435B6D162E4027
3F5133495B3D5365041D2D405969183042132B3D263F53213A4E284155385165
1D364A1D364A284052364E60223949233A4A2B42521E36482E455B243C542841
5B40597339546E445F792B435B546C82000E233E5466243B4B2C43532A425638
50663F597115304A111A1E495458222E3418252D15242D233540122232203544
2034450D2434162D3D162D3C2037461C3342112635253A490E2638243C4E172F
412841511930403249592F4656344958091D2E3145562D415233495B192F411E
364A2B4357162E443B53691C374C2E465E2A445C425C7449637B2B445E2F4B63
1C364E1F3951183046233B511F374B2D45592B41533B51630C2438384F65253A
4F30455A21364B1A2F4424384A1D31432A3D522A3F5420374D21384E324A621F
395127405A3B56701F3B5328445C213C51243D511C3446253C4C162B3A3C4F5E
081D2C4C60712A40521C3448324A602E48601B36512F4D662140572542572F4B
631732472A455A183347163145294256233C50344C5E2941553B53651B334529
415329415331495B001628496272142C3E172F411F384C2B4458243D51314A5E
253E521F384C20384C2C44561E3446243B4B253C4C142A3C3D546A1E344D2E45
5F2D46603F587249627C2F475F4D657B0011263E54662C43532A43532942563C
576C17334B25405A1B252C49535A2631391A272F202F382638431C2C3C293E4D
203445182F3F142B3A152C3B2C4150192F3B1629362035441D35473650611E38
49233D4E1F37493750601D36463047570A2032394F6122384A2D45591F374B1B
3248283F551830462F475D2B44583950663B53692B43593E596E2640583C566E
263E561D354B162E4421394F223A4E2C4458253B4D374D5F071C313E53682C3F
54384B602C40522236482C3D50273B4D35495B34495E2B42581B32482E465E19
334B28415B2B46601C3A5327465D244156243F53233B4D243B4B1C3140425766
011423495D6E1C3244223A4E263E543D576F0B264134516C37556E1A39502543
5C213D550C284014314628455A1833481732472F485C263E542A43572A435727
40541C3549425A6C001628445C6E243C50253D511F374D364E64253D53273F55
21394F243D511E364A2D45571C32441B2F412E4253263C4E2B43572A41573850
683F5971263F593D5670284058566E84000E234A60721C33433750602D465A1A
354A0E2A4223415A1F293337434D16252E11202921313D182936172A37354857
192E3D1E3544102534142A36324854142A351B2F3A1B313D122B3B1F394A1E38
49294354172F4130485A172F41364E60051D2F3E566A122A3E28405429415519
31452A425620394D1D354B21394F3E566C364E6430485E2B455D243E56274159
29415720384E263E542E465C28415528405421394D40586C091E332F44592338
4D2A3D522A3E502E425424384A2D4153334759344A5C253A4F172E4428405626
3E542E486028425A213D552D4A5F2A455A263F53243C4E1E3446182C3D415463
0316253A4F5E344859243C501C344A3E57712A4560233E593D5B74214057132F
4719354D0C2840203D52284358183348173247132E432A42582F475D2B435917
2F45132B41445D710D253730485A2C42542A4256243C502C445A233B512D455B
2B43592A4357122A3E32485A2C40521E32442F43541A30421F364C233B533F57
6F37516929425C2C445C2B43594B6377001227405668283E5031495B17304418
3348132F4728475E21304040515E11222F11222F000F1C102330172A372C3F4C
1D303D1F35401E323D1C303B182C370D222A1229311E343F21384721394B172F
41334B5D1B34482B44581F384C2D465A061F333A5266142C402B4357273C511E
3446243A4C2F475B162F492A476239546E29445E324D67274159344E6628425A
243C52263E54273F551F374D273F551E364C263E54334C600A2236324A5C3149
5B2A4052374D5F1F3547253C4C314858243B4B364C5E1B314320354A29415531
495D2F475B273F53183042314759314759293D4F2233462233461E30413C4F5E
091C2B4156652A3E4F233B4D2C445A3D56701F3A551C3752253F57142F441C37
4C213C511B364B0B263A1730441E394D1631451A3549213C511732472F4A5F0E
28400F29413E566C051B2D3F56663347581C324432485A273F532E465A233B4F
294155294155172C412B41532B3F511E3243283C4D2F455716304827425C3E59
732B445E344E66294159354C624C617600152A3F5469324A5E263E52152E4215
3044233E533350651B2D3E445766182B3A1023320215241326351A2D3A304350
1D313C162A350E232B20353D21363E1B30380F262E172D38233847283F4F192F
4130485A223A4E2F485C263E54334B61041C32395167152D412B4357263C4E1E
3446243849273F53132E48213F5C3A57722A476236516B213C5629435B213B53
233B51273F552C445A1C344A213C511C374C2A455A2F485C021A2E3951632941
531A324430465813293B2A4151283F4F2A4151374E5E1A304212283A22384A26
3C4E2F455732485A1E32433145563243562A3B4E2332451F2E411C2C3D3E4E5E
0F222F43566324394822384A22394F3A526A2D45612038541F374F1931471D36
4A1730441932461C3549263F531D364A0F2A3E142F432D485D203B50435D7510
2A4218314B374F670A2032495D6E3246572A3E4F22384A2A40521F374B243C50
233B4F263E52162C3E2A4052283C4D1D314225394A243C4E1531491E3B563F5A
7429445E385068263E542F4459485D72000B20485D721D35491931451E374B10
293D2843582A455A1727374C5C6C2232420E1F2C0819261526331A2B3830414E
21333E192B360317221B2F3A1A2E39253944122631172D391D32412A4151152B
3D253D4F243C502C4458274054334C60021B2F375064152D41253D512137491C
3244233A4A223A4E1D385223415E37546F27445F27425C213C56213B532B465B
1F374D1C344A253D531D354B1F3A4F1C374C2D485D344D61051D314C62742A40
52172D3F32485A12283A374D5F263C4E1C34462D4557132B3D152D3F253D4F27
3F51223A4C273F511B31432C42542D4153273B4D2031441B2C3F1D2D3E425262
081B28415461273C4B2E45551D3549263E562C455F243D57324A602E475B2942
561730441C3647253F50284253152F4010293D1B3448253D532B4359374F6714
2C44193149374E64041A2C3B4F603046581E34461A30421C3244172F43243C50
1E364A253D51172D3F273D4F2137491A3042263A4B223A4C203C542240593A55
6F26415B2B435B263E54283D524F647901162B54697E172C411B3347142D411A
3347254055243F541121314D5E6B2435420718250718250E1F2C11222F263744
1E303B2537420E222D1E323D0F232E2B3F4A1428331B2E3B1528372C40511529
3B1C324423384D263E52243C502E475B031C3039526619314521394D1D33451B
31432A4151253E5222405929476235526D26445D17324C28445C213C513B566B
20384E122A40193147284056203B501C374C2A455A3D556B021A2E4C62742036
4812283A293F5112283A2E4456183042223A4C2B4355082032132B3D233B4D2A
425418304221394B1A32442F45572D435524384A1C30421D2F401F2F3F425262
04172444576424394833475821364B152C42203850253D552C445A253E52213A
4E162F431E3849223C4D284253213B4C152E42213A4E1C344A2C445A2A425A1C
344C20385041586E081E30354C5C364C5E2137491E34461E36481E364A31495D
1F374B2840541B3045263C4E1C32441B31432D415328405226425A2847603654
6D28445C1C374C2D455B243C50566B80071C313F54692A3F54172C4119314525
3E5220384E1A354A11212E4E5E6A21313D0515210717230C1C28091B261F313C
1D2E3B2839461D2E3B2B3C491728352E3F4C1425321B2E3B0F22312D4152192D
3F1A304222384A2A4254243C5030485C071F333E566A223A4C273F511D35471B
33452E475728415519375026445F3C597427455E1A354F2D49612641563C576C
253D53183046152D432F475D1E394E213C512540553C546A0B23374D62772338
4D1F3449263E5220384C253D511830442A4256274054112A3E152E4229425621
3A4E122B3F1932461A3445334B5D2E47571E3545172B3C1C31401E31403A4D5A
0A1D2A5164711B303F22364720354A162D43182F451C33491E364A1D35491F37
4918304221394B233B4D2F4858344D5D11293B172F411B3347223A4E30475D1E
354B273E5440576D051B2D344A5C283D52243C500F273B223A4E162D432C445A
20384E2A435720384C2941551A32461931432D43552740541A395027465F3C5B
7228445C1F3A4F31495F29415554697E0012273E5166283D5221364B31465B43
5B6F193145213A4E1725314A5B641B29350717230A1A2610202C0A1A2620323D
2536431F303D1829362738451B2C392637440E1F2C20313E0C1E2F2C3E4F1C30
421D3143223648364C5E283D52324A5E051D313B5367253D4F2B435521394B1A
32442B4454203A4B14324B23415C4260792240591F3B5328445C2B465B3B566B
243C5220384E162E442941571A354A28435828435839516708203443586D2136
4B24394E1E364A233B4F1B3347112A3E243D511C3549233C501B3448344D6115
2E421730441C35491630412F495A2A435316303E1229381F3541203340384B58
0114215A6D7C25394A1D314322364820354A192E43152D41172F43243C502941
531B334521394B253D4F324B5B364F5F1830421C3446142C401F374B263D5329
40561D344A3F576B0C2234384E602F475B2840541E364A273F53243C522F475D
21394F2A4258223A4E2E465A1D35491A32462B41531F384C14334A22445C3E5D
741E3D54213C5129415730485C566B800011264C5F741A2F44182D42455A6F3E
53681B33472B43571B273143535A111D270D1C25101F281829320F1F2B283844
2A3B48192A371627341B2C391B2B381E2E3B0E1E2B2233400F2132293B4C1F30
431C30421D3143415769273D4F33495B051D2F354D5F21394B294153213B4C17
31422842521733441A354F2B48633D5B742947601A364E25415928435841596F
2D465A2740541C344A223A50263E542E465C304A623F576D0C2136485C6E2C41
562D425721394D263E52273F55172F452B43591732471D384C1833472540540F
2A3E1A3647274354142E3F2A4455243D4D142E3C132B3720364120343F384B58
00101D546776304253283C4E263A4C263C4E2036481F34490B23371D3549243C
4E162E401E3747223B4B2D46563049592940502B425213293B243A4C21364B3C
5166182D42475C71051B2D30465830485C1E364A253D531B33492C445A263E54
233B51263E541D354B2D455B1F374B1C34482A40521A334716354C2A4C643A59
7026455C1C374C263E542F475B596E830013254054661E32440E223441566B11
263B24394E293E531D28303E4B5308151D101D251120291F2E3713232F2D3D49
2435421A2B382334411C2D3A1F2F3C1F2F3C12222F1D2D3D182839293B4C2132
451F30431A2E404B5F71273D4F3147590B2133334B5D1E3648273F51233D4E19
33442B45551934481B374F34526B35536C3D5C7316324A2E495E223A5041596F
435C70314A5E273F55263E54364E642D455B334D65475F75051A2F44586A2D42
57293E531C34481D35492D455B132B412641561732471732462A4559213C5018
33470D293A1A34451C36472C4555243E4C16303C152E381C323D182E39344754
0E2130495B6C26374A2C40522A3E502F43552A40522B4153162E42223A4E263E
501B3345223A4C1F3848243D4D2942522037471D344412283A142A3C263B5039
4E6314293E3F5469051B2D3A50622E465A2A425621394F20384E2B4359243C52
263E54233B51162E442941571E364A1E364A2C42541B344814334A35576F3554
6B3E5D741B364B2C445A253D51566B80000E203E52641A2E404357691A2F441A
2F441D32472F44590A141B3C484E131F251C29311C2B34202F3820303C394956
1D2D3D1323332030402030402F3F4C21313E11212E1D2D3D0B1B2C3142551D2F
402C3E4F162A3B3448592D41522F46560B22323F56662039492E4757213B4B1B
35452E485925405416324A27455E2F4A6456728A2D475F203B50445C72364F63
3E576B2B44582A42582B43592E465C1931473149613D546A091E33415567243A
4C394F611E364A223A4E374F65142C42203B50213C511530442944581C364726
4051102A3B1B334530485A1B32422037461A323E1F363E0F262E1127323C525E
0317284C607225384D23364B34475C1F35471F35472C42541C3448162E422139
4D1B33450E26382A42541730402D4656142B3B2138481E35450C23333147593A
5062192E433B5065051B2D384E602B43571830441D354B1E364C253D53294157
2D455B2D455B1A32482A4258263E521B3347354B5D253E5213324921435B2E4D
6458778E274257294157385064576C81000F213B4F612A3E502E425420334818
2B40364B6021364B010C103540441C282E0D1B2124303A1A29322F3F4C2D3E4B
1525350818281E2E3E14243425354221313E1323302636461E304127384B2335
463547581428393D51622135462B3F500920303F5666263D4D2C4555243D4D1A
34442B45561E394D213D552D4C63334F674561792944592843583F586C375064
3B54682D465A21394F253D533A5268243C522840583A51670D23354054662339
4B203648223A4E1C3448324A60193147264156213C51132E422740541F394A21
394B1D35472036482F45571C3041243A46182E39223A401A323810272F2E4450
0B1F304A5D7234465D2A3F5532475D1C34482A405221394B284054223A4E2C44
581C344809213520384A1A3244395262243B4B1B3242283F4F162D3D253B4D36
4C5E152A3F3D5267071D2F304658263E52243C50223A501F374D2A4258354D63
2C445A2B4359263E542C445A253D511E364A2C4254223B4F2342592A49622E4D
64405C74304B602E475B3F576B52677C05192B4D61733044562D41531A2D422C
3F542C41561A2F44081317343F4318242A08161C2E3A4421303941515E283946
0A1A2A0C1F2E1B2E3B1629362A3B481B2C391B2B371D2E3B2A3C4D2236482539
4A273B4C25394A2D4152182D3C2F44530A1F2E405766294050274050263F4F1D
36462C46571B364A213E5332516836526A304D62233E532C475C385165395266
3B5367284054294056263D53223A50253D53364E663B5268081E30485C6D1A31
41243A4C1F374B2C4458223A501D354B2D455B21394F173044263E521F37491C
3343263D4D1D31422A3C4D1A2D3C2337420D222A1B313722383E152C34344A56
061C2E50657B3E516C283D58364C65193147253D4F1B35462B44581D354B243C
52162F4310293D1F394A152D3F2840521F38481932421A304222384A1B314322
384A22374C394E630D2335344A5C1C344830485C142C40273F532D455B3B5369
2A42582840562C445828405421394D223A4E263C4E20394D1E3D5234546B3352
692D49612843582942563C5468566C7E000D1F4C60723F5365192D3F1A304226
3C4E263B501B30450E191D404B4F18242A15222A1928310D1D292C3D4A1D303D
0013221D303F1326331D303D32435010222D2838440F202D263849374B5D0317
28273B4C2438492E4253061B2A3B505F0A1F2E3E5362283C4D1C3343253C4C1C
35452A425417324618354A35546B304D62213E531D384D284358334C60375064
3850641E364A2C4359283F55162E4420384E3B536B41586E081F2F405564233A
4A1D3444263E50284054243C521A3248273F551B334720384C283E501A314126
3B4A2C3F4E1D303F2030411929392739440A1D2413292E1F353B172E363E5362
091E33435972455A76394F6B273E58142F442F4A5E122E3F2E495E1E364C263E
541D354B20384E2841551B3347233B4D233B4D223B4B1C3244273D4F172D3F1E
34461F344932475C0D23352F4557293E53223A4E1B334720384C3A51672E465C
263E54263F53233B4F1D35491C344821394B23394B1B33471330453A5970304C
642540551B344829415532485A556B7D000D1F4E6274415567162A3C293F5128
3E502A3F54263B500E191D434E52101C2217242C1827301A2A362A3B48122532
0012211D32410B212D172A372B3D480E202B293C440E222D2B3F502E44560013
231F3646273C4B2C41500518273B4E5D0A1D2C3A4F5E2136451229381E354517
30401E36480D263A1E3B503A5970223F5419364B1A3549233E52314A5E2F485C
2F475B193145263D53233A50294159253D552A425A465D73092030394F5B2138
471B32421830421F374927405419324621394D132B3F2A3F54283C4E15273837
4A592E3E4E253444232F41212E3E2F3E4714262D1D31361C32371229313B505F
00142A516681425776374E6E2E466218344C223F541E3C4F2340551C364E2640
58193449102B40142F431730442D4758243E4F1731422A42541D35471B30453A
4F64162B403F5469021628354C5C182E40354B5D142A3C30485A2E465A284054
243C502840541A2F44182E401C32441D33452135470E26381E394E3A566E2441
561732471B344830485C2E44564C60720011234C60721F33451A2E40253B4D28
3E50162E40162E40030E12434E5219242C132028212F3B2C3E493245520D232F
051A29182D3C192F3B162C3820343F182B33182B320F242C30445513293B263D
4D1D3444263B4A1B303F102332384B5A0B1E2D3E5160223746152A391E324318
2F3F172D3F092236304D6239586F13304519364B1833472540542C4559263F53
233B4F1A3246364D631C33491E364E273F57324A62425A6E041B2A3A505C1B32
412A41500E273720384A253E52142D41233B4F13283D2F43552436471121313B
4B5826364323303E2F394A2C36472C384215252B233639203439182D353A4F5E
03182E455B773C53733F587A29436115334C2342571A394E29455D26425A314B
63274159142F441530451D364A3A53671C3647152F40233B4D152D3F20354A3A
4F64182D423E53680A1E303B4F60182E40283E501B3143253B4D284054294155
233B4F294155182E40182E401D3345182E401B2F400B21332E495E3551692742
57162E4421394D2F4459314557495D6F071B2D4C607222364823394B2C425425
3D4F1830421931430005094C575B2F3A4217242C12202C192B361E313E0D2231
0E23321C3342253B471D333F1A2E39172C340A1D240E232B263D4D11293B2B42
52294050152A391D32411225323A4D5A0C1F2C415461243746182D3C1B2F401A
31411A30421B33473350652A495E0F2C41223F54153044274256223B4F233C50
21394D193145465D73193046152D45263E563B536B3F576B031A29394F5A243C
48243B4A203949162E402C45590F283C273F5313283D2E42542335461C2C3C36
465324313F1D2836333B4C343D4B252F39101E242134371D32341D323A394E5D
0317304E6382364C6F344C703E577715324D1332491D3C5126425A233E582440
58254159133045163348142F432B465A274054213A4E193145172F431C34481E
364A152C422C41560A1E304A5E6F1B2F40203445162C3E1F354720384C2A4256
233B4F263E521F3547172D3F1B2F401C30411A2E3F1C32442F4A5F2E4A622944
59253D531E364A283D522C40524B5F710115273F53652A4052213749253B4D21
394B1830421630410A13174A545B1D292F16212919252F2A3A461D2E3B132633
142A36293F4B2036421D333E0E242F0B222A0B2028122833253A491A31411B2F
40192E3D2034451D32411D303F334655091C2B3D52611D324115293A15293A1C
32442137492D465A2A455919374A132E422F4A5E122D41284253183145264051
253D511830443C5468193046344C64284058263E5641596D051C2B445C68182F
3E223C4A173040183243294256162F43253E520F273B2A4052263A4B2E415035
46532838451B2836243042323F4F222F3D0E1F28203239172A311B2D38314152
1022394D627E395070364F7147638216334E14334A1B384D29455D244058203C
54274159132E43193449162F432E475B2E4859162E401E36481830421C344822
3A4E1B3248384D62000F214458693145560B1F312A4052152A3F2941551F374B
243C50243A4C253B4D142A3C142A3C1D33451C324431495D294459294459223A
50364E621A2F442B4153233749475B6D071B2D4256682A40522B4153172F413A
5266172F43142D410F151C51575E1E262D1B222B262F3818222C1A26301B2C35
273944384C572E424D0B212C07202A0F28320C273118313B0D212C21323F192C
391C2F3E182A3B2234453246573E5263071B2C3B52621A3141162F3F1A32441F
384C253D5330485E1E364A162E401C3647304A5B112B3C2F48581B33452B4454
21394B2840523F586C132C402C445A1C344A273F573850660720303953611B34
441832421E3849142E3F1D364A1D384C153044142D4121394B18304229405017
2B3C122637162A3B14273C1C2F44253B4D1D3444182D3C1E2F3C2532423C4658
131F374B5A744258744A658027445F102E471C364E1C344A2B465A243F531631
46122A40354D631D354B172F4320384A294252243B4B233A4A162D3D273F511A
324619304642576C031427465869182C3E293C51273C511A31472B4258223A4E
263B502236482E42541E34461E34461931451B33493A5268122B3F2C45591932
462C4456192F41324959233A4A4A61710317294D61732B40552E4358263B5028
3F5521384E1D344A10161D4349501D252C1820273039420E1921202D352F3F46
2A3B4451646C1B30380E252D0D2630152E3816313B1D36400E21291B2B371122
2F2737471D2F402435482D4153384C5E081F2F3C5363213A4A1A33431B344823
3C50314B633A52681D3549152B3D1F38481A3343193242263F4F1C35451E3747
364F5F2A4254243E4F233C502941571A3248223A52475F750014263F58681E36
481F394A233D4E253F50213A4E1C374B1833471D384C152F401D3748172F4127
3F51142B3B182E401C3448152C42162F43132D3E152C3C1A2A3A2D3748535A6D
070F2656667D39516927455E1837500E2D44162E461E354B253E522B47582D45
5B1A3248243B51162D431B3046172D3F253C4C283F4E2037462037462840522A
42541A31473D52670314274254652A3D522A3F54374E64152C422E455B1A3246
21364B283C4E314556233A4A20354A162F432C445C2D485D152E42163041233B
4D1C3446223949283F4F1C33434F6676000E203C50621B3045283D522D425831
465C253B541F354E111C244F5A621B262E25303824303A232F3924333C36454E
2A3A462A3A4600111C132732182B380319252D434F1E323D071A221628330617
242434441123342435483044563C5062051C2C374E5E284151203A4A233C502A
435738526A31495F172F43263E50253D4F223A4C152E3E2C45551F38482E4757
294153294153173142233D4E1C3549183145223A50395266041C2E384F5F263C
4E2F4759233B4D29435430495D1A3347294256233C501E36480C2436162E4024
3C4E233A4A182F3F142A3C1E36481E38480E2836102834243542343F4D475162
0914284F60752C445C27465D25455C102F46142C442D445A2A43572B45562F47
5D1B334920385021394F273E54162E421A3244253E4E203A48203A48263E502D
45571A31473B506501122541536435485D32475C40576D182F4530475D1A3246
263B50273D4F2E42532A4151263B50152E423D556D223D521732461E394D243E
4F213B4C1F37492A42541E3545536A7A00132541556724384A2F43552C415626
3B501E33491D32480B1B2241515818282F13232A23343D21323B2A3B442E3F48
25354123333F14263121333E1E2F3C263946495A671728350A1C272436411223
3026394807182B2236482E425433495B081F2F334C5C2A4454233D4D2740542C
455939536B213C51152E42385062253D4F2B4355152D3F314A5A1E37473A5363
294153364E602943542D4758243D51253E52364E643C54680A20323C53632036
48263C4E304658223A4C243C50223B4F2740541B3448294153031B2D20384A18
3042273E4E132A3A142B3B1A31411B35431E38442039431A2E39283341485263
071325475A6F2540551D3D541C3E55214158264156223A4E2C4559213B4C1E36
4C11293F1D354D233B53263C551D344A11293B1D3646243D4D183141233B4D1E
36481A31473E5368000F224456673043583D5267364D6322394F2F465C223A4E
33485D2036482A3E4F2F4557284054132C403F59711F3951163146385367213A
4E2741521C34462C4456283F4F4D647404182A485C6E2E425434485A31465B2C
41562A3F552B405603161E30434B0C1F2713262E22343F20323D2D3F4A3F515C
1C2D3A18293611222F31424F2131413A4A5A1726361425320C1E29233540172A
372E41501A2B3E31455730445633495B0F2636395262304A5A233D4D1E394D26
41553B556D253F571A3248354E621932461C36471B35462A44551933442B4556
2E46582941531B3345294153223A4E21394D2940563951650F23353145561C30
422F45571D33451F37492A42561B3347132B3F183044243C4E172F4121394B1E
36481C3343142B3B1A2E3F1D34431B3541243F4927404A182D35293541505B69
0E1C2E485B701A354A1233471E41552A4B5F2C475C223B4F354E62334D5E3048
5E20384E284058284058243C542E465C10293D1832431E3747193242223A4C1D
3547172E4441566B0012244557682D405542576C2D445A243C542A4258223A4E
354A5F1D334532485A2E445621394D152E423C566E213D55132E433550641C37
4B1B34481E3648253D4F293F51475D6F04182944586925394B25394B2E425431
45572F4459273C5104192141565E172C3420343F142833293D482E404B445661
10212E1425322D3E4B2A3A4A1E2E3E5060701D2C3C0B1B2B1C2D3A1629360F22
312638492B3F513B4F612B4153394F61051E2E3B5464354F5F2B45551C374B21
3C503751692A445C162E44385066122B3F1F384C1B34482E48591C36472C4657
324A5C243C4E1B33452C4456284054374F6322394F3C51660112254557681C2D
402D415324384A2F455720354A21394D172F43223A4E263E501E364821394B21
394B182F3F1F36461C31402C4352253F4B233E4828414B20353D2E3C484C5765
111F314A5F7413304513364A2D526824475B18344C273F552F485C2F495A3048
5E233B532B425C29405A1A314B223C54162E441C3549102A3B1E374721394B2B
4357162D4340556A05192B42566733465B3E566A30465F213951263E54162F43
2B405523394B40566829415318304418334839536B27435B18324A2C475C1631
461B364A1C3448324A5C1E34464F657705192A485C6D2B3F51213547263A4C26
3A4C293E5323384D071B264559642C404B152835182B38213441283B48233643
192C3B011423293C4B20324327394A384A5B2131420F2231314451182B381326
351428392E425435485D1B30453046580018283A5363344E5E324C5C203B4F24
3F53324C642A445C1530453F5A6F153045233E521E374B354E62253F502D4758
233D4E1A34452A425620384C2A4256475F73263D5341566B07182B4252632938
4B3445582A3B4E2B3F51263B501C314621394D2B4357294153132B3D253B4D1F
3547193040233A4A263A4B2D425121394529444E314A541D313C2835434B5868
000F224F647921405712374D22465E21435A18334D1B334B38516520384A253D
533048603A536D374F6B203854203B551732471D384C0C26371630411A32462E
465A1B30463F54690A1E3040546536495E3D5569334962223A52263E54112A3E
273C51283E503C52642A42541E364A213C5137516929455D1C3850335065142F
44203B4F20384C3C54682036484F6577011526475B6C324657293D4E293D4F22
36482D4153304456081A2542545F20313E2637441E2F3C2C3F4C1B2E3B182B38
1B2E3D1E33422034450F23342337482E42530F23340B1F30273A49102534192D
3E0C203234475C394E631C31462E465A0921333E57672D47572E4859223D512B
465B344E662D475F213B533B566B1D384D102B402C45592F485C2C4657173142
1D37480D2738344C600D25392941553F576B2B4258556A7F101F32425062303F
5229384B3B4C5F192A3D1D3045192E43182D422A425621394B122A3C23394B25
3B4D1229391B324220324333475820374616303C243C48263946354250485466
122036485F752A4962294C661C415B143751233E592C465E3F576B0C2436172F
453A526A405874344F6A213C5726415C14304819364B0F2A3E061F33132B3F22
3A4E1E33493F54690B1F314155662F44593E566A2F475F284058284056152D43
284054293F512E44562E46582B4359284358334E6828435D1D39513D59711B36
4B152D432C44582D45592F45573E54660013243C506124384920344525394B18
2C3E1C30421D31430E1E2B4959662535420E1E2B2737442536430A1D2C112433
091D2E1A3141263D4D061D2D3A5363051E2E142E3F1831412C4150021726283C
4D0E243624394E3E53691D3248385064051D2F3F596A304A5B354F6026415529
44592A445C344E6619334B2A445C1C344A21394F284155263F53314A5E233C50
2A4357233C50263E54152D433B53692B4359364E664F647A0B1A2D3E4C5E2635
482C3B4E2E3F52293A4D32455A23384D172C411F34491E34461E3446364C5E06
1C2E283F4F172E3E3344572135471D36461C36441F3645283D4C202E40445265
0E1E354F647F405E7B2244611035512F516E2E48663D5670273F53162E401B33
49374F67374F6B385270284260213D5B213F5816324A1732470F283C0F273B30
485C20354A43586D05192B465A6B2E4358455D713048602F49612B455D253D53
253D51324A5E2F4759364E60253D532B465B2A455F324D6717334B2C465E1D35
4B1E364C263E522A425632485A445A6C0011224155660D2132374B5C283C4E22
36482D4355172D3F0E19274E5B6918253323303E3C4C590314211C2C3C102534
182C3D263D4D1C3545132D3D253F4F0F2C3B183445213B4C162D3D0E25351E34
46152A3F2E43592A4157233A50395165041D313E5869284253354F6026415529
445928425A3A536D2A445C2641562C445A172F451F384C233C5020394D223B4F
2F485C243D5120384E1A32483D556B223A52455D75485F75091A2D3A4A5B3443
562D3E512E3F52283C4E2B3E53273A4F1A2F44293E531C324422384A40566812
283A1E3545293D4F293C51112439183042243E4E1D36463145562E3C4F445167
0C1B35465C782441603A5C7A1B3F5D395877324B6B576E88193145122A3C1830
46415A7435506B304C6A274362314E6D26435E28465F0E2A42112C411D364A24
3C5032475C455A6F1226383C5264273C51435B711E364E3E5870243E56264156
20374D2D4559273F51365061263E5429465B27425C35506A2A445C2843582D45
5B162F431F374B28405423394B455B6D000F20495D6E1D31422E425334485A2B
415323394B273D4F17202E444F5D212C3A303D4B3B4B5801121F142434142938
293E4D2B4251142D3D2C4656163040163342183445254152152E3E273E4E263C
4E21394D31485E1C324B21384E3750640720343F596A203C4D3B576827425626
41561E3850354E68253D552A4258253D531831452740541F384C2C4559223B4F
375267213C511B354D344E66213B533C556F2E4761445A730A1B2E3545563A49
5C2B3C4F3142552F43552C3F54293E53283D52273C5122384A2B41532E445616
2C3E203445203446192B42182D431D364A28425320384A2B41532736494F5D74
0A1B36485E7A2441602B4E6F224566345372344D6D3D536F162E421D35471D35
4B47607A37516F314D6C2D496B35547327456225435E28445C173247223B4F22
3A4E1D324746596E071B2D465C6E21364B3A5268324A62304A6229435B254055
263D5330485C233B4D3E58692A42582643581E3953324D67223C542B4359263D
53172F43283D52253B4D2E4456465C6E000F20475B6C13293B273D4F23394B3B
5163152A3F29415508132145505E1924323845532E3E4B091A272134431C2F3E
324756243B4A1831413B5565193343122C3C183445264051162F3F263C4E263E
522F465C2D435C263C55263E54455D73092236415B6C1F3B4C4864752F4A5E2A
455A1B354D314B63284056344C62263F53213A4E2E475B2841552E475B162F43
385368213C5118324A4E6781132C46526D882139554057710C1F343244553243
5624384A3145573046582B405523384D2A3F5424394E2C4254293F511F35471C
3244263A4B162A3C1C2E4520354B243C522B465A1A3445253B4D27354B515F76
0718334A607C3251701E42602A4D6E405F7E3F56762A3F5B1C3146284052223A
503B546E395371365274385778304F702342612E4F691F3D561F39512941571B
33471E31463F5267061A2C3E5466243B51435B712B455D213B533C566E223D52
2F475D354D61243C4E4962762E495E274459193750304C64233E53334C60263E
5220384C2F45572D43552F45573B5163001324354C5C1B31431C32441F35472D
45571F374B273F530E1C283F4F5B2F3F4C31414E1627340F202D142736213443
233847192E3D1E35452940501A3141041D2D1A33431A3343152D3F1E36481B33
473E556B253D552B435B2F475F435B710821353E576B1D394A516D7E344F6333
4E632741593A526A32495F2D45592941551E364A263E5240586C233C50193246
2F4A5F233E5318344C45607A27425D415D7B354F6D3B536F081D32374B5C2F43
55293D4F3145572A4052273C51162E4219314521394D2D4355263C4E30465829
3F51283C4D2337492B4056132A40213C51344F63152F40263E5038495E415168
02132D415773335370224763214361375774253D5B2136511C3146243C4E2139
4F27425C3A5675345072405E812E4E712E506E284865112E491430482A425836
4D6325384D45586D051B2D465C6E283F55364E64213B53324D67253F57375267
2D455B2F485C1F384C4F687C334E632C495E24425B33526930485E2D45592C41
56203648283E50455B6D283C4D435768000D1F42586A192F4131495B1C344836
4F63223A50324A60192B363446514E616E233643071A270F222F011423283B4A
2336452A3F4E2F41521D31422034451327382C4051233A4A183042243C4E152C
42496076273F57263E56334B633850660820363952661935464D697A2C475C31
4C61304963374F67354C622F44591B30451830441D3549395165243D5120394D
2E495E26405828435D314C6734506E3955733551703E597401192D3E5263374B
5D344A5C2F45572B4153263E521C3448172F43142C402C4254394F61384E602A
4052304455293D4F293E541D344A2742562E4C5D1C3948233C4C334457425368
12233D4F66804F708A2D526C2548622C4A65203854273D562036481F3749223A
50203B553C58772D4B6E3B5B7F3252752F50711B3B581B3954153149253D5549
5E741F32474A5D720C22343B536531485E3A556A1F3852304B65324C64243F54
284056253E521C35494D667A314C612C495E2E4C65304F66324A602C44581B31
431A30421E34463D5365283C4D4A5E6F00102243596B1C3446263E503F586C35
4E62263E54294157061C27394F5A374D581E343F0B212D1124311E313E2B3E4B
1C2F3E3548571E2E3E12223215253619293A1F2F402537481D3547223C4D1B33
4940586E2A425A273E582F475F3F576D052035324D61173344476374223D522A
455A314A642840583D5267354B5D172D3F21374920384A1F37491B3448193246
2C475C2E486035506A24415C3A56743B5776284466425C7A051D313C5363394F
61344A5C283E50324A5C263E52284054223A4E142C402A4052485E702C405227
3B4D364A5B25394B1F344930485E2846591C3A4B2A47561C36462135464D6173
02172D455F7744637C20445C1A3E561F3F56263E562A3F5522384A1E3648233B
531C37523B5678345275345478284A6E204063294867183651213D552941592D
42582B3E533B4E63011729475F713C5369344F64314A6426415B27435B173247
273F551F384C1C35494861752A455A264358314F6823425938516533495B182C
3E2236482135462337481C3041425667001628415769172F432E465A3A526836
4E6418324A1A344C0A202B405661324853192F3A041A26283B481C2F3C203340
2A3A4A4757671424341E2E3E182638253345142234314354344B5B2640513048
5E304860253A55233952172E443F576B031C30304A5B1B3448496276223A502C
445A364E6620384E364E621E3348243A4C253B4D293F51223A4C0E263A223B4F
1E394E3A566E314C67203D584C68862D4968334F6E3E597411293D3B5163344A
5C2A40521A3246364E621F374B294155233B4F2B4357263E523F5567243A4C27
3D4F2F4354293F5124394E2E465A223E4F1431402D4757203949293D4E506476
001429455D731F3E5526465D092B421D3C531B3349273F531A30421C34461E36
4C162F4935516F435F813553761E3F60294869254360203D5817324C243C542A
4157293E543A4D62071C3141596D4A63773D556B18324A2F4B6318324A193449
253E521B34481C3549445D71243F54223F543251681C394E354D611F3547273B
4D293D4F2A3E4F263A4B1024354C60710B1F31374D5F31465B364E622C445A1E
364C19334B18324A10202C4B5B672E404B0B1D280F202D253845192C391C2F3C
2B3E4B1D303D1629361124312535450E1E2E2A3A4A112433334A590720303249
5F152B44283B561C30491E34463D5464071E2E374D5F1B32483F556E22385132
495F30485C213B4C31495F263E541D35491D33452C42542A4151192F412B4357
2840562E4A6235506B24415C46617C36516C3A5570364F69071C3246596E293E
53293E53152C42364D6331495F294157263E542C45591C3549324A5C18304227
40502B4252223949172D3F2C4254253C4C334A5A2E425325394B1E2F4248596C
000F24495E731E364C203B500F2C41223F54102B401D364A1C34462941532740
5417324729435B3C57712D4A6527445F28456035526D26415B1B344E17304A49
6179182E473D546A051D312F485C516A7E3B54682A42582742571C344A1C3549
2E475B1932461B34483E576B233C502F4A5E243F5428415530485A2B43551C32
442137492F4354293D4E1C2E3F4C60710C2032455B6D1B30453B53671F374D1B
33491731491C364E07152153616D13232F0D1D29091A27091A27273A47253845
293C491124311B2E3B0316232030401E2E3E223242182B3A304854193341263B
512D415A2235501C3147182C3E3F5463071C2B32485A1E324B4356712C3F5A2F
455E2C4456264050334E63254055263E541B33451F3345243849253B4D1C3448
1B3349233F573C57721A37523F5A7537526D2C455F324A62071C32485B70273C
5224394F1C33493A51672840561B334921394F263E54233C50294256162E401A
33431A33431B3444293D4E1E324326384927394A3344572C3D501B2C3F516577
0C1F3443586D2941551730440B2339203B50122F4425405520394D1B33452039
4D1A33471E394E284358233F5739556D3D5872334E682F48620E2741152E482A
435D2038503A52680B2339445D714C65793851652841552A4357243D51263F53
1E374B1F384C1932463D566A2B44582E475B30495D1F384C354D5F294153273D
4F1D33451F3344233748283A4B4355660E223455697B31465B385064263D532D
455B233D5529435B0B19254B59650616220A1A261E303B081A253D505D304350
1E313E1225321B2E3D1326351424343F4F5F1727372E41502C4450243E4C253A
50273B5424375211263C1C30423C51600017263C526432465F3E536F2E435F36
4E66304A5B253F502A455A284358243C521F37491F3345263A4B2C42541E364A
1D354B38546C3B567115324D57728D3F5A75253E58455D75081D334C5F742439
4E20354A2B425840576D233B51162E442941572A42582F485C223B4F172F4118
3042152E3E2740501D3143182C3E2135472B3F51384C5E2F435513263B475A6F
03162B44596E2E455B2C445A1E364C2B465B2340552D485D2C4559132C401830
461E364C213B5326405828435D415C7638536D28435D1D385217324C0721391D
374F213B53385066071F354C64783F576B243C50263F531D364A223B4F233C50
1E364C2840562A42583C546A2F4A5F314C61314C61223B4F2E4658294153273D
4F1F35471D3142293D4E2D3F504A5C6D0011235C7082455A6F21394D1B324839
51672742572A455A1927333F4D590D1D290A1A2617293412242F1C2F3C192C39
1E313E1629362F42511124331F2F3F2333430818281F3241273F4B37515F253A
503C50692235502E425B20344640576601182740586A3D526D3A506C2C425E31
48622B4458233F5019364B294459152D431D3547273B4D2337481A30421D3549
243C522A465E27425D213E59526D882B466129425C324A62081D32495C712136
4B1E3348354C623F566C223A5021394F2C445A2C445A385165263F5320384C26
3E50142C3E30485A1A30423044561D3143304456273B4D283C4E1C2F44485D72
000C2150687C182F4531495F1F3A4F2843582D4A5F3350652D485D193147172F
45243E562741592A455F37526C3B567048637D2C47612A455F243F5916304813
2D452D475F324A600F273B4F677B3C54681B3347364E621E374B233C50294256
273F5528405641596F3550652A445C314C61243E562843581F384C2840521A30
421D3345243849283C4D192B3C4A5C6D000F21596D7F4D62771C34481E354B38
5066223D523752671927333A485414222E12222E00121D1D2F3A001320132633
1D303D1C2F3C2D404F1225342C3F4E091C2B0D1D2D1B2E3D2339452F4655283D
5342566F2A3D583D516A192F413C5363081F2F354D5F3A4F6A3B506F2B405F1F
37531934492745581F3C512A455A1D354B1B33452F43552034451B3143172F43
172F452A465E28435E25425D5E7B96415C77304963465E76071C314357692137
491E3446354D61344C60233B512D455B21394F263E543951672E475B2A425635
4D610C2438243C502B4055374C61253A4F31465B22374C23384D21364C4E6379
0012285D748A1D334C2F475F2A445C253F5727435B324E66243E561D374F152F
472A435D28415B243F5A405B7635526D36536E26435E17324C304B65152F4728
425A3E596E4D657B122A3E495F7130455A193145334B5F233B4F1A32482D455B
253D55223A52435D75334D65233C5624405817324C29435B263F532942562139
4B1C32442D415325394B192B3C4254650317294D617344596E253D51283F552B
4359183348425D721C2A363A485416243014222E10202C233540172A371E313E
1B2E3B1E313E1A2D3C1629382D404F0F22311E2E3E2C3F4E293F4B1B32412A3F
552E425B2D405B30445D182E40384F5F092232344D613E54703B5371283F5F25
3F5D1D39512B485D2440581D384D2B4359172F412F4557223949354B5D1B3347
2C445A233E58405B7626435E34516C425F7A28435D374F67091F31405465293F
5123394B334B5F2C4458263E5430485E223A502840563951672D455B29415539
51650E263A1F374B3C516623384D30455A2C41562B405522374C1D32484A6177
071E34556D833850682C445C39536B28425A223E56334F672A445C1C354F0E27
412A4560304B662C476244617C3A577236536E27445F2A455F1F3A542A445C16
30483752673B54681C34485066782B40552B405530485C2E465A21384E395167
223A52213B533D56703D567029445E223D57213C5629445E2742571E374B2E46
5A1830422E4456263A4C344657435566001325495D6F3A4F64233B4F243B5128
40561D384D344F641D29333F4B5513222B1C2B341C2C381D2F3A1C2F3C142734
2336431A2D3A2336450A1D2C263849081A2B1A2C3D2A3D4C2F4551273E4D2E43
5931455E2336513B4F68253B4D3D5464082032375064465C783D5474263F6138
547229485F26455A1C3850122D42263E54162E402B4153243B4B314759233B4F
1E364C223D5736516C14304E35526D5A779229445E4A647C0820323D5464344B
5B2A4052324A5E2B43572B4359263E542941572B43593C546A223A5020384E2F
475D162E42223A4E3D5569172F432A425621394D22394F1A3147233A504A6177
0D233C4860783A526A223C542A435D1C354F29445E3A556F39546E203B561530
4B284260344E6C35516F3C587635516F27445F33506B27425C25405A29435B27
41592E495E445D7114293E4B5F71263B50283D522C41561E364A263D532F475D
2C445C223B553D5571405B762E4964334E692845602A45601D374F152E42263E
521830442B415323394B314557475B6D0014264D617331465B284054253C522F
475D2D485D25405505111B3F4B550B1A233C4B5412222E283A451223301C2F3C
223542203340273A491B2E3D1123341D2F40132536354A59253A49283F4E4358
6E283C552F425D3B4F68394F612C45550A22342E465C3D55714059792942643B
577525445D224357233F57213D55263E54263F5332485A2B4252172F412B4458
253F572A455F2D4A65233F5D415E795C7994233E59344E66051D2F395060384F
5F2942522F475B2C44582C445A183046233B51273F553E566C1B33491C344A24
3C521830441D3549233B4F1A3246273F53334B5F253C521C33492D445A3A5167
021A32475F7738526A3B556D2D46601A334D344F69324D673F5A752B46612C46
642842602642602E4A6824405E24405E25425D3C5974243F5919344E1D374F23
3E53233E53496276102638495D6F30455A273C51364B6012273C354C62273F55
39506A1A334D3F5A7538536E27425D425D78223E5C24415C233D55264156213A
4E28405432475C283E501B2F41506476081C2E4155671C314631495D2C435928
40562B465B213C51030F193E4A5422313A2E3D4602121E21333E1829360E212E
1F323F1629360A1F2E2B404F192D3E293D4E0F2132283D4C2B404F374E5D485D
7324385126395421354E2D43553851610C2436374F653B536F3049691E375935
516F25445D0C2D4128445C2C48602F475D152E4233495B263C4E263E52152E42
2C465E213C56213E5925415F334F6D3D5A75243F5A344E66051D2F4057672E47
57314A5A2A42563A53672B43591C344A1833482843582E465C243C522F475D19
31471F374B263E521E364A2D45591E364A364E621D344A283F55354D63425A70
031B334B637B37516928425A243D571F38522E47612B445E2A45603E5876324C
6A1D37552B476528446216325026426023405B36536E213C5619344E152F4711
2C41223A504A6276051B2D53677921364B34495E273C5131465B273E542D455B
364D6728415B304B66344F6A213C573A5570213D5B0F2C472A445C274257354D
6319314531465B2B4055263A4C4155670B1F3150647612273C2B43572B435729
42562F4A5F344F64030F19404C56222E382B3A430A1A2629394520313E0C1F2C
102330162936152A390C21302C40511E3243081A2B1B2F4039505F263D4C3A4F
65283C5531445F32465F22384A354C5C0E2638324B5F3C526E354C6C27406239
55732241580F2E4329485F26425A274257243D5132485A1A3042243C501C344A
223C542E49632C48662B476539557339557326415C415B730D2539415868263F
4F374F61263F53354E62273F551D354B233E53344F6430485E172F452E465C15
2D43243C5020384C243C502A4256172F432B43571C3349283F55374F6540586E
021A324C647C334D65253F57203953233C562A435D223B55263E5A37516F324C
6A253F5D2D4967203C5A0B2745203D58213E59325069233E58243E561B364B17
2F451F384C49617503192B40546622374C2A3F54293E533951652C43592E465C
3E566E1A334D3C5470334E6926415C37526D2D4A650B26412A465E2A455A263E
5429415730485C152A3F2B3F5145596B000F214155671D324730485C2F475B29
42562843583651660D1820414E56121E281E2D36192A333A4B542B3D4800111E
1B2E3B0F2433243849091D2E2B3F50223647273B4D1F3344243B4A273E4D3E53
692D415A283B562F435C293F51364D5D0A23332E475B3F5571374F6D2E45653A
54721F3B531534493A597028445C375267263F532D435533495B20384C183046
324C643C577124405E213F5C3A5674405C7A1F3A55375169041C30435A6A2F47
594D65772740542740541E394E1F3A4F153045233E532540551A354A445D7119
3246233C50273F532A425631465B273C5131465B21394D253D513A5268465E74
041C324B63792F475F2D455D223A52273F572D455D2E455F18304C314965314C
6727425D2B4661223D58122D4825405B25405B334E6829425C2D475F21394F1C
33491A3246445C7012283A3B516323384D2B40552A42562F475B294056243C52
324A621C364E37506A4059731F3A54415C76243F59122D473D59712B475F334E
632941572A42562C4458273C5142576C0216283F536521364B20384C2941552D
465A274257304B6008131B505B63202C3624333C1F2E3734454E32444F0D212C
2134432A3F4E213546061A2B293D4E2A3E4F182C3E273B4C263D4C3B52613C51
6730445D2E415C2F435C405668324959071E2E2F4759445974354A692E436238
506C1F3A4F1F3D5028475E3D5971203A52233C502A3F5422384A2B4357071F35
28425A325069264260294764334F6D4B6785223D58435C760D25393E5466273F
51496173324B5F2D465A213C51132E431F3A4F274257284358142F433A536717
30441D364A334B5F23384D273C51283D522D425721394D1E364A334B6140586E
0B23394B63792C445C3B536B273F57253B542B415A40566F1C334D2F47632944
5F1E395427425D334E69223D58233E59243F59314A642B455D31496121384E21
384E193145455A6F0D233533495B192E4330485C284054243C502E465C2D455B
223A522038503F59712E4860324B6538546C1B36501E3A522E4A6237536B243E
56223D52243B51253D512C4156364B600013253D51631A2F440921351A324623
3C50223D521D384D00050D46515914212915252C0F1E2721323B21333E071B26
1E31402A3F4E182C3D12263724384A2F43551226382B3F503249583E58663E53
692E425B2D405B243851394D5F334A5909202F354D5F4055702B415D2E44603B
526C263F5325405419354D3551691C364E213A4E253A4F162C3E1F374B172F45
29435B26445D29456338567334526F5D7997243F5A40597311283E3E53682A42
5639516530485E2A42582742571A354A0E293E2E495E3D586C1A354930495D24
3E4F1731422840522B4153273B4D273D4F2D43552D45572C44563C5569435C70
0E273B4E677B2F465C42596F2B4258293E54283D53394F682D455D324B652740
5A213A5429425C3B546E263F591E3751233C562A435D2F475F2D435C1F364C27
3C521F3449475C71172C413C5468294155334B5F172F431C35491D364A243D51
263E54273F553C546A264156344E663853681E385026425A1D39512F4B63203A
52203B5020374D1930461E334841566B00112345596B263B501C344829415520
394D274257223D520A151D4A555D0E1B2313232A15242D2D3E4722343F122631
293C4B1C3140172B3C192D3E1B2F41273B4D1D31432C43532D4453395361475C
7224385121344F2D42582A3E503A4F5E0F26353D5365384C652338543348643C
546C2B4556244051244058254159354F671932461C3448314759142C40223A50
36506823415A223E5C32506D34526F597794233E59354E6809203640556A3A52
6638506431495F2941572843582B465B102B402A455A324D610D283C1A344519
33441E38483D5666293F51263A4C263C4E273D4F2137491F374931495D40596D
082135516A7E344B613F566C30455B364B612F445A2E455B2D455D2F49612E47
61324B6527405A2B445E1C354F243D5728415B273E58364C652E445D253A5027
3C52203348485B700B2337374F63364E622C445810293D314A5E253E52314A5E
344C622C445A2E465C2C445A2843583C576C27425727425726425A26445D2F4B
631B354D1B33492A4157172C4144596E0012243D51631D324723384D2A425613
2C401A32481B364B09141C4C575F16232B1929300F1E272637401D2F3A2C404B
2D404F2A3F4E192D3E091D2E1D3143172B3D071B2D273E4E2F46553B55633B50
66253952293C574C61772B3F513B505F1126353F556731455E253853394C6734
4A632B43552741522B475F26425A2B455D1C35491A3246273F51253D51142C42
203A5223415A2743612F4D6A3A58753F5D7A29445F47607A0F273D3951652E45
5B31485E3B53693D556B233E53274257102B402641562D485C1B364A2741520A
24341C3646324B5B2C43532F4354364A5B3047571A3042172F412D45574A6274
041C30536B7F3951653C54682E4359374C62394B62364B61273E542B43592E48
6039536B2640582741591B344E263F592F475F2038503B516A374D6633485E29
3B521F3045485B70132B3F415A6E324B5F2942561C3549294256274054233C50
30495D294256324B5F1F384C3851652E475B2F485C243F542D496127455E2440
581E3850193147233A50293E53374C610B1F3145596B293E53283D522B43571F
384C1B3448263F53141E254E585F1621291E2B3311222B2F414C1E313E394C59
273C4B1A2F3E1D31421A2E3F1C30421D3143182C3E253B4D1F38483A53632D42
57394D66293D56394E641D3143455A690A1E2F3F556730455B283C55394D6628
3F55263E502A4455365368132F472C475C2B44581B33471E3648263E5221394F
1E38502E4C652E4B6635536E5876913B58732B46613D576F0F263C354D61243C
50283F5531485E3A52681B33492D485D102B402E495D2E495D1C36472E48590A
2434334B5D31495B273D4F2A3E502F43553044561A2E401D31432D43554A6072
081D32546C803D546A3B5268253A55263B563146613D546E2F475D2641561F3A
4F2D485D29435B39536B223C541731492C445C152D433C526B3E556B41566C2A
3F552033484D62770D263A3F5A6E152E422641552E475B162F43314A5E1B3448
173044334C602A4357223B4F3952662D465A1D364A2944593B576F0D29412E4B
602A455A183046253D51263B504C6176001426485E7041566B2E465A273F532C
4458233C50344D611A1F22474D5219232A18252D0B1B273144511C3140243B4A
2239482138471C31401E33422B3F501C30411D3345253B4D18304440586C2941
552E455B263B512B4055273D4F415868091F3142586A374C612A415731485E28
405620394D2A45593B566A1F384C2C4458273C512C4156172C412B42582C445A
2A455A25445B315067304F685A78912E4C65344F693B566B0E263A4157691D32
4731485E31485E233B53273F55233B51132C40253F501B3546132B3D31495B12
2A3C34495E33485D2A3F5423384D273A4F2F43551C2D401A2C3D394B5C495A6D
06192E566B813A50693A506C1D36561B36582842662743621C3B522C4A5D1634
47284659264156233E532B4359172F452B42582C4458273F553F576D41596F20
384E273F553E576B0924383B596A1D394A3B596A1732461A35491B364A274256
2843572A4559364F63284155334B612941571F374D2B43593752661B364A2843
57233C502841551931432C4254506678000F214A607223394B172F411E364811
2B3C213B4C142E3F15191A43484B1D282C16232B0F202D2035441930402D4656
29404F152C3B192E3D1D32412C40511C3041263C4E1E3446172E443D546A2840
543D55691E3348354A5F213749364C5E071D2F415769253D51395165314A5E27
40541C374C2A455A2E475B1B35461C31461D324730435824394E33485E152D43
2C475C1A394E34536A2D4D6457768D2A4960233D553B53690D25373E55652C41
562E43583F556E344A632941571C3549122B3F223C4D223B4B1B34443A506211
263B30455B2F445A1A2F4524394F2B405525394B1C2D402737483444554F6172
11223751637A364B66314967122D4F1B385D3352792543661938512040531533
462341542944581E394D334C6010293D2F475B2840542E475B243D513E566C1E
394E26415636516509273A3E5C6D2F4D5E264455213F521836491A35491E394D
2843572A4559263F53364F63324A60263E541C344A2A43572B44581D37481E38
491D37482A4254223A4C3147593D5365041A2C455B6D1E36481830422A425426
4051243E4F152F4013181942494C1C262D18242E0D1E2B182D3C182F3F3C5565
1B32410F26351F3443293E4D1C304115293A2A4052253B4D2A4157384F652D45
59334B5F273C513E53682D4355304658041A2C3B51631B3347364E622C45591F
384C1D384D1F3A4F1A3347253E522D42572C4156283B50172C4130455B1E364C
2A455A26455A27465D33536A5B7A9116354C2741593C546A071F313950603247
5C192E433A5069344A632840561B34481B34482943540F28382D46562E445626
3B50253A50283C5520374D243B512B40551B2F412034463143541E3041455768
06192E596E84273F5728435E1D3A591E3C5F4F6F932F507116354C1D3B4E1E39
4D19344830495D1A33473E566A0A2236223A4E1A32461C33491830462C445A31
495F1A354A3A55690823373B57683551621C38492F4A5E1F3A4E1C374B213C50
253E52253E521A3347324B5F2C445A1F374D1F364C233B4F1E374B2741522A42
54294153273D4F1C32442F455742586A000D1F394F6120364810283A152D3F14
2C3E142E3F1B35461A1F204C5356151F261928310718251E3342193040425B6B
162D3C081F2E192E3D1B303F2438491C30412F45571C3244182F45364D633E56
6A2E465A1F34492B4055253B4D3F55670D23353E54662840542E465A2F485C22
3B4F2641561B364B213A4E223B4F293E532A3F54283B501A2F44283D531F374D
243F542F4E63203F5634546B56758C0B2A412E4860435B71031B2D415868394E
63183044394F683349622E465C274054284155294354152E3E213A4A2C415622
374C2E425B243A53283F55172F45273F53182E4024384A334758132738445869
001426486074324A622A45603855742C4D6E3151744062801130472D4B5E1B36
4A233E52243D51253E52364E62122A3E2B435720384C1C3349283F552B435943
5B7111293F445F73082337375364264253264253304B5F213C50203B4F274256
2D465A2740542841552B445830485E233B512A415720384C253E52233D4E233B
4D263E50263C4E203648273D4F42586A001224415769263C4E243A4C273F5121
394B1A34451A34452129294D5659131F2515242D0F202D253A491F3646344D5D
0F2636081F2F1E3342091E2D324657182C3D2D4355172D3F152C423B52682C44
582E465A283D523F54691A3042374D5F102638384E602B43572C44582F485C28
4155213C511B364B1730441831452D425723384D1F3247192E431C314721394F
203B5026455A27465D31516845647B133249243E56465E74001325465D6D374F
632840543F556E344C642D455B223B4F2841552D4758253F4F1E38481F374B19
3145364A632D435C2C4359162E443850641E3648192F41243B4B112838415868
0014264B64782E486038566F43617E1739571C3D5E2E506E15344B2E495E1E39
4E1F3A4F2C445A1B33492940561E354B243B511A31471F364C1D344A273E543C
546A0F273D445D7110293D3D5768213B4C344E5F2D465A1C3549294256213A4E
30485C233B4F2E465A2C445831485E283F5521384E1D3549162E421A32442E46
58233B4D192F41172D3F1C30424F6375001426495D6F1C324422384A243C4E1D
3547243C4E20384A242C2C454E511A262C0F1E271C2F3C223948273E4E1E3747
092030162D3D1A2F3E152A39293D4E1A2E3F1D334521374912293F3F566C2F47
5B2840542C415632475C1A3042405668091F312F45571C344831495D2C45592A
4357122D421F3A4F253E521C35492C44581A2F442B3E5331465B1E354B10283E
1E394E2D4A5F23425938586F3C5B7216324A2640583E566C001325445A6C2F47
5B2A4157374F67324A62273F551932462942562E4859233D4D253F4F1A324625
3D51384C652C425B2F465C1B334940586C1E36481A30422239492037473A5161
0D2335496173445F7427435B1836512343601A3C5A234360203B55243F541B36
4B213C512E465C172F451C3349253C522940562D445A29405621384E1D344A40
576D1C344A465F7310293D415B6C294354344E5F2F485C162F43314A5E1A3347
243C50162E421D354930485C2E455B2A4157142B41223A4E253D511D35472D45
571A3244283E503147592135473E5264000F214B5F711A30422036481F35471A
3244284052263E50232D2D3C484A1B292F0E1F282033401D34432A4151152D3F
182F3F182F3F071C2B1F3443293D4E263A4B182E40243A4C1D344A32495F1D35
49162E4230455A2C4156253B4D374D5F0A2032374D5F19314531495D314A5E2B
44581A354A294459213A4E2740543D5569243C502C415723384E20374D1B3349
27415935516916354C3F5E7537526C15304A2B445E395169061E32435B6D3951
65263D532C445C354D652B465B223D512C475B1D394A223C4C1A344429415526
3E523D536C2238512940561B32483C51661D33452C4052293D4E35495A425969
0C2333587082354E62203B500C2B42203F5830516B203E592C47613048601C34
4C3E566E21394F3D556B243B512B425830475D3950662A415722394F132A402E
455B1B32483951650C243840586A2D4557354D5F3951651A32462D4559243C50
253D511E364A1A324630485C344B612C43591E354B2F475B273F53273F513B51
63253B4D3145572A3E50223648435769061A2C566A7C314557394F613D53653B
51632F475920384A232D2D3B474918262C14252E192C391D32412A4052183042
1C33430C2333172C3B1D324133475811253620364831465B193046364D632038
4C30485C2E435832475C2D435542586A081E303E54661A324620384C314A5E22
3B4F264156284358233C501E374B2941551D354931465C1A2F451F364C1A3248
36506829455D18374E38576E29445E203B552039533E566E031B2F3E5668465D
73223A50243C54344C642D475F2B465B2742561C38491731422640511E364A2B
4357344A63253B5432495F2B405644596E293C51364A5C182C3D2E405145596A
0B1F304C6373223A4E2D465A29455D1F3E551A395228465F425B75334B63445C
7439516939516951697F4F667C2B42582E455B2A415730475D1D344A2C435924
3B51334A60465E720C24383D55672B43553C546640586C1E364A1D354930485C
2C44582D455920384C223A4E334A6021384E273E542B4258243C501E36482A40
522036483246581B2F411E3244425668001224526678384C5E2B41531B31431E
344618304221394B1C282A4854581222280A1D251D303D2035443B5163192F41
2D4152203445273A491326353044551C30411D33452E465A263D534960762941
55193145253A4F354A5F1026384A60720A2032344A5C31495D273F53223B4F1D
364A2C475C2C475C243F53253E522D45591931452F445A22374D283F55193147
29435B2A465E14334A3F5E75243F59223D572C455F354D65061E323C54663E56
6C3F576D1A324A4A647C1E3850233E532C475B122E3F254152294556132C4032
4B5F394F682F455E2A3F5532455A384B6024354A3445581C2D4039495A405263
0618295064752F4459364E623048602741591F3A54203B55455E784B627C5269
833F576F2B435B4058705E768E284058354D651A324A2940562D445A19304643
5A703D546A3C54680D25393D5567374F61253D4F3850641830442B4357284054
2D455920384C2C4458253D512940561A31472C4359344B612B43571E364A2E46
5A19314530455A1F34492E415642556A000E23415469162B401A2F441B304519
3145142C401E364A142022414D5116262C0C1F27182B38162A3B354B5D172D3F
2337482135462E41501E31402F43541D3345192E431D354921384E4A61773149
5D132B3F394E6330455A1E34464A6072061C2E354B5D3C5468273F5327405421
3A4E203B50274257284357203B4F2942561E364A2B4056283D532C4359263E54
27415939556D1D3C532F4E651A354F2C455F233A54445C740C2438354D5F3C54
6A3850661E375138516B132D452540552C475C203B4F2945562844552740542A
42583B516A2F455E2F4158384B6034455A27384D2C3B4E2534473141523C4C5D
081A2B495D6F32455A364B61213750243C5429425C203953273E58647B953047
6139506A1C344C284058576F87455D753A526A18304822394F253C521D344A46
5D7340576D374F630A22364961732D45572A4254324A5E1B3347344C6031495D
2B43571F374B3C54682B43572940561E354B253C522A41572B435721394D2B43
57223A4E2C4156293E5330435846596E0114293C516614293E11263B1B334720
384C1B33471E364A14212339484B182A310F232E203544203747455B6D2B4153
1D31421A2E3F2436471F314225394B192F41182D4221394D142B4151687E1F37
4B21394D2B40553B5065192F41455B6D051B2D374D5F445C70253D5128415526
3F531B364B2742572B465B213C512C445A294056263B512A3F55233952203850
1E385039556D32506923415A233E58233C56283F593C546C0A23373D57684B63
79334B6129425C3B546E1B374F28455A314E63213F522C48591B3748223B4F29
41572B435B384E673C4E65304156293A4D30415434455825364928394C435467
0B1C2F4A5E702E41562F445A1F354E263E56354C66405771263C58425874233C
56243D571D36501F3852324B65435C76365068173149273F5528405620384E36
4E643E556B3F576B11293D425A6C2E465830485A294155263E52233B4F3F576B
213A4E183145435C70294256253D53223A50253D53273F552E475B2740542A42
562A425621394D2B43572C415643586D000F2442576C2D42571B33471931451C
34481B3448274054202F3135464915272E0A1E291E33421E35453D536522384A
293D4E1C30412032432B3D4E293D4F1B314322374C374F63193046435A702A42
561A32462F445934495E22384A384E60061C2E354B5D3D556920384C213A4E24
3D51233E532944592641561E394E273F55253D53192E442B40562238511D354D
1E38503E5A72314F6837556E1E37512A435D2D445E324A62031C303F596A4E66
7C2D485D2D46603C556F19354D274459203D522E4C5F2541523753642F475D27
3F552E455F2B415A41566C273A4F293D4F2E4254415265273B4D2A3B4E465A6C
0216284D6075263B51243B51273D56223A52243B5549607A2C425E1129452D46
60233C56223B552C455F1C354F1E3953516B83243E56233E53223A50243C522E
465C3A5167374F630E263A465E702F475930485A243C50273F531B3347375064
1A3347152E423C5569213A4E1D354B21394F2C445A284056294256243D51253D
51243C50142C40233B4F263B5040556A0014293F576B253D511931451A32462E
475B314A5E3B546822313333444714262D081C271A2F3E1A31412E44561C3244
283C4E2135472436473446572D41531C324421364B344C60263D533B52683850
64223A4E2C41563B50652A4052374D5F061C2E33495B2F475B20384C1831451F
384C2B465B25405526435825405528405621394F192E443B50663D536C364E66
334D6539556D3E5C7524425B2B445E27405A2F46603D536C122B3F445E6F4964
793B566B37506A3C577117334B3754692E4B60213F522C4A5B2745561934492B
465B273E58374F67374F632B41532E4456263C4E34485A314759283B50384D62
00152A50687C31485E2B435B2B425C233C56172F4B314965243C581B334F2C44
60344F6A243F5A2E496427425C102E47405C7426425A2541591A344C1A324826
3E54425A70425B6F021A2E5B7385213B4C2A4455253E521932462D465A263F53
1A33471B364A2E495D1C374B1833481D384D2C475C243F542641552540542B44
58213A4E183145243D512F475B4D6579001024455D712E465A2C4559233C5033
4C602942562843571D2C2E37484B1D2F361327321D32411D3444283E502A4052
1C304222364821334427394A24384A1A304220354A2A4256283F5531485E425A
6E1D35492D425731465B2D4355374D5F071D2F384E602A42562840541A334723
3C50294459243F542542572B485D2F475D223A50273C523F546A475D76334B63
38526A435F7738566F213F5827405A3B546E1429444D637C0922363B54683A55
6A2E486026415B39546E1531493350652441562240532B495A2846572A455A24
3F542F4660263E562B4458243C4E223A4C253D4F1F3749334B5D193145344C60
061E324B63793A526A314B63233C562E496328435E25405B37526D2A425E2843
5E304B663C577225425D29476027455E2342592D4C633B576F27435B142F4415
2D43354D63364F630A2236526A7C1630412842532B4458142D412740542E475B
193448223D51274256213C501C374C203B502843582540552742562C475B334C
60223B4F213A4E284155324A5E526A7E0011254E667A3A53673A5367233C501B
364A132E420B263A1B2D2E3F50531F3138142833152A39162D3D192F412E4358
1B2F41263A4C2032431E304124384A1A3042253A4F30485C172E4440576D2D45
592E465A172C4133485D172D3F3B5163071D2F4157692D45592B43571F384C2C
45591B364B2D485D18354A2643582B435920384E31465C30455B384E67193149
36506848647C3B59721F3D56334C662E47611B304C4D627D0C243A3F586C405B
702D475F29445E425D771F3B53314E633350652442553654651937482A455A39
5469243B552E465E2942561D37481D3748253F501933442D4758112A3E385367
041F343C596E304C642F4D66223F5A314E69294563223E5C445E7C233D5B2843
5E213C57415E7927445F213F5831506915344B15344B1F3B532C48602B465B26
41563D556B3B5468132C40455F701731422842532B44581E374B132E422E495D
1D384C2540542442552442551C394E2643581B384D2B485D1A384B2745582944
581A354920394D263F53233C50435C70072034455E721F384C1932461B364A14
2F43254054102E4116272A3A4A5015272E0E202B1326331C30411D31423D5163
192D3E2335461B2D3E1E3041293D4F162A3C1C31462C445811283E485F753249
5F28405424394E22374C152B3D3C526403192B455B6D2D4559253D5120394D30
495D0B263B3651661A354A294459294459223A503E556B2F465C3E566E1D374F
37536B58748C304E6736516B2B445E233C563249634C627B172F453A5367415C
71354F67334E683A556F16324A29465B243F532945562A46571B37482D485C41
596F1129411B334B294458213D4E2C46571C36471731422B4556163041354E62
0B263B446078334E683E5C753E5B7634526D1735521F3B5928435E28435E213C
56243F5927425C314F6827455E27455E38576E213D5519354D3550652D485D16
2E442B43593C55690921335771821B3345264051253E52243D511B3448193448
2540542843572A455A2742571B364B2A455A112C41324D6214324529475A2742
561E394D27405430495D223B4F425B6F0013273B556621394B163041213A4E0A
23372C475B1833471C2931424F570817200C1B2413232F1525321A2B38435461
2232421E3140182B3A2A3D4C25394A213546192D3F162B40233A50425A702D45
5B21394F21394D31495D152A3F354A5F082032395163294155273F53263F5326
3F531A354A223D52334E62243F53344F632641553954693954692C48602A465E
37566D55748B345068324E662A445C274159213951637B910D2539445D712C47
5C3C566E2B4660415C7629435B3853681831451C3647263E50263E502D45592B
43592B43591B364B344F641B34482D4557273D4F273E4E2A3E4F172B3C394F61
051D314C647C425D7724415C314D6B3C5876223E5C122D4818344C243F542B46
5B234055112D4528445C203C54324E662C48602A445C0823383E566C334B611E
364A243C50526A7E0F2537415A6A253B4D2D4557233B4F2F485C183046253D53
2C445A284056294159243C522C445A284056182F45253D53304B5F2843572A42
58324A6030475D3F566C2840544D6579001325344D5D172E3E132C3C18304222
3A4E263D53162D432A36404D596315212B13222B15232F14243016263232424E
293A471D2E3B2134431D303F3044550D21322C405220354A1A31472C445C2E46
5C2D455B20384C28405422374C31465B0A22343850621C3448253D51213A4E31
4A5E1E394E2944592D465A142D413954681A35492D485D203D5229455D234259
3F5E753B5A7129455D28445C274257243F54263E544C647A0D2539425B6F2B43
593651662E49633D5872253F57324D622D45592F4759344B5B2B4252223A4E26
3F53233B513D586D2E495E1C35491D35492C4353263948273A49192C3B3D5162
0A1F34546C822F48622D4863233F5D466280304A6828435D1F3A4F1D384C2641
551A354919364B1F3C511A364E28445C1E3850324C641F374D354D6320384C14
2C401F34495066780C22343F5868283E502F47591C34482E475B1D354B233E53
3850681F374F1C344C263E561E354B31485E273E542940562F485C122D413B53
691D354B30465F22394F30455B4A6072000B1D3C53631E3544203746162C3E24
394E273C5221354E1E2C3842505C111F2B14222E14222E1A2A361C2C39283946
273845233441132635273A492A3F4E1C31402B3F50142A3C1C33492D455D1F37
4D21394F2F475B2D4559263B5031465B0B23353C54661A32462C445820384E39
5167203B502E495E3C5569314A5E344D612A4559233E53122F442F4B631E3A52
435E783D58722A445C233D55465E76253D551830465C748A0E263A415A6E2840
562F4A5F324D6738536D213B532B465B2E465A243C4E2D44543D5464324A5E20
394D2E465C2D485D294459253E521F374B3D54642639481F323F182B3A435768
0A20324F677D304963213C5625425D2E4B663D58732F4A64264156243F532843
581F3A4F1F3C511E3B5018344C29455D1B354D2E4860253D532A4258273E5426
3D532A3F5453697B0F27393E58682A42542D4758162F432D485C203B5019364B
365068213B531731492A445C1B3349374F65273F552D455B3E596D2E495D374F
652A42582A4059132A403A4F65445A6C000719344B5B1027362138471C32442F
44592C41572B3F5824323E4757631D2B371B2B371525311F313C20313E21323F
293A4720313E192C3B1F3241273C4B1F3443273B4C061C2E1A31473D556D253D
531E364C233B4F223A4E253A4F3D5267071F313E5668243C50334B5F21394F32
4A601B364B2A455A2C4559223B4F2E475B2D465A2944592B465B2440581C3850
445F792B46602B455D2A445C3F576F233B53223A50556D8310283C415A6E2840
562A455A334E68304B65203A52294459334B5F183042304757182F3F39516526
3F531C344A314C61213C511C344A1D35493D5464283B4A1C2F3C1124333E5362
051B2D4A63773D576F1B36502A48610F2D4638536D2440582742572944581C37
4C1F3A4F19364B254257143048233F57173149243E5631495F263E5429405613
2A401B30454C6476102A3B3953632D47582541521934482B495C274459122F44
24405828445C1F3B532B475F254055314C611530452B465B2C475B223D512B43
5930485E293F5830475D2B405643596B001325445B6B203746233A4A13293B1C
3146273C52394D6623333F4A5C6721313D1D2F3A11222F1D303D1E313E192C39
3346531E313E2235441A2D3C1E3342152A391C3140182F3F223A4E3C546A263D
53253C52162E4229415530455A34495E051D313A52662941552E465A253D532A
42581A354A264156223B4F2B43571B3349183046344E6618324A354F67233D55
4059732E4761253F57253F573951692D455D283F55485F7510283C40596D2840
562A455A304B6527425C203A522A455A334B5F1D354732495921384829415511
2A3E324A60274257213B5311293F1F374B3249592D404F223542172A37415665
03192B516A7E39546929455D2541591A364E2B475F223F542A45592A45591732
471A354A18354A2C495E1C38501E3A521E3850142E46273F55183046374E641A
31471C3146374F610A2435314E5D324E5F213D4E223D512644572C495E17364B
1C3B52203F5624435A26455C2744592643581330452843581F3A4E2B465A132E
431D354B31476020374D384D63465C6E000B1D3E5565213847233A4A2E445639
4E63334A60283E57192B36415560192B361327320B1E2B1C2F3C1F323F1B2E3B
4154611A2D3A1C2F3E1D303F293E4D172C3B142938263D4D253D5141596F1E35
4B1F364C284054445C702E43582D42570A22363850642A4256263F532B43592B
465B243F542C475C324B5F334B5F2A4258152D43264058213B53253F57354F67
39526C364F691E38502A445C435B73273F571E354B556C820E263A3C5569263E
542E495E2B4660223D57223C54294459233B4F21394B415868233A4A2D45592B
4458172F45284358233D5519314730485C2E4253263948182B381E313E4B616D
081F2F536D7E334E6229465B2643583552672A475C2C495E2B465A2B465A2742
571B364B18354A213E5328445C26425A102A4219334B3A5268243C5232495F18
2F452A3F54455D71051F30355261385465213D4E2641551B394C244156214055
29485F15354C25445B24435A21405524435828455A2B485D304B5F304B5F2843
58132E43294159253B542B4056556A7F001123546B7B3B5261263D4D263C4E29
3E53233952142A4320343F465C67172B360E242F0A202C1B313D1C31401A2F3E
3C51601126351A2F3E0F2433445A66152B37192F3B1B32411C34484A61772B42
5819304631465B3F54692137494056680A22363A52662C45592841552D455B2C
475C2A445C3651661A33472C45591F374D2A42582C445C2A425A2E455F334A64
364D67253C561D344E39506A374F671830482E465E526A800E263A395266243C
5235506529445E223D57264058284358294155233B4D354C5C263D4D233B4F25
3E52263E541B364B1D384D223B4F30485A273B4C182B3A091A271B2F3A415763
0920304C6677314C601C374B2543564260732644573351642C475B2742562641
561E394E0F2B4315314928445C28445C233D55243E563149612941592C435923
3A502E43583A4F64051D2F3D5768334D5E203C4D27425619374A18354A29485F
2F4E651A395027465D24435A24405829455D2F4C61335065163447264457203B
50253F5731496129415932495F4C64781026385067771D3444122939172F4125
3D51253B54243A531A303B4056610C222D061C27081E2A1B313D1B303F1C3140
293E4D2035440F2433172C3B3147531B313D142A36172E3D2C41563E556B2B42
5812293F263B5034495E23394B3E5466041C303B5367314A5E2E475B26415627
4257244058365368263E541C3549253D531B33492941592C445C3B526C3F5670
263D57364D67203751233A543E566E2C445C3D556D4E667C0F263C375064243C
523B566B2A455F26415B29435B2742572C4458233B4D4158681C3343273F5321
3A4E183046163146213C51294256223A4C2338471C2F3C122330223641334955
0219284962722E475B1631451634474462751634473351643F5A6E2B465A1934
49264156122E462541592B475F26425A28425A2741592B435B364E662B42582B
4258374C61495E73051B2D3C5466233B4D1E38492C4559254055173149345068
28445C24435A2B475F2440582A465E29455D233E53375469203D52163348233D
551731492C445C2C445C3D546A556D81041A2C415868162D3D2C4353273F5321
384E142A43293F58162D35384F5700131E182E390F2531243A460A1F2E1F3443
273C4B1C31401B303F182D3C344A56152B37192F3B19303F253A4F42596F273F
5321394D293E531C31461F35473D5365041C303D55693A5268273F551630482A
445C1531493451661D354B1730441C344A193147354D65142C444E657F3D546E
1A314B29405A1F36501C334D2E465E1D354D324A624E667C051C323E576B2941
572742572E4963142F4929435B2843582E465A273F513E5565132A3A28405422
3B4F162E44183348142C422942561931432B404F182B382638431C2E39425562
091E2D49627220394D254054133144274558375364395468344F63466176344F
6419344918344C29455D27425C26415B1A334D19324C243C542941591D344A3F
566C273C52485D72061C2E43596B1D32472A425631485E2E465C1F374F274159
2B455D233F5738526A253F5717314929435B1931493954691734491532471E38
50173149283F591C344C4B6278526A7E000E20364D5D1B3242263D4D243C501B
32483248611C314C0F262E374E56071E26182E39172D38263C48112635203544
314655061B2A1E3342293E4D2A3F4E152B37324854162D3C1F34493B52682139
4D243C50293E53283D522A40523046580B2337435B6F253D532840561D374F24
405819354D26425A1732471D364A1E364C1D354B385068284058526983374E68
1C334D2F46602138521C334D2840581F374F324A624B6379031A304760741D35
4B2B465B28435D15304A2741592A455A253D5131495B3B52622A41512F475B27
40541D354B112C41162E442C44581E3446314655192C3921333E1F313C435663
001423455D6F1F384C2B465A1836492A485B3651652B465A1F3A4F2D485D3D58
6D142F441A364E24405825405A26415B1B344E27405A2941592840581D344A39
5066263B51455A6F081B30465A6C2C3F542B4055394E642B4258293F58304860
3C546C2C465E1F3951223C542139512B435B1D354D243E561F3A4F1734491933
4B213B53364D6729415950667F536B7F0012243C5363122939374E5E172F432F
465C162C45162B46091F25344A50091F250F242C172B362437441A2F3E2D4251
2B3F50081C2D192D3E1D324129404F081F2E1D35411027361C3244374C61273C
5131465B243A4C273D4F273D4F2E44560D25393F576B1D354B2B4359233D552D
4961213C562B475F213E53213C511A354A26415636506828425A455C76374E68
203652293F5B18314B28415B2A435D17304A223C5445607500182E4C65791B33
492E495E2D486217324C253F572944591C344830485A253C4C2D4454243C5025
3E522F475D25405511293F2B435723394B3B505F1B2E3B1B2D381E303B394C59
001423435B6D243D512B465B1C394E1D3A4F304B601732472B465B223D522741
59405A72223E56233F573C577129445E1F38522B445E243C54273F57263C5526
3C551D32483F546905182D495A6D38495E2B3E53394E64233A5030465F324A62
3B526C2D445E1D344E29405A233B532F475F233B532C465E254055203D521832
4A28425A374E682941594A60794F677B082032465E70193242253E4E172F431B
32481B314A23385311252A3C52570E242910262C12272F192D381225342B404F
20344515293A1E32431F3344435A6A19303F243B4A30475621374930455A293E
53354A5F253B4D293F51192F413A5062082034374F632941572B465B1F395137
536B203E5734536A2541592643581D384D2843582C465E29435B3D546E3B526C
283E5A2B435F162F492D466027405A16314B1C3850445F7400172D4760742840
562E495E3B56701B3650213B532843581931452C4456243B4B395060263E521C
3549284056233E5310283E2F475B2A40523A4F5E182936182A35233540364956
071B2C435B6D2C445A2843581F3C510D2A3F2E495E1833482540552944591D37
4F253F572F4B6309253D1B3650213C5627405A324B65253D55213951374D661F
354E20354B394E6300122747586B38495E2A3D52374C62233A50364C65344C64
2F4660213A542B425C2B445E1F374F365068263E563B556D1F3C5128455A1D37
4F29435B2D445E253D55445A7350687C0010244D6577112A3A273F51263E521C
3349283E572035500D20233E535512262B20333A1B2E361C303B0E2130334655
263A4B0E2234223648263A4B2F4656061D2D1A3141182F3F243A4C2E43582B41
532C42542E44563D5365142A3C415769031B2F3A52662F475D2A455A1A344C32
4E66203E572C4B6213324928475C254159233F572A455F3F5A7447607A37506A
2B435F3B536F203953243F591B3650223D572B475F3E5B7001192F40596D3149
5F304B6039546E243F5919334B2C475C1D3549243C4E2B42524057672F475B1B
3448243C522C475C142D41344C602F45573146551223301B2D382C3D4A3F525F
071B2C455D6F2B4359314B63213B53122C442F49612B455D1732472944592C46
5E29435B0D294129455D102B45314C6638516B3F58722C445C1A324A43597222
38512E4359394E63000F2444586A2E41562C415634495F2940563A526A344E66
2A435D1F3A542A435D26415B1D374F36526A2640582B475F18354A28455A213D
5529435B2E455F314961485E77556D81000C20425A6C0C25351C3446364E622A
41572E465E152C46091D1E3C50511023261F33381B2E361E303B142532415463
21324505192B1D31432A3E50243A4C081F2F2138481A31411E3348364B603B51
63283E502C4254415769152B3D3F556701192D41596D273F552A455A1E3A5228
445C2B49621E3D5414334A22415629455D2A465E415C76506B854C657F38516B
28405C38506C213C562B4660233E5826445D29485F345166041C323F586C2E46
5C334E6329445E2A455F132D45344F641F374B1E36482B42523B5262364E6221
3A4E273F5539546910293D30485A334A5A30435215263321333E2738453D505F
0014254860742840583C566E203953233C56253E58314B631732470B263B2A44
5C203A52031F371A364E28435D1F3A5449627C3B546E223A521B334B455B7418
2E47283D5341566B001328445A6C253A4F2C44582D445A273F55324C6428445C
233E5825435C243F5926445D203C5427465D2D49611D395119364B2643582642
5A27435B354E68435B73495F78526A7E00172B3B5365243D4D1A3244334B5F2C
43592239531B324C12242344565716272A14272C162730142631132431405362
293A4D1B2C3F1E314625394B23394B0A2032132A3A162D3D1D32473B50654056
68293F5123394B3147591B31433B5163041C303D5569273F552A455A25415926
415B2C4A631A395023435A1E3F5329485F2A49604C678148637D445C783C5470
253D592D45611D3852314C662C4A6325435C2342592B4A5F061E343F586C2B43
59344F64213C56243F591731493752671B3347233B4D2940503E55653E566A28
4155223A502B465B132C402B4355344B5B2E41501A2B3821313D182936384B5A
0011234961752E465E3A536D29415D324A6620385428415B1F39512E495E142E
46152F47112C46132E4819344E17324C435C76354E681B324C2239533B516A17
2D4620354B43586D0014293E56681E364A2A43572C445A223D522E4A62203F56
203E5722415A27455E27465F2140571F3F562C4B621A39502140552241562C48
6026415B3B546E4A627A43597251697D000F233F57692F48583A5264273F532E
455B132A442B425C0515143C4C4B19282A1021241F2F361A2A361E2F3C455867
2C3D501C30421C2F44273A4F253B4D152B3D1E35451F3547253B4D34495E2F45
57263C4E213749263C4E263C4E384E60092135324A5E314A5E2A425826405827
4159223E561C385028475C24435A2F4E651C3A533F5A743D5873435B77405874
27405A314A64213A5427435B27435B2B475F2C4B622D4961061E323E566A2D46
5A324D6229435B1A364E1E3A523550651A3347274152172F412E4658364E6230
475D30485E3A5268243D5130485A344B5B263B4A1627341B2C3910212E3E5160
001325475F733A526A3049633A536D3C5470273F5B243D5719334B284358253F
57001830122E4618344C29455D2640582E4860405A72294159253D552D435C2B
415A2B40563C5167000F24374F611B33472A4357334B6126415637536B28475E
2A496017364D2A486121405722415827445923405519364B2A475C233F57324D
6726415B3D567048617B4157705A71870014283850622A405229415329415518
304629405A4059730F1A183C49470A16181D292D1D2D3423343D1223304E6170
1B2F41182E401B3045253A4F2D4355091F311E3244283C4E2A40523A5062283E
502E44562E4456304658293F51384E600B21333B516331495B2E465A29415530
485C263E52253E523D5A6F244058304B6528435E3D5571425A76566E8A344D67
2A425A243C5240586E233B51284056324A62273F573B516A051A2F35495B4258
6A385064233E522341541634473755681C394E183649213C503D586D263D5333
4962283E573E556B273F532840543B51632A3E4F1B2F40293C4B1A2D3C344859
041A2C4A5F742A42561F374D48617B3D587217324D17324C253F572F49611630
48112B43213B53173247233E531B33491C344A455D732F465C20364F1A304925
3B542A40594D627804192E455B6D2D425728405430485E223D523E596E2A475C
27445929465B28425A2742572A425831495D20384C273F533D576F223D572F4A
642C47623B536F425B75596E894D637C04192E3A5062394D5F293F5121394D2A
42581E395335506A131B1A46514F1B27291F2B2F23303821323B142532445968
122638172D3F162B4023384D273D4F0C223424384A2337491A30422A40522B41
53253B4D1A30422F45572B41533A5062041A2C394F6123394B2C42542E44562A
4052273D4F273F533853682D4961243F5A39546F3E567448607E4F6783354E68
2B435B2840563C5569263F531F364C243B512237524357701327393C50613147
59374F61253F501935461F3D5036546716334818354A254257324D62253D5527
3D56273B543D52681C33491E364A2E445623394B1A2E3F2D4152203445405465
091F31445A6C284054223A50213B532A455F37546F092740253E58213B531832
4A223C54213C51173247233C501D364A274054314A5E334A60233A501228412E
445D394F68445B710D2035384C5E1F34492B435720374D1A32482843582E495E
142F441E394E21394F30485E2D4257273C51293D4F2D42573E566E304963233E
5939546F39516D49617D556A8553698202142B5A6D822C4052152B3D273E541F
3A4F36516B2F4D660913133E48481E2A2C19282B2131381B2B37172835445968
15293B1C3244192F4123394B2036481026382438491B2F40253B4D384E602E44
5621374923394B384E60192F4132485A061C2E3F55671E34462E445630465822
384A273D4F253D51334E63304C64344F6A3B567149617F364E6C506884455E78
2E465E2941572B44582740541F364C233A502237523E546D0A2032334A5A3349
5B42586A253D4F102A3B1B3448324D61193448223D5125405530485E273F5729
4159253B543E556B263D532840542B4153243A4C172B3C2D41521B2F403C5061
0E22334E64761B3347334B611A344C25405A47647F24425B29425C344E66233E
53284358425D7227425710293D2D465A2942562A4357344B61243B51182F452D
445A2A40593E556B0A1D32364A5C283D522C44581D3549223B4F233E532A455A
2C475C264156162F432F485C2D425724394E2C40521E3348354D65304963324D
683F5A75475F7B374F6B5267825D738C091B32495C712E425412283A2E455B24
3F542D486223415A0B14173A46481B272B1B292F22313A1D2F3A1C2D3A4C5F6E
1D31421A30421C32442137491A3042162D3D1C3041192D3E1C32441A30421D33
452A4052203648364C5E22384A2D43550B21333D5365253B4D354B5D2B415321
37492B415321394D3853682C48601E39543D587348607E4B63813E56723C556F
2A425A28405620394D2C4559263D532E455B2A3F5A3D536C0C22342D44544056
68495F712840521C3446172F4330495D2E475B375064223A50354D632840582F
475F1A3049364D63253D51284054243A4C243A4C192D3E2F43541C30413F5364
071B2C4A61711A2F442C45592941591E3850415C76334E682D475F233D552742
572A455A3D586D233E53112A3E223B4F142D411B3448273E5431485E1E354B2A
4157263C55465D73071A2F3D51632E435821394D273F532740542B465B2D485D
284358264156213A4E354E62253A4F1F3449314557273C51374F672A435D1C37
52415C7748607C4D66803F546F50677D02142B3F5267213547293F51334A6022
3D523B56700D2B440D181C414C501C282C1B292F1928311F313C142532374A59
1E32430F2334182F3F1930401B2F401D3241142938213546172D3F364C5E2238
4A2D43552B41533046581A3042354B5D071D2F3147592B4153354B5D1E344622
384A2E44561C34482843581F3B5327425D3D58733E5674455D7B273F5B39526C
1F374F28405620394D2E475B253C5230475D2E435E40566F132B3F2D45573349
5B384E60243A4C243A4C1B3045253A4F31465B344C601C33492F465C2C445A2C
445A1C344A3951671F374B253D511D354923394B1B2F402D41521B2F403F5364
081C2D4259692F44591932463149611A344C38536D26415B223C541731492944
591C374C334B611B3349142D4120394D1730441A3347233B51425A70162D4327
3E543147603B5268081B3044586A1A2F44132B3F273F53213A4E264156365166
1B364B1B364B274054354E6222374C23384D2D415320354A2D455D223B552641
5C3E59743B536F465F792C415C556C82000D24405368263A4C2C42542A415736
51663D587213314A0F192048545A222E3418252D15242D233540122232223544
2034450F2334162D3D162D3C2237461E3342112635253A49102737263C4E192F
412A4052192F4132485A2F455732485A071D2F2F45572B415333495B192F4120
36482D4355172F433954691A364E2A456028435E425A7849617F2B435F314A64
1E364E21394F183145233C501F364C2D445A293F58394F680C2438385062253B
4D3046582137491C304224374C1D30452A3D522A3F5422374D21384E324A6021
394F2941573F576D233C502D4559243C50253D4F203446273B4C162A3B3A4E5F
081C2D4C60712A40521C3448324A602E48601B3650314C66253F57274159314C
611732472C445A1A3248183145294256233C50334C602840563A52681B324829
4056293F5831485E00152A4D6173162B40172F4320384C2B4458223D522F4A5F
233E531D384D1F384C2B44581E334824394E273B4D14293E3C546C1B344E2A45
602B46613F577349627C3045604E657B0011264053682E42542C42542A42563C
576C17334B23415A1A252D48535B2631391A2630202E3A2638431C2C3C2B3E4D
2035441A2F3E162B3A172C3B2C4150192F3B1629362036421F3646394F612137
49263C4E213749394F611F35473046580A2032394F6122384A2F45572137491D
33452A40521931452D485D27435B344F6A37526D29415F3E5674263E5A3C556F
263E561D354B162F43213A4E22394F2C4359233952354C62041D313B55662840
52364C5E2C40522435482C3D50293A4D37485D38495E2F42571D32472F475B1B
34482843582D485D223A502D455B294155273F51273B4D263A4B1E3140445766
001324495D6E1C3244223A4E263E543D576F0B264036516B3B556D2038502B43
59253D5310293D1831452C45591A33471932462F485C263F532A43572A425827
3F551C344C42596F00152A465C6E263C4E253D4F20384C364F63253D53273F55
21394F243C521D364A2C45591C3244192F412C4254243C502A425827405A344F
6A3D5873263E5A3D5670293E59576E84000E234C60721E3244394F612E465A1A
354A0E2A4223415A1F293337434D18242E11202921313D192936192A37354857
1B2E3D203544102534142A36324854142A361B2F3A1B313D162A3B22384A2137
492C4254192F4132485A192F41384E60071D2F405668142A3C2A40522B41531B
31432C425421394D1B364B1D39513A556F324D682E46642B435F243C58274159
29415920394D263F532E4859294155283F5521375040576D061F332C46572139
4B283E502A3E5030415428374A31405337455B38495E293A4F192E4329415524
3F532E495E264358253D5331495F2D4559273F51283C4E2034451A2D3C415463
0115263A4E5F32485A243C4E1D344A40586E2C465E253F57435B73273F57172F
451D354B10293D243D512A43571A3347193246152E422A43572F485C2B435917
2F45132B43445C720F243932485A2C42542A4254243C502C4559233B512D455B
2B43592A4258112A3E30485C2840521C32442D43551830441E364C213B533B56
7035506B29415D2A435D2C415C4B62780012274256682A3E5033495B18304418
3348132F4728465F25313D43515D14222E14222E000F1C132330192A372C3F4C
1D303D2134411E313E1C2F3C182B380D212C1428331E344023374823394B192F
41354B5D1E34462E445622384A304658091F313C5264162C3E2D4355273D4F1E
3446243A4C2F475B1631462C486039546E29445F344C6A273F5B344C6828425A
243C54263F532740541F394A2840541F364C273D56344B61092236314B5C3149
5B2A4052394D5F2334472B3A4D3746592A394C3A4B5E1F304520354A2941552E
495D2C475B224053172F452E465C2F475B253D4F2034462034451E31403C4F5E
071B2C415566283E50233B4D2D445A3F576D213B531E3850273F57162E441E36
4C233B511D364A0D263A173142203A4B1832431C3647233C5019324631495F10
283E11293F3E576B051B2D3F56662F47591A324430485C273F532D465A223B4F
284155284155152D41294155273F511A3244263D4D2D455718304629435B3E59
7329445E344C6827405A354A654A617702152A415567364A5B283E50162E4215
3045213D55314F68202E3A4957631D2B3713232F0515221626331C2D3A324350
1D303D1629360E212E2033402135401B2F3A112530172D39233748283E50192F
4132485A243A4C32485A293F51364C5E071D2F3C5264172D3F2D4355263C4E1E
344622384A273F531530452440583C57712C476138506C233B5729425C213B53
233B512740542C46571C3647243C501F374B2D435C30475D011A2E3852632941
531C324432465817283B2E3F522C3D502E3F523B4C5F1C2F4412273C20384C23
3C502A45592D485C1931472C445A2C4458243C4E1F33451B2F401A2D3C3C4F5E
0D213241556624384A22384A223A4E3A52682F475F203A521F374D1931471D35
4B172F451932461C35492640511D3748112B3C1630412F485C223B4F455D7312
2A401A3248375064082032475E6E2E4658263E5020384C2840541E374B233C50
223B4F253E52142C40284054243C4E193143233A4A243C4E193147223C543F5A
7429445E364E6A243D572D435C465D73000B204A5E702135461B32421F374B0E
293E26425A26445D1828344D5D6923333F0F1F2B0919251527321A2B3830414E
21323F192A370316231B2E3B1A2D3A253845122631172D391D31422A4052152B
3D273D4F263C4E2E44562A4052364C5E051B2D3A5062172D3F273D4F2137491C
324423394B223A4E1F3A4F26425A39546E29445E29415D233B57213A542B455D
1F374D1C3549253F501D3748223A4E1F374B30465F354C62051D314A62742A40
52172D3F32485A14283A394D5F283C4E2034462F4557152B3D152D3F243E4F26
4051213B4C263F53183046294157294155233B4D1E3244192D3E1B2E3D405362
081B2A3F5463273B4C2E44561D3549263F532E465C263E54334A602F465C2A42
561830441C3549253E52284253152F40102A3B1B3546253E522B445835506412
2D41173247364F63021A2C3750602E46581C34461830421A3244172F43243C50
1E364A253D51152D3F253D4F1F3749183042223B4B223A4C243C522640583A55
6F26415B29425C243D57263C554D647A03162B566A7C192D3E1D3444152D4118
3348233F57203F5612222E4E5E6A2535410818240719240E202B11222F263744
1E2F3C2536430E212E1E313E0F222F2B3E4B1428331B2E3B1327382A40521329
3B1C324423394B283E50263C4E314759061C2E3C52641B314323394B1D33451B
31432A4052263E502641562C495E37526C28435D19314D2A425E213A543B556D
20384E122B3F193344284253233B4F1F374B2D435C3E556B021A2E4A62742036
4812283A293F5112283A2E44561A3042243A4C2B4355082032132B3D223C4D29
4354173142203A4B1931472C445A2B435720384A1C30421B2F401D303F405362
041726445766243849334758213749152D4120384E253D532D445A263D53223A
4E172F431E374B223B4F284253213B4C152F40213B4C1C35492C45592843571A
35491E394E3E596D061E30334C5C344C5E1F37491C34461E36481E364A31495D
1F374B284054193143243C4E1A32441931432942522741522A42582D475F3853
6D28435D1C354F2B455D243A53546C80091C314155672C4051172E3E19314523
3E521C385016354C10222D4D5F6A20323D0416210618230B1D28091B261F313C
1D2F3A283A451D2E3B2B3C491728352E3F4C1425321B2E3D0D21322B4153172D
3F1A304222384A2C4254263C4E32485A091F31405668243A4C293F511F35471D
33453046582941531D384D29465B3E597329445E1C34502F4763263F593C566E
253D53183145152F402F495A21394D243C50283E573D546A0D22374D63752339
4B1F3547263E5020384A253D4F173142294354274152112B3C152F4029435421
3B4C132B3D1A32441A3248324A602E465A1C3446172B3D1C30411E31403A4D5C
0A1D2C5164731B2F40223647203648162E42172F451B33491E354B1D344A1F37
4B18304421394D233B4F2E4859334D5E102A3B1630411833471F3A4E2D485C1B
364A243F543D586C031B2D324B5B263E50243C4E0F2739223A4C162E422D4559
21394D2B435720384A2941531A32441931432B445427415220384E2C465E3E59
7328435D1F38522F4961293F58526A7E0012273E52642A3E4F2138482F475B40
5B6F1430481B3A51142631495B66182A35061823091B260F212C091B2620323D
2537421F313C1829362738451B2C392637440E1F2C1E31400A1E2F283E501A30
421B3143203648364C5E283E50344A5C071D2F3D5365273D4F2D435523394B1C
32442D435521394B183348264358445F79243F592139552A425E2B445E3B556D
243C5220394D1630412943541D35492B43572B415A3A51670A1F3443596B2137
49243A4C1E3648223C4D1A34450F2B3C223E4F1A3647213D4E1B3546344E5F15
2F401830421D3547162F432F475D2A4256162E4014283A1F3344203342384B5A
0114235A6D7C25394A1D3142203648203648172F43142C42172E44243B512941
551B334721394D253D51314B5C354F601731421B3546112C401C374B233E5226
41551A354A3C576B0A2234364F5F2F47592840521E3648273F51253D5130485C
223A4E2B4357223A4C2E46581D35471A32442942521F394A1A324829435B405B
75203B55213A5427415930465F546C800012244C60721C3041182F3F435B6F39
546816324A24435A1428333E525D0C1E290A1C270D1F2A1729340E202B273944
2A3C47192B361627341B2C391A2A3A1D2D3D0D1D2D2033420D2132253B4D1B31
431A30421B3143415769273D4F33495B071D2F374D5F23394B2B4153243A4C1A
30422B41531A32441C374C2D4A5F3F5A742B46601C3450273F5B28415B3F5971
2D455B2740541C3647223C4D273F532F475B33496242576D0E2136485C6E2C42
542B4355203A4B233F502341521331422745561533441B394A18344527415112
2B3B1F36462A4254142D412A4258243C50142C3E15293B203445203342384B5A
00101F5467762E4253283C4D243A4C263C4E1E364A1D35490B22381D344A243C
50162E421E3648223A4C2C46572F495A2640512842530E2A3B1F3B4C1C374B37
5266132E43425D71031B2D2E47573049591E3747263E501C34462D4559273F53
243C50273F531E36482E46581F38481C35452841511A34451C344A314B633C57
7128435D1C354F243E562F455E576F830013254054651E32430C23333F576B0C
273B1D3951203F561B27313C4B5406151E0C1D260E202B1C2E3912242F2C3E49
2435421A2B382434411D2D3A1E2E3E1E2E3E1121311B2E3D14283A253B4D1D33
451B3143182E40495F71273D4F3147590B2133354B5D203648293F51263C4E1C
32442E44561C34481B384D34536A35536C3F5A7416314B2E47612039533F5971
435B71314A5E274152264051374F632E455B364D634A5F75071A2F44586A2D43
55273F511B35461A354929475A0D2D402442551533461533462A4657233D4E1B
334510283A1B33451C344A2B4359243C50182E40172B3C1E31401C2C3C344756
0E2130475B6C2438492A4052283E502D43552A40522B4153162D4322394F263E
521B3347223A4C1F3749243C4E2942521E36481B34440F293A112B3C233D4E36
4F63112A3E3C5569031B2D3851612E47572A4353223A4C21394B2C4458253D51
273F53243C50172F432A42541E36481E37472A42541B354616334838576E3553
6C405B751B344E2C445C253C52566B80000E203E52631A2E3F4357681A304217
30441833472A455913131943464E161E251E29311A2B341D2F3A1D313C364956
1D2D3D1423332330402330402F3E4E2030400E212E192E3D051B2D2D42571B2F
412A3E50162A3B3448592D41523145560D213241556622384A304658223A4E1C
34482F475B273F5514324B24455F2C4A6553728B2947601E3A52425C74344F64
3E576B2C44582B43572C44582F465C1A314732495F3D546A091E333D5569223A
4E364F631B364A1F3A4F355065102D42203B50213C511530452944581C354926
3F5310293D1A33472B475F1431461E364A1C304123344114243016263240515E
0517284C607221394D1F374B32485A1F36462335462E42531E3348182D432338
4D1D32471026382C43531930402F4655162A3B2338472034450E22333347583C
50621B2F413B5163051C2C384F5F2D43551A30421E364A1F374B253D53294157
2D455B2D455B1A32482A4357253E521A3445334B5F233E5212324921435B2B4D
6458778E254159294157384F65576C81000F213D4E612C3E4F30425320344518
2C3D364D5D213847100A0F403E4423262E101A2120313A152A322A404C2B3E4B
152535091729212E3E17243425344420313E1023302237461A304223384D2135
473347591428393D51622135462B3F500B1F303F5666263C4E2C4456243C501B
33472C43591E38501E3C57284B652E4F6942617A25445B2643583D586D374F65
3C54682E465A223A4E263E523B5268253C522940563A51670B23373C54682139
4D1D364A213A4E193449324A60173247284058233B51152D4327405420384C21
394D1D35491D364A28455A1530452039491A2D3A27384121303917262F334350
0D1F30485D7230475D273F5530485C1E34462C405125394A2A3F5422394F2E43
591E33480B21332239491C33433D5261263A4B1D32412A3E4F182C3D293B4C38
4C5D192A3D3F5364071E2E304757283E50263C4E233B4F20384C2A4258354D63
2A455A294459263E542C4559243D511D364A2A4256203B50204259264A622B4D
653D5D742E4A622E465C3F566C52677C07182D4F60733443562F41521C2E3F2E
41503043521E313E1511173D3D431D232A0A161C2A3B441C31393C525E263946
0A1A2A0F1E2E202D3D1B28382B3B481B2C39182B38192F3B263D4D1E36482339
4B253B4D233A4A2B4252162D3D2D4454081F2F405767293F51273F51263E521C
35492C445A1B354D1E3D562F516933526B2D4C651F3E552A475C365166395266
3B5367284054294155263E52233A50263D53374D663B5268081E30465C6E1A30
42223A4C1F37492B4458233B4F1D364A2E455B223A4E183044263E502137491C
3343263D4D1B3242233D4E142D3D2136450F212C20303729363E1E2A343B4856
0A1C2D50657A3B536B253F57354D65193147253D511C34482C43591D354B253C
52172F4311293D20384A152D3F2A41512137491B32421A304222384A1D314322
384A24374C394F610D2434344B5B1C344630485A142C40273F532D455B3B5369
2A42582840562B445827405421394D223A4C263C4E20394D1D3C5532546C3251
6A2B4A6128425A2941573C5369566B80000C214E5F724152651B2C3F1E2F4228
3C4D283C4D1D324117171D474A4F1B232A15222A1629310A1E29283E4A1B313D
0013221F2F3F162535222F3F33435011212D2739440B212D223949334B5D0117
29253C4C2239492C4353041B2B395060081F2F3C5363243C4E1A3244223B4F1B
344829415717324716354C34546B2E4D641F3E551B384D284358334C60375064
3850641E364A2C4458284054172E4421384E3C526B41586E081E303E55652339
4B1D3345283E50284052253D4F1B33452840541D334522384A2A3E4F1C304128
3B4A2C3F4E1B303F1C3140152B372739440D1C251A282E28343A202D3543535F
0D1E31455A70445C7437506A233E58122D472F4961122D422E48601C364E263E
561B364B20384E2841551A3347223C4D233B4D223A4C1A3244253D4F152D411C
34481F344932475C0D23352F4656273F51223A4C1B334720384C3951672E465C
263E54263F53223B4F1C36471C344621394B23394B1B3347112F483957722E4C
65233E581B334B293F5832465F556A80000B22506176435469162A3C2B3F512A
3E502C4052283C4D15171F494C54111A2317242C152830172B36263C48102534
001221213141101F2F1A29392C3C490F1F2B293B460E222D29404F2C45550013
231F3646253C4C2A4150031827394E5D061D2C384F5E1D36461029391B354616
30411D364A0B263B1E3B503A596E223F541B364B1A3549253E52314A5E30485C
2F475B193145263D53233A50294157253D532A425A465D73092030394E5D2337
481B32421A31412138482A41511C334323394B172B3C2C40512A3D4C15283739
4A572E3F4C24364120323D1E31392F3F4618262C2430362531371B283040505C
03142751687E40597335506B2A476216334E223D571E3953233E581A364E2640
58173449102B40142F441530452B465A243D511730442942561C354918304637
4F65142B413D5569001628354B5D162E40334B5D112A3E2F485C2D465A274054
233C50274054183044162E401C32441D34442135460E26381C385038566F243F
5917304A1B324C30465F2E425B4A5F75000F264C5F741F32471A2D42273A4F28
3E50182E40182E40070D14454D5419242C1120291E303B283E4A2E45540B2231
051A291A2D3C1D2D3D1B2B3823333F192A33192A3311232E304554132A3A263D
4D1F3443263B4A1B303F0E2332364B5A091E2D3A5160203747112A3A1A324416
2E40152D41092236324D613D586C1730441D37481A33472840542D4559273F53
233B4F1A3246364D631C33491E364C273F55324A6242596F041B2B3A4F5E1D31
422C4051102737223949283F4F172E3E273B4C15293A31445324374611222F3A
4B5826364221313D2B3C45283A412A3A4117252B29353B2733391D2C353F4F5C
05192A465D733E566E3F5A7427445F15324D23405B1C375129445E26425A314B
63254257122F441330451B364B3853681A3549132E42203B4F122D411D354B37
4F65152D433C5468081E30394F61162E40263E50183145223B4F274054284155
223B4F284155162E40162E401D3444182F3F1B2F400B21332E495E3551692740
5A162E462137502D435C2F435C475C720719304C5F7422354A23384D2C415627
3C511A30421B314300030C4B565E2D394313242D0D212C152B371A31400B2231
0E2332203342293A4721323F1D2D391A2B340B1C2511222B2A3D4A152A392D42
512D404F172A391F323F1225323A4D5A0C1F2C415461243746182D3C1B2F401A
31411A30421B334538506231495B142C3E2740501830422A4254233B4D243C4E
21394D193145465E72193145152D43263E543B536B3F566C03192B374E5E243A
4C243A4C22384A182E402F455712283A294050132A3A2E43522336451C2D3A35
465322323E1929352D3E472E40472131380E1E2525323A202F3822303C3D4E5B
07192A51667B39506638506840597317324C15304A213B532843582540552840
56274256153044183347142F432B465A2540541F3A4E183145162F431B34481D
364A152D412A4256081E30485E70172F411C3446142C401D354920384C2A4256
233B4F263E521F3547172D3F1B2F401C30411C2F3E1E3243314A5E304B602B43
5B253D531E354B283D532C3E554B5E730114293F52672A3F54213749253B4D21
394B183042172F4105121A47545C1728310F212C122532253B47172E3D0F2635
142938293E4D22354221333E13242D1222291020271928312A3A472030401F2F
3F1D2E3B25354222323F20303D3646530C1C2941525F213141172A3917293A1E
32432337493246573145562037461A2E3F344B5B172E3E2B42521B3143273F51
253D511830443C5468193145344C62284056263E5441586E031B2D445A6C182E
40243A4C192F411931432C4254172F41283E501128382A4151263B4A2E415033
4653273845182A3521333E2F414C20313A0E1F2820303C1828351C2C39314151
1224355165774054663D52674E667A1C344A1A32481F384C2E465A294153253D
4F294354152F401B35461630412C48592E4859152F401D37481830421C344622
3A4C1B3345384E60000F2142586A2F4557071F31284054132B3F2941551F374B
243C50223A4C253B4D142B3B162A3B1F334420334235495A2C44562B4458223B
4F364E621A30422B4153233749475B6D071B2D4256682A40522B4252172F413A
5363172F41152E3E0A19220B1C251E2E3A182A350F222F1F344309202F122938
1B32410B202F172A3720323D0F202904141B09141C0C19210D1B270C1C290D1D
2A0515220B18260614200E1C281826321A283405131F000C1A0414210B1A2A06
162609192A2032430B1E2D0C222E051827132837142938051C2B0B2232041B2B
0F27390F273918304411293D031B2F142C400B233701192D152D4111293D1028
3C11293D0A223610293D193145072034294155132B3D10283A162D3D0D243414
29380C1F2E182B381C323E142A36162B3A1429381428391325360E2031112433
172738021222000C1C011423081B2A02162705192A1E32430C20310A1E2F051C
2C0F26360A21310B2434031C2C051F2F0E27370E2737162F3F112838041B2B16
2D3D0D243405192A192D3E1027370E2535172E3E061C2E142A3C193143041C2E
2A425410283A13293B142B3B1226371126350E2130182D3C19304011293B122B
3B1128380B2232142B3B081F2F0E25351B3242081F2F1C3343102736132C3C1E
3846142E3E112C3A182A3510222D31434E2F404D3A4D5C3043522D425139505F
3249581E36421C303B30434B2D3D441C2A3018222907101924303C1D2A382330
3E111D29232F3B17232F2B3743313D4944505C27333F141F2D0D1A28111E2E12
21311927392F3F4F2E3F4C172A371F323F1D303D384B5A1126352A3E4F1C3343
1B3143374F612A42561E364A2D45592E465A132B3F223A4E273F53233B4F223A
4E243C501F384C2942563850662D455B4E677B30495D253D512C4456273D4F34
4B5B223949223948314858223B4B193242223A4C243C5033495B2B3F51324455
3F4F5F23334010202D0D1B270F1F2B12222E1829362F404D283946182B382336
43203544324756112837263D4C1E38461B35433953612D445321384732475633
4857182D3C273C4B304352293D4E2438492940501E34462E44563C526430485A
4F6779334B5D233A4A2F4656223647374C5B253847283D4C364D5C1C36441A31
40253C4B29404F2F4655233A49314857314857223948374E5D273E4D2A445224
3E4C2843512742502F424F384B584154614A5D6C3C4F5E435665384C5D435867
3C53623D55613F535E52656D45555C2D393F3740442C343B3F49533B4753434F
5B323B48434C59343E48434D57434D57515B653B4751323E4A2F3D4935425038
4553384555404F5F3D4D5A34465130424D3F525F3A4D5C2C4150384C5D354C5C
3046583A50623A50623F5567364C5E3C52643C526433495B384E60374D5F364E
603B5365354E6237506440586E354D635570853B566A364F633A53672F475B3F
5769324A5C2F48584B63753E58692E475B395266344C62455D73394E63415567
4A5A6A374754323E48313D4737444C3A474F38475040505C3C4C583747532939
4541525F394C59304652394F5B2F475330475639505F3B505F405564384B583F
525F3E515E3548553A4B583D505F3A4D5C405564364A5B3950603D5365374D5F
586E803F55673F5567384F5F3047573D54643A4E5F3449584A61704159653B53
5F364E5A38505C4C64703E55643A5160445B6A3B526149606F39505F3F59672F
49573E58663A5462283E4A2D434F3B4E5D2F42513346552C3F4E354758334857
3148572C454F2A3E493C4F56404E543540443E434630363B353F493844503B47
53343E4838424C333D47343E48333D47454F5935414B333F4B2E3C482E3B4932
3F4D313E4E32424F3949552E3E4A283A4530424D33465334475635495A223647
2B4153344A5C2D4355354B5D2C4254314858384E6032465735495A2F46562B42
522E46582D455730485C3B5367374F653D556B284056314A5E2C4559263E5231
495D30485A2C4456324A5C2D4758294256304B6028425A324C642A4157364A5C
3E4E5E33414D353F49323D45323E4434414931404934434C38475037464F2B3B
472D3F4A1F303D1F323F263C481C31402138472A4150253A492C415024374629
3C493344512B3C49293A472D3E4B21323F2336451F32412438492B3F50304658
2B41531C32442D43551E34461D3444243B4B293D4E1C304122394818303C1E35
44263E4A233A49283F4E1A3140263D4C2A41512940502940502037472841511F
38482E4757223B4B0F2635081F2E162B3A1528371F2F400D1F30182A3B1C3140
0B22310B242E162A351B2E3518262C1720241D20242025281A252D1C2B341D2C
3514202A18242E16232B1A272F1A272F212E3619262E1D293318273013212D15
25311626331626331C2C38162730172733162833142734102332162A3B0F2334
1229391C3343132738172B3C0F2334142938192D3E122534192C3B1629381326
35192D3E1B2F40162C3E1C3244172F431A3246061E321830440A2236122A3C13
2B3D192F411127390F26360D243410293D102B400D273F0D273F0B223815293B
1C2C3C17262F1F2A321D272E17222A19262E1827301626321B29351826321F2F
3C152633091929102332162B3A1F3646193040243B4B1B2F401F3443182B3A1D
303F2535451D2E3B22323E22323E11212D1425321124311429381B2F40263A4B
192F4112283A162E40183042102638263C4E192F411027371229390E2534182F
3F2138471C33431D34441027371D344412283A1E344613293B112739152B3D19
2F4123394B182E40031D2B09202F1429381528371323341626370D1F300F2433
1328370B242E11262E12242B18242A1A21241011150B0E120E19210F20291D2E
3708172017272E08181F1222290B1B2219262E0C1C23101F280B1C250515210C
1E290F202D0D1F2A1A2B340C1D260E1E2A0E202B12233000111E051A29132738
0A2131182F3F1024350F24330E2332162B3A1326350E1F2C1829361426310E1F
2C1326331528370D213211253612283A102638041C2E183044051D2F0D253706
1C2E0A20320E2233162B3A0E23320E26380C25390D273F0C263E0A223811263B
1424340C1B24141F27111C240B161E111D2710202C0E1E2B1D2D390616220E1E
2B0E1E2E172A391B2F40132A3A283F4F1C32442B425222384A2337482135462B
3E4D29394A2434442A3A46293A431C2C3824344020313E1D303D1E3342283C4D
253B4D1F3547273F511D35471D334523394B1D33451E34461C32441D34442238
4A1E35451A3042293F511A30421A2F44162B40293E531E33481E33491B304624
394F2A3F55293E54142F3D1933413F53641C2E3F3040512E3E4F304253223746
1D324129424C31464E2F41482733391D242722212520232719262E20333B3346
4E1F30392C3E451A2C3321333A17293045555C26383F192A330D2028091B2616
2A351E323D1C303B3F50591928311F2F3B0C1E294758651B2E3B2035441B303F
243849485C6D2E43521B303F3B4E5D4255622435423749543A495232414A2533
3F253541283946273A473B4E5D4C60712B3F50283F4F354B5D2940502A415127
3B4C2337483247563547522C404B273E4D2B4355294459304A622E465C394E63
4252622836421F2933141F270E1A241B29352030401C2F3E40505D1929362332
420F1F2F3E52631B31431B31431A32441E364A445C6E2C44581A3042384C5E3E
526322334639495937455132424924333C2C3C482738452A3D4A374C5B495D6E
2B4153243A4C344C5E1D35472C44561C344620384A2B4355344A5C23394B263B
5032485A31465B34495E2A3F543C516724394F2D4258283D53293D562F405A31
425C34455F3B4C66395462385260566A7B3F5162404E6042526339495A3B505F
3C5160445D67394E5641545949555B4146494443473033373441493E535B4A5D
653F525A40535A3E515842545B4052595A6C733A4C5330434B2F424A31455040
545F3F5560364A5544555E3D4C553C4C583648535364713B4E5B304554394E5D
495D6E4F6374485D6C374C5B3B4E5B5164714355603F505943525B47545C4251
5A4859624757633C4E594558675568774357684054653A51613D5464465A6B4C
60713A4E5F4D606F51646C4F626A465B6A4A62743B5369435D753C53694B6075
5969793C4A5635414B34414938445043536041546336495845556540505D3545
553548574D61733A50622E465A344C60435C704C6579465E72344C60374B5D4D
61734051643F4F5F47556146535B3F4E574A5B643F4F5C3B4E5B475A69536877
43596B3D53653C54663B5365475F71455D6F364E60475F714B6075475C714A5F
74465B703E5368495E7340556B495E7441556E3B4F68394D663A4E674F607B49
5A75495A7552637E}
Left = 304
Top = 88
end
object ImageList1: TImageList
Height = 20
Width = 20
Left = 276
Top = 416
Bitmap = {
494C01010D000E00040014001400FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000500000005000000001002000000000000064
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000C0C0C000C0C0C00000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000C0C0C000C0C0C000C0C0C000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000C0C0C000C0C0C000C0C0C0000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000C0C0C000C0C0C000C0C0
C000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000C0C0C000C0C0
C000C0C0C0000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000C0C0
C000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000008080800080808000808080008080800080808000808080008080
8000808080008080800000000000000000000000000000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
000000000000808080000000000000000000000000000000000080808000FFFF
FF0000000000FFFFFF0080808000FFFFFF0000000000FFFFFF0080808000FFFF
FF0000000000FFFFFF0080808000FFFFFF000000000000000000000000000000
0000000000000000000080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
0000000000008080800000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000C0C0C00000FFFF00C0C0C00000FF
FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF
FF00000000000000000000000000000000000000000000000000000000008080
80000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
0000000000008080800000000000000000000000000080000000800000008000
0000800000008000000080000000800000008000000080000000800000008000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF0000000000C0C0C00000FFFF00C0C0
C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0
C0000000000000000000000000000000000000000000000000000000000000FF
FF0000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF000000000000000000000000000000
00000000000000000000000000000000000000000000FFFF0000FF0000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
000000000000808080000000000000000000000000008000000000FF000000FF
000000FF000000FF000000FF000000FF000000FF000000FF0000800000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFF000000000000FFFF00C0C0C00000FF
FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF
FF00C0C0C0000000000000000000000000000000000000000000000000008080
80000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FF0000000000
0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00000000000000000000000000000000008000000000FF00008000
000080000000800000008000000000FF000000FF000080000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF0000FFFF000000000000FFFF00C0C0
C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0
C00000FFFF0000000000000000000000000000000000000000000000000000FF
FF00808080008080800000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF0080808000000000000000
00000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000008000000000FF00008000
0000808080008000000000FF000000FF00008000000000000000000000008080
8000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFF00FFFFFF0000000000C0C0C00000FF
FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF
FF00C0C0C00000FFFF0000000000000000000000000000000000000000008080
800000FFFF0080808000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0080808000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFFFF00FFFF0000FFFF
0000FF000000FF000000FF00000000FFFF0000FFFF0000FFFF0000FFFF0000BF
BF0000000000000000000000000000000000000000008000000000FF00008000
00008000000000FF000000FF0000800000000000000000000000000000000000
0000000000008080800000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF0000FFFF00FFFFFF00000000000000
0000000000000000000000000000C0C0C00000FFFF00C0C0C00000FFFF00C0C0
C00000FFFF00C0C0C000000000000000000000000000000000000000000000FF
FF00808080008080800080808000808080008080800080808000808080008080
8000808080008080800080808000808080008080800080808000000000000000
000000000000000000000000000000000000FFFF0000FFFFFF00FFFF0000FFFF
0000FFFF0000FF000000FF0000008080800000FFFF0000FFFF0000FFFF0000FF
FF0000BFBF00000000000000000000000000000000008000000000FF00008000
000000FF000000FF000080000000000000000000000080808000000000000000
0000C0C0C0000000000000000000808080000000000000000000000000000000
000000000000000000000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000008080
800000FFFF008080800000FFFF0080808000FFFF0000FFFF0000FFFF0000FFFF
0000808080008080800000FFFF00808080000000000000000000000000000000
00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF
0000FFFF000000BF000000BF00008080800000FFFF0000FFFF000000BF0000BF
BF0000FFFF00000000000000000000000000000000008000000000FF000000FF
000000FF0000800000000000000000000000000000000000000000000000C0C0
C000FFFFFF00FFFFFF00C0C0C000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000FFFF008080800000FFFF0000000000FFFF0000FFFF0000FFFF
0000808080008080800080808000808080000000000000000000000000000000
00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF
000000BF000000BF000000BF000000BF0000FFFFFF0000FFFF000000BF000000
BF0000FFFF0000BFBF000000000000000000000000008000000000FF000000FF
0000800000000000000000000000000000000000000000000000808080000000
0000FFFFFF00FFFFFF00FFFFFF00C0C0C0000000000000000000000000000000
000000000000000000000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FF
FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF
0000808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFF0000FFFF
000000BF000000BF000000BF000000BF000000BF00000000BF000000BF000000
BF0000FFFF0000BFBF000000000000000000000000008000000000FF00008000
0000000000000000000000000000000000000000000000000000000000000000
0000C0C0C000FFFFFF00FFFFFF00C0C0C0000000000000808000000000000000
0000000000000000000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF000000000000FFFF
0000808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFF0000FFFF
000000BF000000BF000000BF000000BF00000000BF000000BF0000FFFF000000
0000000000000000000000000000000000000000000080000000800000000000
0000000000000000000000000000000000000000000000000000000000008080
800000000000C0C0C000C0C0C0000000000000FFFF0080000000008080000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000FFFF0000FFFF0000FFFF000000000000000000008080
8000808080000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
000000BF000000BF000000BF000000BF000000BF000000000000000000000000
0000000000000000000000000000000000000000000080000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF0000FFFF0000FFFF00800000000080
8000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFF0000FFFF0000FFFF00000000000000000000000000000000
0000808080000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
FF00FFFF0000FFFF000000BF000000BF00000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000FFFF00FFFFFF00FFFFFF0000FFFF0000FFFF008000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000FFFF0000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFF0000FFFF000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFF00FFFFFF00FFFFFF0000FFFF0000FF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000FFFF00FFFFFF00FFFFFF0000FF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000008080
8000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000FFFF000080800000FFFF000080800000FFFF000080800000FFFF000080
800000FFFF000080800000FFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000808000C0C0C0000000000000000000000000000000000000000000C0C0
C0000080800000FFFF0000808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FF000000FF000000FF000000FF00000000
000000FF000000FF00000000000000FF000000FF000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000FFFF0000808000C0C0C000000000000000000000000000000000000000
0000C0C0C0000080800000FFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000008080800000FF000000FF000000BF000000FF
000000FF00000000000000FF000000FF00000000000000000000000000008080
8000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF000000BF000000FF000000FF000000FF
000000FF000000FF000000FF000000000000000000000000000080808000FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
0000FFFFFF00FFFFFF00C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000BFBF000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000BFBF0000BFBF0000BFBF00000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF000000BF000000FF000000FF
000000BF000000FF000000BF0000000000000000000080808000FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF000000
0000FFFFFF00FFFFFF00C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000BFBF0000BFBF0000BFBF0000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000BFBF0000BFBF0000BFBF00000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF000000BF000000FF
000000FF000000BF0000FFFF00008080800080808000FFFF0000FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000C0C0C000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000FFFF
FF00FFFFFF00C0C0C00080808000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000BFBF
0000BFBF0000BFBF0000BFBF0000BFBF00000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000BFBF0000BFBF0000BFBF00000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF000000BF
000000BF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
000000000000C0C0C000FFFFFF00FFFFFF00808080000000000080808000FFFF
FF00C0C0C000C0C0C00000000000808080000000000000000000000000000000
0000000000000000000000000000000000000000000000000000BFBF0000BFBF
0000BFBF0000BFBF0000BFBF0000BFBF0000BFBF000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000BFBF0000BFBF0000BFBF00000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000FFFFFF00FFFFFF00808080000000000080808000C0C0
C000000000000000000080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000BFBF0000BFBF0000BFBF0000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000BFBF0000BFBF0000BFBF0000BFBF0000BFBF0000BFBF
0000BFBF00000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF000000BFBF0000BFBF00FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000BFBF0000BFBF0000BFBF0000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000BFBF0000BFBF0000BFBF0000BFBF0000BFBF
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF000000BFBF0000FFFF0000FFFF0000BFBF00FFFF
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF00C0C0C0000000000080808000C0C0
C000808080008080800000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000BFBF0000BFBF0000BFBF0000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000BFBF0000BFBF0000BFBF00000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF000000BFBF0000FFFF0000FFFF0000BFBF00FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000808080000000000000000000000000000000000000000000000000000000
0000000000000000000080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000BFBF0000BFBF0000BFBF0000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000BFBF0000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF000000BFBF0000BFBF00FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000008080800000000000808080000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000BF000000BF000000BF000000BF000000BF000000BF000000
BF000000BF000000BF0000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000C0C0C000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C00000000000FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000BF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000BF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000C0C0C000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
BF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000BF000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C00000000000FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000BF0000000000000000000000
0000000000000000000080808000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000808080000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000000000000000
000000000000000000000000000000FF000000FF000000FF000000FF00000000
000000FF000000FF00000000000000FF000000FF000000000000C0C0C000C0C0
C00000000000000000000000000000000000000000000000BF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000BF00000000000000
0000000000000000000000000000FFFFFF0000000000C0C0C000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C00000000000FFFFFF000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000008080800000FF000000FF000000BF000000FF
000000FF00000000000000FF000000FF000000000000C0C0C000C0C0C0008080
8000000000000000000000000000000000000000BF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000BF000000
00000000000080808000000000000000000080808000C0C0C000C0C0C000C0C0
C0000000FF000000FF000000FF00C0C0C0008080800000000000000000008080
8000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF000000000000000000000000000000
0000000000000000000000000000FFFFFF000000000000000000000000000000
0000000000000000000000000000FFFF000000BF000000FF000000FF000000FF
000000FF000000FF000000FF000000000000C0C0C000C0C0C00080808000FFFF
00000000FF00C0C0C00000000000000000000000BF000000FF00FFFFFF00FFFF
FF00FFFFFF000000FF000000FF00FFFFFF000000FF000000FF00FFFFFF00FFFF
FF00FFFFFF000000FF00FFFFFF000000FF000000FF000000FF000000BF000000
00000000000000000000FFFFFF0000000000C0C0C000C0C0C000FF000000FF00
00000000FF000000FF000000FF00C0C0C00000000000FFFFFF00000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF000000000000000000000000000000
00000000000000000000FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF000000BF00000000FF00C0C0
C00000BF000000FF000000BF0000C0C0C000C0C0C00080808000FFFF0000FFFF
0000000000000000000000000000000000000000BF000000FF000000FF000000
FF00FFFFFF000000FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000
FF00FFFFFF000000FF00FFFFFF000000FF000000FF000000FF000000BF000000
000000000000000000000000000000000000C0C0C000C0C0C000FF000000FF00
00000000FF000000FF000000FF00C0C0C0000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000000000000000
00000000000000000000FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF00000000FF000000FF000000
FF00C0C0C00000BF0000FFFF00008080800080808000FFFF0000FFFF00000000
FF00C0C0C0000000000000000000000000000000BF000000FF00FFFFFF00FFFF
FF00FFFFFF000000FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000
FF00FFFFFF000000FF00FFFFFF00FFFFFF00FFFFFF000000FF000000BF000000
00000000000000000000FFFFFF0000000000C0C0C000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C00000000000FFFFFF00000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00000000000000
000000000000FFFFFF0000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF00000000FF000000FF000000
FF00C0C0C000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000FF00C0C0
C000000000000000000000000000000000000000BF000000FF00FFFFFF000000
FF000000FF000000FF000000FF00FFFFFF000000FF000000FF00FFFFFF000000
FF00FFFFFF000000FF00FFFFFF000000FF00FFFFFF000000FF000000BF000000
00000000000080808000000000000000000080808000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C0008080800000000000000000008080
8000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF00000000FF000000
FF000000FF00C0C0C000FFFF0000FFFF0000FFFF00000000FF000000FF00C0C0
C000000000000000000000000000000000000000BF000000FF00FFFFFF00FFFF
FF00FFFFFF000000FF00FFFFFF00FFFFFF00FFFFFF000000FF00FFFFFF00FFFF
FF00FFFFFF000000FF00FFFFFF00FFFFFF00FFFFFF000000FF000000BF000000
0000000000000000000000000000FFFFFF0000000000C0C0C000FF000000FF00
0000FF000000FF000000C0C0C000C0C0C000C0C0C00000000000FFFFFF000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF00000000
FF000000FF000000FF00C0C0C000FFFF00000000FF000000FF00C0C0C000FFFF
0000000000000000000000000000000000000000BF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000BF000000
00000000000000000000000000000000000000000000C0C0C000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C00000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
00000000FF000000FF000000FF000000FF000000FF00C0C0C00000BFBF00FFFF
0000000000000000000000000000000000000000BF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000BF000000
0000000000000000000000000000FFFFFF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFFFF000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000FFFFFF00000000000000
0000FFFFFF000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
0000FFFF00000000FF000000FF000000FF00C0C0C00000FFFF0000BFBF00FFFF
000000000000000000000000000000000000000000000000BF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000FF000000BF00000000000000
0000000000000000000080808000000000000000000000000000C0C0C000C0C0
C000C0C0C000C0C0C000C0C0C000C0C0C000C0C0C00080808000000000000000
0000808080000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000000000000000
00000000000000000000FFFFFF00000000000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF
00000000FF000000FF000000FF000000FF000000FF00C0C0C000FFFF0000FFFF
00000000000000000000000000000000000000000000000000000000BF000000
FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000FF000000BF0000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000C0C0C000C0C0
C000C0C0C000C0C0C0000000FF000000FF000000FF00C0C0C00000000000FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFF000000000000000000000000000000
0000000000000000000000000000FFFFFF000000000000000000000000000000
0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF00000000
FF000000FF000000FF00C0C0C000FFFF00000000FF00C0C0C000FFFF0000FFFF
0000000000000000000000000000000000000000000000000000000000000000
BF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000FF000000BF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000C0C0C000C0C0
C000FF000000FF0000000000FF000000FF000000FF00C0C0C000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFFFF0000000000000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000000000000000
000000000000000000000000000000000000000000000000FF000000FF000000
FF000000FF00C0C0C0000000000000000000000000000000FF000000FF00C0C0
C000000000000000000000000000000000000000000000000000000000000000
00000000BF000000FF000000FF000000FF000000FF000000FF000000FF000000
FF000000FF000000FF000000BF00000000000000000000000000000000000000
000000000000000000000000000000000000FFFFFF0000000000C0C0C000C0C0
C000FF000000FF0000000000FF000000FF000000FF00C0C0C00000000000FFFF
FF00000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000FF000000FF000000FF000000
FF00C0C0C00000000000000000000000000000000000000000000000FF000000
FF00C0C0C0000000000000000000000000000000000000000000000000000000
0000000000000000BF000000BF000000BF000000BF000000BF000000BF000000
BF000000BF000000BF0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000C0C0C000C0C0
C000FF000000FF000000FF000000FF000000C0C0C000C0C0C000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000FF000000FF00C0C0C0000000
0000000000000000000000000000000000000000000000000000000000000000
FF000000FF00C0C0C00000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000050000000500000000100010000000000C00300000000000000000000
000000000000000000000000FFFFFF00FFFFF0000000000000000000FFFFF000
0000000000000000FFFFF0000000000000000000FFFFF0000000000000000000
F9FFF0000000000000000000F87FF0000000000000000000FC3FF00000000000
00000000FC1FF0000000000000000000FE0FF0000000000000000000FF05F000
0000000000000000EF81F0000000000000000000E7C1F0000000000000000000
F2E0F0000000000000000000F8C070000000000000000000F8F8700000000000
00000000F0FC70000000000000000000FFFFF0000000000000000000FFFFF000
0000000000000000FFFFF0000000000000000000FFFFF0000000000000000000
FFFFFFFFFFFFFFFFFFFF000080007FFFFFFFFFFFE0010000C0007FFFFFFFFFFF
E801000080007FFFFFC000FFE7F90000C0007C000FC000FFE739000080007C00
07C0007F84090000800FFC0007C0007E07F90000801FFC0003C0007C00050000
803FFC0003C0003800010000800FFC0001C0003C000700008083FC0001C0003E
000300008180FC0003C000FF0003000083C07C000FC000FF0001000087C03C00
0FF807FF800100008FE01C001FFC07FF800300009FE00E0FFFF827FFC01F0000
BFF00FFFFFF077FFC07F0000FFF80FFFFFF8FFFFE0FF0000FFFC0FFFFFFDFFFF
F3FF0000FFFF0FFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFFFFFF
FFFFFFFFFFFF0000E001FFFFFFFFFFFFFFFF0000E000FFFFFFFFFFFC00070000
E000FFFFFFFFFFFC00370000E000FFFFFFFFFFFC00670000E000FFFBFFFE0FFC
00C70000E000FFF1FFFE0FFC01870000E000FFE0FFFE0FFC00070000E000FFC0
7FFE0FFC00070000F000FF803FF001FC00070000F801FF001FF803FC00070000
F001FFE0FFFC07FC00070000F001FFE0FFFE0FFC00070000F001FFE0FFFF1FFC
00070000FF1FFFE0FFFFBFFC00070000FF1FFFFFFFFFFFFC00070000FFFFFFFF
FFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000FFFFFFFFFFFFFFFFFFFF0000
FFFFFFFFFFFFFFFFFFFF0000F803FE0007FFFFFFFFFF0000F001FE0007FFFFFF
FFFF0000E000FE0007FFFFFC00070000C0007C0007FFFE7C0007000080003C00
0FF9FFFC00070000000018000FF0FCFC00030000000018001FF0F9FC00070000
000018001FF871FC00070000000018001FFC23FC00070000000018000FFE07FC
0007000000001C000FFF0FFC0007000000001C000FFE07FC0007000000001C00
0FFC27FC0007000080003C0007F071FC00070000C0007E0007E0F8FC00070000
E000FE0007E3FC7C00070000F001FE0007FFFFFF07C70000F803FE0007FFFFFF
1FE30000FFFFFFFFFFFFFFFFFFFF000000000000000000000000000000000000
000000000000}
end
object ActionList1: TActionList
Images = ImageList1
OnUpdate = ActionList1Update
Left = 292
Top = 440
object acAddImages: TAction
Category = 'GlueIt'
Hint = 'Add images from file.'
ImageIndex = 7
OnExecute = btnAddImagesClick
end
object acDeleteAll: TAction
Category = 'GlueIt'
Hint = 'Clear all images from list.'
ImageIndex = 2
OnExecute = btnClearAllClick
end
object acDeleteOne: TAction
Category = 'GlueIt'
Hint = 'Delete one selected image from list.'
ImageIndex = 3
OnExecute = btnDeleteSelectedClick
end
object acSaveToFile: TAction
Category = 'GlueIt'
Hint = 'Save image to file.'
ImageIndex = 11
OnExecute = btnSaveClick
end
object acGlueIt: TAction
Category = 'GlueIt'
Hint = 'Glue all images from list to one.'
ImageIndex = 4
OnExecute = btnGlueItClick
end
object acGlueIzonometrics: TAction
Category = 'GlueIt'
Enabled = False
Hint = 'Glue images as isonometric picture.'
ImageIndex = 8
end
object acUpSelection: TAction
Category = 'GlueIt'
Hint = 'Go up image in list.'
ImageIndex = 6
OnExecute = btnUpSelectionClick
end
object acDownSelection: TAction
Category = 'GlueIt'
Hint = 'Go down image in list.'
ImageIndex = 5
OnExecute = btnDownSelectionClick
end
object acAnimateOn: TAction
Category = 'Anime'
Hint = 'Start Animation'
ImageIndex = 1
OnExecute = btnPlayClick
end
object acAnimateStop: TAction
Category = 'Anime'
Hint = 'Stop Animation.'
ImageIndex = 0
OnExecute = btnStopClick
end
object acAnimeFontOff: TAction
Category = 'AnimeFont'
Hint = 'Start drawing font off.'
ImageIndex = 0
OnExecute = btnFontAnimationStopClick
end
object acAnimeFontOn: TAction
Category = 'AnimeFont'
Hint = 'Start drawing font on.'
ImageIndex = 1
OnExecute = btnFontAnimationStartClick
end
object acLoadImage: TAction
Category = 'Preview'
ImageIndex = 9
OnExecute = LoadImagedirectly1Click
end
object acSaveImage: TAction
Category = 'Preview'
ImageIndex = 11
OnExecute = btnSaveClick
end
object acGetTransparent: TAction
Category = 'Preview'
Caption = 'acGetTransparent'
Enabled = False
Hint = 'Get transparent color from current image.'
ImageIndex = 12
OnExecute = acGetTransparentExecute
end
end
end
/VCL_DELPHIX_D6/DXGlueItEdit.pas
0,0 → 1,1461
unit DXGlueItEdit;
//(c)2007 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) many small images glue into one image.
b) generate font image as one image with subpictures.
c) use image effect for DIB.
d) animation the glued image and font preview.
e) restructuralize of images to square size or unlimeted in one size direction up 2048 px.
f) it works in 24bit deepth always.
g) store into DXImageList directly.
h) reset of transparent color.
i) force size for all images with different size.
j) use the loupe preview for glued image (in preview page).
k) generate mask for alphachannel for characters of fonts.
}
 
interface
 
{$I DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Graphics, ShellAPI, StdCtrls, Dialogs,
DXClass, DIB, jpeg, Menus, DXDraws, ComCtrls, Buttons, Controls, ExtCtrls, Forms,
{$IFDEF VER17UP}System.UITypes,{$ENDIF}
ExtDlgs,{$IFDEF VER6UP} Types,{$ENDIF} ActnList, ImgList;
 
type
TOperationGlueIt = (ogiNew, ogiEdit);
{injected class}
TEdit = class(StdCtrls.TEdit)
private
function GetAsInteger: Integer;
procedure SetAsInteger(const Value: Integer);
published
public
property AsInteger: Integer read GetAsInteger write SetAsInteger;
end;
TDXGlueItEditor = class(TForm)
OpenDialog1: TOpenDialog;
DXTimer1: TDXTimer;
SaveDialog1: TSaveDialog;
DXImageList1: TDXImageList;
Panel5: TPanel;
btnExit: TButton;
Button1: TButton;
PopupMenu1: TPopupMenu;
LoadImagedirectly1: TMenuItem;
mainPageControl: TPageControl;
tsGlueIt: TTabSheet;
tsFontGen: TTabSheet;
Panel1: TPanel;
grManagementOfTheFrames: TGroupBox;
Panel4: TPanel;
chbCrop: TCheckBox;
chbCentered: TCheckBox;
ListBox1: TListBox;
Panel3: TPanel;
btnAddImages: TSpeedButton;
btnDeleteSelected: TSpeedButton;
btnClearAll: TSpeedButton;
btnSave: TSpeedButton;
btnGlueIt: TSpeedButton;
btnGlue2Iso: TSpeedButton;
btnUpSelection: TSpeedButton;
btnDownSelection: TSpeedButton;
chbTransparent: TCheckBox;
Panel2: TPanel;
grPictureAnimationPreview: TGroupBox;
DXDraw1: TDXDraw;
Panel6: TPanel;
btnStop: TSpeedButton;
btnPlay: TSpeedButton;
LAnimationSpeed: TLabel;
pbAnimationSpeed: TProgressBar;
tsPreview: TTabSheet;
GroupBox1: TGroupBox;
Panel7: TPanel;
ScrollBox1: TScrollBox;
Image1: TImage;
GroupBox4: TGroupBox;
Panel8: TPanel;
gbFontSettings: TGroupBox;
Label1: TLabel;
Label4: TLabel;
Label10: TLabel;
cbFontName: TComboBox;
FontSize: TEdit;
gbFontEffects: TGroupBox;
Label5: TLabel;
Label7: TLabel;
eOffset: TEdit;
eOpacity: TEdit;
gbColorSettings: TGroupBox;
Label14: TLabel;
Label15: TLabel;
btnFontGenerate: TButton;
FontPageControl: TPageControl;
tsFont: TTabSheet;
ScrollBox2: TScrollBox;
imgFont: TImage;
tsMask: TTabSheet;
ScrollBox3: TScrollBox;
imgMask: TImage;
tsPreviewFont: TTabSheet;
PreviewMemo: TMemo;
PreviewDraw: TDXDraw;
PreviewTimer: TDXTimer;
FontDXImageList: TDXImageList;
Label16: TLabel;
btnAllChars: TButton;
memAlphabet: TMemo;
cbAntialias: TCheckBox;
cbDrawGrid: TCheckBox;
SavePictureDialog: TSavePictureDialog;
ColorDialog: TColorDialog;
pnlFG: TPanel;
pnlBG: TPanel;
Panel20: TPanel;
btnABold: TSpeedButton;
btnAItalic: TSpeedButton;
btnAUnderline: TSpeedButton;
DXDIB1: TDXDIB;
Label11: TLabel;
Sources: TMemo;
Panel9: TPanel;
btnFontAnimationStop: TSpeedButton;
btnFontAnimationStart: TSpeedButton;
Splitter1: TSplitter;
Splitter2: TSplitter;
Panel10: TPanel;
LDuration: TLabel;
Label6: TLabel;
pbDuration: TProgressBar;
cbEffectsList: TComboBox;
btnApply: TButton;
Panel11: TPanel;
grSubimages: TGroupBox;
LPatternWidth: TLabel;
LPatternHeight: TLabel;
ePatternWidth: TEdit;
ePatternHeight: TEdit;
btnResize: TButton;
btnReplace: TButton;
Panel12: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Label2: TLabel;
panTColor: TPanel;
EWidthOfImages: TEdit;
EHeightOfImages: TEdit;
LWidthOfImages: TLabel;
LHeightOfImages: TLabel;
chbForceSize: TCheckBox;
ImageList1: TImageList;
ActionList1: TActionList;
acAddImages: TAction;
acDeleteAll: TAction;
acDeleteOne: TAction;
acSaveToFile: TAction;
acGlueIt: TAction;
acGlueIzonometrics: TAction;
acUpSelection: TAction;
acDownSelection: TAction;
acAnimateOn: TAction;
acAnimateStop: TAction;
acAnimeFontOff: TAction;
acAnimeFontOn: TAction;
Image2: TImage;
GroupBox2: TGroupBox;
Label13: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Slider: TTrackBar;
chbZoomOut: TCheckBox;
CheckBox1: TCheckBox;
btnGetTransparentcolor: TSpeedButton;
btnCrop: TSpeedButton;
btnFill: TSpeedButton;
SpeedButton10: TSpeedButton;
SpeedButton11: TSpeedButton;
SpeedButton12: TSpeedButton;
SpeedButton13: TSpeedButton;
btnWand: TSpeedButton;
btnMask: TSpeedButton;
acLoadImage: TAction;
acSaveImage: TAction;
acGetTransparent: TAction;
Label8: TLabel;
panBColor: TPanel;
Panel13: TPanel;
EFromImage: TEdit;
EToImage: TEdit;
Label3: TLabel;
LToImage: TLabel;
chbAutoAply: TCheckBox;
procedure chbAutoAplyClick(Sender: TObject);
procedure pbDurationMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pbDurationMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure cbEffectsListChange(Sender: TObject);
procedure chbForceSizeClick(Sender: TObject);
procedure acGetTransparentExecute(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnGetTransparentcolorClick(Sender: TObject);
procedure btnResizeClick(Sender: TObject);
procedure btnReplaceClick(Sender: TObject);
procedure btnFontAnimationStartClick(Sender: TObject);
procedure btnFontAnimationStopClick(Sender: TObject);
procedure PreviewMemoChange(Sender: TObject);
procedure PreviewTimerTimer(Sender: TObject; LagCount: Integer);
procedure btnAUnderlineClick(Sender: TObject);
procedure btnAItalicClick(Sender: TObject);
procedure btnABoldClick(Sender: TObject);
procedure btnFontGenerateClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnAllCharsClick(Sender: TObject);
procedure pnlFGClick(Sender: TObject);
procedure cbFontNameDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure pbAnimationSpeedMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DXDraw1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure LoadImagedirectly1Click(Sender: TObject);
procedure btnApplyClick(Sender: TObject);
procedure pbDurationMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
procedure btnStopClick(Sender: TObject);
procedure btnAddImagesClick(Sender: TObject);
procedure btnClearAllClick(Sender: TObject);
procedure btnUpSelectionClick(Sender: TObject);
procedure btnDownSelectionClick(Sender: TObject);
procedure btnDeleteSelectedClick(Sender: TObject);
procedure btnGlueItClick(Sender: TObject);
procedure btnPlayClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
 
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ActionList1Update(Action: TBasicAction;
var Handled: Boolean);
procedure chbZoomOutClick(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure mainPageControlChange(Sender: TObject);
private
{ Private declarations }
tmpPicture: TPicture;
StartingPoint: TPoint;
FDuration: Integer;
ListObjects: TStringList;
dX, dY: Integer;
FFontStyles: TFontStyles;
charArr: string;
sizesArr: array of Integer;
Zdvih: Integer;
WPattern: Integer;
InitIntInMs: Integer;
WCounter: Integer;
FOperationGlueIt: TOperationGlueIt;
SelectionOfTransparentColor: Boolean;
procedure WMDropFiles(var Message: TWMDropFiles); message wm_DropFiles;
procedure RestructuralizeWithResize(NewWidth, NewHeight: Integer; TranspColor: TColor = clMaroon);
procedure SetOperationGlueIt(const Value: TOperationGlueIt);
procedure DoBitmapEffect(Picture: TPicture);
public
{ Public declarations }
property Operation: TOperationGlueIt read FOperationGlueIt write SetOperationGlueIt;
procedure LoadImageFromList(const iName: string; Image: TPicture; PatternWidth,
PatternHeight: Integer; Transparent: Boolean; TransparentColor: Integer);
procedure SaveImageIntoList(oItem: TPictureCollectionItem);
end;
 
var
DXGlueItEditor: TDXGlueItEditor;
 
implementation
 
{$R *.DFM}
 
 
uses {$IFDEF StandardDX}DirectDraw{$ELSE}DirectX{$ENDIF};
 
{ TEdit }
 
function TEdit.GetAsInteger: Integer;
begin
try
Result := StrToInt(Self.Text);
except
Result := 0;
end;
end;
 
procedure TEdit.SetAsInteger(const Value: Integer);
begin
Self.Text := IntToStr(Value)
end;
 
procedure TDXGlueItEditor.btnStopClick(Sender: TObject);
begin
DXTimer1.Enabled := False;
end;
 
{ TDXGlueItEditor }
 
procedure TDXGlueItEditor.btnAddImagesClick(Sender: TObject);
var
i: Integer;
TI: TPicture;
begin
if OpenDialog1.Execute then
if OpenDialog1.Files.Count > 0 then begin
ListObjects.Clear;
with OpenDialog1.Files do
for I := 0 to Count - 1 do
if FileExists(Strings[I]) then
begin
TI := TPicture.Create;
TI.LoadFromFile(Strings[I]);
EWidthOfImages.AsInteger := Max(EWidthOfImages.AsInteger, TI.Width);
EHeightOfImages.AsInteger := Max(EHeightOfImages.AsInteger, TI.Height);
ListObjects.AddObject(Strings[I], TI);
end;
ListBox1.Items.Assign(ListObjects);
end;
end;
 
procedure TDXGlueItEditor.btnClearAllClick(Sender: TObject);
var
I: Integer;
begin
if MessageDlg('Do you really want delete all frames?', mtWarning, [mbYes, mbNo], 0) = mrNo then Exit;
btnStop.Click;
for I := 0 to ListBox1.Items.Count - 1 do (ListBox1.Items.Objects[I] as TPicture).Free;
ListBox1.Clear;
ListObjects.Clear;
DXImageList1.Items.Clear;
end;
 
procedure TDXGlueItEditor.btnUpSelectionClick(Sender: TObject);
begin
if ListBox1.ItemIndex > 0 then begin
btnStop.Click;
ListBox1.Items.Move(ListBox1.ItemIndex, ListBox1.ItemIndex - 1);
end;
end;
 
procedure TDXGlueItEditor.btnDownSelectionClick(Sender: TObject);
begin
if (ListBox1.ItemIndex <> -1) and (ListBox1.ItemIndex < (ListBox1.Items.Count - 1)) then begin
btnStop.Click;
ListBox1.Items.Move(ListBox1.ItemIndex, ListBox1.ItemIndex + 1);
end;
end;
 
procedure TDXGlueItEditor.btnDeleteSelectedClick(Sender: TObject);
begin
if ListBox1.ItemIndex <> -1 then begin
if MessageDlg('Do you want delete selected item?', mtWarning, [mbYes, mbNo], 0) = mrYes then begin
(ListBox1.Items.Objects[ListBox1.ItemIndex] as TPicture).Free;
ListObjects.Delete(ListBox1.ItemIndex);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end;
end;
 
procedure TDXGlueItEditor.FormCreate(Sender: TObject);
var
cnt: Integer;
begin
DXImageList1.Items.MakeColorTable;
DXDraw1.ColorTable := DXImageList1.Items.ColorTable;
DXDraw1.DefColorTable := DXImageList1.Items.ColorTable;
DXDraw1.UpdatePalette;
tmpPicture := TPicture.Create;
ListObjects := TStringList.Create;
DragAcceptFiles(Handle, True);
WPattern := 0; InitIntInMs := 200; //5 pict per sec
WCounter := 0;
for cnt := 0 to Screen.Fonts.Count - 1 do
cbFontName.Items.Add(Screen.Fonts.Strings[cnt]);
pbAnimationSpeed.Position := 200;
pbDuration.Position := 5;
mainPageControl.ActivePage := tsGlueIt;
FontPageControl.ActivePage := tsPreviewFont;
if chbZoomOut.Checked then Image1.OnMouseMove := Image1MouseMove
else Image1.OnMouseMove := nil;
Tag := 0;
{$IFDEF VER4UP}
pbAnimationSpeed.Smooth := True;
pbDuration.Smooth := True;
{$ENDIF}
end;
 
procedure TDXGlueItEditor.SaveImageIntoList(oItem: TPictureCollectionItem);
begin
oItem.Picture.Assign(DXImageList1.Items[0].Picture);
oItem.Transparent := DXImageList1.Items[0].Transparent;
oItem.TransparentColor := DXImageList1.Items[0].TransparentColor;
oItem.Name := DXImageList1.Items[0].Name;
oItem.PatternWidth := DXImageList1.Items[0].Width;
oItem.PatternHeight := DXImageList1.Items[0].Height;
end;
 
procedure TDXGlueItEditor.LoadImageFromList(const iName: string; Image: TPicture;
PatternWidth, PatternHeight: Integer; Transparent: Boolean; TransparentColor: Integer);
{function for loading existing image from dximagelist do component editor}
var
D: TPictureCollectionItem;
begin
btnPlay.Click;
DXImageList1.Items.Clear;
D := TPictureCollectionItem(DXImageList1.Items.Add);
D.Picture.Assign(Image);
D.Name := Name;
Image1.Picture.Assign(Image);
D.PatternWidth := PatternWidth;
D.PatternHeight := PatternHeight;
D.Transparent := Transparent;
D.TransparentColor := TransparentColor;
DXImageList1.Items.Restore;
ePatternWidth.AsInteger := PatternWidth;
ePatternHeight.AsInteger := PatternHeight;
end;
 
procedure TDXGlueItEditor.btnGlueItClick(Sender: TObject);
// function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;
// from DIB unit
// var
// XScale, YScale: Single;
// begin
// XScale := 1;
// YScale := 1;
// if TargetWidth < SourceWidth then
// XScale := TargetWidth / SourceWidth;
// if TargetHeight < SourceHeight then
// YScale := TargetHeight / SourceHeight;
// Result := XScale;
// if YScale < Result then
// Result := YScale;
// end;
var
i: Integer;
XL, YL, X, Y, QX, QY: Integer;
P: TPicture;
C: Double;
Rz: Integer;
B, BB: TBitmap; Icon: TIcon; DIB: TDIB;
CI: TPictureCollectionItem;
ImageIsBigger: Boolean;
OldName: string;
begin
XL := 0; YL := 0;
B := TBitmap.Create;
B.PixelFormat := pf24bit;
try
if chbForceSize.Checked then begin
XL := EWidthOfImages.AsInteger;
YL := EHeightOfImages.AsInteger;
end
else begin
//must be the same size
for i := 0 to ListBox1.Items.Count - 1 do begin
P := ListBox1.Items.Objects[i] as TPicture;
if Assigned(P) then begin
XL := Max(XL, P.Width);
YL := Max(YL, P.Height);
end;
end;
end;
//square od image
C := Sqrt(ListBox1.Items.Count);
Rz := Trunc(C);
if Frac(C) > 0 then Inc(Rz);
//dimension of Image
B.Width := Rz * XL;
B.Height := Rz * YL;
{set color by user settings}
B.Canvas.Brush.Color := panBColor.Color;
B.Canvas.FillRect(Bounds(0, 0, B.Width, B.Height));
for i := 0 to ListBox1.Items.Count - 1 do begin
P := ListBox1.Items.Objects[i] as TPicture;
if Assigned(P) then begin
if P.Graphic is TIcon then begin
Icon := (P.Graphic as TIcon);
BB := TBitmap.Create;
try
BB.Width := Icon.Width;
BB.Height := Icon.Height;
BB.Canvas.Draw(0, 0, Icon);
BB.Transparent := True;
P.Graphic := BB;
finally
BB.Free;
end;
end;
X := (i mod Rz) * XL;
Y := (i div Rz) * YL;
if chbForceSize.Checked then begin
ImageIsBigger := (P.Width > XL) or (P.Height > YL);
if ImageIsBigger then begin
{image will be crop}
if chbCrop.Checked then begin
B.Canvas.CopyRect(Bounds(X, Y, XL, YL), P.Bitmap.Canvas, Bounds(0, 0, XL, YL))
end
else begin {image will be shrink}
C := GetScale(P.Width, P.Height, XL, YL);
DIB := TDIB.Create;
try
DIB.SetSize(P.Width, P.Height, 24);
DIB.Canvas.Draw(0, 0, P.Graphic);
DIB.DoResample(Round(P.Width * C), Round(P.Height * C), ftrLanczos3);
B.Canvas.StretchDraw(Bounds(X, Y, Round(P.Width * C), Round(P.Height * C)), {P.Graphic} DIB);
finally
DIB.Free;
end;
end;
end
else begin
QX := 0;
QY := 0;
if chbCentered.Checked then begin
QX := (XL - P.Width) div 2;
QY := (YL - P.Height) div 2;
end;
if not chbTransparent.Checked then
B.Canvas.Draw(X + QX, Y + QY, P.Graphic)
else
B.Canvas.BrushCopy(Bounds(X + QX, Y + QY, P.Width, P.Height), P.Bitmap, Bounds(0, 0, P.Width, P.Height), P.Bitmap.Canvas.Pixels[0, P.Height - 1]);
end;
end
else
if not chbTransparent.Checked then
B.Canvas.Draw(X, Y, P.Graphic)
else
B.Canvas.BrushCopy(Bounds(X, Y, XL, YL), P.Bitmap, Bounds(0, 0, XL, YL), P.Bitmap.Canvas.Pixels[0, P.Height - 1]);
end;
end;
Image1.Picture.Assign(B);
 
{reset after image assign}
cbEffectsList.ItemIndex := -1; pbDuration.Position := 5; chbAutoAply.Checked := False;
 
OldName := 'Test';
if DXImageList1.Items.Count > 0 then
if Operation = ogiEdit then
OldName := DXImageList1.Items[0].Name; {puvodni jmeno}
 
DXImageList1.Items.Clear;
CI := TPictureCollectionItem(DXImageList1.Items.Add);
CI.Name := OldName;
CI.Picture.Assign(B);
CI.Transparent := chbTransparent.Checked;
CI.PatternWidth := XL;
CI.PatternHeight := YL;
ePatternWidth.AsInteger := XL;
ePatternHeight.AsInteger := YL;
DXImageList1.Items.Restore;
 
EFromImage.AsInteger := 1;
EToImage.AsInteger := ListBox1.Items.Count;
finally
B.Free;
end;
mainPageControl.ActivePage := tsPreview;
end;
 
procedure TDXGlueItEditor.btnPlayClick(Sender: TObject);
begin
DXTimer1.Enabled := True;
if Image1.Picture.Bitmap.Empty then
btnStop.Click;
end;
 
procedure TDXGlueItEditor.btnSaveClick(Sender: TObject);
begin
if MessageDlg('Do you want save image to file?', mtWarning, [mbYes, mbNo], 0) = mrNo then Exit;
if SaveDialog1.Execute then
Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;
 
procedure TDXGlueItEditor.btnExitClick(Sender: TObject);
begin
btnStop.Click;
btnFontAnimationStop.Click;
Tag := 1;
Close
end;
 
function SpeedConst(InitValue, PerSec, LagCount: Integer): Integer; {$IFDEF VER9UP}inline; {$ENDIF}
begin
Result := InitValue + (PerSec * Round(LagCount / 1000))
end;
 
procedure TDXGlueItEditor.DXTimer1Timer(Sender: TObject; LagCount: Integer);
begin
if DXImageList1.Items.Count <= 0 then Exit;
if not DXDraw1.CanDraw then Exit;
DXDraw1.Surface.Fill(DXDraw1.Surface.ColorMatch(clBlack));
DXDraw1.BeginScene;
try
{clear surface with predefined windows color}
DXDraw1.Surface.Fill(DXDraw1.Surface.ColorMatch(clBlack));
 
//----------------------------------------------------------------------------
{All drawing here like}
Inc(WCounter, LagCount);
{timming}
if WCounter > InitIntInMs then begin
Inc(WPattern);
if WPattern > DXImageList1.Items[0].PatternCount then WPattern := 0;
{only for interval from EFromImage to EToImage}
if WPattern > (EToImage.AsInteger - 1) then WPattern := EFromImage.AsInteger - 1;
{reset counter}
WCounter := 0;
end;
{drawing}
with DXImageList1.Items[0] do
Draw(DXDraw1.Surface, dX-(Width div 2), dY-(Height div 2), WPattern);
//----------------------------------------------------------------------------
finally
DXDraw1.EndScene;
end;
 
{ Draw FrameRate }
with DXDraw1.Surface.Canvas do
try
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Size := 10;
Textout(3, 3, 'FPS: ' + IntToStr(DXTimer1.FrameRate));
if doHardware in DXDraw1.NowOptions then begin
Textout(3, 14, 'Device: Hardware');
end
else begin
Textout(3, 14, 'Device: Software');
end;
finally
Release; { Indispensability }
end;
DXDraw1.Flip;
end;
 
procedure TDXGlueItEditor.FormDestroy(Sender: TObject);
begin
tmpPicture.Free;
ListObjects.Free;
DragAcceptFiles(Handle, False);
end;
 
procedure TDXGlueItEditor.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
StartingPoint.X := X;
StartingPoint.Y := Y;
end;
 
procedure TDXGlueItEditor.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := Source = ListBox1;
end;
 
procedure TDXGlueItEditor.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
DropPosition, StartPosition: Integer;
DropPoint: TPoint;
begin
DropPoint.X := X;
DropPoint.Y := Y;
with Source as TListBox do
begin
StartPosition := ItemAtPos(StartingPoint, True);
DropPosition := ItemAtPos(DropPoint, True);
 
Items.Move(StartPosition, DropPosition);
end;
end;
 
procedure TDXGlueItEditor.WMDropFiles(var Message: TWMDropFiles);
var
FileCount, I: Integer;
FileName: PChar;
FileNameSize: Integer;
S: string;
TI: TPicture;
begin
try
FileCount := DragQueryFile(Message.Drop, Cardinal(-1), nil, 0);
for I := 0 to FileCount - 1 do
begin
FileNameSize := DragQueryFile(Message.Drop, I, nil, 0);
FileName := AllocMem(FileNameSize + 1);
try
DragQueryFile(Message.Drop, I, FileName, FileNameSize + 1);
S := ExtractFileExt(Filename);
if (S = '.bmp') or (S = '.dib') or (S = '.jpg') then begin
TI := TPicture.Create;
TI.LoadFromFile(Filename);
ListBox1.Items.AddObject(FileName, TObject(TI));
end;
finally
FreeMem(FileName);
end;
end;
finally
DragFinish(Message.Drop);
end;
end;
 
procedure TDXGlueItEditor.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
var
I: TPicture;
begin
I := TPicture(ListObjects.Objects[Index]);
if Assigned(I) then
Height := I.Height;
end;
 
procedure TDXGlueItEditor.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
I: TPicture; Ri: TRect; S: string; A: array[0..255] of Char;
Dest, Src: TRect; Icon: TIcon; B: TBitmap;
begin
ListBox1.Canvas.FillRect(Rect);
I := ListBox1.Items.Objects[Index] as TPicture;
if Assigned(I) then begin
if I.Graphic is TIcon then begin
Icon := (I.Graphic as TIcon);
B := TBitmap.Create;
try
B.Width := Icon.Width;
B.Height := Icon.Height;
B.Canvas.Draw(0, 0, Icon);
B.Transparent := True;
I.Graphic := B;
finally
B.Free;
end;
end;
Dest := Rect;
Dest.Right := I.Width - 1;
Src := Bounds(0, 0, I.Width, I.Height);
if chbTransparent.Checked then
ListBox1.Canvas.BrushCopy(Dest, I.Bitmap, Src, I.Bitmap.Canvas.Pixels[0, I.Height])
else
ListBox1.Canvas.Draw(Rect.Left, Rect.Top, I.Graphic);
Ri := Rect;
Ri.Left := Ri.Left + 4 + I.Width;
S := ExtractFileName(ListBox1.Items[Index]);
DrawText(ListBox1.Canvas.Handle, StrPCopy(A, S), -1, Ri, dt_SingleLine or dt_Left or dt_VCenter);
end;
end;
 
procedure TDXGlueItEditor.pbDurationMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
newPosition: integer;
begin
with Sender as TProgressBar do begin
if ssLeft in Shift then
begin
Cursor := crHSplit;
newPosition := Round(x * Max / ClientWidth);
Position := newPosition;
end
else
begin
Cursor := crDefault;
end;
FDuration := Position;
LDuration.Caption := Format('Duration (%d)', [FDuration]);
end;
if ssLeft in Shift then
if chbAutoAply.Checked and (cbEffectsList.ItemIndex <> -1) and not tmpPicture.Graphic.Empty then begin
DoBitmapEffect(tmpPicture);
Application.ProcessMessages;
end;
end;
 
procedure TDXGlueItEditor.DoBitmapEffect(Picture: TPicture);
var
I, dX, dY: Integer;
TT: TDIB;
tbp: Integer;
begin
TT := TDIB.Create;
try
if Assigned(Picture.Bitmap) then
TT.Assign(Picture.Bitmap)
else begin
TT.Width := Picture.Width;
TT.Height := Picture.Height;
TT.Canvas.Draw(0, 0, Picture.Graphic);
end;
 
dX := TT.Width;
dY := TT.Height;
if pbDuration.Position > 5 then
begin
dX := Trunc(pbDuration.Position / 100 * TT.Width);
dY := Trunc(pbDuration.Position / 100 * TT.Height);
end;
tbp := pbDuration.Position;
{ E F F E C T S }
with TT do
case cbEffectsList.ItemIndex of
0: DoGaussianBlur(tbp);
1: DoSplitBlur(tbp);
2: DoAddColorNoise(tbp * 3);
3: DoAddMonoNoise(tbp * 3);
4: for i := 1 to tbp do DoAntiAlias;
5: DoContrast(tbp * 3);
6: DoFishEye(tbp div 10 + 1);
7: DoLightness(tbp * 2);
8: DoDarkness(tbp * 2);
9: DoSaturation(255 - ((tbp * 255) div 100));
10: DoMosaic(tbp div 2);
11: DoTwist(200 - (tbp * 2) + 1);
12: DoSplitlight(tbp div 20);
13: DoTile(tbp div 10);
14: DoSpotLight(tbp, Rect(tbp, tbp, tbp + tbp * 2, tbp + tbp * 2));
15: DoTrace(tbp div 10);
16: for i := 1 to tbp do DoEmboss;
17: DoSolorize(255 - ((tbp * 255) div 100));
18: DoPosterize(((tbp * 255) div 100) + 1);
19: DoGrayscale;
20: DoInvert;
21: DoBrightness(tbp);
22: DoColorize(clRed, clBlue);
{resampling functions}
23: DoResample(dX, dY, ftrBox);
24: DoResample(dX, dY, ftrTriangle);
25: DoResample(dX, dY, ftrHermite);
26: DoResample(dX, dY, ftrBell);
27: DoResample(dX, dY, ftrBSpline);
28: DoResample(dX, dY, ftrLanczos3);
29: DoResample(dX, dY, ftrMitchell);
end; {Case}
Image1.Picture.Bitmap := TT.CreateBitmapFromDIB;
Image1.Invalidate;
finally
TT.Free;
end;
end;
 
procedure TDXGlueItEditor.btnApplyClick(Sender: TObject);
begin
if not Assigned(Image1.Picture.Graphic) then begin
MessageDlg('Not graphics found in image, please glue it first.', mtWarning, [mbOK], 0);
Exit;
end;
btnApply.Enabled := False;
Screen.Cursor := crHourGlass;
try
DoBitmapEffect(Image1.Picture); Application.ProcessMessages;
finally
Screen.Cursor := crDefault;
btnApply.Enabled := True;
end;
end;
 
procedure TDXGlueItEditor.LoadImagedirectly1Click(Sender: TObject);
var
Q: TPictureCollectionItem;
begin
OpenDialog1.Options := OpenDialog1.Options - [ofAllowMultiSelect];
try
if OpenDialog1.Execute then begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
DXImageList1.Items.Clear;
Q := TPictureCollectionItem(DXImageList1.Items.Add);
Q.Name := ExtractFileName(OpenDialog1.FileName);
Q.Picture.LoadFromFile(OpenDialog1.FileName);
Q.Transparent := True;
if Q.Picture.Graphic is TBitmap then begin
Q.TransparentColor := Q.Picture.Bitmap.Canvas.Pixels[Q.Width - 1, Q.Height - 1];
panTColor.Color := Q.TransparentColor;
end;
DXImageList1.Items.Restore;
end;
finally
OpenDialog1.Options := OpenDialog1.Options + [ofAllowMultiSelect]
end;
end;
 
procedure TDXGlueItEditor.DXDraw1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
dX := X;
dY := Y;
end;
 
procedure TDXGlueItEditor.pbAnimationSpeedMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
newPosition: integer;
begin
with Sender as TProgressBar do begin
if ssLeft in Shift then
begin
Cursor := crHSplit;
newPosition := Round(x * Max / ClientWidth);
Position := newPosition;
end
else
begin
Cursor := crDefault;
end;
InitIntInMs := Position;
LAnimationSpeed.Caption := Format('Animation speed (%f/sec):', [InitIntInMs / 1000]);
end;
end;
 
procedure TDXGlueItEditor.cbFontNameDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with (Control as TComboBox).Canvas do
begin
Font.Name := Screen.Fonts.Strings[Index];
//Font.Size := seSize.AsInteger;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, PChar(Screen.Fonts.Strings[Index]))
end;
end;
 
procedure TDXGlueItEditor.pnlFGClick(Sender: TObject);
begin
ColorDialog.Color := (Sender as TPanel).Color;
if ColorDialog.Execute then
(Sender as TPanel).Color := ColorDialog.Color;
end;
 
procedure TDXGlueItEditor.btnAllCharsClick(Sender: TObject);
var
I: Integer;
S: string;
begin
S := '';
for I := 0 to 255 do
if Char(I) < ' ' then S := S + ' ' else S := S + Char(I);
memAlphabet.Lines.Add(S);
end;
 
procedure TDXGlueItEditor.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssShift in Shift then with Image1.Canvas do begin
Brush.Color := panTColor.Color;
Brush.Style := bsSolid;
FloodFill(X, Y, Pixels[X, Y], fsSurface);
end;
end;
 
procedure TDXGlueItEditor.btnFontGenerateClick(Sender: TObject);
var
S, vizfntname: string;
C: Double;
Rz, vX, vY, I, absX, absY, V, X, Y, offC: Integer;
B: TBitmap;
LogFont: TLogFont;
fnt: TFont;
dib, alpha: TDIB;
q, d: TPictureCollectionItem;
begin
{no preview}
btnFontAnimationStop.Click;
{private font def.}
fnt := TFont.Create;
try
fnt.Assign(cbFontName.Font);
V := eOpacity.AsInteger;
fnt.Color := RGB(V, V, V); //0..255
fnt.Name := cbFontName.Text;
fnt.Size := FontSize.AsInteger;
fnt.Style := FFontStyles;
{antialiased/ttf}
if not cbAntialias.Checked then begin
GetObject(fnt.Handle, SizeOf(LogFont), Addr(LogFont));
with LogFont do begin
if cbAntialias.Checked then
lfQuality := ANTIALIASED_QUALITY
else
lfQuality := NONANTIALIASED_QUALITY;
lfOutPrecision := OUT_TT_ONLY_PRECIS;
end;
fnt.Handle := CreateFontIndirect(LogFont);
end;
{get set of chars}
S := TrimRight(memAlphabet.Lines.Text);
if S = '' then begin
btnAllChars.Click;
S := TrimRight(memAlphabet.Lines.Text);
end;
{target square}
C := Sqrt(Length(S));
Rz := Trunc(C);
if Frac(C) > 0 then Inc(Rz);
{generate mask font}
B := TBitmap.Create;
try
B.PixelFormat := pf8bit;
B.Canvas.Brush.Color := clBlack;
B.Canvas.Font.Assign(fnt);
{absolute sizes}
charArr := s;
SetLength(sizesArr, Length(charArr));
vY := B.Canvas.TextHeight(S); Zdvih := vY;
vX := 0;
for I := 0 to Length(S) - 1 do begin
sizesarr[I] := B.Canvas.TextWidth(S[I + 1]);
vX := Max(vX, sizesarr[I]);
end;
 
offC := eOffset.AsInteger;
vX := vX + offC;
vY := vY + offC;
 
absX := Rz * vX;
absY := Rz * vY;
 
B.Width := absX;
B.Height := absY;
 
B.Canvas.FillRect(Bounds(0, 0, B.Width, B.Height));
B.Canvas.Brush.Style := bsClear;
{shadow as offset}
if eOffset.AsInteger > 0 then
for I := 0 to Length(S) - 1 do begin
X := offC + (i mod Rz) * vX;
Y := offC + (i div Rz) * vY;
B.Canvas.TextOut(X, Y, S[I + 1]);
end;
{masked chars}
B.Canvas.Font.Color := clWhite;
for I := 0 to Length(S) - 1 do begin
X := (i mod Rz) * vX;
Y := (i div Rz) * vY;
B.Canvas.TextOut(X, Y, S[I + 1]);
end;
imgMask.Picture.Assign(B);
finally
B.Free;
end;
{generate font}
B := TBitmap.Create;
try
B.PixelFormat := pf24bit;
B.Width := absX;
B.Height := absY;
B.Canvas.Brush.Color := pnlBG.Color;
B.Canvas.Font.Assign(fnt);
B.Canvas.Font.Color := pnlFG.Color;
B.Width := absX;
B.Height := absY;
B.Canvas.FillRect(Bounds(0, 0, B.Width, B.Height));
B.Canvas.Brush.Style := bsClear;
for I := 0 to Length(S) - 1 do begin
X := (i mod Rz) * vX;
Y := (i div Rz) * vY;
B.Canvas.TextOut(X, Y, S[I + 1]);
end;
imgFont.Picture.Assign(B);
finally
B.Free;
end;
finally
vizfntname := fnt.name;
fnt.Free;
end;
 
Sources.Lines.Clear;
Sources.Lines.Add('{Generated constants for simple use of the font}');
Sources.Lines.Add('const');
Sources.Lines.Add(Format(' offsY = %d;', [Zdvih]));
Sources.Lines.Add(Format(' offYbyOrder: array [0..%d] of Integer = (', [Length(charArr) - 1]));
s := '';
for i := Low(sizesArr) to High(sizesArr) do
s := s + IntToStr(sizesArr[i]) + ', ';
Delete(s, Length(s) - 2, 2);
Sources.Lines.Add(s);
Sources.Lines.Add(');');
 
dib := TDIB.Create;
alpha := TDIB.Create;
try
alpha.Assign(imgMask.Picture.Bitmap);
dib.Assign(imgFont.Picture.Bitmap);
dib.AssignAlphaChannel(alpha);
{for preview}
FontDXImageList.Items.Clear;
q := TPictureCollectionItem(FontDXImageList.Items.Add);
q.Picture.Assign(dib);
q.Name := vizfntname;
q.PatternWidth := vX;
q.PatternHeight := vY;
q.Transparent := True;
q.TransparentColor := pnlBG.Color;
FontDXImageList.Items.Restore;
{showing}
Image1.Picture := nil;
Image1.Picture.Bitmap := dib.CreateBitmapFromDIB;
{for exchange with master thread}
DXImageList1.Items.Clear;
d := TPictureCollectionItem(DXImageList1.Items.Add);
d.Picture.Assign(dib);
d.Name := vizfntname;
d.PatternWidth := vX;
d.PatternHeight := vY;
d.Transparent := True;
d.TransparentColor := pnlBG.Color;
DXImageList1.Items.Restore;
 
finally
alpha.Free;
dib.Free;
end;
if PreviewMemo.Lines.Count > 0 then
btnFontAnimationStart.Click;
end;
 
procedure TDXGlueItEditor.btnABoldClick(Sender: TObject);
begin
if btnABold.Down then FFontStyles := FFontStyles + [fsBold]
else FFontStyles := FFontStyles - [fsBold]
end;
 
procedure TDXGlueItEditor.btnAItalicClick(Sender: TObject);
begin
if btnAItalic.Down then FFontStyles := FFontStyles + [fsItalic]
else FFontStyles := FFontStyles - [fsItalic]
end;
 
procedure TDXGlueItEditor.btnAUnderlineClick(Sender: TObject);
begin
if btnAUnderline.Down then FFontStyles := FFontStyles + [fsUnderline]
else FFontStyles := FFontStyles - [fsUnderline]
end;
 
procedure TDXGlueItEditor.PreviewTimerTimer(Sender: TObject; LagCount: Integer);
var i, x, y, j: Integer;
s: string;
begin
if not PreviewDraw.CanDraw then Exit;
 
PreviewDraw.Surface.Fill(PreviewDraw.Surface.ColorMatch(pnlBG.Color));
PreviewDraw.BeginScene;
PreviewDraw.Surface.FillRect(Bounds(0, 0, PreviewDraw.Width, PreviewDraw.Height), pnlBG.Color);
y := 5;
for i := 0 to PreviewMemo.Lines.Count - 1 do begin
s := PreviewMemo.Lines[i];
x := 5;
for j := 1 to Length(s) do begin
FontDXImageList.Items[0].Draw(PreviewDraw.Surface, x, y, Ord(s[j]));
x := x + sizesarr[Ord(s[j])];
end;
y := y + Zdvih;
end;
PreviewDraw.EndScene;
PreviewDraw.Flip;
end;
 
procedure TDXGlueItEditor.PreviewMemoChange(Sender: TObject);
begin
PreviewTimer.Enabled := PreviewMemo.Lines.Text <> '';
end;
 
procedure TDXGlueItEditor.btnFontAnimationStopClick(Sender: TObject);
begin
PreviewTimer.Enabled := False;
PreviewDraw.Surface.FillRect(Bounds(0, 0, PreviewDraw.Width, PreviewDraw.Height), pnlBG.Color);
PreviewDraw.Flip;
end;
 
procedure TDXGlueItEditor.btnFontAnimationStartClick(Sender: TObject);
begin
PreviewTimer.Enabled := True;
end;
 
procedure TDXGlueItEditor.RestructuralizeWithResize(NewWidth, NewHeight: Integer; TranspColor: TColor = clMaroon);
var
C: Double;
Rz: Integer;
Q: TPictureCollectionItem;
IMG: TBitmap;
DIB: TDIB;
I, X, Y, dX, dY: Integer;
DDS: TDirectDrawSurface;
begin
dX := DXImageList1.Items[0].PatternWidth;
dY := DXImageList1.Items[0].PatternHeight;
if NewWidth <> dX then dX := NewWidth;
if NewHeight <> dY then dY := NewHeight;
{target square}
C := Sqrt(DXImageList1.Items[0].PatternCount);
Rz := Trunc(C);
if Frac(C) > 0 then Inc(Rz);
{new picture};
IMG := TBitmap.Create; {glued picture}
DIB := TDIB.Create; {converted sub-image}
DDS := TDirectDrawSurface.Create(DXDraw1.DDraw); {dds}
DDS.SetSize(dX, dY);
{note: there occur error, when surface is not self, but nothing created}
{for this correct run has to set size as power two and must be remaps to mesh}
{or better simple turn off D3D acceleration}
{$IFDEF D3D_deprecated}
DXDraw1.Options := DXDraw1.Options - [do3d]; // dds may be any size
{$ENDIF}
try
IMG.Width := Rz * dX; {new size}
IMG.Height := Rz * dY;
IMG.PixelFormat := pf24bit; {implicit}
IMG.Canvas.Brush.Color := clMaroon; {fill it wit}
IMG.Canvas.FillRect(Bounds(0, 0, IMG.Width, IMG.Height)); {fill now}
{for all non restructuralized image}
for i := 0 to DXImageList1.Items[0].PatternCount - 1 do begin
{refill by transparent color as background}
DDS.Fill(DDS.ColorMatch(TranspColor));
{draw sub-image to dds}
DXImageList1.Items[0].Draw(DDS, 0, 0, i);
{convert to dib}
DIB.Assign(DDS);
{draw to new position}
X := (i mod Rz) * dX;
Y := (i div Rz) * dY;
IMG.Canvas.Draw(X, Y, DIB)
end;
{for preview}
Image1.Picture.Assign(IMG);
{to collection item}
Q := TPictureCollectionItem(DXImageList1.Items.Add);
Q.Picture.Assign(IMG);
Q.PatternWidth := dX;
Q.PatternHeight := dY;
Q.Name := DXImageList1.Items[0].Name; //it has to have name
Q.Transparent := DXImageList1.Items[0].Transparent;
Q.TransparentColor := DXImageList1.Items[0].TransparentColor;
{original image get out}
{$IFNDEF VER5UP}
DXImageList1.Items[0].Free;
{$ELSE}
DXImageList1.Items.Delete(0);
{$ENDIF}
{Indispensability restore}
DXImageList1.Items.Restore;
finally
{freeing resources}
IMG.Free;
DIB.Free;
DDS.Free;
{$IFDEF D3D_deprecated}
DXDraw1.Options := DXDraw1.Options + [do3d];
{$ENDIF}
end;
end;
 
procedure TDXGlueItEditor.btnReplaceClick(Sender: TObject);
begin
if DXImageList1.Items.Count > 0 then
if (ePatternWidth.AsInteger > 0) and (ePatternHeight.AsInteger > 0) then begin
{must be set subimage first}
if DXImageList1.Items[0].PatternWidth <> ePatternWidth.AsInteger then
DXImageList1.Items[0].PatternWidth := ePatternWidth.AsInteger;
if DXImageList1.Items[0].PatternHeight <> ePatternHeight.AsInteger then
DXImageList1.Items[0].PatternHeight := ePatternHeight.AsInteger;
 
DXImageList1.Items.Restore;
RestructuralizeWithResize(DXImageList1.Items[0].PatternWidth,
DXImageList1.Items[0].PatternHeight, panTColor.Color);
end
else
MessageDlg('Please set subimage size first!', mtConfirmation, [mbOK], 0);
end;
 
procedure TDXGlueItEditor.btnResizeClick(Sender: TObject);
begin
if DXImageList1.Items.Count > 0 then {contain image}
if (ePatternWidth.AsInteger > 0) and (ePatternHeight.AsInteger > 0) then begin
{must be set subimage first}
if DXImageList1.Items[0].PatternWidth <> ePatternWidth.AsInteger then
DXImageList1.Items[0].PatternWidth := ePatternWidth.AsInteger;
if DXImageList1.Items[0].PatternHeight <> ePatternHeight.AsInteger then
DXImageList1.Items[0].PatternHeight := ePatternHeight.AsInteger;
 
DXImageList1.Items.Restore;
RestructuralizeWithResize(ePatternWidth.AsInteger, ePatternHeight.AsInteger, panTColor.Color);
end
else
MessageDlg('Please set subimage size first!', mtConfirmation, [mbOK], 0);
end;
 
procedure TDXGlueItEditor.ActionList1Update(Action: TBasicAction;
var Handled: Boolean);
begin
btnAllChars.Enabled := Trim(memAlphabet.Lines.Text) = '';
acDeleteAll.Enabled := ListBox1.Items.Count > 0;
acDeleteOne.Enabled := ListBox1.ItemIndex <> -1;
acSaveToFile.Enabled := not Image1.Picture.Bitmap.Empty;
acGlueIt.Enabled := ListBox1.Items.Count > 0;
btnGetTransparentcolor.Enabled := not Image1.Picture.Bitmap.Empty;
end;
 
procedure TDXGlueItEditor.chbZoomOutClick(Sender: TObject);
begin
if (Sender as TCheckBox).Checked then Image1.OnMouseMove := Image1MouseMove
else Image1.OnMouseMove := nil;
end;
 
procedure TDXGlueItEditor.Image1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
Srect, Drect: TRect;
iWidth, iHeight, DmX, DmY: Integer;
iTmpX, iTmpY: Real;
C: TCanvas;
hDesktop: Hwnd;
dx, dy: Integer;
PP: TPoint;
begin
PP := Image1.ClientToScreen(Point(X, Y));
dx := PP.x;
dy := PP.y;
hDesktop := GetDesktopWindow;
 
iWidth := Image2.Width;
iHeight := Image2.Height;
Drect := Rect(0, 0, iWidth, iHeight);
iTmpX := iWidth / (Slider.Position * 4);
iTmpY := iHeight / (Slider.Position * 4);
Srect := Rect(dx, dy, dx, dy);
InflateRect(Srect, Round(iTmpX), Round(iTmpY));
 
if Srect.Left < 0 then OffsetRect(Srect, -Srect.Left, 0);
if Srect.Top < 0 then OffsetRect(Srect, 0, -Srect.Top);
if Srect.Right > Screen.Width then OffsetRect(Srect, -(Srect.Right - Screen.Width), 0);
if Srect.Bottom > Screen.Height then OffsetRect(Srect, 0, -(Srect.Bottom - Screen.Height));
 
C := TCanvas.Create;
try
C.Handle := GetDC(GetDesktopWindow);
Image2.Canvas.CopyRect(Drect, C, Srect);
finally
ReleaseDC(hDesktop, C.Handle);
C.Free;
end;
with Image2.Canvas do begin
DmX := Slider.Position * 2 * (dX - Srect.Left);
DmY := Slider.Position * 2 * (dY - Srect.Top);
MoveTo(DmX - (iWidth div 4), DmY); // -
LineTo(DmX + (iWidth div 4), DmY); // -
MoveTo(DmX, DmY - (iHeight div 4)); // |
LineTo(DmX, DmY + (iHeight div 4)); // |
end;
end;
 
procedure TDXGlueItEditor.mainPageControlChange(Sender: TObject);
begin
Image2.Visible := mainPageControl.ActivePage = tsPreview;
end;
 
procedure TDXGlueItEditor.SetOperationGlueIt(const Value: TOperationGlueIt);
begin
FOperationGlueIt := Value;
if FOperationGlueIt = ogiNew then
mainPageControl.ActivePage := tsGlueIt
else
mainPageControl.ActivePage := tsPreview;
end;
 
procedure TDXGlueItEditor.btnGetTransparentcolorClick(Sender: TObject);
begin
SelectionOfTransparentColor := (Sender as TSpeedButton).Down;
end;
 
procedure TDXGlueItEditor.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if SelectionOfTransparentColor then begin
panTColor.Color := Image1.Picture.Bitmap.Canvas.Pixels[X, Y];
btnGetTransparentcolor.Down := False;
SelectionOfTransparentColor := False;
end;
end;
 
procedure TDXGlueItEditor.acGetTransparentExecute(Sender: TObject);
begin
SelectionOfTransparentColor := (Sender as TSpeedButton).Down;
end;
 
procedure TDXGlueItEditor.chbForceSizeClick(Sender: TObject);
begin
EWidthOfImages.Enabled := chbForceSize.Checked;
LWidthOfImages.Enabled := chbForceSize.Checked;
EHeightOfImages.Enabled := chbForceSize.Checked;
LHeightOfImages.Enabled := chbForceSize.Checked;
chbCentered.Enabled := chbForceSize.Checked;
chbCrop.Enabled := chbForceSize.Checked;
end;
 
procedure TDXGlueItEditor.cbEffectsListChange(Sender: TObject);
begin
if cbEffectsList.ItemIndex <> -1 then
if Image1.Picture.Bitmap.Empty then begin
ShowMessage('Image has not to be empty for effects!');
cbEffectsList.ItemIndex := -1;
//tmpBitmap.Assign(Image1.Picture.Bitmap);
end;
end;
 
procedure TDXGlueItEditor.pbDurationMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if chbAutoAply.Checked then
if not Image1.Picture.Bitmap.Empty then begin
tmpPicture.Assign(Image1.Picture.Bitmap); //save default image
if not tmpPicture.Graphic.Empty then begin
DoBitmapEffect(tmpPicture);
Application.ProcessMessages;
end;
end;
end;
 
procedure TDXGlueItEditor.pbDurationMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if chbAutoAply.Checked then
if not Image1.Picture.Bitmap.Empty then
if (MessageDlg('Do you want make changes permanent?', mtConfirmation, [mbYes, mbNo], 0) = mrNo) then
Image1.Picture.Bitmap.Assign(tmpPicture); //restore default image
end;
 
procedure TDXGlueItEditor.chbAutoAplyClick(Sender: TObject);
begin
btnApply.Enabled := not chbAutoAply.Checked;
end;
 
end.
/VCL_DELPHIX_D6/DXInptEdit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DXInput.pas
6,7 → 6,20
 
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, MMSystem,
DirectX, DXClass;
DXClass, {$IFDEF VER17UP} Types, {$ENDIF}
{$IfDef StandardDX}
{$IfDef DX9}
DirectInput;
{$Else}
{$IfDef DX81}
DirectInput8;
{$Else}
DirectInput;
{$EndIf}
{$EndIf}
{$Else}
DirectX;
{$EndIf}
 
type
 
765,7 → 778,7
FFindEffectGUID := pdei.guid;
end;
 
Result := DIENUM_STOP;
Result := Integer(DIENUM_STOP);
end;
 
procedure CreateIEffectGuid(const GUID: TGUID;
774,7 → 787,7
if EffectObject.Feff.dwSize=0 then Exit;
 
if FRoot.FInput.FDevice2<>nil then
FRoot.FInput.FDevice2.CreateEffect(GUID, EffectObject.Feff, EffectObject.FEffect, nil);
FRoot.FInput.FDevice2.CreateEffect(GUID, @EffectObject.Feff, EffectObject.FEffect, nil);
end;
 
procedure CreateIEffect(dwFlags: DWORD;
1405,11 → 1418,11
 
if FDevice<>nil then
begin
hr := FDevice.GetDeviceState(dwSize, Data);
hr := FDevice.GetDeviceState(dwSize, @Data);
if (hr=DIERR_INPUTLOST) or (hr=DIERR_NOTACQUIRED) then
begin
FDevice.Acquire;
hr := FDevice.GetDeviceState(dwSize, Data);
hr := FDevice.GetDeviceState(dwSize, @Data);
end;
Result := hr=DI_OK;
end else
1421,7 → 1434,7
function DIEnumDeviceObjectsProc(const peff: TDIDeviceObjectInstanceA;
pvRef: Pointer): HRESULT; stdcall;
begin
Result := DIENUM_CONTINUE;
Result := Integer(DIENUM_CONTINUE);
 
if CompareMem(@peff.guidType, @GUID_Unknown, SizeOf(TGUID)) then Exit;
 
1646,7 → 1659,10
DIK_APPS : Result := VK_APPS;
end;
end;
 
{$IFDEF StandardDX}
type
TDIKeyboardState = array[0..255] of Byte;
{$ENDIF}
var
j: Integer;
i: TDXInputState;
1848,7 → 1864,7
function TJoystick_EnumJoysticksCallback(const lpddi: TDIDeviceInstanceA;
pvRef: Pointer): HRESULT; stdcall;
begin
Result := DIENUM_CONTINUE;
Result := Integer(DIENUM_CONTINUE);
 
with TJoystick(pvRef) do
begin
1856,7 → 1872,7
begin
FDeviceGUID := lpddi.guidInstance;
FEnumFlag := True;
Result := DIENUM_STOP;
Result := Integer(DIENUM_STOP);
Exit;
end;
Inc(FEnumIndex);
1880,7 → 1896,7
FEnumFlag := False;
FEnumIndex := 0;
 
FDXInput.FDInput.EnumDevices(DIDEVTYPE_JOYSTICK, @TJoystick_EnumJoysticksCallback,
FDXInput.FDInput.EnumDevices({DIDEVTYPE_JOYSTICK}4, @TJoystick_EnumJoysticksCallback,
Self, DIEDFL_ATTACHEDONLY);
 
if not FEnumFlag then Exit;
1896,7 → 1912,7
FForceFeedbackDevice := True;
end;
 
if FDXInput.FDInput.CreateDevice(GUID_Joystick, FDevice, nil)<>DI_OK then Exit;
//if FDXInput.FDInput.CreateDevice(GUID_Joystick, FDevice, nil)<>DI_OK then Exit; get out by Paul van Dinther
 
{ Device data format (TDIDataFormat) making. }
 
2122,7 → 2138,7
procedure InitDirectInput(out DI: IDirectInput);
type
TDirectInputCreate = function(hinst: THandle; dwVersion: DWORD;
out ppDI: IDirectInputA; punkOuter: IUnknown): HRESULT; stdcall;
out ppDI: {$IFDEF UNICODE}IDirectInputW{$ELSE}IDirectInputA{$ENDIF}; punkOuter: IUnknown): HRESULT; stdcall;
begin
if FDirectInput=nil then
begin
/VCL_DELPHIX_D6/DXMapEdit.dfm
0,0 → 1,298
object DelphiXMapEditForm: TDelphiXMapEditForm
Left = 320
Top = 226
Width = 618
Height = 442
Caption = 'Background Sprite Map Editor'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object pnlRight: TPanel
Left = 467
Top = 0
Width = 143
Height = 408
Align = alRight
BevelOuter = bvNone
TabOrder = 0
object CancelButton: TButton
Left = 5
Top = 40
Width = 73
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 0
end
object DelphiXMapEditPropertiesPane: TPanel
Left = 0
Top = 72
Width = 138
Height = 267
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 1
end
object OKButton: TButton
Left = 5
Top = 8
Width = 73
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 2
OnClick = OKButtonClick
end
end
object pnlLeft: TPanel
Left = 0
Top = 0
Width = 467
Height = 408
Align = alClient
BevelOuter = bvNone
BorderWidth = 8
TabOrder = 1
object pblBase: TPanel
Left = 8
Top = 8
Width = 451
Height = 392
Align = alClient
BevelOuter = bvNone
BorderWidth = 4
BorderStyle = bsSingle
TabOrder = 0
object Panel1: TPanel
Left = 4
Top = 61
Width = 439
Height = 323
Align = alClient
BevelOuter = bvNone
BorderWidth = 1
Caption = 'Panel1'
TabOrder = 1
object Splitter1: TSplitter
Left = 114
Top = 1
Width = 3
Height = 321
Cursor = crHSplit
end
object PicturesToChip: TListBox
Left = 1
Top = 1
Width = 113
Height = 321
Align = alLeft
DragMode = dmAutomatic
ItemHeight = 16
PopupMenu = PopupMenu1
Style = lbOwnerDrawVariable
TabOrder = 0
Visible = False
OnDrawItem = PicturesToChipDrawItem
OnMeasureItem = PicturesToChipMeasureItem
end
object ScrollBox1: TScrollBox
Left = 117
Top = 1
Width = 321
Height = 321
Align = alClient
TabOrder = 1
object MapArea: TDrawGrid
Left = 1
Top = 1
Width = 165
Height = 165
TabStop = False
BorderStyle = bsNone
DefaultColWidth = 32
DefaultRowHeight = 32
FixedCols = 0
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goDrawFocusSelected]
PopupMenu = PopupMenu2
ScrollBars = ssNone
TabOrder = 0
Visible = False
OnDblClick = MapAreaDblClick
OnDragDrop = MapAreaDragDrop
OnDragOver = MapAreaDragOver
OnDrawCell = MapAreaDrawCell
OnMouseDown = MapAreaMouseDown
OnMouseMove = MapAreaMouseMove
end
end
end
object pnlLabels: TPanel
Left = 4
Top = 4
Width = 439
Height = 57
Align = alTop
BevelOuter = bvNone
TabOrder = 0
object BtnSetSize: TSpeedButton
Left = 413
Top = 3
Width = 21
Height = 46
Hint = 'Set up size.'
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00DDDDDDDDDDDD
DDDDDDDDDDDDDDD0DDDDDDDDDDDDDD080DDDDDDDDDDDD080DDDDDDDDDDDD080D
DDDDDDDDDDD080DDDDDDDDDDDD080DDDDDDDDDDDD080DDDDDDDDDDD0080DDDDD
DDDDDD0FF0DDDDDDDDDDDD0FF0DDDDDDDDDDDD0F0DDDDDDDDDDDDD00DDDDDDDD
DDDDDD0DDDDDDDDDDDDDDD0DDDDDDDDDDDDDDDDDDDDDDDDDDDDD}
ParentShowHint = False
ShowHint = True
OnClick = BtnSetSizeClick
end
object LAreaOfChips: TLabel
Left = 121
Top = 44
Width = 234
Height = 13
Caption = 'Area of Chips (doubleclick to properties change):'
FocusControl = ScrollBox1
Transparent = True
end
object LHeight: TLabel
Left = 288
Top = 31
Width = 46
Height = 13
Caption = 'Chip size:'
FocusControl = EHeight
end
object LImageToSet: TLabel
Left = 5
Top = 5
Width = 109
Height = 13
Caption = 'Image by name to set:'
FocusControl = ImageToSet
end
object LMapSizeX: TLabel
Left = 242
Top = 7
Width = 45
Height = 13
Caption = 'Map size:'
FocusControl = eMapSizeX
end
object LMapSizeY: TLabel
Left = 347
Top = 7
Width = 6
Height = 13
Caption = 'x'
FocusControl = eMapSizeY
end
object LPicturesToChip: TLabel
Left = 5
Top = 44
Width = 42
Height = 13
Caption = 'Pictures:'
FocusControl = PicturesToChip
end
object LWidth: TLabel
Left = 370
Top = 31
Width = 6
Height = 13
Caption = 'x'
FocusControl = EWidth
end
object EHeight: TEdit
Left = 334
Top = 28
Width = 32
Height = 21
TabOrder = 0
Text = '32'
end
object eMapSizeX: TSpinEdit
Left = 293
Top = 4
Width = 50
Height = 22
MaxValue = 128
MinValue = 1
TabOrder = 1
Value = 1
end
object eMapSizeY: TSpinEdit
Left = 360
Top = 4
Width = 50
Height = 22
MaxValue = 128
MinValue = 1
TabOrder = 2
Value = 1
end
object EWidth: TEdit
Left = 378
Top = 28
Width = 32
Height = 21
TabOrder = 3
Text = '32'
end
object ImageToSet: TComboBox
Left = 5
Top = 19
Width = 153
Height = 21
Style = csDropDownList
Enabled = False
ItemHeight = 13
TabOrder = 4
OnChange = ImageToSetChange
end
end
end
end
object PopupMenu1: TPopupMenu
OnPopup = PopupMenu1Popup
Left = 104
Top = 320
object Fillall1: TMenuItem
Caption = 'Fill all'
OnClick = Fillall1Click
end
end
object PopupMenu2: TPopupMenu
OnPopup = PopupMenu2Popup
Left = 256
Top = 200
object ClearOneChip1: TMenuItem
Caption = 'Clear One Chip'
OnClick = ClearOneChip1Click
end
object Clear1: TMenuItem
Caption = 'Clear All Chips'
GroupIndex = 1
OnClick = Clear1Click
end
end
end
/VCL_DELPHIX_D6/DXMapEdit.pas
0,0 → 1,522
unit DXMapEdit;
//(c)2007 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) create image map and store it into rersource.
b) allow do change.
c) controll map by each chip.
 
}
interface
{$INCLUDE DelphiXcfg.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, {$IFDEF VER4UP}ImgList,{$ENDIF}
Grids, Menus, DXMapEditProperties, Spin,
DXSprite, DXClass, DXDraws{$IfNDef StandardDX}, DirectX{$EndIf}, DIB;
 
type
{injected class}
 
{ TEdit }
 
TEdit = class(StdCtrls.TEdit)
private
function GetAsInteger: Integer;
procedure SetAsInteger(const Value: Integer);
published
public
property AsInteger: Integer read GetAsInteger write SetAsInteger;
end;
 
{ TDrawGrid }
// TDrawGrid = class(Grids.TDrawGrid)
// procedure CMMouseEnter(var Msg: TMessage); message CM_MouseEnter;
// procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave;
// end;
 
{ TDelphiXMapEditForm }
 
TDelphiXMapEditForm = class(TForm)
pblBase: TPanel;
LHeight: TLabel;
LMapSizeX: TLabel;
LMapSizeY: TLabel;
EHeight: TEdit;
EWidth: TEdit;
eMapSizeX: TSpinEdit;
eMapSizeY: TSpinEdit;
OKButton: TButton;
CancelButton: TButton;
LWidth: TLabel;
ImageToSet: TComboBox;
LImageToSet: TLabel;
ScrollBox1: TScrollBox;
BtnSetSize: TSpeedButton;
PicturesToChip: TListBox;
LPicturesToChip: TLabel;
MapArea: TDrawGrid;
PopupMenu1: TPopupMenu;
Fillall1: TMenuItem;
PopupMenu2: TPopupMenu;
Clear1: TMenuItem;
LAreaOfChips: TLabel;
ClearOneChip1: TMenuItem;
DelphiXMapEditPropertiesPane: TPanel;
pnlRight: TPanel;
pnlLeft: TPanel;
pnlLabels: TPanel;
Panel1: TPanel;
Splitter1: TSplitter;
procedure OKButtonClick(Sender: TObject);
procedure MapAreaDblClick(Sender: TObject);
procedure ClearOneChip1Click(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure PopupMenu2Popup(Sender: TObject);
procedure Clear1Click(Sender: TObject);
procedure Fillall1Click(Sender: TObject);
procedure MapAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageToSetChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PicturesToChipDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure PicturesToChipMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure FormCreate(Sender: TObject);
procedure MapAreaDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure MapAreaDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure BtnSetSizeClick(Sender: TObject);
procedure MapAreaDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure MapAreaMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
DIB: TDIB;
maparea_X, maparea_Y: Integer;
pct: TDXPictureClip;
FocusPopUpPositionCol, FocusPopUpPositionRow: Integer;
DragPositionCol, DragPositionRow: Integer;
DelphiXMapEditPropertiesForm: TDelphiXMapEditPropertiesForm;
procedure MapTypeDefaultValuesByObject(out MapType: TMapType);
public
DXBackgroundSprite: TBackgroundSprite;
DXImageList: TCustomDXImageList; //instance only
function LoadSplittedImage(ClearContentOfMapArea: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
procedure ResizeMapArea;
end;
 
var
DelphiXMapEditForm: TDelphiXMapEditForm;
 
implementation
 
{$R *.dfm}
 
{ TEdit }
 
function TEdit.GetAsInteger: Integer;
begin
try
Result := StrToInt(Self.Text);
except
Result := 0;
end;
end;
 
procedure TEdit.SetAsInteger(const Value: Integer);
begin
Self.Text := IntToStr(Value)
end;
 
{ TDrawGrid }
 
//procedure TDrawGrid.CMMouseEnter(var Msg: TMessage);
//begin
//
//end;
//
//procedure TDrawGrid.CMMouseLeave(var Msg: TMessage);
//begin
//end;
 
//------------------------------------------------------------------------------
 
{TDelphiXMapEditForm}
 
procedure TDelphiXMapEditForm.MapAreaDragDrop(Sender, Source: TObject; X,
Y: Integer);
var
DropPositionCol, DropPositionRow: Integer;
begin
MapArea.MouseToCell(X, Y, DropPositionCol, DropPositionRow); // convert mouse coord.
if Source is TListBox then begin
if Sender is TDrawGrid then
with Sender as TDrawGrid do begin
with DXBackgroundSprite do
Chips[DropPositionCol, DropPositionRow] := (Source as TListBox).ItemIndex;
Invalidate;
end;
end
else
if Source is TDrawGrid then begin
if Sender is TDrawGrid then
if (DropPositionCol <> DragPositionCol) or (DropPositionRow <> DragPositionRow) then
with Sender as TDrawGrid do begin
with DXBackgroundSprite do
Map[DropPositionCol, DropPositionRow] := Map[DragPositionCol, DragPositionRow];
Invalidate;
end;
end;
end;
 
procedure TDelphiXMapEditForm.MapAreaDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
CurrentCol, CurrentRow: Integer;
begin
MapArea.MouseToCell(X, Y, CurrentCol, CurrentRow); // convert mouse coord.
Accept := ((Source = PicturesToChip) or (Source = Sender))
{ Accept dragged stuff only when the mouse is now over an acceptable region }
and (CurrentCol >= 0) and (CurrentRow >= 0);
if Source = Sender then
MapArea.SetFocus;
end;
 
procedure TDelphiXMapEditForm.MapAreaDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
TmpRect: TRect;
A: array[1..255] of Char;
begin
with MapArea.Canvas do begin
FillRect(Rect);
if pct.IsEmpty then Exit;
with DXBackgroundSprite do begin
DIB.SetSize(pct.Width, pct.Height, 24);
pct.Draw(DIB.Canvas, 0, 0, Chips[ACol, ARow]);
if gdFocused in State then begin
DIB.DoDarkness(80);
end
else begin
if CollisionMap[ACol, ARow] then
DIB.Darker(50)
end;
if Map[ACol, ARow].MirrorFlip <> [] then DIB.Mirror(rmfMirror in Map[ACol, ARow].MirrorFlip, rmfFlip in Map[ACol, ARow].MirrorFlip);
Draw(Rect.Left, Rect.Top, DIB);
end;
if gdFocused in State then
begin
if goDrawFocusSelected in MapArea.Options then
Pen.Color := clHighlight
else
Pen.Color := MapArea.Color;
Brush.Style := bsClear;
{$IFDEF VER5UP}
Rectangle(Rect); InFlateRect(Rect, -1, -1); Rectangle(Rect);
{$ELSE}
Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); InFlateRect(Rect, -1, -1);Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
{$ENDIF}
end;
with DXBackgroundSprite do begin
Font.Name := 'Arial';
Font.Size := 9;
Font.Color := clHighlightText;
Brush.Style := bsClear;
TmpRect := Rect;
TmpRect.Bottom := TmpRect.Bottom - ((TmpRect.Bottom - TmpRect.Top) div 2);
if CollisionMap[ACol, ARow] then
DrawText(MapArea.Canvas.Handle, StrPCopy(@A, 'brick'), -1, TmpRect, dt_SingleLine or dt_Center or dt_VCenter);
TmpRect := Rect;
TmpRect.Top := TmpRect.Bottom - ((TmpRect.Bottom - TmpRect.Top) div 2);
case Map[ACol, ARow].Rendered of
rtDraw: DrawText(MapArea.Canvas.Handle, StrPCopy(@A, 'D:' + IntToStr(Map[ACol, ARow].Alpha)), -1, TmpRect, dt_SingleLine or dt_Center or dt_VCenter);
rtBlend: DrawText(MapArea.Canvas.Handle, StrPCopy(@A, 'B:' + IntToStr(Map[ACol, ARow].Alpha)), -1, TmpRect, dt_SingleLine or dt_Center or dt_VCenter);
rtAdd: DrawText(MapArea.Canvas.Handle, StrPCopy(@A, 'A:' + IntToStr(Map[ACol, ARow].Alpha)), -1, TmpRect, dt_SingleLine or dt_Center or dt_VCenter);
rtSub: DrawText(MapArea.Canvas.Handle, StrPCopy(@A, 'S:' + IntToStr(Map[ACol, ARow].Alpha)), -1, TmpRect, dt_SingleLine or dt_Center or dt_VCenter);
end
end;
end;
end;
 
procedure TDelphiXMapEditForm.FormCreate(Sender: TObject);
begin
DelphiXMapEditPropertiesForm := TDelphiXMapEditPropertiesForm.Create(Self);
DelphiXMapEditPropertiesForm.Parent := DelphiXMapEditPropertiesPane;
DelphiXMapEditPropertiesForm.ParentWindow := Self.DelphiXMapEditPropertiesPane.Handle;
DelphiXMapEditPropertiesForm.Top := 0;
DelphiXMapEditPropertiesForm.Left := 0;
DelphiXMapEditPropertiesForm.BorderStyle := bsNone;
DelphiXMapEditPropertiesForm.Align := alClient;
{nothing selected}
FocusPopUpPositionCol := -1;
FocusPopUpPositionRow := -1;
DIB := TDIB.Create;
pct := TDXPictureClip.Create(nil);
{$IFDEF VER4UP}
MapArea.DoubleBuffered := True;
{$ENDIF}
end;
 
procedure TDelphiXMapEditForm.PicturesToChipMeasureItem(Control: TWinControl;
Index: Integer; var Height: Integer);
begin
Height := pct.Height;
end;
 
procedure TDelphiXMapEditForm.ResizeMapArea;
{$IFNDEF VER4UP}
type
TOldMap = array[0..0, 0..0] of TMapType;
POldMap = ^TOldMap;
{$ENDIF}
var
{$IFDEF VER4UP}
oldmap: array of array of TMapType;
{$ELSE}
oldmap: POldMap;
{$ENDIF}
i, j, oldw, oldh: Integer;
MapType: TMapType;
begin
{older size, save old layout}
oldw := DXBackgroundSprite.MapWidth;
oldh := DXBackgroundSprite.MapHeight;
{$IFDEF VER4UP}
SetLength(oldmap, oldw, oldh);
{$ELSE}
GetMem(oldmap, oldw * oldh * SizeOf(TMapType));
try
{$ENDIF}
{old the content of map}
if not DXBackgroundSprite.IsMapEmpty then
for i := 0 to oldw - 1 do
for j := 0 to oldh - 1 do
oldmap{$IFNDEF VER4UP}^{$ENDIF} [i, j] := DXBackgroundSprite.Map[i, j];
{size realocation}
with DXBackgroundSprite do begin
SetMapSize(eMapSizeX.Value, eMapSizeY.Value);
{prevent resize of cleared by the content object}
MapTypeDefaultValuesByObject(MapType);
for i := 0 to eMapSizeX.Value - 1 do
for j := 0 to eMapSizeY.Value - 1 do begin
Chips[i, j] := 0;
CollisionMap[i, j] := False;
Map[i, j] := MapType;
end;
end;
{back context}
for i := 0 to oldw - 1 do
for j := 0 to oldh - 1 do
DXBackgroundSprite.Map[i, j] := oldmap{$IFNDEF VER4UP}^{$ENDIF} [i, j];
{$IFNDEF VER4UP}
finally
FreeMem(oldmap)
end;
{$ENDIF}
MapArea.ColCount := eMapSizeX.Value;
MapArea.RowCount := eMapSizeY.Value;
MapArea.Width := eMapSizeX.Value * (EWidth.AsInteger + 1);
MapArea.Height := eMapSizeY.Value * (EHeight.AsInteger + 1);
MapArea.Invalidate;
end;
 
procedure TDelphiXMapEditForm.MapTypeDefaultValuesByObject(out MapType: TMapType);
begin
FillChar(MapType, SizeOf(MapType), 0);
{ default values from owner's object }
MapType.CollisionChip := DXBackgroundSprite.Collisioned;
MapType.Overlap := 0;
MapType.AnimLooped:= DXBackgroundSprite.AnimLooped;
MapType.AnimStart := DXBackgroundSprite.AnimStart;
MapType.AnimCount := DXBackgroundSprite.AnimCount;
MapType.AnimSpeed := DXBackgroundSprite.AnimSpeed;
MapType.Alpha := DXBackgroundSprite.Alpha;
MapType.Rendered := DXBackgroundSprite.BlendMode;
MapType.AnimPos := DXBackgroundSprite.AnimPos;
MapType.Angle := DXBackgroundSprite.Angle;
MapType.MirrorFlip := DXBackgroundSprite.MirrorFlip;
MapType.TextureFilter := DXBackgroundSprite.TextureFilter;
MapType.CenterX := DXBackgroundSprite.CenterX;
MapType.CenterY := DXBackgroundSprite.CenterY;
end;
 
procedure TDelphiXMapEditForm.BtnSetSizeClick(Sender: TObject);
begin
ResizeMapArea
end;
 
procedure TDelphiXMapEditForm.PicturesToChipDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
R: TRect;
I: Integer;
begin
with PicturesToChip.Canvas do begin
if not (odSelected in State) then
if Odd(Index) then Brush.Color := {$IFDEF VER6UP}clMoneyGreen{$ELSE}clGreen{$ENDIF}
else Brush.Color := clWhite;
FillRect(Rect);
pct.Draw(PicturesToChip.Canvas, Rect.Left, Rect.Top, Index);
Brush.Style := bsClear;
R := Rect;
R.Left := Rect.Left + pct.Width + 2;
I := Rect.Top + (Rect.Bottom - Rect.Top - PicturesToChip.Canvas.TextHeight(PicturesToChip.Items[index])) div 2;
TextOut(Rect.Left + pct.Width + 2, I, PicturesToChip.Items[index]);
end;
end;
 
procedure TDelphiXMapEditForm.FormDestroy(Sender: TObject);
begin
DIB.Free;
pct.Free;
end;
 
function TDelphiXMapEditForm.LoadSplittedImage(ClearContentOfMapArea: Boolean): Boolean;
var
I, V: Integer;
begin
if (ImageToSet.ItemIndex <> -1) and Assigned(DXImageList) then begin
DXImageList.Items[ImageToSet.ItemIndex].Restore;
pct.Picture := DXImageList.Items[ImageToSet.ItemIndex].Picture;
pct.Width := DXImageList.Items[ImageToSet.ItemIndex].PatternWidth;
pct.Height := DXImageList.Items[ImageToSet.ItemIndex].PatternHeight;
EWidth.AsInteger := pct.Width;
EHeight.AsInteger := pct.Height;
PicturesToChip.Clear;
V := DXImageList.Items[ImageToSet.ItemIndex].PatternCount;
for I := 0 to V - 1 do begin
PicturesToChip.Items.Add(Format(ImageToSet.Text + ' [%d]', [I]));
end;
PicturesToChip.ItemHeight := DXImageList.Items[ImageToSet.ItemIndex].PatternHeight;
{seznam je videt a take MapArea}
PicturesToChip.Visible := True;
{pri zmene obrazku vymazat content!}
if ClearContentOfMapArea then
Clear1.Click;
MapArea.Visible := True;
MapArea.Invalidate;
Result := True;
end
else
Result := False;
end;
 
procedure TDelphiXMapEditForm.ImageToSetChange(Sender: TObject);
begin
if ImageToSet.ItemIndex <> -1 then
begin
LoadSplittedImage(True);
end;
end;
 
procedure TDelphiXMapEditForm.MapAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{ Convert mouse coordinates X, Y to to StringGrid related col and row numbers }
MapArea.MouseToCell(X, Y, DragPositionCol, DragPositionRow);
{ Allow dragging only if an acceptable cell was clicked (cell beyond the fixed column and row) }
if (Button = mbLeft) and (DragPositionCol >= 0) and (DragPositionRow >= 0) then
begin
{ Begin dragging after mouse has moved 4 pixels }
MapArea.BeginDrag(False{$IFDEF VER4UP}, 2{$ENDIF});
end;
end;
 
procedure TDelphiXMapEditForm.MapAreaMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
FocusPositionCol, FocusPositionRow: Integer;
begin
maparea_X := X; maparea_Y := Y;
MapArea.MouseToCell(X, Y, FocusPositionCol, FocusPositionRow);
if not MapArea.Focused then
MapArea.SetFocus;
MapArea.Row := FocusPositionRow;
MapArea.Col := FocusPositionCol;
end;
 
procedure TDelphiXMapEditForm.Fillall1Click(Sender: TObject);
var
i, j: Integer;
begin
if PicturesToChip.ItemIndex <> -1 then
begin
with DXBackgroundSprite do
for i := 0 to MapArea.ColCount - 1 do
for j := 0 to MapArea.RowCount - 1 do
Chips[i, j] := PicturesToChip.ItemIndex;
MapArea.Invalidate;
end;
end;
 
procedure TDelphiXMapEditForm.Clear1Click(Sender: TObject);
var
i, j: Integer;
MapType: TMapType;
begin
MapTypeDefaultValuesByObject(MapType);
with DXBackgroundSprite do
for i := 0 to MapArea.ColCount - 1 do
for j := 0 to MapArea.RowCount - 1 do
begin
Chips[i, j] := 0;
CollisionMap[i, j] := False;
Map[i, j] := MapType;
end;
MapArea.Invalidate;
end;
 
procedure TDelphiXMapEditForm.PopupMenu2Popup(Sender: TObject);
var
Shift: TShiftState;
begin
Shift := [];
MouseMove(Shift, maparea_X, maparea_Y);
MapArea.MouseToCell(maparea_X, maparea_Y, FocusPopUpPositionCol, FocusPopUpPositionRow);
end;
 
procedure TDelphiXMapEditForm.PopupMenu1Popup(Sender: TObject);
begin
Fillall1.Enabled := PicturesToChip.ItemIndex <> -1;
end;
 
procedure TDelphiXMapEditForm.ClearOneChip1Click(Sender: TObject);
var
MapType: TMapType;
begin
MapTypeDefaultValuesByObject(MapType);
with DXBackgroundSprite do
begin
Map[MapArea.Col, MapArea.Row] := MapType;
end;
MapArea.Invalidate;
end;
 
procedure TDelphiXMapEditForm.MapAreaDblClick(Sender: TObject);
begin
{Reset the flag}
DelphiXMapEditPropertiesForm.Tag := 0;
DelphiXMapEditPropertiesForm.Panel2.Color := {$IFDEF VER6UP}clSkyBlue{$ELSE}clBlue{$ENDIF};
if not DelphiXMapEditPropertiesForm.Showing then
DelphiXMapEditPropertiesForm.Show;
Application.ProcessMessages;
DelphiXMapEditPropertiesForm.Col := MapArea.Col;
DelphiXMapEditPropertiesForm.Row := MapArea.Row;
DelphiXMapEditPropertiesForm.LoadCellToForm(DXBackgroundSprite.Map[MapArea.Col, MapArea.Row], MapArea.Col, MapArea.Row);
end;
 
procedure TDelphiXMapEditForm.OKButtonClick(Sender: TObject);
begin
if DelphiXMapEditPropertiesForm.Tag = 1 then
DelphiXMapEditPropertiesForm.btnOK.Click;
end;
 
end.
/VCL_DELPHIX_D6/DXMapEditProperties.dfm
0,0 → 1,221
object DelphiXMapEditPropertiesForm: TDelphiXMapEditPropertiesForm
Left = 575
Top = 327
BorderIcons = [biSystemMenu]
BorderStyle = bsToolWindow
Caption = 'Chip property'
ClientHeight = 265
ClientWidth = 131
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = True
Position = poDefault
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 131
Height = 265
Align = alClient
BevelOuter = bvNone
BorderWidth = 2
TabOrder = 0
object LAlpha: TLabel
Left = 10
Top = 193
Width = 74
Height = 13
Caption = 'Alpha (0..255):'
FocusControl = EAlpha
end
object LAnimCount: TLabel
Left = 21
Top = 106
Width = 63
Height = 13
Caption = 'Anim. Count:'
FocusControl = EAnimCount
end
object LAnimSpeed: TLabel
Left = 20
Top = 125
Width = 64
Height = 13
Caption = 'Anim. Speed:'
FocusControl = EAnimSpeed
end
object LAnimStart: TLabel
Left = 26
Top = 68
Width = 58
Height = 13
Caption = 'Anim. Start:'
FocusControl = EAnimStart
end
object LAnimPos: TLabel
Left = 33
Top = 87
Width = 51
Height = 13
Caption = 'Anim. Pos:'
FocusControl = EAnimPos
end
object EAlpha: TEdit
Left = 84
Top = 190
Width = 43
Height = 18
AutoSize = False
TabOrder = 0
Text = '255'
end
object EAnimCount: TEdit
Left = 84
Top = 103
Width = 43
Height = 18
AutoSize = False
TabOrder = 1
Text = '0'
end
object EAnimSpeed: TEdit
Left = 84
Top = 122
Width = 43
Height = 18
AutoSize = False
TabOrder = 2
Text = '0'
end
object EAnimStart: TEdit
Left = 84
Top = 65
Width = 43
Height = 18
AutoSize = False
TabOrder = 3
Text = '0'
end
object EAnimPos: TEdit
Left = 84
Top = 84
Width = 43
Height = 18
AutoSize = False
TabOrder = 4
Text = '0'
end
object Panel2: TPanel
Left = 2
Top = 2
Width = 127
Height = 23
Align = alTop
BevelOuter = bvLowered
BorderWidth = 2
Caption = 'Chip (%d,%d)'
Color = 16776176
TabOrder = 5
end
object chbCollisioned: TCheckBox
Left = 16
Top = 31
Width = 97
Height = 17
Caption = 'Collisioned Chip'
TabOrder = 6
end
object chbAnimated: TCheckBox
Left = 16
Top = 46
Width = 105
Height = 17
Caption = 'Animation On/Off'
TabOrder = 7
end
object rgBlendMode: TRadioGroup
Left = 3
Top = 141
Width = 124
Height = 47
Caption = ' Blend mode: '
Columns = 2
Items.Strings = (
'Draw'
'Blend'
'Add'
'Sub')
TabOrder = 8
end
object btnOK: TBitBtn
Left = 4
Top = 244
Width = 56
Height = 19
Caption = 'OK'
Default = True
TabOrder = 9
OnClick = btnOKClick
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000E0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
77007777777777777700777774F7777777007777444F777777007774444F7777
770077444F44F77777007444F7744F777700774F77774F7777007777777774F7
770077777777774F7700777777777774F7007777777777774700777777777777
7700}
Spacing = -1
end
object btnCancel: TBitBtn
Left = 68
Top = 244
Width = 56
Height = 19
Cancel = True
Caption = 'Cancel'
TabOrder = 10
Visible = False
OnClick = btnCancelClick
Glyph.Data = {
EE000000424DEE000000000000007600000028000000100000000F0000000100
0400000000007800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
777777777777777770F77770F7777777777777000F7777770F7777000F777770
F777777000F77700F7777777000F700F77777777700000F77777777777000F77
77777777700000F777777777000F70F77777770000F77700F77770000F777770
0F77700F7777777700F77777777777777777}
Spacing = -1
end
object GroupBox1: TGroupBox
Left = 3
Top = 208
Width = 124
Height = 33
Caption = ' Flip/Mirror: '
TabOrder = 11
object chbFlip: TCheckBox
Left = 8
Top = 13
Width = 38
Height = 17
Caption = 'Flip'
TabOrder = 0
end
object chbMirror: TCheckBox
Left = 56
Top = 13
Width = 57
Height = 17
Caption = 'Mirror'
TabOrder = 1
end
end
end
end
/VCL_DELPHIX_D6/DXMapEditProperties.pas
0,0 → 1,368
unit DXMapEditProperties;
//(c)2007 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) set up or change for each chip parameters by drawing or collision brick.
b) integrated into map editor.
 
}
interface
 
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, DXSprite, DXDraws;
 
type
{injected class}
TEdit = class(StdCtrls.TEdit)
private
FButton: TSpeedButton;
FEditorEnabled: Boolean;
FOnBtnClick: TNotifyEvent;
procedure SetGlyph(Pic: TBitmap);
function GetGlyph: TBitmap;
procedure SetNumGlyphs(ANumber: Integer);
function GetNumGlyphs: Integer;
//function GetMinHeight: Integer;
procedure SetEditRect;
function GetAsInteger: Integer;
procedure SetAsInteger(const Value: Integer);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
procedure WMCut(var Message: TWMCut); message WM_CUT;
function GetAsFloat: Double;
procedure SetAsFloat(const Value: Double);
function GetBtnVisible: Boolean;
procedure SetBtnVisible(const Value: Boolean);
protected
function IsValidChar(Key: Char): Boolean; virtual;
procedure aClick(Sender: TObject); virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Button: TSpeedButton read FButton;
property AsInteger: Integer read GetAsInteger write SetAsInteger;
property AsFloat: Double read GetAsFloat write SetAsFloat;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
published
property BtnVisible: Boolean read GetBtnVisible write SetBtnVisible default False;
property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
property Glyph: TBitmap read GetGlyph write SetGlyph;
property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs;
property OnBtnClick: TNotifyEvent read FOnBtnClick write FOnBtnClick;
end;
 
{ TDelphiXMapEditPropertiesForm }
 
TDelphiXMapEditPropertiesForm = class(TForm)
Panel1: TPanel;
LAlpha: TLabel;
LAnimCount: TLabel;
LAnimSpeed: TLabel;
LAnimStart: TLabel;
LAnimPos: TLabel;
EAlpha: TEdit;
EAnimCount: TEdit;
EAnimSpeed: TEdit;
EAnimStart: TEdit;
EAnimPos: TEdit;
Panel2: TPanel;
chbCollisioned: TCheckBox;
chbAnimated: TCheckBox;
rgBlendMode: TRadioGroup;
btnOK: TBitBtn;
btnCancel: TBitBtn;
GroupBox1: TGroupBox;
chbFlip: TCheckBox;
chbMirror: TCheckBox;
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
private
{ Private declarations }
LocalMapType: TMapType;
FCol, FRow: Integer;
public
{ Public declarations }
procedure LoadCellToForm(MapType: TMapType; ACol, ARow: Integer);
function SaveCellFromForm(ACol, ARow: Integer): TMapType;
property Col: Integer read FCol write FCol;
property Row: Integer read FRow write FRow;
end;
 
implementation
 
{$R *.dfm}
 
uses DXMapEdit;
 
{ TEdit }
 
constructor TEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FButton := TSpeedButton.Create(Self);
FButton.Align := alRight;
FButton.Caption := '...';
//FButton.Height := Self.Height-4;
FButton.Width := FButton.Height div 2;
// if csDesigning in ComponentState then
// FButton.Visible := True
// else FButton.Visible := False;
FButton.Parent := Self;
FButton.OnClick := aClick;
FButton.Cursor := crArrow;
ControlStyle := ControlStyle - [csSetCaption];
FButton.Visible := False; {button is not visible as default}
FEditorEnabled := True;
end;
 
destructor TEdit.Destroy;
begin
FButton.Free; FButton := nil;
inherited Destroy;
end;
 
procedure TEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
 
procedure TEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
end;
 
procedure TEdit.SetGlyph(Pic: TBitmap);
begin
FButton.Glyph.Assign(Pic);
end;
 
function TEdit.GetGlyph: TBitmap;
begin
Result := FButton.Glyph;
end;
 
procedure TEdit.SetNumGlyphs(ANumber: Integer);
begin
FButton.NumGlyphs := ANumber;
end;
 
function TEdit.GetNumGlyphs: Integer;
begin
Result := FButton.NumGlyphs;
end;
 
procedure TEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;
 
function TEdit.IsValidChar(Key: Char): Boolean;
begin
Result := True;
end;
 
procedure TEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN {and not WS_BORDER};
end;
 
procedure TEdit.CreateWnd;
begin
inherited CreateWnd;
SetEditRect;
end;
 
procedure TEdit.SetEditRect;
var
Loc: TRect;
W: Integer;
begin
W := FButton.Width;
if not FButton.Visible then W := 0;
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
Loc.Bottom := ClientHeight + 1; {+1 is workaround for windows paint bug}
Loc.Right := ClientWidth - W - 2;
Loc.Top := 0;
Loc.Left := 0;
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); {debug}
end;
 
procedure TEdit.WMSize(var Message: TWMSize);
var
MinHeight: Integer;
begin
inherited;
MinHeight := 5;
{ text edit bug: if size to less than minheight, then edit ctrl does not display the text }
if Height < MinHeight then
Height := MinHeight
else
if Assigned(FButton) and FButton.Visible then
begin
FButton.Width := FButton.Height;
if NewStyleControls and Ctl3D then
FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
else FButton.SetBounds(Width - FButton.Width, 1, FButton.Width, Height - 1);
SetEditRect;
end
else SetEditRect;
end;
{
function TEdit.GetMinHeight: Integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
}
procedure TEdit.aClick(Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else if Assigned(FOnBtnClick) then FOnBtnClick(Self);
end;
 
procedure TEdit.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
 
procedure TEdit.WMCut(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
 
procedure TEdit.CMExit(var Message: TCMExit);
begin
//FButton.Visible := False;
inherited;
end;
 
procedure TEdit.CMEnter(var Message: TCMGotFocus);
begin
//FButton.Visible := True;
if AutoSelect and not (csLButtonDown in ControlState) then
SelectAll;
inherited;
end;
 
function TEdit.GetAsInteger: Integer;
begin
try
Result := StrToInt(Self.Text);
except
Result := 0;
end;
end;
 
function TEdit.GetBtnVisible: Boolean;
begin
Result := FButton.Visible
end;
 
procedure TEdit.SetAsInteger(const Value: Integer);
begin
Self.Text := IntToStr(Value)
end;
 
procedure TEdit.SetBtnVisible(const Value: Boolean);
begin
FButton.Visible := Value;
end;
 
function TEdit.GetAsFloat: Double;
begin
try
Result := StrToFloat(Self.Text);
except
Result := 0;
end;
end;
 
procedure TEdit.SetAsFloat(const Value: Double);
begin
Self.Text := FloatToStr(Value)
end;
 
{ TDelphiXMapEditPropertiesForm }
 
procedure TDelphiXMapEditPropertiesForm.LoadCellToForm(MapType: TMapType; ACol, ARow: Integer);
begin
LocalMapType := MapType;
Panel2.Caption := Format('Chip (%d, %d)', [ACol, ARow]);
chbCollisioned.Checked := MapType.CollisionChip;
chbAnimated.Checked := MapType.AnimLooped;
EAnimStart.AsInteger := MapType.AnimStart;
EAnimCount.AsInteger := MapType.AnimCount;
EAnimSpeed.AsFloat := MapType.AnimSpeed;
EAnimPos.AsFloat := MapType.AnimPos;
rgBlendMode.ItemIndex := Ord(MapType.Rendered);
EAlpha.AsInteger := MapType.Alpha;
chbFlip.Checked := (rmfFlip in MapType.MirrorFlip);
chbMirror.Checked := (rmfMirror in MapType.MirrorFlip);
end;
 
function TDelphiXMapEditPropertiesForm.SaveCellFromForm(ACol, ARow: Integer): TMapType;
begin
Result := LocalMapType;
Result.CollisionChip := chbCollisioned.Checked;
Result.AnimLooped := chbAnimated.Checked;
Result.AnimStart := EAnimStart.AsInteger;
Result.AnimCount := EAnimCount.AsInteger;
Result.AnimSpeed := EAnimSpeed.AsInteger;
Result.AnimPos := EAnimPos.AsInteger;
Result.Rendered := TRenderType(rgBlendMode.ItemIndex);
Result.Alpha := EAlpha.AsInteger;
Result.MirrorFlip := [];
if chbFlip.Checked then Result.MirrorFlip := Result.MirrorFlip + [rmfFlip];
if chbMirror.Checked then Result.MirrorFlip := Result.MirrorFlip + [rmfMirror];
end;
 
procedure TDelphiXMapEditPropertiesForm.btnOKClick(Sender: TObject);
begin
Tag := 1;
Panel2.Color := {$IFDEF VER6UP}clMoneyGreen{$ELSE}clGreen{$ENDIF};
DelphiXMapEditForm.DXBackgroundSprite.Map[FCol, FRow] := SaveCellFromForm(FCol, FRow);
DelphiXMapEditForm.MapArea.Invalidate;
btnCancelClick(Sender);
Hide;
end;
 
procedure TDelphiXMapEditPropertiesForm.btnCancelClick(Sender: TObject);
begin
Tag := 0;
Panel2.Color := {$IFDEF VER6UP}clSkyBlue{$ELSE}clBlue{$ENDIF};
end;
 
end.
/VCL_DELPHIX_D6/DXMidiEdit.dfm
0,0 → 1,187
object DelphiXMidiEditForm: TDelphiXMidiEditForm
Left = 288
Top = 239
BorderStyle = bsDialog
Caption = 'Midi Editor'
ClientHeight = 226
ClientWidth = 346
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
Scaled = False
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Bevel2: TBevel
Left = 8
Top = 8
Width = 249
Height = 209
Shape = bsFrame
end
object OKButton: TButton
Left = 264
Top = 8
Width = 73
Height = 25
Caption = 'OK'
Default = True
TabOrder = 0
OnClick = OKButtonClick
end
object CancelButton: TButton
Left = 264
Top = 40
Width = 73
Height = 25
Cancel = True
Caption = 'Cancel'
TabOrder = 1
OnClick = CancelButtonClick
end
object ClearButton: TButton
Left = 176
Top = 184
Width = 73
Height = 25
Caption = '&Clear'
TabOrder = 4
OnClick = ClearButtonClick
end
object SaveButton: TButton
Left = 96
Top = 184
Width = 73
Height = 25
Caption = '&Save...'
TabOrder = 3
OnClick = SaveButtonClick
end
object LoadButton: TButton
Left = 16
Top = 184
Width = 73
Height = 25
Caption = '&Load...'
TabOrder = 2
OnClick = LoadButtonClick
end
object Panel1: TPanel
Left = 16
Top = 16
Width = 233
Height = 161
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 5
object LengthLabel: TLabel
Left = 16
Top = 16
Width = 19
Height = 13
Caption = 'File:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object SizeLabel: TLabel
Left = 16
Top = 38
Width = 23
Height = 13
Caption = 'Size:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object filenamelabel: TLabel
Left = 72
Top = 16
Width = 42
Height = 13
Caption = 'Filename'
end
object SizeValueLabel: TLabel
Left = 72
Top = 38
Width = 20
Height = 13
Caption = 'Size'
end
end
object btnPlay: TBitBtn
Left = 111
Top = 128
Width = 25
Height = 25
TabOrder = 6
OnClick = btnPlayClick
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777777777777777777777777777777777777777077777777777777700077777
7777777700000777777777770000000777777777000000000777777700000007
7777777700000777777777770007777777777777077777777777777777777777
7777777777777777777777777777777777777777777777777777}
end
object btnStop: TBitBtn
Left = 136
Top = 128
Width = 25
Height = 25
TabOrder = 7
OnClick = btnStopClick
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777777777777777777777777777777777777777777777777777777700000000
7777777700000000777777770000000077777777000000007777777700000000
7777777700000000777777770000000077777777000000007777777777777777
7777777777777777777777777777777777777777777777777777}
end
object SaveDialog: TSaveDialog
DefaultExt = 'mid'
Filter = 'Midi (*.mid)|*.mid|All files (*.*)|*.*'
Options = [ofOverwritePrompt]
Title = 'Save MIDI file.'
Left = 312
Top = 80
end
object OpenDialog: TOpenDialog
DefaultExt = 'mid'
Filter = 'Midi (*.mid)|*.mid|All files (*.*)|*.*'
Options = [ofFileMustExist]
Title = 'Load MIDI file.'
Left = 280
Top = 80
end
object DXSound1: TDXSound
AutoInitialize = True
Options = []
Left = 272
Top = 120
end
object DXMusic1: TDXMusic
DXSound = DXSound1
Midis = <>
Left = 304
Top = 120
end
end
/VCL_DELPHIX_D6/DXMidiEdit.pas
0,0 → 1,192
unit DXMidiEdit;
//(c)2007 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) load existing midi file and store it into rersource.
b) allow do play.
 
}
interface
uses
Windows, SysUtils, Classes, Forms, Dialogs, Controls, StdCtrls, ExtCtrls,
Buttons, ComCtrls, Graphics, DXSounds;
 
type
 
{ TDelphiXWaveEditForm }
 
TDelphiXMidiEditForm = class(TForm)
Bevel2: TBevel;
OKButton: TButton;
CancelButton: TButton;
SaveDialog: TSaveDialog;
OpenDialog: TOpenDialog;
ClearButton: TButton;
SaveButton: TButton;
LoadButton: TButton;
Panel1: TPanel;
LengthLabel: TLabel;
SizeLabel: TLabel;
filenamelabel: TLabel;
SizeValueLabel: TLabel;
DXSound1: TDXSound;
DXMusic1: TDXMusic;
btnPlay: TBitBtn;
btnStop: TBitBtn;
procedure btnStopClick(Sender: TObject);
procedure btnPlayClick(Sender: TObject);
procedure OKButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
procedure LoadButtonClick(Sender: TObject);
procedure SaveButtonClick(Sender: TObject);
procedure ClearButtonClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FChanged: Boolean;
FMidiFileName: string;
FPlaying: Boolean;
T: TMusicListCollectionItem;
procedure UpDateData;
procedure SetPlaying(const Value: Boolean);
public
MidiData: string;
property MidiFileName: string read FMidiFileName write FMidiFileName;
property Playing: Boolean read FPlaying write SetPlaying;
end;
 
var
DelphiXMidiEditForm: TDelphiXMidiEditForm;
 
implementation
 
uses DXConsts;
 
{$R *.DFM}
 
procedure TDelphiXMidiEditForm.FormDestroy(Sender: TObject);
begin
if Playing then T.Stop;
end;
 
procedure TDelphiXMidiEditForm.FormShow(Sender: TObject);
begin
if Length(MidiData) <> 0 then begin
T := DXMusic1.Midis.Add;
T.Midi.MusicData := MidiData;
// if FileExists(MidiFileName) then
// T.LoadFromFile(MidiFileName);
end;
filenamelabel.Caption := MidiFileName;
SizeValueLabel.Caption := Format('%d bytes', [Length(MidiData)]);
UpDateData;
end;
 
procedure TDelphiXMidiEditForm.OKButtonClick(Sender: TObject);
begin
if FChanged then
begin
Tag := 1;
end;
Close;
end;
 
procedure TDelphiXMidiEditForm.CancelButtonClick(Sender: TObject);
begin
Close;
end;
 
procedure TDelphiXMidiEditForm.ClearButtonClick(Sender: TObject);
begin
if Playing then Playing := False;
SetLength(MidiData, 0);
MidiFileName := '';
filenamelabel.Caption := '';
SizeValueLabel.Caption := '';
DXMusic1.Midis.Clear;
FChanged := True;
UpdateData;
end;
 
procedure TDelphiXMidiEditForm.LoadButtonClick(Sender: TObject);
begin
if OpenDialog.Execute then
begin
if Playing then Playing := False;
MidiFileName := OpenDialog.FileName;
filenamelabel.Caption := ExtractFileName(MidiFileName);
T := DXMusic1.Midis.Add;
T.LoadFromFile(MidiFileName);
MidiData := T.Midi.MusicData;
SizeValueLabel.Caption := Format('%d bytes', [T.Size]);
FChanged := True;
UpdateData;
end;
end;
 
procedure TDelphiXMidiEditForm.SaveButtonClick(Sender: TObject);
var
F: file;
begin
if SaveDialog.Execute then
begin
if Playing then Playing := False;
if Length(MidiData) = 0 then Exit;
if FChanged then
begin
if AnsiCompareFileName(MidiFileName, SaveDialog.FileName)=0 then Exit;
end;
AssignFile(F, SaveDialog.FileName);
Rewrite(F,1);
try
BlockWrite(F, MidiData[1], Length(MidiData));
finally
CloseFile(F);
end;
end;
end;
 
procedure TDelphiXMidiEditForm.UpDateData;
begin
if Length(mididata) > 0 then begin
SaveButton.Enabled := True;
ClearButton.Enabled := True;
btnPlay.Enabled := True;
end
else begin
SaveButton.Enabled := False;
ClearButton.Enabled := False;
btnPlay.Enabled := false;
end
end;
 
procedure TDelphiXMidiEditForm.FormCreate(Sender: TObject);
begin
Tag := 0;
FPlaying := False;
end;
 
procedure TDelphiXMidiEditForm.SetPlaying(const Value: Boolean);
begin
if not Value then T.Stop;
FPlaying := Value;
end;
 
procedure TDelphiXMidiEditForm.btnPlayClick(Sender: TObject);
begin
FPlaying := True;
T.Play;
end;
 
procedure TDelphiXMidiEditForm.btnStopClick(Sender: TObject);
begin
if Playing then Playing := False;
end;
 
end.
/VCL_DELPHIX_D6/DXMisc.pas
0,0 → 1,409
unit DXMisc;
 
// Contains miscellaneous code
 
interface
 
uses classes, controls;
 
type
// This obtains the co-ords for the mouse relative to a control
TMousePos = class(Tobject)
private
{ Private declarations }
// Data
fControl: TControl;
 
fMouseX: integer;
fMouseY: integer;
fXDelta: integer;
fYDelta: integer;
// used to scale the mouse input
fSensitivity: Single;
// Options
fClipToControl: boolean;
protected
{ Protected declarations }
procedure SetClipState(Value: boolean);
public
{ Public declarations }
constructor Create(Control: TControl);
destructor Destroy; override;
// Sets the control to use
procedure SetControl(AControl: TControl);
// Grabs the latest mouse co-ords
procedure Update;
// Relative to the parent control
property MouseX: integer read fMouseX;
property MouseY: integer read fMouseY;
property XDelta: integer read fXDelta;
property YDelta: integer read fYDelta;
// The sensitivity of the mouse
property Sensitivity: Single read fSensitivity write fSensitivity;
property ClipToControl: Boolean read fClipToControl write SetClipState;
 
property Control: TControl read fControl write SetControl;
published
{ Published declarations }
end;
 
// This is an example of how to cap the frame rate
// this has NOT been optimized and is just to hide the relatively
// mess code needed to properly calc the time delta for a frame
// and the time delta since the last render
TTiming = class(TObject)
protected
{ Protected declarations }
// Used to implement frame capping
fGraphicsTimeDelta: longword;
LastTimeFrame: longword;
// the number of ms each frame has in its budget
FrameRateBudget: longword; // this is just for the graphics system
// see the properties section
fTimeDelta: longword;
 
TimeFrame: longword;
fFrameRate: longword;
fFrameRateGoal: longword;
 
fNoGraphics: boolean;
// sets up various timing stuff
procedure InitTiming(FrameRate: longword);
public
{ Public declarations }
constructor Create(AFrameRateGoal: longword);
// Calculates the time delta from the last frame
procedure CalcNewTimeDelta;
// Checks if the designated time till the next render has passed
function TimeToRender: boolean;
// Prepares internal info for the next frame
procedure UpdateGraphicsTimeDelta;
procedure CalcFrameRate;
 
property GraphicsTimeDelta: longword read fGraphicsTimeDelta;
// used to determine how much time has elapsed from the last frame in ms
property TimeDelta: longword read fTimeDelta;
// The timestamp for the current frame
property FrameStamp: longword read TimeFrame;
// The frame rate that is being achieved
property FrameRate: longword read fFrameRate;
// The goal frame rate for the frame skipping mechanism
// This also Limits the frame rate to this to
property FrameRateGoal: longword read fFrameRateGoal write InitTiming;
 
// TimeTorender always returns false, used to disable graphics stuff
property NoGraphics: boolean read fNoGraphics write fNoGraphics;
end;
 
TStateMachine = class;
 
TState = class(TObject) // a state aware class
private
fStateIndex: integer;
fStateMachine: TStateMachine;
public
constructor Create; virtual;
 
procedure Execute; virtual; abstract;
property StateIndex: integer read fStateIndex;
property StateMachine: TStateMachine read fStateMachine;
end;
 
// This is a state machine which removes the need for large case statements when executing the current state
TStateMachine = class(TObject)
private
{ Private declarations }
protected
{ Protected declarations }
// Holds a list of the valid states
fStatesList: Tlist;
// the number of states
fStates: integer;
// The max number of allowed states
fMaxStates: integer;
// The current state
fCurrentState: TState;
// Function GetState(index :integer) : TState; virtual;
public
{ Public declarations }
constructor Create;
destructor Destroy; override;
// This registers a state, if the state exists then it is updated
// Dont pass < 0 as the state constant
procedure AddState(State: TState); virtual;
// This removes a registerd state
procedure RemoveState(State: TState); virtual;
// This clears all the states
procedure ClearStates; virtual;
 
// allows easy state changes
procedure ActivateNextState; virtual;
// The current state's id
property CurrentState: TState read fCurrentState write fCurrentState;
 
// The Number of valid states
property States: integer read fStates;
property MaxStates: integer read fMaxStates write fMaxStates;
{
// Allows direct access to the states of an object
Property StateList[index :integer] : TState read GetState;
}
property StateList: Tlist read fStatesList;
end;
const
// This is the default strating number of states the TStateMachine will allocate
StartStates = 16; // This is also what it allocates when it tries to add a new state
MaxNumStates = 255; // this is the max number of states allowed. Why would you want more :)
 
// Scans a Component and the components owned by the Component for a Component of the class type 'Classtype'
function FindComponentType(Aowner: TComponent; Classtype: TComponentClass): TComponent;
 
implementation
 
uses windows, Sysutils, mmsystem;
 
function FindComponentType(Aowner: TComponent; Classtype: TComponentClass): TComponent;
var
index: integer;
begin
if not assigned(AOwner) then
begin
result := nil;
exit;
end;
if AOwner is Classtype then
begin
result := AOwner;
end
else
begin
// For some reason, when in the designer AOwner.ComponentIndex = -1!
// thus this search algo would failed in designer mode
for index := 0 to AOwner.ComponentCount - 1 do
begin
if AOwner.Components[index] is Classtype then
begin
result := AOwner.Components[index];
exit;
end;
end;
result := nil;
end;
end;
 
// -----------------------------------------------------------------------------
// TTiming
// -----------------------------------------------------------------------------
 
constructor TTiming.Create(AFrameRateGoal: longword);
begin
inherited create;
FrameRateGoal := AFrameRateGoal;
InitTiming(FrameRateGoal);
end; {TTiming}
 
procedure TTiming.InitTiming(FrameRate: longword);
begin
fFrameRateGoal := FrameRate;
FrameRateBudget := 1000 div fFrameRateGoal;
fGraphicsTimeDelta := 0;
fTimeDelta := 0;
TimeFrame := timegettime;
LastTimeFrame := TimeFrame;
end; {InitTiming}
 
procedure TTiming.CalcNewTimeDelta;
var
NewTimeFrame: Longword;
begin
// update the time delta & time frame stamps
NewTimeFrame := TimeGetTime;
fTimeDelta := NewTimeFrame - TimeFrame;
TimeFrame := NewTimeFrame;
end; {CalcNewTimeDelta}
 
procedure TTiming.UpdateGraphicsTimeDelta;
begin
// get how long it took to render the frame
LastTimeFrame := timegettime;
fGraphicsTimeDelta := 0;
end;
 
procedure TTiming.CalcFrameRate;
begin
if GraphicsTimeDelta <> 0 then
fFrameRate := 1000 div GraphicsTimeDelta
else
fFrameRate := 0;
end; {CalcFrameRate}
 
function TTiming.TimeToRender: boolean;
begin
// Check to see if we can update the screen
fGraphicsTimeDelta := Timegettime - LastTimeFrame;
result := (GraphicsTimeDelta >= FrameRateBudget) and (not fNoGraphics);
end; {TimeToRender}
 
// -----------------------------------------------------------------------------
// TMousePos
// -----------------------------------------------------------------------------
 
constructor TMousePos.Create(Control: TControl);
begin
inherited Create;
if not assigned(Control) then
raise Exception.Create('Parent can''''t = nil');
fSensitivity := 1.0;
fClipToControl := true;
SetControl(Control);
end; {Create}
 
destructor TMousePos.Destroy;
begin
SetControl(nil);
inherited;
end; {Destroy}
 
procedure TMousePos.SetControl(AControl: TControl);
begin
assert(self <> nil);
if assigned(AControl) then
begin
fControl := AControl;
// This gets the intitial value
Update;
// This gets the correct mouse X,Y deltas
Update;
end
else
begin
fControl := nil;
end;
end; {SetControl}
 
procedure TMousePos.SetClipState(Value: boolean);
begin
if fClipToControl <> value then
begin
fClipToControl := Value;
// Re-obtain the co-ords with the correct option
Update;
end;
end; {SetClipState}
 
procedure TMousePos.Update;
var
pos: TPoint;
begin
// Get the latest mouse info
pos := mouse.CursorPos;
// Convert them to relative to the Control
pos := fControl.ScreenToClient(pos);
if fClipToControl then
begin
if pos.x >= fControl.width then
pos.x := fControl.width - 1
else if pos.x < 0 then
pos.x := 0;
if pos.Y >= fControl.Height then
pos.Y := fControl.Height - 1
else if pos.Y < 0 then
pos.Y := 0;
end;
// Update the mouse delta's
// fmouse? = old mouse pos
// pos.? = new mouse pos
fXDelta := pos.X - fMouseX;
fYDelta := pos.Y - fMouseY;
// Scale the mouse co-ords
if fSensitivity - 1.0 > 0.00001 then
begin
fMouseX := fMouseX + Trunc(fXDelta * fSensitivity);
fMouseY := fMouseY + Trunc(fYDelta * fSensitivity);
end
else
begin
fMouseX := pos.X;
fMouseY := pos.Y;
end;
end; {Update}
 
// -----------------------------------------------------------------------------
// TStateMachine
// -----------------------------------------------------------------------------
 
constructor TStateMachine.Create;
begin
inherited;
fMaxStates := MaxNumStates;
fStatesList := Tlist.create;
end; {Create}
 
destructor TStateMachine.Destroy;
begin
ClearStates;
fStatesList.free;
inherited;
end; {Destroy}
 
procedure TStateMachine.AddState(State: TState);
begin
if (fStatesList.IndexOf(State) = -1) and
(fStates < MaxStates) then
begin
State.fStateIndex := fStatesList.add(State);
State.fStateMachine := self;
if fCurrentState = nil then
fCurrentState := state;
inc(fStates);
end;
end; {AddState}
 
procedure TStateMachine.RemoveState(State: TState);
var
index: integer;
begin
index := fStatesList.IndexOf(State);
if (index <> -1) then
begin
if fCurrentState = state then
fCurrentState := nil;
fStatesList.Delete(index);
Dec(fStates);
end;
end; {RemoveState}
 
procedure TStateMachine.ClearStates;
var
state: Tstate;
begin
while fStatesList.count <> 0 do
begin
state := fStatesList.Items[fStatesList.count - 1];
state.free;
fStatesList.Delete(fStatesList.count - 1);
end;
end; {ClearStates}
 
procedure TStateMachine.ActivateNextState;
var
index: integer;
begin
if fStatesList.count = 0 then
exit;
if fCurrentState = nil then
fCurrentState := fStatesList[0];
index := fCurrentState.StateIndex;
inc(index);
if index >= fStatesList.count - 1 then
index := 0;
fCurrentState := Tstate(fStatesList[index]);
end; {ActivateNextState}
 
constructor Tstate.Create;
begin
inherited Create;
end; {Create}
 
end.
/VCL_DELPHIX_D6/DXPictEdit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DXPlay.pas
5,9 → 5,23
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, SysUtils, Classes, Forms, DXClass, ActiveX, DirectX, DXETable;
Windows, SysUtils, Classes, Forms, DXClass, ActiveX, DXETable,
{$IfDef StandardDX}
DirectDraw,
// Delphi 2010 cannot be use DirectPlay8 because structure was not rewriten
// {$IfDef DX9}
// DirectPlay8, DX7toDX8;
// {$Else}
DirectPlay; //old wersion, current in directory
// {$EndIf}
{$Else}
DirectX;
{$EndIf}
type
{$IfDef DX9}
TDPID = DWORD;
{$EndIf}
 
{ TDXPlayPlayer }
 
88,7 → 102,8
 
TCustomDXPlay = class(TComponent)
private
FDPlay: IDirectPlay4A;
FDPlay: //{$IfDef DX7}
IDirectPlay4A;//{$Else}IDirectPlay8Address{$EndIf};
FGUID: string;
FIsHost: Boolean;
FLocalPlayer: TDXPlayPlayer;
116,7 → 131,11
FAsync: Boolean;
FAsyncSupported: Boolean;
procedure ChangeDPlay;
procedure CreateDPlayWithoutDialog(out DPlay: IDirectPlay4A; const ProviderName: string);
procedure CreateDPlayWithoutDialog(out DPlay:
//{$IfDef DX7}
IDirectPlay4A;
//{$Else}IDirectPlay8Address{$EndIf};
const ProviderName: string);
function OpenDPlayWithLobby(out Name: string): Boolean;
function OpenDPlayWithoutLobby(out Name: string): Boolean;
function OpenDPlayWithoutLobby2(const NewSession: Boolean; const ProviderName, SessionName, PlayerName: string): Boolean;
191,7 → 210,10
function DXPlayMessageType(P: Pointer): DWORD;
 
function DXPlayStringToGUID(const S: string): TGUID;
function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP: IDirectPlay;
function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
//{$IfDef DX7}
IDirectPlay;
//{$Else}IDirectPlay8Server{$EndIf};
pUnk: IUnknown): HRESULT;
 
implementation
224,7 → 246,10
CoTaskMemFree(P);
end;
 
function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP: IDirectPlay;
function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
//{$IfDef DX7}
IDirectPlay;
//{$Else}IDirectPlay8Server{$EndIf};
pUnk: IUnknown): HRESULT;
type
TDirectPlayCreate= function(const lpGUID: TGUID; out lplpDP: IDirectPlay; pUnk: IUnknown): HRESULT; stdcall;
232,9 → 257,27
Result := TDirectPlayCreate(DXLoadLibrary('DPlayX.dll', 'DirectPlayCreate'))
(lpGUID, lplpDP, pUnk);
end;
{$IFDEF UNICODE}
function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT;
type
TDirectPlayEnumerateW= function(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT; stdcall;
begin
Result := TDirectPlayEnumerateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateW'))
(lpEnumDPCallback, lpContext);
end;
 
function DXDirectPlayEnumerateA(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT;
function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
type
TDirectPlayLobbyCreateW = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
begin
Result := TDirectPlayLobbyCreateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateW'))
(lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
end;
{$ELSE}
function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT;
type
TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;
begin
Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))
241,7 → 284,7
(lpEnumDPCallback, lpContext);
end;
 
function DXDirectPlayLobbyCreateA(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
type
TDirectPlayLobbyCreateA = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
250,7 → 293,7
Result := TDirectPlayLobbyCreateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateA'))
(lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
end;
 
{$ENDIF}
{ TDXPlayPlayers }
 
constructor TDXPlayPlayers.Create;
316,10 → 359,16
end;
 
var
{$IFDEF UNICODE}
Lobby1: IDirectPlayLobbyW;
Lobby: IDirectPlayLobby2W;
DPlay: IDirectPlay4W;
{$ELSE}
Lobby1: IDirectPlayLobbyA;
Lobby: IDirectPlayLobby2A;
DPlay: IDirectPlay4A;
{$ENDIF}
DPlay1: IDirectPlay;
DPlay: IDirectPlay4A;
lpAddress: Pointer;
dwAddressSize: DWORD;
begin
327,16 → 376,16
begin
FModemNames := TStringList.Create;
try
if DXDirectPlayLobbyCreateA(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
Lobby := Lobby1 as IDirectPlayLobby2A;
Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
 
if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then
raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
DPlay := DPlay1 as IDirectPlay4A;
DPlay := DPlay1 as {$IFDEF UNICODE}IDirectPlay4W{$ELSE}IDirectPlay4A{$ENDIF};
 
{ get size of player address for all players }
if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil^, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
 
GetMem(lpAddress, dwAddressSize);
344,7 → 393,7
FillChar(lpAddress^, dwAddressSize, 0);
 
{ get the address }
if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress^, dwAddressSize)<>0 then
if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress, dwAddressSize)<>0 then
raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
 
{ get modem strings from address and put them in the combo box }
470,12 → 519,12
 
try
repeat
hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer^, dwMsgBufferSize);
hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
 
if hr=DPERR_BUFFERTOOSMALL then
begin
ReAllocMem(lpvMsgBuffer, dwMsgBufferSize);
hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer^, dwMsgBufferSize);
hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
end;
 
if (hr=0) and (dwMsgBufferSize>=SizeOf(TDPMSG_GENERIC)) then
497,8 → 546,13
 
with Msg_CreatePlayerOrGroup.dpnName do
begin
{$IFDEF UNICODE}
if lpszShortNameW<>nil then
Player.FName := lpszShortNameW;
{$ELSE}
if lpszShortNameA<>nil then
Player.FName := lpszShortNameA;
{$ENDIF}
end;
 
DoAddPlayer(Player);
604,7 → 658,7
 
function TCustomDXPlay.GetProviders: TStrings;
 
function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: LPSTR;
function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPSTR{$ENDIF};
dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer):
BOOL; stdcall;
var
621,7 → 675,7
begin
FProviders := TStringList.Create;
try
DXDirectPlayEnumerateA(@EnumProviderCallback, FProviders);
DXDirectPlayEnumerate(@EnumProviderCallback, FProviders);
except
FProviders.Free; FProviders := nil;
raise;
646,8 → 700,11
 
Guid := New(PGUID);
Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
{$IFDEF UNICODE}
TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameW, TObject(Guid));
{$ELSE}
TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameA, TObject(Guid));
 
{$ENDIF}
Result := True;
end;
 
698,8 → 755,13
ProviderGUID: TGUID;
addressElements: array[0..15] of TDPCompoundAddressElement;
dwElementCount: Integer;
{$IFDEF UNICODE}
Lobby1: IDirectPlayLobbyW;
Lobby: IDirectPlayLobby2W;
{$ELSE}
Lobby1: IDirectPlayLobbyA;
Lobby: IDirectPlayLobby2A;
{$ENDIF}
lpAddress: Pointer;
dwAddressSize: DWORD;
begin
709,9 → 771,9
ProviderGUID := PGUID(Providers.Objects[i])^;
 
{ DirectPlay address making }
if DXDirectPlayLobbyCreateA(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
Lobby := Lobby1 as IDirectPlayLobby2A;
Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
 
FillChar(addressElements, SizeOf(addressElements), 0);
dwElementCount := 0;
760,7 → 822,7
end;
end;
 
if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil^, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
 
GetMem(lpAddress, dwAddressSize);
767,7 → 829,7
try
FillChar(lpAddress^, dwAddressSize, 0);
 
if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress^, dwAddressSize)<>0 then
if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress, dwAddressSize)<>0 then
raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
 
{ DirectPlay initialization }
837,8 → 899,13
 
with lpName do
begin
{$IFDEF UNICODE}
if lpszShortNameW<>nil then
Player.FName := lpszShortNameW;
{$ELSE}
if lpszShortNameA<>nil then
Player.FName := lpszShortNameA;
{$ENDIF}
end;
 
Result := True;
862,11 → 929,11
FLocalPlayer := TDXPlayPlayer.Create(FPlayers);
FLocalPlayer.FName := NameS;
 
if FDPlay.CreatePlayer(FLocalPlayer.FID, Name, FRecvEvent[0], nil^, 0, 0)<>DP_OK then
if FDPlay.CreatePlayer(FLocalPlayer.FID, @Name, FRecvEvent[0], nil, 0, 0)<>DP_OK then
raise EDXPlayError.CreateFmt(SCannotOpened, [FSessionName]);
 
{ Player enumeration }
FDPlay.EnumPlayers(PGUID(nil)^, @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
FDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
 
FIsHost := FPlayers.Count=1;
 
900,21 → 967,25
function TCustomDXPlay.OpenDPlayWithLobby(out Name: string): Boolean;
var
DPlay1: IDirectPlay2;
{$IFDEF UNICODE}
Lobby: IDirectPlayLobbyW;
{$ELSE}
Lobby: IDirectPlayLobbyA;
{$ENDIF}
dwSize: DWORD;
ConnectionSettings: PDPLConnection;
begin
Result := False;
 
if DXDirectPlayLobbyCreateA(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
Exit;
 
if Lobby.GetConnectionSettings(0, PDPLConnection(nil)^, dwSize)<>DPERR_BUFFERTOOSMALL then
if Lobby.GetConnectionSettings(0, PDPLConnection(nil), dwSize)<>DPERR_BUFFERTOOSMALL then
Exit;
 
GetMem(ConnectionSettings, dwSize);
try
if Lobby.GetConnectionSettings(0, ConnectionSettings^, dwSize)<>0 then
if Lobby.GetConnectionSettings(0, ConnectionSettings, dwSize)<>0 then
Exit;
 
with ConnectionSettings^.lpSessionDesc^ do
933,14 → 1004,24
 
with ConnectionSettings.lpSessionDesc^ do
begin
{$IFDEF UNICODE}
if lpszSessionNameW<>nil then
FSessionName := lpszSessionNameW;
{$ELSE}
if lpszSessionNameA<>nil then
FSessionName := lpszSessionNameA;
{$ENDIF}
end;
 
with ConnectionSettings.lpPlayerName^ do
begin
{$IFDEF UNICODE}
if lpszShortNameW<>nil then
Name := lpszShortNameW;
{$ELSE}
if lpszShortNameA<>nil then
Name := lpszShortNameA;
{$ENDIF}
end;
finally
FreeMem(ConnectionSettings);
995,7 → 1076,11
FillChar(dpDesc, SizeOf(dpDesc), 0);
dpDesc.dwSize := SizeOf(dpDesc);
dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;
dpDesc.lpszSessionNameA := PChar(SessionName);
{$IFDEF UNICODE}
dpDesc.lpszSessionNameW := {$IFDEF VER12UP}PChar{$ELSE}PWideChar{$ENDIF}(SessionName);
{$ELSE}
dpDesc.lpszSessionNameA := PAnsiChar(SessionName);
{$ENDIF}
dpDesc.guidApplication := DXPlayStringToGUID(GUID);
dpDesc.dwMaxPlayers := MaxPlayers;
 
1079,7 → 1164,7
DoMessage(FLocalPlayer, Data, DataSize);
end else
if FAsync and FAsyncSupported then
FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data^, DataSize, 0, 0, nil, nil)
FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data, DataSize, 0, 0, nil, nil)
else
FDPlay.Send(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED, Data^, DataSize);
end;
1098,7 → 1183,7
{ Ž©•ªˆ¶‚̃ƒbƒZ[ƒW }
DoMessage(FLocalPlayer, Data, DataSize);
end else
FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data^, DataSize,
FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data, DataSize,
0, 0, nil, @Result); // 0 ˆÈŠO‚̓Tƒ|[ƒg‚µ‚È‚¢ƒfƒoƒCƒX‚ ‚é‚Ì‚ÅŽg‚í‚È‚¢
end;
 
/VCL_DELPHIX_D6/DXPlayFm.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DXPlayFm.pas
1,10 → 1,15
unit DXPlayFm;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, DirectX, DXPlay, ActiveX, DXETable, DIB;
StdCtrls, ExtCtrls, DXPlay, ActiveX, DXETable, DIB,
{$IfDef StandardDX}
DirectDraw, DirectPlay;
{$Else}
DirectX;
{$EndIf}
 
type
TDelphiXDXPlayForm = class(TForm)
54,7 → 59,9
private
FProviderGUID: TGUID;
public
DPlay: IDirectPlay4A;
DPlay: //{$IfDef DX7}
IDirectPlay4A;
//{$Else}IDirectPlay8Address{$EndIf};
DXPlay: TCustomDXPlay;
PlayerName: string;
ProviderName: string;
104,12 → 111,15
 
procedure InitDirectPlay;
var
DPlay1: IDirectPlay;
DPlay1: //{$IfDef DX7}
IDirectPlay;
//{$Else}IDirectPlay8Server{$EndIf};
begin
if DXDirectPlayCreate(FProviderGUID, DPlay1, nil)<>0 then
raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
 
DPlay := DPlay1 as IDirectPlay4A;
DPlay := DPlay1 as //{$IfDef DX7}
IDirectPlay4A//{$Else}IDirectPlay8Address{$EndIf}
end;
 
function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;
125,8 → 135,11
 
Guid := New(PGUID);
Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
{$IFDEF UNICODE}
TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameW, Pointer(Guid));
{$ELSE}
TDelphiXDXPlayForm(lpContext).JoinGameSessionList.Items.AddObject(lpThisSD.lpszSessionNameA, Pointer(Guid));
 
{$ENDIF}
Result := True;
end;
 
232,7 → 245,11
with lpName do
begin
if lpszShortNameA<>nil then
{$IFDEF UNICODE}
TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameW);
{$ELSE}
TDelphiXDXPlayForm(lpContext).JoinGamePlayerList.Items.Add(lpszShortNameA);
{$ENDIF}
end;
 
Result := True;
264,7 → 281,7
hr := TempDPlay.Open(dpDesc, DPOPEN_JOIN);
if hr<>0 then Exit;
try
TempDPlay.EnumPlayers(PGUID(nil)^, @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
TempDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
finally
TempDPlay.Close;
end;
/VCL_DELPHIX_D6/DXReg.pas
1,43 → 1,245
unit DXReg;
 
 
interface
 
{$I DelphiXcfg.inc}
 
uses
Windows, SysUtils, Classes, Forms, Dialogs, Graphics, TypInfo,
DXDraws, DXSounds, DIB, Wave, DXInput, DXPlay, DXSprite,
DXClass;
Controls, StdCtrls, ExtCtrls, Buttons,
{$IFDEF D3DRM}Colli3DX, {$ENDIF}
{$IFNDEF VER6UP}DsgnIntf,
{$ELSE}Designintf, DesignEditors, VCLEditors, PropertyCategories,
{$ENDIF}
DXDraws, DXSounds, DIB, DXWave, DXInput, DXPlay, DXSprite, DXClass;
 
type
 
{ TDXDrawDisplayProperty }
 
TDXDrawDisplayProperty = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure GetValues(Proc: TGetStrProc); override;
procedure SetValue(const Value: string); override;
end;
 
{ TDIBProperty }
 
TDIBProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetValue: string; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
{ TDXDIBEditor }
 
TDXDIBEditor = class(TComponentEditor)
public
procedure Edit; override;
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ TPictureCollectionItem_PictureProperty }
 
TPictureCollectionItem_PictureProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetValue: string; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
{ TDXImageListEditor }
 
TDXImageListEditor = class(TComponentEditor)
private
procedure ListBox1DblClick(Sender: TObject);
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ TDXSpriteEngineEditor}
 
TDXSpriteEngineEditor = class(TComponentEditor)
private
procedure ListBox1DblClick(Sender: TObject);
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ TWaveProperty }
 
TWaveProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetValue: string; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
{ TDXWaveEditor }
 
TDXWaveEditor = class(TComponentEditor)
public
procedure Edit; override;
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ TDXWaveListEditor }
 
TDXWaveListEditor = class(TComponentEditor)
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ TForceFeedbackEffectsProperty }
 
TForceFeedbackEffectsProperty = class(TClassProperty)
public
procedure Edit; override;
function GetValue: string; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
{ TDXInputEditor }
 
TDXInputEditor = class(TComponentEditor)
public
procedure Edit; override;
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ TGUIDProperty }
 
TGUIDProperty = class(TStringProperty)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
{ TSpriteProperty }
 
TSpriteProperty = class(TClassProperty)
public
procedure Edit; override;
function GetValue: string; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
{ TMidiProperty }
 
TMidiProperty = class(TClassProperty)
public
procedure Edit; override;
function GetValue: string; override;
function GetAttributes: TPropertyAttributes; override;
end;
 
TMidiEditor = class(TDefaultEditor)
public
{$IFDEF VER6UP}
procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override;
{$ELSE}
procedure EditProperty(PropertyEditor: TPropertyEditor;
var continue, FreeEditor: Boolean); override;
{$ENDIF}
end;
 
{ TDXMidiListEditor }
 
TDXMidiListEditor = class(TComponentEditor)
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
{ Trace editor}
 
TDXDrawEditor = class(TComponentEditor)
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
procedure Register;
 
 
implementation
 
uses DXPictEdit, DXWaveEdit, DXFFBEdit, DXInptEdit, DXGUIDEdit, DXSpriteEdit,
DXMidiEdit, DXDIBEffectEdit, {$IFDEF VER4UP}DXGlueItEdit,{$ENDIF} DXPathEdit;
 
const
SNone = '(None)';
 
SSettingImage = '&Image...';
SSettingWave = '&Wave...';
SDXGFileFilter = 'DXG file(*.dxg)|*.dxg|All files(*.*)|*.*';
SDXGOpenFileFilter = 'DXG file(*.dxg)|*.dxg|Bitmap file(*.bmp)|*.bmp|All files(*.*)|*.*';
SDXWFileFilter = 'DXW file(*.dxw)|*.dxw|All files(*.*)|*.*';
SDXWFileFilter = 'DXW file(*.dxw)|*.dxg|All files(*.*)|*.*';
SDXWOpenFileFilter = 'DXW file(*.dxw)|*.dxw|Wave file(*.wav)|*.wav|All files(*.*)|*.*';
SDXMFileFilter = 'DXM file(*.dxm)|*.dxm|All files(*.*)|*.*';
SDXMOpenFileFilter = 'DXM file(*.dxm)|*.dxm|Midi file(*.mid)|*.mid|All files(*.*)|*.*';
 
SSinglePlayer = '&Single player';
SMultiPlayer1 = 'Multi player &1';
SMultiPlayer2 = 'Multi player &2';
 
SOpen = '&Open...';
SSave = '&Save..';
SSave = '&Save...';
 
procedure Register;
begin
RegisterPropertyEditor(TypeInfo(TDXDrawDisplay), nil, '',
TDXDrawDisplayProperty);
 
RegisterPropertyEditor(TypeInfo(TDIB), nil, '', TDIBProperty);
RegisterComponentEditor(TCustomDXDIB, TDXDIBEditor);
 
RegisterPropertyEditor(TypeInfo(TPicture), TPictureCollectionItem, 'Picture', TPictureCollectionItem_PictureProperty);
RegisterComponentEditor(TCustomDXImageList, TDXImageListEditor);
 
RegisterPropertyEditor(TypeInfo(TWave), nil, '', TWaveProperty);
RegisterComponentEditor(TCustomDXWave, TDXWaveEditor);
 
RegisterComponentEditor(TCustomDXWaveList, TDXWaveListEditor);
 
RegisterPropertyEditor(TypeInfo(TForceFeedbackEffects), nil, '', TForceFeedbackEffectsProperty);
 
RegisterComponentEditor(TCustomDXInput, TDXInputEditor);
 
RegisterPropertyEditor(TypeInfo(string), TCustomDXPlay, 'GUID', TGUIDProperty);
 
RegisterPropertyEditor(TypeInfo(TImageSprite), NIL, '', TSpriteProperty);
RegisterPropertyEditor(TypeInfo(TImageSpriteEx), NIL, '', TSpriteProperty);
RegisterPropertyEditor(TypeInfo(TSprite), NIL, '', TSpriteProperty);
RegisterPropertyEditor(TypeInfo(TBackgroundSprite), NIL, '', TSpriteProperty);
 
RegisterPropertyEditor(TypeInfo(TMusicDataProp), nil, 'MIDI', TMidiProperty);
RegisterComponentEditor(TDXMusic, TDXMidiListEditor);
RegisterComponentEditor(TDXSpriteEngine, TDXSpriteEngineEditor);
 
RegisterComponents('DelphiX',
[TDXDraw,
TDXDIB,
TDXImageList,
{$IFDEF DX3D_deprecated}
TDX3D,
{$ENDIF}
TDXSound,
TDXWave,
TDXWaveList,
45,9 → 247,1052
TDXPlay,
TDXSpriteEngine,
TDXTimer,
TDXPaintBox]);
TDXPaintBox,
TDXFont,
TDXPowerFont,
TDXMusic
]);
RegisterComponentEditor(TCustomDXDraw, TDXDrawEditor);
end;
 
end.
{ TDXDrawDisplayProperty }
 
function TDXDrawDisplayProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paValueList] - [paReadOnly];
end;
 
const
SDisplayMode = '%dx%dx%d';
 
function TDXDrawDisplayProperty.GetValue: string;
begin
with TDXDrawDisplay(GetOrdValue) do
Result := Format(SDisplayMode, [Width, Height, BitCount]);
end;
 
procedure TDXDrawDisplayProperty.GetValues(Proc: TGetStrProc);
const
List: array[0..2] of TPoint = (
(X: 640; Y: 480),
(X: 800; Y: 600),
(X: 1024; Y: 768));
var
BitCount, i: Integer;
begin
for i := Low(List) to High(List) do
for BitCount := 1 to 3 do
Proc(Format(SDisplayMode, [List[i].x, List[i].y, BitCount * 8]));
end;
 
procedure TDXDrawDisplayProperty.SetValue(const Value: string);
var
s: string;
i, AWidth, AHeight, ABitCount: Integer;
begin
s := Value;
 
i := Pos('x', s);
AWidth := StrToInt(Copy(s, 1, i - 1));
s := Copy(s, i + 1, Length(s));
 
i := Pos('x', s);
AHeight := StrToInt(Copy(s, 1, i - 1));
s := Copy(s, i + 1, Length(s));
 
ABitCount := StrToInt(s);
 
with TDXDrawDisplay(GetOrdValue) do
begin
Width := AWidth;
Height := AHeight;
BitCount := ABitCount;
end;
 
SetOrdValue(GetOrdValue);
end;
 
{ TDIBProperty }
 
procedure TDIBProperty.Edit;
var
Form: TDelphiXPictureEditForm;
begin
Form := TDelphiXPictureEditForm.Create(nil);
try
Form.ViewBox.Picture.Assign(TDIB(GetOrdValue));
Form.DIBClassOnly := True;
Form.ShowModal;
if Form.Tag <> 0 then
begin
SetOrdValue(Integer(Form.ViewBox.Picture.Graphic));
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
function TDIBProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
 
function TDIBProperty.GetValue: string;
begin
if TDIB(GetOrdValue).Size = 0 then
Result := SNone
else
Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
end;
 
{ TDXDIBEditor }
 
procedure TDXDIBEditor.Edit;
var
Form: TDelphiXPictureEditForm;
begin
Form := TDelphiXPictureEditForm.Create(nil);
try
Form.ViewBox.Picture.Assign(TCustomDXDIB(Component).DIB);
Form.DIBClassOnly := True;
Form.ShowModal;
if Form.Tag <> 0 then
begin
TCustomDXDIB(Component).DIB.Assign(TGraphic(Form.ViewBox.Picture.Graphic));
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
procedure TDXDIBEditor.ExecuteVerb(Index: Integer);
begin
case Index of
0: Edit;
end;
end;
 
function TDXDIBEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := SSettingImage;
end;
end;
 
function TDXDIBEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
 
{ TPictureCollectionItem_PictureProperty }
 
procedure TPictureCollectionItem_PictureProperty.Edit;
var
Form: TDelphiXPictureEditForm;
Item: TPictureCollectionItem;
TempDIB: TDIB;
begin
Form := TDelphiXPictureEditForm.Create(nil);
try
Form.ViewBox.Picture := TPicture(GetOrdValue);
Form.ShowModal;
if Form.Tag <> 0 then
begin
SetOrdValue(Integer(Form.ViewBox.Picture));
 
Item := GetComponent(0) as TPictureCollectionItem;
if Item.Picture.Graphic <> nil then
begin
TempDIB := TDIB.Create;
try
TempDIB.SetSize(1, 1, 24);
TempDIB.Canvas.Draw(0, 0, Item.Picture.Graphic);
Item.TransparentColor := TempDIB.Pixels[0, 0];
finally
TempDIB.Free;
end;
end;
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
function TPictureCollectionItem_PictureProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
 
function TPictureCollectionItem_PictureProperty.GetValue: string;
begin
if (TPicture(GetOrdValue).Graphic = nil) or (TPicture(GetOrdValue).Graphic.Empty) then
Result := SNone
else
Result := Format('(%s)', [TPicture(GetOrdValue).Graphic.ClassName]);
end;
 
{ dialog }
function CreateListBox(DblClck: TNotifyEvent; out lstbx: TListBox): TForm;
var
Panel1: TPanel;
Panel2: TPanel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
begin
Result := TForm.Create(nil);
Panel1 := TPanel.Create(Result);
lstbx := TListBox.Create(Result);
Panel2 := TPanel.Create(Result);
BitBtn1 := TBitBtn.Create(Result);
BitBtn2 := TBitBtn.Create(Result);
with Result do
begin
Name := 'Form12';
Left := 0;
Top := 0;
BorderStyle := bsDialog;
Caption := 'Select Item';
ClientHeight := 206;
ClientWidth := 228;
Color := clBtnFace;
Font.Charset := DEFAULT_CHARSET;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'Tahoma';
Font.Style := [];
Position := poScreenCenter;
PixelsPerInch := 96;
end;
with Panel1 do
begin
Name := 'Panel1';
Parent := Result;
Left := 0;
Top := 0;
Width := 228;
Height := 165;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 4;
Caption := '';
TabOrder := 0;
end;
with lstbx do
begin
Name := 'ListBox1';
Parent := Panel1;
Left := 4;
Top := 4;
Width := 220;
Height := 157;
Align := alClient;
ItemHeight := 13;
TabOrder := 0;
OnDblClick := DblClck;
end;
with Panel2 do
begin
Name := 'Panel2';
Parent := Result;
Left := 0;
Top := 165;
Width := 228;
Height := 41;
Align := alBottom;
BevelOuter := bvNone;
Caption := '';
TabOrder := 1;
end;
with BitBtn1 do
begin
Name := 'BitBtn1';
Parent := Panel2;
Left := 24;
Top := 8;
Width := 75;
Height := 25;
TabOrder := 0;
Kind := bkOK;
end;
with BitBtn2 do
begin
Name := 'BitBtn2';
Parent := Panel2;
Left := 128;
Top := 8;
Width := 75;
Height := 25;
TabOrder := 1;
Kind := bkCancel;
end;
end;
function Alter(const str, altstr: string): string;
begin
if str = '' then Result := altstr
else Result := str;
end;
 
{ TDXImageListEditor }
 
procedure TDXImageListEditor.ExecuteVerb(Index: Integer);
var
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
DelphiXDIBEffectEditForm: TTDelphiXDIBEffectEditForm;
{$IFDEF VER4UP}
DXGlueItEditForm: TDXGlueItEditor;
{$ENDIF}
Q: TPictureCollectionItem;
I, N: Integer;
S, Z: string;
{$IFDEF VER4UP}
QQ: TCustomDXImageList;
FrmListBox: TForm;
ListBox1: TListBox;
{$ENDIF}
begin
case Index of
0: begin
OpenDialog := TOpenDialog.Create(nil);
try
OpenDialog.DefaultExt := 'dxg';
OpenDialog.Filter := SDXGOpenFileFilter;
OpenDialog.Options := [ofPathMustExist, ofFileMustExist, ofAllowMultiSelect];
if OpenDialog.Execute then
begin
if OpenDialog.FilterIndex = 2 then
begin
for i := 0 to OpenDialog.Files.Count - 1 do
with TPictureCollectionItem.Create(TCustomDXImageList(Component).Items) do
begin
try
Picture.LoadFromFile(OpenDialog.Files[i]);
Name := ExtractFileName(OpenDialog.Files[i]);
except
Free;
raise;
end;
end;
end else
TCustomDXImageList(Component).Items.LoadFromFile(OpenDialog.FileName);
Designer.Modified;
end;
finally
OpenDialog.Free;
end;
end;
1: begin
SaveDialog := TSaveDialog.Create(nil);
try
SaveDialog.DefaultExt := 'dxg';
SaveDialog.Filter := SDXGFileFilter;
SaveDialog.Options := [ofOverwritePrompt, ofPathMustExist];
if SaveDialog.Execute then
TCustomDXImageList(Component).Items.SaveToFile(SaveDialog.FileName);
finally
SaveDialog.Free;
end;
end;
2:
begin {Create shine effect...}
{special effect}
DelphiXDIBEffectEditForm := TTDelphiXDIBEffectEditForm.Create(nil);
try
DelphiXDIBEffectEditForm.ShowModal;
if DelphiXDIBEffectEditForm.Tag = 1 then begin
{check all names in list of images}
N := 0;
Z := DelphiXDIBEffectEditForm.eName.Text; S := Z;
I := TCustomDXImageList(Component).Items.IndexOf(Z);
{hleda jmeno}
while I <> -1 do begin
S := Format('%s_%d', [Z, N]); {new name}
I := TCustomDXImageList(Component).Items.IndexOf(S);
Inc(N);
end;
{add item}
Q := TPictureCollectionItem(TCustomDXImageList(Component).Items.Add);
Q.Picture.Assign(DelphiXDIBEffectEditForm.ResultDIB);
Q.Name := S; {it has to name!}
Q.Transparent := False; {transparend will be set in future}
Designer.Modified;
end;
finally
DelphiXDIBEffectEditForm.Free;
end;
end;
{$IFDEF VER4UP}
3: {Glue-it editor}
begin
DXGlueItEditForm := TDXGlueItEditor.Create(nil);
try
QQ := TCustomDXImageList(Component); Q := nil;
 
if QQ.Items.Count > 0 then begin
FrmListBox := CreateListBox(ListBox1DblClick, ListBox1);
try
for I := 0 to QQ.Items.Count - 1 do begin
S := QQ.Items[I].Name;
ListBox1.Items.Add(Alter(S, '(unnamed).' + IntToStr(I)));
end;
 
case FrmListBox.ShowModal of
mrOk: //when select one
begin
//when image selected
if ListBox1.ItemIndex <> -1 then begin
Q := QQ.Items[ListBox1.ItemIndex];
//load one image into editor
DXGlueItEditForm.LoadImageFromList(Q.Name, Q.Picture, Q.Width,
Q.Height, Q.Transparent, Q.TransparentColor);
//image loadet, noe se up edit mode
DXGlueItEditForm.Operation := ogiEdit;
end;
end;
mrCancel: DXGlueItEditForm.Operation := ogiNew;
else
Exit
end {case};
finally
FrmListBox.Free;
end;
end
else
DXGlueItEditForm.Operation := ogiNew;
DXGlueItEditForm.ShowModal;
if DXGlueItEditForm.Tag = 1 then begin
//when image as new. it has to create new item
if DXGlueItEditForm.Operation = ogiNew then
Q := TPictureCollectionItem(TCustomDXImageList(Component).Items.Add);
//and store edited image into
if Assigned(Q) then
DXGlueItEditForm.SaveImageIntoList(Q);
//signal to designer that anything was changed;
Designer.Modified;
end;
finally
DXGlueItEditForm.Free;
end;
end;
{$ENDIF}
end;
end;
 
function TDXImageListEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := SOpen;
1: Result := SSave;
2: Result := 'Shine effect...';
{$IFDEF VER4UP}
//fix bug by Pásztor Károly [fenistil@hu.hu]
3: Result := 'Glue it...';
{$ENDIF}
end;
end;
 
function TDXImageListEditor.GetVerbCount: Integer;
begin
Result := {$IFDEF VER4UP}4{$ELSE}3{$ENDIF};
end;
 
procedure TDXImageListEditor.ListBox1DblClick(Sender: TObject);
begin
if Sender is TListBox then with (Sender as TListBox) do
if ItemIndex <> -1 then
(Owner as TForm).ModalResult := mrOk;
end;
 
{ TWaveProperty }
 
procedure TWaveProperty.Edit;
var
Form: TDelphiXWaveEditForm;
begin
Form := TDelphiXWaveEditForm.Create(nil);
try
Form.Wave := TWave(GetOrdValue);
Form.ShowModal;
if Form.Tag <> 0 then
begin
SetOrdValue(Integer(Form.Wave));
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
function TWaveProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
 
function TWaveProperty.GetValue: string;
begin
if TWave(GetOrdValue).Size = 0 then
Result := SNone
else
Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
end;
 
{ TDXWaveEditor }
 
procedure TDXWaveEditor.Edit;
var
Form: TDelphiXWaveEditForm;
begin
Form := TDelphiXWaveEditForm.Create(nil);
try
Form.Wave := TCustomDXWave(Component).Wave;
Form.ShowModal;
if Form.Tag <> 0 then
begin
TCustomDXWave(Component).Wave := Form.Wave;
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
procedure TDXWaveEditor.ExecuteVerb(Index: Integer);
begin
case Index of
0: Edit;
end;
end;
 
function TDXWaveEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := SSettingWave;
end;
end;
 
function TDXWaveEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
 
{ TDXWaveListEditor }
 
procedure TDXWaveListEditor.ExecuteVerb(Index: Integer);
var
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
i: Integer;
begin
case Index of
0: begin
OpenDialog := TOpenDialog.Create(nil);
try
OpenDialog.DefaultExt := 'dxw';
OpenDialog.Filter := SDXWOpenFileFilter;
OpenDialog.Options := [ofPathMustExist, ofFileMustExist, ofAllowMultiSelect];
if OpenDialog.Execute then
begin
if OpenDialog.FilterIndex = 2 then
begin
for i := 0 to OpenDialog.Files.Count - 1 do
with TWaveCollectionItem.Create(TCustomDXWaveList(Component).Items) do
begin
try
Wave.LoadFromFile(OpenDialog.Files[i]);
Name := ExtractFileName(OpenDialog.Files[i]);
except
Free;
raise;
end;
end;
end else
TCustomDXWaveList(Component).Items.LoadFromFile(OpenDialog.FileName);
Designer.Modified;
end;
finally
OpenDialog.Free;
end;
end;
1: begin
SaveDialog := TSaveDialog.Create(nil);
try
SaveDialog.DefaultExt := 'dxw';
SaveDialog.Filter := SDXWFileFilter;
SaveDialog.Options := [ofOverwritePrompt, ofPathMustExist];
if SaveDialog.Execute then
TCustomDXWaveList(Component).Items.SaveToFile(SaveDialog.FileName);
finally
SaveDialog.Free;
end;
end;
end;
end;
 
function TDXWaveListEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := SOpen;
1: Result := SSave;
end;
end;
 
function TDXWaveListEditor.GetVerbCount: Integer;
begin
Result := 2;
end;
 
{ TForceFeedbackEffectsProperty }
 
procedure TForceFeedbackEffectsProperty.Edit;
var
Form: TDelphiXFFEditForm;
Effects: TForceFeedbackEffects;
begin
Effects := TForceFeedbackEffects(GetOrdValue);
 
Form := TDelphiXFFEditForm.Create(nil);
try
if Effects.Input is TJoystick then
Form.Effects := Form.DXInput.Joystick.Effects
else if Effects.Input is TKeyboard then
Form.Effects := Form.DXInput.Keyboard.Effects
else if Effects.Input is TMouse then
Form.Effects := Form.DXInput.Mouse.Effects
else Exit;
 
Form.Effects.Assign(TForceFeedbackEffects(GetOrdValue));
Form.ShowModal;
if Form.Tag <> 0 then
begin
SetOrdValue(Integer(Form.Effects));
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
function TForceFeedbackEffectsProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
 
function TForceFeedbackEffectsProperty.GetValue: string;
begin
if TForceFeedbackEffects(GetOrdValue).Count = 0 then
Result := SNone
else
Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
end;
 
{ TDXInputEditor }
 
procedure TDXInputEditor.Edit;
var
Form: TDelphiXInputEditForm;
begin
Form := TDelphiXInputEditForm.Create(nil);
try
Form.DXInput := TCustomDXInput(Component);
Form.ShowModal;
if Form.Tag <> 0 then
Designer.Modified;
finally
Form.Free;
end;
end;
 
procedure TDXInputEditor.ExecuteVerb(Index: Integer);
begin
case Index of
0: begin
with TCustomDXInput(Component) do
begin
Joystick.ID := 0;
Keyboard.KeyAssigns := DefKeyAssign;
end;
Designer.Modified;
end;
1: begin
with TCustomDXInput(Component) do
begin
Joystick.ID := 0;
Keyboard.KeyAssigns := DefKeyAssign2_1;
end;
Designer.Modified;
end;
2: begin
with TCustomDXInput(Component) do
begin
Joystick.ID := 1;
Keyboard.KeyAssigns := DefKeyAssign2_2;
end;
Designer.Modified;
end;
end;
end;
 
function TDXInputEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := SSinglePlayer;
1: Result := SMultiPlayer1;
2: Result := SMultiPlayer2;
end;
end;
 
function TDXInputEditor.GetVerbCount: Integer;
begin
Result := 3;
end;
 
{ TGUIDProperty }
 
procedure TGUIDProperty.Edit;
var
Form: TDelphiXGUIDEditForm;
begin
Form := TDelphiXGUIDEditForm.Create(nil);
try
Form.GUID := GetStrValue;
Form.ShowModal;
if Form.Tag <> 0 then
begin
SetStrValue(Form.GUID);
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
function TGUIDProperty.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paDialog];
end;
 
{ TSpriteProperty }
 
procedure TSpriteProperty.Edit;
var
DirectAccessToSprite: TSprite;
Form: TDelphiXSpriteEditForm;
//FormDesigner: IDesigner;
begin
DirectAccessToSprite := TSprite(GetOrdValue);
//FormDesigner := Designer;
Form := TDelphiXSpriteEditForm.Create(nil);
{FormDesigner.GetComponentNames(GetTypeData(GetPropType), Proc);}
try
Form.LoadDataToForm(DirectAccessToSprite);
//Form.Sprite.AsSign(TPersistent(GetOrdValue));
Form.ShowModal;
if Form.Tag <> 0 then
begin
DirectAccessToSprite := TSprite(Form.SaveDataFromForm);
SetOrdValue(Integer(DirectAccessToSprite));
Designer.Modified;
end;
finally
Form.Free;
end;
end;
 
function TSpriteProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;
 
function TSpriteProperty.GetValue: string;
begin
Result := Format('(%s)', [TObject(GetOrdValue).ClassName]);
end;
 
{ TMidiProperty }
 
procedure TMidiProperty.Edit;
var
DelphiXMidiEditForm: TDelphiXMidiEditForm;
DirectAccessToMidiData: TMusicDataProp;
S: string; I: Integer;
begin
DirectAccessToMidiData := TMusicDataProp(GetOrdValue);
DelphiXMidiEditForm := TDelphiXMidiEditForm.Create(nil);
try
DelphiXMidiEditForm.MidiData := DirectAccessToMidiData.MusicData;
DelphiXMidiEditForm.MidiFileName := DirectAccessToMidiData.MidiName;
DelphiXMidiEditForm.Showmodal;
if DelphiXMidiEditForm.Tag = 1 then begin
DirectAccessToMidiData.MusicData := DelphiXMidiEditForm.MidiData;
S := '';
if DelphiXMidiEditForm.MidiFileName <> '' then begin
S := ExtractFileName(DelphiXMidiEditForm.MidiFileName);
I := Pos(ExtractFileExt(S), S);
if I > 0 then S := Copy(S, 1, I - 1);
end;
DirectAccessToMidiData.MidiName := S;
Designer.Modified;
end;
finally
DelphiXMidiEditForm.Free;
end;
end;
 
function TMidiProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;
 
function TMidiProperty.GetValue: string;
var
S: string;
begin
S := TMusicDataProp(GetOrdValue).MusicData;
if Length(S) = 0 then
Result := SNone
else
Result := '(Midi)';
end;
 
{$IFDEF VER6UP}
procedure TMidiEditor.EditProperty(const Prop: IProperty; var Continue: Boolean);
{$ELSE}
procedure TMidiEditor.EditProperty(PropertyEditor: TPropertyEditor;
var continue, FreeEditor: Boolean);
{$ENDIF}
var
PropName: string;
begin
PropName := {$IFDEF VER6UP}Prop{$ELSE}PropertyEditor{$ENDIF}.GetName;
if (CompareText(PropName, 'Midi') = 0) then
begin
{$IFDEF VER6UP}Prop{$ELSE}PropertyEditor{$ENDIF}.edit;
continue := false;
end;
end;
 
{ TDXMidiListEditor }
 
procedure TDXMidiListEditor.ExecuteVerb(Index: Integer);
var
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
i: Integer;
begin
case Index of
0: begin
OpenDialog := TOpenDialog.Create(nil);
try
OpenDialog.DefaultExt := 'dxm';
OpenDialog.Filter := SDXMOpenFileFilter;
OpenDialog.Options := [ofPathMustExist, ofFileMustExist, ofAllowMultiSelect];
if OpenDialog.Execute then
begin
if OpenDialog.FilterIndex = 2 then
begin
for i := 0 to OpenDialog.Files.Count - 1 do
with TMusicListCollectionItem.Create(TDXMusic(Component).Midis) do
begin
try
LoadFromFile(OpenDialog.Files[i]);
Name := ExtractFileName(OpenDialog.Files[i]);
except
Free;
raise;
end;
end;
end
else
TDXMusic(Component).Midis.LoadFromFile(OpenDialog.FileName);
Designer.Modified;
end;
finally
OpenDialog.Free;
end;
end;
1: begin
SaveDialog := TSaveDialog.Create(nil);
try
SaveDialog.DefaultExt := 'dxm';
SaveDialog.Filter := SDXMFileFilter;
SaveDialog.Options := [ofOverwritePrompt, ofPathMustExist];
if SaveDialog.Execute then
TCustomDXWaveList(Component).Items.SaveToFile(SaveDialog.FileName);
finally
SaveDialog.Free;
end;
end;
end;
end;
 
function TDXMidiListEditor.GetVerbCount: Integer;
begin
Result := 2;
end;
 
function TDXMidiListEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := SOpen;
1: Result := SSave;
end;
end;
 
{ TDXSpriteEngineEditor }
 
procedure TDXSpriteEngineEditor.ListBox1DblClick(Sender: TObject);
begin
if Sender is TListBox then with (Sender as TListBox) do
if ItemIndex <> -1 then
(Owner as TForm).ModalResult := mrOk;
end;
 
procedure TDXSpriteEngineEditor.ExecuteVerb(Index: Integer);
var
FrmListBox: TForm;
ListBox1: TListBox;
DelphiXSpriteEditForm: TDelphiXSpriteEditForm;
ASprite: TSprite;
I, Z: Integer;
S: string;
Q: TCustomDXSpriteEngine;
begin
case Index of
0: begin
FrmListBox := nil;
Z := 0; //default value
DelphiXSpriteEditForm := TDelphiXSpriteEditForm.Create(nil);
try
Q := TCustomDXSpriteEngine(Component);
case Q.Items.Count of
0: begin
ShowMessage('You must create any item of sprite first!');
Exit;
end;
1: ASprite := Q.Items[Z].Sprite;
else
FrmListBox := CreateListBox(ListBox1DblClick, ListBox1);
for I := 0 to Q.Items.Count - 1 do begin
S := Q.Items[I].Name;
ListBox1.Items.Add(Alter(S, '(unnamed).' + IntToStr(I)));
end;
if FrmListBox.ShowModal <> mrOk then Exit;
Z := ListBox1.ItemIndex;
if Z = -1 then Exit;
ASprite := Q.Items[Z].Sprite;
{synchronize of names}
if ASprite.Caption = '' then
if Q.Items[ListBox1.ItemIndex].Name <> '' then
ASprite.Caption := Q.Items[Z].Name;
end {case};
DelphiXSpriteEditForm.LoadDataToForm(ASprite);
DelphiXSpriteEditForm.ShowModal;
if DelphiXSpriteEditForm.Tag <> 0 then begin
ASprite := TSprite(DelphiXSpriteEditForm.SaveDataFromForm);
if Q.Items[Z].Name = '' then
if ASprite.Caption <> '' then
Q.Items[Z].Name := ASprite.Caption;
Designer.Modified;
end;
finally
if Assigned(FrmListBox) then FrmListBox.Free;
DelphiXSpriteEditForm.Free;
end;
end;
end;
end;
 
function TDXSpriteEngineEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
 
function TDXSpriteEngineEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := 'Sprite Editor';
end;
end;
 
{ TDXDrawEditor }
 
procedure TDXDrawEditor.ExecuteVerb(Index: Integer);
var
ediform: TDelphiXPathsEditForm;
Q: TCustomDXDraw;
I: Integer;
S: string;
T: TTrace;
{$IFNDEF VER4UP}
H: TTrace;
J: Integer;
{$ENDIF}
begin
case Index of
0: begin
Q := TCustomDXDraw(Component);
{paths editor}
ediform := TDelphiXPathsEditForm.Create(nil);
try
ediform.Pane.Width := Q.Display.Width;
ediform.Pane.Height := Q.Display.Width;
for I := 0 to Q.Traces.Count - 1 do begin
S := Q.Traces.Items[I].Name;
T := ediform.PrivateTraces.Add;
T.Name := S;
{$IFDEF VER4UP}
T.Assign(Q.Traces.Items[I]);
{$ELSE}
T.Blit := Q.Traces.Items[I].Blit;
{$ENDIF}
if Trim(S) = '' then S := Format('(unnamed[%d])', [I]);
ediform.cbListOfTraces.Items.Add(S);
end;
ediform.ShowTracesOnPane;
 
ediform.ShowModal;
 
if ediform.Tag = 1 then begin
{clear traces}
Q.Traces.Clear;
{rewrite backward}
for i := 0 to ediform.PrivateTraces.Count -1 do begin
T := Q.Traces.Add;
T.Name := ediform.PrivateTraces.Items[I].Name;
{$IFDEF VER4UP}
T.Assign(ediform.PrivateTraces.Items[i]);
{$ELSE}
H := ediform.PrivateTraces.Items[i];
T.Blit := H.Blit;
T.Blit.SetPathLen(H.Blit.GetPathCount);
for J := 0 to H.Blit.GetPathCount - 1 do begin
T.Blit.Path[J] := H.Blit.Path[J]
end
{$ENDIF}
end;
{prepis zmeny}
Designer.Modified;
end;
finally
ediform.Free;
end;
end;
end;
end;
 
function TDXDrawEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
 
function TDXDrawEditor.GetVerb(Index: Integer): string;
begin
case Index of
0: Result := 'Traces Editor';
end;
end;
 
end.
/VCL_DELPHIX_D6/DXRender.pas
5,7 → 5,18
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, DirectX;
Windows,
{$IfDef StandardDX}
DirectDraw,
{$ifdef DX7}
Direct3D;
{$endif}
{$IfDef DX9}
Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8;
{$EndIf}
{$Else}
DirectX;
{$EndIf}
 
const
DXR_MAXTEXTURE = 4;
16,6 → 27,15
TDXR_Color = DWORD;
TDXR_SurfaceColor = DWORD;
 
{ TDXR_Option }
 
PDXR_Option = ^TDXR_Option;
TDXR_Option = (
DXR_OPTION_VERSION,
DXR_OPTION_MMXENABLE,
DXR_OPTION_RENDERPRIMITIVES
);
 
{ TDXR_ShadeMode }
 
TDXR_ShadeMode = (
34,7 → 54,6
DXR_BLEND_ONE1_SUB_ONE2, // r=c1-c2
DXR_BLEND_ONE2_SUB_ONE1, // r=c2-c1
DXR_BLEND_ONE1_MUL_ONE2, // r=c1*c2
 
DXR_BLEND_SRCALPHA1, // r=c1*a1
DXR_BLEND_SRCALPHA1_ADD_ONE2, // r=c1*a1+c2
DXR_BLEND_ONE2_SUB_SRCALPHA1, // r=c2-c1*a1
41,8 → 60,10
DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2, // r=c1*a1+c2*(1-a2)
DXR_BLEND_INVSRCALPHA1_ADD_SRCALPHA2, // r=c1*(1-a1)+c2*a2
// for lighting
DXR_BLEND_DECAL, // r=c1
DXR_BLEND_DECALALPHA, // r=c1 ra=a2
DXR_BLEND_MODULATE, // r=c1*c2 ra=a2
DXR_BLEND_MODULATEALPHA, // r=c1*c2
DXR_BLEND_ADD // r=c1+c2 ra=a2
);
 
50,7 → 71,9
 
TDXR_TextureFilter = (
DXR_TEXTUREFILTER_NEAREST,
DXR_TEXTUREFILTER_LINEAR
DXR_TEXTUREFILTER_LINEAR,
DXR_TEXTUREFILTER_MIPMAP_NEAREST,
DXR_TEXTUREFILTER_MIPMAP_LINEAR
);
 
{ TDXR_TextureAddress }
60,6 → 83,19
DXR_TEXTUREADDRESS_DONOTCLIP // tx=tx ty=ty
);
 
{ TDXR_CmpFunc }
 
TDXR_CmpFunc = (
DXR_CMPFUNC_NEVER,
DXR_CMPFUNC_LESS,
DXR_CMPFUNC_EQUAL,
DXR_CMPFUNC_LESSEQUAL,
DXR_CMPFUNC_GREATER,
DXR_CMPFUNC_NOTEQUAL,
DXR_CMPFUNC_GREATEREQUAL,
DXR_CMPFUNC_ALWAYS
);
 
{ TDXR_ColorType }
 
TDXR_ColorType = (
89,6 → 125,7
Bits: Pointer; // Pointer to pixeldata(x:0 y:0)
Pitch: Integer; // Offset of next scanline
PitchBit: Integer; // Offset of next scanline (Number of bit)
MipmapChain: PDXR_Surface;
case Integer of
0: (
{ Indexed color }
113,6 → 150,7
sx: TDXR_Value; // Screen coordinates
sy: TDXR_Value;
sz: TDXR_Value;
rhw: TDXR_Value; // 1/sz
color: TDXR_Color;
specular: TDXR_Color;
tu, tv: array[0..DXR_MAXTEXTURE-1] of TDXR_Value;
145,6 → 183,7
ColorKeyEnable: Boolean;
ColorKey: TDXR_SurfaceColor;
TextureAddress: TDXR_TextureAddress;
BumpTexture: Integer;
end;
 
{ TDXR_Cull }
167,19 → 206,26
TextureEnable: Boolean;
TextureList: array[0..DXR_MAXTEXTURE-1] of TDXR_TextureLayer;
TextureFilter: TDXR_TextureFilter;
EnableDrawLine: DWORD;
ZBuffer: PDXR_Surface;
ZFunc: TDXR_CmpFunc;
ZWriteEnable: Boolean;
EnableDrawLine: Integer;
end;
 
function dxrGetOption(Option: TDXR_Option): DWORD;
procedure dxrSetOption(Option: TDXR_Option; Value: DWORD);
 
procedure dxrMakeIndexedSurface(var Surface: TDXR_Surface; Width, Height, BitCount: DWORD;
Bits: Pointer; pitch: Integer; idx_index, idx_alpha: DWORD);
procedure dxrMakeRGBSurface(var Surface: TDXR_Surface; Width, Height, BitCount: DWORD;
Bits: Pointer; pitch: Integer; rgb_red, rgb_green, rgb_blue, rgb_alpha: DWORD);
function dxrScanLine(const Surface: TDXR_Surface; y: DWORD): Pointer;
procedure dxrZBufferClear(const Surface: TDXR_Surface);
 
function dxrDDSurfaceLock(DDSurface: IDirectDrawSurface; var Surface: TDXR_Surface): Boolean;
function dxrDDSurfaceLock2(DDSurface: IDirectDrawSurface; var ddsd: TDDSurfaceDesc;
var Surface: TDXR_Surface): Boolean;
procedure dxrDDSurfaceUnLock(DDSurface: IDirectDrawSurface; const Surface: TDXR_Surface);
function dxrDDSurfaceLock(DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF}; var Surface: TDXR_Surface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
function dxrDDSurfaceLock2(DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF}; var ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
var Surface: TDXR_Surface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
procedure dxrDDSurfaceUnLock(DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF}; const Surface: TDXR_Surface); {$IFDEF VER9UP}inline;{$ENDIF}
 
procedure dxrDefRenderStates(var States: TDXR_RenderStates);
 
220,19 → 266,6
 
PInteger = ^Integer;
 
{ TDXR_CmpFunc }
 
TDXR_CmpFunc = (
DXR_CMPFUNC_NEVER,
DXR_CMPFUNC_LESS,
DXR_CMPFUNC_EQUAL,
DXR_CMPFUNC_LESSEQUAL,
DXR_CMPFUNC_GREATER,
DXR_CMPFUNC_NOTEQUAL,
DXR_CMPFUNC_GREATEREQUAL,
DXR_CMPFUNC_ALWAYS
);
 
{ TDXRMachine }
 
TDXRMachine_TreeType = (
240,6 → 273,9
DXR_TREETYPE_LOADCOLOR, // Load vertex color
DXR_TREETYPE_LOADCONSTCOLOR, // Load constant color
DXR_TREETYPE_LOADTEXTURE, // Load texel
DXR_TREETYPE_LOADBUMPTEXTURE,// Load texel with Bump mapping
// dx := nx + (BumpTexture[nx-1, ny]-BumpTexture[nx+1, ny]);
// dy := ny + (BumpTexture[nx, ny-1]-BumpTexture[nx, ny+1]);
DXR_TREETYPE_LOADDESTPIXEL, // Load dest pixel
DXR_TREETYPE_BLEND // Blend color
);
284,10 → 320,23
DefaultColor: TDXRMachine_Color;
end;
 
TDXRMachine_Reg_RHW = record
Enable: Boolean;
nRHW: TDXRMachine_Int64;
iRHW: TDXRMachine_Int64;
end;
 
TDXRMachine_Reg_Dither = record
Enable: Boolean;
end;
 
TDXRMachine_Reg_ZBuffer = record
Enable: Boolean;
Surface: PDXR_Surface;
CmpFunc: TDXR_CmpFunc;
WriteEnable: Boolean;
end;
 
TDXRMachine_Reg_Axis = record
Axis: TDXRMachine_Axis;
IncEnable: Boolean;
309,6 → 358,10
DXR_TREETYPE_LOADTEXTURE: (
Texture: Integer
);
DXR_TREETYPE_LOADBUMPTEXTURE: (
_Texture: Integer;
BumpTexture: Integer;
);
DXR_TREETYPE_LOADDESTPIXEL: (
);
DXR_TREETYPE_BLEND: (
326,11 → 379,15
FTreeCount: Integer;
FTreeList: array[0..127] of TDXRMachine_Tree;
FMMXUsed: Boolean;
F_ZBuf: Pointer;
F_BiLinearAxis: TDXRMachine_Axis;
F_BiLinearCol1: TDXRMachine_Color;
F_BiLinearCol2: TDXRMachine_Color;
F_BiLinearCol3: TDXRMachine_Color;
F_BiLinearCol4: TDXRMachine_Color;
F_BumpAxis: TDXRMachine_Axis;
F_BumpAxis2: TDXRMachine_Axis;
F_BumpTempCol: DWORD;
FStack: array[0..255] of TDXRMachine_Color;
procedure GenerateCode(var Code: Pointer; Tree: PDXRMachine_Tree);
public
342,16 → 399,19
TextureIndex: array[0..7] of Integer;
TextureIndexCount: Integer;
Dither: TDXRMachine_Reg_Dither;
ZBuffer: TDXRMachine_Reg_ZBuffer;
Axis: TDXRMachine_Reg_Axis;
RHW: TDXRMachine_Reg_RHW;
constructor Create;
destructor Destroy; override;
function CreateTree: PDXRMachine_Tree;
function CreateTree2(Typ: TDXRMachine_TreeType): PDXRMachine_Tree;
function CreateTree_LoadColor(Color: DWORD): PDXRMachine_Tree;
function CreateTree_LoadConstColor(R, G, B, A: Byte): PDXRMachine_Tree;
function CreateTree_LoadTexture(Texture: DWORD): PDXRMachine_Tree;
function CreateTree_Blend(Blend: TDXR_Blend; BlendTree1, BlendTree2: PDXRMachine_Tree): PDXRMachine_Tree;
procedure Initialize;
function CreateTree: PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
function CreateTree2(Typ: TDXRMachine_TreeType): PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
function CreateTree_LoadColor(Color: DWORD): PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
function CreateTree_LoadConstColor(R, G, B, A: Byte): PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
function CreateTree_LoadTexture(Texture: DWORD): PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
function CreateTree_LoadBumpTexture(Texture, BumpTexture: DWORD): PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
function CreateTree_Blend(Blend: TDXR_Blend; BlendTree1, BlendTree2: PDXRMachine_Tree): PDXRMachine_Tree; {$IFDEF VER9UP}inline;{$ENDIF}
procedure Initialize; {$IFDEF VER9UP}inline;{$ENDIF}
procedure Compile(Tree: PDXRMachine_Tree);
procedure Run(Count: Integer);
property Compiled: Boolean read FCompiled write FCompiled;
418,10 → 478,42
@@exit:
pop ebx
end;
 
UseMMX := CPUIDFeatures and CPUIDF_MMX<>0;
end;
 
function dxrGetOption(Option: TDXR_Option): DWORD;
begin
Result := 0;
case Option of
DXR_OPTION_VERSION:
begin
Result := 1*100 + 0;
end;
DXR_OPTION_MMXENABLE:
begin
Result := DWORD(LongBool(UseMMX));
end;
DXR_OPTION_RENDERPRIMITIVES:
begin
Result := RenderPrimitiveCount;
end;
end;
end;
 
procedure dxrSetOption(Option: TDXR_Option; Value: DWORD);
begin
case Option of
DXR_OPTION_MMXENABLE:
begin
UseMMX := LongBool(Value) and (CPUIDFeatures and CPUIDF_MMX<>0);
end;
DXR_OPTION_RENDERPRIMITIVES:
begin
RenderPrimitiveCount := Value;
end;
end;
end;
 
function GetBitCount(B: Integer): DWORD;
begin
Result := 31;
538,14 → 630,14
Result := False;
end;
 
function dxrDDSurfaceLock(DDSurface: IDirectDrawSurface; var Surface: TDXR_Surface): Boolean;
function dxrDDSurfaceLock(DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF}; var Surface: TDXR_Surface): Boolean;
var
ddsd: TDDSurfaceDesc;
ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
begin
Result := dxrDDSurfaceLock2(DDSurface, ddsd, Surface);
end;
 
function dxrDDSurfaceLock2(DDSurface: IDirectDrawSurface; var ddsd: TDDSurfaceDesc;
function dxrDDSurfaceLock2(DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF}; var ddsd: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
var Surface: TDXR_Surface): Boolean;
const
DDPF_PALETTEINDEXED = DDPF_PALETTEINDEXED1 or DDPF_PALETTEINDEXED2 or
562,12 → 654,12
ddsd.lpSurface, ddsd.lPitch, (1 shl ddsd.ddpfPixelFormat.dwRGBBitCount)-1, 0);
end else
begin
{if ddsd.ddpfPixelFormat.dwFlags and DDPF_ALPHAPIXELS<>0 then
if ddsd.ddpfPixelFormat.dwFlags and DDPF_ALPHAPIXELS<>0 then
begin
dxrMakeRGBSurface(Surface, ddsd.dwWidth, ddsd.dwHeight, ddsd.ddpfPixelFormat.dwRGBBitCount,
ddsd.lpSurface, ddsd.lPitch, ddsd.ddpfPixelFormat.dwRBitMask, ddsd.ddpfPixelFormat.dwGBitMask,
ddsd.ddpfPixelFormat.dwBBitMask, ddsd.ddpfPixelFormat.dwRGBAlphaBitMask);
end else}
end else
begin
dxrMakeRGBSurface(Surface, ddsd.dwWidth, ddsd.dwHeight, ddsd.ddpfPixelFormat.dwRGBBitCount,
ddsd.lpSurface, ddsd.lPitch, ddsd.ddpfPixelFormat.dwRBitMask, ddsd.ddpfPixelFormat.dwGBitMask,
577,7 → 669,7
end;
end;
 
procedure dxrDDSurfaceUnLock(DDSurface: IDirectDrawSurface; const Surface: TDXR_Surface);
procedure dxrDDSurfaceUnLock(DDSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface{$ELSE}IDirectDrawSurface7{$ENDIF}; const Surface: TDXR_Surface);
begin
DDSurface.Unlock(Surface.Bits);
end;
587,6 → 679,14
Result := Pointer(Integer(Surface.Bits)+Surface.Pitch*Integer(y));
end;
 
procedure dxrZBufferClear(const Surface: TDXR_Surface);
var
i: Integer;
begin
for i:=0 to Surface.Height-1 do
FillChar(dxrScanLine(Surface, i)^, Abs(Surface.Pitch), $FF);
end;
 
{ TDXRMachine }
 
constructor TDXRMachine.Create;
616,7 → 716,9
FillChar(ColorList, SizeOf(ColorList), 0);
FillChar(TextureList, SizeOf(TextureList), 0);
FillChar(Dither, SizeOf(Dither), 0);
FillChar(ZBuffer, SizeOf(ZBuffer), 0);
FillChar(Axis, SizeOf(Axis), 0);
FillChar(RHW, SizeOf(RHW), 0);
end;
 
function TDXRMachine.CreateTree: PDXRMachine_Tree;
656,6 → 758,14
Result.Texture := Texture;
end;
 
function TDXRMachine.CreateTree_LoadBumpTexture(Texture, BumpTexture: DWORD): PDXRMachine_Tree;
begin
Result := CreateTree;
Result.Typ := DXR_TREETYPE_LOADBUMPTEXTURE;
Result.Texture := Texture;
Result.BumpTexture := BumpTexture;
end;
 
function TDXRMachine.CreateTree_Blend(Blend: TDXR_Blend; BlendTree1, BlendTree2: PDXRMachine_Tree): PDXRMachine_Tree;
begin
Result := CreateTree;
710,10 → 820,7
Col2_1 := [chRed, chGreen, chBlue, chAlpha];
Col2_2 := [];
end;
DXR_BLEND_ONE1_ADD_ONE2,
DXR_BLEND_ONE1_SUB_ONE2,
DXR_BLEND_ONE2_SUB_ONE1,
DXR_BLEND_ONE1_MUL_ONE2:
DXR_BLEND_ONE1_ADD_ONE2, DXR_BLEND_ONE1_SUB_ONE2:
begin
Col1_1 := [chRed, chGreen, chBlue, chAlpha];
Col1_2 := [];
720,6 → 827,13
Col2_1 := [chRed, chGreen, chBlue, chAlpha];
Col2_2 := [];
end;
DXR_BLEND_ONE2_SUB_ONE1, DXR_BLEND_ONE1_MUL_ONE2:
begin
Col1_1 := [chRed, chGreen, chBlue, chAlpha];
Col1_2 := [];
Col2_1 := [chRed, chGreen, chBlue, chAlpha];
Col2_2 := [];
end;
DXR_BLEND_SRCALPHA1:
begin
Col1_1 := [chRed, chGreen, chBlue];
756,6 → 870,13
Col2_2 := [];
end;
 
DXR_BLEND_DECAL:
begin
Col1_1 := [chRed, chGreen, chBlue, chAlpha];
Col1_2 := [];
Col2_1 := [];
Col2_2 := [];
end;
DXR_BLEND_DECALALPHA:
begin
Col1_1 := [chRed, chGreen, chBlue];
765,6 → 886,13
end;
DXR_BLEND_MODULATE:
begin
Col1_1 := [chRed, chGreen, chBlue, chAlpha];
Col1_2 := [];
Col2_1 := [chRed, chGreen, chBlue, chAlpha];
Col2_2 := [];
end;
DXR_BLEND_MODULATEALPHA:
begin
Col1_1 := [chRed, chGreen, chBlue];
Col1_2 := [chAlpha];
Col2_1 := [chRed, chGreen, chBlue];
797,6 → 925,10
begin
// Load texel
end;
DXR_TREETYPE_LOADBUMPTEXTURE:
begin
// Load texel with Bump mapping
end;
DXR_TREETYPE_LOADDESTPIXEL:
begin
// Load dest pixel
816,7 → 948,7
begin
c := Tree.Channels; Tree^.Typ := DXR_TREETYPE_LOADBLACK; Tree.Channels := c;
end else
if (Tree.Blend in [DXR_BLEND_ONE1]) then
if (Tree.Blend in [DXR_BLEND_ONE1, DXR_BLEND_DECAL]) then
begin
c := Tree.Channels; Tree := Tree.BlendTree1; Tree.Channels := c;
end else
824,12 → 956,12
begin
c := Tree.Channels; Tree := Tree.BlendTree2; Tree.Channels := c;
end else
if (Tree.Blend in [DXR_BLEND_ONE1_ADD_ONE2, DXR_BLEND_ONE1_SUB_ONE2]) and
if (Tree.Blend in [DXR_BLEND_ONE1_ADD_ONE2, DXR_BLEND_ONE2_SUB_ONE1]) and
(Tree.BlendTree2.Typ=DXR_TREETYPE_LOADBLACK) then
begin
c := Tree.Channels; Tree := Tree.BlendTree1; Tree.Channels := c;
end else
if (Tree.Blend in [DXR_BLEND_ONE1_ADD_ONE2, DXR_BLEND_ONE1_SUB_ONE2]) and
if (Tree.Blend in [DXR_BLEND_ONE1_ADD_ONE2, DXR_BLEND_ONE2_SUB_ONE1]) and
(Tree.BlendTree1.Typ=DXR_TREETYPE_LOADBLACK) then
begin
c := Tree.Channels; Tree := Tree.BlendTree2; Tree.Channels := c;
862,6 → 994,14
Tree.Channels*GetSurfaceChannels(TextureList[Tree.Texture].Surface^);
TextureList[Tree.Texture].Enable := TextureList[Tree.Texture].EnableChannels<>[];
end;
DXR_TREETYPE_LOADBUMPTEXTURE:
begin
// Load texel with Bump mapping
TextureList[Tree.Texture].EnableChannels := TextureList[Tree.Texture].EnableChannels +
Tree.Channels*GetSurfaceChannels(TextureList[Tree.Texture].Surface^);
TextureList[Tree.Texture].Enable := TextureList[Tree.Texture].EnableChannels<>[];
TextureList[Tree.BumpTexture].Enable := True;
end;
DXR_TREETYPE_LOADDESTPIXEL:
begin
// Load dest pixel
900,6 → 1040,9
Inc(TextureIndexCount);
end;
 
ZBuffer.Enable := ZBuffer.Surface<>nil;
 
RHW.Enable := ZBuffer.Enable;
Axis.IncEnable := Dither.Enable;
 
{ Generate X86 code }
1136,6 → 1279,230
end;
end;
 
procedure genInitZBuffer(var Code: Pointer);
var
_Axis: Pointer;
ByteCount, Pitch: DWORD;
Bits, _ZBuf: Pointer;
begin
if not ZBuffer.Enable then Exit;
 
_Axis := @Axis.Axis;
 
ByteCount := ZBuffer.Surface.BitCount div 8;
Pitch := ZBuffer.Surface.Pitch;
Bits := ZBuffer.Surface.Bits;
 
_ZBuf := @F_ZBuf;
 
asm
jmp @@EndCode
@@StartCode:
mov edx,dword ptr [offset _null]{}@@AxisX:
imul edx,$11{} @@ByteCount: // States.ZBuffer.BitCount div 8
mov eax,dword ptr [offset _null]{}@@AxisY:
imul eax,$11111111{} @@Pitch: // States.ZBuffer.pitch
add eax,$11111111{} @@Bits: // States.ZBuffer.Bits
add eax,edx
mov dword ptr [offset _null],eax{}@@_ZBuf:
@@EndCode:
{$I DXRender.inc}
{ @@AxisX }
mov eax,_Axis; add eax,TDXRMachine_Axis.X
mov edx,offset @@AxisX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisY }
mov eax,_Axis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@AxisY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@ByteCount }
mov eax,ByteCount
mov edx,offset @@ByteCount-1
sub edx,offset @@StartCode
mov byte ptr [ecx+edx],al
 
{ @@Pitch }
mov eax,Pitch
mov edx,offset @@Pitch-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Bits }
mov eax,Bits
mov edx,offset @@Bits-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_ZBuf }
mov eax,_ZBuf
mov edx,offset @@_ZBuf-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
 
procedure genZBufferTest(var Code: Pointer);
var
_ZBuf, _RHW: Pointer;
begin
if not ZBuffer.Enable then Exit;
 
_ZBuf := @F_ZBuf;
_RHW := @RHW.nRHW;
 
asm
jmp @@EndCode
@@StartCode:
mov edx,dword ptr [offset _null]{}@@_ZBuf:
mov ebx,dword ptr [offset _null]{}@@_RHW:
@@EndCode:
{$I DXRender.inc}
{ @@_ZBuf }
mov eax,_ZBuf
mov edx,offset @@_ZBuf-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_RHW }
mov eax,_RHW; add eax,4
mov edx,offset @@_RHW-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
if ZBuffer.CmpFunc<>DXR_CMPFUNC_ALWAYS then
begin
case ZBuffer.Surface.BitCount of
8: begin
asm
jmp @@EndCode
@@StartCode:
movzx eax,byte ptr [edx]
@@EndCode:
{$I DXRender.inc}
end;
end;
16: begin
asm
jmp @@EndCode
@@StartCode:
movzx eax,word ptr [edx]
@@EndCode:
{$I DXRender.inc}
end;
end;
24: begin
asm
jmp @@EndCode
@@StartCode:
movzx ax,byte ptr [edx+2]
shl eax,16
mov ax,word ptr [edx]
@@EndCode:
{$I DXRender.inc}
end;
end;
32: begin
asm
jmp @@EndCode
@@StartCode:
mov eax,dword ptr [edx]
@@EndCode:
{$I DXRender.inc}
end;
end;
end;
 
asm
jmp @@EndCode
@@StartCode:
cmp eax,ebx
@@EndCode:
{$I DXRender.inc}
end;
genCmpFunc(Code, ZBuffer.CmpFunc, SkipAddress);
end;
 
if ZBuffer.WriteEnable then
begin
case ZBuffer.Surface.BitCount of
8: begin
asm
jmp @@EndCode
@@StartCode:
mov byte ptr [edx],bl
@@EndCode:
{$I DXRender.inc}
end;
end;
16: begin
asm
jmp @@EndCode
@@StartCode:
mov word ptr [edx],bx
@@EndCode:
{$I DXRender.inc}
end;
end;
24: begin
asm
jmp @@EndCode
@@StartCode:
mov word ptr [edx],bx
bswap ebx
mov byte ptr [edx+2],bh
@@EndCode:
{$I DXRender.inc}
end;
end;
32: begin
asm
jmp @@EndCode
@@StartCode:
mov dword ptr [edx],ebx
@@EndCode:
{$I DXRender.inc}
end;
end;
end;
end;
end;
 
procedure genUpdateZBufferAddress(var Code: Pointer);
var
ByteCount: DWORD;
_ZBuf: Pointer;
begin
if not ZBuffer.Enable then Exit;
 
ByteCount := ZBuffer.Surface.BitCount shr 3;
 
_ZBuf := @F_ZBuf;
 
asm
jmp @@EndCode
@@StartCode:
add dword ptr [offset _null],$11{}@@_ZBuf:
@@EndCode:
{$I DXRender.inc}
{ @@_ZBuf }
mov eax,ByteCount
mov edx,offset @@_ZBuf-1
sub edx,offset @@StartCode
mov byte ptr [ecx+edx],al
 
{ @@_ZBuf }
mov eax,_ZBuf
mov edx,offset @@_ZBuf-5
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
 
procedure genReadDestPixel(var Code: Pointer);
begin
case Dest.BitCount of
2623,19 → 2990,19
mov dword ptr [ecx+edx],eax
 
{ @@DestR }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@DestR-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@DestG }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@DestG-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@DestB }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@DestB-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2678,19 → 3045,19
mov dword ptr [ecx+edx],eax
 
{ @@DestR }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@DestR-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@DestG }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@DestG-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@DestB }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@DestB-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2732,19 → 3099,19
mov dword ptr [ecx+edx],eax
 
{ @@DestR }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@DestR-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@DestG }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@DestG-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@DestB }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@DestB-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2761,7 → 3128,7
@@EndCode:
{$I DXRender.inc}
{ @@DestR }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R)
mov edx,offset @@DestR-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2772,7 → 3139,7
mov word ptr [ecx+edx],ax
 
{ @@DestG }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G)
mov edx,offset @@DestG-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2783,7 → 3150,7
mov word ptr [ecx+edx],ax
 
{ @@DestB }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B)
mov edx,offset @@DestB-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2825,7 → 3192,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2854,7 → 3221,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2869,7 → 3236,7
@@EndCode:
{$I DXRender.inc}
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A)
mov edx,offset @@Dest-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2912,7 → 3279,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2941,7 → 3308,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2956,7 → 3323,7
@@EndCode:
{$I DXRender.inc}
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R)
mov edx,offset @@Dest-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
2998,7 → 3365,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3027,7 → 3394,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3042,7 → 3409,7
@@EndCode:
{$I DXRender.inc}
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G)
mov edx,offset @@Dest-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3084,7 → 3451,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3113,7 → 3480,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3128,7 → 3495,7
@@EndCode:
{$I DXRender.inc}
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B)
mov edx,offset @@Dest-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3170,7 → 3537,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3199,7 → 3566,7
mov byte ptr [ecx+edx],al
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3214,7 → 3581,7
@@EndCode:
{$I DXRender.inc}
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A)
mov edx,offset @@Dest-6
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3254,7 → 3621,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3283,7 → 3650,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3318,7 → 3685,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3347,7 → 3714,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3382,7 → 3749,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3411,7 → 3778,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3446,7 → 3813,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3475,7 → 3842,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3535,7 → 3902,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3625,7 → 3992,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3715,7 → 4082,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3805,7 → 4172,7
@@EndCode:
{$I DXRender.inc}
{ @@Src }
mov eax,Src; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Src; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Src-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
3889,10 → 4256,13
procedure genEncodeColor2(var Code: Pointer; const Surface: TDXR_Surface; Src: PDXRMachine_Color; EnableChannels: TDXRColorChannels);
begin
if Dither.Enable then
begin
genEncodeColor_with_Dither(Code, Surface, Src, @Axis.Axis, EnableChannels)
else
end else
begin
genEncodeColor(Code, Surface, Src, EnableChannels);
end;
end;
 
procedure genColorKey(var Code: Pointer; const Texture: TDXRMachine_Reg_Texture);
var
4238,25 → 4608,25
@@EndCode:
{$I DXRender.inc}
{ @@_BiLinearCol1 }
mov eax,_BiLinearCol1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,_BiLinearCol1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@_BiLinearCol1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol2 }
mov eax,_BiLinearCol2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,_BiLinearCol2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@_BiLinearCol2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol3 }
mov eax,_BiLinearCol3; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,_BiLinearCol3; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@_BiLinearCol3-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol4 }
mov eax,_BiLinearCol4; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,_BiLinearCol4; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@_BiLinearCol4-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4274,7 → 4644,7
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4314,25 → 4684,25
@@EndCode:
{$I DXRender.inc}
{ @@_BiLinearCol1 }
mov eax,_BiLinearCol1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,_BiLinearCol1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@_BiLinearCol1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol2 }
mov eax,_BiLinearCol2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,_BiLinearCol2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@_BiLinearCol2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol3 }
mov eax,_BiLinearCol3; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,_BiLinearCol3; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@_BiLinearCol3-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol4 }
mov eax,_BiLinearCol4; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,_BiLinearCol4; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@_BiLinearCol4-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4350,7 → 4720,7
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4390,25 → 4760,25
@@EndCode:
{$I DXRender.inc}
{ @@_BiLinearCol1 }
mov eax,_BiLinearCol1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,_BiLinearCol1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@_BiLinearCol1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol2 }
mov eax,_BiLinearCol2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,_BiLinearCol2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@_BiLinearCol2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol3 }
mov eax,_BiLinearCol3; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,_BiLinearCol3; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@_BiLinearCol3-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol4 }
mov eax,_BiLinearCol4; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,_BiLinearCol4; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@_BiLinearCol4-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4426,7 → 4796,7
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4466,25 → 4836,25
@@EndCode:
{$I DXRender.inc}
{ @@_BiLinearCol1 }
mov eax,_BiLinearCol1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,_BiLinearCol1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@_BiLinearCol1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol2 }
mov eax,_BiLinearCol2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,_BiLinearCol2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@_BiLinearCol2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol3 }
mov eax,_BiLinearCol3; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,_BiLinearCol3; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@_BiLinearCol3-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@_BiLinearCol4 }
mov eax,_BiLinearCol4; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,_BiLinearCol4; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@_BiLinearCol4-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4502,7 → 4872,7
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4514,12 → 4884,252
procedure genReadTexture(var Code: Pointer; Dest: PDXRMachine_Color;
const Texture: TDXRMachine_Reg_Texture; EnableChannels: TDXRColorChannels);
begin
if Texture.Filter in [DXR_TEXTUREFILTER_LINEAR] then
if Texture.Filter in [DXR_TEXTUREFILTER_LINEAR, DXR_TEXTUREFILTER_MIPMAP_LINEAR] then
genReadTexture_BiLinear(Code, Dest, Texture, Texture.nAxis, EnableChannels)
else
genReadTexture_Nearest(Code, Dest, Texture, Texture.nAxis, EnableChannels);
end;
 
procedure genReadBumpTexture_Nearest(var Code: Pointer; Dest: PDXRMachine_Color;
const Texture, BumpTexture: TDXRMachine_Reg_Texture; EnableChannels: TDXRColorChannels);
var
_Axis, _Axis2, _iAxis, _BumpAxis, _BumpAxis2: PDXRMachine_Axis;
_BumpTempCol: Pointer;
begin
if EnableChannels=[] then Exit;
 
_Axis := @BumpTexture.nAxis;
_Axis2 := @Texture.nAxis;
_iAxis := @BumpTexture.iAxis;
_BumpAxis := @F_BumpAxis;
_BumpAxis2 := @F_BumpAxis2;
_BumpTempCol := @F_BumpTempCol;
 
{ X }
asm
jmp @@EndCode
@@StartCode:
mov eax,dword ptr [offset _null]{}@@TexX:
mov edx,dword ptr [offset _null]{}@@TexY:
sub eax,dword ptr [offset _null]{}@@iTexX:
mov dword ptr [offset _null],edx{}@@AxisY:
mov dword ptr [offset _null],eax{}@@AxisX:
@@EndCode:
{$I DXRender.inc}
{ @@TexX }
mov eax,_Axis; add eax,TDXRMachine_Axis.X
mov edx,offset @@TexX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@TexY }
mov eax,_Axis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@TexY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@iTexX }
mov eax,_iAxis; add eax,TDXRMachine_Axis.X
mov edx,offset @@iTexX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisX }
mov eax,_BumpAxis; add eax,TDXRMachine_Axis.X
mov edx,offset @@AxisX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisY }
mov eax,_BumpAxis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@AxisY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
genReadSurfacePixel(Code, BumpTexture, _BumpAxis);
 
asm
jmp @@EndCode
@@StartCode:
mov dword ptr [offset _null],eax{}@@BumpTempCol:
@@EndCode:
{$I DXRender.inc}
{ @@BumpTempCol }
mov eax,_BumpTempCol
mov edx,offset @@BumpTempCol-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
asm
jmp @@EndCode
@@StartCode:
mov edx,dword ptr [offset _null]{}@@iAxisX:
add dword ptr [offset _null],edx{}@@AxisX:
@@EndCode:
{$I DXRender.inc}
{ @@iAxisX }
mov eax,_iAxis; add eax,TDXRMachine_Axis.X
mov edx,offset @@iAxisX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisX }
mov eax,_BumpAxis; add eax,TDXRMachine_Axis.X
mov edx,offset @@AxisX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
genReadSurfacePixel(Code, BumpTexture, _BumpAxis);
 
asm
jmp @@EndCode
@@StartCode:
sub eax,dword ptr [offset _null]{}@@BumpTempCol:
sal eax,16
add eax,dword ptr [offset _null]{}@@TexX:
mov dword ptr [offset _null],eax{}@@AxisX:
@@EndCode:
{$I DXRender.inc}
{ @@BumpTempCol }
mov eax,_BumpTempCol
mov edx,offset @@BumpTempCol-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@TexX }
mov eax,_Axis2; add eax,TDXRMachine_Axis.X
mov edx,offset @@TexX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisX }
mov eax,_BumpAxis2; add eax,TDXRMachine_Axis.X
mov edx,offset @@AxisX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
{ Y }
asm
jmp @@EndCode
@@StartCode:
mov eax,dword ptr [offset _null]{}@@TexX:
mov edx,dword ptr [offset _null]{}@@TexY:
sub edx,dword ptr [offset _null]{}@@iTexY:
mov dword ptr [offset _null],eax{}@@AxisX:
mov dword ptr [offset _null],edx{}@@AxisY:
@@EndCode:
{$I DXRender.inc}
{ @@TexX }
mov eax,_Axis; add eax,TDXRMachine_Axis.X
mov edx,offset @@TexX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@TexY }
mov eax,_Axis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@TexY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@iTexY }
mov eax,_iAxis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@iTexY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisX }
mov eax,_BumpAxis; add eax,TDXRMachine_Axis.X
mov edx,offset @@AxisX-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisY }
mov eax,_BumpAxis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@AxisY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
genReadSurfacePixel(Code, BumpTexture, _BumpTempCol);
 
asm
jmp @@EndCode
@@StartCode:
mov dword ptr [offset _null],eax{}@@BumpTempCol:
@@EndCode:
{$I DXRender.inc}
{ @@BumpTempCol }
mov eax,_BumpTempCol
mov edx,offset @@BumpTempCol-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
asm
jmp @@EndCode
@@StartCode:
mov edx,dword ptr [offset _null]{}@@iAxisY:
sal edx,1
sub dword ptr [offset _null],edx{}@@AxisY:
@@EndCode:
{$I DXRender.inc}
{ @@iAxisY }
mov eax,_iAxis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@iAxisY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisY }
mov eax,_BumpAxis; add eax,TDXRMachine_Axis.Y
mov edx,offset @@AxisY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
genReadSurfacePixel(Code, BumpTexture, _BumpAxis);
 
asm
jmp @@EndCode
@@StartCode:
sub eax,dword ptr [offset _null]{}@@BumpTempCol:
sal eax,16
add eax,dword ptr [offset _null]{}@@TexY:
mov dword ptr [offset _null],eax{}@@AxisY:
@@EndCode:
{$I DXRender.inc}
{ @@BumpTempCol }
mov eax,_BumpTempCol
mov edx,offset @@BumpTempCol-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@TexX }
mov eax,_Axis2; add eax,TDXRMachine_Axis.Y
mov edx,offset @@TexY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@AxisX }
mov eax,_BumpAxis2; add eax,TDXRMachine_Axis.Y
mov edx,offset @@AxisY-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
 
genReadTexture_Nearest(Code, Dest, Texture, _BumpAxis2^, EnableChannels);
end;
 
procedure genReadBumpTexture(var Code: Pointer; Dest: PDXRMachine_Color;
const Texture, BumpTexture: TDXRMachine_Reg_Texture; EnableChannels: TDXRColorChannels);
begin
{if Texture.Filter in [DXR_TEXTUREFILTER_LINEAR, DXR_TEXTUREFILTER_MIPMAP_LINEAR] then
genReadBumpTexture_BiLinear(Code, Dest, Texture, BumpTexture, EnableChannels)
else }
genReadBumpTexture_Nearest(Code, Dest, Texture, BumpTexture, EnableChannels);
end;
 
procedure genUpdateAxis(var Code: Pointer);
var
_Axis: Pointer;
4527,6 → 5137,7
if not Axis.IncEnable then Exit;
 
_Axis := @Axis.Axis;
 
asm
jmp @@EndCode
@@StartCode:
4655,6 → 5266,40
nTex := @Texture.nAxis;
iTex := @Texture.iAxis;
 
if UseMMX then
begin
FMMXUsed := True;
asm
jmp @@EndCode
@@StartCode:
db $0F,$6F,$05,$11,$11,$11,$11///movq mm0,qword ptr [$11111111]
@@nTex:
db $0F,$FE,$05,$11,$11,$11,$11///paddd mm0,qword ptr [$11111111]
@@iTex:
db $0F,$7F,$05,$11,$11,$11,$11///movq qword ptr [$11111111],mm0
@@nTex2:
@@EndCode:
{$I DXRender.inc}
{ @@nTex }
mov eax,nTex
mov edx,offset @@nTex-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@nTex2 }
mov eax,nTex
mov edx,offset @@nTex2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@iTex }
mov eax,iTex
mov edx,offset @@iTex-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end else
begin
if Texture.iAxisConstant then
begin
if Texture.iAxis.X<>0 then
4699,7 → 5344,7
end;
end;
end else
begin
//begin
if UseMMX then
begin
FMMXUsed := True;
4734,6 → 5379,7
end;
end else
begin
 
asm
jmp @@EndCode
@@StartCode:
4772,6 → 5418,51
end;
end;
 
procedure genUpdateRHW(var Code: Pointer);
var
nRHW, iRHW: Pointer;
begin
if not RHW.Enable then Exit;
 
nRHW := @RHW.nRHW;
iRHW := @RHW.iRHW;
 
asm
jmp @@EndCode
@@StartCode:
// 64 bit addition
mov eax,dword ptr [offset _null]{}@@iRHW:
mov edx,dword ptr [offset _null]{}@@iRHW2:
add dword ptr [offset _null],eax{}@@nRHW:
adc dword ptr [offset _null],edx{}@@nRHW2:
@@EndCode:
{$I DXRender.inc}
{ @@nRHW }
mov eax,nRHW
mov edx,offset @@nRHW-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@nRHW2 }
mov eax,nRHW; add eax,4
mov edx,offset @@nRHW2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@iRHW }
mov eax,iRHW
mov edx,offset @@iRHW-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@iRHW }
mov eax,iRHW; add eax,4
mov edx,offset @@iRHW2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
 
procedure genBlend(var Code: Pointer; Blend: TDXR_Blend;
Dest, Col1, Col2: PDXRMachine_Color; EnableChannels: TDXRColorChannels;
ConstChannels1, ConstChannels2: TDXRColorChannels);
4928,7 → 5619,7
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
4963,7 → 5654,7
begin
if Dest=Col1 then Exit;
 
if UseMMX then
if UseMMX then //False then//UseMMX then
begin
FMMXUsed := True;
asm
5072,8 → 5763,9
@@StartCode:
db $0F,$6F,$05,$11,$11,$11,$11/// movq mm0,qword ptr [$11111111]
@@Col1:
db $0F,$DD,$05,$11,$11,$11,$11/// paddusw mm0,qword ptr [$11111111]
db $0F,$6F,$0D,$11,$11,$11,$11///movq mm1,qword ptr [$11111111]
@@Col2:
db $0F,$DD,$C1 ///paddusw mm0,mm1
db $0F,$7F,$05,$11,$11,$11,$11/// movq qword ptr [$11111111],mm0
@@Dest:
@@EndCode:
5156,6 → 5848,102
end;
end;
 
procedure genBlend_ONE2_SUB_ONE1(var Code: Pointer; Dest, Col1, Col2: PDXRMachine_Color;
ConstChannels1, ConstChannels12: TDXRColorChannels);
begin
if UseMMX then
begin
FMMXUsed := True;
asm
jmp @@EndCode
@@StartCode:
db $0F,$6F,$05,$11,$11,$11,$11///movq mm0,qword ptr [$11111111]
@@Col1:
db $0F,$6F,$0D,$11,$11,$11,$11///movq mm1,qword ptr [$11111111]
@@Col2:
db $0F,$D9,$C8 ///psubusw mm1,mm0
db $0F,$7F,$0D,$11,$11,$11,$11///movq qword ptr [$11111111],mm1
@@Dest:
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end else
begin
{ Red Channel }
if chRed in EnableChannels then
begin
if chRed in ConstChannels1 then
begin
Func_col1_Sub_const2(Code, @Dest.R, @Col2.R, @Col1.R);
end else
if chRed in ConstChannels2 then
begin
Func_const1_Sub_col2(Code, @Dest.R, @Col1.R, @Col2.R);
end else
Func_col1_Sub_col2(Code, @Dest.R, @Col2.R, @Col1.R);
end;
 
{ Green Channel }
if chRed in EnableChannels then
begin
if chRed in ConstChannels1 then
begin
Func_col1_Sub_const2(Code, @Dest.G, @Col2.G, @Col1.G);
end else
if chRed in ConstChannels2 then
begin
Func_const1_Sub_col2(Code, @Dest.G, @Col1.G, @Col2.G);
end else
Func_col1_Sub_col2(Code, @Dest.G, @Col2.G, @Col1.G);
end;
 
{ Blue Channel }
if chRed in EnableChannels then
begin
if chRed in ConstChannels1 then
begin
Func_col1_Sub_const2(Code, @Dest.B, @Col2.B, @Col1.B);
end else
if chRed in ConstChannels2 then
begin
Func_const1_Sub_col2(Code, @Dest.B, @Col1.B, @Col2.B);
end else
Func_col1_Sub_col2(Code, @Dest.B, @Col2.B, @Col1.B);
end;
 
{ Alpha Channel }
if chRed in EnableChannels then
begin
if chRed in ConstChannels1 then
begin
Func_col1_Sub_const2(Code, @Dest.A, @Col2.A, @Col1.A);
end else
if chRed in ConstChannels2 then
begin
Func_const1_Sub_col2(Code, @Dest.A, @Col1.A, @Col2.A);
end else
Func_col1_Sub_col2(Code, @Dest.A, @Col2.A, @Col1.A);
end;
end;
end;
 
procedure genBlend_ONE1_SUB_ONE2(var Code: Pointer; Dest, Col1, Col2: PDXRMachine_Color;
ConstChannels1, ConstChannels12: TDXRColorChannels);
begin
5303,19 → 6091,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5333,19 → 6121,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5363,19 → 6151,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5393,19 → 6181,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5424,7 → 6212,7
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5467,13 → 6255,13
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5491,13 → 6279,13
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5542,13 → 6330,13
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5566,13 → 6354,13
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5591,7 → 6379,7
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5611,19 → 6399,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5644,19 → 6432,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5677,19 → 6465,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5710,19 → 6498,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5740,7 → 6528,7
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5761,19 → 6549,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5795,19 → 6583,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5829,19 → 6617,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5863,19 → 6651,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5895,7 → 6683,7
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5953,19 → 6741,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
5987,19 → 6775,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6059,19 → 6847,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6093,19 → 6881,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6126,7 → 6914,7
@@EndCode:
{$I DXRender.inc}
{ @@Col1A }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1A-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6184,19 → 6972,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6218,19 → 7006,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6290,19 → 7078,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6324,19 → 7112,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6422,13 → 7210,13
@@EndCode:
{$I DXRender.inc}
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6436,7 → 7224,7
end;
end;
 
procedure genBlend_MODULATE_RGBONLY(var Code: Pointer; Dest, Col1, Col2: PDXRMachine_Color;
procedure genBlend_MODULATE(var Code: Pointer; Dest, Col1, Col2: PDXRMachine_Color;
ConstChannels1, ConstChannels12: TDXRColorChannels);
begin
if chRed in EnableChannels then
6450,19 → 7238,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.R+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6480,19 → 7268,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.G+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6510,19 → 7298,19
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.B+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6539,13 → 7327,13
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6553,6 → 7341,166
end;
end;
 
procedure genBlend_MODULATEALPHA(var Code: Pointer; Dest, Col1, Col2: PDXRMachine_Color;
ConstChannels1, ConstChannels12: TDXRColorChannels);
begin
if UseMMX then
begin
FMMXUsed := True;
asm
jmp @@EndCode
@@StartCode:
db $0F,$6F,$05,$11,$11,$11,$11///movq mm0,qword ptr [$11111111]
@@Col1:
db $0F,$6F,$0D,$11,$11,$11,$11///movq mm1,qword ptr [$11111111]
@@Col2:
db $0F,$E5,$C1 ///pmulhw mm0,mm1
db $0F,$7F,$05,$11,$11,$11,$11///movq qword ptr [$11111111],mm0
@@Dest:
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,offset Dest
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end else
begin
if chRed in EnableChannels then
begin
asm
jmp @@EndCode
@@StartCode:
mov al,byte ptr [offset offset _null]{}@@Col1:
mul byte ptr [offset offset _null] {}@@Col2:
mov byte ptr [offset offset _null],ah{}@@Dest:
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,Byte(TDXRMachine_Color.R+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
 
if chGreen in EnableChannels then
begin
asm
jmp @@EndCode
@@StartCode:
mov al,byte ptr [offset offset _null]{}@@Col1:
mul byte ptr [offset offset _null] {}@@Col2:
mov byte ptr [offset offset _null],ah{}@@Dest:
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,Byte(TDXRMachine_Color.G+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
 
if chBlue in EnableChannels then
begin
asm
jmp @@EndCode
@@StartCode:
mov al,byte ptr [offset offset _null]{}@@Col1:
mul byte ptr [offset offset _null] {}@@Col2:
mov byte ptr [offset offset _null],ah{}@@Dest:
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,Byte(TDXRMachine_Color.B+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
 
if chAlpha in EnableChannels then
begin
asm
jmp @@EndCode
@@StartCode:
mov al,byte ptr [offset offset _null]{}@@Col1:
mul byte ptr [offset offset _null] {}@@Col2:
mov byte ptr [offset offset _null],ah{}@@Dest:
@@EndCode:
{$I DXRender.inc}
{ @@Col1 }
mov eax,Col1; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col1-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Col2 }
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
end;
end;
end;
end;
 
procedure genBlend_ADD(var Code: Pointer; Dest, Col1, Col2: PDXRMachine_Color;
ConstChannels1, ConstChannels12: TDXRColorChannels);
begin
6601,13 → 7549,13
@@EndCode:
{$I DXRender.inc}
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6668,13 → 7616,13
@@EndCode:
{$I DXRender.inc}
{ @@Col2 }
mov eax,Col2; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Col2; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Col2-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
 
{ @@Dest }
mov eax,Dest; add eax,BYTE(TDXRMachine_Color.A+1)
mov eax,Dest; add eax,Byte(TDXRMachine_Color.A+1)
mov edx,offset @@Dest-4
sub edx,offset @@StartCode
mov dword ptr [ecx+edx],eax
6692,7 → 7640,7
DXR_BLEND_ONE2 : genBlend_ONE1(Code, Dest, Col2, ConstChannels2);
DXR_BLEND_ONE1_ADD_ONE2 : genBlend_ONE1_ADD_ONE2(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_ONE1_SUB_ONE2 : genBlend_ONE1_SUB_ONE2(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_ONE2_SUB_ONE1 : genBlend_ONE1_SUB_ONE2(Code, Dest, Col2, Col1, ConstChannels2, ConstChannels1);
DXR_BLEND_ONE2_SUB_ONE1 : genBlend_ONE2_SUB_ONE1(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_ONE1_MUL_ONE2 : genBlend_ONE1_MUL_ONE2(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_SRCALPHA1 : genBlend_SRCALPHA1(Code, Dest, Col1, ConstChannels1);
DXR_BLEND_SRCALPHA1_ADD_ONE2 : genBlend_SRCALPHA1_ADD_ONE2(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
6699,8 → 7647,10
DXR_BLEND_ONE2_SUB_SRCALPHA1 : genBlend_ONE2_SUB_SRCALPHA1(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_SRCALPHA1_ADD_INVSRCALPHA2: genBlend_SRCALPHA1_ADD_INVSRCALPHA2(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_INVSRCALPHA1_ADD_SRCALPHA2: genBlend_INVSRCALPHA1_ADD_SRCALPHA2(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_DECAL : genBlend_ONE1(Code, Dest, Col1, ConstChannels1);
DXR_BLEND_DECALALPHA : genBlend_DECALALPHA(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_MODULATE : genBlend_MODULATE_RGBONLY(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_MODULATE : genBlend_MODULATE(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_MODULATEALPHA : genBlend_MODULATEALPHA(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
DXR_BLEND_ADD : genBlend_ADD(Code, Dest, Col1, Col2, ConstChannels1, ConstChannels2);
end;
end;
6738,6 → 7688,10
begin
genReadTexture(Code, Result, TextureList[Tree.Texture], Tree.Channels);
end;
DXR_TREETYPE_LOADBUMPTEXTURE:
begin
genReadBumpTexture(Code, Result, TextureList[Tree.Texture], TextureList[Tree.BumpTexture], Tree.Channels);
end;
DXR_TREETYPE_LOADDESTPIXEL:
begin
genReadDestPixel(Code);
6883,7 → 7837,7
Col: PDXRMachine_Color;
begin
if (Tree.Typ=DXR_TREETYPE_LOADCOLOR) and (not ColorList[Tree.Color].Gouraud) and
(not Dither.Enable) and (Dest.BitCount in [16, 32]) then
(not ZBuffer.Enable) and (not Dither.Enable) and (Dest.BitCount in [16, 32]) then
begin
FCall := Code;
genInitDestAddress(Code);
6972,7 → 7926,9
genUpdateAxis(Code);
genUpdateColor(Code);
genUpdateTextureAxis(Code);
genUpdateRHW(Code);
genUpdateDestAddress(Code);
genUpdateZBufferAddress(Code);
 
asm
jmp @@EndCode
6986,6 → 7942,8
{ ----------- Main ----------- }
MainCode := Code;
 
genZBufferTest(Code);
 
if Tree.Typ=DXR_TREETYPE_LOADCOLOR then
begin
genEncodeColor2(Code, Dest^, @ColorList[Tree.Color].nColor, Tree.Channels);
6992,7 → 7950,7
genWriteDestPixel(Code);
end else
if (Tree.Typ=DXR_TREETYPE_LOADTEXTURE) and (not Dither.Enable) and
(TextureList[Tree.Texture].Filter in [DXR_TEXTUREFILTER_NEAREST]) and
(TextureList[Tree.Texture].Filter in [DXR_TEXTUREFILTER_NEAREST, DXR_TEXTUREFILTER_MIPMAP_NEAREST]) and
(dxrCompareSurface(Dest^, TextureList[Tree.Texture].Surface^)) then
begin
genReadSurfacePixel(Code, TextureList[Tree.Texture], @TextureList[Tree.Texture].nAxis);
7011,6 → 7969,7
FCall := Code;
 
genInitDestAddress(Code);
genInitZBuffer(Code);
 
genCmpFunc(Code, DXR_CMPFUNC_ALWAYS, MainCode);
end;
7075,7 → 8034,10
TexBlend := DXR_BLEND_MODULATE;
Blend := DXR_BLEND_ONE1;
TextureFilter := DXR_TEXTUREFILTER_NEAREST;
EnableDrawLine := $FFFFFFFF;
ZBuffer := nil;
ZFunc := DXR_CMPFUNC_LESSEQUAL;
ZWriteEnable := True;
EnableDrawLine := 0;
end;
 
for i:=0 to DXR_MAXTEXTURE-1 do
7087,6 → 8049,7
ColorKeyEnable := False;
ColorKey := 0;
TextureAddress := DXR_TEXTUREADDRESS_TILE;
BumpTexture := -1;
end;
end;
 
7108,6 → 8071,9
 
function InitGenerator_MakeTree_LoadTexture(Texture: Integer): PDXRMachine_Tree;
begin
if States.TextureList[Texture].BumpTexture>=0 then
Result := DXRMachine.CreateTree_LoadBumpTexture(Texture, States.TextureList[Texture].BumpTexture)
else
Result := DXRMachine.CreateTree_LoadTexture(Texture);
end;
 
7168,11 → 8134,17
var
i: Integer;
Layer: PDXR_TextureLayer;
Mipmap1, Mipmap2, Mipmap3: Integer;
TmpSurface2: PDXR_Surface;
begin
DXRMachine.Initialize;
 
{ Parameter setting }
DXRMachine.Dest := @Dest;
DXRMachine.ZBuffer.Enable := States.ZBuffer<>nil;
DXRMachine.ZBuffer.Surface := States.ZBuffer;
DXRMachine.ZBuffer.CmpFunc := States.ZFunc;
DXRMachine.ZBuffer.WriteEnable := States.ZWriteEnable;
DXRMachine.Dither.Enable := States.DitherEnable;
 
DXRMachine.ColorList[0].Gouraud := States.Shade=DXR_SHADEMODE_GOURAUD;
7192,9 → 8164,34
Surface := Layer.Surface;
Filter := States.TextureFilter;
TextureAddress := Layer.TextureAddress;
 
if (Filter in [DXR_TEXTUREFILTER_MIPMAP_NEAREST, DXR_TEXTUREFILTER_MIPMAP_LINEAR]) and
(Surface.MipmapChain<>nil) then
begin
{ Mipmap }
Mipmap1 := MaxInt;
Mipmap3 := Trunc(Abs(Hypot(Tri[2].sx-Tri[1].sx, Tri[2].sy-Tri[1].sy))*
Abs(Hypot(Tri[1].sx-Tri[0].sx, Tri[1].sy-Tri[0].sy))*
Abs(Hypot(Tri[2].sx-Tri[0].sx, Tri[2].sy-Tri[0].sy))/9);
 
TmpSurface2 := Surface;
 
while TmpSurface2<>nil do
begin
Mipmap2 := TmpSurface2.Width2*TmpSurface2.Height2;
 
if (Abs(Mipmap3-Mipmap2)<Abs(Mipmap3-Mipmap1)) then
begin
Surface := TmpSurface2;
Mipmap1 := Mipmap2;
end;
 
TmpSurface2 := TmpSurface2.MipmapChain;
end;
end;
end;
end;
end;
 
{ Tree making }
DXRMachine.Compile(InitGenerator_MakeTree);
7235,9 → 8232,15
Result := Comp2DWORD(d*TexYFloat[i]);
end;
 
function FloatToRHWFloat(d: Extended): Comp;
begin
Result := d*Int32Value;
end;
 
procedure drawline(x1, x2, y: Integer;
const x_ntex1, x_ntex2: T2DAxis64Array;
const x_nc1, x_nc2: TCol64Array);
const x_nc1, x_nc2: TCol64Array;
const x_nRHW1, x_nRHW2: Comp);
var
i, xcount, xcount2, ofs: Integer;
begin
7311,6 → 8314,17
end;
end;
 
with DXRMachine.RHW do
begin
if Enable then
begin
nRHW := x_nRHW1;
iRHW := (x_nRHW2-x_nRHW1) / xcount;
if ofs<>0 then
nRHW := nRHW + iRHW*ofs;
end;
end;
 
DXRMachine.Run(xcount2);
end;
 
7321,6 → 8335,7
y_nx1, y_nx2, y_ix1, y_ix2: Comp;
y_ntex1, y_ntex2, y_itex1, y_itex2: T2DAxis64Array;
y_nc1, y_nc2, y_ic1, y_ic2: TCol64Array;
y_nRHW1, y_nRHW2, y_iRHW1, y_iRHW2: Comp;
begin
if ycount<=0 then Exit;
if y1=0 then Exit;
7436,15 → 8451,40
end;
end;
 
if DXRMachine.RHW.Enable then
begin
y_nRHW1 := FloatToRHWFloat(p1.rhw);
y_nRHW2 := FloatToRHWFloat(p2.rhw);
y_iRHW1 := FloatToRHWFloat((pt1.rhw-p1.rhw)/y1);
y_iRHW2 := FloatToRHWFloat((pt2.rhw-p2.rhw)/y2);
 
if ofs1<>0 then
begin
y_nRHW1 := y_nRHW1 + y_iRHW1*ofs1;
end;
 
if ofs2<>0 then
begin
y_nRHW2 := y_nRHW2 + y_iRHW2*ofs2;
end;
end else
begin
y_nRHW1 := 0;
y_nRHW2 := 0;
y_iRHW1 := 0;
y_iRHW2 := 0;
end;
 
for y:=starty to starty+ycount-1 do
begin
if States.EnableDrawLine and (1 shl (y and 31))<>0 then
if (States.EnableDrawLine=0) or ((States.EnableDrawLine-1)=y mod 2) then
if PInteger(Integer(@y_nx1)+4)^<PInteger(Integer(@y_nx2)+4)^ then
begin
drawline(
PInteger(Integer(@y_nx1)+4)^, PInteger(Integer(@y_nx2)+4)^, y,
y_ntex1, y_ntex2,
y_nc1, y_nc2
y_nc1, y_nc2,
y_nRHW1, y_nRHW2
);
end else if PInteger(Integer(@y_nx1)+4)^>PInteger(Integer(@y_nx2)+4)^ then
begin
7451,7 → 8491,8
drawline(
PInteger(Integer(@y_nx2)+4)^, PInteger(Integer(@y_nx1)+4)^, y,
y_ntex2, y_ntex1,
y_nc2, y_nc1
y_nc2, y_nc1,
y_nRHW2, y_nRHW1
);
end;
 
7482,8 → 8523,14
y_nc2[i].A := y_nc2[i].A + y_ic2[i].A;
end;
end;
 
if DXRMachine.RHW.Enable then
begin
y_nRHW1 := y_nRHW1 + y_iRHW1;
y_nRHW2 := y_nRHW2 + y_iRHW2;
end;
end;
end;
 
var
p: array[0..2] of PDXR_Vertex;
7521,6 → 8568,9
if (p[0].sx>=Dest.Width) and (p[1].sx>=Dest.Width) and (p[2].sx>=Dest.Width) then Exit;
 
{ Generate code }
if States.TextureFilter in [DXR_TEXTUREFILTER_MIPMAP_NEAREST, DXR_TEXTUREFILTER_MIPMAP_LINEAR] then
DXRMachine.Compiled := False;
 
if not DXRMachine.Compiled then
InitGenerator;
 
7679,18 → 8729,18
idiv c
end;
 
function Max(B1, B2: Integer): Integer;
function Max(B1, B2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if B1>=B2 then Result := B1 else Result := B2;
end;
 
function Min(B1, B2: Integer): Integer;
function Min(B1, B2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if B1<=B2 then Result := B1 else Result := B2;
end;
 
function BltClipX(const Dest, Src: TDXR_Surface;
var StartX, EndX, StartSrcX: Integer): Boolean;
var StartX, EndX, StartSrcX: Integer): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if StartX<0 then
begin
7704,7 → 8754,7
end;
 
function BltClipY(const Dest, Src: TDXR_Surface;
var StartY, EndY, StartSrcY: Integer): Boolean;
var StartY, EndY, StartSrcY: Integer): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
begin
if StartY<0 then
begin
7718,7 → 8768,7
end;
 
function BltClip(const Dest, Src: TDXR_Surface;
var StartX, StartY, EndX, EndY, StartSrcX, StartSrcY: Integer): Boolean;
var StartX, StartY, EndX, EndY, StartSrcX, StartSrcY: Integer): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
begin
Result := BltClipX(Dest, Src, StartX, EndX, StartSrcX) and
BltClipY(Dest, Src, StartY, EndY, StartSrcY);
7725,7 → 8775,7
end;
 
function FillClip(const Dest: TDXR_Surface;
var StartX, StartY, EndX, EndY: Integer): Boolean;
var StartX, StartY, EndX, EndY: Integer): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
begin
StartX := Max(StartX, 0);
StartY := Max(StartY, 0);
7738,7 → 8788,7
var
CosinTable: array[0..255] of Double;
 
procedure InitCosinTable;
procedure InitCosinTable; {$IFDEF VER9UP}inline;{$ENDIF}
var
i: Integer;
begin
7746,12 → 8796,12
CosinTable[i] := Cos((i/256)*2*PI);
end;
 
function Cos256(i: Integer): Double;
function Cos256(i: Integer): Double; {$IFDEF VER9UP}inline;{$ENDIF}
begin
Result := CosinTable[i and 255];
end;
 
function Sin256(i: Integer): Double;
function Sin256(i: Integer): Double; {$IFDEF VER9UP}inline;{$ENDIF}
begin
Result := CosinTable[(i+192) and 255];
end;
8072,10 → 9122,23
end;
end;
 
//var TextureSurface, DestSurface: TDXR_Surface; RenderStates: TDXR_RenderStates;
//
//dxrDefRenderStates(RenderStates);
//if dxrDDSurfaceLock(Surf.ISurface, DestSurface then begin
// dxrDDSurfaceLock(TextureSurface as IDirectDrawSurface, TextureSurface);
// RenderStates.TextureList<0>.Surface:=@TextureSurface;
// dxrDrawPrimitive(DestSurface, RenderStates, DXR_PRIMITIVETYPE_TRIANGLELIST, @VertexList, 36);
// dxrDDSurfaceUnlock(SurfaceTexture as IDirectDrawSurface, TextureSurface);
// dxrDDSurfaceUnlock(Surf.ISurface, DestSurface);
//end;
 
initialization
ReadCPUID;
Init;
InitCosinTable;
 
dxrSetOption(DXR_OPTION_MMXENABLE, 1);
finalization
FDXRMachine.Free;
end.
end.
/VCL_DELPHIX_D6/DXSounds.pas
5,8 → 5,13
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem,
DirectX, DXClass, Wave;
Windows, Messages, SysUtils, Classes, Controls, Forms, ExtCtrls, MMSystem, ActiveX,
DXClass, DXWave, D3DUtils, {$IFDEF VER17UP} Types, {$ENDIF}
{$IFDEF StandardDX}
DirectSound, DirectMusic;
{$ELSE}
DirectX;
{$ENDIF}
 
type
 
43,6 → 48,50
property ISound: IDirectSound read GetISound;
end;
 
{ TD3DSParams }
 
TConeAngle = record
Inside,Outside:DWord;
end;
TD3DSParams = class
private
FOwner: TDirectSoundBuffer;
 
FDsb: TDS3DBUFFER;
 
function GetPosition: TD3DVector;
function GetVelocity: TD3DVector;
function GetConeOrientation: TD3DVector;
function GetConeAngle: TConeAngle;
function GetConeOutsideVolume: Integer;
function GetMinDistance: TD3DValue;
function GetMaxDistance: TD3DValue;
function GetRaw: TDS3DBuffer;
 
procedure SetPosition(const v: TD3DVector);
procedure SetVelocity(const v: TD3DVector);
procedure SetConeOrientation(const v: TD3DVector);
procedure SetConeAngle(const v: TConeAngle);
procedure SetConeOutsideVolume(const v: Integer);
procedure SetMinDistance(const v: TD3DValue);
procedure SetMaxDistance(const v: TD3DValue);
procedure SetRaw(const v: TDS3DBuffer);
 
function CheckValidity: Boolean;
public
constructor Create(Owner: TDirectSoundBuffer);
destructor Destroy; override;
property Position: TD3DVector read getPosition write setPosition;
property Velocity: TD3DVector read getVelocity write setVelocity;
property ConeOrientation: TD3DVector read getConeOrientation write setConeOrientation;
property ConeAngle: TConeAngle read getConeAngle write setConeAngle;
property ConeOutsideVolume: Integer read getConeOutsideVolume write setConeOutsideVolume;
property MinDistance: TD3DValue read getMinDistance write setMinDistance;
property MaxDistance: TD3DValue read getMaxDistance write setMaxDistance;
property RawParams: TDS3DBuffer read getRaw write setRaw;
procedure Assign(Prms: TD3DSParams);
end;
 
{ TDirectSoundBuffer }
 
TDirectSoundBuffer = class(TDirectX)
49,6 → 98,8
private
FDSound: TDirectSound;
FIDSBuffer: IDirectSoundBuffer;
FIDS3DBuffer:IDirectSound3DBuffer;
FD3DSParams: TD3DSParams;
FCaps: TDSBCaps;
FFormat: PWaveFormatEx;
FFormatSize: Integer;
55,6 → 106,7
FLockAudioPtr1, FLockAudioPtr2: array[0..0] of Pointer;
FLockAudioSize1, FLockAudioSize2: array[0..0] of DWORD;
FLockCount: Integer;
FIsD3D: Boolean;
function GetBitCount: Longint;
function GetFormat: PWaveFormatEx;
function GetFrequency: Integer;
71,6 → 123,9
procedure SetPan(Value: Integer);
procedure SetPosition(Value: Longint);
procedure SetVolume(Value: Integer);
function GetIDS3DBuffer: IDirectSound3DBuffer;
procedure SetIDS3DBuffer(const Value: IDirectSound3DBuffer);
procedure SetD3DSParams(const Value: TD3DSParams);
protected
procedure Check; override;
public
89,7 → 144,7
function Play(Loop: Boolean{$IFNDEF VER100}=False{$ENDIF}): Boolean;
function Restore: Boolean;
function SetFormat(const Format: TWaveFormatEx): Boolean;
procedure SetSize(const Format: TWaveFormatEx; Size: Integer);
procedure SetSize(const Format: TWaveFormatEx; Size: Integer; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
procedure Stop;
procedure UnLock;
property BitCount: Longint read GetBitCount;
99,8 → 154,11
property Frequency: Integer read GetFrequency write SetFrequency;
property IBuffer: IDirectSoundBuffer read GetIBuffer;
property IDSBuffer: IDirectSoundBuffer read GetIDSBuffer write SetIDSBuffer;
property IDS3DBuffer: IDirectSound3DBuffer read GetIDS3DBuffer write SetIDS3DBuffer;
property Playing: Boolean read GetPlaying;
property Pan: Integer read GetPan write SetPan;
property D3DSParams: TD3DSParams read FD3DSParams write SetD3DSParams;
property IsD3D: Boolean read FIsD3D write FIsD3D default False;
property Position: Longint read GetPosition write SetPosition;
property Size: Integer read GetSize;
property Volume: Integer read GetVolume write SetVolume;
377,6 → 435,8
procedure SetPan(Value: Integer);
procedure SetVolume(Value: Integer);
procedure SetWave(Value: TWave);
protected
function GetPlaying: boolean;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
389,6 → 449,8
property Pan: Integer read FPan write SetPan;
property Volume: Integer read FVolume write SetVolume;
property WaveCollection: TWaveCollection read GetWaveCollection;
 
property Playing: boolean read GetPlaying;
published
property Looped: Boolean read FLooped write SetLooped;
property MaxPlayingCount: Integer read FMaxPlayingCount write SetMaxPlayingCount;
445,10 → 507,125
property Items;
end;
 
{ EDXMusicError }
 
EDXMusicError = class(Exception);
 
TMusicListCollection = class;
 
{ TMusicListCollectionItem }
 
TMusicDataProp = class(TPersistent)
private
FMusicData: string;
FMidiname: string;
function GetMusicData: string;
procedure SetMusicData(const Value: string);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadMidiData(Stream: TStream);
procedure WriteMidiData(Stream: TStream);
public
property MusicData: string read GetMusicData write SetMusicData;
published
property MidiName: string read FMidiname write FMidiname;
end;
 
TMusicListCollectionItem = class(THashCollectionItem)
private
{ Private declarations }
FDirectMusicPerformance: IDirectMusicPerformance;
FDirectSound: IDirectSound;
FDirectMusic: IDirectMusic;
FDirectMusicLoader: IDirectMusicLoader;
FDirectMusicSegment: IDirectMusicSegment;
FMusicObjDesc: TDMus_ObjectDesc;
FDirectMusicSegmentState: IDirectMusicSegmentState;
FRepeats: Cardinal;
FStartpoint: Integer;
FDuration: Integer;
// startpoint props in seconds these used to hold millisecond value
FActualDuration: Integer;
FActualStartPoint: Integer;
FIsInitialized: Boolean;
FMusicDataProp: TMusicDataProp;
procedure SetDuration(const Value: integer);
procedure SetRepeats(const Value: Cardinal);
procedure SetStartPoint(const Value: integer);
function GetMusicListCollection: TMusicListCollection;
protected
function GetDisplayName: string; override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
function Size: Integer;
procedure Play;
function IsPlaying: Boolean;
procedure Stop;
procedure Load;
procedure Init;
procedure LoadFromFile(const MidiFileName: string);
procedure SaveToFile(const MidiFileName: string);
property MusicCollection: TMusicListCollection read GetMusicListCollection;
property IsInitialized: Boolean read FIsInitialized write FIsInitialized;
published
property Name;
property Repeats: Cardinal read Frepeats write SetRepeats;
property Duration: integer read FDuration write SetDuration;
property StartPoint: integer read FStartPoint write SetStartPoint;
property Midi: TMusicDataProp read FMusicDataProp write FMusicDataProp;
end;
 
{ TMusicListCollection }
 
TMusicListCollection = class(THashCollection)
private
FOwner: TPersistent;
FDirectSound: IDirectSound;
protected
function GetItem(Index: Integer): TMusicListCollectionItem;
procedure SetItem(Index: Integer; Value: TMusicListCollectionItem);
procedure Update(Item: TCollectionItem); override;
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TComponent);
function Add: TMusicListCollectionItem;
function Find(const Name: string): TMusicListCollectionItem;
procedure Restore;
procedure LoadFromFile(const FileName: string);
procedure LoadFromStream(Stream: TStream);
procedure SaveToFile(const FileName: string);
procedure SaveToStream(Stream: TStream);
{$IFDEF VER4UP}
function Insert(Index: Integer): TMusicListCollectionItem;
{$ENDIF}
property Items[Index: Integer]: TMusicListCollectionItem read GetItem write SetItem;
published
end;
 
{ TDXMusic }
 
TDXMusic = class(TComponent)
private
FDXSound: TDXSound;
FMidis: TMusicListCollection;
procedure SetMidis(const value: TMusicListCollection);
procedure SetDXSound(const Value: TDXSound);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property DXSound: TDXSound read FDXSound write SetDXSound;
property Midis: TMusicListCollection read FMidis write SetMidis;
end;
 
implementation
 
uses DXConsts;
 
const
dm_OK = 0;
 
function DXDirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound;
pUnkOuter: IUnknown): HRESULT;
type
501,8 → 678,8
DirectSoundDrivers: TDirectXDrivers;
DirectSoundCaptureDrivers: TDirectXDrivers;
 
function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: LPCSTR;
lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
function EnumDirectSoundDrivers_DSENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
begin
Result := True;
with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
623,7 → 800,9
constructor TDirectSoundBuffer.Create(ADirectSound: TDirectSound);
begin
inherited Create;
FIsD3D := False;
FDSound := ADirectSound;
FIDS3DBuffer := nil;
FDSound.FBufferList.Add(Self);
end;
 
630,6 → 809,7
destructor TDirectSoundBuffer.Destroy;
begin
IDSBuffer := nil;
IDS3DBuffer := nil;
FDSound.FBufferList.Remove(Self);
inherited Destroy;
end;
640,21 → 820,35
begin
if Source=nil then
IDSBuffer := nil
else if Source is TWave then
else
if Source is TWave then
LoadFromWave(TWave(Source))
else if Source is TDirectSoundBuffer then
else
if Source is TDirectSoundBuffer then
begin
if TDirectSoundBuffer(Source).IDSBuffer=nil then
IDSBuffer := nil
else begin
FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer,
TempBuffer);
if FDSound.DXResult=0 then
else
begin
FDSound.DXResult := FDSound.ISound.DuplicateSoundBuffer(TDirectSoundBuffer(Source).IDSBuffer, TempBuffer);
if FDSound.DXResult = DS_OK then
begin
IDSBuffer := TempBuffer;
end;
end;
end else
 
if FIsD3D then
if TDirectSoundBuffer(Source).IDS3DBuffer = nil then
IDS3DBuffer := nil
else
begin
FDSound.DXResult := FDSound.ISound.QueryInterface(IID_IDirectSound3DBuffer, FIDS3DBuffer);
if FDSound.DXResult = DS_OK then
FD3DSParams := TDirectSoundBuffer(Source).FD3DSParams;
end;
 
end
else
inherited Assign(Source);
end;
 
692,6 → 886,14
DXResult := IBuffer.GetFrequency(DWORD(Result));
end;
 
function TDirectSoundBuffer.GetIDS3DBuffer: IDirectSound3DBuffer;
begin
if Self <> nil then
Result := FIDS3DBuffer
else
Result := nil;
end;
 
function TDirectSoundBuffer.GetIDSBuffer: IDirectSoundBuffer;
begin
if Self<>nil then
721,7 → 923,7
var
dwCurrentWriteCursor: Longint;
begin
IBuffer.GetCurrentPosition(DWORD(Result), DWORD(dwCurrentWriteCursor));
IBuffer.GetCurrentPosition(@DWORD(Result), @DWORD(dwCurrentWriteCursor));
end;
 
function TDirectSoundBuffer.GetSize: Integer;
757,7 → 959,7
Data1, Data2: Pointer;
Data1Size, Data2Size: Longint;
begin
SetSize(Format, Size);
SetSize(Format, Size, FIsD3D);
 
if Data<>nil then
begin
770,9 → 972,11
finally
UnLock;
end;
end else
end
else
begin
FIDSBuffer := nil;
FIDS3DBuffer := nil;
raise EDirectSoundBufferError.CreateFmt(SCannotLock, [SDirectSoundBuffer]);
end;
end;
804,10 → 1008,9
if IDSBuffer=nil then Exit;
 
if FLockCount>High(FLockAudioPtr1) then Exit;
 
DXResult := IBuffer.Lock(LockPosition, LockSize,
FLockAudioPtr1[FLockCount], FLockAudioSize1[FLockCount],
FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount], 0);
{$IFNDEF DX7}@{$ENDIF}FLockAudioPtr1[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize1[FLockCount],
{$IFNDEF DX7}@{$ENDIF}FLockAudioPtr2[FLockCount], {$IFNDEF DX7}@{$ENDIF}FLockAudioSize2[FLockCount], 0);
Result := DXResult=DS_OK;
 
if Result then
835,9 → 1038,14
Result := DXResult=DS_OK;
end;
 
procedure TDirectSoundBuffer.SetD3DSParams(const Value: TD3DSParams);
begin
FD3DSParams.Assign(Value);
end;
 
function TDirectSoundBuffer.SetFormat(const Format: TWaveFormatEx): Boolean;
begin
DXResult := IBuffer.SetFormat(Format);
DXResult := IBuffer.SetFormat(FFormat{$IFDEF DX7}^{$ENDIF});
Result := DXResult=DS_OK;
 
if Result then
845,10 → 1053,10
FreeMem(FFormat);
FFormat := nil;
FFormatSize := 0;
if IBuffer.GetFormat(PWaveFormatEx(nil)^, 0, DWORD(FFormatSize))=DS_OK then
if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
begin
GetMem(FFormat, FFormatSize);
IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
IBuffer.GetFormat(FFormat, FFormatSize, nil);
end;
end;
end;
858,6 → 1066,30
DXResult := IBuffer.SetFrequency(Value);
end;
 
procedure TDirectSoundBuffer.SetIDS3DBuffer(const Value: IDirectSound3DBuffer);
begin
if FIDS3DBuffer = Value then Exit;
 
FIDS3DBuffer := Value;
FillChar(FCaps, SizeOf(FCaps), 0);
FreeMem(FFormat);
FFormat := nil;
FFormatSize := 0;
FLockCount := 0;
 
if FIDS3DBuffer <> nil then
begin
FCaps.dwSize := SizeOf(FCaps);
IBuffer.GetCaps(FCaps);
 
if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
begin
GetMem(FFormat, FFormatSize);
IBuffer.GetFormat(FFormat, FFormatSize, nil);
end;
end;
end;
 
procedure TDirectSoundBuffer.SetIDSBuffer(Value: IDirectSoundBuffer);
begin
if FIDSBuffer=Value then Exit;
874,10 → 1106,10
FCaps.dwSize := SizeOf(FCaps);
IBuffer.GetCaps(FCaps);
 
if IBuffer.GetFormat(PWaveFormatEx(nil)^, 0, DWORD(FFormatSize))=DS_OK then
if IBuffer.GetFormat(PWaveFormatEx(nil), 0, @DWORD(FFormatSize)) = DS_OK then
begin
GetMem(FFormat, FFormatSize);
IBuffer.GetFormat(FFormat^, FFormatSize, PDWORD(nil)^);
IBuffer.GetFormat(FFormat, FFormatSize, nil);
end;
end;
end;
891,8 → 1123,12
begin
DXResult := IBuffer.SetCurrentPosition(Value);
end;
{$IFNDEF DX7}
const
DSBCAPS_CTRLDEFAULT = DSBCAPS_CTRLFREQUENCY or DSBCAPS_CTRLPAN or DSBCAPS_CTRLVOLUME;
{$ENDIF}
 
procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer);
procedure TDirectSoundBuffer.SetSize(const Format: TWaveFormatEx; Size: Integer; D3D: Boolean {$IFNDEF VER100}= False{$ENDIF});
var
BufferDesc: TDSBufferDesc;
begin
907,6 → 1143,8
dwFlags := dwFlags or DSBCAPS_STICKYFOCUS
else if DSound.FGlobalFocus then
dwFlags := dwFlags or DSBCAPS_GLOBALFOCUS;
if D3D then
dwFlags := DSBCAPS_STATIC + DSBCAPS_CTRLDEFAULT + DSBCAPS_CTRL3D - DSBCAPS_CTRLPAN;
dwBufferBytes := Size;
lpwfxFormat := @Format;
end;
935,6 → 1173,207
FLockAudioPtr2[FLockCount], FLockAudioSize2[FLockCount]);
end;
 
{ TD3DSParams }
 
function TD3DSParams.CheckValidity: Boolean;
begin
Result := (FOwner <> nil) and (TDirectSoundBuffer(FOwner).IDS3DBuffer <> nil)
end;
 
constructor TD3DSParams.Create(Owner: TDirectSoundBuffer);
{$IFDEF VER14UP}
function MakeD3DVector(x, y, z: TD3DValue): TD3DVector; {$IFDEF VER9UP}inline; {$ENDIF}
begin
Result.x := x;
Result.y := y;
Result.z := z;
end;
{$ENDIF}
begin
inherited Create;
FOwner := Owner;
with FDsb do
begin
dwSize := SizeOf(TDS3DBuffer);
vPosition := MakeD3DVector(0, 0, 0);
vVelocity := MakeD3DVector(0, 0, 0);
dwInsideConeAngle := DS3D_DEFAULTCONEANGLE;
dwOutsideConeAngle := DS3D_DEFAULTCONEANGLE;
vConeOrientation := MakeD3DVector(0, 0, 0);
lConeoutsideVolume := DS3D_DEFAULTCONEOUTSIDEVOLUME;
flMinDistance := 5;
flMaxDistance := 100.0;
dwMode := DS3DMODE_NORMAL;
end;
end;
 
destructor TD3DSParams.destroy;
begin
inherited destroy;
end;
 
function TD3DSParams.getPosition: TD3DVector;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetPosition(FDsb.vPosition);
end;
result := FDsb.vPosition;
end;
 
function TD3DSParams.getVelocity: TD3DVector;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetVelocity(FDsb.vVelocity);
end;
result := FDsb.vVelocity;
end;
 
function TD3DSParams.getConeOrientation: TD3DVector;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetConeOrientation(FDsb.vConeOrientation);
end;
result := FDsb.vConeOrientation;
end;
 
function TD3DSParams.getConeAngle: TConeAngle;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetConeAngles(FDsb.dwInsideConeAngle, FDsb.dwOutsideConeAngle);
end;
with result do
begin
Inside := FDsb.dwInsideConeAngle;
OutSide := FDsb.dwOutsideConeAngle;
end;
end;
 
function TD3DSParams.getConeOutsideVolume: Integer;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetConeOutsideVolume(FDsb.lConeOutsideVolume);
end;
result := FDsb.lConeOutsideVolume;
end;
 
function TD3DSParams.getMinDistance: TD3DValue;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetMinDistance(FDsb.flMinDistance);
end;
result := FDsb.flMinDistance;
end;
 
function TD3DSParams.getMaxDistance: TD3DValue;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetMaxDistance(FDsb.flMaxDistance);
end;
result := FDsb.flMaxDistance;
end;
 
function TD3DSParams.getRaw: TDS3DBuffer;
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.GetAllParameters(FDsb);
end;
result := FDsb;
end;
 
 
procedure TD3DSParams.setPosition(const v: TD3DVector);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetPosition(v.x, v.y, v.z, DS3D_IMMEDIATE);
end;
FDsb.vPosition := v;
end;
 
procedure TD3DSParams.setVelocity(const v: TD3DVector);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetVelocity(v.x, v.y, v.z, DS3D_IMMEDIATE);
end;
FDsb.vVelocity := v;
end;
 
procedure TD3DSParams.setConeOrientation(const v: TD3DVector);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetConeOrientation(v.x, v.y, v.z, DS3D_IMMEDIATE);
end;
FDsb.vConeOrientation := v;
end;
 
procedure TD3DSParams.setConeAngle(const v: TConeAngle);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetConeAngles(v.Inside, v.Outside, DS3D_IMMEDIATE);
end;
FDsb.dwInsideConeAngle := v.Inside;
FDsb.dwInsideConeAngle := v.Outside;
end;
 
procedure TD3DSParams.setConeOutsideVolume(const v: Integer);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetConeOutsideVolume(v, DS3D_IMMEDIATE);
end;
FDsb.lConeOutsideVolume := v;
end;
 
procedure TD3DSParams.setMinDistance(const v: TD3DValue);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetMinDistance(v, DS3D_IMMEDIATE);
end;
FDsb.flMinDistance := v;
end;
 
procedure TD3DSParams.setMaxDistance(const v: TD3DValue);
begin
if CheckValidity then
begin
FOwner.IDS3DBuffer.SetMaxDistance(v, DS3D_IMMEDIATE);
end;
FDsb.flMaxDistance := v;
end;
 
procedure TD3DSParams.setRaw(const v: TDS3DBuffer);
begin
if CheckValidity then
begin
if FOwner.IDS3DBuffer.SetAllParameters(v, DS3D_IMMEDIATE) <> DS_OK then
{'Parameter is invalid for Params3D'};
end;
FDsb := v;
end;
 
procedure TD3DSParams.Assign(Prms: TD3DSParams);
begin
FDsb := Prms.RawParams;
 
if CheckValidity then
begin
if FOwner.IDS3DBuffer.SetAllParameters(FDsb, DS3D_IMMEDIATE) <> DS_OK then
{'Parameter is invalid for Params3D'};
end;
end;
 
{ TAudioStream }
 
type
1662,7 → 2101,7
var
CapturePosition, ReadPosition: DWORD;
begin
if FBuffer.GetCurrentPosition(CapturePosition, ReadPosition)=DS_OK then
if FBuffer.GetCurrentPosition(@DWORD(CapturePosition), @DWORD(ReadPosition)) = DS_OK then
begin
if FBufferPos<=ReadPosition then
Result := ReadPosition - FBufferPos
1681,7 → 2120,8
begin
if not FCapturing then
Start;
 
Data1 := nil;
Data2 := nil;
Result := 0;
while Result<Count do
begin
1688,7 → 2128,8
Size := Min(Count-Result, GetReadSize);
if Size>0 then
begin
if FBuffer.Lock(FBufferPos, Size, Data1, Data1Size, Data2, Data2Size, 0)=DS_OK then
if FBuffer.Lock(FBufferPos, Size, Data1, {$IFNDEF DX7}@{$ENDIF}Data1Size,
Data2, {$IFNDEF DX7}@{$ENDIF}Data2Size, 0) = DS_OK then
begin
Move(Data1^, Pointer(Integer(@Buffer)+Result)^, Data1Size);
Result := Result + Integer(Data1Size);
1800,7 → 2241,6
FDSound := ADSound;
FEnabled := True;
 
 
FEffectList := TList.Create;
FTimer := TTimer.Create(nil);
FTimer.Interval := 500;
2223,10 → 2663,37
 
if PrevInitialized then
Restore;
end else
end
else
inherited Assign(Source);
end;
 
function TWaveCollectionItem.GetPlaying: boolean;
var
Buffer: TDirectSoundBuffer;
index: integer;
begin
Result := False;
if not FInitialized then Exit;
Assert(GetBuffer <> nil);
Assert(FBufferList <> nil);
if FLooped then
begin
Buffer := GetBuffer;
Assert(Buffer <> nil);
Result := Buffer.Playing;
end
else
begin
for index := 0 to FBufferList.Count - 1 do
begin
Result := TDirectSoundBuffer(FBufferList[index]).Playing;
if Result then
Break;
end;
end;
end; {GetPlaying}
 
function TWaveCollectionItem.GetBuffer: TDirectSoundBuffer;
begin
if FInitialized and (FBuffer=nil) then
2284,7 → 2751,8
GetBuffer.Stop;
GetBuffer.Position := 0;
GetBuffer.Play(True);
end else
end
else
begin
NewBuffer := nil;
for i:=0 to FBufferList.Count-1 do
2302,7 → 2770,8
if NewBuffer=nil then Exit;
 
FBufferList.Add(NewBuffer);
end else
end
else
begin
if FBufferList.Count<FMaxPlayingCount then
begin
2310,7 → 2779,8
if NewBuffer=nil then Exit;
 
FBufferList.Add(NewBuffer);
end else
end
else
begin
NewBuffer := FBufferList[0];
FBufferList.Move(0, FBufferList.Count-1);
2592,6 → 3062,367
FItems.Assign(Value);
end;
 
{(c) 2006 Jaro Benes, Play midi from memory module}
 
{ TMusicDataProp }
 
type
TMidiDataHeader = packed record
Size: Integer;
end;
 
procedure TMusicDataProp.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('Midi', ReadMidiData, WriteMidiData, Length(Self.FMusicData) <> 0);
end;
 
function TMusicDataProp.GetMusicData: string;
begin
SetLength(Result, Length(FMusicData));
if Length(FMusicData) <> 0 then
Move(FMusicData[1], Result[1], Length(FMusicData));
end;
 
procedure TMusicDataProp.ReadMidiData(Stream: TStream);
var
Header: TMidiDataHeader;
begin
Stream.ReadBuffer(Header, SizeOf(Header));
SetLength(FMusicData, Header.Size);
Stream.ReadBuffer(FMusicData[1], Header.Size);
end;
 
procedure TMusicDataProp.SetMusicData(const Value: string);
begin
SetLength(FMusicData, Length(Value));
if Length(Value) <> 0 then
Move(Value[1], FMusicData[1], Length(Value));
end;
 
procedure TMusicDataProp.WriteMidiData(Stream: TStream);
var
Header: TMidiDataHeader;
begin
Header.Size := Length(FMusicData);
Stream.WriteBuffer(Header, SizeOf(Header));
Stream.WriteBuffer(FMusicData[1], Header.Size);
end;
 
{ TMusicListCollectionItem }
 
procedure TMusicListCollectionItem.Load;
var
MidiFilelength: Integer;
begin
// kdyby nahodou uz nejaky existoval tak ho znic
if FDirectMusicSegment <> nil then
FDirectMusicSegment := nil;
ZeroMemory(@FMusicObjDesc, SizeOf(TDMUS_OBJECTDESC));
// tohle je popisek parametru - chceme hrat z pameti
with FMusicObjDesc do
begin
dwsize := SizeOf(TDMUS_OBJECTDESC);
guidclass := CLSID_DirectMusicSegment;
//tohle jen pokud je to ze souboru
//dwvaliddata := DMUS_OBJ_CLASS or DMUS_OBJ_FULLPATH or DMUS_OBJ_FILENAME;
dwvaliddata := DMUS_OBJ_CLASS or DMUS_OBJ_MEMORY or DMUS_OBJ_LOADED;
pbMemData := @FMusicDataProp.FMusicData[1];
llMemLength := Length(FMusicDataProp.FMusicData);
end;
if FDirectMusicLoader.GetObject(FMusicObjDesc, IID_IDirectMusicSegment, FDirectMusicSegment) <> dm_ok then
raise EDXMusicError.Create('Failed to Get object for Direct music'); ;
if FDirectMusicSegment.setParam(GUID_StandardMidiFile, $FFFFFFFF, 0, 0, Pointer(FDirectMusicPerformance)) <> dm_ok then
raise EDXMusicError.Create('Failed to Set param for Direct music'); ;
if FDirectMusicSegment.setParam(GUID_Download, $FFFFFFFF, 0, 0, Pointer(FDirectMusicPerformance)) <> dm_ok then
raise EDXMusicError.Create('Failed to Set param for Direct music'); ;
FDirectMusicSegment.GetLength(MidiFilelength);
if (FActualDuration < MidiFilelength) and (FActualDuration > 0) then
FDirectMusicSegment.SetLength(FActualDuration);
if FActualStartPoint < MidiFilelength - FActualDuration then
FDirectMusicSegment.SetStartpoint(FActualStartPoint);
// jak opakovat
FDirectMusicSegment.Setrepeats(repeats - 1);
end;
 
constructor TMusicListCollectionItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
CoInitialize(nil);
FMusicDataProp := TMusicDataProp.Create;
SetLength(FMusicDataProp.FMusicData, 0);
FDirectMusicPerformance := nil;
FDirectMusic := nil;
FDirectSound := nil;
FDirectMusicSegment := nil;
FDirectMusicLoader := nil;
FIsInitialized := False;
end;
 
procedure TMusicListCollectionItem.Stop;
begin
if FDirectMusicPerformance <> nil then
FDirectMusicPerformance.Stop(nil, nil, 0, 0);
end;
 
function TMusicListCollectionItem.GetDisplayName: string;
begin
Result := inherited GetDisplayName
end;
 
procedure TMusicListCollectionItem.Play;
begin
if not FIsInitialized then
Init;
Load;
if FDirectMusicPerformance <> nil then
FDirectMusicPerformance.PlaySegment(FDirectMusicSegment, 0, 0, @FDirectMusicSegmentState);
end;
 
function TMusicListCollectionItem.IsPlaying: Boolean;
begin
Result := False;
if FDirectMusicPerformance <> nil then
Result := FDirectMusicPerformance.IsPlaying(FDirectMusicSegment, FDirectMusicSegmentState) = DM_OK;
end;
 
destructor TMusicListCollectionItem.Destroy;
begin
FDirectMusicPerformance := nil;
FDirectMusic := nil;
FDirectSound := nil;
FDirectMusicSegment := nil;
FDirectMusicLoader := nil;
FMusicDataProp.Free;
CoUninitialize;
inherited Destroy;
end;
 
procedure TMusicListCollectionItem.SetRepeats(const Value: Cardinal);
begin
Frepeats := Value;
end;
 
procedure TMusicListCollectionItem.SetStartPoint(const Value: integer);
begin
FStartPoint := Value;
end;
 
procedure TMusicListCollectionItem.SetDuration(const Value: integer);
begin
FDuration := Value;
end;
 
procedure TMusicListCollectionItem.Init;
var OK: Boolean;
begin
FIsInitialized := False;
OK := False;
// vytvor FDirectMusicPerformance pokud uz neni vytvoreno
if FDirectMusicPerformance = nil then
OK := CoCreateInstance(CLSID_DirectMusicPerformance, nil, CLSCTX_INPROC,
IID_IDirectMusicperformance, FDirectMusicPerformance) = DM_OK;
if not OK then Exit;
if FDirectSound <> nil then
OK := FDirectMusicPerformance.Init({$IFDEF DX7}@{$ENDIF}FDirectMusic, FDirectSound, 0) = DM_OK
else
OK := FDirectMusicPerformance.Init({$IFDEF DX7}@{$ENDIF}FDirectMusic, nil, 0) = dm_OK;
if not OK then Exit;
// vychozi midi port
// pridej pokud neni nastaven
if FDirectMusicPerformance.Addport(nil) <> DM_OK then Exit;
// zkus vytvorit loader
OK := CoCreateInstance(CLSID_DirectMusicLoader, nil, CLSCTX_Inproc,
IID_IDirectMusicLoader, FDirectMusicLoader) = DM_OK;
FIsInitialized := OK;
end;
 
function TMusicListCollectionItem.GetMusicListCollection: TMusicListCollection;
begin
Result := Collection as TMusicListCollection;
end;
 
procedure TMusicListCollectionItem.SaveToFile(const MidiFileName: string);
var F: file;
begin
AssignFile(F, MidiFileName);
Rewrite(F, 1);
try
BlockWrite(F, FMusicDataProp.FMusicData[1], Length(FMusicDataProp.FMusicData));
finally
CloseFile(F);
end;
end;
 
procedure TMusicListCollectionItem.LoadFromFile(const MidiFileName: string);
var F: file; S: string; I: Integer;
begin
AssignFile(F, MidiFileName);
Reset(F, 1);
try
SetLength(FMusicDataProp.FMusicData, FileSize(F));
BlockRead(F, FMusicDataProp.FMusicData[1], FileSize(F));
S := ExtractFileName(MidiFileName);
I := Pos(ExtractFileExt(S), S);
if I > 0 then S := Copy(S, 1, I - 1);
FMusicDataProp.Midiname := S;
finally
CloseFile(F);
end;
Name := ExtractFileName(MidiFileName);
end;
 
function TMusicListCollectionItem.Size: Integer;
begin
Result := Length(FMusicDataProp.FMusicData);
end;
 
{ TMusicListCollection }
 
constructor TMusicListCollection.Create(AOwner: TComponent);
begin
inherited Create(TMusicListCollectionItem);
FOwner := AOwner;
end;
 
function TMusicListCollection.Add: TMusicListCollectionItem;
begin
Result := TMusicListCollectionItem(inherited Add);
Result.FDirectSound := Self.FDirectSound;
end;
 
function TMusicListCollection.GetItem(Index: Integer): TMusicListCollectionItem;
begin
Result := TMusicListCollectionItem(inherited GetItem(Index));
end;
 
procedure TMusicListCollection.SetItem(Index: Integer;
Value: TMusicListCollectionItem);
begin
inherited SetItem(Index, Value);
end;
 
procedure TMusicListCollection.Update(Item: TCollectionItem);
begin
inherited Update(Item);
end;
 
function TMusicListCollection.Find(
const Name: string): TMusicListCollectionItem;
var
i: Integer;
begin
i := IndexOf(Name);
if i = -1 then
raise EDXMusicError.CreateFmt('The midi document does not exist: %s.', [Name]);
Result := Items[i];
end;
 
{$IFDEF VER4UP}
function TMusicListCollection.Insert(Index: Integer): TMusicListCollectionItem;
begin
Result := TMusicListCollectionItem(inherited Insert(Index));
end;
{$ENDIF}
 
function TMusicListCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
 
procedure TMusicListCollection.Restore;
begin
 
end;
 
procedure TMusicListCollection.SaveToFile(const FileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
 
procedure TMusicListCollection.LoadFromFile(const FileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
 
type
TMidiCollectionComponent = class(TComponent)
private
FList: TMusicListCollection;
published
property List: TMusicListCollection read FList write FList;
end;
 
procedure TMusicListCollection.SaveToStream(Stream: TStream);
var
Component: TMidiCollectionComponent;
begin
Component := TMidiCollectionComponent.Create(nil);
try
Component.FList := Self;
Stream.WriteComponentRes('DelphiXMidiCollection', Component);
finally
Component.Free;
end;
end;
 
procedure TMusicListCollection.LoadFromStream(Stream: TStream);
var
Component: TMidiCollectionComponent;
begin
Clear;
Component := TMidiCollectionComponent.Create(nil);
try
Component.FList := Self;
Stream.ReadComponentRes(Component);
Restore;
finally
Component.Free;
end;
end;
 
{ TDXMusic }
 
constructor TDXMusic.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FMidis := TMusicListCollection.Create(Self);
if Assigned(FDXSound) then
FMidis.FDirectSound := FDXSound.DSound.IDSound;
end;
 
procedure TDXMusic.SetMidis(const value: TMusicListCollection);
begin
FMidis.Assign(Value);
end;
 
destructor TDXMusic.Destroy;
begin
FMidis.Free;
inherited Destroy;
end;
 
procedure TDXMusic.SetDXSound(const Value: TDXSound);
begin
FDXSound := Value;
if Assigned(FDXSound) then
FMidis.FDirectSound := FDXSound.DSound.IDSound;
end;
 
initialization
finalization
DirectSoundDrivers.Free;
/VCL_DELPHIX_D6/DXSprite.pas
5,7 → 5,13
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, SysUtils, Classes, DXClass, DXDraws, DirectX;
Windows, SysUtils, Classes, Graphics, DXClass, DXDraws,
{$IFDEF VER9UP} Types,{$ENDIF}
{$IFDEF StandardDX}
DirectDraw;
{$ELSE}
DirectX;
{$ENDIF}
 
type
 
17,7 → 23,13
 
TSpriteEngine = class;
 
TSprite = class
TSprite = class;
TCollisionEvent = procedure(Sender: TObject; var Done: Boolean) of object;
TMoveEvent = procedure(Sender: TObject; var MoveCount: Integer) of object;
TDrawEvent = procedure(Sender: TObject) of object;
TGetImage = procedure(Sender: TObject; var Image: TPictureCollectionItem) of object;
 
TSprite = class(TPersistent)
private
FEngine: TSpriteEngine;
FParent: TSprite;
32,16 → 44,31
FZ: Integer;
FWidth: Integer;
FHeight: Integer;
{$IFDEF Ver4Up}
FSelected: Boolean;
FGroupNumber: Integer;
{$ENDIF}
FCaption: string;
FTag: Integer;
 
FDXImageList: TCustomDXImageList;
FDXImage: TPictureCollectionItem;
FDXImageName: string;
 
FOnDraw: TDrawEvent;
FOnMove: TMoveEvent;
FOnCollision: TCollisionEvent;
FOnGetImage: TGetImage;
procedure Add(Sprite: TSprite);
procedure Remove(Sprite: TSprite);
procedure AddDrawList(Sprite: TSprite);
procedure Collision2;
procedure Draw;
procedure Draw; {$IFDEF VER9UP}inline;{$ENDIF}
function GetClientRect: TRect;
function GetCount: Integer;
function GetItem(Index: Integer): TSprite;
function GetWorldX: Double;
function GetWorldY: Double;
function GetWorldX: Double; {$IFDEF VER9UP}inline;{$ENDIF}
function GetWorldY: Double; {$IFDEF VER9UP}inline;{$ENDIF}
procedure SetZ(Value: Integer);
protected
procedure DoCollision(Sprite: TSprite; var Done: Boolean); virtual;
49,6 → 76,10
procedure DoMove(MoveCount: Integer); virtual;
function GetBoundsRect: TRect; virtual;
function TestCollision(Sprite: TSprite): Boolean; virtual;
{$IFDEF Ver4Up}
procedure SetGroupNumber(AGroupNumber: Integer); virtual;
procedure SetSelected(ASelected: Boolean); virtual;
{$ENDIF}
public
constructor Create(AParent: TSprite); virtual;
destructor Destroy; override;
56,25 → 87,46
function Collision: Integer;
procedure Dead;
procedure Move(MoveCount: Integer);
procedure ReAnimate(MoveCount: Integer); virtual;
function GetSpriteAt(X, Y: Integer): TSprite;
property BoundsRect: TRect read GetBoundsRect;
property ClientRect: TRect read GetClientRect;
property Collisioned: Boolean read FCollisioned write FCollisioned;
property Count: Integer read GetCount;
property Engine: TSpriteEngine read FEngine;
property Items[Index: Integer]: TSprite read GetItem; default;
property Moved: Boolean read FMoved write FMoved;
property Deaded: Boolean read FDeaded;
property Parent: TSprite read FParent;
property Visible: Boolean read FVisible write FVisible;
property Width: Integer read FWidth write FWidth;
property WorldX: Double read GetWorldX;
property WorldY: Double read GetWorldY;
// Group handling support
{$IFDEF Ver4Up} // if GroupNumber < 0 then no group is assigned
property GroupNumber: Integer read FGroupNumber write SetGroupNumber;
property Selected: Boolean read FSelected write SetSelected;
{$ENDIF}
procedure Assign(Source: TPersistent); override;
published
property Height: Integer read FHeight write FHeight;
property Moved: Boolean read FMoved write FMoved;
property Visible: Boolean read FVisible write FVisible;
property Width: Integer read FWidth write FWidth;
property X: Double read FX write FX;
property Y: Double read FY write FY;
property Z: Integer read FZ write SetZ;
property Collisioned: Boolean read FCollisioned write FCollisioned;
property Tag: Integer read FTag write FTag;
property Caption: string read FCaption write FCaption;
 
property DXImageList: TCustomDXImageList read FDXImageList write FDXImageList;
property DXImageName: string read FDXImageName write FDXImageName;
 
property OnDraw: TDrawEvent read FOnDraw write FOnDraw;
property OnMove: TMoveEvent read FOnMove write FOnMove;
property OnCollision: TCollisionEvent read FOnCollision write FOnCollision;
property OnGetImage: TGetImage read FOnGetImage write FOnGetImage;
end;
 
TSpriteClass = class of TSprite;
 
{ TImageSprite }
 
TImageSprite = class(TSprite)
84,55 → 136,136
FAnimPos: Double;
FAnimSpeed: Double;
FAnimStart: Integer;
FImage: TPictureCollectionItem;
FPixelCheck: Boolean;
FTile: Boolean;
FTransparent: Boolean;
FAngle: Single;
FAlpha: Integer;
FBlendMode: TRenderType;
FCenterX: Double;
FCenterY: Double;
FBlurImageArr: TBlurImageArr;
FBlurImage: Boolean;
FMirrorFlip: TRenderMirrorFlipSet;
FTextureFilter: TD2DTextureFilter;
function GetDrawImageIndex: Integer;
function GetDrawRect: TRect;
function ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
const rect1, rect2: TRect; x1, y1, x2, y2: Integer;
DoPixelCheck: Boolean): Boolean;
function StoreCenterX: Boolean;
function StoreCenterY: Boolean;
function StoreAlpha: Boolean;
procedure SetBlurImage(const Value: Boolean);
procedure SetBlurImageArr(const Value: TBlurImageArr);
function GetImage: TPictureCollectionItem;
procedure SetMirrorFlip(const Value: TRenderMirrorFlipSet);
procedure ReadMirrorFlip(Reader: TReader);
procedure WriteMirrorFlip(Writer: TWriter);
protected
{accessed methods}
procedure ReadAlpha(Reader: TReader);
procedure ReadAngle(Reader: TReader);
procedure ReadAnimCount(Reader: TReader);
procedure ReadAnimLooped(Reader: TReader);
procedure ReadAnimPos(Reader: TReader);
procedure ReadAnimSpeed(Reader: TReader);
procedure ReadAnimStart(Reader: TReader);
procedure ReadBlendMode(Reader: TReader);
procedure ReadCenterX(Reader: TReader);
procedure ReadCenterY(Reader: TReader);
procedure ReadPixelCheck(Reader: TReader);
procedure ReadTile(Reader: TReader);
procedure ReadBlurImage(Reader: TReader);
procedure ReadTextureFilter(Reader: TReader);
procedure WriteAlpha(Writer: TWriter);
procedure WriteAngle(Writer: TWriter);
procedure WriteAnimCount(Writer: TWriter);
procedure WriteAnimLooped(Writer: TWriter);
procedure WriteAnimPos(Writer: TWriter);
procedure WriteAnimSpeed(Writer: TWriter);
procedure WriteAnimStart(Writer: TWriter);
procedure WriteBlendMode(Writer: TWriter);
procedure WriteCenterX(Writer: TWriter);
procedure WriteCenterY(Writer: TWriter);
procedure WritePixelCheck(Writer: TWriter);
procedure WriteTile(Writer: TWriter);
procedure WriteBlurImage(Writer: TWriter);
procedure WriteTextureFilter(Writer: TWriter);
{own store of properties}
procedure DefineProperties(Filer: TFiler); override;
procedure LoadImage; virtual;
procedure DoDraw; override;
procedure DoMove(MoveCount: Integer); override;
function GetBoundsRect: TRect; override;
function TestCollision(Sprite: TSprite): Boolean; override;
procedure SetImage(AImage: TPictureCollectionItem); virtual;
public
constructor Create(AParent: TSprite); override;
property AnimCount: Integer read FAnimCount write FAnimCount;
property AnimLooped: Boolean read FAnimLooped write FAnimLooped;
procedure Assign(Source: TPersistent); override;
procedure ReAnimate(MoveCount: Integer); override;
property Image: TPictureCollectionItem read GetImage write SetImage;
property BlurImageArr: TBlurImageArr read FBlurImageArr write SetBlurImageArr;
{un-published property}
property BlendMode: TRenderType read FBlendMode write FBlendMode default rtDraw;
property Angle: Single read FAngle write FAngle stored StoreAlpha;
property Alpha: Integer read FAlpha write FAlpha default $FF;
property CenterX: Double read FCenterX write FCenterX stored StoreCenterX;
property CenterY: Double read FCenterY write FCenterY stored StoreCenterY;
property AnimCount: Integer read FAnimCount write FAnimCount default 0;
property AnimLooped: Boolean read FAnimLooped write FAnimLooped default False;
property AnimPos: Double read FAnimPos write FAnimPos;
property AnimSpeed: Double read FAnimSpeed write FAnimSpeed;
property AnimStart: Integer read FAnimStart write FAnimStart;
property PixelCheck: Boolean read FPixelCheck write FPixelCheck;
property Image: TPictureCollectionItem read FImage write FImage;
property Tile: Boolean read FTile write FTile;
property AnimStart: Integer read FAnimStart write FAnimStart default 0;
property PixelCheck: Boolean read FPixelCheck write FPixelCheck default False;
property Tile: Boolean read FTile write FTile default False;
property BlurImage: Boolean read FBlurImage write SetBlurImage default False;
property MirrorFlip: TRenderMirrorFlipSet read FMirrorFlip write SetMirrorFlip default [];
property TextureFilter: TD2DTextureFilter read FTextureFilter write FTextureFilter default D2D_POINT;
published
property DXImageList;
property DXImageName;
 
property OnDraw;
property OnMove;
property OnCollision;
property OnGetImage;
end;
 
{ TImageSpriteEx }
 
TImageSpriteEx = class(TImageSprite)
private
FAngle: Integer;
FAlpha: Integer;
protected
procedure DoDraw; override;
function GetBoundsRect: TRect; override;
function TestCollision(Sprite: TSprite): Boolean; override;
public
constructor Create(AParent: TSprite); override;
property Angle: Integer read FAngle write FAngle;
property Alpha: Integer read FAlpha write FAlpha;
end;
end{$IFDEF VER9UP}deprecated{$IFDEF VER14UP} 'Use for backward compatibility only or replace by TImageSprite instead...'{$ENDIF}{$ENDIF};
{ TBackgroundSprite }
 
TBackgroundSprite = class(TSprite)
PMapType = ^TMapType;
TMapType = packed record
MapChip: Integer; {image chip as number}
//ImageName: string[127];
CollisionChip: Boolean; {is collision brick}
CollisionRect: TRect; {dirty vollision area, can be smaller or bigger than silhouette}
Overlap: Integer; {for pulse image, like zoom etc.}
AnimLooped: Boolean; {chip can be live}
AnimStart, AnimCount: Integer;
AnimSpeed, AnimPos: Double; {phase of picture by one map chip}
Rendered: TRenderType; {can be blended}
Alpha: Byte; {and blend level}
Angle: Single;
CenterX, CenterY: Double;
MirrorFlip: TRenderMirrorFlipSet;
TextureFilter: TD2DTextureFilter;
Tag: Integer; {for application use}
end;
 
TBackgroundSprite = class(TImageSprite)
private
FImage: TPictureCollectionItem;
FCollisionMap: Pointer;
FMap: Pointer;
FMapWidth: Integer;
FMapHeight: Integer;
FTile: Boolean;
 
FChipsRect: TRect;
FChipsPatternIndex: Integer;
function GetCollisionMapItem(X, Y: Integer): Boolean;
function GetChip(X, Y: Integer): Integer;
procedure SetChip(X, Y: Integer; Value: Integer);
139,26 → 272,60
procedure SetCollisionMapItem(X, Y: Integer; Value: Boolean);
procedure SetMapHeight(Value: Integer);
procedure SetMapWidth(Value: Integer);
 
function GetCollisionRectItem(X, Y: Integer): TRect;
function GetMap(X, Y: Integer): TMapType;
function GetTagMap(X, Y: Integer): Integer;
procedure SetCollisionRectItem(X, Y: Integer; Value: TRect);
procedure SetMap(X, Y: Integer; Value: TMapType);
procedure SetTagMap(X, Y, Value: Integer);
function GetOverlap(X, Y: Integer): Integer;
procedure SetOverlap(X, Y: Integer; const Value: Integer);
protected
procedure ReadMapData(Stream: TStream);
procedure WriteMapData(Stream: TStream);
procedure DoDraw; override;
function GetBoundsRect: TRect; override;
function TestCollision(Sprite: TSprite): Boolean; override;
procedure SetImage(Img: TPictureCollectionItem); override;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AParent: TSprite); override;
destructor Destroy; override;
procedure ChipsDraw(Image: TPictureCollectionItem; X, Y, PatternIndex: Integer);
procedure SetMapSize(AMapWidth, AMapHeight: Integer);
function IsMapEmpty: Boolean;
property Chips[X, Y: Integer]: Integer read GetChip write SetChip;
property CollisionMap[X, Y: Integer]: Boolean read GetCollisionMapItem write SetCollisionMapItem;
property Image: TPictureCollectionItem read FImage write FImage;
property CollisionRect[X, Y: Integer]: TRect read GetCollisionRectItem write SetCollisionRectItem;
property Overlap[X, Y: Integer]: Integer read GetOverlap write SetOverlap;
property TagMap[X, Y: Integer]: Integer read GetTagMap write SetTagMap;
property Map[X, Y: Integer]: TMapType read GetMap write SetMap;
procedure Assign(Source: TPersistent); override;
property ChipsRect: TRect read FChipsRect write FChipsRect;
property ChipsPatternIndex: Integer read FChipsPatternIndex write FChipsPatternIndex default 0;
{un-published property}
property MapHeight: Integer read FMapHeight write SetMapHeight;
property MapWidth: Integer read FMapWidth write SetMapWidth;
property Tile: Boolean read FTile write FTile;
published
property DXImageList;
property DXImageName;
 
property OnDraw;
property OnMove;
property OnCollision;
property OnGetImage;
end;
 
{ forward class }
 
TCustomDXSpriteEngine = class;
 
{ TSpriteEngine }
 
TSpriteEngine = class(TSprite)
private
FOwner: TCustomDXSpriteEngine;
FAllCount: Integer;
FCollisionCount: Integer;
FCollisionDone: Boolean;
168,7 → 335,18
FDrawCount: Integer;
FSurface: TDirectDrawSurface;
FSurfaceRect: TRect;
procedure SetSurface(Value: TDirectDrawSurface);
{$IFDEF Ver4Up}
FObjectsSelected: Boolean;
FGroupCount: Integer;
FGroups: array of Tlist;
FCurrentSelected: Tlist;
{$ENDIF}
protected
procedure SetSurface(Value: TDirectDrawSurface); virtual;
{$IFDEF Ver4Up}
procedure SetGroupCount(AGroupCount: Integer); virtual;
function GetGroup(Index: Integer): Tlist; virtual;
{$ENDIF}
public
constructor Create(AParent: TSprite); override;
destructor Destroy; override;
178,6 → 356,26
property DrawCount: Integer read FDrawCount;
property Surface: TDirectDrawSurface read FSurface write SetSurface;
property SurfaceRect: TRect read FSurfaceRect;
 
// Extended Sprite Engine
procedure Collisions;
 
// Group handling support
{$IFDEF Ver4Up}
procedure ClearCurrent;
procedure ClearGroup(GroupNumber: Integer);
procedure GroupToCurrent(GroupNumber: Integer; Add: Boolean = False);
procedure CurrentToGroup(GroupNumber: Integer; Add: Boolean = False);
procedure GroupSelect(const Area: TRect; Filter: array of TSpriteClass; Add: Boolean = False); overload;
procedure GroupSelect(const Area: TRect; Add: Boolean = False); overload;
function Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = False): Tsprite; overload;
function Select(Point: TPoint; Add: Boolean = False): Tsprite; overload;
 
property CurrentSelected: TList read fCurrentSelected;
property ObjectsSelected: Boolean read fObjectsSelected;
property Groups[Index: Integer]: Tlist read GetGroup;
property GroupCount: Integer read fGroupCount write SetGroupCount;
{$ENDIF}
end;
 
{ EDXSpriteEngineError }
184,6 → 382,90
 
EDXSpriteEngineError = class(Exception);
 
TSpriteCollection = class;
 
{ TSpriteType }
 
TSpriteType = (stSprite, stImageSprite, stImageSpriteEx, stBackgroundSprite);
 
{ TSpriteCollectionItem }
 
TSpriteCollectionItem = class(THashCollectionItem)
private
FOwner: TPersistent;
FOwnerItem: TSpriteEngine;
FSpriteType: TSpriteType;
FSprite: TSprite;
procedure Finalize;
procedure Initialize;
function GetSpriteCollection: TSpriteCollection;
procedure SetSprite(const Value: TSprite);
procedure SetOnCollision(const Value: TCollisionEvent);
procedure SetOnDraw(const Value: TDrawEvent);
procedure SetOnMove(const Value: TMoveEvent);
function GetSpriteType: TSpriteType;
procedure SetSpriteType(const Value: TSpriteType);
function GetOnCollision: TCollisionEvent;
function GetOnDraw: TDrawEvent;
function GetOnMove: TMoveEvent;
function GetOnGetImage: TGetImage;
procedure SetOnGetImage(const Value: TGetImage);
function GetImageList: TCustomDXImageList;
procedure SetImageList(const Value: TCustomDXImageList);
protected
function GetDisplayName: string; override;
procedure SetDisplayName(const Value: string); override;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property SpriteCollection: TSpriteCollection read GetSpriteCollection;
function Clone(NewName: string): TSprite;
published
{published property of sprite}
property KindSprite: TSpriteType read GetSpriteType write SetSpriteType;
property ImageList: TCustomDXImageList read GetImageList write SetImageList;
property Sprite: TSprite read FSprite write SetSprite;
{published events of sprite}
property OnDraw: TDrawEvent read GetOnDraw write SetOnDraw;
property OnMove: TMoveEvent read GetOnMove write SetOnMove;
property OnCollision: TCollisionEvent read GetOnCollision write SetOnCollision;
property OnGetImage: TGetImage read GetOnGetImage write SetOnGetImage;
end;
 
{ ESpriteCollectionError }
 
ESpriteCollectionError = class(Exception);
 
{ TSpriteCollection }
 
TSCInitialize = procedure(Owner: TSpriteEngine) of object;
TSCFinalize = procedure(Owner: TSpriteEngine) of object;
 
TSpriteCollection = class(THashCollection)
private
FInitializeFlag: Boolean;
FOwner: TPersistent;
FOwnerItem: TSpriteEngine;
FOnInitialize: TSCInitialize;
FOnFinalize: TSCFinalize;
function GetItem(Index: Integer): TSpriteCollectionItem;
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner: TPersistent);
destructor Destroy; override;
function Initialized: Boolean;
function Find(const Name: string): TSpriteCollectionItem;
function Add: TSpriteCollectionItem;
procedure Finalize;
function Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
property Items[Index: Integer]: TSpriteCollectionItem read GetItem; default;
published
property OnInitialize: TSCInitialize read FOnInitialize write FOnInitialize;
property OnFinalize: TSCFinalize read FOnFinalize write FOnFinalize;
end;
 
{ TCustomDXSpriteEngine }
 
TCustomDXSpriteEngine = class(TComponent)
190,31 → 472,67
private
FDXDraw: TCustomDXDraw;
FEngine: TSpriteEngine;
FItems: TSpriteCollection;
procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
procedure SetDXDraw(Value: TCustomDXDraw);
procedure SetItems(const Value: TSpriteCollection);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOnwer: TComponent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Dead;
procedure Draw;
procedure Move(MoveCount: Integer);
procedure Clone(const Amount: Word; const BaseNameOfSprite: string);
function ForEach(PrefixNameOdSprite: string; var Names: TStringList): Boolean;
property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
property Engine: TSpriteEngine read FEngine;
property Items: TSpriteCollection read FItems write SetItems;
end;
 
{ TDXSpriteEngine }
 
TDXSpriteEngine = class(TCustomDXSpriteEngine)
property Items;
published
property DXDraw;
end;
 
function Mod2(i, i2: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
function Mod2f(i: Double; i2: Integer): Double; {$IFDEF VER9UP}inline;{$ENDIF}
function DefaultMapChip(iMapChip: Integer = -1; iCollisionChip: Boolean = False): TMapType; {$IFDEF VER9UP}inline;{$ENDIF}
 
implementation
 
uses DXConsts;
uses DXConsts, TypInfo;
 
const
SSpriteNotFound = 'Sprite not found';
SSpriteDuplicateName = 'Item duplicate name "%s" error';
 
function DefaultMapChip(iMapChip: Integer = -1; iCollisionChip: Boolean = False): TMapType;
begin
FillChar(Result, SizeOf(Result), 0);
with Result do
begin
MapChip := iMapChip; {image chip as number}
CollisionChip := iCollisionChip; {is collision brick}
// CollisionRect: TRect; {dirty vollision area, can be smaller or bigger than silhouette}
// Overlap: Integer; {for pulse image, like zoom etc.}
// AnimLooped: Boolean; {chip can be live}
// AnimStart, AnimCount: Integer;
// AnimSpeed, AnimPos: Double; {phase of picture by one map chip}
Rendered := rtDraw; {can be blended}
Alpha := $FF; {and blend level}
Angle := 0;
CenterX := 0.5;
CenterY := 0.5;
TextureFilter := D2D_POINT;
// Tag: Integer; {for application use}
end;
end;
 
function Mod2(i, i2: Integer): Integer;
begin
Result := i mod i2;
228,7 → 546,7
Result := i
else
begin
Result := i-Trunc(i/i2)*i2;
Result := i - Round(i / i2) * i2;
if Result<0 then
Result := i2+Result;
end;
239,6 → 557,9
constructor TSprite.Create(AParent: TSprite);
begin
inherited Create;
{$IFDEF Ver4Up}
fGroupnumber := -1;
{$ENDIF}
FParent := AParent;
if FParent<>nil then
begin
257,6 → 578,10
 
destructor TSprite.Destroy;
begin
{$IFDEF Ver4Up}
GroupNumber := -1;
Selected := False;
{$ENDIF}
Clear;
if FParent<>nil then
begin
269,6 → 594,33
inherited Destroy;
end;
 
{$IFDEF Ver4Up}
 
procedure TSprite.SetGroupNumber(AGroupNumber: Integer);
begin
if (AGroupNumber <> GroupNumber) and (Engine <> nil) then
begin
if Groupnumber >= 0 then
Engine.Groups[GroupNumber].Remove(self);
if AGroupNumber >= 0 then
Engine.Groups[AGroupNumber].Add(self);
end;
end; {SetGroupNumber}
 
procedure TSprite.SetSelected(ASelected: Boolean);
begin
if (ASelected <> fSelected) and (Engine <> nil) then
begin
fSelected := ASelected;
if Selected then
Engine.CurrentSelected.Add(self)
else
Engine.CurrentSelected.Remove(self);
Engine.fObjectsSelected := Engine.CurrentSelected.count <> 0;
end;
end;
{$ENDIF}
 
procedure TSprite.Add(Sprite: TSprite);
begin
if FList=nil then
303,7 → 655,9
begin
I := (L + H) div 2;
C := TSprite(FDrawList[I]).Z-Sprite.Z;
if C < 0 then L := I + 1 else
if C < 0 then
L := I + 1
else
H := I - 1;
end;
FDrawList.Insert(L, Sprite);
343,17 → 697,20
begin
if Collisioned then
begin
if (Self<>FEngine.FCollisionSprite) and OverlapRect(BoundsRect, FEngine.FCollisionRect) and
FEngine.FCollisionSprite.TestCollision(Self) and TestCollision(FEngine.FCollisionSprite) then
if (Self <> FEngine.FCollisionSprite) and OverlapRect(BoundsRect,
FEngine.FCollisionRect) and FEngine.FCollisionSprite.TestCollision(Self) and
TestCollision(FEngine.FCollisionSprite) then
begin
Inc(FEngine.FCollisionCount);
FEngine.FCollisionSprite.DoCollision(Self, FEngine.FCollisionDone);
if (not FEngine.FCollisionSprite.Collisioned) or (FEngine.FCollisionSprite.FDeaded) then
if (not FEngine.FCollisionSprite.Collisioned) or
(FEngine.FCollisionSprite.FDeaded) then
begin
FEngine.FCollisionDone := True;
end;
end;
if FEngine.FCollisionDone then Exit;
if FEngine.FCollisionDone then
Exit;
for i:=0 to Count-1 do
Items[i].Collision2;
end;
368,16 → 725,22
end;
end;
 
procedure TSprite.DoMove;
procedure TSprite.DoMove(MoveCount: Integer);
begin
if AsSigned(FOnMove) then
FOnMove(Self, MoveCount);
end;
 
procedure TSprite.DoDraw;
begin
if AsSigned(FOnDraw) then
FOnDraw(Self);
end;
 
procedure TSprite.DoCollision(Sprite: TSprite; var Done: Boolean);
begin
if AsSigned(FOnCollision) then
FOnCollision(Sprite, Done);
end;
 
function TSprite.TestCollision(Sprite: TSprite): Boolean;
391,7 → 754,7
begin
if FMoved then
begin
DoMove(MoveCount);
DoMove(MoveCount); ReAnimate(MoveCount);
for i:=0 to Count-1 do
Items[i].Move(MoveCount);
end;
415,10 → 778,12
if FDrawList<>nil then
begin
for i:=0 to FDrawList.Count-1 do
begin
TSprite(FDrawList[i]).Draw;
end;
end;
end;
end;
 
function TSprite.GetSpriteAt(X, Y: Integer): TSprite;
 
427,7 → 792,8
i: Integer;
X2, Y2: Double;
begin
if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)), Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Width)) then
if Sprite.Visible and PointInRect(Point(Round(X), Round(Y)),
Bounds(Round(Sprite.X), Round(Sprite.Y), Sprite.Width, Sprite.Height)) then //corrected by Sergey
begin
if (Result=nil) or (Sprite.Z>Result.Z) then
Result := Sprite;
453,7 → 819,7
 
function TSprite.GetBoundsRect: TRect;
begin
Result := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height);
Result := Bounds(Round(WorldX), Round(WorldY), Width, Height);
end;
 
function TSprite.GetClientRect: TRect;
506,6 → 872,41
end;
end;
 
procedure TSprite.Assign(Source: TPersistent);
begin
if Source is TSprite then
begin
FCollisioned := TSprite(Source).FCollisioned;
FMoved := TSprite(Source).FMoved;
FVisible := TSprite(Source).FVisible;
FHeight := TSprite(Source).FHeight;
FWidth := TSprite(Source).FWidth;
FX := TSprite(Source).FX;
FY := TSprite(Source).FY;
FZ := TSprite(Source).FZ;
{$IFDEF Ver4Up}
FSelected := TSprite(Source).FSelected;
FGroupNumber := TSprite(Source).FGroupNumber;
{$ENDIF}
{copy image base - when exists}
FDXImage := TSprite(Source).FDXImage;
FDXImageName := TSprite(Source).FDXImageName;
FDXImageList := TSprite(Source).FDXImageList;
{events}
FOnDraw := TSprite(Source).FOnDraw;
FOnMove := TSprite(Source).FOnMove;
FOnCollision := TSprite(Source).FOnCollision;
FOnGetImage := TSprite(Source).FOnGetImage;
end
else
inherited;
end;
 
procedure TSprite.ReAnimate(MoveCount: Integer);
begin
 
end;
 
{ TImageSprite }
 
constructor TImageSprite.Create(AParent: TSprite);
512,14 → 913,39
begin
inherited Create(AParent);
FTransparent := True;
FAlpha := 255;
FAngle := 0;
FBlendMode := rtDraw;
FCenterX := 0.5;
FCenterY := 0.5;
FBlurImage := False;
FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0);
FTextureFilter := D2D_POINT;
end;
 
procedure TImageSprite.SetImage(AImage: TPictureCollectionItem);
begin
FDXImage := AImage;
FDXImageName := '';
if AImage <> nil then
begin
Width := AImage.Width;
Height := AImage.Height;
FDXImageName := FDXImage.Name;
end
else
begin
Width := 0;
Height := 0;
end;
end; {SetImage}
 
function TImageSprite.GetBoundsRect: TRect;
var
dx, dy: Integer;
begin
dx := Trunc(WorldX);
dy := Trunc(WorldY);
dx := Round(WorldX);
dy := Round(WorldY);
if FTile then
begin
dx := Mod2(dx, FEngine.SurfaceRect.Right+Width);
537,32 → 963,17
 
procedure TImageSprite.DoMove(MoveCount: Integer);
begin
FAnimPos := FAnimPos + FAnimSpeed*MoveCount;
 
if FAnimLooped then
begin
if FAnimCount>0 then
FAnimPos := Mod2f(FAnimPos, FAnimCount)
if AsSigned(FOnMove) then
FOnMove(Self, MoveCount)
else
FAnimPos := 0;
end else
begin
if FAnimPos>=FAnimCount then
begin
FAnimPos := FAnimCount-1;
FAnimSpeed := 0;
ReAnimate(MoveCount);
end;
if FAnimPos<0 then
begin
FAnimPos := 0;
FAnimSpeed := 0;
end;
end;
end;
 
function TImageSprite.GetDrawImageIndex: Integer;
begin
Result := FAnimStart+Trunc(FAnimPos);
Result := FAnimStart + Trunc(FAnimPos); //solve 1.07f to Round()
end;
 
function TImageSprite.GetDrawRect: TRect;
571,19 → 982,52
OffsetRect(Result, (Width-Image.Width) div 2, (Height-Image.Height) div 2);
end;
 
procedure TImageSprite.LoadImage;
var
vImage: TPictureCollectionItem;
begin
if Image = nil then
if AsSigned(FOnGetImage) then
begin
vImage := nil;
FOnGetImage(Self, vImage);
if vImage <> Image then
Image := vImage;
end
else
if FDXImageName <> '' then
if Assigned(FDXImageList) then
begin
Image := FDXImageList.Items.Find(FDXImageName);
end;
end;
 
procedure TImageSprite.DoDraw;
var
ImageIndex: Integer;
r: TRect;
begin
ImageIndex := GetDrawImageIndex;
r := GetDrawRect;
Image.Draw(FEngine.Surface, r.Left, r.Top, ImageIndex);
LoadImage;
if Image = nil then
Exit;
if AsSigned(FOnDraw) then {owner draw called here}
FOnDraw(Self)
else {when is not owner draw then go here}
begin
r := Bounds(Round(WorldX), Round(WorldY), Width, Height);
{New function implemented}
if Assigned(FEngine.FOwner) then
DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, r, GetDrawImageIndex,
FBlurImageArr, FBlurImage, FTextureFilter, FMirrorFlip, FBlendMode, FAngle,
FAlpha, FCenterX, FCenterY);
end;
end;
 
function ImageCollisionTest(suf1, suf2: TDirectDrawSurface; const rect1, rect2: TRect;
x1,y1,x2,y2: Integer; DoPixelCheck: Boolean): Boolean;
{$WARNINGS OFF}
{$HINTS OFF}
 
function TImageSprite.ImageCollisionTest(suf1, suf2: TDirectDrawSurface;
const rect1, rect2: TRect; x1, y1, x2, y2: Integer; DoPixelCheck: Boolean): Boolean;
 
function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
begin
with DestRect do
599,31 → 1043,42
 
type
PRGB = ^TRGB;
 
TRGB = packed record
R, G, B: Byte;
R, G, B: byte;
end;
var
ddsd1, ddsd2: TDDSurfaceDesc;
r1, r2: TRect;
ddsd1, ddsd2: {$IFDEF D3D_deprecated}TDDSURFACEDESC{$ELSE}TDDSurfaceDesc2{$ENDIF};
r1, r2, r1a, r2a: TRect;
tc1, tc2: DWORD;
x, y, w, h: Integer;
P1, P2: Pointer;
begin
r1 := rect1;
with rect2 do r2 := Bounds(x2-x1, y2-y1, Right-Left, Bottom-Top);
with rect1 do
r1 := Bounds(0, 0, Right - Left, Bottom - Top);
r1a := r1;
with rect2 do
r2 := Bounds(0, 0, Right - Left, Bottom - Top);
r2a := r2;
 
with rect2 do
r2 := Bounds(x2 - x1, y2 - y1, Right - Left, Bottom - Top);
 
Result := OverlapRect(r1, r2);
 
if (suf1=nil) or (suf2=nil) then Exit;
if (suf1 = nil) or (suf2 = nil) then
Exit;
 
if DoPixelCheck and Result then
begin
{ Get Overlapping rectangle }
with r1 do r1 := Bounds(Max(x2-x1, 0), Max(y2-y1, 0), Right-Left, Bottom-Top);
with r2 do r2 := Bounds(Max(x1-x2, 0), Max(y1-y2, 0), Right-Left, Bottom-Top);
with r1 do
r1 := Bounds(Max(x2 - x1, 0), Max(y2 - y1, 0), Right - Left, Bottom - Top);
with r2 do
r2 := Bounds(Max(x1 - x2, 0), Max(y1 - y2, 0), Right - Left, Bottom - Top);
 
ClipRect(r1, rect1);
ClipRect(r2, rect2);
ClipRect(r1, r1a);
ClipRect(r2, r2a);
 
w := Min(r1.Right-r1.Left, r2.Right-r2.Left);
h := Min(r1.Bottom-r1.Top, r2.Bottom-r2.Top);
633,6 → 1088,18
{ Pixel check !!! }
ddsd1.dwSize := SizeOf(ddsd1);
 
with rect1 do
r1 := Bounds(r1.Left + left, r1.Top + top, w, h);
with rect2 do
r2 := Bounds(r2.Left + left, r2.Top + top, w, h);
 
if suf1 = suf2 then
begin
suf2.Lock(r2, ddsd2);
suf2.unlock;
end;
 
if suf1.Lock(r1, ddsd1) then
begin
try
640,8 → 1107,10
if (suf1=suf2) or suf2.Lock(r2, ddsd2) then
begin
try
if suf1=suf2 then ddsd2 := ddsd1;
if ddsd1.ddpfPixelFormat.dwRGBBitCount<>ddsd2.ddpfPixelFormat.dwRGBBitCount then Exit;
{this line out: don't test pixel but rect only, its wrong}
{if suf1=suf2 then ddsd2 := ddsd1;}
if ddsd1.ddpfPixelFormat.dwRGBBitCount <> ddsd2.ddpfPixelFormat.dwRGBBitCount then
Exit;
{ Get transparent color }
tc1 := ddsd1.ddckCKSrcBlt.dwColorSpaceLowValue;
648,7 → 1117,8
tc2 := ddsd2.ddckCKSrcBlt.dwColorSpaceLowValue;
 
case ddsd1.ddpfPixelFormat.dwRGBBitCount of
8 : begin
8:
begin
for y:=0 to h-1 do
begin
P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
655,13 → 1125,15
P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
for x:=0 to w-1 do
begin
if (PByte(P1)^<>tc1) and (PByte(P2)^<>tc2) then Exit;
if (PByte(P1)^ <> tc1) and (PByte(P2)^ <> tc2) then
Exit;
Inc(PByte(P1));
Inc(PByte(P2));
end;
end;
end;
16: begin
16:
begin
for y:=0 to h-1 do
begin
P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
668,13 → 1140,15
P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
for x:=0 to w-1 do
begin
if (PWord(P1)^<>tc1) and (PWord(P2)^<>tc2) then Exit;
if (PWord(P1)^ <> tc1) and (PWord(P2)^ <> tc2) then
Exit;
Inc(PWord(P1));
Inc(PWord(P2));
end;
end;
end;
24: begin
24:
begin
for y:=0 to h-1 do
begin
P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
681,14 → 1155,19
P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
for x:=0 to w-1 do
begin
if ((PRGB(P1)^.R shl 16) or (PRGB(P1)^.G shl 8) or PRGB(P1)^.B<>tc1) and
((PRGB(P2)^.R shl 16) or (PRGB(P2)^.G shl 8) or PRGB(P2)^.B<>tc2) then Exit;
with PRGB(P1)^ do
if (R shl 16) or (G shl 8) or B <> tc1 then
Exit;
with PRGB(P2)^ do
if (R shl 16) or (G shl 8) or B <> tc2 then
Exit;
Inc(PRGB(P1));
Inc(PRGB(P2));
end;
end;
end;
32: begin
32:
begin
for y:=0 to h-1 do
begin
P1 := Pointer(Integer(ddsd1.lpSurface)+y*ddsd1.lPitch);
695,7 → 1174,8
P2 := Pointer(Integer(ddsd2.lpSurface)+y*ddsd2.lPitch);
for x:=0 to w-1 do
begin
if (PDWORD(P1)^ and $FFFFFF<>tc1) and (PDWORD(P2)^ and $FFFFFF<>tc2) then Exit;
if (PDWORD(P1)^ <> tc1) and (PDWORD(P2)^ <> tc2) then
Exit;
Inc(PDWORD(P1));
Inc(PDWORD(P2));
end;
703,7 → 1183,8
end;
end;
finally
if suf1<>suf2 then suf2.UnLock;
if suf1 <> suf2 then
suf2.UnLock;
end;
end;
finally
715,85 → 1196,351
end;
end;
 
{$HINTS ON}
{$WARNINGS ON}
 
function TImageSprite.TestCollision(Sprite: TSprite): Boolean;
var
img1, img2: Integer;
b1, b2: TRect;
box1, box2: TRect;
begin
if (Sprite is TImageSprite) and FPixelCheck then
if (Sprite is TImageSprite) then
if FPixelCheck then
begin
b1 := GetDrawRect;
b2 := TImageSprite(Sprite).GetDrawRect;
box1 := GetDrawRect;
box2 := TImageSprite(Sprite).GetDrawRect;
 
img1 := GetDrawImageIndex;
img2 := TImageSprite(Sprite).GetDrawImageIndex;
 
Result := ImageCollisionTest(Image.PatternSurfaces[img1], TImageSprite(Sprite).Image.PatternSurfaces[img2],
Image.PatternRects[img1], TImageSprite(Sprite).Image.PatternRects[img2],
b1.Left, b1.Top, b2.Left, b2.Top, True);
end else
Result := ImageCollisionTest(Image.PatternSurfaces[img1],
TImageSprite(Sprite).Image.PatternSurfaces[img2], Image.PatternRects[img1],
TImageSprite(Sprite).Image.PatternRects[img2], box1.Left, box1.Top,
box2.Left, box2.Top, True);
end
else
Result := OverlapRect(Bounds(Round(Sprite.WorldX), Round(Sprite.WorldY),
Sprite.Width, Sprite.Height), Bounds(Round(WorldX), Round(WorldY), Width, Height))
else
Result := inherited TestCollision(Sprite);
end;
 
{ TImageSpriteEx }
procedure TImageSprite.Assign(Source: TPersistent);
begin
if Source is TImageSprite then begin
FCenterX := TImageSprite(Source).FCenterX;
FCenterY := TImageSprite(Source).FCenterY;
FAnimCount := TImageSprite(Source).FAnimCount;
FAnimLooped := TImageSprite(Source).FAnimLooped;
FAnimPos := TImageSprite(Source).FAnimPos;
FAnimSpeed := TImageSprite(Source).FAnimSpeed;
FAnimStart := TImageSprite(Source).FAnimStart;
FDXImage := TImageSprite(Source).FDXImage;
FPixelCheck := TImageSprite(Source).FPixelCheck;
FTile := TImageSprite(Source).FTile;
FTransparent := TImageSprite(Source).FTransparent;
FAngle := TImageSprite(Source).FAngle;
FAlpha := TImageSprite(Source).FAlpha;
FBlendMode := TImageSprite(Source).FBlendMode;
FBlurImage := TImageSprite(Source).FBlurImage;
end;
inherited;
end;
 
constructor TImageSpriteEx.Create(AParent: TSprite);
procedure TImageSprite.ReAnimate(MoveCount: Integer);
var
I: Integer;
begin
inherited Create(AParent);
FAlpha := 255;
FAnimPos := FAnimPos + FAnimSpeed * MoveCount;
 
if FAnimLooped then
begin
if FAnimCount > 0 then
FAnimPos := Mod2f(FAnimPos, FAnimCount)
else
FAnimPos := 0;
end
else
begin
if Round(FAnimPos) >= FAnimCount then
begin
FAnimPos := FAnimCount - 1;
FAnimSpeed := 0;
end;
if FAnimPos < 0 then
begin
FAnimPos := 0;
FAnimSpeed := 0;
end;
end;
if FBlurImage then
begin
{ale jen jsou-li jine souradnice}
if (FBlurImageArr[High(FBlurImageArr)].eX <> Round(WorldX)) or
(FBlurImageArr[High(FBlurImageArr)].eY <> Round(WorldY)) then
begin
for i := Low(FBlurImageArr) + 1 to High(FBlurImageArr) do
begin
FBlurImageArr[i - 1] := FBlurImageArr[i];
{adjust the blur intensity}
FBlurImageArr[i - 1].eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * (i - 1);
end;
with FBlurImageArr[High(FBlurImageArr)] do
begin
eX := Round(WorldX);
eY := Round(WorldY);
ePatternIndex := GetDrawImageIndex;
eIntensity := Round(FAlpha / (High(FBlurImageArr) + 1)) * High(FBlurImageArr);
eBlendMode := FBlendMode;
eActive := True;
end;
end;
end;
end;
 
procedure TImageSpriteEx.DoDraw;
function TImageSprite.StoreCenterX: Boolean;
begin
Result := FCenterX <> 0.5;
end;
 
function TImageSprite.StoreCenterY: Boolean;
begin
Result := FCenterY <> 0.5;
end;
 
function TImageSprite.StoreAlpha: Boolean;
begin
Result := FAlpha <> 0.0;
end;
 
procedure TImageSprite.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineProperty('BlendMode', ReadBlendMode, WriteBlendMode, FBlendMode <> rtDraw);
Filer.DefineProperty('Angle', ReadAngle, WriteAngle, FAngle <> 0);
Filer.DefineProperty('CenterX', ReadCenterX, WriteCenterX, FCenterX <> 0.5);
Filer.DefineProperty('CenterY', ReadCenterY, WriteCenterY, FCenterY <> 0.5);
Filer.DefineProperty('Alpha', ReadAlpha, WriteAlpha, FAlpha <> $FF);
Filer.DefineProperty('AnimCount', ReadAnimCount, WriteAnimCount, FAnimCount <> 0);
Filer.DefineProperty('AnimLooped', ReadAnimLooped, WriteAnimLooped, FAnimLooped);
Filer.DefineProperty('AnimPos', ReadAnimPos, WriteAnimPos, FAnimPos <> 0);
Filer.DefineProperty('AnimSpeed', ReadAnimSpeed, WriteAnimSpeed, FAnimSpeed <> 0);
Filer.DefineProperty('AnimStart', ReadAnimStart, WriteAnimStart, True);
Filer.DefineProperty('PixelCheck', ReadPixelCheck, WritePixelCheck, FPixelCheck);
Filer.DefineProperty('Tile', ReadTile, WriteTile, FTile);
Filer.DefineProperty('BlurImage', ReadBlurImage, WriteBlurImage, FBlurImage);
Filer.DefineProperty('MirrorFlip', ReadMirrorFlip, WriteMirrorFlip, FMirrorFlip <> []);
Filer.DefineProperty('TextureFilter', ReadTextureFilter, WriteTextureFilter, FTextureFilter <> D2D_POINT);
end;
 
procedure TImageSprite.WriteMirrorFlip(Writer: TWriter);
var
r: TRect;
q: TRenderMirrorFlip;
s, ss: string;
// I: Integer;
//PI: PPropInfo;
begin
r := Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height);
// PI := GetPropInfo(Self,'MirrorFlip');
// I := Integer(FMirrorFlip);
s := '[]'; ss := '';
for q := Low(TRenderMirrorFlip) to High(TRenderMirrorFlip) do
if q in FMirrorFlip then
ss := ss + GetEnumName(TypeInfo(TRenderMirrorFlip), Ord(q)) + ', ';
if ss <> '' then
s := '[' + Copy(ss, 1, Length(ss) - 2) + ']';
Writer.WriteString(s);
//--- Writer.WriteString(SetToString(PI, GetOrdProp(Self, PI), True));
end;
 
if FAngle and $FF=0 then
procedure TImageSprite.ReadMirrorFlip(Reader: TReader);
var
q: TRenderMirrorFlip;
qq: TRenderMirrorFlipSet;
s {, ss}: string;
// PI: PPropInfo;
begin
if FAlpha<255 then
// PI := GetPropInfo(Self,'MirrorFlip');
// SetOrdProp(Self,PI,StringToSet(PI, Reader.ReadString));
qq := [];
s := Reader.ReadString;
for q := Low(TRenderMirrorFlip) to High(TRenderMirrorFlip) do
if Pos(GetEnumName(TypeInfo(TRenderMirrorFlip), Ord(q)), s) <> 0 then
qq := qq + [q];
FMirrorFlip := qq;
end;
 
procedure TImageSprite.ReadAnimLooped(Reader: TReader);
begin
Image.DrawAlpha(FEngine.FSurface, r, GetDrawImageIndex, FAlpha)
end else
FAnimLooped := Reader.ReadBoolean;
end;
 
procedure TImageSprite.WriteAnimLooped(Writer: TWriter);
begin
Image.StretchDraw(FEngine.FSurface, r, GetDrawImageIndex);
Writer.WriteBoolean(FAnimLooped);
end;
end else
 
procedure TImageSprite.ReadAnimPos(Reader: TReader);
begin
if FAlpha<255 then
FAnimPos := Reader.ReadFloat;
end;
 
procedure TImageSprite.WriteAnimPos(Writer: TWriter);
begin
Image.DrawRotateAlpha(FEngine.FSurface, (r.Left+r.Right) div 2, (r.Top+r.Bottom) div 2,
Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle, FAlpha)
end else
Writer.WriteFloat(FAnimPos);
end;
 
procedure TImageSprite.ReadAnimSpeed(Reader: TReader);
begin
Image.DrawRotate(FEngine.FSurface, (r.Left+r.Right) div 2, (r.Top+r.Bottom) div 2,
Width, Height, GetDrawImageIndex, 0.5, 0.5, FAngle)
FAnimSpeed := Reader.ReadFloat;
end;
 
procedure TImageSprite.WriteAnimSpeed(Writer: TWriter);
begin
Writer.WriteFloat(FAnimSpeed);
end;
 
procedure TImageSprite.ReadAnimStart(Reader: TReader);
begin
FAnimStart := Reader.ReadInteger;
end;
 
function TImageSpriteEx.GetBoundsRect: TRect;
procedure TImageSprite.WriteAnimStart(Writer: TWriter);
begin
Result := FEngine.SurfaceRect;
Writer.WriteInteger(FAnimStart);
end;
 
function TImageSpriteEx.TestCollision(Sprite: TSprite): Boolean;
procedure TImageSprite.ReadPixelCheck(Reader: TReader);
begin
if Sprite is TImageSpriteEx then
FPixelCheck := Reader.ReadBoolean;
end;
 
procedure TImageSprite.WritePixelCheck(Writer: TWriter);
begin
Result := OverlapRect(Bounds(Trunc(Sprite.WorldX), Trunc(Sprite.WorldY), Sprite.Width, Sprite.Height),
Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height));
end else
Writer.WriteBoolean(FPixelCheck);
end;
 
procedure TImageSprite.ReadTile(Reader: TReader);
begin
Result := OverlapRect(Sprite.BoundsRect, Bounds(Trunc(WorldX), Trunc(WorldY), Width, Height));
FTile := Reader.ReadBoolean;
end;
 
procedure TImageSprite.WriteTile(Writer: TWriter);
begin
Writer.WriteBoolean(FTile);
end;
 
procedure TImageSprite.ReadAnimCount(Reader: TReader);
begin
FAnimCount := Reader.ReadInteger;
end;
 
procedure TImageSprite.WriteAnimCount(Writer: TWriter);
begin
Writer.WriteInteger(FAnimCount);
end;
 
procedure TImageSprite.ReadAlpha(Reader: TReader);
begin
FAlpha := Reader.ReadInteger;
end;
 
procedure TImageSprite.WriteAlpha(Writer: TWriter);
begin
Writer.WriteInteger(FAlpha);
end;
 
procedure TImageSprite.ReadCenterY(Reader: TReader);
begin
FCenterY := Reader.ReadFloat;
end;
 
procedure TImageSprite.WriteCenterY(Writer: TWriter);
begin
Writer.WriteFloat(FCenterY);
end;
 
procedure TImageSprite.ReadCenterX(Reader: TReader);
begin
FCenterX := Reader.ReadFloat;
end;
 
procedure TImageSprite.WriteCenterX(Writer: TWriter);
begin
Writer.WriteFloat(FCenterX);
end;
 
procedure TImageSprite.ReadAngle(Reader: TReader);
begin
FAngle := Reader.{$IFDEF VER4UP}ReadSingle{$ELSE}ReadFloat{$ENDIF};
end;
 
procedure TImageSprite.WriteAngle(Writer: TWriter);
begin
Writer.{$IFDEF VER4UP}WriteSingle{$ELSE}WriteFloat{$ENDIF}(FAngle);
end;
 
procedure TImageSprite.ReadBlendMode(Reader: TReader);
begin
FBlendMode := TRenderType(GetEnumValue(TypeInfo(TRenderType), Reader.ReadString));
end;
 
procedure TImageSprite.WriteBlendMode(Writer: TWriter);
begin
Writer.WriteString(GetEnumName(TypeInfo(TRenderType), Ord(FBlendMode)));
end;
 
procedure TImageSprite.ReadBlurImage(Reader: TReader);
begin
FBlurImage := Reader.ReadBoolean;
end;
 
procedure TImageSprite.WriteBlurImage(Writer: TWriter);
begin
Writer.WriteBoolean(FBlurImage);
end;
 
procedure TImageSprite.ReadTextureFilter(Reader: TReader);
begin
FTextureFilter := TD2DTextureFilter(Reader.ReadInteger);
end;
 
procedure TImageSprite.WriteTextureFilter(Writer: TWriter);
begin
Writer.WriteInteger(Ord(FTextureFilter));
end;
 
procedure TImageSprite.SetBlurImageArr(const Value: TBlurImageArr);
begin
FBlurImageArr := Value;
end;
 
procedure TImageSprite.SetBlurImage(const Value: Boolean);
begin
if (FBlurImage <> Value) and (Value) then
begin
FillChar(FBlurImageArr, SizeOf(FBlurImageArr), 0); //get out when set up
end;
FBlurImage := Value;
end;
 
function TImageSprite.GetImage: TPictureCollectionItem;
begin
Result := FDXImage;
end;
 
procedure TImageSprite.SetMirrorFlip(const Value: TRenderMirrorFlipSet);
begin
FMirrorFlip := Value;
end;
 
{ TBackgroundSprite }
 
constructor TBackgroundSprite.Create(AParent: TSprite);
begin
inherited Create(AParent);
FMap := nil;
FMapWidth := 0;
FMapHeight := 0;
Collisioned := False;
end;
 
803,15 → 1550,35
inherited Destroy;
end;
 
procedure TBackgroundSprite.ChipsDraw(Image: TPictureCollectionItem; X, Y: Integer; PatternIndex: Integer);
begin
if AsSigned(FOnDraw) then
FOnDraw(Self)
else
begin
//Image.Draw(FEngine.Surface, X, Y, PatternIndex);
{New function implemented}
if Assigned(FEngine.FOwner) then
//Image.DrawAlpha(DXDraw1.Surface,ChipsRect,ChipsPatternIndex,Blend);
DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, ChipsRect, ChipsPatternIndex,
FBlurImageArr, FBlurImage, FTextureFilter, FMirrorFlip, FBlendMode, FAngle,
Map[X,Y].Alpha, FCenterX, FCenterY);
end;
end;
 
procedure TBackgroundSprite.DoDraw;
var
_x, _y, cx, cy, cx2, cy2, c, ChipWidth, ChipHeight: Integer;
TmpX, TmpY, cx, cy, cx2, cy2, PatternIndex, ChipWidth, ChipHeight: Integer;
StartX, StartY, EndX, EndY, StartX_, StartY_, OfsX, OfsY, dWidth, dHeight: Integer;
r: TRect;
Q: TMapType;
begin
if Image=nil then Exit;
LoadImage;
if Image = nil then
Exit;
 
if (FMapWidth<=0) or (FMapHeight<=0) then Exit;
if (FMapWidth <= 0) or (FMapHeight <= 0) then
Exit;
 
r := Image.PatternRects[0];
ChipWidth := r.Right-r.Left;
820,13 → 1587,13
dWidth := (FEngine.SurfaceRect.Right+ChipWidth) div ChipWidth+1;
dHeight := (FEngine.SurfaceRect.Bottom+ChipHeight) div ChipHeight+1;
 
_x := Trunc(WorldX);
_y := Trunc(WorldY);
TmpX := Round(WorldX);
TmpY := Round(WorldY);
 
OfsX := _x mod ChipWidth;
OfsY := _y mod ChipHeight;
OfsX := TmpX mod ChipWidth;
OfsY := TmpY mod ChipHeight;
 
StartX := _x div ChipWidth;
StartX := TmpX div ChipWidth;
StartX_ := 0;
 
if StartX<0 then
835,7 → 1602,7
StartX := 0;
end;
 
StartY := _y div ChipHeight;
StartY := TmpY div ChipHeight;
StartY_ := 0;
 
if StartY<0 then
855,52 → 1622,87
for cx:=-1 to dWidth do
begin
cx2 := Mod2((cx-StartX+StartX_), FMapWidth);
c := Chips[cx2, cy2];
if c>=0 then
Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c);
PatternIndex := Chips[cx2, cy2];
ChipsPatternIndex := PatternIndex; //refresh only
ChipsRect := Bounds(cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, ChipWidth, ChipHeight);
if PatternIndex >= 0 then
begin
if AsSigned(FOnDraw) then
FOnDraw(Self)
else
begin
{New function implemented}
if Assigned(FEngine.FOwner) then
begin
Q := Map[cx2,cy2];
DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, ChipsRect, Q.MapChip,
FBlurImageArr, FBlurImage, Q.TextureFilter, Q.MirrorFlip, Q.Rendered, Q.Angle,
Q.Alpha, Q.CenterX, Q.CenterY);
end;
end;
end else
end;
end;
end;
end
else
begin
for cy:=StartY to EndY-1 do
for cx:=StartX to EndX-1 do
begin
c := Chips[cx-StartX+StartX_, cy-StartY+StartY_];
if c>=0 then
Image.Draw(FEngine.Surface, cx*ChipWidth+OfsX, cy*ChipHeight+OfsY, c);
PatternIndex := Chips[cx - StartX + StartX_, cy - StartY + StartY_];
ChipsPatternIndex := PatternIndex; //refresh only
ChipsRect := Bounds(cx * ChipWidth + OfsX, cy * ChipHeight + OfsY, ChipWidth, ChipHeight);
if PatternIndex >= 0 then
begin
if AsSigned(FOnDraw) then
FOnDraw(Self)
else
begin
{New function implemented}
if Assigned(FEngine.FOwner) then
begin
Q := Map[cx,cy];
DXDraws.DXDraw_Paint(FEngine.FOwner.FDXDraw, Image, ChipsRect, Q.MapChip,
FBlurImageArr, FBlurImage, Q.TextureFilter, Q.MirrorFlip, Q.Rendered, Q.Angle,
Q.Alpha, Q.CenterX, Q.CenterY);
end;
end;
end
end;
end;
end;
 
function TBackgroundSprite.TestCollision(Sprite: TSprite): Boolean;
var
b, b1, b2: TRect;
box0, box1, box2: TRect;
cx, cy, ChipWidth, ChipHeight: Integer;
r: TRect;
begin
Result := True;
if Image=nil then Exit;
if (FMapWidth<=0) or (FMapHeight<=0) then Exit;
if Image = nil then
Exit;
if (FMapWidth <= 0) or (FMapHeight <= 0) then
Exit;
 
r := Image.PatternRects[0];
ChipWidth := r.Right-r.Left;
ChipHeight := r.Bottom-r.Top;
 
box1 := Sprite.BoundsRect;
box2 := BoundsRect;
 
IntersectRect(box0, box1, box2);
 
b1 := Sprite.BoundsRect;
b2 := BoundsRect;
OffsetRect(box0, -Round(WorldX), -Round(WorldY));
OffsetRect(box1, -Round(WorldX), -Round(WorldY));
 
IntersectRect(b, b1, b2);
 
OffsetRect(b, -Trunc(WorldX), -Trunc(WorldY));
OffsetRect(b1, -Trunc(WorldX), -Trunc(WorldY));
 
for cy:=(b.Top-ChipHeight+1) div ChipHeight to b.Bottom div ChipHeight do
for cx:=(b.Left-ChipWidth+1) div ChipWidth to b.Right div ChipWidth do
for cy := (box0.Top - ChipHeight + 1) div ChipHeight to box0.Bottom div ChipHeight do
for cx := (box0.Left - ChipWidth + 1) div ChipWidth to box0.Right div ChipWidth do
if CollisionMap[Mod2(cx, MapWidth), Mod2(cy, MapHeight)] then
begin
if OverlapRect(Bounds(cx*ChipWidth, cy*ChipHeight, ChipWidth, ChipHeight), b1) then Exit;
if OverlapRect(Bounds(cx * ChipWidth, cy * ChipHeight, ChipWidth,
ChipHeight), box1) then
Exit;
end;
 
Result := False;
909,22 → 1711,43
function TBackgroundSprite.GetChip(X, Y: Integer): Integer;
begin
if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
Result := PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^
Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.MapChip
else
Result := -1;
end;
 
type
PBoolean = ^Boolean;
 
function TBackgroundSprite.GetCollisionMapItem(X, Y: Integer): Boolean;
begin
if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
Result := PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^
Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionChip
else
Result := False;
end;
 
function TBackgroundSprite.GetCollisionRectItem(X, Y: Integer): TRect;
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionRect
else
Result := Rect(0, 0, 0, 0);
end;
 
function TBackgroundSprite.GetTagMap(X, Y: Integer): Integer;
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Tag
else
Result := 0;
end;
 
function TBackgroundSprite.GetMap(X, Y: Integer): TMapType;
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^
else
FillChar(Result, SizeOf(Result), 0);
end;
 
function TBackgroundSprite.GetBoundsRect: TRect;
begin
if FTile then
931,9 → 1754,10
Result := FEngine.SurfaceRect
else
begin
LoadImage;
if Image<>nil then
Result := Bounds(Trunc(WorldX), Trunc(WorldY),
Image.Width*FMapWidth, Image.Height*FMapHeight)
Result := Bounds(Round(WorldX), Round(WorldY), Image.Width * FMapWidth,
Image.Height * FMapHeight)
else
Result := Rect(0, 0, 0, 0);
end;
942,15 → 1766,33
procedure TBackgroundSprite.SetChip(X, Y: Integer; Value: Integer);
begin
if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
PInteger(Integer(FMap)+(Y*FMapWidth+X)*SizeOf(Integer))^ := Value;
PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.MapChip := Value;
end;
 
procedure TBackgroundSprite.SetCollisionMapItem(X, Y: Integer; Value: Boolean);
begin
if (X>=0) and (X<FMapWidth) and (Y>=0) and (Y<FMapHeight) then
PBoolean(Integer(FCollisionMap)+(Y*FMapWidth+X)*SizeOf(Boolean))^ := Value;
PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionChip := Value;
end;
 
procedure TBackgroundSprite.SetCollisionRectItem(X, Y: Integer; Value: TRect);
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.CollisionRect := Value;
end;
 
procedure TBackgroundSprite.SetTagMap(X, Y: Integer; Value: Integer);
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Tag := Value;
end;
 
procedure TBackgroundSprite.SetMap(X, Y: Integer; Value: TMapType);
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^ := Value;
end;
 
procedure TBackgroundSprite.SetMapHeight(Value: Integer);
begin
SetMapSize(FMapWidth, Value);
961,25 → 1803,116
SetMapSize(Value, FMapHeight);
end;
 
procedure TBackgroundSprite.SetImage(Img: TPictureCollectionItem);
begin
inherited SetImage(Img);
if Assigned(Img) then
begin
FWidth := FMapWidth * Img.Width;
FHeight := FMapHeight * Img.Height;
end
else
begin
FWidth := 0;
FHeight := 0;
end;
end;
 
procedure TBackgroundSprite.SetMapSize(AMapWidth, AMapHeight: Integer);
var I: Integer;
begin
if (FMapWidth<>AMapWidth) or (FMapHeight<>AMapHeight) then
if (FMapWidth <> AMapWidth) or (FMapHeight <> AMapHeight) or (FMap = nil) then
begin
try
if (AMapWidth<=0) or (AMapHeight<=0) then
begin
FreeMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType)); FMap := nil;
AMapWidth := 0;
AMapHeight := 0;
end;
FMapWidth := AMapWidth;
FMapHeight := AMapHeight;
ReAllocMem(FMap, FMapWidth*FMapHeight*SizeOf(Integer));
FillChar(FMap^, FMapWidth*FMapHeight*SizeOf(Integer), 0);
System.ReallocMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType));
if Assigned(FMap) then
begin
FillChar(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType), 0);
for I := 0 to FMapWidth * FMapHeight - 1 do
PMapType(Integer(FMap) + (I) * SizeOf(TMapType))^.CollisionChip := True;
end
except
FreeMem(FMap, FMapWidth * FMapHeight * SizeOf(TMapType));
FMap := nil;
end;
end
end;
 
ReAllocMem(FCollisionMap, FMapWidth*FMapHeight*SizeOf(Boolean));
FillChar(FCollisionMap^, FMapWidth*FMapHeight*SizeOf(Boolean), 1);
procedure TBackgroundSprite.Assign(Source: TPersistent);
begin
if Source is TBackgroundSprite then
begin
FMapWidth := TBackgroundSprite(Source).FMapWidth;
FMapHeight := TBackgroundSprite(Source).FMapHeight;
FTile := TBackgroundSprite(Source).FTile;
end;
inherited;
end;
 
procedure TBackgroundSprite.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('Map', ReadMapData, WriteMapData, FMap <> nil);
end;
 
type
TMapDataHeader = packed record
MapWidth: Integer;
MapHeight: Integer;
end;
 
procedure TBackgroundSprite.ReadMapData(Stream: TStream);
var
Header: TMapDataHeader;
begin
Stream.ReadBuffer(Header, SizeOf(Header));
FMapWidth := Header.MapWidth;
FMapHeight := Header.MapHeight;
SetMapSize(Header.MapWidth, Header.MapHeight);
if Assigned(FMap) and (Header.MapWidth > 0) and (Header.MapHeight > 0) then
begin
Stream.ReadBuffer(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType));
end;
end;
 
procedure TBackgroundSprite.WriteMapData(Stream: TStream);
var
Header: TMapDataHeader;
begin
Header.MapWidth := FMapWidth;
Header.MapHeight := FMapHeight;
Stream.WriteBuffer(Header, SizeOf(Header));
if Assigned(FMap) then
Stream.WriteBuffer(FMap^, FMapWidth * FMapHeight * SizeOf(TMapType));
end;
 
function TBackgroundSprite.GetOverlap(X, Y: Integer): Integer;
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
Result := PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Overlap
else
Result := 0;
end;
 
procedure TBackgroundSprite.SetOverlap(X, Y: Integer; const Value: Integer);
begin
if (X >= 0) and (X < FMapWidth) and (Y >= 0) and (Y < FMapHeight) then
PMapType(Integer(FMap) + (Y * FMapWidth + X) * SizeOf(TMapType))^.Overlap := Value;
end;
 
function TBackgroundSprite.IsMapEmpty: Boolean;
begin
Result := (FMap = nil) or (FMapWidth <= 0) or (FMapHeight <= 0);
end;
 
{ TSpriteEngine }
 
constructor TSpriteEngine.Create(AParent: TSprite);
986,14 → 1919,199
begin
inherited Create(AParent);
FDeadList := TList.Create;
// group handling
{$IFDEF Ver4Up}
fCurrentSelected := Tlist.create;
GroupCount := 10;
{$ENDIF}
end;
 
destructor TSpriteEngine.Destroy;
begin
// cleanup Group handling
{$IFDEF Ver4Up}
ClearCurrent;
GroupCount := 0;
{$ENDIF}
FDeadList.Free;
inherited Destroy;
{$IFDEF Ver4Up}
fCurrentSelected.free;
{$ENDIF}
end;
 
procedure TSpriteEngine.Collisions;
var
index: Integer;
begin
for index := 0 to Count - 1 do
Items[index].Collision;
end;
{Collisions}
{$IFDEF Ver4Up}
 
procedure TSpriteEngine.GroupSelect(const Area: TRect; Add: Boolean = False);
begin
GroupSelect(Area, [Tsprite], Add);
end; {GroupSelect}
 
procedure TSpriteEngine.GroupSelect(const Area: TRect; Filter: array of TSpriteClass; Add: Boolean = False);
var
index, index2: Integer;
sprite: TSprite;
begin
Assert(length(Filter) <> 0, 'Filter = []');
if not Add then
ClearCurrent;
if length(Filter) = 1 then
begin
for Index := 0 to Count - 1 do
begin
sprite := Items[Index];
if (sprite is Filter[0]) and OverlapRect(sprite.GetBoundsRect, Area) then
sprite.Selected := true;
end
end
else
begin
for Index := 0 to Count - 1 do
begin
sprite := Items[index];
for index2 := 0 to high(Filter) do
if (sprite is Filter[index2]) and OverlapRect(sprite.GetBoundsRect, Area) then
begin
sprite.Selected := true;
break;
end;
end
end;
fObjectsSelected := CurrentSelected.count <> 0;
end; {GroupSelect}
 
function TSpriteEngine.Select(Point: TPoint; Filter: array of TSpriteClass; Add: Boolean = False): Tsprite;
var
index, index2: Integer;
begin
Assert(length(Filter) <> 0, 'Filter = []');
if not Add then
ClearCurrent;
// By searching the Drawlist in reverse
// we select the highest sprite if the sprit is under the point
assert(FDrawList <> nil, 'FDrawList = nil');
if length(Filter) = 1 then
begin
for Index := FDrawList.Count - 1 downto 0 do
begin
Result := FDrawList[Index];
if (Result is Filter[0]) and PointInRect(Point, Result.GetBoundsRect) then
begin
Result.Selected := true;
fObjectsSelected := CurrentSelected.count <> 0;
exit;
end;
end
end
else
begin
for Index := FDrawList.Count - 1 downto 0 do
begin
Result := FDrawList[index];
for index2 := 0 to high(Filter) do
if (Result is Filter[index2]) and PointInRect(Point, Result.GetBoundsRect) then
begin
Result.Selected := true;
fObjectsSelected := CurrentSelected.count <> 0;
exit;
end;
end
end;
Result := nil;
end; {Select}
 
function TSpriteEngine.Select(Point: TPoint; Add: Boolean = False): TSprite;
begin
Result := Select(Point, [Tsprite], Add);
end; {Select}
 
procedure TSpriteEngine.ClearCurrent;
begin
while CurrentSelected.count <> 0 do
TSprite(CurrentSelected[CurrentSelected.count - 1]).Selected := False;
fObjectsSelected := False;
end; {ClearCurrent}
 
procedure TSpriteEngine.ClearGroup(GroupNumber: Integer);
var
index: Integer;
Group: Tlist;
begin
Group := Groups[GroupNumber];
if Group <> nil then
for index := 0 to Group.count - 1 do
TSprite(Group[index]).Selected := False;
end; {ClearGroup}
 
procedure TSpriteEngine.CurrentToGroup(GroupNumber: Integer; Add: Boolean = False);
var
Group: Tlist;
index: Integer;
begin
Group := Groups[GroupNumber];
if Group = nil then
exit;
if not Add then
ClearGroup(GroupNumber);
for index := 0 to Group.count - 1 do
TSprite(Group[index]).GroupNumber := GroupNumber;
end; {CurrentToGroup}
 
procedure TSpriteEngine.GroupToCurrent(GroupNumber: Integer; Add: Boolean = False);
var
Group: Tlist;
index: Integer;
begin
if not Add then
ClearCurrent;
Group := Groups[GroupNumber];
if Group <> nil then
for index := 0 to Group.count - 1 do
TSprite(Group[index]).Selected := true;
end; {GroupToCurrent}
 
function TSpriteEngine.GetGroup(Index: Integer): Tlist;
begin
if (index >= 0) or (index < fGroupCount) then
Result := fGroups[index]
else
Result := nil;
end; {GetGroup}
 
procedure TSpriteEngine.SetGroupCount(AGroupCount: Integer);
var
index: Integer;
begin
if (AGroupCount <> FGroupCount) and (AGroupCount >= 0) then
begin
if FGroupCount > AGroupCount then
begin // remove groups
for index := AGroupCount to FGroupCount - 1 do
begin
ClearGroup(index);
FGroups[index].Free;
end;
SetLength(FGroups, AGroupCount);
end
else
begin // add groups
SetLength(FGroups, AGroupCount);
for index := FGroupCount to AGroupCount - 1 do
FGroups[index] := Tlist.Create;
end;
FGroupCount := Length(FGroups);
end;
end; {SetGroupCount}
{$ENDIF}
 
procedure TSpriteEngine.Dead;
begin
while FDeadList.Count>0 do
1019,10 → 2137,15
 
{ TCustomDXSpriteEngine }
 
constructor TCustomDXSpriteEngine.Create(AOnwer: TComponent);
constructor TCustomDXSpriteEngine.Create(AOwner: TComponent);
begin
inherited Create(AOnwer);
inherited Create(AOwner);
FEngine := TSpriteEngine.Create(nil);
FEngine.FOwner := Self;
FItems := TSpriteCollection.Create(Self);
FItems.FOwner := Self;
FItems.FOwnerItem := FEngine;
FItems.Initialize(FEngine);
end;
 
destructor TCustomDXSpriteEngine.Destroy;
1076,4 → 2199,269
FDXDraw.RegisterNotifyEvent(DXDrawNotifyEvent);
end;
 
procedure TCustomDXSpriteEngine.SetItems(const Value: TSpriteCollection);
begin
FItems.Assign(Value);
end;
 
procedure TCustomDXSpriteEngine.Clone(const Amount: Word; const BaseNameOfSprite: string);
var
i: Integer;
begin
if Amount = 0 then Exit;
for i := 1 to Amount do
begin
with FItems.Add do
begin
KindSprite := FItems.Find(BaseNameOfSprite).KindSprite;
Sprite.AsSign(FItems.Find(BaseNameOfSprite).Sprite);
{name has to be different}
Name := Format(BaseNameOfSprite + '_%d', [I]); //simple name for sprite like Name_1 etc.
Sprite.Tag := 0; //for sprite you can use Tag property in future as well
end;
end;
end;
 
function TCustomDXSpriteEngine.ForEach(PrefixNameOdSprite: string; var Names: TStringList): Boolean;
var
I: Integer;
begin
if Names = nil then
Names := TStringList.Create;
for I := 0 to Items.Count - 1 do
begin
if PrefixNameOdSprite = '' then
Names.Add(Items[I].Name)
else
{is prefix, fo names like Player????}
if Pos(PrefixNameOdSprite, Items[I].Name) = 1 then
Names.Add(Items[I].Name);
end;
Result := Names.Count > 0;
if not Result then {$IFDEF VER5UP}FreeAndNil(Names){$ELSE}begin Names.Free; names := nil end{$ENDIF};
end;
 
{ TSpriteCollectionItem }
 
function TSpriteCollectionItem.GetSpriteCollection: TSpriteCollection;
begin
Result := Collection as TSpriteCollection;
end;
 
procedure TSpriteCollectionItem.SetSprite(const Value: TSprite);
begin
FSprite.Assign(Value);
end;
 
constructor TSpriteCollectionItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
FOwner := Collection;
FOwnerItem := (Collection as TSpriteCollection).FOwnerItem;
FSpriteType := stSprite;
FSprite := TSprite.Create(FOwnerItem);
end;
 
procedure TSpriteCollectionItem.Assign(Source: TPersistent);
begin
if Source is TSpriteCollectionItem then
begin
Finalize;
FSprite.Assign(TSpriteCollectionItem(Source).FSprite);
inherited Assign(Source);
Initialize;
end
else
inherited;
end;
 
procedure TSpriteCollectionItem.Initialize;
begin
 
end;
 
destructor TSpriteCollectionItem.Destroy;
begin
FSprite.Destroy;
inherited;
end;
 
procedure TSpriteCollectionItem.Finalize;
begin
 
end;
 
procedure TSpriteCollectionItem.SetOnCollision(
const Value: TCollisionEvent);
begin
FSprite.FOnCollision := Value;
end;
 
procedure TSpriteCollectionItem.SetOnDraw(const Value: TDrawEvent);
begin
FSprite.FOnDraw := Value;
end;
 
procedure TSpriteCollectionItem.SetOnMove(const Value: TMoveEvent);
begin
FSprite.FOnMove := Value
end;
 
function TSpriteCollectionItem.GetDisplayName: string;
begin
Result := inherited GetDisplayName
end;
 
procedure TSpriteCollectionItem.SetDisplayName(const Value: string);
begin
if (Value <> '') and (AnsiCompareText(Value, GetDisplayName) <> 0) and
(Collection is TSpriteCollection) and (TSpriteCollection(Collection).IndexOf(Value) >= 0) then
raise Exception.Create(Format(SSpriteDuplicateName, [Value]));
inherited SetDisplayName(Value);
end;
 
function TSpriteCollectionItem.GetSpriteType: TSpriteType;
begin
Result := FSpriteType;
end;
 
procedure TSpriteCollectionItem.SetSpriteType(const Value: TSpriteType);
var
tmpSprite: TSprite;
begin
if Value <> FSpriteType then
begin
case Value of
stSprite: tmpSprite := TSprite.Create(TSpriteEngine(FOwnerItem));
stImageSprite: TImageSprite(tmpSprite) := TImageSprite.Create(TSpriteEngine(FOwnerItem));
stImageSpriteEx: TImageSpriteEx(tmpSprite) := TImageSpriteEx.Create(TSpriteEngine(FOwnerItem));
stBackgroundSprite: TBackgroundSprite(tmpSprite) := TBackgroundSprite.Create(TSpriteEngine(FOwnerItem));
else
tmpSprite := nil
end;
if Assigned(FSprite) then
try
tmpSprite.Assign(FSprite);
tmpSprite.FOnDraw := FSprite.FOnDraw;
tmpSprite.FOnMove := FSprite.FOnMove;
tmpSprite.FOnCollision := FSprite.FOnCollision;
tmpSprite.FOnGetImage := FSprite.FOnGetImage;
finally
FSprite.Free; FSprite := nil;
end;
FSprite := tmpSprite;
FSpriteType := Value;
end;
end;
 
function TSpriteCollectionItem.GetOnCollision: TCollisionEvent;
begin
Result := FSprite.FOnCollision
end;
 
function TSpriteCollectionItem.GetOnDraw: TDrawEvent;
begin
Result := FSprite.FOnDraw
end;
 
function TSpriteCollectionItem.GetOnMove: TMoveEvent;
begin
Result := FSprite.FOnMove
end;
 
function TSpriteCollectionItem.GetOnGetImage: TGetImage;
begin
Result := FSprite.FOnGetImage;
end;
 
procedure TSpriteCollectionItem.SetOnGetImage(const Value: TGetImage);
begin
FSprite.FOnGetImage := Value;
end;
 
function TSpriteCollectionItem.GetImageList: TCustomDXImageList;
begin
Result := FSprite.FDXImageList;
end;
 
procedure TSpriteCollectionItem.SetImageList(const Value: TCustomDXImageList);
begin
FSprite.FDXImageList := Value;
end;
 
function TSpriteCollectionItem.Clone(NewName: string): TSprite;
var
T: TSpriteCollectionItem;
begin
T := GetSpriteCollection.Add;
T.KindSprite := Self.FSpriteType;
T.Assign(Self);
T.Name := NewName;
Result := T.FSprite;
end;
 
{ TSpriteCollection }
 
function TSpriteCollection.Initialized: Boolean;
begin
Result := FInitializeFlag;
end;
 
constructor TSpriteCollection.Create(AOwner: TPersistent);
begin
inherited Create(TSpriteCollectionItem);
FOwner := AOwner;
FInitializeFlag := Initialize(TSpriteEngine(AOwner));
end;
 
function TSpriteCollection.GetItem(Index: Integer): TSpriteCollectionItem;
begin
Result := TSpriteCollectionItem(inherited Items[Index]);
end;
 
function TSpriteCollection.Initialize(DXSpriteEngine: TSpriteEngine): Boolean;
begin
Result := True;
try
if AsSigned(FOnInitialize) then
FOnInitialize(DXSpriteEngine);
except
Result := False;
end
end;
 
function TSpriteCollection.Find(const Name: string): TSpriteCollectionItem;
var
i: Integer;
begin
i := IndexOf(Name);
if i = -1 then
raise ESpriteCollectionError.CreateFmt(SSpriteNotFound, [Name]);
Result := Items[i];
end;
 
procedure TSpriteCollection.Finalize;
begin
if AsSigned(FOnFinalize) then
FOnFinalize(FOwnerItem);
end;
 
function TSpriteCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
 
function TSpriteCollection.Add: TSpriteCollectionItem;
begin
Result := TSpriteCollectionItem(inherited Add);
Result.FOwner := FOwner;
Result.FOwnerItem := FOwnerItem;
end;
 
destructor TSpriteCollection.Destroy;
begin
Finalize;
inherited;
end;
 
end.
/VCL_DELPHIX_D6/DXSpriteEdit.dfm
0,0 → 1,441
object DelphiXSpriteEditForm: TDelphiXSpriteEditForm
Left = 309
Top = 201
BorderStyle = bsDialog
Caption = 'Sprite Init Editor'
ClientHeight = 373
ClientWidth = 370
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
Scaled = False
PixelsPerInch = 96
TextHeight = 13
object Bevel2: TBevel
Left = 8
Top = 8
Width = 273
Height = 361
Shape = bsFrame
end
object OKButton: TButton
Left = 288
Top = 8
Width = 73
Height = 25
Caption = 'OK'
Default = True
TabOrder = 0
OnClick = OKButtonClick
end
object CancelButton: TButton
Left = 288
Top = 40
Width = 73
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
object ClearButton: TButton
Left = 288
Top = 344
Width = 73
Height = 25
Caption = '&Clear'
TabOrder = 2
Visible = False
end
object Panel1: TPanel
Left = 16
Top = 16
Width = 257
Height = 345
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 3
object LAlpha: TLabel
Left = 8
Top = 74
Width = 69
Height = 13
Caption = 'Alpha (0..255):'
FocusControl = EAlpha
end
object LAngle: TLabel
Left = 8
Top = 98
Width = 69
Height = 13
Caption = 'Angle (0..255):'
FocusControl = EAngle
end
object LAnimCount: TLabel
Left = 23
Top = 122
Width = 54
Height = 13
Caption = 'AnimCount:'
FocusControl = EAnimCount
end
object LAnimPos: TLabel
Left = 33
Top = 170
Width = 44
Height = 13
Caption = 'AnimPos:'
FocusControl = EAnimPos
end
object LAnimSpeed: TLabel
Left = 20
Top = 194
Width = 57
Height = 13
Caption = 'AnimSpeed:'
FocusControl = EAnimSpeed
end
object LAnimStart: TLabel
Left = 29
Top = 218
Width = 48
Height = 13
Caption = 'AnimStart:'
FocusControl = EAnimStart
end
object LHeight: TLabel
Left = 43
Top = 242
Width = 34
Height = 13
Caption = 'Height:'
FocusControl = EHeight
end
object LMapHeight: TLabel
Left = 142
Top = 99
Width = 55
Height = 13
Caption = 'MapHeight:'
FocusControl = EMapHeight
end
object LMapWidth: TLabel
Left = 145
Top = 123
Width = 52
Height = 13
Caption = 'MapWidth:'
FocusControl = EMapWidth
end
object LWidth: TLabel
Left = 46
Top = 266
Width = 31
Height = 13
Caption = 'Width:'
FocusControl = EWidth
end
object LX: TLabel
Left = 187
Top = 267
Width = 10
Height = 13
Caption = 'X:'
FocusControl = EX
end
object LY: TLabel
Left = 187
Top = 291
Width = 10
Height = 13
Caption = 'Y:'
FocusControl = EY
end
object LZ: TLabel
Left = 187
Top = 315
Width = 10
Height = 13
Caption = 'Z:'
FocusControl = EZ
end
object Label1: TLabel
Left = 18
Top = 50
Width = 59
Height = 13
Caption = 'Blend mode:'
FocusControl = EBlendMode
end
object Label2: TLabel
Left = 8
Top = 6
Width = 83
Height = 13
Caption = 'Available Images:'
FocusControl = eImage
end
object Label3: TLabel
Left = 156
Top = 51
Width = 41
Height = 13
Caption = 'CenterX:'
FocusControl = ECenterX
end
object Label4: TLabel
Left = 156
Top = 75
Width = 41
Height = 13
Caption = 'CenterY:'
FocusControl = ECenterY
end
object Label5: TLabel
Left = 16
Top = 315
Width = 61
Height = 13
Caption = 'Texture filter:'
FocusControl = ETexFilter
end
object EAlpha: TEdit
Left = 80
Top = 71
Width = 48
Height = 21
TabOrder = 3
Text = '255'
end
object EAngle: TEdit
Left = 80
Top = 95
Width = 48
Height = 21
TabOrder = 4
Text = '0'
end
object EAnimCount: TEdit
Left = 80
Top = 119
Width = 48
Height = 21
TabOrder = 5
Text = '0'
end
object EAnimPos: TEdit
Left = 80
Top = 167
Width = 48
Height = 21
TabOrder = 7
Text = '0'
end
object EAnimSpeed: TEdit
Left = 80
Top = 191
Width = 48
Height = 21
TabOrder = 8
Text = '0'
end
object EAnimStart: TEdit
Left = 80
Top = 215
Width = 48
Height = 21
TabOrder = 9
Text = '0'
end
object EHeight: TEdit
Left = 80
Top = 239
Width = 48
Height = 21
TabOrder = 10
Text = '0'
end
object EMapHeight: TEdit
Left = 200
Top = 96
Width = 48
Height = 21
TabOrder = 15
Text = '0'
end
object EMapWidth: TEdit
Left = 200
Top = 120
Width = 48
Height = 21
TabOrder = 16
Text = '0'
end
object EWidth: TEdit
Left = 80
Top = 263
Width = 48
Height = 21
TabOrder = 11
Text = '0'
end
object EX: TEdit
Left = 200
Top = 264
Width = 48
Height = 21
TabOrder = 22
Text = '0'
end
object EY: TEdit
Left = 200
Top = 288
Width = 48
Height = 21
TabOrder = 23
Text = '0'
end
object EZ: TEdit
Left = 200
Top = 312
Width = 48
Height = 21
TabOrder = 24
Text = '0'
end
object EBlendMode: TComboBox
Left = 80
Top = 47
Width = 72
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 2
Items.Strings = (
'Draw'
'Blend'
'Add'
'Sub')
end
object eImage: TComboBox
Left = 8
Top = 22
Width = 153
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 0
OnChange = eImageChange
OnExit = eImageExit
end
object ECenterX: TEdit
Left = 200
Top = 48
Width = 48
Height = 21
TabOrder = 13
Text = '0'
end
object ECenterY: TEdit
Left = 200
Top = 72
Width = 48
Height = 21
TabOrder = 14
Text = '0'
end
object chbBlurImage: TCheckBox
Left = 59
Top = 288
Width = 69
Height = 17
Alignment = taLeftJustify
Caption = 'Blur Image'
TabOrder = 12
end
object chbAnimLooped: TCheckBox
Left = 48
Top = 144
Width = 80
Height = 17
Alignment = taLeftJustify
Caption = 'AnimLooped'
TabOrder = 6
end
object chbMoved: TCheckBox
Left = 194
Top = 144
Width = 54
Height = 17
Alignment = taLeftJustify
Caption = 'Moved'
TabOrder = 17
end
object chbCollisioned: TCheckBox
Left = 177
Top = 168
Width = 71
Height = 17
Alignment = taLeftJustify
Caption = 'Collisioned'
TabOrder = 18
end
object chbPixelCheck: TCheckBox
Left = 175
Top = 192
Width = 73
Height = 17
Alignment = taLeftJustify
Caption = 'PixelCheck'
TabOrder = 19
end
object chbTile: TCheckBox
Left = 209
Top = 216
Width = 39
Height = 17
Alignment = taLeftJustify
Caption = 'Tile'
TabOrder = 20
end
object chbVisible: TCheckBox
Left = 196
Top = 240
Width = 52
Height = 17
Alignment = taLeftJustify
Caption = 'Visible'
TabOrder = 21
end
object btnMapEdit: TButton
Left = 173
Top = 13
Width = 75
Height = 25
Caption = 'Map Edit'
Enabled = False
TabOrder = 1
OnClick = MapEditButtonClick
end
object ETexFilter: TComboBox
Left = 80
Top = 312
Width = 89
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 25
Items.Strings = (
'POINT'
'LINEAR'
'FLATCUBIC'
'GAUSSIANCUBIC'
'ANISOTROPIC')
end
end
end
/VCL_DELPHIX_D6/DXSpriteEdit.pas
0,0 → 1,446
unit DXSpriteEdit;
//(c)2006-7 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) create sprite and store it into rersource.
b) allow do change and create complex sprite (background or particle).
c) default values for complex type too.
d) direct link to image from dximagelist.
 
}
interface
{$INCLUDE DelphiXcfg.inc}
uses
Windows, SysUtils, Classes, Forms, Dialogs, Controls, ExtCtrls, StdCtrls,
Graphics, DXSprite, DXDraws;
 
type
{ TEdit }
 
TEdit = class(StdCtrls.TEdit) {injected class}
private
function GetAsInteger: Integer;
procedure SetAsInteger(const Value: Integer);
function GetAsFloat: Double;
procedure SetAsFloat(const Value: Double);
published
public
property AsInteger: Integer read GetAsInteger write SetAsInteger;
property AsFloat: Double read GetAsFloat write SetAsFloat;
end;
 
{ TDelphiXWaveEditForm }
 
TDelphiXSpriteEditForm = class(TForm)
Bevel2: TBevel;
OKButton: TButton;
CancelButton: TButton;
ClearButton: TButton;
Panel1: TPanel;
EAlpha: TEdit;
EAngle: TEdit;
EAnimCount: TEdit;
EAnimPos: TEdit;
EAnimSpeed: TEdit;
EAnimStart: TEdit;
EHeight: TEdit;
EMapHeight: TEdit;
EMapWidth: TEdit;
EWidth: TEdit;
EX: TEdit;
EY: TEdit;
EZ: TEdit;
LAlpha: TLabel;
LAngle: TLabel;
LAnimCount: TLabel;
LAnimPos: TLabel;
LAnimSpeed: TLabel;
LAnimStart: TLabel;
LHeight: TLabel;
LMapHeight: TLabel;
LMapWidth: TLabel;
LWidth: TLabel;
LX: TLabel;
LY: TLabel;
LZ: TLabel;
Label1: TLabel;
EBlendMode: TComboBox;
eImage: TComboBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
ECenterX: TEdit;
ECenterY: TEdit;
chbBlurImage: TCheckBox;
chbAnimLooped: TCheckBox;
chbMoved: TCheckBox;
chbCollisioned: TCheckBox;
chbPixelCheck: TCheckBox;
chbTile: TCheckBox;
chbVisible: TCheckBox;
btnMapEdit: TButton;
Label5: TLabel;
ETexFilter: TComboBox;
procedure eImageChange(Sender: TObject);
procedure eImageExit(Sender: TObject);
procedure OKButtonClick(Sender: TObject);
procedure MapEditButtonClick(Sender: TObject);
private
FChanged: Boolean;
FvkType: TSpriteType;
FSprite: TSprite;
//
FDXImageList: TCustomDXImageList;
FDXImageName: string;
procedure FieldEnabler(SpriteType: TSpriteType);
public
procedure LoadDataToForm(AData: TPersistent);
function SaveDataFromForm: TPersistent;
property Sprite: TSprite read FSprite write FSprite;
end;
 
var
DelphiXSpriteEditForm: TDelphiXSpriteEditForm;
 
implementation
 
uses DXConsts, DXMapEdit, DXClass;
 
{$R *.DFM}
 
{ TEdit }
 
function TEdit.GetAsFloat: Double;
begin
try
Result := StrToFloat(Self.Text);
except
Result := 0;
end;
end;
 
function TEdit.GetAsInteger: Integer;
begin
try
Result := StrToInt(Self.Text);
except
Result := 0;
end;
end;
 
procedure TEdit.SetAsFloat(const Value: Double);
begin
Self.Text := FloatToStr(Value)
end;
 
procedure TEdit.SetAsInteger(const Value: Integer);
begin
Self.Text := IntToStr(Value)
end;
 
{ TDelphiXSpriteEditForm }
 
procedure TDelphiXSpriteEditForm.LoadDataToForm(AData: TPersistent);
procedure LoadAsSprite;
begin
with AData as TSprite do begin
chbCollisioned.Checked := Collisioned;
chbMoved.Checked := Moved;
chbVisible.Checked := Visible;
EHeight.AsInteger := Height;
EWidth.AsInteger := Width;
EX.AsFloat := X;
EY.AsFloat := Y;
EZ.AsInteger := Z;
end;
Caption := 'Sprite Init Editor (TSprite)';
end;
procedure LoadAsImageSprite;
var
ii: Integer;
pci: TPictureCollectionItem;
begin
LoadAsSprite;
with AData as TImageSprite do begin
EAnimCount.AsInteger := AnimCount;
chbAnimLooped.Checked := AnimLooped;
EAnimPos.AsFloat := AnimPos;
EAnimSpeed.AsFloat := AnimSpeed;
EAnimStart.AsInteger := AnimStart;
ECenterX.AsFloat := CenterX;
ECenterY.AsFloat := CenterY;
chbPixelCheck.Checked := PixelCheck;
chbTile.Checked := Tile;
EAlpha.AsInteger := Alpha;
EAngle.AsFloat := Angle;
EBlendMode.ItemIndex := Ord(BlendMode);
ETexFilter.ItemIndex := Ord(TextureFilter);
EImage.Clear;
if Assigned(DXImageList) then
for ii := 0 to DXImageList.Items.Count - 1 do begin
if DXImageList.Items[ii].Name = '' then
EImage.Items.Add('_unnamed_' + IntToStr(ii))
else
EImage.Items.Add(DXImageList.Items[ii].Name);
end;
{contain image}
pci := Image;
{is attached}
if Assigned(pci) then begin
{search in imagelist}
for ii := 0 to DXImageList.Items.Count - 1 do
if DXImageList.Items[ii] = pci then begin
EImage.ItemIndex := ii;
Break;
end;
end
else begin
if DXImageName <> '' then begin
ii := EImage.Items.IndexOf(DXImageName);
if ii <> -1 then
EImage.ItemIndex := ii;
end;
end;
end;
Caption := 'Sprite Init Editor (TImageSprite)';
end;
procedure LoadAsImageSpriteEx;
begin
LoadAsImageSprite;
Caption := 'Sprite Init Editor (TImageSpriteEx)';
end;
procedure LoadAsBackgroundSprite;
begin
LoadAsImageSprite;
with AData as TBackgroundSprite do begin
EMapHeight.AsInteger := MapHeight;
EMapWidth.AsInteger := MapWidth;
chbTile.Checked := Tile;
end;
btnMapEdit.Enabled := eImage.ItemIndex <> -1;
Caption := 'Sprite Init Editor (TBackgroundSprite)';
end;
const
cktypearr: array[TSpriteType] of Integer = (0, 2, 3, 1);
begin
FSprite := TSprite(AData);
FDXImageList := TSprite(AData).DXImageList;
if AData is TBackgroundSprite then Fvktype := stBackgroundSprite
else if AData is TImageSpriteEx then Fvktype := stImageSpriteEx
else if AData is TImageSprite then Fvktype := stImageSprite
else Fvktype := stSprite;
 
FieldEnabler(Fvktype);
try
case Fvktype of
stSprite: LoadAsSprite;
stImageSprite: LoadAsImageSprite;
stImageSpriteEx: LoadAsImageSpriteEx;
stBackgroundSprite: LoadAsBackgroundSprite;
end;
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
 
function TDelphiXSpriteEditForm.SaveDataFromForm: TPersistent;
var AData: TSprite;
procedure SaveAsSprite;
begin
with AData as TSprite do begin
Collisioned := chbCollisioned.Checked;
Moved := chbMoved.Checked;
Visible := chbVisible.Checked;
Height := EHeight.AsInteger;
Width := EWidth.AsInteger;
X := EX.AsFloat;
Y := EY.AsFloat;
Z := EZ.AsInteger;
end;
end;
procedure SaveAsImageSprite;
begin
SaveAsSprite;
with AData as TImageSprite do begin
AnimCount := EAnimCount.AsInteger;
AnimLooped := chbAnimLooped.Checked;
AnimPos := EAnimPos.AsFloat;
AnimSpeed := EAnimSpeed.AsFloat;
AnimStart := EAnimStart.AsInteger;
PixelCheck := chbPixelCheck.Checked;
Tile := chbTile.Checked;
Alpha := EAlpha.AsInteger;
Angle := EAngle.AsFloat;
CenterX := ECenterX.AsFloat;
CenterY := ECenterY.AsFloat;
BlendMode := TRenderType(EBlendMode.ItemIndex);
TextureFilter := TD2DTextureFilter(ETexFilter.ItemIndex);
BlurImage := chbBlurImage.Checked;
if Assigned(DXImageList) then
if DXImageName <> eImage.Text then
if eImage.ItemIndex <> -1 then begin
{DX}Image := DXImageList.Items[eImage.ItemIndex];
DXImageName := DXImageList.Items[eImage.ItemIndex].Name;
end;
end;
end;
procedure SaveAsImageSpriteEx;
begin
SaveAsImageSprite;
end;
procedure SaveAsBackgroundSprite;
begin
SaveAsImageSprite;
with AData as TBackgroundSprite do begin
MapHeight := EMapHeight.AsInteger;
Tile := chbTile.Checked;
MapWidth := EMapWidth.AsInteger;
end;
end;
begin
Result := nil;
try
AData := FSprite;
case Fvktype of
stSprite: SaveAsSprite;
stImageSprite: SaveAsImageSprite;
stImageSpriteEx: SaveAsImageSpriteEx;
stBackgroundSprite: SaveAsBackgroundSprite;
end;
Result := AData;
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
 
procedure TDelphiXSpriteEditForm.OKButtonClick(Sender: TObject);
begin
FChanged := True;
if FChanged then
begin
Tag := 1;
end;
 
Close;
end;
 
procedure TDelphiXSpriteEditForm.FieldEnabler(SpriteType: TSpriteType);
var I: Integer;
begin
ECenterX.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
ECenterY.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
EAlpha.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
EAngle.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
EBlendMode.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
EAnimCount.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
chbAnimLooped.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
EAnimPos.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
EAnimSpeed.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
EAnimStart.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
chbCollisioned.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
chbBlurImage.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
EHeight.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
EImage.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
EMapHeight.Enabled := (SpriteType in [stBackgroundSprite]);
EMapWidth.Enabled := (SpriteType in [stBackgroundSprite]);
chbMoved.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
chbPixelCheck.Enabled := (SpriteType in [stImageSprite, stImageSpriteEx]);
chbTile.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
chbVisible.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
chbBlurImage.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
EWidth.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
EX.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
EY.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
EZ.Enabled := (SpriteType in [stSprite..stBackgroundSprite]);
ETexFilter.Enabled := (SpriteType in [stImageSprite..stBackgroundSprite]);
for I := 0 to ComponentCount - 1 do begin
if (Components[I] is TEdit) then with (Components[I] as TEdit) do
if Enabled then Color := clWindow else Color := clBtnFace;
if (Components[I] is TComboBox) then with (Components[I] as TComboBox) do
if Enabled then Color := clWindow else Color := clBtnFace;
end
end;
 
procedure TDelphiXSpriteEditForm.MapEditButtonClick(Sender: TObject);
{only for editing maps for TBackgroudSprite}
var
I{, J}: Integer;
Q: TBackgroundSprite;
begin
DelphiXMapEditForm := TDelphiXMapEditForm.Create(nil);
try
DelphiXMapEditForm.DXImageList := FDXImageList; {local instance copy}
DelphiXMapEditForm.DXBackgroundSprite := TBackgroundSprite(FSprite);
{vymaz combo a natahni jmena}
DelphiXMapEditForm.ImageToSet.Items.Clear;
DelphiXMapEditForm.ImageToSet.Items.Assign(EImage.Items);
DelphiXMapEditForm.ImageToSet.ItemIndex := EImage.ItemIndex;
DelphiXMapEditForm.PicturesToChip.Visible := DelphiXMapEditForm.LoadSplittedImage{$IFNDEF VER4UP}(False){$ENDIF};
{nepovolit zmenu, pokud byla udelana uz na hlavnim formu}
DelphiXMapEditForm.ImageToSet.Enabled := DelphiXMapEditForm.ImageToSet.ItemIndex = -1;
if Assigned(FSprite) then begin
Q := TBackgroundSprite(FSprite);
if not Q.IsMapEmpty then begin
DelphiXMapEditForm.eMapSizeX.Value := Q.MapWidth;
DelphiXMapEditForm.eMapSizeY.Value := Q.MapHeight;
{velikost podle dlazdice v listu}
I := DelphiXMapEditForm.ImageToSet.ItemIndex;
if I <> -1 then begin
DelphiXMapEditForm.EWidth.AsInteger := DelphiXMapEditForm.DXImageList.Items[I].Width; ;
DelphiXMapEditForm.EHeight.AsInteger := DelphiXMapEditForm.DXImageList.Items[I].Height;
end;
DelphiXMapEditForm.ResizeMapArea;
end
else
DelphiXMapEditForm.ResizeMapArea;
end;
{pokud je regulerni jmeno obrazku na spritu, vyber ho}
with DelphiXMapEditForm.ImageToSet do
if FDXImageName <> '' then
ItemIndex := Items.IndexOf(FDXImageName);
{nastav tam jeste obrabeny sprite}
DelphiXMapEditForm.DXBackGroundSprite := TBackgroundSprite(FSprite);
DelphiXMapEditForm.MapArea.DefaultColWidth := DelphiXMapEditForm.EWidth.AsInteger;
DelphiXMapEditForm.MapArea.DefaultRowHeight := DelphiXMapEditForm.EHeight.AsInteger;
{a volej dialog}
DelphiXMapEditForm.eMapSizeX.OnChange := DelphiXMapEditForm.BtnSetSizeClick;
DelphiXMapEditForm.eMapSizeY.OnChange := DelphiXMapEditForm.BtnSetSizeClick;
if DelphiXMapEditForm.ShowModal = mrOK then begin
{pokud je vse OK, uloz mapu ke spritu}
if Assigned(DelphiXMapEditForm.DXBackGroundSprite) then begin
FDXImageName := '';
if DelphiXMapEditForm.ImageToSet.ItemIndex <> -1 then
FDXImageName := FDXImageList.Items[DelphiXMapEditForm.ImageToSet.ItemIndex].Name;
EMapHeight.AsInteger := DelphiXMapEditForm.eMapSizeY.Value;
EMapWidth.AsInteger := DelphiXMapEditForm.eMapSizeX.Value;
end;
end;
finally
DelphiXMapEditForm.Free;
DelphiXMapEditForm := nil;
end;
end;
 
procedure TDelphiXSpriteEditForm.eImageExit(Sender: TObject);
begin
if eImage.ItemIndex <> -1 then begin
EWidth.AsInteger := FDXImageList.Items[eImage.ItemIndex].Width;
EHeight.AsInteger := FDXImageList.Items[eImage.ItemIndex].Height;
end;
end;
 
procedure TDelphiXSpriteEditForm.eImageChange(Sender: TObject);
begin
if FvkType = stBackgroundSprite then
btnMapEdit.Enabled := eImage.ItemIndex <> -1
else
btnMapEdit.Enabled := False;
end;
 
end.
/VCL_DELPHIX_D6/DXWave.pas
0,0 → 1,726
unit DXWave;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, SysUtils, Classes, MMSystem;
 
type
 
{ EWaveError }
 
EWaveError = class(Exception);
 
{ TWave }
 
TWave = class(TPersistent)
private
FData: Pointer;
FFormat: PWaveFormatEx;
FFormatSize: Integer;
FSize: Integer;
procedure SetFormatSize(Value: Integer);
procedure SetSize(Value: Integer);
protected
procedure DefineProperties(Filer: TFiler); override;
procedure ReadData(Stream: TStream); virtual;
procedure WriteData(Stream: TStream); virtual;
public
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Clear;
procedure LoadFromFile(const FileName : string);
procedure LoadFromStream(Stream: TStream);
procedure SaveToFile(const FileName : string);
procedure SaveToStream(Stream: TStream);
procedure SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
property Data: Pointer read FData;
property Format: PWaveFormatEx read FFormat;
property FormatSize: Integer read FFormatSize write SetFormatSize;
property Size: Integer read FSize write SetSize;
end;
 
{ TCustomDXWave }
 
TCustomDXWave = class(TComponent)
private
FWave: TWave;
procedure SetWave(Value: TWave);
public
constructor Create(AOnwer: TComponent); override;
destructor Destroy; override;
property Wave: TWave read FWave write SetWave;
end;
 
{ TDXWave }
 
TDXWave = class(TCustomDXWave)
published
property Wave;
end;
 
{ EWaveStreamError }
 
EWaveStreamError = class(Exception);
 
{ TCustomWaveStream }
 
TCustomWaveStream = class(TStream)
private
FPosition: Integer;
protected
function GetFilledSize: Integer; virtual;
function GetFormat: PWaveFormatEx; virtual; abstract;
function GetFormatSize: Integer; virtual;
function GetSize: Integer; {$IFDEF VER5UP} reintroduce;{$ENDIF} virtual;
function ReadWave(var Buffer; Count: Integer): Integer; virtual;
procedure SetFormatSize(Value: Integer); virtual; abstract;
procedure SetSize(Value: Integer); override;
function WriteWave(const Buffer; Count: Integer): Integer; virtual;
public
function Read(var Buffer; Count: Longint): Longint; override;
function Seek(Offset: Longint; Origin: Word): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
procedure SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
property FilledSize: Integer read GetFilledSize;
property Format: PWaveFormatEx read GetFormat;
property FormatSize: Integer read GetFormatSize write SetFormatSize;
property Size: Integer read GetSize write SetSize;
end;
 
{ TCustomWaveStream2 }
 
TCustomWaveStream2 = class(TCustomWaveStream)
private
FFormat: PWaveFormatEx;
FFormatSize: Integer;
protected
function GetFormat: PWaveFormatEx; override;
function GetFormatSize: Integer; override;
procedure SetFormatSize(Value: Integer); override;
public
destructor Destroy; override;
end;
 
{ TWaveObjectStream }
 
TWaveObjectStream = class(TCustomWaveStream)
private
FWave: TWave;
protected
function GetFormat: PWaveFormatEx; override;
function GetFormatSize: Integer; override;
function GetSize: Integer; override;
function ReadWave(var Buffer; Count: Integer): Integer; override;
procedure SetFormatSize(Value: Integer); override;
procedure SetSize(Value: Integer); override;
function WriteWave(const Buffer; Count: Integer): Integer; override;
public
constructor Create(AWave: TWave);
end;
 
{ TWaveStream }
 
TWaveStream = class(TCustomWaveStream2)
private
FDataPosition: Integer;
FDataHeaderPosition: Integer;
FOpened: Boolean;
FOriPosition: Integer;
FReadMode: Boolean;
FSize: Integer;
FStream: TStream;
procedure CloseWriteMode;
procedure OpenReadMode;
procedure OpenWriteMode;
protected
function GetSize: Integer; override;
function ReadWave(var Buffer; Count: Integer): Integer; override;
function WriteWave(const Buffer; Count: Integer): Integer; override;
public
constructor Create(AStream: TStream);
destructor Destroy; override;
procedure Open(WriteMode: Boolean);
end;
 
{ TWaveFileStream }
 
TWaveFileStream = class(TWaveStream)
private
FFileStream: TFileStream;
public
constructor Create(const FileName: string; FileMode: Integer);
destructor Destroy; override;
end;
 
procedure MakePCMWaveFormatEx(var Format: TWaveFormatEx;
SamplesPerSec, BitsPerSample, Channels: Integer);
 
implementation
 
uses DXConsts;
 
procedure MakePCMWaveFormatEx(var Format: TWaveFormatEx;
SamplesPerSec, BitsPerSample, Channels: Integer);
begin
with Format do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := Channels;
nSamplesPerSec := SamplesPerSec;
wBitsPerSample := BitsPerSample;
nBlockAlign := nChannels*(wBitsPerSample div 8);
nAvgBytesPerSec := nBlockAlign*nSamplesPerSec;
cbSize := 0;
end;
end;
 
{ TWave }
 
const
WavePoolSize = 8096;
 
destructor TWave.Destroy;
begin
Clear;
inherited Destroy;
end;
 
procedure TWave.Assign(Source: TPersistent);
var
AWave: TWave;
begin
if Source=nil then
begin
Clear;
end else if Source is TWave then
begin
if Source<>Self then
begin
AWave := TWave(Source);
Size := AWave.Size;
FormatSize := AWave.FormatSize;
Move(AWave.Data^, FData^, FSize);
Move(AWave.Format^, FFormat^, FFormatSize);
end;
end else
inherited Assign(Source);
end;
 
procedure TWave.Clear;
begin
FreeMem(FData, 0); FData := nil;
FreeMem(FFormat, 0); FFormat := nil;
 
FSize := 0;
FFormatSize := 0;
end;
 
procedure TWave.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('WAVE', ReadData, WriteData, True);
end;
 
procedure TWave.LoadFromFile(const FileName : string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
 
procedure TWave.LoadFromStream(Stream: TStream);
var
WaveStream: TWaveStream;
begin
Clear;
 
WaveStream := TWaveStream.Create(Stream);
try
WaveStream.Open(False);
 
FormatSize := WaveStream.FormatSize;
Move(WaveStream.Format^, Format^, FormatSize);
Size := WaveStream.Size;
WaveStream.ReadBuffer(FData^, Size);
finally
WaveStream.Free;
end;
end;
 
procedure TWave.ReadData(Stream: TStream);
begin
LoadFromStream(Stream);
end;
 
procedure TWave.SaveToFile(const FileName : string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
 
procedure TWave.SaveToStream(Stream: TStream);
var
WaveStream: TWaveStream;
begin
if (FFormatSize<=0) or (FSize<=0) then Exit;
 
WaveStream := TWaveStream.Create(Stream);
try
WaveStream.FormatSize := FormatSize;
Move(Format^, WaveStream.Format^, FormatSize);
 
WaveStream.Open(True);
WaveStream.WriteBuffer(FData^, Size);
finally
WaveStream.Free;
end;
end;
 
procedure TWave.SetFormatSize(Value: Integer);
begin
if Value<=0 then Value := 0;
ReAllocMem(FFormat, Value);
FFormatSize := Value;
end;
 
procedure TWave.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
begin
FormatSize := SizeOf(TWaveFormatEx);
MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
end;
 
procedure TWave.SetSize(Value: Integer);
var
i: Integer;
begin
if Value<=0 then Value := 0;
 
i := (Value+WavePoolSize-1) div WavePoolSize;
if i<>(FSize+WavePoolSize-1) div WavePoolSize then
ReAllocMem(FData, i*WavePoolSize);
 
FSize := Value;
end;
 
procedure TWave.WriteData(Stream: TStream);
begin
SaveToStream(Stream);
end;
 
{ TCustomDXWave }
 
constructor TCustomDXWave.Create(AOnwer: TComponent);
begin
inherited Create(AOnwer);
FWave := TWave.Create;
end;
 
destructor TCustomDXWave.Destroy;
begin
FWave.Free;
inherited Destroy;
end;
 
procedure TCustomDXWave.SetWave(Value: TWave);
begin
FWave.Assign(Value);
end;
 
{ TCustomWaveStream }
 
function TCustomWaveStream.GetFilledSize: Longint;
begin
Result := -1;
end;
 
function TCustomWaveStream.GetFormatSize: Integer;
begin
Result := 0;
end;
 
function TCustomWaveStream.GetSize: Integer;
begin
Result := -1;
end;
 
function TCustomWaveStream.Read(var Buffer; Count: Longint): Longint;
begin
if GetSize<0 then
Result := ReadWave(Buffer, Count)
else
begin
if FPosition>Size then
FPosition := Size;
if FPosition+Count>Size then
Result := Size-FPosition
else
Result := Count;
 
Result := ReadWave(Buffer, Result);
end;
 
Inc(FPosition, Result);
end;
 
function TCustomWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
Result := 0;
end;
 
function TCustomWaveStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
case Origin of
soFromBeginning: FPosition := Offset;
soFromCurrent : FPosition := FPosition + Offset;
soFromEnd : FPosition := GetSize + Offset;
end;
if FPosition<0 then FPosition := 0;
if FPosition>GetSize then FPosition := GetSize;
 
Result := FPosition;
end;
 
procedure TCustomWaveStream.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels: Integer);
begin
FormatSize := SizeOf(TWaveFormatEx);
MakePCMWaveFormatEx(Format^, SamplesPerSec, BitsPerSample, Channels);
end;
 
procedure TCustomWaveStream.SetSize(Value: Integer);
begin
end;
 
function TCustomWaveStream.Write(const Buffer; Count: Longint): Longint;
begin
if FPosition>Size then
FPosition := Size;
Result := WriteWave(Buffer, Count);
Inc(FPosition, Result);
end;
 
function TCustomWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
Result := 0;
end;
 
{ TCustomWaveStream2 }
 
destructor TCustomWaveStream2.Destroy;
begin
FormatSize := 0;
inherited Destroy;
end;
 
function TCustomWaveStream2.GetFormat: PWaveFormatEx;
begin
Result := FFormat;
end;
 
function TCustomWaveStream2.GetFormatSize: Integer;
begin
Result := FFormatSize;
end;
 
procedure TCustomWaveStream2.SetFormatSize(Value: Integer);
begin
ReAllocMem(FFormat, Value);
FFormatSize := Value;
end;
 
{ TWaveObjectStream }
 
constructor TWaveObjectStream.Create(AWave: TWave);
begin
inherited Create;
FWave := AWave;
 
FormatSize := FWave.FormatSize;
Move(FWave.Format^, Format^, FormatSize);
end;
 
function TWaveObjectStream.GetFormat: PWaveFormatEx;
begin
Result := FWave.Format;
end;
 
function TWaveObjectStream.GetFormatSize: Integer;
begin
Result := FWave.FormatSize;
end;
 
function TWaveObjectStream.GetSize: Integer;
begin
Result := FWave.Size;
end;
 
function TWaveObjectStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
Result := Count;
Move(Pointer(Integer(FWave.Data)+Position)^, Buffer, Count);
end;
 
procedure TWaveObjectStream.SetFormatSize(Value: Integer);
begin
FWave.FormatSize := Value;
end;
 
procedure TWaveObjectStream.SetSize(Value: Integer);
begin
FWave.Size := Value;
end;
 
function TWaveObjectStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
Result := Count;
if Position+Count>Size then
SetSize(Size+(Position+Count+Size));
Move(Buffer, Pointer(Integer(FWave.Data)+Position)^, Count);
end;
 
{ TWaveStream }
 
const
ID_RIFF = Ord('R') + Ord('I')*$100 + Ord('F')*$10000 + Ord('F')*$1000000;
ID_WAVE = Ord('W') + Ord('A')*$100 + Ord('V')*$10000 + Ord('E')*$1000000;
ID_FMT = Ord('f') + Ord('m')*$100 + Ord('t')*$10000 + Ord(' ')*$1000000;
ID_FACT = Ord('f') + Ord('a')*$100 + Ord('c')*$10000 + Ord('t')*$1000000;
ID_DATA = Ord('d') + Ord('a')*$100 + Ord('t')*$10000 + Ord('a')*$1000000;
 
type
TWaveFileHeader = packed record
FType: Integer;
Size: Longint;
RType: Integer;
end;
 
TWaveChunkHeader = packed record
CType: Longint;
Size: Longint;
end;
 
constructor TWaveStream.Create(AStream: TStream);
begin
inherited Create;
FStream := AStream;
 
FOriPosition := FStream.Position;
end;
 
destructor TWaveStream.Destroy;
begin
if FOpened and (not FReadMode) then
CloseWriteMode;
inherited Destroy;
end;
 
function TWaveStream.GetSize: Integer;
begin
if FOpened then
begin
if not FReadMode then
Result := FStream.Size-FDataPosition
else
Result := FSize;
end else
Result := 0;
end;
 
function TWaveStream.ReadWave(var Buffer; Count: Integer): Integer;
begin
if not FOpened then
raise EWaveStreamError.Create(SStreamNotOpend);
 
FStream.Position := FDataPosition+Position;
Result := FStream.Read(Buffer, Count);
end;
 
function TWaveStream.WriteWave(const Buffer; Count: Integer): Integer;
begin
if not FOpened then
raise EWaveStreamError.Create(SStreamNotOpend);
 
if FReadMode then
begin
if Position+Count>FSize then
Count := FSize-Position;
end;
 
FStream.Position := FDataPosition+Position;
Result := FStream.Write(Buffer, Count);
end;
 
procedure TWaveStream.Open(WriteMode: Boolean);
begin
if WriteMode then
OpenWriteMode
else
OpenReadMode;
end;
 
procedure TWaveStream.OpenReadMode;
var
WF: TWaveFileHeader;
WC: TWaveChunkHeader;
 
procedure Readfmt; { fmt }
begin
FormatSize := WC.Size;
FStream.ReadBuffer(Format^, WC.Size);
end;
 
procedure Readdata; { data }
begin
FSize := WC.Size;
FDataPosition := FStream.Position;
FStream.Seek(FSize, 1);
end;
 
begin
if FOpened then
raise EWaveStreamError.Create(SStreamOpend);
 
FOpened := True;
FReadMode := True;
 
FStream.Position := FOriPosition;
 
//if FStream.Size-FStream.Position<=0 then Exit;
 
{ File header reading. }
FStream.ReadBuffer(WF, SizeOf(TWaveFileHeader));
 
{ Is it Wave file of the file? }
if (WF.FType<>ID_RIFF) or (WF.RType<>ID_WAVE) then
raise EWaveStreamError.Create(SInvalidWave);
 
{ Chunk reading. }
FillChar(WC, SizeOf(WC), 0);
FStream.Read(WC, SizeOf(TWaveChunkHeader));
while WC.CType<>0 do
begin
case WC.CType of
ID_FMT : Readfmt;
ID_DATA: Readdata;
else
{ Chunk which does not correspond is disregarded. }
FStream.Seek(WC.Size, 1);
end;
 
FillChar(WC, SizeOf(WC), 0);
FStream.Read(WC, SizeOf(TWaveChunkHeader));
end;
end;
 
procedure TWaveStream.OpenWriteMode;
 
procedure WriteFmt; { fmt }
var
WC: TWaveChunkHeader;
begin
with WC do
begin
CType := ID_FMT;
Size := FFormatSize;
end;
 
FStream.WriteBuffer(WC, SizeOf(WC));
FStream.WriteBuffer(FFormat^, FFormatSize);
end;
 
procedure WriteData; { data }
var
WC: TWaveChunkHeader;
begin
FDataHeaderPosition := FStream.Position;
 
with WC do
begin
CType := ID_DATA;
Size := 0;
end;
 
FStream.WriteBuffer(WC, SizeOf(WC));
 
FDataPosition := FStream.Position;
end;
 
var
WF: TWaveFileHeader;
begin
if FOpened then
raise EWaveStreamError.Create(SStreamOpend);
 
if FormatSize=0 then
raise EWaveStreamError.Create(SInvalidWaveFormat);
 
FOpened := True;
FStream.Position := FOriPosition;
 
FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));
 
{ Chunk writing. }
WriteFmt;
WriteData;
end;
 
procedure TWaveStream.CloseWriteMode;
 
procedure WriteDataHeader; { data }
var
WC: TWaveChunkHeader;
begin
FStream.Position := FDataHeaderPosition;
 
with WC do
begin
CType := ID_DATA;
Size := Self.Size;
end;
 
FStream.WriteBuffer(WC, SizeOf(WC));
end;
 
var
WF: TWaveFileHeader;
begin
with WF do
begin
FType := ID_RIFF;
Size := (FStream.Size-FOriPosition)-SizeOf(TWaveChunkHeader);
RType := ID_WAVE;
end;
FStream.Position := FOriPosition;
FStream.WriteBuffer(WF, SizeOf(TWaveFileHeader));
WriteDataHeader;
FStream.Position := FStream.Size;
end;
 
{ TWaveFileStream }
 
constructor TWaveFileStream.Create(const FileName: string; FileMode: Integer);
begin
FFileStream := TFileStream.Create(FileName, FileMode);
inherited Create(FFileStream);
end;
 
destructor TWaveFileStream.Destroy;
begin
inherited Destroy;
FFileStream.Free;
end;
 
end.
/VCL_DELPHIX_D6/DXWaveEdit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DXWaveEdit.pas
4,7 → 4,7
 
uses
Windows, SysUtils, Classes, Forms, Dialogs, Controls, StdCtrls, ExtCtrls,
Buttons, ComCtrls, DXSounds, Wave, Graphics;
Buttons, ComCtrls, DXSounds, DXWave, Graphics;
 
type
 
/VCL_DELPHIX_D6/DelphiX.bdsproj
0,0 → 1,177
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType"></Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{6EC6E3ED-F62F-4EBA-BD15-B71B48535D8D}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiX.dpk</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">0</Compiler>
<Compiler Name="D">0</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">1</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">0</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">0</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler> <Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="CodePage"></Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">0</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription">DelphiX - DirectX components for Delphi</Linker> <Linker Name="GenerateHpps">False</Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir">.\</Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir">.\</Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages"></Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="RemoteHost"></Parameters>
<Parameters Name="RemotePath"></Parameters>
<Parameters Name="RemoteLauncher"></Parameters>
<Parameters Name="RemoteCWD"></Parameters>
<Parameters Name="RemoteDebug">False</Parameters> <Parameters Name="Debug Symbols Search Path"></Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">8</VersionInfo>
<VersionInfo Name="Build">3</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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">unDelphiX for Delphi 6, 7, 2005, 2006, 2007, 2009</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.8.3</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">unDelphiX</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">DELPHIX</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">unDelphiX 1.08.3</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.8.3</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
/VCL_DELPHIX_D6/DelphiX.dcr
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/VCL_DELPHIX_D6/DelphiX.dpk
0,0 → 1,102
package DelphiX;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi'}
{$IFDEF VER140} { Borland Delphi 6.x }
{$LIBSUFFIX '60'}
{$ENDIF}
{$IFDEF VER145} { Borland C++Builder 6.x }
{$LIBSUFFIX '65'}
{$ENDIF}
{$IFDEF VER150} { Borland Delphi 7.x }
{$LIBSUFFIX '70'}
{$ENDIF}
{$IFDEF VER170} { Borland Delphi 2005 9.x }
{$LIBSUFFIX '90'}
{$ENDIF}
{$IFDEF VER180} { Borland Delphi 2006, Turbo 10.x } // JB
{$LIBSUFFIX '100'}
{$ENDIF}
{$IFDEF VER185} { Borland Delphi 2007 11.x } // JB
{$LIBSUFFIX '110'}
{$ENDIF}
{$IFDEF VER200} { Borland Delphi 2009 12.x } // JB
{$LIBSUFFIX '120'}
{$ENDIF}
{$IFDEF VER210} { Borland Delphi 2010 14.x } // JB
{$LIBSUFFIX '140'}
{$ENDIF}
 
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
{Note: must be defined as global for SXMedia using}
{$DEFINE D3D_deprecated}
 
requires
vcl,
vclsmp,
designide,
//png,
rtl,
vcljpg,
vclx;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm},
SXReg in '.\SXMedia\SXReg.pas',
SXEditor in '.\SXMedia\SXEditor.pas',
SXAbout in '.\SXMedia\SXAbout.pas',
MpSndSys in '.\SXMedia\MpSndSys.pas',
SXEngine in '.\SXMedia\SXEngine.pas',
SXModPlayer in '.\SXMedia\SXModPlayer.pas',
SXMovie in '.\SXMedia\SXMovie.pas';
 
end.
/VCL_DELPHIX_D6/DelphiX.dproj
0,0 → 1,107
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6ec6e3ed-f62f-4eba-bd15-b71b48535d8d}</ProjectGuid>
<MainSource>DelphiX.dpk</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>C:\Users\Public\Documents\RAD Studio\5.0\Bpl\DelphiX110.bpl</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DcuOutput>
</DCC_DcuOutput>
<DCC_ObjOutput>
</DCC_ObjOutput>
<DCC_HppOutput>
</DCC_HppOutput>
<DCC_DcpOutput>
</DCC_DcpOutput>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">DelphiX - DirectX components for Delphi</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">True</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options><Package_Options Name="LibSuffix">110</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">8</VersionInfo><VersionInfo Name="Build">3</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">1029</VersionInfo><VersionInfo Name="CodePage">1250</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys><VersionInfoKeys Name="FileDescription">unDelphiX for Delphi 6, 7, 2005, 2006, 2007, 2009</VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.8.3</VersionInfoKeys><VersionInfoKeys Name="InternalName">unDelphiX</VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">© Hiroyuki Hori</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks">© Hiroyuki Hori</VersionInfoKeys><VersionInfoKeys Name="OriginalFilename">DELPHIX</VersionInfoKeys><VersionInfoKeys Name="ProductName">unDelphiX 1.08.3</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.8.3</VersionInfoKeys><VersionInfoKeys Name="Comments">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">DelphiX.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="DelphiX.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="$(SystemRoot)\system32\designide.dcp" />
<DCCReference Include="$(SystemRoot)\system32\rtl.dcp" />
<DCCReference Include="$(SystemRoot)\system32\vcl.dcp" />
<DCCReference Include="$(SystemRoot)\system32\vcljpg.dcp" />
<DCCReference Include="$(SystemRoot)\system32\vclsmp.dcp" />
<DCCReference Include="$(SystemRoot)\system32\vclx.dcp" />
<DCCReference Include="DelphiX.dcr" />
<DCCReference Include="DelphiX.dcr" />
<DCCReference Include="DIB.pas" />
<DCCReference Include="DXClass.pas" />
<DCCReference Include="DXConsts.pas" />
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<DCCReference Include="DXDraws.pas" />
<DCCReference Include="DXETable.pas" />
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXInput.pas" />
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXPlay.pas" />
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXReg.pas" />
<DCCReference Include="DXRender.pas" />
<DCCReference Include="DXSounds.pas" />
<DCCReference Include="DXSprite.pas" />
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXWave.pas" />
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas" />
</ItemGroup>
</Project>
/VCL_DELPHIX_D6/DelphiX.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX100.bdsproj
0,0 → 1,175
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType">VCLApplication</Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{0B6521B6-2815-496E-BCCD-81462FB6EE32}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiX100.dpk</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">0</Compiler>
<Compiler Name="D">0</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">1</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">0</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">0</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler>
<Compiler Name="UnitInitSeq">True</Compiler>
<Compiler Name="LocalPInvoke">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="CodePage"></Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">0</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="GenerateHpps">False</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription">DelphiX - DirectX components for Delphi</Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages"></Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="Debug Symbols Search Path"></Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">8</VersionInfo>
<VersionInfo Name="Build">4</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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">unDelphiX for Delphi 2006/Turbo</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.9.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">unDelphiX</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">DELPHIX</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">unDelphiX 1.09.0</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.9.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
/VCL_DELPHIX_D6/DelphiX100.dpk
0,0 → 1,73
package DelphiX100;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi 2006'}
{$DESIGNONLY}
{$IMPLICITBUILD OFF}
 
requires
vcl,
vclsmp,
designide,
rtl,
vcljpg,
vclx;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX100.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX110.dpk
0,0 → 1,72
package DelphiX110;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi 2007'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vcljpg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX110.dproj
0,0 → 1,102
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{5feb56dc-7ab1-463a-b31f-4b2e44162275}</ProjectGuid>
<MainSource>DelphiX110.dpk</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>C:\Documents and Settings\Micrel\Dokumenty\RAD Studio\5.0\Bpl\DelphiX110.bpl</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_AssertionsAtRuntime>False</DCC_AssertionsAtRuntime>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_WriteableConstants>True</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">DelphiX - DirectX components for Delphi 2007</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">True</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">8</VersionInfo><VersionInfo Name="Build">4</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">1029</VersionInfo><VersionInfo Name="CodePage">1250</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">Hiroyuki Hori</VersionInfoKeys><VersionInfoKeys Name="FileDescription">unDelphiX for Delphi 2007</VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.8.4</VersionInfoKeys><VersionInfoKeys Name="InternalName">unDelphiX</VersionInfoKeys><VersionInfoKeys Name="LegalCopyright">© Hiroyuki Hori</VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks">© Hiroyuki Hori</VersionInfoKeys><VersionInfoKeys Name="OriginalFilename">DELPHIX</VersionInfoKeys><VersionInfoKeys Name="ProductName">unDelphiX 1.08.4</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.8.4</VersionInfoKeys><VersionInfoKeys Name="Comments">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys></VersionInfoKeys><Excluded_Packages>
<Excluded_Packages Name="C:\Documents and Settings\All Users\Dokumenty\RAD Studio\5.0\Bpl\jbLib110.bpl">jbLib (part 1)</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages><Source><Source Name="MainSource">DelphiX110.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="DelphiX110.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr" />
<DCCReference Include="DelphiX.dcr" />
<DCCReference Include="designide.dcp" />
<DCCReference Include="DIB.pas" />
<DCCReference Include="DXClass.pas" />
<DCCReference Include="DXConsts.pas" />
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<DCCReference Include="DXDraws.pas" />
<DCCReference Include="DXETable.pas" />
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXInput.pas" />
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXPlay.pas" />
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXReg.pas" />
<DCCReference Include="DXRender.pas" />
<DCCReference Include="DXSounds.pas" />
<DCCReference Include="DXSprite.pas" />
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXWave.pas" />
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="rtl.dcp" />
<DCCReference Include="TurboPixels.pas" />
<DCCReference Include="vcl.dcp" />
<DCCReference Include="vcljpg.dcp" />
<DCCReference Include="vclsmp.dcp" />
</ItemGroup>
</Project>
/VCL_DELPHIX_D6/DelphiX110.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX120.dpk
0,0 → 1,73
package DelphiX120;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi 2009'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX120.dproj
0,0 → 1,175
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{144096F0-D488-4452-8A4D-981EBF9B99CC}</ProjectGuid>
<MainSource>DelphiX120.dpk</MainSource>
<Config Condition="'$(Config)'==''">Debug</Config>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<ProjectVersion>12.0</ProjectVersion>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<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="'$(Base)'!=''">
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Platform>x86</DCC_Platform>
<DCC_DependencyCheckOutputName>C:\Documents and Settings\All Users\Dokumenty\RAD Studio\6.0\Bpl\DelphiX120.bpl</DCC_DependencyCheckOutputName>
<DCC_Description>DelphiX - DirectX components for Delphi 2009</DCC_Description>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_N>false</DCC_N>
<DCC_K>false</DCC_K>
<GenDll>true</GenDll>
<DCC_S>false</DCC_S>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
<GenPackage>true</GenPackage>
<DCC_F>false</DCC_F>
<DCC_E>false</DCC_E>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="DelphiX120.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<DCCReference Include="DelphiX.dcr"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiX120.dpk</Source>
</Source>
<Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">8</VersionInfo>
<VersionInfo Name="Build">4</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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">unDelphiX for Delphi 2009</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.8.4</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">unDelphiX</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">DELPHIX</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">unDelphiX 1.08.4</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.8.4</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k120.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp120.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>
/VCL_DELPHIX_D6/DelphiX120.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX140.dpk
0,0 → 1,73
package DelphiX140;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi 2010'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX140.dproj
0,0 → 1,172
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{EDE2D9FF-D101-436D-BE6E-B71045750312}</ProjectGuid>
<MainSource>DelphiX140.dpk</MainSource>
<Config Condition="'$(Config)'==''">Debug</Config>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<ProjectVersion>12.0</ProjectVersion>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<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="'$(Base)'!=''">
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<DCC_DependencyCheckOutputName>..\..\..\Bpl\DelphiX140.bpl</DCC_DependencyCheckOutputName>
<DCC_Platform>x86</DCC_Platform>
<DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias)</DCC_UnitAlias>
<DCC_Description>DelphiX - DirectX components for Delphi 2010</DCC_Description>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_N>false</DCC_N>
<DCC_K>false</DCC_K>
<GenDll>true</GenDll>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<GenPackage>true</GenPackage>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_E>false</DCC_E>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="DelphiX140.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiX140.dpk</Source>
</Source>
<Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">8</VersionInfo>
<VersionInfo Name="Build">4</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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription">unDelphiX for Delphi 2010</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.8.4</VersionInfoKeys>
<VersionInfoKeys Name="InternalName">unDelphiX</VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks">© Hiroyuki Hori</VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename">DELPHIX</VersionInfoKeys>
<VersionInfoKeys Name="ProductName">unDelphiX 1.08.4</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.8.4</VersionInfoKeys>
<VersionInfoKeys Name="Comments">Unofficial version DelphiX with hardware acceleration.</VersionInfoKeys>
<VersionInfoKeys Name="LastCompiledTime">25.2.2011 13:27:10</VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>
/VCL_DELPHIX_D6/DelphiX140.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX140_Icon.ico
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX150.dpk
0,0 → 1,73
package DelphiX150;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX150.dproj
0,0 → 1,175
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{40C51905-1F0A-4D72-A87A-C9C8D9665324}</ProjectGuid>
<MainSource>DelphiX150.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform>Win32</Platform>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<ProjectVersion>12.3</ProjectVersion>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<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="'$(Base)'!=''">
<DCC_WriteableConstants>true</DCC_WriteableConstants>
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;WinTypes=Windows;WinProcs=Windows;$(DCC_UnitAlias)</DCC_UnitAlias>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_Description>DelphiX - DirectX components for Delphi XE</DCC_Description>
<DCC_N>false</DCC_N>
<DCC_K>false</DCC_K>
<GenDll>true</GenDll>
<DCC_S>false</DCC_S>
<DCC_AssertionsAtRuntime>false</DCC_AssertionsAtRuntime>
<GenPackage>true</GenPackage>
<DCC_F>false</DCC_F>
<DCC_E>false</DCC_E>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="DelphiX150.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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>
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiX150.dpk</Source>
</Source>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</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>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k150.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp150.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
</Project>
/VCL_DELPHIX_D6/DelphiX150.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX160.dpk
0,0 → 1,73
package DelphiX160;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE2'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX160.dproj
0,0 → 1,195
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{91308B77-8E11-452A-8053-24D7DF8D544D}</ProjectGuid>
<MainSource>DelphiX160.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>13.4</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<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="('$(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="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
<GenPackage>true</GenPackage>
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_Description>DelphiX - DirectX components for Delphi XE2</DCC_Description>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<GenDll>true</GenDll>
<DCC_K>false</DCC_K>
<VerInfo_Locale>1029</VerInfo_Locale>
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>DelphiX160_Icon.ico</Icon_MainIcon>
<DCC_UsePackage>vclx;vcl;vclimg;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Icon_MainIcon>DelphiX160_Icon.ico</Icon_MainIcon>
<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>
<DCC_UsePackage>vclx;vcl;vclimg;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
<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_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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">DelphiX160.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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</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>
</Delphi.Personality>
<Platforms>
<Platform value="Win64">False</Platform>
<Platform value="Win32">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
</Project>
/VCL_DELPHIX_D6/DelphiX160.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX160_Icon.ico
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX170.dpk
0,0 → 1,76
package DelphiX170;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE3'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX170.dproj
0,0 → 1,200
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{1B8334F4-5772-413C-A193-734E8502FFD1}</ProjectGuid>
<MainSource>DelphiX170.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>14.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="('$(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="'$(Base)'!=''">
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_E>false</DCC_E>
<DCC_S>false</DCC_S>
<VerInfo_Locale>1029</VerInfo_Locale>
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_K>false</DCC_K>
<DCC_Description>DelphiX - DirectX components for Delphi XE3</DCC_Description>
<GenPackage>true</GenPackage>
<DCC_N>false</DCC_N>
<DCC_F>false</DCC_F>
<GenDll>true</GenDll>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=;CFBundleDisplayName=;CFBundleIdentifier=;CFBundleVersion=;CFBundlePackageType=;CFBundleSignature=;CFBundleAllowMixedLocalizations=;CFBundleExecutable=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>rtl;vclimg;vcl;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>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>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>rtl;vclimg;vcl;vclx;VclSmp;$(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>false</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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">DelphiX170.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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</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="CFBundleIdentifier"/>
<VersionInfoKeys Name="CFBundleVersion"/>
<VersionInfoKeys Name="CFBundlePackageType"/>
<VersionInfoKeys Name="CFBundleSignature"/>
<VersionInfoKeys Name="CFBundleAllowMixedLocalizations"/>
<VersionInfoKeys Name="CFBundleExecutable"/>
</VersionInfoKeys>
</Delphi.Personality>
<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>
/VCL_DELPHIX_D6/DelphiX170.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX180.dpk
0,0 → 1,76
package DelphiX180;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE4'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX180.dproj
0,0 → 1,215
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{0B5603A8-5BDE-4468-8CCA-29D742741EFB}</ProjectGuid>
<MainSource>DelphiX180.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>14.6</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="('$(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)'!=''">
<DCC_N>false</DCC_N>
<VerInfo_Locale>1029</VerInfo_Locale>
<GenDll>true</GenDll>
<DCC_Description>DelphiX - DirectX components for Delphi XE3</DCC_Description>
<DCC_K>false</DCC_K>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<GenPackage>true</GenPackage>
<DCC_E>false</DCC_E>
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<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=;CFBundleDisplayName=;UIDeviceFamily=;CFBundleIdentifier=;CFBundleVersion=;CFBundlePackageType=;CFBundleSignature=;CFBundleAllowMixedLocalizations=;UISupportedInterfaceOrientations=;CFBundleExecutable=;CFBundleResourceSpecification=;LSRequiresIPhoneOS=;CFBundleInfoDictionaryVersion=;CFBundleDevelopmentRegion=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>vcl;rtl;vclimg;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
<DCC_Namespace>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>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>vcl;rtl;vclimg;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</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_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="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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">DelphiX180.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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</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="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>
/VCL_DELPHIX_D6/DelphiX180.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX190.dpk
0,0 → 1,76
package DelphiX190;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE5'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX190.dproj
0,0 → 1,243
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{41E25D19-4508-47C8-BCF2-B3098831677C}</ProjectGuid>
<MainSource>DelphiX190.dpk</MainSource>
<ProjectVersion>15.3</ProjectVersion>
<FrameworkType>None</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Base)'=='true') or '$(Base_OSX32)'!=''">
<Base_OSX32>true</Base_OSX32>
<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)'=='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)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1029</VerInfo_Locale>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_CBuilderOutput>All</DCC_CBuilderOutput>
<GenDll>true</GenDll>
<GenPackage>true</GenPackage>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</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_OSX32)'!=''">
<DCC_UsePackage>rtl;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>vcl;rtl;vclx;vclimg;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Locale>1033</VerInfo_Locale>
<DCC_Namespace>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>vcl;rtl;vclx;vclimg;VclSmp;$(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_Locale>1033</VerInfo_Locale>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<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="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</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>Package</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">DelphiX190.dpk</Source>
</Source>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</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">1029</VersionInfo>
<VersionInfo Name="CodePage">1250</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 Name="package"/>
<VersionInfoKeys Name="label"/>
<VersionInfoKeys Name="versionCode"/>
<VersionInfoKeys Name="versionName"/>
<VersionInfoKeys Name="persistent"/>
<VersionInfoKeys Name="restoreAnyVersion"/>
<VersionInfoKeys Name="installLocation"/>
<VersionInfoKeys Name="largeHeap"/>
<VersionInfoKeys Name="theme"/>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k190.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDSBIN)\dclofficexp190.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<Deployment/>
<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>
/VCL_DELPHIX_D6/DelphiX190.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX200.dpk
0,0 → 1,77
package DelphiX200;
 
{$R *.res}
{$R *.otares}
{$R 'DelphiX.dcr'}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES ON}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE DEBUG}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE6'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX200.dproj
0,0 → 1,164
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{4B8D9C4D-3E58-4C54-96C6-DAB5B1E90C92}</ProjectGuid>
<MainSource>DelphiX200.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
<FrameworkType>VCL</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="('$(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="'$(Base)'!=''">
<VerInfo_Locale>1029</VerInfo_Locale>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_S>false</DCC_S>
<SanitizedProjectName>DelphiX200</SanitizedProjectName>
<DCC_K>false</DCC_K>
<DCC_E>false</DCC_E>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=</VerInfo_Keys>
<GenDll>true</GenDll>
<DCC_F>false</DCC_F>
<DCC_N>false</DCC_N>
<GenPackage>true</GenPackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_UsePackage>rtl;vclimg;vcl;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Locale>1033</VerInfo_Locale>
<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>
<DCC_Namespace>Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>rtl;vclimg;vcl;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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">DelphiX200.dpk</Source>
</Source>
</Delphi.Personality>
<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>
/VCL_DELPHIX_D6/DelphiX200.otares
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX200.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX210.dpk
0,0 → 1,52
package DelphiX210;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE7'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX210.dproj
0,0 → 1,160
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{578A4D41-825A-401C-AF9B-AC5829013818}</ProjectGuid>
<MainSource>DelphiX210.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>16.0</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="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_Description>DelphiX - DirectX components for Delphi XE7</DCC_Description>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_E>false</DCC_E>
<DCC_ImageBase>00400000</DCC_ImageBase>
<VerInfo_Locale>1029</VerInfo_Locale>
<DCC_K>false</DCC_K>
<GenDll>true</GenDll>
<DCC_F>false</DCC_F>
<SanitizedProjectName>DelphiX210</SanitizedProjectName>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=</VerInfo_Keys>
<DCC_S>false</DCC_S>
<DesignOnlyPackage>true</DesignOnlyPackage>
<DCC_N>false</DCC_N>
<GenPackage>true</GenPackage>
</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_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="'$(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_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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">DelphiX210.dpk</Source>
</Source>
</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>
/VCL_DELPHIX_D6/DelphiX210.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX220.dpk
0,0 → 1,52
package DelphiX220;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi XE8'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vclx,
vclimg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm}{$IFDEF SXEXTENSIONS},
SXReg in 'SXMedia\SXReg.pas',
MpSndSys in 'SXMedia\MpSndSys.pas',
SXAbout in 'SXMedia\SXAbout.pas' {AboutBox},
SXEditor in 'SXMedia\SXEditor.pas',
SXEngine in 'SXMedia\SXEngine.pas',
SXModPlayer in 'SXMedia\SXModPlayer.pas',
SXMovie in 'SXMedia\SXMovie.pas'{$ENDIF};
 
end.
/VCL_DELPHIX_D6/DelphiX220.dproj
0,0 → 1,169
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{C07C3146-1FAD-40A5-AD4D-8CDB0A5D5D2F}</ProjectGuid>
<MainSource>DelphiX220.dpk</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Package</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>17.2</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="('$(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="'$(Base)'!=''">
<DCC_N>false</DCC_N>
<SanitizedProjectName>DelphiX220</SanitizedProjectName>
<VerInfo_Locale>1029</VerInfo_Locale>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace)</DCC_Namespace>
<GenPackage>true</GenPackage>
<GenDll>true</GenDll>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_S>false</DCC_S>
<DesignOnlyPackage>true</DesignOnlyPackage>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=</VerInfo_Keys>
<DCC_F>false</DCC_F>
<DCC_E>false</DCC_E>
<DCC_Description>DelphiX - DirectX components for Delphi XE8</DCC_Description>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<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>
<DCC_UsePackage>rtl;vclimg;vcl;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_UsePackage>rtl;vclimg;vcl;vclx;VclSmp;$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="DelphiX.dcr"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="vclsmp.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vclx.dcp"/>
<DCCReference Include="vclimg.dcp"/>
<DCCReference Include="DIB.pas"/>
<DCCReference Include="DXClass.pas"/>
<DCCReference Include="DXConsts.pas"/>
<DCCReference Include="DXDraws.pas"/>
<DCCReference Include="DXETable.pas"/>
<DCCReference Include="DXInput.pas"/>
<DCCReference Include="DXPlay.pas"/>
<DCCReference Include="DXPlayFm.pas">
<Form>DelphiXDXPlayForm</Form>
</DCCReference>
<DCCReference Include="DXRender.pas"/>
<DCCReference Include="DXReg.pas"/>
<DCCReference Include="DXSounds.pas"/>
<DCCReference Include="DXSprite.pas"/>
<DCCReference Include="DXWave.pas"/>
<DCCReference Include="DXFFBEdit.pas">
<Form>DelphiXFFEditForm</Form>
</DCCReference>
<DCCReference Include="DXGUIDEdit.pas">
<Form>DelphiXGUIDEditForm</Form>
</DCCReference>
<DCCReference Include="DXInptEdit.pas">
<Form>DelphiXInputEditForm</Form>
</DCCReference>
<DCCReference Include="DXPictEdit.pas">
<Form>DelphiXPictureEditForm</Form>
</DCCReference>
<DCCReference Include="DXWaveEdit.pas">
<Form>DelphiXWaveEditForm</Form>
</DCCReference>
<DCCReference Include="TurboPixels.pas"/>
<DCCReference Include="DXSpriteEdit.pas">
<Form>DelphiXSpriteEditForm</Form>
</DCCReference>
<DCCReference Include="DXMidiEdit.pas">
<Form>DelphiXMidiEditForm</Form>
</DCCReference>
<DCCReference Include="DXMapEditProperties.pas">
<Form>DelphiXMapEditPropertiesForm</Form>
</DCCReference>
<DCCReference Include="DXMapEdit.pas">
<Form>DelphiXMapEditForm</Form>
</DCCReference>
<DCCReference Include="DxPathEdit.pas">
<Form>DelphiXPathsEditForm</Form>
</DCCReference>
<DCCReference Include="DXGlueItEdit.pas">
<Form>DXGlueItEditor</Form>
</DCCReference>
<DCCReference Include="DXDIBEffectEdit.pas">
<Form>TDelphiXDIBEffectEditForm</Form>
</DCCReference>
<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">DelphiX220.dpk</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Android">False</Platform>
<Platform value="iOSDevice32">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>
/VCL_DELPHIX_D6/DelphiX220.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX30.dpk
0,0 → 1,60
package DelphiX30;
 
{$R *.RES}
{$R 'DelphiX.dcr'}
{$ALIGN ON}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS OFF}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $00400000}
{$DESCRIPTION 'DelphiX - DirectX component collection for Delphi'}
{$IMPLICITBUILD ON}
 
requires
vcl30,
VCLSMP30;
 
contains
DIB,
DXClass,
DXConsts,
DXDraws,
DXETable,
DXInput,
DXPlay,
DXPlayFm,
DXRender,
DXReg,
DXSounds,
DXSprite,
DXWave,
DXFFBEdit,
DXGUIDEdit,
DXInptEdit,
DXPictEdit,
DXWaveEdit,
turbopixels,
DXSpriteEdit,
DXMidiEdit,
DXMapEdit,
DXMapEditProperties,
DXPathEdit,
DXDIBEffectEdit;
 
end.
/VCL_DELPHIX_D6/DelphiX30.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX40.dpk
0,0 → 1,62
package DelphiX40;
 
{$R *.RES}
{$R 'DelphiX.dcr'}
{$ALIGN ON}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS OFF}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $00400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi'}
{$IMPLICITBUILD ON}
 
requires
vcl40,
VCLSMP40,
vcljpg40;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
turbopixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas',
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DXPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm};
 
end.
/VCL_DELPHIX_D6/DelphiX40.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX50.dpk
0,0 → 1,62
package DelphiX50;
 
{$R *.RES}
{$R 'DelphiX.dcr'}
{$ALIGN ON}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS OFF}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi'}
{$IMPLICITBUILD ON}
 
requires
vcl50,
VCLSMP50,
vcljpg50;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
turbopixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DXPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm};
 
end.
/VCL_DELPHIX_D6/DelphiX50.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX60.dpk
0,0 → 1,64
package DelphiX60;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS OFF}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi'}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vcljpg;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DXPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm};
 
end.
/VCL_DELPHIX_D6/DelphiX60.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX70.dpk
0,0 → 1,65
package DelphiX70;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS OFF}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi'}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vcljpg,
vclx;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DXPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm};
 
end.
/VCL_DELPHIX_D6/DelphiX70.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiX90.dpk
0,0 → 1,65
package DelphiX90;
 
{$R *.res}
{$R 'DelphiX.dcr'}
{$ALIGN 8}
{$ASSERTIONS OFF}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST ON}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'DelphiX - DirectX components for Delphi'}
{$IMPLICITBUILD ON}
 
requires
vcl,
vclsmp,
designide,
rtl,
vcljpg,
vclx;
 
contains
DIB in 'DIB.pas',
DXClass in 'DXClass.pas',
DXConsts in 'DXConsts.pas',
DXDraws in 'DXDraws.pas',
DXETable in 'DXETable.pas',
DXInput in 'DXInput.pas',
DXPlay in 'DXPlay.pas',
DXPlayFm in 'DXPlayFm.pas' {DelphiXDXPlayForm},
DXRender in 'DXRender.pas',
DXReg in 'DXReg.pas',
DXSounds in 'DXSounds.pas',
DXSprite in 'DXSprite.pas',
DXWave in 'DXWave.pas',
DXFFBEdit in 'DXFFBEdit.pas' {DelphiXFFEditForm},
DXGUIDEdit in 'DXGUIDEdit.pas' {DelphiXGUIDEditForm},
DXInptEdit in 'DXInptEdit.pas' {DelphiXInputEditForm},
DXPictEdit in 'DXPictEdit.pas' {DelphiXPictureEditForm},
DXWaveEdit in 'DXWaveEdit.pas' {DelphiXWaveEditForm},
TurboPixels in 'TurboPixels.pas',
DXSpriteEdit in 'DXSpriteEdit.pas' {DelphiXSpriteEditForm},
DXMidiEdit in 'DXMidiEdit.pas' {DelphiXMidiEditForm},
DXMapEditProperties in 'DXMapEditProperties.pas' {DelphiXMapEditPropertiesForm},
DXMapEdit in 'DXMapEdit.pas' {DelphiXMapEditForm},
DxPathEdit in 'DxPathEdit.pas' {DelphiXPathsEditForm},
DXGlueItEdit in 'DXGlueItEdit.pas' {DXGlueItEditor},
DXDIBEffectEdit in 'DXDIBEffectEdit.pas' {TDelphiXDIBEffectEditForm};
 
end.
/VCL_DELPHIX_D6/DelphiX90.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/DelphiXcfg.inc
1,32 → 1,542
{$B-,J+,Q-,R-,T-,X+}
//*********************************************************************
// Main configuration file for (un)DelphiX
//*********************************************************************
{$IFDEF VER100}
{$DEFINE VER3UP}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE VER4UP}
{$DEFINE VER3UP}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$ENDIF}
{$IFDEF VER150}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$ENDIF}
{$IFDEF VER170}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$ENDIF}
{$IFDEF VER180}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$IFDEF VER185}
{$DEFINE VER11UP}
{$ENDIF}
{$ENDIF}
{$IFDEF VER200}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$ENDIF}
{$IFDEF VER210}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$ENDIF}
{$IFDEF VER220}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP} //Delphi XE
{$ENDIF}
 
{$IFDEF VER230}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP} //Delphi XE2
{$ENDIF}
 
{$IFDEF VER240}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP}
{$DEFINE VER17UP} //Delphi XE3
{$ENDIF}
 
{$IFDEF VER250}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP}
{$DEFINE VER17UP}
{$DEFINE VER18UP} //Delphi XE4
{$ENDIF}
 
{$IFDEF VER260}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP}
{$DEFINE VER17UP}
{$DEFINE VER18UP}
{$DEFINE VER19UP} //Delphi XE5
{$ENDIF}
 
{$IFDEF VER270}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP}
{$DEFINE VER17UP}
{$DEFINE VER18UP}
{$DEFINE VER19UP}
{$DEFINE VER20UP} //Delphi XE6
{$ENDIF}
 
{$IFDEF VER280}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP}
{$DEFINE VER17UP}
{$DEFINE VER18UP}
{$DEFINE VER19UP}
{$DEFINE VER20UP}
{$DEFINE VER21UP} //Delphi XE7
{$ENDIF}
 
{$IFDEF VER290}
{$DEFINE VER3UP}
{$DEFINE VER4UP}
{$DEFINE VER5UP}
{$DEFINE VER6UP}
{$DEFINE VER7UP}
{$DEFINE VER9UP}
{$DEFINE VER10UP}
{$DEFINE VER11UP}
{$DEFINE VER12UP}
{$DEFINE VER14UP}
{$DEFINE VER15UP}
{$DEFINE VER16UP}
{$DEFINE VER17UP}
{$DEFINE VER18UP}
{$DEFINE VER19UP}
{$DEFINE VER20UP}
{$DEFINE VER21UP}
{$DEFINE VER22UP} //Delphi XE8
{$ENDIF}
 
{$IFDEF VER100}
// Delphi 3
{$DEFINE DelphiX_Delphi3}
{$Define D3UP}
{$ENDIF}
 
{$IFDEF VER120}
// Delphi 4
{$DEFINE DelphiX_Delphi4}
{$Define D3UP}
{$Define D4UP}
{$ENDIF}
 
{$IFDEF VER130}
// Delphi 5
{$DEFINE DelphiX_Delphi5}
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$ENDIF}
 
{$IFDEF DelphiX_Delphi3}
{$DEFINE DelphiX_Spt3}
{$IFDEF VER140}
// Delphi 6
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$ENDIF}
 
{$IFDEF DelphiX_Delphi4}
{$DEFINE DelphiX_Spt3}
{$DEFINE DelphiX_Spt4}
{$IFDEF VER150}
// Delphi 7
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$ENDIF}
 
{$IFDEF DelphiX_Delphi5}
{$DEFINE DelphiX_Spt3}
{$DEFINE DelphiX_Spt4}
{$DEFINE DelphiX_Spt5}
{$IFDEF VER170}
// Delphi 9 - 2005
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$ENDIF}
 
{$IFDEF VER180}
// Delphi 10 - 2006 or Turbo
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$ENDIF}
 
{$IFDEF VER185}
// Delphi 11 - 2007
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$ENDIF}
 
{$IFDEF VER200}
// Delphi 12 - 2009
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$ENDIF}
 
{$IFDEF VER210}
// Delphi 14 - 2010
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER220}
// Delphi 15 - XE
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER230}
// Delphi 16 - XE2
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER240}
// Delphi 17 - XE3
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D17UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER250}
// Delphi 18 - XE4
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D17UP}
{$Define D18UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER260}
// Delphi 19 - XE5
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D17UP}
{$Define D18UP}
{$Define D19UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER270}
// Delphi 20 - XE6
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D17UP}
{$Define D18UP}
{$Define D19UP}
{$Define D20UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER280}
// Delphi 21 - XE7
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D17UP}
{$Define D18UP}
{$Define D19UP}
{$Define D20UP}
{$Define D21UP}
{$Define D_EE_UP}
{$ENDIF}
 
{$IFDEF VER290}
// Delphi 22 - XE8
{$Define D3UP}
{$Define D4UP}
{$Define D5UP}
{$Define D6UP}
{$Define D7UP}
{$Define D9UP}
{$Define D10UP}
{$Define D11UP}
{$Define D12UP}
{$Define D14UP}
{$Define D15UP}
{$Define D16UP}
{$Define D17UP}
{$Define D18UP}
{$Define D19UP}
{$Define D20UP}
{$Define D21UP}
{$Define D22UP}
{$Define D_EE_UP}
{$ENDIF}
 
{standard feature for drawing blend textures}
{this conditional is add-on as is for eliminate bad color key switching}
{$DEFINE DrawHWAcc}
 
{DirectX Double precision activation}
{$DEFINE DXDOUBLEPRECISION}
 
{when you can use this option, you must use separate headers unit }
{if this turn off, you use built-in standard DirectX.pas unit (in one file)}
{$IFDEF D_EE_UP} //Delphi 2010/XE
{$DEFINE StandardDX}
{$ELSE}
{.$DEFINE StandardDX}
{$ENDIF}
 
{Only one can be set!}
{Use standard of DirectX version 7}
{$IFNDEF D_EE_UP}
{$DEFINE DX7}
{$ELSE}
 
{Use standard of DirectX version 9}
{in concert with StandardDX for separate units only}
{$IFDEF StandardDX}
{$DEFINE DX9}
{$ENDIF}
{$ENDIF}
 
{for better texture compression can be use ZLIB here}
{in some Delphi versions it errors occurred because ZLib package is "lock-like" package}
{I recommend use it for final version application only}
{$IFDEF VER5UP} {Delphi 5 (and lower) has any problems with ZLIB, may be replace by 3rd party lib. manually}
{$DEFINE DXTextureImage_UseZLIB}
{$ENDIF}
{when videotexture is used - like change images in texture}
{Note: it consume 2x more memory because texture is store twice unchanged and}
{changed - this conditional add/remove store shadow image in texture buffer}
{$IFDEF VER5UP} {Delphi 5 (and lower) has any problems with ZLIB, may be replace by 3rd party lib. manually}
{$DEFINE VIDEOTEX}
{$ENDIF}
 
{software rendering based on Hori's DXR code}
{this option is only for remove all DXR code, is not recommended remove it}
{it can be remove only for special usage like use PURE DirectX for SW rendering too}
{$DEFINE DXR_deprecated}
 
{$IfDef DX7}
{Retained mode is turn off for Vista as implicit value}
{When you want use it, you have to add the D3DRM.DLL}
{is recommended put library into Windows/System32 system directory}
{in application directory does not works properly under Vista}
{$Define D3D_deprecated} //both must be turn-on
{.$Define D3DRM} //required D3DRM.DLL !!
{for separete unit is DirectRM.pas required !! - it is not include in Delphi 2010/XE !!}
{this class is deprecated; when you can it use, remove dot bellow}
{this add additional component for D3D over DXDraw}
{$IFDEF D3DRM}
{$Define DX3D_deprecated}
{$ENDIF}
 
{$ELSE}
{$Define D3D_deprecated}
{$EndIf}
 
{$IFDEF VER12UP}
{PNG support is added in Delphi 2009 and up as native feature}
{there is turn on, it is for backward compatibility only}
{$Define PNG_GRAPHICS}
{$ELSE}
{for Delphi 2007 and lower when you usen PNG support, you have write}
{name of PNG package into required section of pavkage source .dpk}
{and turn on this support here - remove the dot only bellow}
{.$Define PNG_GRAPHICS}
{$ENDIF}
 
{special feature for enumerate displayis like primary, secondary etc.}
{only for special purpose, multimonitors etc.}
{.$Define _DMO_}
/VCL_DELPHIX_D6/DirectPlay.pas
0,0 → 1,2511
unit DirectPlay;
 
(*==========================================================================;
*
* Copyright (C) Microsoft Corporation. All Rights Reserved.
*
* File: dplay.h dplobby.h
* Content: DirectPlay include files
*
* DirectX 7 Delphi adaptation by Erik Unger
*
* Modified: 4-Jun-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
***************************************************************************)
 
interface
 
{$MINENUMSIZE 4}
{$ALIGN ON}
 
uses
Windows;
 
type
{$IFDEF UNICODE}
PCharAW = PWideChar;
{$ELSE}
PCharAW = PAnsiChar;
{$ENDIF}
 
var
DPlayDLL: HMODULE = 0;
 
(*==========================================================================;
*
* Copyright (C) 1994-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dplay.h
* Content: DirectPlay include file
*
***************************************************************************)
 
function DPErrorString(Value: HResult): string;
 
const
// {D1EB6D20-8923-11d0-9D97-00A0C90A43CB}
CLSID_DirectPlay: TGUID =
(D1: $D1EB6D20; D2: $8923; D3: $11D0; D4: ($9D, $97, $00, $A0, $C9, $A, $43, $CB));
 
(*
* GUIDS used by Service Providers shipped with DirectPlay
* Use these to identify Service Provider returned by EnumConnections
*)
 
// GUID for IPX service provider
// {685BC400-9D2C-11cf-A9CD-00AA006886E3}
DPSPGUID_IPX: TGUID =
(D1: $685BC400; D2: $9D2C; D3: $11CF; D4: ($A9, $CD, $00, $AA, $00, $68, $86, $E3));
 
// GUID for TCP/IP service provider
// 36E95EE0-8577-11cf-960C-0080C7534E82
DPSPGUID_TCPIP: TGUID =
(D1: $36E95EE0; D2: $8577; D3: $11CF; D4: ($96, $0C, $00, $80, $C7, $53, $4E, $82));
 
// GUID for Serial service provider
// {0F1D6860-88D9-11cf-9C4E-00A0C905425E}
DPSPGUID_SERIAL: TGUID =
(D1: $F1D6860; D2: $88D9; D3: $11CF; D4: ($9C, $4E, $00, $A0, $C9, $05, $42, $5E));
 
// GUID for Modem service provider
// {44EAA760-CB68-11cf-9C4E-00A0C905425E}
DPSPGUID_MODEM: TGUID =
(D1: $44EAA760; D2: $CB68; D3: $11CF; D4: ($9C, $4E, $00, $A0, $C9, $05, $42, $5E));
 
(****************************************************************************
*
* DirectPlay Structures
*
* Various structures used to invoke DirectPlay.
*
****************************************************************************)
 
type
(*
* TDPID
* DirectPlay player and group ID
*)
TDPID = DWORD;
PDPID = ^TDPID;
 
const
(*
* DPID that system messages come from
*)
DPID_SYSMSG = 0;
 
(*
* DPID representing all players in the session
*)
DPID_ALLPLAYERS = 0;
 
(*
* DPID representing the server player
*)
DPID_SERVERPLAYER = 1;
 
(*
* DPID representing the maximum ID in the range of DPID's reserved for
* use by DirectPlay.
*)
DPID_RESERVEDRANGE = 100;
 
(*
* The player ID is unknown (used with e.g. DPSESSION_NOMESSAGEID)
*)
DPID_UNKNOWN = $FFFFFFFF;
 
type
(*
* DPCAPS
* Used to obtain the capabilities of a DirectPlay object
*)
PDPCaps = ^TDPCaps;
TDPCaps = packed record
dwSize: DWORD; // Size of structure, in bytes
dwFlags: DWORD; // DPCAPS_xxx flags
dwMaxBufferSize: DWORD; // Maximum message size, in bytes, for this service provider
dwMaxQueueSize: DWORD; // Obsolete.
dwMaxPlayers: DWORD; // Maximum players/groups (local + remote)
dwHundredBaud: DWORD; // Bandwidth in 100 bits per second units;
// i.e. 24 is 2400, 96 is 9600, etc.
dwLatency: DWORD; // Estimated latency; 0 = unknown
dwMaxLocalPlayers: DWORD; // Maximum # of locally created players allowed
dwHeaderLength: DWORD; // Maximum header length, in bytes, on messages
// added by the service provider
dwTimeout: DWORD; // Service provider's suggested timeout value
// This is how long DirectPlay will wait for
// responses to system messages
end;
 
const
(*
* This DirectPlay object is the session host. If the host exits the
* session, another application will become the host and receive a
* DPSYS_HOST system message.
*)
DPCAPS_ISHOST = $00000002;
 
(*
* The service provider bound to this DirectPlay object can optimize
* group messaging.
*)
DPCAPS_GROUPOPTIMIZED = $00000008;
 
(*
* The service provider bound to this DirectPlay object can optimize
* keep alives (see DPSESSION_KEEPALIVE)
*)
DPCAPS_KEEPALIVEOPTIMIZED = $00000010;
 
(*
* The service provider bound to this DirectPlay object can optimize
* guaranteed message delivery.
*)
DPCAPS_GUARANTEEDOPTIMIZED = $00000020;
 
(*
* This DirectPlay object supports guaranteed message delivery.
*)
DPCAPS_GUARANTEEDSUPPORTED = $00000040;
 
(*
* This DirectPlay object supports digital signing of messages.
*)
DPCAPS_SIGNINGSUPPORTED = $00000080;
 
(*
* This DirectPlay object supports encryption of messages.
*)
DPCAPS_ENCRYPTIONSUPPORTED = $00000100;
 
(*
* This DirectPlay player was created on this machine
*)
DPPLAYERCAPS_LOCAL = $00000800;
 
(*
* Current Open settings supports all forms of Cancel
*)
DPCAPS_ASYNCCANCELSUPPORTED = $00001000;
 
(*
* Current Open settings supports CancelAll, but not Cancel
*)
DPCAPS_ASYNCCANCELALLSUPPORTED = $00002000;
 
(*
* Current Open settings supports Send Timeouts for sends
*)
DPCAPS_SENDTIMEOUTSUPPORTED = $00004000;
 
(*
* Current Open settings supports send priority
*)
DPCAPS_SENDPRIORITYSUPPORTED = $00008000;
 
(*
* Current Open settings supports DPSEND_ASYNC flag
*)
DPCAPS_ASYNCSUPPORTED = $00010000;
 
type
(*
* TDPSessionDesc2
* Used to describe the properties of a DirectPlay
* session instance
*)
PDPSessionDesc2 = ^TDPSessionDesc2;
TDPSessionDesc2 = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // DPSESSION_xxx flags
guidInstance: TGUID; // ID for the session instance
guidApplication: TGUID; // GUID of the DirectPlay application.
// GUID_NULL for all applications.
dwMaxPlayers: DWORD; // Maximum # players allowed in session
dwCurrentPlayers: DWORD; // Current # players in session (read only)
case Integer of
0: (
lpszSessionName: PCharAW; // Name of the session
lpszPassword: PCharAW; // Password of the session (optional)
dwReserved1: DWORD; // Reserved for future MS use.
dwReserved2: DWORD;
dwUser1: DWORD; // For use by the application
dwUser2: DWORD;
dwUser3: DWORD;
dwUser4: DWORD;
);
1: (
lpszSessionNameA: PAnsiChar; // Name of the session
lpszPasswordA: PAnsiChar // Password of the session (optional)
);
2: (
lpszSessionNameW: PWideChar;
lpszPasswordW: PWideChar
);
end;
 
const
(*
* Applications cannot create new players in this session.
*)
DPSESSION_NEWPLAYERSDISABLED = $00000001;
 
(*
* If the DirectPlay object that created the session, the host,
* quits, then the host will attempt to migrate to another
* DirectPlay object so that new players can continue to be created
* and new applications can join the session.
*)
DPSESSION_MIGRATEHOST = $00000004;
 
(*
* This flag tells DirectPlay not to set the idPlayerTo and idPlayerFrom
* fields in player messages. This cuts two DWORD's off the message
* overhead.
*)
DPSESSION_NOMESSAGEID = $00000008;
 
(*
* This flag tells DirectPlay to not allow any new applications to
* join the session. Applications already in the session can still
* create new players.
*)
DPSESSION_JOINDISABLED = $00000020;
 
(*
* This flag tells DirectPlay to detect when remote players
* exit abnormally (e.g. their computer or modem gets unplugged)
*)
DPSESSION_KEEPALIVE = $00000040;
 
(*
* This flag tells DirectPlay not to send a message to all players
* when a players remote data changes
*)
DPSESSION_NODATAMESSAGES = $00000080;
 
(*
* This flag indicates that the session belongs to a secure server
* and needs user authentication
*)
DPSESSION_SECURESERVER = $00000100;
 
(*
* This flag indicates that the session is private and requirs a password
* for EnumSessions as well as Open.
*)
DPSESSION_PRIVATE = $00000200;
 
(*
* This flag indicates that the session requires a password for joining.
*)
DPSESSION_PASSWORDREQUIRED = $00000400;
 
(*
* This flag tells DirectPlay to route all messages through the server
*)
DPSESSION_MULTICASTSERVER = $00000800;
 
(*
* This flag tells DirectPlay to only download information about the
* DPPLAYER_SERVERPLAYER.
*)
DPSESSION_CLIENTSERVER = $00001000;
 
(*
* This flag tells DirectPlay to use the protocol built into dplay
* for reliability and statistics all the time. When this bit is
* set, only other sessions with this bit set can join or be joined.
*)
DPSESSION_DIRECTPLAYPROTOCOL = $00002000;
 
(*
* This flag tells DirectPlay that preserving order of received
* packets is not important, when using reliable delivery. This
* will allow messages to be indicated out of order if preceding
* messages have not yet arrived. Otherwise DPLAY will wait for
* earlier messages before delivering later reliable messages.
*)
DPSESSION_NOPRESERVEORDER = $00004000;
 
(*
* This flag tells DirectPlay to optimize communication for latency
*)
DPSESSION_OPTIMIZELATENCY = $00008000;
 
type
(*
* TDPName
* Used to hold the name of a DirectPlay entity
* like a player or a group
*)
PDPName = ^TDPName;
TDPName = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszShortName: PCharAW; // The short or friendly name
lpszLongName: PCharAW; // The long or formal name
);
1: (
lpszShortNameA: PAnsiChar;
lpszLongNameA: PAnsiChar;
);
2: (
lpszShortNameW: PWideChar;
lpszLongNameW: PWideChar;
);
end;
 
(*
* TDPCredentials
* Used to hold the user name and password of a DirectPlay user
*)
 
PDPCredentials = ^TDPCredentials;
TDPCredentials = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszUsername: PCharAW; // User name of the account
lpszPassword: PCharAW; // Password of the account
lpszDomain: PCharAW; // Domain name of the account
);
1: (
lpszUsernameA: PAnsiChar; // User name of the account
lpszPasswordA: PAnsiChar; // Password of the account
lpszDomainA: PAnsiChar; // Domain name of the account
);
2: (
lpszUsernameW: PWideChar; // User name of the account
lpszPasswordW: PWideChar; // Password of the account
lpszDomainW: PWideChar; // Domain name of the account
);
end;
 
(*
* TDPSecurityDesc
* Used to describe the security properties of a DirectPlay
* session instance
*)
PDPSecurityDesc = ^TDPSecurityDesc;
TDPSecurityDesc = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszSSPIProvider: PCharAW; // SSPI provider name
lpszCAPIProvider: PCharAW; // CAPI provider name
dwCAPIProviderType: DWORD; // Crypto Service Provider type
dwEncryptionAlgorithm: DWORD; // Encryption Algorithm type
);
1: (
lpszSSPIProviderA: PAnsiChar; // SSPI provider name
lpszCAPIProviderA: PAnsiChar; // CAPI provider name
);
2: (
lpszSSPIProviderW: PWideChar; // SSPI provider name
lpszCAPIProviderW: PWideChar; // CAPI provider name
);
end;
 
(*
* DPACCOUNTDESC
* Used to describe a user membership account
*)
 
PDPAccountDesc = ^TDPAccountDesc;
TDPAccountDesc = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (lpszAccountID: PCharAW); // Account identifier
1: (lpszAccountIDA: PAnsiChar);
2: (lpszAccountIDW: PWideChar);
end;
 
(*
* TDPLConnection
* Used to hold all in the informaion needed to connect
* an application to a session or create a session
*)
PDPLConnection = ^TDPLConnection;
TDPLConnection = packed record
dwSize: DWORD; // Size of this structure
dwFlags: DWORD; // Flags specific to this structure
lpSessionDesc: PDPSessionDesc2; // Pointer to session desc to use on connect
lpPlayerName: PDPName; // Pointer to Player name structure
guidSP: TGUID; // GUID of the DPlay SP to use
lpAddress: Pointer; // Address for service provider
dwAddressSize: DWORD; // Size of address data
end;
 
(*
* TDPChat
* Used to hold the a DirectPlay chat message
*)
PDPChat = ^TDPChat;
TDPChat = packed record
dwSize: DWORD;
dwFlags: DWORD;
case Integer of
0: (lpszMessage: PCharAW); // Message string
1: (lpszMessageA: PAnsiChar);
2: (lpszMessageW: PWideChar);
end;
 
(*
* TSGBuffer
* Scatter Gather Buffer used for SendEx
*)
PSGBuffer = ^TSGBuffer;
TSGBuffer = packed record
len: UINT;
pData: PUCHAR;
end;
 
(****************************************************************************
*
* Prototypes for DirectPlay callback functions
*
****************************************************************************)
 
(*
* Callback for IDirectPlay2::EnumSessions
*)
TDPEnumSessionsCallback2 = function(lpThisSD: PDPSessionDesc2;
var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
 
const
(*
* This flag is set on the EnumSessions callback dwFlags parameter when
* the time out has occurred. There will be no session data for this
* callback. If *lpdwTimeOut is set to a non-zero value and the
* EnumSessionsCallback function returns TRUE then EnumSessions will
* continue waiting until the next timeout occurs. Timeouts are in
* milliseconds.
*)
DPESC_TIMEDOUT = $00000001;
 
type
(*
* Callback for IDirectPlay2.EnumPlayers
* IDirectPlay2.EnumGroups
* IDirectPlay2.EnumGroupPlayers
*)
TDPEnumPlayersCallback2 = function(DPID: TDPID; dwPlayerType: DWORD;
const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
 
(*
* ANSI callback for DirectPlayEnumerate
* This callback prototype will be used if compiling
* for ANSI strings
*)
TDPEnumDPCallbackA = function(const lpguidSP: TGUID; lpSPName: PAnsiChar;
dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer): BOOL; stdcall;
 
(*
* Unicode callback for DirectPlayEnumerate
* This callback prototype will be used if compiling
* for Unicode strings
*)
TDPEnumDPCallbackW = function(const lpguidSP: TGUID; lpSPName: PWideChar;
dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer): BOOL; stdcall;
 
(*
* Callback for DirectPlayEnumerate
*)
{$IFDEF UNICODE}
TDPEnumDPCallback = TDPEnumDPCallbackW;
{$ELSE}
TDPEnumDPCallback = TDPEnumDPCallbackA;
{$ENDIF}
 
(*
* Callback for IDirectPlay3(A/W).EnumConnections
*)
TDPEnumConnectionsCallback = function(const lpguidSP: TGUID;
lpConnection: Pointer; dwConnectionSize: DWORD; const lpName: TDPName;
dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
 
(*
* API's
*)
 
var
DirectPlayEnumerate: function(lpEnumDPCallback: TDPEnumDPCallback;
lpContext: Pointer): HResult; stdcall;
DirectPlayEnumerateA: function(lpEnumDPCallback: TDPEnumDPCallbackA;
lpContext: Pointer): HResult; stdcall;
DirectPlayEnumerateW: function(lpEnumDPCallback: TDPEnumDPCallbackW;
lpContext: Pointer): HResult; stdcall;
 
(****************************************************************************
*
* IDirectPlay2 (and IDirectPlay2A) Interface
*
****************************************************************************)
 
type
IDirectPlay2AW = interface(IUnknown)
(*** IDirectPlay2 methods ***)
function AddPlayerToGroup(idGroup: TDPID; idPlayer: TDPID): HResult; stdcall;
function Close: HResult; stdcall;
function CreateGroup(out lpidGroup: TDPID; lpGroupName: PDPName;
lpData: Pointer; dwDataSize: DWORD; dwFlags: DWORD): HResult; stdcall;
function CreatePlayer(out lpidPlayer: TDPID; pPlayerName: PDPName;
hEvent: THandle; lpData: Pointer; dwDataSize: DWORD; dwFlags: DWORD): HResult; stdcall;
function DeletePlayerFromGroup(idGroup: TDPID; idPlayer: TDPID): HResult; stdcall;
function DestroyGroup(idGroup: TDPID): HResult; stdcall;
function DestroyPlayer(idPlayer: TDPID): HResult; stdcall;
function EnumGroupPlayers(idGroup: TDPID; lpguidInstance: PGUID;
lpEnumPlayersCallback2: TDPEnumPlayersCallback2; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function EnumGroups(lpguidInstance: PGUID; lpEnumPlayersCallback2:
TDPEnumPlayersCallback2; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumPlayers(lpguidInstance: PGUID; lpEnumPlayersCallback2:
TDPEnumPlayersCallback2; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumSessions(const lpsd: TDPSessionDesc2; dwTimeout: DWORD;
lpEnumSessionsCallback2: TDPEnumSessionsCallback2; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDPCaps: TDPCaps; dwFlags: DWORD): HResult; stdcall;
function GetGroupData(idGroup: TDPID; lpData: Pointer; var lpdwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function GetGroupName(idGroup: TDPID; lpData: Pointer; var lpdwDataSize: DWORD):
HResult; stdcall;
function GetMessageCount(idPlayer: TDPID; var lpdwCount: DWORD): HResult; stdcall;
function GetPlayerAddress(idPlayer: TDPID; lpAddress: Pointer;
var lpdwAddressSize: DWORD): HResult; stdcall;
function GetPlayerCaps(idPlayer: TDPID; var lpPlayerCaps: TDPCaps;
dwFlags: DWORD): HResult; stdcall;
function GetPlayerData(idPlayer: TDPID; lpData: Pointer; var lpdwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function GetPlayerName(idPlayer: TDPID; lpData: Pointer; var lpdwDataSize: DWORD): HResult; stdcall;
function GetSessionDesc(lpData: Pointer; var lpdwDataSize: DWORD): HResult; stdcall;
function Initialize(const lpGUID: TGUID): HResult; stdcall;
function Open(var lpsd: TDPSessionDesc2; dwFlags: DWORD): HResult; stdcall;
function Receive(var lpidFrom: TDPID; var lpidTo: TDPID; dwFlags: DWORD;
lpData: Pointer; var lpdwDataSize: DWORD): HResult; stdcall;
function Send(idFrom: TDPID; lpidTo: TDPID; dwFlags: DWORD; var lpData;
lpdwDataSize: DWORD): HResult; stdcall;
function SetGroupData(idGroup: TDPID; lpData: Pointer; dwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetGroupName(idGroup: TDPID; lpGroupName: PDPName;
dwFlags: DWORD): HResult; stdcall;
function SetPlayerData(idPlayer: TDPID; lpData: Pointer; dwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetPlayerName(idPlayer: TDPID; lpPlayerName: PDPName;
dwFlags: DWORD): HResult; stdcall;
function SetSessionDesc(var lpSessDesc: TDPSessionDesc2; dwFlags: DWORD):
HResult; stdcall;
end;
 
IDirectPlay2W = interface(IDirectPlay2AW)
['{2B74F7C0-9154-11CF-A9CD-00AA006886E3}']
end;
IDirectPlay2A = interface(IDirectPlay2AW)
['{9d460580-a822-11cf-960c-0080c7534e82}']
end;
 
{$IFDEF UNICODE}
IDirectPlay2 = IDirectPlay2W;
{$ELSE}
IDirectPlay2 = IDirectPlay2A;
{$ENDIF}
 
(****************************************************************************
*
* IDirectPlay3 (and IDirectPlay3A) Interface
*
****************************************************************************)
 
IDirectPlay3AW = interface(IDirectPlay2AW)
(*** IDirectPlay3 methods ***)
function AddGroupToGroup(idParentGroup: TDPID; idGroup: TDPID): HResult; stdcall;
function CreateGroupInGroup(idParentGroup: TDPID; var lpidGroup: TDPID;
lpGroupName: PDPName; lpData: Pointer; dwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function DeleteGroupFromGroup(idParentGroup: TDPID; idGroup: TDPID): HResult; stdcall;
function EnumConnections(lpguidApplication: PGUID;
lpEnumCallback: TDPEnumConnectionsCallback; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function EnumGroupsInGroup(idGroup: TDPID; lpguidInstance: PGUID;
lpEnumPlayersCallback2: TDPEnumPlayersCallback2; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function GetGroupConnectionSettings(dwFlags: DWORD; idGroup: TDPID;
lpData: Pointer; var lpdwDataSize: DWORD): HResult; stdcall;
function InitializeConnection(lpConnection: Pointer; dwFlags: DWORD): HResult; stdcall;
function SecureOpen(var lpsd: TDPSessionDesc2; dwFlags: DWORD;
var lpSecurity: TDPSecurityDesc; var lpCredentials: TDPCredentials): HResult; stdcall;
function SendChatMessage(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD;
var lpChatMessage: TDPChat): HResult; stdcall;
function SetGroupConnectionSettings(dwFlags: DWORD; idGroup: TDPID;
var lpConnection: TDPLConnection): HResult; stdcall;
function StartSession(dwFlags: DWORD; idGroup: TDPID): HResult; stdcall;
function GetGroupFlags(idGroup: TDPID; out lpdwFlags: DWORD): HResult; stdcall;
function GetGroupParent(idGroup: TDPID; out lpidParent: TDPID): HResult; stdcall;
function GetPlayerAccount(idPlayer: TDPID; dwFlags: DWORD; var lpData;
var lpdwDataSize: DWORD): HResult; stdcall;
function GetPlayerFlags(idPlayer: TDPID; out lpdwFlags: DWORD): HResult; stdcall;
end;
 
IDirectPlay3W = interface(IDirectPlay3AW)
['{133EFE40-32DC-11D0-9CFB-00A0C90A43CB}']
end;
IDirectPlay3A = interface(IDirectPlay3AW)
['{133efe41-32dc-11d0-9cfb-00a0c90a43cb}']
end;
 
{$IFDEF UNICODE}
IDirectPlay3 = IDirectPlay3W;
{$ELSE}
IDirectPlay3 = IDirectPlay3A;
{$ENDIF}
 
(****************************************************************************
*
* IDirectPlay4 (and IDirectPlay4A) Interface
*
****************************************************************************)
 
IDirectPlay4AW = interface(IDirectPlay3AW)
(*** IDirectPlay4 methods ***)
function GetGroupOwner(idGroup: TDPID; out idOwner: TDPID): HResult; stdcall;
function SetGroupOwner(idGroup: TDPID; idOwner: TDPID): HResult; stdcall;
function SendEx(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD; lpData: Pointer;
dwDataSize: DWORD; dwPriority: DWORD; dwTimeout: DWORD;
lpContext: Pointer; lpdwMsgId: PDWORD): HResult; stdcall;
function GetMessageQueue(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD;
lpdwNumMsgs: PDWORD; lpdwNumBytes: PDWORD): HResult; stdcall;
function CancelMessage(dwMessageID: DWORD; dwFlags: DWORD): HResult; stdcall;
function CancelPriority(dwMinPriority: DWORD; dwMaxPriority: DWORD; dwFlags: DWORD): HResult; stdcall;
end;
 
IDirectPlay4W = interface(IDirectPlay4AW)
['{0ab1c530-4745-11D1-a7a1-0000f803abfc}']
end;
IDirectPlay4A = interface(IDirectPlay4AW)
['{0ab1c531-4745-11D1-a7a1-0000f803abfc}']
end;
 
{$IFDEF UNICODE}
IDirectPlay4 = IDirectPlay4W;
{$ELSE}
IDirectPlay4 = IDirectPlay4A;
{$ENDIF}
 
const
(****************************************************************************
*
* EnumConnections API flags
*
****************************************************************************)
 
(*
* Enumerate Service Providers
*)
DPCONNECTION_DIRECTPLAY = $00000001;
 
(*
* Enumerate Lobby Providers
*)
DPCONNECTION_DIRECTPLAYLOBBY = $00000002;
 
(****************************************************************************
*
* EnumPlayers API flags
*
****************************************************************************)
 
(*
* Enumerate all players in the current session
*)
DPENUMPLAYERS_ALL = $00000000;
DPENUMGROUPS_ALL = DPENUMPLAYERS_ALL;
 
(*
* Enumerate only local (created by this application) players
* or groups
*)
DPENUMPLAYERS_LOCAL = $00000008;
DPENUMGROUPS_LOCAL = DPENUMPLAYERS_LOCAL;
 
(*
* Enumerate only remote (non-local) players
* or groups
*)
DPENUMPLAYERS_REMOTE = $00000010;
DPENUMGROUPS_REMOTE = DPENUMPLAYERS_REMOTE;
 
(*
* Enumerate groups along with the players
*)
DPENUMPLAYERS_GROUP = $00000020;
 
(*
* Enumerate players or groups in another session
* (must supply lpguidInstance)
*)
DPENUMPLAYERS_SESSION = $00000080;
DPENUMGROUPS_SESSION = DPENUMPLAYERS_SESSION;
 
(*
* Enumerate server players
*)
DPENUMPLAYERS_SERVERPLAYER = $00000100;
 
(*
* Enumerate spectator players
*)
DPENUMPLAYERS_SPECTATOR = $00000200;
 
(*
* Enumerate shortcut groups
*)
DPENUMGROUPS_SHORTCUT = $00000400;
 
(*
* Enumerate staging area groups
*)
DPENUMGROUPS_STAGINGAREA = $00000800;
 
(*
* Enumerate hidden groups
*)
DPENUMGROUPS_HIDDEN = $00001000;
 
(*
* Enumerate the group's owner
*)
DPENUMPLAYERS_OWNER = $00002000;
 
(****************************************************************************
*
* CreatePlayer API flags
*
****************************************************************************)
 
(*
* This flag indicates that this player should be designated
* the server player. The app should specify this at CreatePlayer.
*)
DPPLAYER_SERVERPLAYER = DPENUMPLAYERS_SERVERPLAYER;
 
(*
* This flag indicates that this player should be designated
* a spectator. The app should specify this at CreatePlayer.
*)
DPPLAYER_SPECTATOR = DPENUMPLAYERS_SPECTATOR;
 
(*
* This flag indicates that this player was created locally.
* (returned from GetPlayerFlags)
*)
DPPLAYER_LOCAL = DPENUMPLAYERS_LOCAL;
 
(*
* This flag indicates that this player is the group's owner
* (Only returned in EnumGroupPlayers)
*)
DPPLAYER_OWNER = DPENUMPLAYERS_OWNER;
 
(****************************************************************************
*
* CreateGroup API flags
*
****************************************************************************)
 
(*
* This flag indicates that the StartSession can be called on the group.
* The app should specify this at CreateGroup, or CreateGroupInGroup.
*)
DPGROUP_STAGINGAREA = DPENUMGROUPS_STAGINGAREA;
 
(*
* This flag indicates that this group was created locally.
* (returned from GetGroupFlags)
*)
DPGROUP_LOCAL = DPENUMGROUPS_LOCAL;
 
(*
* This flag indicates that this group was created hidden.
*)
DPGROUP_HIDDEN = DPENUMGROUPS_HIDDEN;
 
(****************************************************************************
*
* EnumSessions API flags
*
****************************************************************************)
 
(*
* Enumerate sessions which can be joined
*)
DPENUMSESSIONS_AVAILABLE = $00000001;
 
(*
* Enumerate all sessions even if they can't be joined.
*)
DPENUMSESSIONS_ALL = $00000002;
 
(*
* Start an asynchronous enum sessions
*)
DPENUMSESSIONS_ASYNC = $00000010;
 
(*
* Stop an asynchronous enum sessions
*)
DPENUMSESSIONS_STOPASYNC = $00000020;
 
(*
* Enumerate sessions even if they require a password
*)
DPENUMSESSIONS_PASSWORDREQUIRED = $00000040;
 
(*
* Return status about progress of enumeration instead of
* showing any status dialogs.
*)
DPENUMSESSIONS_RETURNSTATUS = $00000080;
 
(****************************************************************************
*
* GetCaps and GetPlayerCaps API flags
*
****************************************************************************)
 
(*
* The latency returned should be for guaranteed message sending.
* Default is non-guaranteed messaging.
*)
DPGETCAPS_GUARANTEED = $00000001;
 
(****************************************************************************
*
* GetGroupData, GetPlayerData API flags
* Remote and local Group/Player data is maintained separately.
* Default is DPGET_REMOTE.
*
****************************************************************************)
 
(*
* Get the remote data (set by any DirectPlay object in
* the session using DPSET_REMOTE)
*)
DPGET_REMOTE = $00000000;
 
(*
* Get the local data (set by this DirectPlay object
* using DPSET_LOCAL)
*)
DPGET_LOCAL = $00000001;
 
(****************************************************************************
*
* Open API flags
*
****************************************************************************)
 
(*
* Join the session that is described by the DPSESSIONDESC2 structure
*)
DPOPEN_JOIN = $00000001;
 
(*
* Create a new session as described by the DPSESSIONDESC2 structure
*)
DPOPEN_CREATE = $00000002;
 
(*
* Return status about progress of open instead of showing
* any status dialogs.
*)
DPOPEN_RETURNSTATUS = DPENUMSESSIONS_RETURNSTATUS;
 
(****************************************************************************
*
* DPLCONNECTION flags
*
****************************************************************************)
 
(*
* This application should create a new session as
* described by the DPSESIONDESC structure
*)
DPLCONNECTION_CREATESESSION = DPOPEN_CREATE;
 
(*
* This application should join the session described by
* the DPSESIONDESC structure with the lpAddress data
*)
DPLCONNECTION_JOINSESSION = DPOPEN_JOIN;
 
(****************************************************************************
*
* Receive API flags
* Default is DPRECEIVE_ALL
*
****************************************************************************)
 
(*
* Get the first message in the queue
*)
DPRECEIVE_ALL = $00000001;
 
(*
* Get the first message in the queue directed to a specific player
*)
DPRECEIVE_TOPLAYER = $00000002;
 
(*
* Get the first message in the queue from a specific player
*)
DPRECEIVE_FROMPLAYER = $00000004;
 
(*
* Get the message but don't remove it from the queue
*)
DPRECEIVE_PEEK = $00000008;
 
(****************************************************************************
*
* Send API flags
*
****************************************************************************)
 
(*
* Send the message using a guaranteed send method.
* Default is non-guaranteed.
*)
DPSEND_GUARANTEED = $00000001;
 
(*
* This flag is obsolete. It is ignored by DirectPlay
*)
DPSEND_HIGHPRIORITY = $00000002;
 
(*
* This flag is obsolete. It is ignored by DirectPlay
*)
DPSEND_OPENSTREAM = $00000008;
 
(*
* This flag is obsolete. It is ignored by DirectPlay
*)
DPSEND_CLOSESTREAM = $00000010;
 
(*
* Send the message digitally signed to ensure authenticity.
*)
DPSEND_SIGNED = $00000020;
 
(*
* Send the message with encryption to ensure privacy.
*)
DPSEND_ENCRYPTED = $00000040;
 
(*
* The message is a lobby system message
*)
DPSEND_LOBBYSYSTEMMESSAGE = $00000080;
 
(*
* andyco - added this so we can make addforward async.
* needs to be sanitized when we add / expose full async
* support. 8/3/97.
*)
DPSEND_ASYNC = $00000200;
 
(*
* When a message is completed, don't tell me.
* by default the application is notified with a system message.
*)
DPSEND_NOSENDCOMPLETEMSG = $00000400;
 
(*
* Maximum priority for sends available to applications
*)
DPSEND_MAX_PRI = $0000FFFF;
DPSEND_MAX_PRIORITY = DPSEND_MAX_PRI;
 
(****************************************************************************
*
* SetGroupData, SetGroupName, SetPlayerData, SetPlayerName,
* SetSessionDesc API flags.
* Default is DPSET_REMOTE.
*
****************************************************************************)
 
(*
* Propagate the data to all players in the session
*)
DPSET_REMOTE = $00000000;
 
(*
* Do not propagate the data to other players
*)
DPSET_LOCAL = $00000001;
 
(*
* Used with DPSET_REMOTE, use guaranteed message send to
* propagate the data
*)
DPSET_GUARANTEED = $00000002;
 
(****************************************************************************
*
* GetMessageQueue API flags.
* Default is DPMESSAGEQUEUE_SEND
*
****************************************************************************)
 
(*
* Get Send Queue - requires Service Provider Support
*)
DPMESSAGEQUEUE_SEND = $00000001;
 
(*
* Get Receive Queue
*)
DPMESSAGEQUEUE_RECEIVE = $00000002;
 
(****************************************************************************
*
* Connect API flags
*
****************************************************************************)
 
(*
* Start an asynchronous connect which returns status codes
*)
DPCONNECT_RETURNSTATUS = DPENUMSESSIONS_RETURNSTATUS;
 
(****************************************************************************
*
* DirectPlay system messages and message data structures
*
* All system message come 'From' player DPID_SYSMSG. To determine what type
* of message it is, cast the lpData from Receive to TDPMsg_Generic and check
* the dwType member against one of the following DPSYS_xxx constants. Once
* a match is found, cast the lpData to the corresponding of the DPMSG_xxx
* structures to access the data of the message.
*
****************************************************************************)
 
(*
* A new player or group has been created in the session
* Use TDPMsg_CreatePlayerOrGroup. Check dwPlayerType to see if it
* is a player or a group.
*)
DPSYS_CREATEPLAYERORGROUP = $0003;
 
(*
* A player has been deleted from the session
* Use TDPMsg_DestroyPlayerOrGroup
*)
DPSYS_DESTROYPLAYERORGROUP = $0005;
 
(*
* A player has been added to a group
* Use DPMSG_ADDPLAYERTOGROUP
*)
DPSYS_ADDPLAYERTOGROUP = $0007;
 
(*
* A player has been removed from a group
* Use DPMSG_DELETEPLAYERFROMGROUP
*)
DPSYS_DELETEPLAYERFROMGROUP = $0021;
 
(*
* This DirectPlay object lost its connection with all the
* other players in the session.
* Use DPMSG_SESSIONLOST.
*)
DPSYS_SESSIONLOST = $0031;
 
(*
* The current host has left the session.
* This DirectPlay object is now the host.
* Use DPMSG_HOST.
*)
DPSYS_HOST = $0101;
 
(*
* The remote data associated with a player or
* group has changed. Check dwPlayerType to see
* if it is a player or a group
* Use DPMSG_SETPLAYERORGROUPDATA
*)
DPSYS_SETPLAYERORGROUPDATA = $0102;
 
(*
* The name of a player or group has changed.
* Check dwPlayerType to see if it is a player
* or a group.
* Use TDPMsg_SetPlayerOrGroupName
*)
DPSYS_SETPLAYERORGROUPNAME = $0103;
 
(*
* The session description has changed.
* Use DPMSG_SETSESSIONDESC
*)
DPSYS_SETSESSIONDESC = $0104;
 
(*
* A group has been added to a group
* Use TDPMsg_AddGroupToGroup
*)
DPSYS_ADDGROUPTOGROUP = $0105;
 
(*
* A group has been removed from a group
* Use DPMsg_DeleteGroupFromGroup
*)
DPSYS_DELETEGROUPFROMGROUP = $0106;
 
(*
* A secure player-player message has arrived.
* Use DPMSG_SECUREMESSAGE
*)
DPSYS_SECUREMESSAGE = $0107;
 
(*
* Start a new session.
* Use DPMSG_STARTSESSION
*)
DPSYS_STARTSESSION = $0108;
 
(*
* A chat message has arrived
* Use DPMSG_CHAT
*)
DPSYS_CHAT = $0109;
 
(*
* The owner of a group has changed
* Use DPMSG_SETGROUPOWNER
*)
DPSYS_SETGROUPOWNER = $010A;
 
(*
* An async send has finished, failed or been cancelled
* Use DPMSG_SENDCOMPLETE
*)
DPSYS_SENDCOMPLETE = $010D;
 
(*
* Used in the dwPlayerType field to indicate if it applies to a group
* or a player
*)
DPPLAYERTYPE_GROUP = $00000000;
DPPLAYERTYPE_PLAYER = $00000001;
 
type
(*
* TDPMsg_Generic
* Generic message structure used to identify the message type.
*)
PDPMsg_Generic = ^TDPMsg_Generic;
TDPMsg_Generic = packed record
dwType: DWORD; // Message type
end;
 
(*
* TDPMsg_CreatePlayerOrGroup
* System message generated when a new player or group
* created in the session with information about it.
*)
PDPMsg_CreatePlayerOrGroup = ^TDPMsg_CreatePlayerOrGroup;
TDPMsg_CreatePlayerOrGroup = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
DPID: TDPID; // ID of the player or group
dwCurrentPlayers: DWORD; // current # players & groups in session
lpData: Pointer; // pointer to remote data
dwDataSize: DWORD; // size of remote data
dpnName: TDPName; // structure with name info
// the following fields are only available when using
// the IDirectPlay3 interface or greater
dpIdParent: TDPID; // id of parent group
dwFlags: DWORD; // player or group flags
end;
 
(*
* TDPMsg_DestroyPlayerOrGroup
* System message generated when a player or group is being
* destroyed in the session with information about it.
*)
PDPMsg_DestroyPlayerOrGroup = ^TDPMsg_DestroyPlayerOrGroup;
TDPMsg_DestroyPlayerOrGroup = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
DPID: TDPID; // player ID being deleted
lpLocalData: Pointer; // copy of players local data
dwLocalDataSize: DWORD; // sizeof local data
lpRemoteData: Pointer; // copy of players remote data
dwRemoteDataSize: DWORD; // sizeof remote data
// the following fields are only available when using
// the IDirectPlay3 interface or greater
dpnName: TDPName; // structure with name info
dpIdParent: TDPID; // id of parent group
dwFlags: DWORD; // player or group flags
end;
 
(*
* DPMSG_ADDPLAYERTOGROUP
* System message generated when a player is being added
* to a group.
*)
PDPMsg_AddPlayerToGroup = ^TDPMsg_AddPlayerToGroup;
TDPMsg_AddPlayerToGroup = packed record
dwType: DWORD; // Message type
dpIdGroup: TDPID; // group ID being added to
dpIdPlayer: TDPID; // player ID being added
end;
 
(*
* DPMSG_DELETEPLAYERFROMGROUP
* System message generated when a player is being
* removed from a group
*)
PDPMsg_DeletePlayerFromGroup = ^TDPMsg_DeletePlayerFromGroup;
TDPMsg_DeletePlayerFromGroup = TDPMsg_AddPlayerToGroup;
 
(*
* TDPMsg_AddGroupToGroup
* System message generated when a group is being added
* to a group.
*)
PDPMsg_AddGroupToGroup = ^TDPMsg_AddGroupToGroup;
TDPMsg_AddGroupToGroup = packed record
dwType: DWORD; // Message type
dpIdParentGroup: TDPID; // group ID being added to
dpIdGroup: TDPID; // group ID being added
end;
 
(*
* DPMsg_DeleteGroupFromGroup
* System message generated when a GROUP is being
* removed from a group
*)
PDPMsg_DeleteGroupFromGroup = ^TDPMsg_DeleteGroupFromGroup;
TDPMsg_DeleteGroupFromGroup = TDPMsg_AddGroupToGroup;
 
(*
* DPMSG_SETPLAYERORGROUPDATA
* System message generated when remote data for a player or
* group has changed.
*)
PDPMsg_SetPlayerOrGroupData = ^TDPMsg_SetPlayerOrGroupData;
TDPMsg_SetPlayerOrGroupData = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
DPID: TDPID; // ID of player or group
lpData: Pointer; // pointer to remote data
dwDataSize: DWORD; // size of remote data
end;
 
(*
* DPMSG_SETPLAYERORGROUPNAME
* System message generated when the name of a player or
* group has changed.
*)
PDPMsg_SetPlayerOrGroupName = ^TDPMsg_SetPlayerOrGroupName;
TDPMsg_SetPlayerOrGroupName = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
DPID: TDPID; // ID of player or group
dpnName: TDPName; // structure with new name info
end;
 
(*
* DPMSG_SETSESSIONDESC
* System message generated when session desc has changed
*)
PDPMsg_SetSessionDesc = ^TDPMsg_SetSessionDesc;
TDPMsg_SetSessionDesc = packed record
dwType: DWORD; // Message type
dpDesc: TDPSessionDesc2; // Session desc
end;
 
(*
* DPMSG_HOST
* System message generated when the host has migrated to this
* DirectPlay object.
*
*)
PDPMsg_Host = ^TDPMsg_Host;
TDPMsg_Host = TDPMsg_Generic;
 
(*
* DPMSG_SESSIONLOST
* System message generated when the connection to the session is lost.
*
*)
PDPMsg_SessionLost = ^TDPMsg_SessionLost;
TDPMsg_SessionLost = TDPMsg_Generic;
 
(*
* DPMSG_SECUREMESSAGE
* System message generated when a player requests a secure send
*)
PDPMsg_SecureMessage = ^TDPMsg_SecureMessage;
TDPMsg_SecureMessage = packed record
dwType: DWORD; // Message Type
dwFlags: DWORD; // Signed/Encrypted
dpIdFrom: TDPID; // ID of Sending Player
lpData: Pointer; // Player message
dwDataSize: DWORD; // Size of player message
end;
 
(*
* DPMSG_STARTSESSION
* System message containing all information required to
* start a new session
*)
PDPMsg_StartSession = ^TDPMsg_StartSession;
TDPMsg_StartSession = packed record
dwType: DWORD; // Message type
lpConn: PDPLConnection; // TDPLConnection structure
end;
 
(*
* DPMSG_CHAT
* System message containing a chat message
*)
PDPMsg_Chat = ^TDPMsg_Chat;
TDPMsg_Chat = packed record
dwType: DWORD; // Message type
dwFlags: DWORD; // Message flags
idFromPlayer: TDPID; // ID of the Sending Player
idToPlayer: TDPID; // ID of the To Player
idToGroup: TDPID; // ID of the To Group
lpChat: PDPChat; // Pointer to a structure containing the chat message
end;
 
(*
* DPMSG_SETGROUPOWNER
* System message generated when the owner of a group has changed
*)
PDPMsg_SetGroupOwner = ^TDPMsg_SetGroupOwner;
TDPMsg_SetGroupOwner = packed record
dwType: DWORD; // Message type
idGroup: TDPID; // ID of the group
idNewOwner: TDPID; // ID of the player that is the new owner
idOldOwner: TDPID; // ID of the player that used to be the owner
end;
 
(*
* DPMSG_SENDCOMPLETE
* System message generated when finished with an Async Send message
*
* NOTE SENDPARMS has an overlay for DPMSG_SENDCOMPLETE, don't
* change this message w/o changing SENDPARMS.
*)
PDPMsg_SendComplete = ^TDPMsg_SendComplete;
TDPMsg_SendComplete = packed record
dwType: DWORD; // Message type
idFrom: TDPID;
idTo: TDPID;
dwFlags: DWORD;
dwPriority: DWORD;
dwTimeout: DWORD;
lpvContext: Pointer;
dwMsgID: DWORD;
hr: HRESULT;
dwSendTime: DWORD;
end;
 
(****************************************************************************
*
* DIRECTPLAY ERRORS
*
* Errors are represented by negative values and cannot be combined.
*
****************************************************************************)
const
MAKE_DPHRESULT = HResult($88770000);
 
DP_OK = S_OK;
DPERR_ALREADYINITIALIZED = MAKE_DPHRESULT + 5;
DPERR_ACCESSDENIED = MAKE_DPHRESULT + 10;
DPERR_ACTIVEPLAYERS = MAKE_DPHRESULT + 20;
DPERR_BUFFERTOOSMALL = MAKE_DPHRESULT + 30;
DPERR_CANTADDPLAYER = MAKE_DPHRESULT + 40;
DPERR_CANTCREATEGROUP = MAKE_DPHRESULT + 50;
DPERR_CANTCREATEPLAYER = MAKE_DPHRESULT + 60;
DPERR_CANTCREATESESSION = MAKE_DPHRESULT + 70;
DPERR_CAPSNOTAVAILABLEYET = MAKE_DPHRESULT + 80;
DPERR_EXCEPTION = MAKE_DPHRESULT + 90;
DPERR_GENERIC = E_FAIL;
DPERR_INVALIDFLAGS = MAKE_DPHRESULT + 120;
DPERR_INVALIDOBJECT = MAKE_DPHRESULT + 130;
DPERR_INVALIDPARAM = E_INVALIDARG;
DPERR_INVALIDPARAMS = DPERR_INVALIDPARAM;
DPERR_INVALIDPLAYER = MAKE_DPHRESULT + 150;
DPERR_INVALIDGROUP = MAKE_DPHRESULT + 155;
DPERR_NOCAPS = MAKE_DPHRESULT + 160;
DPERR_NOCONNECTION = MAKE_DPHRESULT + 170;
DPERR_NOMEMORY = E_OUTOFMEMORY;
DPERR_OUTOFMEMORY = DPERR_NOMEMORY;
DPERR_NOMESSAGES = MAKE_DPHRESULT + 190;
DPERR_NONAMESERVERFOUND = MAKE_DPHRESULT + 200;
DPERR_NOPLAYERS = MAKE_DPHRESULT + 210;
DPERR_NOSESSIONS = MAKE_DPHRESULT + 220;
DPERR_PENDING = E_PENDING;
DPERR_SENDTOOBIG = MAKE_DPHRESULT + 230;
DPERR_TIMEOUT = MAKE_DPHRESULT + 240;
DPERR_UNAVAILABLE = MAKE_DPHRESULT + 250;
DPERR_UNSUPPORTED = E_NOTIMPL;
DPERR_BUSY = MAKE_DPHRESULT + 270;
DPERR_USERCANCEL = MAKE_DPHRESULT + 280;
DPERR_NOINTERFACE = E_NOINTERFACE;
DPERR_CANNOTCREATESERVER = MAKE_DPHRESULT + 290;
DPERR_PLAYERLOST = MAKE_DPHRESULT + 300;
DPERR_SESSIONLOST = MAKE_DPHRESULT + 310;
DPERR_UNINITIALIZED = MAKE_DPHRESULT + 320;
DPERR_NONEWPLAYERS = MAKE_DPHRESULT + 330;
DPERR_INVALIDPASSWORD = MAKE_DPHRESULT + 340;
DPERR_CONNECTING = MAKE_DPHRESULT + 350;
DPERR_CONNECTIONLOST = MAKE_DPHRESULT + 360;
DPERR_UNKNOWNMESSAGE = MAKE_DPHRESULT + 370;
DPERR_CANCELFAILED = MAKE_DPHRESULT + 380;
DPERR_INVALIDPRIORITY = MAKE_DPHRESULT + 390;
DPERR_NOTHANDLED = MAKE_DPHRESULT + 400;
DPERR_CANCELLED = MAKE_DPHRESULT + 410;
DPERR_ABORTED = MAKE_DPHRESULT + 420;
 
DPERR_BUFFERTOOLARGE = MAKE_DPHRESULT + 1000;
DPERR_CANTCREATEPROCESS = MAKE_DPHRESULT + 1010;
DPERR_APPNOTSTARTED = MAKE_DPHRESULT + 1020;
DPERR_INVALIDINTERFACE = MAKE_DPHRESULT + 1030;
DPERR_NOSERVICEPROVIDER = MAKE_DPHRESULT + 1040;
DPERR_UNKNOWNAPPLICATION = MAKE_DPHRESULT + 1050;
DPERR_NOTLOBBIED = MAKE_DPHRESULT + 1070;
DPERR_SERVICEPROVIDERLOADED = MAKE_DPHRESULT + 1080;
DPERR_ALREADYREGISTERED = MAKE_DPHRESULT + 1090;
DPERR_NOTREGISTERED = MAKE_DPHRESULT + 1100;
 
//
// Security related errors
//
DPERR_AUTHENTICATIONFAILED = MAKE_DPHRESULT + 2000;
DPERR_CANTLOADSSPI = MAKE_DPHRESULT + 2010;
DPERR_ENCRYPTIONFAILED = MAKE_DPHRESULT + 2020;
DPERR_SIGNFAILED = MAKE_DPHRESULT + 2030;
DPERR_CANTLOADSECURITYPACKAGE = MAKE_DPHRESULT + 2040;
DPERR_ENCRYPTIONNOTSUPPORTED = MAKE_DPHRESULT + 2050;
DPERR_CANTLOADCAPI = MAKE_DPHRESULT + 2060;
DPERR_NOTLOGGEDIN = MAKE_DPHRESULT + 2070;
DPERR_LOGONDENIED = MAKE_DPHRESULT + 2080;
 
(****************************************************************************
*
* dplay 1.0 obsolete structures + interfaces
* Included for compatibility only. New apps should
* use IDirectPlay2
*
****************************************************************************)
 
DPOPEN_OPENSESSION = DPOPEN_JOIN;
DPOPEN_CREATESESSION = DPOPEN_CREATE;
 
DPENUMSESSIONS_PREVIOUS = $00000004;
 
DPENUMPLAYERS_PREVIOUS = $00000004;
 
DPSEND_GUARANTEE = DPSEND_GUARANTEED;
DPSEND_TRYONCE = $00000004;
 
DPCAPS_NAMESERVICE = $00000001;
DPCAPS_NAMESERVER = DPCAPS_ISHOST;
DPCAPS_GUARANTEED = $00000004;
 
DPLONGNAMELEN = 52;
DPSHORTNAMELEN = 20;
DPSESSIONNAMELEN = 32;
DPPASSWORDLEN = 16;
DPUSERRESERVED = 16;
 
DPSYS_ADDPLAYER = $0003;
DPSYS_DELETEPLAYER = $0005;
 
DPSYS_DELETEGROUP = $0020;
DPSYS_DELETEPLAYERFROMGRP = $0021;
DPSYS_CONNECT = $484B;
 
type
PDPMsg_AddPlayer = ^TDPMsg_AddPlayer;
TDPMsg_AddPlayer = packed record
dwType: DWORD;
dwPlayerType: DWORD;
DPID: TDPID;
szLongName: array[0..DPLONGNAMELEN - 1] of Char;
szShortName: array[0..DPSHORTNAMELEN - 1] of Char;
dwCurrentPlayers: DWORD;
end;
 
PDPMsg_AddGroup = ^TDPMsg_AddGroup;
TDPMsg_AddGroup = TDPMsg_AddPlayer;
 
PDPMsg_GroupAdd = ^TDPMsg_GroupAdd;
TDPMsg_GroupAdd = packed record
dwType: DWORD;
dpIdGroup: TDPID;
dpIdPlayer: TDPID;
end;
 
PDPMsg_GroupDelete = ^TDPMsg_GroupDelete;
TDPMsg_GroupDelete = TDPMsg_GroupAdd;
 
PDPMsg_DeletePlayer = ^TDPMsg_DeletePlayer;
TDPMsg_DeletePlayer = packed record
dwType: DWORD;
DPID: TDPID;
end;
 
TDPEnumPlayersCallback = function(dpId: TDPID; lpFriendlyName: PChar;
lpFormalName: PChar; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
 
PDPSessionDesc = ^TDPSessionDesc;
TDPSessionDesc = packed record
dwSize: DWORD;
guidSession: TGUID;
dwSession: DWORD;
dwMaxPlayers: DWORD;
dwCurrentPlayers: DWORD;
dwFlags: DWORD;
szSessionName: array[0..DPSESSIONNAMELEN - 1] of Char;
szUserField: array[0..DPUSERRESERVED - 1] of Char;
dwReserved1: DWORD;
szPassword: array[0..DPPASSWORDLEN - 1] of Char;
dwReserved2: DWORD;
dwUser1: DWORD;
dwUser2: DWORD;
dwUser3: DWORD;
dwUser4: DWORD;
end;
 
TDPEnumSessionsCallback = function(const lpDPSessionDesc: TDPSessionDesc;
lpContext: Pointer; var lpdwTimeOut: DWORD; dwFlags: DWORD): BOOL; stdcall;
 
type
IDirectPlay = interface(IUnknown)
['{5454e9a0-db65-11ce-921c-00aa006c4972}']
(*** IDirectPlay methods ***)
function AddPlayerToGroup(pidGroup: TDPID; pidPlayer: TDPID): HResult; stdcall;
function Close: HResult; stdcall;
function CreatePlayer(out lppidID: TDPID; lpPlayerFriendlyName: PChar;
lpPlayerFormalName: PChar; lpEvent: PHandle): HResult; stdcall;
function CreateGroup(out lppidID: TDPID; lpGroupFriendlyName: PChar;
lpGroupFormalName: PChar): HResult; stdcall;
function DeletePlayerFromGroup(pidGroup: TDPID; pidPlayer: TDPID): HResult; stdcall;
function DestroyPlayer(pidID: TDPID): HResult; stdcall;
function DestroyGroup(pidID: TDPID): HResult; stdcall;
function EnableNewPlayers(bEnable: BOOL): HResult; stdcall;
function EnumGroupPlayers(pidGroupPID: TDPID; lpEnumPlayersCallback:
TDPEnumPlayersCallback; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumGroups(dwSessionID: DWORD; lpEnumPlayersCallback:
TDPEnumPlayersCallback; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumPlayers(dwSessionId: DWORD; lpEnumPlayersCallback:
TDPEnumPlayersCallback; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumSessions(var lpSDesc: TDPSessionDesc; dwTimeout: DWORD;
lpEnumSessionsCallback: TDPEnumSessionsCallback; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDPCaps: TDPCaps): HResult; stdcall;
function GetMessageCount(pidID: TDPID; var lpdwCount: DWORD): HResult; stdcall;
function GetPlayerCaps(pidID: TDPID; var lpDPPlayerCaps: TDPCaps): HResult; stdcall;
function GetPlayerName(pidID: TDPID; lpPlayerFriendlyName: PChar;
var lpdwFriendlyNameLength: DWORD; lpPlayerFormalName: PChar;
var lpdwFormalNameLength: DWORD): HResult; stdcall;
function Initialize(const lpGUID: TGUID): HResult; stdcall;
function Open(var lpSDesc: TDPSessionDesc): HResult; stdcall;
function Receive(var lppidFrom, lppidTo: TDPID; dwFlags: DWORD;
var lpvBuffer; var lpdwSize: DWORD): HResult; stdcall;
function SaveSession(lpSessionName: PChar): HResult; stdcall;
function Send(pidFrom: TDPID; pidTo: TDPID; dwFlags: DWORD;
var lpvBuffer; dwBuffSize: DWORD): HResult; stdcall;
function SetPlayerName(pidID: TDPID; lpPlayerFriendlyName: PChar;
lpPlayerFormalName: PChar): HResult; stdcall;
end;
 
(*
* GUIDS used by DirectPlay objects
*)
IID_IDirectPlay2W = IDirectPlay2W;
IID_IDirectPlay2A = IDirectPlay2A;
IID_IDirectPlay2 = IDirectPlay2;
 
IID_IDirectPlay3W = IDirectPlay3W;
IID_IDirectPlay3A = IDirectPlay3A;
IID_IDirectPlay3 = IDirectPlay3;
 
IID_IDirectPlay4W = IDirectPlay4W;
IID_IDirectPlay4A = IDirectPlay4A;
IID_IDirectPlay4 = IDirectPlay4;
 
IID_IDirectPlay = IDirectPlay;
 
var
DirectPlayCreate: function(lpGUID: PGUID; out lplpDP: IDirectPlay;
pUnk: IUnknown): HResult; stdcall;
 
(*==========================================================================;
*
* Copyright (C) 1996-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dplobby.h
* Content: DirectPlayLobby include file
***************************************************************************)
 
(*
* GUIDS used by DirectPlay objects
*)
 
const
(* {2FE8F810-B2A5-11d0-A787-0000F803ABFC} *)
CLSID_DirectPlayLobby: TGUID =
(D1: $2FE8F810; D2: $B2A5; D3: $11D0; D4: ($A7, $87, $00, $00, $F8, $3, $AB, $FC));
 
(****************************************************************************
*
* IDirectPlayLobby Structures
*
* Various structures used to invoke DirectPlayLobby.
*
****************************************************************************)
 
type
(*
* TDPLAppInfo
* Used to hold information about a registered DirectPlay
* application
*)
PDPLAppInfo = ^TDPLAppInfo;
TDPLAppInfo = packed record
dwSize: DWORD; // Size of this structure
guidApplication: TGUID; // GUID of the Application
case Integer of // Pointer to the Application Name
0: (lpszAppName: PCharAW);
1: (lpszAppNameW: PWideChar);
3: (lpszAppNameA: PChar);
end;
 
(*
* TDPCompoundAddressElement
*
* An array of these is passed to CreateCompoundAddresses()
*)
PDPCompoundAddressElement = ^TDPCompoundAddressElement;
TDPCompoundAddressElement = packed record
guidDataType: TGUID;
dwDataSize: DWORD;
lpData: Pointer;
end;
 
(*
* TDPApplicationDesc
* Used to register a DirectPlay application
*)
PDPApplicationDesc = ^TDPApplicationDesc;
TDPApplicationDesc = packed record
dwSize: DWORD;
dwFlags: DWORD;
case Integer of
0: (lpszApplicationName: PCharAW;
guidApplication: TGUID;
lpszFilename: PCharAW;
lpszCommandLine: PCharAW;
lpszPath: PCharAW;
lpszCurrentDirectory: PCharAW;
lpszDescriptionA: PAnsiChar;
lpszDescriptionW: PWideChar);
1: (lpszApplicationNameA: PAnsiChar;
filler1: TGUID;
lpszFilenameA: PAnsiChar;
lpszCommandLineA: PAnsiChar;
lpszPathA: PAnsiChar;
lpszCurrentDirectoryA: PAnsiChar);
2: (lpszApplicationNameW: PWideChar;
filler2: TGUID;
lpszFilenameW: PWideChar;
lpszCommandLineW: PWideChar;
lpszPathW: PWideChar;
lpszCurrentDirectoryW: PWideChar);
end;
 
(*
* TDPApplicationDesc2
* Used to register a DirectPlay application
*)
PDPApplicationDesc2 = ^TDPApplicationDesc2;
TDPApplicationDesc2 = packed record
dwSize: DWORD;
dwFlags: DWORD;
case Integer of
0: (lpszApplicationName: PCharAW;
guidApplication: TGUID;
lpszFilename: PCharAW;
lpszCommandLine: PCharAW;
lpszPath: PCharAW;
lpszCurrentDirectory: PCharAW;
lpszDescriptionA: PAnsiChar;
lpszDescriptionW: PWideChar;
lpszAppLauncherName: PCharAW);
1: (lpszApplicationNameA: PAnsiChar;
filler1: TGUID;
lpszFilenameA: PAnsiChar;
lpszCommandLineA: PAnsiChar;
lpszPathA: PAnsiChar;
lpszCurrentDirectoryA: PAnsiChar;
filler3: PChar;
filler4: PChar;
lpszAppLauncherNameA: PAnsiChar);
2: (lpszApplicationNameW: PWideChar;
filler2: TGUID;
lpszFilenameW: PWideChar;
lpszCommandLineW: PWideChar;
lpszPathW: PWideChar;
lpszCurrentDirectoryW: PWideChar;
filler5: PChar;
filler6: PChar;
lpszAppLauncherNameW: PWideChar);
end;
 
(****************************************************************************
*
* Enumeration Method Callback Prototypes
*
****************************************************************************)
 
(*
* Callback for EnumAddress()
*)
TDPEnumAdressCallback = function(const guidDataType: TGUID;
dwDataSize: DWORD; lpData: Pointer; lpContext: Pointer): BOOL; stdcall;
 
(*
* Callback for EnumAddressTypes()
*)
TDPLEnumAddressTypesCallback = function(const guidDataType: TGUID;
lpContext: Pointer; dwFlags: DWORD): BOOL; stdcall;
 
(*
* Callback for EnumLocalApplications()
*)
TDPLEnumLocalApplicationsCallback = function(const lpAppInfo: TDPLAppInfo;
lpContext: Pointer; dwFlags: DWORD): BOOL; stdcall;
 
(****************************************************************************
*
* IDirectPlayLobby (and IDirectPlayLobbyA) Interface
*
****************************************************************************)
 
type
IDirectPlayLobbyAW = interface(IUnknown)
(*** IDirectPlayLobby methods ***)
function Connect(dwFlags: DWORD; out lplpDP: IDirectPlay2;
pUnk: IUnknown): HResult; stdcall;
function CreateAddress(const guidSP, guidDataType: TGUID; var lpData;
dwDataSize: DWORD; var lpAddress; var lpdwAddressSize: DWORD): HResult; stdcall;
function EnumAddress(lpEnumAddressCallback: TDPEnumAdressCallback;
var lpAddress; dwAddressSize: DWORD; lpContext: Pointer): HResult; stdcall;
function EnumAddressTypes(lpEnumAddressTypeCallback:
TDPLEnumAddressTypesCallback; const guidSP: TGUID; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function EnumLocalApplications(lpEnumLocalAppCallback: TDPLEnumLocalApplicationsCallback;
lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function GetConnectionSettings(dwAppID: DWORD; lpData: PDPLConnection;
var lpdwDataSize: DWORD): HResult; stdcall;
function ReceiveLobbyMessage(dwFlags: DWORD; dwAppID: DWORD;
var lpdwMessageFlags: DWORD; lpData: Pointer; var lpdwDataSize: DWORD): HResult; stdcall;
function RunApplication(dwFlags: DWORD; var lpdwAppId: DWORD;
const lpConn: TDPLConnection; hReceiveEvent: THandle): HResult; stdcall;
function SendLobbyMessage(dwFlags: DWORD; dwAppID: DWORD; const lpData;
dwDataSize: DWORD): HResult; stdcall;
function SetConnectionSettings(dwFlags: DWORD; dwAppID: DWORD;
var lpConn: TDPLConnection): HResult; stdcall;
function SetLobbyMessageEvent(dwFlags: DWORD; dwAppID: DWORD;
hReceiveEvent: THandle): HResult; stdcall;
end;
 
IDirectPlayLobbyW = interface(IDirectPlayLobbyAW)
['{AF465C71-9588-11CF-A020-00AA006157AC}']
end;
IDirectPlayLobbyA = interface(IDirectPlayLobbyAW)
['{26C66A70-B367-11cf-A024-00AA006157AC}']
end;
 
{$IFDEF UNICODE}
IDirectPlayLobby = IDirectPlayLobbyW;
{$ELSE}
IDirectPlayLobby = IDirectPlayLobbyA;
{$ENDIF}
 
(****************************************************************************
*
* IDirectPlayLobby2 (and IDirectPlayLobby2A) Interface
*
****************************************************************************)
 
IDirectPlayLobby2AW = interface(IDirectPlayLobbyAW)
(*** IDirectPlayLobby2 methods ***)
function CreateCompoundAddress(const lpElements: TDPCompoundAddressElement;
dwElementCount: DWORD; lpAddress: Pointer; var lpdwAddressSize: DWORD): HResult; stdcall;
end;
 
IDirectPlayLobby2W = interface(IDirectPlayLobby2AW)
['{0194C220-A303-11D0-9C4F-00A0C905425E}']
end;
IDirectPlayLobby2A = interface(IDirectPlayLobby2AW)
['{1BB4AF80-A303-11d0-9C4F-00A0C905425E}']
end;
 
{$IFDEF UNICODE}
IDirectPlayLobby2 = IDirectPlayLobby2W;
{$ELSE}
IDirectPlayLobby2 = IDirectPlayLobby2A;
{$ENDIF}
 
(****************************************************************************
*
* IDirectPlayLobby3 (and IDirectPlayLobby3A) Interface
*
****************************************************************************)
 
IDirectPlayLobby3AW = interface(IDirectPlayLobby2AW)
(*** IDirectPlayLobby3 methods ***)
function ConnectEx(dwFlags: DWORD; const riid: TGUID;
out lplpDP; pUnk: IUnknown): HResult; stdcall;
function RegisterApplication(dwFlags: DWORD;
var lpAppDesc: TDPApplicationDesc): HResult; stdcall;
function UnregisterApplication(dwFlags: DWORD;
const guidApplication: TGUID): HResult; stdcall;
function WaitForConnectionSettings(dwFlags: DWORD): HResult; stdcall;
end;
 
IDirectPlayLobby3W = interface(IDirectPlayLobby3AW)
['{2DB72490-652C-11d1-A7A8-0000F803ABFC}']
end;
IDirectPlayLobby3A = interface(IDirectPlayLobby3AW)
['{2DB72491-652C-11d1-A7A8-0000F803ABFC}']
end;
 
{$IFDEF UNICODE}
IDirectPlayLobby3 = IDirectPlayLobby3W;
{$ELSE}
IDirectPlayLobby3 = IDirectPlayLobby3A;
{$ENDIF}
 
IID_IDirectPlayLobbyW = IDirectPlayLobbyW;
IID_IDirectPlayLobbyA = IDirectPlayLobbyA;
IID_IDirectPlayLobby = IDirectPlayLobby;
 
IID_IDirectPlayLobby2W = IDirectPlayLobby2W;
IID_IDirectPlayLobby2A = IDirectPlayLobby2A;
IID_IDirectPlayLobby2 = IDirectPlayLobby2;
 
IID_IDirectPlayLobby3W = IDirectPlayLobby3W;
IID_IDirectPlayLobby3A = IDirectPlayLobby3A;
IID_IDirectPlayLobby3 = IDirectPlayLobby3;
 
(****************************************************************************
*
* DirectPlayLobby API Prototypes
*
****************************************************************************)
 
var
DirectPlayLobbyCreateW: function(lpguidSP: PGUID; out lplpDPL:
IDirectPlayLobbyW; lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HResult; stdcall;
DirectPlayLobbyCreateA: function(lpguidSP: PGUID; out lplpDPL:
IDirectPlayLobbyA; lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HResult; stdcall;
DirectPlayLobbyCreate: function(lpguidSP: PGUID; out lplpDPL:
IDirectPlayLobby; lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HResult; stdcall;
 
const
(****************************************************************************
*
* DirectPlayLobby Flags
*
****************************************************************************)
 
(*
* This flag is used by IDirectPlayLobby.WaitForConnectionSettings to
* cancel a current wait that is in progress.
*)
DPLWAIT_CANCEL = $00000001;
 
(*
* This is a message flag used by ReceiveLobbyMessage. It can be
* returned in the dwMessageFlags parameter to indicate a message from
* the system.
*)
DPLMSG_SYSTEM = $00000001;
 
(*
* This is a message flag used by ReceiveLobbyMessage and SendLobbyMessage.
* It is used to indicate that the message is a standard lobby message.
* TDPLMsg_SetProperty, TDPLMsg_SetPropertyResponse, TDPLMsg_GetProperty,
* TDPLMsg_GetPropertyResponse
*)
DPLMSG_STANDARD = $00000002;
 
type
(****************************************************************************
*
* DirectPlayLobby messages and message data structures
*
* All system messages have a dwMessageFlags value of DPLMSG_SYSTEM returned
* from a call to ReceiveLobbyMessage.
*
* All standard messages have a dwMessageFlags value of DPLMSG_STANDARD returned
* from a call to ReceiveLobbyMessage.
*
****************************************************************************)
 
(*
* TDPLMsg_Generic
* Generic message structure used to identify the message type.
*)
PDPLMsg_Generic = ^TDPLMsg_Generic;
TDPLMsg_Generic = packed record
dwType: DWORD; // Message type
end;
 
(*
* TDPLMsg_SystemMessage
* Generic message format for all system messages --
* DPLSYS_CONNECTIONSETTINGSREAD, DPLSYS_DPLYCONNECTSUCCEEDED,
* DPLSYS_DPLAYCONNECTFAILED, DPLSYS_APPTERMINATED, DPLSYS_NEWCONNECTIONSETTINGS
*)
PDPLMsg_SystemMessage = ^TDPLMsg_SystemMessage;
TDPLMsg_SystemMessage = packed record
dwType: DWORD; // Message type
guidInstance: TGUID; // Instance GUID of the dplay session the message corresponds to
end;
 
(*
* TDPLMsg_SetProperty
* Standard message sent by an application to a lobby to set a
* property
*)
PDPLMsg_SetProperty = ^TDPLMsg_SetProperty;
TDPLMsg_SetProperty = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID (DPL_NOCONFIRMATION if no confirmation desired)
guidPlayer: TGUID; // Player GUID
guidPropertyTag: TGUID; // Property GUID
dwDataSize: DWORD; // Size of data
dwPropertyData: array[0..0] of DWORD; // Buffer containing data
end;
 
const
DPL_NOCONFIRMATION = 0;
 
type
(*
* TDPLMsg_SetPropertyResponse
* Standard message returned by a lobby to confirm a
* TDPLMsg_SetProperty message.
*)
PDPLMsg_SetPropertyResponse = ^TDPLMsg_SetPropertyResponse;
TDPLMsg_SetPropertyResponse = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID
guidPlayer: TGUID; // Player GUID
guidPropertyTag: TGUID; // Property GUID
hr: HResult; // Return Code
end;
 
(*
* TDPLMsg_GetProperty
* Standard message sent by an application to a lobby to request
* the current value of a property
*)
PDPLMsg_GetProperty = ^TDPLMsg_GetProperty;
TDPLMsg_GetProperty = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID
guidPlayer: TGUID; // Player GUID
guidPropertyTag: TGUID; // Property GUID
end;
LPDPLMSG_GETPROPERTY = ^TDPLMsg_GetProperty;
 
(*
* TDPLMsg_GetPropertyResponse
* Standard message returned by a lobby in response to a
* TDPLMsg_GetProperty message.
*)
PDPLMsg_GetPropertyResponse = ^TDPLMsg_GetPropertyResponse;
TDPLMsg_GetPropertyResponse = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID
guidPlayer: TGUID; // Player GUID
guidPropertyTag: TGUID; // Property GUID
hr: HResult; // Return Code
dwDataSize: DWORD; // Size of data
dwPropertyData: array[0..0] of DWORD; // Buffer containing data
end;
 
(*
* TDPLMsg_NewSessionHost
* Standard message returned by a lobby in response to a
* the session host migrating to a new client
*)
PDPLMsg_NewSessionHost = ^TDPLMsg_NewSessionHost;
TDPLMsg_NewSessionHost = packed record
dwType: DWORD; // Message type
guidInstance: TGUID; // Property GUID
end;
 
const
(******************************************
*
* DirectPlay Lobby message dwType values
*
*****************************************)
 
(*
* The application has read the connection settings.
* It is now O.K. for the lobby client to release
* its IDirectPlayLobby interface.
*)
DPLSYS_CONNECTIONSETTINGSREAD = $00000001;
 
(*
* The application's call to DirectPlayConnect failed
*)
DPLSYS_DPLAYCONNECTFAILED = $00000002;
 
(*
* The application has created a DirectPlay session.
*)
DPLSYS_DPLAYCONNECTSUCCEEDED = $00000003;
 
(*
* The application has terminated.
*)
DPLSYS_APPTERMINATED = $00000004;
 
(*
* The message is a TDPLMsg_SetProperty message.
*)
DPLSYS_SETPROPERTY = $00000005;
 
(*
* The message is a TDPLMsg_SetPropertyResponse message.
*)
DPLSYS_SETPROPERTYRESPONSE = $00000006;
 
(*
* The message is a TDPLMsg_GetProperty message.
*)
DPLSYS_GETPROPERTY = $00000007;
 
(*
* The message is a TDPLMsg_GetPropertyResponse message.
*)
DPLSYS_GETPROPERTYRESPONSE = $00000008;
 
(*
* The message is a TDPLMsg_NewSessionHost message.
*)
DPLSYS_NEWSESSIONHOST = $00000009;
 
(*
* New connection settings are available.
*)
DPLSYS_NEWCONNECTIONSETTINGS = $0000000A;
 
(****************************************************************************
*
* DirectPlay defined property GUIDs and associated data structures
*
****************************************************************************)
 
(*
* DPLPROPERTY_MessagesSupported
*
* Request whether the lobby supports standard. Lobby with respond with either
* TRUE or FALSE or may not respond at all.
*
* Property data is a single BOOL with TRUE or FALSE
*)
// {762CCDA1-D916-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_MessagesSupported: TGUID =
(D1: $762CCDA1; D2: $D916; D3: $11D0; D4: ($BA, $39, $00, $C0, $4F, $D7, $ED, $67));
 
(*
* DPLPROPERTY_LobbyGuid
*
* Request the GUID that identifies the lobby software that the application
* is communicating with.
*
* Property data is a single GUID.
*)
// {F56920A0-D218-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_LobbyGuid: TGUID =
(D1: $F56920A0; D2: $D218; D3: $11D0; D4: ($BA, $39, $00, $C0, $4F, $D7, $ED, $67));
 
(*
* DPLPROPERTY_PlayerGuid
*
* Request the GUID that identifies the player on this machine for sending
* property data back to the lobby.
*
* Property data is the DPLDATA_PLAYERDATA structure
*)
// {B4319322-D20D-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_PlayerGuid: TGUID =
(D1: $B4319322; D2: $D20D; D3: $11D0; D4: ($BA, $39, $00, $C0, $4F, $D7, $ED, $67));
 
type
(*
* TDPLData_PlayerGUID
*
* Data structure to hold the GUID of the player and player creation flags
* from the lobby.
*)
PDPLData_PlayerGUID = ^TDPLData_PlayerGUID;
TDPLData_PlayerGUID = packed record
guidPlayer: TGUID;
dwPlayerFlags: DWORD;
end;
 
const
(*
* DPLPROPERTY_PlayerScore
*
* Used to send an array of long integers to the lobby indicating the
* score of a player.
*
* Property data is the TDPLData_PlayerScore structure.
*)
// {48784000-D219-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_PlayerScore: TGUID =
(D1: $48784000; D2: $D219; D3: $11D0; D4: ($BA, $39, $00, $C0, $4F, $D7, $ED, $67));
 
type
(*
* TDPLData_PlayerScore
*
* Data structure to hold an array of long integers representing a player score.
* Application must allocate enough memory to hold all the scores.
*)
PDPLData_PlayerScore = ^TDPLData_PlayerScore;
TDPLData_PlayerScore = packed record
dwScoreCount: DWORD;
Score: array[0..0] of Longint;
end;
 
(****************************************************************************
*
* DirectPlay Address ID's
*
****************************************************************************)
 
(* DirectPlay Address
*
* A DirectPlay address consists of multiple chunks of data, each tagged
* with a GUID signifying the type of data in the chunk. The chunk also
* has a length so that unknown chunk types can be skipped.
*
* The EnumAddress() function is used to parse these address data chunks.
*)
 
(*
* TDPAddress
*
* Header for block of address data elements
*)
PDPAddress = ^TDPAddress;
TDPAddress = packed record
guidDataType: TGUID;
dwDataSize: DWORD;
end;
 
const
(*
* DPAID_TotalSize
*
* Chunk is a DWORD containing size of entire TDPAddress structure
*)
 
// {1318F560-912C-11d0-9DAA-00A0C90A43CB}
DPAID_TotalSize: TGUID =
(D1: $1318F560; D2: $912C; D3: $11D0; D4: ($9D, $AA, $00, $A0, $C9, $A, $43, $CB));
 
(*
* DPAID_ServiceProvider
*
* Chunk is a GUID describing the service provider that created the chunk.
* All addresses must contain this chunk.
*)
 
// {07D916C0-E0AF-11cf-9C4E-00A0C905425E}
DPAID_ServiceProvider: TGUID =
(D1: $7D916C0; D2: $E0AF; D3: $11CF; D4: ($9C, $4E, $00, $A0, $C9, $5, $42, $5E));
 
(*
* DPAID_LobbyProvider
*
* Chunk is a GUID describing the lobby provider that created the chunk.
* All addresses must contain this chunk.
*)
 
// {59B95640-9667-11d0-A77D-0000F803ABFC}
DPAID_LobbyProvider: TGUID =
(D1: $59B95640; D2: $9667; D3: $11D0; D4: ($A7, $7D, $00, $00, $F8, $3, $AB, $FC));
 
(*
* DPAID_Phone and DPAID_PhoneW
*
* Chunk is a string containing a phone number (i.e. "1-800-555-1212")
* in ANSI or UNICODE format
*)
 
// {78EC89A0-E0AF-11cf-9C4E-00A0C905425E}
DPAID_Phone: TGUID =
(D1: $78EC89A0; D2: $E0AF; D3: $11CF; D4: ($9C, $4E, $00, $A0, $C9, $5, $42, $5E));
 
// {BA5A7A70-9DBF-11d0-9CC1-00A0C905425E}
DPAID_PhoneW: TGUID =
(D1: $BA5A7A70; D2: $9DBF; D3: $11D0; D4: ($9C, $C1, $00, $A0, $C9, $5, $42, $5E));
 
(*
* DPAID_Modem and DPAID_ModemW
*
* Chunk is a string containing a modem name registered with TAPI
* in ANSI or UNICODE format
*)
 
// {F6DCC200-A2FE-11d0-9C4F-00A0C905425E}
DPAID_Modem: TGUID =
(D1: $F6DCC200; D2: $A2FE; D3: $11D0; D4: ($9C, $4F, $00, $A0, $C9, $5, $42, $5E));
 
// {01FD92E0-A2FF-11d0-9C4F-00A0C905425E}
DPAID_ModemW: TGUID =
(D1: $1FD92E0; D2: $A2FF; D3: $11D0; D4: ($9C, $4F, $00, $A0, $C9, $5, $42, $5E));
 
(*
* DPAID_Inet and DPAID_InetW
*
* Chunk is a string containing a TCP/IP host name or an IP address
* (i.e. "dplay.microsoft.com" or "137.55.100.173") in ANSI or UNICODE format
*)
 
// {C4A54DA0-E0AF-11cf-9C4E-00A0C905425E}
DPAID_INet: TGUID =
(D1: $C4A54DA0; D2: $E0AF; D3: $11CF; D4: ($9C, $4E, $00, $A0, $C9, $5, $42, $5E));
 
// {E63232A0-9DBF-11d0-9CC1-00A0C905425E}
DPAID_INetW: TGUID =
(D1: $E63232A0; D2: $9DBF; D3: $11D0; D4: ($9C, $C1, $00, $A0, $C9, $5, $42, $5E));
 
(*
* DPAID_InetPort
*
* Chunk is the port number used for creating the apps TCP and UDP sockets.
* WORD value (i.e. 47624)
*)
 
// {E4524541-8EA5-11d1-8A96-006097B01411}
DPAID_INetPort: TGUID =
(D1: $E4524541; D2: $8EA5; D3: $11D1; D4: ($8A, $96, $00, $60, $97, $B0, $14, $11));
 
//@@BEGIN_MSINTERNAL
(*
* DPAID_MaxMessageSize
*
* Tells DPLAY what the maximum allowed message size is. Enables SPs to
* combat Denial of Service attacks
*)
 
// this terrible hack is needed so the SP can work with the Elmer build.
// it can be removed when the MSINTERNAL stuff is removed
{$DEFINE MAXMSGSIZEGUIDDEFINED}
 
// {F5D09980-F0C4-11d1-8326-006097B01411}
DPAID_MaxMessageSize: TGUID =
(D1: $F5D09980; D2: $F0C4; D3: $11D1; D4: ($83, $26, $00, $60, $97, $B0, $14, $11));
//@@END_MSINTERNAL
 
(*
* TDPComPortAddress
*
* Used to specify com port settings. The constants that define baud rate,
* stop bits and parity are defined in WINBASE.H. The constants for flow
* control are given below.
*)
 
DPCPA_NOFLOW = 0; // no flow control
DPCPA_XONXOFFFLOW = 1; // software flow control
DPCPA_RTSFLOW = 2; // hardware flow control with RTS
DPCPA_DTRFLOW = 3; // hardware flow control with DTR
DPCPA_RTSDTRFLOW = 4; // hardware flow control with RTS and DTR
 
type
PDPComPortAddress = ^TDPComPortAddress;
TDPComPortAddress = packed record
dwComPort: DWORD; // COM port to use (1-4)
dwBaudRate: DWORD; // baud rate (100-256k)
dwStopBits: DWORD; // no. stop bits (1-2)
dwParity: DWORD; // parity (none, odd, even, mark)
dwFlowControl: DWORD; // flow control (none, xon/xoff, rts, dtr)
end;
 
const
(*
* DPAID_ComPort
*
* Chunk contains a TDPComPortAddress structure defining the serial port.
*)
 
// {F2F0CE00-E0AF-11cf-9C4E-00A0C905425E}
DPAID_ComPort: TGUID =
(D1: $F2F0CE00; D2: $E0AF; D3: $11CF; D4: ($9C, $4E, $00, $A0, $C9, $5, $42, $5E));
 
(****************************************************************************
*
* dplobby 1.0 obsolete definitions
* Included for compatibility only.
*
****************************************************************************)
 
DPLAD_SYSTEM = DPLMSG_SYSTEM;
 
implementation
 
(*==========================================================================;
*
* Copyright (C) 1994-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dplay.h
* Content: DirectPlay include file
*
***************************************************************************)
 
function DPErrorString(Value: HResult): string;
begin
case Value of
CLASS_E_NOAGGREGATION: Result := 'A non-NULL value was passed for the pUnkOuter parameter in DirectPlayCreate, DirectPlayLobbyCreate, or IDirectPlayLobby2::Connect.';
DPERR_ACCESSDENIED: Result := 'The session is full or an incorrect password was supplied.';
DPERR_ACTIVEPLAYERS: Result := 'The requested operation cannot be performed because there are existing active players.';
DPERR_ALREADYINITIALIZED: Result := 'This object is already initialized.';
DPERR_APPNOTSTARTED: Result := 'The application has not been started yet.';
DPERR_AUTHENTICATIONFAILED: Result := 'The password or credentials supplied could not be authenticated.';
DPERR_BUFFERTOOLARGE: Result := 'The data buffer is too large to store.';
DPERR_BUSY: Result := 'A message cannot be sent because the transmission medium is busy.';
DPERR_BUFFERTOOSMALL: Result := 'The supplied buffer is not large enough to contain the requested data.';
DPERR_CANTADDPLAYER: Result := 'The player cannot be added to the session.';
DPERR_CANTCREATEGROUP: Result := 'A new group cannot be created.';
DPERR_CANTCREATEPLAYER: Result := 'A new player cannot be created.';
DPERR_CANTCREATEPROCESS: Result := 'Cannot start the application.';
DPERR_CANTCREATESESSION: Result := 'A new session cannot be created.';
DPERR_CANTLOADCAPI: Result := 'No credentials were supplied and the CryptoAPI package (CAPI) to use for cryptography services cannot be loaded.';
DPERR_CANTLOADSECURITYPACKAGE: Result := 'The software security package cannot be loaded.';
DPERR_CANTLOADSSPI: Result := 'No credentials were supplied and the software security package (SSPI) that will prompt for credentials cannot be loaded.';
DPERR_CAPSNOTAVAILABLEYET: Result := 'The capabilities of the DirectPlay object have not been determined yet. This error will occur if the DirectPlay object is implemented on a connectivity solution that requires polling to determine available bandwidth and latency.';
DPERR_CONNECTING: Result := 'The method is in the process of connecting to the network. The application should keep calling the method until it returns DP_OK, indicating successful completion, or it returns a different error.';
DPERR_ENCRYPTIONFAILED: Result := 'The requested information could not be digitally encrypted. Encryption is used for message privacy. This error is only relevant in a secure session.';
DPERR_EXCEPTION: Result := 'An exception occurred when processing the request.';
DPERR_GENERIC: Result := 'An undefined error condition occurred.';
// DPERR_INVALIDCREDENTIALS: Result := 'The credentials supplied (as to IDirectPlay3::SecureOpen) were not valid.';
DPERR_INVALIDFLAGS: Result := 'The flags passed to this method are invalid.';
DPERR_INVALIDGROUP: Result := 'The group ID is not recognized as a valid group ID for this game session.';
DPERR_INVALIDINTERFACE: Result := 'The interface parameter is invalid.';
DPERR_INVALIDOBJECT: Result := 'The DirectPlay object pointer is invalid.';
DPERR_INVALIDPARAMS: Result := 'One or more of the parameters passed to the method are invalid.';
DPERR_INVALIDPASSWORD: Result := 'An invalid password was supplied when attempting to join a session that requires a password.';
DPERR_INVALIDPLAYER: Result := 'The player ID is not recognized as a valid player ID for this game session.';
DPERR_LOGONDENIED: Result := 'The session could not be opened because credentials are required and either no credentials were supplied or the credentials were invalid.';
DPERR_NOCAPS: Result := 'The communication link that DirectPlay is attempting to use is not capable of this function.';
DPERR_NOCONNECTION: Result := 'No communication link was established.';
DPERR_NOINTERFACE: Result := 'The interface is not supported.';
DPERR_NOMESSAGES: Result := 'There are no messages in the receive queue.';
DPERR_NONAMESERVERFOUND: Result := 'No name server (host) could be found or created. A host must exist to create a player.';
DPERR_NONEWPLAYERS: Result := 'The session is not accepting any new players.';
DPERR_NOPLAYERS: Result := 'There are no active players in the session.';
DPERR_NOSESSIONS: Result := 'There are no existing sessions for this game.';
DPERR_NOTLOBBIED: Result := 'Returned by the IDirectPlayLobby2::Connect method if the application was not started by using the IDirectPlayLobby2::RunApplication method or if there is no DPLCONNECTION structure currently initialized for this DirectPlayLobby object.';
DPERR_NOTLOGGEDIN: Result := 'An action cannot be performed because a player or client application is not logged in. Returned by the IDirectPlay3::Send method when the client application tries to send a secure message without being logged in.';
DPERR_OUTOFMEMORY: Result := 'There is insufficient memory to perform the requested operation.';
DPERR_PLAYERLOST: Result := 'A player has lost the connection to the session.';
DPERR_SENDTOOBIG: Result := 'The message being sent by the IDirectPlay3::Send method is too large.';
DPERR_SESSIONLOST: Result := 'The connection to the session has been lost.';
DPERR_SIGNFAILED: Result := 'The requested information could not be digitally signed. Digital signatures are used to establish the authenticity of messages.';
DPERR_TIMEOUT: Result := 'The operation could not be completed in the specified time.';
DPERR_UNAVAILABLE: Result := 'The requested function is not available at this time.';
DPERR_UNINITIALIZED: Result := 'The requested object has not been initialized.';
DPERR_UNKNOWNAPPLICATION: Result := 'An unknown application was specified.';
DPERR_UNSUPPORTED: Result := 'The function is not available in this implementation. Returned from IDirectPlay3::GetGroupConnectionSettings and IDirectPlay3::SetGroupConnectionSettings if they are called from a session that is not a lobby session.';
DPERR_USERCANCEL: Result := 'Can be returned in two ways. 1) The user canceled the connection process during a call to the IDirectPlay3::Open method. 2) The user clicked Cancel in one of the DirectPlay service provider dialog boxes during a call to IDirectPlay3::EnumSessions.';
else Result := 'Unrecognized Error';
end;
end;
 
function IsNTandDelphiRunning : boolean;
var
OSVersion : TOSVersionInfo;
AppName : array[0..255] of char;
begin
OSVersion.dwOsVersionInfoSize := sizeof(OSVersion);
GetVersionEx(OSVersion);
// Not running in NT or program is not Delphi itself ?
AppName[0] := #0;
lstrcat(AppName, PChar(ParamStr(0))); // ParamStr(0) = Application.ExeName
{$IFDEF UNICODE}
CharUpperBuff(AppName, High(AppName) + 1);
{$ELSE}
CharUpperBuff(AppName, SizeOf(AppName));
{$ENDIF}
result := ( (OSVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) and
(Pos('DELPHI32.EXE', AppName) = Length(AppName) - Length('DELPHI32.EXE') + 1) );
end;
 
initialization
begin
if not IsNTandDelphiRunning then
begin
DPlayDLL := LoadLibrary('DPlayX.dll');
 
DirectPlayEnumerateA := GetProcAddress(DPlayDLL, 'DirectPlayEnumerateA');
DirectPlayEnumerateW := GetProcAddress(DPlayDLL, 'DirectPlayEnumerateW');
{$IFDEF UNICODE}
DirectPlayEnumerate := DirectPlayEnumerateW;
{$ELSE}
DirectPlayEnumerate := DirectPlayEnumerateA;
{$ENDIF}
 
DirectPlayCreate := GetProcAddress(DPlayDLL, 'DirectPlayCreate');
 
// File: dplay.h
 
DirectPlayLobbyCreateW := GetProcAddress(DPlayDLL, 'DirectPlayLobbyCreateW');
DirectPlayLobbyCreateA := GetProcAddress(DPlayDLL, 'DirectPlayLobbyCreateA');
{$IFDEF UNICODE}
DirectPlayLobbyCreate := DirectPlayLobbyCreateW;
{$ELSE}
DirectPlayLobbyCreate := DirectPlayLobbyCreateA;
{$ENDIF}
 
end;
end;
 
finalization
begin
if DPlayDLL <> 0 then FreeLibrary(DPlayDLL);
end;
 
end.
/VCL_DELPHIX_D6/DirectX.pas
25,118 → 25,111
* URL : http://www.infosakyu.ne.jp/~kazuya-y/index.html
*
***************************************************************************)
{
(c)2004 Jaro Benes Recompilation with Erik Unger's headers
 
unit DirectX;
Join in order:
1) DirectDraw
2) Direct3D
3) Direct3DRM
4) DirectInput
5) DirectPlay
6) DirectSetup
7) DirectSound
8) DirectMusic
}
Unit DirectX;
 
interface
Interface
 
{$Z4}
{$A+}
{$WEAKPACKAGEUNIT}
{Delphi version marks}
 
{$IFNDEF DirectX3}
{$IFNDEF DirectX5}
{$IFNDEF DirectX6}
{$IFNDEF DirectX7}
{$DEFINE DirectX7}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$I DelphiXcfg.inc}
 
{$IFDEF DirectX3}
{$UNDEF DirectX5}
{$UNDEF DirectX6}
{$UNDEF DirectX7}
{$DEFINE SupportDirectX3}
{$ENDIF}
{$MINENUMSIZE 4}
{$ALIGN ON}
 
{$IFDEF DirectX5}
{$UNDEF DirectX3}
{$UNDEF DirectX6}
{$UNDEF DirectX7}
{$DEFINE SupportDirectX3}
{$DEFINE SupportDirectX5}
{$ENDIF}
 
{$IFDEF DirectX6}
{$UNDEF DirectX3}
{$UNDEF DirectX5}
{$UNDEF DirectX7}
{$DEFINE SupportDirectX3}
{$DEFINE SupportDirectX5}
{$DEFINE SupportDirectX6}
{$ENDIF}
 
{$IFDEF DirectX7}
{$UNDEF DirectX3}
{$UNDEF DirectX5}
{$UNDEF DirectX6}
{$DEFINE SupportDirectX3}
{$DEFINE SupportDirectX5}
{$DEFINE SupportDirectX6}
{$DEFINE SupportDirectX7}
{$ENDIF}
 
uses Windows, MMSystem, ActiveX;
 
const
{$IFDEF DirectX3}
DirectXUnitVersion = 3;
{$ENDIF}{$IFDEF DirectX5}
DirectXUnitVersion = 5;
{$ENDIF}{$IFDEF DirectX6}
DirectXUnitVersion = 6;
{$ENDIF}{$IFDEF DirectX7}
DirectXUnitVersion = 7;
{$ENDIF}
 
uses
Windows, MMSystem;
//DirectDraw file
(*==========================================================================;
*
* Copyright (C) Microsoft Corporation. All Rights Reserved.
* Copyright (C) 1994-1997 Microsoft Corporation. All Rights Reserved.
*
* File: ddraw.h
* Content: DirectDraw include file
* Files: ddraw.h dvp.h
* Content: DirectDraw and DirectDrawVideoPort include files
*
* DirectX 7.0 Delphi adaptation by Erik Unger
*
* Modified: 10-Sep-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
*
***************************************************************************)
 
{ FOURCC codes for DX compressed-texture pixel formats }
var
DDrawDLL : HMODULE = 0;
 
const
FOURCC_DXT1 = Ord('D') + Ord('X') shl 8 + Ord('T') shl 16 + Ord('1') shl 24;
FOURCC_DXT2 = Ord('D') + Ord('X') shl 8 + Ord('T') shl 16 + Ord('2') shl 24;
FOURCC_DXT3 = Ord('D') + Ord('X') shl 8 + Ord('T') shl 16 + Ord('3') shl 24;
FOURCC_DXT4 = Ord('D') + Ord('X') shl 8 + Ord('T') shl 16 + Ord('4') shl 24;
FOURCC_DXT5 = Ord('D') + Ord('X') shl 8 + Ord('T') shl 16 + Ord('5') shl 24;
function DDErrorString(Value: HResult) : string;
 
{ GUIDS used by DirectDraw objects }
function MAKEFOURCC(ch0, ch1, ch2, ch3: Char) : DWORD;
 
(*
* FOURCC codes for DX compressed-texture pixel formats
*)
const
FOURCC_DXT1 = 'DXT1';
FOURCC_DXT2 = 'DXT2';
FOURCC_DXT3 = 'DXT3';
FOURCC_DXT4 = 'DXT4';
FOURCC_DXT5 = 'DXT5';
 
(*
* GUIDS used by DirectDraw objects
*)
const
CLSID_DirectDraw: TGUID = '{D7B70EE0-4340-11CF-B063-0020AFC2CD35}';
CLSID_DirectDraw7: TGUID = '{3C305196-50DB-11D3-9CFE-00C04FD930C5}';
CLSID_DirectDrawClipper: TGUID = '{593817A0-7DB3-11CF-A2DE-00AA00B93356}';
IID_IDirectDraw: TGUID = '{6C14DB80-A733-11CE-A521-0020AF0BE560}';
IID_IDirectDraw2: TGUID = '{B3A6F3E0-2B43-11CF-A2DE-00AA00B93356}';
IID_IDirectDraw4: TGUID = '{9C59509A-39BD-11D1-8C4A-00C04FD930C5}';
IID_IDirectDraw7: TGUID = '{15E65EC0-3B9C-11D2-B92F-00609797EA5B}';
IID_IDirectDrawSurface: TGUID = '{6C14DB81-A733-11CE-A521-0020AF0BE560}';
IID_IDirectDrawSurface2: TGUID = '{57805885-6EEC-11CF-9441-A82303C10E27}';
IID_IDirectDrawSurface3: TGUID = '{DA044E00-69B2-11D0-A1D5-00AA00B8DFBB}';
IID_IDirectDrawSurface4: TGUID = '{0B2B8630-AD35-11D0-8EA6-00609797EA5B}';
IID_IDirectDrawSurface7: TGUID = '{06675A80-3B9B-11D2-B92F-00609797EA5B}';
IID_IDirectDrawPalette: TGUID = '{6C14DB84-A733-11CE-A521-0020AF0BE560}';
IID_IDirectDrawClipper: TGUID = '{6C14DB85-A733-11CE-A521-0020AF0BE560}';
IID_IDirectDrawColorControl: TGUID = '{4B9F0EE0-0D7E-11D0-9B06-00A0C903A3B8}';
IID_IDirectDrawGammaControl: TGUID = '{69C11C3E-B46B-11D1-AD7A-00C04FC29B4E}';
CLSID_DirectDraw7: TGUID = '{3c305196-50db-11d3-9cfe-00c04fd930c5}';
CLSID_DirectDrawClipper: TGUID = '{593817A0-7DB3-11CF-A2DE-00AA00b93356}';
 
const
DD_ROP_SPACE = 256 div 32; // space required to store ROP array
DD_ROP_SPACE = (256 div 32); // space required to store ROP array
 
MAX_DDDEVICEID_STRING = 512;
 
{ DirectDraw Structures }
(*
* Flags for the IDirectDraw4::GetDeviceIdentifier method
*)
 
(*
* This flag causes GetDeviceIdentifier to return information about the host (typically 2D) adapter in a system equipped
* with a stacked secondary 3D adapter. Such an adapter appears to the application as if it were part of the
* host adapter, but is typically physcially located on a separate card. The stacked secondary's information is
* returned when GetDeviceIdentifier's dwFlags field is zero, since this most accurately reflects the qualities
* of the DirectDraw object involved.
*)
DDGDI_GETHOSTIDENTIFIER = $00000001;
 
(*============================================================================
*
* DirectDraw Structures
*
* Various structures used to invoke DirectDraw.
*
*==========================================================================*)
 
var
NilGUID : TGUID{$IfNDef VER6UP} absolute 0{$EndIf};
 
type
TRefGUID = packed record
case integer of
1: (guid : PGUID);
2: (dwFlags : DWORD);
end;
 
IDirectDraw = interface;
IDirectDraw2 = interface;
IDirectDraw4 = interface;
146,41 → 139,40
IDirectDrawSurface3 = interface;
IDirectDrawSurface4 = interface;
IDirectDrawSurface7 = interface;
 
IDirectDrawPalette = interface;
IDirectDrawClipper = interface;
IDirectDrawColorControl = interface;
IDirectDrawGammaControl = interface;
 
{ TDDARGB structure }
 
(*
* Generic pixel format with 8-bit RGB and alpha components
*)
PDDARGB = ^TDDARGB;
TDDARGB = record
Blue: Byte;
Green: Byte;
Red: Byte;
Alpha: Byte;
TDDARGB = packed record
blue: BYTE;
green: BYTE;
red: BYTE;
alpha: BYTE;
end;
 
DDARGB = TDDARGB;
LPDDARGB = PDDARGB;
 
{ TDDRGBA structure }
 
(*
* This version of the structure remains for backwards source compatibility.
* The DDARGB structure is the one that should be used for all DirectDraw APIs.
*)
PDDRGBA = ^TDDRGBA;
TDDRGBA = record
Red: Byte;
Green: Byte;
Blue: Byte;
Alpha: Byte;
TDDRGBA = packed record
red : BYTE;
green : BYTE;
blue : BYTE;
alpha : BYTE;
end;
 
DDRGBA = TDDRGBA;
LPDDRGBA = PDDRGBA;
 
{ TDDColorKey structure }
 
(*
* TDDColorKey
*)
PDDColorKey = ^TDDColorKey;
TDDColorKey = record
TDDColorKey = packed record
dwColorSpaceLowValue: DWORD; // low boundary of color space that is to
// be treated as Color Key, inclusive
dwColorSpaceHighValue: DWORD; // high boundary of color space that is
187,13 → 179,21
// to be treated as Color Key, inclusive
end;
 
DDCOLORKEY = TDDColorKey;
LPDDCOLORKEY = PDDColorKey;
// Delphi 5 can't handle interface in variant records
// so we have to use pointers instead (which can be type-casted into interfaces):
 
{ TDDBltFX structure }
{$IFDEF VER5UP}
PDirectDrawSurface = Pointer;
{$ELSE}
PDirectDrawSurface = IDirectDrawSurface;
{$ENDIF}
 
(*
* TDDBltFX
* Used to pass override information to the DIRECTDRAWSURFACE callback Blt.
*)
PDDBltFX = ^TDDBltFX;
TDDBltFX = record
TDDBltFX = packed record
dwSize: DWORD; // size of structure
dwDDFX: DWORD; // FX operations
dwROP: DWORD; // Win32 raster operations
204,89 → 204,88
dwZBufferHigh: DWORD; // High limit of Z buffer
dwZBufferBaseDest: DWORD; // Destination base value
dwZDestConstBitDepth: DWORD; // Bit depth used to specify Z constant for destination
case Integer of
case integer of
0: (
dwZDestConst: DWORD; // Constant to use as Z buffer for dest
dwZDestConst : DWORD // Constant to use as Z buffer for dest
);
1: (
lpDDSZBufferDest : PDirectDrawSurface; // Surface to use as Z buffer for dest
dwZSrcConstBitDepth: DWORD; // Bit depth used to specify Z constant for source
case integer of
0: (
dwZSrcConst: DWORD; // Constant to use as Z buffer for src
);
1: (
lpDDSZBufferSrc : PDirectDrawSurface; // Surface to use as Z buffer for src
dwAlphaEdgeBlendBitDepth: DWORD; // Bit depth used to specify constant for alpha edge blend
dwAlphaEdgeBlend: DWORD; // Alpha for edge blending
dwReserved: DWORD;
dwAlphaDestConstBitDepth: DWORD; // Bit depth used to specify alpha constant for destination
case integer of
0: (
dwAlphaDestConst: DWORD; // Constant to use as Alpha Channel
);
1: (
lpDDSAlphaDest : PDirectDrawSurface; // Surface to use as Alpha Channel
dwAlphaSrcConstBitDepth: DWORD; // Bit depth used to specify alpha constant for source
case integer of
0: (
dwAlphaSrcConst: DWORD; // Constant to use as Alpha Channel
);
1: (
lpDDSAlphaSrc : PDirectDrawSurface; // Surface to use as Alpha Channel
case integer of
0: (
dwFillColor: DWORD; // color in RGB or Palettized
ddckDestColorkey: TDDColorKey; // DestColorkey override
ddckSrcColorkey: TDDColorKey; // SrcColorkey override
);
1: (
lpDDSZBufferDest: Pointer{IDirectDrawSurface}; // Surface to use as Z buffer for dest
_union1b: DWORD;
lpDDSZBufferSrc: Pointer{IDirectDrawSurface}; // Surface to use as Z buffer for src
_union1d: DWORD;
_union1e: DWORD;
_union1f: DWORD;
_union1g: DWORD;
lpDDSAlphaDest: Pointer{IDirectDrawSurface}; // Surface to use as Alpha Channel
_union1i: DWORD;
lpDDSAlphaSrc: Pointer{IDirectDrawSurface}; // Surface to use as Alpha Channel
dwFillDepth: DWORD; // depth value for z-buffer
);
2: (
_union2a: DWORD;
_union2b: DWORD;
_union2c: DWORD;
_union2d: DWORD;
_union2e: DWORD;
_union2f: DWORD;
_union2g: DWORD;
_union2h: DWORD;
_union2i: DWORD;
_union2j: DWORD;
lpDDSPattern: Pointer{IDirectDrawSurface}; // Surface to use as pattern
dwFillPixel : DWORD; // pixel value
);
3: (
lpDDSPattern : PDirectDrawSurface; // Surface to use as pattern
ddckDestColorkey : TDDColorKey; // DestColorkey override
ddckSrcColorkey : TDDColorKey; // SrcColorkey override
)
)
)
)
)
end;
 
DDBLTFX = TDDBltFX;
LPDDBLTFX = PDDBltFX;
 
{ TDDSCaps structure }
 
(*
* TDDSCaps
*)
PDDSCaps = ^TDDSCaps;
TDDSCaps = record
TDDSCaps = packed record
dwCaps: DWORD; // capabilities of surface wanted
end;
 
DDSCAPS = TDDSCaps;
LPDDSCAPS = PDDSCaps;
{ TDDOSCaps structure }
 
(*
* TDDOSCaps
*)
PDDOSCaps = ^TDDOSCaps;
TDDOSCaps = record
TDDOSCaps = packed record
dwCaps: DWORD; // capabilities of surface wanted
end;
 
DDOSCAPS = TDDOSCaps;
LPDDOSCAPS = PDDOSCaps;
 
 
{ TDDSCapsEx structure }
 
(*
* This structure is used internally by DirectDraw.
*)
PDDSCapsEx = ^TDDSCapsEx;
TDDSCapsEx = record
TDDSCapsEx = packed record
dwCaps2: DWORD;
dwCaps3: DWORD;
dwCaps4: DWORD;
end;
 
DDSCAPSEX = TDDSCapsEx;
LPDDSCAPSEX = PDDSCapsEx;
 
{ TDDSCaps2 structure }
 
(*
* TDDSCaps2
*)
PDDSCaps2 = ^TDDSCaps2;
TDDSCaps2 = record
TDDSCaps2 = packed record
dwCaps: DWORD; // capabilities of surface wanted
dwCaps2: DWORD;
dwCaps3: DWORD;
293,53 → 292,15
dwCaps4: DWORD;
end;
 
DDSCAPS2 = TDDSCaps2;
LPDDSCAPS2 = PDDSCaps2;
 
{ TDDCaps structure }
 
PDDCaps_DX1 = ^TDDCaps_DX1;
TDDCaps_DX1 = record
dwSize: DWORD; // size of the DDDRIVERCAPS structure
dwCaps: DWORD; // driver specific capabilities
dwCaps2: DWORD; // more driver specific capabilites
dwCKeyCaps: DWORD; // color key capabilities of the surface
dwFXCaps: DWORD; // driver specific stretching and effects capabilites
dwFXAlphaCaps: DWORD; // alpha driver specific capabilities
dwPalCaps: DWORD; // palette capabilities
dwSVCaps: DWORD; // stereo vision capabilities
dwAlphaBltConstBitDepths: DWORD; // DDBD_2,4,8
dwAlphaBltPixelBitDepths: DWORD; // DDBD_1,2,4,8
dwAlphaBltSurfaceBitDepths: DWORD; // DDBD_1,2,4,8
dwAlphaOverlayConstBitDepths: DWORD; // DDBD_2,4,8
dwAlphaOverlayPixelBitDepths: DWORD; // DDBD_1,2,4,8
dwAlphaOverlaySurfaceBitDepths: DWORD; // DDBD_1,2,4,8
dwZBufferBitDepths: DWORD; // DDBD_8,16,24,32
dwVidMemTotal: DWORD; // total amount of video memory
dwVidMemFree: DWORD; // amount of free video memory
dwMaxVisibleOverlays: DWORD; // maximum number of visible overlays
dwCurrVisibleOverlays: DWORD; // current number of visible overlays
dwNumFourCCCodes: DWORD; // number of four cc codes
dwAlignBoundarySrc: DWORD; // source rectangle alignment
dwAlignSizeSrc: DWORD; // source rectangle byte size
dwAlignBoundaryDest: DWORD; // dest rectangle alignment
dwAlignSizeDest: DWORD; // dest rectangle byte size
dwAlignStrideAlign: DWORD; // stride alignment
dwRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
ddsCaps: TDDSCaps; // TDDSCaps structure has all the general capabilities
dwMinOverlayStretch: DWORD; // minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxOverlayStretch: DWORD; // maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMinLiveVideoStretch: DWORD; // minimum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxLiveVideoStretch: DWORD; // maximum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMinHwCodecStretch: DWORD; // minimum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxHwCodecStretch: DWORD; // maximum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwReserved1: DWORD; // reserved
dwReserved2: DWORD; // reserved
dwReserved3: DWORD; // reserved
end;
 
(*
* TDDCaps
*)
(*
* This structure is the TDDCaps structure as it was in version 2 and 3 of Direct X.
* It is present for back compatability.
*)
PDDCaps_DX3 = ^TDDCaps_DX3;
TDDCaps_DX3 = record
TDDCaps_DX3 = packed record
dwSize: DWORD; // size of the DDDRIVERCAPS structure
dwCaps: DWORD; // driver specific capabilities
dwCaps2: DWORD; // more driver specific capabilites
365,7 → 326,7
dwAlignBoundaryDest: DWORD; // dest rectangle alignment
dwAlignSizeDest: DWORD; // dest rectangle byte size
dwAlignStrideAlign: DWORD; // stride alignment
dwRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
dwRops: Array [0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
ddsCaps: TDDSCaps; // TDDSCaps structure has all the general capabilities
dwMinOverlayStretch: DWORD; // minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxOverlayStretch: DWORD; // maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
379,22 → 340,26
dwSVBCaps: DWORD; // driver specific capabilities for System->Vmem blts
dwSVBCKeyCaps: DWORD; // driver color key capabilities for System->Vmem blts
dwSVBFXCaps: DWORD; // driver FX capabilities for System->Vmem blts
dwSVBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwSVBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwVSBCaps: DWORD; // driver specific capabilities for Vmem->System blts
dwVSBCKeyCaps: DWORD; // driver color key capabilities for Vmem->System blts
dwVSBFXCaps: DWORD; // driver FX capabilities for Vmem->System blts
dwVSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwVSBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwSSBCaps: DWORD; // driver specific capabilities for System->System blts
dwSSBCKeyCaps: DWORD; // driver color key capabilities for System->System blts
dwSSBFXCaps: DWORD; // driver FX capabilities for System->System blts
dwSSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
dwReserved4: DWORD; // reserved
dwReserved5: DWORD; // reserved
dwReserved6: DWORD; // reserved
dwSSBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
dwReserved4 : DWORD;
dwReserved5 : DWORD;
dwReserved6 : DWORD;
end;
 
(*
* This structure is the TDDCaps structure as it was in version 5 of Direct X.
* It is present for back compatability.
*)
PDDCaps_DX5 = ^TDDCaps_DX5;
TDDCaps_DX5 = record
TDDCaps_DX5 = packed record
dwSize: DWORD; // size of the DDDRIVERCAPS structure
dwCaps: DWORD; // driver specific capabilities
dwCaps2: DWORD; // more driver specific capabilites
420,7 → 385,7
dwAlignBoundaryDest: DWORD; // dest rectangle alignment
dwAlignSizeDest: DWORD; // dest rectangle byte size
dwAlignStrideAlign: DWORD; // stride alignment
dwRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
dwRops: Array [0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
ddsCaps: TDDSCaps; // TDDSCaps structure has all the general capabilities
dwMinOverlayStretch: DWORD; // minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxOverlayStretch: DWORD; // maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
434,16 → 399,16
dwSVBCaps: DWORD; // driver specific capabilities for System->Vmem blts
dwSVBCKeyCaps: DWORD; // driver color key capabilities for System->Vmem blts
dwSVBFXCaps: DWORD; // driver FX capabilities for System->Vmem blts
dwSVBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwSVBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwVSBCaps: DWORD; // driver specific capabilities for Vmem->System blts
dwVSBCKeyCaps: DWORD; // driver color key capabilities for Vmem->System blts
dwVSBFXCaps: DWORD; // driver FX capabilities for Vmem->System blts
dwVSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwVSBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwSSBCaps: DWORD; // driver specific capabilities for System->System blts
dwSSBCKeyCaps: DWORD; // driver color key capabilities for System->System blts
dwSSBFXCaps: DWORD; // driver FX capabilities for System->System blts
dwSSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
{ Members added for DX5 }
dwSSBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
// Members added for DX5:
dwMaxVideoPorts: DWORD; // maximum number of usable video ports
dwCurrVideoPorts: DWORD; // current number of video ports used
dwSVBCaps2: DWORD; // more driver specific capabilities for System->Vmem blts
451,79 → 416,16
dwNLVBCaps2: DWORD; // more driver specific capabilities non-local->local vidmem blts
dwNLVBCKeyCaps: DWORD; // driver color key capabilities for non-local->local vidmem blts
dwNLVBFXCaps: DWORD; // driver FX capabilities for non-local->local blts
dwNLVBRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported for non-local->local blts
dwNLVBRops: Array [0..DD_ROP_SPACE-1] of DWORD; // ROPS supported for non-local->local blts
end;
 
PDDCaps_DX6 = ^TDDCaps_DX6;
TDDCaps_DX6 = record
TDDCaps_DX6 = packed record
dwSize: DWORD; // size of the DDDRIVERCAPS structure
dwCaps: DWORD; // driver specific capabilities
dwCaps2: DWORD; // more driver specific capabilites
dwCKeyCaps: DWORD; // color key capabilities of the surface
dwFXCaps: DWORD; // driver specific stretching and effects capabilites
dwFXAlphaCaps: DWORD; // alpha caps
dwPalCaps: DWORD; // palette capabilities
dwSVCaps: DWORD; // stereo vision capabilities
dwAlphaBltConstBitDepths: DWORD; // DDBD_2,4,8
dwAlphaBltPixelBitDepths: DWORD; // DDBD_1,2,4,8
dwAlphaBltSurfaceBitDepths: DWORD; // DDBD_1,2,4,8
dwAlphaOverlayConstBitDepths: DWORD; // DDBD_2,4,8
dwAlphaOverlayPixelBitDepths: DWORD; // DDBD_1,2,4,8
dwAlphaOverlaySurfaceBitDepths: DWORD; // DDBD_1,2,4,8
dwZBufferBitDepths: DWORD; // DDBD_8,16,24,32
dwVidMemTotal: DWORD; // total amount of video memory
dwVidMemFree: DWORD; // amount of free video memory
dwMaxVisibleOverlays: DWORD; // maximum number of visible overlays
dwCurrVisibleOverlays: DWORD; // current number of visible overlays
dwNumFourCCCodes: DWORD; // number of four cc codes
dwAlignBoundarySrc: DWORD; // source rectangle alignment
dwAlignSizeSrc: DWORD; // source rectangle byte size
dwAlignBoundaryDest: DWORD; // dest rectangle alignment
dwAlignSizeDest: DWORD; // dest rectangle byte size
dwAlignStrideAlign: DWORD; // stride alignment
dwRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
ddsOldCaps: TDDSCaps; // Was TDDSCaps ddsCaps. ddsCaps is of type DDSCAPS2 for DX6
dwMinOverlayStretch: DWORD; // minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxOverlayStretch: DWORD; // maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMinLiveVideoStretch: DWORD; // minimum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxLiveVideoStretch: DWORD; // maximum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMinHwCodecStretch: DWORD; // minimum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxHwCodecStretch: DWORD; // maximum hardware codec stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwReserved1: DWORD; // reserved
dwReserved2: DWORD; // reserved
dwReserved3: DWORD; // reserved
dwSVBCaps: DWORD; // driver specific capabilities for System->Vmem blts
dwSVBCKeyCaps: DWORD; // driver color key capabilities for System->Vmem blts
dwSVBFXCaps: DWORD; // driver FX capabilities for System->Vmem blts
dwSVBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwVSBCaps: DWORD; // driver specific capabilities for Vmem->System blts
dwVSBCKeyCaps: DWORD; // driver color key capabilities for Vmem->System blts
dwVSBFXCaps: DWORD; // driver FX capabilities for Vmem->System blts
dwVSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwSSBCaps: DWORD; // driver specific capabilities for System->System blts
dwSSBCKeyCaps: DWORD; // driver color key capabilities for System->System blts
dwSSBFXCaps: DWORD; // driver FX capabilities for System->System blts
dwSSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
{ Members added for DX5 }
dwMaxVideoPorts: DWORD; // maximum number of usable video ports
dwCurrVideoPorts: DWORD; // current number of video ports used
dwSVBCaps2: DWORD; // more driver specific capabilities for System->Vmem blts
dwNLVBCaps: DWORD; // driver specific capabilities for non-local->local vidmem blts
dwNLVBCaps2: DWORD; // more driver specific capabilities non-local->local vidmem blts
dwNLVBCKeyCaps: DWORD; // driver color key capabilities for non-local->local vidmem blts
dwNLVBFXCaps: DWORD; // driver FX capabilities for non-local->local blts
dwNLVBRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported for non-local->local blts
{ Members added for DX6 }
ddsCaps: TDDSCaps2; // Surface Caps
end;
 
PDDCaps_DX7 = ^TDDCaps_DX7;
TDDCaps_DX7 = record
dwSize: DWORD; // size of the DDDRIVERCAPS structure
dwCaps: DWORD; // driver specific capabilities
dwCaps2: DWORD; // more driver specific capabilites
dwCKeyCaps: DWORD; // color key capabilities of the surface
dwFXCaps: DWORD; // driver specific stretching and effects capabilites
dwFXAlphaCaps: DWORD; // alpha driver specific capabilities
dwPalCaps: DWORD; // palette capabilities
dwSVCaps: DWORD; // stereo vision capabilities
544,8 → 446,8
dwAlignBoundaryDest: DWORD; // dest rectangle alignment
dwAlignSizeDest: DWORD; // dest rectangle byte size
dwAlignStrideAlign: DWORD; // stride alignment
dwRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
ddsOldCaps: TDDSCaps; // Was TDDSCaps ddsCaps. ddsCaps is of type DDSCAPS2 for DX6
dwRops: Array [0..DD_ROP_SPACE-1] of DWORD; // ROPS supported
ddsOldCaps: TDDSCaps; // Was dssCaps: TDDSCaps. ddsCaps is of type TDDScaps2 for DX6
dwMinOverlayStretch: DWORD; // minimum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMaxOverlayStretch: DWORD; // maximum overlay stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
dwMinLiveVideoStretch: DWORD; // minimum live video stretch factor multiplied by 1000, eg 1000 == 1.0, 1300 == 1.3
558,16 → 460,16
dwSVBCaps: DWORD; // driver specific capabilities for System->Vmem blts
dwSVBCKeyCaps: DWORD; // driver color key capabilities for System->Vmem blts
dwSVBFXCaps: DWORD; // driver FX capabilities for System->Vmem blts
dwSVBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwSVBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->Vmem blts
dwVSBCaps: DWORD; // driver specific capabilities for Vmem->System blts
dwVSBCKeyCaps: DWORD; // driver color key capabilities for Vmem->System blts
dwVSBFXCaps: DWORD; // driver FX capabilities for Vmem->System blts
dwVSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwVSBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for Vmem->System blts
dwSSBCaps: DWORD; // driver specific capabilities for System->System blts
dwSSBCKeyCaps: DWORD; // driver color key capabilities for System->System blts
dwSSBFXCaps: DWORD; // driver FX capabilities for System->System blts
dwSSBRops: array[0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
{ Members added for DX5 }
dwSSBRops: Array [0..DD_ROP_SPACE-1] of DWORD;// ROPS supported for System->System blts
// Members added for DX5:
dwMaxVideoPorts: DWORD; // maximum number of usable video ports
dwCurrVideoPorts: DWORD; // current number of video ports used
dwSVBCaps2: DWORD; // more driver specific capabilities for System->Vmem blts
575,40 → 477,48
dwNLVBCaps2: DWORD; // more driver specific capabilities non-local->local vidmem blts
dwNLVBCKeyCaps: DWORD; // driver color key capabilities for non-local->local vidmem blts
dwNLVBFXCaps: DWORD; // driver FX capabilities for non-local->local blts
dwNLVBRops: array[0..DD_ROP_SPACE-1] of DWORD; // ROPS supported for non-local->local blts
{ Members added for DX6 }
dwNLVBRops: Array [0..DD_ROP_SPACE-1] of DWORD; // ROPS supported for non-local->local blts
// Members added for DX6 release
ddsCaps: TDDSCaps2; // Surface Caps
end;
 
{$IFDEF DirectX1}
TDDCaps = TDDCaps_DX1;
PDDCaps = PDDCaps_DX1;
{$ENDIF}{$IFDEF DirectX3}
TDDCaps_DX7 = TDDCaps_DX6;
PDDCaps = ^TDDCaps;
 
{$IFDEF DIRECTX3}
TDDCaps = TDDCaps_DX3;
PDDCaps = PDDCaps_DX3;
{$ENDIF}{$IFDEF DirectX5}
{$ELSE}
{$IFDEF DIRECTX5}
TDDCaps = TDDCaps_DX5;
PDDCaps = PDDCaps_DX5;
{$ENDIF}{$IFDEF DirectX6}
{$ELSE}
{$IFDEF DIRECTX6}
TDDCaps = TDDCaps_DX6;
PDDCaps = PDDCaps_DX6;
{$ENDIF}{$IFDEF DirectX7}
{$ELSE}
TDDCaps = TDDCaps_DX7;
PDDCaps = PDDCaps_DX7;
{$ENDIF}
{$ENDIF}
{$ENDIF}
 
DDCAPS = TDDCaps;
LPDDCAPS = PDDCaps;
 
{ TDDPixelFormat structure }
 
PDDPixelFormat = ^TDDPixelFormat;
TDDPixelFormat = record
 
(*
* TDDPixelFormat
*)
PDDPixelFormat_DX5 = ^TDDPixelFormat_DX5;
TDDPixelFormat_DX5 = packed record
dwSize: DWORD; // size of structure
dwFlags: DWORD; // pixel format flags
dwFourCC: DWORD; // (FOURCC code)
case Integer of
0: (
dwZBufferBitDepth: DWORD; // how many bits for z buffers
);
1: (
dwAlphaBitDepth: DWORD; // how many bits for alpha channels
);
2: (
dwRGBBitCount: DWORD; // how many bits per pixel
dwRBitMask: DWORD; // mask for red bit
dwGBitMask: DWORD; // mask for green bits
615,14 → 525,38
dwBBitMask: DWORD; // mask for blue bits
dwRGBAlphaBitMask: DWORD; // mask for alpha channel
);
3: (
dwYUVBitCount: DWORD; // how many bits per pixel
dwYBitMask: DWORD; // mask for Y bits
dwUBitMask: DWORD; // mask for U bits
dwVBitMask: DWORD; // mask for V bits
case Integer of
0: (
dwYUVAlphaBitMask: DWORD; // mask for alpha channel
);
1: (
_union1a: DWORD;
_union1b: DWORD;
_union1c: DWORD;
_union1d: DWORD;
dwRGBZBitMask: DWORD; // mask for Z channel
dwRGBZBitMask: DWORD;
);
2: (
dwYUVZBitMask: DWORD;
);
);
end;
 
PDDPixelFormat_DX6 = ^TDDPixelFormat_DX6;
TDDPixelFormat_DX6 = packed record
dwSize: DWORD; // size of structure
dwFlags: DWORD; // pixel format flags
dwFourCC: DWORD; // (FOURCC code)
case Integer of
1: (
dwRGBBitCount : DWORD; // how many bits per pixel
dwRBitMask : DWORD; // mask for red bit
dwGBitMask : DWORD; // mask for green bits
dwBBitMask : DWORD; // mask for blue bits
dwRGBAlphaBitMask : DWORD; // mask for alpha channel
);
2: (
dwYUVBitCount: DWORD; // how many bits per pixel
dwYBitMask: DWORD; // mask for Y bits
dwUBitMask: DWORD; // mask for U bits
630,43 → 564,52
dwYUVAlphaBitMask: DWORD; // mask for alpha channel
);
3: (
_union3a: DWORD;
_union3b: DWORD;
_union3c: DWORD;
_union3d: DWORD;
dwYUVZBitMask: DWORD; // mask for Z channel
);
4: (
dwZBufferBitDepth: DWORD; // how many bits for z buffers
dwZBufferBitDepth : DWORD; // how many total bits/pixel in z buffer (including any stencil bits)
dwStencilBitDepth: DWORD; // how many stencil bits (note: dwZBufferBitDepth-dwStencilBitDepth is total Z-only bits)
dwZBitMask: DWORD; // mask for Z bits
dwStencilBitMask: DWORD; // mask for stencil bits
dwLuminanceAlphaBitMask : DWORD;// mask for alpha channel
);
5: (
4: (
dwAlphaBitDepth: DWORD; // how many bits for alpha channels
);
6: (
dwLuminanceBitCount: DWORD; // how many bits per pixel
dwLuminanceBitMask: DWORD; // mask for luminance bits
_union6c: DWORD;
_union6d: DWORD;
dwLuminanceAlphaBitMask: DWORD;
);
7: (
dwBumpBitCount: DWORD; // how many bits per "buxel", total
dwBumpDuBitMask: DWORD; // mask for bump map U delta bits
dwBumpDvBitMask: DWORD; // mask for bump map V delta bits
dwBumpLuminanceBitMask: DWORD; // mask for luminance in bump map
dwRGBZBitMask : DWORD; // mask for Z channel
);
5: (
dwLuminanceBitCount : DWORD; // how many bits per pixel
dwBumpDuBitMask : DWORD; // mask for bump map U delta bits
Fill1, Fill2 : DWORD;
dwYUVZBitMask : DWORD; // mask for Z channel
);
6: ( dwBumpBitCount : DWORD; // how many bits per "buxel", total
);
end;
 
DDPIXELFORMAT = TDDPixelFormat;
LPDDPIXELFORMAT = PDDPixelFormat;
TDDPixelFormat_DX3 = TDDPixelFormat_DX5;
TDDPixelFormat_DX7 = TDDPixelFormat_DX6;
 
{ DDOVERLAYFX structure }
PDDPixelFormat = ^TDDPixelFormat;
{$IFDEF DIRECTX3}
TDDPixelFormat = TDDPixelFormat_DX3;
{$ELSE}
{$IFDEF DIRECTX5}
TDDPixelFormat = TDDPixelFormat_DX5;
{$ELSE}
{$IFDEF DIRECTX6}
TDDPixelFormat = TDDPixelFormat_DX6;
{$ELSE}
TDDPixelFormat = TDDPixelFormat_DX7;
{$ENDIF}
{$ENDIF}
{$ENDIF}
 
PDDOverlayFx = ^TDDOverlayFx;
TDDOverlayFx = record
(*
* TDDOverlayFX
*)
PDDOverlayFX = ^TDDOverlayFX;
TDDOverlayFX = packed record
dwSize: DWORD; // size of structure
dwAlphaEdgeBlendBitDepth: DWORD; // Bit depth used to specify constant for alpha edge blend
dwAlphaEdgeBlend: DWORD; // Constant to use as alpha for edge blend
683,157 → 626,40
dwFlags: DWORD; // flags
);
1: (
lpDDSAlphaDest: Pointer{IDirectDrawSurface}; // Surface to use as alpha channel for dest
_union1b: DWORD;
lpDDSAlphaSrc: Pointer{IDirectDrawSurface}; // Surface to use as alpha channel for src
lpDDSAlphaDest: PDirectDrawSurface; // Surface to use as alpha channel for dest
filler: DWORD;
lpDDSAlphaSrc: PDirectDrawSurface; // Surface to use as alpha channel for src
);
end;
 
DDOVERLAYFX = TDDOverlayFx;
LPDDOVERLAYFX = PDDOverlayFx;
 
{ TDDBltBatch structure }
 
(*
* TDDBltBatch: BltBatch entry structure
*)
PDDBltBatch = ^TDDBltBatch;
TDDBltBatch = record
TDDBltBatch = packed record
lprDest: PRect;
lpDDSSrc: IDirectDrawSurface;
lprSrc: PRect;
dwFlags: DWORD;
lpDDBltFx: PDDBltFX;
lpDDBltFx: TDDBltFX;
end;
 
DDBLTBATCH = TDDBltBatch;
LPDDBLTBATCH = PDDBltBatch;
 
{ TDDSurfaceDesc structure }
 
PDDSurfaceDesc = ^TDDSurfaceDesc;
TDDSurfaceDesc = record
dwSize: DWORD; // size of the TDDSurfaceDesc structure
dwFlags: DWORD; // determines what fields are valid
dwHeight: DWORD; // height of surface to be created
dwWidth: DWORD; // width of input surface
case Integer of
0: (
lPitch: Longint;
dwBackBufferCount: DWORD; // number of back buffers requested
case Integer of
0: (
dwMipMapCount: DWORD; // number of mip-map levels requested
dwAlphaBitDepth: DWORD; // depth of alpha buffer requested
dwReserved: DWORD; // reserved
lpSurface: Pointer; // pointer to the associated surface memory
ddckCKDestOverlay: TDDColorKey;// color key for destination overlay use
ddckCKDestBlt: TDDColorKey; // color key for destination blt use
ddckCKSrcOverlay: TDDColorKey; // color key for source overlay use
ddckCKSrcBlt: TDDColorKey; // color key for source blt use
ddpfPixelFormat: TDDPixelFormat;// pixel format description of the surface
ddsCaps: TDDSCaps; // direct draw surface capabilities
);
1: (
dwZBufferBitDepth: DWORD; // depth of Z buffer requested
);
2: (
dwRefreshRate: DWORD; // refresh rate (used when display mode is described)
);
);
1: (
dwLinearSize: DWORD
);
end;
 
DDSURFACEDESC = TDDSurfaceDesc;
LPDDSURFACEDESC = PDDSurfaceDesc;
 
{ TDDSurfaceDesc2 structure }
 
PDDSurfaceDesc2 = ^TDDSurfaceDesc2;
TDDSurfaceDesc2 = record
dwSize: DWORD; // size of the TDDSurfaceDesc2 structure
dwFlags: DWORD; // determines what fields are valid
dwHeight: DWORD; // height of surface to be created
dwWidth: DWORD; // width of input surface
case Integer of
0: (
lPitch: Longint;
dwBackBufferCount: DWORD; // number of back buffers requested
case Integer of
0: (
dwMipMapCount: DWORD; // number of mip-map levels requested
dwAlphaBitDepth: DWORD; // depth of alpha buffer requested
dwReserved: DWORD; // reserved
lpSurface: Pointer; // pointer to the associated surface memory
ddckCKDestOverlay: TDDColorKey;// color key for destination overlay use
ddckCKDestBlt: TDDColorKey; // color key for destination blt use
ddckCKSrcOverlay: TDDColorKey; // color key for source overlay use
ddckCKSrcBlt: TDDColorKey; // color key for source blt use
ddpfPixelFormat: TDDPixelFormat;// pixel format description of the surface
ddsCaps: TDDSCaps2; // direct draw surface capabilities
dwTextureStage: DWORD; // stage in multitexture cascade
);
1: (
dwRefreshRate: DWORD; // refresh rate (used when display mode is described)
);
);
1: (
dwLinearSize: DWORD
);
end;
 
DDSURFACEDESC2 = TDDSurfaceDesc2;
LPDDSURFACEDESC2 = PDDSurfaceDesc2;
 
{ TDDOptSurfaceDesc structure }
 
PDDOptSurfaceDesc = ^TDDOptSurfaceDesc;
TDDOptSurfaceDesc = record
dwSize: DWORD; // size of the DDOPTSURFACEDESC structure
dwFlags: DWORD; // determines what fields are valid
ddSCaps: TDDSCaps2; // Common caps like: Memory type
ddOSCaps: TDDOSCaps; // Common caps like: Memory type
guid: TGUID; // Compression technique GUID
dwCompressionRatio: DWORD; // Compression ratio
end;
 
DDOPTSURFACEDESC = TDDOptSurfaceDesc;
LPDDOPTSURFACEDESC = PDDOptSurfaceDesc;
 
{ TDDColorControl structure }
 
PDDColorControl = ^TDDColorControl;
TDDColorControl = record
dwSize: DWORD;
dwFlags: DWORD;
lBrightness: Longint;
lContrast: Longint;
lHue: Longint;
lSaturation: Longint;
lSharpness: Longint;
lGamma: Longint;
lColorEnable: Longint;
dwReserved1: DWORD;
end;
 
DDCOLORCONTROL = TDDColorControl;
LPDDCOLORCONTROL = PDDCOLORCONTROL;
 
{ TDDGammaRamp structure }
 
(*
* TDDGammaRamp
*)
PDDGammaRamp = ^TDDGammaRamp;
TDDGammaRamp = record
Red: array[0..255] of Word;
Green: array[0..255] of Word;
Blue: array[0..255] of Word;
TDDGammaRamp = packed record
red : array[0..255] of WORD;
green : array[0..255] of WORD;
blue : array[0..255] of WORD;
end;
 
DDGAMMARAMP = TDDGammaRamp;
LPDDGAMMARAMP = PDDGammaRamp;
(*
* This is the structure within which DirectDraw returns data about the current graphics driver and chipset
*)
 
{ TDDDeviceIdentifier structure }
 
PDDDeviceIdentifier = ^TDDDeviceIdentifier;
TDDDeviceIdentifier = record
TDDDeviceIdentifier = packed record
//
// These elements are for presentation to the user only. They should not be used to identify particular
// drivers, since this is unreliable and many different strings may be associated with the same
876,13 → 702,8
guidDeviceIdentifier: TGUID;
end;
 
DDDEVICEIDENTIFIER = TDDDeviceIdentifier;
LPDDDEVICEIDENTIFIER = PDDDeviceIdentifier;
 
{ TDDDeviceIdentifier2 structure }
 
PDDDeviceIdentifier2 = ^TDDDeviceIdentifier2;
TDDDeviceIdentifier2 = record
TDDDeviceIdentifier2 = packed record
//
// These elements are for presentation to the user only. They should not be used to identify particular
// drivers, since this is unreliable and many different strings may be associated with the same
924,247 → 745,432
//
guidDeviceIdentifier: TGUID;
 
//
// This element is used to determine the Windows Hardware Quality Lab (WHQL)
// certification level for this driver/device pair.
//
(*
* This element is used to determine the Windows Hardware Quality Lab (WHQL)
* certification level for this driver/device pair.
*)
dwWHQLLevel: DWORD;
end;
 
DDDEVICEIDENTIFIER2 = TDDDeviceIdentifier2;
LPDDDEVICEIDENTIFIER2 = PDDDeviceIdentifier2;
 
{ Callbacks }
 
(*
* callbacks
*)
TClipperCallback = function(lpDDClipper: IDirectDrawClipper; hWnd: HWND;
Code: DWORD; lpContext: Pointer): HResult; stdcall;
LPCLIPPERCALLBACK = TClipperCallback;
 
TSurfacesStreamingCallback = function(Arg: DWORD): HResult; stdcall;
LPSURFACESTREAMINGCALLBACK =TSurfacesStreamingCallback;
 
(*
* TDDSurfaceDesc
*)
PDDSurfaceDesc_DX5 = ^TDDSurfaceDesc_DX5;
TDDSurfaceDesc_DX5 = packed record
dwSize: DWORD; // size of the TDDSurfaceDesc structure
dwFlags: DWORD; // determines what fields are valid
dwHeight: DWORD; // height of surface to be created
dwWidth: DWORD; // width of input surface
case Integer of
0: (
dwLinearSize : DWORD; // unused at the moment
);
1: (
lPitch: LongInt; // distance to start of next line (return value only)
dwBackBufferCount: DWORD; // number of back buffers requested
case Integer of
0: (
dwMipMapCount: DWORD; // number of mip-map levels requested
dwAlphaBitDepth: DWORD; // depth of alpha buffer requested
dwReserved: DWORD; // reserved
lpSurface: Pointer; // pointer to the associated surface memory
ddckCKDestOverlay: TDDColorKey; // color key for destination overlay use
ddckCKDestBlt: TDDColorKey; // color key for destination blt use
ddckCKSrcOverlay: TDDColorKey; // color key for source overlay use
ddckCKSrcBlt: TDDColorKey; // color key for source blt use
ddpfPixelFormat: TDDPixelFormat_DX5; // pixel format description of the surface
ddsCaps: TDDSCaps; // direct draw surface capabilities
);
1: (
dwZBufferBitDepth: DWORD; // depth of Z buffer requested
);
2: (
dwRefreshRate: DWORD; // refresh rate (used when display mode is described)
);
);
end;
 
PDDSurfaceDesc_DX6 = ^TDDSurfaceDesc_DX6;
TDDSurfaceDesc_DX6 = packed record
dwSize: DWORD; // size of the TDDSurfaceDesc structure
dwFlags: DWORD; // determines what fields are valid
dwHeight: DWORD; // height of surface to be created
dwWidth: DWORD; // width of input surface
case Integer of
0: (
dwLinearSize : DWORD; // unused at the moment
);
1: (
lPitch: LongInt; // distance to start of next line (return value only)
dwBackBufferCount: DWORD; // number of back buffers requested
case Integer of
0: (
dwMipMapCount: DWORD; // number of mip-map levels requested
dwAlphaBitDepth: DWORD; // depth of alpha buffer requested
dwReserved: DWORD; // reserved
lpSurface: Pointer; // pointer to the associated surface memory
ddckCKDestOverlay: TDDColorKey; // color key for destination overlay use
ddckCKDestBlt: TDDColorKey; // color key for destination blt use
ddckCKSrcOverlay: TDDColorKey; // color key for source overlay use
ddckCKSrcBlt: TDDColorKey; // color key for source blt use
ddpfPixelFormat: TDDPixelFormat_DX6; // pixel format description of the surface
ddsCaps: TDDSCaps; // direct draw surface capabilities
);
1: (
dwZBufferBitDepth: DWORD; // depth of Z buffer requested
);
2: (
dwRefreshRate: DWORD; // refresh rate (used when display mode is described)
);
);
end;
 
PDDSurfaceDesc = ^TDDSurfaceDesc;
{$IFDEF DIRECTX5}
TDDSurfaceDesc = TDDSurfaceDesc_DX5;
{$ELSE}
TDDSurfaceDesc = TDDSurfaceDesc_DX6;
{$ENDIF}
 
 
(*
* TDDSurfaceDesc2
*)
PDDSurfaceDesc2 = ^TDDSurfaceDesc2;
TDDSurfaceDesc2 = packed record
dwSize: DWORD; // size of the TDDSurfaceDesc structure
dwFlags: DWORD; // determines what fields are valid
dwHeight: DWORD; // height of surface to be created
dwWidth: DWORD; // width of input surface
case Integer of
0: (
lPitch : LongInt; // distance to start of next line (return value only)
);
1: (
dwLinearSize : DWORD; // Formless late-allocated optimized surface size
dwBackBufferCount: DWORD; // number of back buffers requested
case Integer of
0: (
dwMipMapCount: DWORD; // number of mip-map levels requested
dwAlphaBitDepth: DWORD; // depth of alpha buffer requested
dwReserved: DWORD; // reserved
lpSurface: Pointer; // pointer to the associated surface memory
ddckCKDestOverlay: TDDColorKey; // color key for destination overlay use
ddckCKDestBlt: TDDColorKey; // color key for destination blt use
ddckCKSrcOverlay: TDDColorKey; // color key for source overlay use
ddckCKSrcBlt: TDDColorKey; // color key for source blt use
ddpfPixelFormat: TDDPixelFormat; // pixel format description of the surface
ddsCaps: TDDSCaps2; // direct draw surface capabilities
dwTextureStage: DWORD; // stage in multitexture cascade
);
1: (
dwRefreshRate: DWORD; // refresh rate (used when display mode is described)
);
);
end;
 
(*
* TDDOptSurfaceDesc
*)
 
PDDOptSurfaceDesc = ^TDDOptSurfaceDesc;
TDDOptSurfaceDesc = packed record
dwSize : DWORD; // size of the DDOPTSURFACEDESC structure
dwFlags : DWORD; // determines what fields are valid
ddSCaps : TDDSCaps2; // Common caps like: Memory type
ddOSCaps : TDDOSCaps; // Common caps like: Memory type
guid : TGUID; // Compression technique GUID
dwCompressionRatio : DWORD; // Compression ratio
end;
 
(*
* DDCOLORCONTROL
*)
PDDColorControl = ^TDDColorControl;
TDDColorControl = packed record
dwSize: DWORD;
dwFlags: DWORD;
lBrightness: LongInt;
lContrast: LongInt;
lHue: LongInt;
lSaturation: LongInt;
lSharpness: LongInt;
lGamma: LongInt;
lColorEnable: LongInt;
dwReserved1: DWORD;
end;
 
(*
* callbacks
*)
 
{$IFNDEF WINNT}
TDDEnumModesCallback = function(const lpDDSurfaceDesc: TDDSurfaceDesc;
lpContext: Pointer): HResult; stdcall;
LPDDENUMMODESCALLBACK = TDDEnumModesCallback;
 
TDDEnumModesCallback2 = function(const lpDDSurfaceDesc: TDDSurfaceDesc2;
lpContext: Pointer): HResult; stdcall;
LPDDENUMMODESCALLBACK2 = TDDEnumModesCallback2;
 
TDDEnumSurfacesCallback = function(lpDDSurface: IDirectDrawSurface;
const lpDDSurfaceDesc: TDDSurfaceDesc; lpContext: Pointer): HResult; stdcall;
LPDDENUMSURFACESCALLBACK = TDDEnumSurfacesCallback;
 
TDDEnumSurfacesCallback2 = function(lpDDSurface: IDirectDrawSurface4;
const lpDDSurfaceDesc: TDDSurfaceDesc2; lpContext: Pointer): HResult; stdcall;
LPDDENUMSURFACESCALLBACK2 = TDDEnumSurfacesCallback2;
 
TDDEnumSurfacesCallback7 = function(lpDDSurface: IDirectDrawSurface7;
const lpDDSurfaceDesc: TDDSurfaceDesc2; lpContext: Pointer): HResult; stdcall;
LPDDENUMSURFACESCALLBACK7 = TDDEnumSurfacesCallback7;
{$ENDIF}
 
{ IDirectDraw Interface }
(*
* INTERACES FOLLOW:
* IDirectDraw
* IDirectDrawClipper
* IDirectDrawPalette
* IDirectDrawSurface
*)
 
(*
* IDirectDraw
*)
 
IDirectDraw = interface(IUnknown)
['{6C14DB80-A733-11CE-A521-0020AF0BE560}']
// IDirectDraw methods
(*** IDirectDraw methods ***)
function Compact: HResult; stdcall;
function CreateClipper(dwFlags: DWORD; out lplpDDClipper: IDirectDrawClipper;
function CreateClipper (dwFlags: DWORD;
out lplpDDClipper: IDirectDrawClipper;
pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette(dwFlags: DWORD; lpColorTable: PPaletteEntry;
out lplpDDPalette: IDirectDrawPalette; pUnkOuter: IUnknown): HResult; stdcall;
function CreateSurface(const lpDDSurfaceDesc: TDDSurfaceDesc;
out lplpDDSurface: IDirectDrawSurface; pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette (dwFlags: DWORD; lpColorTable: pointer;
out lplpDDPalette: IDirectDrawPalette;
pUnkOuter: IUnknown) : HResult; stdcall;
function CreateSurface (var lpDDSurfaceDesc: TDDSurfaceDesc;
out lplpDDSurface: IDirectDrawSurface;
pUnkOuter: IUnknown) : HResult; stdcall;
function DuplicateSurface(lpDDSurface: IDirectDrawSurface;
out lplpDupDDSurface: IDirectDrawSurface): HResult; stdcall;
function EnumDisplayModes(dwFlags: DWORD;
const lpDDSurfaceDesc: TDDSurfaceDesc; lpContext: Pointer;
lpDDSurfaceDesc: PDDSurfaceDesc; lpContext: Pointer;
lpEnumModesCallback: TDDEnumModesCallback): HResult; stdcall;
function EnumSurfaces(dwFlags: DWORD; const lpDDSD: TDDSurfaceDesc;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback): HResult; stdcall;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback) :
HResult; stdcall;
function FlipToGDISurface: HResult; stdcall;
function GetCaps(var lpDDDriverCaps: TDDCaps; var lpDDHELCaps: TDDCaps): HResult; stdcall;
function GetDisplayMode(var lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function GetFourCCCodes(var lpNumCodes, lpCodes: DWORD): HResult; stdcall;
function GetGDISurface(out lplpGDIDDSSurface: IDirectDrawSurface): HResult; stdcall;
function GetMonitorFrequency(var lpdwFrequency: DWORD): HResult; stdcall;
function GetScanLine(var lpdwScanLine: DWORD): HResult; stdcall;
function GetVerticalBlankStatus(var lpbIsInVB: BOOL): HResult; stdcall;
function GetCaps (lpDDDriverCaps: PDDCaps; lpDDHELCaps: PDDCaps) : HResult; stdcall;
function GetDisplayMode (out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function GetFourCCCodes (var lpNumCodes: DWORD; lpCodes: PDWORD) : HResult; stdcall;
function GetGDISurface (out lplpGDIDDSSurface: IDirectDrawSurface) :
HResult; stdcall;
function GetMonitorFrequency (out lpdwFrequency: DWORD) : HResult; stdcall;
function GetScanLine (out lpdwScanLine: DWORD) : HResult; stdcall;
function GetVerticalBlankStatus (out lpbIsInVB: BOOL) : HResult; stdcall;
function Initialize(lpGUID: PGUID): HResult; stdcall;
function RestoreDisplayMode: HResult; stdcall;
function SetCooperativeLevel(hWnd: HWND; dwFlags: DWORD): HResult; stdcall;
function SetDisplayMode(dwWidth, dwHeight, dwBpp: DWORD): HResult; stdcall;
function WaitForVerticalBlank(dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
(*** Warning! SetDisplayMode differs between DirectDraw 1 and DirectDraw 2 ***)
function SetDisplayMode (dwWidth: DWORD; dwHeight: DWORD;
dwBpp: DWORD) : HResult; stdcall;
function WaitForVerticalBlank (dwFlags: DWORD; hEvent: THandle) :
HResult; stdcall;
end;
 
{ IDirectDraw2 Interface }
 
IDirectDraw2 = interface(IUnknown)
['{B3A6F3E0-2B43-11CF-A2DE-00AA00B93356}']
// IDirectDraw methods
(*** IDirectDraw methods ***)
function Compact: HResult; stdcall;
function CreateClipper(dwFlags: DWORD; out lplpDDClipper: IDirectDrawClipper;
function CreateClipper (dwFlags: DWORD;
out lplpDDClipper: IDirectDrawClipper;
pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette(dwFlags: DWORD; lpColorTable: PPaletteEntry;
out lplpDDPalette: IDirectDrawPalette; pUnkOuter: IUnknown): HResult; stdcall;
function CreateSurface(const lpDDSurfaceDesc: TDDSurfaceDesc;
out lplpDDSurface: IDirectDrawSurface; pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette (dwFlags: DWORD; lpColorTable: pointer;
out lplpDDPalette: IDirectDrawPalette;
pUnkOuter: IUnknown) : HResult; stdcall;
function CreateSurface (var lpDDSurfaceDesc: TDDSurfaceDesc;
out lplpDDSurface: IDirectDrawSurface;
pUnkOuter: IUnknown) : HResult; stdcall;
function DuplicateSurface(lpDDSurface: IDirectDrawSurface;
out lplpDupDDSurface: IDirectDrawSurface): HResult; stdcall;
function EnumDisplayModes(dwFlags: DWORD;
const lpDDSurfaceDesc: TDDSurfaceDesc; lpContext: Pointer;
lpDDSurfaceDesc: PDDSurfaceDesc; lpContext: Pointer;
lpEnumModesCallback: TDDEnumModesCallback): HResult; stdcall;
function EnumSurfaces(dwFlags: DWORD; const lpDDSD: TDDSurfaceDesc;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback): HResult; stdcall;
function EnumSurfaces (dwFlags: DWORD; var lpDDSD: TDDSurfaceDesc;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback) :
HResult; stdcall;
function FlipToGDISurface: HResult; stdcall;
function GetCaps(var lpDDDriverCaps: TDDCaps; var lpDDHELCaps: TDDCaps): HResult; stdcall;
function GetDisplayMode(var lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function GetFourCCCodes(var lpNumCodes, lpCodes: DWORD): HResult; stdcall;
function GetCaps (lpDDDriverCaps: PDDCaps; lpDDHELCaps: PDDCaps) : HResult; stdcall;
function GetDisplayMode (out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function GetFourCCCodes (var lpNumCodes: DWORD; lpCodes: PDWORD) : HResult; stdcall;
function GetGDISurface(out lplpGDIDDSSurface: IDirectDrawSurface): HResult; stdcall;
function GetMonitorFrequency(var lpdwFrequency: DWORD): HResult; stdcall;
function GetScanLine(var lpdwScanLine: DWORD): HResult; stdcall;
function GetVerticalBlankStatus(var lpbIsInVB: BOOL): HResult; stdcall;
function GetMonitorFrequency (out lpdwFrequency: DWORD) : HResult; stdcall;
function GetScanLine (out lpdwScanLine: DWORD) : HResult; stdcall;
function GetVerticalBlankStatus (out lpbIsInVB: BOOL) : HResult; stdcall;
function Initialize(lpGUID: PGUID): HResult; stdcall;
function RestoreDisplayMode: HResult; stdcall;
function SetCooperativeLevel(hWnd: HWND; dwFlags: DWORD): HResult; stdcall;
function SetDisplayMode(dwWidth, dwHeight, dwBPP, dwRefreshRate: DWORD;
dwFlags: DWORD): HResult; stdcall;
function WaitForVerticalBlank(dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
// IDirectDraw2 methods
(*** Warning! SetDisplayMode differs between DirectDraw 1 and DirectDraw 2 ***)
function SetDisplayMode (dwWidth: DWORD; dwHeight: DWORD; dwBPP: DWORD;
dwRefreshRate: DWORD; dwFlags: DWORD) : HResult; stdcall;
function WaitForVerticalBlank (dwFlags: DWORD; hEvent: THandle) :
HResult; stdcall;
(*** Added in the v2 interface ***)
function GetAvailableVidMem(var lpDDSCaps: TDDSCaps;
var lpdwTotal, lpdwFree: DWORD): HResult; stdcall;
out lpdwTotal, lpdwFree: DWORD) : HResult; stdcall;
end;
 
{ IDirectDraw4 Interface }
 
IDirectDraw4 = interface(IUnknown)
['{9C59509A-39BD-11D1-8C4A-00C04FD930C5}']
// IDirectDraw methods
['{9c59509a-39bd-11d1-8c4a-00c04fd930c5}']
(*** IDirectDraw methods ***)
function Compact: HResult; stdcall;
function CreateClipper(dwFlags: DWORD; out lplpDDClipper: IDirectDrawClipper;
function CreateClipper (dwFlags: DWORD;
out lplpDDClipper: IDirectDrawClipper;
pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette(dwFlags: DWORD; lpColorTable: PPaletteEntry;
out lplpDDPalette: IDirectDrawPalette; pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette (dwFlags: DWORD; lpColorTable: pointer;
out lplpDDPalette: IDirectDrawPalette;
pUnkOuter: IUnknown) : HResult; stdcall;
function CreateSurface(const lpDDSurfaceDesc: TDDSurfaceDesc2;
out lplpDDSurface: IDirectDrawSurface4; pUnkOuter: IUnknown): HResult; stdcall;
out lplpDDSurface: IDirectDrawSurface4;
pUnkOuter: IUnknown) : HResult; stdcall;
function DuplicateSurface(lpDDSurface: IDirectDrawSurface4;
out lplpDupDDSurface: IDirectDrawSurface4): HResult; stdcall;
function EnumDisplayModes(dwFlags: DWORD;
const lpDDSurfaceDesc: TDDSurfaceDesc2; lpContext: Pointer;
lpDDSurfaceDesc: PDDSurfaceDesc2; lpContext: Pointer;
lpEnumModesCallback: TDDEnumModesCallback2): HResult; stdcall;
function EnumSurfaces(dwFlags: DWORD; const lpDDSD: TDDSurfaceDesc2;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback2): HResult; stdcall;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback2) :
HResult; stdcall;
function FlipToGDISurface: HResult; stdcall;
function GetCaps(var lpDDDriverCaps: TDDCaps; var lpDDHELCaps: TDDCaps): HResult; stdcall;
function GetDisplayMode(var lpDDSurfaceDesc: TDDSurfaceDesc2): HResult; stdcall;
function GetFourCCCodes(var lpNumCodes, lpCodes: DWORD): HResult; stdcall;
function GetGDISurface(out lplpGDIDDSSurface: IDirectDrawSurface2): HResult; stdcall;
function GetMonitorFrequency(var lpdwFrequency: DWORD): HResult; stdcall;
function GetScanLine(var lpdwScanLine: DWORD): HResult; stdcall;
function GetVerticalBlankStatus(var lpbIsInVB: BOOL): HResult; stdcall;
function GetCaps (lpDDDriverCaps: PDDCaps; lpDDHELCaps: PDDCaps) : HResult; stdcall;
function GetDisplayMode (out lpDDSurfaceDesc: TDDSurfaceDesc2) : HResult; stdcall;
function GetFourCCCodes (var lpNumCodes: DWORD; lpCodes: PDWORD) : HResult; stdcall;
function GetGDISurface (out lplpGDIDDSSurface: IDirectDrawSurface4) :
HResult; stdcall;
function GetMonitorFrequency (out lpdwFrequency: DWORD) : HResult; stdcall;
function GetScanLine (out lpdwScanLine: DWORD) : HResult; stdcall;
function GetVerticalBlankStatus (out lpbIsInVB: BOOL) : HResult; stdcall;
function Initialize(lpGUID: PGUID): HResult; stdcall;
function RestoreDisplayMode: HResult; stdcall;
function SetCooperativeLevel(hWnd: HWND; dwFlags: DWORD): HResult; stdcall;
function SetDisplayMode(dwWidth, dwHeight, dwBPP, dwRefreshRate: DWORD;
dwFlags: DWORD): HResult; stdcall;
function WaitForVerticalBlank(dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
// IDirectDraw2 methods
function GetAvailableVidMem(var lpDDSCaps: TDDSCaps;
var lpdwTotal, lpdwFree: DWORD): HResult; stdcall;
// IDirectDraw4 methods
function GetSurfaceFromDC(hdc: HDC; lpDDS: IDirectDrawSurface4): HResult; stdcall;
(*** Warning! SetDisplayMode differs between DirectDraw 1 and DirectDraw 2 ***)
function SetDisplayMode (dwWidth: DWORD; dwHeight: DWORD; dwBPP: DWORD;
dwRefreshRate: DWORD; dwFlags: DWORD) : HResult; stdcall;
function WaitForVerticalBlank (dwFlags: DWORD; hEvent: THandle) :
HResult; stdcall;
(*** Added in the v2 interface ***)
function GetAvailableVidMem (const lpDDSCaps: TDDSCaps2;
out lpdwTotal, lpdwFree: DWORD) : HResult; stdcall;
(*** Added in the V4 Interface ***)
function GetSurfaceFromDC (hdc : Windows.HDC;
out lpDDS4: IDirectDrawSurface4) : HResult; stdcall;
function RestoreAllSurfaces: HResult; stdcall;
function TestCooperativeLevel: HResult; stdcall;
function GetDeviceIdentifier(var lpdddi: TDDDeviceIdentifier; dwFlags: DWORD): HResult; stdcall;
function GetDeviceIdentifier (out lpdddi: TDDDeviceIdentifier;
dwFlags: DWORD) : HResult; stdcall;
end;
 
{ IDirectDraw7 Interface }
 
IDirectDraw7 = interface(IUnknown)
['{15E65EC0-3B9C-11D2-B92F-00609797EA5B}']
// IDirectDraw methods
['{15e65ec0-3b9c-11d2-b92f-00609797ea5b}']
(*** IDirectDraw methods ***)
function Compact: HResult; stdcall;
function CreateClipper(dwFlags: DWORD; out lplpDDClipper: IDirectDrawClipper;
function CreateClipper (dwFlags: DWORD;
out lplpDDClipper: IDirectDrawClipper;
pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette(dwFlags: DWORD; lpColorTable: PPaletteEntry;
out lplpDDPalette: IDirectDrawPalette; pUnkOuter: IUnknown): HResult; stdcall;
function CreatePalette (dwFlags: DWORD; lpColorTable: pointer;
out lplpDDPalette: IDirectDrawPalette;
pUnkOuter: IUnknown) : HResult; stdcall;
function CreateSurface(const lpDDSurfaceDesc: TDDSurfaceDesc2;
out lplpDDSurface: IDirectDrawSurface7; pUnkOuter: IUnknown): HResult; stdcall;
out lplpDDSurface: IDirectDrawSurface7;
pUnkOuter: IUnknown) : HResult; stdcall;
function DuplicateSurface(lpDDSurface: IDirectDrawSurface7;
out lplpDupDDSurface: IDirectDrawSurface7): HResult; stdcall;
function EnumDisplayModes(dwFlags: DWORD;
const lpDDSurfaceDesc: TDDSurfaceDesc2; lpContext: Pointer;
lpDDSurfaceDesc: PDDSurfaceDesc2; lpContext: Pointer;
lpEnumModesCallback: TDDEnumModesCallback2): HResult; stdcall;
function EnumSurfaces(dwFlags: DWORD; const lpDDSD: TDDSurfaceDesc2;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback7): HResult; stdcall;
lpContext: Pointer; lpEnumCallback: TDDEnumSurfacesCallback7) :
HResult; stdcall;
function FlipToGDISurface: HResult; stdcall;
function GetCaps(var lpDDDriverCaps: TDDCaps; var lpDDHELCaps: TDDCaps): HResult; stdcall;
function GetDisplayMode(var lpDDSurfaceDesc: TDDSurfaceDesc2): HResult; stdcall;
function GetFourCCCodes(var lpNumCodes, lpCodes: DWORD): HResult; stdcall;
function GetGDISurface(out lplpGDIDDSSurface: IDirectDrawSurface7): HResult; stdcall;
function GetMonitorFrequency(var lpdwFrequency: DWORD): HResult; stdcall;
function GetScanLine(var lpdwScanLine: DWORD): HResult; stdcall;
function GetVerticalBlankStatus(var lpbIsInVB: BOOL): HResult; stdcall;
function GetCaps (lpDDDriverCaps: PDDCaps; lpDDHELCaps: PDDCaps) : HResult; stdcall;
function GetDisplayMode (out lpDDSurfaceDesc: TDDSurfaceDesc2) : HResult; stdcall;
function GetFourCCCodes (var lpNumCodes: DWORD; lpCodes: PDWORD) : HResult; stdcall;
function GetGDISurface (out lplpGDIDDSSurface: IDirectDrawSurface7) :
HResult; stdcall;
function GetMonitorFrequency (out lpdwFrequency: DWORD) : HResult; stdcall;
function GetScanLine (out lpdwScanLine: DWORD) : HResult; stdcall;
function GetVerticalBlankStatus (out lpbIsInVB: BOOL) : HResult; stdcall;
function Initialize(lpGUID: PGUID): HResult; stdcall;
function RestoreDisplayMode: HResult; stdcall;
function SetCooperativeLevel(hWnd: HWND; dwFlags: DWORD): HResult; stdcall;
function SetDisplayMode(dwWidth, dwHeight, dwBPP, dwRefreshRate: DWORD;
dwFlags: DWORD): HResult; stdcall;
function WaitForVerticalBlank(dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
// IDirectDraw2 methods
function GetAvailableVidMem(var lpDDSCaps: TDDSCaps;
var lpdwTotal, lpdwFree: DWORD): HResult; stdcall;
// IDirectDraw4 methods
function GetSurfaceFromDC(hdc: HDC; lpDDS: IDirectDrawSurface4): HResult; stdcall;
function SetDisplayMode (dwWidth: DWORD; dwHeight: DWORD; dwBPP: DWORD;
dwRefreshRate: DWORD; dwFlags: DWORD) : HResult; stdcall;
function WaitForVerticalBlank (dwFlags: DWORD; hEvent: THandle) :
HResult; stdcall;
(*** Added in the v2 interface ***)
function GetAvailableVidMem (const lpDDSCaps: TDDSCaps2;
out lpdwTotal, lpdwFree: DWORD) : HResult; stdcall;
(*** Added in the V4 Interface ***)
function GetSurfaceFromDC (hdc : Windows.HDC;
out lpDDS: IDirectDrawSurface7) : HResult; stdcall;
function RestoreAllSurfaces: HResult; stdcall;
function TestCooperativeLevel: HResult; stdcall;
function GetDeviceIdentifier(var lpdddi: TDDDeviceIdentifier; dwFlags: DWORD): HResult; stdcall;
// IDirectDraw7 methods
function StartModeTest(var lpModesToTest: TSize; dwNumEntries: DWORD; dwFlags: DWORD): HResult; stdcall;
function EvaluateMode(dwFlags: DWORD; var pSecondsUntilTimeout: DWORD): HResult; stdcall;
function GetDeviceIdentifier (out lpdddi: TDDDeviceIdentifier2;
dwFlags: DWORD) : HResult; stdcall;
function StartModeTest(const lpModesToTest; dwNumEntries, dwFlags: DWORD) : HResult; stdcall;
function EvaluateMode(dwFlags: DWORD; out pSecondsUntilTimeout: DWORD) : HResult; stdcall;
end;
 
{ IDirectDrawPalette Interface }
 
 
(*
* IDirectDrawPalette
*)
 
IDirectDrawPalette = interface(IUnknown)
['{6C14DB84-A733-11CE-A521-0020AF0BE560}']
// IDirectDrawPalette methods
function GetCaps(varlpdwCaps: DWORD): HResult; stdcall;
(*** IDirectDrawPalette methods ***)
function GetCaps (out lpdwCaps: DWORD) : HResult; stdcall;
function GetEntries(dwFlags: DWORD; dwBase: DWORD; dwNumEntries: DWORD;
lpEntries: PPaletteEntry): HResult; stdcall;
lpEntries: pointer) : HResult; stdcall;
function Initialize(lpDD: IDirectDraw; dwFlags: DWORD;
lpDDColorTable: PPaletteEntry): HResult; stdcall;
lpDDColorTable: pointer) : HResult; stdcall;
function SetEntries(dwFlags: DWORD; dwStartingEntry: DWORD;
dwCount: DWORD; lpEntries: PPaletteEntry): HResult; stdcall;
dwCount: DWORD; lpEntries: pointer) : HResult; stdcall;
end;
 
{ IDirectDrawClipper Interface }
(*
* IDirectDrawClipper
*)
 
IDirectDrawClipper = interface(IUnknown)
['{6C14DB85-A733-11CE-A521-0020AF0BE560}']
// IDirectDrawClipper methods
function GetClipList(const lpRect: TRect; lpClipList: PRgnData;
(*** IDirectDrawClipper methods ***)
function GetClipList (lpRect: PRect; lpClipList: PRgnData;
var lpdwSize: DWORD): HResult; stdcall;
function GetHWnd(var lphWnd: HWND): HResult; stdcall;
function GetHWnd (out lphWnd: HWND) : HResult; stdcall;
function Initialize(lpDD: IDirectDraw; dwFlags: DWORD): HResult; stdcall;
function IsClipListChanged(var lpbChanged: BOOL): HResult; stdcall;
function IsClipListChanged (out lpbChanged: BOOL) : HResult; stdcall;
function SetClipList(lpClipList: PRgnData; dwFlags: DWORD): HResult; stdcall;
function SetHWnd(dwFlags: DWORD; hWnd: HWND): HResult; stdcall;
end;
 
{ IDirectDrawSurface Interface }
(*
* IDirectDrawSurface and related interfaces
*)
 
IDirectDrawSurface = interface(IUnknown)
['{6C14DB81-A733-11CE-A521-0020AF0BE560}']
// IDirectDrawSurface methods
function AddAttachedSurface(lpDDSAttachedSurface: IDirectDrawSurface): HResult; stdcall;
(*** IDirectDrawSurface methods ***)
function AddAttachedSurface (lpDDSAttachedSurface: IDirectDrawSurface) :
HResult; stdcall;
function AddOverlayDirtyRect(const lpRect: TRect): HResult; stdcall;
function Blt(const lpDestRect: TRect; lpDDSrcSurface: IDirectDrawSurface;
const lpSrcRect: TRect; dwFlags: DWORD; const lpDDBltFx: TDDBltFX): HResult; stdcall;
function Blt (lpDestRect: PRect;
lpDDSrcSurface: IDirectDrawSurface; lpSrcRect: PRect;
dwFlags: DWORD; lpDDBltFx: PDDBltFX) : HResult; stdcall;
function BltBatch(const lpDDBltBatch: TDDBltBatch; dwCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function BltFast(dwX, dwY: DWORD; lpDDSrcSurface: IDirectDrawSurface;
const lpSrcRect: TRect; dwTrans: DWORD): HResult; stdcall;
function BltFast (dwX: DWORD; dwY: DWORD;
lpDDSrcSurface: IDirectDrawSurface; lpSrcRect: PRect;
dwTrans: DWORD) : HResult; stdcall;
function DeleteAttachedSurface(dwFlags: DWORD;
lpDDSAttachedSurface: IDirectDrawSurface): HResult; stdcall;
function EnumAttachedSurfaces(lpContext: Pointer;
1174,50 → 1180,57
function Flip(lpDDSurfaceTargetOverride: IDirectDrawSurface;
dwFlags: DWORD): HResult; stdcall;
function GetAttachedSurface(var lpDDSCaps: TDDSCaps;
out lplpDDAttachedSurface: IDirectDrawSurface): HResult; stdcall;
(*out*)var lplpDDAttachedSurface: IDirectDrawSurface) : HResult; stdcall;
function GetBltStatus(dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDDSCaps: TDDSCaps): HResult; stdcall;
function GetCaps (out lpDDSCaps: TDDSCaps) : HResult; stdcall;
function GetClipper(out lplpDDClipper: IDirectDrawClipper): HResult; stdcall;
function GetColorKey(dwFlags: DWORD; var lpDDColorKey: TDDColorKey): HResult; stdcall;
function GetDC(var lphDC: HDC): HResult; stdcall;
function GetColorKey (dwFlags: DWORD; out lpDDColorKey: TDDColorKey) :
HResult; stdcall;
function GetDC (out lphDC: HDC) : HResult; stdcall;
function GetFlipStatus(dwFlags: DWORD): HResult; stdcall;
function GetOverlayPosition(var lplX, lplY: Longint): HResult; stdcall;
function GetOverlayPosition (out lplX, lplY: LongInt) : HResult; stdcall;
function GetPalette(out lplpDDPalette: IDirectDrawPalette): HResult; stdcall;
function GetPixelFormat(var lpDDPixelFormat: TDDPixelFormat): HResult; stdcall;
function GetSurfaceDesc(var lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function GetPixelFormat (out lpDDPixelFormat: TDDPixelFormat) : HResult; stdcall;
function GetSurfaceDesc (out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function Initialize(lpDD: IDirectDraw;
const lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function IsLost: HResult; stdcall;
function Lock(lpDestRect: PRect; var lpDDSurfaceDesc: TDDSurfaceDesc;
dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
function ReleaseDC(hDC: HDC): HResult; stdcall;
function Restore: HResult; stdcall;
function Lock (lpDestRect: PRect; out lpDDSurfaceDesc:
TDDSurfaceDesc; dwFlags: DWORD; hEvent: THandle) : HResult; stdcall;
function ReleaseDC (hDC: Windows.HDC) : HResult; stdcall;
function _Restore: HResult; stdcall;
function SetClipper(lpDDClipper: IDirectDrawClipper): HResult; stdcall;
function SetColorKey(dwFlags: DWORD; const lpDDColorKey: TDDColorKey): HResult; stdcall;
function SetOverlayPosition(lX, lY: Longint): HResult; stdcall;
function SetColorKey (dwFlags: DWORD; lpDDColorKey: PDDColorKey) :
HResult; stdcall;
function SetOverlayPosition (lX, lY: LongInt) : HResult; stdcall;
function SetPalette(lpDDPalette: IDirectDrawPalette): HResult; stdcall;
function Unlock(lpSurfaceData: Pointer): HResult; stdcall;
function UpdateOverlay(const lpSrcRect: TRect;
lpDDDestSurface: IDirectDrawSurface; const lpDestRect: TRect;
dwFlags: DWORD; const lpDDOverlayFx: TDDOverlayFX): HResult; stdcall;
function UpdateOverlay (lpSrcRect: PRect;
lpDDDestSurface: IDirectDrawSurface; lpDestRect: PRect;
dwFlags: DWORD; lpDDOverlayFx: PDDOverlayFX) : HResult; stdcall;
function UpdateOverlayDisplay(dwFlags: DWORD): HResult; stdcall;
function UpdateOverlayZOrder(dwFlags: DWORD;
lpDDSReference: IDirectDrawSurface): HResult; stdcall;
end;
 
{ IDirectDrawSurface2 Interface }
(*
* IDirectDrawSurface2 and related interfaces
*)
 
IDirectDrawSurface2 = interface(IUnknown)
['{57805885-6EEC-11CF-9441-A82303C10E27}']
// IDirectDrawSurface methods
function AddAttachedSurface(lpDDSAttachedSurface: IDirectDrawSurface2): HResult; stdcall;
['{57805885-6eec-11cf-9441-a82303c10e27}']
(*** IDirectDrawSurface methods ***)
function AddAttachedSurface (lpDDSAttachedSurface: IDirectDrawSurface2) :
HResult; stdcall;
function AddOverlayDirtyRect(const lpRect: TRect): HResult; stdcall;
function Blt(const lpDestRect: TRect; lpDDSrcSurface: IDirectDrawSurface2;
const lpSrcRect: TRect; dwFlags: DWORD; const lpDDBltFx: TDDBltFX): HResult; stdcall;
function Blt (lpDestRect: PRect;
lpDDSrcSurface: IDirectDrawSurface2; lpSrcRect: PRect;
dwFlags: DWORD; lpDDBltFx: PDDBltFX) : HResult; stdcall;
function BltBatch(const lpDDBltBatch: TDDBltBatch; dwCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function BltFast(dwX, dwY: DWORD; lpDDSrcSurface: IDirectDrawSurface2;
const lpSrcRect: TRect; dwTrans: DWORD): HResult; stdcall;
function BltFast (dwX: DWORD; dwY: DWORD;
lpDDSrcSurface: IDirectDrawSurface2; lpSrcRect: PRect;
dwTrans: DWORD) : HResult; stdcall;
function DeleteAttachedSurface(dwFlags: DWORD;
lpDDSAttachedSurface: IDirectDrawSurface2): HResult; stdcall;
function EnumAttachedSurfaces(lpContext: Pointer;
1229,51 → 1242,56
function GetAttachedSurface(var lpDDSCaps: TDDSCaps;
out lplpDDAttachedSurface: IDirectDrawSurface2): HResult; stdcall;
function GetBltStatus(dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDDSCaps: TDDSCaps): HResult; stdcall;
function GetCaps (out lpDDSCaps: TDDSCaps) : HResult; stdcall;
function GetClipper(out lplpDDClipper: IDirectDrawClipper): HResult; stdcall;
function GetColorKey(dwFlags: DWORD; var lpDDColorKey: TDDColorKey): HResult; stdcall;
function GetDC(var lphDC: HDC): HResult; stdcall;
function GetColorKey (dwFlags: DWORD; out lpDDColorKey: TDDColorKey) :
HResult; stdcall;
function GetDC (out lphDC: HDC) : HResult; stdcall;
function GetFlipStatus(dwFlags: DWORD): HResult; stdcall;
function GetOverlayPosition(var lplX, lplY: Longint): HResult; stdcall;
function GetOverlayPosition (out lplX, lplY: LongInt) : HResult; stdcall;
function GetPalette(out lplpDDPalette: IDirectDrawPalette): HResult; stdcall;
function GetPixelFormat(var lpDDPixelFormat: TDDPixelFormat): HResult; stdcall;
function GetSurfaceDesc(var lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function Initialize(lpDD: IDirectDraw; const lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function GetPixelFormat (out lpDDPixelFormat: TDDPixelFormat) : HResult; stdcall;
function GetSurfaceDesc (out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function Initialize (lpDD: IDirectDraw;
out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function IsLost: HResult; stdcall;
function Lock(lpDestRect: PRect; const lpDDSurfaceDesc: TDDSurfaceDesc;
dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
function ReleaseDC(hDC: HDC): HResult; stdcall;
function Restore: HResult; stdcall;
function Lock (lpDestRect: PRect;
out lpDDSurfaceDesc: TDDSurfaceDesc; dwFlags: DWORD;
hEvent: THandle) : HResult; stdcall;
function ReleaseDC (hDC: Windows.HDC) : HResult; stdcall;
function _Restore: HResult; stdcall;
function SetClipper(lpDDClipper: IDirectDrawClipper): HResult; stdcall;
function SetColorKey(dwFlags: DWORD; const lpDDColorKey: TDDColorKey): HResult; stdcall;
function SetOverlayPosition(lX, lY: Longint): HResult; stdcall;
function SetColorKey (dwFlags: DWORD; lpDDColorKey: PDDColorKey) :
HResult; stdcall;
function SetOverlayPosition (lX, lY: LongInt) : HResult; stdcall;
function SetPalette(lpDDPalette: IDirectDrawPalette): HResult; stdcall;
function Unlock(lpSurfaceData: Pointer): HResult; stdcall;
function UpdateOverlay(const lpSrcRect: TRect;
lpDDDestSurface: IDirectDrawSurface2; const lpDestRect: TRect;
dwFlags: DWORD; const lpDDOverlayFx: TDDOverlayFX): HResult; stdcall;
function UpdateOverlay (lpSrcRect: PRect;
lpDDDestSurface: IDirectDrawSurface2; lpDestRect: PRect;
dwFlags: DWORD; lpDDOverlayFx: PDDOverlayFX) : HResult; stdcall;
function UpdateOverlayDisplay(dwFlags: DWORD): HResult; stdcall;
function UpdateOverlayZOrder(dwFlags: DWORD;
lpDDSReference: IDirectDrawSurface2): HResult; stdcall;
// IDirectDrawSurface2 methods
function GetDDInterface(out lplpDD: IUnknown): HResult; stdcall;
(*** Added in the v2 interface ***)
function GetDDInterface (var lplpDD: IDirectDraw) : HResult; stdcall;
function PageLock(dwFlags: DWORD): HResult; stdcall;
function PageUnlock(dwFlags: DWORD): HResult; stdcall;
end;
 
{ IDirectDrawSurface3 Interface }
 
IDirectDrawSurface3 = interface(IUnknown)
['{DA044E00-69B2-11D0-A1D5-00AA00B8DFBB}']
// IDirectDrawSurface methods
function AddAttachedSurface(lpDDSAttachedSurface: IDirectDrawSurface3): HResult; stdcall;
(*** IDirectDrawSurface methods ***)
function AddAttachedSurface (lpDDSAttachedSurface: IDirectDrawSurface3) :
HResult; stdcall;
function AddOverlayDirtyRect(const lpRect: TRect): HResult; stdcall;
function Blt(const lpDestRect: TRect; lpDDSrcSurface: IDirectDrawSurface3;
const lpSrcRect: TRect; dwFlags: DWORD; const lpDDBltFx: TDDBltFX): HResult; stdcall;
function Blt (lpDestRect: PRect;
lpDDSrcSurface: IDirectDrawSurface3; lpSrcRect: PRect;
dwFlags: DWORD; lpDDBltFx: PDDBltFX) : HResult; stdcall;
function BltBatch(const lpDDBltBatch: TDDBltBatch; dwCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function BltFast(dwX, dwY: DWORD; lpDDSrcSurface: IDirectDrawSurface3;
const lpSrcRect: TRect; dwTrans: DWORD): HResult; stdcall;
function BltFast (dwX: DWORD; dwY: DWORD;
lpDDSrcSurface: IDirectDrawSurface3; lpSrcRect: PRect;
dwTrans: DWORD) : HResult; stdcall;
function DeleteAttachedSurface(dwFlags: DWORD;
lpDDSAttachedSurface: IDirectDrawSurface3): HResult; stdcall;
function EnumAttachedSurfaces(lpContext: Pointer;
1285,53 → 1303,61
function GetAttachedSurface(var lpDDSCaps: TDDSCaps;
out lplpDDAttachedSurface: IDirectDrawSurface3): HResult; stdcall;
function GetBltStatus(dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDDSCaps: TDDSCaps): HResult; stdcall;
function GetCaps (out lpDDSCaps: TDDSCaps) : HResult; stdcall;
function GetClipper(out lplpDDClipper: IDirectDrawClipper): HResult; stdcall;
function GetColorKey(dwFlags: DWORD; var lpDDColorKey: TDDColorKey): HResult; stdcall;
function GetDC(var lphDC: HDC): HResult; stdcall;
function GetColorKey (dwFlags: DWORD; out lpDDColorKey: TDDColorKey) :
HResult; stdcall;
function GetDC (out lphDC: HDC) : HResult; stdcall;
function GetFlipStatus(dwFlags: DWORD): HResult; stdcall;
function GetOverlayPosition(var lplX, lplY: Longint): HResult; stdcall;
function GetOverlayPosition (out lplX, lplY: LongInt) : HResult; stdcall;
function GetPalette(out lplpDDPalette: IDirectDrawPalette): HResult; stdcall;
function GetPixelFormat(var lpDDPixelFormat: TDDPixelFormat): HResult; stdcall;
function GetSurfaceDesc(var lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function Initialize(lpDD: IDirectDraw; const lpDDSurfaceDesc: TDDSurfaceDesc): HResult; stdcall;
function GetPixelFormat (out lpDDPixelFormat: TDDPixelFormat) : HResult; stdcall;
function GetSurfaceDesc (out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function Initialize (lpDD: IDirectDraw;
out lpDDSurfaceDesc: TDDSurfaceDesc) : HResult; stdcall;
function IsLost: HResult; stdcall;
function Lock(lpDestRect: PRect; const lpDDSurfaceDesc: TDDSurfaceDesc;
dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
function ReleaseDC(hDC: HDC): HResult; stdcall;
function Restore: HResult; stdcall;
function Lock (lpDestRect: PRect;
out lpDDSurfaceDesc: TDDSurfaceDesc; dwFlags: DWORD;
hEvent: THandle) : HResult; stdcall;
function ReleaseDC (hDC: Windows.HDC) : HResult; stdcall;
function _Restore: HResult; stdcall;
function SetClipper(lpDDClipper: IDirectDrawClipper): HResult; stdcall;
function SetColorKey(dwFlags: DWORD; const lpDDColorKey: TDDColorKey): HResult; stdcall;
function SetOverlayPosition(lX, lY: Longint): HResult; stdcall;
function SetColorKey (dwFlags: DWORD; lpDDColorKey: PDDColorKey) :
HResult; stdcall;
function SetOverlayPosition (lX, lY: LongInt) : HResult; stdcall;
function SetPalette(lpDDPalette: IDirectDrawPalette): HResult; stdcall;
function Unlock(lpSurfaceData: Pointer): HResult; stdcall;
function UpdateOverlay(const lpSrcRect: TRect;
lpDDDestSurface: IDirectDrawSurface3; const lpDestRect: TRect;
dwFlags: DWORD; const lpDDOverlayFx: TDDOverlayFX): HResult; stdcall;
function UpdateOverlay (lpSrcRect: PRect;
lpDDDestSurface: IDirectDrawSurface3; lpDestRect: PRect;
dwFlags: DWORD; lpDDOverlayFx: PDDOverlayFX) : HResult; stdcall;
function UpdateOverlayDisplay(dwFlags: DWORD): HResult; stdcall;
function UpdateOverlayZOrder(dwFlags: DWORD;
lpDDSReference: IDirectDrawSurface3): HResult; stdcall;
// IDirectDrawSurface2 methods
function GetDDInterface(out lplpDD: IUnknown): HResult; stdcall;
(*** Added in the v2 interface ***)
function GetDDInterface (out lplpDD: IDirectDraw) : HResult; stdcall;
function PageLock(dwFlags: DWORD): HResult; stdcall;
function PageUnlock(dwFlags: DWORD): HResult; stdcall;
// IDirectDrawSurface3 methods
(*** Added in the V3 interface ***)
function SetSurfaceDesc(const lpddsd: TDDSurfaceDesc; dwFlags: DWORD): HResult; stdcall;
end;
 
{ IDirectDrawSurface4 Interface }
 
(*
* IDirectDrawSurface4 and related interfaces
*)
IDirectDrawSurface4 = interface(IUnknown)
['{0B2B8630-AD35-11D0-8EA6-00609797EA5B}']
// IDirectDrawSurface methods
function AddAttachedSurface(lpDDSAttachedSurface: IDirectDrawSurface4): HResult; stdcall;
(*** IDirectDrawSurface methods ***)
function AddAttachedSurface (lpDDSAttachedSurface: IDirectDrawSurface4) :
HResult; stdcall;
function AddOverlayDirtyRect(const lpRect: TRect): HResult; stdcall;
function Blt(const lpDestRect: TRect; lpDDSrcSurface: IDirectDrawSurface4;
const lpSrcRect: TRect; dwFlags: DWORD; const lpDDBltFx: TDDBltFX): HResult; stdcall;
function Blt (lpDestRect: PRect;
lpDDSrcSurface: IDirectDrawSurface4; lpSrcRect: PRect;
dwFlags: DWORD; lpDDBltFx: PDDBltFX) : HResult; stdcall;
function BltBatch(const lpDDBltBatch: TDDBltBatch; dwCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function BltFast(dwX, dwY: DWORD; lpDDSrcSurface: IDirectDrawSurface4;
const lpSrcRect: TRect; dwTrans: DWORD): HResult; stdcall;
function BltFast (dwX: DWORD; dwY: DWORD;
lpDDSrcSurface: IDirectDrawSurface4; lpSrcRect: PRect;
dwTrans: DWORD) : HResult; stdcall;
function DeleteAttachedSurface(dwFlags: DWORD;
lpDDSAttachedSurface: IDirectDrawSurface4): HResult; stdcall;
function EnumAttachedSurfaces(lpContext: Pointer;
1340,62 → 1366,69
lpfnCallback: TDDEnumSurfacesCallback2): HResult; stdcall;
function Flip(lpDDSurfaceTargetOverride: IDirectDrawSurface4;
dwFlags: DWORD): HResult; stdcall;
function GetAttachedSurface(var lpDDSCaps: TDDSCaps2;
function GetAttachedSurface (const lpDDSCaps: TDDSCaps2;
out lplpDDAttachedSurface: IDirectDrawSurface4): HResult; stdcall;
function GetBltStatus(dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDDSCaps: TDDSCaps2): HResult; stdcall;
function GetCaps (out lpDDSCaps: TDDSCaps2) : HResult; stdcall;
function GetClipper(out lplpDDClipper: IDirectDrawClipper): HResult; stdcall;
function GetColorKey(dwFlags: DWORD; var lpDDColorKey: TDDColorKey): HResult; stdcall;
function GetDC(var lphDC: HDC): HResult; stdcall;
function GetColorKey (dwFlags: DWORD; out lpDDColorKey: TDDColorKey) :
HResult; stdcall;
function GetDC (out lphDC: HDC) : HResult; stdcall;
function GetFlipStatus(dwFlags: DWORD): HResult; stdcall;
function GetOverlayPosition(var lplX, lplY: Longint): HResult; stdcall;
function GetOverlayPosition (out lplX, lplY: LongInt) : HResult; stdcall;
function GetPalette(out lplpDDPalette: IDirectDrawPalette): HResult; stdcall;
function GetPixelFormat(var lpDDPixelFormat: TDDPixelFormat): HResult; stdcall;
function GetSurfaceDesc(var lpDDSurfaceDesc: TDDSurfaceDesc2): HResult; stdcall;
function Initialize(lpDD: IDirectDraw; const lpDDSurfaceDesc: TDDSurfaceDesc2): HResult; stdcall;
function GetPixelFormat (out lpDDPixelFormat: TDDPixelFormat) : HResult; stdcall;
function GetSurfaceDesc (out lpDDSurfaceDesc: TDDSurfaceDesc2) : HResult; stdcall;
function Initialize (lpDD: IDirectDraw;
out lpDDSurfaceDesc: TDDSurfaceDesc2) : HResult; stdcall;
function IsLost: HResult; stdcall;
function Lock(lpDestRect: PRect; const lpDDSurfaceDesc: TDDSurfaceDesc2;
dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
function ReleaseDC(hDC: HDC): HResult; stdcall;
function Restore: HResult; stdcall;
function Lock (lpDestRect: PRect;
out lpDDSurfaceDesc: TDDSurfaceDesc2; dwFlags: DWORD;
hEvent: THandle) : HResult; stdcall;
function ReleaseDC (hDC: Windows.HDC) : HResult; stdcall;
function _Restore: HResult; stdcall;
function SetClipper(lpDDClipper: IDirectDrawClipper): HResult; stdcall;
function SetColorKey(dwFlags: DWORD; const lpDDColorKey: TDDColorKey): HResult; stdcall;
function SetOverlayPosition(lX, lY: Longint): HResult; stdcall;
function SetColorKey (dwFlags: DWORD; lpDDColorKey: PDDColorKey) :
HResult; stdcall;
function SetOverlayPosition (lX, lY: LongInt) : HResult; stdcall;
function SetPalette(lpDDPalette: IDirectDrawPalette): HResult; stdcall;
function Unlock(lpSurfaceData: Pointer): HResult; stdcall;
function UpdateOverlay(const lpSrcRect: TRect; lpDDDestSurface: IDirectDrawSurface4;
const lpDestRect: TRect; dwFlags: DWORD; const lpDDOverlayFx: TDDOverlayFX): HResult; stdcall;
function Unlock (lpRect: PRect) : HResult; stdcall;
function UpdateOverlay (lpSrcRect: PRect;
lpDDDestSurface: IDirectDrawSurface4; lpDestRect: PRect;
dwFlags: DWORD; lpDDOverlayFx: PDDOverlayFX) : HResult; stdcall;
function UpdateOverlayDisplay(dwFlags: DWORD): HResult; stdcall;
function UpdateOverlayZOrder(dwFlags: DWORD; lpDDSReference: IDirectDrawSurface4): HResult; stdcall;
// IDirectDrawSurface2 methods
function UpdateOverlayZOrder (dwFlags: DWORD;
lpDDSReference: IDirectDrawSurface4) : HResult; stdcall;
(*** Added in the v2 interface ***)
function GetDDInterface(out lplpDD: IUnknown): HResult; stdcall;
function PageLock(dwFlags: DWORD): HResult; stdcall;
function PageUnlock(dwFlags: DWORD): HResult; stdcall;
// IDirectDrawSurface3 methods
function SetSurfaceDesc(const lpddsd: TDDSurfaceDesc2; dwFlags: DWORD): HResult; stdcall;
// IDirectDrawSurface4 methods
function SetPrivateData(const guidTag: TGUID; lpData: Pointer;
(*** Added in the V3 interface ***)
function SetSurfaceDesc(const lpddsd2: TDDSurfaceDesc2; dwFlags: DWORD) : HResult; stdcall;
(*** Added in the v4 interface ***)
function SetPrivateData(const guidTag: TGUID; lpData: pointer;
cbSize: DWORD; dwFlags: DWORD): HResult; stdcall;
function GetPrivateData(const guidTag: TGUID; lpData: Pointer;
var cbSize: DWORD): HResult; stdcall;
function GetPrivateData(const guidTag: TGUID; lpBuffer: pointer;
var lpcbBufferSize: DWORD) : HResult; stdcall;
function FreePrivateData(const guidTag: TGUID): HResult; stdcall;
function GetUniquenessValue(var lpValue: DWORD): HResult; stdcall;
function GetUniquenessValue(out lpValue: DWORD) : HResult; stdcall;
function ChangeUniquenessValue: HResult; stdcall;
end;
 
{ IDirectDrawSurface7 Interface }
 
IDirectDrawSurface7 = interface(IUnknown)
['{06675A80-3B9B-11D2-B92F-00609797EA5B}']
// IDirectDrawSurface methods
function AddAttachedSurface(lpDDSAttachedSurface: IDirectDrawSurface7): HResult; stdcall;
['{06675a80-3b9b-11d2-b92f-00609797ea5b}']
(*** IDirectDrawSurface methods ***)
function AddAttachedSurface (lpDDSAttachedSurface: IDirectDrawSurface7) :
HResult; stdcall;
function AddOverlayDirtyRect(const lpRect: TRect): HResult; stdcall;
function Blt(const lpDestRect: TRect; lpDDSrcSurface: IDirectDrawSurface7;
const lpSrcRect: TRect; dwFlags: DWORD; const lpDDBltFx: TDDBltFX): HResult; stdcall;
function Blt (lpDestRect: PRect;
lpDDSrcSurface: IDirectDrawSurface7; lpSrcRect: PRect;
dwFlags: DWORD; lpDDBltFx: PDDBltFX) : HResult; stdcall;
function BltBatch(const lpDDBltBatch: TDDBltBatch; dwCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function BltFast(dwX, dwY: DWORD; lpDDSrcSurface: IDirectDrawSurface7;
const lpSrcRect: TRect; dwTrans: DWORD): HResult; stdcall;
function BltFast (dwX: DWORD; dwY: DWORD;
lpDDSrcSurface: IDirectDrawSurface7; lpSrcRect: PRect;
dwTrans: DWORD) : HResult; stdcall;
function DeleteAttachedSurface(dwFlags: DWORD;
lpDDSAttachedSurface: IDirectDrawSurface7): HResult; stdcall;
function EnumAttachedSurfaces(lpContext: Pointer;
1404,438 → 1437,2038
lpfnCallback: TDDEnumSurfacesCallback7): HResult; stdcall;
function Flip(lpDDSurfaceTargetOverride: IDirectDrawSurface7;
dwFlags: DWORD): HResult; stdcall;
function GetAttachedSurface(var lpDDSCaps: TDDSCaps2;
function GetAttachedSurface (const lpDDSCaps: TDDSCaps2;
out lplpDDAttachedSurface: IDirectDrawSurface7): HResult; stdcall;
function GetBltStatus(dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDDSCaps: TDDSCaps2): HResult; stdcall;
function GetCaps (out lpDDSCaps: TDDSCaps2) : HResult; stdcall;
function GetClipper(out lplpDDClipper: IDirectDrawClipper): HResult; stdcall;
function GetColorKey(dwFlags: DWORD; var lpDDColorKey: TDDColorKey): HResult; stdcall;
function GetDC(var lphDC: HDC): HResult; stdcall;
function GetColorKey (dwFlags: DWORD; out lpDDColorKey: TDDColorKey) :
HResult; stdcall;
function GetDC (out lphDC: HDC) : HResult; stdcall;
function GetFlipStatus(dwFlags: DWORD): HResult; stdcall;
function GetOverlayPosition(var lplX, lplY: Longint): HResult; stdcall;
function GetOverlayPosition (out lplX, lplY: LongInt) : HResult; stdcall;
function GetPalette(out lplpDDPalette: IDirectDrawPalette): HResult; stdcall;
function GetPixelFormat(var lpDDPixelFormat: TDDPixelFormat): HResult; stdcall;
function GetSurfaceDesc(var lpDDSurfaceDesc: TDDSurfaceDesc2): HResult; stdcall;
function Initialize(lpDD: IDirectDraw; const lpDDSurfaceDesc: TDDSurfaceDesc2): HResult; stdcall;
function GetPixelFormat (out lpDDPixelFormat: TDDPixelFormat) : HResult; stdcall;
function GetSurfaceDesc (out lpDDSurfaceDesc: TDDSurfaceDesc2) : HResult; stdcall;
function Initialize (lpDD: IDirectDraw;
out lpDDSurfaceDesc: TDDSurfaceDesc2) : HResult; stdcall;
function IsLost: HResult; stdcall;
function Lock(lpDestRect: PRect; const lpDDSurfaceDesc: TDDSurfaceDesc2;
dwFlags: DWORD; hEvent: THandle): HResult; stdcall;
function ReleaseDC(hDC: HDC): HResult; stdcall;
function Restore: HResult; stdcall;
function Lock (lpDestRect: PRect;
out lpDDSurfaceDesc: TDDSurfaceDesc2; dwFlags: DWORD;
hEvent: THandle) : HResult; stdcall;
function ReleaseDC (hDC: Windows.HDC) : HResult; stdcall;
function _Restore: HResult; stdcall;
function SetClipper(lpDDClipper: IDirectDrawClipper): HResult; stdcall;
function SetColorKey(dwFlags: DWORD; const lpDDColorKey: TDDColorKey): HResult; stdcall;
function SetOverlayPosition(lX, lY: Longint): HResult; stdcall;
function SetColorKey (dwFlags: DWORD; lpDDColorKey: PDDColorKey) :
HResult; stdcall;
function SetOverlayPosition (lX, lY: LongInt) : HResult; stdcall;
function SetPalette(lpDDPalette: IDirectDrawPalette): HResult; stdcall;
function Unlock(lpSurfaceData: Pointer): HResult; stdcall;
function UpdateOverlay(const lpSrcRect: TRect; lpDDDestSurface: IDirectDrawSurface7;
const lpDestRect: TRect; dwFlags: DWORD; const lpDDOverlayFx: TDDOverlayFX): HResult; stdcall;
function Unlock (lpRect: PRect) : HResult; stdcall;
function UpdateOverlay (lpSrcRect: PRect;
lpDDDestSurface: IDirectDrawSurface7; lpDestRect: PRect;
dwFlags: DWORD; lpDDOverlayFx: PDDOverlayFX) : HResult; stdcall;
function UpdateOverlayDisplay(dwFlags: DWORD): HResult; stdcall;
function UpdateOverlayZOrder(dwFlags: DWORD; lpDDSReference: IDirectDrawSurface7): HResult; stdcall;
// IDirectDrawSurface2 methods
function UpdateOverlayZOrder (dwFlags: DWORD;
lpDDSReference: IDirectDrawSurface7) : HResult; stdcall;
(*** Added in the v2 interface ***)
function GetDDInterface(out lplpDD: IUnknown): HResult; stdcall;
function PageLock(dwFlags: DWORD): HResult; stdcall;
function PageUnlock(dwFlags: DWORD): HResult; stdcall;
// IDirectDrawSurface3 methods
function SetSurfaceDesc(const lpddsd: TDDSurfaceDesc2; dwFlags: DWORD): HResult; stdcall;
// IDirectDrawSurface4 methods
function SetPrivateData(const guidTag: TGUID; lpData: Pointer;
(*** Added in the V3 interface ***)
function SetSurfaceDesc(const lpddsd2: TDDSurfaceDesc2; dwFlags: DWORD) : HResult; stdcall;
(*** Added in the v4 interface ***)
function SetPrivateData(const guidTag: TGUID; lpData: pointer;
cbSize: DWORD; dwFlags: DWORD): HResult; stdcall;
function GetPrivateData(const guidTag: TGUID; lpData: Pointer;
var cbSize: DWORD): HResult; stdcall;
function GetPrivateData(const guidTag: TGUID; lpBuffer: pointer;
var lpcbBufferSize: DWORD) : HResult; stdcall;
function FreePrivateData(const guidTag: TGUID): HResult; stdcall;
function GetUniquenessValue(var lpValue: DWORD): HResult; stdcall;
function GetUniquenessValue(out lpValue: DWORD) : HResult; stdcall;
function ChangeUniquenessValue: HResult; stdcall;
// Moved Texture7 methods here
(*** Moved Texture7 methods here ***)
function SetPriority(dwPriority: DWORD): HResult; stdcall;
function GetPriority(var lpdwPriority: DWORD): HResult; stdcall;
function GetPriority(out lpdwPriority: DWORD) : HResult; stdcall;
function SetLOD(dwMaxLOD: DWORD): HResult; stdcall;
function GetLOD(var lpdwMaxLOD: DWORD): HResult; stdcall;
function GetLOD(out lpdwMaxLOD: DWORD) : HResult; stdcall;
end;
 
{ IDirectDrawColorControl Interface }
 
IDirectDrawColorControl = interface(IUnknown)
['{4B9F0EE0-0D7E-11D0-9B06-00A0C903A3B8}']
// IDirectDrawColorControl methods
function GetColorControls(var lpColorControl: TDDColorControl): HResult; stdcall;
function GetColorControls(out lpColorControl: TDDColorControl) : HResult; stdcall;
function SetColorControls(const lpColorControl: TDDColorControl): HResult; stdcall;
end;
 
{ IDirectDrawGammaControl Interface }
 
(*
* IDirectDrawGammaControl
*)
IDirectDrawGammaControl = interface(IUnknown)
['{69C11C3E-B46B-11D1-AD7A-00C04FC29B4E}']
// IDirectDrawGammaControl methods
function GetGammaRamp(dwFlags: DWORD; var lpRampData: TDDGammaRamp): HResult; stdcall;
function SetGammaRamp(dwFlags: DWORD; const lpRampData: TDDGammaRamp): HResult; stdcall;
function GetGammaRamp (dwFlags: DWORD; out lpRampData: TDDGammaRamp)
: HResult; stdcall;
function SetGammaRamp (dwFlags: DWORD; const lpRampData: TDDGammaRamp)
: HResult; stdcall;
end;
 
const
{ Flags for DirectDrawEnumerateEx }
DDENUM_ATTACHEDSECONDARYDEVICES = $00000001;
DDENUM_DETACHEDSECONDARYDEVICES = $00000002;
DDENUM_NONDISPLAYDEVICES = $00000004;
type
IID_IDirectDraw = IDirectDraw;
IID_IDirectDraw2 = IDirectDraw2;
IID_IDirectDraw4 = IDirectDraw4;
IID_IDirectDraw7 = IDirectDraw7;
IID_IDirectDrawSurface = IDirectDrawSurface;
IID_IDirectDrawSurface2 = IDirectDrawSurface2;
IID_IDirectDrawSurface3 = IDirectDrawSurface3;
IID_IDirectDrawSurface4 = IDirectDrawSurface4;
IID_IDirectDrawSurface7 = IDirectDrawSurface7;
 
{ Flags for the IDirectDraw4.GetDeviceIdentifier method }
DDGDI_GETHOSTIDENTIFIER = $00000001;
IID_IDirectDrawPalette = IDirectDrawPalette;
IID_IDirectDrawClipper = IDirectDrawClipper;
IID_IDirectDrawColorControl = IDirectDrawColorControl;
IID_IDirectDrawGammaControl = IDirectDrawGammaControl;
 
{ ddsCaps field is valid. }
const
(*
* ddsCaps field is valid.
*)
DDSD_CAPS = $00000001; // default
 
(*
* dwHeight field is valid.
*)
DDSD_HEIGHT = $00000002;
 
(*
* dwWidth field is valid.
*)
DDSD_WIDTH = $00000004;
 
(*
* lPitch is valid.
*)
DDSD_PITCH = $00000008;
 
(*
* dwBackBufferCount is valid.
*)
DDSD_BACKBUFFERCOUNT = $00000020;
 
(*
* dwZBufferBitDepth is valid. (shouldnt be used in DDSURFACEDESC2)
*)
DDSD_ZBUFFERBITDEPTH = $00000040;
 
(*
* dwAlphaBitDepth is valid.
*)
DDSD_ALPHABITDEPTH = $00000080;
 
(*
* lpSurface is valid.
*)
DDSD_LPSURFACE = $00000800;
 
(*
* ddpfPixelFormat is valid.
*)
DDSD_PIXELFORMAT = $00001000;
 
(*
* ddckCKDestOverlay is valid.
*)
DDSD_CKDESTOVERLAY = $00002000;
 
(*
* ddckCKDestBlt is valid.
*)
DDSD_CKDESTBLT = $00004000;
 
(*
* ddckCKSrcOverlay is valid.
*)
DDSD_CKSRCOVERLAY = $00008000;
 
(*
* ddckCKSrcBlt is valid.
*)
DDSD_CKSRCBLT = $00010000;
 
(*
* dwMipMapCount is valid.
*)
DDSD_MIPMAPCOUNT = $00020000;
 
(*
* dwRefreshRate is valid
*)
DDSD_REFRESHRATE = $00040000;
 
(*
* dwLinearSize is valid
*)
DDSD_LINEARSIZE = $00080000;
 
(*
* dwTextureStage is valid
*)
DDSD_TEXTURESTAGE = $00100000;
DDSD_FVF = $00200000;
DDSD_SRCVBHANDLE = $00400000;
DDSD_ALL = $007ff9ee;
 
{ DirectDraw Driver Capability Flags }
(*
* All input fields are valid.
*)
DDSD_ALL = $001ff9ee;
 
 
(*
* guid field is valid.
*)
DDOSD_GUID = $00000001;
 
(*
* dwCompressionRatio field is valid.
*)
DDOSD_COMPRESSION_RATIO = $00000002;
 
(*
* ddSCaps field is valid.
*)
DDOSD_SCAPS = $00000004;
 
(*
* ddOSCaps field is valid.
*)
DDOSD_OSCAPS = $00000008;
 
(*
* All input fields are valid.
*)
DDOSD_ALL = $0000000f;
 
(*
* The surface's optimized pixelformat is compressed
*)
DDOSDCAPS_OPTCOMPRESSED = $00000001;
 
(*
* The surface's optimized pixelformat is reordered
*)
DDOSDCAPS_OPTREORDERED = $00000002;
 
(*
* The opt surface is a monolithic mipmap
*)
DDOSDCAPS_MONOLITHICMIPMAP = $00000004;
 
(*
* The valid Surf caps:
* DDSCAPS_SYSTEMMEMORY = $00000800;
* DDSCAPS_VIDEOMEMORY = $00004000;
* DDSCAPS_LOCALVIDMEM = $10000000;
* DDSCAPS_NONLOCALVIDMEM = $20000000;
*)
DDOSDCAPS_VALIDSCAPS = $30004800;
 
(*
* The valid OptSurf caps
*)
DDOSDCAPS_VALIDOSCAPS = $00000007;
 
 
(*
* DDCOLORCONTROL
*)
 
(*
* lBrightness field is valid.
*)
DDCOLOR_BRIGHTNESS = $00000001;
 
(*
* lContrast field is valid.
*)
DDCOLOR_CONTRAST = $00000002;
 
(*
* lHue field is valid.
*)
DDCOLOR_HUE = $00000004;
 
(*
* lSaturation field is valid.
*)
DDCOLOR_SATURATION = $00000008;
 
(*
* lSharpness field is valid.
*)
DDCOLOR_SHARPNESS = $00000010;
 
(*
* lGamma field is valid.
*)
DDCOLOR_GAMMA = $00000020;
 
(*
* lColorEnable field is valid.
*)
DDCOLOR_COLORENABLE = $00000040;
 
 
 
(*============================================================================
*
* Direct Draw Capability Flags
*
* These flags are used to describe the capabilities of a given Surface.
* All flags are bit flags.
*
*==========================================================================*)
 
(****************************************************************************
*
* DIRECTDRAWSURFACE CAPABILITY FLAGS
*
****************************************************************************)
(*
* This bit currently has no meaning.
*)
DDSCAPS_RESERVED1 = $00000001;
 
(*
* Indicates that this surface contains alpha-only information.
* (To determine if a surface is RGBA/YUVA, the pixel format must be
* interrogated.)
*)
DDSCAPS_ALPHA = $00000002;
 
(*
* Indicates that this surface is a backbuffer. It is generally
* set by CreateSurface when the DDSCAPS_FLIP capability bit is set.
* It indicates that this surface is THE back buffer of a surface
* flipping structure. DirectDraw supports N surfaces in a
* surface flipping structure. Only the surface that immediately
* precedeces the DDSCAPS_FRONTBUFFER has this capability bit set.
* The other surfaces are identified as back buffers by the presence
* of the DDSCAPS_FLIP capability, their attachment order, and the
* absence of the DDSCAPS_FRONTBUFFER and DDSCAPS_BACKBUFFER
* capabilities. The bit is sent to CreateSurface when a standalone
* back buffer is being created. This surface could be attached to
* a front buffer and/or back buffers to form a flipping surface
* structure after the CreateSurface call. See AddAttachments for
* a detailed description of the behaviors in this case.
*)
DDSCAPS_BACKBUFFER = $00000004;
 
(*
* Indicates a complex surface structure is being described. A
* complex surface structure results in the creation of more than
* one surface. The additional surfaces are attached to the root
* surface. The complex structure can only be destroyed by
* destroying the root.
*)
DDSCAPS_COMPLEX = $00000008;
 
(*
* Indicates that this surface is a part of a surface flipping structure.
* When it is passed to CreateSurface the DDSCAPS_FRONTBUFFER and
* DDSCAP_BACKBUFFER bits are not set. They are set by CreateSurface
* on the resulting creations. The dwBackBufferCount field in the
* TDDSurfaceDesc structure must be set to at least 1 in order for
* the CreateSurface call to succeed. The DDSCAPS_COMPLEX capability
* must always be set with creating multiple surfaces through CreateSurface.
*)
DDSCAPS_FLIP = $00000010;
 
(*
* Indicates that this surface is THE front buffer of a surface flipping
* structure. It is generally set by CreateSurface when the DDSCAPS_FLIP
* capability bit is set.
* If this capability is sent to CreateSurface then a standalonw front buffer
* is created. This surface will not have the DDSCAPS_FLIP capability.
* It can be attached to other back buffers to form a flipping structure.
* See AddAttachments for a detailed description of the behaviors in this
* case.
*)
DDSCAPS_FRONTBUFFER = $00000020;
 
(*
* Indicates that this surface is any offscreen surface that is not an overlay,
* texture, zbuffer, front buffer, back buffer, or alpha surface. It is used
* to identify plain vanilla surfaces.
*)
DDSCAPS_OFFSCREENPLAIN = $00000040;
 
(*
* Indicates that this surface is an overlay. It may or may not be directly visible
* depending on whether or not it is currently being overlayed onto the primary
* surface. DDSCAPS_VISIBLE can be used to determine whether or not it is being
* overlayed at the moment.
*)
DDSCAPS_OVERLAY = $00000080;
 
(*
* Indicates that unique DirectDrawPalette objects can be created and
* attached to this surface.
*)
DDSCAPS_PALETTE = $00000100;
 
(*
* Indicates that this surface is the primary surface. The primary
* surface represents what the user is seeing at the moment.
*)
DDSCAPS_PRIMARYSURFACE = $00000200;
 
(*
* This flag used to be DDSCAPS_PRIMARYSURFACELEFT, which is now
* obsolete.
*)
DDSCAPS_RESERVED3 = $00000400;
(*
* Indicates that this surface is the primary surface for the left eye.
* The primary surface for the left eye represents what the user is seeing
* at the moment with the users left eye. When this surface is created the
* DDSCAPS_PRIMARYSURFACE represents what the user is seeing with the users
* right eye.
*)
DDSCAPS_PRIMARYSURFACELEFT = DDSCAPS_RESERVED3;
 
(*
* Indicates that this surface memory was allocated in system memory
*)
DDSCAPS_SYSTEMMEMORY = $00000800;
 
(*
* Indicates that this surface can be used as a 3D texture. It does not
* indicate whether or not the surface is being used for that purpose.
*)
DDSCAPS_TEXTURE = $00001000;
 
(*
* Indicates that a surface may be a destination for 3D rendering. This
* bit must be set in order to query for a Direct3D Device Interface
* from this surface.
*)
DDSCAPS_3DDEVICE = $00002000;
 
(*
* Indicates that this surface exists in video memory.
*)
DDSCAPS_VIDEOMEMORY = $00004000;
 
(*
* Indicates that changes made to this surface are immediately visible.
* It is always set for the primary surface and is set for overlays while
* they are being overlayed and texture maps while they are being textured.
*)
DDSCAPS_VISIBLE = $00008000;
 
(*
* Indicates that only writes are permitted to the surface. Read accesses
* from the surface may or may not generate a protection fault, but the
* results of a read from this surface will not be meaningful. READ ONLY.
*)
DDSCAPS_WRITEONLY = $00010000;
 
(*
* Indicates that this surface is a z buffer. A z buffer does not contain
* displayable information. Instead it contains bit depth information that is
* used to determine which pixels are visible and which are obscured.
*)
DDSCAPS_ZBUFFER = $00020000;
 
(*
* Indicates surface will have a DC associated long term
*)
DDSCAPS_OWNDC = $00040000;
 
(*
* Indicates surface should be able to receive live video
*)
DDSCAPS_LIVEVIDEO = $00080000;
 
(*
* Indicates surface should be able to have a stream decompressed
* to it by the hardware.
*)
DDSCAPS_HWCODEC = $00100000;
 
(*
* Surface is a ModeX surface.
*
*)
DDSCAPS_MODEX = $00200000;
 
(*
* Indicates surface is one level of a mip-map. This surface will
* be attached to other DDSCAPS_MIPMAP surfaces to form the mip-map.
* This can be done explicitly, by creating a number of surfaces and
* attaching them with AddAttachedSurface or by implicitly by CreateSurface.
* If this bit is set then DDSCAPS_TEXTURE must also be set.
*)
DDSCAPS_MIPMAP = $00400000;
 
(*
* This bit is reserved. It should not be specified.
*)
DDSCAPS_RESERVED2 = $00800000;
 
(*
* Indicates that memory for the surface is not allocated until the surface
* is loaded (via the Direct3D texture Load() function).
*)
DDSCAPS_ALLOCONLOAD = $04000000;
 
(*
* Indicates that the surface will recieve data from a video port.
*)
DDSCAPS_VIDEOPORT = $08000000;
 
(*
* Indicates that a video memory surface is resident in true, local video
* memory rather than non-local video memory. If this flag is specified then
* so must DDSCAPS_VIDEOMEMORY. This flag is mutually exclusive with
* DDSCAPS_NONLOCALVIDMEM.
*)
DDSCAPS_LOCALVIDMEM = $10000000;
 
(*
* Indicates that a video memory surface is resident in non-local video
* memory rather than true, local video memory. If this flag is specified
* then so must DDSCAPS_VIDEOMEMORY. This flag is mutually exclusive with
* DDSCAPS_LOCALVIDMEM.
*)
DDSCAPS_NONLOCALVIDMEM = $20000000;
 
(*
* Indicates that this surface is a standard VGA mode surface, and not a
* ModeX surface. (This flag will never be set in combination with the
* DDSCAPS_MODEX flag).
*)
DDSCAPS_STANDARDVGAMODE = $40000000;
 
(*
* Indicates that this surface will be an optimized surface. This flag is
* currently only valid in conjunction with the DDSCAPS_TEXTURE flag. The surface
* will be created without any underlying video memory until loaded.
*)
DDSCAPS_OPTIMIZED = $80000000;
 
 
 
(*
* Indicates that this surface will receive data from a video port using
* the de-interlacing hardware. This allows the driver to allocate memory
* for any extra buffers that may be required. The DDSCAPS_VIDEOPORT and
* DDSCAPS_OVERLAY flags must also be set.
*)
DDSCAPS2_HARDWAREDEINTERLACE = $00000002;
 
(*
* Indicates to the driver that this surface will be locked very frequently
* (for procedural textures, dynamic lightmaps, etc). Surfaces with this cap
* set must also have DDSCAPS_TEXTURE. This cap cannot be used with
* DDSCAPS2_HINTSTATIC and DDSCAPS2_OPAQUE.
*)
DDSCAPS2_HINTDYNAMIC = $00000004;
 
(*
* Indicates to the driver that this surface can be re-ordered/retiled on
* load. This operation will not change the size of the texture. It is
* relatively fast and symmetrical, since the application may lock these
* bits (although it will take a performance hit when doing so). Surfaces
* with this cap set must also have DDSCAPS_TEXTURE. This cap cannot be
* used with DDSCAPS2_HINTDYNAMIC and DDSCAPS2_OPAQUE.
*)
DDSCAPS2_HINTSTATIC = $00000008;
 
(*
* Indicates that the client would like this texture surface to be managed by the
* DirectDraw/Direct3D runtime. Surfaces with this cap set must also have
* DDSCAPS_TEXTURE and DDSCAPS_SYSTEMMEMORY.
*)
DDSCAPS2_TEXTUREMANAGE = $00000010;
 
(*
* These bits are reserved for internal use *)
DDSCAPS2_RESERVED1 = $00000020;
DDSCAPS2_RESERVED2 = $00000040;
 
(*
* Indicates to the driver that this surface will never be locked again.
* The driver is free to optimize this surface via retiling and actual compression.
* All calls to Lock() or Blts from this surface will fail. Surfaces with this
* cap set must also have DDSCAPS_TEXTURE. This cap cannot be used with
* DDSCAPS2_HINTDYNAMIC and DDSCAPS2_HINTSTATIC.
*)
DDSCAPS2_OPAQUE = $00000080;
 
(*
* Applications should set this bit at CreateSurface time to indicate that they
* intend to use antialiasing. Only valid if DDSCAPS_3DDEVICE is also set.
*)
DDSCAPS2_HINTANTIALIASING = $00000100;
 
(*
* This flag is used at CreateSurface time to indicate that this set of
* surfaces is a cubic environment map
*)
DDSCAPS2_CUBEMAP = $00000200;
 
(*
* These flags preform two functions:
* - At CreateSurface time, they define which of the six cube faces are
* required by the application.
* - After creation, each face in the cubemap will have exactly one of these
* bits set.
*)
DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
 
(*
* This macro may be used to specify all faces of a cube map at CreateSurface time
*)
DDSCAPS2_CUBEMAP_ALLFACES = ( DDSCAPS2_CUBEMAP_POSITIVEX or
DDSCAPS2_CUBEMAP_NEGATIVEX or
DDSCAPS2_CUBEMAP_POSITIVEY or
DDSCAPS2_CUBEMAP_NEGATIVEY or
DDSCAPS2_CUBEMAP_POSITIVEZ or
DDSCAPS2_CUBEMAP_NEGATIVEZ );
 
 
(*
* This flag is an additional flag which is present on mipmap sublevels from DX7 onwards
* It enables easier use of GetAttachedSurface rather than EnumAttachedSurfaces for surface
* constructs such as Cube Maps, wherein there are more than one mipmap surface attached
* to the root surface.
* This caps bit is ignored by CreateSurface
*)
DDSCAPS2_MIPMAPSUBLEVEL = $00010000;
 
(* This flag indicates that the texture should be managed by D3D only *)
DDSCAPS2_D3DTEXTUREMANAGE = $00020000;
 
(* This flag indicates that the managed surface can be safely lost *)
DDSCAPS2_DONOTPERSIST = $00040000;
 
(* indicates that this surface is part of a stereo flipping chain *)
DDSCAPS2_STEREOSURFACELEFT = $00080000;
 
 
 
(****************************************************************************
*
* DIRECTDRAW DRIVER CAPABILITY FLAGS
*
****************************************************************************)
 
(*
* Display hardware has 3D acceleration.
*)
DDCAPS_3D = $00000001;
 
(*
* Indicates that DirectDraw will support only dest rectangles that are aligned
* on DIRECTDRAWCAPS.dwAlignBoundaryDest boundaries of the surface, respectively.
* READ ONLY.
*)
DDCAPS_ALIGNBOUNDARYDEST = $00000002;
 
(*
* Indicates that DirectDraw will support only source rectangles whose sizes in
* BYTEs are DIRECTDRAWCAPS.dwAlignSizeDest multiples, respectively. READ ONLY.
*)
DDCAPS_ALIGNSIZEDEST = $00000004;
(*
* Indicates that DirectDraw will support only source rectangles that are aligned
* on DIRECTDRAWCAPS.dwAlignBoundarySrc boundaries of the surface, respectively.
* READ ONLY.
*)
DDCAPS_ALIGNBOUNDARYSRC = $00000008;
 
(*
* Indicates that DirectDraw will support only source rectangles whose sizes in
* BYTEs are DIRECTDRAWCAPS.dwAlignSizeSrc multiples, respectively. READ ONLY.
*)
DDCAPS_ALIGNSIZESRC = $00000010;
 
(*
* Indicates that DirectDraw will create video memory surfaces that have a stride
* alignment equal to DIRECTDRAWCAPS.dwAlignStride. READ ONLY.
*)
DDCAPS_ALIGNSTRIDE = $00000020;
 
(*
* Display hardware is capable of blt operations.
*)
DDCAPS_BLT = $00000040;
 
(*
* Display hardware is capable of asynchronous blt operations.
*)
DDCAPS_BLTQUEUE = $00000080;
 
(*
* Display hardware is capable of color space conversions during the blt operation.
*)
DDCAPS_BLTFOURCC = $00000100;
 
(*
* Display hardware is capable of stretching during blt operations.
*)
DDCAPS_BLTSTRETCH = $00000200;
 
(*
* Display hardware is shared with GDI.
*)
DDCAPS_GDI = $00000400;
 
(*
* Display hardware can overlay.
*)
DDCAPS_OVERLAY = $00000800;
 
(*
* Set if display hardware supports overlays but can not clip them.
*)
DDCAPS_OVERLAYCANTCLIP = $00001000;
 
(*
* Indicates that overlay hardware is capable of color space conversions during
* the overlay operation.
*)
DDCAPS_OVERLAYFOURCC = $00002000;
 
(*
* Indicates that stretching can be done by the overlay hardware.
*)
DDCAPS_OVERLAYSTRETCH = $00004000;
 
(*
* Indicates that unique DirectDrawPalettes can be created for DirectDrawSurfaces
* other than the primary surface.
*)
DDCAPS_PALETTE = $00008000;
 
(*
* Indicates that palette changes can be syncd with the veritcal refresh.
*)
DDCAPS_PALETTEVSYNC = $00010000;
 
(*
* Display hardware can return the current scan line.
*)
DDCAPS_READSCANLINE = $00020000;
 
(*
* Display hardware has stereo vision capabilities. DDSCAPS_PRIMARYSURFACELEFT
* can be created.
*)
DDCAPS_STEREOVIEW = $00040000;
 
(*
* Display hardware is capable of generating a vertical blank interrupt.
*)
DDCAPS_VBI = $00080000;
 
(*
* Supports the use of z buffers with blt operations.
*)
DDCAPS_ZBLTS = $00100000;
 
(*
* Supports Z Ordering of overlays.
*)
DDCAPS_ZOVERLAYS = $00200000;
 
(*
* Supports color key
*)
DDCAPS_COLORKEY = $00400000;
 
(*
* Supports alpha surfaces
*)
DDCAPS_ALPHA = $00800000;
 
(*
* colorkey is hardware assisted(DDCAPS_COLORKEY will also be set)
*)
DDCAPS_COLORKEYHWASSIST = $01000000;
 
(*
* no hardware support at all
*)
DDCAPS_NOHARDWARE = $02000000;
 
(*
* Display hardware is capable of color fill with bltter
*)
DDCAPS_BLTCOLORFILL = $04000000;
 
(*
* Display hardware is bank switched, and potentially very slow at
* random access to VRAM.
*)
DDCAPS_BANKSWITCHED = $08000000;
 
(*
* Display hardware is capable of depth filling Z-buffers with bltter
*)
DDCAPS_BLTDEPTHFILL = $10000000;
 
(*
* Display hardware is capable of clipping while bltting.
*)
DDCAPS_CANCLIP = $20000000;
 
(*
* Display hardware is capable of clipping while stretch bltting.
*)
DDCAPS_CANCLIPSTRETCHED = $40000000;
 
(*
* Display hardware is capable of bltting to or from system memory
*)
DDCAPS_CANBLTSYSMEM = $80000000;
 
{ More DirectDraw Driver Capability Flags (dwCaps2) }
 
(****************************************************************************
*
* MORE DIRECTDRAW DRIVER CAPABILITY FLAGS (dwCaps2)
*
****************************************************************************)
 
(*
* Display hardware is certified
*)
DDCAPS2_CERTIFIED = $00000001;
 
(*
* Driver cannot interleave 2D operations (lock and blt) to surfaces with
* Direct3D rendering operations between calls to BeginScene() and EndScene()
*)
DDCAPS2_NO2DDURING3DSCENE = $00000002;
 
(*
* Display hardware contains a video port
*)
DDCAPS2_VIDEOPORT = $00000004;
 
(*
* The overlay can be automatically flipped according to the video port
* VSYNCs, providing automatic doubled buffered display of video port
* data using an overlay
*)
DDCAPS2_AUTOFLIPOVERLAY = $00000008;
 
(*
* Overlay can display each field of interlaced data individually while
* it is interleaved in memory without causing jittery artifacts.
*)
DDCAPS2_CANBOBINTERLEAVED = $00000010;
 
(*
* Overlay can display each field of interlaced data individually while
* it is not interleaved in memory without causing jittery artifacts.
*)
DDCAPS2_CANBOBNONINTERLEAVED = $00000020;
 
(*
* The overlay surface contains color controls (brightness, sharpness, etc.)
*)
DDCAPS2_COLORCONTROLOVERLAY = $00000040;
 
(*
* The primary surface contains color controls (gamma, etc.)
*)
DDCAPS2_COLORCONTROLPRIMARY = $00000080;
 
(*
* RGBZ -> RGB supported for 16:16 RGB:Z
*)
DDCAPS2_CANDROPZ16BIT = $00000100;
 
(*
* Driver supports non-local video memory.
*)
DDCAPS2_NONLOCALVIDMEM = $00000200;
 
(*
* Dirver supports non-local video memory but has different capabilities for
* non-local video memory surfaces. If this bit is set then so must
* DDCAPS2_NONLOCALVIDMEM.
*)
DDCAPS2_NONLOCALVIDMEMCAPS = $00000400;
 
(*
* Driver neither requires nor prefers surfaces to be pagelocked when performing
* blts involving system memory surfaces
*)
DDCAPS2_NOPAGELOCKREQUIRED = $00000800;
 
(*
* Driver can create surfaces which are wider than the primary surface
*)
DDCAPS2_WIDESURFACES = $00001000;
 
(*
* Driver supports bob without using a video port by handling the
* DDFLIP_ODD and DDFLIP_EVEN flags specified in Flip.
*)
DDCAPS2_CANFLIPODDEVEN = $00002000;
 
(*
* Driver supports bob using hardware
*)
DDCAPS2_CANBOBHARDWARE = $00004000;
 
(*
* Driver supports bltting any FOURCC surface to another surface of the same FOURCC
*)
DDCAPS2_COPYFOURCC = $00008000;
DDCAPS2_PRIMARYGAMMA = $00020000;
DDCAPS2_CANRENDERWINDOWED = $00080000;
DDCAPS2_CANCALIBRATEGAMMA = $00100000;
DDCAPS2_FLIPINTERVAL = $00200000;
DDCAPS2_FLIPNOVSYNC = $00400000;
DDCAPS2_CANMANAGETEXTURE = $00800000;
DDCAPS2_TEXMANINNONLOCALVIDMEM = $01000000;
DDCAPS2_STEREO = $02000000;
DDCAPS2_SYSTONONLOCAL_AS_SYSTOLOCAL = $04000000;
 
{ DirectDrawSurface Capability Flags }
 
DDSCAPS_RESERVED1 = $00000001; { DDSCAPS_3D }
DDSCAPS_ALPHA = $00000002;
DDSCAPS_BACKBUFFER = $00000004;
DDSCAPS_COMPLEX = $00000008;
DDSCAPS_FLIP = $00000010;
DDSCAPS_FRONTBUFFER = $00000020;
DDSCAPS_OFFSCREENPLAIN = $00000040;
DDSCAPS_OVERLAY = $00000080;
DDSCAPS_PALETTE = $00000100;
DDSCAPS_PRIMARYSURFACE = $00000200;
DDSCAPS_RESERVED3 = $00000400; { DDSCAPS_PRIMARYSURFACELEFT }
DDSCAPS_SYSTEMMEMORY = $00000800;
DDSCAPS_TEXTURE = $00001000;
DDSCAPS_3DDEVICE = $00002000;
DDSCAPS_VIDEOMEMORY = $00004000;
DDSCAPS_VISIBLE = $00008000;
DDSCAPS_WRITEONLY = $00010000;
DDSCAPS_ZBUFFER = $00020000;
DDSCAPS_OWNDC = $00040000;
DDSCAPS_LIVEVIDEO = $00080000;
DDSCAPS_HWCODEC = $00100000;
DDSCAPS_MODEX = $00200000;
DDSCAPS_MIPMAP = $00400000;
DDSCAPS_RESERVED2 = $00800000;
DDSCAPS_ALLOCONLOAD = $04000000;
DDSCAPS_VIDEOPORT = $08000000;
DDSCAPS_LOCALVIDMEM = $10000000;
DDSCAPS_NONLOCALVIDMEM = $20000000;
DDSCAPS_STANDARDVGAMODE = $40000000;
DDSCAPS_OPTIMIZED = $80000000;
(*
* Driver supports loadable gamma ramps for the primary surface
*)
DDCAPS2_PRIMARYGAMMA = $00020000;
 
{ DirectDrawSurface Capability Flags 2 }
(*
* Driver can render in windowed mode.
*)
DDCAPS2_CANRENDERWINDOWED = $00080000;
 
DDSCAPS2_HARDWAREDEINTERLACE = $00000002;
DDSCAPS2_HINTDYNAMIC = $00000004;
DDSCAPS2_HINTSTATIC = $00000008;
DDSCAPS2_TEXTUREMANAGE = $00000010;
DDSCAPS2_RESERVED1 = $00000020;
DDSCAPS2_RESERVED2 = $00000040;
DDSCAPS2_OPAQUE = $00000080;
DDSCAPS2_HINTANTIALIASING = $00000100;
DDSCAPS2_CUBEMAP = $00000200;
DDSCAPS2_CUBEMAP_POSITIVEX = $00000400;
DDSCAPS2_CUBEMAP_NEGATIVEX = $00000800;
DDSCAPS2_CUBEMAP_POSITIVEY = $00001000;
DDSCAPS2_CUBEMAP_NEGATIVEY = $00002000;
DDSCAPS2_CUBEMAP_POSITIVEZ = $00004000;
DDSCAPS2_CUBEMAP_NEGATIVEZ = $00008000;
(*
* A calibrator is available to adjust the gamma ramp according to the
* physical display properties so that the result will be identical on
* all calibrated systems.
*)
DDCAPS2_CANCALIBRATEGAMMA = $00100000;
 
DDSCAPS2_CUBEMAP_ALLFACES =
DDSCAPS2_CUBEMAP_POSITIVEX or DDSCAPS2_CUBEMAP_NEGATIVEX or
DDSCAPS2_CUBEMAP_POSITIVEY or DDSCAPS2_CUBEMAP_NEGATIVEY or
DDSCAPS2_CUBEMAP_POSITIVEZ or DDSCAPS2_CUBEMAP_NEGATIVEZ;
(*
* Indicates that the driver will respond to DDFLIP_INTERVALn flags
*)
DDCAPS2_FLIPINTERVAL = $00200000;
 
DDSCAPS2_MIPMAPSUBLEVEL = $00010000;
DDSCAPS2_D3DTEXTUREMANAGE = $00020000;
DDSCAPS2_DONOTPERSIST = $00040000;
DDSCAPS2_STEREOSURFACELEFT = $00080000;
(*
* Indicates that the driver will respond to DDFLIP_NOVSYNC
*)
DDCAPS2_FLIPNOVSYNC = $00400000;
 
{ TDDOptSurfaceDesc flags }
(*
* Driver supports management of video memory, if this flag is ON,
* driver manages the texture if requested with DDSCAPS2_TEXTUREMANAGE on
* DirectX manages the texture if this flag is OFF and surface has DDSCAPS2_TEXTUREMANAGE on
*)
DDCAPS2_CANMANAGETEXTURE = $00800000;
 
DDOSD_GUID = $00000001;
DDOSD_COMPRESSION_RATIO = $00000002;
DDOSD_SCAPS = $00000004;
DDOSD_OSCAPS = $00000008;
DDOSD_ALL = $0000000F;
(*
* The Direct3D texture manager uses this cap to decide whether to put managed
* surfaces in non-local video memory. If the cap is set, the texture manager will
* put managed surfaces in non-local vidmem. Drivers that cannot texture from
* local vidmem SHOULD NOT set this cap.
*)
DDCAPS2_TEXMANINNONLOCALVIDMEM = $01000000;
 
{ ddOSCaps field is valid. }
(*
* Indicates that the driver supports DX7 type of stereo in at least one mode (which may
* not necessarily be the current mode). Applications should use IDirectDraw7 (or higher)
* ::EnumDisplayModes and check the DDSURFACEDESC.ddsCaps.dwCaps2 field for the presence of
* DDSCAPS2_STEREOSURFACELEFT to check if a particular mode supports stereo. The application
* can also use IDirectDraw7(or higher)::GetDisplayMode to check the current mode.
*)
DDCAPS2_STEREO = $02000000;
 
DDOSDCAPS_OPTCOMPRESSED = $00000001;
DDOSDCAPS_OPTREORDERED = $00000002;
DDOSDCAPS_MONOLITHICMIPMAP = $00000004;
DDOSDCAPS_VALIDSCAPS = $30004800;
DDOSDCAPS_VALIDOSCAPS = $00000007;
(*
* This caps bit is intended for internal DirectDraw use.
* -It is only valid if DDCAPS2_NONLOCALVIDMEMCAPS is set.
* -If this bit is set, then DDCAPS_CANBLTSYSMEM MUST be set by the driver (and
* all the assoicated system memory blt caps must be correct).
* -It implies that the system->video blt caps in DDCAPS also apply to system to
* nonlocal blts. I.e. the dwSVBCaps, dwSVBCKeyCaps, dwSVBFXCaps and dwSVBRops
* members of DDCAPS (DDCORECAPS) are filled in correctly.
* -Any blt from system to nonlocal memory that matches these caps bits will
* be passed to the driver.
*
* NOTE: This is intended to enable the driver itself to do efficient reordering
* of textures. This is NOT meant to imply that hardware can write into AGP memory.
* This operation is not currently supported.
*)
DDCAPS2_SYSTONONLOCAL_AS_SYSTOLOCAL = $04000000;
 
{ DirectDraw FX Alpha Capability Flags }
(****************************************************************************
*
* DIRECTDRAW FX ALPHA CAPABILITY FLAGS
*
****************************************************************************)
 
(*
* Supports alpha blending around the edge of a source color keyed surface.
* For Blt.
*)
DDFXALPHACAPS_BLTALPHAEDGEBLEND = $00000001;
 
(*
* Supports alpha information in the pixel format. The bit depth of alpha
* information in the pixel format can be 1,2,4, or 8. The alpha value becomes
* more opaque as the alpha value increases. (0 is transparent.)
* For Blt.
*)
DDFXALPHACAPS_BLTALPHAPIXELS = $00000002;
 
(*
* Supports alpha information in the pixel format. The bit depth of alpha
* information in the pixel format can be 1,2,4, or 8. The alpha value
* becomes more transparent as the alpha value increases. (0 is opaque.)
* This flag can only be set if DDCAPS_ALPHA is set.
* For Blt.
*)
DDFXALPHACAPS_BLTALPHAPIXELSNEG = $00000004;
 
(*
* Supports alpha only surfaces. The bit depth of an alpha only surface can be
* 1,2,4, or 8. The alpha value becomes more opaque as the alpha value increases.
* (0 is transparent.)
* For Blt.
*)
DDFXALPHACAPS_BLTALPHASURFACES = $00000008;
 
(*
* The depth of the alpha channel data can range can be 1,2,4, or 8.
* The NEG suffix indicates that this alpha channel becomes more transparent
* as the alpha value increases. (0 is opaque.) This flag can only be set if
* DDCAPS_ALPHA is set.
* For Blt.
*)
DDFXALPHACAPS_BLTALPHASURFACESNEG = $00000010;
 
(*
* Supports alpha blending around the edge of a source color keyed surface.
* For Overlays.
*)
DDFXALPHACAPS_OVERLAYALPHAEDGEBLEND = $00000020;
 
(*
* Supports alpha information in the pixel format. The bit depth of alpha
* information in the pixel format can be 1,2,4, or 8. The alpha value becomes
* more opaque as the alpha value increases. (0 is transparent.)
* For Overlays.
*)
DDFXALPHACAPS_OVERLAYALPHAPIXELS = $00000040;
 
(*
* Supports alpha information in the pixel format. The bit depth of alpha
* information in the pixel format can be 1,2,4, or 8. The alpha value
* becomes more transparent as the alpha value increases. (0 is opaque.)
* This flag can only be set if DDCAPS_ALPHA is set.
* For Overlays.
*)
DDFXALPHACAPS_OVERLAYALPHAPIXELSNEG = $00000080;
 
(*
* Supports alpha only surfaces. The bit depth of an alpha only surface can be
* 1,2,4, or 8. The alpha value becomes more opaque as the alpha value increases.
* (0 is transparent.)
* For Overlays.
*)
DDFXALPHACAPS_OVERLAYALPHASURFACES = $00000100;
 
(*
* The depth of the alpha channel data can range can be 1,2,4, or 8.
* The NEG suffix indicates that this alpha channel becomes more transparent
* as the alpha value increases. (0 is opaque.) This flag can only be set if
* DDCAPS_ALPHA is set.
* For Overlays.
*)
DDFXALPHACAPS_OVERLAYALPHASURFACESNEG = $00000200;
 
{ DirectDraw FX Capability Flags }
(****************************************************************************
*
* DIRECTDRAW FX CAPABILITY FLAGS
*
****************************************************************************)
 
(*
* Uses arithmetic operations to stretch and shrink surfaces during blt
* rather than pixel doubling techniques. Along the Y axis.
*)
DDFXCAPS_BLTARITHSTRETCHY = $00000020;
 
(*
* Uses arithmetic operations to stretch during blt
* rather than pixel doubling techniques. Along the Y axis. Only
* works for x1, x2, etc.
*)
DDFXCAPS_BLTARITHSTRETCHYN = $00000010;
 
(*
* Supports mirroring left to right in blt.
*)
DDFXCAPS_BLTMIRRORLEFTRIGHT = $00000040;
 
(*
* Supports mirroring top to bottom in blt.
*)
DDFXCAPS_BLTMIRRORUPDOWN = $00000080;
 
(*
* Supports arbitrary rotation for blts.
*)
DDFXCAPS_BLTROTATION = $00000100;
 
(*
* Supports 90 degree rotations for blts.
*)
DDFXCAPS_BLTROTATION90 = $00000200;
 
(*
* DirectDraw supports arbitrary shrinking of a surface along the
* x axis (horizontal direction) for blts.
*)
DDFXCAPS_BLTSHRINKX = $00000400;
 
(*
* DirectDraw supports integer shrinking (1x,2x,) of a surface
* along the x axis (horizontal direction) for blts.
*)
DDFXCAPS_BLTSHRINKXN = $00000800;
 
(*
* DirectDraw supports arbitrary shrinking of a surface along the
* y axis (horizontal direction) for blts.
*)
DDFXCAPS_BLTSHRINKY = $00001000;
 
(*
* DirectDraw supports integer shrinking (1x,2x,) of a surface
* along the y axis (vertical direction) for blts.
*)
DDFXCAPS_BLTSHRINKYN = $00002000;
 
(*
* DirectDraw supports arbitrary stretching of a surface along the
* x axis (horizontal direction) for blts.
*)
DDFXCAPS_BLTSTRETCHX = $00004000;
 
(*
* DirectDraw supports integer stretching (1x,2x,) of a surface
* along the x axis (horizontal direction) for blts.
*)
DDFXCAPS_BLTSTRETCHXN = $00008000;
 
(*
* DirectDraw supports arbitrary stretching of a surface along the
* y axis (horizontal direction) for blts.
*)
DDFXCAPS_BLTSTRETCHY = $00010000;
 
(*
* DirectDraw supports integer stretching (1x,2x,) of a surface
* along the y axis (vertical direction) for blts.
*)
DDFXCAPS_BLTSTRETCHYN = $00020000;
 
(*
* Uses arithmetic operations to stretch and shrink surfaces during
* overlay rather than pixel doubling techniques. Along the Y axis
* for overlays.
*)
DDFXCAPS_OVERLAYARITHSTRETCHY = $00040000;
 
(*
* Uses arithmetic operations to stretch surfaces during
* overlay rather than pixel doubling techniques. Along the Y axis
* for overlays. Only works for x1, x2, etc.
*)
DDFXCAPS_OVERLAYARITHSTRETCHYN = $00000008;
 
(*
* DirectDraw supports arbitrary shrinking of a surface along the
* x axis (horizontal direction) for overlays.
*)
DDFXCAPS_OVERLAYSHRINKX = $00080000;
 
(*
* DirectDraw supports integer shrinking (1x,2x,) of a surface
* along the x axis (horizontal direction) for overlays.
*)
DDFXCAPS_OVERLAYSHRINKXN = $00100000;
 
(*
* DirectDraw supports arbitrary shrinking of a surface along the
* y axis (horizontal direction) for overlays.
*)
DDFXCAPS_OVERLAYSHRINKY = $00200000;
 
(*
* DirectDraw supports integer shrinking (1x,2x,) of a surface
* along the y axis (vertical direction) for overlays.
*)
DDFXCAPS_OVERLAYSHRINKYN = $00400000;
 
(*
* DirectDraw supports arbitrary stretching of a surface along the
* x axis (horizontal direction) for overlays.
*)
DDFXCAPS_OVERLAYSTRETCHX = $00800000;
 
(*
* DirectDraw supports integer stretching (1x,2x,) of a surface
* along the x axis (horizontal direction) for overlays.
*)
DDFXCAPS_OVERLAYSTRETCHXN = $01000000;
 
(*
* DirectDraw supports arbitrary stretching of a surface along the
* y axis (horizontal direction) for overlays.
*)
DDFXCAPS_OVERLAYSTRETCHY = $02000000;
 
(*
* DirectDraw supports integer stretching (1x,2x,) of a surface
* along the y axis (vertical direction) for overlays.
*)
DDFXCAPS_OVERLAYSTRETCHYN = $04000000;
 
(*
* DirectDraw supports mirroring of overlays across the vertical axis
*)
DDFXCAPS_OVERLAYMIRRORLEFTRIGHT = $08000000;
 
(*
* DirectDraw supports mirroring of overlays across the horizontal axis
*)
DDFXCAPS_OVERLAYMIRRORUPDOWN = $10000000;
 
(*
* Driver can do alpha blending for blits.
*)
DDFXCAPS_BLTALPHA = $00000001;
 
(*
* Driver can do geometric transformations (or warps) for blits.
*)
DDFXCAPS_BLTTRANSFORM = $00000002;
 
(*
* Driver can do surface-reconstruction filtering for warped blits.
*)
DDFXCAPS_BLTFILTER = DDFXCAPS_BLTARITHSTRETCHY;
 
(*
* Driver can do alpha blending for overlays.
*)
DDFXCAPS_OVERLAYALPHA = $00000004;
 
(*
* Driver can do geometric transformations (or warps) for overlays.
*)
DDFXCAPS_OVERLAYTRANSFORM = $20000000;
 
(*
* Driver can do surface-reconstruction filtering for warped overlays.
*)
DDFXCAPS_OVERLAYFILTER = DDFXCAPS_OVERLAYARITHSTRETCHY;
 
{ DirectDraw Stereo View Capabilities }
(****************************************************************************
*
* DIRECTDRAW STEREO VIEW CAPABILITIES
*
****************************************************************************)
 
(*
* This flag used to be DDSVCAPS_ENIGMA, which is now obsolete
* The stereo view is accomplished via enigma encoding.
*)
DDSVCAPS_RESERVED1 = $00000001;
DDSVCAPS_ENIGMA = DDSVCAPS_RESERVED1;
 
(*
* This flag used to be DDSVCAPS_FLICKER, which is now obsolete
* The stereo view is accomplished via high frequency flickering.
*)
DDSVCAPS_RESERVED2 = $00000002;
DDSVCAPS_FLICKER = DDSVCAPS_RESERVED2;
 
(*
* This flag used to be DDSVCAPS_REDBLUE, which is now obsolete
* The stereo view is accomplished via red and blue filters applied
* to the left and right eyes. All images must adapt their colorspaces
* for this process.
*)
DDSVCAPS_RESERVED3 = $00000004;
DDSVCAPS_REDBLUE = DDSVCAPS_RESERVED3;
 
(*
* This flag used to be DDSVCAPS_SPLIT, which is now obsolete
* The stereo view is accomplished with split screen technology.
*)
DDSVCAPS_RESERVED4 = $00000008;
DDSVCAPS_SPLIT = DDSVCAPS_RESERVED4;
 
(*
* The stereo view is accomplished with switching technology
*)
DDSVCAPS_STEREOSEQUENTIAL = $00000010;
 
{ DirectDrawPalette Capabilities }
(****************************************************************************
*
* DIRECTDRAWPALETTE CAPABILITIES
*
****************************************************************************)
 
(*
* Index is 4 bits. There are sixteen color entries in the palette table.
*)
DDPCAPS_4BIT = $00000001;
 
(*
* Index is onto a 8 bit color index. This field is only valid with the
* DDPCAPS_1BIT, DDPCAPS_2BIT or DDPCAPS_4BIT capability and the target
* surface is in 8bpp. Each color entry is one byte long and is an index
* into destination surface's 8bpp palette.
*)
DDPCAPS_8BITENTRIES = $00000002;
 
(*
* Index is 8 bits. There are 256 color entries in the palette table.
*)
DDPCAPS_8BIT = $00000004;
 
(*
* Indicates that this DIRECTDRAWPALETTE should use the palette color array
* passed into the lpDDColorArray parameter to initialize the DIRECTDRAWPALETTE
* object.
* This flag is obsolete. DirectDraw always initializes the color array from
* the lpDDColorArray parameter. The definition remains for source-level
* compatibility.
*)
DDPCAPS_INITIALIZE = $00000008;
 
(*
* This palette is the one attached to the primary surface. Changing this
* table has immediate effect on the display unless DDPSETPAL_VSYNC is specified
* and supported.
*)
DDPCAPS_PRIMARYSURFACE = $00000010;
 
(*
* This palette is the one attached to the primary surface left. Changing
* this table has immediate effect on the display for the left eye unless
* DDPSETPAL_VSYNC is specified and supported.
*)
DDPCAPS_PRIMARYSURFACELEFT = $00000020;
 
(*
* This palette can have all 256 entries defined
*)
DDPCAPS_ALLOW256 = $00000040;
 
(*
* This palette can have modifications to it synced with the monitors
* refresh rate.
*)
DDPCAPS_VSYNC = $00000080;
 
(*
* Index is 1 bit. There are two color entries in the palette table.
*)
DDPCAPS_1BIT = $00000100;
 
(*
* Index is 2 bit. There are four color entries in the palette table.
*)
DDPCAPS_2BIT = $00000200;
 
(*
* The peFlags member of PALETTEENTRY denotes an 8 bit alpha value
*)
DDPCAPS_ALPHA = $00000400;
 
{ DirectDraw BitDepth Constants }
(****************************************************************************
*
* DIRECTDRAWPALETTE SETENTRY CONSTANTS
*
****************************************************************************)
 
 
(****************************************************************************
*
* DIRECTDRAWPALETTE GETENTRY CONSTANTS
*
****************************************************************************)
 
(* 0 is the only legal value *)
 
(****************************************************************************
*
* DIRECTDRAWSURFACE SETPALETTE CONSTANTS
*
****************************************************************************)
 
(*
* The passed pointer is an IUnknown ptr. The cbData argument to SetPrivateData
* must be set to sizeof(IUnknown^). DirectDraw will call AddRef through this
* pointer and Release when the private data is destroyed. This includes when
* the surface or palette is destroyed before such priovate data is destroyed.
*)
DDSPD_IUNKNOWNPOINTER = $00000001;
 
(*
* Private data is only valid for the current state of the object,
* as determined by the uniqueness value.
*)
DDSPD_VOLATILE = $00000002;
 
(****************************************************************************
*
* DIRECTDRAWSURFACE SETPALETTE CONSTANTS
*
****************************************************************************)
 
 
(****************************************************************************
*
* DIRECTDRAW BITDEPTH CONSTANTS
*
* NOTE: These are only used to indicate supported bit depths. These
* are flags only, they are not to be used as an actual bit depth. The
* absolute numbers 1, 2, 4, 8, 16, 24 and 32 are used to indicate actual
* bit depths in a surface or for changing the display mode.
*
****************************************************************************)
 
(*
* 1 bit per pixel.
*)
DDBD_1 = $00004000;
 
(*
* 2 bits per pixel.
*)
DDBD_2 = $00002000;
 
(*
* 4 bits per pixel.
*)
DDBD_4 = $00001000;
 
(*
* 8 bits per pixel.
*)
DDBD_8 = $00000800;
 
(*
* 16 bits per pixel.
*)
DDBD_16 = $00000400;
 
(*
* 24 bits per pixel.
*)
DDBD_24 = $00000200;
 
(*
* 32 bits per pixel.
*)
DDBD_32 = $00000100;
 
{ DirectDraw Set/Get Color Key Flags }
(****************************************************************************
*
* DIRECTDRAWSURFACE SET/GET COLOR KEY FLAGS
*
****************************************************************************)
 
(*
* Set if the structure contains a color space. Not set if the structure
* contains a single color key.
*)
DDCKEY_COLORSPACE = $00000001;
 
(*
* Set if the structure specifies a color key or color space which is to be
* used as a destination color key for blt operations.
*)
DDCKEY_DESTBLT = $00000002;
 
(*
* Set if the structure specifies a color key or color space which is to be
* used as a destination color key for overlay operations.
*)
DDCKEY_DESTOVERLAY = $00000004;
 
(*
* Set if the structure specifies a color key or color space which is to be
* used as a source color key for blt operations.
*)
DDCKEY_SRCBLT = $00000008;
 
(*
* Set if the structure specifies a color key or color space which is to be
* used as a source color key for overlay operations.
*)
DDCKEY_SRCOVERLAY = $00000010;
 
{ DirectDraw Color Key Capability Flags }
 
(****************************************************************************
*
* DIRECTDRAW COLOR KEY CAPABILITY FLAGS
*
****************************************************************************)
 
(*
* Supports transparent blting using a color key to identify the replaceable
* bits of the destination surface for RGB colors.
*)
DDCKEYCAPS_DESTBLT = $00000001;
 
(*
* Supports transparent blting using a color space to identify the replaceable
* bits of the destination surface for RGB colors.
*)
DDCKEYCAPS_DESTBLTCLRSPACE = $00000002;
 
(*
* Supports transparent blting using a color space to identify the replaceable
* bits of the destination surface for YUV colors.
*)
DDCKEYCAPS_DESTBLTCLRSPACEYUV = $00000004;
 
(*
* Supports transparent blting using a color key to identify the replaceable
* bits of the destination surface for YUV colors.
*)
DDCKEYCAPS_DESTBLTYUV = $00000008;
 
(*
* Supports overlaying using colorkeying of the replaceable bits of the surface
* being overlayed for RGB colors.
*)
DDCKEYCAPS_DESTOVERLAY = $00000010;
 
(*
* Supports a color space as the color key for the destination for RGB colors.
*)
DDCKEYCAPS_DESTOVERLAYCLRSPACE = $00000020;
 
(*
* Supports a color space as the color key for the destination for YUV colors.
*)
DDCKEYCAPS_DESTOVERLAYCLRSPACEYUV = $00000040;
 
(*
* Supports only one active destination color key value for visible overlay
* surfaces.
*)
DDCKEYCAPS_DESTOVERLAYONEACTIVE = $00000080;
 
(*
* Supports overlaying using colorkeying of the replaceable bits of the
* surface being overlayed for YUV colors.
*)
DDCKEYCAPS_DESTOVERLAYYUV = $00000100;
 
(*
* Supports transparent blting using the color key for the source with
* this surface for RGB colors.
*)
DDCKEYCAPS_SRCBLT = $00000200;
 
(*
* Supports transparent blting using a color space for the source with
* this surface for RGB colors.
*)
DDCKEYCAPS_SRCBLTCLRSPACE = $00000400;
 
(*
* Supports transparent blting using a color space for the source with
* this surface for YUV colors.
*)
DDCKEYCAPS_SRCBLTCLRSPACEYUV = $00000800;
 
(*
* Supports transparent blting using the color key for the source with
* this surface for YUV colors.
*)
DDCKEYCAPS_SRCBLTYUV = $00001000;
 
(*
* Supports overlays using the color key for the source with this
* overlay surface for RGB colors.
*)
DDCKEYCAPS_SRCOVERLAY = $00002000;
 
(*
* Supports overlays using a color space as the source color key for
* the overlay surface for RGB colors.
*)
DDCKEYCAPS_SRCOVERLAYCLRSPACE = $00004000;
 
(*
* Supports overlays using a color space as the source color key for
* the overlay surface for YUV colors.
*)
DDCKEYCAPS_SRCOVERLAYCLRSPACEYUV = $00008000;
 
(*
* Supports only one active source color key value for visible
* overlay surfaces.
*)
DDCKEYCAPS_SRCOVERLAYONEACTIVE = $00010000;
 
(*
* Supports overlays using the color key for the source with this
* overlay surface for YUV colors.
*)
DDCKEYCAPS_SRCOVERLAYYUV = $00020000;
 
(*
* there are no bandwidth trade-offs for using colorkey with an overlay
*)
DDCKEYCAPS_NOCOSTOVERLAY = $00040000;
 
{ DirectDraw PixelFormat Flags }
 
(****************************************************************************
*
* DIRECTDRAW PIXELFORMAT FLAGS
*
****************************************************************************)
 
(*
* The surface has alpha channel information in the pixel format.
*)
DDPF_ALPHAPIXELS = $00000001;
 
(*
* The pixel format contains alpha only information
*)
DDPF_ALPHA = $00000002;
 
(*
* The FourCC code is valid.
*)
DDPF_FOURCC = $00000004;
 
(*
* The surface is 4-bit color indexed.
*)
DDPF_PALETTEINDEXED4 = $00000008;
 
(*
* The surface is indexed into a palette which stores indices
* into the destination surface's 8-bit palette.
*)
DDPF_PALETTEINDEXEDTO8 = $00000010;
 
(*
* The surface is 8-bit color indexed.
*)
DDPF_PALETTEINDEXED8 = $00000020;
 
(*
* The RGB data in the pixel format structure is valid.
*)
DDPF_RGB = $00000040;
 
(*
* The surface will accept pixel data in the format specified
* and compress it during the write.
*)
DDPF_COMPRESSED = $00000080;
 
(*
* The surface will accept RGB data and translate it during
* the write to YUV data. The format of the data to be written
* will be contained in the pixel format structure. The DDPF_RGB
* flag will be set.
*)
DDPF_RGBTOYUV = $00000100;
 
(*
* pixel format is YUV - YUV data in pixel format struct is valid
*)
DDPF_YUV = $00000200;
 
(*
* pixel format is a z buffer only surface
*)
DDPF_ZBUFFER = $00000400;
 
(*
* The surface is 1-bit color indexed.
*)
DDPF_PALETTEINDEXED1 = $00000800;
 
(*
* The surface is 2-bit color indexed.
*)
DDPF_PALETTEINDEXED2 = $00001000;
 
(*
* The surface contains Z information in the pixels
*)
DDPF_ZPIXELS = $00002000;
 
(*
* The surface contains stencil information along with Z
*)
DDPF_STENCILBUFFER = $00004000;
 
(*
* Premultiplied alpha format -- the color components have been
* premultiplied by the alpha component.
*)
DDPF_ALPHAPREMULT = $00008000;
 
 
(*
* Luminance data in the pixel format is valid.
* Use this flag for luminance-only or luminance+alpha surfaces,
* the bit depth is then ddpf.dwLuminanceBitCount.
*)
DDPF_LUMINANCE = $00020000;
 
(*
* Luminance data in the pixel format is valid.
* Use this flag when hanging luminance off bumpmap surfaces,
* the bit mask for the luminance portion of the pixel is then
* ddpf.dwBumpLuminanceBitMask
*)
DDPF_BUMPLUMINANCE = $00040000;
 
(*
* Bump map dUdV data in the pixel format is valid.
*)
DDPF_BUMPDUDV = $00080000;
 
{ DirectDraw SetDisplayMode Flags }
(*===========================================================================
*
*
* DIRECTDRAW CALLBACK FLAGS
*
*
*==========================================================================*)
 
(****************************************************************************
*
* DIRECTDRAW ENUMSURFACES FLAGS
*
****************************************************************************)
 
(*
* Enumerate all of the surfaces that meet the search criterion.
*)
DDENUMSURFACES_ALL = $00000001;
 
(*
* A search hit is a surface that matches the surface description.
*)
DDENUMSURFACES_MATCH = $00000002;
 
(*
* A search hit is a surface that does not match the surface description.
*)
DDENUMSURFACES_NOMATCH = $00000004;
 
(*
* Enumerate the first surface that can be created which meets the search criterion.
*)
DDENUMSURFACES_CANBECREATED = $00000008;
 
(*
* Enumerate the surfaces that already exist that meet the search criterion.
*)
DDENUMSURFACES_DOESEXIST = $00000010;
 
(****************************************************************************
*
* DIRECTDRAW SETDISPLAYMODE FLAGS
*
****************************************************************************)
 
(*
* The desired mode is a standard VGA mode
*)
DDSDM_STANDARDVGAMODE = $00000001;
 
{ DirectDraw EnumDisplayModes Flags }
(****************************************************************************
*
* DIRECTDRAW ENUMDISPLAYMODES FLAGS
*
****************************************************************************)
 
(*
* Enumerate Modes with different refresh rates. EnumDisplayModes guarantees
* that a particular mode will be enumerated only once. This flag specifies whether
* the refresh rate is taken into account when determining if a mode is unique.
*)
DDEDM_REFRESHRATES = $00000001;
 
(*
* Enumerate VGA modes. Specify this flag if you wish to enumerate supported VGA
* modes such as mode 0x13 in addition to the usual ModeX modes (which are always
* enumerated if the application has previously called SetCooperativeLevel with the
* DDSCL_ALLOWMODEX flag set).
*)
DDEDM_STANDARDVGAMODES = $00000002;
 
{ DirectDraw EnumSurfaces Flags }
 
DDENUMSURFACES_ALL = $00000001;
DDENUMSURFACES_MATCH = $00000002;
DDENUMSURFACES_NOMATCH = $00000004;
DDENUMSURFACES_CANBECREATED = $00000008;
DDENUMSURFACES_DOESEXIST = $00000010;
(****************************************************************************
*
* DIRECTDRAW SETCOOPERATIVELEVEL FLAGS
*
****************************************************************************)
 
{ DirectDraw SetCooperativeLevel Flags }
(*
* Exclusive mode owner will be responsible for the entire primary surface.
* GDI can be ignored. used with DD
*)
DDSCL_FULLSCREEN = $00000001;
 
DDSCL_FULLSCREEN = $00000001;
(*
* allow CTRL_ALT_DEL to work while in fullscreen exclusive mode
*)
DDSCL_ALLOWREBOOT = $00000002;
 
(*
* prevents DDRAW from modifying the application window.
* prevents DDRAW from minimize/restore the application window on activation.
*)
DDSCL_NOWINDOWCHANGES = $00000004;
 
(*
* app wants to work as a regular Windows application
*)
DDSCL_NORMAL = $00000008;
 
(*
* app wants exclusive access
*)
DDSCL_EXCLUSIVE = $00000010;
 
 
(*
* app can deal with non-windows display modes
*)
DDSCL_ALLOWMODEX = $00000040;
 
(*
* this window will receive the focus messages
*)
DDSCL_SETFOCUSWINDOW = $00000080;
 
(*
* this window is associated with the DDRAW object and will
* cover the screen in fullscreen mode
*)
DDSCL_SETDEVICEWINDOW = $00000100;
 
(*
* app wants DDRAW to create a window to be associated with the
* DDRAW object
*)
DDSCL_CREATEDEVICEWINDOW = $00000200;
 
(*
* App explicitly asks DDRAW/D3D to be multithread safe. This makes D3D
* take the global crtisec more frequently.
*)
DDSCL_MULTITHREADED = $00000400;
 
(*
* App hints that it would like to keep the FPU set up for optimal Direct3D
* performance (single precision and exceptions disabled) so Direct3D
* does not need to explicitly set the FPU each time
*)
DDSCL_FPUSETUP = $00000800;
 
(*
* App specifies that it needs either double precision FPU or FPU exceptions
* enabled. This makes Direct3D explicitly set the FPU state eah time it is
* called. Setting the flag will reduce Direct3D performance. The flag is
* assumed by default in DirectX 6 and earlier. See also DDSCL_FPUSETUP
*)
DDSCL_FPUPRESERVE = $00001000;
 
{ DirectDraw Blt Flags }
(****************************************************************************
*
* DIRECTDRAW BLT FLAGS
*
****************************************************************************)
 
(*
* Use the alpha information in the pixel format or the alpha channel surface
* attached to the destination surface as the alpha channel for this blt.
*)
DDBLT_ALPHADEST = $00000001;
 
(*
* Use the dwConstAlphaDest field in the TDDBltFX structure as the alpha channel
* for the destination surface for this blt.
*)
DDBLT_ALPHADESTCONSTOVERRIDE = $00000002;
 
(*
* The NEG suffix indicates that the destination surface becomes more
* transparent as the alpha value increases. (0 is opaque)
*)
DDBLT_ALPHADESTNEG = $00000004;
 
(*
* Use the lpDDSAlphaDest field in the TDDBltFX structure as the alpha
* channel for the destination for this blt.
*)
DDBLT_ALPHADESTSURFACEOVERRIDE = $00000008;
 
(*
* Use the dwAlphaEdgeBlend field in the TDDBltFX structure as the alpha channel
* for the edges of the image that border the color key colors.
*)
DDBLT_ALPHAEDGEBLEND = $00000010;
 
(*
* Use the alpha information in the pixel format or the alpha channel surface
* attached to the source surface as the alpha channel for this blt.
*)
DDBLT_ALPHASRC = $00000020;
 
(*
* Use the dwConstAlphaSrc field in the TDDBltFX structure as the alpha channel
* for the source for this blt.
*)
DDBLT_ALPHASRCCONSTOVERRIDE = $00000040;
 
(*
* The NEG suffix indicates that the source surface becomes more transparent
* as the alpha value increases. (0 is opaque)
*)
DDBLT_ALPHASRCNEG = $00000080;
 
(*
* Use the lpDDSAlphaSrc field in the TDDBltFX structure as the alpha channel
* for the source for this blt.
*)
DDBLT_ALPHASRCSURFACEOVERRIDE = $00000100;
 
(*
* Do this blt asynchronously through the FIFO in the order received. If
* there is no room in the hardware FIFO fail the call.
*)
DDBLT_ASYNC = $00000200;
 
(*
* Uses the dwFillColor field in the TDDBltFX structure as the RGB color
* to fill the destination rectangle on the destination surface with.
*)
DDBLT_COLORFILL = $00000400;
 
(*
* Uses the dwDDFX field in the TDDBltFX structure to specify the effects
* to use for the blt.
*)
DDBLT_DDFX = $00000800;
 
(*
* Uses the dwDDROPS field in the TDDBltFX structure to specify the ROPS
* that are not part of the Win32 API.
*)
DDBLT_DDROPS = $00001000;
 
(*
* Use the color key associated with the destination surface.
*)
DDBLT_KEYDEST = $00002000;
 
(*
* Use the dckDestColorkey field in the TDDBltFX structure as the color key
* for the destination surface.
*)
DDBLT_KEYDESTOVERRIDE = $00004000;
 
(*
* Use the color key associated with the source surface.
*)
DDBLT_KEYSRC = $00008000;
 
(*
* Use the dckSrcColorkey field in the TDDBltFX structure as the color key
* for the source surface.
*)
DDBLT_KEYSRCOVERRIDE = $00010000;
 
(*
* Use the dwROP field in the TDDBltFX structure for the raster operation
* for this blt. These ROPs are the same as the ones defined in the Win32 API.
*)
DDBLT_ROP = $00020000;
 
(*
* Use the dwRotationAngle field in the TDDBltFX structure as the angle
* (specified in 1/100th of a degree) to rotate the surface.
*)
DDBLT_ROTATIONANGLE = $00040000;
 
(*
* Z-buffered blt using the z-buffers attached to the source and destination
* surfaces and the dwZBufferOpCode field in the TDDBltFX structure as the
* z-buffer opcode.
*)
DDBLT_ZBUFFER = $00080000;
 
(*
* Z-buffered blt using the dwConstDest Zfield and the dwZBufferOpCode field
* in the TDDBltFX structure as the z-buffer and z-buffer opcode respectively
* for the destination.
*)
DDBLT_ZBUFFERDESTCONSTOVERRIDE = $00100000;
 
(*
* Z-buffered blt using the lpDDSDestZBuffer field and the dwZBufferOpCode
* field in the TDDBltFX structure as the z-buffer and z-buffer opcode
* respectively for the destination.
*)
DDBLT_ZBUFFERDESTOVERRIDE = $00200000;
 
(*
* Z-buffered blt using the dwConstSrcZ field and the dwZBufferOpCode field
* in the TDDBltFX structure as the z-buffer and z-buffer opcode respectively
* for the source.
*)
DDBLT_ZBUFFERSRCCONSTOVERRIDE = $00400000;
 
(*
* Z-buffered blt using the lpDDSSrcZBuffer field and the dwZBufferOpCode
* field in the TDDBltFX structure as the z-buffer and z-buffer opcode
* respectively for the source.
*)
DDBLT_ZBUFFERSRCOVERRIDE = $00800000;
 
(*
* wait until the device is ready to handle the blt
* this will cause blt to not return DDERR_WASSTILLDRAWING
*)
DDBLT_WAIT = $01000000;
 
(*
* Uses the dwFillDepth field in the TDDBltFX structure as the depth value
* to fill the destination rectangle on the destination Z-buffer surface
* with.
*)
DDBLT_DEPTHFILL = $02000000;
 
(*
* wait until the device is ready to handle the blt
* this will cause blt to not return DDERR_WASSTILLDRAWING
*)
DDBLT_DONOTWAIT = $08000000;
 
{ BltFast Flags }
(****************************************************************************
*
* BLTFAST FLAGS
*
****************************************************************************)
 
DDBLTFAST_NOCOLORKEY = $00000000;
DDBLTFAST_SRCCOLORKEY = $00000001;
1843,310 → 3476,1387
DDBLTFAST_WAIT = $00000010;
DDBLTFAST_DONOTWAIT = $00000020;
 
{ Flip Flags }
(****************************************************************************
*
* FLIP FLAGS
*
****************************************************************************)
 
 
DDFLIP_WAIT = $00000001;
 
(*
* Indicates that the target surface contains the even field of video data.
* This flag is only valid with an overlay surface.
*)
DDFLIP_EVEN = $00000002;
 
(*
* Indicates that the target surface contains the odd field of video data.
* This flag is only valid with an overlay surface.
*)
DDFLIP_ODD = $00000004;
 
(*
* Causes DirectDraw to perform the physical flip immediately and return
* to the application. Typically, what was the front buffer but is now the back
* buffer will still be visible (depending on timing) until the next vertical
* retrace. Subsequent operations involving the two flipped surfaces will
* not check to see if the physical flip has finished (i.e. will not return
* DDERR_WASSTILLDRAWING for that reason (but may for other reasons)).
* This allows an application to perform Flips at a higher frequency than the
* monitor refresh rate, but may introduce visible artifacts.
* Only effective if DDCAPS2_FLIPNOVSYNC is set. If that bit is not set,
* DDFLIP_NOVSYNC has no effect.
*)
DDFLIP_NOVSYNC = $00000008;
 
 
(*
* Flip Interval Flags. These flags indicate how many vertical retraces to wait between
* each flip. The default is one. DirectDraw will return DDERR_WASSTILLDRAWING for each
* surface involved in the flip until the specified number of vertical retraces has
* ocurred. Only effective if DDCAPS2_FLIPINTERVAL is set. If that bit is not set,
* DDFLIP_INTERVALn has no effect.
*)
 
(*
* DirectDraw will flip on every other vertical sync
*)
DDFLIP_INTERVAL2 = $02000000;
 
 
(*
* DirectDraw will flip on every third vertical sync
*)
DDFLIP_INTERVAL3 = $03000000;
 
 
(*
* DirectDraw will flip on every fourth vertical sync
*)
DDFLIP_INTERVAL4 = $04000000;
 
(*
* DirectDraw will flip and display a main stereo surface
*)
DDFLIP_STEREO = $00000010;
 
(*
* On IDirectDrawSurface7 and higher interfaces, the default is DDFLIP_WAIT. If you wish
* to override the default and use time when the accelerator is busy (as denoted by
* the DDERR_WASSTILLDRAWING return code) then use DDFLIP_DONOTWAIT.
*)
DDFLIP_DONOTWAIT = $00000020;
 
{ DirectDraw Surface Overlay Flags }
(****************************************************************************
*
* DIRECTDRAW SURFACE OVERLAY FLAGS
*
****************************************************************************)
 
(*
* Use the alpha information in the pixel format or the alpha channel surface
* attached to the destination surface as the alpha channel for the
* destination overlay.
*)
DDOVER_ALPHADEST = $00000001;
 
(*
* Use the dwConstAlphaDest field in the TDDOverlayFX structure as the
* destination alpha channel for this overlay.
*)
DDOVER_ALPHADESTCONSTOVERRIDE = $00000002;
 
(*
* The NEG suffix indicates that the destination surface becomes more
* transparent as the alpha value increases.
*)
DDOVER_ALPHADESTNEG = $00000004;
 
(*
* Use the lpDDSAlphaDest field in the TDDOverlayFX structure as the alpha
* channel destination for this overlay.
*)
DDOVER_ALPHADESTSURFACEOVERRIDE = $00000008;
 
(*
* Use the dwAlphaEdgeBlend field in the TDDOverlayFX structure as the alpha
* channel for the edges of the image that border the color key colors.
*)
DDOVER_ALPHAEDGEBLEND = $00000010;
 
(*
* Use the alpha information in the pixel format or the alpha channel surface
* attached to the source surface as the source alpha channel for this overlay.
*)
DDOVER_ALPHASRC = $00000020;
 
(*
* Use the dwConstAlphaSrc field in the TDDOverlayFX structure as the source
* alpha channel for this overlay.
*)
DDOVER_ALPHASRCCONSTOVERRIDE = $00000040;
 
(*
* The NEG suffix indicates that the source surface becomes more transparent
* as the alpha value increases.
*)
DDOVER_ALPHASRCNEG = $00000080;
 
(*
* Use the lpDDSAlphaSrc field in the TDDOverlayFX structure as the alpha channel
* source for this overlay.
*)
DDOVER_ALPHASRCSURFACEOVERRIDE = $00000100;
 
(*
* Turn this overlay off.
*)
DDOVER_HIDE = $00000200;
 
(*
* Use the color key associated with the destination surface.
*)
DDOVER_KEYDEST = $00000400;
 
(*
* Use the dckDestColorkey field in the TDDOverlayFX structure as the color key
* for the destination surface
*)
DDOVER_KEYDESTOVERRIDE = $00000800;
 
(*
* Use the color key associated with the source surface.
*)
DDOVER_KEYSRC = $00001000;
 
(*
* Use the dckSrcColorkey field in the TDDOverlayFX structure as the color key
* for the source surface.
*)
DDOVER_KEYSRCOVERRIDE = $00002000;
 
(*
* Turn this overlay on.
*)
DDOVER_SHOW = $00004000;
 
(*
* Add a dirty rect to an emulated overlayed surface.
*)
DDOVER_ADDDIRTYRECT = $00008000;
 
(*
* Redraw all dirty rects on an emulated overlayed surface.
*)
DDOVER_REFRESHDIRTYRECTS = $00010000;
 
(*
* Redraw the entire surface on an emulated overlayed surface.
*)
DDOVER_REFRESHALL = $00020000;
 
(*
* Use the overlay FX flags to define special overlay FX
*)
DDOVER_DDFX = $00080000;
 
(*
* Autoflip the overlay when ever the video port autoflips
*)
DDOVER_AUTOFLIP = $00100000;
 
(*
* Display each field of video port data individually without
* causing any jittery artifacts
*)
DDOVER_BOB = $00200000;
 
(*
* Indicates that bob/weave decisions should not be overridden by other
* interfaces.
*)
DDOVER_OVERRIDEBOBWEAVE = $00400000;
 
(*
* Indicates that the surface memory is composed of interleaved fields.
*)
DDOVER_INTERLEAVED = $00800000;
 
(*
* Indicates that bob will be performed using hardware rather than
* software or emulated.
*)
DDOVER_BOBHARDWARE = $01000000;
 
(*
* Indicates that overlay FX structure contains valid ARGB scaling factors.
*)
DDOVER_ARGBSCALEFACTORS = $02000000;
 
(*
* Indicates that ARGB scaling factors can be degraded to fit driver capabilities.
*)
DDOVER_DEGRADEARGBSCALING = $04000000;
 
{ DirectDrawSurface Lock Flags }
(****************************************************************************
*
* DIRECTDRAWSURFACE LOCK FLAGS
*
****************************************************************************)
 
DDLOCK_SURFACEMEMORYPTR = $00000000; // default
(*
* The default. Set to indicate that Lock should return a valid memory pointer
* to the top of the specified rectangle. If no rectangle is specified then a
* pointer to the top of the surface is returned.
*)
DDLOCK_SURFACEMEMORYPTR = $00000000; // = default
 
(*
* Set to indicate that Lock should wait until it can obtain a valid memory
* pointer before returning. If this bit is set, Lock will never return
* DDERR_WASSTILLDRAWING.
*)
DDLOCK_WAIT = $00000001;
 
(*
* Set if an event handle is being passed to Lock. Lock will trigger the event
* when it can return the surface memory pointer requested.
*)
DDLOCK_EVENT = $00000002;
 
(*
* Indicates that the surface being locked will only be read from.
*)
DDLOCK_READONLY = $00000010;
 
(*
* Indicates that the surface being locked will only be written to
*)
DDLOCK_WRITEONLY = $00000020;
 
(*
* Indicates that a system wide lock should not be taken when this surface
* is locked. This has several advantages (cursor responsiveness, ability
* to call more Windows functions, easier debugging) when locking video
* memory surfaces. However, an application specifying this flag must
* comply with a number of conditions documented in the help file.
* Furthermore, this flag cannot be specified when locking the primary.
*)
DDLOCK_NOSYSLOCK = $00000800;
 
(*
* Used only with Direct3D Vertex Buffer Locks. Indicates that no vertices
* that were referred to in Draw*PrimtiveVB calls since the start of the
* frame (or the last lock without this flag) will be modified during the
* lock. This can be useful when one is only appending data to the vertex
* buffer
*)
DDLOCK_NOOVERWRITE = $00001000;
 
(*
* Indicates that no assumptions will be made about the contents of the
* surface or vertex buffer during this lock.
* This enables two things:
* - Direct3D or the driver may provide an alternative memory
* area as the vertex buffer. This is useful when one plans to clear the
* contents of the vertex buffer and fill in new data.
* - Drivers sometimes store surface data in a re-ordered format.
* When the application locks the surface, the driver is forced to un-re-order
* the surface data before allowing the application to see the surface contents.
* This flag is a hint to the driver that it can skip the un-re-ordering process
* since the application plans to overwrite every single pixel in the surface
* or locked rectangle (and so erase any un-re-ordered pixels anyway).
* Applications should always set this flag when they intend to overwrite the entire
* surface or locked rectangle.
*)
DDLOCK_DISCARDCONTENTS = $00002000;
(*
* DDLOCK_OKTOSWAP is an older, less informative name for DDLOCK_DISCARDCONTENTS
*)
DDLOCK_OKTOSWAP = $00002000;
 
(*
* On IDirectDrawSurface7 and higher interfaces, the default is DDLOCK_WAIT. If you wish
* to override the default and use time when the accelerator is busy (as denoted by
* the DDERR_WASSTILLDRAWING return code) then use DDLOCK_DONOTWAIT.
*)
DDLOCK_DONOTWAIT = $00004000;
 
{ DirectDrawSurface Blt FX Flags }
 
(****************************************************************************
*
* DIRECTDRAWSURFACE PAGELOCK FLAGS
*
****************************************************************************)
 
(*
* No flags defined at present
*)
 
 
(****************************************************************************
*
* DIRECTDRAWSURFACE PAGEUNLOCK FLAGS
*
****************************************************************************)
 
(*
* No flags defined at present
*)
 
 
(****************************************************************************
*
* DIRECTDRAWSURFACE BLT FX FLAGS
*
****************************************************************************)
 
(*
* If stretching, use arithmetic stretching along the Y axis for this blt.
*)
DDBLTFX_ARITHSTRETCHY = $00000001;
 
(*
* Do this blt mirroring the surface left to right. Spin the
* surface around its y-axis.
*)
DDBLTFX_MIRRORLEFTRIGHT = $00000002;
 
(*
* Do this blt mirroring the surface up and down. Spin the surface
* around its x-axis.
*)
DDBLTFX_MIRRORUPDOWN = $00000004;
 
(*
* Schedule this blt to avoid tearing.
*)
DDBLTFX_NOTEARING = $00000008;
 
(*
* Do this blt rotating the surface one hundred and eighty degrees.
*)
DDBLTFX_ROTATE180 = $00000010;
 
(*
* Do this blt rotating the surface two hundred and seventy degrees.
*)
DDBLTFX_ROTATE270 = $00000020;
 
(*
* Do this blt rotating the surface ninety degrees.
*)
DDBLTFX_ROTATE90 = $00000040;
 
(*
* Do this z blt using dwZBufferLow and dwZBufferHigh as range values
* specified to limit the bits copied from the source surface.
*)
DDBLTFX_ZBUFFERRANGE = $00000080;
 
(*
* Do this z blt adding the dwZBufferBaseDest to each of the sources z values
* before comparing it with the desting z values.
*)
DDBLTFX_ZBUFFERBASEDEST = $00000100;
 
{ DirectDrawSurface Overlay FX Flags }
(****************************************************************************
*
* DIRECTDRAWSURFACE OVERLAY FX FLAGS
*
****************************************************************************)
 
(*
* If stretching, use arithmetic stretching along the Y axis for this overlay.
*)
DDOVERFX_ARITHSTRETCHY = $00000001;
 
(*
* Mirror the overlay across the vertical axis
*)
DDOVERFX_MIRRORLEFTRIGHT = $00000002;
 
(*
* Mirror the overlay across the horizontal axis
*)
DDOVERFX_MIRRORUPDOWN = $00000004;
 
{ Flags for dwDDFX member of DDSPRITEFX structure }
(****************************************************************************
*
* Flags for dwDDFX member of DDSPRITEFX structure
*
****************************************************************************)
(*
* Use affine transformation matrix in fTransform member.
*)
DDSPRITEFX_AFFINETRANSFORM = $00000001;
 
DDSPRITEFX_AFFINETRANSFORM = $00000001;
(*
* Use RGBA scaling factors in ddrgbaScaleFactors member.
*)
DDSPRITEFX_RGBASCALING = $00000002;
 
(*
* Degrade RGBA scaling factors to accommodate driver's capabilities.
*)
DDSPRITEFX_DEGRADERGBASCALING = $00000004;
 
(*
* Do bilinear filtering of stretched or warped sprite.
*)
DDSPRITEFX_BILINEARFILTER = $00000008;
 
(*
* Do "blur" filtering of stretched or warped sprite.
*)
DDSPRITEFX_BLURFILTER = $00000010;
 
(*
* Do "flat" filtering of stretched or warped sprite.
*)
DDSPRITEFX_FLATFILTER = $00000020;
 
(*
* Degrade filtering operation to accommodate driver's capabilities.
*)
DDSPRITEFX_DEGRADEFILTER = $00000040;
 
{ DirectDraw WaitForVerticalBlank Flags }
(****************************************************************************
*
* DIRECTDRAW WAITFORVERTICALBLANK FLAGS
*
****************************************************************************)
 
(*
* return when the vertical blank interval begins
*)
DDWAITVB_BLOCKBEGIN = $00000001;
 
(*
* set up an event to trigger when the vertical blank begins
*)
DDWAITVB_BLOCKBEGINEVENT = $00000002;
 
(*
* return when the vertical blank interval ends and display begins
*)
DDWAITVB_BLOCKEND = $00000004;
 
{ DirectDraw GetFlipStatus Flags }
(****************************************************************************
*
* DIRECTDRAW GETFLIPSTATUS FLAGS
*
****************************************************************************)
 
(*
* is it OK to flip now?
*)
DDGFS_CANFLIP = $00000001;
 
(*
* is the last flip finished?
*)
DDGFS_ISFLIPDONE = $00000002;
 
{ DirectDraw GetBltStatus Flags }
(****************************************************************************
*
* DIRECTDRAW GETBLTSTATUS FLAGS
*
****************************************************************************)
 
(*
* is it OK to blt now?
*)
DDGBS_CANBLT = $00000001;
 
(*
* is the blt to the surface finished?
*)
DDGBS_ISBLTDONE = $00000002;
 
{ DirectDraw EnumOverlayZOrder Flags }
 
(****************************************************************************
*
* DIRECTDRAW ENUMOVERLAYZORDER FLAGS
*
****************************************************************************)
 
(*
* Enumerate overlays back to front.
*)
DDENUMOVERLAYZ_BACKTOFRONT = $00000000;
 
(*
* Enumerate overlays front to back
*)
DDENUMOVERLAYZ_FRONTTOBACK = $00000001;
 
{ DirectDraw UpdateOverlayZOrder Flags }
(****************************************************************************
*
* DIRECTDRAW UPDATEOVERLAYZORDER FLAGS
*
****************************************************************************)
 
(*
* Send overlay to front
*)
DDOVERZ_SENDTOFRONT = $00000000;
 
(*
* Send overlay to back
*)
DDOVERZ_SENDTOBACK = $00000001;
 
(*
* Move Overlay forward
*)
DDOVERZ_MOVEFORWARD = $00000002;
 
(*
* Move Overlay backward
*)
DDOVERZ_MOVEBACKWARD = $00000003;
 
(*
* Move Overlay in front of relative surface
*)
DDOVERZ_INSERTINFRONTOF = $00000004;
 
(*
* Move Overlay in back of relative surface
*)
DDOVERZ_INSERTINBACKOF = $00000005;
 
{ DirectDrawSurface SetPrivateData Constants }
(****************************************************************************
*
* DIRECTDRAW SETGAMMARAMP FLAGS
*
****************************************************************************)
 
DDSPD_IUNKNOWNPOINTER = $00000001;
DDSPD_VOLATILE = $00000002;
 
{ TDDColorControl flags }
 
DDCOLOR_BRIGHTNESS = $00000001;
DDCOLOR_CONTRAST = $00000002;
DDCOLOR_HUE = $00000004;
DDCOLOR_SATURATION = $00000008;
DDCOLOR_SHARPNESS = $00000010;
DDCOLOR_GAMMA = $00000020;
DDCOLOR_COLORENABLE = $00000040;
 
{ DirectDraw SetGammaRamp Flags }
 
(*
* Request calibrator to adjust the gamma ramp according to the physical
* properties of the display so that the result should appear identical
* on all systems.
*)
DDSGR_CALIBRATE = $00000001;
 
{ DirectDraw StartModeTest Flags }
(****************************************************************************
*
* DIRECTDRAW STARTMODETEST FLAGS
*
****************************************************************************)
 
(*
* Indicates that the mode being tested has passed
*)
DDSMT_ISTESTREQUIRED = $00000001;
 
{ DirectDraw EvaluateMode Flags }
 
(****************************************************************************
*
* DIRECTDRAW EVALUATEMODE FLAGS
*
****************************************************************************)
 
(*
* Indicates that the mode being tested has passed
*)
DDEM_MODEPASSED = $00000001;
 
(*
* Indicates that the mode being tested has failed
*)
DDEM_MODEFAILED = $00000002;
 
{ DirectDraw Return Codes }
(*===========================================================================
*
*
* DIRECTDRAW RETURN CODES
*
* The return values from DirectDraw Commands and Surface that return an HResult
* are codes from DirectDraw concerning the results of the action
* requested by DirectDraw.
*
*==========================================================================*)
 
DD_OK = HResult(0);
DD_FALSE = HResult(S_FALSE);
(*
* Status is OK
*
* Issued by: DirectDraw Commands and all callbacks
*)
DD_OK = 0;
DD_FALSE = S_FALSE;
 
{ DirectDraw EnumCallback Return Values }
(****************************************************************************
*
* DIRECTDRAW ENUMCALLBACK RETURN VALUES
*
* EnumCallback returns are used to control the flow of the DIRECTDRAW and
* DIRECTDRAWSURFACE object enumerations. They can only be returned by
* enumeration callback routines.
*
****************************************************************************)
 
(*
* stop the enumeration
*)
DDENUMRET_CANCEL = 0;
 
(*
* continue the enumeration
*)
DDENUMRET_OK = 1;
 
{ DirectDraw Error Codes }
(****************************************************************************
*
* DIRECTDRAW ERRORS
*
* Errors are represented by negative values and cannot be combined.
*
****************************************************************************)
 
DDERR_ALREADYINITIALIZED = HResult($88760000 + 5);
DDERR_CANNOTATTACHSURFACE = HResult($88760000 + 10);
DDERR_CANNOTDETACHSURFACE = HResult($88760000 + 20);
DDERR_CURRENTLYNOTAVAIL = HResult($88760000 + 40);
DDERR_EXCEPTION = HResult($88760000 + 55);
DDERR_GENERIC = HResult(E_FAIL);
DDERR_HEIGHTALIGN = HResult($88760000 + 90);
DDERR_INCOMPATIBLEPRIMARY = HResult($88760000 + 95);
DDERR_INVALIDCAPS = HResult($88760000 + 100);
DDERR_INVALIDCLIPLIST = HResult($88760000 + 110);
DDERR_INVALIDMODE = HResult($88760000 + 120);
DDERR_INVALIDOBJECT = HResult($88760000 + 130);
DDERR_INVALIDPARAMS = HResult(E_INVALIDARG);
DDERR_INVALIDPIXELFORMAT = HResult($88760000 + 145);
DDERR_INVALIDRECT = HResult($88760000 + 150);
DDERR_LOCKEDSURFACES = HResult($88760000 + 160);
DDERR_NO3D = HResult($88760000 + 170);
DDERR_NOALPHAHW = HResult($88760000 + 180);
DDERR_NOSTEREOHARDWARE = HResult($88760000 + 181);
DDERR_NOSURFACELEFT = HResult($88760000 + 182);
DDERR_NOCLIPLIST = HResult($88760000 + 205);
DDERR_NOCOLORCONVHW = HResult($88760000 + 210);
DDERR_NOCOOPERATIVELEVELSET = HResult($88760000 + 212);
DDERR_NOCOLORKEY = HResult($88760000 + 215);
DDERR_NOCOLORKEYHW = HResult($88760000 + 220);
DDERR_NODIRECTDRAWSUPPORT = HResult($88760000 + 222);
DDERR_NOEXCLUSIVEMODE = HResult($88760000 + 225);
DDERR_NOFLIPHW = HResult($88760000 + 230);
DDERR_NOGDI = HResult($88760000 + 240);
DDERR_NOMIRRORHW = HResult($88760000 + 250);
DDERR_NOTFOUND = HResult($88760000 + 255);
DDERR_NOOVERLAYHW = HResult($88760000 + 260);
DDERR_OVERLAPPINGRECTS = HResult($88760000 + 270);
DDERR_NORASTEROPHW = HResult($88760000 + 280);
DDERR_NOROTATIONHW = HResult($88760000 + 290);
DDERR_NOSTRETCHHW = HResult($88760000 + 310);
DDERR_NOT4BITCOLOR = HResult($88760000 + 316);
DDERR_NOT4BITCOLORINDEX = HResult($88760000 + 317);
DDERR_NOT8BITCOLOR = HResult($88760000 + 320);
DDERR_NOTEXTUREHW = HResult($88760000 + 330);
DDERR_NOVSYNCHW = HResult($88760000 + 335);
DDERR_NOZBUFFERHW = HResult($88760000 + 340);
DDERR_NOZOVERLAYHW = HResult($88760000 + 350);
DDERR_OUTOFCAPS = HResult($88760000 + 360);
DDERR_OUTOFMEMORY = HResult(E_OUTOFMEMORY);
DDERR_OUTOFVIDEOMEMORY = HResult($88760000 + 380);
DDERR_OVERLAYCANTCLIP = HResult($88760000 + 382);
DDERR_OVERLAYCOLORKEYONLYONEACTIVE = HResult($88760000 + 384);
DDERR_PALETTEBUSY = HResult($88760000 + 387);
DDERR_COLORKEYNOTSET = HResult($88760000 + 400);
DDERR_SURFACEALREADYATTACHED = HResult($88760000 + 410);
DDERR_SURFACEALREADYDEPENDENT = HResult($88760000 + 420);
DDERR_SURFACEBUSY = HResult($88760000 + 430);
DDERR_CANTLOCKSURFACE = HResult($88760000 + 435);
DDERR_SURFACEISOBSCURED = HResult($88760000 + 440);
DDERR_SURFACELOST = HResult($88760000 + 450);
DDERR_SURFACENOTATTACHED = HResult($88760000 + 460);
DDERR_TOOBIGHEIGHT = HResult($88760000 + 470);
DDERR_TOOBIGSIZE = HResult($88760000 + 480);
DDERR_TOOBIGWIDTH = HResult($88760000 + 490);
DDERR_UNSUPPORTED = HResult(E_NOTIMPL);
DDERR_UNSUPPORTEDFORMAT = HResult($88760000 + 510);
DDERR_UNSUPPORTEDMASK = HResult($88760000 + 520);
DDERR_INVALIDSTREAM = HResult($88760000 + 521);
DDERR_VERTICALBLANKINPROGRESS = HResult($88760000 + 537);
DDERR_WASSTILLDRAWING = HResult($88760000 + 540);
DDERR_DDSCAPSCOMPLEXREQUIRED = HResult($88760000 + 542);
DDERR_XALIGN = HResult($88760000 + 560);
DDERR_INVALIDDIRECTDRAWGUID = HResult($88760000 + 561);
DDERR_DIRECTDRAWALREADYCREATED = HResult($88760000 + 562);
DDERR_NODIRECTDRAWHW = HResult($88760000 + 563);
DDERR_PRIMARYSURFACEALREADYEXISTS = HResult($88760000 + 564);
DDERR_NOEMULATION = HResult($88760000 + 565);
DDERR_REGIONTOOSMALL = HResult($88760000 + 566);
DDERR_CLIPPERISUSINGHWND = HResult($88760000 + 567);
DDERR_NOCLIPPERATTACHED = HResult($88760000 + 568);
DDERR_NOHWND = HResult($88760000 + 569);
DDERR_HWNDSUBCLASSED = HResult($88760000 + 570);
DDERR_HWNDALREADYSET = HResult($88760000 + 571);
DDERR_NOPALETTEATTACHED = HResult($88760000 + 572);
DDERR_NOPALETTEHW = HResult($88760000 + 573);
DDERR_BLTFASTCANTCLIP = HResult($88760000 + 574);
DDERR_NOBLTHW = HResult($88760000 + 575);
DDERR_NODDROPSHW = HResult($88760000 + 576);
DDERR_OVERLAYNOTVISIBLE = HResult($88760000 + 577);
DDERR_NOOVERLAYDEST = HResult($88760000 + 578);
DDERR_INVALIDPOSITION = HResult($88760000 + 579);
DDERR_NOTAOVERLAYSURFACE = HResult($88760000 + 580);
DDERR_EXCLUSIVEMODEALREADYSET = HResult($88760000 + 581);
DDERR_NOTFLIPPABLE = HResult($88760000 + 582);
DDERR_CANTDUPLICATE = HResult($88760000 + 583);
DDERR_NOTLOCKED = HResult($88760000 + 584);
DDERR_CANTCREATEDC = HResult($88760000 + 585);
DDERR_NODC = HResult($88760000 + 586);
DDERR_WRONGMODE = HResult($88760000 + 587);
DDERR_IMPLICITLYCREATED = HResult($88760000 + 588);
DDERR_NOTPALETTIZED = HResult($88760000 + 589);
DDERR_UNSUPPORTEDMODE = HResult($88760000 + 590);
DDERR_NOMIPMAPHW = HResult($88760000 + 591);
DDERR_INVALIDSURFACETYPE = HResult($88760000 + 592);
DDERR_NOOPTIMIZEHW = HResult($88760000 + 600);
DDERR_NOTLOADED = HResult($88760000 + 601);
DDERR_NOFOCUSWINDOW = HResult($88760000 + 602);
DDERR_NOTONMIPMAPSUBLEVEL = HResult($88760000 + 603);
DDERR_DCALREADYCREATED = HResult($88760000 + 620);
DDERR_NONONLOCALVIDMEM = HResult($88760000 + 630);
DDERR_CANTPAGELOCK = HResult($88760000 + 640);
DDERR_CANTPAGEUNLOCK = HResult($88760000 + 660);
DDERR_NOTPAGELOCKED = HResult($88760000 + 680);
DDERR_MOREDATA = HResult($88760000 + 690);
DDERR_EXPIRED = HResult($88760000 + 691);
DDERR_TESTFINISHED = HResult($88760000 + 692);
DDERR_NEWMODE = HResult($88760000 + 693);
DDERR_D3DNOTINITIALIZED = HResult($88760000 + 694);
DDERR_VIDEONOTACTIVE = HResult($88760000 + 695);
DDERR_NOMONITORINFORMATION = HResult($88760000 + 696);
DDERR_NODRIVERSUPPORT = HResult($88760000 + 697);
DDERR_DEVICEDOESNTOWNSURFACE = HResult($88760000 + 699);
DDERR_NOTINITIALIZED = HResult(CO_E_NOTINITIALIZED);
_FACDD = $876;
MAKE_DDHRESULT = HResult(1 shl 31) or HResult(_FACDD shl 16);
 
{ API's }
 
function GET_WHQL_YEAR(dwWHQLLevel: DWORD): DWORD;
function GET_WHQL_MONTH(dwWHQLLevel: DWORD): DWORD;
function GET_WHQL_DAY(dwWHQLLevel: DWORD): DWORD;
(*
* This object is already initialized
*)
DDERR_ALREADYINITIALIZED = MAKE_DDHRESULT + 5;
 
(*
* This surface can not be attached to the requested surface.
*)
DDERR_CANNOTATTACHSURFACE = MAKE_DDHRESULT + 10;
 
(*
* This surface can not be detached from the requested surface.
*)
DDERR_CANNOTDETACHSURFACE = MAKE_DDHRESULT + 20;
 
(*
* Support is currently not available.
*)
DDERR_CURRENTLYNOTAVAIL = MAKE_DDHRESULT + 40;
 
(*
* An exception was encountered while performing the requested operation
*)
DDERR_EXCEPTION = MAKE_DDHRESULT + 55;
 
(*
* Generic failure.
*)
DDERR_GENERIC = E_FAIL;
 
(*
* Height of rectangle provided is not a multiple of reqd alignment
*)
DDERR_HEIGHTALIGN = MAKE_DDHRESULT + 90;
 
(*
* Unable to match primary surface creation request with existing
* primary surface.
*)
DDERR_INCOMPATIBLEPRIMARY = MAKE_DDHRESULT + 95;
 
(*
* One or more of the caps bits passed to the callback are incorrect.
*)
DDERR_INVALIDCAPS = MAKE_DDHRESULT + 100;
 
(*
* DirectDraw does not support provided Cliplist.
*)
DDERR_INVALIDCLIPLIST = MAKE_DDHRESULT + 110;
 
(*
* DirectDraw does not support the requested mode
*)
DDERR_INVALIDMODE = MAKE_DDHRESULT + 120;
 
(*
* DirectDraw received a pointer that was an invalid DIRECTDRAW object.
*)
DDERR_INVALIDOBJECT = MAKE_DDHRESULT + 130;
 
(*
* One or more of the parameters passed to the callback function are
* incorrect.
*)
DDERR_INVALIDPARAMS = E_INVALIDARG;
 
(*
* pixel format was invalid as specified
*)
DDERR_INVALIDPIXELFORMAT = MAKE_DDHRESULT + 145;
 
(*
* Rectangle provided was invalid.
*)
DDERR_INVALIDRECT = MAKE_DDHRESULT + 150;
 
(*
* Operation could not be carried out because one or more surfaces are locked
*)
DDERR_LOCKEDSURFACES = MAKE_DDHRESULT + 160;
 
(*
* There is no 3D present.
*)
DDERR_NO3D = MAKE_DDHRESULT + 170;
 
(*
* Operation could not be carried out because there is no alpha accleration
* hardware present or available.
*)
DDERR_NOALPHAHW = MAKE_DDHRESULT + 180;
 
(*
* Operation could not be carried out because there is no stereo
* hardware present or available.
*)
DDERR_NOSTEREOHARDWARE = MAKE_DDHRESULT + 181;
 
(*
* Operation could not be carried out because there is no hardware
* present which supports stereo surfaces
*)
DDERR_NOSURFACELEFT = MAKE_DDHRESULT + 182;
 
(*
* no clip list available
*)
DDERR_NOCLIPLIST = MAKE_DDHRESULT + 205;
 
(*
* Operation could not be carried out because there is no color conversion
* hardware present or available.
*)
DDERR_NOCOLORCONVHW = MAKE_DDHRESULT + 210;
 
(*
* Create function called without DirectDraw object method SetCooperativeLevel
* being called.
*)
DDERR_NOCOOPERATIVELEVELSET = MAKE_DDHRESULT + 212;
 
(*
* Surface doesn't currently have a color key
*)
DDERR_NOCOLORKEY = MAKE_DDHRESULT + 215;
 
(*
* Operation could not be carried out because there is no hardware support
* of the dest color key.
*)
DDERR_NOCOLORKEYHW = MAKE_DDHRESULT + 220;
 
(*
* No DirectDraw support possible with current display driver
*)
DDERR_NODIRECTDRAWSUPPORT = MAKE_DDHRESULT + 222;
 
(*
* Operation requires the application to have exclusive mode but the
* application does not have exclusive mode.
*)
DDERR_NOEXCLUSIVEMODE = MAKE_DDHRESULT + 225;
 
(*
* Flipping visible surfaces is not supported.
*)
DDERR_NOFLIPHW = MAKE_DDHRESULT + 230;
 
(*
* There is no GDI present.
*)
DDERR_NOGDI = MAKE_DDHRESULT + 240;
 
(*
* Operation could not be carried out because there is no hardware present
* or available.
*)
DDERR_NOMIRRORHW = MAKE_DDHRESULT + 250;
 
(*
* Requested item was not found
*)
DDERR_NOTFOUND = MAKE_DDHRESULT + 255;
 
(*
* Operation could not be carried out because there is no overlay hardware
* present or available.
*)
DDERR_NOOVERLAYHW = MAKE_DDHRESULT + 260;
 
(*
* Operation could not be carried out because the source and destination
* rectangles are on the same surface and overlap each other.
*)
DDERR_OVERLAPPINGRECTS = MAKE_DDHRESULT + 270;
 
(*
* Operation could not be carried out because there is no appropriate raster
* op hardware present or available.
*)
DDERR_NORASTEROPHW = MAKE_DDHRESULT + 280;
 
(*
* Operation could not be carried out because there is no rotation hardware
* present or available.
*)
DDERR_NOROTATIONHW = MAKE_DDHRESULT + 290;
 
(*
* Operation could not be carried out because there is no hardware support
* for stretching
*)
DDERR_NOSTRETCHHW = MAKE_DDHRESULT + 310;
 
(*
* DirectDrawSurface is not in 4 bit color palette and the requested operation
* requires 4 bit color palette.
*)
DDERR_NOT4BITCOLOR = MAKE_DDHRESULT + 316;
 
(*
* DirectDrawSurface is not in 4 bit color index palette and the requested
* operation requires 4 bit color index palette.
*)
DDERR_NOT4BITCOLORINDEX = MAKE_DDHRESULT + 317;
 
(*
* DirectDraw Surface is not in 8 bit color mode and the requested operation
* requires 8 bit color.
*)
DDERR_NOT8BITCOLOR = MAKE_DDHRESULT + 320;
 
(*
* Operation could not be carried out because there is no texture mapping
* hardware present or available.
*)
DDERR_NOTEXTUREHW = MAKE_DDHRESULT + 330;
 
(*
* Operation could not be carried out because there is no hardware support
* for vertical blank synchronized operations.
*)
DDERR_NOVSYNCHW = MAKE_DDHRESULT + 335;
 
(*
* Operation could not be carried out because there is no hardware support
* for zbuffer blting.
*)
DDERR_NOZBUFFERHW = MAKE_DDHRESULT + 340;
 
(*
* Overlay surfaces could not be z layered based on their BltOrder because
* the hardware does not support z layering of overlays.
*)
DDERR_NOZOVERLAYHW = MAKE_DDHRESULT + 350;
 
(*
* The hardware needed for the requested operation has already been
* allocated.
*)
DDERR_OUTOFCAPS = MAKE_DDHRESULT + 360;
 
(*
* DirectDraw does not have enough memory to perform the operation.
*)
DDERR_OUTOFMEMORY = E_OUTOFMEMORY;
 
(*
* DirectDraw does not have enough memory to perform the operation.
*)
DDERR_OUTOFVIDEOMEMORY = MAKE_DDHRESULT + 380;
 
(*
* hardware does not support clipped overlays
*)
DDERR_OVERLAYCANTCLIP = MAKE_DDHRESULT + 382;
 
(*
* Can only have ony color key active at one time for overlays
*)
DDERR_OVERLAYCOLORKEYONLYONEACTIVE = MAKE_DDHRESULT + 384;
 
(*
* Access to this palette is being refused because the palette is already
* locked by another thread.
*)
DDERR_PALETTEBUSY = MAKE_DDHRESULT + 387;
 
(*
* No src color key specified for this operation.
*)
DDERR_COLORKEYNOTSET = MAKE_DDHRESULT + 400;
 
(*
* This surface is already attached to the surface it is being attached to.
*)
DDERR_SURFACEALREADYATTACHED = MAKE_DDHRESULT + 410;
 
(*
* This surface is already a dependency of the surface it is being made a
* dependency of.
*)
DDERR_SURFACEALREADYDEPENDENT = MAKE_DDHRESULT + 420;
 
(*
* Access to this surface is being refused because the surface is already
* locked by another thread.
*)
DDERR_SURFACEBUSY = MAKE_DDHRESULT + 430;
 
(*
* Access to this surface is being refused because no driver exists
* which can supply a pointer to the surface.
* This is most likely to happen when attempting to lock the primary
* surface when no DCI provider is present.
* Will also happen on attempts to lock an optimized surface.
*)
DDERR_CANTLOCKSURFACE = MAKE_DDHRESULT + 435;
 
(*
* Access to Surface refused because Surface is obscured.
*)
DDERR_SURFACEISOBSCURED = MAKE_DDHRESULT + 440;
 
(*
* Access to this surface is being refused because the surface is gone.
* The DIRECTDRAWSURFACE object representing this surface should
* have Restore called on it.
*)
DDERR_SURFACELOST = MAKE_DDHRESULT + 450;
 
(*
* The requested surface is not attached.
*)
DDERR_SURFACENOTATTACHED = MAKE_DDHRESULT + 460;
 
(*
* Height requested by DirectDraw is too large.
*)
DDERR_TOOBIGHEIGHT = MAKE_DDHRESULT + 470;
 
(*
* Size requested by DirectDraw is too large -- The individual height and
* width are OK.
*)
DDERR_TOOBIGSIZE = MAKE_DDHRESULT + 480;
 
(*
* Width requested by DirectDraw is too large.
*)
DDERR_TOOBIGWIDTH = MAKE_DDHRESULT + 490;
 
(*
* Action not supported.
*)
DDERR_UNSUPPORTED = E_NOTIMPL;
 
(*
* FOURCC format requested is unsupported by DirectDraw
*)
DDERR_UNSUPPORTEDFORMAT = MAKE_DDHRESULT + 510;
 
(*
* Bitmask in the pixel format requested is unsupported by DirectDraw
*)
DDERR_UNSUPPORTEDMASK = MAKE_DDHRESULT + 520;
 
(*
* The specified stream contains invalid data
*)
DDERR_INVALIDSTREAM = MAKE_DDHRESULT + 521;
 
(*
* vertical blank is in progress
*)
DDERR_VERTICALBLANKINPROGRESS = MAKE_DDHRESULT + 537;
 
(*
* Informs DirectDraw that the previous Blt which is transfering information
* to or from this Surface is incomplete.
*)
DDERR_WASSTILLDRAWING = MAKE_DDHRESULT + 540;
 
(*
* The specified surface type requires specification of the COMPLEX flag
*)
DDERR_DDSCAPSCOMPLEXREQUIRED = MAKE_DDHRESULT + 542;
 
(*
* Rectangle provided was not horizontally aligned on reqd. boundary
*)
DDERR_XALIGN = MAKE_DDHRESULT + 560;
 
(*
* The GUID passed to DirectDrawCreate is not a valid DirectDraw driver
* identifier.
*)
DDERR_INVALIDDIRECTDRAWGUID = MAKE_DDHRESULT + 561;
 
(*
* A DirectDraw object representing this driver has already been created
* for this process.
*)
DDERR_DIRECTDRAWALREADYCREATED = MAKE_DDHRESULT + 562;
 
(*
* A hardware only DirectDraw object creation was attempted but the driver
* did not support any hardware.
*)
DDERR_NODIRECTDRAWHW = MAKE_DDHRESULT + 563;
 
(*
* this process already has created a primary surface
*)
DDERR_PRIMARYSURFACEALREADYEXISTS = MAKE_DDHRESULT + 564;
 
(*
* software emulation not available.
*)
DDERR_NOEMULATION = MAKE_DDHRESULT + 565;
 
(*
* region passed to Clipper::GetClipList is too small.
*)
DDERR_REGIONTOOSMALL = MAKE_DDHRESULT + 566;
 
(*
* an attempt was made to set a clip list for a clipper objec that
* is already monitoring an hwnd.
*)
DDERR_CLIPPERISUSINGHWND = MAKE_DDHRESULT + 567;
 
(*
* No clipper object attached to surface object
*)
DDERR_NOCLIPPERATTACHED = MAKE_DDHRESULT + 568;
 
(*
* Clipper notification requires an HWND or
* no HWND has previously been set as the CooperativeLevel HWND.
*)
DDERR_NOHWND = MAKE_DDHRESULT + 569;
 
(*
* HWND used by DirectDraw CooperativeLevel has been subclassed,
* this prevents DirectDraw from restoring state.
*)
DDERR_HWNDSUBCLASSED = MAKE_DDHRESULT + 570;
 
(*
* The CooperativeLevel HWND has already been set.
* It can not be reset while the process has surfaces or palettes created.
*)
DDERR_HWNDALREADYSET = MAKE_DDHRESULT + 571;
 
(*
* No palette object attached to this surface.
*)
DDERR_NOPALETTEATTACHED = MAKE_DDHRESULT + 572;
 
(*
* No hardware support for 16 or 256 color palettes.
*)
DDERR_NOPALETTEHW = MAKE_DDHRESULT + 573;
 
(*
* If a clipper object is attached to the source surface passed into a
* BltFast call.
*)
DDERR_BLTFASTCANTCLIP = MAKE_DDHRESULT + 574;
 
(*
* No blter.
*)
DDERR_NOBLTHW = MAKE_DDHRESULT + 575;
 
(*
* No DirectDraw ROP hardware.
*)
DDERR_NODDROPSHW = MAKE_DDHRESULT + 576;
 
(*
* returned when GetOverlayPosition is called on a hidden overlay
*)
DDERR_OVERLAYNOTVISIBLE = MAKE_DDHRESULT + 577;
 
(*
* returned when GetOverlayPosition is called on a overlay that UpdateOverlay
* has never been called on to establish a destionation.
*)
DDERR_NOOVERLAYDEST = MAKE_DDHRESULT + 578;
 
(*
* returned when the position of the overlay on the destionation is no longer
* legal for that destionation.
*)
DDERR_INVALIDPOSITION = MAKE_DDHRESULT + 579;
 
(*
* returned when an overlay member is called for a non-overlay surface
*)
DDERR_NOTAOVERLAYSURFACE = MAKE_DDHRESULT + 580;
 
(*
* An attempt was made to set the cooperative level when it was already
* set to exclusive.
*)
DDERR_EXCLUSIVEMODEALREADYSET = MAKE_DDHRESULT + 581;
 
(*
* An attempt has been made to flip a surface that is not flippable.
*)
DDERR_NOTFLIPPABLE = MAKE_DDHRESULT + 582;
 
(*
* Can't duplicate primary & 3D surfaces, or surfaces that are implicitly
* created.
*)
DDERR_CANTDUPLICATE = MAKE_DDHRESULT + 583;
 
(*
* Surface was not locked. An attempt to unlock a surface that was not
* locked at all, or by this process, has been attempted.
*)
DDERR_NOTLOCKED = MAKE_DDHRESULT + 584;
 
(*
* Windows can not create any more DCs, or a DC was requested for a paltte-indexed
* surface when the surface had no palette AND the display mode was not palette-indexed
* (in this case DirectDraw cannot select a proper palette into the DC)
*)
DDERR_CANTCREATEDC = MAKE_DDHRESULT + 585;
 
(*
* No DC was ever created for this surface.
*)
DDERR_NODC = MAKE_DDHRESULT + 586;
 
(*
* This surface can not be restored because it was created in a different
* mode.
*)
DDERR_WRONGMODE = MAKE_DDHRESULT + 587;
 
(*
* This surface can not be restored because it is an implicitly created
* surface.
*)
DDERR_IMPLICITLYCREATED = MAKE_DDHRESULT + 588;
 
(*
* The surface being used is not a palette-based surface
*)
DDERR_NOTPALETTIZED = MAKE_DDHRESULT + 589;
 
(*
* The display is currently in an unsupported mode
*)
DDERR_UNSUPPORTEDMODE = MAKE_DDHRESULT + 590;
 
(*
* Operation could not be carried out because there is no mip-map
* texture mapping hardware present or available.
*)
DDERR_NOMIPMAPHW = MAKE_DDHRESULT + 591;
 
(*
* The requested action could not be performed because the surface was of
* the wrong type.
*)
DDERR_INVALIDSURFACETYPE = MAKE_DDHRESULT + 592;
 
(*
* Device does not support optimized surfaces, therefore no video memory optimized surfaces
*)
DDERR_NOOPTIMIZEHW = MAKE_DDHRESULT + 600;
 
(*
* Surface is an optimized surface, but has not yet been allocated any memory
*)
DDERR_NOTLOADED = MAKE_DDHRESULT + 601;
 
(*
* Attempt was made to create or set a device window without first setting
* the focus window
*)
DDERR_NOFOCUSWINDOW = MAKE_DDHRESULT + 602;
 
(*
* Attempt was made to set a palette on a mipmap sublevel
*)
DDERR_NOTONMIPMAPSUBLEVEL = MAKE_DDHRESULT + 603;
 
(*
* A DC has already been returned for this surface. Only one DC can be
* retrieved per surface.
*)
DDERR_DCALREADYCREATED = MAKE_DDHRESULT + 620;
 
(*
* An attempt was made to allocate non-local video memory from a device
* that does not support non-local video memory.
*)
DDERR_NONONLOCALVIDMEM = MAKE_DDHRESULT + 630;
 
(*
* The attempt to page lock a surface failed.
*)
DDERR_CANTPAGELOCK = MAKE_DDHRESULT + 640;
 
(*
* The attempt to page unlock a surface failed.
*)
DDERR_CANTPAGEUNLOCK = MAKE_DDHRESULT + 660;
 
(*
* An attempt was made to page unlock a surface with no outstanding page locks.
*)
DDERR_NOTPAGELOCKED = MAKE_DDHRESULT + 680;
 
(*
* There is more data available than the specified buffer size could hold
*)
DDERR_MOREDATA = MAKE_DDHRESULT + 690;
 
(*
* The data has expired and is therefore no longer valid.
*)
DDERR_EXPIRED = MAKE_DDHRESULT + 691;
 
(*
* The mode test has finished executing.
*)
DDERR_TESTFINISHED = MAKE_DDHRESULT + 692;
 
(*
* The mode test has switched to a new mode.
*)
DDERR_NEWMODE = MAKE_DDHRESULT + 693;
 
(*
* D3D has not yet been initialized.
*)
DDERR_D3DNOTINITIALIZED = MAKE_DDHRESULT + 694;
 
(*
* The video port is not active
*)
DDERR_VIDEONOTACTIVE = MAKE_DDHRESULT + 695;
 
(*
* The monitor does not have EDID data.
*)
DDERR_NOMONITORINFORMATION = MAKE_DDHRESULT + 696;
 
(*
* The driver does not enumerate display mode refresh rates.
*)
DDERR_NODRIVERSUPPORT = MAKE_DDHRESULT + 697;
 
(*
* Surfaces created by one direct draw device cannot be used directly by
* another direct draw device.
*)
DDERR_DEVICEDOESNTOWNSURFACE = MAKE_DDHRESULT + 699;
 
(*
* An attempt was made to invoke an interface member of a DirectDraw object
* created by CoCreateInstance() before it was initialized.
*)
DDERR_NOTINITIALIZED = CO_E_NOTINITIALIZED;
 
(* Alpha bit depth constants *)
 
(*
* API's
*)
 
type
HMonitor = THandle;
 
TDDEnumCallbackA = function(lpGUID: PGUID; lpDriverDescription: LPSTR;
lpDriverName: LPSTR; lpContext: Pointer): BOOL; stdcall;
LPDDENUMCALLBACKA = TDDEnumCallbackA;
TDDEnumCallbackA = function (lpGUID: PGUID; lpDriverDescription: PAnsiChar;
lpDriverName: PAnsiChar; lpContext: Pointer) : BOOL; stdcall;
TDDEnumCallbackW = function (lpGUID: PGUID; lpDriverDescription: PWideChar;
lpDriverName: PWideChar; lpContext: Pointer) : BOOL; stdcall;
{$IFDEF UNICODE}
TDDEnumCallback = TDDEnumCallbackW;
{$ELSE}
TDDEnumCallback = TDDEnumCallbackA;
{$ENDIF}
 
TDDEnumCallbackW = function(lpGUID: PGUID; lpDriverDescription: LPWSTR;
lpDriverName: LPWSTR; lpContext: Pointer): BOOL; stdcall;
LPDDENUMCALLBACKW = TDDEnumCallbackW;
TDDEnumCallbackExA = function (lpGUID: PGUID; lpDriverDescription: PAnsiChar;
lpDriverName: PAnsiChar; lpContext: Pointer; Monitor: HMonitor) : BOOL;
stdcall;
TDDEnumCallbackExW = function (lpGUID: PGUID; lpDriverDescription: PWideChar;
lpDriverName: PWideChar; lpContext: Pointer; Monitor: HMonitor) : BOOL;
stdcall;
 
TDDEnumCallback = TDDEnumCallbackA;
LPDDENUMCALLBACK = TDDEnumCallback;
{$IFDEF UNICODE}
TDDEnumCallbackEx = TDDEnumCallbackExW;
{$ELSE}
TDDEnumCallbackEx = TDDEnumCallbackExA;
{$ENDIF}
 
TDDEnumCallbackExA = function(lpGUID: PGUID; lpDriverDescription: LPSTR;
lpDriverName: LPSTR; lpContext: Pointer; Monitor: HMonitor): BOOL; stdcall;
LPDDENUMCALLBACKEXA = TDDEnumCallbackExA;
var
DirectDrawEnumerateA : function (lpCallback: TDDEnumCallbackA;
lpContext: Pointer) : HResult; stdcall;
DirectDrawEnumerateW : function (lpCallback: TDDEnumCallbackW;
lpContext: Pointer) : HResult; stdcall;
DirectDrawEnumerate : function (lpCallback: TDDEnumCallback;
lpContext: Pointer) : HResult; stdcall;
 
TDDEnumCallbackExW = function(lpGUID: PGUID; lpDriverDescription: LPWSTR;
lpDriverName: LPWSTR; lpContext: Pointer; Monitor: HMonitor): BOOL; stdcall;
LPDDENUMCALLBACKEXW = TDDEnumCallbackExW;
DirectDrawEnumerateExA : function (lpCallback: TDDEnumCallbackExA;
lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
DirectDrawEnumerateExW : function (lpCallback: TDDEnumCallbackExW;
lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
DirectDrawEnumerateEx : function (lpCallback: TDDEnumCallbackEx;
lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
 
TDDEnumCallbackEx = TDDEnumCallbackExA;
LPDDENUMCALLBACKEX = TDDEnumCallbackEx;
DirectDrawCreate : function (lpGUID: PGUID;
out lplpDD: IDirectDraw;
pUnkOuter: IUnknown) : HResult; stdcall;
DirectDrawCreateEx : function (lpGUID: PGUID;
out lplpDD: IDirectDraw7; const iid: TGUID;
pUnkOuter: IUnknown) : HResult; stdcall;
DirectDrawCreateClipper : function (dwFlags: DWORD;
out lplpDDClipper: IDirectDrawClipper;
pUnkOuter: IUnknown) : HResult; stdcall;
 
const
(*
* Flags for DirectDrawEnumerateEx
* DirectDrawEnumerateEx supercedes DirectDrawEnumerate. You must use GetProcAddress to
* obtain a function pointer (of type LPDIRECTDRAWENUMERATEEX) to DirectDrawEnumerateEx.
* By default, only the primary display device is enumerated.
* DirectDrawEnumerate is equivalent to DirectDrawEnumerate(,,DDENUM_NONDISPLAYDEVICES)
*)
 
(*
* This flag causes enumeration of any GDI display devices which are part of
* the Windows Desktop
*)
DDENUM_ATTACHEDSECONDARYDEVICES = $00000001;
 
(*
* This flag causes enumeration of any GDI display devices which are not
* part of the Windows Desktop
*)
DDENUM_DETACHEDSECONDARYDEVICES = $00000002;
 
(*
* This flag causes enumeration of non-display devices
*)
DDENUM_NONDISPLAYDEVICES = $00000004;
 
REGSTR_KEY_DDHW_DESCRIPTION = 'Description';
REGSTR_KEY_DDHW_DRIVERNAME = 'DriverName';
REGSTR_PATH_DDHW = 'Hardware\DirectDrawDrivers';
2154,21 → 4864,14
DDCREATE_HARDWAREONLY = $00000001;
DDCREATE_EMULATIONONLY = $00000002;
 
function DirectDrawEnumerateA(lpCallback: TDDEnumCallbackA; lpContext: Pointer): HResult; stdcall;
function DirectDrawEnumerateW(lpCallback: TDDEnumCallbackW; lpContext: Pointer): HResult; stdcall;
function DirectDrawEnumerate(lpCallback: TDDEnumCallbackA; lpContext: Pointer): HResult; stdcall;
(*
* Macros for interpretting DDEVICEIDENTIFIER2.dwWHQLLevel
*)
function GET_WHQL_YEAR(dwWHQLLevel: DWORD) : DWORD;
function GET_WHQL_MONTH(dwWHQLLevel: DWORD) : DWORD;
function GET_WHQL_DAY(dwWHQLLevel: DWORD) : DWORD;
 
function DirectDrawEnumerateExA(lpCallback: TDDEnumCallbackExA; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function DirectDrawEnumerateExW(lpCallback: TDDEnumCallbackExW; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function DirectDrawEnumerateEx(lpCallback: TDDEnumCallbackExA; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
 
function DirectDrawCreate(lpGUID: PGUID; out lplpDD: IDirectDraw;
pUnkOuter: IUnknown): HResult; stdcall;
function DirectDrawCreateEx(lpGUID: PGUID; out lplpDD; const iid: TGUID;
pUnkOuter: IUnknown): HResult; stdcall;
function DirectDrawCreateClipper(dwFlags: DWORD; out lplpDDClipper: IDirectDrawClipper;
pUnkOuter: IUnknown): HResult; stdcall;
 
(*==========================================================================;
*
* Copyright (C) 1996-1997 Microsoft Corporation. All Rights Reserved.
2178,31 → 4881,45
*
***************************************************************************)
 
{ GUIDS used by DirectDrawVideoPort objects }
 
const
IID_IDDVideoPortContainer: TGUID = '{6C142760-A733-11CE-A521-0020AF0BE560}';
IID_IDirectDrawVideoPort: TGUID = '{B36D93E0-2B43-11CF-A2DE-00AA00B93356}';
(*
* GUIDS used by DirectDrawVideoPort objects
*)
DDVPTYPE_E_HREFH_VREFH: TGUID =
(D1:$54F39980;D2:$DA60;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
DDVPTYPE_E_HREFH_VREFL: TGUID =
(D1:$92783220;D2:$DA60;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
DDVPTYPE_E_HREFL_VREFH: TGUID =
(D1:$A07A02E0;D2:$DA60;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
DDVPTYPE_E_HREFL_VREFL: TGUID =
(D1:$E09C77E0;D2:$DA60;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
DDVPTYPE_CCIR656: TGUID =
(D1:$FCA326A0;D2:$DA60;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
DDVPTYPE_BROOKTREE: TGUID =
(D1:$1352A560;D2:$DA61;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
DDVPTYPE_PHILIPS: TGUID =
(D1:$332CF160;D2:$DA61;D3:$11CF;D4:($9B,$06,$00,$A0,$C9,$03,$A3,$B8));
 
DDVPTYPE_E_HREFH_VREFH: TGUID = '{54F39980-DA60-11CF-9B06-00A0C903A3B8}';
DDVPTYPE_E_HREFH_VREFL: TGUID = '{92783220-DA60-11CF-9B06-00A0C903A3B8}';
DDVPTYPE_E_HREFL_VREFH: TGUID = '{A07A02E0-DA60-11CF-9B06-00A0C903A3B8}';
DDVPTYPE_E_HREFL_VREFL: TGUID = '{E09C77E0-DA60-11CF-9B06-00A0C903A3B8}';
DDVPTYPE_CCIR656: TGUID = '{FCA326A0-DA60-11CF-9B06-00A0C903A3B8}';
DDVPTYPE_BROOKTREE: TGUID = '{1352A560-DA61-11CF-9B06-00A0C903A3B8}';
DDVPTYPE_PHILIPS: TGUID = '{332CF160-DA61-11CF-9B06-00A0C903A3B8}';
(*
* GUIDS used to describe connections
*)
 
{ DirectDraw Structures }
(*============================================================================
*
* DirectDraw Structures
*
* Various structures used to invoke DirectDraw.
*
*==========================================================================*)
 
type
IDDVideoPortContainer = interface;
IDirectDrawVideoPort = interface;
 
{ TDDVideoportConnect structure }
 
PDDVideoportConnect = ^TDDVideoportConnect;
TDDVideoportConnect = record
dwSize: DWORD; // size of the TDDVideoportConnect structure
(*
* TDDVideoPortConnect
*)
PDDVideoPortConnect = ^TDDVideoPortConnect;
TDDVideoPortConnect = packed record
dwSize: DWORD; // size of the TDDVideoPortConnect structure
dwPortWidth: DWORD; // Width of the video port
guidTypeID: TGUID; // Description of video port connection
dwFlags: DWORD; // Connection flags
2209,14 → 4926,12
dwReserved1: DWORD; // Reserved, set to zero.
end;
 
DDVIDEOPORTCONNECT = TDDVideoportConnect;
LPDDVIDEOPORTCONNECT = PDDVideoportConnect;
 
{ TDDVideoportCaps structure }
 
PDDVideoportCaps = ^TDDVideoportCaps;
TDDVideoportCaps = record
dwSize: DWORD; // size of the TDDVideoportCaps structure
(*
* TDDVideoPortCaps
*)
PDDVideoPortCaps = ^TDDVideoPortCaps;
TDDVideoPortCaps = packed record
dwSize: DWORD; // size of the TDDVideoPortCaps structure
dwFlags: DWORD; // indicates which fields contain data
dwMaxWidth: DWORD; // max width of the video port field
dwMaxVBIWidth: DWORD; // max width of the VBI data
2237,14 → 4952,59
wNumFilterTapsY: WORD; // Number of taps the prescaler uses in the Y direction (0 - no prescale, 1 - replication, etc.)
end;
 
DDVIDEOPORTCAPS = TDDVideoportCaps;
LPDDVIDEOPORTCAPS = PDDVideoportCaps;
const
(*
* The dwMaxWidth and dwMaxVBIWidth members are valid
*)
DDVPD_WIDTH = $00000001;
 
{ TDDVideoportDesc structure }
(*
* The dwMaxHeight member is valid
*)
DDVPD_HEIGHT = $00000002;
 
PDDVideoportDesc = ^TDDVideoportDesc;
TDDVideoportDesc = record
dwSize: DWORD; // size of the TDDVideoportDesc structure
(*
* The dwVideoPortID member is valid
*)
DDVPD_ID = $00000004;
 
(*
* The dwCaps member is valid
*)
DDVPD_CAPS = $00000008;
 
(*
* The dwFX member is valid
*)
DDVPD_FX = $00000010;
 
(*
* The dwNumAutoFlipSurfaces member is valid
*)
DDVPD_AUTOFLIP = $00000020;
 
(*
* All of the alignment members are valid
*)
DDVPD_ALIGN = $00000040;
 
(*
* The dwNumPreferredAutoflip member is valid
*)
DDVPD_PREFERREDAUTOFLIP = $00000080;
 
(*
* The wNumFilterTapsX and wNumFilterTapsY fields are valid
*)
DDVPD_FILTERQUALITY = $00000100;
 
type
(*
* TDDVideoPortDesc
*)
PDDVideoPortDesc = ^TDDVideoPortDesc;
TDDVideoPortDesc = packed record
dwSize: DWORD; // size of the TDDVideoPortDesc structure
dwFieldWidth: DWORD; // width of the video port field
dwVBIWidth: DWORD; // width of the VBI data
dwFieldHeight: DWORD; // height of the video port field
2252,18 → 5012,16
dwMaxPixelsPerSecond: DWORD; // Maximum pixel rate per second
dwVideoPortID: DWORD; // Video port ID (0 - (dwMaxVideoPorts -1))
dwReserved1: DWORD; // Reserved for future use - set to zero
VideoPortType: TDDVideoportConnect; // Description of video port connection
VideoPortType: TDDVideoPortConnect; // Description of video port connection
dwReserved2: DWORD; // Reserved for future use - set to zero
dwReserved3: DWORD; // Reserved for future use - set to zero
end;
 
DDVIDEOPORTDESC = TDDVideoportDesc;
LPDDVIDEOPORTDESC = PDDVideoportDesc;
 
{ TDDVideoportInfo structure }
 
PDDVideoportInfo = ^TDDVideoportInfo;
TDDVideoportInfo = record
(*
* TDDVideoPortInfo
*)
PDDVideoPortInfo = ^TDDVideoPortInfo;
TDDVideoPortInfo = packed record
dwSize: DWORD; // Size of the structure
dwOriginX: DWORD; // Placement of the video data within the surface.
dwOriginY: DWORD; // Placement of the video data within the surface.
2279,13 → 5037,11
dwReserved2: DWORD; // Reserved for future use - set to zero
end;
 
DDVIDEOPORTINFO = TDDVideoportInfo;
LPDDVIDEOPORTINFO = PDDVideoportInfo;
 
{ TDDVideoportBandWidth structure }
 
PDDVideoportBandWidth = ^TDDVideoportBandWidth;
TDDVideoportBandWidth = record
(*
* TDDVideoPortBandWidth
*)
PDDVideoPortBandWidth = ^TDDVideoPortBandWidth;
TDDVideoPortBandWidth = packed record
dwSize: DWORD; // Size of the structure
dwCaps: DWORD;
dwOverlay: DWORD; // Zoom factor at which overlay is supported
2296,226 → 5052,669
dwReserved2: DWORD; // Reserved for future use - set to zero
end;
 
DDVIDEOPORTBANDWIDTH = TDDVideoportBandWidth;
LPDDVIDEOPORTBANDWIDTH = PDDVideoportBandWidth;
 
{ TDDVideoportStatus structure }
 
PDDVideoportStatus = ^TDDVideoportStatus;
TDDVideoportStatus = record
(*
* TDDVideoPortStatus
*)
PDDVideoPortStatus = ^TDDVideoPortStatus;
TDDVideoPortStatus = record
dwSize: DWORD; // Size of the structure
bInUse: BOOL; // TRUE if video port is currently being used
dwFlags: DWORD; // Currently not used
dwReserved1: DWORD; // Reserved for future use
VideoPortType: TDDVideoportConnect; // Information about the connection
VideoPortType: TDDVideoPortConnect; // Information about the connection
dwReserved2: DWORD; // Reserved for future use
dwReserved3: DWORD; // Reserved for future use
end;
 
DDVIDEOPORTSTATUS = TDDVideoportStatus;
LPDDVIDEOPORTSTATUS = PDDVideoportStatus;
 
{ API's }
 
TDDEnumVideoCallback = function(const lpDDVideoPortCaps: TDDVideoportCaps;
lpContext: Pointer): HResult; stdcall;
LPDDENUMVIDEOCALLBACK = TDDEnumVideoCallback;
 
{ IDirectDrawVideoPortContainer Interface }
 
IDDVideoPortContainer = interface(IUnknown)
['{6C142760-A733-11CE-A521-0020AF0BE560}']
// IDDVideoPortContainer methods
function CreateVideoPort(dwFlags: DWORD; const lpDDVideoPortDesc:
TDDVideoportDesc; out lplpDDVideoPort: IDirectDrawVideoPort;
pUnkOuter: IUnknown): HResult; stdcall;
function EnumVideoPorts(dwFlags: DWORD;
const lpDDVideoPortCaps: TDDVideoportCaps; lpContext: Pointer;
lpEnumVideoCallback: TDDEnumVideoCallback): HResult; stdcall;
function GetVideoPortConnectInfo(dwPortId: DWORD; var lpNumEntries: DWORD;
var lpConnectInfo: TDDVideoportConnect): HResult; stdcall;
function QueryVideoPortStatus(dwPortId: DWORD;
var lpVPStatus: TDDVideoportStatus): HResult; stdcall;
end;
 
{ IDirectDrawVideoPort Interface }
 
IDirectDrawVideoPort = interface(IUnknown)
['{B36D93E0-2B43-11CF-A2DE-00AA00B93356}']
// IDirectDrawVideoPort methods
function Flip(lpDDSurface: IDirectDrawSurface; dwFlags: DWORD): HResult; stdcall;
function GetBandwidthInfo(const lpddpfFormat: TDDPixelFormat; dwWidth: DWORD;
dwHeight: DWORD; dwFlags: DWORD; var lpBandwidth: TDDVideoportBandWidth): HResult; stdcall;
function GetColorControls(var lpColorControl: TDDColorControl): HResult; stdcall;
function GetInputFormats(var lpNumFormats: DWORD; var lpFormats:
TDDPixelFormat; dwFlags: DWORD): HResult; stdcall;
function GetOutputFormats(const lpInputFormat: TDDPixelFormat;
var lpNumFormats: DWORD; var lpFormats: TDDPixelFormat; dwFlags: DWORD): HResult; stdcall;
function GetFieldPolarity(var lpbVideoField: BOOL): HResult; stdcall;
function GetVideoLine(var lpdwLine: DWORD): HResult; stdcall;
function GetVideoSignalStatus(varlpdwStatus: DWORD): HResult; stdcall;
function SetColorControls(const lpColorControl: TDDColorControl): HResult; stdcall;
function SetTargetSurface(lpDDSurface: IDirectDrawSurface; dwFlags: DWORD): HResult; stdcall;
function StartVideo(const lpVideoInfo: TDDVideoportInfo): HResult; stdcall;
function StopVideo: HResult; stdcall;
function UpdateVideo(const lpVideoInfo: TDDVideoportInfo): HResult; stdcall;
function WaitForSync(dwFlags: DWORD; dwLine: DWORD; dwTimeout: DWORD): HResult; stdcall;
end;
 
 
const
{ Video Port Flags }
(*============================================================================
*
* Video Port Flags
*
* All flags are bit flags.
*
*==========================================================================*)
 
DDVPD_WIDTH = $00000001;
DDVPD_HEIGHT = $00000002;
DDVPD_ID = $00000004;
DDVPD_CAPS = $00000008;
DDVPD_FX = $00000010;
DDVPD_AUTOFLIP = $00000020;
DDVPD_ALIGN = $00000040;
DDVPD_PREFERREDAUTOFLIP = $00000080;
DDVPD_FILTERQUALITY = $00000100;
(****************************************************************************
*
* VIDEOPORT TDDVideoPortConnect FLAGS
*
****************************************************************************)
 
{ TDDVideoportConnect flags }
(*
* When this is set by the driver and passed to the client, this
* indicates that the video port is capable of double clocking the data.
* When this is set by the client, this indicates that the video port
* should enable double clocking. This flag is only valid with external
* syncs.
*)
DDVPCONNECT_DOUBLECLOCK = $00000001;
 
DDVPCONNECT_DOUBLECLOCK = $00000001;
(*
* When this is set by the driver and passed to the client, this
* indicates that the video port is capable of using an external VACT
* signal. When this is set by the client, this indicates that the
* video port should use the external VACT signal.
*)
DDVPCONNECT_VACT = $00000002;
 
(*
* When this is set by the driver and passed to the client, this
* indicates that the video port is capable of treating even fields
* like odd fields and visa versa. When this is set by the client,
* this indicates that the video port should treat even fields like odd
* fields.
*)
DDVPCONNECT_INVERTPOLARITY = $00000004;
 
(*
* Indicates that any data written to the video port during the VREF
* period will not be written into the frame buffer. This flag is read only.
*)
DDVPCONNECT_DISCARDSVREFDATA = $00000008;
 
(*
* When this is set be the driver and passed to the client, this
* indicates that the device will write half lines into the frame buffer
* if half lines are provided by the decoder. If this is set by the client,
* this indicates that the decoder will be supplying half lines.
*)
DDVPCONNECT_HALFLINE = $00000010;
 
(*
* Indicates that the signal is interlaced. This flag is only
* set by the client.
*)
DDVPCONNECT_INTERLACED = $00000020;
 
(*
* Indicates that video port is shareable and that this video port
* will use the even fields. This flag is only set by the client.
*)
DDVPCONNECT_SHAREEVEN = $00000040;
 
(*
* Indicates that video port is shareable and that this video port
* will use the odd fields. This flag is only set by the client.
*)
DDVPCONNECT_SHAREODD = $00000080;
 
{ TDDVideoportDesc caps }
(****************************************************************************
*
* VIDEOPORT TDDVideoPortDesc CAPS
*
****************************************************************************)
 
(*
* Flip can be performed automatically to avoid tearing.
*)
DDVPCAPS_AUTOFLIP = $00000001;
 
(*
* Supports interlaced video
*)
DDVPCAPS_INTERLACED = $00000002;
 
(*
* Supports non-interlaced video
*)
DDVPCAPS_NONINTERLACED = $00000004;
 
(*
* Indicates that the device can return whether the current field
* of an interlaced signal is even or odd.
*)
DDVPCAPS_READBACKFIELD = $00000008;
 
(*
* Indicates that the device can return the current line of video
* being written into the frame buffer.
*)
DDVPCAPS_READBACKLINE = $00000010;
 
(*
* Allows two gen-locked video streams to share a single video port,
* where one stream uses the even fields and the other uses the odd
* fields. Separate parameters (including address, scaling,
* cropping, etc.) are maintained for both fields.)
*)
DDVPCAPS_SHAREABLE = $00000020;
 
(*
* Even fields of video can be automatically discarded.
*)
DDVPCAPS_SKIPEVENFIELDS = $00000040;
 
(*
* Odd fields of video can be automatically discarded.
*)
DDVPCAPS_SKIPODDFIELDS = $00000080;
 
(*
* Indicates that the device is capable of driving the graphics
* VSYNC with the video port VSYNC.
*)
DDVPCAPS_SYNCMASTER = $00000100;
 
(*
* Indicates that data within the vertical blanking interval can
* be written to a different surface.
*)
DDVPCAPS_VBISURFACE = $00000200;
 
(*
* Indicates that the video port can perform color operations
* on the incoming data before it is written to the frame buffer.
*)
DDVPCAPS_COLORCONTROL = $00000400;
 
(*
* Indicates that the video port can accept VBI data in a different
* width or format than the regular video data.
*)
DDVPCAPS_OVERSAMPLEDVBI = $00000800;
 
(*
* Indicates that the video port can write data directly to system memory
*)
DDVPCAPS_SYSTEMMEMORY = $00001000;
 
(*
* Indicates that the VBI and video portions of the video stream can
* be controlled by an independent processes.
*)
DDVPCAPS_VBIANDVIDEOINDEPENDENT = $00002000;
 
(*
* Indicates that the video port contains high quality hardware
* de-interlacing hardware that should be used instead of the
* bob/weave algorithms.
*)
DDVPCAPS_HARDWAREDEINTERLACE = $00004000;
 
{ TDDVideoportDesc FX }
(****************************************************************************
*
* VIDEOPORT TDDVideoPortDesc FX
*
****************************************************************************)
 
(*
* Limited cropping is available to crop out the vertical interval data.
*)
DDVPFX_CROPTOPDATA = $00000001;
 
(*
* Incoming data can be cropped in the X direction before it is written
* to the surface.
*)
DDVPFX_CROPX = $00000002;
 
(*
* Incoming data can be cropped in the Y direction before it is written
* to the surface.
*)
DDVPFX_CROPY = $00000004;
 
(*
* Supports interleaving interlaced fields in memory.
*)
DDVPFX_INTERLEAVE = $00000008;
 
(*
* Supports mirroring left to right as the video data is written
* into the frame buffer.
*)
DDVPFX_MIRRORLEFTRIGHT = $00000010;
 
(*
* Supports mirroring top to bottom as the video data is written
* into the frame buffer.
*)
DDVPFX_MIRRORUPDOWN = $00000020;
 
(*
* Data can be arbitrarily shrunk in the X direction before it
* is written to the surface.
*)
DDVPFX_PRESHRINKX = $00000040;
 
(*
* Data can be arbitrarily shrunk in the Y direction before it
* is written to the surface.
*)
DDVPFX_PRESHRINKY = $00000080;
 
(*
* Data can be binary shrunk (1/2, 1/4, 1/8, etc.) in the X
* direction before it is written to the surface.
*)
DDVPFX_PRESHRINKXB = $00000100;
 
(*
* Data can be binary shrunk (1/2, 1/4, 1/8, etc.) in the Y
* direction before it is written to the surface.
*)
DDVPFX_PRESHRINKYB = $00000200;
 
(*
* Data can be shrunk in increments of 1/x in the X direction
* (where X is specified in the TDDVideoPortCaps.dwPreshrinkXStep)
* before it is written to the surface.
*)
DDVPFX_PRESHRINKXS = $00000400;
 
(*
* Data can be shrunk in increments of 1/x in the Y direction
* (where X is specified in the TDDVideoPortCaps.dwPreshrinkYStep)
* before it is written to the surface.
*)
DDVPFX_PRESHRINKYS = $00000800;
 
(*
* Data can be arbitrarily stretched in the X direction before
* it is written to the surface.
*)
DDVPFX_PRESTRETCHX = $00001000;
 
(*
* Data can be arbitrarily stretched in the Y direction before
* it is written to the surface.
*)
DDVPFX_PRESTRETCHY = $00002000;
 
(*
* Data can be integer stretched in the X direction before it is
* written to the surface.
*)
DDVPFX_PRESTRETCHXN = $00004000;
 
(*
* Data can be integer stretched in the Y direction before it is
* written to the surface.
*)
DDVPFX_PRESTRETCHYN = $00008000;
 
(*
* Indicates that data within the vertical blanking interval can
* be converted independently of the remaining video data.
*)
DDVPFX_VBICONVERT = $00010000;
 
(*
* Indicates that scaling can be disabled for data within the
* vertical blanking interval.
*)
DDVPFX_VBINOSCALE = $00020000;
 
(*
* Indicates that the video data can ignore the left and right
* cropping coordinates when cropping oversampled VBI data.
*)
DDVPFX_IGNOREVBIXCROP = $00040000;
 
(*
* Indicates that interleaving can be disabled for data within the
* vertical blanking interval.
*)
DDVPFX_VBINOINTERLEAVE = $00080000;
 
{ TDDVideoportInfo flags }
(****************************************************************************
*
* VIDEOPORT TDDVideoPortInfo FLAGS
*
****************************************************************************)
 
(*
* Perform automatic flipping. Auto-flipping is performed between
* the overlay surface that was attached to the video port using
* IDirectDrawVideoPort::AttachSurface and the overlay surfaces that
* are attached to the surface via the IDirectDrawSurface::AttachSurface
* method. The flip order is the order in which the overlay surfaces
* were. attached.
*)
DDVP_AUTOFLIP = $00000001;
 
(*
* Perform conversion using the ddpfOutputFormat information.
*)
DDVP_CONVERT = $00000002;
 
(*
* Perform cropping using the specified rectangle.
*)
DDVP_CROP = $00000004;
 
(*
* Indicates that interlaced fields should be interleaved in memory.
*)
DDVP_INTERLEAVE = $00000008;
 
(*
* Indicates that the data should be mirrored left to right as it's
* written into the frame buffer.
*)
DDVP_MIRRORLEFTRIGHT = $00000010;
 
(*
* Indicates that the data should be mirrored top to bottom as it's
* written into the frame buffer.
*)
DDVP_MIRRORUPDOWN = $00000020;
 
(*
* Perform pre-scaling/zooming based on the pre-scale parameters.
*)
DDVP_PRESCALE = $00000040;
 
(*
* Ignore input of even fields.
*)
DDVP_SKIPEVENFIELDS = $00000080;
 
(*
* Ignore input of odd fields.
*)
DDVP_SKIPODDFIELDS = $00000100;
 
(*
* Drive the graphics VSYNCs using the video port VYSNCs.
*)
DDVP_SYNCMASTER = $00000200;
 
(*
* The ddpfVBIOutputFormatFormat member contains data that should be used
* to convert the data within the vertical blanking interval.
*)
DDVP_VBICONVERT = $00000400;
 
(*
* Indicates that data within the vertical blanking interval
* should not be scaled.
*)
DDVP_VBINOSCALE = $00000800;
 
(*
* Indicates that these bob/weave decisions should not be
* overriden by other interfaces.
*)
DDVP_OVERRIDEBOBWEAVE = $00001000;
 
(*
* Indicates that the video data should ignore the left and right
* cropping coordinates when cropping the VBI data.
*)
DDVP_IGNOREVBIXCROP = $00002000;
 
(*
* Indicates that interleaving can be disabled for data within the
* vertical blanking interval.
*)
DDVP_VBINOINTERLEAVE = $00004000;
 
(*
* Indicates that the video port should use the hardware
* de-interlacing hardware.
*)
DDVP_HARDWAREDEINTERLACE = $00008000;
 
{ DirectDrawVideoport GetInputFormat/GetOutputFormat flags }
(****************************************************************************
*
* DIRIRECTDRAWVIDEOPORT GETINPUTFORMAT/GETOUTPUTFORMAT FLAGS
*
****************************************************************************)
 
(*
* Return formats for the video data
*)
DDVPFORMAT_VIDEO = $00000001;
 
(*
* Return formats for the VBI data
*)
DDVPFORMAT_VBI = $00000002;
 
{ DirectDrawVideoport SetTargetSurface flags }
(****************************************************************************
*
* DIRIRECTDRAWVIDEOPORT SETTARGETSURFACE FLAGS
*
****************************************************************************)
 
(*
* Surface should receive video data (and VBI data if a surface
* is not explicitly attached for that purpose)
*)
DDVPTARGET_VIDEO = $00000001;
 
(*
* Surface should receive VBI data
*)
DDVPTARGET_VBI = $00000002;
 
{ DirectDrawVideoport WaitForSync flags }
(****************************************************************************
*
* DIRIRECTDRAWVIDEOPORT WAITFORSYNC FLAGS
*
****************************************************************************)
 
(*
* Waits until the beginning of the next VSYNC
*)
DDVPWAIT_BEGIN = $00000001;
 
(*
* Waits until the end of the next/current VSYNC
*)
DDVPWAIT_END = $00000002;
 
(*
* Waits until the beginning of the specified line
*)
DDVPWAIT_LINE = $00000003;
 
{ DirectDrawVideoport flip flags }
(****************************************************************************
*
* DIRECTDRAWVIDEOPORT FLIP FLAGS
*
****************************************************************************)
 
(*
* Flips the normal video surface
*)
DDVPFLIP_VIDEO = $00000001;
 
(*
* Flips the VBI surface
*)
DDVPFLIP_VBI = $00000002;
 
{ DirectDrawVideoport GetVideoSiginalStatus values }
(****************************************************************************
*
* DIRIRECTDRAWVIDEOPORT GETVIDEOSIGNALSTATUS VALUES
*
****************************************************************************)
 
(*
* No video signal is present at the video port
*)
DDVPSQ_NOSIGNAL = $00000001;
 
(*
* A valid video signal is present at the video port
*)
DDVPSQ_SIGNALOK = $00000002;
 
{ TDDVideoportBandWidth Flags }
(****************************************************************************
*
* VIDEOPORTBANDWIDTH Flags
*
****************************************************************************)
 
(*
* The specified height/width refer to the size of the video port data
* written into memory, after prescaling has occured.
*)
DDVPB_VIDEOPORT = $00000001;
 
(*
* The specified height/width refer to the source size of the overlay.
*)
DDVPB_OVERLAY = $00000002;
 
(*
* This is a query for the device to return which caps this device requires.
*)
DDVPB_TYPE = $00000004;
 
{ TDDVideoportBandWidth Caps }
(****************************************************************************
*
* VIDEOPORTBANDWIDTH Caps
*
****************************************************************************)
 
(*
* The bandwidth for this device is dependant on the overlay source size.
*)
DDVPBCAPS_SOURCE = $00000001;
 
(*
* The bandwidth for this device is dependant on the overlay destination
* size.
*)
DDVPBCAPS_DESTINATION = $00000002;
 
{ IDDVideoportContainer.CreateVideoPort flags }
(****************************************************************************
*
* DDVIDEOPORTCONTAINER CreateVideoPort flags
*
****************************************************************************)
 
(*
* The process only wants to control the VBI portion of the video stream.
*)
DDVPCREATE_VBIONLY = $00000001;
 
(*
* The process only wants to control the non-VBI (video) portion of
* the video stream.
*)
DDVPCREATE_VIDEOONLY = $00000002;
 
{ TDDVideoportStatus flags }
(****************************************************************************
*
* DDVIDEOPORTSTATUS flags
*
****************************************************************************)
 
(*
* The video port interface is only controlling the VBI portion of the
* video stream
*)
DDVPSTATUS_VBIONLY = $00000001;
 
(*
* The video port interface is only controlling the video portion of the
* video stream
*)
DDVPSTATUS_VIDEOONLY = $00000002;
 
 
type
(*
* API's
*)
 
TDDEnumVideoCallback = function (lpTDDVideoPortCaps: PDDVideoPortCaps;
lpContext: Pointer) : HResult; stdcall;
 
(*
* INTERACES FOLLOW:
* IDirectDrawVideoPort
* IVideoPort
*)
 
 
(*
* IDirectDrawVideoPort
*)
IDirectDrawVideoPort = interface (IUnknown)
['{B36D93E0-2B43-11CF-A2DE-00AA00B93356}']
(*** IDirectDrawVideoPort methods ***)
function Flip(lpDDSurface: IDirectDrawSurface; dwFlags: DWORD) : HResult; stdcall;
function GetBandwidthInfo(var lpddpfFormat: TDDPixelFormat;
dwWidth: DWORD; dwHeight: DWORD; dwFlags: DWORD;
var lpBandwidth: TDDVideoPortBandWidth) : HResult; stdcall;
function GetColorControls(var lpColorControl: TDDColorControl) : HResult; stdcall;
function GetInputFormats(var lpNumFormats: DWORD; var lpFormats:
TDDPixelFormat; dwFlags: DWORD) : HResult; stdcall;
function GetOutputFormats(var lpInputFormat: TDDPixelFormat;
var lpNumFormats: DWORD; lpFormats: PDDPixelFormat; dwFlags: DWORD)
: HResult; stdcall;
function GetFieldPolarity(var lpbVideoField: BOOL) : HResult; stdcall;
function GetVideoLine(var lpdwLine: DWORD) : HResult; stdcall;
function GetVideoSignalStatus(varlpdwStatus: DWORD) : HResult; stdcall;
function SetColorControls(var lpColorControl: TDDColorControl) : HResult; stdcall;
function SetTargetSurface(lpDDSurface: IDirectDrawSurface; dwFlags: DWORD) :
HResult; stdcall;
function StartVideo(var lpVideoInfo: TDDVideoPortInfo) : HResult; stdcall;
function StopVideo: HResult; stdcall;
function UpdateVideo(var lpVideoInfo: TDDVideoPortInfo) : HResult; stdcall;
function WaitForSync(dwFlags: DWORD; dwLine: DWORD; dwTimeout: DWORD) :
HResult; stdcall;
end;
 
(*
* IDirectDrawVideoPortContainer
*)
IDDVideoPortContainer = interface (IUnknown)
['{6C142760-A733-11CE-A521-0020AF0BE560}']
(*** IDDVideoPortContainer methods ***)
function CreateVideoPort(dwFlags: DWORD; var lpTDDVideoPortDesc:
TDDVideoPortDesc; var lplpDDVideoPort: IDirectDrawVideoPort;
pUnkOuter: IUnknown) : HResult; stdcall;
function EnumVideoPorts(dwFlags: DWORD;
lpTDDVideoPortCaps: PDDVideoPortCaps; lpContext: Pointer;
lpEnumVideoCallback: TDDEnumVideoCallback) : HResult; stdcall;
function GetVideoPortConnectInfo(dwPortId: DWORD; var lpNumEntries: DWORD;
lpConnectInfo: PDDVideoPortConnect) : HResult; stdcall;
function QueryVideoPortStatus(dwPortId: DWORD;
var lpVPStatus: TDDVideoPortStatus) : HResult; stdcall;
end;
 
IID_IDDVideoPortContainer = IDDVideoPortContainer;
IID_IDirectDrawVideoPort = IDirectDrawVideoPort;
 
 
//Direct3D file
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
* Copyright (C) 1995-1998 Microsoft Corporation. All Rights Reserved.
*
* File: d3dtypes.h
* Content: Direct3D types include file
* Files: d3dtypes.h d3dcaps.h d3d.h
*
* DirectX 7.0 Delphi adaptation by Erik Unger
*
* Modyfied: 26-Jun-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
***************************************************************************)
 
(* TD3DValue is the fundamental Direct3D fractional data type *)
 
type
TRefClsID = TGUID;
 
type
TD3DValue = Single;
D3DValue = TD3DValue;
 
TD3DFixed = Longint;
D3DFIXED = TD3DFixed;
 
TD3DFixed = LongInt;
float = TD3DValue;
PD3DColor = ^TD3DColor;
TD3DColor = DWORD;
D3DCOLOR = TD3DColor;
 
function D3DVALP(val: TD3DValue; prec: Integer): TD3DValue;
function D3DVAL(val: TD3DValue): TD3DValue;
function D3DDivide(a, b: TD3DValue): TD3DValue;
function D3DMultiply(a, b: TD3DValue): TD3DValue;
function D3DVal(val: variant) : float;
function D3DDivide(a,b: double) : float;
function D3DMultiply(a,b: double) : float;
 
(*
* Format of CI colors is
2524,13 → 5723,24
* +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
*)
 
function CI_GETALPHA(ci: Integer): Byte;
function CI_GETINDEX(ci: Integer): Word;
function CI_GETFRACTION(ci: Integer): Byte;
function CI_ROUNDINDEX(ci: Integer): Integer;
function CI_MASKALPHA(ci: Integer): Integer;
function CI_MAKE(a: Byte; i: Word; f: Byte): Integer;
// #define CI_GETALPHA(ci) ((ci) >> 24)
function CI_GETALPHA(ci: DWORD) : DWORD;
 
// #define CI_GETINDEX(ci) (((ci) >> 8) & 0xffff)
function CI_GETINDEX(ci: DWORD) : DWORD;
 
// #define CI_GETFRACTION(ci) ((ci) & 0xff)
function CI_GETFRACTION(ci: DWORD) : DWORD;
 
// #define CI_ROUNDINDEX(ci) CI_GETINDEX((ci) + 0x80)
function CI_ROUNDINDEX(ci: DWORD) : DWORD;
 
// #define CI_MASKALPHA(ci) ((ci) & 0xffffff)
function CI_MASKALPHA(ci: DWORD) : DWORD;
 
// #define CI_MAKE(a, i, f) (((a) << 24) | ((i) << 8) | (f))
function CI_MAKE(a,i,f: DWORD) : DWORD;
 
(*
* Format of RGBA colors is
* +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
2538,19 → 5748,35
* +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
*)
 
function RGBA_GETALPHA(rgb: TD3DColor): Byte;
function RGBA_GETRED(rgb: TD3DColor): Byte;
function RGBA_GETGREEN(rgb: TD3DColor): Byte;
function RGBA_GETBLUE(rgb: TD3DColor): Byte;
function RGBA_MAKE(r, g, b, a: Byte): TD3DColor;
// #define RGBA_GETALPHA(rgb) ((rgb) >> 24)
function RGBA_GETALPHA(rgb: TD3DColor) : DWORD;
 
// #define RGBA_GETRED(rgb) (((rgb) >> 16) & 0xff)
function RGBA_GETRED(rgb: TD3DColor) : DWORD;
 
// #define RGBA_GETGREEN(rgb) (((rgb) >> 8) & 0xff)
function RGBA_GETGREEN(rgb: TD3DColor) : DWORD;
 
// #define RGBA_GETBLUE(rgb) ((rgb) & 0xff)
function RGBA_GETBLUE(rgb: TD3DColor) : DWORD;
 
// #define RGBA_MAKE(r, g, b, a) ((TD3DColor) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)))
function RGBA_MAKE(r, g, b, a: DWORD) : TD3DColor;
 
(* D3DRGB and D3DRGBA may be used as initialisers for D3DCOLORs
* The float values must be in the range 0..1
*)
 
function D3DRGB(r, g, b: TD3DValue): TD3DColor;
function D3DRGBA(r, g, b, a: TD3DValue): TD3DColor;
// #define D3DRGB(r, g, b) \
// (0xff000000L | (((long)((r) * 255)) << 16) | (((long)((g) * 255)) << 8) | (long)((b) * 255))
function D3DRGB(r, g, b: float) : TD3DColor;
 
// #define D3DRGBA(r, g, b, a) \
// ( (((long)((a) * 255)) << 24) | (((long)((r) * 255)) << 16) \
// | (((long)((g) * 255)) << 8) | (long)((b) * 255) \
// )
function D3DRGBA(r, g, b, a: float) : TD3DColor;
 
(*
* Format of RGB colors is
* +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
2558,44 → 5784,64
* +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
*)
 
function RGB_GETRED(rgb: TD3DColor): Byte;
function RGB_GETGREEN(rgb: TD3DColor): Byte;
function RGB_GETBLUE(rgb: TD3DColor): Byte;
function RGBA_SETALPHA(rgba: TD3DColor; x: Byte): TD3DColor;
function RGB_MAKE(r, g, b: Byte): TD3DColor;
// #define RGB_GETRED(rgb) (((rgb) >> 16) & 0xff)
function RGB_GETRED(rgb: TD3DColor) : DWORD;
 
// #define RGB_GETGREEN(rgb) (((rgb) >> 8) & 0xff)
function RGB_GETGREEN(rgb: TD3DColor) : DWORD;
 
// #define RGB_GETBLUE(rgb) ((rgb) & 0xff)
function RGB_GETBLUE(rgb: TD3DColor) : DWORD;
 
// #define RGBA_SETALPHA(rgba, x) (((x) << 24) | ((rgba) & 0x00ffffff))
function RGBA_SETALPHA(rgba: TD3DColor; x: DWORD) : TD3DColor;
 
// #define RGB_MAKE(r, g, b) ((TD3DColor) (((r) << 16) | ((g) << 8) | (b)))
function RGB_MAKE(r, g, b: DWORD) : TD3DColor;
 
// #define RGBA_TORGB(rgba) ((TD3DColor) ((rgba) & 0xffffff))
function RGBA_TORGB(rgba: TD3DColor): TD3DColor;
 
// #define RGB_TORGBA(rgb) ((TD3DColor) ((rgb) | 0xff000000))
function RGB_TORGBA(rgb: TD3DColor): TD3DColor;
 
(*
* Flags for Enumerate functions
*)
const
{ Flags for Enumerate functions }
 
(*
* Stop the enumeration
*)
 
D3DENUMRET_CANCEL = DDENUMRET_CANCEL;
 
(*
* Continue the enumeration
*)
 
D3DENUMRET_OK = DDENUMRET_OK;
 
type
TD3DValidateCallback = function(lpUserArg: Pointer; dwOffset: DWORD): HResult; stdcall;
LPD3DVALIDATECALLBACK = TD3DValidateCallback;
 
TD3DEnumTextureFormatsCalback = function(const lpDdsd: TDDSurfaceDesc;
TD3DValidateCallback = function (lpUserArg: Pointer;
dwOffset: DWORD): HResult; stdcall;
TD3DEnumTextureFormatsCallback = function (var lpDdsd: TDDSurfaceDesc;
lpContext: Pointer): HResult; stdcall;
LPD3DENUMTEXTUREFORMATSCALLBACK = TD3DEnumTextureFormatsCalback;
 
TD3DEnumPixelFormatsCallback = function(const lpDDPixFmt: TDDPixelFormat;
TD3DEnumPixelFormatsCallback = function (var lpDDPixFmt: TDDPixelFormat;
lpContext: Pointer): HResult; stdcall;
 
 
PD3DMaterialHandle = ^TD3DMaterialHandle;
TD3DMaterialHandle = DWORD;
D3DMATERIALHANDLE = TD3DMaterialHandle;
 
PD3DTextureHandle = ^TD3DTextureHandle;
TD3DTextureHandle = DWORD;
D3DTEXTUREHANDLE = TD3DTextureHandle;
 
PD3DMatrixHandle = ^TD3DMatrixHandle;
TD3DMatrixHandle = DWORD;
D3DMATRIXHANDLE = TD3DMatrixHandle;
 
{ TD3DColorValue structure }
 
PD3DColorValue = ^TD3DColorValue;
TD3DColorValue = record
TD3DColorValue = packed record
case Integer of
0: (
r: TD3DValue;
2611,34 → 5857,28
);
end;
 
D3DCOLORVALUE = TD3DColorValue;
 
{ TD3DRect structure }
 
PD3DRect = ^TD3DRect;
TD3DRect = record
TD3DRect = packed record
case Integer of
0: (
x1: Longint;
y1: Longint;
x2: Longint;
y2: Longint;
x1: LongInt;
y1: LongInt;
x2: LongInt;
y2: LongInt;
);
1: (
lX1: Longint;
lY1: Longint;
lX2: Longint;
lY2: Longint;
lX1: LongInt;
lY1: LongInt;
lX2: LongInt;
lY2: LongInt;
);
2: (
a: array[0..3] of LongInt;
);
end;
 
D3DRECT = TD3DRect;
LPD3DRECT = PD3DRect;
 
{ TD3DVector structure }
 
PD3DVector = ^TD3DVector;
TD3DVector = record
TD3DVector = packed record
case Integer of
0: (
x: TD3DValue;
2652,18 → 5892,25
);
end;
 
D3DVECTOR = TD3DVector;
LPD3DVECTOR = PD3DVector;
(******************************************************************
* *
* D3DVec.inl *
* *
* Float-valued 3D vector class for Direct3D. *
* *
* Copyright (c) 1996-1998 Microsoft Corp. All rights reserved. *
* *
******************************************************************)
 
// Addition and subtraction
function VectorAdd(v1, v2: TD3DVector) : TD3DVector;
function VectorSub(v1, v2: TD3DVector) : TD3DVector;
function VectorAdd(const v1, v2: TD3DVector) : TD3DVector;
function VectorSub(const v1, v2: TD3DVector) : TD3DVector;
// Scalar multiplication and division
function VectorMulS(v: TD3DVector; s: TD3DValue) : TD3DVector;
function VectorDivS(v: TD3DVector; s: TD3DValue) : TD3DVector;
function VectorMulS(const v: TD3DVector; s: TD3DValue) : TD3DVector;
function VectorDivS(const v: TD3DVector; s: TD3DValue) : TD3DVector;
// Memberwise multiplication and division
function VectorMul(v1, v2: TD3DVector) : TD3DVector;
function VectorDiv(v1, v2: TD3DVector) : TD3DVector;
function VectorMul(const v1, v2: TD3DVector) : TD3DVector;
function VectorDiv(const v1, v2: TD3DVector) : TD3DVector;
// Vector dominance
function VectorSmaller(v1, v2: TD3DVector) : boolean;
function VectorSmallerEquel(v1, v2: TD3DVector) : boolean;
2673,25 → 5920,29
function VectorSquareMagnitude(v: TD3DVector) : TD3DValue;
function VectorMagnitude(v: TD3DVector) : TD3DValue;
// Returns vector with same direction and unit length
function VectorNormalize(v: TD3DVector) : TD3DVector;
function VectorNormalize(const v: TD3DVector) : TD3DVector;
// Return min/max component of the input vector
function VectorMin(v: TD3DVector) : TD3DValue;
function VectorMax(v: TD3DVector) : TD3DValue;
// Return memberwise min/max of input vectors
function VectorMinimize(v1, v2: TD3DVector) : TD3DVector;
function VectorMaximize(v1, v2: TD3DVector) : TD3DVector;
function VectorMinimize(const v1, v2: TD3DVector) : TD3DVector;
function VectorMaximize(const v1, v2: TD3DVector) : TD3DVector;
// Dot and cross product
function VectorDotProduct(v1, v2: TD3DVector) : TD3DValue;
function VectorCrossProduct(v1, v2: TD3DVector) : TD3DVector;
function VectorCrossProduct(const v1, v2: TD3DVector) : TD3DVector;
 
type
{ Vertex data types supported in an ExecuteBuffer. }
(*
* Vertex data types supported in an ExecuteBuffer.
*)
 
{ TD3DHVertex structure }
(*
* Homogeneous vertices
*)
 
PD3DHVertex = ^TD3DHVertex;
TD3DHVertex = record
dwFlags: DWORD; // Homogeneous clipping flags
TD3DHVertex = packed record
dwFlags: DWORD; (* Homogeneous clipping flags *)
case Integer of
0: (
hx: TD3DValue;
2705,21 → 5956,21
);
end;
 
D3DHVERTEX = TD3DHVertex;
(*
* Transformed/lit vertices
*)
 
{ TD3DTLVertex structure }
 
PD3DTLVertex = ^TD3DTLVertex;
TD3DTLVertex = record
TD3DTLVertex = packed record
case Integer of
0: (
sx: TD3DValue; // Screen coordinates
sx: TD3DValue; (* Screen coordinates *)
sy: TD3DValue;
sz: TD3DValue;
rhw: TD3DValue; // Reciprocal of homogeneous w
color: TD3DColor; // Vertex color
specular: TD3DColor; // Specular component of vertex
tu: TD3DValue; // Texture coordinates
rhw: TD3DValue; (* Reciprocal of homogeneous w *)
color: TD3DColor; (* Vertex color *)
specular: TD3DColor; (* Specular component of vertex *)
tu: TD3DValue; (* Texture coordinates *)
tv: TD3DValue;
);
1: (
2734,21 → 5985,21
);
end;
 
D3DTLVERTEX = TD3DTLVertex;
(*
* Untransformed/lit vertices
*)
 
{ TD3DLVertex structure }
 
PD3DLVertex = ^TD3DLVertex;
TD3DLVertex = record
TD3DLVertex = packed record
case Integer of
0: (
x: TD3DValue; // Homogeneous coordinates
x: TD3DValue; (* Homogeneous coordinates *)
y: TD3DValue;
z: TD3DValue;
dwReserved: DWORD;
color: TD3DColor; // Vertex color
specular: TD3DColor; // Specular component of vertex
tu: TD3DValue; // Texture coordinates
color: TD3DColor; (* Vertex color *)
specular: TD3DColor; (* Specular component of vertex *)
tu: TD3DValue; (* Texture coordinates *)
tv: TD3DValue;
);
1: (
2755,7 → 6006,7
dvX: TD3DValue;
dvY: TD3DValue;
dvZ: TD3DValue;
_union1d: DWORD;
UNIONFILLER1d: DWORD;
dcColor: TD3DColor;
dcSpecular: TD3DColor;
dvTU: TD3DValue;
2763,21 → 6014,21
);
end;
 
D3DLVERTEX = TD3DLVertex;
(*
* Untransformed/unlit vertices
*)
 
{ TD3DVertex structure }
 
PD3DVertex = ^TD3DVertex;
TD3DVertex = record
TD3DVertex = packed record
case Integer of
0: (
x: TD3DValue; // Homogeneous coordinates
x: TD3DValue; (* Homogeneous coordinates *)
y: TD3DValue;
z: TD3DValue;
nx: TD3DValue; // Normal
nx: TD3DValue; (* Normal *)
ny: TD3DValue;
nz: TD3DValue;
tu: TD3DValue; // Texture coordinates
tu: TD3DValue; (* Texture coordinates *)
tv: TD3DValue;
);
1: (
2792,86 → 6043,78
);
end;
 
D3DVERTEX = TD3DVertex;
(*
* Matrix, viewport, and tranformation structures and definitions.
*)
 
{ TD3DMatrix structure }
 
PD3DMatrix = ^TD3DMatrix;
TD3DMatrix = record
_11, _12, _13, _14: TD3DValue;
TD3DMatrix = packed record
case integer of
0 : (_11, _12, _13, _14: TD3DValue;
_21, _22, _23, _24: TD3DValue;
_31, _32, _33, _34: TD3DValue;
_41, _42, _43, _44: TD3DValue;
_41, _42, _43, _44: TD3DValue);
1 : (m : array [0..3, 0..3] of TD3DValue);
end;
 
D3DMATRIX = TD3DMatrix;
 
{ TD3DViewport structure }
 
PD3DViewport = ^TD3DViewport;
TD3DViewport = record
TD3DViewport = packed record
dwSize: DWORD;
dwX: DWORD;
dwY: DWORD; // Top left
dwY: DWORD; (* Top left *)
dwWidth: DWORD;
dwHeight: DWORD; // Dimensions
dvScaleX: TD3DValue; // Scale homogeneous to screen
dvScaleY: TD3DValue; // Scale homogeneous to screen
dvMaxX: TD3DValue; // Min/max homogeneous x coord
dvMaxY: TD3DValue; // Min/max homogeneous y coord
dwHeight: DWORD; (* Dimensions *)
dvScaleX: TD3DValue; (* Scale homogeneous to screen *)
dvScaleY: TD3DValue; (* Scale homogeneous to screen *)
dvMaxX: TD3DValue; (* Min/max homogeneous x coord *)
dvMaxY: TD3DValue; (* Min/max homogeneous y coord *)
dvMinZ: TD3DValue;
dvMaxZ: TD3DValue; // Min/max homogeneous z coord
dvMaxZ: TD3DValue; (* Min/max homogeneous z coord *)
end;
 
D3DVIEWPORT = TD3DViewport;
 
{ TD3DViewport2 structure }
 
PD3DViewport2 = ^TD3DViewport2;
TD3DViewport2 = record
TD3DViewport2 = packed record
dwSize: DWORD;
dwX: DWORD;
dwY: DWORD; // Top left
dwY: DWORD; (* Viewport Top left *)
dwWidth: DWORD;
dwHeight: DWORD; // Dimensions
dvClipX: TD3DValue; // Top left of clip volume
dwHeight: DWORD; (* Viewport Dimensions *)
dvClipX: TD3DValue; (* Top left of clip volume *)
dvClipY: TD3DValue;
dvClipWidth: TD3DValue; // Clip Volume Dimensions
dvClipWidth: TD3DValue; (* Clip Volume Dimensions *)
dvClipHeight: TD3DValue;
dvMinZ: TD3DValue;
dvMaxZ: TD3DValue; // Min/max homogeneous z coord
dvMinZ: TD3DValue; (* Min/max of clip Volume *)
dvMaxZ: TD3DValue;
end;
 
D3DVIEWPORT2 = TD3DViewport2;
 
{ TD3DViewport2 structure }
 
PD3DViewport7 = ^TD3DViewport7;
TD3DViewport7 = record
TD3DViewport7 = packed record
dwX: DWORD;
dwY: DWORD; // Top left
dwY: DWORD; (* Viewport Top left *)
dwWidth: DWORD;
dwHeight: DWORD; // Dimensions
dvMinZ: TD3DValue;
dvMaxZ: TD3DValue; // Min/max homogeneous z coord
dwHeight: DWORD; (* Viewport Dimensions *)
dvMinZ: TD3DValue; (* Min/max of clip Volume *)
dvMaxZ: TD3DValue;
end;
 
D3DVIEWPORT7 = TD3DViewport7;
(*
* Values for clip fields.
*)
 
const
{ Max number of user clipping planes, supported in D3D. }
// Max number of user clipping planes, supported in D3D.
D3DMAXUSERCLIPPLANES = 32;
 
{ These bits could be ORed together to use with D3DRENDERSTATE_CLIPPLANEENABLE }
D3DCLIPPLANE0 = 1 shl 0;
D3DCLIPPLANE1 = 1 shl 1;
D3DCLIPPLANE2 = 1 shl 2;
D3DCLIPPLANE3 = 1 shl 3;
D3DCLIPPLANE4 = 1 shl 4;
D3DCLIPPLANE5 = 1 shl 5;
// These bits could be ORed together to use with D3DRENDERSTATE_CLIPPLANEENABLE
//
D3DCLIPPLANE0 = (1 shl 0);
D3DCLIPPLANE1 = (1 shl 1);
D3DCLIPPLANE2 = (1 shl 2);
D3DCLIPPLANE3 = (1 shl 3);
D3DCLIPPLANE4 = (1 shl 4);
D3DCLIPPLANE5 = (1 shl 5);
 
{ Values for clip fields. }
 
const
D3DCLIP_LEFT = $00000001;
D3DCLIP_RIGHT = $00000002;
D3DCLIP_TOP = $00000004;
2885,7 → 6128,9
D3DCLIP_GEN4 = $00000400;
D3DCLIP_GEN5 = $00000800;
 
{ Values for d3d status. }
(*
* Values for d3d status.
*)
 
D3DSTATUS_CLIPUNIONLEFT = D3DCLIP_LEFT;
D3DSTATUS_CLIPUNIONRIGHT = D3DCLIP_RIGHT;
2913,8 → 6158,9
D3DSTATUS_CLIPINTERSECTIONGEN4 = $00400000;
D3DSTATUS_CLIPINTERSECTIONGEN5 = $00800000;
D3DSTATUS_ZNOTVISIBLE = $01000000;
(* Do not use 0x80000000 for any status flags in future as it is reserved *)
 
D3DSTATUS_CLIPUNIONALL =
D3DSTATUS_CLIPUNIONALL = (
D3DSTATUS_CLIPUNIONLEFT or
D3DSTATUS_CLIPUNIONRIGHT or
D3DSTATUS_CLIPUNIONTOP or
2926,9 → 6172,9
D3DSTATUS_CLIPUNIONGEN2 or
D3DSTATUS_CLIPUNIONGEN3 or
D3DSTATUS_CLIPUNIONGEN4 or
D3DSTATUS_CLIPUNIONGEN5;
D3DSTATUS_CLIPUNIONGEN5);
 
D3DSTATUS_CLIPINTERSECTIONALL =
D3DSTATUS_CLIPINTERSECTIONALL = (
D3DSTATUS_CLIPINTERSECTIONLEFT or
D3DSTATUS_CLIPINTERSECTIONRIGHT or
D3DSTATUS_CLIPINTERSECTIONTOP or
2940,61 → 6186,59
D3DSTATUS_CLIPINTERSECTIONGEN2 or
D3DSTATUS_CLIPINTERSECTIONGEN3 or
D3DSTATUS_CLIPINTERSECTIONGEN4 or
D3DSTATUS_CLIPINTERSECTIONGEN5;
D3DSTATUS_CLIPINTERSECTIONGEN5);
 
D3DSTATUS_DEFAULT = (
D3DSTATUS_CLIPINTERSECTIONALL or
D3DSTATUS_ZNOTVISIBLE );
 
{ Options for direct transform calls }
(*
* Options for direct transform calls
*)
 
D3DTRANSFORM_CLIPPED = $00000001;
D3DTRANSFORM_UNCLIPPED = $00000002;
 
type
{ TD3DTransformData structure }
 
PD3DTransformData = ^TD3DTransformData;
TD3DTransformData = record
TD3DTransformData = packed record
dwSize: DWORD;
lpIn: Pointer; // Input vertices
dwInSize: DWORD; // Stride of input vertices
lpOut: Pointer; // Output vertices
dwOutSize: DWORD; // Stride of output vertices
lpHOut: PD3DHVertex; // Output homogeneous vertices
dwClip: DWORD; // Clipping hint
lpIn: Pointer; (* Input vertices *)
dwInSize: DWORD; (* Stride of input vertices *)
lpOut: Pointer; (* Output vertices *)
dwOutSize: DWORD; (* Stride of output vertices *)
lpHOut: ^TD3DHVertex; (* Output homogeneous vertices *)
dwClip: DWORD; (* Clipping hint *)
dwClipIntersection: DWORD;
dwClipUnion: DWORD; // Union of all clip flags
drExtent: TD3DRect; // Extent of transformed vertices
dwClipUnion: DWORD; (* Union of all clip flags *)
drExtent: TD3DRect; (* Extent of transformed vertices *)
end;
 
D3DTRANSFORMDATA = TD3DTransformData;
LPD3DTRANSFORMDATA = PD3DTransformData;
(*
* Structure defining position and direction properties for lighting.
*)
 
{ TD3DLightingElement structure }
 
PD3DLightingElement = ^TD3DLightingElement;
TD3DLightingElement = record
dvPosition: TD3DVector; // Lightable point in model space
dvNormal: TD3DVector; // Normalised unit vector
TD3DLightingElement = packed record
dvPosition: TD3DVector; (* Lightable point in model space *)
dvNormal: TD3DVector; (* Normalised unit vector *)
end;
 
D3DLIGHTINGELEMENT = TD3DLightingElement;
LPD3DLIGHTINGELEMENT = PD3DLightingElement;
(*
* Structure defining material properties for lighting.
*)
 
{ TD3DMaterial structure }
 
PD3DMaterial = ^TD3DMaterial;
TD3DMaterial = record
TD3DMaterial = packed record
dwSize: DWORD;
case Integer of
0: (
diffuse: TD3DColorValue; // Diffuse color RGBA
ambient: TD3DColorValue; // Ambient color RGB
specular: TD3DColorValue; // Specular 'shininess'
emissive: TD3DColorValue; // Emissive color RGB
power: TD3DValue; // Sharpness if specular highlight
hTexture: TD3DTextureHandle; // Handle to texture map
diffuse: TD3DColorValue; (* Diffuse color RGBA *)
ambient: TD3DColorValue; (* Ambient color RGB *)
specular: TD3DColorValue; (* Specular 'shininess' *)
emissive: TD3DColorValue; (* Emissive color RGB *)
power: TD3DValue; (* Sharpness if specular highlight *)
hTexture: TD3DTextureHandle; (* Handle to texture map *)
dwRampSize: DWORD;
);
1: (
3006,20 → 6250,15
);
end;
 
D3DMATERIAL = TD3DMaterial;
LPD3DMATERIAL = PD3DMaterial;
 
{ TD3DMaterial7 structure }
 
PD3DMaterial7 = ^TD3DMaterial7;
TD3DMaterial7 = record
TD3DMaterial7 = packed record
case Integer of
0: (
diffuse: TD3DColorValue; // Diffuse color RGBA
ambient: TD3DColorValue; // Ambient color RGB
specular: TD3DColorValue; // Specular 'shininess'
emissive: TD3DColorValue; // Emissive color RGB
power: TD3DValue; // Sharpness if specular highlight
diffuse: TD3DColorValue; (* Diffuse color RGBA *)
ambient: TD3DColorValue; (* Ambient color RGB *)
specular: TD3DColorValue; (* Specular 'shininess' *)
emissive: TD3DColorValue; (* Emissive color RGB *)
power: TD3DValue; (* Sharpness if specular highlight *)
);
1: (
dcvDiffuse: TD3DColorValue;
3030,117 → 6269,97
);
end;
 
D3DMATERIAL7 = TD3DMaterial7;
LPD3DMATERIAL7 = PD3DMaterial7;
 
{ TD3DLightType }
 
PD3DLightType = ^TD3DLightType;
TD3DLightType = (
D3DLIGHT_INVALID_0,
D3DLIGHT_POINT,
D3DLIGHT_SPOT,
D3DLIGHT_DIRECTIONAL,
D3DLIGHT_PARALLELPOINT
{$IFNDEF SupportDirectX5},D3DLIGHT_GLSPOT{$ENDIF}
);
// Note: The following light type (D3DLIGHT_PARALLELPOINT)
// is no longer supported from D3D for DX7 onwards.
D3DLIGHT_PARALLELPOINT,
D3DLIGHT_GLSPOT);
 
D3DLIGHTTYPE = TD3DLightType;
(*
* Structure defining a light source and its properties.
*)
 
{ TD3DLight structure }
 
PD3DLight = ^TD3DLight;
TD3DLight = record
TD3DLight = packed record
dwSize: DWORD;
dltType: TD3DLightType; // Type of light source
dcvColor: TD3DColorValue; // Color of light
dvPosition: TD3DVector; // Position in world space
dvDirection: TD3DVector; // Direction in world space
dvRange: TD3DValue; // Cutoff range
dvFalloff: TD3DValue; // Falloff
dvAttenuation0: TD3DValue; // Constant attenuation
dvAttenuation1: TD3DValue; // Linear attenuation
dvAttenuation2: TD3DValue; // Quadratic attenuation
dvTheta: TD3DValue; // Inner angle of spotlight cone
dvPhi: TD3DValue; // Outer angle of spotlight cone
dltType: TD3DLightType; (* Type of light source *)
dcvColor: TD3DColorValue; (* Color of light *)
dvPosition: TD3DVector; (* Position in world space *)
dvDirection: TD3DVector; (* Direction in world space *)
dvRange: TD3DValue; (* Cutoff range *)
dvFalloff: TD3DValue; (* Falloff *)
dvAttenuation0: TD3DValue; (* Constant attenuation *)
dvAttenuation1: TD3DValue; (* Linear attenuation *)
dvAttenuation2: TD3DValue; (* Quadratic attenuation *)
dvTheta: TD3DValue; (* Inner angle of spotlight cone *)
dvPhi: TD3DValue; (* Outer angle of spotlight cone *)
end;
 
D3DLIGHT = TD3DLight;
LPD3DLIGHT = PD3DLight;
 
{ TD3DLight7 structure }
 
PD3DLight7 = ^TD3DLight7;
TD3DLight7 = record
dltType: TD3DLightType; // Type of light source
dcvDiffuse: TD3DColorValue; // Diffuse color of light
dcvSpecular: TD3DColorValue;// Specular color of light
dcvAmbient: TD3DColorValue; // Ambient color of light
dvPosition: TD3DVector; // Position in world space
dvDirection: TD3DVector; // Direction in world space
dvRange: TD3DValue; // Cutoff range
dvFalloff: TD3DValue; // Falloff
dvAttenuation0: TD3DValue; // Constant attenuation
dvAttenuation1: TD3DValue; // Linear attenuation
dvAttenuation2: TD3DValue; // Quadratic attenuation
dvTheta: TD3DValue; // Inner angle of spotlight cone
dvPhi: TD3DValue; // Outer angle of spotlight cone
TD3DLight7 = packed record
dltType: TD3DLightType; (* Type of light source *)
dcvDiffuse: TD3DColorValue; (* Diffuse color of light *)
dcvSpecular: TD3DColorValue;(* Specular color of light *)
dcvAmbient: TD3DColorValue; (* Ambient color of light *)
dvPosition: TD3DVector; (* Position in world space *)
dvDirection: TD3DVector; (* Direction in world space *)
dvRange: TD3DValue; (* Cutoff range *)
dvFalloff: TD3DValue; (* Falloff *)
dvAttenuation0: TD3DValue; (* Constant attenuation *)
dvAttenuation1: TD3DValue; (* Linear attenuation *)
dvAttenuation2: TD3DValue; (* Quadratic attenuation *)
dvTheta: TD3DValue; (* Inner angle of spotlight cone *)
dvPhi: TD3DValue; (* Outer angle of spotlight cone *)
end;
 
D3DLIGHT7 = TD3DLight7;
LPD3DLIGHT7 = PD3DLight7;
(*
* Structure defining a light source and its properties.
*)
 
{ Structure defining a light source and its properties. }
 
(* flags bits *)
const
{ flags bits }
 
D3DLIGHT_ACTIVE = $00000001;
D3DLIGHT_NO_SPECULAR = $00000002;
D3DLIGHT_ALL = D3DLIGHT_ACTIVE or D3DLIGHT_NO_SPECULAR;
D3DLIGHT_ALL = D3DLIGHT_ACTIVE or D3DLIGHT_ACTIVE;
 
{ maximum valid light range }
D3DLIGHT_RANGE_MAX: TD3DValue = 3.4 * 10e+38;
(* maximum valid light range *)
D3DLIGHT_RANGE_MAX = 1.8439088915e+18; //sqrt(FLT_MAX);
 
type
{ TD3DLight2 structure }
 
PD3DLight2 = ^TD3DLight2;
TD3DLight2 = record
TD3DLight2 = packed record
dwSize: DWORD;
dltType: TD3DLightType; // Type of light source
dcvColor: TD3DColorValue; // Color of light
dvPosition: TD3DVector; // Position in world space
dvDirection: TD3DVector; // Direction in world space
dvRange: TD3DValue; // Cutoff range
dvFalloff: TD3DValue; // Falloff
dvAttenuation0: TD3DValue; // Constant attenuation
dvAttenuation1: TD3DValue; // Linear attenuation
dvAttenuation2: TD3DValue; // Quadratic attenuation
dvTheta: TD3DValue; // Inner angle of spotlight cone
dvPhi: TD3DValue; // Outer angle of spotlight cone
dltType: TD3DLightType; (* Type of light source *)
dcvColor: TD3DColorValue; (* Color of light *)
dvPosition: TD3DVector; (* Position in world space *)
dvDirection: TD3DVector; (* Direction in world space *)
dvRange: TD3DValue; (* Cutoff range *)
dvFalloff: TD3DValue; (* Falloff *)
dvAttenuation0: TD3DValue; (* Constant attenuation *)
dvAttenuation1: TD3DValue; (* Linear attenuation *)
dvAttenuation2: TD3DValue; (* Quadratic attenuation *)
dvTheta: TD3DValue; (* Inner angle of spotlight cone *)
dvPhi: TD3DValue; (* Outer angle of spotlight cone *)
dwFlags: DWORD;
end;
 
D3DLIGHT2 = TD3DLight2;
LPD3DLIGHT2 = PD3DLight2;
 
{ TD3DLightData structure }
 
PD3DLightData = ^TD3DLightData;
TD3DLightData = record
TD3DLightData = packed record
dwSize: DWORD;
lpIn: PD3DLightingElement; // Input positions and normals
dwInSize: DWORD; // Stride of input elements
lpOut: PD3DTLVertex; // Output colors
dwOutSize: DWORD; // Stride of output colors
lpIn: ^TD3DLightingElement; (* Input positions and normals *)
dwInSize: DWORD; (* Stride of input elements *)
lpOut: ^TD3DTLVertex; (* Output colors *)
dwOutSize: DWORD; (* Stride of output colors *)
end;
 
D3DLIGHTDATA = TD3DLightData;
LPD3DLIGHTDATA = PD3DLightData;
 
(*
* Before DX5, these values were in an enum called
* D3DCOLORMODEL. This was not correct, since they are
* TD3DColorModel. This was not correct, since they are
* bit flags. A driver can surface either or both flags
* in the dcmColorModel member of D3DDEVICEDESC.
*)
3147,23 → 6366,32
 
type
TD3DColorModel = DWORD;
D3DCOLORMODEL = TD3DColorModel;
 
const
D3DCOLOR_INVALID_0 = 0;
D3DCOLOR_MONO = 1;
D3DCOLOR_RGB = 2;
 
{ Options for clearing }
(*
* Options for clearing
*)
 
const
D3DCLEAR_TARGET = $00000001; // Clear target surface
D3DCLEAR_ZBUFFER = $00000002; // Clear target z buffer
D3DCLEAR_STENCIL = $00000004; // Clear stencil planes
D3DCLEAR_TARGET = $00000001; (* Clear target surface *)
D3DCLEAR_ZBUFFER = $00000002; (* Clear target z buffer *)
D3DCLEAR_STENCIL = $00000004; (* Clear stencil planes *)
 
{ Supported op codes for execute instructions. }
(*
* Execute buffers are allocated via Direct3D. These buffers may then
* be filled by the application with instructions to execute along with
* vertex data.
*)
 
(*
* Supported op codes for execute instructions.
*)
 
type
PD3DOpcode = ^TD3DOpcode;
TD3DOpcode = (
D3DOP_INVALID_0,
D3DOP_POINT,
3179,71 → 6407,63
D3DOP_EXIT,
D3DOP_BRANCHFORWARD,
D3DOP_SPAN,
D3DOP_SETSTATUS
);
D3DOP_SETSTATUS);
 
D3DOPCODE = TD3DOpcode;
 
{ TD3DInstruction structure }
 
TD3DInstruction = record
bOpcode: Byte; // Instruction opcode
bSize: Byte; // Size of each instruction data unit
wCount: WORD; // Count of instruction data units to follow
PD3DInstruction = ^TD3DInstruction;
TD3DInstruction = packed record
bOpcode: BYTE; (* Instruction opcode *)
bSize: BYTE; (* Size of each instruction data unit *)
wCount: WORD; (* Count of instruction data units to follow *)
end;
D3DINSTRUCTION = TD3DInstruction;
 
{ TD3DTextureLoad structure }
(*
* Structure for texture loads
*)
 
TD3DTextureLoad = record
PD3DTextureLoad = ^TD3DTextureLoad;
TD3DTextureLoad = packed record
hDestTexture: TD3DTextureHandle;
hSrcTexture: TD3DTextureHandle;
end;
D3DTEXTURELOAD = TD3DTextureLoad;
 
{ TD3DPickRecord structure }
(*
* Structure for picking
*)
 
TD3DPickRecord = record
PD3DPickRecord = ^TD3DPickRecord;
TD3DPickRecord = packed record
bOpcode: BYTE;
bPad: BYTE;
dwOffset: DWORD;
dvZ: TD3DValue;
end;
D3DPICKRECORD = TD3DPickRecord;
 
{ TD3DShadeMode }
(*
* The following defines the rendering states which can be set in the
* execute buffer.
*)
 
PD3DShadeMode = ^TD3DShadeMode;
TD3DShadeMode = (
D3DSHADE_INVALID_0,
D3DSHADE_FLAT,
D3DSHADE_GOURAUD,
D3DSHADE_PHONG
);
D3DSHADE_PHONG);
 
D3DSHADEMODE = TD3DShadeMode;
 
{ TD3DFillMode }
 
PD3DFillMode = ^TD3DFillMode;
TD3DFillMode = (
D3DFILL_INVALID_0,
D3DFILL_POINT,
D3DFILL_WIREFRAME,
D3DFILL_SOLID
);
D3DFILL_SOLID);
 
D3DFILLMODE = TD3DFillMode;
 
{ TD3DLinePattern structure }
 
TD3DLinePattern = record
PD3DLinePattern = ^TD3DLinePattern;
TD3DLinePattern = packed record
wRepeatFactor: WORD;
wLinePattern: WORD;
end;
 
D3DLINEPATTERN = TD3DLinePattern;
 
{ TD3DTextureFilter }
 
PD3DTextureFilter = ^TD3DTextureFilter;
TD3DTextureFilter = (
D3DFILTER_INVALID_0,
D3DFILTER_NEAREST,
3251,13 → 6471,9
D3DFILTER_MIPNEAREST,
D3DFILTER_MIPLINEAR,
D3DFILTER_LINEARMIPNEAREST,
D3DFILTER_LINEARMIPLINEAR
);
D3DFILTER_LINEARMIPLINEAR);
 
D3DTEXTUREFILTER = TD3DTextureFilter;
 
{ TD3DBlend }
 
PD3DBlend = ^TD3DBlend;
TD3DBlend = (
D3DBLEND_INVALID_0,
D3DBLEND_ZERO,
3272,13 → 6488,9
D3DBLEND_INVDESTCOLOR,
D3DBLEND_SRCALPHASAT,
D3DBLEND_BOTHSRCALPHA,
D3DBLEND_BOTHINVSRCALPHA
);
D3DBLEND_BOTHINVSRCALPHA);
 
D3DBLEND = TD3DBlend;
 
{ TD3DTextureBlend }
 
PD3DTextureBlend = ^TD3DTextureBlend;
TD3DTextureBlend = (
D3DTBLEND_INVALID_0,
D3DTBLEND_DECAL,
3288,36 → 6500,24
D3DTBLEND_DECALMASK,
D3DTBLEND_MODULATEMASK,
D3DTBLEND_COPY,
D3DTBLEND_ADD
);
D3DTBLEND_ADD);
 
D3DTEXTUREBLEND = TD3DTextureBlend;
 
{ TD3DTextureAddress }
 
PD3DTextureAddress = ^TD3DTextureAddress;
TD3DTextureAddress = (
D3DTADDRESS_INVALID_0,
D3DTADDRESS_WRAP,
D3DTADDRESS_MIRROR,
D3DTADDRESS_CLAMP,
D3DTADDRESS_BORDER
);
D3DTADDRESS_BORDER);
 
D3DTEXTUREADDRESS = TD3DTextureAddress;
 
{ TD3DCull }
 
PD3DCull = ^TD3DCull;
TD3DCull = (
D3DCULL_INVALID_0,
D3DCULL_NONE,
D3DCULL_CW,
D3DCULL_CCW
);
D3DCULL_CCW);
 
D3DCULL = TD3DCull;
 
{ TD3DCmpFunc }
 
PD3DCmpFunc = ^TD3DCmpFunc;
TD3DCmpFunc = (
D3DCMP_INVALID_0,
D3DCMP_NEVER,
3327,13 → 6527,9
D3DCMP_GREATER,
D3DCMP_NOTEQUAL,
D3DCMP_GREATEREQUAL,
D3DCMP_ALWAYS
);
D3DCMP_ALWAYS);
 
D3DCMPFUNC = TD3DCmpFunc;
 
{ TD3DStencilOp }
 
PD3DStencilOp = ^TD3DStencilOp;
TD3DStencilOp = (
D3DSTENCILOP_INVALID_0,
D3DSTENCILOP_KEEP,
3343,55 → 6539,37
D3DSTENCILOP_DECRSAT,
D3DSTENCILOP_INVERT,
D3DSTENCILOP_INCR,
D3DSTENCILOP_DECR
);
D3DSTENCILOP_DECR);
 
D3DSTENCILOP = TD3DStencilOp;
 
{ TD3DFogMode }
 
PD3DFogMode = ^TD3DFogMode;
TD3DFogMode = (
D3DFOG_NONE,
D3DFOG_EXP,
D3DFOG_EXP2,
D3DFOG_LINEAR
);
D3DFOG_LINEAR);
 
D3DFOGMODE = TD3DFogMode;
 
{ TD3DZBufferType }
 
PD3DZBufferType = ^TD3DZBufferType;
TD3DZBufferType = (
D3DZB_FALSE,
D3DZB_TRUE, // Z buffering
D3DZB_USEW // W buffering
);
D3DZB_USEW); // W buffering
 
D3DZBUFFERTYPE = TD3DZBufferType;
 
{ TD3DAntialiasMode }
 
PD3DAntialiasMode = ^TD3DAntialiasMode;
TD3DAntialiasMode = (
D3DANTIALIAS_NONE,
D3DANTIALIAS_SORTDEPENDENT,
D3DANTIALIAS_SORTINDEPENDENT
);
D3DANTIALIAS_SORTINDEPENDENT);
 
D3DANTIALIASMODE = TD3DAntialiasMode;
 
{ TD3DVertexType }
 
// Vertex types supported by Direct3D
PD3DVertexType = ^TD3DVertexType;
TD3DVertexType = (
D3DVT_INVALID_0,
D3DVT_VERTEX,
D3DVT_LVERTEX,
D3DVT_TLVERTEX
);
D3DVT_TLVERTEX);
 
D3DVERTEXTYPE = TD3DVertexType;
 
{ TD3DPrimitiveType }
 
// Primitives supported by draw-primitive API
PD3DPrimitiveType = ^TD3DPrimitiveType;
TD3DPrimitiveType = (
D3DPT_INVALID_0,
D3DPT_POINTLIST,
3399,55 → 6577,42
D3DPT_LINESTRIP,
D3DPT_TRIANGLELIST,
D3DPT_TRIANGLESTRIP,
D3DPT_TRIANGLEFAN
);
D3DPT_TRIANGLEFAN);
 
D3DPRIMITIVETYPE = TD3DPrimitiveType;
(*
* Amount to add to a state to generate the override for that state.
*)
 
{ Amount to add to a state to generate the override for that state. }
 
const
D3DSTATE_OVERRIDE_BIAS = 256;
 
function D3DSTATE_OVERRIDE(typ: DWORD): DWORD;
(*
* A state which sets the override flag for the specified state type.
*)
 
{ A state which sets the override flag for the specified state type. }
function D3DSTATE_OVERRIDE(StateType: DWORD) : DWORD;
 
type
{ TD3DTransformStateType }
PD3DTransformStateType = ^TD3DTransformStateType;
TD3DTransformStateType = DWORD;
const
D3DTRANSFORMSTATE_WORLD = 1;
D3DTRANSFORMSTATE_VIEW = 2;
D3DTRANSFORMSTATE_PROJECTION = 3;
D3DTRANSFORMSTATE_WORLD1 = 4; // 2nd matrix to blend
D3DTRANSFORMSTATE_WORLD2 = 5; // 3rd matrix to blend
D3DTRANSFORMSTATE_WORLD3 = 6; // 4th matrix to blend
D3DTRANSFORMSTATE_TEXTURE0 = 16;
D3DTRANSFORMSTATE_TEXTURE1 = 17;
D3DTRANSFORMSTATE_TEXTURE2 = 18;
D3DTRANSFORMSTATE_TEXTURE3 = 19;
D3DTRANSFORMSTATE_TEXTURE4 = 20;
D3DTRANSFORMSTATE_TEXTURE5 = 21;
D3DTRANSFORMSTATE_TEXTURE6 = 22;
D3DTRANSFORMSTATE_TEXTURE7 = 23;
 
TD3DTransformStateType = (
D3DTRANSFORMSTATE_INVALID_0,
D3DTRANSFORMSTATE_WORLD,
D3DTRANSFORMSTATE_VIEW,
D3DTRANSFORMSTATE_PROJECTION,
 
D3DTRANSFORMSTATE_WORLD1,
D3DTRANSFORMSTATE_WORLD2,
D3DTRANSFORMSTATE_WORLD3,
D3DTRANSFORMSTATE_INVALID_7,
D3DTRANSFORMSTATE_INVALID_8,
D3DTRANSFORMSTATE_INVALID_9,
D3DTRANSFORMSTATE_INVALID_10,
D3DTRANSFORMSTATE_INVALID_11,
D3DTRANSFORMSTATE_INVALID_12,
D3DTRANSFORMSTATE_INVALID_13,
D3DTRANSFORMSTATE_INVALID_14,
D3DTRANSFORMSTATE_INVALID_15,
D3DTRANSFORMSTATE_TEXTURE0,
D3DTRANSFORMSTATE_TEXTURE1,
D3DTRANSFORMSTATE_TEXTURE2,
D3DTRANSFORMSTATE_TEXTURE3,
D3DTRANSFORMSTATE_TEXTURE4,
D3DTRANSFORMSTATE_TEXTURE5,
D3DTRANSFORMSTATE_TEXTURE6,
D3DTRANSFORMSTATE_TEXTURE7
);
 
D3DTRANSFORMSTATETYPE = TD3DTransformStateType;
 
{ TD3DLightStateType }
 
type
PD3DLightStateType = ^TD3DLightStateType;
TD3DLightStateType = (
D3DLIGHTSTATE_INVALID_0,
D3DLIGHTSTATE_MATERIAL,
3457,216 → 6622,185
D3DLIGHTSTATE_FOGSTART,
D3DLIGHTSTATE_FOGEND,
D3DLIGHTSTATE_FOGDENSITY,
D3DLIGHTSTATE_COLORVERTEX
);
D3DLIGHTSTATE_COLORVERTEX);
 
D3DLIGHTSTATETYPE = TD3DLightStateType;
PD3DRenderStateType = ^TD3DRenderStateType;
TD3DRenderStateType = DWORD;
const
D3DRENDERSTATE_ANTIALIAS = 2; (* D3DANTIALIASMODE *)
D3DRENDERSTATE_TEXTUREPERSPECTIVE = 4; (* TRUE for perspective correction *)
D3DRENDERSTATE_ZENABLE = 7; (* D3DZBUFFERTYPE (or TRUE/FALSE for legacy) *)
D3DRENDERSTATE_FILLMODE = 8; (* D3DFILL_MODE *)
D3DRENDERSTATE_SHADEMODE = 9; (* D3DSHADEMODE *)
D3DRENDERSTATE_LINEPATTERN = 10; (* D3DLINEPATTERN *)
D3DRENDERSTATE_ZWRITEENABLE = 14; (* TRUE to enable z writes *)
D3DRENDERSTATE_ALPHATESTENABLE = 15; (* TRUE to enable alpha tests *)
D3DRENDERSTATE_LASTPIXEL = 16; (* TRUE for last-pixel on lines *)
D3DRENDERSTATE_SRCBLEND = 19; (* D3DBLEND *)
D3DRENDERSTATE_DESTBLEND = 20; (* D3DBLEND *)
D3DRENDERSTATE_CULLMODE = 22; (* D3DCULL *)
D3DRENDERSTATE_ZFUNC = 23; (* D3DCMPFUNC *)
D3DRENDERSTATE_ALPHAREF = 24; (* D3DFIXED *)
D3DRENDERSTATE_ALPHAFUNC = 25; (* D3DCMPFUNC *)
D3DRENDERSTATE_DITHERENABLE = 26; (* TRUE to enable dithering *)
D3DRENDERSTATE_ALPHABLENDENABLE = 27; (* TRUE to enable alpha blending *)
D3DRENDERSTATE_FOGENABLE = 28; (* TRUE to enable fog blending *)
D3DRENDERSTATE_SPECULARENABLE = 29; (* TRUE to enable specular *)
D3DRENDERSTATE_ZVISIBLE = 30; (* TRUE to enable z checking *)
D3DRENDERSTATE_STIPPLEDALPHA = 33; (* TRUE to enable stippled alpha (RGB device only) *)
D3DRENDERSTATE_FOGCOLOR = 34; (* D3DCOLOR *)
D3DRENDERSTATE_FOGTABLEMODE = 35; (* D3DFOGMODE *)
D3DRENDERSTATE_FOGSTART = 36; (* Fog start (for both vertex and pixel fog) *)
D3DRENDERSTATE_FOGEND = 37; (* Fog end *)
D3DRENDERSTATE_FOGDENSITY = 38; (* Fog density *)
D3DRENDERSTATE_EDGEANTIALIAS = 40; (* TRUE to enable edge antialiasing *)
D3DRENDERSTATE_COLORKEYENABLE = 41; (* TRUE to enable source colorkeyed textures *)
D3DRENDERSTATE_ZBIAS = 47; (* LONG Z bias *)
D3DRENDERSTATE_RANGEFOGENABLE = 48; (* Enables range-based fog *)
 
{ TD3DRenderStateType }
D3DRENDERSTATE_STENCILENABLE = 52; (* BOOL enable/disable stenciling *)
D3DRENDERSTATE_STENCILFAIL = 53; (* D3DSTENCILOP to do if stencil test fails *)
D3DRENDERSTATE_STENCILZFAIL = 54; (* D3DSTENCILOP to do if stencil test passes and Z test fails *)
D3DRENDERSTATE_STENCILPASS = 55; (* D3DSTENCILOP to do if both stencil and Z tests pass *)
D3DRENDERSTATE_STENCILFUNC = 56; (* D3DCMPFUNC fn. Stencil Test passes if ((ref & mask) stencilfn (stencil & mask)) is true *)
D3DRENDERSTATE_STENCILREF = 57; (* Reference value used in stencil test *)
D3DRENDERSTATE_STENCILMASK = 58; (* Mask value used in stencil test *)
D3DRENDERSTATE_STENCILWRITEMASK = 59; (* Write mask applied to values written to stencil buffer *)
D3DRENDERSTATE_TEXTUREFACTOR = 60; (* D3DCOLOR used for multi-texture blend *)
 
TD3DRenderStateType = (
D3DRENDERSTATE_INVALID_0,
D3DRENDERSTATE_TEXTUREHANDLE, // Texture handle for legacy interfaces (Texture,Texture2)
D3DRENDERSTATE_ANTIALIAS, // TD3DAntialiasMode
D3DRENDERSTATE_TEXTUREADDRESS, // TD3DTextureAddress
D3DRENDERSTATE_TEXTUREPERSPECTIVE, // TRUE for perspective correction
D3DRENDERSTATE_WRAPU, // TRUE for wrapping in u
D3DRENDERSTATE_WRAPV, // TRUE for wrapping in v
D3DRENDERSTATE_ZENABLE, // TD3DZBufferType (or TRUE/FALSE for legacy)
D3DRENDERSTATE_FILLMODE, // TD3DFillMode
D3DRENDERSTATE_SHADEMODE, // TD3DShadeMode
D3DRENDERSTATE_LINEPATTERN, // TD3DLinePattern
D3DRENDERSTATE_MONOENABLE, // TRUE to enable mono rasterization
D3DRENDERSTATE_ROP2, // ROP2
D3DRENDERSTATE_PLANEMASK, // DWORD physical plane mask
D3DRENDERSTATE_ZWRITEENABLE, // TRUE to enable z writes
D3DRENDERSTATE_ALPHATESTENABLE, // TRUE to enable alpha tests
D3DRENDERSTATE_LASTPIXEL, // TRUE for last-pixel on lines
D3DRENDERSTATE_TEXTUREMAG, // TD3DTextureFilter
D3DRENDERSTATE_TEXTUREMIN, // TD3DTextureFilter
D3DRENDERSTATE_SRCBLEND, // TD3DBlend
D3DRENDERSTATE_DESTBLEND, // TD3DBlend
D3DRENDERSTATE_TEXTUREMAPBLEND, // TD3DTextureBlend
D3DRENDERSTATE_CULLMODE, // TD3DCull
D3DRENDERSTATE_ZFUNC, // TD3DCmpFunc
D3DRENDERSTATE_ALPHAREF, // TD3DFixed
D3DRENDERSTATE_ALPHAFUNC, // TD3DCmpFunc
D3DRENDERSTATE_DITHERENABLE, // TRUE to enable dithering
D3DRENDERSTATE_ALPHABLENDENABLE, // TRUE to enable alpha blending
D3DRENDERSTATE_FOGENABLE, // TRUE to enable fog
D3DRENDERSTATE_SPECULARENABLE, // TRUE to enable specular
D3DRENDERSTATE_ZVISIBLE, // TRUE to enable z checking
D3DRENDERSTATE_SUBPIXEL, // TRUE to enable subpixel correction
D3DRENDERSTATE_SUBPIXELX, // TRUE to enable correction in X only
D3DRENDERSTATE_STIPPLEDALPHA, // TRUE to enable stippled alpha
D3DRENDERSTATE_FOGCOLOR, // TD3DColor
D3DRENDERSTATE_FOGTABLEMODE, // TD3DFogMode
D3DRENDERSTATE_FOGSTART, // Fog start (for both vertex and pixel fog)
D3DRENDERSTATE_FOGEND, // Fog end
D3DRENDERSTATE_FOGDENSITY, // Fog density
D3DRENDERSTATE_STIPPLEENABLE, // TRUE to enable stippling
D3DRENDERSTATE_EDGEANTIALIAS, // TRUE to enable edge antialiasing
D3DRENDERSTATE_COLORKEYENABLE, // TRUE to enable source colorkeyed textures
D3DRENDERSTATE_BORDERCOLOR, // Border color for texturing w/border
D3DRENDERSTATE_TEXTUREADDRESSU, // Texture addressing mode for U coordinate
D3DRENDERSTATE_TEXTUREADDRESSV, // Texture addressing mode for V coordinate
D3DRENDERSTATE_MIPMAPLODBIAS, // TD3DValue Mipmap LOD bias
D3DRENDERSTATE_ZBIAS, // LONG Z bias
D3DRENDERSTATE_RANGEFOGENABLE, // Enables range-based fog
D3DRENDERSTATE_ANISOTROPY, // Max. anisotropy. 1 = no anisotropy
D3DRENDERSTATE_FLUSHBATCH, // Explicit flush for DP batching (DX5 Only)
D3DRENDERSTATE_TRANSLUCENTSORTINDEPENDENT,// BOOL enable sort-independent transparency
D3DRENDERSTATE_STENCILENABLE, // BOOL enable/disable stenciling
D3DRENDERSTATE_STENCILFAIL, // TD3DStencilOp to do if stencil test fails
D3DRENDERSTATE_STENCILZFAIL, // TD3DStencilOp to do if stencil test passes and Z test fails
D3DRENDERSTATE_STENCILPASS, // TD3DStencilOp to do if both stencil and Z tests pass
D3DRENDERSTATE_STENCILFUNC , // TD3DCmpFunc fn. Stencil Test passes if ((ref & mask) stencilfn (stencil & mask)) is true
D3DRENDERSTATE_STENCILREF, // Reference value used in stencil test
D3DRENDERSTATE_STENCILMASK, // Mask value used in stencil test
D3DRENDERSTATE_STENCILWRITEMASK, // Write mask applied to values written to stencil buffer
D3DRENDERSTATE_TEXTUREFACTOR, // TD3DColor used for multi-texture blend
D3DRENDERSTATE_INVALID_61,
D3DRENDERSTATE_INVALID_62,
D3DRENDERSTATE_INVALID_63,
D3DRENDERSTATE_STIPPLEPATTERN00, // Stipple pattern 01...
D3DRENDERSTATE_STIPPLEPATTERN01,
D3DRENDERSTATE_STIPPLEPATTERN02,
D3DRENDERSTATE_STIPPLEPATTERN03,
D3DRENDERSTATE_STIPPLEPATTERN04,
D3DRENDERSTATE_STIPPLEPATTERN05,
D3DRENDERSTATE_STIPPLEPATTERN06,
D3DRENDERSTATE_STIPPLEPATTERN07,
D3DRENDERSTATE_STIPPLEPATTERN08,
D3DRENDERSTATE_STIPPLEPATTERN09,
D3DRENDERSTATE_STIPPLEPATTERN10,
D3DRENDERSTATE_STIPPLEPATTERN11,
D3DRENDERSTATE_STIPPLEPATTERN12,
D3DRENDERSTATE_STIPPLEPATTERN13,
D3DRENDERSTATE_STIPPLEPATTERN14,
D3DRENDERSTATE_STIPPLEPATTERN15,
D3DRENDERSTATE_STIPPLEPATTERN16,
D3DRENDERSTATE_STIPPLEPATTERN17,
D3DRENDERSTATE_STIPPLEPATTERN18,
D3DRENDERSTATE_STIPPLEPATTERN19,
D3DRENDERSTATE_STIPPLEPATTERN20,
D3DRENDERSTATE_STIPPLEPATTERN21,
D3DRENDERSTATE_STIPPLEPATTERN22,
D3DRENDERSTATE_STIPPLEPATTERN23,
D3DRENDERSTATE_STIPPLEPATTERN24,
D3DRENDERSTATE_STIPPLEPATTERN25,
D3DRENDERSTATE_STIPPLEPATTERN26,
D3DRENDERSTATE_STIPPLEPATTERN27,
D3DRENDERSTATE_STIPPLEPATTERN28,
D3DRENDERSTATE_STIPPLEPATTERN29,
D3DRENDERSTATE_STIPPLEPATTERN30,
D3DRENDERSTATE_STIPPLEPATTERN31,
D3DRENDERSTATE_INVALID_95,
D3DRENDERSTATE_INVALID_96,
D3DRENDERSTATE_INVALID_97,
D3DRENDERSTATE_INVALID_98,
D3DRENDERSTATE_INVALID_99,
D3DRENDERSTATE_INVALID_100,
D3DRENDERSTATE_INVALID_101,
D3DRENDERSTATE_INVALID_102,
D3DRENDERSTATE_INVALID_103,
D3DRENDERSTATE_INVALID_104,
D3DRENDERSTATE_INVALID_105,
D3DRENDERSTATE_INVALID_106,
D3DRENDERSTATE_INVALID_107,
D3DRENDERSTATE_INVALID_108,
D3DRENDERSTATE_INVALID_109,
D3DRENDERSTATE_INVALID_110,
D3DRENDERSTATE_INVALID_111,
D3DRENDERSTATE_INVALID_112,
D3DRENDERSTATE_INVALID_113,
D3DRENDERSTATE_INVALID_114,
D3DRENDERSTATE_INVALID_115,
D3DRENDERSTATE_INVALID_116,
D3DRENDERSTATE_INVALID_117,
D3DRENDERSTATE_INVALID_118,
D3DRENDERSTATE_INVALID_119,
D3DRENDERSTATE_INVALID_120,
D3DRENDERSTATE_INVALID_121,
D3DRENDERSTATE_INVALID_122,
D3DRENDERSTATE_INVALID_123,
D3DRENDERSTATE_INVALID_124,
D3DRENDERSTATE_INVALID_125,
D3DRENDERSTATE_INVALID_126,
D3DRENDERSTATE_INVALID_127,
(*
* 128 values [128; 255] are reserved for texture coordinate wrap flags.
* These are constructed with the D3DWRAP_U and D3DWRAP_V macros. Using
* a flags word preserves forward compatibility with texture coordinates
* that are >2D.
*)
D3DRENDERSTATE_WRAP0 = 128; (* wrap for 1st texture coord. set *)
D3DRENDERSTATE_WRAP1 = 129; (* wrap for 2nd texture coord. set *)
D3DRENDERSTATE_WRAP2 = 130; (* wrap for 3rd texture coord. set *)
D3DRENDERSTATE_WRAP3 = 131; (* wrap for 4th texture coord. set *)
D3DRENDERSTATE_WRAP4 = 132; (* wrap for 5th texture coord. set *)
D3DRENDERSTATE_WRAP5 = 133; (* wrap for 6th texture coord. set *)
D3DRENDERSTATE_WRAP6 = 134; (* wrap for 7th texture coord. set *)
D3DRENDERSTATE_WRAP7 = 135; (* wrap for 8th texture coord. set *)
D3DRENDERSTATE_CLIPPING = 136;
D3DRENDERSTATE_LIGHTING = 137;
D3DRENDERSTATE_EXTENTS = 138;
D3DRENDERSTATE_AMBIENT = 139;
D3DRENDERSTATE_FOGVERTEXMODE = 140;
D3DRENDERSTATE_COLORVERTEX = 141;
D3DRENDERSTATE_LOCALVIEWER = 142;
D3DRENDERSTATE_NORMALIZENORMALS = 143;
D3DRENDERSTATE_COLORKEYBLENDENABLE = 144;
D3DRENDERSTATE_DIFFUSEMATERIALSOURCE = 145;
D3DRENDERSTATE_SPECULARMATERIALSOURCE = 146;
D3DRENDERSTATE_AMBIENTMATERIALSOURCE = 147;
D3DRENDERSTATE_EMISSIVEMATERIALSOURCE = 148;
D3DRENDERSTATE_VERTEXBLEND = 151;
D3DRENDERSTATE_CLIPPLANEENABLE = 152;
 
//
// 128 values [128, 255] are reserved for texture coordinate wrap flags.
// These are constructed with the D3DWRAP_U and D3DWRAP_V macros. Using
// a flags word preserves forward compatibility with texture coordinates
// that are >2D.
// retired renderstates - not supported for DX7 interfaces
//
D3DRENDERSTATE_WRAP0, // wrap for 1st texture coord. set
D3DRENDERSTATE_WRAP1, // wrap for 2nd texture coord. set
D3DRENDERSTATE_WRAP2, // wrap for 3rd texture coord. set
D3DRENDERSTATE_WRAP3, // wrap for 4th texture coord. set
D3DRENDERSTATE_WRAP4, // wrap for 5th texture coord. set
D3DRENDERSTATE_WRAP5, // wrap for 6th texture coord. set
D3DRENDERSTATE_WRAP6, // wrap for 7th texture coord. set
D3DRENDERSTATE_WRAP7, // wrap for 8th texture coord. set
D3DRENDERSTATE_CLIPPING,
D3DRENDERSTATE_LIGHTING,
D3DRENDERSTATE_EXTENTS,
D3DRENDERSTATE_AMBIENT,
D3DRENDERSTATE_FOGVERTEXMODE,
D3DRENDERSTATE_COLORVERTEX,
D3DRENDERSTATE_LOCALVIEWER,
D3DRENDERSTATE_NORMALIZENORMALS,
D3DRENDERSTATE_COLORKEYBLENDENABLE,
D3DRENDERSTATE_DIFFUSEMATERIALSOURCE,
D3DRENDERSTATE_SPECULARMATERIALSOURCE,
D3DRENDERSTATE_AMBIENTMATERIALSOURCE,
D3DRENDERSTATE_EMISSIVEMATERIALSOURCE,
D3DRENDERSTATE_INVALID_149,
D3DRENDERSTATE_INVALID_150,
D3DRENDERSTATE_VERTEXBLEND,
D3DRENDERSTATE_CLIPPLANEENABLE
);
D3DRENDERSTATE_TEXTUREHANDLE = 1; (* Texture handle for legacy interfaces (Texture;Texture2) *)
D3DRENDERSTATE_TEXTUREADDRESS = 3; (* D3DTEXTUREADDRESS *)
D3DRENDERSTATE_WRAPU = 5; (* TRUE for wrapping in u *)
D3DRENDERSTATE_WRAPV = 6; (* TRUE for wrapping in v *)
D3DRENDERSTATE_MONOENABLE = 11; (* TRUE to enable mono rasterization *)
D3DRENDERSTATE_ROP2 = 12; (* ROP2 *)
D3DRENDERSTATE_PLANEMASK = 13; (* DWORD physical plane mask *)
D3DRENDERSTATE_TEXTUREMAG = 17; (* D3DTEXTUREFILTER *)
D3DRENDERSTATE_TEXTUREMIN = 18; (* D3DTEXTUREFILTER *)
D3DRENDERSTATE_TEXTUREMAPBLEND = 21; (* D3DTEXTUREBLEND *)
D3DRENDERSTATE_SUBPIXEL = 31; (* TRUE to enable subpixel correction *)
D3DRENDERSTATE_SUBPIXELX = 32; (* TRUE to enable correction in X only *)
D3DRENDERSTATE_STIPPLEENABLE = 39; (* TRUE to enable stippling *)
D3DRENDERSTATE_BORDERCOLOR = 43; (* Border color for texturing w/border *)
D3DRENDERSTATE_TEXTUREADDRESSU = 44; (* Texture addressing mode for U coordinate *)
D3DRENDERSTATE_TEXTUREADDRESSV = 45; (* Texture addressing mode for V coordinate *)
D3DRENDERSTATE_MIPMAPLODBIAS = 46; (* D3DVALUE Mipmap LOD bias *)
D3DRENDERSTATE_ANISOTROPY = 49; (* Max. anisotropy. 1 = no anisotropy *)
D3DRENDERSTATE_FLUSHBATCH = 50; (* Explicit flush for DP batching (DX5 Only) *)
D3DRENDERSTATE_TRANSLUCENTSORTINDEPENDENT=51; (* BOOL enable sort-independent transparency *)
D3DRENDERSTATE_STIPPLEPATTERN00 = 64; (* Stipple pattern 01... *)
D3DRENDERSTATE_STIPPLEPATTERN01 = 65;
D3DRENDERSTATE_STIPPLEPATTERN02 = 66;
D3DRENDERSTATE_STIPPLEPATTERN03 = 67;
D3DRENDERSTATE_STIPPLEPATTERN04 = 68;
D3DRENDERSTATE_STIPPLEPATTERN05 = 69;
D3DRENDERSTATE_STIPPLEPATTERN06 = 70;
D3DRENDERSTATE_STIPPLEPATTERN07 = 71;
D3DRENDERSTATE_STIPPLEPATTERN08 = 72;
D3DRENDERSTATE_STIPPLEPATTERN09 = 73;
D3DRENDERSTATE_STIPPLEPATTERN10 = 74;
D3DRENDERSTATE_STIPPLEPATTERN11 = 75;
D3DRENDERSTATE_STIPPLEPATTERN12 = 76;
D3DRENDERSTATE_STIPPLEPATTERN13 = 77;
D3DRENDERSTATE_STIPPLEPATTERN14 = 78;
D3DRENDERSTATE_STIPPLEPATTERN15 = 79;
D3DRENDERSTATE_STIPPLEPATTERN16 = 80;
D3DRENDERSTATE_STIPPLEPATTERN17 = 81;
D3DRENDERSTATE_STIPPLEPATTERN18 = 82;
D3DRENDERSTATE_STIPPLEPATTERN19 = 83;
D3DRENDERSTATE_STIPPLEPATTERN20 = 84;
D3DRENDERSTATE_STIPPLEPATTERN21 = 85;
D3DRENDERSTATE_STIPPLEPATTERN22 = 86;
D3DRENDERSTATE_STIPPLEPATTERN23 = 87;
D3DRENDERSTATE_STIPPLEPATTERN24 = 88;
D3DRENDERSTATE_STIPPLEPATTERN25 = 89;
D3DRENDERSTATE_STIPPLEPATTERN26 = 90;
D3DRENDERSTATE_STIPPLEPATTERN27 = 91;
D3DRENDERSTATE_STIPPLEPATTERN28 = 92;
D3DRENDERSTATE_STIPPLEPATTERN29 = 93;
D3DRENDERSTATE_STIPPLEPATTERN30 = 94;
D3DRENDERSTATE_STIPPLEPATTERN31 = 95;
 
D3DRENDERSTATETYPE = TD3DRenderStateType;
//
// retired renderstate names - the values are still used under new naming conventions
//
D3DRENDERSTATE_FOGTABLESTART = 36; (* Fog table start *)
D3DRENDERSTATE_FOGTABLEEND = 37; (* Fog table end *)
D3DRENDERSTATE_FOGTABLEDENSITY = 38; (* Fog table density *)
 
TD3DMaterialColorSource = (
type
// Values for material source
PD3DMateralColorSource = ^TD3DMateralColorSource;
TD3DMateralColorSource = (
D3DMCS_MATERIAL, // Color from material is used
D3DMCS_COLOR1, // Diffuse vertex color is used
D3DMCS_COLOR2 // Specular vertex color is used
); // force 32-bit size enum
);
 
const
{ For back-compatibility with legacy compilations }
// For back-compatibility with legacy compilations
D3DRENDERSTATE_BLENDENABLE = D3DRENDERSTATE_ALPHABLENDENABLE;
D3DRENDERSTATE_FOGTABLESTART = D3DRENDERSTATE_FOGSTART;
D3DRENDERSTATE_FOGTABLEEND = D3DRENDERSTATE_FOGEND;
D3DRENDERSTATE_FOGTABLEDENSITY = D3DRENDERSTATE_FOGDENSITY;
 
{ Bias to apply to the texture coordinate set to apply a wrap to. }
D3DRENDERSTATE_WRAPBIAS = TD3DRenderStateType(128);
 
{ Flags to construct the WRAP render states }
// Bias to apply to the texture coordinate set to apply a wrap to.
D3DRENDERSTATE_WRAPBIAS = 128;
 
(* Flags to construct the WRAP render states *)
D3DWRAP_U = $00000001;
D3DWRAP_V = $00000002;
 
{ Flags to construct the WRAP render states for 1D thru 4D texture coordinates }
(* Flags to construct the WRAP render states for 1D thru 4D texture coordinates *)
D3DWRAPCOORD_0 = $00000001; // same as D3DWRAP_U
D3DWRAPCOORD_1 = $00000002; // same as D3DWRAP_V
D3DWRAPCOORD_2 = $00000004;
D3DWRAPCOORD_3 = $00000008;
 
function D3DRENDERSTATE_STIPPLEPATTERN(y: DWORD): TD3DRenderStateType;
function D3DRENDERSTATE_STIPPLEPATTERN(y: integer) : TD3DRenderStateType;
 
type
 
TD3DState = record
PD3DState = ^TD3DState;
TD3DState = packed record
case Integer of
0: (
dtstTransformStateType: TD3DTransformStateType;
dwArg: array[0..0] of DWORD;
dwArg: Array [ 0..0 ] of DWORD;
);
1: (
dlstLightStateType: TD3DLightStateType;
dvArg: array[0..0] of TD3DValue;
dvArg: Array [ 0..0 ] of TD3DValue;
);
2: (
drstRenderStateType: TD3DRenderStateType;
3673,39 → 6807,39
);
end;
 
D3DSTATE = TD3DState;
 
{ TD3DMatrixLoad structure }
 
TD3DMatrixLoad = record
hDestMatrix: TD3DMatrixHandle; // Destination matrix
hSrcMatrix: TD3DMatrixHandle; // Source matrix
(*
* Operation used to load matrices
* hDstMat = hSrcMat
*)
PD3DMatrixLoad = ^TD3DMatrixLoad;
TD3DMatrixLoad = packed record
hDestMatrix: TD3DMatrixHandle; (* Destination matrix *)
hSrcMatrix: TD3DMatrixHandle; (* Source matrix *)
end;
 
D3DMATRIXLOAD = TD3DMatrixLoad;
 
{ TD3DMatrixMultiply structure }
 
TD3DMatrixMultiply = record
hDestMatrix: TD3DMatrixHandle; // Destination matrix
hSrcMatrix1: TD3DMatrixHandle; // First source matrix
hSrcMatrix2: TD3DMatrixHandle; // Second source matrix
(*
* Operation used to multiply matrices
* hDstMat = hSrcMat1 * hSrcMat2
*)
PD3DMatrixMultiply = ^TD3DMatrixMultiply;
TD3DMatrixMultiply = packed record
hDestMatrix: TD3DMatrixHandle; (* Destination matrix *)
hSrcMatrix1: TD3DMatrixHandle; (* First source matrix *)
hSrcMatrix2: TD3DMatrixHandle; (* Second source matrix *)
end;
 
D3DMATRIXMULTIPLY = TD3DMatrixMultiply;
 
{ TD3DProcessVertices structure }
 
TD3DProcessVertices = record
dwFlags: DWORD; // Do we transform or light or just copy?
wStart: WORD; // Index to first vertex in source
wDest: WORD; // Index to first vertex in local buffer
dwCount: DWORD; // Number of vertices to be processed
dwReserved: DWORD; // Must be zero
(*
* Operation used to transform and light vertices.
*)
PD3DProcessVertices = ^TD3DProcessVertices;
TD3DProcessVertices = packed record
dwFlags: DWORD; (* Do we transform or light or just copy? *)
wStart: WORD; (* Index to first vertex in source *)
wDest: WORD; (* Index to first vertex in local buffer *)
dwCount: DWORD; (* Number of vertices to be processed *)
dwReserved: DWORD; (* Must be zero *)
end;
 
D3DPROCESSVERTICES = TD3DProcessVertices;
 
const
D3DPROCESSVERTICES_TRANSFORMLIGHT = $00000000;
D3DPROCESSVERTICES_TRANSFORM = $00000001;
3715,52 → 6849,54
D3DPROCESSVERTICES_UPDATEEXTENTS = $00000008;
D3DPROCESSVERTICES_NOCOLOR = $00000010;
 
{ TD3DTextureStagesStateType }
 
(*
* State enumerants for per-stage texture processing.
*)
type
TD3DTextureStagesStateType = (
D3DTSS_INVALID_0,
D3DTSS_COLOROP, // TD3DTextureOp - per-stage blending controls for color channels
D3DTSS_COLORARG1, // D3DTA_* (texture arg)
D3DTSS_COLORARG2, // D3DTA_* (texture arg)
D3DTSS_ALPHAOP, // TD3DTextureOp - per-stage blending controls for alpha channel
D3DTSS_ALPHAARG1, // D3DTA_* (texture arg)
D3DTSS_ALPHAARG2, // D3DTA_* (texture arg)
D3DTSS_BUMPENVMAT00, // TD3DValue (bump mapping matrix)
D3DTSS_BUMPENVMAT01, // TD3DValue (bump mapping matrix)
D3DTSS_BUMPENVMAT10, // TD3DValue (bump mapping matrix)
D3DTSS_BUMPENVMAT11, // TD3DValue (bump mapping matrix)
D3DTSS_TEXCOORDINDEX, // identifies which set of texture coordinates index this texture
D3DTSS_ADDRESS, // TD3DTextureAddress for both coordinates
D3DTSS_ADDRESSU, // TD3DTextureAddress for U coordinate
D3DTSS_ADDRESSV, // TD3DTextureAddress for V coordinate
D3DTSS_BORDERCOLOR, // TD3DColor
D3DTSS_MAGFILTER, // TD3DTextureMagFilter filter to use for magnification
D3DTSS_MINFILTER, // TD3DTextureMinFilter filter to use for minification
D3DTSS_MIPFILTER, // TD3DTextureMipFilter filter to use between mipmaps during minification
D3DTSS_MIPMAPLODBIAS, // D3DVALUE Mipmap LOD bias
D3DTSS_MAXMIPLEVEL, // DWORD 0..(n-1) LOD index of largest map to use (0 == largest)
D3DTSS_MAXANISOTROPY, // DWORD maximum anisotropy
D3DTSS_BUMPENVLSCALE, // TD3DValue scale for bump map luminance
D3DTSS_BUMPENVLOFFSET, // TD3DValue offset for bump map luminance
D3DTSS_TEXTURETRANSFORMFLAGS // D3DTEXTURETRANSFORMFLAGS controls texture transform
);
 
D3DTEXTURESTAGESTATETYPE = TD3DTextureStagesStateType;
 
PD3DTextureStageStateType = ^TD3DTextureStageStateType;
TD3DTextureStageStateType = DWORD;
const
{ Values, used with D3DTSS_TEXCOORDINDEX, to specify that the vertex data(position }
{ and normal in the camera space) should be taken as texture coordinates }
{ Low 16 bits are used to specify texture coordinate index, to take the WRAP mode from }
D3DTSS_COLOROP = 1; (* D3DTEXTUREOP - per-stage blending controls for color channels *)
D3DTSS_COLORARG1 = 2; (* D3DTA_* (texture arg) *)
D3DTSS_COLORARG2 = 3; (* D3DTA_* (texture arg) *)
D3DTSS_ALPHAOP = 4; (* D3DTEXTUREOP - per-stage blending controls for alpha channel *)
D3DTSS_ALPHAARG1 = 5; (* D3DTA_* (texture arg) *)
D3DTSS_ALPHAARG2 = 6; (* D3DTA_* (texture arg) *)
D3DTSS_BUMPENVMAT00 = 7; (* D3DVALUE (bump mapping matrix) *)
D3DTSS_BUMPENVMAT01 = 8; (* D3DVALUE (bump mapping matrix) *)
D3DTSS_BUMPENVMAT10 = 9; (* D3DVALUE (bump mapping matrix) *)
D3DTSS_BUMPENVMAT11 = 10; (* D3DVALUE (bump mapping matrix) *)
D3DTSS_TEXCOORDINDEX = 11; (* identifies which set of texture coordinates index this texture *)
D3DTSS_ADDRESS = 12; (* D3DTEXTUREADDRESS for both coordinates *)
D3DTSS_ADDRESSU = 13; (* D3DTEXTUREADDRESS for U coordinate *)
D3DTSS_ADDRESSV = 14; (* D3DTEXTUREADDRESS for V coordinate *)
D3DTSS_BORDERCOLOR = 15; (* D3DCOLOR *)
D3DTSS_MAGFILTER = 16; (* D3DTEXTUREMAGFILTER filter to use for magnification *)
D3DTSS_MINFILTER = 17; (* D3DTEXTUREMINFILTER filter to use for minification *)
D3DTSS_MIPFILTER = 18; (* D3DTEXTUREMIPFILTER filter to use between mipmaps during minification *)
D3DTSS_MIPMAPLODBIAS = 19; (* D3DVALUE Mipmap LOD bias *)
D3DTSS_MAXMIPLEVEL = 20; (* DWORD 0..(n-1) LOD index of largest map to use (0 == largest) *)
D3DTSS_MAXANISOTROPY = 21; (* DWORD maximum anisotropy *)
D3DTSS_BUMPENVLSCALE = 22; (* D3DVALUE scale for bump map luminance *)
D3DTSS_BUMPENVLOFFSET = 23; (* D3DVALUE offset for bump map luminance *)
D3DTSS_TEXTURETRANSFORMFLAGS = 24; (* D3DTEXTURETRANSFORMFLAGS controls texture transform *)
 
// Values, used with D3DTSS_TEXCOORDINDEX, to specify that the vertex data(position
// and normal in the camera space) should be taken as texture coordinates
// Low 16 bits are used to specify texture coordinate index, to take the WRAP mode from
//
D3DTSS_TCI_PASSTHRU = $00000000;
D3DTSS_TCI_CAMERASPACENORMAL = $00010000;
D3DTSS_TCI_CAMERASPACEPOSITION = $00020000;
D3DTSS_TCI_CAMERASPACEREFLECTIONVECTOR = $00030000;
 
{ TD3DTextureOp }
 
type
(*
* Enumerations for COLOROP and ALPHAOP texture blending operations set in
* texture processing stage controls in D3DRENDERSTATE.
*)
PD3DTextureOp = ^TD3DTextureOp;
TD3DTextureOp = (
D3DTOP_INVALID_0,
// Control
3767,10 → 6903,12
D3DTOP_DISABLE, // disables stage
D3DTOP_SELECTARG1, // the default
D3DTOP_SELECTARG2,
 
// Modulate
D3DTOP_MODULATE, // multiply args together
D3DTOP_MODULATE2X, // multiply and 1 bit
D3DTOP_MODULATE4X, // multiply and 2 bits
 
// Add
D3DTOP_ADD, // add arguments together
D3DTOP_ADDSIGNED, // add with -0.5 bias
3779,6 → 6917,7
D3DTOP_ADDSMOOTH, // add 2 args, subtract product
// Arg1 + Arg2 - Arg1*Arg2
// = Arg1 + (1-Arg1)*Arg2
 
// Linear alpha blend: Arg1*(Alpha) + Arg2*(1-Alpha)
D3DTOP_BLENDDIFFUSEALPHA, // iterated alpha
D3DTOP_BLENDTEXTUREALPHA, // texture alpha
3786,6 → 6925,7
// Linear alpha blend with pre-multiplied arg1 input: Arg1 + Arg2*(1-Alpha)
D3DTOP_BLENDTEXTUREALPHAPM, // texture alpha
D3DTOP_BLENDCURRENTALPHA, // by alpha of current color
 
// Specular mapping
D3DTOP_PREMODULATE, // modulate with next texture before use
D3DTOP_MODULATEALPHA_ADDCOLOR, // Arg1.RGB + Arg1.A*Arg2.RGB
3796,6 → 6936,7
// COLOROP only
D3DTOP_MODULATEINVCOLOR_ADDALPHA, // (1-Arg1.RGB)*Arg2.RGB + Arg1.A
// COLOROP only
 
// Bump mapping
D3DTOP_BUMPENVMAP, // per pixel env map perturbation
D3DTOP_BUMPENVMAPLUMINANCE, // with luminance channel
3807,11 → 6948,10
D3DTOP_DOTPRODUCT3
);
 
D3DTEXTUREOP = TD3DTextureOp;
 
{ Values for COLORARG1,2 and ALPHAARG1,2 texture blending operations
set in texture processing stage controls in D3DRENDERSTATE. }
 
(*
* Values for COLORARG1,2 and ALPHAARG1,2 texture blending operations
* set in texture processing stage controls in D3DRENDERSTATE.
*)
const
D3DTA_SELECTMASK = $0000000f; // mask for arg selector
D3DTA_DIFFUSE = $00000000; // select diffuse color
3822,9 → 6962,11
D3DTA_COMPLEMENT = $00000010; // take 1.0 - x
D3DTA_ALPHAREPLICATE = $00000020; // replicate alpha to color components
 
{ IDirect3DTexture2 State Filter Types }
 
(*
* IDirect3DTexture2 State Filter Types
*)
type
PD3DTextureMagFilter = ^TD3DTextureMagFilter;
TD3DTextureMagFilter = (
D3DTFG_INVALID_0,
D3DTFG_POINT, // nearest
3834,8 → 6976,7
D3DTFG_ANISOTROPIC
);
 
D3DTEXTUREMAGFILTER = TD3DTextureMagFilter;
 
PD3DTextureMinFilter = ^TD3DTextureMinFilter;
TD3DTextureMinFilter = (
D3DTFN_INVALID_0,
D3DTFN_POINT, // nearest
3843,8 → 6984,7
D3DTFN_ANISOTROPIC
);
 
D3DTEXTUREMINFILTER = TD3DTextureMinFilter;
 
PD3DTextureMipFilter = ^TD3DTextureMipFilter;
TD3DTextureMipFilter = (
D3DTFP_INVALID_0,
D3DTFP_NONE, // mipmapping disabled (use MAG filter)
3852,37 → 6992,55
D3DTFP_LINEAR // linear interpolation
);
 
D3DTEXTUREMIPFILTER = TD3DTextureMipFilter;
 
{ Triangle flags }
(*
* Triangle flags
*)
 
(*
* Tri strip and fan flags.
* START loads all three vertices
* EVEN and ODD load just v3 with even or odd culling
* START_FLAT contains a count from 0 to 29 that allows the
* whole strip or fan to be culled in one hit.
* e.g. for a quad len = 1
*)
const
D3DTRIFLAG_START = $00000000;
// #define D3DTRIFLAG_STARTFLAT(len) (len) (* 0 < len < 30 *)
function D3DTRIFLAG_STARTFLAT(len: DWORD) : DWORD;
 
const
D3DTRIFLAG_ODD = $0000001e;
D3DTRIFLAG_EVEN = $0000001f;
 
function D3DTRIFLAG_STARTFLAT(len: DWORD): DWORD;
(*
* Triangle edge flags
* enable edges for wireframe or antialiasing
*)
D3DTRIFLAG_EDGEENABLE1 = $00000100; (* v0-v1 edge *)
D3DTRIFLAG_EDGEENABLE2 = $00000200; (* v1-v2 edge *)
D3DTRIFLAG_EDGEENABLE3 = $00000400; (* v2-v0 edge *)
D3DTRIFLAG_EDGEENABLETRIANGLE = (
D3DTRIFLAG_EDGEENABLE1 or D3DTRIFLAG_EDGEENABLE2 or D3DTRIFLAG_EDGEENABLE3);
 
{ Triangle edge flags }
(*
* Primitive structures and related defines. Vertex offsets are to types
* TD3DVertex, TD3DLVertex, or TD3DTLVertex.
*)
 
const
D3DTRIFLAG_EDGEENABLE1 = $00000100; // v0-v1 edge
D3DTRIFLAG_EDGEENABLE2 = $00000200; // v1-v2 edge
D3DTRIFLAG_EDGEENABLE3 = $00000400; // v2-v0 edge
D3DTRIFLAG_EDGEENABLETRIANGLE =
D3DTRIFLAG_EDGEENABLE1 or D3DTRIFLAG_EDGEENABLE2 or D3DTRIFLAG_EDGEENABLE3;
 
{ TD3DTriangle structure }
 
(*
* Triangle list primitive structure
*)
type
PD3DTriangle = ^TD3DTriangle;
TD3DTriangle = record
TD3DTriangle = packed record
case Integer of
0: (
v1: WORD; // Vertex indices
v1: WORD; (* Vertex indices *)
v2: WORD;
v3: WORD;
wFlags: WORD; // Edge (and other) flags
wFlags: WORD; (* Edge (and other) flags *)
);
1: (
wV1: WORD;
3891,16 → 7049,15
);
end;
 
D3DTRIANGLE = TD3DTriangle;
LPD3DTRIANGLE = PD3DTriangle;
 
{ TD3DLine structure }
 
(*
* Line strip structure.
* The instruction count - 1 defines the number of line segments.
*)
PD3DLine = ^TD3DLine;
TD3DLine = record
TD3DLine = packed record
case Integer of
0: (
v1: WORD; // Vertex indices
v1: WORD; (* Vertex indices *)
v2: WORD;
);
1: (
3909,86 → 7066,77
);
end;
 
D3DLINE = TD3DLine;
LPD3DLINE = PD3DLine;
 
{ TD3DSpan structure }
 
(*
* Span structure
* Spans join a list of points with the same y value.
* If the y value changes, a new span is started.
*)
PD3DSpan = ^TD3DSpan;
TD3DSpan = record
wCount: WORD; // Number of spans
wFirst: WORD; // Index to first vertex
TD3DSpan = packed record
wCount: WORD; (* Number of spans *)
wFirst: WORD; (* Index to first vertex *)
end;
 
D3DSPAN = TD3DSpan;
LPD3DSPAN = PD3DSpan;
 
{ TD3DPoint structure }
 
(*
* Point structure
*)
PD3DPoint = ^TD3DPoint;
TD3DPoint = record
wCount: WORD; // number of points
wFirst: WORD; // index to first vertex
TD3DPoint = packed record
wCount: WORD; (* number of points *)
wFirst: WORD; (* index to first vertex *)
end;
 
D3DPOINT = TD3DPoint;
LPD3DPOINT = PD3DPoint;
 
{ TD3DBranch structure }
 
(*
* Forward branch structure.
* Mask is logically anded with the driver status mask
* if the result equals 'value', the branch is taken.
*)
PD3DBranch = ^TD3DBranch;
TD3DBranch = record
dwMask: DWORD; // Bitmask against D3D status
TD3DBranch = packed record
dwMask: DWORD; (* Bitmask against D3D status *)
dwValue: DWORD;
bNegate: BOOL; // TRUE to negate comparison
dwOffset: DWORD; // How far to branch forward (0 for exit)
bNegate: BOOL; (* TRUE to negate comparison *)
dwOffset: DWORD; (* How far to branch forward (0 for exit)*)
end;
 
D3DBRANCH = TD3DBranch;
LPD3DBRANCH = PD3DBranch;
 
{ TD3DStatus structure }
 
(*
* Status used for set status instruction.
* The D3D status is initialised on device creation
* and is modified by all execute calls.
*)
PD3DStatus = ^TD3DStatus;
TD3DStatus = record
dwFlags: DWORD; // Do we set extents or status
dwStatus: DWORD; // D3D status
TD3DStatus = packed record
dwFlags: DWORD; (* Do we set extents or status *)
dwStatus: DWORD; (* D3D status *)
drExtent: TD3DRect;
end;
 
D3DSTATUS = TD3DStatus;
LPD3DSTATUS = PD3DStatus;
 
const
D3DSETSTATUS_STATUS = $00000001;
D3DSETSTATUS_EXTENTS = $00000002;
D3DSETSTATUS_ALL = D3DSETSTATUS_STATUS or D3DSETSTATUS_EXTENTS;
D3DSETSTATUS_ALL = (D3DSETSTATUS_STATUS or D3DSETSTATUS_EXTENTS);
 
{ TD3DClipStatus structure }
 
type
PD3DClipStatus = ^TD3DClipStatus;
TD3DClipStatus = record
dwFlags: DWORD; // Do we set 2d extents, 3D extents or status
dwStatus: DWORD; // Clip status
minx, maxx: Single; // X extents
miny, maxy: Single; // Y extents
minz, maxz: Single; // Z extents
TD3DClipStatus = packed record
dwFlags : DWORD; (* Do we set 2d extents, 3D extents or status *)
dwStatus : DWORD; (* Clip status *)
minx, maxx : float; (* X extents *)
miny, maxy : float; (* Y extents *)
minz, maxz : float; (* Z extents *)
end;
 
D3DCLIPSTATUS = TD3DClipStatus;
LPD3DCLIPSTATUS = PD3DClipStatus;
 
const
D3DCLIPSTATUS_STATUS = $00000001;
D3DCLIPSTATUS_EXTENTS2 = $00000002;
D3DCLIPSTATUS_EXTENTS3 = $00000004;
 
{ TD3DStats structure }
 
(*
* Statistics structure
*)
type
PD3DStats = ^TD3DStats;
TD3DStats = record
TD3DStats = packed record
dwSize: DWORD;
dwTrianglesDrawn: DWORD;
dwLinesDrawn: DWORD;
3997,20 → 7145,18
dwVerticesProcessed: DWORD;
end;
 
D3DSTATS = TD3DStats;
LPD3DSTATS = PD3DStats;
 
{ Execute options. }
 
(*
* Execute options.
* When calling using D3DEXECUTE_UNCLIPPED all the primitives
* inside the buffer must be contained within the viewport.
*)
const
D3DEXECUTE_CLIPPED = $00000001;
D3DEXECUTE_UNCLIPPED = $00000002;
 
{ TD3DExecuteData structure }
 
type
PD3DExecuteData = ^TD3DExecuteData;
TD3DExecuteData = record
TD3DExecuteData = packed record
dwSize: DWORD;
dwVertexOffset: DWORD;
dwVertexCount: DWORD;
4017,24 → 7163,23
dwInstructionOffset: DWORD;
dwInstructionLength: DWORD;
dwHVertexOffset: DWORD;
dsStatus: D3DSTATUS; // Status after execute
dsStatus: TD3DStatus; (* Status after execute *)
end;
 
D3DEXECUTEDATA = TD3DExecuteData;
LPD3DEXECUTEDATA = PD3DExecuteData;
(*
* Palette flags.
* This are or'ed with the peFlags in the PALETTEENTRYs passed to DirectDraw.
*)
 
{ Palette flags. }
 
const
D3DPAL_FREE = $00; // Renderer may use this entry freely
D3DPAL_READONLY = $40; // Renderer may not set this entry
D3DPAL_RESERVED = $80; // Renderer may not use this entry
D3DPAL_FREE = $00; (* Renderer may use this entry freely *)
D3DPAL_READONLY = $40; (* Renderer may not set this entry *)
D3DPAL_RESERVED = $80; (* Renderer may not use this entry *)
 
{ TD3DVertexBufferDesc structure }
 
type
PD3DVertexBufferDesc = ^TD3DVertexBufferDesc;
TD3DVertexBufferDesc = record
TD3DVertexBufferDesc = packed record
dwSize: DWORD;
dwCaps: DWORD;
dwFVF: DWORD;
4041,36 → 7186,35
dwNumVertices: DWORD;
end;
 
D3DVERTEXBUFFERDESC = TD3DVertexBufferDesc;
LPD3DVERTEXBUFFERDESC = PD3DVertexBufferDesc;
 
{ These correspond to DDSCAPS_* flags }
 
const
(* These correspond to DDSCAPS_* flags *)
D3DVBCAPS_SYSTEMMEMORY = $00000800;
D3DVBCAPS_WRITEONLY = $00010000;
D3DVBCAPS_OPTIMIZED = $80000000;
D3DVBCAPS_DONOTCLIP = $00000001;
 
{ Vertex Operations for ProcessVertices }
(* Vertex Operations for ProcessVertices *)
D3DVOP_LIGHT = (1 shl 10);
D3DVOP_TRANSFORM = (1 shl 0);
D3DVOP_CLIP = (1 shl 2);
D3DVOP_EXTENTS = (1 shl 3);
 
D3DVOP_LIGHT = 1 shl 10;
D3DVOP_TRANSFORM = 1 shl 0;
D3DVOP_CLIP = 1 shl 2;
D3DVOP_EXTENTS = 1 shl 3;
(* The maximum number of vertices user can pass to any d3d
drawing function or to create vertex buffer with
*)
D3DMAXNUMVERTICES = ((1 shl 16) - 1);
(* The maximum number of primitives user can pass to any d3d
drawing function.
*)
D3DMAXNUMPRIMITIVES = ((1 shl 16) - 1);
 
{ The maximum number of vertices user can pass to any d3d
drawing function or to create vertex buffer with }
D3DMAXNUMVERTICES = (1 shl 16)-1;
(* Bits for dwFlags in ProcessVertices call *)
D3DPV_DONOTCOPYDATA = (1 shl 0);
 
{ The maximum number of primitives user can pass to any d3d drawing function. }
D3DMAXNUMPRIMITIVES = (1 shl 16)-1;
//-------------------------------------------------------------------
 
{ Bits for dwFlags in ProcessVertices call }
D3DPV_DONOTCOPYDATA = 1 shl 0;
 
{ Flexible vertex format bits }
 
// Flexible vertex format bits
//
D3DFVF_RESERVED0 = $001;
D3DFVF_POSITION_MASK = $00E;
D3DFVF_XYZ = $002;
4080,10 → 7224,12
D3DFVF_XYZB3 = $00a;
D3DFVF_XYZB4 = $00c;
D3DFVF_XYZB5 = $00e;
 
D3DFVF_NORMAL = $010;
D3DFVF_RESERVED1 = $020;
D3DFVF_DIFFUSE = $040;
D3DFVF_SPECULAR = $080;
 
D3DFVF_TEXCOUNT_MASK = $f00;
D3DFVF_TEXCOUNT_SHIFT = 8;
D3DFVF_TEX0 = $000;
4096,30 → 7242,27
D3DFVF_TEX7 = $700;
D3DFVF_TEX8 = $800;
 
D3DFVF_RESERVED2 = $F000; // 4 reserved bits
D3DFVF_RESERVED2 = $f000; // 4 reserved bits
 
D3DFVF_VERTEX = D3DFVF_XYZ or D3DFVF_NORMAL or D3DFVF_TEX1;
D3DFVF_LVERTEX = D3DFVF_XYZ or D3DFVF_RESERVED1 or D3DFVF_DIFFUSE or
D3DFVF_SPECULAR or D3DFVF_TEX1;
D3DFVF_TLVERTEX = D3DFVF_XYZRHW or D3DFVF_DIFFUSE or D3DFVF_SPECULAR or
D3DFVF_TEX1;
D3DFVF_VERTEX = ( D3DFVF_XYZ or D3DFVF_NORMAL or D3DFVF_TEX1 );
D3DFVF_LVERTEX = ( D3DFVF_XYZ or D3DFVF_RESERVED1 or D3DFVF_DIFFUSE or
D3DFVF_SPECULAR or D3DFVF_TEX1 );
D3DFVF_TLVERTEX = ( D3DFVF_XYZRHW or D3DFVF_DIFFUSE or D3DFVF_SPECULAR or
D3DFVF_TEX1 );
 
{ TD3DDP_PtrStride }
 
type
TD3DDP_PtrStride = record
lpvData: Pointer;
PD3DDP_PtrStride = ^TD3DDP_PtrStride;
TD3DDP_PtrStride = packed record
lpvData : pointer;
dwStride: DWORD;
end;
 
D3DDP_PTRSTRIDE = TD3DDP_PtrStride;
 
const
D3DDP_MAXTEXCOORD = 8;
 
type
PD3DDrawPrimitiveStridedData = ^TD3DDrawPrimitiveStridedData;
TD3DDrawPrimitiveStridedData = record
TD3DDrawPrimitiveStridedData = packed record
position: TD3DDP_PtrStride;
normal: TD3DDP_PtrStride;
diffuse: TD3DDP_PtrStride;
4127,62 → 7270,57
textureCoords: array[0..D3DDP_MAXTEXCOORD-1] of TD3DDP_PtrStride;
end;
 
D3DDRAWPRIMITIVESTRIDEDDATA = TD3DDrawPrimitiveStridedData;
LPD3DDRAWPRIMITIVESTRIDEDDATA = PD3DDrawPrimitiveStridedData;
 
{ ComputeSphereVisibility return values }
 
//---------------------------------------------------------------------
// ComputeSphereVisibility return values
//
const
D3DVIS_INSIDE_FRUSTUM = 0;
D3DVIS_INTERSECT_FRUSTUM = 1;
D3DVIS_OUTSIDE_FRUSTUM = 2;
D3DVIS_INSIDE_LEFT = 0;
D3DVIS_INTERSECT_LEFT = 1 shl 2;
D3DVIS_OUTSIDE_LEFT = 2 shl 2;
D3DVIS_INTERSECT_LEFT = (1 shl 2);
D3DVIS_OUTSIDE_LEFT = (2 shl 2);
D3DVIS_INSIDE_RIGHT = 0;
D3DVIS_INTERSECT_RIGHT = 1 shl 4;
D3DVIS_OUTSIDE_RIGHT = 2 shl 4;
D3DVIS_INTERSECT_RIGHT = (1 shl 4);
D3DVIS_OUTSIDE_RIGHT = (2 shl 4);
D3DVIS_INSIDE_TOP = 0;
D3DVIS_INTERSECT_TOP = 1 shl 6;
D3DVIS_OUTSIDE_TOP = 2 shl 6;
D3DVIS_INTERSECT_TOP = (1 shl 6);
D3DVIS_OUTSIDE_TOP = (2 shl 6);
D3DVIS_INSIDE_BOTTOM = 0;
D3DVIS_INTERSECT_BOTTOM = 1 shl 8;
D3DVIS_OUTSIDE_BOTTOM = 2 shl 8;
D3DVIS_INTERSECT_BOTTOM = (1 shl 8);
D3DVIS_OUTSIDE_BOTTOM = (2 shl 8);
D3DVIS_INSIDE_NEAR = 0;
D3DVIS_INTERSECT_NEAR = 1 shl 10;
D3DVIS_OUTSIDE_NEAR = 2 shl 10;
D3DVIS_INTERSECT_NEAR = (1 shl 10);
D3DVIS_OUTSIDE_NEAR = (2 shl 10);
D3DVIS_INSIDE_FAR = 0;
D3DVIS_INTERSECT_FAR = 1 shl 12;
D3DVIS_OUTSIDE_FAR = 2 shl 12;
D3DVIS_INTERSECT_FAR = (1 shl 12);
D3DVIS_OUTSIDE_FAR = (2 shl 12);
 
D3DVIS_MASK_FRUSTUM = 3 shl 0;
D3DVIS_MASK_LEFT = 3 shl 2;
D3DVIS_MASK_RIGHT = 3 shl 4;
D3DVIS_MASK_TOP = 3 shl 6;
D3DVIS_MASK_BOTTOM = 3 shl 8;
D3DVIS_MASK_NEAR = 3 shl 10;
D3DVIS_MASK_FAR = 3 shl 12;
D3DVIS_MASK_FRUSTUM = (3 shl 0);
D3DVIS_MASK_LEFT = (3 shl 2);
D3DVIS_MASK_RIGHT = (3 shl 4);
D3DVIS_MASK_TOP = (3 shl 6);
D3DVIS_MASK_BOTTOM = (3 shl 8);
D3DVIS_MASK_NEAR = (3 shl 10);
D3DVIS_MASK_FAR = (3 shl 12);
 
{ To be used with GetInfo() }
 
// To be used with GetInfo()
D3DDEVINFOID_TEXTUREMANAGER = 1;
D3DDEVINFOID_D3DTEXTUREMANAGER = 2;
D3DDEVINFOID_TEXTURING = 3;
 
type
 
{ TD3DStateBlockType }
 
PD3DStateBlockType = ^TD3DStateBlockType;
TD3DStateBlockType = (
D3DBST_INVALID_0,
D3DSBT_INVALID_0 ,
D3DSBT_ALL , // capture all state
D3DSBT_PIXELSTATE, // capture pixel state
D3DSBT_VERTEXSTATE // capture vertex state
);
 
D3DSTATEBLOCKTYPE = TD3DStateBlockType;
 
{ TD3DVertexBlendFlags }
 
// The D3DVERTEXBLENDFLAGS type is used with D3DRENDERSTATE_VERTEXBLEND state.
//
PD3DVertexBlendFlags = ^TD3DVertexBlendFlags;
TD3DVertexBlendFlags = (
D3DVBLEND_DISABLE, // Disable vertex blending
D3DVBLEND_1WEIGHT, // blend between 2 matrices
4190,273 → 7328,20
D3DVBLEND_3WEIGHTS // blend between 4 matrices
);
 
D3DVERTEXBLENDFLAGS = TD3DVertexBlendFlags;
 
{ TD3DTextureTransformFlags }
 
PD3DTextureTransformFlags = ^TD3DTextureTransformFlags;
TD3DTextureTransformFlags = (
D3DTTFF_DISABLE, // texture coordinates are passed directly
D3DTTFF_COUNT1, // rasterizer should expect 1-D texture coords
D3DTTFF_COUNT2, // rasterizer should expect 2-D texture coords
D3DTTFF_COUNT3, // rasterizer should expect 3-D texture coords
D3DTTFF_COUNT4, // rasterizer should expect 4-D texture coords
D3DTIFF_INVALID_5,
D3DTIFF_INVALID_6,
D3DTIFF_INVALID_7,
D3DTIFF_INVALID_8,
D3DTIFF_INVALID_9,
D3DTIFF_INVALID_10,
D3DTIFF_INVALID_11,
D3DTIFF_INVALID_12,
D3DTIFF_INVALID_13,
D3DTIFF_INVALID_14,
D3DTIFF_INVALID_15,
D3DTIFF_INVALID_16,
D3DTIFF_INVALID_17,
D3DTIFF_INVALID_18,
D3DTIFF_INVALID_19,
D3DTIFF_INVALID_20,
D3DTIFF_INVALID_21,
D3DTIFF_INVALID_22,
D3DTIFF_INVALID_23,
D3DTIFF_INVALID_24,
D3DTIFF_INVALID_25,
D3DTIFF_INVALID_26,
D3DTIFF_INVALID_27,
D3DTIFF_INVALID_28,
D3DTIFF_INVALID_29,
D3DTIFF_INVALID_30,
D3DTIFF_INVALID_31,
D3DTIFF_INVALID_32,
D3DTIFF_INVALID_33,
D3DTIFF_INVALID_34,
D3DTIFF_INVALID_35,
D3DTIFF_INVALID_36,
D3DTIFF_INVALID_37,
D3DTIFF_INVALID_38,
D3DTIFF_INVALID_39,
D3DTIFF_INVALID_40,
D3DTIFF_INVALID_41,
D3DTIFF_INVALID_42,
D3DTIFF_INVALID_43,
D3DTIFF_INVALID_44,
D3DTIFF_INVALID_45,
D3DTIFF_INVALID_46,
D3DTIFF_INVALID_47,
D3DTIFF_INVALID_48,
D3DTIFF_INVALID_49,
D3DTIFF_INVALID_50,
D3DTIFF_INVALID_51,
D3DTIFF_INVALID_52,
D3DTIFF_INVALID_53,
D3DTIFF_INVALID_54,
D3DTIFF_INVALID_55,
D3DTIFF_INVALID_56,
D3DTIFF_INVALID_57,
D3DTIFF_INVALID_58,
D3DTIFF_INVALID_59,
D3DTIFF_INVALID_60,
D3DTIFF_INVALID_61,
D3DTIFF_INVALID_62,
D3DTIFF_INVALID_63,
D3DTIFF_INVALID_64,
D3DTIFF_INVALID_65,
D3DTIFF_INVALID_66,
D3DTIFF_INVALID_67,
D3DTIFF_INVALID_68,
D3DTIFF_INVALID_69,
D3DTIFF_INVALID_70,
D3DTIFF_INVALID_71,
D3DTIFF_INVALID_72,
D3DTIFF_INVALID_73,
D3DTIFF_INVALID_74,
D3DTIFF_INVALID_75,
D3DTIFF_INVALID_76,
D3DTIFF_INVALID_77,
D3DTIFF_INVALID_78,
D3DTIFF_INVALID_79,
D3DTIFF_INVALID_80,
D3DTIFF_INVALID_81,
D3DTIFF_INVALID_82,
D3DTIFF_INVALID_83,
D3DTIFF_INVALID_84,
D3DTIFF_INVALID_85,
D3DTIFF_INVALID_86,
D3DTIFF_INVALID_87,
D3DTIFF_INVALID_88,
D3DTIFF_INVALID_89,
D3DTIFF_INVALID_90,
D3DTIFF_INVALID_91,
D3DTIFF_INVALID_92,
D3DTIFF_INVALID_93,
D3DTIFF_INVALID_94,
D3DTIFF_INVALID_95,
D3DTIFF_INVALID_96,
D3DTIFF_INVALID_97,
D3DTIFF_INVALID_98,
D3DTIFF_INVALID_99,
D3DTIFF_INVALID_100,
D3DTIFF_INVALID_101,
D3DTIFF_INVALID_102,
D3DTIFF_INVALID_103,
D3DTIFF_INVALID_104,
D3DTIFF_INVALID_105,
D3DTIFF_INVALID_106,
D3DTIFF_INVALID_107,
D3DTIFF_INVALID_108,
D3DTIFF_INVALID_109,
D3DTIFF_INVALID_110,
D3DTIFF_INVALID_111,
D3DTIFF_INVALID_112,
D3DTIFF_INVALID_113,
D3DTIFF_INVALID_114,
D3DTIFF_INVALID_115,
D3DTIFF_INVALID_116,
D3DTIFF_INVALID_117,
D3DTIFF_INVALID_118,
D3DTIFF_INVALID_119,
D3DTIFF_INVALID_120,
D3DTIFF_INVALID_121,
D3DTIFF_INVALID_122,
D3DTIFF_INVALID_123,
D3DTIFF_INVALID_124,
D3DTIFF_INVALID_125,
D3DTIFF_INVALID_126,
D3DTIFF_INVALID_127,
D3DTIFF_INVALID_128,
D3DTIFF_INVALID_129,
D3DTIFF_INVALID_130,
D3DTIFF_INVALID_131,
D3DTIFF_INVALID_132,
D3DTIFF_INVALID_133,
D3DTIFF_INVALID_134,
D3DTIFF_INVALID_135,
D3DTIFF_INVALID_136,
D3DTIFF_INVALID_137,
D3DTIFF_INVALID_138,
D3DTIFF_INVALID_139,
D3DTIFF_INVALID_140,
D3DTIFF_INVALID_141,
D3DTIFF_INVALID_142,
D3DTIFF_INVALID_143,
D3DTIFF_INVALID_144,
D3DTIFF_INVALID_145,
D3DTIFF_INVALID_146,
D3DTIFF_INVALID_147,
D3DTIFF_INVALID_148,
D3DTIFF_INVALID_149,
D3DTIFF_INVALID_150,
D3DTIFF_INVALID_151,
D3DTIFF_INVALID_152,
D3DTIFF_INVALID_153,
D3DTIFF_INVALID_154,
D3DTIFF_INVALID_155,
D3DTIFF_INVALID_156,
D3DTIFF_INVALID_157,
D3DTIFF_INVALID_158,
D3DTIFF_INVALID_159,
D3DTIFF_INVALID_160,
D3DTIFF_INVALID_161,
D3DTIFF_INVALID_162,
D3DTIFF_INVALID_163,
D3DTIFF_INVALID_164,
D3DTIFF_INVALID_165,
D3DTIFF_INVALID_166,
D3DTIFF_INVALID_167,
D3DTIFF_INVALID_168,
D3DTIFF_INVALID_169,
D3DTIFF_INVALID_170,
D3DTIFF_INVALID_171,
D3DTIFF_INVALID_172,
D3DTIFF_INVALID_173,
D3DTIFF_INVALID_174,
D3DTIFF_INVALID_175,
D3DTIFF_INVALID_176,
D3DTIFF_INVALID_177,
D3DTIFF_INVALID_178,
D3DTIFF_INVALID_179,
D3DTIFF_INVALID_180,
D3DTIFF_INVALID_181,
D3DTIFF_INVALID_182,
D3DTIFF_INVALID_183,
D3DTIFF_INVALID_184,
D3DTIFF_INVALID_185,
D3DTIFF_INVALID_186,
D3DTIFF_INVALID_187,
D3DTIFF_INVALID_188,
D3DTIFF_INVALID_189,
D3DTIFF_INVALID_190,
D3DTIFF_INVALID_191,
D3DTIFF_INVALID_192,
D3DTIFF_INVALID_193,
D3DTIFF_INVALID_194,
D3DTIFF_INVALID_195,
D3DTIFF_INVALID_196,
D3DTIFF_INVALID_197,
D3DTIFF_INVALID_198,
D3DTIFF_INVALID_199,
D3DTIFF_INVALID_200,
D3DTIFF_INVALID_201,
D3DTIFF_INVALID_202,
D3DTIFF_INVALID_203,
D3DTIFF_INVALID_204,
D3DTIFF_INVALID_205,
D3DTIFF_INVALID_206,
D3DTIFF_INVALID_207,
D3DTIFF_INVALID_208,
D3DTIFF_INVALID_209,
D3DTIFF_INVALID_210,
D3DTIFF_INVALID_211,
D3DTIFF_INVALID_212,
D3DTIFF_INVALID_213,
D3DTIFF_INVALID_214,
D3DTIFF_INVALID_215,
D3DTIFF_INVALID_216,
D3DTIFF_INVALID_217,
D3DTIFF_INVALID_218,
D3DTIFF_INVALID_219,
D3DTIFF_INVALID_220,
D3DTIFF_INVALID_221,
D3DTIFF_INVALID_222,
D3DTIFF_INVALID_223,
D3DTIFF_INVALID_224,
D3DTIFF_INVALID_225,
D3DTIFF_INVALID_226,
D3DTIFF_INVALID_227,
D3DTIFF_INVALID_228,
D3DTIFF_INVALID_229,
D3DTIFF_INVALID_230,
D3DTIFF_INVALID_231,
D3DTIFF_INVALID_232,
D3DTIFF_INVALID_233,
D3DTIFF_INVALID_234,
D3DTIFF_INVALID_235,
D3DTIFF_INVALID_236,
D3DTIFF_INVALID_237,
D3DTIFF_INVALID_238,
D3DTIFF_INVALID_239,
D3DTIFF_INVALID_240,
D3DTIFF_INVALID_241,
D3DTIFF_INVALID_242,
D3DTIFF_INVALID_243,
D3DTIFF_INVALID_244,
D3DTIFF_INVALID_245,
D3DTIFF_INVALID_246,
D3DTIFF_INVALID_247,
D3DTIFF_INVALID_248,
D3DTIFF_INVALID_249,
D3DTIFF_INVALID_250,
D3DTIFF_INVALID_251,
D3DTIFF_INVALID_252,
D3DTIFF_INVALID_253,
D3DTIFF_INVALID_254,
D3DTIFF_INVALID_255,
D3DTTFF_PROJECTED // texcoords to be divided by COUNTth element
D3DTTFF_COUNT4 // rasterizer should expect 4-D texture coords
);
 
{ Macros to set texture coordinate format bits in the FVF id }
const
D3DTTFF_PROJECTED = TD3DTextureTransformFlags(256); // texcoords to be divided by COUNTth element
 
const
// Macros to set texture coordinate format bits in the FVF id
 
D3DFVF_TEXTUREFORMAT2 = 0; // Two floating point values
D3DFVF_TEXTUREFORMAT1 = 3; // One floating point value
D3DFVF_TEXTUREFORMAT3 = 1; // Three floating point values
4469,7 → 7354,6
 
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3dcaps.h
* Content: Direct3D capabilities include file
4476,52 → 7360,46
*
***************************************************************************)
 
{ Description of capabilities of transform }
(* Description of capabilities of transform *)
 
type
PD3DTransformCaps = ^TD3DTransformCaps;
TD3DTransformCaps = record
TD3DTransformCaps = packed record
dwSize: DWORD;
dwCaps: DWORD;
end;
 
D3DTRANSFORMCAPS = TD3DTransformCaps;
LPD3DTRANSFORMCAPS = PD3DTransformCaps;
 
const
D3DTRANSFORMCAPS_CLIP = $00000001; // Will clip whilst transforming
D3DTRANSFORMCAPS_CLIP = $00000001; (* Will clip whilst transforming *)
 
{ Description of capabilities of lighting }
(* Description of capabilities of lighting *)
 
type
PD3DLightingCaps = ^TD3DLightingCaps;
TD3DLightingCaps = record
TD3DLightingCaps = packed record
dwSize: DWORD;
dwCaps: DWORD; // Lighting caps
dwLightingModel: DWORD; // Lighting model - RGB or mono
dwNumLights: DWORD; // Number of lights that can be handled
dwCaps: DWORD; (* Lighting caps *)
dwLightingModel: DWORD; (* Lighting model - RGB or mono *)
dwNumLights: DWORD; (* Number of lights that can be handled *)
end;
 
D3DLIGHTINGCAPS = TD3DLightingCaps;
LPD3DLIGHTINGCAPS = PD3DLightingCaps;
 
const
D3DLIGHTINGMODEL_RGB = $00000001;
D3DLIGHTINGMODEL_MONO = $00000002;
 
D3DLIGHTCAPS_POINT = $00000001; // Point lights supported
D3DLIGHTCAPS_SPOT = $00000002; // Spot lights supported
D3DLIGHTCAPS_DIRECTIONAL = $00000004; // Directional lights supported
D3DLIGHTCAPS_PARALLELPOINT = $00000008; // Parallel point lights supported
D3DLIGHTCAPS_GLSPOT = $00000010; // GL syle spot lights supported
D3DLIGHTCAPS_POINT = $00000001; (* Point lights supported *)
D3DLIGHTCAPS_SPOT = $00000002; (* Spot lights supported *)
D3DLIGHTCAPS_DIRECTIONAL = $00000004; (* Directional lights supported *)
D3DLIGHTCAPS_PARALLELPOINT = $00000008; (* Parallel point lights supported *)
D3DLIGHTCAPS_GLSPOT = $00000010; (* GL syle spot lights supported *)
 
{ Description of capabilities for each primitive type }
(* Description of capabilities for each primitive type *)
 
type
PD3DPrimCaps = ^TD3DPrimCaps;
TD3DPrimCaps = record
TD3DPrimCaps = packed record
dwSize: DWORD;
dwMiscCaps: DWORD; // Capability flags
dwMiscCaps: DWORD; (* Capability flags *)
dwRasterCaps: DWORD;
dwZCmpCaps: DWORD;
dwSrcBlendCaps: DWORD;
4532,16 → 7410,13
dwTextureFilterCaps: DWORD;
dwTextureBlendCaps: DWORD;
dwTextureAddressCaps: DWORD;
dwStippleWidth: DWORD; // maximum width and height of
dwStippleHeight: DWORD; // of supported stipple (up to 32x32)
dwStippleWidth: DWORD; (* maximum width and height of *)
dwStippleHeight: DWORD; (* of supported stipple (up to 32x32) *)
end;
 
D3DPRIMCAPS = TD3DPrimCaps;
LPD3DPRIMCAPS = PD3DPrimCaps;
const
(* TD3DPrimCaps dwMiscCaps *)
 
{ TD3DPrimCaps dwMiscCaps }
 
const
D3DPMISCCAPS_MASKPLANES = $00000001;
D3DPMISCCAPS_MASKZ = $00000002;
D3DPMISCCAPS_LINEPATTERNREP = $00000004;
4550,7 → 7425,7
D3DPMISCCAPS_CULLCW = $00000020;
D3DPMISCCAPS_CULLCCW = $00000040;
 
{ TD3DPrimCaps dwRasterCaps }
(* TD3DPrimCaps dwRasterCaps *)
 
D3DPRASTERCAPS_DITHER = $00000001;
D3DPRASTERCAPS_ROP2 = $00000002;
4575,8 → 7450,9
D3DPRASTERCAPS_WFOG = $00100000;
D3DPRASTERCAPS_ZFOG = $00200000;
 
{ TD3DPrimCaps dwZCmpCaps, dwAlphaCmpCaps }
(* TD3DPrimCaps dwZCmpCaps, dwAlphaCmpCaps *)
 
const
D3DPCMPCAPS_NEVER = $00000001;
D3DPCMPCAPS_LESS = $00000002;
D3DPCMPCAPS_EQUAL = $00000004;
4586,7 → 7462,7
D3DPCMPCAPS_GREATEREQUAL = $00000040;
D3DPCMPCAPS_ALWAYS = $00000080;
 
{ TD3DPrimCaps dwSourceBlendCaps, dwDestBlendCaps }
(* TD3DPrimCaps dwSourceBlendCaps, dwDestBlendCaps *)
 
D3DPBLENDCAPS_ZERO = $00000001;
D3DPBLENDCAPS_ONE = $00000002;
4602,7 → 7478,7
D3DPBLENDCAPS_BOTHSRCALPHA = $00000800;
D3DPBLENDCAPS_BOTHINVSRCALPHA = $00001000;
 
{ TD3DPrimCaps dwShadeCaps }
(* TD3DPrimCaps dwShadeCaps *)
 
D3DPSHADECAPS_COLORFLATMONO = $00000001;
D3DPSHADECAPS_COLORFLATRGB = $00000002;
4629,23 → 7505,75
D3DPSHADECAPS_FOGGOURAUD = $00080000;
D3DPSHADECAPS_FOGPHONG = $00100000;
 
{ TD3DPrimCaps dwTextureCaps }
(* TD3DPrimCaps dwTextureCaps *)
 
(*
* Perspective-correct texturing is supported
*)
D3DPTEXTURECAPS_PERSPECTIVE = $00000001;
 
(*
* Power-of-2 texture dimensions are required
*)
D3DPTEXTURECAPS_POW2 = $00000002;
 
(*
* Alpha in texture pixels is supported
*)
D3DPTEXTURECAPS_ALPHA = $00000004;
 
(*
* Color-keyed textures are supported
*)
D3DPTEXTURECAPS_TRANSPARENCY = $00000008;
 
(*
* obsolete, see D3DPTADDRESSCAPS_BORDER
*)
D3DPTEXTURECAPS_BORDER = $00000010;
 
(*
* Only square textures are supported
*)
D3DPTEXTURECAPS_SQUAREONLY = $00000020;
 
(*
* Texture indices are not scaled by the texture size prior
* to interpolation.
*)
D3DPTEXTURECAPS_TEXREPEATNOTSCALEDBYSIZE = $00000040;
 
(*
* Device can draw alpha from texture palettes
*)
D3DPTEXTURECAPS_ALPHAPALETTE = $00000080;
 
(*
* Device can use non-POW2 textures if:
* 1) D3DTEXTURE_ADDRESS is set to CLAMP for this texture's stage
* 2) D3DRS_WRAP(N) is zero for this texture's coordinates
* 3) mip mapping is not enabled (use magnification filter only)
*)
D3DPTEXTURECAPS_NONPOW2CONDITIONAL = $00000100;
 
// 0x00000200L unused
 
(*
* Device can divide transformed texture coordinates by the
* COUNTth texture coordinate (can do D3DTTFF_PROJECTED)
*)
D3DPTEXTURECAPS_PROJECTED = $00000400;
 
(*
* Device can do cubemap textures
*)
D3DPTEXTURECAPS_CUBEMAP = $00000800;
 
D3DPTEXTURECAPS_COLORKEYBLEND = $00001000;
 
{ TD3DPrimCaps dwTextureFilterCaps }
 
(* TD3DPrimCaps dwTextureFilterCaps *)
 
D3DPTFILTERCAPS_NEAREST = $00000001;
D3DPTFILTERCAPS_LINEAR = $00000002;
D3DPTFILTERCAPS_MIPNEAREST = $00000004;
4653,19 → 7581,16
D3DPTFILTERCAPS_LINEARMIPNEAREST = $00000010;
D3DPTFILTERCAPS_LINEARMIPLINEAR = $00000020;
 
{ Device3 Min Filter }
 
(* Device3 Min Filter *)
D3DPTFILTERCAPS_MINFPOINT = $00000100;
D3DPTFILTERCAPS_MINFLINEAR = $00000200;
D3DPTFILTERCAPS_MINFANISOTROPIC = $00000400;
 
{ Device3 Mip Filter }
 
(* Device3 Mip Filter *)
D3DPTFILTERCAPS_MIPFPOINT = $00010000;
D3DPTFILTERCAPS_MIPFLINEAR = $00020000;
 
{ Device3 Mag Filter }
 
(* Device3 Mag Filter *)
D3DPTFILTERCAPS_MAGFPOINT = $01000000;
D3DPTFILTERCAPS_MAGFLINEAR = $02000000;
D3DPTFILTERCAPS_MAGFANISOTROPIC = $04000000;
4672,7 → 7597,7
D3DPTFILTERCAPS_MAGFAFLATCUBIC = $08000000;
D3DPTFILTERCAPS_MAGFGAUSSIANCUBIC = $10000000;
 
{ TD3DPrimCaps dwTextureBlendCaps }
(* TD3DPrimCaps dwTextureBlendCaps *)
 
D3DPTBLENDCAPS_DECAL = $00000001;
D3DPTBLENDCAPS_MODULATE = $00000002;
4683,8 → 7608,7
D3DPTBLENDCAPS_COPY = $00000040;
D3DPTBLENDCAPS_ADD = $00000080;
 
{ TD3DPrimCaps dwTextureAddressCaps }
 
(* TD3DPrimCaps dwTextureAddressCaps *)
D3DPTADDRESSCAPS_WRAP = $00000001;
D3DPTADDRESSCAPS_MIRROR = $00000002;
D3DPTADDRESSCAPS_CLAMP = $00000004;
4691,7 → 7615,7
D3DPTADDRESSCAPS_BORDER = $00000008;
D3DPTADDRESSCAPS_INDEPENDENTUV = $00000010;
 
{ D3DDEVICEDESC dwStencilCaps }
(* D3DDEVICEDESC dwStencilCaps *)
 
D3DSTENCILCAPS_KEEP = $00000001;
D3DSTENCILCAPS_ZERO = $00000002;
4702,7 → 7626,7
D3DSTENCILCAPS_INCR = $00000040;
D3DSTENCILCAPS_DECR = $00000080;
 
{ D3DDEVICEDESC dwTextureOpCaps }
(* D3DDEVICEDESC dwTextureOpCaps *)
 
D3DTEXOPCAPS_DISABLE = $00000001;
D3DTEXOPCAPS_SELECTARG1 = $00000002;
4729,77 → 7653,41
D3DTEXOPCAPS_BUMPENVMAPLUMINANCE = $00400000;
D3DTEXOPCAPS_DOTPRODUCT3 = $00800000;
 
{ D3DDEVICEDESC dwFVFCaps flags }
(* D3DDEVICEDESC dwFVFCaps flags *)
 
D3DFVFCAPS_TEXCOORDCOUNTMASK = $0000ffff; // mask for texture coordinate count field
D3DFVFCAPS_DONOTSTRIPELEMENTS = $00080000; // Device prefers that vertex elements not be stripped
D3DFVFCAPS_TEXCOORDCOUNTMASK = $0000ffff; (* mask for texture coordinate count field *)
D3DFVFCAPS_DONOTSTRIPELEMENTS = $00080000; (* Device prefers that vertex elements not be stripped *)
 
{ Description for a device. }
(*
* Description for a device.
* This is used to describe a device that is to be created or to query
* the current device.
*)
 
type
PD3DDeviceDesc_DX3 = ^TD3DDeviceDesc_DX3;
TD3DDeviceDesc_DX3 = record
dwSize: DWORD; // Size of D3DDEVICEDESC structure
dwFlags: DWORD; // Indicates which fields have valid data
dcmColorModel: TD3DColorModel; // Color model of device
dwDevCaps: DWORD; // Capabilities of device
dtcTransformCaps: TD3DTransformCaps; // Capabilities of transform
bClipping: BOOL; // Device can do 3D clipping
dlcLightingCaps: TD3DLightingCaps; // Capabilities of lighting
PD3DDeviceDesc = ^TD3DDeviceDesc;
TD3DDeviceDesc = packed record
dwSize: DWORD; (* Size of TD3DDeviceDesc structure *)
dwFlags: DWORD; (* Indicates which fields have valid data *)
dcmColorModel: TD3DColorModel; (* Color model of device *)
dwDevCaps: DWORD; (* Capabilities of device *)
dtcTransformCaps: TD3DTransformCaps; (* Capabilities of transform *)
bClipping: BOOL; (* Device can do 3D clipping *)
dlcLightingCaps: TD3DLightingCaps; (* Capabilities of lighting *)
dpcLineCaps: TD3DPrimCaps;
dpcTriCaps: TD3DPrimCaps;
dwDeviceRenderBitDepth: DWORD; // One of DDBB_8, 16, etc..
dwDeviceZBufferBitDepth: DWORD; // One of DDBD_16, 32, etc..
dwMaxBufferSize: DWORD; // Maximum execute buffer size
dwMaxVertexCount: DWORD; // Maximum vertex count
end;
dwDeviceRenderBitDepth: DWORD; (* One of DDBB_8, 16, etc.. *)
dwDeviceZBufferBitDepth: DWORD; (* One of DDBD_16, 32, etc.. *)
dwMaxBufferSize: DWORD; (* Maximum execute buffer size *)
dwMaxVertexCount: DWORD; (* Maximum vertex count *)
// *** New fields for DX5 *** //
 
PD3DDeviceDesc_DX5 = ^TD3DDeviceDesc_DX5;
TD3DDeviceDesc_DX5 = record
dwSize: DWORD; // Size of D3DDEVICEDESC structure
dwFlags: DWORD; // Indicates which fields have valid data
dcmColorModel: TD3DColorModel; // Color model of device
dwDevCaps: DWORD; // Capabilities of device
dtcTransformCaps: TD3DTransformCaps; // Capabilities of transform
bClipping: BOOL; // Device can do 3D clipping
dlcLightingCaps: TD3DLightingCaps; // Capabilities of lighting
dpcLineCaps: TD3DPrimCaps;
dpcTriCaps: TD3DPrimCaps;
dwDeviceRenderBitDepth: DWORD; // One of DDBB_8, 16, etc..
dwDeviceZBufferBitDepth: DWORD; // One of DDBD_16, 32, etc..
dwMaxBufferSize: DWORD; // Maximum execute buffer size
dwMaxVertexCount: DWORD; // Maximum vertex count
// New fields for DX5
// Width and height caps are 0 for legacy HALs.
dwMinTextureWidth, dwMinTextureHeight : DWORD;
dwMaxTextureWidth, dwMaxTextureHeight : DWORD;
dwMinStippleWidth, dwMaxStippleWidth : DWORD;
dwMinStippleHeight, dwMaxStippleHeight : DWORD;
end;
 
PD3DDeviceDesc_DX6 = ^TD3DDeviceDesc_DX6;
TD3DDeviceDesc_DX6 = record
dwSize: DWORD; // Size of D3DDEVICEDESC structure
dwFlags: DWORD; // Indicates which fields have valid data
dcmColorModel: TD3DColorModel; // Color model of device
dwDevCaps: DWORD; // Capabilities of device
dtcTransformCaps: TD3DTransformCaps; // Capabilities of transform
bClipping: BOOL; // Device can do 3D clipping
dlcLightingCaps: TD3DLightingCaps; // Capabilities of lighting
dpcLineCaps: TD3DPrimCaps;
dpcTriCaps: TD3DPrimCaps;
dwDeviceRenderBitDepth: DWORD; // One of DDBB_8, 16, etc..
dwDeviceZBufferBitDepth: DWORD; // One of DDBD_16, 32, etc..
dwMaxBufferSize: DWORD; // Maximum execute buffer size
dwMaxVertexCount: DWORD; // Maximum vertex count
 
// New fields for DX5
// Width and height caps are 0 for legacy HALs.
dwMinTextureWidth, dwMinTextureHeight : DWORD;
dwMaxTextureWidth, dwMaxTextureHeight : DWORD;
dwMinStippleWidth, dwMaxStippleWidth : DWORD;
dwMinStippleHeight, dwMaxStippleHeight : DWORD;
 
// New fields for DX6
dwMaxTextureRepeat: DWORD;
dwMaxTextureAspectRatio: DWORD;
4812,43 → 7700,26
dvGuardBandTop: TD3DValue;
dvGuardBandRight: TD3DValue;
dvGuardBandBottom: TD3DValue;
 
dvExtentsAdjust: TD3DValue;
dwStencilCaps: DWORD;
dwFVFCaps: DWORD; // low 4 bits: 0 implies TLVERTEX only, 1..8 imply FVF aware
 
dwFVFCaps : DWORD; (* low 4 bits: 0 implies TLVERTEX only, 1..8 imply FVF aware *)
dwTextureOpCaps: DWORD;
wMaxTextureBlendStages: Word;
wMaxSimultaneousTextures: Word;
wMaxTextureBlendStages : WORD;
wMaxSimultaneousTextures : WORD;
end;
 
{$IFDEF DirectX3}
TD3DDeviceDesc = TD3DDeviceDesc_DX3;
PD3DDeviceDesc = PD3DDeviceDesc_DX3;
{$ENDIF}{$IFDEF DirectX5}
TD3DDeviceDesc = TD3DDeviceDesc_DX5;
PD3DDeviceDesc = PD3DDeviceDesc_DX5;
{$ENDIF}{$IFDEF DirectX6}
TD3DDeviceDesc = TD3DDeviceDesc_DX6;
PD3DDeviceDesc = PD3DDeviceDesc_DX6;
{$ENDIF}{$IFDEF DirectX7}
TD3DDeviceDesc = TD3DDeviceDesc_DX6;
PD3DDeviceDesc = PD3DDeviceDesc_DX6;
{$ENDIF}
 
D3DDEVICEDESC = TD3DDeviceDesc;
LPD3DDEVICEDESC = PD3DDeviceDesc;
 
PD3DDeviceDesc7 = ^TD3DDeviceDesc7;
TD3DDeviceDesc7 = record
dwDevCaps: DWORD;
TD3DDeviceDesc7 = packed record
dwDevCaps: DWORD; (* Capabilities of device *)
dpcLineCaps: TD3DPrimCaps;
dpcTriCaps: TD3DPrimCaps;
dwDeviceRenderBitDepth: DWORD;
dwDeviceZBufferBitDepth: DWORD;
dwDeviceRenderBitDepth: DWORD; (* One of DDBB_8, 16, etc.. *)
dwDeviceZBufferBitDepth: DWORD; (* One of DDBD_16, 32, etc.. *)
 
dwMinTextureWidth: DWORD;
dwMinTextureHeight: DWORD;
dwMaxTextureWidth: DWORD;
dwMaxTextureHeight: DWORD;
dwMinTextureWidth, dwMinTextureHeight: DWORD;
dwMaxTextureWidth, dwMaxTextureHeight: DWORD;
 
dwMaxTextureRepeat: DWORD;
dwMaxTextureAspectRatio: DWORD;
4864,15 → 7735,15
 
dwFVFCaps: DWORD;
dwTextureOpCaps: DWORD;
wMaxTextureBlendStages: Word;
wMaxSimultaneousTextures: Word;
wMaxTextureBlendStages: WORD;
wMaxSimultaneousTextures: WORD;
 
dwMaxActiveLights: DWORD;
dvMaxVertexW: TD3DValue;
deviceGUID: TGUID;
 
wMaxUserClipPlanes: Word;
wMaxVertexBlendMatrices: Word;
wMaxUserClipPlanes: WORD;
wMaxVertexBlendMatrices: WORD;
 
dwVertexProcessingCaps: DWORD;
 
4882,91 → 7753,102
dwReserved4: DWORD;
end;
 
const
D3DDEVICEDESCSIZE = sizeof(TD3DDeviceDesc);
D3DDEVICEDESC7SIZE = sizeof(TD3DDeviceDesc7);
 
type
TD3DEnumDevicesCallback = function(const lpGuid: TGUID;
lpDeviceDescription: LPSTR; lpDeviceName: LPSTR;
const lpD3DHWDeviceDesc: TD3DDeviceDesc;
const lpD3DHELDeviceDesc: TD3DDeviceDesc;
lpUserArg: Pointer): HResult; stdcall;
TD3DEnumDevicesCallbackA = function (lpGuid: PGUID; // nil for the default device
lpDeviceDescription: PAnsiChar; lpDeviceName: PAnsiChar;
var lpD3DHWDeviceDesc: TD3DDeviceDesc;
var lpD3DHELDeviceDesc: TD3DDeviceDesc;
lpContext : pointer) : HResult; stdcall;
TD3DEnumDevicesCallback = TD3DEnumDevicesCallbackA;
 
LPD3DENUMDEVICESCALLBACK = TD3DEnumDevicesCallback;
TD3DEnumDevicesCallback7A = function (
lpDeviceDescription: PAnsiChar; lpDeviceName: PAnsiChar;
const lpD3DDeviceDesc: TD3DDeviceDesc7; lpContext: Pointer) : HResult; stdcall;
TD3DEnumDevicesCallback7 = TD3DEnumDevicesCallback7A;
 
TD3DEnumDevicesCallback7 = function(lpDeviceDescription: LPSTR; lpDeviceName: LPSTR;
const lpD3DDeviceDesc: TD3DDeviceDesc7; lpUserArg: Pointer): HResult; stdcall;
(* TD3DDeviceDesc dwFlags indicating valid fields *)
 
LPD3DENUMDEVICESCALLBACK7 = TD3DEnumDevicesCallback7;
 
{ TD3DDeviceDesc dwFlags indicating valid fields }
 
const
D3DDD_COLORMODEL = $00000001; // dcmColorModel is valid
D3DDD_DEVCAPS = $00000002; // dwDevCaps is valid
D3DDD_TRANSFORMCAPS = $00000004; // dtcTransformCaps is valid
D3DDD_LIGHTINGCAPS = $00000008; // dlcLightingCaps is valid
D3DDD_BCLIPPING = $00000010; // bClipping is valid
D3DDD_LINECAPS = $00000020; // dpcLineCaps is valid
D3DDD_TRICAPS = $00000040; // dpcTriCaps is valid
D3DDD_DEVICERENDERBITDEPTH = $00000080; // dwDeviceRenderBitDepth is valid
D3DDD_DEVICEZBUFFERBITDEPTH = $00000100; // dwDeviceZBufferBitDepth is valid
D3DDD_MAXBUFFERSIZE = $00000200; // dwMaxBufferSize is valid
D3DDD_MAXVERTEXCOUNT = $00000400; // dwMaxVertexCount is valid
D3DDD_COLORMODEL = $00000001; (* dcmColorModel is valid *)
D3DDD_DEVCAPS = $00000002; (* dwDevCaps is valid *)
D3DDD_TRANSFORMCAPS = $00000004; (* dtcTransformCaps is valid *)
D3DDD_LIGHTINGCAPS = $00000008; (* dlcLightingCaps is valid *)
D3DDD_BCLIPPING = $00000010; (* bClipping is valid *)
D3DDD_LINECAPS = $00000020; (* dpcLineCaps is valid *)
D3DDD_TRICAPS = $00000040; (* dpcTriCaps is valid *)
D3DDD_DEVICERENDERBITDEPTH = $00000080; (* dwDeviceRenderBitDepth is valid *)
D3DDD_DEVICEZBUFFERBITDEPTH = $00000100; (* dwDeviceZBufferBitDepth is valid *)
D3DDD_MAXBUFFERSIZE = $00000200; (* dwMaxBufferSize is valid *)
D3DDD_MAXVERTEXCOUNT = $00000400; (* dwMaxVertexCount is valid *)
 
{ TD3DDeviceDesc dwDevCaps flags }
(* TD3DDeviceDesc dwDevCaps flags *)
 
D3DDEVCAPS_FLOATTLVERTEX = $00000001; // Device accepts floating point
// for post-transform vertex data
D3DDEVCAPS_SORTINCREASINGZ = $00000002; // Device needs data sorted for increasing Z
D3DDEVCAPS_SORTDECREASINGZ = $00000004; // Device needs data sorted for decreasing Z
D3DDEVCAPS_SORTEXACT = $00000008; // Device needs data sorted exactly
D3DDEVCAPS_FLOATTLVERTEX = $00000001; (* Device accepts floating point *)
(* for post-transform vertex data *)
D3DDEVCAPS_SORTINCREASINGZ = $00000002; (* Device needs data sorted for increasing Z*)
D3DDEVCAPS_SORTDECREASINGZ = $00000004; (* Device needs data sorted for decreasing Z*)
D3DDEVCAPS_SORTEXACT = $00000008; (* Device needs data sorted exactly *)
 
D3DDEVCAPS_EXECUTESYSTEMMEMORY = $00000010; // Device can use execute buffers from system memory
D3DDEVCAPS_EXECUTEVIDEOMEMORY = $00000020; // Device can use execute buffers from video memory
D3DDEVCAPS_TLVERTEXSYSTEMMEMORY = $00000040; // Device can use TL buffers from system memory
D3DDEVCAPS_TLVERTEXVIDEOMEMORY = $00000080; // Device can use TL buffers from video memory
D3DDEVCAPS_TEXTURESYSTEMMEMORY = $00000100; // Device can texture from system memory
D3DDEVCAPS_TEXTUREVIDEOMEMORY = $00000200; // Device can texture from device memory
D3DDEVCAPS_DRAWPRIMTLVERTEX = $00000400; // Device can draw TLVERTEX primitives
D3DDEVCAPS_CANRENDERAFTERFLIP = $00000800; // Device can render without waiting for flip to complete
D3DDEVCAPS_TEXTURENONLOCALVIDMEM = $00001000; // Device can texture from nonlocal video memory
D3DDEVCAPS_DRAWPRIMITIVES2 = $00002000; // Device can support DrawPrimitives2
D3DDEVCAPS_SEPARATETEXTUREMEMORIES = $00004000; // Device is texturing from separate memory pools
D3DDEVCAPS_DRAWPRIMITIVES2EX = $00008000; // Device can support Extended DrawPrimitives2 i.e. DX7 compliant driver
D3DDEVCAPS_HWTRANSFORMANDLIGHT = $00010000; // Device can support transformation and lighting in hardware and DRAWPRIMITIVES2EX must be also
D3DDEVCAPS_CANBLTSYSTONONLOCAL = $00020000; // Device supports a Tex Blt from system memory to non-local vidmem
D3DDEVCAPS_HWRASTERIZATION = $00080000; // Device has HW acceleration for rasterization
D3DDEVCAPS_EXECUTESYSTEMMEMORY = $00000010; (* Device can use execute buffers from system memory *)
D3DDEVCAPS_EXECUTEVIDEOMEMORY = $00000020; (* Device can use execute buffers from video memory *)
D3DDEVCAPS_TLVERTEXSYSTEMMEMORY = $00000040; (* Device can use TL buffers from system memory *)
D3DDEVCAPS_TLVERTEXVIDEOMEMORY = $00000080; (* Device can use TL buffers from video memory *)
D3DDEVCAPS_TEXTURESYSTEMMEMORY = $00000100; (* Device can texture from system memory *)
D3DDEVCAPS_TEXTUREVIDEOMEMORY = $00000200; (* Device can texture from device memory *)
D3DDEVCAPS_DRAWPRIMTLVERTEX = $00000400; (* Device can draw TLVERTEX primitives *)
D3DDEVCAPS_CANRENDERAFTERFLIP = $00000800; (* Device can render without waiting for flip to complete *)
D3DDEVCAPS_TEXTURENONLOCALVIDMEM = $00001000; (* Device can texture from nonlocal video memory *)
D3DDEVCAPS_DRAWPRIMITIVES2 = $00002000; (* Device can support DrawPrimitives2 *)
D3DDEVCAPS_SEPARATETEXTUREMEMORIES = $00004000; (* Device is texturing from separate memory pools *)
D3DDEVCAPS_DRAWPRIMITIVES2EX = $00008000; (* Device can support Extended DrawPrimitives2 i.e. DX7 compliant driver*)
D3DDEVCAPS_HWTRANSFORMANDLIGHT = $00010000; (* Device can support transformation and lighting in hardware and DRAWPRIMITIVES2EX must be also *)
D3DDEVCAPS_CANBLTSYSTONONLOCAL = $00020000; (* Device supports a Tex Blt from system memory to non-local vidmem *)
D3DDEVCAPS_HWRASTERIZATION = $00080000; (* Device has HW acceleration for rasterization *)
 
{ TD3DDeviceDesc7.dwVertexProcessingCaps field }
(*
* These are the flags in the D3DDEVICEDESC7.dwVertexProcessingCaps field
*)
 
(* device can do texgen *)
D3DVTXPCAPS_TEXGEN = $00000001;
(* device can do IDirect3DDevice7 colormaterialsource ops *)
D3DVTXPCAPS_MATERIALSOURCE7 = $00000002;
(* device can do vertex fog *)
D3DVTXPCAPS_VERTEXFOG = $00000004;
(* device can do directional lights *)
D3DVTXPCAPS_DIRECTIONALLIGHTS = $00000008;
(* device can do positional lights (includes point and spot) *)
D3DVTXPCAPS_POSITIONALLIGHTS = $00000010;
(* device can do local viewer *)
D3DVTXPCAPS_LOCALVIEWER = $00000020;
 
D3DFDS_COLORMODEL = $00000001; // Match color model
D3DFDS_GUID = $00000002; // Match guid
D3DFDS_HARDWARE = $00000004; // Match hardware/software
D3DFDS_TRIANGLES = $00000008; // Match in triCaps
D3DFDS_LINES = $00000010; // Match in lineCaps
D3DFDS_MISCCAPS = $00000020; // Match primCaps.dwMiscCaps
D3DFDS_RASTERCAPS = $00000040; // Match primCaps.dwRasterCaps
D3DFDS_ZCMPCAPS = $00000080; // Match primCaps.dwZCmpCaps
D3DFDS_ALPHACMPCAPS = $00000100; // Match primCaps.dwAlphaCmpCaps
D3DFDS_SRCBLENDCAPS = $00000200; // Match primCaps.dwSourceBlendCaps
D3DFDS_DSTBLENDCAPS = $00000400; // Match primCaps.dwDestBlendCaps
D3DFDS_SHADECAPS = $00000800; // Match primCaps.dwShadeCaps
D3DFDS_TEXTURECAPS = $00001000; // Match primCaps.dwTextureCaps
D3DFDS_TEXTUREFILTERCAPS = $00002000; // Match primCaps.dwTextureFilterCaps
D3DFDS_TEXTUREBLENDCAPS = $00004000; // Match primCaps.dwTextureBlendCaps
D3DFDS_TEXTUREADDRESSCAPS = $00008000; // Match primCaps.dwTextureBlendCaps
D3DFDS_COLORMODEL = $00000001; (* Match color model *)
D3DFDS_GUID = $00000002; (* Match guid *)
D3DFDS_HARDWARE = $00000004; (* Match hardware/software *)
D3DFDS_TRIANGLES = $00000008; (* Match in triCaps *)
D3DFDS_LINES = $00000010; (* Match in lineCaps *)
D3DFDS_MISCCAPS = $00000020; (* Match primCaps.dwMiscCaps *)
D3DFDS_RASTERCAPS = $00000040; (* Match primCaps.dwRasterCaps *)
D3DFDS_ZCMPCAPS = $00000080; (* Match primCaps.dwZCmpCaps *)
D3DFDS_ALPHACMPCAPS = $00000100; (* Match primCaps.dwAlphaCmpCaps *)
D3DFDS_SRCBLENDCAPS = $00000200; (* Match primCaps.dwSourceBlendCaps *)
D3DFDS_DSTBLENDCAPS = $00000400; (* Match primCaps.dwDestBlendCaps *)
D3DFDS_SHADECAPS = $00000800; (* Match primCaps.dwShadeCaps *)
D3DFDS_TEXTURECAPS = $00001000; (* Match primCaps.dwTextureCaps *)
D3DFDS_TEXTUREFILTERCAPS = $00002000; (* Match primCaps.dwTextureFilterCaps *)
D3DFDS_TEXTUREBLENDCAPS = $00004000; (* Match primCaps.dwTextureBlendCaps *)
D3DFDS_TEXTUREADDRESSCAPS = $00008000; (* Match primCaps.dwTextureBlendCaps *)
 
{ FindDevice arguments }
 
(*
* FindDevice arguments
*)
type
PD3DFindDeviceSearch = ^TD3DFindDeviceSearch;
TD3DFindDeviceSearch = record
TD3DFindDeviceSearch = packed record
dwSize: DWORD;
dwFlags: DWORD;
bHardware: BOOL;
4976,133 → 7858,103
dpcPrimCaps: TD3DPrimCaps;
end;
 
D3DFINDDEVICESEARCH = TD3DFindDeviceSearch;
LPD3DFINDDEVICESEARCH = PD3DFindDeviceSearch;
 
PD3DFindDeviceResult = ^TD3DFindDeviceResult;
TD3DFindDeviceResult = record
TD3DFindDeviceResult = packed record
dwSize: DWORD;
guid: TGUID; // guid which matched
ddHwDesc: TD3DDeviceDesc; // hardware TD3DDeviceDesc
ddSwDesc: TD3DDeviceDesc; // software TD3DDeviceDesc
guid: TGUID; (* guid which matched *)
ddHwDesc: TD3DDeviceDesc; (* hardware TD3DDeviceDesc *)
ddSwDesc: TD3DDeviceDesc; (* software TD3DDeviceDesc *)
end;
 
D3DFINDDEVICERESULT = TD3DFindDeviceResult;
LPD3DFINDDEVICERESULT = PD3DFindDeviceResult;
 
{ Description of execute buffer. }
 
(*
* Description of execute buffer.
*)
PD3DExecuteBufferDesc = ^TD3DExecuteBufferDesc;
TD3DExecuteBufferDesc = record
dwSize: DWORD; // size of this structure
dwFlags: DWORD; // flags indicating which fields are valid
dwCaps: DWORD; // capabilities of execute buffer
dwBufferSize: DWORD; // size of execute buffer data
lpData: Pointer; // pointer to actual data
TD3DExecuteBufferDesc = packed record
dwSize: DWORD; (* size of this structure *)
dwFlags: DWORD; (* flags indicating which fields are valid *)
dwCaps: DWORD; (* capabilities of execute buffer *)
dwBufferSize: DWORD; (* size of execute buffer data *)
lpData: Pointer; (* pointer to actual data *)
end;
 
D3DEXECUTEBUFFERDESC = TD3DExecuteBufferDesc;
LPD3DEXECUTEBUFFERDESC = PD3DExecuteBufferDesc;
(* D3DEXECUTEBUFFER dwFlags indicating valid fields *)
 
{ D3DEXECUTEBUFFER dwFlags indicating valid fields }
 
const
D3DDEB_BUFSIZE = $00000001; // buffer size valid
D3DDEB_CAPS = $00000002; // caps valid
D3DDEB_LPDATA = $00000004; // lpData valid
D3DDEB_BUFSIZE = $00000001; (* buffer size valid *)
D3DDEB_CAPS = $00000002; (* caps valid *)
D3DDEB_LPDATA = $00000004; (* lpData valid *)
 
{ D3DEXECUTEBUFFER dwCaps }
(* D3DEXECUTEBUFFER dwCaps *)
 
D3DDEBCAPS_SYSTEMMEMORY = $00000001; // buffer in system memory
D3DDEBCAPS_VIDEOMEMORY = $00000002; // buffer in device memory
D3DDEBCAPS_MEM = D3DDEBCAPS_SYSTEMMEMORY or D3DDEBCAPS_VIDEOMEMORY;
D3DDEBCAPS_SYSTEMMEMORY = $00000001; (* buffer in system memory *)
D3DDEBCAPS_VIDEOMEMORY = $00000002; (* buffer in device memory *)
D3DDEBCAPS_MEM = (D3DDEBCAPS_SYSTEMMEMORY or D3DDEBCAPS_VIDEOMEMORY);
 
type
 
{ TD3DDevInfo_TextureManager }
 
PD3DDevInfo_TextureManager = ^TD3DDevInfo_TextureManager;
TD3DDevInfo_TextureManager = record
bThrashing: BOOL; // indicates if thrashing
dwApproxBytesDownloaded: DWORD; // Approximate number of bytes downloaded by texture manager
dwNumEvicts: DWORD; // number of textures evicted
dwNumVidCreates: DWORD; // number of textures created in video memory
dwNumTexturesUsed: DWORD; // number of textures used
dwNumUsedTexInVid: DWORD; // number of used textures present in video memory
dwWorkingSet: DWORD; // number of textures in video memory
dwWorkingSetBytes: DWORD; // number of bytes in video memory
dwTotalManaged: DWORD; // total number of managed textures
dwTotalBytes: DWORD; // total number of bytes of managed textures
dwLastPri: DWORD; // priority of last texture evicted
TD3DDevInfo_TextureManager = packed record
bThrashing: BOOL; (* indicates if thrashing *)
dwApproxBytesDownloaded: DWORD; (* Approximate number of bytes downloaded by texture manager *)
dwNumEvicts: DWORD; (* number of textures evicted *)
dwNumVidCreates: DWORD; (* number of textures created in video memory *)
dwNumTexturesUsed: DWORD; (* number of textures used *)
dwNumUsedTexInVid: DWORD; (* number of used textures present in video memory *)
dwWorkingSet: DWORD; (* number of textures in video memory *)
dwWorkingSetBytes: DWORD; (* number of bytes in video memory *)
dwTotalManaged: DWORD; (* total number of managed textures *)
dwTotalBytes: DWORD; (* total number of bytes of managed textures *)
dwLastPri: DWORD; (* priority of last texture evicted *)
end;
 
D3DDEVINFO_TEXTUREMANAGER = TD3DDevInfo_TextureManager;
LPD3DDEVINFO_TEXTUREMANAGER = PD3DDevInfo_TextureManager;
 
{ TD3DDevInfo_Texturing }
 
PD3DDevInfo_Texturing = ^TD3DDevInfo_Texturing;
TD3DDevInfo_Texturing = record
dwNumLoads: DWORD; // counts Load() API calls
dwApproxBytesLoaded: DWORD; // Approximate number bytes loaded via Load()
dwNumPreLoads: DWORD; // counts PreLoad() API calls
dwNumSet: DWORD; // counts SetTexture() API calls
dwNumCreates: DWORD; // counts texture creates
dwNumDestroys: DWORD; // counts texture destroys
dwNumSetPriorities: DWORD; // counts SetPriority() API calls
dwNumSetLODs: DWORD; // counts SetLOD() API calls
dwNumLocks: DWORD; // counts number of texture locks
dwNumGetDCs: DWORD; // counts number of GetDCs to textures
TD3DDevInfo_Texturing = packed record
dwNumLoads: DWORD; (* counts Load() API calls *)
dwApproxBytesLoaded: DWORD; (* Approximate number bytes loaded via Load() *)
dwNumPreLoads: DWORD; (* counts PreLoad() API calls *)
dwNumSet: DWORD; (* counts SetTexture() API calls *)
dwNumCreates: DWORD; (* counts texture creates *)
dwNumDestroys: DWORD; (* counts texture destroys *)
dwNumSetPriorities: DWORD; (* counts SetPriority() API calls *)
dwNumSetLODs: DWORD; (* counts SetLOD() API calls *)
dwNumLocks: DWORD; (* counts number of texture locks *)
dwNumGetDCs: DWORD; (* counts number of GetDCs to textures *)
end;
 
D3DDEVINFO_TEXTURING = TD3DDevInfo_Texturing;
LPD3DDEVINFO_TEXTURING = PD3DDevInfo_Texturing;
 
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3d.h
* Content: Direct3D include file
*
***************************************************************************)
****************************************************************************)
 
{ Interface IID's }
function D3DErrorString(Value: HResult) : string;
 
(*
* Interface IID's
*)
 
const
IID_IDirect3D: TGUID = '{3BBA0080-2421-11CF-A31A-00AA00B93356}';
IID_IDirect3D2: TGUID = '{6AAE1EC1-662A-11D0-889D-00AA00BBB76A}';
IID_IDirect3D3: TGUID = '{BB223240-E72B-11D0-A9B4-00AA00C0993E}';
IID_IDirect3D7: TGUID = '{F5049E77-4861-11D2-A407-00A0C90629A8}';
(*
* Internal Guid to distinguish requested MMX from MMX being used as an RGB rasterizer
*)
IID_IDirect3DRampDevice: TGUID =
(D1:$F2086B20;D2:$259F;D3:$11CF;D4:($A3,$1A,$00,$AA,$00,$B9,$33,$56));
IID_IDirect3DRGBDevice: TGUID =
(D1:$A4665C60;D2:$2673;D3:$11CF;D4:($A3,$1A,$00,$AA,$00,$B9,$33,$56));
IID_IDirect3DHALDevice: TGUID =
(D1:$84E63dE0;D2:$46AA;D3:$11CF;D4:($81,$6F,$00,$00,$C0,$20,$15,$6E));
IID_IDirect3DMMXDevice: TGUID =
(D1:$881949a1;D2:$d6f3;D3:$11d0;D4:($89,$ab,$00,$a0,$c9,$05,$41,$29));
 
IID_IDirect3DRampDevice: TGUID = '{F2086B20-259F-11CF-A31A-00AA00B93356}';
IID_IDirect3DRGBDevice: TGUID = '{A4665C60-2673-11CF-A31A-00AA00B93356}';
IID_IDirect3DHALDevice: TGUID = '{84E63DE0-46AA-11CF-816F-0000C020156E}';
IID_IDirect3DMMXDevice: TGUID = '{881949A1-D6F3-11D0-89AB-00A0C9054129}';
IID_IDirect3DRefDevice: TGUID = '{50936643-13E9-11D1-89AA-00A0C9054129}';
IID_IDirect3DNullDevice: TGUID = '{8767DF22-BACC-11D1-8969-00A0C90629A8}';
IID_IDirect3DTnLHalDevice: TGUID = '{F5049E78-4861-11D2-A407-00A0C90629A8}';
IID_IDirect3DRefDevice: TGUID =
(D1:$50936643;D2:$13e9;D3:$11d1;D4:($89,$aa,$00,$a0,$c9,$05,$41,$29));
IID_IDirect3DNullDevice: TGUID =
(D1:$8767df22;D2:$bacc;D3:$11d1;D4:($89,$69,$00,$a0,$c9,$06,$29,$a8));
 
IID_IDirect3DDevice: TGUID = '{64108800-957D-11D0-89AB-00A0C9054129}';
IID_IDirect3DDevice2: TGUID = '{93281501-8CF8-11D0-89AB-00A0C9054129}';
IID_IDirect3DDevice3: TGUID = '{B0AB3B60-33D7-11D1-A981-00C04FD7B174}';
IID_IDirect3DDevice7: TGUID = '{F5049E79-4861-11D2-A407-00A0C90629A8}';
IID_IDirect3DTnLHalDevice: TGUID = '{f5049e78-4861-11d2-a407-00a0c90629a8}';
IID_IDirect3DTexture: TGUID ='{2CDCD9E0-25A0-11CF-A31A-00AA00B93356}';
IID_IDirect3DTexture2: TGUID = '{93281502-8CF8-11D0-89AB-00A0C9054129}';
IID_IDirect3DLight: TGUID = '{4417C142-33AD-11CF-816F-0000C020156E}';
IID_IDirect3DMaterial: TGUID = '{4417C144-33AD-11CF-816F-0000C020156E}';
IID_IDirect3DMaterial2: TGUID = '{93281503-8CF8-11D0-89AB-00A0C9054129}';
IID_IDirect3DMaterial3: TGUID = '{CA9C46F4-D3C5-11D1-B75A-00600852B312}';
IID_IDirect3DExecuteBuffer: TGUID = '{4417C145-33AD-11CF-816F-0000C020156E}';
IID_IDirect3DViewport: TGUID = '{4417C146-33AD-11CF-816F-0000C020156E}';
IID_IDirect3DViewport2: TGUID = '{93281500-8CF8-11D0-89AB-00A0C9054129}';
IID_IDirect3DViewport3: TGUID = '{B0AB3B61-33D7-11D1-A981-00C04FD7B174}';
IID_IDirect3DVertexBuffer: TGUID = '{7A503555-4A83-11D1-A5DB-00A0C90367F8}';
IID_IDirect3DVertexBuffer7: TGUID = '{F5049E7D-4861-11D2-A407-00A0C90629A8}';
 
{ Data structures }
 
type
IDirect3D = interface;
IDirect3D2 = interface;
5125,89 → 7977,96
IDirect3DVertexBuffer = interface;
IDirect3DVertexBuffer7 = interface;
 
(*
* Direct3D interfaces
*)
 
IDirect3D = interface(IUnknown)
['{3BBA0080-2421-11CF-A31A-00AA00B93356}']
// IDirect3D methods
function Initialize(const lpREFIID: TGUID): HResult; stdcall;
(*** IDirect3D methods ***)
function Initialize (lpREFIID: {REFIID} PGUID) : HResult; stdcall;
function EnumDevices(lpEnumDevicesCallback: TD3DEnumDevicesCallback;
lpUserArg: Pointer): HResult; stdcall;
function CreateLight(out lplpDirect3Dlight: IDirect3DLight;
function CreateLight (var lplpDirect3Dlight: IDirect3DLight;
pUnkOuter: IUnknown): HResult; stdcall;
function CreateMaterial(out lplpDirect3DMaterial: IDirect3DMaterial;
function CreateMaterial (var lplpDirect3DMaterial: IDirect3DMaterial;
pUnkOuter: IUnknown): HResult; stdcall;
function CreateViewport(out lplpD3DViewport: IDirect3DViewport;
function CreateViewport (var lplpD3DViewport: IDirect3DViewport;
pUnkOuter: IUnknown): HResult; stdcall;
function FindDevice(const lpD3DFDS: TD3DFindDeviceSearch;
function FindDevice (var lpD3DFDS: TD3DFindDeviceSearch;
var lpD3DFDR: TD3DFindDeviceResult): HResult; stdcall;
end;
 
IDirect3D2 = interface(IUnknown)
['{6AAE1EC1-662A-11D0-889D-00AA00BBB76A}']
// IDirect3D methods
['{6aae1ec1-662a-11d0-889d-00aa00bbb76a}']
(*** IDirect3D2 methods ***)
function EnumDevices(lpEnumDevicesCallback: TD3DEnumDevicesCallback;
lpUserArg: Pointer): HResult; stdcall;
function CreateLight(out lplpDirect3Dlight: IDirect3DLight;
lpUserArg: pointer) : HResult; stdcall;
function CreateLight (var lplpDirect3Dlight: IDirect3DLight;
pUnkOuter: IUnknown): HResult; stdcall;
function CreateMaterial(out lplpDirect3DMaterial: IDirect3DMaterial2;
function CreateMaterial (var lplpDirect3DMaterial2: IDirect3DMaterial2;
pUnkOuter: IUnknown): HResult; stdcall;
function CreateViewport(out lplpD3DViewport: IDirect3DViewport2;
function CreateViewport (var lplpD3DViewport2: IDirect3DViewport2;
pUnkOuter: IUnknown ): HResult; stdcall;
function FindDevice(const lpD3DFDS: TD3DFindDeviceSearch;
function FindDevice (var lpD3DFDS: TD3DFindDeviceSearch;
var lpD3DFDR: TD3DFindDeviceResult): HResult; stdcall;
// IDirect3D2 methods
function CreateDevice(const rclsid: TGUID; lpDDS: IDirectDrawSurface;
function CreateDevice (const rclsid: TRefClsID; lpDDS: IDirectDrawSurface;
out lplpD3DDevice2: IDirect3DDevice2): HResult; stdcall;
end;
 
IDirect3D3 = interface(IUnknown)
['{BB223240-E72B-11D0-A9B4-00AA00C0993E}']
// IDirect3D methods
['{bb223240-e72b-11d0-a9b4-00aa00c0993e}']
(*** IDirect3D3 methods ***)
function EnumDevices(lpEnumDevicesCallback: TD3DEnumDevicesCallback;
lpUserArg: Pointer): HResult; stdcall;
function CreateLight(out lplpDirect3Dlight: IDirect3DLight;
lpUserArg: pointer) : HResult; stdcall;
function CreateLight (var lplpDirect3Dlight: IDirect3DLight;
pUnkOuter: IUnknown): HResult; stdcall;
function CreateMaterial(out lplpDirect3DMaterial: IDirect3DMaterial3;
function CreateMaterial (var lplpDirect3DMaterial3: IDirect3DMaterial3;
pUnkOuter: IUnknown): HResult; stdcall;
function CreateViewport(out lplpD3DViewport: IDirect3DViewport3;
function CreateViewport (var lplpD3DViewport3: IDirect3DViewport3;
pUnkOuter: IUnknown ): HResult; stdcall;
function FindDevice(const lpD3DFDS: TD3DFindDeviceSearch;
function FindDevice (var lpD3DFDS: TD3DFindDeviceSearch;
var lpD3DFDR: TD3DFindDeviceResult): HResult; stdcall;
// IDirect3D2 methods
function CreateDevice(const rclsid: TGUID; lpDDS: IDirectDrawSurface4;
out lplpD3DDevice2: IDirect3DDevice3; pUnkOuter: IUnknown): HResult; stdcall;
// IDirect3D3 methods
function CreateVertexBuffer(const lpVBDesc: TD3DVertexBufferDesc;
out lpD3DVertexBuffer: IDirect3DVertexBuffer; dwFlags: DWORD; pUnkOuter: IUnknown): HResult; stdcall;
function EnumZBufferFormats(const riidDevice: TGUID; lpEnumCallback: TD3DEnumPixelFormatsCallback;
lpContext: Pointer): HResult; stdcall;
function CreateDevice (const rclsid: TRefClsID; lpDDS: IDirectDrawSurface4;
out lplpD3DDevice: IDirect3DDevice3; pUnkOuter: IUnknown) : HResult; stdcall;
function CreateVertexBuffer (var lpVBDesc: TD3DVertexBufferDesc;
var lpD3DVertexBuffer: IDirect3DVertexBuffer;
dwFlags: DWORD; pUnkOuter: IUnknown) : HResult; stdcall;
function EnumZBufferFormats (const riidDevice: TRefClsID; lpEnumCallback:
TD3DEnumPixelFormatsCallback; lpContext: pointer) : HResult; stdcall;
function EvictManagedTextures: HResult; stdcall;
end;
 
IDirect3D7 = interface(IUnknown)
['{F5049E77-4861-11D2-A407-00A0C90629A8}']
// IDirect3D7 methods
['{f5049e77-4861-11d2-a407-00a0c90629a8}']
(*** IDirect3D7 methods ***)
function EnumDevices(lpEnumDevicesCallback: TD3DEnumDevicesCallback7;
lpUserArg: Pointer): HResult; stdcall;
lpUserArg: pointer) : HResult; stdcall;
function CreateDevice(const rclsid: TGUID; lpDDS: IDirectDrawSurface7;
out lplpD3DDevice7: IDirect3DDevice7): HResult; stdcall;
out lplpD3DDevice: IDirect3DDevice7) : HResult; stdcall;
function CreateVertexBuffer(const lpVBDesc: TD3DVertexBufferDesc;
out lpD3DVertexBuffer: IDirect3DVertexBuffer7; dwFlags: DWORD): HResult; stdcall;
function EnumZBufferFormats(const riidDevice: TGUID; lpEnumCallback: TD3DEnumPixelFormatsCallback;
lpContext: Pointer): HResult; stdcall;
out lplpD3DVertexBuffer: IDirect3DVertexBuffer7;
dwFlags: DWORD) : HResult; stdcall;
function EnumZBufferFormats (const riidDevice: TGUID; lpEnumCallback:
TD3DEnumPixelFormatsCallback; lpContext: pointer) : HResult; stdcall;
function EvictManagedTextures: HResult; stdcall;
end;
 
(*
* Direct3D Device interfaces
*)
 
IDirect3DDevice = interface(IUnknown)
['{64108800-957D-11D0-89AB-00A0C9054129}']
// IDirect3DDevice methods
function Initialize(lpd3d: IDirect3D; const lpGUID: TGUID;
const lpd3ddvdesc: TD3DDeviceDesc): HResult; stdcall;
['{64108800-957d-11d0-89ab-00a0c9054129}']
(*** IDirect3DDevice methods ***)
function Initialize (lpd3d: IDirect3D; lpGUID: PGUID;
var lpd3ddvdesc: TD3DDeviceDesc) : HResult; stdcall;
function GetCaps(var lpD3DHWDevDesc: TD3DDeviceDesc;
var lpD3DHELDevDesc: TD3DDeviceDesc): HResult; stdcall;
function SwapTextureHandles(lpD3DTex1: IDirect3DTexture;
lpD3DTex2: IDirect3DTexture): HResult; stdcall;
function CreateExecuteBuffer(const lpDesc: TD3DExecuteBufferDesc;
out lplpDirect3DExecuteBuffer: IDirect3DExecuteBuffer;
function CreateExecuteBuffer (var lpDesc: TD3DExecuteBufferDesc ;
var lplpDirect3DExecuteBuffer: IDirect3DExecuteBuffer;
pUnkOuter: IUnknown): HResult; stdcall;
function GetStats(var lpD3DStats: TD3DStats): HResult; stdcall;
function Execute(lpDirect3DExecuteBuffer: IDirect3DExecuteBuffer;
5215,82 → 8074,94
function AddViewport(lpDirect3DViewport: IDirect3DViewport): HResult; stdcall;
function DeleteViewport(lpDirect3DViewport: IDirect3DViewport): HResult; stdcall;
function NextViewport(lpDirect3DViewport: IDirect3DViewport;
out lplpDirect3DViewport: IDirect3DViewport; dwFlags: DWORD): HResult; stdcall;
var lplpDirect3DViewport: IDirect3DViewport; dwFlags: DWORD) : HResult; stdcall;
function Pick(lpDirect3DExecuteBuffer: IDirect3DExecuteBuffer;
lpDirect3DViewport: IDirect3DViewport; dwFlags: DWORD;
const lpRect: TD3DRect): HResult; stdcall;
var lpRect: TD3DRect) : HResult; stdcall;
function GetPickRecords(var lpCount: DWORD;
var lpD3DPickRec: TD3DPickRecord): HResult; stdcall;
function EnumTextureFormats(lpd3dEnumTextureProc: TD3DEnumTextureFormatsCalback;
lpArg: Pointer): HResult; stdcall;
function EnumTextureFormats (lpd3dEnumTextureProc:
TD3DEnumTextureFormatsCallback; lpArg: Pointer) :
HResult; stdcall;
function CreateMatrix(var lpD3DMatHandle: TD3DMatrixHandle): HResult; stdcall;
function SetMatrix(d3dMatHandle: TD3DMatrixHandle;
const lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function GetMatrix(lpD3DMatHandle: TD3DMatrixHandle;
var lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function GetMatrix (var lpD3DMatHandle: TD3DMatrixHandle;
var lpD3DMatrix: TD3DMatrix) : HResult; stdcall;
function DeleteMatrix(d3dMatHandle: TD3DMatrixHandle): HResult; stdcall;
function BeginScene: HResult; stdcall;
function EndScene: HResult; stdcall;
function GetDirect3D(out lpD3D: IDirect3D): HResult; stdcall;
function GetDirect3D (var lpD3D: IDirect3D) : HResult; stdcall;
end;
 
IDirect3DDevice2 = interface(IUnknown)
['{93281501-8CF8-11D0-89AB-00A0C9054129}']
// IDirect3DDevice2 methods
['{93281501-8cf8-11d0-89ab-00a0c9054129}']
(*** IDirect3DDevice2 methods ***)
function GetCaps(var lpD3DHWDevDesc: TD3DDeviceDesc;
var lpD3DHELDevDesc: TD3DDeviceDesc): HResult; stdcall;
function SwapTextureHandles(lpD3DTex1: IDirect3DTexture2;
lpD3DTex2: IDirect3DTexture2): HResult; stdcall;
function GetStats(var lpD3DStats: TD3DStats): HResult; stdcall;
function AddViewport(lpDirect3DViewport: IDirect3DViewport2): HResult; stdcall;
function AddViewport (lpDirect3DViewport2: IDirect3DViewport2) : HResult; stdcall;
function DeleteViewport(lpDirect3DViewport: IDirect3DViewport2): HResult; stdcall;
function NextViewport(lpDirect3DViewport: IDirect3DViewport2;
out lplpDirect3DViewport: IDirect3DViewport2; dwFlags: DWORD): HResult; stdcall;
function EnumTextureFormats(lpd3dEnumTextureProc: TD3DEnumTextureFormatsCalback;
lpArg: Pointer): HResult; stdcall;
var lplpDirect3DViewport: IDirect3DViewport2; dwFlags: DWORD) :
HResult; stdcall;
function EnumTextureFormats (
lpd3dEnumTextureProc: TD3DEnumTextureFormatsCallback; lpArg: Pointer) :
HResult; stdcall;
function BeginScene: HResult; stdcall;
function EndScene: HResult; stdcall;
function GetDirect3D(out lpD3D: IDirect3D2): HResult; stdcall;
function SetCurrentViewport(lpd3dViewport2: IDirect3DViewport2): HResult; stdcall;
function GetCurrentViewport(out lplpd3dViewport2: IDirect3DViewport2): HResult; stdcall;
function SetRenderTarget(lpNewRenderTarget: IDirectDrawSurface): HResult; stdcall;
function GetRenderTarget(out lplpNewRenderTarget: IDirectDrawSurface): HResult; stdcall;
function GetDirect3D (var lpD3D: IDirect3D2) : HResult; stdcall;
 
(*** DrawPrimitive API ***)
function SetCurrentViewport (lpd3dViewport2: IDirect3DViewport2)
: HResult; stdcall;
function GetCurrentViewport (var lplpd3dViewport2: IDirect3DViewport2)
: HResult; stdcall;
 
function SetRenderTarget (lpNewRenderTarget: IDirectDrawSurface)
: HResult; stdcall;
function GetRenderTarget (var lplpNewRenderTarget: IDirectDrawSurface)
: HResult; stdcall;
 
function Begin_(d3dpt: TD3DPrimitiveType; d3dvt: TD3DVertexType;
dwFlags: DWORD): HResult; stdcall;
function BeginIndexed(dptPrimitiveType: TD3DPrimitiveType; dvtVertexType:
TD3DVertexType; const lpvVertices; dwNumVertices: DWORD;
TD3DVertexType; lpvVertices: pointer; dwNumVertices: DWORD;
dwFlags: DWORD): HResult; stdcall;
function Vertex(const lpVertexType): HResult; stdcall;
function Vertex (lpVertexType: pointer) : HResult; stdcall;
function Index(wVertexIndex: WORD): HResult; stdcall;
function End_(dwFlags: DWORD): HResult; stdcall;
 
function GetRenderState(dwRenderStateType: TD3DRenderStateType;
var lpdwRenderState: DWORD): HResult; stdcall;
var lpdwRenderState) : HResult; stdcall;
function SetRenderState(dwRenderStateType: TD3DRenderStateType;
dwRenderState: DWORD): HResult; stdcall;
function GetLightState(dwLightStateType: TD3DLightStateType;
var lpdwLightState: DWORD): HResult; stdcall;
var lpdwLightState) : HResult; stdcall;
function SetLightState(dwLightStateType: TD3DLightStateType;
dwLightState: DWORD): HResult; stdcall;
function SetTransform(dtstTransformStateType: TD3DTransformStateType;
const lpD3DMatrix: TD3DMatrix): HResult; stdcall;
var lpD3DMatrix: TD3DMatrix) : HResult; stdcall;
function GetTransform(dtstTransformStateType: TD3DTransformStateType;
var lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function MultiplyTransform(dtstTransformStateType: TD3DTransformStateType;
var lpD3DMatrix: TD3DMatrix): HResult; stdcall;
 
function DrawPrimitive(dptPrimitiveType: TD3DPrimitiveType;
dvtVertexType: TD3DVertexType; const lpvVertices; dwVertexCount,
dvtVertexType: TD3DVertexType; var lpvVertices; dwVertexCount,
dwFlags: DWORD): HResult; stdcall;
function DrawIndexedPrimitive(dptPrimitiveType: TD3DPrimitiveType;
dvtVertexType: TD3DVertexType; const lpvVertices;
dwVertexCount: DWORD; const dwIndices; dwIndexCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetClipStatus(const lpD3DClipStatus: TD3DClipStatus): HResult; stdcall;
dwVertexTypeDesc: DWORD; lpvVertices: pointer; dwVertexCount: DWORD;
var lpwIndices: WORD; dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function SetClipStatus (var lpD3DClipStatus: TD3DClipStatus) : HResult; stdcall;
function GetClipStatus(var lpD3DClipStatus: TD3DClipStatus): HResult; stdcall;
end;
 
IDirect3DDevice3 = interface(IUnknown)
['{B0AB3B60-33D7-11D1-A981-00C04FD7B174}']
// IDirect3DDevice3 methods
['{b0ab3b60-33d7-11d1-a981-00c04fd7b174}']
(*** IDirect3DDevice2 methods ***)
function GetCaps(var lpD3DHWDevDesc: TD3DDeviceDesc;
var lpD3DHELDevDesc: TD3DDeviceDesc): HResult; stdcall;
function GetStats(var lpD3DStats: TD3DStats): HResult; stdcall;
5297,155 → 8168,193
function AddViewport(lpDirect3DViewport: IDirect3DViewport3): HResult; stdcall;
function DeleteViewport(lpDirect3DViewport: IDirect3DViewport3): HResult; stdcall;
function NextViewport(lpDirect3DViewport: IDirect3DViewport3;
out lplpDirect3DViewport: IDirect3DViewport3; dwFlags: DWORD): HResult; stdcall;
function EnumTextureFormats(lpd3dEnumPixelProc: TD3DEnumPixelFormatsCallback;
lpArg: Pointer): HResult; stdcall;
var lplpAnotherViewport: IDirect3DViewport3; dwFlags: DWORD) : HResult; stdcall;
function EnumTextureFormats (
lpd3dEnumPixelProc: TD3DEnumPixelFormatsCallback; lpArg: Pointer) :
HResult; stdcall;
function BeginScene: HResult; stdcall;
function EndScene: HResult; stdcall;
function GetDirect3D(out lpD3D: IDirect3D3): HResult; stdcall;
function SetCurrentViewport(lpd3dViewport: IDirect3DViewport3): HResult; stdcall;
function GetCurrentViewport(out lplpd3dViewport: IDirect3DViewport3): HResult; stdcall;
function SetRenderTarget(lpNewRenderTarget: IDirectDrawSurface4): HResult; stdcall;
function GetRenderTarget(out lplpNewRenderTarget: IDirectDrawSurface4): HResult; stdcall;
function GetDirect3D (var lpD3D: IDirect3D3) : HResult; stdcall;
function SetCurrentViewport (lpd3dViewport: IDirect3DViewport3)
: HResult; stdcall;
function GetCurrentViewport (var lplpd3dViewport: IDirect3DViewport3)
: HResult; stdcall;
function SetRenderTarget (lpNewRenderTarget: IDirectDrawSurface4)
: HResult; stdcall;
function GetRenderTarget (var lplpNewRenderTarget: IDirectDrawSurface4)
: HResult; stdcall;
function Begin_(d3dpt: TD3DPrimitiveType; dwVertexTypeDesc: DWORD;
dwFlags: DWORD): HResult; stdcall;
function BeginIndexed(dptPrimitiveType: TD3DPrimitiveType; dwVertexTypeDesc: DWORD;
const lpvVertices; dwNumVertices: DWORD; dwFlags: DWORD): HResult; stdcall;
function Vertex(const lpVertexType): HResult; stdcall;
function BeginIndexed (dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; lpvVertices: pointer; dwNumVertices: DWORD;
dwFlags: DWORD) : HResult; stdcall;
function Vertex (lpVertex: pointer) : HResult; stdcall;
function Index(wVertexIndex: WORD): HResult; stdcall;
function End_(dwFlags: DWORD): HResult; stdcall;
function GetRenderState(dwRenderStateType: TD3DRenderStateType;
var lpdwRenderState: DWORD): HResult; stdcall;
var lpdwRenderState) : HResult; stdcall;
function SetRenderState(dwRenderStateType: TD3DRenderStateType;
dwRenderState: DWORD): HResult; stdcall;
function GetLightState(dwLightStateType: TD3DLightStateType;
var lpdwLightState: DWORD): HResult; stdcall;
var lpdwLightState) : HResult; stdcall;
function SetLightState(dwLightStateType: TD3DLightStateType;
dwLightState: DWORD): HResult; stdcall;
function SetTransform(dtstTransformStateType: TD3DTransformStateType;
const lpD3DMatrix: TD3DMatrix): HResult; stdcall;
var lpD3DMatrix: TD3DMatrix) : HResult; stdcall;
function GetTransform(dtstTransformStateType: TD3DTransformStateType;
var lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function MultiplyTransform(dtstTransformStateType: TD3DTransformStateType;
var lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function DrawPrimitive(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; const lpvVertices; dwVertexCount,
dwFlags: DWORD): HResult; stdcall;
dwVertexTypeDesc: DWORD; const lpvVertices;
dwVertexCount, dwFlags: DWORD) : HResult; stdcall;
function DrawIndexedPrimitive(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; const lpvVertices;
dwVertexCount: DWORD; const dwIndices; dwIndexCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetClipStatus(const lpD3DClipStatus: TD3DClipStatus): HResult; stdcall;
dwVertexTypeDesc: DWORD; const lpvVertices; dwVertexCount: DWORD;
var lpwIndices: WORD; dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function SetClipStatus (var lpD3DClipStatus: TD3DClipStatus) : HResult; stdcall;
function GetClipStatus(var lpD3DClipStatus: TD3DClipStatus): HResult; stdcall;
function DrawPrimitiveStrided(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; const lpVertexArray;
dwVertexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
dwVertexTypeDesc : DWORD;
var lpVertexArray: TD3DDrawPrimitiveStridedData;
dwVertexCount, dwFlags: DWORD) : HResult; stdcall;
function DrawIndexedPrimitiveStrided(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; const lpVertexArray;
dwVertexCount: DWORD; const lpwIndices; dwIndexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
dwVertexTypeDesc : DWORD;
var lpVertexArray: TD3DDrawPrimitiveStridedData; dwVertexCount: DWORD;
var lpwIndices: WORD; dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function DrawPrimitiveVB(dptPrimitiveType: TD3DPrimitiveType;
lpd3dVertexBuffer: IDirect3DVertexBuffer; dwStartVertex, dwNumVertices: DWORD;
dwFlags: DWORD): HResult; stdcall;
lpd3dVertexBuffer: IDirect3DVertexBuffer;
dwStartVertex, dwNumVertices, dwFlags: DWORD) : HResult; stdcall;
function DrawIndexedPrimitiveVB(dptPrimitiveType: TD3DPrimitiveType;
lpd3dVertexBuffer: IDirect3DVertexBuffer; const lpwIndices; dwIndexCount: DWORD;
dwFlags: DWORD): HResult; stdcall;
function ComputeSphereVisibility(const lpCenters; const lpRadii;
dwNumSpheres: DWORD; dwFlags: DWORD; var lpdwReturnValues): HResult; stdcall;
function GetTexture(dwStage: DWORD; out lplpTexture: IDirect3DTexture2): HResult; stdcall;
function SetTexture(dwStage: DWORD; lpTexture: IDirect3DTexture2): HResult; stdcall;
function GetTextureStageState(dwStage: DWORD; dwState: TD3DTextureStagesStateType;
var lpdwValue: DWORD): HResult; stdcall;
function SetTextureStageState(dwStage: DWORD; dwState: TD3DTextureStagesStateType;
lpdwValue: DWORD): HResult; stdcall;
function ValidateDevice(var lpdwPasses: DWORD): HResult; stdcall;
lpd3dVertexBuffer: IDirect3DVertexBuffer; var lpwIndices: WORD;
dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function ComputeSphereVisibility (var lpCenters: TD3DVector;
var lpRadii: TD3DValue; dwNumSpheres, dwFlags: DWORD;
var lpdwReturnValues: DWORD) : HResult; stdcall;
function GetTexture (dwStage: DWORD; var lplpTexture: IDirect3DTexture2)
: HResult; stdcall;
function SetTexture (dwStage: DWORD; lplpTexture: IDirect3DTexture2)
: HResult; stdcall;
function GetTextureStageState (dwStage: DWORD;
dwState: TD3DTextureStageStateType; var lpdwValue: DWORD) : HResult; stdcall;
function SetTextureStageState (dwStage: DWORD;
dwState: TD3DTextureStageStateType; lpdwValue: DWORD) : HResult; stdcall;
function ValidateDevice (var lpdwExtraPasses: DWORD) : HResult; stdcall;
end;
 
IDirect3DDevice7 = interface(IUnknown)
['{F5049E79-4861-11D2-A407-00A0C90629A8}']
// IDirect3DDevice7 methods
function GetCaps(var lpD3DDeviceDesc: TD3DDeviceDesc7): HResult; stdcall;
function EnumTextureFormats(lpd3dEnumPixelProc: TD3DEnumPixelFormatsCallback;
lpArg: Pointer): HResult; stdcall;
['{f5049e79-4861-11d2-a407-00a0c90629a8}']
(*** IDirect3DDevice7 methods ***)
function GetCaps(out lpD3DDevDesc: TD3DDeviceDesc7) : HResult; stdcall;
function EnumTextureFormats(lpd3dEnumPixelProc: TD3DEnumPixelFormatsCallback; lpArg: Pointer) : HResult; stdcall;
function BeginScene: HResult; stdcall;
function EndScene: HResult; stdcall;
function GetDirect3D(out lplpD3D: IDirect3D7): HResult; stdcall;
function GetDirect3D(out lpD3D: IDirect3D7) : HResult; stdcall;
function SetRenderTarget(lpNewRenderTarget: IDirectDrawSurface7; dwFlags: DWORD): HResult; stdcall;
function GetRenderTarget(out lplpRenderTarget: IDirectDrawSurface7): HResult; stdcall;
function Clear(dwCount: DWORD; const lpRects: TD3DRect; dwFlags: DWORD; dwColor: TD3DColor;
dvZ: TD3DValue; dwStencil: DWORD): HResult; stdcall;
function SetTransform(dtstTransformStateType: TD3DTransformStateType; const lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function GetTransform(dtstTransformStateType: TD3DTransformStateType; var lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function Clear(dwCount: DWORD; lpRects: PD3DRect; dwFlags, dwColor: DWORD; dvZ: TD3DValue; dwStencil: DWORD) : HResult; stdcall;
function SetTransform(dtstTransformStateType: TD3DTransformStateType;
const lpD3DMatrix: TD3DMatrix) : HResult; stdcall;
function GetTransform(dtstTransformStateType: TD3DTransformStateType;
out lpD3DMatrix: TD3DMatrix) : HResult; stdcall;
function SetViewport(const lpViewport: TD3DViewport7): HResult; stdcall;
function MultiplyTransform(dtstTransformStateType: TD3DTransformStateType; const lpD3DMatrix: TD3DMatrix): HResult; stdcall;
function GetViewport(var lpViewport: TD3DViewport7): HResult; stdcall;
function MultiplyTransform(dtstTransformStateType: TD3DTransformStateType;
const lpD3DMatrix: TD3DMatrix) : HResult; stdcall;
function GetViewport(out lpViewport: TD3DViewport7) : HResult; stdcall;
function SetMaterial(const lpMaterial: TD3DMaterial7): HResult; stdcall;
function GetMaterial(var lpMaterial: TD3DMaterial7): HResult; stdcall;
function GetMaterial(out lpMaterial: TD3DMaterial7) : HResult; stdcall;
function SetLight(dwLightIndex: DWORD; const lpLight: TD3DLight7): HResult; stdcall;
function GetLight(dwLightIndex: DWORD; var lpLight: TD3DLight7): HResult; stdcall;
function GetLight(dwLightIndex: DWORD; out lpLight: TD3DLight7) : HResult; stdcall;
function SetRenderState(dwRenderStateType: TD3DRenderStateType; dwRenderState: DWORD): HResult; stdcall;
function GetRenderState(dwRenderStateType: TD3DRenderStateType; var lpdwRenderState: DWORD): HResult; stdcall;
function GetRenderState(dwRenderStateType: TD3DRenderStateType; out dwRenderState: DWORD) : HResult; stdcall;
function BeginStateBlock: HResult; stdcall;
function EndStateBlock(var lpdwBlockHandle: DWORD): HResult; stdcall;
function EndStateBlock(out lpdwBlockHandle: DWORD) : HResult; stdcall;
function PreLoad(lpddsTexture: IDirectDrawSurface7): HResult; stdcall;
function DrawPrimitive(dptPrimitiveType: TD3DPrimitiveType; dwVertexTypeDesc: DWORD;
const lpvVertices; dwVertexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
function DrawIndexedPrimitive(d3dptPrimitiveType: TD3DPrimitiveType; dwVertexTypeDesc: DWORD;
const lpvVertices; dwVertexCount: DWORD; const lpwIndices; dwIndexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
function DrawPrimitive(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; const lpvVertices;
dwVertexCount, dwFlags: DWORD) : HResult; stdcall;
function DrawIndexedPrimitive(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc: DWORD; const lpvVertices; dwVertexCount: DWORD;
const lpwIndices; dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function SetClipStatus(const lpD3DClipStatus: TD3DClipStatus): HResult; stdcall;
function GetClipStatus(var lpD3DClipStatus: TD3DClipStatus): HResult; stdcall;
function DrawPrimitiveStrided(dptPrimitiveType: TD3DPrimitiveType; dwVertexTypeDesc: DWORD;
const lpVertexArray; dwVertexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
function DrawIndexedPrimitiveStrided(d3dptPrimitiveType: TD3DPrimitiveType; dwVertexTypeDesc: DWORD;
const lpVertexArray; dwVertexCount: DWORD; const lpwIndices; dwIndexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
function DrawPrimitiveVB(d3dptPrimitiveType: TD3DPrimitiveType; lpd3dVertexBuffer: IDirect3DVertexBuffer7;
dwStartVertex: DWORD; dwNumVertices: DWORD; dwFlags: DWORD): HResult; stdcall;
function DrawIndexedPrimitiveVB(d3dptPrimitiveType: TD3DPrimitiveType; lpd3dVertexBuffer: IDirect3DVertexBuffer7;
dwStartVertex: DWORD; dwNumVertices: DWORD; const lpwIndices; dwIndexCount: DWORD; dwFlags: DWORD): HResult; stdcall;
function ComputeSphereVisibility(const lpCenters; const lpRadii; dwNumSpheres: DWORD; dwFlags: DWORD; var lpdwReturnValue): HResult; stdcall;
function GetClipStatus(out lpD3DClipStatus: TD3DClipStatus) : HResult; stdcall;
function DrawPrimitiveStrided(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc : DWORD;
const lpVertexArray: TD3DDrawPrimitiveStridedData;
dwVertexCount, dwFlags: DWORD) : HResult; stdcall;
function DrawIndexedPrimitiveStrided(dptPrimitiveType: TD3DPrimitiveType;
dwVertexTypeDesc : DWORD;
const lpVertexArray: TD3DDrawPrimitiveStridedData; dwVertexCount: DWORD;
var lpwIndices: WORD; dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function DrawPrimitiveVB(dptPrimitiveType: TD3DPrimitiveType;
lpd3dVertexBuffer: IDirect3DVertexBuffer7;
dwStartVertex, dwNumVertices, dwFlags: DWORD) : HResult; stdcall;
function DrawIndexedPrimitiveVB(dptPrimitiveType: TD3DPrimitiveType;
lpd3dVertexBuffer: IDirect3DVertexBuffer7; dwStartVertex, dwNumVertices: DWORD;
var lpwIndices: WORD; dwIndexCount, dwFlags: DWORD) : HResult; stdcall;
function ComputeSphereVisibility(const lpCenters: TD3DVector;
var lpRadii: TD3DValue; dwNumSpheres, dwFlags: DWORD;
var lpdwReturnValues: DWORD) : HResult; stdcall;
function GetTexture(dwStage: DWORD; out lplpTexture: IDirectDrawSurface7): HResult; stdcall;
function SetTexture(dwStage: DWORD; lpTexture: IDirectDrawSurface7): HResult; stdcall;
function GetTextureStageState(dwStage: DWORD; dwState: TD3DTextureStagesStateType; var lpdwValue: DWORD): HResult; stdcall;
function SetTextureStageState(dwStage: DWORD; dwState: TD3DTextureStagesStateType; dwValue: DWORD): HResult; stdcall;
function ValidateDevice(var lpdwPasses: DWORD): HResult; stdcall;
function GetTextureStageState(dwStage: DWORD;
dwState: TD3DTextureStageStateType; out lpdwValue: DWORD) : HResult; stdcall;
function SetTextureStageState(dwStage: DWORD;
dwState: TD3DTextureStageStateType; lpdwValue: DWORD) : HResult; stdcall;
function ValidateDevice(out lpdwExtraPasses: DWORD) : HResult; stdcall;
function ApplyStateBlock(dwBlockHandle: DWORD): HResult; stdcall;
function CaptureStateBlock(dwBlockHandle: DWORD): HResult; stdcall;
function DeleteStateBlock(dwBlockHandle: DWORD): HResult; stdcall;
function CreateStateBlock(d3dsbType: TD3DSTATEBLOCKTYPE; var lpdwBlockHandle: DWORD): HResult; stdcall;
function Load(lpDestTex: IDirectDrawSurface7; const lpDestPoint: TPoint; lpSrcTex: IDirectDrawSurface7; const lprcSrcRect: TRect; dwFlags: DWORD): HResult; stdcall;
function CreateStateBlock(d3dsbType: TD3DStateBlockType; out lpdwBlockHandle: DWORD) : HResult; stdcall;
function Load(lpDestTex: IDirectDrawSurface7; lpDestPoint: PPoint;
lpSrcTex: IDirectDrawSurface7; lprcSrcRect: PRect; dwFlags: DWORD) : HResult; stdcall;
function LightEnable(dwLightIndex: DWORD; bEnable: BOOL): HResult; stdcall;
function GetLightEnable(dwLightIndex: DWORD; var pbEnable: BOOL): HResult; stdcall;
function SetClipPlane(dwIndex: DWORD; const pPlaneEquation): HResult; stdcall;
function GetClipPlane(dwIndex: DWORD; var pPlaneEquation): HResult; stdcall;
function GetLightEnable(dwLightIndex: DWORD; out bEnable: BOOL) : HResult; stdcall;
function SetClipPlane(dwIndex: DWORD; var pPlaneEquation: TD3DValue) : HResult; stdcall;
function GetClipPlane(dwIndex: DWORD; out pPlaneEquation: TD3DValue) : HResult; stdcall;
function GetInfo(dwDevInfoID: DWORD; pDevInfoStruct: Pointer; dwSize: DWORD): HResult; stdcall;
end;
 
(*
* Execute Buffer interface
*)
 
IDirect3DExecuteBuffer = interface(IUnknown)
['{4417C145-33AD-11CF-816F-0000C020156E}']
// IDirect3DExecuteBuffer methods
(*** IDirect3DExecuteBuffer methods ***)
function Initialize(lpDirect3DDevice: IDirect3DDevice;
const lpDesc: TD3DExecuteBufferDesc): HResult; stdcall;
var lpDesc: TD3DExecuteBufferDesc) : HResult; stdcall;
function Lock(var lpDesc: TD3DExecuteBufferDesc): HResult; stdcall;
function Unlock: HResult; stdcall;
function SetExecuteData(const lpData: TD3DExecuteData): HResult; stdcall;
function SetExecuteData (var lpData: TD3DExecuteData) : HResult; stdcall;
function GetExecuteData(var lpData: TD3DExecuteData): HResult; stdcall;
function Validate(var lpdwOffset: DWORD; lpFunc: TD3DValidateCallback;
lpUserArg: Pointer; dwReserved: DWORD): HResult; stdcall;
(*** Warning! Optimize is defined differently in the header files
and the online documentation ***)
function Optimize(dwFlags: DWORD): HResult; stdcall;
end;
 
(*
* Light interfaces
*)
 
IDirect3DLight = interface(IUnknown)
['{4417C142-33AD-11CF-816F-0000C020156E}']
// IDirect3DLight methods
(*** IDirect3DLight methods ***)
function Initialize(lpDirect3D: IDirect3D): HResult; stdcall;
function SetLight(const lpLight: TD3DLight): HResult; stdcall;
function GetLight(var lpLight: TD3DLight): HResult; stdcall;
function SetLight (var lpLight: TD3DLight2) : HResult; stdcall;
function GetLight (var lpLight: TD3DLight2) : HResult; stdcall;
end;
 
(*
* Material interfaces
*)
 
IDirect3DMaterial = interface(IUnknown)
['{4417C144-33AD-11CF-816F-0000C020156E}']
// IDirect3DMaterial methods
(*** IDirect3DMaterial methods ***)
function Initialize(lpDirect3D: IDirect3D): HResult; stdcall;
function SetMaterial(const lpMat: TD3DMaterial): HResult; stdcall;
function SetMaterial (var lpMat: TD3DMaterial) : HResult; stdcall;
function GetMaterial(var lpMat: TD3DMaterial): HResult; stdcall;
function GetHandle(lpDirect3DDevice: IDirect3DDevice;
var lpHandle: TD3DMaterialHandle): HResult; stdcall;
5454,9 → 8363,9
end;
 
IDirect3DMaterial2 = interface(IUnknown)
['{93281503-8CF8-11D0-89AB-00A0C9054129}']
// IDirect3DMaterial2 methods
function SetMaterial(const lpMat: TD3DMaterial): HResult; stdcall;
['{93281503-8cf8-11d0-89ab-00a0c9054129}']
(*** IDirect3DMaterial2 methods ***)
function SetMaterial (var lpMat: TD3DMaterial) : HResult; stdcall;
function GetMaterial(var lpMat: TD3DMaterial): HResult; stdcall;
function GetHandle(lpDirect3DDevice: IDirect3DDevice2;
var lpHandle: TD3DMaterialHandle): HResult; stdcall;
5463,17 → 8372,21
end;
 
IDirect3DMaterial3 = interface(IUnknown)
['{CA9C46F4-D3C5-11D1-B75A-00600852B312}']
// IDirect3DMaterial3 methods
function SetMaterial(const lpMat: TD3DMaterial): HResult; stdcall;
['{ca9c46f4-d3c5-11d1-b75a-00600852b312}']
(*** IDirect3DMaterial2 methods ***)
function SetMaterial (var lpMat: TD3DMaterial) : HResult; stdcall;
function GetMaterial(var lpMat: TD3DMaterial): HResult; stdcall;
function GetHandle(lpDirect3DDevice: IDirect3DDevice3;
var lpHandle: TD3DMaterialHandle): HResult; stdcall;
end;
 
(*
* Texture interfaces
*)
 
IDirect3DTexture = interface(IUnknown)
['{2CDCD9E0-25A0-11CF-A31A-00AA00B93356}']
// IDirect3DTexture methods
(*** IDirect3DTexture methods ***)
function Initialize(lpD3DDevice: IDirect3DDevice;
lpDDSurface: IDirectDrawSurface): HResult; stdcall;
function GetHandle(lpDirect3DDevice: IDirect3DDevice;
5484,31 → 8397,37
end;
 
IDirect3DTexture2 = interface(IUnknown)
['{93281502-8CF8-11D0-89AB-00A0C9054129}']
// IDirect3DTexture2 methods
function GetHandle(lpDirect3DDevice2: IDirect3DDevice2;
['{93281502-8cf8-11d0-89ab-00a0c9054129}']
(*** IDirect3DTexture2 methods ***)
function GetHandle (lpDirect3DDevice: IDirect3DDevice2;
var lpHandle: TD3DTextureHandle): HResult; stdcall;
function PaletteChanged(dwStart: DWORD; dwCount: DWORD): HResult; stdcall;
function Load(lpD3DTexture2: IDirect3DTexture2): HResult; stdcall;
function Load (lpD3DTexture: IDirect3DTexture2) : HResult; stdcall;
end;
 
(*
* Viewport interfaces
*)
 
IDirect3DViewport = interface(IUnknown)
['{4417C146-33AD-11CF-816F-0000C020156E}']
// IDirect3DViewport methods
(*** IDirect3DViewport methods ***)
function Initialize(lpDirect3D: IDirect3D): HResult; stdcall;
function GetViewport(var lpData: TD3DViewport): HResult; stdcall;
function GetViewport (out lpData: TD3DViewport) : HResult; stdcall;
function SetViewport(const lpData: TD3DViewport): HResult; stdcall;
function TransformVertices(dwVertexCount: DWORD;
var lpData: TD3DTransformData; dwFlags: DWORD;
var lpOffscreen: DWORD): HResult; stdcall;
const lpData: TD3DTransformData; dwFlags: DWORD;
out lpOffscreen: DWORD) : HResult; stdcall;
function LightElements(dwElementCount: DWORD;
var lpData: TD3DLightData): HResult; stdcall;
function SetBackground(hMat: TD3DMaterialHandle): HResult; stdcall;
function GetBackground(hMat: TD3DMaterialHandle): HResult; stdcall;
function SetBackgroundDepth(lpDDSurface: IDirectDrawSurface): HResult; stdcall;
function GetBackground (out hMat: TD3DMaterialHandle) : HResult; stdcall;
function SetBackgroundDepth (lpDDSurface: IDirectDrawSurface) :
HResult; stdcall;
function GetBackgroundDepth(out lplpDDSurface: IDirectDrawSurface;
var lpValid: BOOL): HResult; stdcall;
function Clear(dwCount: DWORD; const lpRects: TD3DRect; dwFlags: DWORD): HResult; stdcall;
out lpValid: BOOL) : HResult; stdcall;
function Clear (dwCount: DWORD; const lpRects: TD3DRect; dwFlags: DWORD) :
HResult; stdcall;
function AddLight(lpDirect3DLight: IDirect3DLight): HResult; stdcall;
function DeleteLight(lpDirect3DLight: IDirect3DLight): HResult; stdcall;
function NextLight(lpDirect3DLight: IDirect3DLight;
5515,28 → 8434,74
out lplpDirect3DLight: IDirect3DLight; dwFlags: DWORD): HResult; stdcall;
end;
 
IDirect3DViewport2 = interface(IDirect3DViewport)
['{93281500-8CF8-11D0-89AB-00A0C9054129}']
// IDirect3DViewport2 methods
function GetViewport2(var lpData: TD3DViewport2): HResult; stdcall;
IDirect3DViewport2 = interface (IUnknown)
['{93281500-8cf8-11d0-89ab-00a0c9054129}']
(*** IDirect3DViewport2 methods ***)
function Initialize (lpDirect3D: IDirect3D) : HResult; stdcall;
function GetViewport (out lpData: TD3DViewport) : HResult; stdcall;
function SetViewport (const lpData: TD3DViewport) : HResult; stdcall;
function TransformVertices (dwVertexCount: DWORD;
const lpData: TD3DTransformData; dwFlags: DWORD;
out lpOffscreen: DWORD) : HResult; stdcall;
function LightElements (dwElementCount: DWORD;
var lpData: TD3DLightData) : HResult; stdcall;
function SetBackground (hMat: TD3DMaterialHandle) : HResult; stdcall;
function GetBackground (out hMat: TD3DMaterialHandle) : HResult; stdcall;
function SetBackgroundDepth (lpDDSurface: IDirectDrawSurface) :
HResult; stdcall;
function GetBackgroundDepth (out lplpDDSurface: IDirectDrawSurface;
out lpValid: BOOL) : HResult; stdcall;
function Clear (dwCount: DWORD; const lpRects: TD3DRect; dwFlags: DWORD) :
HResult; stdcall;
function AddLight (lpDirect3DLight: IDirect3DLight) : HResult; stdcall;
function DeleteLight (lpDirect3DLight: IDirect3DLight) : HResult; stdcall;
function NextLight (lpDirect3DLight: IDirect3DLight;
out lplpDirect3DLight: IDirect3DLight; dwFlags: DWORD) : HResult; stdcall;
(*** IDirect3DViewport2 methods ***)
function GetViewport2 (out lpData: TD3DViewport2) : HResult; stdcall;
function SetViewport2(const lpData: TD3DViewport2): HResult; stdcall;
end;
 
IDirect3DViewport3 = interface(IDirect3DViewport2)
['{B0AB3B61-33D7-11D1-A981-00C04FD7B174}']
// IDirect3DViewport3 methods
function SetBackgroundDepth2(lpDDS: IDirectDrawSurface4): HResult; stdcall;
function GetBackgroundDepth2(out lplpDDS: IDirectDrawSurface4; var lpValid: BOOL): HResult; stdcall;
IDirect3DViewport3 = interface (IUnknown)
['{b0ab3b61-33d7-11d1-a981-00c04fd7b174}']
(*** IDirect3DViewport3 methods ***)
function Initialize (lpDirect3D: IDirect3D) : HResult; stdcall;
function GetViewport (out lpData: TD3DViewport) : HResult; stdcall;
function SetViewport (const lpData: TD3DViewport) : HResult; stdcall;
function TransformVertices (dwVertexCount: DWORD;
const lpData: TD3DTransformData; dwFlags: DWORD;
out lpOffscreen: DWORD) : HResult; stdcall;
function LightElements (dwElementCount: DWORD;
var lpData: TD3DLightData) : HResult; stdcall;
function SetBackground (hMat: TD3DMaterialHandle) : HResult; stdcall;
function GetBackground (var hMat: TD3DMaterialHandle) : HResult; stdcall;
function SetBackgroundDepth (
lpDDSurface: IDirectDrawSurface) : HResult; stdcall;
function GetBackgroundDepth (out lplpDDSurface: IDirectDrawSurface;
out lpValid: BOOL) : HResult; stdcall;
function Clear (dwCount: DWORD; const lpRects: TD3DRect; dwFlags: DWORD) :
HResult; stdcall;
function AddLight (lpDirect3DLight: IDirect3DLight) : HResult; stdcall;
function DeleteLight (lpDirect3DLight: IDirect3DLight) : HResult; stdcall;
function NextLight (lpDirect3DLight: IDirect3DLight;
out lplpDirect3DLight: IDirect3DLight; dwFlags: DWORD) : HResult; stdcall;
function GetViewport2 (out lpData: TD3DViewport2) : HResult; stdcall;
function SetViewport2 (const lpData: TD3DViewport2) : HResult; stdcall;
function SetBackgroundDepth2 (
lpDDSurface: IDirectDrawSurface4) : HResult; stdcall;
function GetBackgroundDepth2 (out lplpDDSurface: IDirectDrawSurface4;
out lpValid: BOOL) : HResult; stdcall;
function Clear2(dwCount: DWORD; const lpRects: TD3DRect; dwFlags: DWORD;
dwColor: DWORD; dvZ: TD3DValue; dwStencil: DWORD): HResult; stdcall;
end;
 
IDirect3DVertexBuffer = interface(IUnknown)
['{7A503555-4A83-11D1-A5DB-00A0C90367F8}']
// IDirect3DVertexBuffer methods
function Lock(dwFlags: DWORD; var lplpData: Pointer; var lpdwSize: DWORD): HResult; stdcall;
['{7a503555-4a83-11d1-a5db-00a0c90367f8}']
(*** IDirect3DVertexBuffer methods ***)
function Lock (dwFlags: DWORD; var lplpData: pointer; var lpdwSize: DWORD)
: HResult; stdcall;
function Unlock: HResult; stdcall;
function ProcessVertices(dwVertexOp: DWORD; dwDestIndex: DWORD; dwCount: DWORD;
function ProcessVertices (dwVertexOp, dwDestIndex, dwCount: DWORD;
lpSrcBuffer: IDirect3DVertexBuffer; dwSrcIndex: DWORD;
lpD3DDevice: IDirect3DDevice3; dwFlags: DWORD): HResult; stdcall;
function GetVertexBufferDesc(var lpVBDesc: TD3DVertexBufferDesc): HResult; stdcall;
5544,145 → 8509,770
end;
 
IDirect3DVertexBuffer7 = interface(IUnknown)
['{F5049E7D-4861-11D2-A407-00A0C90629A8}']
// IDirect3DVertexBuffer7 methods
function Lock(dwFlags: DWORD; var lplpData: Pointer; var lpdwSize: DWORD): HResult; stdcall;
['{f5049e7d-4861-11d2-a407-00a0c90629a8}']
(*** IDirect3DVertexBuffer methods ***)
function Lock (dwFlags: DWORD; out lplpData: Pointer; out lpdwSize: DWORD) : HResult; stdcall;
function Unlock: HResult; stdcall;
function ProcessVertices(dwVertexOp: DWORD; dwDestIndex: DWORD; dwCount: DWORD;
lpSrcBuffer: IDirect3DVertexBuffer7; dwSrcIndex: DWORD; lpD3DDevice: IDirect3DDevice7; dwFlags: DWORD): HResult; stdcall;
function GetVertexBufferDesc(var lpVBDesc: TD3DVertexBufferDesc): HResult; stdcall;
function ProcessVertices (dwVertexOp, dwDestIndex, dwCount: DWORD;
lpSrcBuffer: IDirect3DVertexBuffer7; dwSrcIndex: DWORD;
lpD3DDevice: IDirect3DDevice7; dwFlags: DWORD) : HResult; stdcall;
function GetVertexBufferDesc (out lpVBDesc: TD3DVertexBufferDesc) : HResult; stdcall;
function Optimize(lpD3DDevice: IDirect3DDevice7; dwFlags: DWORD): HResult; stdcall;
function ProcessVerticesStrided(dwVertexOp: DWORD; dwDestIndex: DWORD; dwCount: DWORD;
const lpVertexArray; dwSrcIndex: DWORD; lpD3DDevice: IDirect3DDevice7; dwFlags: DWORD): HResult; stdcall;
function ProcessVerticesStrided(dwVertexOp, dwDestIndex, dwCount: DWORD;
lpVertexArray: TD3DDrawPrimitiveStridedData; dwVertexTypeDesc: DWORD;
lpD3DDevice: IDirect3DDevice7; dwFlags: DWORD) : HResult; stdcall;
end;
 
type
IID_IDirect3D = IDirect3D;
IID_IDirect3D2 = IDirect3D2;
IID_IDirect3D3 = IDirect3D3;
IID_IDirect3D7 = IDirect3D7;
 
IID_IDirect3DDevice = IDirect3DDevice;
IID_IDirect3DDevice2 = IDirect3DDevice2;
IID_IDirect3DDevice3 = IDirect3DDevice3;
IID_IDirect3DDevice7 = IDirect3DDevice7;
 
IID_IDirect3DTexture = IDirect3DTexture;
IID_IDirect3DTexture2 = IDirect3DTexture2;
IID_IDirect3DLight = IDirect3DLight;
IID_IDirect3DMaterial = IDirect3DMaterial;
IID_IDirect3DMaterial2 = IDirect3DMaterial2;
IID_IDirect3DMaterial3 = IDirect3DMaterial3;
IID_IDirect3DExecuteBuffer = IDirect3DExecuteBuffer;
IID_IDirect3DViewport = IDirect3DViewport;
IID_IDirect3DViewport2 = IDirect3DViewport2;
IID_IDirect3DViewport3 = IDirect3DViewport3;
IID_IDirect3DVertexBuffer = IDirect3DVertexBuffer;
IID_IDirect3DVertexBuffer7 = IDirect3DVertexBuffer7;
 
 
const
(****************************************************************************
*
* Flags for IDirect3DDevice::NextViewport
*
****************************************************************************)
 
{ Flags for IDirect3DDevice::NextViewport }
(*
* Return the next viewport
*)
D3DNEXT_NEXT = $00000001;
 
D3DNEXT_NEXT = $00000001;
(*
* Return the first viewport
*)
D3DNEXT_HEAD = $00000002;
 
(*
* Return the last viewport
*)
D3DNEXT_TAIL = $00000004;
 
{ Flags for DrawPrimitive/DrawIndexedPrimitive
Also valid for Begin/BeginIndexed }
 
(****************************************************************************
*
* Flags for DrawPrimitive/DrawIndexedPrimitive
* Also valid for Begin/BeginIndexed
* Also valid for VertexBuffer::CreateVertexBuffer
****************************************************************************)
 
(*
* Wait until the device is ready to draw the primitive
* This will cause DP to not return DDERR_WASSTILLDRAWING
*)
D3DDP_WAIT = $00000001;
 
(*
* Hint that it is acceptable to render the primitive out of order.
*)
D3DDP_OUTOFORDER = $00000002;
 
(*
* Hint that the primitives have been clipped by the application.
*)
D3DDP_DONOTCLIP = $00000004;
 
(*
* Hint that the extents need not be updated.
*)
D3DDP_DONOTUPDATEEXTENTS = $00000008;
 
(*
* Hint that the lighting should not be applied on vertices.
*)
 
D3DDP_DONOTLIGHT = $00000010;
 
{ Direct3D Errors }
 
(*
* Direct3D Errors
* DirectDraw error codes are used when errors not specified here.
*)
 
const
D3D_OK = HResult(DD_OK);
D3DERR_BADMAJORVERSION = HResult($88760000 + 700);
D3DERR_BADMINORVERSION = HResult($88760000 + 701);
MAKE_D3DHRESULT = HResult($88760000);
 
{ An invalid device was requested by the application. }
D3D_OK = DD_OK;
D3DERR_BADMAJORVERSION = MAKE_D3DHRESULT + 700;
D3DERR_BADMINORVERSION = MAKE_D3DHRESULT + 701;
 
D3DERR_INVALID_DEVICE = HResult($88760000 + 705);
D3DERR_INITFAILED = HResult($88760000 + 706);
(*
* An invalid device was requested by the application.
*)
D3DERR_INVALID_DEVICE = MAKE_D3DHRESULT + 705;
D3DERR_INITFAILED = MAKE_D3DHRESULT + 706;
 
{ SetRenderTarget attempted on a device that was
QI'd off the render target. }
(*
* SetRenderTarget attempted on a device that was
* QI'd off the render target.
*)
D3DERR_DEVICEAGGREGATED = MAKE_D3DHRESULT + 707;
 
D3DERR_DEVICEAGGREGATED = HResult($88760000 + 707);
D3DERR_EXECUTE_CREATE_FAILED = MAKE_D3DHRESULT + 710;
D3DERR_EXECUTE_DESTROY_FAILED = MAKE_D3DHRESULT + 711;
D3DERR_EXECUTE_LOCK_FAILED = MAKE_D3DHRESULT + 712;
D3DERR_EXECUTE_UNLOCK_FAILED = MAKE_D3DHRESULT + 713;
D3DERR_EXECUTE_LOCKED = MAKE_D3DHRESULT + 714;
D3DERR_EXECUTE_NOT_LOCKED = MAKE_D3DHRESULT + 715;
 
D3DERR_EXECUTE_CREATE_FAILED = HResult($88760000 + 710);
D3DERR_EXECUTE_DESTROY_FAILED = HResult($88760000 + 711);
D3DERR_EXECUTE_LOCK_FAILED = HResult($88760000 + 712);
D3DERR_EXECUTE_UNLOCK_FAILED = HResult($88760000 + 713);
D3DERR_EXECUTE_LOCKED = HResult($88760000 + 714);
D3DERR_EXECUTE_NOT_LOCKED = HResult($88760000 + 715);
D3DERR_EXECUTE_FAILED = MAKE_D3DHRESULT + 716;
D3DERR_EXECUTE_CLIPPED_FAILED = MAKE_D3DHRESULT + 717;
 
D3DERR_EXECUTE_FAILED = HResult($88760000 + 716);
D3DERR_EXECUTE_CLIPPED_FAILED = HResult($88760000 + 717);
D3DERR_TEXTURE_NO_SUPPORT = MAKE_D3DHRESULT + 720;
D3DERR_TEXTURE_CREATE_FAILED = MAKE_D3DHRESULT + 721;
D3DERR_TEXTURE_DESTROY_FAILED = MAKE_D3DHRESULT + 722;
D3DERR_TEXTURE_LOCK_FAILED = MAKE_D3DHRESULT + 723;
D3DERR_TEXTURE_UNLOCK_FAILED = MAKE_D3DHRESULT + 724;
D3DERR_TEXTURE_LOAD_FAILED = MAKE_D3DHRESULT + 725;
D3DERR_TEXTURE_SWAP_FAILED = MAKE_D3DHRESULT + 726;
D3DERR_TEXTURE_LOCKED = MAKE_D3DHRESULT + 727;
D3DERR_TEXTURE_NOT_LOCKED = MAKE_D3DHRESULT + 728;
D3DERR_TEXTURE_GETSURF_FAILED = MAKE_D3DHRESULT + 729;
 
D3DERR_TEXTURE_NO_SUPPORT = HResult($88760000 + 720);
D3DERR_TEXTURE_CREATE_FAILED = HResult($88760000 + 721);
D3DERR_TEXTURE_DESTROY_FAILED = HResult($88760000 + 722);
D3DERR_TEXTURE_LOCK_FAILED = HResult($88760000 + 723);
D3DERR_TEXTURE_UNLOCK_FAILED = HResult($88760000 + 724);
D3DERR_TEXTURE_LOAD_FAILED = HResult($88760000 + 725);
D3DERR_TEXTURE_SWAP_FAILED = HResult($88760000 + 726);
D3DERR_TEXTURE_LOCKED = HResult($88760000 + 727);
D3DERR_TEXTURE_NOT_LOCKED = HResult($88760000 + 728);
D3DERR_TEXTURE_GETSURF_FAILED = HResult($88760000 + 729);
D3DERR_MATRIX_CREATE_FAILED = MAKE_D3DHRESULT + 730;
D3DERR_MATRIX_DESTROY_FAILED = MAKE_D3DHRESULT + 731;
D3DERR_MATRIX_SETDATA_FAILED = MAKE_D3DHRESULT + 732;
D3DERR_MATRIX_GETDATA_FAILED = MAKE_D3DHRESULT + 733;
D3DERR_SETVIEWPORTDATA_FAILED = MAKE_D3DHRESULT + 734;
 
D3DERR_MATRIX_CREATE_FAILED = HResult($88760000 + 730);
D3DERR_MATRIX_DESTROY_FAILED = HResult($88760000 + 731);
D3DERR_MATRIX_SETDATA_FAILED = HResult($88760000 + 732);
D3DERR_MATRIX_GETDATA_FAILED = HResult($88760000 + 733);
D3DERR_SETVIEWPORTDATA_FAILED = HResult($88760000 + 734);
D3DERR_INVALIDCURRENTVIEWPORT = MAKE_D3DHRESULT + 735;
D3DERR_INVALIDPRIMITIVETYPE = MAKE_D3DHRESULT + 736;
D3DERR_INVALIDVERTEXTYPE = MAKE_D3DHRESULT + 737;
D3DERR_TEXTURE_BADSIZE = MAKE_D3DHRESULT + 738;
D3DERR_INVALIDRAMPTEXTURE = MAKE_D3DHRESULT + 739;
 
D3DERR_INVALIDCURRENTVIEWPORT = HResult($88760000 + 735);
D3DERR_INVALIDPRIMITIVETYPE = HResult($88760000 + 736);
D3DERR_INVALIDVERTEXTYPE = HResult($88760000 + 737);
D3DERR_TEXTURE_BADSIZE = HResult($88760000 + 738);
D3DERR_INVALIDRAMPTEXTURE = HResult($88760000 + 739);
D3DERR_MATERIAL_CREATE_FAILED = MAKE_D3DHRESULT + 740;
D3DERR_MATERIAL_DESTROY_FAILED = MAKE_D3DHRESULT + 741;
D3DERR_MATERIAL_SETDATA_FAILED = MAKE_D3DHRESULT + 742;
D3DERR_MATERIAL_GETDATA_FAILED = MAKE_D3DHRESULT + 743;
 
D3DERR_MATERIAL_CREATE_FAILED = HResult($88760000 + 740);
D3DERR_MATERIAL_DESTROY_FAILED = HResult($88760000 + 741);
D3DERR_MATERIAL_SETDATA_FAILED = HResult($88760000 + 742);
D3DERR_MATERIAL_GETDATA_FAILED = HResult($88760000 + 743);
D3DERR_INVALIDPALETTE = MAKE_D3DHRESULT + 744;
 
D3DERR_INVALIDPALETTE = HResult($88760000 + 744);
D3DERR_ZBUFF_NEEDS_SYSTEMMEMORY = MAKE_D3DHRESULT + 745;
D3DERR_ZBUFF_NEEDS_VIDEOMEMORY = MAKE_D3DHRESULT + 746;
D3DERR_SURFACENOTINVIDMEM = MAKE_D3DHRESULT + 747;
 
D3DERR_ZBUFF_NEEDS_SYSTEMMEMORY = HResult($88760000 + 745);
D3DERR_ZBUFF_NEEDS_VIDEOMEMORY = HResult($88760000 + 746);
D3DERR_SURFACENOTINVIDMEM = HResult($88760000 + 747);
D3DERR_LIGHT_SET_FAILED = MAKE_D3DHRESULT + 750;
D3DERR_LIGHTHASVIEWPORT = MAKE_D3DHRESULT + 751;
D3DERR_LIGHTNOTINTHISVIEWPORT = MAKE_D3DHRESULT + 752;
 
D3DERR_LIGHT_SET_FAILED = HResult($88760000 + 750);
D3DERR_LIGHTHASVIEWPORT = HResult($88760000 + 751);
D3DERR_LIGHTNOTINTHISVIEWPORT = HResult($88760000 + 752);
D3DERR_SCENE_IN_SCENE = MAKE_D3DHRESULT + 760;
D3DERR_SCENE_NOT_IN_SCENE = MAKE_D3DHRESULT + 761;
D3DERR_SCENE_BEGIN_FAILED = MAKE_D3DHRESULT + 762;
D3DERR_SCENE_END_FAILED = MAKE_D3DHRESULT + 763;
 
D3DERR_SCENE_IN_SCENE = HResult($88760000 + 760);
D3DERR_SCENE_NOT_IN_SCENE = HResult($88760000 + 761);
D3DERR_SCENE_BEGIN_FAILED = HResult($88760000 + 762);
D3DERR_SCENE_END_FAILED = HResult($88760000 + 763);
D3DERR_INBEGIN = MAKE_D3DHRESULT + 770;
D3DERR_NOTINBEGIN = MAKE_D3DHRESULT + 771;
D3DERR_NOVIEWPORTS = MAKE_D3DHRESULT + 772;
D3DERR_VIEWPORTDATANOTSET = MAKE_D3DHRESULT + 773;
D3DERR_VIEWPORTHASNODEVICE = MAKE_D3DHRESULT + 774;
D3DERR_NOCURRENTVIEWPORT = MAKE_D3DHRESULT + 775;
 
D3DERR_INBEGIN = HResult($88760000 + 770);
D3DERR_NOTINBEGIN = HResult($88760000 + 771);
D3DERR_NOVIEWPORTS = HResult($88760000 + 772);
D3DERR_VIEWPORTDATANOTSET = HResult($88760000 + 773);
D3DERR_VIEWPORTHASNODEVICE = HResult($88760000 + 774);
D3DERR_NOCURRENTVIEWPORT = HResult($88760000 + 775);
D3DERR_INVALIDVERTEXFORMAT = MAKE_D3DHRESULT + 2048;
 
D3DERR_INVALIDVERTEXFORMAT = HResult($88760000 + 2048);
(*
* Attempted to CreateTexture on a surface that had a color key
*)
D3DERR_COLORKEYATTACHED = MAKE_D3DHRESULT + 2050;
 
D3DERR_COLORKEYATTACHED = HResult($88760000 + 2050);
D3DERR_VERTEXBUFFEROPTIMIZED = MAKE_D3DHRESULT + 2060;
D3DERR_VBUF_CREATE_FAILED = MAKE_D3DHRESULT + 2061;
D3DERR_VERTEXBUFFERLOCKED = MAKE_D3DHRESULT + 2062;
 
D3DERR_VERTEXBUFFEROPTIMIZED = HResult($88760000 + 2060);
D3DERR_VBUF_CREATE_FAILED = HResult($88760000 + 2061);
D3DERR_VERTEXBUFFERLOCKED = HResult($88760000 + 2062);
D3DERR_VERTEXBUFFERUNLOCKFAILED = HResult($88760000 + 2063);
D3DERR_ZBUFFER_NOTPRESENT = MAKE_D3DHRESULT + 2070;
D3DERR_STENCILBUFFER_NOTPRESENT = MAKE_D3DHRESULT + 2071;
 
D3DERR_ZBUFFER_NOTPRESENT = HResult($88760000 + 2070);
D3DERR_STENCILBUFFER_NOTPRESENT = HResult($88760000 + 2071);
D3DERR_WRONGTEXTUREFORMAT = MAKE_D3DHRESULT + 2072;
D3DERR_UNSUPPORTEDCOLOROPERATION = MAKE_D3DHRESULT + 2073;
D3DERR_UNSUPPORTEDCOLORARG = MAKE_D3DHRESULT + 2074;
D3DERR_UNSUPPORTEDALPHAOPERATION = MAKE_D3DHRESULT + 2075;
D3DERR_UNSUPPORTEDALPHAARG = MAKE_D3DHRESULT + 2076;
D3DERR_TOOMANYOPERATIONS = MAKE_D3DHRESULT + 2077;
D3DERR_CONFLICTINGTEXTUREFILTER = MAKE_D3DHRESULT + 2078;
D3DERR_UNSUPPORTEDFACTORVALUE = MAKE_D3DHRESULT + 2079;
D3DERR_CONFLICTINGRENDERSTATE = MAKE_D3DHRESULT + 2081;
D3DERR_UNSUPPORTEDTEXTUREFILTER = MAKE_D3DHRESULT + 2082;
D3DERR_TOOMANYPRIMITIVES = MAKE_D3DHRESULT + 2083;
D3DERR_INVALIDMATRIX = MAKE_D3DHRESULT + 2084;
D3DERR_TOOMANYVERTICES = MAKE_D3DHRESULT + 2085;
D3DERR_CONFLICTINGTEXTUREPALETTE = MAKE_D3DHRESULT + 2086;
 
D3DERR_WRONGTEXTUREFORMAT = HResult($88760000 + 2072);
D3DERR_UNSUPPORTEDCOLOROPERATION = HResult($88760000 + 2073);
D3DERR_UNSUPPORTEDCOLORARG = HResult($88760000 + 2074);
D3DERR_UNSUPPORTEDALPHAOPERATION = HResult($88760000 + 2075);
D3DERR_UNSUPPORTEDALPHAARG = HResult($88760000 + 2076);
D3DERR_TOOMANYOPERATIONS = HResult($88760000 + 2077);
D3DERR_CONFLICTINGTEXTUREFILTER = HResult($88760000 + 2078);
D3DERR_UNSUPPORTEDFACTORVALUE = HResult($88760000 + 2079);
D3DERR_CONFLICTINGRENDERSTATE = HResult($88760000 + 2081);
D3DERR_UNSUPPORTEDTEXTUREFILTER = HResult($88760000 + 2082);
D3DERR_TOOMANYPRIMITIVES = HResult($88760000 + 2083);
D3DERR_INVALIDMATRIX = HResult($88760000 + 2084);
D3DERR_TOOMANYVERTICES = HResult($88760000 + 2085);
D3DERR_CONFLICTINGTEXTUREPALETTE = HResult($88760000 + 2086);
D3DERR_INVALIDSTATEBLOCK = MAKE_D3DHRESULT + 2100;
D3DERR_INBEGINSTATEBLOCK = MAKE_D3DHRESULT + 2101;
D3DERR_NOTINBEGINSTATEBLOCK = MAKE_D3DHRESULT + 2102;
 
D3DERR_INVALIDSTATEBLOCK = HResult($88760000 + 2100);
D3DERR_INBEGINSTATEBLOCK = HResult($88760000 + 2101);
D3DERR_NOTINBEGINSTATEBLOCK = HResult($88760000 + 2102);
procedure DisableFPUExceptions;
procedure EnableFPUExceptions;
 
(***************************************************************************
*
* Copyright (C) 1998-1999 Microsoft Corporation. All Rights Reserved.
*
* File: dxfile.h
*
* Content: DirectX File public header file
*
***************************************************************************)
 
var
DXFileDLL : HMODULE;
 
function DXFileErrorString(Value: HResult) : string;
 
type
TDXFileFormat = (
DXFILEFORMAT_BINARY,
DXFILEFORMAT_TEXT,
DXFILEFORMAT_COMPRESSED
);
 
TDXFileLoadOptions = (
DXFILELOAD_FROMFILE,
DXFILELOAD_FROMRESOURCE,
DXFILELOAD_FROMMEMORY,
DXFILELOAD_INVALID_3,
DXFILELOAD_FROMSTREAM,
DXFILELOAD_INVALID_5,
DXFILELOAD_INVALID_6,
DXFILELOAD_INVALID_7,
DXFILELOAD_FROMURL
);
 
PDXFileLoadResource = ^TDXFileLoadResource;
TDXFileLoadResource = packed record
hModule: HModule;
lpName: PAnsiChar;
lpType: PAnsiChar;
end;
 
PDXFileLoadMemory = ^TDXFileLoadMemory;
TDXFileLoadMemory = packed record
lpMemory: Pointer;
dSize: DWORD;
end;
 
(*
* DirectX File object types.
*)
 
IDirectXFile = interface;
IDirectXFileEnumObject = interface;
IDirectXFileSaveObject = interface;
IDirectXFileObject = interface;
IDirectXFileData = interface;
IDirectXFileDataReference = interface;
IDirectXFileBinary = interface;
 
(*
* DirectX File interfaces.
*)
 
IDirectXFile = interface (IUnknown)
['{3d82ab40-62da-11cf-ab39-0020af71e433}']
function CreateEnumObject (pvSource: Pointer;
dwLoadOptions: TDXFileLoadOptions;
var ppEnumObj: IDirectXFileEnumObject) : HResult; stdcall;
function CreateSaveObject (szFileName: PChar; dwFileFormat: TDXFileFormat;
var ppSaveObj: IDirectXFileSaveObject) : HResult; stdcall;
function RegisterTemplates (pvData: Pointer; cbSize: DWORD) : HResult; stdcall;
end;
 
IDirectXFileEnumObject = interface (IUnknown)
['{3d82ab41-62da-11cf-ab39-0020af71e433}']
function GetNextDataObject (var ppDataObj: IDirectXFileData) : HResult; stdcall;
function GetDataObjectById
(const rguid: TGUID; var ppDataObj: IDirectXFileData) : HResult; stdcall;
function GetDataObjectByName
(szName: PChar; var ppDataObj: IDirectXFileData) : HResult; stdcall;
end;
 
IDirectXFileSaveObject = interface (IUnknown)
['{3d82ab42-62da-11cf-ab39-0020af71e433}']
function SaveTemplates
(cTemplates: DWORD; var ppguidTemplates: PGUID) : HResult; stdcall;
function CreateDataObject (const rguidTemplate: TGUID; szName: PChar;
pguid: PGUID; cbSize: DWORD; pvData: Pointer;
var ppDataObj: IDirectXFileData) : HResult; stdcall;
function SaveData (pDataObj: IDirectXFileData) : HResult; stdcall;
end;
 
IDirectXFileObject = interface (IUnknown)
['{3d82ab43-62da-11cf-ab39-0020af71e433}']
function GetName (pstrNameBuf: PChar; var dwBufLen: DWORD) : HResult; stdcall;
function GetId (var pGuidBuf: TGUID) : HResult; stdcall;
end;
 
IDirectXFileData = interface (IDirectXFileObject)
['{3d82ab44-62da-11cf-ab39-0020af71e433}']
function GetData
(szMember: PChar; var pcbSize: DWORD; var ppvData: Pointer) : HResult; stdcall;
function GetType (var ppguid: PGUID) : HResult; stdcall;
function GetNextObject (var ppChildObj: IDirectXFileObject) : HResult; stdcall;
function AddDataObject (pDataObj: IDirectXFileData) : HResult; stdcall;
function AddDataReference (szRef: PChar; pguidRef: PGUID) : HResult; stdcall;
function AddBinaryObject (szName: PChar; pguid: PGUID; szMimeType: PChar;
pvData: Pointer; cbSize: DWORD) : HResult; stdcall;
end;
 
IDirectXFileDataReference = interface (IDirectXFileObject)
['{3d82ab45-62da-11cf-ab39-0020af71e433}']
function Resolve (var ppDataObj: IDirectXFileData) : HResult; stdcall;
end;
 
IDirectXFileBinary = interface (IDirectXFileObject)
['{3d82ab46-62da-11cf-ab39-0020af71e433}']
function GetSize (var pcbSize: DWORD) : HResult; stdcall;
function GetMimeType (var pszMimeType: PChar) : HResult; stdcall;
function Read(pvData: Pointer; cbSize: DWORD; pcbRead: PDWORD{?}) : HResult; stdcall;
end;
 
const
 
(*
* DirectXFile Object Class Id (for CoCreateInstance())
*)
 
CLSID_CDirectXFile: TGUID =
(D1:$4516ec43;D2:$8f20;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
 
(*
* DirectX File Interface GUIDs.
*)
 
type
IID_IDirectXFile = IDirectXFile;
IID_IDirectXFileEnumObject = IDirectXFileEnumObject;
IID_IDirectXFileSaveObject = IDirectXFileSaveObject;
IID_IDirectXFileObject = IDirectXFileObject;
IID_IDirectXFileData = IDirectXFileData;
IID_IDirectXFileDataReference = IDirectXFileDataReference;
IID_IDirectXFileBinary = IDirectXFileBinary;
 
(*
* DirectX File Header template's GUID.
*)
const
TID_DXFILEHeader: TGUID =
(D1:$3d82ab43;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
(*
* DirectX File errors.
*)
 
const
DXFILE_OK = 0;
 
DXFILEERR_BADOBJECT = MAKE_D3DHRESULT or 850;
DXFILEERR_BADVALUE = MAKE_D3DHRESULT or 851;
DXFILEERR_BADTYPE = MAKE_D3DHRESULT or 852;
DXFILEERR_BADSTREAMHANDLE = MAKE_D3DHRESULT or 853;
DXFILEERR_BADALLOC = MAKE_D3DHRESULT or 854;
DXFILEERR_NOTFOUND = MAKE_D3DHRESULT or 855;
DXFILEERR_NOTDONEYET = MAKE_D3DHRESULT or 856;
DXFILEERR_FILENOTFOUND = MAKE_D3DHRESULT or 857;
DXFILEERR_RESOURCENOTFOUND = MAKE_D3DHRESULT or 858;
DXFILEERR_URLNOTFOUND = MAKE_D3DHRESULT or 859;
DXFILEERR_BADRESOURCE = MAKE_D3DHRESULT or 860;
DXFILEERR_BADFILETYPE = MAKE_D3DHRESULT or 861;
DXFILEERR_BADFILEVERSION = MAKE_D3DHRESULT or 862;
DXFILEERR_BADFILEFLOATSIZE = MAKE_D3DHRESULT or 863;
DXFILEERR_BADFILECOMPRESSIONTYPE = MAKE_D3DHRESULT or 864;
DXFILEERR_BADFILE = MAKE_D3DHRESULT or 865;
DXFILEERR_PARSEERROR = MAKE_D3DHRESULT or 866;
DXFILEERR_NOTEMPLATE = MAKE_D3DHRESULT or 867;
DXFILEERR_BADARRAYSIZE = MAKE_D3DHRESULT or 868;
DXFILEERR_BADDATAREFERENCE = MAKE_D3DHRESULT or 869;
DXFILEERR_INTERNALERROR = MAKE_D3DHRESULT or 870;
DXFILEERR_NOMOREOBJECTS = MAKE_D3DHRESULT or 871;
DXFILEERR_BADINTRINSICS = MAKE_D3DHRESULT or 872;
DXFILEERR_NOMORESTREAMHANDLES = MAKE_D3DHRESULT or 873;
DXFILEERR_NOMOREDATA = MAKE_D3DHRESULT or 874;
DXFILEERR_BADCACHEFILE = MAKE_D3DHRESULT or 875;
DXFILEERR_NOINTERNET = MAKE_D3DHRESULT or 876;
 
{$IFDEF D3DRM}
(*
* API for creating IDirectXFile interface.
*)
 
var
DirectXFileCreate : function
(out lplpDirectXFile: IDirectXFile) : HResult; stdcall;
 
(* D3DRM XFile templates in binary form *)
const
D3DRM_XTEMPLATE_BYTES = 3215;
D3DRM_XTEMPLATES: array [0..D3DRM_XTEMPLATE_BYTES-1] of byte = (
$78, $6f, $66, $20, $30, $33, $30, $32, $62,
$69, $6e, $20, $30, $30, $36, $34, $1f, 0, $1,
0, $6, 0, 0, 0, $48, $65, $61, $64, $65,
$72, $a, 0, $5, 0, $43, $ab, $82, $3d, $da,
$62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4,
$33, $28, 0, $1, 0, $5, 0, 0, 0, $6d,
$61, $6a, $6f, $72, $14, 0, $28, 0, $1, 0,
$5, 0, 0, 0, $6d, $69, $6e, $6f, $72, $14,
0, $29, 0, $1, 0, $5, 0, 0, 0, $66,
$6c, $61, $67, $73, $14, 0, $b, 0, $1f, 0,
$1, 0, $6, 0, 0, 0, $56, $65, $63, $74,
$6f, $72, $a, 0, $5, 0, $5e, $ab, $82, $3d,
$da, $62, $cf, $11, $ab, $39, 0, $20, $af, $71,
$e4, $33, $2a, 0, $1, 0, $1, 0, 0, 0,
$78, $14, 0, $2a, 0, $1, 0, $1, 0, 0,
0, $79, $14, 0, $2a, 0, $1, 0, $1, 0,
0, 0, $7a, $14, 0, $b, 0, $1f, 0, $1,
0, $8, 0, 0, 0, $43, $6f, $6f, $72, $64,
$73, $32, $64, $a, 0, $5, 0, $44, $3f, $f2,
$f6, $86, $76, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $2a, 0, $1, 0, $1, 0, 0,
0, $75, $14, 0, $2a, 0, $1, 0, $1, 0,
0, 0, $76, $14, 0, $b, 0, $1f, 0, $1,
0, $9, 0, 0, 0, $4d, $61, $74, $72, $69,
$78, $34, $78, $34, $a, 0, $5, 0, $45, $3f,
$f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40,
$33, $35, $94, $a3, $34, 0, $2a, 0, $1, 0,
$6, 0, 0, 0, $6d, $61, $74, $72, $69, $78,
$e, 0, $3, 0, $10, 0, 0, 0, $f, 0,
$14, 0, $b, 0, $1f, 0, $1, 0, $9, 0,
0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42,
$41, $a, 0, $5, 0, $e0, $44, $ff, $35, $7c,
$6c, $cf, $11, $8f, $52, 0, $40, $33, $35, $94,
$a3, $2a, 0, $1, 0, $3, 0, 0, 0, $72,
$65, $64, $14, 0, $2a, 0, $1, 0, $5, 0,
0, 0, $67, $72, $65, $65, $6e, $14, 0, $2a,
0, $1, 0, $4, 0, 0, 0, $62, $6c, $75,
$65, $14, 0, $2a, 0, $1, 0, $5, 0, 0,
0, $61, $6c, $70, $68, $61, $14, 0, $b, 0,
$1f, 0, $1, 0, $8, 0, 0, 0, $43, $6f,
$6c, $6f, $72, $52, $47, $42, $a, 0, $5, 0,
$81, $6e, $e1, $d3, $35, $78, $cf, $11, $8f, $52,
0, $40, $33, $35, $94, $a3, $2a, 0, $1, 0,
$3, 0, 0, 0, $72, $65, $64, $14, 0, $2a,
0, $1, 0, $5, 0, 0, 0, $67, $72, $65,
$65, $6e, $14, 0, $2a, 0, $1, 0, $4, 0,
0, 0, $62, $6c, $75, $65, $14, 0, $b, 0,
$1f, 0, $1, 0, $c, 0, 0, 0, $49, $6e,
$64, $65, $78, $65, $64, $43, $6f, $6c, $6f, $72,
$a, 0, $5, 0, $20, $b8, $30, $16, $42, $78,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $5, 0, 0, 0, $69, $6e,
$64, $65, $78, $14, 0, $1, 0, $9, 0, 0,
0, $43, $6f, $6c, $6f, $72, $52, $47, $42, $41,
$1, 0, $a, 0, 0, 0, $69, $6e, $64, $65,
$78, $43, $6f, $6c, $6f, $72, $14, 0, $b, 0,
$1f, 0, $1, 0, $7, 0, 0, 0, $42, $6f,
$6f, $6c, $65, $61, $6e, $a, 0, $5, 0, $a0,
$a6, $7d, $53, $37, $ca, $d0, $11, $94, $1c, 0,
$80, $c8, $c, $fa, $7b, $29, 0, $1, 0, $9,
0, 0, 0, $74, $72, $75, $65, $66, $61, $6c,
$73, $65, $14, 0, $b, 0, $1f, 0, $1, 0,
$9, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61,
$6e, $32, $64, $a, 0, $5, 0, $63, $ae, $85,
$48, $e8, $78, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $1, 0, $7, 0, 0, 0, $42,
$6f, $6f, $6c, $65, $61, $6e, $1, 0, $1, 0,
0, 0, $75, $14, 0, $1, 0, $7, 0, 0,
0, $42, $6f, $6f, $6c, $65, $61, $6e, $1, 0,
$1, 0, 0, 0, $76, $14, 0, $b, 0, $1f,
0, $1, 0, $c, 0, 0, 0, $4d, $61, $74,
$65, $72, $69, $61, $6c, $57, $72, $61, $70, $a,
0, $5, 0, $60, $ae, $85, $48, $e8, $78, $cf,
$11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1,
0, $7, 0, 0, 0, $42, $6f, $6f, $6c, $65,
$61, $6e, $1, 0, $1, 0, 0, 0, $75, $14,
0, $1, 0, $7, 0, 0, 0, $42, $6f, $6f,
$6c, $65, $61, $6e, $1, 0, $1, 0, 0, 0,
$76, $14, 0, $b, 0, $1f, 0, $1, 0, $f,
0, 0, 0, $54, $65, $78, $74, $75, $72, $65,
$46, $69, $6c, $65, $6e, $61, $6d, $65, $a, 0,
$5, 0, $e1, $90, $27, $a4, $10, $78, $cf, $11,
$8f, $52, 0, $40, $33, $35, $94, $a3, $31, 0,
$1, 0, $8, 0, 0, 0, $66, $69, $6c, $65,
$6e, $61, $6d, $65, $14, 0, $b, 0, $1f, 0,
$1, 0, $8, 0, 0, 0, $4d, $61, $74, $65,
$72, $69, $61, $6c, $a, 0, $5, 0, $4d, $ab,
$82, $3d, $da, $62, $cf, $11, $ab, $39, 0, $20,
$af, $71, $e4, $33, $1, 0, $9, 0, 0, 0,
$43, $6f, $6c, $6f, $72, $52, $47, $42, $41, $1,
0, $9, 0, 0, 0, $66, $61, $63, $65, $43,
$6f, $6c, $6f, $72, $14, 0, $2a, 0, $1, 0,
$5, 0, 0, 0, $70, $6f, $77, $65, $72, $14,
0, $1, 0, $8, 0, 0, 0, $43, $6f, $6c,
$6f, $72, $52, $47, $42, $1, 0, $d, 0, 0,
0, $73, $70, $65, $63, $75, $6c, $61, $72, $43,
$6f, $6c, $6f, $72, $14, 0, $1, 0, $8, 0,
0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42,
$1, 0, $d, 0, 0, 0, $65, $6d, $69, $73,
$73, $69, $76, $65, $43, $6f, $6c, $6f, $72, $14,
0, $e, 0, $12, 0, $12, 0, $12, 0, $f,
0, $b, 0, $1f, 0, $1, 0, $8, 0, 0,
0, $4d, $65, $73, $68, $46, $61, $63, $65, $a,
0, $5, 0, $5f, $ab, $82, $3d, $da, $62, $cf,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $29,
0, $1, 0, $12, 0, 0, 0, $6e, $46, $61,
$63, $65, $56, $65, $72, $74, $65, $78, $49, $6e,
$64, $69, $63, $65, $73, $14, 0, $34, 0, $29,
0, $1, 0, $11, 0, 0, 0, $66, $61, $63,
$65, $56, $65, $72, $74, $65, $78, $49, $6e, $64,
$69, $63, $65, $73, $e, 0, $1, 0, $12, 0,
0, 0, $6e, $46, $61, $63, $65, $56, $65, $72,
$74, $65, $78, $49, $6e, $64, $69, $63, $65, $73,
$f, 0, $14, 0, $b, 0, $1f, 0, $1, 0,
$d, 0, 0, 0, $4d, $65, $73, $68, $46, $61,
$63, $65, $57, $72, $61, $70, $73, $a, 0, $5,
0, $c0, $c5, $1e, $ed, $a8, $c0, $d0, $11, $94,
$1c, 0, $80, $c8, $c, $fa, $7b, $29, 0, $1,
0, $f, 0, 0, 0, $6e, $46, $61, $63, $65,
$57, $72, $61, $70, $56, $61, $6c, $75, $65, $73,
$14, 0, $34, 0, $1, 0, $9, 0, 0, 0,
$42, $6f, $6f, $6c, $65, $61, $6e, $32, $64, $1,
0, $e, 0, 0, 0, $66, $61, $63, $65, $57,
$72, $61, $70, $56, $61, $6c, $75, $65, $73, $e,
0, $1, 0, $f, 0, 0, 0, $6e, $46, $61,
$63, $65, $57, $72, $61, $70, $56, $61, $6c, $75,
$65, $73, $f, 0, $14, 0, $b, 0, $1f, 0,
$1, 0, $11, 0, 0, 0, $4d, $65, $73, $68,
$54, $65, $78, $74, $75, $72, $65, $43, $6f, $6f,
$72, $64, $73, $a, 0, $5, 0, $40, $3f, $f2,
$f6, $86, $76, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $29, 0, $1, 0, $e, 0, 0,
0, $6e, $54, $65, $78, $74, $75, $72, $65, $43,
$6f, $6f, $72, $64, $73, $14, 0, $34, 0, $1,
0, $8, 0, 0, 0, $43, $6f, $6f, $72, $64,
$73, $32, $64, $1, 0, $d, 0, 0, 0, $74,
$65, $78, $74, $75, $72, $65, $43, $6f, $6f, $72,
$64, $73, $e, 0, $1, 0, $e, 0, 0, 0,
$6e, $54, $65, $78, $74, $75, $72, $65, $43, $6f,
$6f, $72, $64, $73, $f, 0, $14, 0, $b, 0,
$1f, 0, $1, 0, $10, 0, 0, 0, $4d, $65,
$73, $68, $4d, $61, $74, $65, $72, $69, $61, $6c,
$4c, $69, $73, $74, $a, 0, $5, 0, $42, $3f,
$f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40,
$33, $35, $94, $a3, $29, 0, $1, 0, $a, 0,
0, 0, $6e, $4d, $61, $74, $65, $72, $69, $61,
$6c, $73, $14, 0, $29, 0, $1, 0, $c, 0,
0, 0, $6e, $46, $61, $63, $65, $49, $6e, $64,
$65, $78, $65, $73, $14, 0, $34, 0, $29, 0,
$1, 0, $b, 0, 0, 0, $66, $61, $63, $65,
$49, $6e, $64, $65, $78, $65, $73, $e, 0, $1,
0, $c, 0, 0, 0, $6e, $46, $61, $63, $65,
$49, $6e, $64, $65, $78, $65, $73, $f, 0, $14,
0, $e, 0, $1, 0, $8, 0, 0, 0, $4d,
$61, $74, $65, $72, $69, $61, $6c, $f, 0, $b,
0, $1f, 0, $1, 0, $b, 0, 0, 0, $4d,
$65, $73, $68, $4e, $6f, $72, $6d, $61, $6c, $73,
$a, 0, $5, 0, $43, $3f, $f2, $f6, $86, $76,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $8, 0, 0, 0, $6e, $4e,
$6f, $72, $6d, $61, $6c, $73, $14, 0, $34, 0,
$1, 0, $6, 0, 0, 0, $56, $65, $63, $74,
$6f, $72, $1, 0, $7, 0, 0, 0, $6e, $6f,
$72, $6d, $61, $6c, $73, $e, 0, $1, 0, $8,
0, 0, 0, $6e, $4e, $6f, $72, $6d, $61, $6c,
$73, $f, 0, $14, 0, $29, 0, $1, 0, $c,
0, 0, 0, $6e, $46, $61, $63, $65, $4e, $6f,
$72, $6d, $61, $6c, $73, $14, 0, $34, 0, $1,
0, $8, 0, 0, 0, $4d, $65, $73, $68, $46,
$61, $63, $65, $1, 0, $b, 0, 0, 0, $66,
$61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73,
$e, 0, $1, 0, $c, 0, 0, 0, $6e, $46,
$61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73,
$f, 0, $14, 0, $b, 0, $1f, 0, $1, 0,
$10, 0, 0, 0, $4d, $65, $73, $68, $56, $65,
$72, $74, $65, $78, $43, $6f, $6c, $6f, $72, $73,
$a, 0, $5, 0, $21, $b8, $30, $16, $42, $78,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $d, 0, 0, 0, $6e, $56,
$65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72,
$73, $14, 0, $34, 0, $1, 0, $c, 0, 0,
0, $49, $6e, $64, $65, $78, $65, $64, $43, $6f,
$6c, $6f, $72, $1, 0, $c, 0, 0, 0, $76,
$65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72,
$73, $e, 0, $1, 0, $d, 0, 0, 0, $6e,
$56, $65, $72, $74, $65, $78, $43, $6f, $6c, $6f,
$72, $73, $f, 0, $14, 0, $b, 0, $1f, 0,
$1, 0, $4, 0, 0, 0, $4d, $65, $73, $68,
$a, 0, $5, 0, $44, $ab, $82, $3d, $da, $62,
$cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33,
$29, 0, $1, 0, $9, 0, 0, 0, $6e, $56,
$65, $72, $74, $69, $63, $65, $73, $14, 0, $34,
0, $1, 0, $6, 0, 0, 0, $56, $65, $63,
$74, $6f, $72, $1, 0, $8, 0, 0, 0, $76,
$65, $72, $74, $69, $63, $65, $73, $e, 0, $1,
0, $9, 0, 0, 0, $6e, $56, $65, $72, $74,
$69, $63, $65, $73, $f, 0, $14, 0, $29, 0,
$1, 0, $6, 0, 0, 0, $6e, $46, $61, $63,
$65, $73, $14, 0, $34, 0, $1, 0, $8, 0,
0, 0, $4d, $65, $73, $68, $46, $61, $63, $65,
$1, 0, $5, 0, 0, 0, $66, $61, $63, $65,
$73, $e, 0, $1, 0, $6, 0, 0, 0, $6e,
$46, $61, $63, $65, $73, $f, 0, $14, 0, $e,
0, $12, 0, $12, 0, $12, 0, $f, 0, $b,
0, $1f, 0, $1, 0, $14, 0, 0, 0, $46,
$72, $61, $6d, $65, $54, $72, $61, $6e, $73, $66,
$6f, $72, $6d, $4d, $61, $74, $72, $69, $78, $a,
0, $5, 0, $41, $3f, $f2, $f6, $86, $76, $cf,
$11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1,
0, $9, 0, 0, 0, $4d, $61, $74, $72, $69,
$78, $34, $78, $34, $1, 0, $b, 0, 0, 0,
$66, $72, $61, $6d, $65, $4d, $61, $74, $72, $69,
$78, $14, 0, $b, 0, $1f, 0, $1, 0, $5,
0, 0, 0, $46, $72, $61, $6d, $65, $a, 0,
$5, 0, $46, $ab, $82, $3d, $da, $62, $cf, $11,
$ab, $39, 0, $20, $af, $71, $e4, $33, $e, 0,
$12, 0, $12, 0, $12, 0, $f, 0, $b, 0,
$1f, 0, $1, 0, $9, 0, 0, 0, $46, $6c,
$6f, $61, $74, $4b, $65, $79, $73, $a, 0, $5,
0, $a9, $46, $dd, $10, $5b, $77, $cf, $11, $8f,
$52, 0, $40, $33, $35, $94, $a3, $29, 0, $1,
0, $7, 0, 0, 0, $6e, $56, $61, $6c, $75,
$65, $73, $14, 0, $34, 0, $2a, 0, $1, 0,
$6, 0, 0, 0, $76, $61, $6c, $75, $65, $73,
$e, 0, $1, 0, $7, 0, 0, 0, $6e, $56,
$61, $6c, $75, $65, $73, $f, 0, $14, 0, $b,
0, $1f, 0, $1, 0, $e, 0, 0, 0, $54,
$69, $6d, $65, $64, $46, $6c, $6f, $61, $74, $4b,
$65, $79, $73, $a, 0, $5, 0, $80, $b1, $6,
$f4, $3b, $7b, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $29, 0, $1, 0, $4, 0, 0,
0, $74, $69, $6d, $65, $14, 0, $1, 0, $9,
0, 0, 0, $46, $6c, $6f, $61, $74, $4b, $65,
$79, $73, $1, 0, $6, 0, 0, 0, $74, $66,
$6b, $65, $79, $73, $14, 0, $b, 0, $1f, 0,
$1, 0, $c, 0, 0, 0, $41, $6e, $69, $6d,
$61, $74, $69, $6f, $6e, $4b, $65, $79, $a, 0,
$5, 0, $a8, $46, $dd, $10, $5b, $77, $cf, $11,
$8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0,
$1, 0, $7, 0, 0, 0, $6b, $65, $79, $54,
$79, $70, $65, $14, 0, $29, 0, $1, 0, $5,
0, 0, 0, $6e, $4b, $65, $79, $73, $14, 0,
$34, 0, $1, 0, $e, 0, 0, 0, $54, $69,
$6d, $65, $64, $46, $6c, $6f, $61, $74, $4b, $65,
$79, $73, $1, 0, $4, 0, 0, 0, $6b, $65,
$79, $73, $e, 0, $1, 0, $5, 0, 0, 0,
$6e, $4b, $65, $79, $73, $f, 0, $14, 0, $b,
0, $1f, 0, $1, 0, $10, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $4f, $70,
$74, $69, $6f, $6e, $73, $a, 0, $5, 0, $c0,
$56, $bf, $e2, $f, $84, $cf, $11, $8f, $52, 0,
$40, $33, $35, $94, $a3, $29, 0, $1, 0, $a,
0, 0, 0, $6f, $70, $65, $6e, $63, $6c, $6f,
$73, $65, $64, $14, 0, $29, 0, $1, 0, $f,
0, 0, 0, $70, $6f, $73, $69, $74, $69, $6f,
$6e, $71, $75, $61, $6c, $69, $74, $79, $14, 0,
$b, 0, $1f, 0, $1, 0, $9, 0, 0, 0,
$41, $6e, $69, $6d, $61, $74, $69, $6f, $6e, $a,
0, $5, 0, $4f, $ab, $82, $3d, $da, $62, $cf,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $e,
0, $12, 0, $12, 0, $12, 0, $f, 0, $b,
0, $1f, 0, $1, 0, $c, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $53, $65,
$74, $a, 0, $5, 0, $50, $ab, $82, $3d, $da,
$62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4,
$33, $e, 0, $1, 0, $9, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $f, 0,
$b, 0, $1f, 0, $1, 0, $a, 0, 0, 0,
$49, $6e, $6c, $69, $6e, $65, $44, $61, $74, $61,
$a, 0, $5, 0, $a0, $ee, $23, $3a, $b1, $94,
$d0, $11, $ab, $39, 0, $20, $af, $71, $e4, $33,
$e, 0, $1, 0, $6, 0, 0, 0, $42, $49,
$4e, $41, $52, $59, $f, 0, $b, 0, $1f, 0,
$1, 0, $3, 0, 0, 0, $55, $72, $6c, $a,
0, $5, 0, $a1, $ee, $23, $3a, $b1, $94, $d0,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $29,
0, $1, 0, $5, 0, 0, 0, $6e, $55, $72,
$6c, $73, $14, 0, $34, 0, $31, 0, $1, 0,
$4, 0, 0, 0, $75, $72, $6c, $73, $e, 0,
$1, 0, $5, 0, 0, 0, $6e, $55, $72, $6c,
$73, $f, 0, $14, 0, $b, 0, $1f, 0, $1,
0, $f, 0, 0, 0, $50, $72, $6f, $67, $72,
$65, $73, $73, $69, $76, $65, $4d, $65, $73, $68,
$a, 0, $5, 0, $60, $c3, $63, $8a, $7d, $99,
$d0, $11, $94, $1c, 0, $80, $c8, $c, $fa, $7b,
$e, 0, $1, 0, $3, 0, 0, 0, $55, $72,
$6c, $13, 0, $1, 0, $a, 0, 0, 0, $49,
$6e, $6c, $69, $6e, $65, $44, $61, $74, $61, $f,
0, $b, 0, $1f, 0, $1, 0, $4, 0, 0,
0, $47, $75, $69, $64, $a, 0, $5, 0, $e0,
$90, $27, $a4, $10, $78, $cf, $11, $8f, $52, 0,
$40, $33, $35, $94, $a3, $29, 0, $1, 0, $5,
0, 0, 0, $64, $61, $74, $61, $31, $14, 0,
$28, 0, $1, 0, $5, 0, 0, 0, $64, $61,
$74, $61, $32, $14, 0, $28, 0, $1, 0, $5,
0, 0, 0, $64, $61, $74, $61, $33, $14, 0,
$34, 0, $2d, 0, $1, 0, $5, 0, 0, 0,
$64, $61, $74, $61, $34, $e, 0, $3, 0, $8,
0, 0, 0, $f, 0, $14, 0, $b, 0, $1f,
0, $1, 0, $e, 0, 0, 0, $53, $74, $72,
$69, $6e, $67, $50, $72, $6f, $70, $65, $72, $74,
$79, $a, 0, $5, 0, $e0, $21, $f, $7f, $e1,
$bf, $d1, $11, $82, $c0, 0, $a0, $c9, $69, $72,
$71, $31, 0, $1, 0, $3, 0, 0, 0, $6b,
$65, $79, $14, 0, $31, 0, $1, 0, $5, 0,
0, 0, $76, $61, $6c, $75, $65, $14, 0, $b,
0, $1f, 0, $1, 0, $b, 0, 0, 0, $50,
$72, $6f, $70, $65, $72, $74, $79, $42, $61, $67,
$a, 0, $5, 0, $e1, $21, $f, $7f, $e1, $bf,
$d1, $11, $82, $c0, 0, $a0, $c9, $69, $72, $71,
$e, 0, $1, 0, $e, 0, 0, 0, $53, $74,
$72, $69, $6e, $67, $50, $72, $6f, $70, $65, $72,
$74, $79, $f, 0, $b, 0, $1f, 0, $1, 0,
$e, 0, 0, 0, $45, $78, $74, $65, $72, $6e,
$61, $6c, $56, $69, $73, $75, $61, $6c, $a, 0,
$5, 0, $a0, $6a, $11, $98, $ba, $bd, $d1, $11,
$82, $c0, 0, $a0, $c9, $69, $72, $71, $1, 0,
$4, 0, 0, 0, $47, $75, $69, $64, $1, 0,
$12, 0, 0, 0, $67, $75, $69, $64, $45, $78,
$74, $65, $72, $6e, $61, $6c, $56, $69, $73, $75,
$61, $6c, $14, 0, $e, 0, $12, 0, $12, 0,
$12, 0, $f, 0, $b, 0);
 
//---------------
 
//Direct3DRM file
(*==========================================================================;
*
* Copyright (C) 1994-1997 Microsoft Corporation. All Rights Reserved.
*
* Files: D3DRMDef.h D3DRMObj.h D3DRM.h D3DRMWin.h RMXFGUID.h RMXFTmpl.h
* Content: Direct3D Retained Mode include files
*
* DirectX 7.0 Delphi adaptation by Erik Unger
*
* Modified: 10-Sep-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
*
***************************************************************************)
 
var
D3DRMDLL : HMODULE = 0;
 
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3drmdef.h
5690,64 → 9280,37
*
***************************************************************************)
 
{ TD3DRMVector4D structure }
 
type
PD3DRMVector4D = ^TD3DRMVector4D;
TD3DRMVector4D = record
TD3DRMVector4D = packed record
x, y, z, w: TD3DValue;
end;
 
D3DRMVECTOR4D = TD3DRMVector4D;
LPD3DRMVECTOR4D = PD3DRMVector4D;
 
{ TD3DRMMatrix4D structure }
 
PD3DRMMatrix4D = ^TD3DRMMatrix4D;
TD3DRMMatrix4D = array[0..3, 0..3] of TD3DValue;
D3DRMMATRIX4D = TD3DRMMatrix4D;
 
{ TD3DRMQuaternion structure }
 
PD3DRMQuaternion = ^TD3DRMQuaternion;
TD3DRMQuaternion = record
TD3DRMQuaternion = packed record
s: TD3DValue;
v: TD3DVector;
end;
 
D3DRMQUATERNION = TD3DRMQuaternion;
LPD3DRMQUATERNION = PD3DRMQUATERNION;
 
{ TD3DRMRay structure }
 
PD3DRMRay = ^TD3DRMRay;
TD3DRMRay = record
TD3DRMRay = packed record
dvDir: TD3DVector;
dvPos: TD3DVector;
end;
 
D3DRMRAY = TD3DRMRay;
LPD3DRMRAY = PD3DRMRay;
 
{ TD3DRMBox structure }
 
PD3DRMBox = ^TD3DRMBox;
TD3DRMBox = record
TD3DRMBox = packed record
min, max: TD3DVector;
end;
 
D3DRMBOX = TD3DRMBox;
LPD3DRMBOX = PD3DRMBox;
TD3DRMWrapCallback = procedure (var lpD3DVector: TD3DVector;
var lpU, lpV: Integer; var lpD3DRMVA, lpD3DRMVB: TD3DVector; lpArg:
Pointer); stdcall; // unused ?
 
{ TD3DRMWrapCallback }
 
TD3DRMWrapCallback = procedure(var lpD3DVector: TD3DVector; var lpU: Integer;
var lpV: Integer; var lpD3DRMVA: TD3DVector; lpD3DRMVB: TD3DVector;
lpArg: Pointer); stdcall;
 
D3DRMWRAPCALLBACK = TD3DRMWrapCallback;
 
{ TD3DRMLightType }
 
PD3DRMLightType = ^TD3DRMLightType; // is it 16 or 32 bit ?
TD3DRMLightType = (
D3DRMLIGHT_AMBIENT,
D3DRMLIGHT_POINT,
5756,13 → 9319,9
D3DRMLIGHT_PARALLELPOINT
);
 
D3DRMLIGHTTYPE = TD3DRMLightType;
PD3DRMShadeMode = ^TD3DRMShadeMode;
TD3DRMShadeMode = WORD;
 
{ TD3DRMShadeMode }
 
TD3DRMShadeMode = Word;
D3DRMSHADEMODE = TD3DRMShadeMode;
 
const
D3DRMSHADE_FLAT = 0;
D3DRMSHADE_GOURAUD = 1;
5770,11 → 9329,9
D3DRMSHADE_MASK = 7;
D3DRMSHADE_MAX = 8;
 
{ TD3DRMLightMode }
 
type
TD3DRMLightMode = Word;
D3DRMLIGHTMODE = TD3DRMLightMode;
PD3DRMLightMode = ^TD3DRMLightMode;
TD3DRMLightMode = WORD;
 
const
D3DRMLIGHT_OFF = 0 * D3DRMSHADE_MAX;
5782,11 → 9339,9
D3DRMLIGHT_MASK = 7 * D3DRMSHADE_MAX;
D3DRMLIGHT_MAX = 8 * D3DRMSHADE_MAX;
 
{ TD3DRMFillMode }
 
type
TD3DRMFillMode = Word;
D3DRMFILLMODE = TD3DRMFillMode;
PD3DRMFillMode = ^TD3DRMFillMode;
TD3DRMFillMode = WORD;
 
const
D3DRMFILL_POINTS = 0 * D3DRMLIGHT_MAX;
5795,60 → 9350,59
D3DRMFILL_MASK = 7 * D3DRMLIGHT_MAX;
D3DRMFILL_MAX = 8 * D3DRMLIGHT_MAX;
 
{ TD3DRMRenderQuality }
 
type
PD3DRMRenderQuality = ^TD3DRMRenderQuality;
TD3DRMRenderQuality = DWORD;
D3DRMRENDERQUALITY = TD3DRMRenderQuality;
 
const
D3DRMRENDER_WIREFRAME = D3DRMSHADE_FLAT + D3DRMLIGHT_OFF + D3DRMFILL_WIREFRAME;
D3DRMRENDER_UNLITFLAT = D3DRMSHADE_FLAT + D3DRMLIGHT_OFF + D3DRMFILL_SOLID;
D3DRMRENDER_FLAT = D3DRMSHADE_FLAT + D3DRMLIGHT_ON + D3DRMFILL_SOLID;
D3DRMRENDER_GOURAUD = D3DRMSHADE_GOURAUD + D3DRMLIGHT_ON + D3DRMFILL_SOLID;
D3DRMRENDER_PHONG = D3DRMSHADE_PHONG + D3DRMLIGHT_ON + D3DRMFILL_SOLID;
D3DRMRENDER_WIREFRAME =
(D3DRMSHADE_FLAT + D3DRMLIGHT_OFF + D3DRMFILL_WIREFRAME);
D3DRMRENDER_UNLITFLAT =
(D3DRMSHADE_FLAT + D3DRMLIGHT_OFF + D3DRMFILL_SOLID);
D3DRMRENDER_FLAT =
(D3DRMSHADE_FLAT + D3DRMLIGHT_ON + D3DRMFILL_SOLID);
D3DRMRENDER_GOURAUD =
(D3DRMSHADE_GOURAUD + D3DRMLIGHT_ON + D3DRMFILL_SOLID);
D3DRMRENDER_PHONG =
(D3DRMSHADE_PHONG + D3DRMLIGHT_ON + D3DRMFILL_SOLID);
 
D3DRMRENDERMODE_BLENDEDTRANSPARENCY = 1;
D3DRMRENDERMODE_SORTEDTRANSPARENCY = 2;
D3DRMRENDERMODE_LIGHTINMODELSPACE = 8;
D3DRMRENDERMODE_VIEWDEPENDENTSPECULAR = 16;
D3DRMRENDERMODE_DISABLESORTEDALPHAZWRITE = 32;
 
{ TD3DRMTextureQuality }
 
type
PD3DRMTextureQuality = ^TD3DRMTextureQuality;
TD3DRMTextureQuality = (
D3DRMTEXTURE_NEAREST, // choose nearest texel
D3DRMTEXTURE_LINEAR, // interpolate 4 texels
D3DRMTEXTURE_MIPNEAREST, // nearest texel in nearest mipmap
D3DRMTEXTURE_MIPLINEAR, // interpolate 2 texels from 2 mipmaps
D3DRMTEXTURE_LINEARMIPNEAREST, // interpolate 4 texels in nearest mipmap
D3DRMTEXTURE_LINEARMIPLINEAR // interpolate 8 texels from 2 mipmaps
D3DRMTEXTURE_NEAREST, (* choose nearest texel *)
D3DRMTEXTURE_LINEAR, (* interpolate 4 texels *)
D3DRMTEXTURE_MIPNEAREST, (* nearest texel in nearest mipmap *)
D3DRMTEXTURE_MIPLINEAR, (* interpolate 2 texels from 2 mipmaps *)
D3DRMTEXTURE_LINEARMIPNEAREST, (* interpolate 4 texels in nearest mipmap *)
D3DRMTEXTURE_LINEARMIPLINEAR (* interpolate 8 texels from 2 mipmaps *)
);
 
D3DRMTEXTUREQUALITY = TD3DRMTextureQuality;
 
{ Texture flags }
 
const
D3DRMTEXTURE_FORCERESIDENT = $00000001; // texture should be kept in video memory
D3DRMTEXTURE_STATIC = $00000002; // texture will not change
D3DRMTEXTURE_DOWNSAMPLEPOINT = $00000004; // point filtering should be used when downsampling
D3DRMTEXTURE_DOWNSAMPLEBILINEAR = $00000008; // bilinear filtering should be used when downsampling
D3DRMTEXTURE_DOWNSAMPLEREDUCEDEPTH = $00000010; // reduce bit depth when downsampling
D3DRMTEXTURE_DOWNSAMPLENONE = $00000020; // texture should never be downsampled
D3DRMTEXTURE_CHANGEDPIXELS = $00000040; // pixels have changed
D3DRMTEXTURE_CHANGEDPALETTE = $00000080; // palette has changed
D3DRMTEXTURE_INVALIDATEONLY = $00000100; // dirty regions are invalid
(*
* Texture flags
*)
D3DRMTEXTURE_FORCERESIDENT = $00000001; (* texture should be kept in video memory *)
D3DRMTEXTURE_STATIC = $00000002; (* texture will not change *)
D3DRMTEXTURE_DOWNSAMPLEPOINT = $00000004; (* point filtering should be used when downsampling *)
D3DRMTEXTURE_DOWNSAMPLEBILINEAR = $00000008; (* bilinear filtering should be used when downsampling *)
D3DRMTEXTURE_DOWNSAMPLEREDUCEDEPTH = $00000010; (* reduce bit depth when downsampling *)
D3DRMTEXTURE_DOWNSAMPLENONE = $00000020; (* texture should never be downsampled *)
D3DRMTEXTURE_CHANGEDPIXELS = $00000040; (* pixels have changed *)
D3DRMTEXTURE_CHANGEDPALETTE = $00000080; (* palette has changed *)
D3DRMTEXTURE_INVALIDATEONLY = $00000100; (* dirty regions are invalid *)
 
{ Shadow flags }
(*
* Shadow flags
*)
D3DRMSHADOW_TRUEALPHA = $00000001; (* shadow should render without artifacts when true alpha is on *)
 
const
D3DRMSHADOW_TRUEALPHA = $00000001; // shadow should render without artifacts when true alpha is on
 
{ TD3DRMCombineType }
 
type
PD3DRMCombineType = ^TD3DRMCombineType;
TD3DRMCombineType = (
D3DRMCOMBINE_REPLACE,
D3DRMCOMBINE_BEFORE,
5855,40 → 9409,26
D3DRMCOMBINE_AFTER
);
 
D3DRMCOMBINETYPE = TD3DRMCombineType;
 
{ TD3DRMColorModel }
 
PD3DRMColorModel = ^TD3DRMColorModel;
TD3DRMColorModel = TD3DColorModel;
D3DRMCOLORMODEL = TD3DRMColorModel;
 
{ TD3DRMPaletteFlags }
 
PD3DRMPaletteFlags = ^TD3DRMPaletteFlags;
TD3DRMPaletteFlags = (
D3DRMPALETTE_FREE, // renderer may use this entry freely
D3DRMPALETTE_READONLY, // fixed but may be used by renderer
D3DRMPALETTE_RESERVED // may not be used by renderer
D3DRMPALETTE_FREE, (* renderer may use this entry freely *)
D3DRMPALETTE_READONLY, (* fixed but may be used by renderer *)
D3DRMPALETTE_RESERVED (* may not be used by renderer *)
);
 
D3DRMPALETTEFLAGS = TD3DRMPaletteFlags;
 
{ TD3DRMPaletteEntry structure }
 
PD3DRMPaletteEntry = ^TD3DRMPaletteEntry;
TD3DRMPaletteEntry = record
red: Byte; // 0 .. 255
green: Byte; // 0 .. 255
blue: Byte; // 0 .. 255
flags: Byte; // one of TD3DRMPaletteFlags
TD3DRMPaletteEntry = packed record
red: Byte; (* 0 .. 255 *)
green: Byte; (* 0 .. 255 *)
blue: Byte; (* 0 .. 255 *)
flags: Byte; (* one of D3DRMPALETTEFLAGS *)
end;
 
D3DRMPALETTEENTRY = TD3DRMPaletteEntry;
LPD3DRMPALETTEENTRY = PD3DRMPaletteEntry;
 
{ TD3DRMImage structure }
 
PD3DRMImage = ^TD3DRMImage;
TD3DRMImage = record
TD3DRMImage = packed record
width, height: Integer; (* width and height in pixels *)
aspectx, aspecty: Integer; (* aspect ratio for non-square pixels *)
depth: Integer; (* bits per pixel *)
5902,10 → 9442,10
buffer2: Pointer; (* second rendering buffer for double
buffering, set to NULL for single
buffering. *)
red_mask: Longint;
green_mask: Longint;
blue_mask: Longint;
alpha_mask: Longint; (* if rgb is true, these are masks for
red_mask: DWORD;
green_mask: DWORD;
blue_mask: DWORD;
alpha_mask: DWORD; (* if rgb is true, these are masks for
the red, green and blue parts of a
pixel. Otherwise, these are masks
for the significant bits of the
5920,11 → 9460,7
elements. *)
end;
 
D3DRMIMAGE = TD3DRMImage;
LPD3DRMIMAGE = PD3DRMImage;
 
{ TD3DRMWrapType }
 
PD3DRMWrapType = ^TD3DRMWrapType;
TD3DRMWrapType = (
D3DRMWRAP_FLAT,
D3DRMWRAP_CYLINDER,
5934,31 → 9470,29
D3DRMWRAP_BOX
);
 
D3DRMWRAPTYPE = TD3DRMWrapType;
 
const
D3DRMWIREFRAME_CULL = 1; // cull backfaces
D3DRMWIREFRAME_HIDDENLINE = 2; // lines are obscured by closer objects
D3DRMWIREFRAME_CULL = 1; (* cull backfaces *)
D3DRMWIREFRAME_HIDDENLINE = 2; (* lines are obscured by closer objects *)
 
{ TD3DRMProjectionType }
 
type
(*
* Do not use righthanded perspective in Viewport2::SetProjection().
* Set up righthanded mode by using IDirect3DRM3::SetOptions().
*)
PD3DRMProjectionType = ^TD3DRMProjectionType;
TD3DRMProjectionType = (
D3DRMPROJECT_PERSPECTIVE,
D3DRMPROJECT_ORTHOGRAPHIC,
D3DRMPROJECT_RIGHTHANDPERSPECTIVE, // Only valid pre-DX6
D3DRMPROJECT_RIGHTHANDORTHOGRAPHIC // Only valid pre-DX6
D3DRMPROJECT_RIGHTHANDPERSPECTIVE, (* Only valid pre-DX6 *)
D3DRMPROJECT_RIGHTHANDORTHOGRAPHIC (* Only valid pre-DX6 *)
);
 
D3DRMPROJECTIONTYPE = TD3DRMProjectionType;
 
const
D3DRMOPTIONS_LEFTHANDED = $00000001; // Default
D3DRMOPTIONS_RIGHTHANDED = $00000002;
D3DRMOPTIONS_LEFTHANDED = 00000001; (* Default *)
D3DRMOPTIONS_RIGHTHANDED = 00000002;
 
{ TD3DRMXOFFormat }
 
type
PD3DRMXOFFormat = ^TD3DRMXOFFormat;
TD3DRMXOFFormat = (
D3DRMXOF_BINARY,
D3DRMXOF_COMPRESSED,
5965,13 → 9499,7
D3DRMXOF_TEXT
);
 
D3DRMXOFFORMAT = TD3DRMXOFFormat;
 
{ TD3DRMSaveOptions }
 
TD3DRMSaveOptions = DWORD;
D3DRMSAVEOPTIONS = TD3DRMSaveOptions;
 
const
D3DRMXOFSAVE_NORMALS = 1;
D3DRMXOFSAVE_TEXTURECOORDINATES = 2;
5981,28 → 9509,21
D3DRMXOFSAVE_TEMPLATES = 16;
D3DRMXOFSAVE_TEXTURETOPOLOGY = 32;
 
{ TD3DRMColorSource }
 
type
PD3DRMColorSource = ^TD3DRMColorSource;
TD3DRMColorSource = (
D3DRMCOLOR_FROMFACE,
D3DRMCOLOR_FROMVERTEX
);
 
D3DRMCOLORSOURCE = TD3DRMColorSource;
 
{ TD3DRMFrameConstraint }
 
PD3DRMFrameConstraint = ^TD3DRMFrameConstraint;
TD3DRMFrameConstraint = (
D3DRMCONSTRAIN_Z, // use only X and Y rotations
D3DRMCONSTRAIN_Y, // use only X and Z rotations
D3DRMCONSTRAIN_X // use only Y and Z rotations
D3DRMCONSTRAIN_Z, (* use only X and Y rotations *)
D3DRMCONSTRAIN_Y, (* use only X and Z rotations *)
D3DRMCONSTRAIN_X (* use only Y and Z rotations *)
);
 
D3DRMFRAMECONSTRAINT = TD3DRMFrameConstraint;
 
{ TD3DRMMaterialMode }
 
PD3DRMMaterialMode = ^TD3DRMMaterialMode;
TD3DRMMaterialMode = (
D3DRMMATERIAL_FROMMESH,
D3DRMMATERIAL_FROMPARENT,
6009,56 → 9530,39
D3DRMMATERIAL_FROMFRAME
);
 
D3DRMMATERIALMODE = TD3DRMMaterialMode;
 
{ TD3DRMFogMode }
 
PD3DRMFogMode = ^TD3DRMFogMode;
TD3DRMFogMode = (
D3DRMFOG_LINEAR, // linear between start and end
D3DRMFOG_EXPONENTIAL, // density * exp(-distance)
D3DRMFOG_EXPONENTIALSQUARED // density * exp(-distance*distance)
D3DRMFOG_LINEAR, (* linear between start and end *)
D3DRMFOG_EXPONENTIAL, (* density * exp(-distance) *)
D3DRMFOG_EXPONENTIALSQUARED (* density * exp(-distance*distance) *)
);
 
D3DRMFOGMODE = TD3DRMFogMode;
 
{ TD3DRMZBufferMode }
 
PD3DRMZBufferMode = ^TD3DRMZBufferMode;
TD3DRMZBufferMode = (
D3DRMZBUFFER_FROMPARENT, // default
D3DRMZBUFFER_ENABLE, // enable zbuffering
D3DRMZBUFFER_DISABLE // disable zbuffering
D3DRMZBUFFER_FROMPARENT, (* default *)
D3DRMZBUFFER_ENABLE, (* enable zbuffering *)
D3DRMZBUFFER_DISABLE (* disable zbuffering *)
);
 
D3DRMZBUFFERMODE = TD3DRMZBufferMode;
 
{ TD3DRMSortMode }
 
PD3DRMSortMode = ^TD3DRMSortMode;
TD3DRMSortMode = (
D3DRMSORT_FROMPARENT, // default
D3DRMSORT_NONE, // don't sort child frames
D3DRMSORT_FRONTTOBACK, // sort child frames front-to-back
D3DRMSORT_BACKTOFRONT // sort child frames back-to-front
D3DRMSORT_FROMPARENT, (* default *)
D3DRMSORT_NONE, (* don't sort child frames *)
D3DRMSORT_FRONTTOBACK, (* sort child frames front-to-back *)
D3DRMSORT_BACKTOFRONT (* sort child frames back-to-front *)
);
 
D3DRMSORTMODE = TD3DRMSortMode;
 
{ TD3DRMMaterialOverride structure }
 
PD3DRMMaterialOverride = ^TD3DRMMaterialOverride;
TD3DRMMaterialOverride = record
dwSize: DWORD; // Size of this structure
dwFlags: DWORD; // Indicate which fields are valid
dcDiffuse: TD3DColorValue; // RGBA
dcAmbient: TD3DColorValue; // RGB
dcEmissive: TD3DColorValue; // RGB
dcSpecular: TD3DColorValue; // RGB
TD3DRMMaterialOverride = packed record
dwSize : DWORD; (* Size of this structure *)
dwFlags : DWORD; (* Indicate which fields are valid *)
dcDiffuse : TD3DColorValue; (* RGBA *)
dcAmbient : TD3DColorValue; (* RGB *)
dcEmissive : TD3DColorValue; (* RGB *)
dcSpecular : TD3DColorValue; (* RGB *)
dvPower: TD3DValue;
lpD3DRMTex: IUnknown;
end;
 
D3DRMMATERIALOVERRIDE = TD3DRMMaterialOverride;
LPD3DRMMATERIALOVERRIDE = PD3DRMMaterialOverride;
 
const
D3DRMMATERIALOVERRIDE_DIFFUSE_ALPHAONLY = $00000001;
D3DRMMATERIALOVERRIDE_DIFFUSE_RGBONLY = $00000002;
6082,23 → 9586,27
D3DRMSTATECHANGE_RENDER = $000000020;
D3DRMSTATECHANGE_LIGHT = $000000040;
 
{ Values for flags in RM3::CreateDeviceFromSurface }
 
(*
* Values for flags in RM3::CreateDeviceFromSurface
*)
D3DRMDEVICE_NOZBUFFER = $00000001;
 
{ Values for flags in Object2::SetClientData }
 
(*
* Values for flags in Object2::SetClientData
*)
D3DRMCLIENTDATA_NONE = $00000001;
D3DRMCLIENTDATA_LOCALFREE = $00000002;
D3DRMCLIENTDATA_IUNKNOWN = $00000004;
 
{ Values for flags in Frame2::AddMoveCallback. }
 
(*
* Values for flags in Frame2::AddMoveCallback.
*)
D3DRMCALLBACK_PREORDER = 0;
D3DRMCALLBACK_POSTORDER = 1;
 
{ Values for flags in MeshBuilder2::RayPick. }
 
(*
* Values for flags in MeshBuilder2::RayPick.
*)
D3DRMRAYPICK_ONLYBOUNDINGBOXES = 1;
D3DRMRAYPICK_IGNOREFURTHERPRIMITIVES = 2;
D3DRMRAYPICK_INTERPOLATEUV = 4;
6105,37 → 9613,39
D3DRMRAYPICK_INTERPOLATECOLOR = 8;
D3DRMRAYPICK_INTERPOLATENORMAL = $10;
 
{ Values for flags in MeshBuilder3::AddFacesIndexed. }
 
(*
* Values for flags in MeshBuilder3::AddFacesIndexed.
*)
D3DRMADDFACES_VERTICESONLY = 1;
 
 
{ Values for flags in MeshBuilder2::GenerateNormals. }
 
(*
* Values for flags in MeshBuilder2::GenerateNormals.
*)
D3DRMGENERATENORMALS_PRECOMPACT = 1;
D3DRMGENERATENORMALS_USECREASEANGLE = 2;
 
{ Values for MeshBuilder3::GetParentMesh }
 
(*
* Values for MeshBuilder3::GetParentMesh
*)
D3DRMMESHBUILDER_DIRECTPARENT = 1;
D3DRMMESHBUILDER_ROOTMESH = 2;
 
{ Flags for MeshBuilder3::Enable }
(*
* Flags for MeshBuilder3::Enable
*)
D3DRMMESHBUILDER_RENDERENABLE = $00000001;
D3DRMMESHBUILDER_PICKENABLE = $00000002;
 
{ Flags for MeshBuilder3::AddMeshBuilder }
D3DRMADDMESHBUILDER_DONTCOPYAPPDATA = 1;
D3DRMADDMESHBUILDER_FLATTENSUBMESHES = 2;
D3DRMADDMESHBUILDER_NOSUBMESHES = 4;
 
{ Flags for Object2::GetAge when used with MeshBuilders }
(*
* Flags for Object2::GetAge when used with MeshBuilders
*)
D3DRMMESHBUILDERAGE_GEOMETRY = $00000001;
D3DRMMESHBUILDERAGE_MATERIALS = $00000002;
D3DRMMESHBUILDERAGE_TEXTURES = $00000004;
 
{ Format flags for MeshBuilder3::AddTriangles. }
 
(*
* Format flags for MeshBuilder3::AddTriangles.
*)
D3DRMFVF_TYPE = $00000001;
D3DRMFVF_NORMAL = $00000002;
D3DRMFVF_COLOR = $00000004;
6145,29 → 9655,31
D3DRMVERTEX_FAN = $00000002;
D3DRMVERTEX_LIST = $00000004;
 
{ Values for flags in Viewport2::Clear2 }
 
(*
* Values for flags in Viewport2::Clear2
*)
D3DRMCLEAR_TARGET = $00000001;
D3DRMCLEAR_ZBUFFER = $00000002;
D3DRMCLEAR_DIRTYRECTS = $00000004;
D3DRMCLEAR_ALL = D3DRMCLEAR_TARGET or D3DRMCLEAR_ZBUFFER or D3DRMCLEAR_DIRTYRECTS;
D3DRMCLEAR_ALL = (D3DRMCLEAR_TARGET or
D3DRMCLEAR_ZBUFFER or
D3DRMCLEAR_DIRTYRECTS);
 
{ Values for flags in Frame3::SetSceneFogMethod }
 
(*
* Values for flags in Frame3::SetSceneFogMethod
*)
D3DRMFOGMETHOD_VERTEX = $00000001;
D3DRMFOGMETHOD_TABLE = $00000002;
D3DRMFOGMETHOD_ANY = $00000004;
 
{ Values for flags in Frame3::SetTraversalOptions }
 
(*
* Values for flags in Frame3::SetTraversalOptions
*)
D3DRMFRAME_RENDERENABLE = $00000001;
D3DRMFRAME_PICKENABLE = $00000002;
 
{ TD3DRMAnimationOptions }
 
type
TD3DRMAnimationOptions = DWORD;
D3DRMANIMATIONOPTIONS = TD3DRMAnimationOptions;
 
const
D3DRMANIMATION_OPEN = $01;
6177,12 → 9689,8
D3DRMANIMATION_SCALEANDROTATION = $00000010;
D3DRMANIMATION_POSITION = $00000020;
 
{ TD3DRMInterpolationOptions }
 
type
TD3DRMInterpolationOptions = DWORD;
D3DRMINTERPOLATIONOPTIONS = TD3DRMInterpolationOptions;
 
const
D3DRMINTERPOLATION_OPEN = $01;
D3DRMINTERPOLATION_CLOSED = $02;
6192,11 → 9700,8
D3DRMINTERPOLATION_VERTEXCOLOR = $40;
D3DRMINTERPOLATION_SLERPNORMALS = $80;
 
{ TD3DRMLoadOptions }
 
type
TD3DRMLoadOptions = DWORD;
D3DRMLOADOPTIONS = TD3DRMLoadOptions;
 
const
D3DRMLOAD_FROMFILE = $00;
6215,30 → 9720,20
 
D3DRMLOAD_ASYNCHRONOUS = $400;
 
{ TD3DRMLoadReource }
 
type
PD3DRMLoadReource = ^TD3DRMLoadReource;
TD3DRMLoadReource = record
PD3DRMLoadResource = ^TD3DRMLoadResource;
TD3DRMLoadResource = packed record
hModule: HMODULE;
lpName: PChar;
lpType: PChar;
lpName: PAnsiChar;
lpType: PAnsiChar;
end;
 
D3DRMLOADRESOURCE = TD3DRMLoadReource;
LPD3DRMLOADRESOURCE = PD3DRMLoadReource;
 
{ TD3DRMLoadMemory }
 
PD3DRMLoadMemory = ^TD3DRMLoadMemory;
TD3DRMLoadMemory = record
TD3DRMLoadMemory = packed record
lpMemory: Pointer;
dSize: DWORD;
dwSize: DWORD;
end;
 
D3DRMLOADMEMORY = TD3DRMLoadMemory;
LPD3DRMLOADMEMORY = PD3DRMLoadMemory;
 
const
D3DRMPMESHSTATUS_VALID = $01;
D3DRMPMESHSTATUS_INTERRUPTED = $02;
6249,43 → 9744,32
D3DRMPMESHEVENT_BASEMESH = $01;
D3DRMPMESHEVENT_COMPLETE = $02;
 
{ TD3DRMPMeshLoadStatus }
 
type
PD3DRMPMeshLoadStatus = ^TD3DRMPMeshLoadStatus;
TD3DRMPMeshLoadStatus = record
dwSize: DWORD; // Size of this structure
dwPMeshSize: DWORD; // Total Size (bytes)
dwBaseMeshSize: DWORD; // Total Size of the Base Mesh
dwBytesLoaded: DWORD; // Total bytes loaded
dwVerticesLoaded: DWORD; // Number of vertices loaded
TD3DRMPMeshLoadStatus = packed record
dwSize, // Size of this structure
dwPMeshSize, // Total Size (bytes)
dwBaseMeshSize, // Total Size of the Base Mesh
dwBytesLoaded, // Total bytes loaded
dwVerticesLoaded, // Number of vertices loaded
dwFacesLoaded: DWORD; // Number of faces loaded
dwLoadResult: HResult; // Result of the load operation
dwFlags: DWORD;
end;
 
D3DRMPMESHLOADSTATUS = TD3DRMPMeshLoadStatus;
LPD3DRMPMESHLOADSTATUS = PD3DRMPMeshLoadStatus;
 
{ TD3DRMUserVisualReason }
 
PD3DRMUserVisualReason = ^TD3DRMUserVisualReason;
TD3DRMUserVisualReason = (
D3DRMUSERVISUAL_CANSEE,
D3DRMUSERVISUAL_RENDER
);
 
D3DRMUSERVISUALREASON = TD3DRMUserVisualReason;
 
{ TD3DRMAnimationKey }
 
PD3DRMAnimationKey = ^TD3DRMAnimationKey;
TD3DRMAnimationKey = record
TD3DRMAnimationKey = packed record
dwSize: DWORD;
dwKeyType: DWORD;
dvTime: TD3DValue;
dwID: DWORD;
 
case Integer of
case integer of
0: (dqRotateKey: TD3DRMQuaternion);
1: (dvScaleKey: TD3DVector);
2: (dvPositionKey: TD3DVector);
6292,31 → 9776,33
3: (dvK: array[0..3] of TD3DValue);
end;
 
D3DRMANIMATIONKEY = TD3DRMAnimationKey;
LPD3DRMANIMATIONKEY = PD3DRMAnimationKey;
procedure D3DRMAnimationGetRotateKey
(var rmKey: TD3DRMAnimationKey; var rmQuat: TD3DRMQuaternion);
 
procedure D3DRMAnimationGetRotateKey(const rmKey: TD3DRMAnimationKey; var rmQuat: TD3DRMQuaternion);
procedure D3DRMAnimationGetScaleKey(const rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
procedure D3DRMAnimationGetPositionKey(const rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
procedure D3DRMAnimationSetRotateKey(var rmKey: TD3DRMAnimationKey; const rmQuat: TD3DRMQuaternion);
procedure D3DRMAnimationSetScaleKey(var rmKey: TD3DRMAnimationKey; const dvVec: TD3DVector);
procedure D3DRMAnimationSetPositionKey(var rmKey: TD3DRMAnimationKey; const dvVec: TD3DVector);
procedure D3DRMAnimationGetScaleKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
 
procedure D3DRMAnimationGetPositionKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
 
procedure D3DRMAnimatioSetRotateKey
(var rmKey: TD3DRMAnimationKey; var rmQuat: TD3DRMQuaternion);
 
procedure D3DRMAnimationSetScaleKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
 
procedure D3DRMAnimationSetPositionKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
 
const
D3DRMANIMATION_ROTATEKEY = $01;
D3DRMANIMATION_SCALEKEY = $02;
D3DRMANIMATION_POSITIONKEY = $03;
D3DRMANIMATION_ROTATEKEY = 01;
D3DRMANIMATION_SCALEKEY = 02;
D3DRMANIMATION_POSITIONKEY = 03;
 
{ TD3DRMMapping }
 
type
TD3DRMMapping = DWORD;
D3DRMMAPPING = TD3DRMMapping;
 
{ TD3DRMMappingFlag }
 
PD3DRMMappingFlag = ^TD3DRMMappingFlag;
TD3DRMMappingFlag = DWORD;
D3DRMMAPPINGFLAG = TD3DRMMappingFlag;
 
const
D3DRMMAP_WRAPU = 1;
6323,11 → 9809,9
D3DRMMAP_WRAPV = 2;
D3DRMMAP_PERSPCORRECT = 4;
 
{ TD3DRMVertex }
 
type
PD3DRMVertex = ^TD3DRMVertex;
TD3DRMVertex = record
TD3DRMVertex = packed record
position: TD3DVector;
normal: TD3DVector;
tu, tv: TD3DValue;
6334,173 → 9818,197
color: TD3DColor;
end;
 
D3DRMVERTEX = TD3DRMVertex;
LPD3DRMVERTEX = PD3DRMVertex;
TD3DRMGroupIndex = LongInt; (* group indexes begin a 0 *)
 
{ TD3DRMGroupIndex }
 
TD3DRMGroupIndex = Longint;
D3DRMGROUPINDEX = TD3DRMGroupIndex; // group indexes begin a 0
 
const
D3DRMGROUP_ALLGROUPS = -1;
 
{ Create a color from three components in the range 0-1 inclusive. }
function D3DRMCreateColorRGB(red, green, blue: TD3DValue): TD3DColor; stdcall;
var
(*
* Create a color from three components in the range 0-1 inclusive.
*)
D3DRMCreateColorRGB : function (red, green, blue: TD3DValue) : TD3DColor;
stdcall;
 
{ Create a color from four components in the range 0-1 inclusive. }
function D3DRMCreateColorRGBA(red, green, blue, alpha: TD3DValue): TD3DColor; stdcall;
(*
* Create a color from four components in the range 0-1 inclusive.
*)
D3DRMCreateColorRGBA : function (red, green, blue, alpha: TD3DValue)
: TD3DColor; stdcall;
 
{ Get the red component of a color. }
function D3DRMColorGetRed(d3drmc: TD3DColor): TD3DValue; stdcall;
(*
* Get the red component of a color.
*)
D3DRMColorGetRed : function (d3drmc: TD3DColor) : TD3DValue; stdcall;
 
{ Get the green component of a color. }
function D3DRMColorGetGreen(d3drmc: TD3DColor): TD3DValue; stdcall;
(*
* Get the green component of a color.
*)
D3DRMColorGetGreen : function (d3drmc: TD3DColor) : TD3DValue; stdcall;
 
{ Get the blue component of a color. }
function D3DRMColorGetBlue(d3drmc: TD3DColor): TD3DValue; stdcall;
(*
* Get the blue component of a color.
*)
D3DRMColorGetBlue : function (d3drmc: TD3DColor) : TD3DValue; stdcall;
 
{ Get the alpha component of a color. }
function D3DRMColorGetAlpha(d3drmc: TD3DColor): TD3DValue; stdcall;
(*
* Get the alpha component of a color.
*)
D3DRMColorGetAlpha : function (d3drmc: TD3DColor) : TD3DValue; stdcall;
 
{ Add two vectors. Returns its first argument. }
function D3DRMVectorAdd(var d, s1, s2: TD3DVector): PD3DVector; stdcall;
(*
* Add two vectors. Returns its first argument.
*)
D3DRMVectorAdd : function (var d, s1, s2: TD3DVector) : PD3DVector; stdcall;
 
{ Subtract two vectors. Returns its first argument. }
function D3DRMVectorSubtract(var d, s1, s2: TD3DVector): PD3DVector; stdcall;
(*
* Subtract two vectors. Returns its first argument.
*)
D3DRMVectorSubtract : function (var d, s1, s2: TD3DVector) : PD3DVector;
stdcall;
 
{ Reflect a ray about a given normal. Returns its first argument. }
function D3DRMVectorReflect(var d, ray, norm: TD3DVector): PD3DVector; stdcall;
(*
* Reflect a ray about a given normal. Returns its first argument.
*)
D3DRMVectorReflect : function (var d, ray, norm: TD3DVector) : PD3DVector;
stdcall;
 
{ Calculate the vector cross product. Returns its first argument. }
function D3DRMVectorCrossProduct(var d, s1, s2: TD3DVector): PD3DVector; stdcall;
(*
* Calculate the vector cross product. Returns its first argument.
*)
D3DRMVectorCrossProduct : function (var d, s1, s2: TD3DVector) : PD3DVector;
stdcall;
 
{ Return the vector dot product. }
function D3DRMVectorDotProduct(var s1, s2: TD3DVector): TD3DValue; stdcall;
(*
* Return the vector dot product.
*)
D3DRMVectorDotProduct : function (var s1, s2: TD3DVector) : TD3DValue;
stdcall;
 
{ Scale a vector so that its modulus is 1. Returns its argument or
NULL if there was an error (e.g. a zero vector was passed). }
function D3DRMVectorNormalize(var lpv: TD3DVector): PD3DVector; stdcall;
(*
* Scale a vector so that its modulus is 1. Returns its argument or
* NULL if there was an error (e.g. a zero vector was passed).
*)
D3DRMVectorNormalize : function (var lpv: TD3DVector) : PD3DVector; stdcall;
 
{ Return the length of a vector (e.g. sqrt(x*x + y*y + z*z)). }
function D3DRMVectorModulus(var v: TD3DVector): TD3DValue; stdcall;
(*
* Return the length of a vector (e.g. sqrt(x*x + y*y + z*z)).
*)
D3DRMVectorModulus : function (var v: TD3DVector) : TD3DValue; stdcall;
 
{ Set the rotation part of a matrix to be a rotation of theta radians
around the given axis. }
function D3DRMVectorRotate(var r, v, axis: TD3DVector; theta: TD3DValue): PD3DVector; stdcall;
(*
* Set the rotation part of a matrix to be a rotation of theta radians
* around the given axis.
*)
D3DRMVectorRotate : function (var r, v, axis: TD3DVector; theta: TD3DValue) :
PD3DVector; stdcall;
 
{ Scale a vector uniformly in all three axes }
function D3DRMVectorScale( var d, s: TD3DVector; factor: TD3DValue): PD3DVector; stdcall;
(*
* Scale a vector uniformly in all three axes
*)
D3DRMVectorScale : function (var d, s: TD3DVector; factor: TD3DValue) :
PD3DVector; stdcall;
 
{ Return a random unit vector }
function D3DRMVectorRandom(var d: TD3DVector): PD3DVector; stdcall;
(*
* Return a random unit vector
*)
D3DRMVectorRandom : function (var d: TD3DVector) : PD3DVector; stdcall;
 
{ Returns a unit quaternion that represents a rotation of theta radians
around the given axis. }
function D3DRMQuaternionFromRotation(var quat: PD3DRMQuaternion;
(*
* Returns a unit quaternion that represents a rotation of theta radians
* around the given axis.
*)
 
D3DRMQuaternionFromRotation : function (var quat: TD3DRMQuaternion;
var v: TD3DVector; theta: TD3DValue): PD3DRMQuaternion; stdcall;
 
{ Calculate the product of two quaternions }
function D3DRMQuaternionMultiply(var q, a, b: TD3DRMQuaternion): PD3DRMQuaternion; stdcall;
(*
* Calculate the product of two quaternions
*)
D3DRMQuaternionMultiply : function (var q, a, b: TD3DRMQuaternion) :
PD3DRMQuaternion; stdcall;
 
{ Interpolate between two quaternions }
function D3DRMQuaternionSlerp(var q, a, b: TD3DRMQuaternion; alpha: TD3DValue): PD3DRMQuaternion; stdcall;
(*
* Interpolate between two quaternions
*)
D3DRMQuaternionSlerp : function (var q, a, b: TD3DRMQuaternion;
alpha: TD3DValue) : PD3DRMQuaternion; stdcall;
 
{ Calculate the matrix for the rotation that a unit quaternion represents }
procedure D3DRMMatrixFromQuaternion(dmMat: TD3DRMMatrix4D; var lpDqQuat: TD3DRMQuaternion); stdcall;
(*
* Calculate the matrix for the rotation that a unit quaternion represents
*)
D3DRMMatrixFromQuaternion : procedure (dmMat: TD3DRMMatrix4D; var lpDqQuat:
TD3DRMQuaternion); stdcall;
 
{ Calculate the quaternion that corresponds to a rotation matrix }
function D3DRMQuaternionFromMatrix(var lpQuat: TD3DRMQuaternion; Mat: TD3DRMMatrix4D): PD3DRMQuaternion;
(*
* Calculate the quaternion that corresponds to a rotation matrix
*)
D3DRMQuaternionFromMatrix : function (var lpQuat: TD3DRMQuaternion;
Mat: TD3DRMMatrix4D) : PD3DRMQuaternion; stdcall;
 
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3drm.h, d3drmobj.h, d3drmwin.h
* File: d3drmobj.h
* Content: Direct3DRM include file
*
***************************************************************************)
 
{ Direct3DRM Object classes }
(*
* Direct3DRM Object classes
*)
 
const
CLSID_CDirect3DRMDevice: TGUID = '{4FA3568E-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMViewport: TGUID = '{4FA3568F-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMFrame: TGUID = '{4FA35690-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMMesh: TGUID = '{4FA35691-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMMeshBuilder: TGUID = '{4FA35692-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMFace: TGUID = '{4FA35693-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMLight: TGUID = '{4FA35694-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMTexture: TGUID = '{4FA35695-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMWrap: TGUID = '{4FA35696-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMMaterial: TGUID = '{4FA35697-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMAnimation: TGUID = '{4FA35698-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMAnimationSet: TGUID = '{4FA35699-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMUserVisual: TGUID = '{4FA3569A-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMShadow: TGUID = '{4FA3569B-623F-11CF-AC4A-0000C03825A1}';
CLSID_CDirect3DRMViewportInterpolator: TGUID = '{0DE9EAA1-3B84-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMFrameInterpolator: TGUID = '{0DE9EAA2-3B84-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMMeshInterpolator: TGUID = '{0DE9EAA3-3B84-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMLightInterpolator: TGUID = '{0DE9EAA6-3B84-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMMaterialInterpolator: TGUID = '{0DE9EAA7-3B84-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMTextureInterpolator: TGUID = '{0DE9EAA8-3B84-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMProgressiveMesh: TGUID = '{4516EC40-8F20-11D0-9B6D-0000C0781BC3}';
CLSID_CDirect3DRMClippedVisual: TGUID = '{5434E72D-6D66-11D1-BB0B-0000F875865A}';
CLSID_CDirect3DRMDevice: TGUID =
(D1:$4fa3568e;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMViewport: TGUID =
(D1:$4fa3568f;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMFrame: TGUID =
(D1:$4fa35690;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMMesh: TGUID =
(D1:$4fa35691;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMMeshBuilder: TGUID =
(D1:$4fa35692;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMFace: TGUID =
(D1:$4fa35693;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMLight: TGUID =
(D1:$4fa35694;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMTexture: TGUID =
(D1:$4fa35695;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMWrap: TGUID =
(D1:$4fa35696;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMMaterial: TGUID =
(D1:$4fa35697;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMAnimation: TGUID =
(D1:$4fa35698;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMAnimationSet: TGUID =
(D1:$4fa35699;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMUserVisual: TGUID =
(D1:$4fa3569a;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMShadow: TGUID =
(D1:$4fa3569b;D2:$623f;D3:$11cf;D4:($ac,$4a,$00,$00,$c0,$38,$25,$a1));
CLSID_CDirect3DRMViewportInterpolator: TGUID =
(D1:$0de9eaa1;D2:$3b84;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMFrameInterpolator: TGUID =
(D1:$0de9eaa2;D2:$3b84;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMMeshInterpolator: TGUID =
(D1:$0de9eaa3;D2:$3b84;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMLightInterpolator: TGUID =
(D1:$0de9eaa6;D2:$3b84;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMMaterialInterpolator: TGUID =
(D1:$0de9eaa7;D2:$3b84;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMTextureInterpolator: TGUID =
(D1:$0de9eaa8;D2:$3b84;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMProgressiveMesh: TGUID =
(D1:$4516ec40;D2:$8f20;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
CLSID_CDirect3DRMClippedVisual: TGUID =
(D1:$5434e72d;D2:$6d66;D3:$11d1;D4:($bb,$0b,$00,$00,$f8,$75,$86,$5a));
 
{ Direct3DRM Object interfaces }
 
IID_IDirect3DRMObject: TGUID = '{EB16CB00-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMObject2: TGUID = '{4516EC7C-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMDevice: TGUID = '{E9E19280-6E05-11CF-AC4A-0000C03825A1}';
IID_IDirect3DRMDevice2: TGUID = '{4516EC78-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMDevice3: TGUID = '{549F498B-BFEB-11D1-8ED8-00A0C967A482}';
IID_IDirect3DRMViewport: TGUID = '{EB16CB02-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMViewport2: TGUID = '{4A1B1BE6-BFED-11D1-8ED8-00A0C967A482}';
IID_IDirect3DRMFrame: TGUID = '{EB16CB03-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMFrame2: TGUID = '{C3DFBD60-3988-11D0-9EC2-0000C0291AC3}';
IID_IDirect3DRMFrame3: TGUID = '{FF6B7F70-A40E-11D1-91F9-0000F8758E66}';
IID_IDirect3DRMVisual: TGUID = '{EB16CB04-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMMesh: TGUID = '{A3A80D01-6E12-11CF-AC4A-0000C03825A1}';
IID_IDirect3DRMMeshBuilder: TGUID = '{A3A80D02-6E12-11CF-AC4A-0000C03825A1}';
IID_IDirect3DRMMeshBuilder2: TGUID = '{4516EC77-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMMeshBuilder3: TGUID = '{4516EC82-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMFace: TGUID = '{EB16CB07-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMFace2: TGUID = '{4516EC81-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMLight: TGUID = '{EB16CB08-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMTexture: TGUID = '{EB16CB09-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMTexture2: TGUID = '{120F30C0-1629-11D0-941C-0080C80CFA7B}';
IID_IDirect3DRMTexture3: TGUID = '{FF6B7F73-A40E-11D1-91F9-0000F8758E66}';
IID_IDirect3DRMWrap: TGUID = '{EB16CB0A-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMMaterial: TGUID = '{EB16CB0B-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMMaterial2: TGUID = '{FF6B7F75-A40E-11D1-91F9-0000F8758E66}';
IID_IDirect3DRMAnimation: TGUID = '{EB16CB0D-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMAnimation2: TGUID = '{FF6B7F77-A40E-11D1-91F9-0000F8758E66}';
IID_IDirect3DRMAnimationSet: TGUID = '{EB16CB0E-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMAnimationSet2: TGUID = '{FF6B7F79-A40E-11D1-91F9-0000F8758E66}';
IID_IDirect3DRMObjectArray: TGUID = '{242F6BC2-3849-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMDeviceArray: TGUID = '{EB16CB10-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMViewportArray: TGUID = '{EB16CB11-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMFrameArray: TGUID = '{EB16CB12-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMVisualArray: TGUID = '{EB16CB13-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMLightArray: TGUID = '{EB16CB14-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMPickedArray: TGUID = '{EB16CB16-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMFaceArray: TGUID = '{EB16CB17-D271-11CE-AC48-0000C03825A1}';
IID_IDirect3DRMAnimationArray: TGUID = '{D5F1CAE0-4BD7-11D1-B974-0060083E45F3}';
IID_IDirect3DRMUserVisual: TGUID = '{59163DE0-6D43-11CF-AC4A-0000C03825A1}';
IID_IDirect3DRMShadow: TGUID = '{AF359780-6BA3-11CF-AC4A-0000C03825A1}';
IID_IDirect3DRMShadow2: TGUID = '{86B44E25-9C82-11D1-BB0B-00A0C981A0A6}';
IID_IDirect3DRMInterpolator: TGUID = '{242F6BC1-3849-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMProgressiveMesh: TGUID = '{4516EC79-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMPicked2Array: TGUID = '{4516EC7B-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRMClippedVisual: TGUID = '{5434E733-6D66-11D1-BB0B-0000F875865A}';
 
IID_IDirect3DRMWinDevice: TGUID = '{C5016CC0-D273-11CE-AC48-0000C03825A1}';
IID_IDirect3DRM: TGUID = '{2BC49361-8327-11CF-AC4A-0000C03825A1}';
IID_IDirect3DRM2: TGUID = '{4516ECC8-8F20-11D0-9B6D-0000C0781BC3}';
IID_IDirect3DRM3: TGUID = '{4516EC83-8F20-11D0-9B6D-0000C0781BC3}';
 
type
IDirect3DRMObject = interface;
IDirect3DRMObject2 = interface;
IDirect3DRMDevice = interface;
IDirect3DRMDevice2 = interface;
IDirect3DRMDevice3 = interface;
6523,94 → 10031,117
IDirect3DRMWrap = interface;
IDirect3DRMMaterial = interface;
IDirect3DRMMaterial2 = interface;
IDirect3DRMInterpolator = interface;
IDirect3DRMAnimation = interface;
IDirect3DRMAnimation2 = interface;
IDirect3DRMAnimationSet = interface;
IDirect3DRMAnimationSet2 = interface;
IDirect3DRMUserVisual = interface;
IDirect3DRMShadow = interface;
IDirect3DRMShadow2 = interface;
IDirect3DRMArray= interface;
IDirect3DRMObjectArray = interface;
IDirect3DRMDeviceArray = interface;
IDirect3DRMFaceArray = interface;
IDirect3DRMViewportArray = interface;
IDirect3DRMFrameArray = interface;
IDirect3DRMAnimationArray = interface;
IDirect3DRMVisualArray = interface;
IDirect3DRMLightArray = interface;
IDirect3DRMPickedArray = interface;
IDirect3DRMFaceArray = interface;
IDirect3DRMAnimationArray = interface;
IDirect3DRMUserVisual = interface;
IDirect3DRMShadow = interface;
IDirect3DRMShadow2 = interface;
IDirect3DRMInterpolator = interface;
IDirect3DRMProgressiveMesh = interface;
IDirect3DRMPicked2Array = interface;
IDirect3DRMLightArray = interface;
IDirect3DRMProgressiveMesh = interface;
IDirect3DRMClippedVisual = interface;
 
IDirect3DRMWinDevice = interface;
IDirect3DRM = interface;
IDirect3DRM2 = interface;
IDirect3DRM3 = interface;
(*
* Direct3DRM Object interfaces
*)
IID_IDirect3DRMObject = IDirect3DRMObject;
IID_IDirect3DRMDevice = IDirect3DRMDevice;
IID_IDirect3DRMDevice2 = IDirect3DRMDevice2;
IID_IDirect3DRMDevice3 = IDirect3DRMDevice3;
IID_IDirect3DRMViewport = IDirect3DRMViewport;
IID_IDirect3DRMViewport2 = IDirect3DRMViewport2;
IID_IDirect3DRMFrame = IDirect3DRMFrame;
IID_IDirect3DRMFrame2 = IDirect3DRMFrame2;
IID_IDirect3DRMFrame3 = IDirect3DRMFrame3;
IID_IDirect3DRMVisual = IDirect3DRMVisual;
IID_IDirect3DRMMesh = IDirect3DRMMesh;
IID_IDirect3DRMMeshBuilder = IDirect3DRMMeshBuilder;
IID_IDirect3DRMMeshBuilder2 = IDirect3DRMMeshBuilder2;
IID_IDirect3DRMMeshBuilder3 = IDirect3DRMMeshBuilder3;
IID_IDirect3DRMFace = IDirect3DRMFace;
IID_IDirect3DRMFace2 = IDirect3DRMFace2;
IID_IDirect3DRMLight = IDirect3DRMLight;
IID_IDirect3DRMTexture = IDirect3DRMTexture;
IID_IDirect3DRMTexture2 = IDirect3DRMTexture2;
IID_IDirect3DRMTexture3 = IDirect3DRMTexture3;
IID_IDirect3DRMWrap = IDirect3DRMWrap;
IID_IDirect3DRMMaterial = IDirect3DRMMaterial;
IID_IDirect3DRMMaterial2 = IDirect3DRMMaterial2;
IID_IDirect3DRMAnimation = IDirect3DRMAnimation;
IID_IDirect3DRMAnimation2 = IDirect3DRMAnimation2;
IID_IDirect3DRMAnimationSet = IDirect3DRMAnimationSet;
IID_IDirect3DRMAnimationSet2 = IDirect3DRMAnimationSet2;
IID_IDirect3DRMObjectArray = IDirect3DRMObjectArray;
IID_IDirect3DRMDeviceArray = IDirect3DRMDeviceArray;
IID_IDirect3DRMViewportArray = IDirect3DRMViewportArray;
IID_IDirect3DRMFrameArray = IDirect3DRMFrameArray;
IID_IDirect3DRMVisualArray = IDirect3DRMVisualArray;
IID_IDirect3DRMLightArray = IDirect3DRMLightArray;
IID_IDirect3DRMPickedArray = IDirect3DRMPickedArray;
IID_IDirect3DRMFaceArray = IDirect3DRMFaceArray;
IID_IDirect3DRMAnimationArray = IDirect3DRMAnimationArray;
IID_IDirect3DRMUserVisual = IDirect3DRMUserVisual;
IID_IDirect3DRMShadow = IDirect3DRMShadow;
IID_IDirect3DRMShadow2 = IDirect3DRMShadow2;
IID_IDirect3DRMInterpolator = IDirect3DRMInterpolator;
IID_IDirect3DRMProgressiveMesh = IDirect3DRMProgressiveMesh;
IID_IDirect3DRMPicked2Array = IDirect3DRMPicked2Array;
IID_IDirect3DRMClippedVisual = IDirect3DRMClippedVisual;
 
TD3DRMObjectCallback = procedure(obj: IDirect3DRMObject; arg: Pointer); cdecl;
D3DRMOBJECTCALLBACK = TD3DRMObjectCallback;
 
TD3DRMFrameMoveCallback = procedure(obj: IDirect3DRMFrame; arg: Pointer; delta: TD3DValue); cdecl;
D3DRMFRAMEMOVECALLBACK = TD3DRMFrameMoveCallback;
 
TD3DRMFrame3MoveCallback = procedure(obj: IDirect3DRMFrame3; arg: Pointer; delta: TD3DValue); cdecl;
D3DRMFRAME3MOVECALLBACK = TD3DRMFrame3MoveCallback;
 
TD3DRMUpdateCallback = procedure(obj: IDirect3DRMDevice; arg: Pointer;
iRectCount: DWORD; d3dRectUpdate: PD3DRect); cdecl;
D3DRMUPDATECALLBACK = TD3DRMUpdateCallback;
 
TD3DRMDevice3UpdateCallback = procedure(obj: IDirect3DRMDevice3; arg: Pointer;
iRectCount: DWORD; d3dRectUpdate: PD3DRect); cdecl;
D3DRMDEVICE3UPDATECALLBACK = TD3DRMDevice3UpdateCallback;
PIDirect3DRMFaceArray = ^IDirect3DRMFaceArray;
 
TD3DRMObjectCallback = procedure (lpD3DRMobj: IDirect3DRMObject;
lpArg: Pointer); cdecl;
TD3DRMFrameMoveCallback = procedure (lpD3DRMFrame: IDirect3DRMFrame;
lpArg: Pointer; delta: TD3DValue); cdecl;
TD3DRMFrame3MoveCallback = procedure (lpD3DRMFrame: IDirect3DRMFrame3;
lpArg: Pointer; delta: TD3DValue); cdecl;
TD3DRMUpdateCallback = procedure (lpobj: IDirect3DRMDevice; lpArg: Pointer;
iRectCount: Integer; const d3dRectUpdate: TD3DRect); cdecl;
TD3DRMDevice3UpdateCallback = procedure (lpobj: IDirect3DRMDevice3;
lpArg: Pointer; iRectCount: Integer; const d3dRectUpdate: TD3DRect);cdecl;
TD3DRMUserVisualCallback = function(lpD3DRMUV: IDirect3DRMUserVisual;
lpArg: Pointer; lpD3DRMUVreason: TD3DRMUserVisualReason;
lpD3DRMDev: IDirect3DRMDevice;
lpD3DRMview: IDirect3DRMViewport): Longint; cdecl;
D3DRMUSERVISUALCALLBACK = TD3DRMUserVisualCallback;
 
TD3DRMLoadTextureCallback = function(tex_name: PChar; arg: Pointer;
lpD3DRMview: IDirect3DRMViewport) : Integer; cdecl;
TD3DRMLoadTextureCallback = function (tex_name: PAnsiChar; lpArg: Pointer;
out lpD3DRMTex: IDirect3DRMTexture): HResult; cdecl;
D3DRMLOADTEXTURECALLBACK = TD3DRMLoadTextureCallback;
 
TD3DRMLoadTexture3Callback = function(tex_name: PChar; arg: Pointer;
TD3DRMLoadTexture3Callback = function (tex_name: PAnsiChar; lpArg: Pointer;
out lpD3DRMTex: IDirect3DRMTexture3): HResult; cdecl;
D3DRMLOADTEXTURE3CALLBACK = TD3DRMLoadTexture3Callback;
 
TD3DRMLoadCallback = procedure(lpObject: IDirect3DRMObject; const ObjectGuid: TGUID;
lpArg: Pointer); cdecl;
D3DRMLOADCALLBACK = TD3DRMLoadCallback;
 
TD3DRMLoadCallback = procedure (lpObject: IDirect3DRMObject;
const ObjectGuid: TGUID; lpArg: Pointer); cdecl;
TD3DRMDownSampleCallback = function(lpDirect3DRMTexture: IDirect3DRMTexture3;
pArg: Pointer; pDDSSrc, pDDSDst: IDirectDrawSurface): HResult; cdecl;
D3DRMDOWNSAMPLECALLBACK = TD3DRMDownSampleCallback;
 
pArg: pointer; pDDSSrc, pDDSDst: IDirectDrawSurface) : HResult; cdecl;
TD3DRMValidationCallback = function(lpDirect3DRMTexture: IDirect3DRMTexture3;
pArg: Pointer; dwFlags: DWORD; dwcRects: DWORD; pRects: PRect): HResult; cdecl;
D3DRMVALIDATIONCALLBACK = TD3DRMValidationCallback;
pArg: pointer; dwFlags, DWcRects: DWORD; const pRects: TRect) : HResult; cdecl;
 
{ TD3DRMPickDesc }
 
PD3DRMPickDesc = ^TD3DRMPickDesc;
TD3DRMPickDesc = record
ulFaceIdx: Longint;
lGroupIdx: Longint;
TD3DRMPickDesc = packed record
ulFaceIdx: DWORD;
lGroupIdx: LongInt;
vPosition: TD3DVector;
end;
 
D3DRMPICKDESC = TD3DRMPickDesc;
LPD3DRMPICKDESC = PD3DRMPickDesc;
 
{ TD3DRMPickDesc2 }
 
PD3DRMPickDesc2 = ^TD3DRMPickDesc2;
TD3DRMPickDesc2 = record
ulFaceIdx: Longint;
lGroupIdx: Longint;
TD3DRMPickDesc2 = packed record
ulFaceIdx: DWORD;
lGroupIdx: LongInt;
dvPosition: TD3DVector;
tu, tv: TD3DValue;
dvNormal: TD3DVector;
6617,13 → 10148,20
dcColor: TD3DColor;
end;
 
D3DRMPICKDESC2 = TD3DRMPickDesc2;
LPD3DRMPICKDESC2 = PD3DRMPickDesc2;
 
(*
* Base class
*)
{$IFDEF D2COM}
IDirect3DRMObject = class (IUnknown)
{$ELSE}
IDirect3DRMObject = interface(IUnknown)
['{EB16CB00-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMObject methods
function Clone(pUnkOuter: IUnknown; const riid: TGUID; out ppvObj): HResult; stdcall;
['{eb16cb00-d271-11ce-ac48-0000c03825a1}']
{$ENDIF}
(*
* The methods for IDirect3DRMObject
*)
function Clone (pUnkOuter: IUnknown; riid: TGUID;
var ppvObj: Pointer) : HResult; stdcall;
function AddDestroyCallback(lpCallback: TD3DRMObjectCallback;
lpArg: Pointer): HResult; stdcall;
function DeleteDestroyCallback(d3drmObjProc: TD3DRMObjectCallback;
6630,38 → 10168,23
lpArg: Pointer): HResult; stdcall;
function SetAppData(ulData: DWORD): HResult; stdcall;
function GetAppData: DWORD; stdcall;
function SetName(lpName: PChar): HResult; stdcall;
function GetName(var lpdwSize: DWORD; lpName: PChar): HResult; stdcall;
function GetClassName(var lpdwSize: DWORD; lpName: PChar): HResult; stdcall;
function SetName (lpName: PAnsiChar) : HResult; stdcall;
function GetName (var lpdwSize: DWORD; lpName: PAnsiChar) : HResult; stdcall;
function GetClassName (var lpdwSize: DWORD; lpName: PAnsiChar) : HResult; stdcall;
end;
 
IDirect3DRMObject2 = interface(IUnknown)
['{EB16CB00-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMObject2 methods
function AddDestroyCallback(lpCallback: TD3DRMObjectCallback; lpArg: Pointer): HResult; stdcall;
function Clone(pUnkOuter: IUnknown; const riid: TGUID;
out ppvObj): HResult; stdcall;
function DeleteDestroyCallback(d3drmObjProc: TD3DRMObjectCallback;
lpArg: Pointer): HResult; stdcall;
function GetClientData(dwID: DWORD; var lplpvData: Pointer): HResult; stdcall;
function GetDirect3DRM(out lplpDirect3DRM: IDirect3DRM): HResult; stdcall;
function GetName(var lpdwSize: DWORD; lpName: LPSTR): HResult; stdcall;
function SetClientData(dwID: DWORD; lplpvData: Pointer; dwFlags: DWORD): HResult; stdcall;
function SetName(lpName: PChar): HResult; stdcall;
function GetAge(dwFlags: DWORD; var pdwAge: DWORD): HResult; stdcall;
end;
 
IDirect3DRMVisual = interface(IDirect3DRMObject)
['{EB16CB04-D271-11CE-AC48-0000C03825A1}']
end;
 
IDirect3DRMDevice = interface(IDirect3DRMObject)
['{E9E19280-6E05-11CF-AC4A-0000C03825A1}']
// IDirect3DRMDevice methods
function Init(width, height: DWORD): HResult; stdcall;
['{e9e19280-6e05-11cf-ac4a-0000c03825a1}']
(*
* IDirect3DRMDevice methods
*)
function Init (width: LongInt; height: LongInt) : HResult; stdcall;
function InitFromD3D(lpD3D: IDirect3D; lpD3DIMDev: IDirect3DDevice): HResult; stdcall;
function InitFromClipper(lpDDClipper: IDirectDrawClipper;
const lpGUID: TGUID; width, height: DWORD): HResult; stdcall;
function InitFromClipper (lpDDClipper: IDirectDrawClipper; lpGUID: PGUID;
width: Integer; height: Integer) : HResult; stdcall;
function Update: HResult; stdcall;
function AddUpdateCallback(d3drmUpdateProc: TD3DRMUpdateCallback;
arg: Pointer): HResult; stdcall;
6687,36 → 10210,79
end;
 
IDirect3DRMDevice2 = interface(IDirect3DRMDevice)
['{4516EC78-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMDevice2 methods
['{4516ec78-8f20-11d0-9b6d-0000c0781bc3}']
(*
* IDirect3DRMDevice2 methods
*)
function InitFromD3D2(lpD3D: IDirect3D2; lpD3DIMDev: IDirect3DDevice2): HResult; stdcall;
function InitFromSurface(const lpGUID: TGUID; lpDD: IDirectDraw; lpDDSBack: IDirectDrawSurface) : HResult; stdcall;
function SetRenderMode(dwFlags: DWORD ) : HResult; stdcall;
function GetRenderMode : DWORD; stdcall;
function GetDirect3DDevice2(out lplpD3DDevice: IDirect3DDevice2) : HResult; stdcall;
end;
 
IDirect3DRMDevice3 = interface (IDirect3DRMObject)
['{549f498b-bfeb-11d1-8ed8-00a0c967a482}']
(*
* IDirect3DRMDevice methods
*)
function Init (width: LongInt; height: LongInt) : HResult; stdcall;
function InitFromD3D (lpD3D: IDirect3D2; lpD3DIMDev: IDirect3DDevice2) : HResult; stdcall;
function InitFromClipper (lpDDClipper: IDirectDrawClipper; lpGUID: PGUID;
width: Integer; height: Integer) : HResult; stdcall;
function Update: HResult; stdcall;
function AddUpdateCallback (d3drmUpdateProc: TD3DRMDevice3UpdateCallback;
arg: Pointer) : HResult; stdcall;
function DeleteUpdateCallback (d3drmUpdateProc: TD3DRMDevice3UpdateCallback;
arg: Pointer) : HResult; stdcall;
function SetBufferCount (dwCount: DWORD) : HResult; stdcall;
function GetBufferCount: DWORD; stdcall;
function SetDither (bDither: BOOL) : HResult; stdcall;
function SetShades (ulShades: DWORD) : HResult; stdcall;
function SetQuality (rqQuality: TD3DRMRenderQuality) : HResult; stdcall;
function SetTextureQuality (tqTextureQuality: TD3DRMTextureQuality) : HResult; stdcall;
function GetViewports (out lplpViewports: IDirect3DRMViewportArray) : HResult; stdcall;
function GetDither: BOOL; stdcall;
function GetShades: DWORD; stdcall;
function GetHeight: DWORD; stdcall;
function GetWidth: DWORD; stdcall;
function GetTrianglesDrawn: DWORD; stdcall;
function GetWireframeOptions: DWORD; stdcall;
function GetQuality: TD3DRMRenderQuality; stdcall;
function GetColorModel: TD3DColorModel; stdcall;
function GetTextureQuality: TD3DRMTextureQuality; stdcall;
function GetDirect3DDevice (out lplpD3DDevice: IDirect3DDevice) : HResult; stdcall;
(*
* IDirect3DRMDevice2 methods
*)
function InitFromD3D2(lpD3D: IDirect3D2; lpD3DIMDev: IDirect3DDevice2) : HResult; stdcall;
function InitFromSurface(const lpGUID: TGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface): HResult; stdcall;
function SetRenderMode(dwFlags: DWORD): HResult; stdcall;
function GetRenderMode: DWORD; stdcall;
function GetDirect3DDevice2(out lplpD3DDevice: IDirect3DDevice2): HResult; stdcall;
end;
(*
* IDirect3DRMDevice3 methods
*)
function FindPreferredTextureFormat (dwBitDepths, dwFlags: DWORD;
out lpDDPF: TDDPixelFormat) : HResult; stdcall;
function RenderStateChange (dwStateNum, dwVal, dwFlags: DWORD) : HResult; stdcall;
 
IDirect3DRMDevice3 = interface(IDirect3DRMDevice2)
['{549F498B-BFEB-11D1-8ED8-00A0C967A482}']
// IDirect3DRMDevice3 methods
function FindPreferredTextureFormat(dwBitDepths: DWORD; dwFlags: DWORD;
var lpDDPF: TDDPixelFormat): HResult; stdcall;
function RenderStateChange(drsType: TD3DRenderStateType; dwVal: DWORD;
dwFlags: DWORD): HResult; stdcall;
function LightStateChange(drsType: TD3DLightStateType; dwVal: DWORD;
dwFlags: DWORD): HResult; stdcall;
function GetStateChangeOptions(dwStateClass: DWORD; dwStateNum: DWORD;
function LightStateChange (drsType: TD3DLightStateType; // defined different in header and help
dwVal, dwFlags: DWORD) : HResult; stdcall;
function GetStateChangeOptions (dwStateClass, dwStateNum: DWORD;
var pdwFlags: DWORD): HResult; stdcall;
function SetStateChangeOptions(dwStateClass: DWORD; dwStateNum: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetStateChangeOptions ( dwStateClass, dwStateNum, dwFlags: DWORD) : HResult; stdcall;
end;
 
IDirect3DRMViewport = interface(IDirect3DRMObject)
['{EB16CB02-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMViewport methods
['{eb16cb02-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMViewport methods
*)
function Init(lpD3DRMDevice: IDirect3DRMDevice;
lpD3DRMFrameCamera: IDirect3DRMFrame; xpos, ypos, width, height: DWORD): HResult; stdcall;
lpD3DRMFrameCamera: IDirect3DRMFrame; xpos, ypos,
width, height: DWORD) : HResult; stdcall;
function Clear: HResult; stdcall;
function Render(lpD3DRMFrame: IDirect3DRMFrame): HResult; stdcall;
function SetFront(rvFront: TD3DValue): HResult; stdcall;
6725,20 → 10291,20
function SetUniformScaling(bScale: BOOL): HResult; stdcall;
function SetCamera(lpCamera: IDirect3DRMFrame): HResult; stdcall;
function SetProjection(rptType: TD3DRMProjectionType): HResult; stdcall;
function Transform(var lprvDst: TD3DRMVector4D; const lprvSrc: TD3DVector): HResult; stdcall;
function InverseTransform(var lprvDst: TD3DVector;
var lprvSrc: TD3DRMVector4D): HResult; stdcall;
function Configure(lX, lY: Longint; dwWidth, dwHeight: DWORD): HResult; stdcall;
function Transform (out lprvDst: TD3DRMVector4D; const lprvSrc: TD3DVector) : HResult; stdcall;
function InverseTransform (out lprvDst: TD3DVector;
const lprvSrc: TD3DRMVector4D) : HResult; stdcall;
function Configure (lX, lY: LongInt; dwWidth, dwHeight: DWORD) : HResult; stdcall;
function ForceUpdate(dwX1, dwY1, dwX2, dwY2: DWORD): HResult; stdcall;
function SetPlane(rvLeft, rvRight, rvBottom, rvTop: TD3DValue): HResult; stdcall;
function GetCamera(out lpCamera: IDirect3DRMFrame): HResult; stdcall;
function GetDevice(out lpD3DRMDevice: IDirect3DRMDevice): HResult; stdcall;
function GetPlane(var lpd3dvLeft, lpd3dvRight, lpd3dvBottom,
lpd3dvTop: TD3DValue): HResult; stdcall;
function Pick(lX, lY: Longint; out lplpVisuals: IDirect3DRMPickedArray): HResult; stdcall;
function GetPlane (out lpd3dvLeft, lpd3dvRight, lpd3dvBottom, lpd3dvTop:
TD3DValue) : HResult; stdcall;
function Pick (lX, lY: LongInt; var lplpVisuals: IDirect3DRMPickedArray) : HResult; stdcall;
function GetUniformScaling: BOOL; stdcall;
function GetX: Longint; stdcall;
function GetY: Longint; stdcall;
function GetX: LongInt; stdcall;
function GetY: LongInt; stdcall;
function GetWidth: DWORD; stdcall;
function GetHeight: DWORD; stdcall;
function GetField: TD3DValue; stdcall;
6749,10 → 10315,13
end;
 
IDirect3DRMViewport2 = interface(IDirect3DRMObject)
['{4A1B1BE6-BFED-11D1-8ED8-00A0C967A482}']
// IDirect3DRMViewport2 methods
function Init(dec: IDirect3DRMDevice3; camera: IDirect3DRMFrame3;
xpos, ypos: DWORD; width, height: DWORD): HResult; stdcall;
['{4a1b1be6-bfed-11d1-8ed8-00a0c967a482}']
(*
* IDirect3DRMViewport2 methods
*)
function Init (lpD3DRMDevice: IDirect3DRMDevice3;
lpD3DRMFrameCamera: IDirect3DRMFrame3; xpos, ypos,
width, height: DWORD) : HResult; stdcall;
function Clear(dwFlags: DWORD): HResult; stdcall;
function Render(lpD3DRMFrame: IDirect3DRMFrame3): HResult; stdcall;
function SetFront(rvFront: TD3DValue): HResult; stdcall;
6761,20 → 10330,20
function SetUniformScaling(bScale: BOOL): HResult; stdcall;
function SetCamera(lpCamera: IDirect3DRMFrame3): HResult; stdcall;
function SetProjection(rptType: TD3DRMProjectionType): HResult; stdcall;
function Transform(var lprvDst: TD3DRMVector4D; const lprvSrc: TD3DVector): HResult; stdcall;
function InverseTransform(var lprvDst: TD3DVector;
function Transform (out lprvDst: TD3DRMVector4D; const lprvSrc: TD3DVector) : HResult; stdcall;
function InverseTransform (out lprvDst: TD3DVector;
const lprvSrc: TD3DRMVector4D): HResult; stdcall;
function Configure(lX, lY: Longint; dwWidth, dwHeight: DWORD): HResult; stdcall;
function Configure (lX, lY: LongInt; dwWidth, dwHeight: DWORD) : HResult; stdcall;
function ForceUpdate(dwX1, dwY1, dwX2, dwY2: DWORD): HResult; stdcall;
function SetPlane(rvLeft, rvRight, rvBottom, rvTop: TD3DValue): HResult; stdcall;
function GetCamera(out lpCamera: IDirect3DRMFrame3): HResult; stdcall;
function GetDevice(out lpD3DRMDevice: IDirect3DRMDevice3): HResult; stdcall;
function GetPlane(var lpd3dvLeft, lpd3dvRight, lpd3dvBottom,
lpd3dvTop: TD3DValue): HResult; stdcall;
function Pick(lX, lY: Longint; out lplpVisuals: IDirect3DRMPickedArray): HResult; stdcall;
function GetPlane (out lpd3dvLeft, lpd3dvRight, lpd3dvBottom, lpd3dvTop:
TD3DValue) : HResult; stdcall;
function Pick (lX, lY: LongInt; var lplpVisuals: IDirect3DRMPickedArray) : HResult; stdcall;
function GetUniformScaling: BOOL; stdcall;
function GetX: Longint; stdcall;
function GetY: Longint; stdcall;
function GetX: LongInt; stdcall;
function GetY: LongInt; stdcall;
function GetWidth: DWORD; stdcall;
function GetHeight: DWORD; stdcall;
function GetField: TD3DValue; stdcall;
6781,16 → 10350,18
function GetBack: TD3DValue; stdcall;
function GetFront: TD3DValue; stdcall;
function GetProjection: TD3DRMProjectionType; stdcall;
function GetDirect3DViewport(out lplpD3DViewport: IDirect3DViewport): HResult; stdcall;
function TransformVectors(dwNumVectors: DWORD; var lpDstVectors: TD3DRMVector4D;
const lpSrcVectors: TD3DVector): HResult; stdcall;
function InverseTransformVectors(dwNumVectors: DWORD; var lpDstVectors: TD3DVector;
const lpSrcVectors: TD3DRMVector4D): HResult; stdcall;
function GetDirect3DViewport (var lplpD3DViewport: IDirect3DViewport) : HResult; stdcall;
function TransformVectors (dwNumVectors: DWORD; out lpDstVectors:
TD3DRMVector4D; const lpSrcVectors: TD3DVector) : HResult; stdcall;
function InverseTransformVectors (dwNumVectors: DWORD; out lpDstVectors:
TD3DRMVector4D; const lpSrcVectors: TD3DVector) : HResult; stdcall;
end;
 
IDirect3DRMFrame = interface(IDirect3DRMVisual)
['{EB16CB03-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMFrame methods
['{eb16cb03-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMFrame methods
*)
function AddChild(lpD3DRMFrameChild: IDirect3DRMFrame): HResult; stdcall;
function AddLight(lpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
function AddMoveCallback(d3drmFMC: TD3DRMFrameMoveCallback;
6797,10 → 10368,9
lpArg: Pointer): HResult; stdcall;
function AddTransform(rctCombine: TD3DRMCombineType;
rmMatrix: TD3DRMMatrix4D): HResult; stdcall;
function AddTranslation(rctCombine: TD3DRMCombineType; rvX, rvY,
rvZ: TD3DValue): HResult; stdcall;
function AddScale(rctCombine: TD3DRMCombineType; rvX, rvY,
rvZ: TD3DValue): HResult; stdcall;
function AddTranslation (rctCombine: TD3DRMCombineType; rvX, rvY, rvZ:
TD3DValue) : HResult; stdcall;
function AddScale (rctCombine: TD3DRMCombineType; rvX, rvY, rvZ: TD3DValue) : HResult; stdcall;
function AddRotation(rctCombine: TD3DRMCombineType; rvX, rvY, rvZ,
rvTheta: TD3DValue): HResult; stdcall;
function AddVisual(lpD3DRMVisual: IDirect3DRMVisual): HResult; stdcall;
6809,20 → 10379,20
function GetLights(out lplpLights: IDirect3DRMLightArray): HResult; stdcall;
function GetMaterialMode: TD3DRMMaterialMode; stdcall;
function GetParent(out lplpParent: IDirect3DRMFrame): HResult; stdcall;
function GetPosition(lpRef: IDirect3DRMFrame; var lprvPos: TD3DVector): HResult; stdcall;
function GetRotation(lpRef: IDirect3DRMFrame; var lprvAxis: TD3DVector;
var lprvTheta: TD3DValue): HResult; stdcall;
function GetPosition (lpRef: IDirect3DRMFrame; out lprvPos: TD3DVector) : HResult; stdcall;
function GetRotation (lpRef: IDirect3DRMFrame; out lprvAxis: TD3DVector;
out lprvTheta: TD3DValue) : HResult; stdcall;
function GetScene(out lplpRoot: IDirect3DRMFrame): HResult; stdcall;
function GetSortMode: TD3DRMSortMode; stdcall;
function GetTexture(out lplpTexture: IDirect3DRMTexture): HResult; stdcall;
function GetTransform(var rmMatrix: TD3DRMMatrix4D): HResult; stdcall;
function GetTransform (out rmMatrix: TD3DRMMatrix4D) : HResult; stdcall;
function GetVelocity(lpRef: IDirect3DRMFrame; var lprvVel: TD3DVector;
fRotVel: BOOL): HResult; stdcall;
function GetOrientation(lpRef: IDirect3DRMFrame; var lprvDir: TD3DVector;
var lprvUp: TD3DVector): HResult; stdcall;
function GetVisuals(out lplpVisuals: IDirect3DRMVisualArray): HResult; stdcall;
function GetTextureTopology(var lpU, lpV: BOOL): HResult; stdcall;
function InverseTransform(var lprvDst, lprvSrc: TD3DVector): HResult; stdcall;
function GetTextureTopology (out lpU, lpV: BOOL) : HResult; stdcall;
function InverseTransform (out lprvDst: TD3DVector; const lprvSrc: TD3DVector) : HResult; stdcall;
function Load(lpvObjSource: Pointer; lpvObjID: Pointer;
d3drmLOFlags: TD3DRMLoadOptions; d3drmLoadTextureProc:
TD3DRMLoadTextureCallback; lpArgLTP: Pointer): HResult; stdcall;
6839,7 → 10409,7
function GetSceneFogColor: TD3DColor; stdcall;
function GetSceneFogEnable: BOOL; stdcall;
function GetSceneFogMode: TD3DRMFogMode; stdcall;
function GetSceneFogParams(var lprvStart, lprvEnd, lprvDensity: TD3DValue): HResult; stdcall;
function GetSceneFogParams (out lprvStart, lprvEnd, lprvDensity: TD3DValue) : HResult; stdcall;
function SetSceneBackground(rcColor: TD3DColor): HResult; stdcall;
function SetSceneBackgroundRGB(rvRed, rvGreen, rvBlue: TD3DValue): HResult; stdcall;
function SetSceneBackgroundDepth(lpImage: IDirectDrawSurface): HResult; stdcall;
6863,34 → 10433,41
function SetVelocity(lpRef: IDirect3DRMFrame; rvX, rvY, rvZ: TD3DValue;
fRotVel: BOOL): HResult; stdcall;
function SetZbufferMode(d3drmZBM: TD3DRMZBufferMode): HResult; stdcall;
function Transform(var lpd3dVDst, lpd3dVSrc: TD3DVector): HResult; stdcall;
function Transform (out lpd3dVDst: TD3DVector; const lpd3dVSrc: TD3DVector) : HResult; stdcall;
end;
 
IDirect3DRMFrame2 = interface(IDirect3DRMFrame)
['{C3DFBD60-3988-11D0-9EC2-0000C0291AC3}']
// IDirect3DRMFrame2 methods
['{c3dfbd60-3988-11d0-9ec2-0000c0291ac3}']
(*
* IDirect3DRMFrame2 methods
*)
function AddMoveCallback2(d3drmFMC: TD3DRMFrameMoveCallback; lpArg:
Pointer; dwFlags: DWORD): HResult; stdcall;
function GetBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GetBoxEnable: BOOL; stdcall;
function GetAxes(var dir, up: TD3DVector): HResult; stdcall;
function GetBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function GetBoxEnable : boolean; stdcall;
function GetAxes (out dir, up: TD3DVector) : HResult; stdcall;
function GetMaterial(out lplpMaterial: IDirect3DRMMaterial): HResult; stdcall;
function GetInheritAxes: BOOL; stdcall;
function GetHierarchyBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function SetBox(const lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GetInheritAxes : boolean; stdcall;
function GetHierarchyBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function SetBox (const lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function SetBoxEnable(bEnableFlag: BOOL): HResult; stdcall;
function SetAxes(dx, dy, dz, ux, uy, uz: TD3DValue): HResult; stdcall;
function SetInheritAxes(inherit_from_parent: BOOL): HResult; stdcall;
function SetMaterial(lplpMaterial: IDirect3DRMMaterial): HResult; stdcall;
function SetQuaternion(lpRef: IDirect3DRMFrame2; var quat: TD3DRMQuaternion): HResult; stdcall;
function RayPick(lpRefFrame: IDirect3DRMFrame; const ray: TD3DRMRay;
dwFlags: DWORD; out lplpPicked2Array: IDirect3DRMPicked2Array): HResult; stdcall;
function Save(lpFilename: PChar; d3dFormat: TD3DRMXOFFormat;
function SetMaterial (var lplpMaterial: IDirect3DRMMaterial) : HResult; stdcall;
function SetQuaternion (lpRef: IDirect3DRMFrame;
const quat: TD3DRMQuaternion) : HResult; stdcall;
function RayPick (lpRefFrame: IDirect3DRMFrame; var ray: TD3DRMRay;
dwFlags: DWORD; out lplpPicked2Array: IDirect3DRMPicked2Array) :
HResult; stdcall;
function Save (lpFilename: PAnsiChar; d3dFormat: TD3DRMXOFFormat;
d3dSaveFlags: TD3DRMSaveOptions): HResult; stdcall;
end;
 
IDirect3DRMFrame3 = interface(IDirect3DRMVisual)
['{FF6B7F70-A40E-11D1-91F9-0000F8758E66}']
['{ff6b7f70-a40e-11d1-91f9-0000f8758e66}']
(*
* IDirect3DRMFrame3 methods
*)
function AddChild(lpD3DRMFrameChild: IDirect3DRMFrame3): HResult; stdcall;
function AddLight(lpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
function AddMoveCallback(d3drmFMC: TD3DRMFrame3MoveCallback;
6897,10 → 10474,9
lpArg: Pointer; dwFlags: DWORD): HResult; stdcall;
function AddTransform(rctCombine: TD3DRMCombineType;
rmMatrix: TD3DRMMatrix4D): HResult; stdcall;
function AddTranslation(rctCombine: TD3DRMCombineType; rvX, rvY,
rvZ: TD3DValue): HResult; stdcall;
function AddScale(rctCombine: TD3DRMCombineType; rvX, rvY,
rvZ: TD3DValue): HResult; stdcall;
function AddTranslation (rctCombine: TD3DRMCombineType; rvX, rvY, rvZ:
TD3DValue) : HResult; stdcall;
function AddScale (rctCombine: TD3DRMCombineType; rvX, rvY, rvZ: TD3DValue) : HResult; stdcall;
function AddRotation(rctCombine: TD3DRMCombineType; rvX, rvY, rvZ,
rvTheta: TD3DValue): HResult; stdcall;
function AddVisual(lpD3DRMVisual: IDirect3DRMVisual): HResult; stdcall;
6909,19 → 10485,20
function GetLights(out lplpLights: IDirect3DRMLightArray): HResult; stdcall;
function GetMaterialMode: TD3DRMMaterialMode; stdcall;
function GetParent(out lplpParent: IDirect3DRMFrame3): HResult; stdcall;
function GetPosition(lpRef: IDirect3DRMFrame3; var lprvPos: TD3DVector): HResult; stdcall;
function GetRotation(lpRef: IDirect3DRMFrame3; var lprvAxis: TD3DVector;
var lprvTheta: TD3DValue): HResult; stdcall;
function GetPosition (lpRef: IDirect3DRMFrame3; out lprvPos: TD3DVector) : HResult; stdcall;
function GetRotation (lpRef: IDirect3DRMFrame3; out lprvAxis: TD3DVector;
out lprvTheta: TD3DValue) : HResult; stdcall;
function GetScene(out lplpRoot: IDirect3DRMFrame3): HResult; stdcall;
function GetSortMode: TD3DRMSortMode; stdcall;
function GetTexture(out lplpTexture: IDirect3DRMTexture3): HResult; stdcall;
function GetTransform(RefFrame: IDirect3DRMFrame3; var rmMatrix: TD3DRMMatrix4D): HResult; stdcall;
function GetVelocity(lpRef: IDirect3DRMFrame3; var lprvVel: TD3DVector;
function GetTransform (lpRefFrame: IDirect3DRMFrame3;
var rmMatrix: TD3DRMMatrix4D) : HResult; stdcall;
function GetVelocity (lpRef: IDirect3DRMFrame3; out lprvVel: TD3DVector;
fRotVel: BOOL): HResult; stdcall;
function GetOrientation(lpRef: IDirect3DRMFrame3; var lprvDir: TD3DVector;
var lprvUp: TD3DVector): HResult; stdcall;
function GetVisuals(var pdwNumVisuals: DWORD; var lplpVisuals: Pointer): HResult; stdcall;
function InverseTransform(var lprvDst, lprvSrc: TD3DVector): HResult; stdcall;
function GetOrientation (lpRef: IDirect3DRMFrame3; out lprvDir: TD3DVector;
out lprvUp: TD3DVector) : HResult; stdcall;
function GetVisuals (out lplpVisuals: IDirect3DRMVisualArray) : HResult; stdcall;
function InverseTransform (out lprvDst: TD3DVector; const lprvSrc: TD3DVector) : HResult; stdcall;
function Load(lpvObjSource: Pointer; lpvObjID: Pointer;
d3drmLOFlags: TD3DRMLoadOptions; d3drmLoadTextureProc:
TD3DRMLoadTexture3Callback; lpArgLTP: Pointer): HResult; stdcall;
6937,7 → 10514,7
function GetSceneFogColor: TD3DColor; stdcall;
function GetSceneFogEnable: BOOL; stdcall;
function GetSceneFogMode: TD3DRMFogMode; stdcall;
function GetSceneFogParams(var lprvStart, lprvEnd, lprvDensity: TD3DValue): HResult; stdcall;
function GetSceneFogParams (out lprvStart, lprvEnd, lprvDensity: TD3DValue) : HResult; stdcall;
function SetSceneBackground(rcColor: TD3DColor): HResult; stdcall;
function SetSceneBackgroundRGB(rvRed, rvGreen, rvBlue: TD3DValue): HResult; stdcall;
function SetSceneBackgroundDepth(lpImage: IDirectDrawSurface): HResult; stdcall;
6952,48 → 10529,59
function SetMaterialMode(rmmMode: TD3DRMMaterialMode): HResult; stdcall;
function SetOrientation(lpRef: IDirect3DRMFrame3; rvDx, rvDy, rvDz, rvUx,
rvUy, rvUz: TD3DValue): HResult; stdcall;
function SetPosition(lpRef: IDirect3DRMFrame3; rvX, rvY, rvZ: TD3DValue): HResult; stdcall;
function SetRotation(lpRef: IDirect3DRMFrame3; rvX, rvY, rvZ, rvTheta: TD3DValue): HResult; stdcall;
function SetPosition (lpRef: IDirect3DRMFrame3; rvX, rvY, rvZ: TD3DValue) :
HResult; stdcall;
function SetRotation (lpRef: IDirect3DRMFrame3; rvX, rvY, rvZ,
rvTheta: TD3DValue) : HResult; stdcall;
function SetSortMode(d3drmSM: TD3DRMSortMode): HResult; stdcall;
function SetTexture(lpD3DRMTexture: IDirect3DRMTexture3): HResult; stdcall;
function SetVelocity(lpRef: IDirect3DRMFrame3; rvX, rvY, rvZ: TD3DValue;
fRotVel: BOOL): HResult; stdcall;
function SetZbufferMode(d3drmZBM: TD3DRMZBufferMode): HResult; stdcall;
function Transform(var lpd3dVDst, lpd3dVSrc: TD3DVector): HResult; stdcall;
function GetBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GetBoxEnable: BOOL; stdcall;
function GetAxes(var dir, up: TD3DVector): HResult; stdcall;
function Transform (out lpd3dVDst: TD3DVector; const lpd3dVSrc: TD3DVector) : HResult; stdcall;
 
function GetBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function GetBoxEnable : boolean; stdcall;
function GetAxes (out dir, up: TD3DVector) : HResult; stdcall;
function GetMaterial(out lplpMaterial: IDirect3DRMMaterial2): HResult; stdcall;
function GetInheritAxes: BOOL; stdcall;
function GetHierarchyBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function SetBox(const lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GetInheritAxes : boolean; stdcall;
function GetHierarchyBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function SetBox (const lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function SetBoxEnable(bEnableFlag: BOOL): HResult; stdcall;
function SetAxes(dx, dy, dz, ux, uy, uz: TD3DValue): HResult; stdcall;
function SetInheritAxes(inherit_from_parent: BOOL): HResult; stdcall;
function SetMaterial(lplpMaterial: IDirect3DRMMaterial2): HResult; stdcall;
function SetQuaternion(lpRef: IDirect3DRMFrame3; var quat: TD3DRMQuaternion): HResult; stdcall;
function RayPick(lpRefFrame: IDirect3DRMFrame3; const ray: TD3DRMRay;
function SetMaterial (var lplpMaterial: IDirect3DRMMaterial2) : HResult; stdcall;
function SetQuaternion (lpRef: IDirect3DRMFrame3;
const quat: TD3DRMQuaternion) : HResult; stdcall;
function RayPick (lpRefFrame: IDirect3DRMFrame3; var ray: TD3DRMRay;
dwFlags: DWORD; out lplpPicked2Array: IDirect3DRMPicked2Array): HResult; stdcall;
function Save(lpFilename: PChar; d3dFormat: TD3DRMXOFFormat;
function Save (lpFilename: PAnsiChar; d3dFormat: TD3DRMXOFFormat;
d3dSaveFlags: TD3DRMSaveOptions): HResult; stdcall;
function TransformVectors(reference: IDirect3DRMFrame3; dwNumVectors: DWORD;
var lpDstVectors: TD3DVector; const lpSrcVectors: TD3DVector): HResult; stdcall;
function InverseTransformVectors(reference: IDirect3DRMFrame3; dwNumVectors: DWORD;
var lpDstVectors: TD3DVector; const lpSrcVectors: TD3DVector): HResult; stdcall;
function TransformVectors (lpRefFrame: IDirect3DRMFrame3;
dwNumVectors: DWORD; out lpDstVectors: TD3DVector;
const lpSrcVectors: TD3DVector) : HResult; stdcall;
function InverseTransformVectors (lpRefFrame: IDirect3DRMFrame3;
dwNumVectors: DWORD; out lpDstVectors: TD3DVector;
const lpSrcVectors: TD3DVector) : HResult; stdcall;
function SetTraversalOptions(dwFlags: DWORD): HResult; stdcall;
function GetTraversalOptions(var lpdwFlags: DWORD): HResult; stdcall;
function GetTraversalOptions (out lpdwFlags: DWORD) : HResult; stdcall;
function SetSceneFogMethod(dwFlags: DWORD): HResult; stdcall;
function GetSceneFogMethod(var lpdwFlags: DWORD): HResult; stdcall;
function SetMaterialOverride(lpdmOverride: TD3DRMMaterialOverride): HResult; stdcall;
function GetMaterialOverride(var lplpdmOverride: TD3DRMMaterialOverride): HResult; stdcall;
function GetSceneFogMethod (out lpdwFlags: DWORD) : HResult; stdcall;
function SetMaterialOverride (
const lpdmOverride: TD3DRMMaterialOverride) : HResult; stdcall;
function GetMaterialOverride (
const lpdmOverride: TD3DRMMaterialOverride) : HResult; stdcall;
end;
 
 
IDirect3DRMMesh = interface(IDirect3DRMVisual)
['{A3A80D01-6E12-11CF-AC4A-0000C03825A1}']
// IDirect3DRMMesh methods
['{a3a80d01-6e12-11cf-ac4a-0000c03825a1}']
(*
* IDirect3DRMMesh methods
*)
function Scale(sx, sy, sz: TD3DValue): HResult; stdcall;
function Translate(tx, ty, tz: TD3DValue): HResult; stdcall;
function GetBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GetBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function AddGroup(vCount, fCount, vPerFace: DWORD; var fData: DWORD;
var returnId: TD3DRMGroupIndex): HResult; stdcall;
function SetVertices(id: TD3DRMGroupIndex; index, count: DWORD;
7009,10 → 10597,10
IDirect3DRMMaterial): HResult; stdcall;
function SetGroupTexture(id: TD3DRMGroupIndex; value: IDirect3DRMTexture): HResult; stdcall;
function GetGroupCount: DWORD; stdcall;
function GetGroup(id: TD3DRMGroupIndex; var vCount, fCount, vPerFace,
fDataSize, fData: DWORD): HResult; stdcall;
function GetVertices(id: TD3DRMGroupIndex; index: DWORD; count: DWORD;
var returnPtr: TD3DRMVertex): HResult; stdcall;
function GetGroup (id: TD3DRMGroupIndex; vCount, fCount, vPerFace : PDWORD;
var fDataSize: DWORD; fData: PDWORD) : HResult; stdcall;
function GetVertices (id: TD3DRMGroupIndex; index, count : DWORD;
out returnPtr : TD3DRMVertex) : HResult; stdcall;
function GetGroupColor(id: TD3DRMGroupIndex): TD3DColor; stdcall;
function GetGroupMapping(id: TD3DRMGroupIndex): TD3DRMMapping; stdcall;
function GetGroupQuality(id: TD3DRMGroupIndex): TD3DRMRenderQuality; stdcall;
7023,52 → 10611,66
end;
 
IDirect3DRMProgressiveMesh = interface(IDirect3DRMVisual)
['{4516EC79-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMProgressiveMesh methods
['{4516ec79-8f20-11d0-9b6d-0000c0781bc3}']
(*
* IDirect3DRMProgressiveMesh methods
*)
function Load(lpSource, lpObjID: pointer; dloLoadflags: TD3DRMLoadOptions;
lpCallback: TD3DRMLoadTextureCallback; lpArg: pointer): HResult; stdcall;
function GetLoadStatus(var lpStatus: TD3DRMPMeshLoadStatus): HResult; stdcall;
function GetLoadStatus (out lpStatus: TD3DRMPMeshLoadStatus) : HResult; stdcall;
function SetMinRenderDetail(d3dVal: TD3DValue): HResult; stdcall;
function Abort(dwFlags: DWORD): HResult; stdcall;
function GetFaceDetail(var lpdwCount: DWORD): HResult; stdcall;
function GetVertexDetail(var lpdwCount: DWORD): HResult; stdcall;
function GetFaceDetail (out lpdwCount: DWORD) : HResult; stdcall;
function GetVertexDetail (out lpdwCount: DWORD) : HResult; stdcall;
function SetFaceDetail(dwCount: DWORD): HResult; stdcall;
function SetVertexDetail(dwCount: DWORD): HResult; stdcall;
function GetFaceDetailRange(var lpdwMin, lpdwMax: DWORD): HResult; stdcall;
function GetVertexDetailRange(var lpdwMin, lpdwMax: DWORD): HResult; stdcall;
function GetDetail(var lpdvVal: TD3DValue): HResult; stdcall;
function GetFaceDetailRange (out lpdwMin, lpdwMax: DWORD) : HResult; stdcall;
function GetVertexDetailRange (out lpdwMin, lpdwMax: DWORD) : HResult; stdcall;
function GetDetail (out lpdvVal: TD3DValue) : HResult; stdcall;
function SetDetail(lpdvVal: TD3DValue): HResult; stdcall;
function RegisterEvents(hEvent: THANDLE; dwFlags, dwReserved: DWORD): HResult; stdcall;
function CreateMesh(out lplpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
function Duplicate(out lplpD3DRMPMesh: IDirect3DRMProgressiveMesh): HResult; stdcall;
function GetBox(var lpBBox: TD3DRMBox): HResult; stdcall;
function GetBox (out lpBBox: TD3DRMBox) : HResult; stdcall;
function SetQuality(quality: TD3DRMRenderQuality): HResult; stdcall;
function GetQuality(var lpdwquality: TD3DRMRenderQuality): HResult; stdcall;
function GetQuality (out lpdwquality: TD3DRMRenderQuality) : HResult; stdcall;
end;
 
IDirect3DRMShadow = interface(IDirect3DRMVisual)
['{AF359780-6BA3-11CF-AC4A-0000C03825A1}']
// IDirect3DRMShadow methods
['{af359780-6ba3-11cf-ac4a-0000c03825a1}']
(*
* IDirect3DRMShadow methods
*)
function Init(lpD3DRMVisual: IDirect3DRMVisual;
lpD3DRMLight: IDirect3DRMLight; px, py, pz, nx, ny, nz: TD3DValue): HResult; stdcall;
lpD3DRMLight: IDirect3DRMLight;
px, py, pz, nx, ny, nz: TD3DValue) : HResult; stdcall;
end;
 
IDirect3DRMShadow2 = interface(IDirect3DRMShadow)
['{86B44E25-9C82-11D1-BB0B-00A0C981A0A6}']
// IDirect3DRMShadow2 methods
['{86b44e25-9c82-11d1-bb0b-00a0c981a0a6}']
(*
* IDirect3DRMShadow2 methods
*)
function GetVisual(out lplpDirect3DRMVisual: IDirect3DRMVisual): HResult; stdcall;
function SetVisual(pUNK: IUnknown; dwFlags: DWORD): HResult; stdcall;
function SetVisual (lpDirect3DRMVisual: IDirect3DRMVisual;
dwFlags: DWORD) : HResult; stdcall;
function GetLight(out lplpDirect3DRMLight: IDirect3DRMLight): HResult; stdcall;
function SetLight(lpDirect3DRMLight: IDirect3DRMLight; dwFlags: DWORD): HResult; stdcall;
function GetPlane(var px, py, pz: TD3DValue; var nx, ny, nz: TD3DValue): HResult; stdcall;
function SetPlane(px, py, pz: TD3DValue; nx, ny, nz: TD3DValue): HResult; stdcall;
function GetOptions(var pdwOptions: DWORD): HResult; stdcall;
function SetLight (lplpDirect3DRMLight: IDirect3DRMLight;
dwFlags: DWORD) : HResult; stdcall;
function GetPlane (
var pdvPX, pdvPY, pdvPZ, pdvNX, pdvNY, pdvNZ: TD3DValue) : HResult; stdcall;
function SetPlane (px, py, pz, nx, ny, nz: TD3DValue;
dwFlags: DWORD) : HResult; stdcall;
function GetOptions (out pdwOptions: DWORD) : HResult; stdcall;
function SetOptions(dwOptions: DWORD): HResult; stdcall;
 
end;
 
IDirect3DRMFace = interface(IDirect3DRMObject)
['{EB16CB07-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMFace methods
['{eb16cb07-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMFace methods
*)
function AddVertex(x, y, z: TD3DValue): HResult; stdcall;
function AddVertexAndNormalIndexed(vertex: DWORD; normal: DWORD): HResult; stdcall;
function SetColorRGB(red, green, blue: TD3DValue): HResult; stdcall;
7077,22 → 10679,26
function SetTextureCoordinates(vertex: DWORD; u, v: TD3DValue): HResult; stdcall;
function SetMaterial(lpMat: IDirect3DRMMaterial): HResult; stdcall;
function SetTextureTopology(cylU, cylV: BOOL): HResult; stdcall;
function GetVertex(index: DWORD; var lpPosition: TD3DVector; var lpNormal: TD3DVector): HResult; stdcall;
function GetVertices(var lpdwVertexCount: DWORD; var lpPosition, lpNormal: TD3DVector): HResult; stdcall;
function GetTextureCoordinates(index: DWORD; var lpU, lpV: TD3DValue): HResult; stdcall;
function GetTextureTopology(var lpU, lpV: BOOL): HResult; stdcall;
function GetNormal(var lpNormal: TD3DVector): HResult; stdcall;
function GetVertex (index: DWORD; out lpPosition: TD3DVector;
out lpNormal: TD3DVector) : HResult; stdcall;
function GetVertices (var lpdwVertexCount: DWORD;
out lpPosition, lpNormal: TD3DVector) : HResult; stdcall;
function GetTextureCoordinates (index: DWORD; out lpU, lpV: TD3DValue) : HResult; stdcall;
function GetTextureTopology (out lpU, lpV: BOOL) : HResult; stdcall;
function GetNormal (out lpNormal: TD3DVector) : HResult; stdcall;
function GetTexture(out lplpTexture: IDirect3DRMTexture): HResult; stdcall;
function GetMaterial(out lpMat: IDirect3DRMMaterial): HResult; stdcall;
function GetVertexCount: Longint; stdcall;
function GetVertexIndex(dwIndex: DWORD): Longint; stdcall;
function GetTextureCoordinateIndex(dwIndex: DWORD): Longint; stdcall;
function GetVertexCount: Integer; stdcall;
function GetVertexIndex (dwIndex: DWORD) : Integer; stdcall;
function GetTextureCoordinateIndex (dwIndex: DWORD) : Integer; stdcall;
function GetColor: TD3DColor; stdcall;
end;
 
IDirect3DRMFace2 = interface(IDirect3DRMObject)
['{4516EC81-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMFace methods
['{4516ec81-8f20-11d0-9b6d-0000c0781bc3}']
(*
* IDirect3DRMFace2 methods
*)
function AddVertex(x, y, z: TD3DValue): HResult; stdcall;
function AddVertexAndNormalIndexed(vertex: DWORD; normal: DWORD): HResult; stdcall;
function SetColorRGB(red, green, blue: TD3DValue): HResult; stdcall;
7101,30 → 10707,35
function SetTextureCoordinates(vertex: DWORD; u, v: TD3DValue): HResult; stdcall;
function SetMaterial(lpMat: IDirect3DRMMaterial2): HResult; stdcall;
function SetTextureTopology(cylU, cylV: BOOL): HResult; stdcall;
function GetVertex(index: DWORD; var lpPosition: TD3DVector; var lpNormal: TD3DVector): HResult; stdcall;
function GetVertices(var lpdwVertexCount: DWORD; var lpPosition, lpNormal: TD3DVector): HResult; stdcall;
function GetTextureCoordinates(index: DWORD; var lpU, lpV: TD3DValue): HResult; stdcall;
function GetTextureTopology(var lpU, lpV: BOOL): HResult; stdcall;
function GetNormal(var lpNormal: TD3DVector): HResult; stdcall;
function GetVertex (index: DWORD; out lpPosition: TD3DVector;
out lpNormal: TD3DVector) : HResult; stdcall;
function GetVertices (var lpdwVertexCount: DWORD;
out lpPosition, lpNormal: TD3DVector) : HResult; stdcall;
function GetTextureCoordinates (index: DWORD; out lpU, lpV: TD3DValue) : HResult; stdcall;
function GetTextureTopology (out lpU, lpV: BOOL) : HResult; stdcall;
function GetNormal (out lpNormal: TD3DVector) : HResult; stdcall;
function GetTexture(out lplpTexture: IDirect3DRMTexture3): HResult; stdcall;
function GetMaterial(out lpMat: IDirect3DRMMaterial2): HResult; stdcall;
function GetVertexCount: Longint; stdcall;
function GetVertexIndex(dwIndex: DWORD): Longint; stdcall;
function GetTextureCoordinateIndex(dwIndex: DWORD): Longint; stdcall;
function GetVertexCount: Integer; stdcall;
function GetVertexIndex (dwIndex: DWORD) : Integer; stdcall;
function GetTextureCoordinateIndex (dwIndex: DWORD) : Integer; stdcall;
function GetColor: TD3DColor; stdcall;
end;
 
IDirect3DRMMeshBuilder = interface(IDirect3DRMVisual)
['{A3A80D02-6E12-11CF-AC4A-0000C03825A1}']
// IDirect3DRMMeshBuilder methods
function Load(lpvObjSource, lpvObjID: Pointer; d3drmLOFlags: TD3DRMLoadOptions;
d3drmLoadTextureProc: TD3DRMLoadTextureCallback; lpvArg: Pointer): HResult; stdcall;
['{a3a80d02-6e12-11cf-ac4a-0000c03825a1}']
(*
* IDirect3DRMMeshBuilder methods
*)
function Load (lpvObjSource, lpvObjID: Pointer; d3drmLOFlags:
TD3DRMLoadOptions; d3drmLoadTextureProc: TD3DRMLoadTextureCallback;
lpvArg: Pointer) : HResult; stdcall;
function Save(lpFilename: PChar; TD3DRMXOFFormat: TD3DRMXOFFormat;
d3drmSOContents: TD3DRMSaveOptions): HResult; stdcall;
function Scale(sx, sy, sz: TD3DValue): HResult; stdcall;
function Translate(tx, ty, tz: TD3DValue): HResult; stdcall;
function SetColorSource(source: TD3DRMColorSource): HResult; stdcall;
function GetBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GetBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function GenerateNormals: HResult; stdcall;
function GetColorSource: TD3DRMColorSource; stdcall;
function AddMesh(lpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
7131,9 → 10742,9
function AddMeshBuilder(lpD3DRMMeshBuild: IDirect3DRMMeshBuilder): HResult; stdcall;
function AddFrame(lpD3DRMFrame: IDirect3DRMFrame): HResult; stdcall;
function AddFace(lpD3DRMFace: IDirect3DRMFace): HResult; stdcall;
function AddFaces(dwVertexCount: DWORD; var lpD3DVertices: TD3DVector;
normalCount: DWORD; var lpNormals: TD3DVector; var lpFaceData: DWORD;
out lplpD3DRMFaceArray: IDirect3DRMFaceArray): HResult; stdcall;
function AddFaces (dwVertexCount: DWORD; const lpD3DVertices: TD3DVector;
normalCount: DWORD; lpNormals: PD3DVector; var lpFaceData: DWORD;
lplpD3DRMFaceArray: PIDirect3DRMFaceArray) : HResult; stdcall;
function ReserveSpace(vertexCount, normalCount, faceCount: DWORD): HResult; stdcall;
function SetColorRGB(red, green, blue: TD3DValue): HResult; stdcall;
function SetColor(color: TD3DColor): HResult; stdcall;
7149,52 → 10760,62
function SetVertexColorRGB(index: DWORD; red, green, blue: TD3DValue): HResult; stdcall;
function GetFaces(out lplpD3DRMFaceArray: IDirect3DRMFaceArray): HResult; stdcall;
function GetVertices(var vcount: DWORD; var vertices: TD3DVector;
var ncount: DWORD; var normals: TD3DVector; var face_data_size: DWORD;
var face_data: DWORD): HResult; stdcall;
function GetTextureCoordinates(index: DWORD; var u, v: TD3DValue): HResult; stdcall;
function AddVertex(x, y, z: TD3DValue): Longint; stdcall;
function AddNormal(x, y, z: TD3DValue): Longint; stdcall;
var ncount : DWORD;
var normals : TD3DVector;
var face_data_size, face_data : DWORD) : HResult; stdcall;
function GetTextureCoordinates(index : DWORD; out u, v : TD3DValue) : HResult; stdcall;
function AddVertex (x, y, z: TD3DValue) : Integer; stdcall;
function AddNormal (x, y, z: TD3DValue) : Integer; stdcall;
function CreateFace(out lplpd3drmFace: IDirect3DRMFace): HResult; stdcall;
function GetQuality: TD3DRMRenderQuality; stdcall;
function GetPerspective: BOOL; stdcall;
function GetFaceCount: Longint; stdcall;
function GetVertexCount: Longint; stdcall;
function GetFaceCount: Integer; stdcall;
function GetVertexCount: Integer; stdcall;
function GetVertexColor(index: DWORD): TD3DColor; stdcall;
function CreateMesh(out lplpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
end;
 
IDirect3DRMMeshBuilder2 = interface(IDirect3DRMMeshBuilder)
['{4516EC77-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMMeshBuilder2 methods
function GenerateNormals2(dvCreaseAngle: TD3DValue; dwFlags: DWORD): HResult; stdcall;
function GetFace(dwIndex: DWORD; out lplpD3DRMFace: IDirect3DRMFace): HResult; stdcall;
['{4516ec77-8f20-11d0-9b6d-0000c0781bc3}']
(*
* IDirect3DRMMeshBuilder2 methods
*)
function GenerateNormals2 (
dvCreaseAngle: TD3DValue; dwFlags: DWORD) : HResult; stdcall;
function GetFace (dwIndex: DWORD; lplpD3DRMFace: IDirect3DRMFace) : HResult; stdcall;
end;
 
IDirect3DRMMeshBuilder3 = interface(IDirect3DRMVisual)
['{4516EC82-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMMeshBuilder methods
function Load(lpvObjSource, lpvObjID: Pointer; d3drmLOFlags: TD3DRMLoadOptions;
d3drmLoadTextureProc: TD3DRMLoadTexture3Callback; lpvArg: Pointer): HResult; stdcall;
function Save(lpFilename: PChar; TD3DRMXOFFormat: TD3DRMXOFFormat;
['{ff6b7f71-a40e-11d1-91f9-0000f8758e66}']
(*
* IDirect3DRMMeshBuilder3 methods
*)
function Load (lpvObjSource, lpvObjID: Pointer;
d3drmLOFlags: TD3DRMLoadOptions;
d3drmLoadTextureProc: TD3DRMLoadTexture3Callback;
lpvArg: Pointer) : HResult; stdcall;
function Save (lpFilename: PAnsiChar; TD3DRMXOFFormat: TD3DRMXOFFormat;
d3drmSOContents: TD3DRMSaveOptions): HResult; stdcall;
function Scale(sx, sy, sz: TD3DValue): HResult; stdcall;
function Translate(tx, ty, tz: TD3DValue): HResult; stdcall;
function SetColorSource(source: TD3DRMColorSource): HResult; stdcall;
function GetBox(var lpD3DRMBox: TD3DRMBox): HResult; stdcall;
function GenerateNormals(dvCreaseAngle: TD3DValue; dwFlags: DWORD): HResult; stdcall;
function GetBox (out lpTD3DRMBox: TD3DRMBox) : HResult; stdcall;
function GenerateNormals (
dvCreaseAngle: TD3DValue; dwFlags: DWORD): HResult; stdcall;
function GetColorSource: TD3DRMColorSource; stdcall;
function AddMesh(lpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
function AddMeshBuilder(lpD3DRMMeshBuild: IDirect3DRMMeshBuilder3): HResult; stdcall;
function AddMeshBuilder (
lpD3DRMMeshBuild: IDirect3DRMMeshBuilder3) : HResult; stdcall;
function AddFrame(lpD3DRMFrame: IDirect3DRMFrame3): HResult; stdcall;
function AddFace(lpD3DRMFace: IDirect3DRMFace2): HResult; stdcall;
function AddFaces(dwVertexCount: DWORD; var lpD3DVertices: TD3DVector;
normalCount: DWORD; var lpNormals: TD3DVector; var lpFaceData: DWORD;
out lplpD3DRMFaceArray: IDirect3DRMFaceArray): HResult; stdcall;
function AddFaces (dwVertexCount: DWORD; const lpD3DVertices: TD3DVector;
normalCount: DWORD; lpNormals: PD3DVector; var lpFaceData: DWORD;
lplpD3DRMFaceArray: PIDirect3DRMFaceArray) : HResult; stdcall;
function ReserveSpace(vertexCount, normalCount, faceCount: DWORD): HResult; stdcall;
function SetColorRGB(red, green, blue: TD3DValue): HResult; stdcall;
function SetColor(color: TD3DColor): HResult; stdcall;
function SetTexture(lpD3DRMTexture: IDirect3DRMTexture3): HResult; stdcall;
function SetMaterial(lpDirect3DRMMaterial: IDirect3DRMMaterial2): HResult; stdcall;
function SetMaterial (lpIDirect3DRMmaterial: IDirect3DRMMaterial2) : HResult; stdcall;
function SetTextureTopology(cylU, cylV: BOOL): HResult; stdcall;
function SetQuality(quality: TD3DRMRenderQuality): HResult; stdcall;
function SetPerspective(perspective: BOOL): HResult; stdcall;
7204,50 → 10825,53
function SetVertexColor(index: DWORD; color: TD3DColor): HResult; stdcall;
function SetVertexColorRGB(index: DWORD; red, green, blue: TD3DValue): HResult; stdcall;
function GetFaces(out lplpD3DRMFaceArray: IDirect3DRMFaceArray): HResult; stdcall;
function GetGeometry(var vcount: DWORD; var vertices; var ncount: DWORD; var normals;
var face_data_size: DWORD; var face_data): HResult; stdcall;
function GetTextureCoordinates(index: DWORD; var u, v: TD3DValue): HResult; stdcall;
function AddVertex(x, y, z: TD3DValue): Longint; stdcall;
function AddNormal(x, y, z: TD3DValue): Longint; stdcall;
function GetGeometry (var vcount: DWORD; var vertices : TD3DVector;
var ncount : DWORD; var normals : TD3DVector;
var face_data_size, face_data : DWORD) : HResult; stdcall;
function GetTextureCoordinates(index : DWORD; out u, v : TD3DValue) : HResult; stdcall;
function AddVertex (x, y, z: TD3DValue) : Integer; stdcall;
function AddNormal (x, y, z: TD3DValue) : Integer; stdcall;
function CreateFace(out lplpd3drmFace: IDirect3DRMFace2): HResult; stdcall;
function GetQuality: TD3DRMRenderQuality; stdcall;
function GetPerspective: BOOL; stdcall;
function GetFaceCount: Longint; stdcall;
function GetVertexCount: Longint; stdcall;
function GetFaceCount: Integer; stdcall;
function GetVertexCount: Integer; stdcall;
function GetVertexColor(index: DWORD): TD3DColor; stdcall;
function CreateMesh(out lplpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
function GetFace(dwIndex: DWORD; out lplpD3DRMFace: IDirect3DRMFace2): HResult; stdcall;
function GetVertex(dwIndex: DWORD; var lpVector: TD3DVector): HResult; stdcall;
function GetNormal(dwIndex: DWORD; var lpVector: TD3DVector): HResult; stdcall;
function DeleteVertices(dwIndexFirst: DWORD; dwCount: DWORD): HResult; stdcall;
function DeleteNormals(dwIndexFirst: DWORD; dwCount: DWORD): HResult; stdcall;
function DeleteFace(lpD3DRMFace: IDirect3DRMFace2): HResult; stdcall;
function GetFace
(dwIndex: DWORD; lplpD3DRMFace: IDirect3DRMFace) : HResult; stdcall;
function GetVertex (dwIndex: DWORD; out lpVector: TD3DVector) : HResult; stdcall;
function GetNormal (dwIndex: DWORD; out lpVector: TD3DVector) : HResult; stdcall;
function DeleteVertices (dwFirstIndex, dwCount: DWORD) : HResult; stdcall;
function DeleteNormals (dwFirstIndex, dwCount: DWORD) : HResult; stdcall;
function DeleteFace (lpFace: IDirect3DRMFace2) : HResult; stdcall;
function Empty(dwFlags: DWORD): HResult; stdcall;
function Optimize(dwFlags: DWORD): HResult; stdcall;
function AddFacesIndexed(dwFlags: DWORD; var lpdwvIndices: DWORD;
var dwIndexFirst: DWORD; var dwCount: DWORD): HResult; stdcall;
lpdwIndexFirst, lpdwCount: PDWORD) : HResult; stdcall;
function CreateSubMesh(out lplpUnk: IUnknown): HResult; stdcall;
function GetParentMesh(dwFlags: DWORD; out lplpUnk: IUnknown): HResult; stdcall;
function GetSubMeshes(var lpdwCount: DWORD; out lplpUnk: IUnknown): HResult; stdcall;
function DeleteSubMesh(lpUnk: IUnknown): HResult; stdcall;
function GetSubMeshes (lpdwCount: PDWORD; lpUnk: IUnknown) : HResult; stdcall;
function DeleteSubMesh (lplpUnk: IUnknown) : HResult; stdcall;
function Enable(dwFlags: DWORD): HResult; stdcall;
function GetEnable(var lpdwFlags: DWORD): HResult; stdcall;
function AddTriangles(dwFlags: DWORD; dwFormat: DWORD; dwVertexCount: DWORD;
lpvData: Pointer): HResult; stdcall;
function SetVertices(dwIndexFirst: DWORD; dwCount: DWORD;
const lpdvVector: TD3DVector): HResult; stdcall;
function GetVertices(dwIndexFirst: DWORD; var lpdwCount: DWORD;
function GetEnable (out lpdwFlags: DWORD) : HResult; stdcall;
function AddTriangles (dwFlags, dwFormat, dwVertexCount: DWORD;
lpData: pointer) : HResult; stdcall;
function SetVertices
(dwFirst, dwCount: DWORD; const lpdvVector: TD3DVector) : HResult; stdcall;
function GetVertices(dwFirst: DWORD; var lpdwCount: DWORD;
lpdvVector: PD3DVector) : HResult; stdcall;
function SetNormals(dwFirst, dwCount: DWORD; const lpdvVector: TD3DVector) : HResult; stdcall;
function GetNormals (dwFirst: DWORD; lpdwCount: PDWORD;
var lpdvVector: TD3DVector): HResult; stdcall;
function SetNormals(dwIndexFirst: DWORD; dwCount: DWORD;
const lpdvVector: TD3DVector): HResult; stdcall;
function GetNormals(dwIndexFirst: DWORD; var lpdwCount: DWORD;
var lpdvVector: TD3DVector): HResult; stdcall;
function GetNormalCount: Longint; stdcall;
function GetNormalCount : integer; stdcall;
end;
 
IDirect3DRMLight = interface(IDirect3DRMObject)
['{EB16CB08-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMLight methods
['{eb16cb08-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMLight methods
*)
function SetType(d3drmtType: TD3DRMLightType): HResult; stdcall;
function SetColor(rcColor: TD3DColor): HResult; stdcall;
function SetColorRGB(rvRed, rvGreen, rvBlue: TD3DValue): HResult; stdcall;
7270,9 → 10894,11
end;
 
IDirect3DRMTexture = interface(IDirect3DRMVisual)
['{EB16CB09-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMTexture methods
function InitFromFile(filename: PChar): HResult; stdcall;
['{eb16cb09-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMTexture methods
*)
function InitFromFile (filename: PAnsiChar) : HResult; stdcall;
function InitFromSurface(lpDDS: IDirectDrawSurface): HResult; stdcall;
function InitFromResource(rs: HRSRC): HResult; stdcall;
function Changed(bPixels, bPalette: BOOL): HResult; stdcall;
7279,12 → 10905,12
function SetColors(ulColors: DWORD): HResult; stdcall;
function SetShades(ulShades: DWORD): HResult; stdcall;
function SetDecalSize(rvWidth, rvHeight: TD3DValue): HResult; stdcall;
function SetDecalOrigin(lX, lY: Longint): HResult; stdcall;
function SetDecalOrigin (lX, lY: LongInt) : HResult; stdcall;
function SetDecalScale(dwScale: DWORD): HResult; stdcall;
function SetDecalTransparency(bTransp: BOOL): HResult; stdcall;
function SetDecalTransparentColor(rcTransp: TD3DColor): HResult; stdcall;
function GetDecalSize(var lprvWidth, lprvHeight: TD3DValue): HResult; stdcall;
function GetDecalOrigin(var lplX, lplY: Longint): HResult; stdcall;
function GetDecalSize (out lprvWidth, lprvHeight: TD3DValue) : HResult; stdcall;
function GetDecalOrigin (out lplX, lplY: LongInt) : HResult; stdcall;
function GetImage: PD3DRMImage; stdcall;
function GetShades: DWORD; stdcall;
function GetColors: DWORD; stdcall;
7294,53 → 10920,70
end;
 
IDirect3DRMTexture2 = interface(IDirect3DRMTexture)
['{120F30C0-1629-11D0-941C-0080C80CFA7B}']
// IDirect3DRMTexture2 methods
['{120f30c0-1629-11d0-941c-0080c80cfa7b}']
(*
* IDirect3DRMTexture2 methods
*)
function InitFromImage(const lpImage: TD3DRMImage): HResult; stdcall;
function InitFromResource2(hModule: HModule; strName, strType: PChar): HResult; stdcall;
function InitFromResource2 (hModule: HModule;
strName, strType: PAnsiChar) : HResult; stdcall;
function GenerateMIPMap(dwFlags: DWORD): HResult; stdcall;
end;
 
IDirect3DRMTexture3 = interface(IDirect3DRMTexture2)
['{FF6B7F73-A40E-11D1-91F9-0000F8758E66}']
// IDirect3DRMTexture3 methods
function GetSurface(dwFlags: DWORD; out lplpDDS: IDirectDrawSurface): HResult; stdcall;
function SetCacheOptions(lImportance: Longint; dwFlags: DWORD): HResult; stdcall;
function GetCacheOptions(var lplImportance: Longint; var lpdwFlags: DWORD): HResult; stdcall;
function SetDownsampleCallback(pCallback: TD3DRMDownSampleCallback; pArg: Pointer): HResult; stdcall;
function SetValidationCallback(pCallback: TD3DRMValidationCallback; pArg: Pointer): HResult; stdcall;
['{ff6b7f73-a40e-11d1-91f9-0000f8758e66}']
(*
* IDirect3DRMTexture3 methods
*)
function GetSurface
(dwFlags: DWORD; out lplpDDS: IDirectDrawSurface) : HResult; stdcall;
function SetCacheOptions (lImportance: integer; dwFlags: DWORD) : HResult; stdcall;
function GetCacheOptions (var lplImportance: integer; var lpdwFlags: DWORD) : HResult; stdcall;
function SetDownsampleCallback (
pCallback: TD3DRMDownSampleCallback; pArg: pointer) : HResult; stdcall;
function SetValidationCallback (
pCallback: TD3DRMValidationCallback; pArg: pointer) : HResult; stdcall;
end;
 
IDirect3DRMWrap = interface(IDirect3DRMObject)
['{EB16CB0A-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMWrap methods
['{eb16cb0a-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMWrap methods
*)
function Init(d3drmwt: TD3DRMWrapType; lpd3drmfRef: IDirect3DRMFrame;
ox, oy, oz, dx, dy, dz, ux, uy, uz, ou, ov, su, sv: TD3DValue): HResult; stdcall;
ox, oy, oz, dx, dy, dz, ux, uy, uz, ou, ov, su, sv: TD3DValue)
: HResult; stdcall;
function Apply(lpObject: IDirect3DRMObject): HResult; stdcall;
function ApplyRelative(frame: IDirect3DRMFrame; mesh: IDirect3DRMObject): HResult; stdcall;
end;
 
IDirect3DRMMaterial = interface(IDirect3DRMObject)
['{EB16CB0B-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMMaterial methods
['{eb16cb0b-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMMaterial methods
*)
function SetPower(rvPower: TD3DValue): HResult; stdcall;
function SetSpecular(r, g, b: TD3DValue): HResult; stdcall;
function SetEmissive(r, g, b: TD3DValue): HResult; stdcall;
function GetPower: TD3DValue; stdcall;
function GetSpecular(var r, g, b: TD3DValue): HResult; stdcall;
function GetEmissive(var r, g, b: TD3DValue): HResult; stdcall;
function GetSpecular (out lpr, lpg, lpb: TD3DValue) : HResult; stdcall;
function GetEmissive (out lpr, lpg, lpb: TD3DValue) : HResult; stdcall;
end;
 
IDirect3DRMMaterial2 = interface(IDirect3DRMMaterial)
['{FF6B7F75-A40E-11D1-91F9-0000F8758E66}']
// IDirect3DRMMaterial2 methods
function GetAmbient(var r, g, b: TD3DValue): HResult; stdcall;
['{ff6b7f75-a40e-11d1-91f9-0000f8758e66}']
(*
* IDirect3DRMMaterial2 methods
*)
function GetAmbient(out r,g,b: TD3DValue) : HResult; stdcall;
function SetAmbient(r, g, b: TD3DValue): HResult; stdcall;
end;
 
IDirect3DRMAnimation = interface(IDirect3DRMObject)
['{EB16CB0D-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMAnimation methods
['{eb16cb0d-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMAnimation methods
*)
function SetOptions(d3drmanimFlags: TD3DRMAnimationOptions): HResult; stdcall;
function AddRotateKey(rvTime: TD3DValue; const rqQuat: TD3DRMQuaternion): HResult; stdcall;
function AddPositionKey(rvTime, rvX, rvY, rvZ: TD3DValue): HResult; stdcall;
7351,30 → 10994,27
function GetOptions: TD3DRMAnimationOptions; stdcall;
end;
 
IDirect3DRMAnimation2 = interface(IDirect3DRMObject)
['{FF6B7F77-A40E-11D1-91F9-0000F8758E66}']
// IDirect3DRMAnimation2 methods
function SetOptions(d3drmanimFlags: TD3DRMAnimationOptions): HResult; stdcall;
function AddRotateKey(rvTime: TD3DValue; const rqQuat: TD3DRMQuaternion): HResult; stdcall;
function AddPositionKey(rvTime, rvX, rvY, rvZ: TD3DValue): HResult; stdcall;
function AddScaleKey(time, x, y, z: TD3DValue): HResult; stdcall;
function DeleteKey(time: TD3DValue): HResult; stdcall;
function SetFrame(lpD3DRMFrame: IDirect3DRMFrame3): HResult; stdcall;
function SetTime(rvTime: TD3DValue): HResult; stdcall;
function GetOptions: TD3DRMAnimationOptions; stdcall;
IDirect3DRMAnimation2 = interface (IDirect3DRMAnimation)
['{ff6b7f77-a40e-11d1-91f9-0000f8758e66}']
(*
* IDirect3DRMAnimation methods
*)
function GetFrame(out lpD3DFrame: IDirect3DRMFrame3): HResult; stdcall;
function DeleteKeyByID(dwID: DWORD): HResult; stdcall;
function AddKey(const lpKey: TD3DRMAnimationKey): HResult; stdcall;
function ModifyKey(const lpKey: TD3DRMAnimationKey): HResult; stdcall;
function GetKeys(dvTimeMin, dvTimeMax: TD3DValue; var lpdwNumKeys: DWORD;
var lpKey: TD3DRMAnimationKey): HResult; stdcall;
lpKey: PD3DRMAnimationKey) : HResult; stdcall;
end;
 
IDirect3DRMAnimationSet = interface(IDirect3DRMObject)
['{EB16CB0E-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMAnimationSet methods
['{eb16cb0e-d271-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMAnimationSet methods
*)
function AddAnimation(lpD3DRMAnimation: IDirect3DRMAnimation): HResult; stdcall;
function Load(lpvObjSource, lpvObjID: Pointer; d3drmLOFlags: TD3DRMLoadOptions;
function Load (lpvObjSource, lpvObjID: Pointer;
d3drmLOFlags: TD3DRMLoadOptions;
d3drmLoadTextureProc: TD3DRMLoadTextureCallback; lpArgLTP: Pointer;
lpParentFrame: IDirect3DRMFrame): HResult; stdcall;
function DeleteAnimation(lpD3DRMAnimation: IDirect3DRMAnimation): HResult; stdcall;
7382,21 → 11022,27
end;
 
IDirect3DRMAnimationSet2 = interface(IDirect3DRMObject)
['{FF6B7F79-A40E-11D1-91F9-0000F8758E66}']
// IDirect3DRMAnimationSet2 methods
function AddAnimation(aid: IDirect3DRMAnimation2): HResult; stdcall;
function Load(filename, name: Pointer; loadflags: TD3DRMLoadOptions;
d3drmLoadTextureProc: TD3DRMLoadTexture3Callback; lpArg: Pointer;
['{ff6b7f79-a40e-11d1-91f9-0000f8758e66}']
(*
* IDirect3DRMAnimationSet methods
*)
function AddAnimation (lpD3DRMAnimation: IDirect3DRMAnimation2) : HResult; stdcall;
function Load (lpvObjSource, lpvObjID: Pointer;
d3drmLOFlags: TD3DRMLoadOptions;
d3drmLoadTextureProc: TD3DRMLoadTexture3Callback; lpArgLTP: Pointer;
lpParentFrame: IDirect3DRMFrame3): HResult; stdcall;
function DeleteAnimation(aid: IDirect3DRMAnimation2): HResult; stdcall;
function SetTime(time: TD3DValue): HResult; stdcall;
function GetAnimations(out lpAnimationArray: IDirect3DRMAnimationArray): HResult; stdcall;
function DeleteAnimation (lpD3DRMAnimation: IDirect3DRMAnimation2) : HResult; stdcall;
function SetTime (rvTime: TD3DValue) : HResult; stdcall;
function GetAnimations(out lplpArray: IDirect3DRMAnimationArray) : HResult; stdcall;
end;
 
IDirect3DRMUserVisual = interface(IDirect3DRMVisual)
['{59163DE0-6D43-11CF-AC4A-0000C03825A1}']
// IDirect3DRMUserVisual methods
function Init(d3drmUVProc: TD3DRMUserVisualCallback; lpArg: Pointer): HResult; stdcall;
['{59163de0-6d43-11cf-ac4a-0000c03825a1}']
(*
* IDirect3DRMUserVisual methods
*)
function Init (d3drmUVProc: TD3DRMUserVisualCallback;
lpArg: Pointer) : HResult; stdcall;
end;
 
IDirect3DRMArray = interface(IUnknown)
7407,72 → 11053,75
*)
end;
 
IDirect3DRMObjectarray = interface(IDirect3DRMArray)
function GetElement(index: DWORD; out lplpD3DRMObject: IDirect3DRMObject): HResult; stdcall;
IDirect3DRMObjectArray = interface (IDirect3DRMArray)
['{242f6bc2-3849-11d0-9b6d-0000c0781bc3}']
function GetElement (index: DWORD; out lplpD3DRMObject:
IDirect3DRMObject) : HResult; stdcall;
end;
 
IDirect3DRMDeviceArray = interface(IDirect3DRMArray)
['{EB16CB10-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMDevicearraymethods
function GetElement(index: DWORD; out lplpD3DRMDevice: IDirect3DRMDevice): HResult; stdcall;
['{eb16cb0e-d271-11ce-ac48-0000c03825a1}']
function GetElement (index: DWORD; out lplpD3DRMDevice:
IDirect3DRMDevice) : HResult; stdcall;
end;
 
IDirect3DRMFrameArray = interface(IDirect3DRMArray)
['{EB16CB12-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMFramearraymethods
['{eb16cb12-d271-11ce-ac48-0000c03825a1}']
function GetElement(index: DWORD; out lplpD3DRMFrame: IDirect3DRMFrame): HResult; stdcall;
end;
 
IDirect3DRMViewportArray = interface(IDirect3DRMArray)
['{EB16CB11-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMViewportarraymethods
function GetElement(index: DWORD; out lplpD3DRMViewport: IDirect3DRMViewport): HResult; stdcall;
['{eb16cb11-d271-11ce-ac48-0000c03825a1}']
function GetElement (index: DWORD; out lplpD3DRMViewport:
IDirect3DRMViewport) : HResult; stdcall;
end;
 
IDirect3DRMVisualArray = interface(IDirect3DRMArray)
['{EB16CB13-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMVisualarraymethods
function GetElement(index: DWORD; out lplpD3DRMVisual: IDirect3DRMVisual): HResult; stdcall;
['{eb16cb13-d271-11ce-ac48-0000c03825a1}']
function GetElement (index: DWORD; out lplpD3DRMVisual:
IDirect3DRMVisual) : HResult; stdcall;
end;
 
IDirect3DRMAnimationArray = interface(IDirect3DRMArray)
['{D5F1CAE0-4BD7-11D1-B974-0060083E45F3}']
function GetElement(index: DWORD; out lplpD3DRMAnimation: IDirect3DRMAnimation2): HResult; stdcall;
['{d5f1cae0-4bd7-11d1-b974-0060083e45f3}']
function GetElement (index: DWORD; out lplpD3DRMAnimation2:
IDirect3DRMAnimation2) : HResult; stdcall;
end;
 
IDirect3DRMPickedArray = interface(IDirect3DRMArray)
['{EB16CB16-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMPickedarraymethods
['{eb16cb16-d271-11ce-ac48-0000c03825a1}']
function GetPick(index: DWORD; out lplpVisual: IDirect3DRMVisual;
out lplpFrameArray: IDirect3DRMFrameArray;
var lpD3DRMPickDesc: TD3DRMPickDesc): HResult; stdcall;
const lpD3DRMPickDesc: TD3DRMPickDesc) : HResult; stdcall;
 
end;
 
IDirect3DRMLightArray = interface(IDirect3DRMArray)
['{EB16CB14-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMLightarraymethods
['{eb16cb14-d271-11ce-ac48-0000c03825a1}']
function GetElement(index: DWORD; out lplpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
end;
 
 
IDirect3DRMFaceArray = interface(IDirect3DRMArray)
['{EB16CB17-D271-11CE-AC48-0000C03825A1}']
// IDirect3DRMFacearraymethods
['{eb16cb17-d271-11ce-ac48-0000c03825a1}']
function GetElement(index: DWORD; out lplpD3DRMFace: IDirect3DRMFace): HResult; stdcall;
end;
 
IDirect3DRMPicked2Array = interface(IDirect3DRMArray)
['{4516EC7B-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMPicked2arraymethods
['{4516ec7b-8f20-11d0-9b6d-0000c0781bc3}']
function GetPick(index: DWORD; out lplpVisual: IDirect3DRMVisual;
out lplpFrameArray: IDirect3DRMFrameArray;
const lpD3DRMPickDesc2: D3DRMPICKDESC2): HResult; stdcall;
out lplpFrameArray: IDirect3DRMFrameArray; const lpD3DRMPickDesc2:
TD3DRMPickDesc2) : HResult; stdcall;
end;
 
IDirect3DRMInterpolator = interface(IDirect3DRMObject)
['{242F6BC1-3849-11D0-9B6D-0000C0781BC3}']
// IDirect3DRMInterpolator methods
['{242f6bc1-3849-11d0-9b6d-0000c0781bc3}']
(*
* IDirect3DRMInterpolator methods
*)
function AttachObject(lpD3DRMObject: IDirect3DRMObject): HResult; stdcall;
function GetAttachedObjects(lpD3DRMObjectArray: IDirect3DRMObjectArray): HResult; stdcall;
function GetAttachedObjects
(lpD3DRMObjectArray: IDirect3DRMObjectArray) : HResult; stdcall;
function DetachObject(lpD3DRMObject: IDirect3DRMObject): HResult; stdcall;
function SetIndex(d3dVal: TD3DValue): HResult; stdcall;
function GetIndex: TD3DValue; stdcall;
7480,163 → 11129,228
d3drmInterpFlags: TD3DRMInterpolationOptions): HResult; stdcall;
end;
 
IDirect3DRMClippedVisual = interface(IDirect3DRMVisual)
['{5434E733-6D66-11D1-BB0B-0000F875865A}']
// IDirect3DRMClippedVisual methods
IDirect3DRMClippedVisual = interface (IDirect3DRMObject)
['{5434e733-6d66-11d1-bb0b-0000f875865a}']
(*
* IDirect3DRMClippedVisual methods
*)
function Init(lpD3DRMVisual: IDirect3DRMVisual): HResult; stdcall;
function AddPlane(lpRef: IDirect3DRMFrame3; const lpdvPoint, lpdvNormal: TD3DVector;
dwFlags: DWORD; var lpdwReturnID: DWORD): HResult; stdcall;
function AddPlane (lpRef: IDirect3DRMFrame3;
const lpdvPoint, lpdvNormal: TD3DVector;
dwFlags: DWORD; out lpdwReturnID: DWORD) : HResult; stdcall;
function DeletePlane(dwID, dwFlags: DWORD): HResult; stdcall;
function GetPlaneIDs(var lpdwCount, lpdwID: DWORD; dwFlags: DWORD): HResult; stdcall;
function GetPlaneIDs (var lpdwCount: DWORD; out lpdwID: DWORD; dwFlags: DWORD) : HResult; stdcall;
function GetPlane (dwID: DWORD; lpRef: IDirect3DRMFrame3;
var lpdvPoint, lpdvNormal: TD3DVector; dwFlags: DWORD): HResult; stdcall;
out lpdvPoint, lpdvNormal: TD3DVector; dwFlags: DWORD) : HResult; stdcall;
function SetPlane (dwID: DWORD; lpRef: IDirect3DRMFrame3;
const lpdvPoint, lpdvNormal: TD3DVector; dwFlags: DWORD): HResult; stdcall;
end;
 
IDirect3DRMWinDevice = interface(IDirect3DRMObject)
['{C5016CC0-D273-11CE-AC48-0000C03825A1}']
// IDirect3DRMWinDevice methods
function HandlePaint(hDC: HDC): HResult; stdcall;
function HandleActivate(wparam: WORD): HResult; stdcall;
end;
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3drm.h
* Content: Direct3DRM include file
*
***************************************************************************)
 
function D3DRMErrorString(Value: HResult) : string;
 
//type
//TRefClsID = TGUID;
 
type
TD3DRMDevicePaletteCallback = procedure (lpDirect3DRMDev: IDirect3DRMDevice;
lpArg: Pointer; dwIndex: DWORD; red, green, blue: LongInt); cdecl;
 
(*
* Direct3DRM Object Class (for CoCreateInstance())
*)
const
CLSID_CDirect3DRM: TGUID =
(D1:$4516ec41;D2:$8f20;D3:$11d0;D4:($9b,$6d,$00,$00,$c0,$78,$1b,$c3));
 
type
IDirect3DRM = interface(IUnknown)
['{2BC49361-8327-11CF-AC4A-0000C03825A1}']
// IDirect3DRM methods
function CreateObject(const rclsid: TGUID; pUnkOuter: IUnknown;
['{2bc49361-8327-11cf-ac4a-0000c03825a1}']
function CreateObject (const rclsid: TRefClsID; pUnkOuter: IUnknown;
const riid: TGUID; out ppv): HResult; stdcall;
function CreateFrame(lpD3DRMFrame: IDirect3DRMFrame;
out lplpD3DRMFrame: IDirect3DRMFrame): HResult; stdcall;
function CreateMesh(out lplpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
function CreateMeshBuilder(out lplpD3DRMMeshBuilder:
var lplpD3DRMFrame: IDirect3DRMFrame) : HResult; stdcall;
function CreateMesh (var lplpD3DRMMesh: IDirect3DRMMesh) : HResult; stdcall;
function CreateMeshBuilder (var lplpD3DRMMeshBuilder:
IDirect3DRMMeshBuilder): HResult; stdcall;
function CreateFace(out lplpd3drmFace: IDirect3DRMFace): HResult; stdcall;
function CreateAnimation(out lplpD3DRMAnimation: IDirect3DRMAnimation): HResult; stdcall;
function CreateAnimationSet(out lplpD3DRMAnimationSet:
function CreateFace (var lplpd3drmFace: IDirect3DRMFace) : HResult; stdcall;
function CreateAnimation (var lplpD3DRMAnimation: IDirect3DRMAnimation) : HResult; stdcall;
function CreateAnimationSet (var lplpD3DRMAnimationSet:
IDirect3DRMAnimationSet): HResult; stdcall;
function CreateTexture(const lpImage: TD3DRMImage;
out lplpD3DRMTexture: IDirect3DRMTexture): HResult; stdcall;
function CreateTexture (var lpImage: TD3DRMImage;
var lplpD3DRMTexture: IDirect3DRMTexture) : HResult; stdcall;
function CreateLight(d3drmltLightType: TD3DRMLightType;
cColor: TD3DColor; out lplpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
function CreateLightRGB(ltLightType: TD3DRMLightType; vRed, vGreen, vBlue:
TD3DValue; out lplpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
function CreateMaterial(vPower: TD3DValue; out lplpD3DRMMaterial:
cColor: TD3DColor; var lplpD3DRMLight: IDirect3DRMLight) : HResult; stdcall;
function CreateLightRGB (ltLightType: TD3DRMLightType; vRed,
vGreen, vBlue: TD3DValue; var lplpD3DRMLight: IDirect3DRMLight) : HResult; stdcall;
function CreateMaterial (vPower: TD3DValue; var lplpD3DRMMaterial:
IDirect3DRMMaterial): HResult; stdcall;
function CreateDevice(dwWidth, dwHeight: DWORD; out lplpD3DRMDevice:
function CreateDevice (dwWidth, dwHeight: DWORD; var lplpD3DRMDevice:
IDirect3DRMDevice): HResult; stdcall;
function CreateDeviceFromSurface(const lpGUID: TGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface; out lplpD3DRMDevice: IDirect3DRMDevice): HResult; stdcall;
 
(* Create a Windows Device using DirectDraw surfaces *)
function CreateDeviceFromSurface (lpGUID: PGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface; var lplpD3DRMDevice: IDirect3DRMDevice) :
HResult; stdcall;
 
(* Create a Windows Device using D3D objects *)
function CreateDeviceFromD3D(lpD3D: IDirect3D; lpD3DDev: IDirect3DDevice;
out lplpD3DRMDevice: IDirect3DRMDevice): HResult; stdcall;
var lplpD3DRMDevice: IDirect3DRMDevice) : HResult; stdcall;
 
function CreateDeviceFromClipper(lpDDClipper: IDirectDrawClipper;
const lpGUID: TGUID; width, height: DWORD; out lplpD3DRMDevice:
lpGUID: PGUID; width, height: Integer; var lplpD3DRMDevice:
IDirect3DRMDevice): HResult; stdcall;
 
function CreateTextureFromSurface(lpDDS: IDirectDrawSurface;
out lplpD3DRMTexture: IDirect3DRMTexture): HResult; stdcall;
var lplpD3DRMTexture: IDirect3DRMTexture) : HResult; stdcall;
 
function CreateShadow(lpVisual: IDirect3DRMVisual;
lpLight: IDirect3DRMLight; px, py, pz, nx, ny, nz: TD3DValue;
out lplpShadow: IDirect3DRMVisual): HResult; stdcall;
var lplpShadow: IDirect3DRMVisual) : HResult; stdcall;
function CreateViewport(lpDev: IDirect3DRMDevice;
lpCamera: IDirect3DRMFrame; dwXPos, dwYPos, dwWidth, dwHeight: DWORD;
out lplpD3DRMViewport: IDirect3DRMViewport): HResult; stdcall;
var lplpD3DRMViewport: IDirect3DRMViewport) : HResult; stdcall;
function CreateWrap(wraptype: TD3DRMWrapType; lpRef: IDirect3DRMFrame;
ox, oy, oz, dx, dy, dz, ux, uy, uz, ou, ov, su, sv: TD3DValue;
out lplpD3DRMWrap: IDirect3DRMWrap): HResult; stdcall;
var lplpD3DRMWrap: IDirect3DRMWrap) : HResult; stdcall;
function CreateUserVisual(fn: TD3DRMUserVisualCallback; lpArg: Pointer;
out lplpD3DRMUV: IDirect3DRMUserVisual): HResult; stdcall;
function LoadTexture(lpFileName: LPSTR; out lplpD3DRMTexture:
var lplpD3DRMUV: IDirect3DRMUserVisual) : HResult; stdcall;
function LoadTexture (lpFileName: PAnsiChar; var lplpD3DRMTexture:
IDirect3DRMTexture): HResult; stdcall;
function LoadTextureFromResource(rs: HRSRC; out lplpD3DRMTexture:
function LoadTextureFromResource (rs: HRSRC; var lplpD3DRMTexture:
IDirect3DRMTexture): HResult; stdcall;
function SetSearchPath(lpPath: LPSTR): HResult; stdcall;
function AddSearchPath(lpPath: LPSTR): HResult; stdcall;
function GetSearchPath(var lpdwSize: DWORD; lpszPath: LPSTR): HResult; stdcall;
 
function SetSearchPath (lpPath: PAnsiChar) : HResult; stdcall;
function AddSearchPath (lpPath: PAnsiChar) : HResult; stdcall;
function GetSearchPath (var lpdwSize: DWORD; lpszPath: PAnsiChar) : HResult; stdcall;
function SetDefaultTextureColors(dwColors: DWORD): HResult; stdcall;
function SetDefaultTextureShades(dwShades: DWORD): HResult; stdcall;
function GetDevices(out lplpDevArray: IDirect3DRMDeviceArray): HResult; stdcall;
function GetNamedObject(lpName: LPSTR; out lplpD3DRMObject:
IDirect3DRMObject): HResult; stdcall;
 
function GetDevices (var lplpDevArray: IDirect3DRMDeviceArray) : HResult; stdcall;
function GetNamedObject (lpName: PAnsiChar; var lplpD3DRMObject: IDirect3DRMObject) : HResult; stdcall;
 
function EnumerateObjects(func: TD3DRMObjectCallback; lpArg: Pointer): HResult; stdcall;
 
function Load(lpvObjSource, lpvObjID: Pointer; var lplpGUIDs: PGUID;
dwcGUIDs: DWORD; d3drmLOFlags: TD3DRMLoadOptions; d3drmLoadProc:
D3DRMLOADCALLBACK; lpArgLP: Pointer; d3drmLoadTextureProc:
TD3DRMLoadTextureCallback; lpArgLTP: Pointer;
lpParentFrame: IDirect3DRMFrame): HResult; stdcall;
TD3DRMLoadCallback; lpArgLP: Pointer; d3drmLoadTextureProc:
TD3DRMLoadTextureCallback; lpArgLTP: Pointer; lpParentFrame:
IDirect3DRMFrame) : HResult; stdcall;
function Tick(d3dvalTick: TD3DValue): HResult; stdcall;
end;
 
// Moved from D3DRMObj, to avoid circular unit reference:
 
IDirect3DRMObject2 = interface (IUnknown)
['{4516ec7c-8f20-11d0-9b6d-0000c0781bc3}']
(*
* IDirect3DRMObject2 methods
*)
function AddDestroyCallback (lpCallback: TD3DRMObjectCallback;
lpArg: Pointer) : HResult; stdcall;
function Clone (pUnkOuter: IUnknown; const riid: TGUID;
out ppvObj) : HResult; stdcall;
function DeleteDestroyCallback (d3drmObjProc: TD3DRMObjectCallback;
lpArg: Pointer) : HResult; stdcall;
function GetClientData (dwID: DWORD; out lplpvData: Pointer) : HResult; stdcall;
function GetDirect3DRM (out lplpDirect3DRM: IDirect3DRM) : HResult; stdcall;
function GetName (var lpdwSize: DWORD; lpName: PAnsiChar) : HResult; stdcall;
function SetClientData (dwID: DWORD; lpvData: pointer; dwFlags: DWORD) : HResult; stdcall;
function SetName (lpName: PAnsiChar) : HResult; stdcall;
function GetAge (dwFlags: DWORD; out pdwAge: DWORD) : HResult; stdcall;
end;
 
IID_IDirect3DRMObject2 = IDirect3DRMObject2;
 
IDirect3DRM2 = interface(IUnknown)
['{4516ECC8-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRM2 methods
function CreateObject(const rclsid: TGUID; pUnkOuter: IUnknown;
['{4516ecc8-8f20-11d0-9b6d-0000c0781bc3}']
function CreateObject (const rclsid: TRefClsID; pUnkOuter: IUnknown;
const riid: TGUID; out ppv): HResult; stdcall;
function CreateFrame(lpD3DRMFrame: IDirect3DRMFrame2;
out lplpD3DRMFrame: IDirect3DRMFrame2): HResult; stdcall;
function CreateMesh(out lplpD3DRMMesh: IDirect3DRMMesh): HResult; stdcall;
function CreateMeshBuilder(out lplpD3DRMMeshBuilder:
var lplpD3DRMFrame: IDirect3DRMFrame2) : HResult; stdcall;
function CreateMesh (var lplpD3DRMMesh: IDirect3DRMMesh) : HResult; stdcall;
function CreateMeshBuilder (var lplpD3DRMMeshBuilder:
IDirect3DRMMeshBuilder2): HResult; stdcall;
function CreateFace(out lplpd3drmFace: IDirect3DRMFace): HResult; stdcall;
function CreateAnimation(out lplpD3DRMAnimation: IDirect3DRMAnimation): HResult; stdcall;
function CreateAnimationSet(out lplpD3DRMAnimationSet:
function CreateFace (var lplpd3drmFace: IDirect3DRMFace) : HResult; stdcall;
function CreateAnimation (var lplpD3DRMAnimation: IDirect3DRMAnimation) : HResult; stdcall;
function CreateAnimationSet (var lplpD3DRMAnimationSet:
IDirect3DRMAnimationSet): HResult; stdcall;
function CreateTexture(const lpImage: TD3DRMImage;
out lplpD3DRMTexture: IDirect3DRMTexture2): HResult; stdcall;
function CreateTexture (var lpImage: TD3DRMImage;
var lplpD3DRMTexture: IDirect3DRMTexture2) : HResult; stdcall;
function CreateLight(d3drmltLightType: TD3DRMLightType;
cColor: TD3DColor; out lplpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
cColor: TD3DColor; var lplpD3DRMLight: IDirect3DRMLight) : HResult; stdcall;
function CreateLightRGB(ltLightType: TD3DRMLightType; vRed,
vGreen, vBlue: TD3DValue; out lplpD3DRMLight: IDirect3DRMLight): HResult; stdcall;
function CreateMaterial(vPower: TD3DValue; out lplpD3DRMMaterial:
vGreen, vBlue: TD3DValue; var lplpD3DRMLight: IDirect3DRMLight) : HResult; stdcall;
function CreateMaterial (vPower: TD3DValue; var lplpD3DRMMaterial:
IDirect3DRMMaterial): HResult; stdcall;
function CreateDevice(dwWidth, dwHeight: DWORD; out lplpD3DRMDevice:
function CreateDevice (dwWidth, dwHeight: DWORD; var lplpD3DRMDevice:
IDirect3DRMDevice2): HResult; stdcall;
function CreateDeviceFromSurface(const lpGUID: TGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface; out lplpD3DRMDevice: IDirect3DRMDevice2): HResult; stdcall;
 
(* Create a Windows Device using DirectDraw surfaces *)
function CreateDeviceFromSurface (lpGUID: PGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface; var lplpD3DRMDevice: IDirect3DRMDevice2) :
HResult; stdcall;
 
(* Create a Windows Device using D3D objects *)
function CreateDeviceFromD3D(lpD3D: IDirect3D2; lpD3DDev: IDirect3DDevice2;
out lplpD3DRMDevice: IDirect3DRMDevice2): HResult; stdcall;
var lplpD3DRMDevice: IDirect3DRMDevice2) : HResult; stdcall;
 
function CreateDeviceFromClipper(lpDDClipper: IDirectDrawClipper;
const lpGUID: TGUID; width, height: DWORD; out lplpD3DRMDevice:
lpGUID: PGUID; width, height: Integer; var lplpD3DRMDevice:
IDirect3DRMDevice2): HResult; stdcall;
 
function CreateTextureFromSurface( lpDDS: IDirectDrawSurface;
out lplpD3DRMTexture: IDirect3DRMTexture2): HResult; stdcall;
var lplpD3DRMTexture: IDirect3DRMTexture2) : HResult; stdcall;
 
function CreateShadow(lpVisual: IDirect3DRMVisual;
lpLight: IDirect3DRMLight; px, py, pz, nx, ny, nz: TD3DValue;
out lplpShadow: IDirect3DRMVisual): HResult; stdcall;
var lplpShadow: IDirect3DRMVisual) : HResult; stdcall;
function CreateViewport(lpDev: IDirect3DRMDevice;
lpCamera: IDirect3DRMFrame; dwXPos, dwYPos, dwWidth, dwHeight: DWORD;
out lplpD3DRMViewport: IDirect3DRMViewport): HResult; stdcall;
var lplpD3DRMViewport: IDirect3DRMViewport) : HResult; stdcall;
function CreateWrap(wraptype: TD3DRMWrapType; lpRef: IDirect3DRMFrame;
ox, oy, oz, dx, dy, dz, ux, uy, uz, ou, ov, su, sv: TD3DValue;
out lplpD3DRMWrap: IDirect3DRMWrap): HResult; stdcall;
var lplpD3DRMWrap: IDirect3DRMWrap) : HResult; stdcall;
function CreateUserVisual(fn: TD3DRMUserVisualCallback; lpArg: Pointer;
out lplpD3DRMUV: IDirect3DRMUserVisual): HResult; stdcall;
function LoadTexture(lpFileName: LPSTR; out lplpD3DRMTexture:
var lplpD3DRMUV: IDirect3DRMUserVisual) : HResult; stdcall;
function LoadTexture (lpFileName: PAnsiChar; var lplpD3DRMTexture:
IDirect3DRMTexture2): HResult; stdcall;
function LoadTextureFromResource(hModule: HModule; str: LPCSTR; out lplpD3DRMTexture:
function LoadTextureFromResource (rs: HRSRC; var lplpD3DRMTexture:
IDirect3DRMTexture2): HResult; stdcall;
function SetSearchPath(lpPath: LPSTR): HResult; stdcall;
function AddSearchPath(lpPath: LPSTR): HResult; stdcall;
function GetSearchPath(var lpdwSize: DWORD; lpszPath: LPSTR): HResult; stdcall;
 
function SetSearchPath (lpPath: PAnsiChar) : HResult; stdcall;
function AddSearchPath (lpPath: PAnsiChar) : HResult; stdcall;
function GetSearchPath (var lpdwSize: DWORD; lpszPath: PAnsiChar) : HResult; stdcall;
function SetDefaultTextureColors(dwColors: DWORD): HResult; stdcall;
function SetDefaultTextureShades(dwShades: DWORD): HResult; stdcall;
function GetDevices(out lplpDevArray: IDirect3DRMDeviceArray): HResult; stdcall;
function GetNamedObject(lpName: LPSTR; out lplpD3DRMObject:
 
function GetDevices (var lplpDevArray: IDirect3DRMDeviceArray) : HResult; stdcall;
function GetNamedObject (lpName: PAnsiChar; var lplpD3DRMObject:
IDirect3DRMObject): HResult; stdcall;
 
function EnumerateObjects(func: TD3DRMObjectCallback; lpArg: Pointer): HResult; stdcall;
 
function Load(lpvObjSource, lpvObjID: Pointer; var lplpGUIDs: PGUID;
dwcGUIDs: DWORD; d3drmLOFlags: TD3DRMLoadOptions; d3drmLoadProc:
D3DRMLOADCALLBACK; lpArgLP: Pointer; d3drmLoadTextureProc:
TD3DRMLoadCallback; lpArgLP: Pointer; d3drmLoadTextureProc:
TD3DRMLoadTextureCallback; lpArgLTP: Pointer; lpParentFrame:
IDirect3DRMFrame): HResult; stdcall;
function Tick(d3dvalTick: TD3DValue): HResult; stdcall;
function CreateProgressiveMesh(out lplpD3DRMProgressiveMesh:
function CreateProgressiveMesh (var lplpD3DRMProgressiveMesh:
IDirect3DRMProgressiveMesh): HResult; stdcall;
end;
 
IDirect3DRM3 = interface(IUnknown)
['{4516EC83-8F20-11D0-9B6D-0000C0781BC3}']
// IDirect3DRM2 methods
function CreateObject(const rclsid: TGUID; pUnkOuter: IUnknown;
['{4516ec83-8f20-11d0-9b6d-0000c0781bc3}']
function CreateObject (const rclsid: TRefClsID; pUnkOuter: IUnknown;
const riid: TGUID; out ppv): HResult; stdcall;
function CreateFrame(lpD3DRMFrame: IDirect3DRMFrame3;
out lplpD3DRMFrame: IDirect3DRMFrame3): HResult; stdcall;
7657,18 → 11371,26
IDirect3DRMMaterial2): HResult; stdcall;
function CreateDevice(dwWidth, dwHeight: DWORD; out lplpD3DRMDevice:
IDirect3DRMDevice3): HResult; stdcall;
function CreateDeviceFromSurface(const lpGUID: TGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface; out lplpD3DRMDevice: IDirect3DRMDevice3): HResult; stdcall;
 
(* Create a Windows Device using DirectDraw surfaces *)
function CreateDeviceFromSurface (lpGUID: PGUID; lpDD: IDirectDraw;
lpDDSBack: IDirectDrawSurface; dwFlags: DWORD;
out lplpD3DRMDevice: IDirect3DRMDevice3) : HResult; stdcall;
 
(* Create a Windows Device using D3D objects *)
function CreateDeviceFromD3D(lpD3D: IDirect3D2; lpD3DDev: IDirect3DDevice2;
out lplpD3DRMDevice: IDirect3DRMDevice3): HResult; stdcall;
 
function CreateDeviceFromClipper(lpDDClipper: IDirectDrawClipper;
const lpGUID: TGUID; width, height: DWORD; out lplpD3DRMDevice:
IDirect3DRMDevice3): HResult; stdcall;
lpGUID: PGUID; width, height: Integer;
out lplpD3DRMDevice: IDirect3DRMDevice3) : HResult; stdcall;
 
function CreateTextureFromSurface( lpDDS: IDirectDrawSurface;
out lplpD3DRMTexture: IDirect3DRMTexture3): HResult; stdcall;
function CreateShadow(lpVisual: IDirect3DRMVisual;
lpLight: IDirect3DRMLight; px, py, pz, nx, ny, nz: TD3DValue;
out lplpShadow: IDirect3DRMShadow): HResult; stdcall;
 
function CreateShadow (pUnk: IUnknown; lpLight: IDirect3DRMLight;
px, py, pz, nx, ny, nz: TD3DValue;
out lplpShadow: IDirect3DRMShadow2) : HResult; stdcall;
function CreateViewport(lpDev: IDirect3DRMDevice3;
lpCamera: IDirect3DRMFrame3; dwXPos, dwYPos, dwWidth, dwHeight: DWORD;
out lplpD3DRMViewport: IDirect3DRMViewport2): HResult; stdcall;
7677,733 → 11399,687
out lplpD3DRMWrap: IDirect3DRMWrap): HResult; stdcall;
function CreateUserVisual(fn: TD3DRMUserVisualCallback; lpArg: Pointer;
out lplpD3DRMUV: IDirect3DRMUserVisual): HResult; stdcall;
function LoadTexture(lpFileName: LPSTR; out lplpD3DRMTexture:
function LoadTexture (lpFileName: PAnsiChar; out lplpD3DRMTexture:
IDirect3DRMTexture3): HResult; stdcall;
function LoadTextureFromResource(hModule: HModule; str: LPCSTR; out lplpD3DRMTexture:
IDirect3DRMTexture3): HResult; stdcall;
function LoadTextureFromResource (hModule: HMODULE;
strName, strType: PAnsiChar;
out lplpD3DRMTexture: IDirect3DRMTexture3) : HResult; stdcall;
 
function SetSearchPath(lpPath: LPSTR): HResult; stdcall;
function AddSearchPath(lpPath: LPSTR): HResult; stdcall;
function GetSearchPath(var lpdwSize: DWORD; lpszPath: LPSTR): HResult; stdcall;
function SetSearchPath (lpPath: PAnsiChar) : HResult; stdcall;
function AddSearchPath (lpPath: PAnsiChar) : HResult; stdcall;
function GetSearchPath (var lpdwSize: DWORD; lpszPath: PAnsiChar) : HResult; stdcall;
function SetDefaultTextureColors(dwColors: DWORD): HResult; stdcall;
function SetDefaultTextureShades(dwShades: DWORD): HResult; stdcall;
 
function GetDevices(out lplpDevArray: IDirect3DRMDeviceArray): HResult; stdcall;
function GetNamedObject(lpName: LPSTR; out lplpD3DRMObject:
IDirect3DRMObject): HResult; stdcall;
function GetNamedObject (lpName: PAnsiChar; out lplpD3DRMObject: IDirect3DRMObject) : HResult; stdcall;
 
function EnumerateObjects(func: TD3DRMObjectCallback; lpArg: Pointer): HResult; stdcall;
 
function Load(lpvObjSource, lpvObjID: Pointer; var lplpGUIDs: PGUID;
dwcGUIDs: DWORD; d3drmLOFlags: TD3DRMLoadOptions; d3drmLoadProc:
D3DRMLOADCALLBACK; lpArgLP: Pointer; d3drmLoadTextureProc:
TD3DRMLoadCallback; lpArgLP: Pointer; d3drmLoadTextureProc:
TD3DRMLoadTexture3Callback; lpArgLTP: Pointer; lpParentFrame:
IDirect3DRMFrame3): HResult; stdcall;
function Tick(d3dvalTick: TD3DValue): HResult; stdcall;
function CreateProgressiveMesh(out lplpD3DRMProgressiveMesh:
IDirect3DRMProgressiveMesh): HResult; stdcall;
// IDirect3RM3 methods
function RegisterClient(const rguid: TGUID; var lpdwID: DWORD): HResult; stdcall;
 
(* Used with IDirect3DRMObject2 *)
function RegisterClient (const rguid: TGUID; out lpdwID: DWORD) : HResult; stdcall;
function UnregisterClient(const rguid: TGUID): HResult; stdcall;
 
function CreateClippedVisual(lpVisual: IDirect3DRMVisual;
out lpClippedVisual: IDirect3DRMVisual): HResult; stdcall;
function SetOptions(lpdwOptions: DWORD): HResult; stdcall;
function GetOptions(var lpdwOptions: DWORD): HResult; stdcall;
lpClippedVisual: IDirect3DRMClippedVisual) : HResult; stdcall;
function SetOptions (dwOptions: DWORD) : HResult; stdcall;
function GetOptions (out lpdwOptions: DWORD) : HResult; stdcall;
end;
 
IID_IDirect3DRM = IDirect3DRM;
IID_IDirect3DRM2 = IDirect3DRM2;
IID_IDirect3DRM3 = IDirect3DRM3;
 
const
D3DRM_OK = HResult(DD_OK);
D3DRMERR_BADOBJECT = HResult($88760000 + 781);
D3DRMERR_BADTYPE = HResult($88760000 + 782);
D3DRMERR_BADALLOC = HResult($88760000 + 783);
D3DRMERR_FACEUSED = HResult($88760000 + 784);
D3DRMERR_NOTFOUND = HResult($88760000 + 785);
D3DRMERR_NOTDONEYET = HResult($88760000 + 786);
D3DRMERR_FILENOTFOUND = HResult($88760000 + 787);
D3DRMERR_BADFILE = HResult($88760000 + 788);
D3DRMERR_BADDEVICE = HResult($88760000 + 789);
D3DRMERR_BADVALUE = HResult($88760000 + 790);
D3DRMERR_BADMAJORVERSION = HResult($88760000 + 791);
D3DRMERR_BADMINORVERSION = HResult($88760000 + 792);
D3DRMERR_UNABLETOEXECUTE = HResult($88760000 + 793);
D3DRMERR_LIBRARYNOTFOUND = HResult($88760000 + 794);
D3DRMERR_INVALIDLIBRARY = HResult($88760000 + 795);
D3DRMERR_PENDING = HResult($88760000 + 796);
D3DRMERR_NOTENOUGHDATA = HResult($88760000 + 797);
D3DRMERR_REQUESTTOOLARGE = HResult($88760000 + 798);
D3DRMERR_REQUESTTOOSMALL = HResult($88760000 + 799);
D3DRMERR_CONNECTIONLOST = HResult($88760000 + 800);
D3DRMERR_LOADABORTED = HResult($88760000 + 801);
D3DRMERR_NOINTERNET = HResult($88760000 + 802);
D3DRMERR_BADCACHEFILE = HResult($88760000 + 803);
D3DRMERR_BOXNOTSET = HResult($88760000 + 804);
D3DRMERR_BADPMDATA = HResult($88760000 + 805);
D3DRMERR_CLIENTNOTREGISTERED = HResult($88760000 + 806);
D3DRMERR_NOTCREATEDFROMDDS = HResult($88760000 + 807);
D3DRMERR_NOSUCHKEY = HResult($88760000 + 808);
D3DRMERR_INCOMPATABLEKEY = HResult($88760000 + 809);
D3DRMERR_ELEMENTINUSE = HResult($88760000 + 810);
D3DRMERR_TEXTUREFORMATNOTFOUND = HResult($88760000 + 811);
D3DRMERR_NOTAGGREGATED = HResult($88760000 + 812);
MAKE_D3RMDHRESULT = HResult($88760000);
 
{ Create a Direct3DRM API }
function Direct3DRMCreate(out lplpDirect3DRM: IDirect3DRM): HResult; stdcall;
D3DRM_OK = DD_OK;
D3DRMERR_BADOBJECT = MAKE_D3RMDHRESULT + 781;
D3DRMERR_BADTYPE = MAKE_D3RMDHRESULT + 782;
D3DRMERR_BADALLOC = MAKE_D3RMDHRESULT + 783;
D3DRMERR_FACEUSED = MAKE_D3RMDHRESULT + 784;
D3DRMERR_NOTFOUND = MAKE_D3RMDHRESULT + 785;
D3DRMERR_NOTDONEYET = MAKE_D3RMDHRESULT + 786;
D3DRMERR_FILENOTFOUND = MAKE_D3RMDHRESULT + 787;
D3DRMERR_BADFILE = MAKE_D3RMDHRESULT + 788;
D3DRMERR_BADDEVICE = MAKE_D3RMDHRESULT + 789;
D3DRMERR_BADVALUE = MAKE_D3RMDHRESULT + 790;
D3DRMERR_BADMAJORVERSION = MAKE_D3RMDHRESULT + 791;
D3DRMERR_BADMINORVERSION = MAKE_D3RMDHRESULT + 792;
D3DRMERR_UNABLETOEXECUTE = MAKE_D3RMDHRESULT + 793;
D3DRMERR_LIBRARYNOTFOUND = MAKE_D3RMDHRESULT + 794;
D3DRMERR_INVALIDLIBRARY = MAKE_D3RMDHRESULT + 795;
D3DRMERR_PENDING = MAKE_D3RMDHRESULT + 796;
D3DRMERR_NOTENOUGHDATA = MAKE_D3RMDHRESULT + 797;
D3DRMERR_REQUESTTOOLARGE = MAKE_D3RMDHRESULT + 798;
D3DRMERR_REQUESTTOOSMALL = MAKE_D3RMDHRESULT + 799;
D3DRMERR_CONNECTIONLOST = MAKE_D3RMDHRESULT + 800;
D3DRMERR_LOADABORTED = MAKE_D3RMDHRESULT + 801;
D3DRMERR_NOINTERNET = MAKE_D3RMDHRESULT + 802;
D3DRMERR_BADCACHEFILE = MAKE_D3RMDHRESULT + 803;
D3DRMERR_BOXNOTSET = MAKE_D3RMDHRESULT + 804;
D3DRMERR_BADPMDATA = MAKE_D3RMDHRESULT + 805;
D3DRMERR_CLIENTNOTREGISTERED = MAKE_D3RMDHRESULT + 806;
D3DRMERR_NOTCREATEDFROMDDS = MAKE_D3RMDHRESULT + 807;
D3DRMERR_NOSUCHKEY = MAKE_D3RMDHRESULT + 808;
D3DRMERR_INCOMPATABLEKEY = MAKE_D3RMDHRESULT + 809;
D3DRMERR_ELEMENTINUSE = MAKE_D3RMDHRESULT + 810;
D3DRMERR_TEXTUREFORMATNOTFOUND = MAKE_D3RMDHRESULT + 811;
 
(* Create a Direct3DRM API *)
var
Direct3DRMCreate : function (out lplpDirect3DRM: IDirect3DRM) : HResult; stdcall;
 
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3drmwin.h
* Content: Direct3DRM include file
*
***************************************************************************)
 
type
IDirect3DRMWinDevice = interface (IDirect3DRMObject)
['{c5016cc0-d273-11ce-ac48-0000c03825a1}']
(*
* IDirect3DRMWinDevice methods
*)
 
(* Repaint the window with the last frame which was rendered. *)
function HandlePaint (hDC: HDC) : HResult; stdcall;
 
(* Respond to a WM_ACTIVATE message. *)
function HandleActivate (wparam: WORD) : HResult; stdcall;
end;
 
(*
* GUIDS used by Direct3DRM Windows interface
*)
IID_IDirect3DRMWinDevice = IDirect3DRMWinDevice;
 
(***************************************************************************
*
* Copyright (C) 1998-1999 Microsoft Corporation. All Rights Reserved.
*
* File: dxfile.h
* File: rmxfguid.h
*
* Content: DirectX File public header file
* Content: Defines GUIDs of D3DRM's templates.
*
***************************************************************************)
 
{ DirectXFile Object Class Id (for CoCreateInstance()) }
 
const
CLSID_CDirectXFile: TGUID = '{4516EC43-8F20-11D0-9B6D-0000C0781BC3}';
(* {2B957100-9E9A-11cf-AB39-0020AF71E433} *)
TID_D3DRMInfo: TGUID =
(D1:$2b957100;D2:$9e9a;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
{ DirectX File Interface GUIDs. }
(* {3D82AB44-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMMesh: TGUID =
(D1:$3d82ab44;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
IID_IDirectXFile: TGUID = '{3D82AB40-62DA-11CF-AB39-0020AF71E433}';
IID_IDirectXFileEnumObject: TGUID = '{3D82AB41-62DA-11CF-AB39-0020AF71E433}';
IID_IDirectXFileSaveObject: TGUID = '{3D82AB42-62DA-11CF-AB39-0020AF71E433}';
IID_IDirectXFileObject: TGUID = '{3D82AB43-62DA-11CF-AB39-0020AF71E433}';
IID_IDirectXFileData: TGUID = '{3D82AB44-62DA-11CF-AB39-0020AF71E433}';
IID_IDirectXFileDataReference: TGUID = '{3D82AB45-62DA-11CF-AB39-0020AF71E433}';
IID_IDirectXFileBinary: TGUID = '{3D82AB46-62DA-11CF-AB39-0020AF71E433}';
(* {3D82AB5E-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMVector: TGUID =
(D1:$3d82ab5e;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
type
TDXFileFormat = DWORD;
DXFILEFORMAT = TDXFileFormat;
(* {3D82AB5F-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMMeshFace: TGUID =
(D1:$3d82ab5f;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
const
DXFILEFORMAT_BINARY = 0;
DXFILEFORMAT_TEXT = 1;
DXFILEFORMAT_COMPRESSED = 2;
(* {3D82AB4D-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMMaterial: TGUID =
(D1:$3d82ab4d;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
type
TDXFileLoadOptions = DWORD;
DXFILELOADOPTIONS = TDXFileLoadOptions;
(* {35FF44E1-6C7C-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialArray: TGUID =
(D1:$35ff44e1;D2:$6c7c;D3:$11cf;D4:($8F,$52,$00,$40,$33,$35,$94,$a3));
 
const
DXFILELOAD_FROMFILE = $00;
DXFILELOAD_FROMRESOURCE = $01;
DXFILELOAD_FROMMEMORY = $02;
DXFILELOAD_FROMSTREAM = $04;
DXFILELOAD_FROMURL = $08;
(* {3D82AB46-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMFrame: TGUID =
(D1:$3d82ab46;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
type
PDXFileLoadResource = ^TDXFileLoadResource;
TDXFileLoadResource = record
hModule: HModule;
lpName: PChar;
lpType: PChar;
end;
(* {F6F23F41-7686-11cf-8F52-0040333594A3} *)
TID_D3DRMFrameTransformMatrix: TGUID =
(D1:$f6f23f41;D2:$7686;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
DXFILELOADRESOURCE = TDXFileLoadResource;
LPDXFILELOADRESOURCE = PDXFileLoadResource;
(* {F6F23F42-7686-11cf-8F52-0040333594A3} *)
TID_D3DRMMeshMaterialList: TGUID =
(D1:$f6f23f42;D2:$7686;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
PDXFileLoadMemory = ^TDXFileLoadMemory;
TDXFileLoadMemory = record
lpMemory: Pointer;
dSize: DWORD;
end;
(* {F6F23F40-7686-11cf-8F52-0040333594A3} *)
TID_D3DRMMeshTextureCoords: TGUID =
(D1:$f6f23f40;D2:$7686;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
DXFILELOADMEMORY = TDXFileLoadMemory;
LPDXFILELOADMEMORY = PDXFileLoadMemory;
(* {F6F23F43-7686-11cf-8F52-0040333594A3} *)
TID_D3DRMMeshNormals: TGUID =
(D1:$f6f23f43;D2:$7686;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
{ DirectX File object types. }
(* {F6F23F44-7686-11cf-8F52-0040333594A3} *)
TID_D3DRMCoords2d: TGUID =
(D1:$f6f23f44;D2:$7686;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
type
IDirectXFile = interface;
IDirectXFileEnumObject = interface;
IDirectXFileSaveObject = interface;
IDirectXFileObject = interface;
IDirectXFileData = interface;
IDirectXFileDataReference = interface;
IDirectXFileBinary = interface;
(* {F6F23F45-7686-11cf-8F52-0040333594A3} *)
TID_D3DRMMatrix4x4: TGUID =
(D1:$f6f23f45;D2:$7686;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
IDirectXFile = interface(IUnknown)
['{3D82AB40-62DA-11CF-AB39-0020AF71E433}']
function CreateEnumObject(pvSource: Pointer; dwLoadOptions: TDXFileLoadOptions;
out ppEnumObj: IDirectXFileEnumObject): HResult; stdcall;
function CreateSaveObject(szFileName: PChar; dwFileFormat: TDXFileFormat;
out ppSaveObj: IDirectXFileSaveObject): HResult; stdcall;
function RegisterTemplates(pvData: Pointer; cbSize: DWORD): HResult; stdcall;
end;
(* {3D82AB4F-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMAnimation: TGUID =
(D1:$3d82ab4f;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
IDirectXFileEnumObject = interface(IUnknown)
['{3D82AB41-62DA-11CF-AB39-0020AF71E433}']
function GetNextDataObject(out ppDataObj: IDirectXFileData): HResult; stdcall;
function GetDataObjectById(const rguid: TGUID; out ppDataObj: IDirectXFileData): HResult; stdcall;
function GetDataObjectByName(szName: PChar; out ppDataObj: IDirectXFileData): HResult; stdcall;
end;
(* {3D82AB50-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMAnimationSet: TGUID =
(D1:$3d82ab50;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
IDirectXFileSaveObject = interface(IUnknown)
['{3D82AB42-62DA-11CF-AB39-0020AF71E433}']
function SaveTemplates(cTemplates: DWORD; var ppguidTemplates: PGUID): HResult; stdcall;
function CreateDataObject(const rguidTemplate: TGUID; szName: PChar;
const pguid: TGUID; cbSize: DWORD; pvData: Pointer;
out ppDataObj: IDirectXFileData): HResult; stdcall;
function SaveData(pDataObj: IDirectXFileData): HResult; stdcall;
end;
(* {10DD46A8-775B-11cf-8F52-0040333594A3} *)
TID_D3DRMAnimationKey: TGUID =
(D1:$10dd46a8;D2:$775b;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
IDirectXFileObject = interface(IUnknown)
['{3D82AB43-62DA-11CF-AB39-0020AF71E433}']
function GetName(pstrNameBuf: PChar; var dwBufLen: DWORD): HResult; stdcall;
function GetId (var pGuidBuf: TGUID): HResult; stdcall;
end;
(* {10DD46A9-775B-11cf-8F52-0040333594A3} *)
TID_D3DRMFloatKeys: TGUID =
(D1:$10dd46a9;D2:$775b;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
IDirectXFileData = interface(IDirectXFileObject)
['{3D82AB44-62DA-11CF-AB39-0020AF71E433}']
function GetData(szMember: PChar; var pcbSize: DWORD; var ppvData: Pointer): HResult; stdcall;
function GetType(var ppguid: PGUID): HResult; stdcall;
function GetNextObject(out ppChildObj: IDirectXFileObject): HResult; stdcall;
function AddDataObject(pDataObj: IDirectXFileData): HResult; stdcall;
function AddDataReference(szRef: PChar; pguidRef: PGUID): HResult; stdcall;
function AddBinaryObjec (szName: PChar; pguid: PGUID; szMimeType: PChar;
pvData: Pointer; cbSize: DWORD): HResult; stdcall;
end;
(* {01411840-7786-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialAmbientColor: TGUID =
(D1:$01411840;D2:$7786;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
IDirectXFileDataReference = interface(IDirectXFileObject)
['{3D82AB45-62DA-11CF-AB39-0020AF71E433}']
function Resolve(out ppDataObj: IDirectXFileData): HResult; stdcall;
end;
(* {01411841-7786-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialDiffuseColor: TGUID =
(D1:$01411841;D2:$7786;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
IDirectXFileBinary = interface(IDirectXFileObject)
['{3D82AB46-62DA-11CF-AB39-0020AF71E433}']
function GetSize(var pcbSize: DWORD): HResult; stdcall;
function GetMimeType(var pszMimeType: PChar): HResult; stdcall;
function Read(pvData: Pointer; cbSize: DWORD; var pcbRead: DWORD): HResult; stdcall;
end;
(* {01411842-7786-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialSpecularColor: TGUID =
(D1:$01411842;D2:$7786;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
{ DirectX File Header template's GUID. }
(* {D3E16E80-7835-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialEmissiveColor: TGUID =
(D1:$d3e16e80;D2:$7835;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
const
TID_DXFILEHeader: TGUID = '{3D82AB43-62DA-11CF-AB39-0020AF71E433}';
(* {01411843-7786-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialPower: TGUID =
(D1:$01411843;D2:$7786;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
{ DirectX File errors. }
(* {35FF44E0-6C7C-11cf-8F52-0040333594A3} *)
TID_D3DRMColorRGBA: TGUID =
(D1:$35ff44e0;D2:$6c7c;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$A3));
 
const
DXFILE_OK = HResult(0);
(* {D3E16E81-7835-11cf-8F52-0040333594A3} *)
TID_D3DRMColorRGB: TGUID =
(D1:$d3e16e81;D2:$7835;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
DXFILEERR_BADOBJECT = HResult($88760000 + 850);
DXFILEERR_BADVALUE = HResult($88760000 + 851);
DXFILEERR_BADTYPE = HResult($88760000 + 852);
DXFILEERR_BADSTREAMHANDLE = HResult($88760000 + 853);
DXFILEERR_BADALLOC = HResult($88760000 + 854);
DXFILEERR_NOTFOUND = HResult($88760000 + 855);
DXFILEERR_NOTDONEYET = HResult($88760000 + 856);
DXFILEERR_FILENOTFOUND = HResult($88760000 + 857);
DXFILEERR_RESOURCENOTFOUND = HResult($88760000 + 858);
DXFILEERR_URLNOTFOUND = HResult($88760000 + 859);
DXFILEERR_BADRESOURCE = HResult($88760000 + 860);
DXFILEERR_BADFILETYPE = HResult($88760000 + 861);
DXFILEERR_BADFILEVERSION = HResult($88760000 + 862);
DXFILEERR_BADFILEFLOATSIZE = HResult($88760000 + 863);
DXFILEERR_BADFILECOMPRESSIONTYPE = HResult($88760000 + 864);
DXFILEERR_BADFILE = HResult($88760000 + 865);
DXFILEERR_PARSEERROR = HResult($88760000 + 866);
DXFILEERR_NOTEMPLATE = HResult($88760000 + 867);
DXFILEERR_BADARRAYSIZE = HResult($88760000 + 868);
DXFILEERR_BADDATAREFERENCE = HResult($88760000 + 869);
DXFILEERR_INTERNALERROR = HResult($88760000 + 870);
DXFILEERR_NOMOREOBJECTS = HResult($88760000 + 871);
DXFILEERR_BADINTRINSICS = HResult($88760000 + 872);
DXFILEERR_NOMORESTREAMHANDLES = HResult($88760000 + 873);
DXFILEERR_NOMOREDATA = HResult($88760000 + 874);
DXFILEERR_BADCACHEFILE = HResult($88760000 + 875);
DXFILEERR_NOINTERNET = HResult($88760000 + 876);
(* {A42790E0-7810-11cf-8F52-0040333594A3} *)
TID_D3DRMGuid: TGUID =
(D1:$a42790e0;D2:$7810;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
{ API for creating IDirectXFile interface. }
(* {A42790E1-7810-11cf-8F52-0040333594A3} *)
TID_D3DRMTextureFilename: TGUID =
(D1:$a42790e1;D2:$7810;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
function DirectXFileCreate(out lplpDirectXFile: IDirectXFile): HResult; stdcall;
(* {A42790E2-7810-11cf-8F52-0040333594A3} *)
TID_D3DRMTextureReference: TGUID =
(D1:$a42790e2;D2:$7810;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(***************************************************************************
*
* Copyright (C) 1998-1999 Microsoft Corporation. All Rights Reserved.
*
* File: rmxfguid.h
*
* Content: Defines GUIDs of D3DRM's templates.
*
***************************************************************************)
(* {1630B820-7842-11cf-8F52-0040333594A3} *)
TID_D3DRMIndexedColor: TGUID =
(D1:$1630b820;D2:$7842;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
const
TID_D3DRMInfo: TGUID = '{2B957100-9E9A-11cf-AB39-0020AF71E433}';
TID_D3DRMMesh: TGUID = '{3D82AB44-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMVector: TGUID = '{3D82AB5E-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMMeshFace: TGUID = '{3D82AB5F-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMMaterial: TGUID = '{3D82AB4D-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMMaterialArray: TGUID = '{35FF44E1-6C7C-11cf-8F52-0040333594A3}';
TID_D3DRMFrame: TGUID = '{3D82AB46-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMFrameTransformMatrix: TGUID = '{F6F23F41-7686-11cf-8F52-0040333594A3}';
TID_D3DRMMeshMaterialList: TGUID = '{F6F23F42-7686-11cf-8F52-0040333594A3}';
TID_D3DRMMeshTextureCoords: TGUID = '{F6F23F40-7686-11cf-8F52-0040333594A3}';
TID_D3DRMMeshNormals: TGUID = '{F6F23F43-7686-11cf-8F52-0040333594A3}';
TID_D3DRMCoords2d: TGUID = '{F6F23F44-7686-11cf-8F52-0040333594A3}';
TID_D3DRMMatrix4x4: TGUID = '{F6F23F45-7686-11cf-8F52-0040333594A3}';
TID_D3DRMAnimation: TGUID = '{3D82AB4F-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMAnimationSet: TGUID = '{3D82AB50-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMAnimationKey: TGUID = '{10DD46A8-775B-11cf-8F52-0040333594A3}';
TID_D3DRMFloatKeys: TGUID = '{10DD46A9-775B-11cf-8F52-0040333594A3}';
TID_D3DRMMaterialAmbientColor: TGUID = '{01411840-7786-11cf-8F52-0040333594A3}';
TID_D3DRMMaterialDiffuseColor: TGUID = '{01411841-7786-11cf-8F52-0040333594A3}';
TID_D3DRMMaterialSpecularColor: TGUID = '{01411842-7786-11cf-8F52-0040333594A3}';
TID_D3DRMMaterialEmissiveColor: TGUID = '{D3E16E80-7835-11cf-8F52-0040333594A3}';
TID_D3DRMMaterialPower: TGUID = '{01411843-7786-11cf-8F52-0040333594A3}';
TID_D3DRMColorRGBA: TGUID = '{35FF44E0-6C7C-11cf-8F52-0040333594A3}';
TID_D3DRMColorRGB: TGUID = '{D3E16E81-7835-11cf-8F52-0040333594A3}';
TID_D3DRMGuid: TGUID = '{A42790E0-7810-11cf-8F52-0040333594A3}';
TID_D3DRMTextureFilename: TGUID = '{A42790E1-7810-11cf-8F52-0040333594A3}';
TID_D3DRMTextureReference: TGUID = '{A42790E2-7810-11cf-8F52-0040333594A3}';
TID_D3DRMIndexedColor: TGUID = '{1630B820-7842-11cf-8F52-0040333594A3}';
TID_D3DRMMeshVertexColors: TGUID = '{1630B821-7842-11cf-8F52-0040333594A3}';
TID_D3DRMMaterialWrap: TGUID = '{4885AE60-78E8-11cf-8F52-0040333594A3}';
TID_D3DRMBoolean: TGUID = '{537DA6A0-CA37-11d0-941C-0080C80CFA7B}';
TID_D3DRMMeshFaceWraps: TGUID = '{ED1EC5C0-C0A8-11d0-941C-0080C80CFA7B}';
TID_D3DRMBoolean2d: TGUID = '{4885AE63-78E8-11cf-8F52-0040333594A3}';
TID_D3DRMTimedFloatKeys: TGUID = '{F406B180-7B3B-11cf-8F52-0040333594A3}';
TID_D3DRMAnimationOptions: TGUID = '{E2BF56C0-840F-11cf-8F52-0040333594A3}';
TID_D3DRMFramePosition: TGUID = '{E2BF56C1-840F-11cf-8F52-0040333594A3}';
TID_D3DRMFrameVelocity: TGUID = '{E2BF56C2-840F-11cf-8F52-0040333594A3}';
TID_D3DRMFrameRotation: TGUID = '{E2BF56C3-840F-11cf-8F52-0040333594A3}';
TID_D3DRMLight: TGUID = '{3D82AB4A-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMCamera: TGUID = '{3D82AB51-62DA-11cf-AB39-0020AF71E433}';
TID_D3DRMAppData: TGUID = '{E5745280-B24F-11cf-9DD5-00AA00A71A2F}';
TID_D3DRMLightUmbra: TGUID = '{AED22740-B31F-11cf-9DD5-00AA00A71A2F}';
TID_D3DRMLightRange: TGUID = '{AED22742-B31F-11cf-9DD5-00AA00A71A2F}';
TID_D3DRMLightPenumbra: TGUID = '{AED22741-B31F-11cf-9DD5-00AA00A71A2F}';
TID_D3DRMLightAttenuation: TGUID = '{A8A98BA0-C5E5-11cf-B941-0080C80CFA7B}';
TID_D3DRMInlineData: TGUID = '{3A23EEA0-94B1-11d0-AB39-0020AF71E433}';
TID_D3DRMUrl: TGUID = '{3A23EEA1-94B1-11d0-AB39-0020AF71E433}';
(* {1630B821-7842-11cf-8F52-0040333594A3} *)
TID_D3DRMMeshVertexColors: TGUID =
(D1:$1630b821;D2:$7842;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
TID_D3DRMProgressiveMesh: TGUID = '{8A63C360-997D-11d0-941C-0080C80CFA7B}';
TID_D3DRMExternalVisual: TGUID = '{98116AA0-BDBA-11d1-82C0-00A0C9697271}';
TID_D3DRMStringProperty: TGUID = '{7F0F21E0-BFE1-11d1-82C0-00A0C9697271}';
TID_D3DRMPropertyBag: TGUID = '{7F0F21E1-BFE1-11d1-82C0-00A0C9697271}';
TID_D3DRMRightHanded: TGUID = '{7F5D5EA0-D53A-11d1-82C0-00A0C9697271}';
(* {4885AE60-78E8-11cf-8F52-0040333594A3} *)
TID_D3DRMMaterialWrap: TGUID =
(D1:$4885ae60;D2:$78e8;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(***************************************************************************
(* {537DA6A0-CA37-11d0-941C-0080C80CFA7B} *)
TID_D3DRMBoolean: TGUID =
(D1:$537da6a0;D2:$ca37;D3:$11d0;D4:($94,$1c,$00,$80,$c8,$0c,$fa,$7b));
 
(* {ED1EC5C0-C0A8-11d0-941C-0080C80CFA7B} *)
TID_D3DRMMeshFaceWraps: TGUID =
(D1:$ed1ec5c0;D2:$c0a8;D3:$11d0;D4:($94,$1c,$00,$80,$c8,$0c,$fa,$7b));
 
(* {4885AE63-78E8-11cf-8F52-0040333594A3} *)
TID_D3DRMBoolean2d: TGUID =
(D1:$4885ae63;D2:$78e8;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(* {F406B180-7B3B-11cf-8F52-0040333594A3} *)
TID_D3DRMTimedFloatKeys: TGUID =
(D1:$f406b180;D2:$7b3b;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(* {E2BF56C0-840F-11cf-8F52-0040333594A3} *)
TID_D3DRMAnimationOptions: TGUID =
(D1:$e2bf56c0;D2:$840f;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(* {E2BF56C1-840F-11cf-8F52-0040333594A3} *)
TID_D3DRMFramePosition: TGUID =
(D1:$e2bf56c1;D2:$840f;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(* {E2BF56C2-840F-11cf-8F52-0040333594A3} *)
TID_D3DRMFrameVelocity: TGUID =
(D1:$e2bf56c2;D2:$840f;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(* {E2BF56C3-840F-11cf-8F52-0040333594A3} *)
TID_D3DRMFrameRotation: TGUID =
(D1:$e2bf56c3;D2:$840f;D3:$11cf;D4:($8f,$52,$00,$40,$33,$35,$94,$a3));
 
(* {3D82AB4A-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMLight: TGUID =
(D1:$3d82ab4a;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
(* {3D82AB51-62DA-11cf-AB39-0020AF71E433} *)
TID_D3DRMCamera: TGUID =
(D1:$3d82ab51;D2:$62da;D3:$11cf;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
(* {E5745280-B24F-11cf-9DD5-00AA00A71A2F} *)
TID_D3DRMAppData: TGUID =
(D1:$e5745280;D2:$b24f;D3:$11cf;D4:($9d,$d5,$00,$aa,$00,$a7,$1a,$2f));
 
(* {AED22740-B31F-11cf-9DD5-00AA00A71A2F} *)
TID_D3DRMLightUmbra: TGUID =
(D1:$aed22740;D2:$b31f;D3:$11cf;D4:($9d,$d5,$00,$aa,$00,$a7,$1a,$2f));
 
(* {AED22742-B31F-11cf-9DD5-00AA00A71A2F} *)
TID_D3DRMLightRange: TGUID =
(D1:$aed22742;D2:$b31f;D3:$11cf;D4:($9d,$d5,$00,$aa,$00,$a7,$1a,$2f));
 
(* {AED22741-B31F-11cf-9DD5-00AA00A71A2F} *)
TID_D3DRMLightPenumbra: TGUID =
(D1:$aed22741;D2:$b31f;D3:$11cf;D4:($9d,$d5,$00,$aa,$00,$a7,$1a,$2f));
 
(* {A8A98BA0-C5E5-11cf-B941-0080C80CFA7B} *)
TID_D3DRMLightAttenuation: TGUID =
(D1:$a8a98ba0;D2:$c5e5;D3:$11cf;D4:($b9,$41,$00,$80,$c8,$0c,$fa,$7b));
 
(* {3A23EEA0-94B1-11d0-AB39-0020AF71E433} *)
TID_D3DRMInlineData: TGUID =
(D1:$3a23eea0;D2:$94b1;D3:$11d0;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
(* {3A23EEA1-94B1-11d0-AB39-0020AF71E433} *)
TID_D3DRMUrl: TGUID =
(D1:$3a23eea1;D2:$94b1;D3:$11d0;D4:($ab,$39,$00,$20,$af,$71,$e4,$33));
 
(* {8A63C360-997D-11d0-941C-0080C80CFA7B} *)
TID_D3DRMProgressiveMesh: TGUID =
(D1:$8A63C360;D2:$997D;D3:$11d0;D4:($94,$1C,$00,$80,$C8,$0C,$FA,$7B));
 
(* {98116AA0-BDBA-11d1-82C0-00A0C9697271} *)
TID_D3DRMExternalVisual: TGUID =
(D1:$98116AA0;D2:$BDBA;D3:$11d1;D4:($82,$C0,$00,$A0,$C9,$69,$72,$71));
 
(* {7F0F21E0-BFE1-11d1-82C0-00A0C9697271} *)
TID_D3DRMStringProperty: TGUID =
(D1:$7f0f21e0;D2:$bfe1;D3:$11d1;D4:($82,$c0,$00,$a0,$c9,$69,$72,$71));
 
(* {7F0F21E1-BFE1-11d1-82C0-00A0C9697271} *)
TID_D3DRMPropertyBag: TGUID =
(D1:$7f0f21e1;D2:$bfe1;D3:$11d1;D4:($82,$c0,$00,$a0,$c9,$69,$72,$71));
 
// {7F5D5EA0-D53A-11d1-82C0-00A0C9697271}
TID_D3DRMRightHanded: TGUID =
(D1:$7f5d5ea0;D2:$d53a;D3:$11d1;D4:($82,$c0,$00,$a0,$c9,$69,$72,$71));
 
(*==========================================================================;
*
* Copyright (C) 1998-1999 Microsoft Corporation. All Rights Reserved.
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: rmxftmpl.h
* Content: D3DRM XFile templates in binary form
*
* Content: D3DRM XFile templates in binary form.
*
***************************************************************************)
 
const
D3DRM_XTEMPLATES: array [0..3214] of byte = (
$78, $6f, $66, $20, $30, $33, $30, $32, $62,
$69, $6e, $20, $30, $30, $36, $34, $1f, 0, $1,
0, $6, 0, 0, 0, $48, $65, $61, $64, $65,
$72, $a, 0, $5, 0, $43, $ab, $82, $3d, $da,
$62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4,
$33, $28, 0, $1, 0, $5, 0, 0, 0, $6d,
$61, $6a, $6f, $72, $14, 0, $28, 0, $1, 0,
$5, 0, 0, 0, $6d, $69, $6e, $6f, $72, $14,
0, $29, 0, $1, 0, $5, 0, 0, 0, $66,
$6c, $61, $67, $73, $14, 0, $b, 0, $1f, 0,
$1, 0, $6, 0, 0, 0, $56, $65, $63, $74,
$6f, $72, $a, 0, $5, 0, $5e, $ab, $82, $3d,
$da, $62, $cf, $11, $ab, $39, 0, $20, $af, $71,
$e4, $33, $2a, 0, $1, 0, $1, 0, 0, 0,
$78, $14, 0, $2a, 0, $1, 0, $1, 0, 0,
0, $79, $14, 0, $2a, 0, $1, 0, $1, 0,
0, 0, $7a, $14, 0, $b, 0, $1f, 0, $1,
0, $8, 0, 0, 0, $43, $6f, $6f, $72, $64,
$73, $32, $64, $a, 0, $5, 0, $44, $3f, $f2,
$f6, $86, $76, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $2a, 0, $1, 0, $1, 0, 0,
0, $75, $14, 0, $2a, 0, $1, 0, $1, 0,
0, 0, $76, $14, 0, $b, 0, $1f, 0, $1,
0, $9, 0, 0, 0, $4d, $61, $74, $72, $69,
$78, $34, $78, $34, $a, 0, $5, 0, $45, $3f,
$f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40,
$33, $35, $94, $a3, $34, 0, $2a, 0, $1, 0,
$6, 0, 0, 0, $6d, $61, $74, $72, $69, $78,
$e, 0, $3, 0, $10, 0, 0, 0, $f, 0,
$14, 0, $b, 0, $1f, 0, $1, 0, $9, 0,
0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42,
$41, $a, 0, $5, 0, $e0, $44, $ff, $35, $7c,
$6c, $cf, $11, $8f, $52, 0, $40, $33, $35, $94,
$a3, $2a, 0, $1, 0, $3, 0, 0, 0, $72,
$65, $64, $14, 0, $2a, 0, $1, 0, $5, 0,
0, 0, $67, $72, $65, $65, $6e, $14, 0, $2a,
0, $1, 0, $4, 0, 0, 0, $62, $6c, $75,
$65, $14, 0, $2a, 0, $1, 0, $5, 0, 0,
0, $61, $6c, $70, $68, $61, $14, 0, $b, 0,
$1f, 0, $1, 0, $8, 0, 0, 0, $43, $6f,
$6c, $6f, $72, $52, $47, $42, $a, 0, $5, 0,
$81, $6e, $e1, $d3, $35, $78, $cf, $11, $8f, $52,
0, $40, $33, $35, $94, $a3, $2a, 0, $1, 0,
$3, 0, 0, 0, $72, $65, $64, $14, 0, $2a,
0, $1, 0, $5, 0, 0, 0, $67, $72, $65,
$65, $6e, $14, 0, $2a, 0, $1, 0, $4, 0,
0, 0, $62, $6c, $75, $65, $14, 0, $b, 0,
$1f, 0, $1, 0, $c, 0, 0, 0, $49, $6e,
$64, $65, $78, $65, $64, $43, $6f, $6c, $6f, $72,
$a, 0, $5, 0, $20, $b8, $30, $16, $42, $78,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $5, 0, 0, 0, $69, $6e,
$64, $65, $78, $14, 0, $1, 0, $9, 0, 0,
0, $43, $6f, $6c, $6f, $72, $52, $47, $42, $41,
$1, 0, $a, 0, 0, 0, $69, $6e, $64, $65,
$78, $43, $6f, $6c, $6f, $72, $14, 0, $b, 0,
$1f, 0, $1, 0, $7, 0, 0, 0, $42, $6f,
$6f, $6c, $65, $61, $6e, $a, 0, $5, 0, $a0,
$a6, $7d, $53, $37, $ca, $d0, $11, $94, $1c, 0,
$80, $c8, $c, $fa, $7b, $29, 0, $1, 0, $9,
0, 0, 0, $74, $72, $75, $65, $66, $61, $6c,
$73, $65, $14, 0, $b, 0, $1f, 0, $1, 0,
$9, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61,
$6e, $32, $64, $a, 0, $5, 0, $63, $ae, $85,
$48, $e8, $78, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $1, 0, $7, 0, 0, 0, $42,
$6f, $6f, $6c, $65, $61, $6e, $1, 0, $1, 0,
0, 0, $75, $14, 0, $1, 0, $7, 0, 0,
0, $42, $6f, $6f, $6c, $65, $61, $6e, $1, 0,
$1, 0, 0, 0, $76, $14, 0, $b, 0, $1f,
0, $1, 0, $c, 0, 0, 0, $4d, $61, $74,
$65, $72, $69, $61, $6c, $57, $72, $61, $70, $a,
0, $5, 0, $60, $ae, $85, $48, $e8, $78, $cf,
$11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1,
0, $7, 0, 0, 0, $42, $6f, $6f, $6c, $65,
$61, $6e, $1, 0, $1, 0, 0, 0, $75, $14,
0, $1, 0, $7, 0, 0, 0, $42, $6f, $6f,
$6c, $65, $61, $6e, $1, 0, $1, 0, 0, 0,
$76, $14, 0, $b, 0, $1f, 0, $1, 0, $f,
0, 0, 0, $54, $65, $78, $74, $75, $72, $65,
$46, $69, $6c, $65, $6e, $61, $6d, $65, $a, 0,
$5, 0, $e1, $90, $27, $a4, $10, $78, $cf, $11,
$8f, $52, 0, $40, $33, $35, $94, $a3, $31, 0,
$1, 0, $8, 0, 0, 0, $66, $69, $6c, $65,
$6e, $61, $6d, $65, $14, 0, $b, 0, $1f, 0,
$1, 0, $8, 0, 0, 0, $4d, $61, $74, $65,
$72, $69, $61, $6c, $a, 0, $5, 0, $4d, $ab,
$82, $3d, $da, $62, $cf, $11, $ab, $39, 0, $20,
$af, $71, $e4, $33, $1, 0, $9, 0, 0, 0,
$43, $6f, $6c, $6f, $72, $52, $47, $42, $41, $1,
0, $9, 0, 0, 0, $66, $61, $63, $65, $43,
$6f, $6c, $6f, $72, $14, 0, $2a, 0, $1, 0,
$5, 0, 0, 0, $70, $6f, $77, $65, $72, $14,
0, $1, 0, $8, 0, 0, 0, $43, $6f, $6c,
$6f, $72, $52, $47, $42, $1, 0, $d, 0, 0,
0, $73, $70, $65, $63, $75, $6c, $61, $72, $43,
$6f, $6c, $6f, $72, $14, 0, $1, 0, $8, 0,
0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42,
$1, 0, $d, 0, 0, 0, $65, $6d, $69, $73,
$73, $69, $76, $65, $43, $6f, $6c, $6f, $72, $14,
0, $e, 0, $12, 0, $12, 0, $12, 0, $f,
0, $b, 0, $1f, 0, $1, 0, $8, 0, 0,
0, $4d, $65, $73, $68, $46, $61, $63, $65, $a,
0, $5, 0, $5f, $ab, $82, $3d, $da, $62, $cf,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $29,
0, $1, 0, $12, 0, 0, 0, $6e, $46, $61,
$63, $65, $56, $65, $72, $74, $65, $78, $49, $6e,
$64, $69, $63, $65, $73, $14, 0, $34, 0, $29,
0, $1, 0, $11, 0, 0, 0, $66, $61, $63,
$65, $56, $65, $72, $74, $65, $78, $49, $6e, $64,
$69, $63, $65, $73, $e, 0, $1, 0, $12, 0,
0, 0, $6e, $46, $61, $63, $65, $56, $65, $72,
$74, $65, $78, $49, $6e, $64, $69, $63, $65, $73,
$f, 0, $14, 0, $b, 0, $1f, 0, $1, 0,
$d, 0, 0, 0, $4d, $65, $73, $68, $46, $61,
$63, $65, $57, $72, $61, $70, $73, $a, 0, $5,
0, $c0, $c5, $1e, $ed, $a8, $c0, $d0, $11, $94,
$1c, 0, $80, $c8, $c, $fa, $7b, $29, 0, $1,
0, $f, 0, 0, 0, $6e, $46, $61, $63, $65,
$57, $72, $61, $70, $56, $61, $6c, $75, $65, $73,
$14, 0, $34, 0, $1, 0, $9, 0, 0, 0,
$42, $6f, $6f, $6c, $65, $61, $6e, $32, $64, $1,
0, $e, 0, 0, 0, $66, $61, $63, $65, $57,
$72, $61, $70, $56, $61, $6c, $75, $65, $73, $e,
0, $1, 0, $f, 0, 0, 0, $6e, $46, $61,
$63, $65, $57, $72, $61, $70, $56, $61, $6c, $75,
$65, $73, $f, 0, $14, 0, $b, 0, $1f, 0,
$1, 0, $11, 0, 0, 0, $4d, $65, $73, $68,
$54, $65, $78, $74, $75, $72, $65, $43, $6f, $6f,
$72, $64, $73, $a, 0, $5, 0, $40, $3f, $f2,
$f6, $86, $76, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $29, 0, $1, 0, $e, 0, 0,
0, $6e, $54, $65, $78, $74, $75, $72, $65, $43,
$6f, $6f, $72, $64, $73, $14, 0, $34, 0, $1,
0, $8, 0, 0, 0, $43, $6f, $6f, $72, $64,
$73, $32, $64, $1, 0, $d, 0, 0, 0, $74,
$65, $78, $74, $75, $72, $65, $43, $6f, $6f, $72,
$64, $73, $e, 0, $1, 0, $e, 0, 0, 0,
$6e, $54, $65, $78, $74, $75, $72, $65, $43, $6f,
$6f, $72, $64, $73, $f, 0, $14, 0, $b, 0,
$1f, 0, $1, 0, $10, 0, 0, 0, $4d, $65,
$73, $68, $4d, $61, $74, $65, $72, $69, $61, $6c,
$4c, $69, $73, $74, $a, 0, $5, 0, $42, $3f,
$f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40,
$33, $35, $94, $a3, $29, 0, $1, 0, $a, 0,
0, 0, $6e, $4d, $61, $74, $65, $72, $69, $61,
$6c, $73, $14, 0, $29, 0, $1, 0, $c, 0,
0, 0, $6e, $46, $61, $63, $65, $49, $6e, $64,
$65, $78, $65, $73, $14, 0, $34, 0, $29, 0,
$1, 0, $b, 0, 0, 0, $66, $61, $63, $65,
$49, $6e, $64, $65, $78, $65, $73, $e, 0, $1,
0, $c, 0, 0, 0, $6e, $46, $61, $63, $65,
$49, $6e, $64, $65, $78, $65, $73, $f, 0, $14,
0, $e, 0, $1, 0, $8, 0, 0, 0, $4d,
$61, $74, $65, $72, $69, $61, $6c, $f, 0, $b,
0, $1f, 0, $1, 0, $b, 0, 0, 0, $4d,
$65, $73, $68, $4e, $6f, $72, $6d, $61, $6c, $73,
$a, 0, $5, 0, $43, $3f, $f2, $f6, $86, $76,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $8, 0, 0, 0, $6e, $4e,
$6f, $72, $6d, $61, $6c, $73, $14, 0, $34, 0,
$1, 0, $6, 0, 0, 0, $56, $65, $63, $74,
$6f, $72, $1, 0, $7, 0, 0, 0, $6e, $6f,
$72, $6d, $61, $6c, $73, $e, 0, $1, 0, $8,
0, 0, 0, $6e, $4e, $6f, $72, $6d, $61, $6c,
$73, $f, 0, $14, 0, $29, 0, $1, 0, $c,
0, 0, 0, $6e, $46, $61, $63, $65, $4e, $6f,
$72, $6d, $61, $6c, $73, $14, 0, $34, 0, $1,
0, $8, 0, 0, 0, $4d, $65, $73, $68, $46,
$61, $63, $65, $1, 0, $b, 0, 0, 0, $66,
$61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73,
$e, 0, $1, 0, $c, 0, 0, 0, $6e, $46,
$61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73,
$f, 0, $14, 0, $b, 0, $1f, 0, $1, 0,
$10, 0, 0, 0, $4d, $65, $73, $68, $56, $65,
$72, $74, $65, $78, $43, $6f, $6c, $6f, $72, $73,
$a, 0, $5, 0, $21, $b8, $30, $16, $42, $78,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $d, 0, 0, 0, $6e, $56,
$65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72,
$73, $14, 0, $34, 0, $1, 0, $c, 0, 0,
0, $49, $6e, $64, $65, $78, $65, $64, $43, $6f,
$6c, $6f, $72, $1, 0, $c, 0, 0, 0, $76,
$65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72,
$73, $e, 0, $1, 0, $d, 0, 0, 0, $6e,
$56, $65, $72, $74, $65, $78, $43, $6f, $6c, $6f,
$72, $73, $f, 0, $14, 0, $b, 0, $1f, 0,
$1, 0, $4, 0, 0, 0, $4d, $65, $73, $68,
$a, 0, $5, 0, $44, $ab, $82, $3d, $da, $62,
$cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33,
$29, 0, $1, 0, $9, 0, 0, 0, $6e, $56,
$65, $72, $74, $69, $63, $65, $73, $14, 0, $34,
0, $1, 0, $6, 0, 0, 0, $56, $65, $63,
$74, $6f, $72, $1, 0, $8, 0, 0, 0, $76,
$65, $72, $74, $69, $63, $65, $73, $e, 0, $1,
0, $9, 0, 0, 0, $6e, $56, $65, $72, $74,
$69, $63, $65, $73, $f, 0, $14, 0, $29, 0,
$1, 0, $6, 0, 0, 0, $6e, $46, $61, $63,
$65, $73, $14, 0, $34, 0, $1, 0, $8, 0,
0, 0, $4d, $65, $73, $68, $46, $61, $63, $65,
$1, 0, $5, 0, 0, 0, $66, $61, $63, $65,
$73, $e, 0, $1, 0, $6, 0, 0, 0, $6e,
$46, $61, $63, $65, $73, $f, 0, $14, 0, $e,
0, $12, 0, $12, 0, $12, 0, $f, 0, $b,
0, $1f, 0, $1, 0, $14, 0, 0, 0, $46,
$72, $61, $6d, $65, $54, $72, $61, $6e, $73, $66,
$6f, $72, $6d, $4d, $61, $74, $72, $69, $78, $a,
0, $5, 0, $41, $3f, $f2, $f6, $86, $76, $cf,
$11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1,
0, $9, 0, 0, 0, $4d, $61, $74, $72, $69,
$78, $34, $78, $34, $1, 0, $b, 0, 0, 0,
$66, $72, $61, $6d, $65, $4d, $61, $74, $72, $69,
$78, $14, 0, $b, 0, $1f, 0, $1, 0, $5,
0, 0, 0, $46, $72, $61, $6d, $65, $a, 0,
$5, 0, $46, $ab, $82, $3d, $da, $62, $cf, $11,
$ab, $39, 0, $20, $af, $71, $e4, $33, $e, 0,
$12, 0, $12, 0, $12, 0, $f, 0, $b, 0,
$1f, 0, $1, 0, $9, 0, 0, 0, $46, $6c,
$6f, $61, $74, $4b, $65, $79, $73, $a, 0, $5,
0, $a9, $46, $dd, $10, $5b, $77, $cf, $11, $8f,
$52, 0, $40, $33, $35, $94, $a3, $29, 0, $1,
0, $7, 0, 0, 0, $6e, $56, $61, $6c, $75,
$65, $73, $14, 0, $34, 0, $2a, 0, $1, 0,
$6, 0, 0, 0, $76, $61, $6c, $75, $65, $73,
$e, 0, $1, 0, $7, 0, 0, 0, $6e, $56,
$61, $6c, $75, $65, $73, $f, 0, $14, 0, $b,
0, $1f, 0, $1, 0, $e, 0, 0, 0, $54,
$69, $6d, $65, $64, $46, $6c, $6f, $61, $74, $4b,
$65, $79, $73, $a, 0, $5, 0, $80, $b1, $6,
$f4, $3b, $7b, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $29, 0, $1, 0, $4, 0, 0,
0, $74, $69, $6d, $65, $14, 0, $1, 0, $9,
0, 0, 0, $46, $6c, $6f, $61, $74, $4b, $65,
$79, $73, $1, 0, $6, 0, 0, 0, $74, $66,
$6b, $65, $79, $73, $14, 0, $b, 0, $1f, 0,
$1, 0, $c, 0, 0, 0, $41, $6e, $69, $6d,
$61, $74, $69, $6f, $6e, $4b, $65, $79, $a, 0,
$5, 0, $a8, $46, $dd, $10, $5b, $77, $cf, $11,
$8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0,
$1, 0, $7, 0, 0, 0, $6b, $65, $79, $54,
$79, $70, $65, $14, 0, $29, 0, $1, 0, $5,
0, 0, 0, $6e, $4b, $65, $79, $73, $14, 0,
$34, 0, $1, 0, $e, 0, 0, 0, $54, $69,
$6d, $65, $64, $46, $6c, $6f, $61, $74, $4b, $65,
$79, $73, $1, 0, $4, 0, 0, 0, $6b, $65,
$79, $73, $e, 0, $1, 0, $5, 0, 0, 0,
$6e, $4b, $65, $79, $73, $f, 0, $14, 0, $b,
0, $1f, 0, $1, 0, $10, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $4f, $70,
$74, $69, $6f, $6e, $73, $a, 0, $5, 0, $c0,
$56, $bf, $e2, $f, $84, $cf, $11, $8f, $52, 0,
$40, $33, $35, $94, $a3, $29, 0, $1, 0, $a,
0, 0, 0, $6f, $70, $65, $6e, $63, $6c, $6f,
$73, $65, $64, $14, 0, $29, 0, $1, 0, $f,
0, 0, 0, $70, $6f, $73, $69, $74, $69, $6f,
$6e, $71, $75, $61, $6c, $69, $74, $79, $14, 0,
$b, 0, $1f, 0, $1, 0, $9, 0, 0, 0,
$41, $6e, $69, $6d, $61, $74, $69, $6f, $6e, $a,
0, $5, 0, $4f, $ab, $82, $3d, $da, $62, $cf,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $e,
0, $12, 0, $12, 0, $12, 0, $f, 0, $b,
0, $1f, 0, $1, 0, $c, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $53, $65,
$74, $a, 0, $5, 0, $50, $ab, $82, $3d, $da,
$62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4,
$33, $e, 0, $1, 0, $9, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $f, 0,
$b, 0, $1f, 0, $1, 0, $a, 0, 0, 0,
$49, $6e, $6c, $69, $6e, $65, $44, $61, $74, $61,
$a, 0, $5, 0, $a0, $ee, $23, $3a, $b1, $94,
$d0, $11, $ab, $39, 0, $20, $af, $71, $e4, $33,
$e, 0, $1, 0, $6, 0, 0, 0, $42, $49,
$4e, $41, $52, $59, $f, 0, $b, 0, $1f, 0,
$1, 0, $3, 0, 0, 0, $55, $72, $6c, $a,
0, $5, 0, $a1, $ee, $23, $3a, $b1, $94, $d0,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $29,
0, $1, 0, $5, 0, 0, 0, $6e, $55, $72,
$6c, $73, $14, 0, $34, 0, $31, 0, $1, 0,
$4, 0, 0, 0, $75, $72, $6c, $73, $e, 0,
$1, 0, $5, 0, 0, 0, $6e, $55, $72, $6c,
$73, $f, 0, $14, 0, $b, 0, $1f, 0, $1,
0, $f, 0, 0, 0, $50, $72, $6f, $67, $72,
$65, $73, $73, $69, $76, $65, $4d, $65, $73, $68,
$a, 0, $5, 0, $60, $c3, $63, $8a, $7d, $99,
$d0, $11, $94, $1c, 0, $80, $c8, $c, $fa, $7b,
$e, 0, $1, 0, $3, 0, 0, 0, $55, $72,
$6c, $13, 0, $1, 0, $a, 0, 0, 0, $49,
$6e, $6c, $69, $6e, $65, $44, $61, $74, $61, $f,
0, $b, 0, $1f, 0, $1, 0, $4, 0, 0,
0, $47, $75, $69, $64, $a, 0, $5, 0, $e0,
$90, $27, $a4, $10, $78, $cf, $11, $8f, $52, 0,
$40, $33, $35, $94, $a3, $29, 0, $1, 0, $5,
0, 0, 0, $64, $61, $74, $61, $31, $14, 0,
$28, 0, $1, 0, $5, 0, 0, 0, $64, $61,
$74, $61, $32, $14, 0, $28, 0, $1, 0, $5,
0, 0, 0, $64, $61, $74, $61, $33, $14, 0,
$34, 0, $2d, 0, $1, 0, $5, 0, 0, 0,
$64, $61, $74, $61, $34, $e, 0, $3, 0, $8,
0, 0, 0, $f, 0, $14, 0, $b, 0, $1f,
0, $1, 0, $e, 0, 0, 0, $53, $74, $72,
$69, $6e, $67, $50, $72, $6f, $70, $65, $72, $74,
$79, $a, 0, $5, 0, $e0, $21, $f, $7f, $e1,
$bf, $d1, $11, $82, $c0, 0, $a0, $c9, $69, $72,
$71, $31, 0, $1, 0, $3, 0, 0, 0, $6b,
$65, $79, $14, 0, $31, 0, $1, 0, $5, 0,
0, 0, $76, $61, $6c, $75, $65, $14, 0, $b,
0, $1f, 0, $1, 0, $b, 0, 0, 0, $50,
$72, $6f, $70, $65, $72, $74, $79, $42, $61, $67,
$a, 0, $5, 0, $e1, $21, $f, $7f, $e1, $bf,
$d1, $11, $82, $c0, 0, $a0, $c9, $69, $72, $71,
$e, 0, $1, 0, $e, 0, 0, 0, $53, $74,
$72, $69, $6e, $67, $50, $72, $6f, $70, $65, $72,
$74, $79, $f, 0, $b, 0, $1f, 0, $1, 0,
$e, 0, 0, 0, $45, $78, $74, $65, $72, $6e,
$61, $6c, $56, $69, $73, $75, $61, $6c, $a, 0,
$5, 0, $a0, $6a, $11, $98, $ba, $bd, $d1, $11,
$82, $c0, 0, $a0, $c9, $69, $72, $71, $1, 0,
$4, 0, 0, 0, $47, $75, $69, $64, $1, 0,
$12, 0, 0, 0, $67, $75, $69, $64, $45, $78,
$74, $65, $72, $6e, $61, $6c, $56, $69, $73, $75,
$61, $6c, $14, 0, $e, 0, $12, 0, $12, 0,
$12, 0, $f, 0, $b, 0);
D3DRM_XTEMPLATE_BYTES_2 = 3278;
 
D3DRM_XTEMPLATE_BYTES = 3278;
D3DRM_XTEMPLATES_2: array [0..D3DRM_XTEMPLATE_BYTES_2-1] of byte = (
$78, $6f, $66, $20, $30, $33, $30, $32, $62, $69, $6e, $20, $30, $30, $36, $34, $1f, 0, $1,
0, $6, 0, 0, 0, $48, $65, $61, $64, $65, $72, $a, 0, $5, 0, $43, $ab, $82, $3d, $da,
$62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $28, 0, $1, 0, $5, 0, 0, 0, $6d,
$61, $6a, $6f, $72, $14, 0, $28, 0, $1, 0, $5, 0, 0, 0, $6d, $69, $6e, $6f, $72, $14,
0, $29, 0, $1, 0, $5, 0, 0, 0, $66, $6c, $61, $67, $73, $14, 0, $b, 0, $1f, 0,
$1, 0, $6, 0, 0, 0, $56, $65, $63, $74, $6f, $72, $a, 0, $5, 0, $5e, $ab, $82, $3d,
$da, $62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $2a, 0, $1, 0, $1, 0, 0, 0,
$78, $14, 0, $2a, 0, $1, 0, $1, 0, 0, 0, $79, $14, 0, $2a, 0, $1, 0, $1, 0,
0, 0, $7a, $14, 0, $b, 0, $1f, 0, $1, 0, $8, 0, 0, 0, $43, $6f, $6f, $72, $64,
$73, $32, $64, $a, 0, $5, 0, $44, $3f, $f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $2a, 0, $1, 0, $1, 0, 0, 0, $75, $14, 0, $2a, 0, $1, 0, $1, 0,
0, 0, $76, $14, 0, $b, 0, $1f, 0, $1, 0, $9, 0, 0, 0, $4d, $61, $74, $72, $69,
$78, $34, $78, $34, $a, 0, $5, 0, $45, $3f, $f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40,
$33, $35, $94, $a3, $34, 0, $2a, 0, $1, 0, $6, 0, 0, 0, $6d, $61, $74, $72, $69, $78,
$e, 0, $3, 0, $10, 0, 0, 0, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0, $9, 0,
0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42, $41, $a, 0, $5, 0, $e0, $44, $ff, $35, $7c,
$6c, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $2a, 0, $1, 0, $3, 0, 0, 0, $72,
$65, $64, $14, 0, $2a, 0, $1, 0, $5, 0, 0, 0, $67, $72, $65, $65, $6e, $14, 0, $2a,
0, $1, 0, $4, 0, 0, 0, $62, $6c, $75, $65, $14, 0, $2a, 0, $1, 0, $5, 0, 0,
0, $61, $6c, $70, $68, $61, $14, 0, $b, 0, $1f, 0, $1, 0, $8, 0, 0, 0, $43, $6f,
$6c, $6f, $72, $52, $47, $42, $a, 0, $5, 0, $81, $6e, $e1, $d3, $35, $78, $cf, $11, $8f, $52,
0, $40, $33, $35, $94, $a3, $2a, 0, $1, 0, $3, 0, 0, 0, $72, $65, $64, $14, 0, $2a,
0, $1, 0, $5, 0, 0, 0, $67, $72, $65, $65, $6e, $14, 0, $2a, 0, $1, 0, $4, 0,
0, 0, $62, $6c, $75, $65, $14, 0, $b, 0, $1f, 0, $1, 0, $c, 0, 0, 0, $49, $6e,
$64, $65, $78, $65, $64, $43, $6f, $6c, $6f, $72, $a, 0, $5, 0, $20, $b8, $30, $16, $42, $78,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $5, 0, 0, 0, $69, $6e,
$64, $65, $78, $14, 0, $1, 0, $9, 0, 0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42, $41,
$1, 0, $a, 0, 0, 0, $69, $6e, $64, $65, $78, $43, $6f, $6c, $6f, $72, $14, 0, $b, 0,
$1f, 0, $1, 0, $7, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61, $6e, $a, 0, $5, 0, $a0,
$a6, $7d, $53, $37, $ca, $d0, $11, $94, $1c, 0, $80, $c8, $c, $fa, $7b, $29, 0, $1, 0, $9,
0, 0, 0, $74, $72, $75, $65, $66, $61, $6c, $73, $65, $14, 0, $b, 0, $1f, 0, $1, 0,
$9, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61, $6e, $32, $64, $a, 0, $5, 0, $63, $ae, $85,
$48, $e8, $78, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1, 0, $7, 0, 0, 0, $42,
$6f, $6f, $6c, $65, $61, $6e, $1, 0, $1, 0, 0, 0, $75, $14, 0, $1, 0, $7, 0, 0,
0, $42, $6f, $6f, $6c, $65, $61, $6e, $1, 0, $1, 0, 0, 0, $76, $14, 0, $b, 0, $1f,
0, $1, 0, $c, 0, 0, 0, $4d, $61, $74, $65, $72, $69, $61, $6c, $57, $72, $61, $70, $a,
0, $5, 0, $60, $ae, $85, $48, $e8, $78, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1,
0, $7, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61, $6e, $1, 0, $1, 0, 0, 0, $75, $14,
0, $1, 0, $7, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61, $6e, $1, 0, $1, 0, 0, 0,
$76, $14, 0, $b, 0, $1f, 0, $1, 0, $f, 0, 0, 0, $54, $65, $78, $74, $75, $72, $65,
$46, $69, $6c, $65, $6e, $61, $6d, $65, $a, 0, $5, 0, $e1, $90, $27, $a4, $10, $78, $cf, $11,
$8f, $52, 0, $40, $33, $35, $94, $a3, $31, 0, $1, 0, $8, 0, 0, 0, $66, $69, $6c, $65,
$6e, $61, $6d, $65, $14, 0, $b, 0, $1f, 0, $1, 0, $8, 0, 0, 0, $4d, $61, $74, $65,
$72, $69, $61, $6c, $a, 0, $5, 0, $4d, $ab, $82, $3d, $da, $62, $cf, $11, $ab, $39, 0, $20,
$af, $71, $e4, $33, $1, 0, $9, 0, 0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42, $41, $1,
0, $9, 0, 0, 0, $66, $61, $63, $65, $43, $6f, $6c, $6f, $72, $14, 0, $2a, 0, $1, 0,
$5, 0, 0, 0, $70, $6f, $77, $65, $72, $14, 0, $1, 0, $8, 0, 0, 0, $43, $6f, $6c,
$6f, $72, $52, $47, $42, $1, 0, $d, 0, 0, 0, $73, $70, $65, $63, $75, $6c, $61, $72, $43,
$6f, $6c, $6f, $72, $14, 0, $1, 0, $8, 0, 0, 0, $43, $6f, $6c, $6f, $72, $52, $47, $42,
$1, 0, $d, 0, 0, 0, $65, $6d, $69, $73, $73, $69, $76, $65, $43, $6f, $6c, $6f, $72, $14,
0, $e, 0, $12, 0, $12, 0, $12, 0, $f, 0, $b, 0, $1f, 0, $1, 0, $8, 0, 0,
0, $4d, $65, $73, $68, $46, $61, $63, $65, $a, 0, $5, 0, $5f, $ab, $82, $3d, $da, $62, $cf,
$11, $ab, $39, 0, $20, $af, $71, $e4, $33, $29, 0, $1, 0, $12, 0, 0, 0, $6e, $46, $61,
$63, $65, $56, $65, $72, $74, $65, $78, $49, $6e, $64, $69, $63, $65, $73, $14, 0, $34, 0, $29,
0, $1, 0, $11, 0, 0, 0, $66, $61, $63, $65, $56, $65, $72, $74, $65, $78, $49, $6e, $64,
$69, $63, $65, $73, $e, 0, $1, 0, $12, 0, 0, 0, $6e, $46, $61, $63, $65, $56, $65, $72,
$74, $65, $78, $49, $6e, $64, $69, $63, $65, $73, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0,
$d, 0, 0, 0, $4d, $65, $73, $68, $46, $61, $63, $65, $57, $72, $61, $70, $73, $a, 0, $5,
0, $c0, $c5, $1e, $ed, $a8, $c0, $d0, $11, $94, $1c, 0, $80, $c8, $c, $fa, $7b, $29, 0, $1,
0, $f, 0, 0, 0, $6e, $46, $61, $63, $65, $57, $72, $61, $70, $56, $61, $6c, $75, $65, $73,
$14, 0, $34, 0, $1, 0, $9, 0, 0, 0, $42, $6f, $6f, $6c, $65, $61, $6e, $32, $64, $1,
0, $e, 0, 0, 0, $66, $61, $63, $65, $57, $72, $61, $70, $56, $61, $6c, $75, $65, $73, $e,
0, $1, 0, $f, 0, 0, 0, $6e, $46, $61, $63, $65, $57, $72, $61, $70, $56, $61, $6c, $75,
$65, $73, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0, $11, 0, 0, 0, $4d, $65, $73, $68,
$54, $65, $78, $74, $75, $72, $65, $43, $6f, $6f, $72, $64, $73, $a, 0, $5, 0, $40, $3f, $f2,
$f6, $86, $76, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $e, 0, 0,
0, $6e, $54, $65, $78, $74, $75, $72, $65, $43, $6f, $6f, $72, $64, $73, $14, 0, $34, 0, $1,
0, $8, 0, 0, 0, $43, $6f, $6f, $72, $64, $73, $32, $64, $1, 0, $d, 0, 0, 0, $74,
$65, $78, $74, $75, $72, $65, $43, $6f, $6f, $72, $64, $73, $e, 0, $1, 0, $e, 0, 0, 0,
$6e, $54, $65, $78, $74, $75, $72, $65, $43, $6f, $6f, $72, $64, $73, $f, 0, $14, 0, $b, 0,
$1f, 0, $1, 0, $10, 0, 0, 0, $4d, $65, $73, $68, $4d, $61, $74, $65, $72, $69, $61, $6c,
$4c, $69, $73, $74, $a, 0, $5, 0, $42, $3f, $f2, $f6, $86, $76, $cf, $11, $8f, $52, 0, $40,
$33, $35, $94, $a3, $29, 0, $1, 0, $a, 0, 0, 0, $6e, $4d, $61, $74, $65, $72, $69, $61,
$6c, $73, $14, 0, $29, 0, $1, 0, $c, 0, 0, 0, $6e, $46, $61, $63, $65, $49, $6e, $64,
$65, $78, $65, $73, $14, 0, $34, 0, $29, 0, $1, 0, $b, 0, 0, 0, $66, $61, $63, $65,
$49, $6e, $64, $65, $78, $65, $73, $e, 0, $1, 0, $c, 0, 0, 0, $6e, $46, $61, $63, $65,
$49, $6e, $64, $65, $78, $65, $73, $f, 0, $14, 0, $e, 0, $1, 0, $8, 0, 0, 0, $4d,
$61, $74, $65, $72, $69, $61, $6c, $f, 0, $b, 0, $1f, 0, $1, 0, $b, 0, 0, 0, $4d,
$65, $73, $68, $4e, $6f, $72, $6d, $61, $6c, $73, $a, 0, $5, 0, $43, $3f, $f2, $f6, $86, $76,
$cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $8, 0, 0, 0, $6e, $4e,
$6f, $72, $6d, $61, $6c, $73, $14, 0, $34, 0, $1, 0, $6, 0, 0, 0, $56, $65, $63, $74,
$6f, $72, $1, 0, $7, 0, 0, 0, $6e, $6f, $72, $6d, $61, $6c, $73, $e, 0, $1, 0, $8,
0, 0, 0, $6e, $4e, $6f, $72, $6d, $61, $6c, $73, $f, 0, $14, 0, $29, 0, $1, 0, $c,
0, 0, 0, $6e, $46, $61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73, $14, 0, $34, 0, $1,
0, $8, 0, 0, 0, $4d, $65, $73, $68, $46, $61, $63, $65, $1, 0, $b, 0, 0, 0, $66,
$61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73, $e, 0, $1, 0, $c, 0, 0, 0, $6e, $46,
$61, $63, $65, $4e, $6f, $72, $6d, $61, $6c, $73, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0,
$10, 0, 0, 0, $4d, $65, $73, $68, $56, $65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72, $73,
$a, 0, $5, 0, $21, $b8, $30, $16, $42, $78, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3,
$29, 0, $1, 0, $d, 0, 0, 0, $6e, $56, $65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72,
$73, $14, 0, $34, 0, $1, 0, $c, 0, 0, 0, $49, $6e, $64, $65, $78, $65, $64, $43, $6f,
$6c, $6f, $72, $1, 0, $c, 0, 0, 0, $76, $65, $72, $74, $65, $78, $43, $6f, $6c, $6f, $72,
$73, $e, 0, $1, 0, $d, 0, 0, 0, $6e, $56, $65, $72, $74, $65, $78, $43, $6f, $6c, $6f,
$72, $73, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0, $4, 0, 0, 0, $4d, $65, $73, $68,
$a, 0, $5, 0, $44, $ab, $82, $3d, $da, $62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33,
$29, 0, $1, 0, $9, 0, 0, 0, $6e, $56, $65, $72, $74, $69, $63, $65, $73, $14, 0, $34,
0, $1, 0, $6, 0, 0, 0, $56, $65, $63, $74, $6f, $72, $1, 0, $8, 0, 0, 0, $76,
$65, $72, $74, $69, $63, $65, $73, $e, 0, $1, 0, $9, 0, 0, 0, $6e, $56, $65, $72, $74,
$69, $63, $65, $73, $f, 0, $14, 0, $29, 0, $1, 0, $6, 0, 0, 0, $6e, $46, $61, $63,
$65, $73, $14, 0, $34, 0, $1, 0, $8, 0, 0, 0, $4d, $65, $73, $68, $46, $61, $63, $65,
$1, 0, $5, 0, 0, 0, $66, $61, $63, $65, $73, $e, 0, $1, 0, $6, 0, 0, 0, $6e,
$46, $61, $63, $65, $73, $f, 0, $14, 0, $e, 0, $12, 0, $12, 0, $12, 0, $f, 0, $b,
0, $1f, 0, $1, 0, $14, 0, 0, 0, $46, $72, $61, $6d, $65, $54, $72, $61, $6e, $73, $66,
$6f, $72, $6d, $4d, $61, $74, $72, $69, $78, $a, 0, $5, 0, $41, $3f, $f2, $f6, $86, $76, $cf,
$11, $8f, $52, 0, $40, $33, $35, $94, $a3, $1, 0, $9, 0, 0, 0, $4d, $61, $74, $72, $69,
$78, $34, $78, $34, $1, 0, $b, 0, 0, 0, $66, $72, $61, $6d, $65, $4d, $61, $74, $72, $69,
$78, $14, 0, $b, 0, $1f, 0, $1, 0, $5, 0, 0, 0, $46, $72, $61, $6d, $65, $a, 0,
$5, 0, $46, $ab, $82, $3d, $da, $62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $e, 0,
$12, 0, $12, 0, $12, 0, $f, 0, $b, 0, $1f, 0, $1, 0, $9, 0, 0, 0, $46, $6c,
$6f, $61, $74, $4b, $65, $79, $73, $a, 0, $5, 0, $a9, $46, $dd, $10, $5b, $77, $cf, $11, $8f,
$52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $7, 0, 0, 0, $6e, $56, $61, $6c, $75,
$65, $73, $14, 0, $34, 0, $2a, 0, $1, 0, $6, 0, 0, 0, $76, $61, $6c, $75, $65, $73,
$e, 0, $1, 0, $7, 0, 0, 0, $6e, $56, $61, $6c, $75, $65, $73, $f, 0, $14, 0, $b,
0, $1f, 0, $1, 0, $e, 0, 0, 0, $54, $69, $6d, $65, $64, $46, $6c, $6f, $61, $74, $4b,
$65, $79, $73, $a, 0, $5, 0, $80, $b1, $6, $f4, $3b, $7b, $cf, $11, $8f, $52, 0, $40, $33,
$35, $94, $a3, $29, 0, $1, 0, $4, 0, 0, 0, $74, $69, $6d, $65, $14, 0, $1, 0, $9,
0, 0, 0, $46, $6c, $6f, $61, $74, $4b, $65, $79, $73, $1, 0, $6, 0, 0, 0, $74, $66,
$6b, $65, $79, $73, $14, 0, $b, 0, $1f, 0, $1, 0, $c, 0, 0, 0, $41, $6e, $69, $6d,
$61, $74, $69, $6f, $6e, $4b, $65, $79, $a, 0, $5, 0, $a8, $46, $dd, $10, $5b, $77, $cf, $11,
$8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $7, 0, 0, 0, $6b, $65, $79, $54,
$79, $70, $65, $14, 0, $29, 0, $1, 0, $5, 0, 0, 0, $6e, $4b, $65, $79, $73, $14, 0,
$34, 0, $1, 0, $e, 0, 0, 0, $54, $69, $6d, $65, $64, $46, $6c, $6f, $61, $74, $4b, $65,
$79, $73, $1, 0, $4, 0, 0, 0, $6b, $65, $79, $73, $e, 0, $1, 0, $5, 0, 0, 0,
$6e, $4b, $65, $79, $73, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0, $10, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $4f, $70, $74, $69, $6f, $6e, $73, $a, 0, $5, 0, $c0,
$56, $bf, $e2, $f, $84, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $a,
0, 0, 0, $6f, $70, $65, $6e, $63, $6c, $6f, $73, $65, $64, $14, 0, $29, 0, $1, 0, $f,
0, 0, 0, $70, $6f, $73, $69, $74, $69, $6f, $6e, $71, $75, $61, $6c, $69, $74, $79, $14, 0,
$b, 0, $1f, 0, $1, 0, $9, 0, 0, 0, $41, $6e, $69, $6d, $61, $74, $69, $6f, $6e, $a,
0, $5, 0, $4f, $ab, $82, $3d, $da, $62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $e,
0, $12, 0, $12, 0, $12, 0, $f, 0, $b, 0, $1f, 0, $1, 0, $c, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $53, $65, $74, $a, 0, $5, 0, $50, $ab, $82, $3d, $da,
$62, $cf, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $e, 0, $1, 0, $9, 0, 0, 0, $41,
$6e, $69, $6d, $61, $74, $69, $6f, $6e, $f, 0, $b, 0, $1f, 0, $1, 0, $a, 0, 0, 0,
$49, $6e, $6c, $69, $6e, $65, $44, $61, $74, $61, $a, 0, $5, 0, $a0, $ee, $23, $3a, $b1, $94,
$d0, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $e, 0, $1, 0, $6, 0, 0, 0, $42, $49,
$4e, $41, $52, $59, $f, 0, $b, 0, $1f, 0, $1, 0, $3, 0, 0, 0, $55, $72, $6c, $a,
0, $5, 0, $a1, $ee, $23, $3a, $b1, $94, $d0, $11, $ab, $39, 0, $20, $af, $71, $e4, $33, $29,
0, $1, 0, $5, 0, 0, 0, $6e, $55, $72, $6c, $73, $14, 0, $34, 0, $31, 0, $1, 0,
$4, 0, 0, 0, $75, $72, $6c, $73, $e, 0, $1, 0, $5, 0, 0, 0, $6e, $55, $72, $6c,
$73, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0, $f, 0, 0, 0, $50, $72, $6f, $67, $72,
$65, $73, $73, $69, $76, $65, $4d, $65, $73, $68, $a, 0, $5, 0, $60, $c3, $63, $8a, $7d, $99,
$d0, $11, $94, $1c, 0, $80, $c8, $c, $fa, $7b, $e, 0, $1, 0, $3, 0, 0, 0, $55, $72,
$6c, $13, 0, $1, 0, $a, 0, 0, 0, $49, $6e, $6c, $69, $6e, $65, $44, $61, $74, $61, $f,
0, $b, 0, $1f, 0, $1, 0, $4, 0, 0, 0, $47, $75, $69, $64, $a, 0, $5, 0, $e0,
$90, $27, $a4, $10, $78, $cf, $11, $8f, $52, 0, $40, $33, $35, $94, $a3, $29, 0, $1, 0, $5,
0, 0, 0, $64, $61, $74, $61, $31, $14, 0, $28, 0, $1, 0, $5, 0, 0, 0, $64, $61,
$74, $61, $32, $14, 0, $28, 0, $1, 0, $5, 0, 0, 0, $64, $61, $74, $61, $33, $14, 0,
$34, 0, $2d, 0, $1, 0, $5, 0, 0, 0, $64, $61, $74, $61, $34, $e, 0, $3, 0, $8,
0, 0, 0, $f, 0, $14, 0, $b, 0, $1f, 0, $1, 0, $e, 0, 0, 0, $53, $74, $72,
$69, $6e, $67, $50, $72, $6f, $70, $65, $72, $74, $79, $a, 0, $5, 0, $e0, $21, $f, $7f, $e1,
$bf, $d1, $11, $82, $c0, 0, $a0, $c9, $69, $72, $71, $31, 0, $1, 0, $3, 0, 0, 0, $6b,
$65, $79, $14, 0, $31, 0, $1, 0, $5, 0, 0, 0, $76, $61, $6c, $75, $65, $14, 0, $b,
0, $1f, 0, $1, 0, $b, 0, 0, 0, $50, $72, $6f, $70, $65, $72, $74, $79, $42, $61, $67,
$a, 0, $5, 0, $e1, $21, $f, $7f, $e1, $bf, $d1, $11, $82, $c0, 0, $a0, $c9, $69, $72, $71,
$e, 0, $1, 0, $e, 0, 0, 0, $53, $74, $72, $69, $6e, $67, $50, $72, $6f, $70, $65, $72,
$74, $79, $f, 0, $b, 0, $1f, 0, $1, 0, $e, 0, 0, 0, $45, $78, $74, $65, $72, $6e,
$61, $6c, $56, $69, $73, $75, $61, $6c, $a, 0, $5, 0, $a0, $6a, $11, $98, $ba, $bd, $d1, $11,
$82, $c0, 0, $a0, $c9, $69, $72, $71, $1, 0, $4, 0, 0, 0, $47, $75, $69, $64, $1, 0,
$12, 0, 0, 0, $67, $75, $69, $64, $45, $78, $74, $65, $72, $6e, $61, $6c, $56, $69, $73, $75,
$61, $6c, $14, 0, $e, 0, $12, 0, $12, 0, $12, 0, $f, 0, $b, 0, $1f, 0, $1, 0,
$b, 0, 0, 0, $52, $69, $67, $68, $74, $48, $61, $6e, $64, $65, $64, $a, 0, $5, 0, $a0,
$5e, $5d, $7f, $3a, $d5, $d1, $11, $82, $c0, 0, $a0, $c9, $69, $72, $71, $29, 0, $1, 0, $c,
0, 0, 0, $62, $52, $69, $67, $68, $74, $48, $61, $6e, $64, $65, $64, $14, 0, $b, 0);
 
//---------------
{$ENDIF}
//DirectInput file
(*==========================================================================;
*
* Copyright (C) 1996-1997 Microsoft Corporation. All Rights Reserved.
* Copyright (C) 1996-1999 Microsoft Corporation. All Rights Reserved.
*
* File: dinput.h
* Content: DirectInput include file
*
****************************************************************************)
* DirectX 7.0 Delphi adaptation by Erik Unger, input format
* variable structure & other fixups by Arne Schäpers (as)
*
* Modified: 10-Sep-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
* a.schaepers@digitalpublishing.de
*
***************************************************************************)
 
const
{$IFDEF DirectX3}
DIRECTINPUT_VERSION = $0300;
{$ENDIF}{$IFDEF DirectX5}
DIRECTINPUT_VERSION = $0500;
{$ENDIF}{$IFDEF DirectX6}
DIRECTINPUT_VERSION = $0500;
{$ENDIF}{$IFDEF DirectX7}
DIRECTINPUT_VERSION = $0700;
{ Some notes from as:
1. DirectInput Enum callback functions which are documented with result
type BOOL in the SDK had to be changed to result type integer because the debug
version of DINPUT.DLL (which is the same for SDK versions 5.0, 5.2, 6.0, and 6.1)
explicitely checks for two possible return values:
 
0 - FALSE in C and in Delphi
1 - TRUE in C, defined as DIENUM_CONTINUE
 
In Delphi, TRUE means $FFFFFFFF (= -1) for the LongBool (= BOOL) data
type, and AL = 1 (upper three bytes undefined) for the Boolean data type.
The debug version of DINPUT.DLL will throw an external exception
("invalid return value for callback") when fed with either value.
 
This change affects the following methods:
EnumDevices, EnumObjects, EnumEffects, EnumCreatedEffectObjects
 
2. Windows 98 and DX6 debug versions DInput and DSound
 
Under Windows 98, the "debug" setup of the DirectX SDK 6.x skips DInput.DLL
and DSound.DLL, i.e. makes you end up with the retail version of these two
files without any notice.
The debug versions of DInput.DLL and DSound.DLL can be found in the
\extras\Win98\Win98Dbg folder of the SDK CD; they need to be installed
"manually".
 
This problem has been fixed with DX7 where the SDK installs the debug versions
of DInput and DSound without any "manual" help.
 
}
 
 
var
DInputDLL : HMODULE;
 
{$IFDEF DIRECTX3}
const DIRECTINPUT_VERSION = $0300;
{$ELSE}
const DIRECTINPUT_VERSION = $0700;
{$ENDIF}
 
{ Class IDs }
function DIErrorString(Value: HResult) : string;
 
//type
// TRefGUID = packed record
// case integer of
// 1: (guid : PGUID);
// 2: (dwFlags : DWORD);
// end;
 
(****************************************************************************
*
* Class IDs
*
****************************************************************************)
const
CLSID_DirectInput: TGUID = '{25E609E0-B259-11CF-BFC7-444553540000}';
CLSID_DirectInputDevice: TGUID = '{25E609E1-B259-11CF-BFC7-444553540000}';
CLSID_DirectInput: TGUID =
(D1:$25E609E0;D2:$B259;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
CLSID_DirectInputDevice: TGUID =
(D1:$25E609E1;D2:$B259;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
 
{ Interfaces }
(****************************************************************************
*
* Predefined object types
*
****************************************************************************)
 
const
IID_IDirectInputA: TGUID = '{89521360-AA8A-11CF-BFC7-444553540000}';
IID_IDirectInputW: TGUID = '{89521361-AA8A-11CF-BFC7-444553540000}';
IID_IDirectInput2A: TGUID = '{5944E662-AA8A-11CF-BFC7-444553540000}';
IID_IDirectInput2W: TGUID = '{5944E663-AA8A-11CF-BFC7-444553540000}';
IID_IDirectInput7A: TGUID = '{9A4CB684-236D-11D3-8E9D-00C04F6844AE}';
IID_IDirectInput7W: TGUID = '{9A4CB685-236D-11D3-8E9D-00C04F6844AE}';
IID_IDirectInputDeviceA: TGUID = '{5944E680-C92E-11CF-BFC7-444553540000}';
IID_IDirectInputDeviceW: TGUID = '{5944E681-C92E-11CF-BFC7-444553540000}';
IID_IDirectInputDevice2A: TGUID = '{5944E682-C92E-11CF-BFC7-444553540000}';
IID_IDirectInputDevice2W: TGUID = '{5944E683-C92E-11CF-BFC7-444553540000}';
IID_IDirectInputDevice7A: TGUID = '{57D7C6BC-2356-11D3-8E9D-00C04F6844AE}';
IID_IDirectInputDevice7W: TGUID = '{57D7C6BD-2356-11D3-8E9D-00C04F6844AE}';
IID_IDirectInputEffect: TGUID = '{E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35}';
GUID_XAxis: TGUID =
(D1:$A36D02E0;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_YAxis: TGUID =
(D1:$A36D02E1;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_ZAxis: TGUID =
(D1:$A36D02E2;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_RxAxis: TGUID =
(D1:$A36D02F4;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_RyAxis: TGUID =
(D1:$A36D02F5;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_RzAxis: TGUID =
(D1:$A36D02E3;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_Slider: TGUID =
(D1:$A36D02E4;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
 
{ Predefined object types }
GUID_Button: TGUID =
(D1:$A36D02F0;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_Key: TGUID =
(D1:$55728220;D2:$D33C;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
 
GUID_XAxis: TGUID = '{A36D02E0-C9F3-11CF-BFC7-444553540000}';
GUID_YAxis: TGUID = '{A36D02E1-C9F3-11CF-BFC7-444553540000}';
GUID_ZAxis: TGUID = '{A36D02E2-C9F3-11CF-BFC7-444553540000}';
GUID_RxAxis: TGUID = '{A36D02F4-C9F3-11CF-BFC7-444553540000}';
GUID_RyAxis: TGUID = '{A36D02F5-C9F3-11CF-BFC7-444553540000}';
GUID_RzAxis: TGUID = '{A36D02E3-C9F3-11CF-BFC7-444553540000}';
GUID_Slider: TGUID = '{A36D02E4-C9F3-11CF-BFC7-444553540000}';
GUID_Button: TGUID = '{A36D02F0-C9F3-11CF-BFC7-444553540000}';
GUID_Key: TGUID = '{55728220-D33C-11CF-BFC7-444553540000}';
GUID_POV: TGUID = '{A36D02F2-C9F3-11CF-BFC7-444553540000}';
GUID_Unknown: TGUID = '{A36D02F3-C9F3-11CF-BFC7-444553540000}';
GUID_POV: TGUID =
(D1:$A36D02F2;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
 
{ Predefined product GUIDs }
GUID_Unknown: TGUID =
(D1:$A36D02F3;D2:$C9F3;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
 
GUID_SysMouse: TGUID = '{6F1D2B60-D5A0-11CF-BFC7-444553540000}';
GUID_SysKeyboard: TGUID = '{6F1D2B61-D5A0-11CF-BFC7-444553540000}';
GUID_Joystick: TGUID = '{6F1D2B70-D5A0-11CF-BFC7-444553540000}';
(****************************************************************************
*
* Predefined product GUIDs
*
****************************************************************************)
 
GUID_SysMouse: TGUID =
(D1:$6F1D2B60;D2:$D5A0;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_SysKeyboard: TGUID =
(D1:$6F1D2B61;D2:$D5A0;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_Joystick: TGUID =
(D1:$6F1D2B70;D2:$D5A0;D3:$11CF;D4:($BF,$C7,$44,$45,$53,$54,$00,$00));
GUID_SysMouseEm: TGUID = '{6F1D2B80-D5A0-11CF-BFC7-444553540000}';
GUID_SysMouseEm2: TGUID = '{6F1D2B81-D5A0-11CF-BFC7-444553540000}';
GUID_SysKeyboardEm: TGUID = '{6F1D2B82-D5A0-11CF-BFC7-444553540000}';
GUID_SysKeyboardEm2: TGUID = '{6F1D2B83-D5A0-11CF-BFC7-444553540000}';
 
{ Predefined force feedback effects }
(****************************************************************************
*
* Predefined force feedback effects
*
****************************************************************************)
 
GUID_ConstantForce: TGUID = '{13541C20-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_RampForce: TGUID = '{13541C21-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Square: TGUID = '{13541C22-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Sine: TGUID = '{13541C23-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Triangle: TGUID = '{13541C24-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_SawtoothUp: TGUID = '{13541C25-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_SawtoothDown: TGUID = '{13541C26-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Spring: TGUID = '{13541C27-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Damper: TGUID = '{13541C28-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Inertia: TGUID = '{13541C29-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_Friction: TGUID = '{13541C2A-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_CustomForce: TGUID = '{13541C2B-8E33-11D0-9AD0-00A0C9A06E35}';
GUID_ConstantForce: TGUID =
(D1:$13541C20;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_RampForce: TGUID =
(D1:$13541C21;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Square: TGUID =
(D1:$13541C22;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Sine: TGUID =
(D1:$13541C23;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Triangle: TGUID =
(D1:$13541C24;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_SawtoothUp: TGUID =
(D1:$13541C25;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_SawtoothDown: TGUID =
(D1:$13541C26;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Spring: TGUID =
(D1:$13541C27;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Damper: TGUID =
(D1:$13541C28;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Inertia: TGUID =
(D1:$13541C29;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_Friction: TGUID =
(D1:$13541C2A;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
GUID_CustomForce: TGUID =
(D1:$13541C2B;D2:$8E33;D3:$11D0;D4:($9A,$D0,$00,$A0,$C9,$A0,$6E,$35));
 
{ IDirectInputEffect }
 
 
(****************************************************************************
*
* Interfaces and Structures...
*
****************************************************************************)
 
(****************************************************************************
*
* IDirectInputEffect
*
****************************************************************************)
 
const
DIEFT_ALL = $00000000;
 
8422,7 → 12098,7
DIEFT_DEADBAND = $00004000;
DIEFT_STARTDELAY = $00008000;
 
function DIEFT_GETTYPE(n: DWORD): DWORD;
function DIEFT_GETTYPE(n: variant) : byte;
 
const
DI_DEGREES = 100;
8431,129 → 12107,101
 
type
PDIConstantForce = ^TDIConstantForce;
TDIConstantForce = record
lMagnitude: Longint;
TDIConstantForce = packed record
lMagnitude : LongInt;
end;
 
DICONSTANTFORCE = TDIConstantForce;
LPDICONSTANTFORCE = PDIConstantForce;
 
PDIRampForce = ^TDIRampForce;
TDIRampForce = record
lStart: Longint;
lEnd: Longint;
TDIRampForce = packed record
lStart : LongInt;
lEnd : LongInt;
end;
 
DIRAMPFORCE = TDIRampForce;
LPDIRAMPFORCE = PDIRampForce;
 
PDIPeriodic = ^TDIPeriodic;
TDIPeriodic = record
TDIPeriodic = packed record
dwMagnitude: DWORD;
lOffset: Longint;
lOffset : LongInt;
dwPhase: DWORD;
dwPeriod: DWORD;
end;
 
DIPERIODIC = TDIPeriodic;
LPDIPERIODIC = PDIPeriodic;
 
PDICondition = ^TDICondition;
TDICondition = record
lOffset: Longint;
lPositiveCoefficient: Longint;
lNegativeCoefficient: Longint;
TDICondition = packed record
lOffset : LongInt;
lPositiveCoefficient : LongInt;
lNegativeCoefficient : LongInt;
dwPositiveSaturation: DWORD;
dwNegativeSaturation: DWORD;
lDeadBand: Longint;
lDeadBand : LongInt;
end;
 
DICONDITION = TDICondition;
LPDICONDITION = PDICondition;
 
PDICustomForce = ^TDICustomForce;
TDICustomForce = record
TDICustomForce = packed record
cChannels: DWORD;
dwSamplePeriod: DWORD;
cSamples: DWORD;
rglForceData: PLongint;
rglForceData : PLongInt;
end;
 
DICUSTOMFORCE = TDICustomForce;
LPDICUSTOMFORCE = PDICustomForce;
 
PDIEnvelope = ^TDIEnvelope;
TDIEnvelope = record
dwSize: DWORD; // sizeof(DIENVELOPE)
TDIEnvelope = packed record
dwSize : DWORD; (* sizeof(DIENVELOPE) *)
dwAttackLevel: DWORD;
dwAttackTime: DWORD; // Microseconds
dwAttackTime : DWORD; (* Microseconds *)
dwFadeLevel: DWORD;
dwFadeTime: DWORD; // Microseconds
dwFadeTime : DWORD; (* Microseconds *)
end;
 
DIENVELOPE = TDIEnvelope;
LPDIENVELOPE = PDIEnvelope;
 
PDIEffect_DX5 = ^TDIEffect_DX5;
TDIEffect_DX5 = record
dwSize: DWORD; // sizeof(DIEFFECT)
dwFlags: DWORD; // DIEFF_*
dwDuration: DWORD; // Microseconds
dwSamplePeriod: DWORD; // Microseconds
TDIEffect_DX5 = packed record
dwSize : DWORD; (* sizeof(DIEFFECT) *)
dwFlags : DWORD; (* DIEFF_* *)
dwDuration : DWORD; (* Microseconds *)
dwSamplePeriod : DWORD; (* Microseconds *)
dwGain: DWORD;
dwTriggerButton: DWORD; // or DIEB_NOTRIGGER
dwTriggerRepeatInterval: DWORD; // Microseconds
cAxes: DWORD; // Number of axes
rgdwAxes: PDWORD; // arrayof axes
rglDirection: PLongint; // arrayof directions
lpEnvelope: PDIEnvelope; // Optional
cbTypeSpecificParams: DWORD; // Size of params
lpvTypeSpecificParams: Pointer; // Pointer to params
dwTriggerButton : DWORD; (* or DIEB_NOTRIGGER *)
dwTriggerRepeatInterval : DWORD; (* Microseconds *)
cAxes : DWORD; (* Number of axes *)
rgdwAxes : PDWORD; (* Array of axes *)
rglDirection : PLongInt; (* Array of directions *)
lpEnvelope : PDIEnvelope; (* Optional *)
cbTypeSpecificParams : DWORD; (* Size of params *)
lpvTypeSpecificParams : pointer; (* Pointer to params *)
end;
 
PDIEffect_DX6 = ^TDIEffect_DX6;
TDIEffect_DX6 = record
dwSize: DWORD; // sizeof(DIEFFECT)
dwFlags: DWORD; // DIEFF_*
dwDuration: DWORD; // Microseconds
dwSamplePeriod: DWORD; // Microseconds
TDIEffect_DX6 = packed record
dwSize : DWORD; (* sizeof(DIEFFECT) *)
dwFlags : DWORD; (* DIEFF_* *)
dwDuration : DWORD; (* Microseconds *)
dwSamplePeriod : DWORD; (* Microseconds *)
dwGain: DWORD;
dwTriggerButton: DWORD; // or DIEB_NOTRIGGER
dwTriggerRepeatInterval: DWORD; // Microseconds
cAxes: DWORD; // Number of axes
rgdwAxes: PDWORD; // arrayof axes
rglDirection: PLongint; // arrayof directions
lpEnvelope: PDIEnvelope; // Optional
cbTypeSpecificParams: DWORD; // Size of params
lpvTypeSpecificParams: Pointer; // Pointer to params
dwStartDelay: DWORD; // Microseconds
dwTriggerButton : DWORD; (* or DIEB_NOTRIGGER *)
dwTriggerRepeatInterval : DWORD; (* Microseconds *)
cAxes : DWORD; (* Number of axes *)
rgdwAxes : PDWORD; (* Array of axes *)
rglDirection : PLongInt; (* Array of directions *)
lpEnvelope : PDIEnvelope; (* Optional *)
cbTypeSpecificParams : DWORD; (* Size of params *)
lpvTypeSpecificParams : pointer; (* Pointer to params *)
dwStartDelay: DWORD; (* Microseconds *)
end;
 
{$IFDEF SupportDirectX6}
PDIEffect = PDIEffect_DX6;
PDIEffect = ^TDIEffect;
{$IFDEF DIRECTX5}
TDIEffect = TDIEffect_DX5;
{$ELSE}
TDIEffect = TDIEffect_DX6;
{$ELSE}
PDIEffect = PDIEffect_DX5;
TDIEffect = TDIEffect_DX5;
{$ENDIF}
 
DIEFFECT = TDIEFFECT;
LPDIEFFECT = PDIEFFECT;
 
PDIFileEffect = ^TDIFileEffect;
TDIFileEffect = record
TDIFileEffect = packed record
dwSize: DWORD;
GuidEffect: TGUID;
lpDiEffect: PDIEffect;
szFriendlyName: array[0..MAX_PATH-1] of Char;
szFriendlyName : array [0..MAX_PATH-1] of AnsiChar;
end;
 
DIFILEEFFECT = TDIFileEffect;
LPDIFILEEFFECT = PDIFileEffect;
 
TDIEnumEffectsInFileCallback = function(const lpDiFileEf: TDIFileEffect; pvRef: Pointer): BOOL; far pascal;
LPDIENUMEFFECTSINFILECALLBACK = TDIEnumEffectsInFileCallback;
 
const
DIEFF_OBJECTIDS = $00000001;
DIEFF_OBJECTOFFSETS = $00000002;
8570,12 → 12218,12
DIEP_DIRECTION = $00000040;
DIEP_ENVELOPE = $00000080;
DIEP_TYPESPECIFICPARAMS = $00000100;
{$IFDEF DIRECTX5}
DIEP_ALLPARAMS = $000001FF;
{$ELSE}
DIEP_STARTDELAY = $00000200;
DIEP_ALLPARAMS_DX5 = $000001FF;
{$IFDEF SupportDirectX6}
DIEP_ALLPARAMS = $000003FF;
{$ELSE}
DIEP_ALLPARAMS = $000001FF;
{$ENDIF}
DIEP_START = $20000000;
DIEP_NORESTART = $40000000;
8588,36 → 12236,43
DIEGES_PLAYING = $00000001;
DIEGES_EMULATED = $00000002;
 
 
type
PDIEffEscape = ^TDIEffEscape;
TDIEffEscape = record
TDIEffEscape = packed record
dwSize: DWORD;
dwCommand: DWORD;
lpvInBuffer: Pointer;
lpvInBuffer : pointer;
cbInBuffer: DWORD;
lpvOutBuffer: Pointer;
lpvOutBuffer : pointer;
cbOutBuffer: DWORD;
end;
 
DIEFFESCAPE = TDIEffEscape;
LPDIEFFESCAPE = PDIEffEscape;
 
//
// IDirectSoundCapture // as: ???
//
IDirectInputEffect = interface(IUnknown)
['{E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35}']
// IDirectInputEffect methods
function Initialize(hinst: THandle; dwVersion: DWORD; const rguid: TGUID): HResult; stdcall;
(** IDirectInputEffect methods ***)
function Initialize(hinst: THandle; dwVersion: DWORD;
const rguid: TGUID) : HResult; stdcall;
function GetEffectGuid(var pguid: TGUID): HResult; stdcall;
function GetParameters(var peff: TDIEffect; dwFlags: DWORD): HResult; stdcall;
function SetParameters(const peff: TDIEffect; dwFlags: DWORD): HResult; stdcall;
function SetParameters(var peff: TDIEffect; dwFlags: DWORD) : HResult; stdcall;
function Start(dwIterations: DWORD; dwFlags: DWORD): HResult; stdcall;
function Stop: HResult; stdcall;
function GetEffectStatus(var pdwFlags: DWORD): HResult; stdcall;
function DownLoad: HResult; stdcall;
function Download : HResult; stdcall;
function Unload: HResult; stdcall;
function Escape(const pesc: TDIEffEscape): HResult; stdcall;
function Escape(var pesc: TDIEffEscape) : HResult; stdcall;
end;
 
{ IDirectInputDevice }
(****************************************************************************
*
* IDirectInputDevice
*
****************************************************************************)
 
const
DIDEVTYPE_DEVICE = 1;
8654,12 → 12309,12
DIDEVTYPEJOYSTICK_WHEEL = 6;
DIDEVTYPEJOYSTICK_HEADTRACKER = 7;
 
function GET_DIDEVICE_TYPE(dwDevType: DWORD): DWORD;
function GET_DIDEVICE_SUBTYPE(dwDevType: DWORD): DWORD;
function GET_DIDEVICE_TYPE(dwDevType: variant) : byte;
function GET_DIDEVICE_SUBTYPE(dwDevType: variant) : byte;
 
type
PDIDevCaps_DX3 = ^TDIDevCaps_DX3;
TDIDevCaps_DX3 = record
TDIDevCaps_DX3 = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwDevType: DWORD;
8669,7 → 12324,7
end;
 
PDIDevCaps_DX5 = ^TDIDevCaps_DX5;
TDIDevCaps_DX5 = record
TDIDevCaps_DX5 = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwDevType: DWORD;
8683,29 → 12338,18
dwFFDriverVersion: DWORD;
end;
 
{$IFDEF DirectX3}
PDIDevCaps = ^TDIDevCaps;
{$IFDEF DIRECTX3}
TDIDevCaps = TDIDevCaps_DX3;
PDIDevCaps = PDIDevCaps_DX3;
{$ENDIF}{$IFDEF DirectX5}
{$ELSE}
TDIDevCaps = TDIDevCaps_DX5;
PDIDevCaps = PDIDevCaps_DX5;
{$ENDIF}{$IFDEF DirectX6}
TDIDevCaps = TDIDevCaps_DX5;
PDIDevCaps = PDIDevCaps_DX5;
{$ENDIF}{$IFDEF DirectX7}
TDIDevCaps = TDIDevCaps_DX5;
PDIDevCaps = PDIDevCaps_DX5;
{$ENDIF}
 
DIDEVCAPS = TDIDevCaps;
LPDIDEVCAPS = PDIDevCaps;
 
const
DIDC_ATTACHED = $00000001;
DIDC_POLLEDDEVICE = $00000002;
DIDC_EMULATED = $00000004;
DIDC_POLLEDDATAFORMAT = $00000008;
 
DIDC_FORCEFEEDBACK = $00000100;
DIDC_FFATTACK = $00000200;
DIDC_FFFADE = $00000400;
8733,22 → 12377,25
 
DIDFT_ANYINSTANCE = $00FFFF00;
DIDFT_INSTANCEMASK = DIDFT_ANYINSTANCE;
 
function DIDFT_MAKEINSTANCE(n: variant) : DWORD;
function DIDFT_GETTYPE(n: variant) : byte;
function DIDFT_GETINSTANCE(n: variant) : DWORD;
const
DIDFT_FFACTUATOR = $01000000;
DIDFT_FFEFFECTTRIGGER = $02000000;
DIDFT_OUTPUT = $10000000;
DIDFT_VENDORDEFINED = $04000000;
DIDFT_ALIAS = $08000000;
 
function DIDFT_ENUMCOLLECTION(n: variant) : DWORD;
const
DIDFT_NOCOLLECTION = $00FFFF00;
 
function DIDFT_MAKEINSTANCE(n: WORD): DWORD;
function DIDFT_GETTYPE(n: DWORD): DWORD;
function DIDFT_GETINSTANCE(n: DWORD): WORD;
function DIDFT_ENUMCOLLECTION(n: WORD): DWORD;
 
 
type
PDIObjectDataFormat = ^TDIObjectDataFormat;
TDIObjectDataFormat = record
TDIObjectDataFormat = packed record
pguid: PGUID;
dwOfs: DWORD;
dwType: DWORD;
8755,11 → 12402,8
dwFlags: DWORD;
end;
 
DIOBJECTDATAFORMAT = TDIObjectDataFormat;
LPDIOBJECTDATAFORMAT = PDIObjectDataFormat;
 
PDIDataFormat = ^TDIDataFormat;
TDIDataFormat = record
TDIDataFormat = packed record
dwSize: DWORD;
dwObjSize: DWORD;
dwFlags: DWORD;
8768,32 → 12412,46
rgodf: PDIObjectDataFormat;
end;
 
DIDATAFORMAT = TDIDataFormat;
LPDIDATAFORMAT = PDIDataFormat;
 
const
DIDF_ABSAXIS = $00000001;
DIDF_RELAXIS = $00000002;
 
type
PDIDeviceObjectInstanceA_DX3 = ^TDIDeviceObjectInstanceA_DX3;
TDIDeviceObjectInstanceA_DX3 = record
PDIDeviceObjectInstance_DX3A = ^TDIDeviceObjectInstance_DX3A;
TDIDeviceObjectInstance_DX3A = packed record
dwSize: DWORD;
guidType: TGUID;
dwOfs: DWORD;
dwType: DWORD;
dwFlags: DWORD;
tszName: array[0..MAX_PATH-1] of CHAR;
tszName: Array [0..MAX_PATH-1] of CHAR;
end;
 
PDIDeviceObjectInstanceA_DX5 = ^TDIDeviceObjectInstanceA_DX5;
TDIDeviceObjectInstanceA_DX5 = record
PDIDeviceObjectInstance_DX3W = ^TDIDeviceObjectInstance_DX3W;
TDIDeviceObjectInstance_DX3W = packed record
dwSize: DWORD;
guidType: TGUID;
dwOfs: DWORD;
dwType: DWORD;
dwFlags: DWORD;
tszName: array[0..MAX_PATH-1] of CHAR;
tszName: Array [0..MAX_PATH-1] of WCHAR;
end;
 
PDIDeviceObjectInstance_DX3 = ^TDIDeviceObjectInstance_DX3;
{$IFDEF UNICODE}
TDIDeviceObjectInstance_DX3 = TDIDeviceObjectInstance_DX3W;
{$ELSE}
TDIDeviceObjectInstance_DX3 = TDIDeviceObjectInstance_DX3A;
{$ENDIF}
 
PDIDeviceObjectInstance_DX5A = ^TDIDeviceObjectInstance_DX5A;
TDIDeviceObjectInstance_DX5A = packed record
dwSize: DWORD;
guidType: TGUID;
dwOfs: DWORD;
dwType: DWORD;
dwFlags: DWORD;
tszName: Array [0..MAX_PATH-1] of CHAR;
dwFFMaxForce: DWORD;
dwFFForceResolution: DWORD;
wCollectionNumber: WORD;
8805,41 → 12463,14
wReserved: WORD;
end;
 
{$IFDEF DirectX3}
TDIDeviceObjectInstanceA = TDIDeviceObjectInstanceA_DX3;
PDIDeviceObjectInstanceA = PDIDeviceObjectInstanceA_DX3;
{$ENDIF}{$IFDEF DirectX5}
TDIDeviceObjectInstanceA = TDIDeviceObjectInstanceA_DX5;
PDIDeviceObjectInstanceA = PDIDeviceObjectInstanceA_DX5;
{$ENDIF}{$IFDEF DirectX6}
TDIDeviceObjectInstanceA = TDIDeviceObjectInstanceA_DX5;
PDIDeviceObjectInstanceA = PDIDeviceObjectInstanceA_DX5;
{$ENDIF}{$IFDEF DirectX7}
TDIDeviceObjectInstanceA = TDIDeviceObjectInstanceA_DX5;
PDIDeviceObjectInstanceA = PDIDeviceObjectInstanceA_DX5;
{$ENDIF}
 
DIDEVICEOBJECTINSTANCEA = TDIDeviceObjectInstanceA;
LPDIDEVICEOBJECTINSTANCEA = PDIDeviceObjectInstanceA;
 
PDIDeviceObjectInstanceW_DX3 = ^TDIDeviceObjectInstanceW_DX3;
TDIDeviceObjectInstanceW_DX3 = record
PDIDeviceObjectInstance_DX5W = ^TDIDeviceObjectInstance_DX5W;
TDIDeviceObjectInstance_DX5W = packed record
dwSize: DWORD;
guidType: TGUID;
dwOfs: DWORD;
dwType: DWORD;
dwFlags: DWORD;
tszName: array[0..MAX_PATH-1] of WCHAR;
end;
 
PDIDeviceObjectInstanceW_DX5 = ^TDIDeviceObjectInstanceW_DX5;
TDIDeviceObjectInstanceW_DX5 = record
dwSize: DWORD;
guidType: TGUID;
dwOfs: DWORD;
dwType: DWORD;
dwFlags: DWORD;
tszName: array[0..MAX_PATH-1] of WCHAR;
tszName: Array [0..MAX_PATH-1] of WCHAR;
dwFFMaxForce: DWORD;
dwFFForceResolution: DWORD;
wCollectionNumber: WORD;
8851,40 → 12482,39
wReserved: WORD;
end;
 
{$IFDEF DirectX3}
TDIDeviceObjectInstanceW = TDIDeviceObjectInstanceW_DX3;
PDIDeviceObjectInstanceW = PDIDeviceObjectInstanceW_DX3;
{$ENDIF}{$IFDEF DirectX5}
TDIDeviceObjectInstanceW = TDIDeviceObjectInstanceW_DX5;
PDIDeviceObjectInstanceW = PDIDeviceObjectInstanceW_DX5;
{$ENDIF}{$IFDEF DirectX6}
TDIDeviceObjectInstanceW = TDIDeviceObjectInstanceW_DX5;
PDIDeviceObjectInstanceW = PDIDeviceObjectInstanceW_DX5;
{$ENDIF}{$IFDEF DirectX7}
TDIDeviceObjectInstanceW = TDIDeviceObjectInstanceW_DX5;
PDIDeviceObjectInstanceW = PDIDeviceObjectInstanceW_DX5;
PDIDeviceObjectInstance_DX5 = ^TDIDeviceObjectInstance_DX5;
{$IFDEF UNICODE}
TDIDeviceObjectInstance_DX5 = TDIDeviceObjectInstance_DX5W;
{$ELSE}
TDIDeviceObjectInstance_DX5 = TDIDeviceObjectInstance_DX5A;
{$ENDIF}
 
DIDEVICEOBJECTINSTANCEW = TDIDeviceObjectInstanceW;
LPDIDEVICEOBJECTINSTANCEW = PDIDeviceObjectInstanceW;
PDIDeviceObjectInstanceA = ^TDIDeviceObjectInstanceA;
PDIDeviceObjectInstanceW = ^TDIDeviceObjectInstanceA;
PDIDeviceObjectInstance = ^TDIDeviceObjectInstance;
{$IFDEF DIRECTX3}
TDIDeviceObjectInstanceA = TDIDeviceObjectInstance_DX3A;
TDIDeviceObjectInstanceW = TDIDeviceObjectInstance_DX3W;
TDIDeviceObjectInstance = TDIDeviceObjectInstance_DX3;
{$ELSE}
TDIDeviceObjectInstanceA = TDIDeviceObjectInstance_DX5A;
TDIDeviceObjectInstanceW = TDIDeviceObjectInstance_DX5W;
TDIDeviceObjectInstance = TDIDeviceObjectInstance_DX5;
{$ENDIF}
 
TDIDeviceObjectInstance = TDIDeviceObjectInstanceA;
PDIDeviceObjectInstance = PDIDeviceObjectInstanceA;
// Bug fix (and deviation from the SDK). Callback *must* return
// DIENUM_STOP (= 0) or DIENUM_CONTINUE (=1) in order to work
// with the debug version of DINPUT.DLL
TDIEnumDeviceObjectsCallbackA = function (
var lpddoi: TDIDeviceObjectInstanceA; pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumDeviceObjectsCallbackW = function (
var lpddoi: TDIDeviceObjectInstanceW; pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumDeviceObjectsCallback = function (
var lpddoi: TDIDeviceObjectInstance; pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
 
DIDEVICEOBJECTINSTANCE = TDIDeviceObjectInstance;
LPDIDEVICEOBJECTINSTANCE = PDIDeviceObjectInstance;
TDIEnumDeviceObjectsProc = function (
var lpddoi: TDIDeviceObjectInstance; pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
 
TDIEnumDeviceObjectsCallbackA = function(const peff: TDIDeviceObjectInstanceA;
pvRef: Pointer): HResult; stdcall;
LPDIENUMDEVICEOBJECTSCALLBACKA = TDIEnumDeviceObjectsCallbackA;
 
TDIEnumDeviceObjectsCallbackW = function(const peff: TDIDeviceObjectInstanceW;
pvRef: Pointer): HResult; stdcall;
LPDIENUMDEVICEOBJECTSCALLBACKW = TDIEnumDeviceObjectsCallbackW;
 
TDIEnumDeviceObjectsCallback = TDIEnumDeviceObjectsCallbackA;
LPDIENUMDEVICEOBJECTSCALLBACK = TDIEnumDeviceObjectsCallback;
 
const
DIDOI_FFACTUATOR = $00000001;
DIDOI_FFEFFECTTRIGGER = $00000002;
8898,7 → 12528,7
 
type
PDIPropHeader = ^TDIPropHeader;
TDIPropHeader = record
TDIPropHeader = packed record
dwSize: DWORD;
dwHeaderSize: DWORD;
dwObj: DWORD;
8905,9 → 12535,6
dwHow: DWORD;
end;
 
DIPROPHEADER = TDIPropHeader;
LPDIPROPHEADER = PDIPropHeader;
 
const
DIPH_DEVICE = 0;
DIPH_BYOFFSET = 1;
8914,97 → 12541,105
DIPH_BYID = 2;
DIPH_BYUSAGE = 3;
 
function DIMAKEUSAGEDWORD(UsagePage, Usage: Word): DWORD;
function DIMAKEUSAGEDWORD(UsagePage, Usage: WORD) : DWORD;
 
type
PDIPropDWORD = ^TDIPropDWORD;
TDIPropDWORD = record
PDIPropDWord = ^TDIPropDWord;
TDIPropDWord = packed record
diph: TDIPropHeader;
dwData: DWORD;
end;
 
DIPROPDWORD = TDIPropDWORD;
LPDIPROPDWORD = PDIPropDWORD;
 
PDIPropRange = ^TDIPropRange;
TDIPropRange = record
TDIPropRange = packed record
diph: TDIPropHeader;
lMin: Longint;
lMax: Longint;
end;
 
DIPROPRANGE = TDIPropRange;
LPDIPROPRANGE = PDIPropRange;
const
DIPROPRANGE_NOMIN = $80000000;
DIPROPRANGE_NOMAX = $7FFFFFFF;
 
type
PDIPropCal = ^TDIPropCal;
TDIPropCal = record
TDIPropCal = packed record
diph: TDIPropHeader;
lMin: Longint;
lCenter: Longint;
lMax: Longint;
lMin: LongInt;
lCenter: LongInt;
lMax: LongInt;
end;
 
DIPROPCAL = TDIPropCal;
LPDIPROPCAL = PDIPropCal;
 
PDIPropGUIDAndPath = ^TDIPropGUIDAndPath;
TDIPropGUIDAndPath = record
TDIPropGUIDAndPath = packed record
diph: TDIPropHeader;
guidClass: TGUID;
wszPath: array[0..MAX_PATH-1] of WCHAR;
wszPath: array [0..MAX_PATH-1] of WideChar;
end;
 
DIPROPGUIDANDPATH = TDIPropGUIDAndPath;
LPDIPROPGUIDANDPATH = PDIPropGUIDAndPath;
 
PDIPropString = ^TDIPropString;
TDIPropString = record
TDIPropString = packed record
diph: TDIPropHeader;
wsz: array[0..MAX_PATH-1] of WCHAR;
wsz: array [0..MAX_PATH-1] of WideChar;
end;
 
DIPROPSTRING = TDIPropString;
LPDIPROPSTRING = PDIPropString;
type
MAKEDIPROP = PGUID;
 
const
DIPROPRANGE_NOMIN = $80000000;
DIPROPRANGE_NOMAX = $7FFFFFFF;
DIPROP_BUFFERSIZE = MAKEDIPROP(1);
 
DIPROP_BUFFERSIZE = PGUID(1);
DIPROP_AXISMODE = PGUID(2);
DIPROP_AXISMODE = MAKEDIPROP(2);
 
DIPROPAXISMODE_ABS = 0;
DIPROPAXISMODE_REL = 1;
 
DIPROP_GRANULARITY = PGUID(3);
DIPROP_RANGE = PGUID(4);
DIPROP_DEADZONE = PGUID(5);
DIPROP_SATURATION = PGUID(6);
DIPROP_FFGAIN = PGUID(7);
DIPROP_FFLOAD = PGUID(8);
DIPROP_AUTOCENTER = PGUID(9);
DIPROP_GRANULARITY = MAKEDIPROP(3);
 
DIPROP_RANGE = MAKEDIPROP(4);
 
DIPROP_DEADZONE = MAKEDIPROP(5);
 
DIPROP_SATURATION = MAKEDIPROP(6);
 
DIPROP_FFGAIN = MAKEDIPROP(7);
 
DIPROP_FFLOAD = MAKEDIPROP(8);
 
DIPROP_AUTOCENTER = MAKEDIPROP(9);
 
DIPROPAUTOCENTER_OFF = 0;
DIPROPAUTOCENTER_ON = 1;
 
DIPROP_CALIBRATIONMODE = PGUID(10);
DIPROP_CALIBRATIONMODE = MAKEDIPROP(10);
 
DIPROPCALIBRATIONMODE_COOKED = 0;
DIPROPCALIBRATIONMODE_RAW = 1;
 
DIPROP_CALIBRATION = PGUID(11);
DIPROP_GUIDANDPATH = PGUID(12);
DIPROP_INSTANCENAME = PGUID(13);
DIPROP_PRODUCTNAME = PGUID(14);
DIPROP_JOYSTICKID = PGUID(15);
DIPROP_GETPORTDISPLAYNAME = PGUID(16);
DIPROP_ENABLEREPORTID = PGUID(17);
DIPROP_GETPHYSICALRANGE = PGUID(18);
DIPROP_GETLOGICALRANGE = PGUID(19);
DIPROP_CALIBRATION = MAKEDIPROP(11);
 
DIPROP_GUIDANDPATH = MAKEDIPROP(12);
 
DIPROP_INSTANCENAME = MAKEDIPROP(13);
 
DIPROP_PRODUCTNAME = MAKEDIPROP(14);
 
DIPROP_JOYSTICKID = MAKEDIPROP(15);
 
DIPROP_GETPORTDISPLAYNAME = MAKEDIPROP(16);
 
 
DIPROP_ENABLEREPORTID = MAKEDIPROP(17);
 
 
DIPROP_GETPHYSICALRANGE = MAKEDIPROP(18);
 
DIPROP_GETLOGICALRANGE = MAKEDIPROP(19);
 
 
type
PDIDeviceObjectData = ^TDIDeviceObjectData;
TDIDeviceObjectData = record
TDIDeviceObjectData = packed record
dwOfs: DWORD;
dwData: DWORD;
dwTimeStamp: DWORD;
9011,11 → 12646,12
dwSequence: DWORD;
end;
 
DIDEVICEOBJECTDATA = TDIDeviceObjectData;
LPDIDEVICEOBJECTDATA = PDIDeviceObjectData;
 
const
DIGDD_PEEK = $00000001;
{
#define DISEQUENCE_COMPARE(dwSequence1, cmp, dwSequence2) \
(int) ((dwSequence1) - (dwSequence2)) cmp 0
}
 
DISCL_EXCLUSIVE = $00000001;
DISCL_NONEXCLUSIVE = $00000002;
9023,140 → 12659,137
DISCL_BACKGROUND = $00000008;
DISCL_NOWINKEY = $00000010;
 
 
type
PDIDeviceInstanceA_DX3 = ^TDIDeviceInstanceA_DX3;
TDIDeviceInstanceA_DX3 = record
 
PDIDeviceInstance_DX3A = ^TDIDeviceInstance_DX3A;
TDIDeviceInstance_DX3A = packed record
dwSize: DWORD;
guidInstance: TGUID;
guidProduct: TGUID;
dwDevType: DWORD;
tszInstanceName: array[0..MAX_PATH-1] of CHAR;
tszProductName: array[0..MAX_PATH-1] of CHAR;
tszInstanceName: Array [0..MAX_PATH-1] of AnsiChar;
tszProductName: Array [0..MAX_PATH-1] of AnsiChar;
end;
 
PDIDeviceInstanceA_DX5 = ^TDIDeviceInstanceA_DX5;
TDIDeviceInstanceA_DX5 = record
PDIDeviceInstance_DX3W = ^TDIDeviceInstance_DX3W;
TDIDeviceInstance_DX3W = packed record
dwSize: DWORD;
guidInstance: TGUID;
guidProduct: TGUID;
dwDevType: DWORD;
tszInstanceName: array[0..MAX_PATH-1] of CHAR;
tszProductName: array[0..MAX_PATH-1] of CHAR;
guidFFDriver: TGUID;
wUsagePage: WORD;
wUsage: WORD;
tszInstanceName: Array [0..MAX_PATH-1] of WideChar;
tszProductName: Array [0..MAX_PATH-1] of WideChar;
end;
 
{$IFDEF DirectX3}
TDIDeviceInstanceA = TDIDeviceInstanceA_DX3;
PDIDeviceInstanceA = PDIDeviceInstanceA_DX3;
{$ENDIF}{$IFDEF DirectX5}
TDIDeviceInstanceA = TDIDeviceInstanceA_DX5;
PDIDeviceInstanceA = PDIDeviceInstanceA_DX5;
{$ENDIF}{$IFDEF DirectX6}
TDIDeviceInstanceA = TDIDeviceInstanceA_DX5;
PDIDeviceInstanceA = PDIDeviceInstanceA_DX5;
{$ENDIF}{$IFDEF DirectX7}
TDIDeviceInstanceA = TDIDeviceInstanceA_DX5;
PDIDeviceInstanceA = PDIDeviceInstanceA_DX5;
PDIDeviceInstance_DX3 = ^TDIDeviceInstance_DX3;
{$IFDEF UNICODE}
TDIDeviceInstance_DX3 = TDIDeviceInstance_DX3W;
{$ELSE}
TDIDeviceInstance_DX3 = TDIDeviceInstance_DX3A;
{$ENDIF}
 
DIDEVICEINSTANCEA = TDIDeviceInstanceA;
LPDIDEVICEINSTANCEA = PDIDeviceInstanceA;
 
PDIDeviceInstanceW_DX3 = ^TDIDeviceInstanceW_DX3;
TDIDeviceInstanceW_DX3 = record
PDIDeviceInstance_DX5A = ^TDIDeviceInstance_DX5A;
TDIDeviceInstance_DX5A = packed record
dwSize: DWORD;
guidInstance: TGUID;
guidProduct: TGUID;
dwDevType: DWORD;
tszInstanceName: array[0..MAX_PATH-1] of WCHAR;
tszProductName: array[0..MAX_PATH-1] of WCHAR;
tszInstanceName: Array [0..MAX_PATH-1] of AnsiChar;
tszProductName: Array [0..MAX_PATH-1] of AnsiChar;
guidFFDriver: TGUID;
wUsagePage: WORD;
wUsage: WORD;
end;
 
PDIDeviceInstanceW_DX5 = ^TDIDeviceInstanceW_DX5;
TDIDeviceInstanceW_DX5 = record
PDIDeviceInstance_DX5W = ^TDIDeviceInstance_DX5W;
TDIDeviceInstance_DX5W = packed record
dwSize: DWORD;
guidInstance: TGUID;
guidProduct: TGUID;
dwDevType: DWORD;
tszInstanceName: array[0..MAX_PATH-1] of WCHAR;
tszProductName: array[0..MAX_PATH-1] of WCHAR;
tszInstanceName: Array [0..MAX_PATH-1] of WideChar;
tszProductName: Array [0..MAX_PATH-1] of WideChar;
guidFFDriver: TGUID;
wUsagePage: WORD;
wUsage: WORD;
end;
 
{$IFDEF DirectX3}
TDIDeviceInstanceW = TDIDeviceInstanceW_DX3;
PDIDeviceInstanceW = PDIDeviceInstanceW_DX3;
{$ENDIF}{$IFDEF DirectX5}
TDIDeviceInstanceW = TDIDeviceInstanceW_DX5;
PDIDeviceInstanceW = PDIDeviceInstanceW_DX5;
{$ENDIF}{$IFDEF DirectX6}
TDIDeviceInstanceW = TDIDeviceInstanceW_DX5;
PDIDeviceInstanceW = PDIDeviceInstanceW_DX5;
{$ENDIF}{$IFDEF DirectX7}
TDIDeviceInstanceW = TDIDeviceInstanceW_DX5;
PDIDeviceInstanceW = PDIDeviceInstanceW_DX5;
PDIDeviceInstance_DX5 = ^TDIDeviceInstance_DX5;
{$IFDEF UNICODE}
TDIDeviceInstance_DX5 = TDIDeviceInstance_DX5W;
{$ELSE}
TDIDeviceInstance_DX5 = TDIDeviceInstance_DX5A;
{$ENDIF}
 
DIDEVICEINSTANCEW = TDIDeviceInstanceW;
LPDIDEVICEINSTANCEW = PDIDeviceInstanceW;
PDIDeviceInstanceA = ^TDIDeviceInstanceA;
PDIDeviceInstanceW = ^TDIDeviceInstanceW;
PDIDeviceInstance = ^TDIDeviceInstance;
{$IFDEF DIRECTX3}
TDIDeviceInstanceA = TDIDeviceInstance_DX3A;
TDIDeviceInstanceW = TDIDeviceInstance_DX3W;
TDIDeviceInstance = TDIDeviceInstance_DX3;
{$ELSE}
TDIDeviceInstanceA = TDIDeviceInstance_DX5A;
TDIDeviceInstanceW = TDIDeviceInstance_DX5W;
TDIDeviceInstance = TDIDeviceInstance_DX5;
{$ENDIF}
 
TDIDeviceInstance = TDIDeviceInstanceA;
PDIDeviceInstance = PDIDeviceInstanceA;
 
DIDEVICEINSTANCE = TDIDeviceInstance;
LPDIDEVICEINSTANCE = PDIDeviceInstance;
 
IDirectInputDeviceW = interface(IUnknown)
['{5944E681-C92E-11CF-BFC7-444553540000}']
// IDirectInputDeviceW methods
IDirectInputDeviceA = interface (IUnknown)
['{5944E680-C92E-11CF-BFC7-444553540000}']
(*** IDirectInputDeviceA methods ***)
function GetCapabilities(var lpDIDevCaps: TDIDevCaps): HResult; stdcall;
function EnumObjects(lpCallback: TDIEnumDeviceObjectsCallbackW;
function EnumObjects(lpCallback: TDIEnumDeviceObjectsCallbackA;
pvRef: Pointer; dwFlags: DWORD): HResult; stdcall;
function GetProperty(rguidProp: PGUID; var pdiph: TDIPropHeader): HResult; stdcall;
function SetProperty(rguidProp: PGUID; const pdiph: TDIPropHeader): HResult; stdcall;
function GetProperty(rguidProp: PGUID; var pdiph: TDIPropHeader) :
HResult; stdcall;
function SetProperty(rguidProp: PGUID; const pdiph: TDIPropHeader) :
HResult; stdcall;
function Acquire: HResult; stdcall;
function Unacquire: HResult; stdcall;
function GetDeviceState(cbData: DWORD; var lpvData): HResult; stdcall;
function GetDeviceData(cbObjectData: DWORD; var rgdod: TDIDeviceObjectData;
function GetDeviceState(cbData: DWORD; lpvData: Pointer) : HResult; stdcall;
function GetDeviceData(cbObjectData: DWORD; rgdod: PDIDeviceObjectData;
var pdwInOut: DWORD; dwFlags: DWORD): HResult; stdcall;
function SetDataFormat(const lpdf: TDIDataFormat): HResult; stdcall;
function SetDataFormat(var lpdf: TDIDataFormat) : HResult; stdcall;
function SetEventNotification(hEvent: THandle): HResult; stdcall;
function SetCooperativeLevel(hwnd: HWND; dwFlags: DWORD): HResult; stdcall;
function GetObjectInfo(var pdidoi: TDIDeviceObjectInstanceW; dwObj: DWORD;
function GetObjectInfo(var pdidoi: TDIDeviceObjectInstanceA; dwObj: DWORD;
dwHow: DWORD): HResult; stdcall;
function GetDeviceInfo(var pdidi: TDIDeviceInstanceW): HResult; stdcall;
function GetDeviceInfo(var pdidi: TDIDeviceInstanceA) : HResult; stdcall;
function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HResult; stdcall;
function Initialize(hinst: THandle; dwVersion: DWORD; const rguid: TGUID): HResult; stdcall;
end;
 
IDirectInputDeviceA = interface(IUnknown)
['{5944E680-C92E-11CF-BFC7-444553540000}']
// IDirectInputDeviceA methods
IDirectInputDeviceW = interface (IUnknown)
['{5944E681-C92E-11CF-BFC7-444553540000}']
(*** IDirectInputDeviceW methods ***)
function GetCapabilities(var lpDIDevCaps: TDIDevCaps): HResult; stdcall;
function EnumObjects(lpCallback: TDIEnumDeviceObjectsCallbackA;
function EnumObjects(lpCallback: TDIEnumDeviceObjectsCallbackW;
pvRef: Pointer; dwFlags: DWORD): HResult; stdcall;
function GetProperty(rguidProp: PGUID; var pdiph: TDIPropHeader): HResult; stdcall;
function SetProperty(rguidProp: PGUID; const pdiph: TDIPropHeader): HResult; stdcall;
function GetProperty(rguidProp: PGUID; var pdiph: TDIPropHeader) :
HResult; stdcall;
function SetProperty(rguidProp: PGUID; var pdiph: TDIPropHeader) :
HResult; stdcall;
function Acquire: HResult; stdcall;
function Unacquire: HResult; stdcall;
function GetDeviceState(cbData: DWORD; var lpvData): HResult; stdcall;
function GetDeviceData(cbObjectData: DWORD; var rgdod: TDIDeviceObjectData;
function GetDeviceState(cbData: DWORD; lpvData: Pointer) : HResult; stdcall;
function GetDeviceData(cbObjectData: DWORD; rgdod: PDIDeviceObjectData;
var pdwInOut: DWORD; dwFlags: DWORD): HResult; stdcall;
function SetDataFormat(const lpdf: TDIDataFormat): HResult; stdcall;
function SetDataFormat(var lpdf: TDIDataFormat) : HResult; stdcall;
function SetEventNotification(hEvent: THandle): HResult; stdcall;
function SetCooperativeLevel(hwnd: HWND; dwFlags: DWORD): HResult; stdcall;
function GetObjectInfo(var pdidoi: TDIDeviceObjectInstanceA; dwObj: DWORD;
function GetObjectInfo(var pdidoi: TDIDeviceObjectInstanceW; dwObj: DWORD;
dwHow: DWORD): HResult; stdcall;
function GetDeviceInfo(var pdidi: TDIDeviceInstanceA): HResult; stdcall;
function GetDeviceInfo(var pdidi: TDIDeviceInstanceW) : HResult; stdcall;
function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HResult; stdcall;
function Initialize(hinst: THandle; dwVersion: DWORD; const rguid: TGUID): HResult; stdcall;
end;
 
{$IFDEF UNICODE}
IDirectInputDevice = IDirectInputDeviceW;
{$ELSE}
IDirectInputDevice = IDirectInputDeviceA;
{$ENDIF}
 
const
DISFFC_RESET = $00000001;
9179,15 → 12812,9
DIGFFS_USERFFSWITCHOFF = $00000800;
DIGFFS_DEVICELOST = $80000000;
 
DISDD_CONTINUE = 1;
 
DIFEF_DEFAULT = $00000000;
DIFEF_INCLUDENONSTANDARD = $00000001;
DIFEF_MODIFYIFNEEDED = $00000010;
 
type
PDIEffectInfoA = ^TDIEffectInfoA;
TDIEffectInfoA = record
TDIEffectInfoA = packed record
dwSize: DWORD;
guid: TGUID;
dwEffType: DWORD;
9196,11 → 12823,8
tszName: array[0..MAX_PATH-1] of CHAR;
end;
 
DIEFFECTINFOA = TDIEffectInfoA;
LPDIEFFECTINFOA = PDIEffectInfoA;
 
PDIEffectInfoW = ^TDIEffectInfoW;
TDIEffectInfoW = record
TDIEffectInfoW = packed record
dwSize: DWORD;
guid: TGUID;
dwEffType: DWORD;
9209,142 → 12833,255
tszName: array[0..MAX_PATH-1] of WCHAR;
end;
 
DIEFFECTINFOW = TDIEffectInfoW;
LPDIEFFECTINFOW = PDIEffectInfoW;
PDIEffectInfo = ^TDIEffectInfo;
{$IFDEF UNICODE}
TDIEffectInfo = TDIEffectInfoW;
{$ELSE}
TDIEffectInfo = TDIEffectInfoA;
{$ENDIF}
 
DIEFFECTINFO = TDIEffectInfoA;
LPDIEFFECTINFO = PDIEffectInfoA;
const
DISDD_CONTINUE = $00000001;
 
TDIEnumEffectsCallbackA = function(const pdei: TDIEffectInfoA;
pvRef: Pointer): HResult; stdcall;
LPDIENUMEFFECTSCALLBACKA = TDIEnumEffectsCallbackA;
// Bug fix & deviation from the SDK: Must return DIENUM_STOP or
// DIENUM_CONTINUE (=1) in order to work with the debug version of DINPUT.DLL
type
TDIEnumEffectsCallbackA =
function(var pdei: TDIEffectInfoA; pvRef: pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumEffectsCallbackW =
function(var pdei: TDIEffectInfoW; pvRef: pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumEffectsCallback =
function(var pdei: TDIEffectInfo; pvRef: pointer) : Integer; stdcall; // BOOL; stdcall;
TDIEnumEffectsProc = TDIEnumEffectsCallback;
 
TDIEnumEffectsCallbackW = function(const pdei: TDIEffectInfoW;
pvRef: Pointer): HResult; stdcall;
LPDIENUMEFFECTSCALLBACKW = TDIEnumEffectsCallbackW;
TDIEnumCreatedEffectObjectsCallback =
function(peff: IDirectInputEffect; pvRev: pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumCreatedEffectObjectsProc = TDIEnumCreatedEffectObjectsCallback;
 
TDIEnumEffectsCallback = TDIEnumEffectsCallbackA;
LPDIENUMEFFECTSCALLBACK = TDIEnumEffectsCallback;
 
LPDIENUMCREATEDEFFECTOBJECTSCALLBACK = function(const peff:
IDirectInputEffect; pvRef: Pointer): HResult; stdcall;
 
IDirectInputDevice2W = interface(IDirectInputDeviceW)
['{5944E683-C92E-11CF-BFC7-444553540000}']
// IDirectInputDevice2W methods
function CreateEffect(const rguid: TGUID; const lpeff: TDIEffect;
out ppdeff: IDirectInputEffect; punkOuter: IUnknown): HResult; stdcall;
function EnumEffects(lpCallback: TDIEnumEffectsCallbackW; pvRef: Pointer;
dwEffType: DWORD): HResult; stdcall;
function GetEffectInfo(var pdei: TDIEffectInfoW; const rguid: TGUID): HResult; stdcall;
IDirectInputDevice2A = interface (IDirectInputDeviceA)
['{5944E682-C92E-11CF-BFC7-444553540000}']
(*** IDirectInputDevice2A methods ***)
function CreateEffect(const rguid: TGUID; lpeff: PDIEffect;
var ppdeff: IDirectInputEffect; punkOuter: IUnknown) : HResult; stdcall;
function EnumEffects(lpCallback: TDIEnumEffectsCallbackA;
pvRef: pointer; dwEffType: DWORD) : HResult; stdcall;
function GetEffectInfo(pdei: TDIEffectInfoA; const rguid: TGUID) : HResult; stdcall;
function GetForceFeedbackState(var pdwOut: DWORD): HResult; stdcall;
function SendForceFeedbackCommand(dwFlags: DWORD): HResult; stdcall;
function EnumCreatedEffectObjects(lpCallback:
LPDIENUMCREATEDEFFECTOBJECTSCALLBACK; pvRef: Pointer; fl: DWORD): HResult; stdcall;
function Escape(const pesc: TDIEffEscape): HResult; stdcall;
TDIEnumCreatedEffectObjectsCallback;
pvRef: pointer; fl: DWORD) : HResult; stdcall;
function Escape(var pesc: TDIEffEscape) : HResult; stdcall;
function Poll: HResult; stdcall;
function SendDeviceData(cbObjectData: DWORD; const rgdod: TDIDeviceObjectData;
function SendDeviceData
(cbObjectData: DWORD; var rgdod: TDIDeviceObjectData;
var pdwInOut: DWORD; fl: DWORD): HResult; stdcall;
end;
 
IDirectInputDevice2A = interface(IDirectInputDeviceA)
['{5944E682-C92E-11CF-BFC7-444553540000}']
// IDirectInputDevice2A methods
function CreateEffect(const rguid: TGUID; const lpeff: TDIEffect;
out ppdeff: IDirectInputEffect; punkOuter: IUnknown): HResult; stdcall;
function EnumEffects(lpCallback: TDIEnumEffectsCallbackA; pvRef: Pointer;
dwEffType: DWORD): HResult; stdcall;
function GetEffectInfo(var pdei: TDIEffectInfoA; const rguid: TGUID): HResult; stdcall;
IDirectInputDevice2W = interface (IDirectInputDeviceW)
['{5944E683-C92E-11CF-BFC7-444553540000}']
(*** IDirectInputDevice2W methods ***)
function CreateEffect(const rguid: TGUID; lpeff: PDIEffect;
var ppdeff: IDirectInputEffect; punkOuter: IUnknown) : HResult; stdcall;
function EnumEffects(lpCallback: TDIEnumEffectsCallbackW;
pvRef: pointer; dwEffType: DWORD) : HResult; stdcall;
function GetEffectInfo(pdei: TDIEffectInfoW; const rguid: TGUID) : HResult; stdcall;
function GetForceFeedbackState(var pdwOut: DWORD): HResult; stdcall;
function SendForceFeedbackCommand(dwFlags: DWORD): HResult; stdcall;
function EnumCreatedEffectObjects(lpCallback:
LPDIENUMCREATEDEFFECTOBJECTSCALLBACK; pvRef: Pointer; fl: DWORD): HResult; stdcall;
function Escape(const pesc: TDIEffEscape): HResult; stdcall;
TDIEnumCreatedEffectObjectsCallback;
pvRef: pointer; fl: DWORD) : HResult; stdcall;
function Escape(var pesc: TDIEffEscape) : HResult; stdcall;
function Poll: HResult; stdcall;
function SendDeviceData(cbObjectData: DWORD; const rgdod: TDIDeviceObjectData;
function SendDeviceData
(cbObjectData: DWORD; var rgdod: TDIDeviceObjectData;
var pdwInOut: DWORD; fl: DWORD): HResult; stdcall;
end;
 
{$IFDEF UNICODE}
IDirectInputDevice2 = IDirectInputDevice2W;
{$ELSE}
IDirectInputDevice2 = IDirectInputDevice2A;
{$ENDIF}
 
const
DIFEF_DEFAULT = $00000000;
DIFEF_INCLUDENONSTANDARD = $00000001;
DIFEF_MODIFYIFNEEDED = $00000010;
 
///Weitermachen: (as: nur die Deklarationen eingefüllt, die ich zum Testen gebraucht habe)
 
type
TEnumEffectsInFileCallback = function(gaga, huhu: Integer): HResult;
 
type
IDirectInputDevice7W = interface(IDirectInputDevice2W)
['{57D7C6BC-2356-11D3-8E9D-00C04F6844AE}']
// IDirectInputDevice7W methods
function EnumEffectsInFile(lpszFileName: LPCWSTR; pec: TDIEnumEffectsInFileCallback;
pvRef: Pointer; dwFlags: DWORD): HResult; stdcall;
function WriteEffectToFile(lpszFileName: LPCWSTR; dwEntries: DWORD;
const rgDiFileEft: TDIFileEffect; dwFlags: DWORD): HResult; stdcall;
['{57D7C6BD-2356-11D3-8E9D-00C04F6844AE}']
(*** IDirectInputDevice7A methods ***)
function EnumEffectsInFile(const lpszFileName: PChar;
pec: TEnumEffectsInFileCallback; pvRef: Pointer; dwFlags: DWord): HResult; stdcall;
function WriteEffectToFile(const lpszFileName: PChar;
dwEntries: DWord; const rgDIFileEft: PDIFileEffect; dwFlags: DWord): HResult; stdcall;
end;
 
IDirectInputDevice7A = interface(IDirectInputDevice2A)
['{57D7C6BD-2356-11D3-8E9D-00C04F6844AE}']
// IDirectInputDevice7A methods
function EnumEffectsInFile(lpszFileName: LPCSTR; pec: TDIEnumEffectsInFileCallback;
pvRef: Pointer; dwFlags: DWORD): HResult; stdcall;
function WriteEffectToFile(lpszFileName: LPCSTR; dwEntries: DWORD;
const rgDiFileEft: TDIFileEffect; dwFlags: DWORD): HResult; stdcall;
['{57D7C6BC-2356-11D3-8E9D-00C04F6844AE}']
function EnumEffectsInFile(const lpszFileName: PChar;
pec: TEnumEffectsInFileCallback; pvRef: Pointer; dwFlags: DWord): HResult; stdcall;
function WriteEffectToFile(const lpszFileName: PChar;
dwEntries: DWord; const rgDIFileEft: PDIFileEffect; dwFlags: DWord): HResult; stdcall;
end;
 
{$IFDEF UNICODE}
IDirectInputDevice7 = IDirectInputDevice7W;
{$ELSE}
IDirectInputDevice7 = IDirectInputDevice7A;
{$ENDIF}
 
{ Mouse }
(****************************************************************************
*
* Mouse
*
****************************************************************************)
 
type
TDIMouseState = record
PDIMouseState = ^TDIMouseState;
TDIMouseState = packed record
lX: Longint;
lY: Longint;
lZ: Longint;
rgbButtons: array[0..3] of BYTE;
rgbButtons: Array [0..3] of BYTE; // up to 4 buttons
end;
 
DIMOUSESTATE = TDIMouseState;
 
TDIMouseState2 = record
PDIMouseState2 = ^TDIMouseState2;
TDIMouseState2 = packed record
lX: Longint;
lY: Longint;
lZ: Longint;
rgbButtons: array[0..7] of BYTE;
rgbButtons: Array [0..7] of BYTE; // up to 8 buttons
end;
 
DIMOUSESTATE2 = TDIMouseState2;
const
DIMOFS_X = 0;
DIMOFS_Y = 4;
DIMOFS_Z = 8;
DIMOFS_BUTTON0 = 12;
DIMOFS_BUTTON1 = 13;
DIMOFS_BUTTON2 = 14;
DIMOFS_BUTTON3 = 15;
// DX7 supports up to 8 mouse buttons
DIMOFS_BUTTON4 = DIMOFS_BUTTON0+4;
DIMOFS_BUTTON5 = DIMOFS_BUTTON0+5;
DIMOFS_BUTTON6 = DIMOFS_BUTTON0+6;
DIMOFS_BUTTON7 = DIMOFS_BUTTON0+7;
 
 
const
_c_dfDIMouse_Objects: array[0..1] of TDIObjectDataFormat = (
(pguid: nil; dwOfs: 0; dwType: DIDFT_RELAXIS or DIDFT_ANYINSTANCE; dwFlags: 0),
(pguid: @GUID_Button; dwOfs: 12; dwType: DIDFT_BUTTON or DIDFT_ANYINSTANCE; dwFlags: 0)
_c_dfDIMouse_Objects: array[0..6] of TDIObjectDataFormat = (
( pguid: @GUID_XAxis;
dwOfs: DIMOFS_X;
dwType: DIDFT_AXIS or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_YAxis;
dwOfs: DIMOFS_Y;
dwType: DIDFT_AXIS or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_ZAxis;
dwOfs: DIMOFS_Z;
dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON0;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON1;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON2;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON3;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0)
);
 
c_dfDIMouse: TDIDataFormat = (
dwSize: Sizeof(c_dfDIMouse);
dwObjSize: Sizeof(TDIObjectDataFormat);
dwFlags: DIDF_RELAXIS;
dwDataSize: Sizeof(TDIMouseState);
dwNumObjs: High(_c_dfDIMouse_Objects)+1;
rgodf: @_c_dfDIMouse_Objects
dwSize: Sizeof(c_dfDIMouse); // $18
dwObjSize: Sizeof(TDIObjectDataFormat); // $10
dwFlags: DIDF_RELAXIS; //
dwDataSize: Sizeof(TDIMouseState); // $10
dwNumObjs: High(_c_dfDIMouse_Objects)+1; // 7
rgodf: @_c_dfDIMouse_Objects[Low(_c_dfDIMouse_Objects)]
);
 
{ Keyboard }
 
type
TDIKeyboardState = array[0..255] of Byte;
DIKEYBOARDSTATE = TDIKeyboardState;
 
const
_c_dfDIKeyboard_Objects: array[0..0] of TDIObjectDataFormat = (
(pguid: @GUID_Key; dwOfs: 1; dwType: DIDFT_BUTTON or DIDFT_ANYINSTANCE; dwFlags: 0)
_c_dfDIMouse2_Objects: array[0..10] of TDIObjectDataFormat = (
( pguid: @GUID_XAxis;
dwOfs: DIMOFS_X;
dwType: DIDFT_AXIS or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_YAxis;
dwOfs: DIMOFS_Y;
dwType: DIDFT_AXIS or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_ZAxis;
dwOfs: DIMOFS_Z;
dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON0;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON1;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON2;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON3;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// fields introduced with IDirectInputDevice7.GetDeviceState
( pguid: nil;
dwOfs: DIMOFS_BUTTON4;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON5;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON6;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: nil;
dwOfs: DIMOFS_BUTTON7;
dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0)
);
 
c_dfDIKeyboard: TDIDataFormat = (
dwSize: Sizeof(c_dfDIKeyboard);
dwObjSize: Sizeof(TDIObjectDataFormat);
dwFlags: 0;
dwDataSize: SizeOf(TDIKeyboardState);
dwNumObjs: High(_c_dfDIKeyboard_Objects)+1;
rgodf: @_c_dfDIKeyboard_Objects
c_dfDIMouse2: TDIDataFormat = (
dwSize: Sizeof(c_dfDIMouse); // $18
dwObjSize: Sizeof(TDIObjectDataFormat); // $10
dwFlags: DIDF_RELAXIS; //
dwDataSize: Sizeof(TDIMouseState2); // $14
dwNumObjs: High(_c_dfDIMouse_Objects)+1; // 11
rgodf: @_c_dfDIMouse2_Objects[Low(_c_dfDIMouse2_Objects)]
);
 
{ DirectInput keyboard scan codes }
 
(****************************************************************************
*
* DirectInput keyboard scan codes
*
****************************************************************************)
 
const
DIK_ESCAPE = $01;
DIK_1 = $02;
9357,9 → 13094,9
DIK_8 = $09;
DIK_9 = $0A;
DIK_0 = $0B;
DIK_MINUS = $0C; // - on main keyboard
DIK_MINUS = $0C; (* - on main keyboard *)
DIK_EQUALS = $0D;
DIK_BACK = $0E; // backspace
DIK_BACK = $0E; (* backspace *)
DIK_TAB = $0F;
DIK_Q = $10;
DIK_W = $11;
9373,7 → 13110,7
DIK_P = $19;
DIK_LBRACKET = $1A;
DIK_RBRACKET = $1B;
DIK_RETURN = $1C; // Enter on main keyboard
DIK_RETURN = $1C; (* Enter on main keyboard *)
DIK_LCONTROL = $1D;
DIK_A = $1E;
DIK_S = $1F;
9386,7 → 13123,7
DIK_L = $26;
DIK_SEMICOLON = $27;
DIK_APOSTROPHE = $28;
DIK_GRAVE = $29; // accent grave
DIK_GRAVE = $29; (* accent grave *)
DIK_LSHIFT = $2A;
DIK_BACKSLASH = $2B;
DIK_Z = $2C;
9397,11 → 13134,11
DIK_N = $31;
DIK_M = $32;
DIK_COMMA = $33;
DIK_PERIOD = $34; // . on main keyboard
DIK_SLASH = $35; // / on main keyboard
DIK_PERIOD = $34; (* . on main keyboard *)
DIK_SLASH = $35; (* / on main keyboard *)
DIK_RSHIFT = $36;
DIK_MULTIPLY = $37; // * on numeric keypad
DIK_LMENU = $38; // left Alt
DIK_MULTIPLY = $37; (* * on numeric keypad *)
DIK_LMENU = $38; (* left Alt *)
DIK_SPACE = $39;
DIK_CAPITAL = $3A;
DIK_F1 = $3B;
9415,199 → 13152,849
DIK_F9 = $43;
DIK_F10 = $44;
DIK_NUMLOCK = $45;
DIK_SCROLL = $46; // Scroll Lock
DIK_SCROLL = $46; (* Scroll Lock *)
DIK_NUMPAD7 = $47;
DIK_NUMPAD8 = $48;
DIK_NUMPAD9 = $49;
DIK_SUBTRACT = $4A; // - on numeric keypad
DIK_SUBTRACT = $4A; (* - on numeric keypad *)
DIK_NUMPAD4 = $4B;
DIK_NUMPAD5 = $4C;
DIK_NUMPAD6 = $4D;
DIK_ADD = $4E; // + on numeric keypad
DIK_ADD = $4E; (* + on numeric keypad *)
DIK_NUMPAD1 = $4F;
DIK_NUMPAD2 = $50;
DIK_NUMPAD3 = $51;
DIK_NUMPAD0 = $52;
DIK_DECIMAL = $53; // . on numeric keypad
DIK_DECIMAL = $53; (* . on numeric keypad *)
// $54 to $56 unassigned
DIK_F11 = $57;
DIK_F12 = $58;
 
DIK_F13 = $64; // (NEC PC98)
DIK_F14 = $65; // (NEC PC98)
DIK_F15 = $66; // (NEC PC98)
 
DIK_KANA = $70; // (Japanese keyboard)
DIK_CONVERT = $79; // (Japanese keyboard)
DIK_NOCONVERT = $7B; // (Japanese keyboard)
DIK_YEN = $7D; // (Japanese keyboard)
DIK_NUMPADEQUALS = $8D; // = on numeric keypad (NEC PC98)
DIK_CIRCUMFLEX = $90; // (Japanese keyboard)
DIK_AT = $91; // (NEC PC98)
DIK_COLON = $92; // (NEC PC98)
DIK_UNDERLINE = $93; // (NEC PC98)
DIK_KANJI = $94; // (Japanese keyboard)
DIK_STOP = $95; // (NEC PC98)
DIK_AX = $96; // (Japan AX)
DIK_UNLABELED = $97; // (J3100)
DIK_NUMPADENTER = $9C; // Enter on numeric keypad
// $59 to $63 unassigned
DIK_F13 = $64; (* (NEC PC98) *)
DIK_F14 = $65; (* (NEC PC98) *)
DIK_F15 = $66; (* (NEC PC98) *)
// $67 to $6F unassigned
DIK_KANA = $70; (* (Japanese keyboard) *)
DIK_CONVERT = $79; (* (Japanese keyboard) *)
DIK_NOCONVERT = $7B; (* (Japanese keyboard) *)
DIK_YEN = $7D; (* (Japanese keyboard) *)
DIK_NUMPADEQUALS = $8D; (* = on numeric keypad (NEC PC98) *)
// $8E to $8F unassigned
DIK_CIRCUMFLEX = $90; (* (Japanese keyboard) *)
DIK_AT = $91; (* (NEC PC98) *)
DIK_COLON = $92; (* (NEC PC98) *)
DIK_UNDERLINE = $93; (* (NEC PC98) *)
DIK_KANJI = $94; (* (Japanese keyboard) *)
DIK_STOP = $95; (* (NEC PC98) *)
DIK_AX = $96; (* (Japan AX) *)
DIK_UNLABELED = $97; (* (J3100) *)
// $98 to $99 unassigned
DIK_NUMPADENTER = $9C; (* Enter on numeric keypad *)
DIK_RCONTROL = $9D;
DIK_NUMPADCOMMA = $B3; // , on numeric keypad (NEC PC98)
DIK_DIVIDE = $B5; // / on numeric keypad
// $9E to $B2 unassigned
DIK_NUMPADCOMMA = $B3; (* , on numeric keypad (NEC PC98) *)
// $B4 unassigned
DIK_DIVIDE = $B5; (* / on numeric keypad *)
// $B6 unassigned
DIK_SYSRQ = $B7;
DIK_RMENU = $B8; // right Alt
DIK_HOME = $C7; // Home on arrow keypad
DIK_UP = $C8; // UpArrow on arrow keypad
DIK_PRIOR = $C9; // PgUp on arrow keypad
DIK_LEFT = $CB; // LeftArrow on arrow keypad
DIK_RIGHT = $CD; // RightArrow on arrow keypad
DIK_END = $CF; // End on arrow keypad
DIK_DOWN = $D0; // DownArrow on arrow keypad
DIK_NEXT = $D1; // PgDn on arrow keypad
DIK_INSERT = $D2; // Insert on arrow keypad
DIK_DELETE = $D3; // Delete on arrow keypad
DIK_LWIN = $DB; // Left Windows key
DIK_RWIN = $DC; // Right Windows key
DIK_APPS = $DD; // AppMenu key
DIK_RMENU = $B8; (* right Alt *)
// $B9 to $C4 unassigned
DIK_PAUSE = $C5; (* Pause (watch out - not realiable on some kbds) *)
// $C6 unassigned
DIK_HOME = $C7; (* Home on arrow keypad *)
DIK_UP = $C8; (* UpArrow on arrow keypad *)
DIK_PRIOR = $C9; (* PgUp on arrow keypad *)
// $CA unassigned
DIK_LEFT = $CB; (* LeftArrow on arrow keypad *)
DIK_RIGHT = $CD; (* RightArrow on arrow keypad *)
// $CF unassigned
DIK_END = $CF; (* End on arrow keypad *)
DIK_DOWN = $D0; (* DownArrow on arrow keypad *)
DIK_NEXT = $D1; (* PgDn on arrow keypad *)
DIK_INSERT = $D2; (* Insert on arrow keypad *)
DIK_DELETE = $D3; (* Delete on arrow keypad *)
DIK_LWIN = $DB; (* Left Windows key *)
DIK_RWIN = $DC; (* Right Windows key *)
DIK_APPS = $DD; (* AppMenu key *)
// New with DX 6.1 & Win98
DIK_POWER = $DE;
DIK_SLEEP = $DF;
// $E0 to $E2 unassigned
// $E3 = Wake up ("translated" in German DInput to "Kielwasser" (ship's wake) ;-)
 
//
// Alternate names for keys, to facilitate transition from DOS.
//
DIK_BACKSPACE = DIK_BACK; // backspace
DIK_NUMPADSTAR = DIK_MULTIPLY; // * on numeric keypad
DIK_LALT = DIK_LMENU; // left Alt
DIK_CAPSLOCK = DIK_CAPITAL; // CapsLock
DIK_NUMPADMINUS = DIK_SUBTRACT; // - on numeric keypad
DIK_NUMPADPLUS = DIK_ADD; // + on numeric keypad
DIK_NUMPADPERIOD = DIK_DECIMAL; // . on numeric keypad
DIK_NUMPADSLASH = DIK_DIVIDE; // / on numeric keypad
DIK_RALT = DIK_RMENU; // right Alt
DIK_UPARROW = DIK_UP; // UpArrow on arrow keypad
DIK_PGUP = DIK_PRIOR; // PgUp on arrow keypad
DIK_LEFTARROW = DIK_LEFT; // LeftArrow on arrow keypad
DIK_RIGHTARROW = DIK_RIGHT; // RightArrow on arrow keypad
DIK_DOWNARROW = DIK_DOWN; // DownArrow on arrow keypad
DIK_PGDN = DIK_NEXT; // PgDn on arrow keypad
(*
* Alternate names for keys, to facilitate transition from DOS.
*)
DIK_BACKSPACE = DIK_BACK ; (* backspace *)
DIK_NUMPADSTAR = DIK_MULTIPLY; (* * on numeric keypad *)
DIK_LALT = DIK_LMENU ; (* left Alt *)
DIK_CAPSLOCK = DIK_CAPITAL ; (* CapsLock *)
DIK_NUMPADMINUS = DIK_SUBTRACT; (* - on numeric keypad *)
DIK_NUMPADPLUS = DIK_ADD ; (* + on numeric keypad *)
DIK_NUMPADPERIOD = DIK_DECIMAL ; (* . on numeric keypad *)
DIK_NUMPADSLASH = DIK_DIVIDE ; (* / on numeric keypad *)
DIK_RALT = DIK_RMENU ; (* right Alt *)
DIK_UPARROW = DIK_UP ; (* UpArrow on arrow keypad *)
DIK_PGUP = DIK_PRIOR ; (* PgUp on arrow keypad *)
DIK_LEFTARROW = DIK_LEFT ; (* LeftArrow on arrow keypad *)
DIK_RIGHTARROW = DIK_RIGHT ; (* RightArrow on arrow keypad *)
DIK_DOWNARROW = DIK_DOWN ; (* DownArrow on arrow keypad *)
DIK_PGDN = DIK_NEXT ; (* PgDn on arrow keypad *)
 
{ Joystick }
(****************************************************************************
*
* Keyboard
*
****************************************************************************)
 
 
type
TDIKeyboardState = array[0..255] of Byte;
(*
const
_c_dfDIKeyboard_Objects: array[0..255] of TDIObjectDataFormat = (
( pguid: @GUID_Key;
dwOfs: DIK_ESCAPE;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// -------- top row (except function keys) on main kbd ------------
( pguid: @GUID_Key;
dwOfs: DIK_1; // "1" on main kbd, Offset 2
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_2; // "2" on main kbd, Offset 3
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_3; // "3" on main kbd, etc.
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_4;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_5;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_6;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_7;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_8;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_9;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_0; // "0", main kbd
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_MINUS; // "-" on US kbds, "ß" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_EQUALS; // "=" for US, "´" for german
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_BACK; // backspace
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// ----------- 2nd row -----------------------
( pguid: @GUID_Key;
dwOfs: DIK_TAB;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_Q;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_W;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_E;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_R;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_T;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_Y; // "Z" on german & french keyboards
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_U;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_I;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_O;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_P;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_LBRACKET; // "Ü" on german keyboards
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RBRACKET; // "+" on german keyboards
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RETURN; // Enter on main kbd
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// next row should really start with caps lock but doesn't ;-)
// (DIK_CAPITAL is Offset $3A, i.e. after 4th row)
( pguid: @GUID_Key;
dwOfs: DIK_LCONTROL; // Left Ctrl (german kbds: "Strg")
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// ----------- 3rd row ------------------------------
( pguid: @GUID_Key;
dwOfs: DIK_A;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_S;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_D;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_G;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_H;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_J;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_K;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_L;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_SEMICOLON; // "Ö" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_APOSTROPHE; // "Ä" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_GRAVE; // accent grave, "'" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// ---------------- 4th row -----------------------
( pguid: @GUID_Key;
dwOfs: DIK_LSHIFT; // left shift
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_BACKSLASH; // "<" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_Z; // "Y" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_X;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_C;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_V;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_B;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_N;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_M;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_COMMA;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_PERIOD; // on main kbd
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_SLASH; // "-" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RSHIFT;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// --- misc keys (bye, bye, order) ----------------
( pguid: @GUID_Key;
dwOfs: DIK_MULTIPLY; // on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_LMENU; // left ALT
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_SPACE; // space bar
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_CAPITAL; // caps lock (on main kbd, above LSHIFT)
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// ---------- function keys -----------
( pguid: @GUID_Key;
dwOfs: DIK_F1;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F2;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F3;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F4;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F5;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F6;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F7;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F8;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F9;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F10;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// ------- F11, F12 after numeric keypad (for "historical reasons" -- XT kbd)
 
// --------- numeric keypad (mostly, that is) -----------
( pguid: @GUID_Key;
dwOfs: DIK_NUMLOCK; // numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_SCROLL; // scroll lock
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD7;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD8;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD9;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_SUBTRACT; // "-" on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD4;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD5;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD6;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_ADD; // "+" on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD1;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD2;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD3;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NUMPAD0; // "0" or "Insert" on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_DECIMAL; // "." or "Del" on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: $54;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// "extended" function keys; F13 to F15 only on NEC PC98
( pguid: @GUID_Key;
dwOfs: DIK_F11;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_F12;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// -------------------------------------------------
// a whole lot of keys for asian kbds only
// -------------------------------------------------
( pguid: @GUID_Key;
dwOfs: DIK_NUMPADENTER; // Enter on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RCONTROL; // right Ctrl on main kbd
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key; // "," on numeric keypad (NEC PC98 only)
dwOfs: DIK_NUMPADCOMMA;
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_DIVIDE; // "/" on numeric keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_SYSRQ; // "System request", "Druck/S-Abf" on german kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RMENU; // right ALT
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_PAUSE; // "Pause" - not reliable on some kbds
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
 
// ----------- arrow keypad -----------------
( pguid: @GUID_Key;
dwOfs: DIK_HOME; // Home on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_UP; // UpArrow on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_PRIOR; // PgUp on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_LEFT; // LeftArrow on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RIGHT; // RightArrow on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_END; // End on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_DOWN; // DownArrow on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_NEXT; // PgDn on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_INSERT; // Insert on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_DELETE; // Delete on arrow keypad
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_LWIN; // Left Windows key
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_RWIN; // Right Windows key
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: DIK_APPS; // AppMenu key
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
// -------- added with Win 98 / DirectX 6.1 ------------
( pguid: @GUID_Key;
dwOfs: 222; // Power on key
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: 223; // Sleep key
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0),
( pguid: @GUID_Key;
dwOfs: 227; // Wake (up) key. The german "translation"
// reads "Kielwasser" (ship's wake) ;-)
dwType: DIDFT_BUTTON or DIDFT_NOCOLLECTION;
dwFlags: 0)
);
*)
 
var // set by initialization - I was simply too lazy
_c_dfDIKeyboard_Objects: array[0..255] of TDIObjectDataFormat;
const
c_dfDIKeyboard: TDIDataFormat = (
dwSize: Sizeof(c_dfDIKeyboard);
dwObjSize: Sizeof(TDIObjectDataFormat);
dwFlags: DIDF_RELAXIS;
dwDataSize: Sizeof(TDIKeyboardState);
dwNumObjs: High(_c_dfDIKeyboard_Objects)+1;
rgodf: @_c_dfDIKeyboard_Objects[Low(_c_dfDIKeyboard_Objects)]
);
 
(****************************************************************************
*
* Joystick
*
****************************************************************************)
 
 
type
PDIJoyState = ^TDIJoyState;
TDIJoyState = record
lX: Longint; // x-axis position
lY: Longint; // y-axis position
lZ: Longint; // z-axis position
lRx: Longint; // x-axis rotation
lRy: Longint; // y-axis rotation
lRz: Longint; // z-axis rotation
rglSlider: array[0..1] of Longint; // extra axes positions
rgdwPOV: array[0..3] of DWORD; // POV directions
rgbButtons: array[0..31] of BYTE; // 32 buttons
TDIJoyState = packed record
lX: Longint; (* x-axis position *)
lY: Longint; (* y-axis position *)
lZ: Longint; (* z-axis position *)
lRx: Longint; (* x-axis rotation *)
lRy: Longint; (* y-axis rotation *)
lRz: Longint; (* z-axis rotation *)
rglSlider: Array [0..1] of Longint; (* extra axes positions *)
rgdwPOV: Array [0..3] of DWORD; (* POV directions *)
rgbButtons: Array [0..31] of BYTE; (* 32 buttons *)
end;
 
DIJOYSTATE = TDIJoyState;
 
PDIJOYSTATE2 = ^TDIJoyState2;
TDIJoyState2 = record
lX: Longint; // x-axis position
lY: Longint; // y-axis position
lZ: Longint; // z-axis position
lRx: Longint; // x-axis rotation
lRy: Longint; // y-axis rotation
lRz: Longint; // z-axis rotation
rglSlider: array[0..1] of Longint; // extra axes positions
rgdwPOV: array[0..3] of DWORD; // POV directions
rgbButtons: array[0..127] of BYTE; // 128 buttons
lVX: Longint; // x-axis velocity
lVY: Longint; // y-axis velocity
lVZ: Longint; // z-axis velocity
lVRx: Longint; // x-axis angular velocity
lVRy: Longint; // y-axis angular velocity
lVRz: Longint; // z-axis angular velocity
rglVSlider: array[0..1] of Longint; // extra axes velocities
lAX: Longint; // x-axis acceleration
lAY: Longint; // y-axis acceleration
lAZ: Longint; // z-axis acceleration
lARx: Longint; // x-axis angular acceleration
lARy: Longint; // y-axis angular acceleration
lARz: Longint; // z-axis angular acceleration
rglASlider: array[0..1] of Longint; // extra axes accelerations
lFX: Longint; // x-axis force
lFY: Longint; // y-axis force
lFZ: Longint; // z-axis force
lFRx: Longint; // x-axis torque
lFRy: Longint; // y-axis torque
lFRz: Longint; // z-axis torque
rglFSlider: array[0..1] of Longint; // extra axes forces
PDIJoyState2 = ^TDIJoyState2;
TDIJoyState2 = packed record
lX: Longint; (* x-axis position *)
lY: Longint; (* y-axis position *)
lZ: Longint; (* z-axis position *)
lRx: Longint; (* x-axis rotation *)
lRy: Longint; (* y-axis rotation *)
lRz: Longint; (* z-axis rotation *)
rglSlider: Array [0..1] of Longint; (* extra axes positions *)
rgdwPOV: Array [0..3] of DWORD; (* POV directions *)
rgbButtons: Array [0..127] of BYTE; (* 128 buttons *)
lVX: Longint; (* x-axis velocity *)
lVY: Longint; (* y-axis velocity *)
lVZ: Longint; (* z-axis velocity *)
lVRx: Longint; (* x-axis angular velocity *)
lVRy: Longint; (* y-axis angular velocity *)
lVRz: Longint; (* z-axis angular velocity *)
rglVSlider: Array [0..1] of Longint; (* extra axes velocities *)
lAX: Longint; (* x-axis acceleration *)
lAY: Longint; (* y-axis acceleration *)
lAZ: Longint; (* z-axis acceleration *)
lARx: Longint; (* x-axis angular acceleration *)
lARy: Longint; (* y-axis angular acceleration *)
lARz: Longint; (* z-axis angular acceleration *)
rglASlider: Array [0..1] of Longint; (* extra axes accelerations *)
lFX: Longint; (* x-axis force *)
lFY: Longint; (* y-axis force *)
lFZ: Longint; (* z-axis force *)
lFRx: Longint; (* x-axis torque *)
lFRy: Longint; (* y-axis torque *)
lFRz: Longint; (* z-axis torque *)
rglFSlider: Array [0..1] of Longint; (* extra axes forces *)
end;
 
DIJOYSTATE2 = TDIJoyState2;
 
{const
_c_dfDIJoystick_Objects: array[0..1] of TDIObjectDataFormat = (
function DIJOFS_SLIDER(n: variant) : variant;
 
function DIJOFS_POV(n: variant) : variant;
 
function DIJOFS_BUTTON(n: variant) : variant;
const
DIJOFS_BUTTON_ = 48;
 
const
DIJOFS_BUTTON0 = DIJOFS_BUTTON_ + 0;
DIJOFS_BUTTON1 = DIJOFS_BUTTON_ + 1;
DIJOFS_BUTTON2 = DIJOFS_BUTTON_ + 2;
DIJOFS_BUTTON3 = DIJOFS_BUTTON_ + 3;
DIJOFS_BUTTON4 = DIJOFS_BUTTON_ + 4;
DIJOFS_BUTTON5 = DIJOFS_BUTTON_ + 5;
DIJOFS_BUTTON6 = DIJOFS_BUTTON_ + 6;
DIJOFS_BUTTON7 = DIJOFS_BUTTON_ + 7;
DIJOFS_BUTTON8 = DIJOFS_BUTTON_ + 8;
DIJOFS_BUTTON9 = DIJOFS_BUTTON_ + 9;
DIJOFS_BUTTON10 = DIJOFS_BUTTON_ + 10;
DIJOFS_BUTTON11 = DIJOFS_BUTTON_ + 11;
DIJOFS_BUTTON12 = DIJOFS_BUTTON_ + 12;
DIJOFS_BUTTON13 = DIJOFS_BUTTON_ + 13;
DIJOFS_BUTTON14 = DIJOFS_BUTTON_ + 14;
DIJOFS_BUTTON15 = DIJOFS_BUTTON_ + 15;
DIJOFS_BUTTON16 = DIJOFS_BUTTON_ + 16;
DIJOFS_BUTTON17 = DIJOFS_BUTTON_ + 17;
DIJOFS_BUTTON18 = DIJOFS_BUTTON_ + 18;
DIJOFS_BUTTON19 = DIJOFS_BUTTON_ + 19;
DIJOFS_BUTTON20 = DIJOFS_BUTTON_ + 20;
DIJOFS_BUTTON21 = DIJOFS_BUTTON_ + 21;
DIJOFS_BUTTON22 = DIJOFS_BUTTON_ + 22;
DIJOFS_BUTTON23 = DIJOFS_BUTTON_ + 23;
DIJOFS_BUTTON24 = DIJOFS_BUTTON_ + 24;
DIJOFS_BUTTON25 = DIJOFS_BUTTON_ + 25;
DIJOFS_BUTTON26 = DIJOFS_BUTTON_ + 26;
DIJOFS_BUTTON27 = DIJOFS_BUTTON_ + 27;
DIJOFS_BUTTON28 = DIJOFS_BUTTON_ + 28;
DIJOFS_BUTTON29 = DIJOFS_BUTTON_ + 29;
DIJOFS_BUTTON30 = DIJOFS_BUTTON_ + 30;
DIJOFS_BUTTON31 = DIJOFS_BUTTON_ + 31;
 
 
const
DIJOFS_X =0;
DIJOFS_Y =4;
DIJOFS_Z =8;
DIJOFS_RX =12;
DIJOFS_RY =16;
DIJOFS_RZ =20;
 
_c_dfDIJoystick_Objects: array[0..43] of TDIObjectDataFormat = (
( pguid: @GUID_XAxis;
dwOfs: DIJOFS_X; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
( pguid: @GUID_YAxis;
dwOfs: DIJOFS_Y; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
( pguid: @GUID_ZAxis;
dwOfs: DIJOFS_Z; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
( pguid: @GUID_RxAxis;
dwOfs: DIJOFS_RX; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
( pguid: @GUID_RyAxis;
dwOfs: DIJOFS_RY; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
( pguid: @GUID_RzAxis;
dwOfs: DIJOFS_RZ; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
 
( pguid: @GUID_Slider; // 2 Sliders
dwOfs: 24; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
( pguid: @GUID_Slider;
dwOfs: 28; dwType: $80000000 or DIDFT_AXIS or DIDFT_NOCOLLECTION; dwFlags: $100),
 
( pguid: @GUID_POV; // 4 POVs (yes, really)
dwOfs: 32; dwType: $80000000 or DIDFT_POV or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: @GUID_POV;
dwOfs: 36; dwType: $80000000 or DIDFT_POV or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: @GUID_POV;
dwOfs: 40; dwType: $80000000 or DIDFT_POV or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: @GUID_POV;
dwOfs: 44; dwType: $80000000 or DIDFT_POV or DIDFT_NOCOLLECTION; dwFlags: 0),
 
( pguid: nil; // Buttons
dwOfs: DIJOFS_BUTTON0; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: 0;
dwType: DIDFT_AXIS or DIDFT_ANYINSTANCE;
dwFlags: 0),
dwOfs: DIJOFS_BUTTON1; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: 48;
dwType: DIDFT_BUTTON or DIDFT_ANYINSTANCE;
dwFlags: 0)
dwOfs: DIJOFS_BUTTON2; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON3; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON4; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON5; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON6; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON7; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON8; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON9; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON10; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON11; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON12; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON13; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON14; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON15; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON16; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON17; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON18; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON19; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON20; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON21; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON22; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON23; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON24; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON25; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON26; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON27; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON28; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON29; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON30; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0),
( pguid: nil;
dwOfs: DIJOFS_BUTTON31; dwType: $80000000 or DIDFT_BUTTON or DIDFT_NOCOLLECTION; dwFlags: 0)
);
 
c_dfDIJoystick: TDIDataFormat = (
dwSize: Sizeof(c_dfDIJoystick);
dwObjSize: Sizeof(TDIObjectDataFormat);
dwObjSize: Sizeof(TDIObjectDataFormat); // $10
dwFlags: DIDF_ABSAXIS;
dwDataSize: SizeOf(DIJOYSTATE);
dwNumObjs: High(_c_dfDIJoystick_Objects)+1;
rgodf: @_c_dfDIJoystick_Objects);
dwDataSize: SizeOf(TDIJoyState); // $10
dwNumObjs: High(_c_dfDIJoystick_Objects)+1; // $2C
rgodf: @_c_dfDIJoystick_Objects[Low(_c_dfDIJoystick_Objects)]
);
 
var // Set by initialization part -- didn't want to type in another 656 consts...
_c_dfDIJoystick2_Objects: array[0..$A3] of TDIObjectDataFormat;
{ Elements $00..$2B: exact copy of _c_dfDIJoystick
Elements $2C..$8B: more "buttons" with nil GUIDs
remaining elements ($8B..$A2):
$8C,$8D,$8E: X axis, Y axis, Z axis with dwFlags = $0200
$8F,$90,$91: rX axis, rY axis, rZ axis with dwFlags = $0200
$92, $93: Slider with dwFlags = $0200
--------
$94,$95,$96: X axis, Y axis, Z axis with dwFlags = $0300
$97,$98,$99: rX axis, rY axis, rZ axis with dwFlags = $0300
$9A,$9B: Slider with dwFlags = $0300
--------
$9C,$9D,$9E: X axis, Y axis, Z axis with dwFlags = $0400
$9F, $A0, $A1: rX axis, rY axis, rZ axis with dwFlags = $0400
$A2, $A3: Slider with dwFlags = $0400
}
const
DIJOFS_X = 0;
DIJOFS_Y = 4;
DIJOFS_Z = 8;
DIJOFS_RX = 12;
DIJOFS_RY = 16;
DIJOFS_RZ = 20;
DIJOFS_SLIDER = 24;
DIJOFS_POV = 32;
DIJOFS_BUTTON = 48;
c_dfDIJoystick2: TDIDataFormat = (
dwSize: Sizeof(c_dfDIJoystick2);
dwObjSize: Sizeof(TDIObjectDataFormat);
dwFlags: DIDF_ABSAXIS;
dwDataSize: SizeOf(TDIJoyState2); // $110
dwNumObjs: High(_c_dfDIJoystick2_Objects)+1;
rgodf: @_c_dfDIJoystick2_Objects[Low(_c_dfDIJoystick2_Objects)]
);
 
{ IDirectInput }
(****************************************************************************
*
* IDirectInput
*
****************************************************************************)
 
const
 
DIENUM_STOP = 0;
DIENUM_CONTINUE = 1;
 
type
// as with the other enum functions: must rtn DIENUM_STOP or DIENUM_CONTINUE
TDIEnumDevicesCallbackA = function (var lpddi: TDIDeviceInstanceA;
pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumDevicesCallbackW = function (var lpddi: TDIDeviceInstanceW;
pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumDevicesCallback = function (var lpddi: TDIDeviceInstance;
pvRef: Pointer): Integer; stdcall; // BOOL; stdcall;
TDIEnumDevicesProc = TDIEnumDevicesCallback;
 
TDIEnumDevicesCallbackA = function(const lpddi: TDIDeviceInstanceA;
pvRef: Pointer): HResult; stdcall;
LPDIENUMDEVICESCALLBACKA = TDIEnumDevicesCallbackA;
 
TDIEnumDevicesCallbackW = function(const lpddi: TDIDeviceInstanceW;
pvRef: Pointer): HResult; stdcall;
LPDIENUMDEVICESCALLBACKW = TDIEnumDevicesCallbackW;
 
TDIEnumDevicesCallback = TDIEnumDevicesCallbackA;
LPDIENUMDEVICESCALLBACK = TDIEnumDevicesCallback;
 
const
DIEDFL_ALLDEVICES = $00000000;
DIEDFL_ATTACHEDONLY = $00000001;
DIEDFL_FORCEFEEDBACK = $00000100;
DIEDFL_INCLUDEALIASES = $00010000;
DIEDFL_INCLUDEPHANTOMS = $00020000;
 
type
 
IDirectInputW = interface(IUnknown)
['{89521361-AA8A-11CF-BFC7-444553540000}']
// IDirectInputW methods
function CreateDevice(const rguid: TGUID;
out lplpDirectInputDevice: IDirectInputDeviceW; pUnkOuter: IUnknown): HResult; stdcall;
(*** IDirectInputW methods ***)
function CreateDevice(const rguid: TGUID; var lplpDirectInputDevice:
IDirectInputDeviceW; pUnkOuter: IUnknown) : HResult; stdcall;
function EnumDevices(dwDevType: DWORD; lpCallback: TDIEnumDevicesCallbackW;
pvRef: Pointer; dwFlags: DWORD): HResult; stdcall;
function GetDeviceStatus(var rguidInstance: TGUID): HResult; stdcall;
function GetDeviceStatus(const rguidInstance: TGUID) : HResult; stdcall;
function RunControlPanel(hwndOwner: HWND; dwFlags: DWORD): HResult; stdcall;
function Initialize(hinst: THandle; dwVersion: DWORD): HResult; stdcall;
end;
9614,9 → 14001,9
 
IDirectInputA = interface(IUnknown)
['{89521360-AA8A-11CF-BFC7-444553540000}']
// IDirectInputA methods
function CreateDevice(const rguid: TGUID;
out lplpDirectInputDevice: IDirectInputDeviceA; pUnkOuter: IUnknown): HResult; stdcall;
(*** IDirectInputA methods ***)
function CreateDevice(const rguid: TGUID; var lplpDirectInputDevice:
IDirectInputDeviceA; pUnkOuter: IUnknown) : HResult; stdcall;
function EnumDevices(dwDevType: DWORD; lpCallback: TDIEnumDevicesCallbackA;
pvRef: Pointer; dwFlags: DWORD): HResult; stdcall;
function GetDeviceStatus(const rguidInstance: TGUID): HResult; stdcall;
9624,158 → 14011,570
function Initialize(hinst: THandle; dwVersion: DWORD): HResult; stdcall;
end;
 
{$IFDEF UNICODE}
IDirectInput = IDirectInputW;
{$ELSE}
IDirectInput = IDirectInputA;
{$ENDIF}
 
 
IDirectInput2W = interface(IDirectInputW)
['{5944E663-AA8A-11CF-BFC7-444553540000}']
// IDirectInput2W methods
function FindDevice(Arg1: PGUID; Arg2: PWideChar; Arg3: PGUID): HResult; stdcall;
(*** IDirectInput2W methods ***)
function FindDevice(const rguidClass: TGUID; ptszName: PWideChar; out pguidInstance: TGUID): HResult; stdcall;
end;
 
IDirectInput2A = interface(IDirectInputA)
['{5944E662-AA8A-11CF-BFC7-444553540000}']
// IDirectInput2A methods
function FindDevice(Arg1: PGUID; Arg2: PAnsiChar; Arg3: PGUID): HResult; stdcall;
(*** IDirectInput2A methods ***)
function FindDevice(const rguidClass: TGUID; ptszName: PAnsiChar; out pguidInstance: TGUID): HResult; stdcall;
end;
 
{$IFDEF UNICODE}
IDirectInput2 = IDirectInput2W;
{$ELSE}
IDirectInput2 = IDirectInput2A;
{$ENDIF}
 
 
type
IDirectInput7W = interface(IDirectInput2W)
['{9A4CB685-236D-11D3-8E9D-00C04F6844AE}']
// IDirectInput7W methods
function CreateDeviceEx(const rguid: TGUID; const riid: TGUID;
out pvOut; pUnkOuter: IUnknown): HResult; stdcall;
{*** IDirectInput7W methods ***}
function CreateDeviceEx(const rguid, riid: TGUID; out lplpDirectInputDevice;
pUnkOuter: IUnknown) : HResult; stdcall;
end;
 
IDirectInput7A = interface(IDirectInput2A)
['{9A4CB684-236D-11D3-8E9D-00C04F6844AE}']
// IDirectInput7A methods
function CreateDeviceEx(const rguid: TGUID; const riid: TGUID;
out pvOut; pUnkOuter: IUnknown): HResult; stdcall;
{*** IDirectInput7A methods ***}
function CreateDeviceEx(const rguid, riid: TGUID; out lplpDirectInputDevice;
pUnkOuter: IUnknown) : HResult; stdcall;
end;
 
{$IFDEF UNICODE}
IDirectInput7 = IDirectInput7W;
{$ELSE}
IDirectInput7 = IDirectInput7A;
{$ENDIF}
 
{ Return Codes }
 
var
DirectInputCreateA : function (hinst: THandle; dwVersion: DWORD;
out ppDI: IDirectInputA;
punkOuter: IUnknown) : HResult; stdcall;
DirectInputCreateW : function (hinst: THandle; dwVersion: DWORD;
out ppDI: IDirectInputW;
punkOuter: IUnknown) : HResult; stdcall;
DirectInputCreate : function (hinst: THandle; dwVersion: DWORD;
out ppDI: IDirectInput;
punkOuter: IUnknown) : HResult; stdcall;
 
DirectInputCreateEx : function (
hinst: THandle;
dwVersion: DWORD;
const riidltf: TGUID;
out ppvOut;
punkOuter: IUnknown) : HResult; stdcall;
 
(****************************************************************************
*
* Interfaces
*
****************************************************************************)
type
IID_IDirectInputW = IDirectInputW;
IID_IDirectInputA = IDirectInputA;
IID_IDirectInput = IDirectInput;
 
IID_IDirectInput2W = IDirectInput2W;
IID_IDirectInput2A = IDirectInput2A;
IID_IDirectInput2 = IDirectInput2;
 
IID_IDirectInput7W = IDirectInput7W;
IID_IDirectInput7A = IDirectInput7A;
IID_IDirectInput7 = IDirectInput7;
 
IID_IDirectInputDeviceW = IDirectInputDeviceW;
IID_IDirectInputDeviceA = IDirectInputDeviceA;
IID_IDirectInputDevice = IDirectInputDevice;
 
IID_IDirectInputDevice2W = IDirectInputDevice2W;
IID_IDirectInputDevice2A = IDirectInputDevice2A;
IID_IDirectInputDevice2 = IDirectInputDevice2;
 
IID_IDirectInputEffect = IDirectInputEffect;
 
IID_IDirectInputDevice7W = IDirectInputDevice7W;
IID_IDirectInputDevice7A = IDirectInputDevice7A;
IID_IDirectInputDevice7 = IDirectInputDevice7;
 
(****************************************************************************
*
* Return Codes
*
****************************************************************************)
 
(*
* The operation completed successfully.
*)
const
DI_OK = HResult(S_OK);
DI_NOTATTACHED = HResult(S_FALSE);
DI_BUFFEROVERFLOW = HResult(S_FALSE);
DI_PROPNOEFFECT = HResult(S_FALSE);
DI_NOEFFECT = HResult(S_FALSE);
DI_POLLEDDEVICE = HResult($00000002);
DI_DOWNLOADSKIPPED = HResult($00000003);
DI_EFFECTRESTARTED = HResult($00000004);
DI_TRUNCATED = HResult($00000008);
DI_TRUNCATEDANDRESTARTED = HResult($0000000C);
DI_OK = S_OK;
 
DIERR_OLDDIRECTINPUTVERSION = HResult($8007047E);
DIERR_BETADIRECTINPUTVERSION = HResult($80070481);
DIERR_BADDRIVERVER = HResult($80070077);
DIERR_DEVICENOTREG = HResult(REGDB_E_CLASSNOTREG);
DIERR_NOTFOUND = HResult($80070002);
DIERR_OBJECTNOTFOUND = HResult($80070002);
DIERR_INVALIDPARAM = HResult(E_INVALIDARG);
DIERR_NOINTERFACE = HResult(E_NOINTERFACE);
DIERR_GENERIC = HResult(E_FAIL);
DIERR_OUTOFMEMORY = HResult(E_OUTOFMEMORY);
DIERR_UNSUPPORTED = HResult(E_NOTIMPL);
DIERR_NOTINITIALIZED = HResult($80070015);
DIERR_ALREADYINITIALIZED = HResult($800704DF);
DIERR_NOAGGREGATION = HResult(CLASS_E_NOAGGREGATION);
DIERR_OTHERAPPHASPRIO = HResult(E_ACCESSDENIED);
DIERR_INPUTLOST = HResult($8007001E);
DIERR_ACQUIRED = HResult($800700AA);
DIERR_NOTACQUIRED = HResult($8007000C);
DIERR_READONLY = HResult(E_ACCESSDENIED);
DIERR_HANDLEEXISTS = HResult(E_ACCESSDENIED);
DIERR_PENDING = HResult($80070007);
(*
* The device exists but is not currently attached.
*)
DI_NOTATTACHED = S_FALSE;
 
(*
* The device buffer overflowed. Some input was lost.
*)
DI_BUFFEROVERFLOW = S_FALSE;
 
(*
* The change in device properties had no effect.
*)
DI_PROPNOEFFECT = S_FALSE;
 
(*
* The operation had no effect.
*)
DI_NOEFFECT = S_FALSE;
 
(*
* The device is a polled device. As a result, device buffering
* will not collect any data and event notifications will not be
* signalled until GetDeviceState is called.
*)
DI_POLLEDDEVICE = $00000002;
 
(*
* The parameters of the effect were successfully updated by
* IDirectInputEffect::SetParameters, but the effect was not
* downloaded because the device is not exclusively acquired
* or because the DIEP_NODOWNLOAD flag was passed.
*)
DI_DOWNLOADSKIPPED = $00000003;
 
(*
* The parameters of the effect were successfully updated by
* IDirectInputEffect::SetParameters, but in order to change
* the parameters, the effect needed to be restarted.
*)
DI_EFFECTRESTARTED = $00000004;
 
(*
* The parameters of the effect were successfully updated by
* IDirectInputEffect::SetParameters, but some of them were
* beyond the capabilities of the device and were truncated.
*)
DI_TRUNCATED = $00000008;
 
(*
* Equal to DI_EFFECTRESTARTED | DI_TRUNCATED.
*)
DI_TRUNCATEDANDRESTARTED = $0000000C;
 
SEVERITY_ERROR_FACILITY_WIN32 =
HResult(SEVERITY_ERROR shl 31) or HResult(FACILITY_WIN32 shl 16);
 
(*
* The application requires a newer version of DirectInput.
*)
 
DIERR_OLDDIRECTINPUTVERSION = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_OLD_WIN_VERSION;
 
(*
* The application was written for an unsupported prerelease version
* of DirectInput.
*)
DIERR_BETADIRECTINPUTVERSION = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_RMODE_APP;
 
(*
* The object could not be created due to an incompatible driver version
* or mismatched or incomplete driver components.
*)
DIERR_BADDRIVERVER = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_BAD_DRIVER_LEVEL;
 
(*
* The device or device instance or effect is not registered with DirectInput.
*)
DIERR_DEVICENOTREG = REGDB_E_CLASSNOTREG;
 
(*
* The requested object does not exist.
*)
DIERR_NOTFOUND = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_FILE_NOT_FOUND;
 
(*
* The requested object does not exist.
*)
DIERR_OBJECTNOTFOUND = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_FILE_NOT_FOUND;
 
(*
* An invalid parameter was passed to the returning function,
* or the object was not in a state that admitted the function
* to be called.
*)
DIERR_INVALIDPARAM = E_INVALIDARG;
 
(*
* The specified interface is not supported by the object
*)
DIERR_NOINTERFACE = E_NOINTERFACE;
 
(*
* An undetermined error occured inside the DInput subsystem
*)
DIERR_GENERIC = E_FAIL;
 
(*
* The DInput subsystem couldn't allocate sufficient memory to complete the
* caller's request.
*)
DIERR_OUTOFMEMORY = E_OUTOFMEMORY;
 
(*
* The function called is not supported at this time
*)
DIERR_UNSUPPORTED = E_NOTIMPL;
 
(*
* This object has not been initialized
*)
DIERR_NOTINITIALIZED = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_NOT_READY;
 
(*
* This object is already initialized
*)
DIERR_ALREADYINITIALIZED = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_ALREADY_INITIALIZED;
 
(*
* This object does not support aggregation
*)
DIERR_NOAGGREGATION = CLASS_E_NOAGGREGATION;
 
(*
* Another app has a higher priority level, preventing this call from
* succeeding.
*)
DIERR_OTHERAPPHASPRIO = E_ACCESSDENIED;
 
(*
* Access to the device has been lost. It must be re-acquired.
*)
DIERR_INPUTLOST = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_READ_FAULT;
 
(*
* The operation cannot be performed while the device is acquired.
*)
DIERR_ACQUIRED = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_BUSY;
 
(*
* The operation cannot be performed unless the device is acquired.
*)
DIERR_NOTACQUIRED = SEVERITY_ERROR_FACILITY_WIN32
or ERROR_INVALID_ACCESS;
 
(*
* The specified property cannot be changed.
*)
DIERR_READONLY = E_ACCESSDENIED;
 
(*
* The device already has an event notification associated with it.
*)
DIERR_HANDLEEXISTS = E_ACCESSDENIED;
 
(*
* Data is not yet available.
*)
E_PENDING = HResult($80070007);
 
(*
* Unable to IDirectInputJoyConfig_Acquire because the user
* does not have sufficient privileges to change the joystick
* configuration.
*)
DIERR_INSUFFICIENTPRIVS = HResult($80040200);
DIERR_DEVICEFULL = HResult($80040201);
DIERR_MOREDATA = HResult($80040202);
DIERR_NOTDOWNLOADED = HResult($80040203);
DIERR_HASEFFECTS = HResult($80040204);
DIERR_NOTEXCLUSIVEACQUIRED = HResult($80040205);
DIERR_INCOMPLETEEFFECT = HResult($80040206);
DIERR_NOTBUFFERED = HResult($80040207);
DIERR_EFFECTPLAYING = HResult($80040208);
DIERR_UNPLUGGED = HResult($80040209);
DIERR_REPORTFULL = HResult($8004020A);
 
(*
* The device is full.
*)
DIERR_DEVICEFULL = DIERR_INSUFFICIENTPRIVS + 1;
 
{ Definitions for non-IDirectInput (VJoyD) features defined more recently
than the current sdk files }
(*
* Not all the requested information fit into the buffer.
*)
DIERR_MOREDATA = DIERR_INSUFFICIENTPRIVS + 2;
 
(*
* The effect is not downloaded.
*)
DIERR_NOTDOWNLOADED = DIERR_INSUFFICIENTPRIVS + 3;
 
(*
* The device cannot be reinitialized because there are still effects
* attached to it.
*)
DIERR_HASEFFECTS = DIERR_INSUFFICIENTPRIVS + 4;
 
(*
* The operation cannot be performed unless the device is acquired
* in DISCL_EXCLUSIVE mode.
*)
DIERR_NOTEXCLUSIVEACQUIRED = DIERR_INSUFFICIENTPRIVS + 5;
 
(*
* The effect could not be downloaded because essential information
* is missing. For example, no axes have been associated with the
* effect, or no type-specific information has been created.
*)
DIERR_INCOMPLETEEFFECT = DIERR_INSUFFICIENTPRIVS + 6;
 
(*
* Attempted to read buffered device data from a device that is
* not buffered.
*)
DIERR_NOTBUFFERED = DIERR_INSUFFICIENTPRIVS + 7;
 
(*
* An attempt was made to modify parameters of an effect while it is
* playing. Not all hardware devices support altering the parameters
* of an effect while it is playing.
*)
DIERR_EFFECTPLAYING = DIERR_INSUFFICIENTPRIVS + 8;
 
(*
* The operation could not be completed because the device is not
* plugged in.
*)
DIERR_UNPLUGGED = $80040209;
 
(*
* SendDeviceData failed because more information was requested
* to be sent than can be sent to the device. Some devices have
* restrictions on how much data can be sent to them. (For example,
* there might be a limit on the number of buttons that can be
* pressed at once.)
*)
DIERR_REPORTFULL = $8004020A;
 
 
(****************************************************************************
*
* Definitions for non-IDirectInput (VJoyD) features defined more recently
* than the current sdk files
*
****************************************************************************)
 
(*
* Flag to indicate that the dwReserved2 field of the JOYINFOEX structure
* contains mini-driver specific data to be passed by VJoyD to the mini-
* driver instead of doing a poll.
*)
JOY_PASSDRIVERDATA = $10000000;
 
(*
* Informs the joystick driver that the configuration has been changed
* and should be reloaded from the registery.
* dwFlags is reserved and should be set to zero
*)
 
function joyConfigChanged(dwFlags: DWORD) : MMRESULT; stdcall;
 
const
(*
* Hardware Setting indicating that the device is a headtracker
*)
JOY_HWS_ISHEADTRACKER = $02000000;
 
(*
* Hardware Setting indicating that the VxD is used to replace
* the standard analog polling
*)
JOY_HWS_ISGAMEPORTDRIVER = $04000000;
 
(*
* Hardware Setting indicating that the driver needs a standard
* gameport in order to communicate with the device.
*)
JOY_HWS_ISANALOGPORTDRIVER = $08000000;
 
(*
* Hardware Setting indicating that VJoyD should not load this
* driver, it will be loaded externally and will register with
* VJoyD of it's own accord.
*)
JOY_HWS_AUTOLOAD = $10000000;
 
(*
* Hardware Setting indicating that the driver acquires any
* resources needed without needing a devnode through VJoyD.
*)
JOY_HWS_NODEVNODE = $20000000;
 
(*
* Hardware Setting indicating that the device is a gameport bus
*)
JOY_HWS_ISGAMEPORTBUS = $80000000;
JOY_HWS_GAMEPORTBUSBUSY = $00000001;
 
//from older Verion:
(*
* Hardware Setting indicating that the VxD can be used as
* a port 201h emulator.
*)
JOY_HWS_ISGAMEPORTEMULATOR = $40000000;
 
 
(*
* Usage Setting indicating that the settings are volatile and
* should be removed if still present on a reboot.
*)
JOY_US_VOLATILE = $00000008;
 
{ Definitions for non-IDirectInput (VJoyD) features defined more recently
than the current ddk files }
(****************************************************************************
*
* Definitions for non-IDirectInput (VJoyD) features defined more recently
* than the current ddk files
*
****************************************************************************)
 
(*
* Poll type in which the do_other field of the JOYOEMPOLLDATA
* structure contains mini-driver specific data passed from an app.
*)
JOY_OEMPOLL_PASSDRIVERDATA = 7;
 
function DirectInputCreate(hinst: THandle; dwVersion: DWORD;
out ppDI: IDirectInputA; punkOuter: IUnknown): HResult; stdcall;
function DirectInputCreateEx(hinst: THandle; dwVersion: DWORD;
const riidltf: TGUID; out ppDI: IDirectInputA; punkOuter: IUnknown): HResult; stdcall;
//DirectPlay file
 
(*==========================================================================;
*
* Copyright (C) Microsoft Corporation. All Rights Reserved.
*
* File: dplay.h dplobby.h
* Content: DirectPlay include files
*
* DirectX 7 Delphi adaptation by Erik Unger
*
* Modified: 4-Jun-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
***************************************************************************)
 
var
DPlayDLL : HMODULE = 0;
 
(*==========================================================================;
*
* Copyright (C) 1994-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dplay.h
* Content: DirectPlay include file
*
***************************************************************************)
 
function DPErrorString(Value: HResult) : string;
 
const
{ GUIDS used by DirectPlay objects }
// {D1EB6D20-8923-11d0-9D97-00A0C90A43CB}
CLSID_DirectPlay: TGUID =
(D1:$d1eb6d20;D2:$8923;D3:$11d0;D4:($9d,$97,$00,$a0,$c9,$a,$43,$cb));
 
CLSID_DirectPlay: TGUID = '{D1EB6D20-8923-11D0-9D97-00A0C90A43CB}';
(*
* GUIDS used by Service Providers shipped with DirectPlay
* Use these to identify Service Provider returned by EnumConnections
*)
 
IID_IDirectPlay: TGUID = '{5454E9A0-DB65-11CE-921C-00AA006C4972}';
IID_IDirectPlay2: TGUID = '{2B74F7C0-9154-11CF-A9CD-00AA006886E3}';
IID_IDirectPlay2A: TGUID = '{9D460580-A822-11CF-960C-0080C7534E82}';
IID_IDirectPlay3: TGUID = '{133EFE40-32DC-11D0-9CFB-00A0C90A43CB}';
IID_IDirectPlay3A: TGUID = '{133EFE41-32DC-11D0-9CFB-00A0C90A43CB}';
IID_IDirectPlay4: TGUID = '{0AB1C530-4745-11D1-A7A1-0000F803ABFC}';
IID_IDirectPlay4A: TGUID = '{0AB1C531-4745-11D1-A7A1-0000F803ABFC}';
// GUID for IPX service provider
// {685BC400-9D2C-11cf-A9CD-00AA006886E3}
DPSPGUID_IPX: TGUID =
(D1:$685bc400;D2:$9d2c;D3:$11cf;D4:($a9,$cd,$00,$aa,$00,$68,$86,$e3));
 
{ GUIDS used by Service Providers shipped with DirectPlay
Use these to identify Service Provider returned by EnumConnections }
// GUID for TCP/IP service provider
// 36E95EE0-8577-11cf-960C-0080C7534E82
DPSPGUID_TCPIP: TGUID =
(D1:$36E95EE0;D2:$8577;D3:$11cf;D4:($96,$0c,$00,$80,$c7,$53,$4e,$82));
 
DPSPGUID_IPX: TGUID = '{685BC400-9D2C-11CF-A9CD-00AA006886E3}';
DPSPGUID_TCPIP: TGUID = '{36E95EE0-8577-11CF-960C-0080C7534E82}';
DPSPGUID_SERIAL: TGUID = '{0F1D6860-88D9-11CF-9C4E-00A0C905425E}';
DPSPGUID_MODEM: TGUID = '{44EAA760-CB68-11CF-9C4E-00A0C905425E}';
// GUID for Serial service provider
// {0F1D6860-88D9-11cf-9C4E-00A0C905425E}
DPSPGUID_SERIAL: TGUID =
(D1:$f1d6860;D2:$88d9;D3:$11cf;D4:($9c,$4e,$00,$a0,$c9,$05,$42,$5e));
 
{ DirectPlay Structures }
// GUID for Modem service provider
// {44EAA760-CB68-11cf-9C4E-00A0C905425E}
DPSPGUID_MODEM: TGUID =
(D1:$44eaa760;D2:$cb68;D3:$11cf;D4:($9c,$4e,$00,$a0,$c9,$05,$42,$5e));
 
 
(****************************************************************************
*
* DirectPlay Structures
*
* Various structures used to invoke DirectPlay.
*
****************************************************************************)
 
type
{$IFDEF UNICODE}
PCharAW = PWideChar;
{$ELSE}
PCharAW = PAnsiChar;
{$ENDIF}
(*
* TDPID
* DirectPlay player and group ID
*)
TDPID = DWORD;
PDPID = ^TDPID;
TDPID = DWORD;
 
DPID = TDPID;
LPDPID = PDPID;
 
const
DPID_SYSMSG = 0; // DPID that system messages come from
DPID_ALLPLAYERS = 0; // DPID representing all players in the session
DPID_SERVERPLAYER = 1; // DPID representing the server player
DPID_RESERVEDRANGE = 100; // DPID representing the maxiumum ID in the range of DPID's reserved for
// use by DirectPlay.
DPID_UNKNOWN = $FFFFFFFF; // The player ID is unknown (used with e.g. DPSESSION_NOMESSAGEID)
(*
* DPID that system messages come from
*)
DPID_SYSMSG = 0;
 
(*
* DPID representing all players in the session
*)
DPID_ALLPLAYERS = 0;
 
(*
* DPID representing the server player
*)
DPID_SERVERPLAYER = 1;
 
(*
* DPID representing the maximum ID in the range of DPID's reserved for
* use by DirectPlay.
*)
DPID_RESERVEDRANGE = 100;
 
(*
* The player ID is unknown (used with e.g. DPSESSION_NOMESSAGEID)
*)
DPID_UNKNOWN = $FFFFFFFF;
 
type
(*
* DPCAPS
* Used to obtain the capabilities of a DirectPlay object
*)
PDPCaps = ^TDPCaps;
TDPCaps = record
TDPCaps = packed record
dwSize: DWORD; // Size of structure, in bytes
dwFlags: DWORD; // DPCAPS_xxx flags
dwMaxBufferSize: DWORD; // Maximum message size, in bytes, for this service provider
9792,27 → 14591,85
// responses to system messages
end;
 
DPCAPS = TDPCaps;
LPDPCAPS = PDPCaps;
 
const
(*
* This DirectPlay object is the session host. If the host exits the
* session, another application will become the host and receive a
* DPSYS_HOST system message.
*)
DPCAPS_ISHOST = $00000002;
 
(*
* The service provider bound to this DirectPlay object can optimize
* group messaging.
*)
DPCAPS_GROUPOPTIMIZED = $00000008;
 
(*
* The service provider bound to this DirectPlay object can optimize
* keep alives (see DPSESSION_KEEPALIVE)
*)
DPCAPS_KEEPALIVEOPTIMIZED = $00000010;
 
(*
* The service provider bound to this DirectPlay object can optimize
* guaranteed message delivery.
*)
DPCAPS_GUARANTEEDOPTIMIZED = $00000020;
 
(*
* This DirectPlay object supports guaranteed message delivery.
*)
DPCAPS_GUARANTEEDSUPPORTED = $00000040;
 
(*
* This DirectPlay object supports digital signing of messages.
*)
DPCAPS_SIGNINGSUPPORTED = $00000080;
 
(*
* This DirectPlay object supports encryption of messages.
*)
DPCAPS_ENCRYPTIONSUPPORTED = $00000100;
 
(*
* This DirectPlay player was created on this machine
*)
DPPLAYERCAPS_LOCAL = $00000800;
 
(*
* Current Open settings supports all forms of Cancel
*)
DPCAPS_ASYNCCANCELSUPPORTED = $00001000;
 
(*
* Current Open settings supports CancelAll, but not Cancel
*)
DPCAPS_ASYNCCANCELALLSUPPORTED = $00002000;
 
(*
* Current Open settings supports Send Timeouts for sends
*)
DPCAPS_SENDTIMEOUTSUPPORTED = $00004000;
 
(*
* Current Open settings supports send priority
*)
DPCAPS_SENDPRIORITYSUPPORTED = $00008000;
 
(*
* Current Open settings supports DPSEND_ASYNC flag
*)
DPCAPS_ASYNCSUPPORTED = $00010000;
 
type
(*
* TDPSessionDesc2
* Used to describe the properties of a DirectPlay
* session instance
*)
PDPSessionDesc2 = ^TDPSessionDesc2;
TDPSessionDesc2 = record
TDPSessionDesc2 = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // DPSESSION_xxx flags
guidInstance: TGUID; // ID for the session instance
9820,11 → 14677,10
// GUID_NULL for all applications.
dwMaxPlayers: DWORD; // Maximum # players allowed in session
dwCurrentPlayers: DWORD; // Current # players in session (read only)
 
case Integer of
case integer of
0: (
lpszSessionName: LPWSTR; // Name of the session - Unicode
lpszPassword: LPWSTR; // Password of the session (optional) - Unicode
lpszSessionName: PCharAW; // Name of the session
lpszPassword: PCharAW; // Password of the session (optional)
dwReserved1: DWORD; // Reserved for future MS use.
dwReserved2: DWORD;
dwUser1: DWORD; // For use by the application
9833,49 → 14689,130
dwUser4: DWORD;
);
1: (
lpszSessionNameA: LPSTR; // Name of the session - ANSI
lpszPasswordA: LPSTR; // Password of the session (optional) - ANSI
lpszSessionNameA: PAnsiChar; // Name of the session
lpszPasswordA: PAnsiChar // Password of the session (optional)
);
2 : (
lpszSessionNameW: PWideChar;
lpszPasswordW: PWideChar
);
end;
 
DPSESSIONDESC2 = TDPSessionDesc2;
LPDPSESSIONDESC2 = PDPSessionDesc2;
 
const
(*
* Applications cannot create new players in this session.
*)
DPSESSION_NEWPLAYERSDISABLED = $00000001;
 
(*
* If the DirectPlay object that created the session, the host,
* quits, then the host will attempt to migrate to another
* DirectPlay object so that new players can continue to be created
* and new applications can join the session.
*)
DPSESSION_MIGRATEHOST = $00000004;
 
(*
* This flag tells DirectPlay not to set the idPlayerTo and idPlayerFrom
* fields in player messages. This cuts two DWORD's off the message
* overhead.
*)
DPSESSION_NOMESSAGEID = $00000008;
 
(*
* This flag tells DirectPlay to not allow any new applications to
* join the session. Applications already in the session can still
* create new players.
*)
DPSESSION_JOINDISABLED = $00000020;
 
(*
* This flag tells DirectPlay to detect when remote players
* exit abnormally (e.g. their computer or modem gets unplugged)
*)
DPSESSION_KEEPALIVE = $00000040;
 
(*
* This flag tells DirectPlay not to send a message to all players
* when a players remote data changes
*)
DPSESSION_NODATAMESSAGES = $00000080;
 
(*
* This flag indicates that the session belongs to a secure server
* and needs user authentication
*)
DPSESSION_SECURESERVER = $00000100;
 
(*
* This flag indicates that the session is private and requirs a password
* for EnumSessions as well as Open.
*)
DPSESSION_PRIVATE = $00000200;
 
(*
* This flag indicates that the session requires a password for joining.
*)
DPSESSION_PASSWORDREQUIRED = $00000400;
 
(*
* This flag tells DirectPlay to route all messages through the server
*)
DPSESSION_MULTICASTSERVER = $00000800;
 
(*
* This flag tells DirectPlay to only download information about the
* DPPLAYER_SERVERPLAYER.
*)
DPSESSION_CLIENTSERVER = $00001000;
 
(*
* This flag tells DirectPlay to use the protocol built into dplay
* for reliability and statistics all the time. When this bit is
* set, only other sessions with this bit set can join or be joined.
*)
DPSESSION_DIRECTPLAYPROTOCOL = $00002000;
 
(*
* This flag tells DirectPlay that preserving order of received
* packets is not important, when using reliable delivery. This
* will allow messages to be indicated out of order if preceding
* messages have not yet arrived. Otherwise DPLAY will wait for
* earlier messages before delivering later reliable messages.
*)
DPSESSION_NOPRESERVEORDER = $00004000;
 
(*
* This flag tells DirectPlay to optimize communication for latency
*)
DPSESSION_OPTIMIZELATENCY = $00008000;
 
type
(*
* TDPName
* Used to hold the name of a DirectPlay entity
* like a player or a group
*)
PDPName = ^TDPName;
TDPName = record
TDPName = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszShortName: LPWSTR; // The short or friendly name - Unicode
lpszLongName: LPWSTR // The long or formal name - Unicode
lpszShortName : PCharAW; // The short or friendly name
lpszLongName : PCharAW; // The long or formal name
);
1: (
lpszShortNameA: LPSTR; // The short or friendly name - ANSI
lpszLongNameA: LPSTR // The long or formal name - ANSI
lpszShortNameA : PAnsiChar;
lpszLongNameA : PAnsiChar;
);
2 : (
lpszShortNameW : PWideChar;
lpszLongNameW : PWideChar;
);
end;
 
DPNAME = TDPName;
LPDPNAME = PDPName;
 
(*
* TDPCredentials
* Used to hold the user name and password of a DirectPlay user
9882,79 → 14819,75
*)
 
PDPCredentials = ^TDPCredentials;
TDPCredentials = record
TDPCredentials = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszUsername: LPWSTR; // User name of the account - Unicode
lpszPassword: LPWSTR; // Password of the account - Unicode
lpszDomain: LPWSTR; // Domain name of the account - Unicode
lpszUsername: PCharAW; // User name of the account
lpszPassword: PCharAW; // Password of the account
lpszDomain: PCharAW; // Domain name of the account
);
1: (
lpszUsernameA: LPSTR; // User name of the account - ANSI
lpszPasswordA: LPSTR; // Password of the account - ANSI
lpszDomainA: LPSTR // Domain name of the account - ANSI
lpszUsernameA: PAnsiChar; // User name of the account
lpszPasswordA: PAnsiChar; // Password of the account
lpszDomainA: PAnsiChar; // Domain name of the account
);
2 : (
lpszUsernameW: PWideChar; // User name of the account
lpszPasswordW: PWideChar; // Password of the account
lpszDomainW: PWideChar; // Domain name of the account
);
end;
 
DPCREDENTIALS = TDPCredentials;
LPDPCREDENTIALS = PDPCredentials;
 
(*
* DPSECURITYDESC
* TDPSecurityDesc
* Used to describe the security properties of a DirectPlay
* session instance
*)
 
PDPSecurityDesc = ^TDPSecurityDesc;
TDPSecurityDesc = record
TDPSecurityDesc = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszSSPIProvider: LPWSTR; // SSPI provider name - Unicode
lpszCAPIProvider: LPWSTR; // CAPI provider name - Unicode
lpszSSPIProvider : PCharAW; // SSPI provider name
lpszCAPIProvider : PCharAW; // CAPI provider name
dwCAPIProviderType: DWORD; // Crypto Service Provider type
dwEncryptionAlgorithm: DWORD; // Encryption Algorithm type
);
1: (
lpszSSPIProviderA: LPSTR; // SSPI provider name - ANSI
lpszCAPIProviderA: LPSTR; // CAPI provider name - ANSI
lpszSSPIProviderA : PAnsiChar; // SSPI provider name
lpszCAPIProviderA : PAnsiChar; // CAPI provider name
);
2 : (
lpszSSPIProviderW : PWideChar; // SSPI provider name
lpszCAPIProviderW : PWideChar; // CAPI provider name
);
end;
 
DPSECURITYDESC = TDPSecurityDesc;
LPDPSECURITYDESC = PDPSecurityDesc;
 
(*
* TDPAccountDesc
* DPACCOUNTDESC
* Used to describe a user membership account
*)
 
PDPAccountDesc = ^TDPAccountDesc;
TDPAccountDesc = record
TDPAccountDesc = packed record
dwSize: DWORD; // Size of structure
dwFlags: DWORD; // Not used. Must be zero.
case Integer of
0: (
lpszAccountID: LPWSTR; // Account identifier - Unicode
);
1: (
lpszAccountIDA: LPSTR; // Account identifier - ANSI
);
0 : (lpszAccountID : PCharAW); // Account identifier
1 : (lpszAccountIDA : PAnsiChar);
2 : (lpszAccountIDW : PWideChar);
end;
 
DPACCOUNTDESC = TDPAccountDesc;
LPDPACCOUNTDESC = PDPAccountDesc;
 
(*
* TDPLConnection
* Used to hold all in the informaion needed to connect
* an application to a session or create a session
*)
 
PDPLConnection = ^TDPLConnection;
TDPLConnection = record
TDPLConnection = packed record
dwSize: DWORD; // Size of this structure
dwFlags: DWORD; // Flags specific to this structure
lpSessionDesc: PDPSessionDesc2; // Pointer to session desc to use on connect
9964,345 → 14897,796
dwAddressSize: DWORD; // Size of address data
end;
 
DPLCONNECTION = TDPLConnection;
LPDPLCONNECTION = PDPLConnection;
 
(*
* TDPChat
* Used to hold the a DirectPlay chat message
*)
 
PDPChat = ^TDPChat;
TDPChat = record
TDPChat = packed record
dwSize: DWORD;
dwFlags: DWORD;
case Integer of
0: (
lpszMessage: LPWSTR; // Message string - Unicode
);
1: (
lpszMessageA: LPSTR; // Message string - ANSI
);
0 : (lpszMessage : PCharAW); // Message string
1 : (lpszMessageA : PAnsiChar);
2 : (lpszMessageW : PWideChar);
end;
 
DPCHAT = TDPChat;
LPDPCHAT = PDPChat;
 
(*
* SGBUFFER
* TSGBuffer
* Scatter Gather Buffer used for SendEx
*)
 
PSGBuffer = ^TSGBuffer;
TSGBuffer = record
len: UINT; // length of buffer data
pData: PUChar; // pointer to buffer data
TSGBuffer = packed record
len: UINT;
pData: PUCHAR;
end;
 
SGBUFFER = TSGBuffer;
LPSGBUFFER = PSGBuffer;
(****************************************************************************
*
* Prototypes for DirectPlay callback functions
*
****************************************************************************)
 
{ Prototypes for DirectPlay callback functions }
 
{ Callback for IDirectPlay2::EnumSessions }
 
TDPEnumSessionsCallback2 = function(const lpThisSD: TDPSessionDesc2;
(*
* Callback for IDirectPlay2::EnumSessions
*)
TDPEnumSessionsCallback2 = function(lpThisSD: PDPSessionDesc2;
var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
LPDPENUMSESSIONSCALLBACK2 = TDPEnumSessionsCallback2;
 
const
(*
* This flag is set on the EnumSessions callback dwFlags parameter when
* the time out has occurred. There will be no session data for this
* callback. If *lpdwTimeOut is set to a non-zero value and the
* EnumSessionsCallback function returns TRUE then EnumSessions will
* continue waiting until the next timeout occurs. Timeouts are in
* milliseconds.
*)
DPESC_TIMEDOUT = $00000001;
 
type
TDPEnumPlayersCallback2 = function(dpId: TDPID; dwPlayerType: DWORD;
(*
* Callback for IDirectPlay2.EnumPlayers
* IDirectPlay2.EnumGroups
* IDirectPlay2.EnumGroupPlayers
*)
TDPEnumPlayersCallback2 = function(DPID: TDPID; dwPlayerType: DWORD;
const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
LPDPENUMPLAYERSCALLBACK2 = TDPEnumPlayersCallback2;
 
TDPEnumDPCallback = function(const lpguidSP: TGUID; lpSPName: LPWSTR;
 
(*
* ANSI callback for DirectPlayEnumerate
* This callback prototype will be used if compiling
* for ANSI strings
*)
TDPEnumDPCallbackA = function(const lpguidSP: TGUID; lpSPName: PAnsiChar;
dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer): BOOL; stdcall;
LPDPENUMDPCALLBACK = TDPEnumDPCallback;
 
TDPEnumDPCallbackA = function(const lpguidSP: TGUID; lpSPName: LPSTR;
(*
* Unicode callback for DirectPlayEnumerate
* This callback prototype will be used if compiling
* for Unicode strings
*)
TDPEnumDPCallbackW = function(const lpguidSP: TGUID; lpSPName: PWideChar;
dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer): BOOL; stdcall;
LPDPENUMDPCALLBACKA = TDPEnumDPCallbackA;
 
(*
* Callback for DirectPlayEnumerate
*)
{$IFDEF UNICODE}
TDPEnumDPCallback = TDPEnumDPCallbackW;
{$ELSE}
TDPEnumDPCallback = TDPEnumDPCallbackA;
{$ENDIF}
 
(*
* Callback for IDirectPlay3(A/W).EnumConnections
*)
TDPEnumConnectionsCallback = function(const lpguidSP: TGUID;
lpConnection: Pointer; dwConnectionSize: DWORD; const lpName: TDPName;
dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
LPDPENUMCONNECTIONSCALLBACK = TDPEnumConnectionsCallback;
 
{ API's }
(*
* API's
*)
 
function DirectPlayEnumerateA(lpEnumDPCallback: TDPEnumDPCallbackA;
var
DirectPlayEnumerate : function (lpEnumDPCallback: TDPEnumDPCallback;
lpContext: Pointer): HResult; stdcall;
function DirectPlayEnumerateW(lpEnumDPCallback: TDPEnumDPCallback;
DirectPlayEnumerateA : function (lpEnumDPCallback: TDPEnumDPCallbackA;
lpContext: Pointer): HResult; stdcall;
function DirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackA;
DirectPlayEnumerateW : function (lpEnumDPCallback: TDPEnumDPCallbackW;
lpContext: Pointer): HResult; stdcall;
 
 
{ IDirectPlay2 (and IDirectPlay2A) Interface }
(****************************************************************************
*
* IDirectPlay2 (and IDirectPlay2A) Interface
*
****************************************************************************)
 
type
IDirectPlay2 = interface(IUnknown)
['{2B74F7C0-9154-11CF-A9CD-00AA006886E3}']
// IDirectPlay2 methods
IDirectPlay2AW = interface (IUnknown)
(*** IDirectPlay2 methods ***)
function AddPlayerToGroup(idGroup: TDPID; idPlayer: TDPID): HResult; stdcall;
function Close: HResult; stdcall;
function CreateGroup(var lpidGroup: TDPID; const lpGroupName: TDPName;
const lpData; dwDataSize: DWORD; dwFlags: DWORD): HResult; stdcall;
function CreatePlayer(var lpidPlayer: TDPID; const pPlayerName: TDPName;
hEvent: THandle; const lpData; dwDataSize: DWORD; dwFliags: DWORD): HResult; stdcall;
function CreateGroup(out lpidGroup: TDPID; lpGroupName: PDPName;
lpData: Pointer; dwDataSize: DWORD; dwFlags: DWORD) : HResult; stdcall;
function CreatePlayer(out lpidPlayer: TDPID; pPlayerName: PDPName;
hEvent: THandle; lpData: Pointer; dwDataSize: DWORD; dwFlags: DWORD) : HResult; stdcall;
function DeletePlayerFromGroup(idGroup: TDPID; idPlayer: TDPID): HResult; stdcall;
function DestroyGroup(idGroup: TDPID): HResult; stdcall;
function DestroyPlayer(idPlayer: TDPID): HResult; stdcall;
function EnumGroupPlayers(idGroup: TDPID; const lpguidInstance: TGUID;
function EnumGroupPlayers(idGroup: TDPID; lpguidInstance: PGUID;
lpEnumPlayersCallback2: TDPEnumPlayersCallback2; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function EnumGroups(const lpguidInstance: TGUID; lpEnumPlayersCallback2:
LPDPENUMPLAYERSCALLBACK2; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumPlayers(const lpguidInstance: TGUID; lpEnumPlayersCallback2:
LPDPENUMPLAYERSCALLBACK2; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumGroups(lpguidInstance: PGUID; lpEnumPlayersCallback2:
TDPEnumPlayersCallback2; lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
function EnumPlayers(lpguidInstance: PGUID; lpEnumPlayersCallback2:
TDPEnumPlayersCallback2; lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
function EnumSessions(const lpsd: TDPSessionDesc2; dwTimeout: DWORD;
lpEnumSessionsCallback2: TDPEnumSessionsCallback2; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function GetCaps(var lpDPCaps: TDPCaps; dwFlags: DWORD): HResult; stdcall;
function GetGroupData(idGroup: TDPID; var lpData; var lpdwDataSize: DWORD;
function GetGroupData(idGroup: TDPID; lpData: Pointer; var lpdwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function GetGroupName(idGroup: TDPID; var lpData; var lpdwDataSize: DWORD): HResult; stdcall;
function GetGroupName(idGroup: TDPID; lpData: Pointer; var lpdwDataSize: DWORD) :
HResult; stdcall;
function GetMessageCount(idPlayer: TDPID; var lpdwCount: DWORD): HResult; stdcall;
function GetPlayerAddress(idPlayer: TDPID; var lpAddress;
function GetPlayerAddress(idPlayer: TDPID; lpAddress: Pointer;
var lpdwAddressSize: DWORD): HResult; stdcall;
function GetPlayerCaps(idPlayer: TDPID; var lpPlayerCaps: TDPCaps;
dwFlags: DWORD): HResult; stdcall;
function GetPlayerData(idPlayer: TDPID; var lpData; var lpdwDataSize: DWORD;
function GetPlayerData(idPlayer: TDPID; lpData: Pointer; var lpdwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function GetPlayerName(idPlayer: TDPID; var lpData; var lpdwDataSize: DWORD): HResult; stdcall;
function GetSessionDesc(var lpData; var lpdwDataSize: DWORD): HResult; stdcall;
function GetPlayerName(idPlayer: TDPID; lpData: Pointer; var lpdwDataSize: DWORD) : HResult; stdcall;
function GetSessionDesc(lpData: Pointer; var lpdwDataSize: DWORD) : HResult; stdcall;
function Initialize(const lpGUID: TGUID): HResult; stdcall;
function Open(var lpsd: TDPSessionDesc2; dwFlags: DWORD): HResult; stdcall;
function Receive(var lpidFrom: TDPID; var lpidTo: TDPID; dwFlags: DWORD;
var lpData; var lpdwDataSize: DWORD): HResult; stdcall;
function Send(idFrom: TDPID; lpidTo: TDPID; dwFlags: DWORD; const lpData;
lpData: Pointer; var lpdwDataSize: DWORD) : HResult; stdcall;
function Send(idFrom: TDPID; lpidTo: TDPID; dwFlags: DWORD; var lpData;
lpdwDataSize: DWORD): HResult; stdcall;
function SetGroupData(idGroup: TDPID; const lpData; dwDataSize: DWORD;
function SetGroupData(idGroup: TDPID; lpData: Pointer; dwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetGroupName(idGroup: TDPID; const lpGroupName: TDPName;
function SetGroupName(idGroup: TDPID; lpGroupName: PDPName;
dwFlags: DWORD): HResult; stdcall;
function SetPlayerData(idPlayer: TDPID; const lpData; dwDataSize: DWORD;
function SetPlayerData(idPlayer: TDPID; lpData: Pointer; dwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function SetPlayerName(idPlayer: TDPID; const lpPlayerName: TDPName;
function SetPlayerName(idPlayer: TDPID; lpPlayerName: PDPName;
dwFlags: DWORD): HResult; stdcall;
function SetSessionDesc(const lpSessDesc: TDPSessionDesc2; dwFlags: DWORD): HResult; stdcall;
function SetSessionDesc(var lpSessDesc: TDPSessionDesc2; dwFlags: DWORD) :
HResult; stdcall;
end;
 
IDirectPlay2A = interface(IDirectPlay2)
['{9D460580-A822-11CF-960C-0080C7534E82}']
IDirectPlay2W = interface (IDirectPlay2AW)
['{2B74F7C0-9154-11CF-A9CD-00AA006886E3}']
end;
IDirectPlay2A = interface (IDirectPlay2AW)
['{9d460580-a822-11cf-960c-0080c7534e82}']
end;
 
{ IDirectPlay3 (and IDirectPlay3A) Interface }
{$IFDEF UNICODE}
IDirectPlay2 = IDirectPlay2W;
{$ELSE}
IDirectPlay2 = IDirectPlay2A;
{$ENDIF}
 
IDirectPlay3 = interface(IDirectPlay2)
['{133EFE40-32DC-11D0-9CFB-00A0C90A43CB}']
// IDirectPlay3 methods
(****************************************************************************
*
* IDirectPlay3 (and IDirectPlay3A) Interface
*
****************************************************************************)
 
IDirectPlay3AW = interface (IDirectPlay2AW)
(*** IDirectPlay3 methods ***)
function AddGroupToGroup(idParentGroup: TDPID; idGroup: TDPID): HResult; stdcall;
function CreateGroupInGroup(idParentGroup: TDPID; var lpidGroup: TDPID;
var lpGroupName: TDPName; const lpData; dwDataSize: DWORD;
lpGroupName: PDPName; lpData: Pointer; dwDataSize: DWORD;
dwFlags: DWORD): HResult; stdcall;
function DeleteGroupFromGroup(idParentGroup: TDPID; idGroup: TDPID): HResult; stdcall;
function EnumConnections(const lpguidApplication: TGUID;
function EnumConnections(lpguidApplication: PGUID;
lpEnumCallback: TDPEnumConnectionsCallback; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function EnumGroupsInGroup(idGroup: TDPID; const lpguidInstance: TGUID;
function EnumGroupsInGroup(idGroup: TDPID; lpguidInstance: PGUID;
lpEnumPlayersCallback2: TDPEnumPlayersCallback2; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function GetGroupConnectionSettings(dwFlags: DWORD; idGroup: TDPID;
var lpData; var lpdwDataSize: DWORD): HResult; stdcall;
lpData: Pointer; var lpdwDataSize: DWORD) : HResult; stdcall;
function InitializeConnection(lpConnection: Pointer; dwFlags: DWORD): HResult; stdcall;
function SecureOpen(const lpsd: TDPSessionDesc2; dwFlags: DWORD;
const lpSecurity: TDPSecurityDesc; const lpCredentials: TDPCredentials): HResult; stdcall;
function SecureOpen(var lpsd: TDPSessionDesc2; dwFlags: DWORD;
var lpSecurity: TDPSecurityDesc; var lpCredentials: TDPCredentials) : HResult; stdcall;
function SendChatMessage(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD;
const lpChatMessage: TDPChat): HResult; stdcall;
var lpChatMessage: TDPChat) : HResult; stdcall;
function SetGroupConnectionSettings(dwFlags: DWORD; idGroup: TDPID;
const lpConnection: TDPLConnection): HResult; stdcall;
var lpConnection: TDPLConnection) : HResult; stdcall;
function StartSession(dwFlags: DWORD; idGroup: TDPID): HResult; stdcall;
function GetGroupFlags(idGroup: TDPID; var lpdwFlags: DWORD): HResult; stdcall;
function GetGroupParent(idGroup: TDPID; var lpidParent: TDPID): HResult; stdcall;
function GetGroupFlags(idGroup: TDPID; out lpdwFlags: DWORD) : HResult; stdcall;
function GetGroupParent(idGroup: TDPID; out lpidParent: TDPID) : HResult; stdcall;
function GetPlayerAccount(idPlayer: TDPID; dwFlags: DWORD; var lpData;
var lpdwDataSize: DWORD): HResult; stdcall;
function GetPlayerFlags(idPlayer: TDPID; var lpdwFlags: DWORD): HResult; stdcall;
function GetPlayerFlags(idPlayer: TDPID; out lpdwFlags: DWORD) : HResult; stdcall;
end;
 
IDirectPlay3A = interface(IDirectPlay3)
['{133EFE41-32DC-11D0-9CFB-00A0C90A43CB}']
 
IDirectPlay3W = interface (IDirectPlay3AW)
['{133EFE40-32DC-11D0-9CFB-00A0C90A43CB}']
end;
IDirectPlay3A = interface (IDirectPlay3AW)
['{133efe41-32dc-11d0-9cfb-00a0c90a43cb}']
end;
 
{ IDirectPlay4 (and IDirectPlay4A) Interface }
{$IFDEF UNICODE}
IDirectPlay3 = IDirectPlay3W;
{$ELSE}
IDirectPlay3 = IDirectPlay3A;
{$ENDIF}
 
IDirectPlay4 = interface(IDirectPlay3)
['{0AB1C530-4745-11D1-A7A1-0000F803ABFC}']
// IDirectPlay4 methods
function GetGroupOwner(idGroup: TDPID; var idOwner: TDPID): HResult; stdcall;
 
(****************************************************************************
*
* IDirectPlay4 (and IDirectPlay4A) Interface
*
****************************************************************************)
 
IDirectPlay4AW = interface (IDirectPlay3AW)
(*** IDirectPlay4 methods ***)
function GetGroupOwner(idGroup: TDPID; out idOwner: TDPID) : HResult; stdcall;
function SetGroupOwner(idGroup: TDPID; idOwner: TDPID): HResult; stdcall;
function SendEx(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD; const pData;
function SendEx(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD; lpData: Pointer;
dwDataSize: DWORD; dwPriority: DWORD; dwTimeout: DWORD;
lpContext: Pointer; lpdwMsgId: PDWORD): HResult; stdcall;
function GetMessageQueue(idFrom: TDPID; idTo: TDPID; dwFlags: DWORD;
var lpdwNumMsgs: DWORD; var lpdwNumBytes: DWORD): HResult; stdcall;
lpdwNumMsgs: PDWORD; lpdwNumBytes: PDWORD) : HResult; stdcall;
function CancelMessage(dwMessageID: DWORD; dwFlags: DWORD): HResult; stdcall;
function CancelPriority(dwMinPriority: DWORD; dwMaxPriority: DWORD; dwFlags: DWORD): HResult; stdcall;
end;
 
IDirectPlay4A = interface(IDirectPlay4)
['{0AB1C531-4745-11D1-A7A1-0000F803ABFC}']
 
IDirectPlay4W = interface (IDirectPlay4AW)
['{0ab1c530-4745-11D1-a7a1-0000f803abfc}']
end;
IDirectPlay4A = interface (IDirectPlay4AW)
['{0ab1c531-4745-11D1-a7a1-0000f803abfc}']
end;
 
{$IFDEF UNICODE}
IDirectPlay4 = IDirectPlay4W;
{$ELSE}
IDirectPlay4 = IDirectPlay4A;
{$ENDIF}
 
 
const
{ EnumConnections API flags }
(****************************************************************************
*
* EnumConnections API flags
*
****************************************************************************)
 
(*
* Enumerate Service Providers
*)
DPCONNECTION_DIRECTPLAY = $00000001;
 
(*
* Enumerate Lobby Providers
*)
DPCONNECTION_DIRECTPLAYLOBBY = $00000002;
 
{ EnumPlayers API flags }
(****************************************************************************
*
* EnumPlayers API flags
*
****************************************************************************)
 
(*
* Enumerate all players in the current session
*)
DPENUMPLAYERS_ALL = $00000000;
DPENUMGROUPS_ALL = DPENUMPLAYERS_ALL;
 
(*
* Enumerate only local (created by this application) players
* or groups
*)
DPENUMPLAYERS_LOCAL = $00000008;
DPENUMGROUPS_LOCAL = DPENUMPLAYERS_LOCAL;
 
(*
* Enumerate only remote (non-local) players
* or groups
*)
DPENUMPLAYERS_REMOTE = $00000010;
DPENUMGROUPS_REMOTE = DPENUMPLAYERS_REMOTE;
 
(*
* Enumerate groups along with the players
*)
DPENUMPLAYERS_GROUP = $00000020;
 
(*
* Enumerate players or groups in another session
* (must supply lpguidInstance)
*)
DPENUMPLAYERS_SESSION = $00000080;
DPENUMGROUPS_SESSION = DPENUMPLAYERS_SESSION;
 
(*
* Enumerate server players
*)
DPENUMPLAYERS_SERVERPLAYER = $00000100;
 
(*
* Enumerate spectator players
*)
DPENUMPLAYERS_SPECTATOR = $00000200;
 
(*
* Enumerate shortcut groups
*)
DPENUMGROUPS_SHORTCUT = $00000400;
 
(*
* Enumerate staging area groups
*)
DPENUMGROUPS_STAGINGAREA = $00000800;
 
(*
* Enumerate hidden groups
*)
DPENUMGROUPS_HIDDEN = $00001000;
 
(*
* Enumerate the group's owner
*)
DPENUMPLAYERS_OWNER = $00002000;
 
{ CreatePlayer API flags }
(****************************************************************************
*
* CreatePlayer API flags
*
****************************************************************************)
 
(*
* This flag indicates that this player should be designated
* the server player. The app should specify this at CreatePlayer.
*)
DPPLAYER_SERVERPLAYER = DPENUMPLAYERS_SERVERPLAYER;
 
(*
* This flag indicates that this player should be designated
* a spectator. The app should specify this at CreatePlayer.
*)
DPPLAYER_SPECTATOR = DPENUMPLAYERS_SPECTATOR;
 
(*
* This flag indicates that this player was created locally.
* (returned from GetPlayerFlags)
*)
DPPLAYER_LOCAL = DPENUMPLAYERS_LOCAL;
 
(*
* This flag indicates that this player is the group's owner
* (Only returned in EnumGroupPlayers)
*)
DPPLAYER_OWNER = DPENUMPLAYERS_OWNER;
 
{ CreateGroup API flags }
(****************************************************************************
*
* CreateGroup API flags
*
****************************************************************************)
 
(*
* This flag indicates that the StartSession can be called on the group.
* The app should specify this at CreateGroup, or CreateGroupInGroup.
*)
DPGROUP_STAGINGAREA = DPENUMGROUPS_STAGINGAREA;
 
(*
* This flag indicates that this group was created locally.
* (returned from GetGroupFlags)
*)
DPGROUP_LOCAL = DPENUMGROUPS_LOCAL;
 
(*
* This flag indicates that this group was created hidden.
*)
DPGROUP_HIDDEN = DPENUMGROUPS_HIDDEN;
 
{ EnumSessions API flags }
(****************************************************************************
*
* EnumSessions API flags
*
****************************************************************************)
 
(*
* Enumerate sessions which can be joined
*)
DPENUMSESSIONS_AVAILABLE = $00000001;
 
(*
* Enumerate all sessions even if they can't be joined.
*)
DPENUMSESSIONS_ALL = $00000002;
 
(*
* Start an asynchronous enum sessions
*)
DPENUMSESSIONS_ASYNC = $00000010;
 
(*
* Stop an asynchronous enum sessions
*)
DPENUMSESSIONS_STOPASYNC = $00000020;
 
(*
* Enumerate sessions even if they require a password
*)
DPENUMSESSIONS_PASSWORDREQUIRED = $00000040;
 
(*
* Return status about progress of enumeration instead of
* showing any status dialogs.
*)
DPENUMSESSIONS_RETURNSTATUS = $00000080;
 
{ GetCaps and GetPlayerCaps API flags }
(****************************************************************************
*
* GetCaps and GetPlayerCaps API flags
*
****************************************************************************)
 
(*
* The latency returned should be for guaranteed message sending.
* Default is non-guaranteed messaging.
*)
DPGETCAPS_GUARANTEED = $00000001;
 
{ GetGroupData, GetPlayerData API flags }
(****************************************************************************
*
* GetGroupData, GetPlayerData API flags
* Remote and local Group/Player data is maintained separately.
* Default is DPGET_REMOTE.
*
****************************************************************************)
 
(*
* Get the remote data (set by any DirectPlay object in
* the session using DPSET_REMOTE)
*)
DPGET_REMOTE = $00000000;
 
(*
* Get the local data (set by this DirectPlay object
* using DPSET_LOCAL)
*)
DPGET_LOCAL = $00000001;
 
{ Open API flags }
(****************************************************************************
*
* Open API flags
*
****************************************************************************)
 
(*
* Join the session that is described by the DPSESSIONDESC2 structure
*)
DPOPEN_JOIN = $00000001;
 
(*
* Create a new session as described by the DPSESSIONDESC2 structure
*)
DPOPEN_CREATE = $00000002;
 
(*
* Return status about progress of open instead of showing
* any status dialogs.
*)
DPOPEN_RETURNSTATUS = DPENUMSESSIONS_RETURNSTATUS;
 
{ TDPLConnection flags }
(****************************************************************************
*
* DPLCONNECTION flags
*
****************************************************************************)
 
(*
* This application should create a new session as
* described by the DPSESIONDESC structure
*)
DPLCONNECTION_CREATESESSION = DPOPEN_CREATE;
 
(*
* This application should join the session described by
* the DPSESIONDESC structure with the lpAddress data
*)
DPLCONNECTION_JOINSESSION = DPOPEN_JOIN;
 
{ Receive API flags }
(****************************************************************************
*
* Receive API flags
* Default is DPRECEIVE_ALL
*
****************************************************************************)
 
(*
* Get the first message in the queue
*)
DPRECEIVE_ALL = $00000001;
 
(*
* Get the first message in the queue directed to a specific player
*)
DPRECEIVE_TOPLAYER = $00000002;
 
(*
* Get the first message in the queue from a specific player
*)
DPRECEIVE_FROMPLAYER = $00000004;
 
(*
* Get the message but don't remove it from the queue
*)
DPRECEIVE_PEEK = $00000008;
 
{ Send API flags }
(****************************************************************************
*
* Send API flags
*
****************************************************************************)
 
(*
* Send the message using a guaranteed send method.
* Default is non-guaranteed.
*)
DPSEND_GUARANTEED = $00000001;
 
(*
* This flag is obsolete. It is ignored by DirectPlay
*)
DPSEND_HIGHPRIORITY = $00000002;
 
(*
* This flag is obsolete. It is ignored by DirectPlay
*)
DPSEND_OPENSTREAM = $00000008;
 
(*
* This flag is obsolete. It is ignored by DirectPlay
*)
DPSEND_CLOSESTREAM = $00000010;
 
(*
* Send the message digitally signed to ensure authenticity.
*)
DPSEND_SIGNED = $00000020;
 
(*
* Send the message with encryption to ensure privacy.
*)
DPSEND_ENCRYPTED = $00000040;
 
(*
* The message is a lobby system message
*)
DPSEND_LOBBYSYSTEMMESSAGE = $00000080;
 
(*
* andyco - added this so we can make addforward async.
* needs to be sanitized when we add / expose full async
* support. 8/3/97.
*)
DPSEND_ASYNC = $00000200;
 
(*
* When a message is completed, don't tell me.
* by default the application is notified with a system message.
*)
DPSEND_NOSENDCOMPLETEMSG = $00000400;
 
 
(*
* Maximum priority for sends available to applications
*)
DPSEND_MAX_PRI = $0000FFFF;
DPSEND_MAX_PRIORITY = DPSEND_MAX_PRI;
 
{ SetGroupData, SetGroupName, SetPlayerData, SetPlayerName,
SetSessionDesc API flags. }
(****************************************************************************
*
* SetGroupData, SetGroupName, SetPlayerData, SetPlayerName,
* SetSessionDesc API flags.
* Default is DPSET_REMOTE.
*
****************************************************************************)
 
(*
* Propagate the data to all players in the session
*)
DPSET_REMOTE = $00000000;
 
(*
* Do not propagate the data to other players
*)
DPSET_LOCAL = $00000001;
 
(*
* Used with DPSET_REMOTE, use guaranteed message send to
* propagate the data
*)
DPSET_GUARANTEED = $00000002;
 
{ GetMessageQueue API flags. }
(****************************************************************************
*
* GetMessageQueue API flags.
* Default is DPMESSAGEQUEUE_SEND
*
****************************************************************************)
 
DPMESSAGEQUEUE_SEND = $00000001; // Default
DPMESSAGEQUEUE_RECEIVE = $00000002; // Default
(*
* Get Send Queue - requires Service Provider Support
*)
DPMESSAGEQUEUE_SEND = $00000001;
 
{ Connect API flags }
(*
* Get Receive Queue
*)
DPMESSAGEQUEUE_RECEIVE = $00000002;
 
(****************************************************************************
*
* Connect API flags
*
****************************************************************************)
 
(*
* Start an asynchronous connect which returns status codes
*)
DPCONNECT_RETURNSTATUS = DPENUMSESSIONS_RETURNSTATUS;
 
{ DirectPlay system messages and message data structures }
(****************************************************************************
*
* DirectPlay system messages and message data structures
*
* All system message come 'From' player DPID_SYSMSG. To determine what type
* of message it is, cast the lpData from Receive to TDPMsg_Generic and check
* the dwType member against one of the following DPSYS_xxx constants. Once
* a match is found, cast the lpData to the corresponding of the DPMSG_xxx
* structures to access the data of the message.
*
****************************************************************************)
 
(*
* A new player or group has been created in the session
* Use TDPMsg_CreatePlayerOrGroup. Check dwPlayerType to see if it
* is a player or a group.
*)
DPSYS_CREATEPLAYERORGROUP = $0003;
 
(*
* A player has been deleted from the session
* Use TDPMsg_DestroyPlayerOrGroup
*)
DPSYS_DESTROYPLAYERORGROUP = $0005;
 
(*
* A player has been added to a group
* Use DPMSG_ADDPLAYERTOGROUP
*)
DPSYS_ADDPLAYERTOGROUP = $0007;
 
(*
* A player has been removed from a group
* Use DPMSG_DELETEPLAYERFROMGROUP
*)
DPSYS_DELETEPLAYERFROMGROUP = $0021;
 
(*
* This DirectPlay object lost its connection with all the
* other players in the session.
* Use DPMSG_SESSIONLOST.
*)
DPSYS_SESSIONLOST = $0031;
 
(*
* The current host has left the session.
* This DirectPlay object is now the host.
* Use DPMSG_HOST.
*)
DPSYS_HOST = $0101;
 
(*
* The remote data associated with a player or
* group has changed. Check dwPlayerType to see
* if it is a player or a group
* Use DPMSG_SETPLAYERORGROUPDATA
*)
DPSYS_SETPLAYERORGROUPDATA = $0102;
 
(*
* The name of a player or group has changed.
* Check dwPlayerType to see if it is a player
* or a group.
* Use TDPMsg_SetPlayerOrGroupName
*)
DPSYS_SETPLAYERORGROUPNAME = $0103;
 
(*
* The session description has changed.
* Use DPMSG_SETSESSIONDESC
*)
DPSYS_SETSESSIONDESC = $0104;
 
(*
* A group has been added to a group
* Use TDPMsg_AddGroupToGroup
*)
DPSYS_ADDGROUPTOGROUP = $0105;
 
(*
* A group has been removed from a group
* Use DPMsg_DeleteGroupFromGroup
*)
DPSYS_DELETEGROUPFROMGROUP = $0106;
 
(*
* A secure player-player message has arrived.
* Use DPMSG_SECUREMESSAGE
*)
DPSYS_SECUREMESSAGE = $0107;
 
(*
* Start a new session.
* Use DPMSG_STARTSESSION
*)
DPSYS_STARTSESSION = $0108;
 
(*
* A chat message has arrived
* Use DPMSG_CHAT
*)
DPSYS_CHAT = $0109;
 
(*
* The owner of a group has changed
* Use DPMSG_SETGROUPOWNER
*)
DPSYS_SETGROUPOWNER = $010A;
DPSYS_SENDCOMPLETE = $010d;
 
(*
* An async send has finished, failed or been cancelled
* Use DPMSG_SENDCOMPLETE
*)
DPSYS_SENDCOMPLETE = $010D;
 
{ Used in the dwPlayerType field to indicate if it applies to a group or a player}
 
(*
* Used in the dwPlayerType field to indicate if it applies to a group
* or a player
*)
DPPLAYERTYPE_GROUP = $00000000;
DPPLAYERTYPE_PLAYER = $00000001;
 
{ TDPMsg_Generic }
 
type
(*
* TDPMsg_Generic
* Generic message structure used to identify the message type.
*)
PDPMsg_Generic = ^TDPMsg_Generic;
TDPMsg_Generic = record
TDPMsg_Generic = packed record
dwType: DWORD; // Message type
end;
 
DPMSG_GENERIC = TDPMsg_Generic;
LPDPMSG_GENERIC = PDPMsg_Generic;
 
{ TDPMsg_CreatePlayerOrGroup }
 
(*
* TDPMsg_CreatePlayerOrGroup
* System message generated when a new player or group
* created in the session with information about it.
*)
PDPMsg_CreatePlayerOrGroup = ^TDPMsg_CreatePlayerOrGroup;
TDPMsg_CreatePlayerOrGroup = record
TDPMsg_CreatePlayerOrGroup = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
dpId: TDPID; // ID of the player or group
DPID: TDPID; // ID of the player or group
dwCurrentPlayers: DWORD; // current # players & groups in session
lpData: Pointer; // pointer to remote data
dwDataSize: DWORD; // size of remote data
10313,16 → 15697,16
dwFlags: DWORD; // player or group flags
end;
 
DPMSG_CREATEPLAYERORGROUP = TDPMsg_CreatePlayerOrGroup;
LPDPMSG_CREATEPLAYERORGROUP = PDPMsg_CreatePlayerOrGroup;
 
{ TDPMsg_DestroyPlayerOrGroup }
 
(*
* TDPMsg_DestroyPlayerOrGroup
* System message generated when a player or group is being
* destroyed in the session with information about it.
*)
PDPMsg_DestroyPlayerOrGroup = ^TDPMsg_DestroyPlayerOrGroup;
TDPMsg_DestroyPlayerOrGroup = record
TDPMsg_DestroyPlayerOrGroup = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
dpId: TDPID; // player ID being deleted
DPID: TDPID; // player ID being deleted
lpLocalData: Pointer; // copy of players local data
dwLocalDataSize: DWORD; // sizeof local data
lpRemoteData: Pointer; // copy of players remote data
10334,107 → 15718,106
dwFlags: DWORD; // player or group flags
end;
 
DPMSG_DESTROYPLAYERORGROUP = TDPMsg_DestroyPlayerOrGroup;
LPDPMSG_DESTROYPLAYERORGROUP = PDPMsg_DestroyPlayerOrGroup;
 
{ TDPMsg_AddPlayerOrGroup }
 
PDPMsg_AddPlayerOrGroup = ^TDPMsg_AddPlayerOrGroup;
TDPMsg_AddPlayerOrGroup = record
(*
* DPMSG_ADDPLAYERTOGROUP
* System message generated when a player is being added
* to a group.
*)
PDPMsg_AddPlayerToGroup = ^TDPMsg_AddPlayerToGroup;
TDPMsg_AddPlayerToGroup = packed record
dwType: DWORD; // Message type
dpIdGroup: TDPID; // group ID being added to
dpIdPlayer: TDPID; // player ID being added
end;
 
DPMSG_ADDPLAYERTOGROUP = TDPMsg_AddPlayerOrGroup;
LPDPMSG_ADDPLAYERTOGROUP = PDPMsg_AddPlayerOrGroup;
(*
* DPMSG_DELETEPLAYERFROMGROUP
* System message generated when a player is being
* removed from a group
*)
PDPMsg_DeletePlayerFromGroup = ^TDPMsg_DeletePlayerFromGroup;
TDPMsg_DeletePlayerFromGroup = TDPMsg_AddPlayerToGroup;
 
{ TDPMsg_DeletePlayerFromGroup }
 
TDPMsg_DeletePlayerFromGroup = TDPMsg_AddPlayerOrGroup;
PDPMsg_DeletePlayerFromGroup = PDPMsg_AddPlayerOrGroup;
 
DPMSG_DELETEPLAYERFROMGROUP = TDPMsg_DeletePlayerFromGroup;
LPDPMSG_DELETEPLAYERFROMGROUP = PDPMsg_DeletePlayerFromGroup;
 
{ TDPMsg_AddGroupToGroup }
 
(*
* TDPMsg_AddGroupToGroup
* System message generated when a group is being added
* to a group.
*)
PDPMsg_AddGroupToGroup = ^TDPMsg_AddGroupToGroup;
TDPMsg_AddGroupToGroup = record
TDPMsg_AddGroupToGroup = packed record
dwType: DWORD; // Message type
dpIdParentGroup: TDPID; // group ID being added to
dpIdGroup: TDPID; // group ID being added
end;
 
DPMSG_ADDGROUPTOGROUP = TDPMsg_AddGroupToGroup;
LPDPMSG_ADDGROUPTOGROUP = PDPMsg_AddGroupToGroup;
 
{ TDPMsg_DeleteGroupFromGroup }
 
(*
* DPMsg_DeleteGroupFromGroup
* System message generated when a GROUP is being
* removed from a group
*)
PDPMsg_DeleteGroupFromGroup = ^TDPMsg_DeleteGroupFromGroup;
TDPMsg_DeleteGroupFromGroup = TDPMsg_AddGroupToGroup;
PDPMsg_DeleteGroupFromGroup = PDPMsg_AddGroupToGroup;
 
DPMSG_DELETEGROUPFROMGROUP = TDPMsg_DeleteGroupFromGroup;
LPDPMSG_DELETEGROUPFROMGROUP = PDPMsg_DeleteGroupFromGroup;
 
{ TDPMsg_SetPlayerOrGroupData }
 
(*
* DPMSG_SETPLAYERORGROUPDATA
* System message generated when remote data for a player or
* group has changed.
*)
PDPMsg_SetPlayerOrGroupData = ^TDPMsg_SetPlayerOrGroupData;
TDPMsg_SetPlayerOrGroupData = record
TDPMsg_SetPlayerOrGroupData = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
dpId: TDPID; // ID of player or group
DPID: TDPID; // ID of player or group
lpData: Pointer; // pointer to remote data
dwDataSize: DWORD; // size of remote data
end;
 
DPMSG_SETPLAYERORGROUPDATA = TDPMsg_SetPlayerOrGroupData;
LPDPMSG_SETPLAYERORGROUPDATA = PDPMsg_SetPlayerOrGroupData;
 
{ TDPMsg_SetPlayerOrGroupName }
 
(*
* DPMSG_SETPLAYERORGROUPNAME
* System message generated when the name of a player or
* group has changed.
*)
PDPMsg_SetPlayerOrGroupName = ^TDPMsg_SetPlayerOrGroupName;
TDPMsg_SetPlayerOrGroupName = record
TDPMsg_SetPlayerOrGroupName = packed record
dwType: DWORD; // Message type
dwPlayerType: DWORD; // Is it a player or group
dpId: TDPID; // ID of player or group
DPID: TDPID; // ID of player or group
dpnName: TDPName; // structure with new name info
end;
 
DPMSG_SETPLAYERORGROUPNAME = TDPMsg_SetPlayerOrGroupName;
LPDPMSG_SETPLAYERORGROUPNAME = PDPMsg_SetPlayerOrGroupName;
 
{ TDPMsg_SetSessionDesc }
 
(*
* DPMSG_SETSESSIONDESC
* System message generated when session desc has changed
*)
PDPMsg_SetSessionDesc = ^TDPMsg_SetSessionDesc;
TDPMsg_SetSessionDesc = record
TDPMsg_SetSessionDesc = packed record
dwType: DWORD; // Message type
dpDesc: TDPSessionDesc2; // Session desc
end;
 
DPMSG_SETSESSIONDESC = TDPMsg_SetSessionDesc;
LPDPMSG_SETSESSIONDESC = PDPMsg_SetSessionDesc;
 
{ TDPMsg_Host }
 
(*
* DPMSG_HOST
* System message generated when the host has migrated to this
* DirectPlay object.
*
*)
PDPMsg_Host = ^TDPMsg_Host;
TDPMsg_Host = TDPMsg_Generic;
 
DPMSG_HOST = TDPMsg_Host;
LPDPMSG_HOST = PDPMsg_Host;
 
{ TDPMsg_SessionLost }
 
(*
* DPMSG_SESSIONLOST
* System message generated when the connection to the session is lost.
*
*)
PDPMsg_SessionLost = ^TDPMsg_SessionLost;
TDPMsg_SessionLost = TDPMsg_Generic;
 
DPMSG_SESSIONLOST = TDPMsg_SessionLost;
LPDPMSG_SESSIONLOST = PDPMsg_SessionLost;
 
{ TDPMsg_SecureMessage }
 
(*
* DPMSG_SECUREMESSAGE
* System message generated when a player requests a secure send
*)
PDPMsg_SecureMessage = ^TDPMsg_SecureMessage;
TDPMsg_SecureMessage = record
TDPMsg_SecureMessage = packed record
dwType: DWORD; // Message Type
dwFlags: DWORD; // Signed/Encrypted
dpIdFrom: TDPID; // ID of Sending Player
10442,24 → 15825,23
dwDataSize: DWORD; // Size of player message
end;
 
DPMSG_SECUREMESSAGE = TDPMsg_SecureMessage;
LPDPMSG_SECUREMESSAGE = PDPMsg_SecureMessage;
 
{ TDPMsg_StartSession }
 
(*
* DPMSG_STARTSESSION
* System message containing all information required to
* start a new session
*)
PDPMsg_StartSession = ^TDPMsg_StartSession;
TDPMsg_StartSession = record
TDPMsg_StartSession = packed record
dwType: DWORD; // Message type
lpConn: PDPLConnection; // TDPLConnection structure
end;
 
DPMSG_STARTSESSION = TDPMsg_StartSession;
LPDPMSG_STARTSESSION = PDPMsg_StartSession;
 
{ TDPMsg_Chat }
 
(*
* DPMSG_CHAT
* System message containing a chat message
*)
PDPMsg_Chat = ^TDPMsg_Chat;
TDPMsg_Chat = record
TDPMsg_Chat = packed record
dwType: DWORD; // Message type
dwFlags: DWORD; // Message flags
idFromPlayer: TDPID; // ID of the Sending Player
10468,13 → 15850,12
lpChat: PDPChat; // Pointer to a structure containing the chat message
end;
 
DPMSG_CHAT = TDPMsg_Chat;
LPDPMSG_CHAT = PDPMsg_Chat;
 
{ TDPMsg_SetGroupOwner }
 
(*
* DPMSG_SETGROUPOWNER
* System message generated when the owner of a group has changed
*)
PDPMsg_SetGroupOwner = ^TDPMsg_SetGroupOwner;
TDPMsg_SetGroupOwner = record
TDPMsg_SetGroupOwner = packed record
dwType: DWORD; // Message type
idGroup: TDPID; // ID of the group
idNewOwner: TDPID; // ID of the player that is the new owner
10481,13 → 15862,15
idOldOwner: TDPID; // ID of the player that used to be the owner
end;
 
DPMSG_SETGROUPOWNER = TDPMsg_SetGroupOwner;
LPDPMSG_SETGROUPOWNER = PDPMsg_SetGroupOwner;
 
{ TDPMsg_SendComplete }
 
(*
* DPMSG_SENDCOMPLETE
* System message generated when finished with an Async Send message
*
* NOTE SENDPARMS has an overlay for DPMSG_SENDCOMPLETE, don't
* change this message w/o changing SENDPARMS.
*)
PDPMsg_SendComplete= ^TDPMsg_SendComplete;
TDPMsg_SendComplete = record
TDPMsg_SendComplete = packed record
dwType: DWORD; // Message type
idFrom: TDPID;
idTo: TDPID;
10500,84 → 15883,98
dwSendTime: DWORD;
end;
 
DPMSG_SENDCOMPLETE = TDPMsg_SendComplete;
LPDPMSG_SENDCOMPLETE = PDPMsg_SendComplete;
 
{ DIRECTPLAY ERRORS }
(****************************************************************************
*
* DIRECTPLAY ERRORS
*
* Errors are represented by negative values and cannot be combined.
*
****************************************************************************)
const
DP_OK = HResult(S_OK);
DPERR_ALREADYINITIALIZED = HResult($88770000 + 5);
DPERR_ACCESSDENIED = HResult($88770000 + 10);
DPERR_ACTIVEPLAYERS = HResult($88770000 + 20);
DPERR_BUFFERTOOSMALL = HResult($88770000 + 30);
DPERR_CANTADDPLAYER = HResult($88770000 + 40);
DPERR_CANTCREATEGROUP = HResult($88770000 + 50);
DPERR_CANTCREATEPLAYER = HResult($88770000 + 60);
DPERR_CANTCREATESESSION = HResult($88770000 + 70);
DPERR_CAPSNOTAVAILABLEYET = HResult($88770000 + 80);
DPERR_EXCEPTION = HResult($88770000 + 90);
DPERR_GENERIC = HResult(E_FAIL);
DPERR_INVALIDFLAGS = HResult($88770000 + 120);
DPERR_INVALIDOBJECT = HResult($88770000 + 130);
DPERR_INVALIDPARAM = HResult(E_INVALIDARG);
DPERR_INVALIDPARAMS = HResult(DPERR_INVALIDPARAM);
DPERR_INVALIDPLAYER = HResult($88770000 + 150);
DPERR_INVALIDGROUP = HResult($88770000 + 155);
DPERR_NOCAPS = HResult($88770000 + 160);
DPERR_NOCONNECTION = HResult($88770000 + 170);
DPERR_NOMEMORY = HResult(E_OUTOFMEMORY);
DPERR_OUTOFMEMORY = HResult(DPERR_NOMEMORY);
DPERR_NOMESSAGES = HResult($88770000 + 190);
DPERR_NONAMESERVERFOUND = HResult($88770000 + 200);
DPERR_NOPLAYERS = HResult($88770000 + 210);
DPERR_NOSESSIONS = HResult($88770000 + 220);
DPERR_PENDING = HResult(E_PENDING);
DPERR_SENDTOOBIG = HResult($88770000 + 230);
DPERR_TIMEOUT = HResult($88770000 + 240);
DPERR_UNAVAILABLE = HResult($88770000 + 250);
DPERR_UNSUPPORTED = HResult(E_NOTIMPL);
DPERR_BUSY = HResult($88770000 + 270);
DPERR_USERCANCEL = HResult($88770000 + 280);
DPERR_NOINTERFACE = HResult(E_NOINTERFACE);
DPERR_CANNOTCREATESERVER = HResult($88770000 + 290);
DPERR_PLAYERLOST = HResult($88770000 + 300);
DPERR_SESSIONLOST = HResult($88770000 + 310);
DPERR_UNINITIALIZED = HResult($88770000 + 320);
DPERR_NONEWPLAYERS = HResult($88770000 + 330);
DPERR_INVALIDPASSWORD = HResult($88770000 + 340);
DPERR_CONNECTING = HResult($88770000 + 350);
DPERR_CONNECTIONLOST = HResult($88770000 + 360);
DPERR_UNKNOWNMESSAGE = HResult($88770000 + 370);
DPERR_CANCELFAILED = HResult($88770000 + 380);
DPERR_INVALIDPRIORITY = HResult($88770000 + 390);
DPERR_NOTHANDLED = HResult($88770000 + 400);
DPERR_CANCELLED = HResult($88770000 + 410);
DPERR_ABORTED = HResult($88770000 + 420);
DPERR_BUFFERTOOLARGE = HResult($88770000 + 1000);
DPERR_CANTCREATEPROCESS = HResult($88770000 + 1010);
DPERR_APPNOTSTARTED = HResult($88770000 + 1020);
DPERR_INVALIDINTERFACE = HResult($88770000 + 1030);
DPERR_NOSERVICEPROVIDER = HResult($88770000 + 1040);
DPERR_UNKNOWNAPPLICATION = HResult($88770000 + 1050);
DPERR_NOTLOBBIED = HResult($88770000 + 1070);
DPERR_SERVICEPROVIDERLOADED = HResult($88770000 + 1080);
DPERR_ALREADYREGISTERED = HResult($88770000 + 1090);
DPERR_NOTREGISTERED = HResult($88770000 + 1100);
MAKE_DPHRESULT = HResult($88770000);
 
{ Security related errors }
DP_OK = S_OK;
DPERR_ALREADYINITIALIZED = MAKE_DPHRESULT + 5;
DPERR_ACCESSDENIED = MAKE_DPHRESULT + 10;
DPERR_ACTIVEPLAYERS = MAKE_DPHRESULT + 20;
DPERR_BUFFERTOOSMALL = MAKE_DPHRESULT + 30;
DPERR_CANTADDPLAYER = MAKE_DPHRESULT + 40;
DPERR_CANTCREATEGROUP = MAKE_DPHRESULT + 50;
DPERR_CANTCREATEPLAYER = MAKE_DPHRESULT + 60;
DPERR_CANTCREATESESSION = MAKE_DPHRESULT + 70;
DPERR_CAPSNOTAVAILABLEYET = MAKE_DPHRESULT + 80;
DPERR_EXCEPTION = MAKE_DPHRESULT + 90;
DPERR_GENERIC = E_FAIL;
DPERR_INVALIDFLAGS = MAKE_DPHRESULT + 120;
DPERR_INVALIDOBJECT = MAKE_DPHRESULT + 130;
DPERR_INVALIDPARAM = E_INVALIDARG;
DPERR_INVALIDPARAMS = DPERR_INVALIDPARAM;
DPERR_INVALIDPLAYER = MAKE_DPHRESULT + 150;
DPERR_INVALIDGROUP = MAKE_DPHRESULT + 155;
DPERR_NOCAPS = MAKE_DPHRESULT + 160;
DPERR_NOCONNECTION = MAKE_DPHRESULT + 170;
DPERR_NOMEMORY = E_OUTOFMEMORY;
DPERR_OUTOFMEMORY = DPERR_NOMEMORY;
DPERR_NOMESSAGES = MAKE_DPHRESULT + 190;
DPERR_NONAMESERVERFOUND = MAKE_DPHRESULT + 200;
DPERR_NOPLAYERS = MAKE_DPHRESULT + 210;
DPERR_NOSESSIONS = MAKE_DPHRESULT + 220;
DPERR_PENDING = E_PENDING;
DPERR_SENDTOOBIG = MAKE_DPHRESULT + 230;
DPERR_TIMEOUT = MAKE_DPHRESULT + 240;
DPERR_UNAVAILABLE = MAKE_DPHRESULT + 250;
DPERR_UNSUPPORTED = E_NOTIMPL;
DPERR_BUSY = MAKE_DPHRESULT + 270;
DPERR_USERCANCEL = MAKE_DPHRESULT + 280;
DPERR_NOINTERFACE = E_NOINTERFACE;
DPERR_CANNOTCREATESERVER = MAKE_DPHRESULT + 290;
DPERR_PLAYERLOST = MAKE_DPHRESULT + 300;
DPERR_SESSIONLOST = MAKE_DPHRESULT + 310;
DPERR_UNINITIALIZED = MAKE_DPHRESULT + 320;
DPERR_NONEWPLAYERS = MAKE_DPHRESULT + 330;
DPERR_INVALIDPASSWORD = MAKE_DPHRESULT + 340;
DPERR_CONNECTING = MAKE_DPHRESULT + 350;
DPERR_CONNECTIONLOST = MAKE_DPHRESULT + 360;
DPERR_UNKNOWNMESSAGE = MAKE_DPHRESULT + 370;
DPERR_CANCELFAILED = MAKE_DPHRESULT + 380;
DPERR_INVALIDPRIORITY = MAKE_DPHRESULT + 390;
DPERR_NOTHANDLED = MAKE_DPHRESULT + 400;
DPERR_CANCELLED = MAKE_DPHRESULT + 410;
DPERR_ABORTED = MAKE_DPHRESULT + 420;
 
DPERR_AUTHENTICATIONFAILED = HResult($88770000 + 2000);
DPERR_CANTLOADSSPI = HResult($88770000 + 2010);
DPERR_ENCRYPTIONFAILED = HResult($88770000 + 2020);
DPERR_SIGNFAILED = HResult($88770000 + 2030);
DPERR_CANTLOADSECURITYPACKAGE = HResult($88770000 + 2040);
DPERR_ENCRYPTIONNOTSUPPORTED = HResult($88770000 + 2050);
DPERR_CANTLOADCAPI = HResult($88770000 + 2060);
DPERR_NOTLOGGEDIN = HResult($88770000 + 2070);
DPERR_LOGONDENIED = HResult($88770000 + 2080);
 
// define this to ignore obsolete interfaces and constants
DPERR_BUFFERTOOLARGE = MAKE_DPHRESULT + 1000;
DPERR_CANTCREATEPROCESS = MAKE_DPHRESULT + 1010;
DPERR_APPNOTSTARTED = MAKE_DPHRESULT + 1020;
DPERR_INVALIDINTERFACE = MAKE_DPHRESULT + 1030;
DPERR_NOSERVICEPROVIDER = MAKE_DPHRESULT + 1040;
DPERR_UNKNOWNAPPLICATION = MAKE_DPHRESULT + 1050;
DPERR_NOTLOBBIED = MAKE_DPHRESULT + 1070;
DPERR_SERVICEPROVIDERLOADED = MAKE_DPHRESULT + 1080;
DPERR_ALREADYREGISTERED = MAKE_DPHRESULT + 1090;
DPERR_NOTREGISTERED = MAKE_DPHRESULT + 1100;
 
//
// Security related errors
//
DPERR_AUTHENTICATIONFAILED = MAKE_DPHRESULT + 2000;
DPERR_CANTLOADSSPI = MAKE_DPHRESULT + 2010;
DPERR_ENCRYPTIONFAILED = MAKE_DPHRESULT + 2020;
DPERR_SIGNFAILED = MAKE_DPHRESULT + 2030;
DPERR_CANTLOADSECURITYPACKAGE = MAKE_DPHRESULT + 2040;
DPERR_ENCRYPTIONNOTSUPPORTED = MAKE_DPHRESULT + 2050;
DPERR_CANTLOADCAPI = MAKE_DPHRESULT + 2060;
DPERR_NOTLOGGEDIN = MAKE_DPHRESULT + 2070;
DPERR_LOGONDENIED = MAKE_DPHRESULT + 2080;
 
(****************************************************************************
*
* dplay 1.0 obsolete structures + interfaces
* Included for compatibility only. New apps should
* use IDirectPlay2
*
****************************************************************************)
 
DPOPEN_OPENSESSION = DPOPEN_JOIN;
DPOPEN_CREATESESSION = DPOPEN_CREATE;
 
10605,71 → 16002,41
DPSYS_DELETEPLAYERFROMGRP = $0021;
DPSYS_CONNECT = $484b;
 
{ TDPMsg_AddPlayer }
 
type
PDPMsg_AddPlayer = ^TDPMsg_AddPlayer;
TDPMsg_AddPlayer = record
TDPMsg_AddPlayer = packed record
dwType: DWORD;
dwPlayerType: DWORD;
dpId: TDPID;
DPID: TDPID;
szLongName: array[0..DPLONGNAMELEN-1] of Char;
szShortName: array[0..DPSHORTNAMELEN-1] of Char;
dwCurrentPlayers: DWORD;
end;
 
DPMSG_ADDPLAYER = TDPMsg_AddPlayer;
LPDPMSG_ADDPLAYER = PDPMsg_AddPlayer;
 
{ TDPMsg_AddGroup }
 
PDPMsg_AddGroup = ^TDPMsg_AddGroup;
TDPMsg_AddGroup = TDPMsg_AddPlayer;
 
DPMSG_ADDGROUP = TDPMsg_AddGroup;
LPDPMSG_ADDGROUP = PDPMsg_AddGroup;
 
{ TDPMsg_GroupAdd }
 
PDPMsg_GroupAdd = ^TDPMsg_GroupAdd;
TDPMsg_GroupAdd = record
TDPMsg_GroupAdd = packed record
dwType: DWORD;
dpIdGroup: TDPID;
dpIdPlayer: TDPID;
end;
 
DPMSG_GROUPADD = TDPMsg_GroupAdd;
LPDPMSG_GROUPADD = PDPMsg_GroupAdd;
 
{ TDPMsg_GroupDelete }
 
PDPMsg_GroupDelete = ^TDPMsg_GroupDelete;
TDPMsg_GroupDelete = TDPMsg_GroupAdd;
 
DPMSG_GROUPDELETE = TDPMsg_GroupDelete;
LPDPMSG_GROUPDELETE = PDPMsg_GroupDelete;
 
{ TDPMsg_DeletePlayer }
 
PDPMsg_DeletePlayer = ^TDPMsg_DeletePlayer;
TDPMsg_DeletePlayer = record
TDPMsg_DeletePlayer = packed record
dwType: DWORD;
dpId: TDPID;
DPID: TDPID;
end;
 
DPMSG_DELETEPLAYER = TDPMsg_DeletePlayer;
LPDPMSG_DELETEPLAYER = PDPMsg_DeletePlayer;
TDPEnumPlayersCallback = function(dpId: TDPID; lpFriendlyName: PChar;
lpFormalName: PChar; dwFlags: DWORD; lpContext: Pointer) : BOOL; stdcall;
 
{ TDPEnumPlayersCallback }
 
TDPEnumPlayersCallback = function(dpId: TDPID; lpFriendlyName: LPSTR;
lpFormalName: LPSTR; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
LPDPENUMPLAYERSCALLBACK = TDPEnumPlayersCallback;
 
{ TDPSessionDesc }
 
PDPSessionDesc = ^TDPSessionDesc;
TDPSessionDesc = record
TDPSessionDesc = packed record
dwSize: DWORD;
guidSession: TGUID;
dwSession: DWORD;
10676,10 → 16043,10
dwMaxPlayers: DWORD;
dwCurrentPlayers: DWORD;
dwFlags: DWORD;
szSessionName: array[0..DPSESSIONNAMELEN-1] of char;
szUserField: array[0..DPUSERRESERVED-1] of char;
szSessionName: Array [0..DPSESSIONNAMELEN-1] of char;
szUserField: Array [0..DPUSERRESERVED-1] of char;
dwReserved1: DWORD;
szPassword: array[0..DPPASSWORDLEN-1] of char;
szPassword: Array [0..DPPASSWORDLEN-1] of char;
dwReserved2: DWORD;
dwUser1: DWORD;
dwUser2: DWORD;
10687,57 → 16054,68
dwUser4: DWORD;
end;
 
DPSESSIONDESC = TDPSessionDesc;
LPDPSESSIONDESC = PDPSessionDesc;
 
{ TDPEnumSessionsCallback }
 
TDPEnumSessionsCallback = function(var lpDPSessionDesc: TDPSessionDesc;
TDPEnumSessionsCallback = function(const lpDPSessionDesc: TDPSessionDesc;
lpContext: Pointer; var lpdwTimeOut: DWORD; dwFlags: DWORD): BOOL; stdcall;
LPDPENUMSESSIONSCALLBACK = TDPEnumSessionsCallback;
 
type
IDirectPlay = interface(IUnknown)
// IDirectPlay methods
['{5454e9a0-db65-11ce-921c-00aa006c4972}']
(*** IDirectPlay methods ***)
function AddPlayerToGroup(pidGroup: TDPID; pidPlayer: TDPID): HResult; stdcall;
function Close: HResult; stdcall;
function CreatePlayer(var lppidID: TDPID; lpPlayerFriendlyName: LPSTR;
lpPlayerFormalName: LPSTR; lpEvent: PHandle): HResult; stdcall;
function CreateGroup(var lppidID: TDPID; lpGroupFriendlyName: LPSTR;
lpGroupFormalName: LPSTR): HResult; stdcall;
function CreatePlayer(out lppidID: TDPID; lpPlayerFriendlyName: PChar;
lpPlayerFormalName: PChar; lpEvent: PHandle) : HResult; stdcall;
function CreateGroup(out lppidID: TDPID; lpGroupFriendlyName: PChar;
lpGroupFormalName: PChar) : HResult; stdcall;
function DeletePlayerFromGroup(pidGroup: TDPID; pidPlayer: TDPID): HResult; stdcall;
function DestroyPlayer(pidID: TDPID): HResult; stdcall;
function DestroyGroup(pidID: TDPID): HResult; stdcall;
function EnableNewPlayers(bEnable: BOOL): HResult; stdcall;
function EnumGroupPlayers(pidGroupPID: TDPID; lpEnumPlayersCallback:
LPDPENUMPLAYERSCALLBACK; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
TDPEnumPlayersCallback; lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
function EnumGroups(dwSessionID: DWORD; lpEnumPlayersCallback:
LPDPENUMPLAYERSCALLBACK; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
TDPEnumPlayersCallback; lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
function EnumPlayers(dwSessionId: DWORD; lpEnumPlayersCallback:
LPDPENUMPLAYERSCALLBACK; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function EnumSessions(const lpSDesc: TDPSessionDesc; dwTimeout: DWORD;
lpEnumSessionsCallback: TDPEnumPlayersCallback; lpContext: Pointer;
TDPEnumPlayersCallback; lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
function EnumSessions(var lpSDesc: TDPSessionDesc; dwTimeout: DWORD;
lpEnumSessionsCallback: TDPEnumSessionsCallback; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function GetCaps(const lpDPCaps: TDPCaps): HResult; stdcall;
function GetCaps(var lpDPCaps: TDPCaps) : HResult; stdcall;
function GetMessageCount(pidID: TDPID; var lpdwCount: DWORD): HResult; stdcall;
function GetPlayerCaps(pidID: TDPID; const lpDPPlayerCaps: TDPCaps): HResult; stdcall;
function GetPlayerName(pidID: TDPID; lpPlayerFriendlyName: LPSTR;
var lpdwFriendlyNameLength: DWORD; lpPlayerFormalName: LPSTR;
function GetPlayerCaps(pidID: TDPID; var lpDPPlayerCaps: TDPCaps) : HResult; stdcall;
function GetPlayerName(pidID: TDPID; lpPlayerFriendlyName: PChar;
var lpdwFriendlyNameLength: DWORD; lpPlayerFormalName: PChar;
var lpdwFormalNameLength: DWORD): HResult; stdcall;
function Initialize(const lpGUID: TGUID): HResult; stdcall;
function Open(const lpSDesc: TDPSessionDesc): HResult; stdcall;
function Open(var lpSDesc: TDPSessionDesc) : HResult; stdcall;
function Receive(var lppidFrom, lppidTo: TDPID; dwFlags: DWORD;
var lpvBuffer; var lpdwSize: DWORD): HResult; stdcall;
function SaveSession(lpSessionName: LPSTR): HResult; stdcall;
function SaveSession(lpSessionName: PChar) : HResult; stdcall;
function Send(pidFrom: TDPID; pidTo: TDPID; dwFlags: DWORD;
const lpvBuffer; dwBuffSize: DWORD): HResult; stdcall;
function SetPlayerName(pidID: TDPID; lpPlayerFriendlyName: LPSTR;
lpPlayerFormalName: LPSTR): HResult; stdcall;
var lpvBuffer; dwBuffSize: DWORD) : HResult; stdcall;
function SetPlayerName(pidID: TDPID; lpPlayerFriendlyName: PChar;
lpPlayerFormalName: PChar) : HResult; stdcall;
end;
 
{ API's (cont.) }
(*
* GUIDS used by DirectPlay objects
*)
IID_IDirectPlay2W = IDirectPlay2W;
IID_IDirectPlay2A = IDirectPlay2A;
IID_IDirectPlay2 = IDirectPlay2;
 
function DirectPlayCreate(const lpGUID: TGUID; out lplpDP: IDirectPlay;
IID_IDirectPlay3W = IDirectPlay3W;
IID_IDirectPlay3A = IDirectPlay3A;
IID_IDirectPlay3 = IDirectPlay3;
 
IID_IDirectPlay4W = IDirectPlay4W;
IID_IDirectPlay4A = IDirectPlay4A;
IID_IDirectPlay4 = IDirectPlay4;
 
IID_IDirectPlay = IDirectPlay;
 
var
DirectPlayCreate : function (lpGUID: PGUID; out lplpDP: IDirectPlay;
pUnk: IUnknown): HResult; stdcall;
 
(*==========================================================================;
10746,238 → 16124,345
*
* File: dplobby.h
* Content: DirectPlayLobby include file
*
***************************************************************************)
 
{ GUIDS used by DirectPlay objects }
(*
* GUIDS used by DirectPlay objects
*)
 
const
CLSID_DirectPlayLobby: TGUID = '{2FE8F810-B2A5-11D0-A787-0000F803ABFC}';
(* {2FE8F810-B2A5-11d0-A787-0000F803ABFC} *)
CLSID_DirectPlayLobby: TGUID =
(D1:$2fe8f810;D2:$b2a5;D3:$11d0;D4:($a7,$87,$00,$00,$f8,$3,$ab,$fc));
 
IID_IDirectPlayLobby: TGUID = '{AF465C71-9588-11cf-A020-00AA006157AC}';
IID_IDirectPlayLobbyA: TGUID = '{26C66A70-B367-11cf-A024-00AA006157AC}';
IID_IDirectPlayLobby2: TGUID = '{0194C220-A303-11d0-9C4F-00A0C905425E}';
IID_IDirectPlayLobby2A: TGUID = '{1BB4AF80-A303-11d0-9C4F-00A0C905425E}';
IID_IDirectPlayLobby3: TGUID = '{2DB72490-652C-11d1-A7A8-0000F803ABFC}';
IID_IDirectPlayLobby3A: TGUID = '{2DB72491-652C-11d1-A7A8-0000F803ABFC}';
(****************************************************************************
*
* IDirectPlayLobby Structures
*
* Various structures used to invoke DirectPlayLobby.
*
****************************************************************************)
 
{ IDirectPlayLobby Structures }
 
{ TDPLAppInfo }
 
type
(*
* TDPLAppInfo
* Used to hold information about a registered DirectPlay
* application
*)
PDPLAppInfo = ^TDPLAppInfo;
TDPLAppInfo = record
TDPLAppInfo = packed record
dwSize: DWORD; // Size of this structure
guidApplication: TGUID; // GUID of the Application
case Integer of // Pointer to the Application Name
0: (lpszAppNameA: LPSTR);
1: (lpszAppName: LPWSTR);
0: (lpszAppName: PCharAW);
1: (lpszAppNameW: PWideChar);
3: (lpszAppNameA: PChar);
end;
 
DPLAPPINFO = TDPLAppInfo;
LPDPLAPPINFO = PDPLAppInfo;
 
{ TDPCompoundAddressElement }
 
(*
* TDPCompoundAddressElement
*
* An array of these is passed to CreateCompoundAddresses()
*)
PDPCompoundAddressElement = ^TDPCompoundAddressElement;
TDPCompoundAddressElement = record
TDPCompoundAddressElement = packed record
guidDataType: TGUID;
dwDataSize: DWORD;
lpData: Pointer;
end;
 
DPCOMPOUNDADDRESSELEMENT = TDPCompoundAddressElement;
LPDPCOMPOUNDADDRESSELEMENT = PDPCompoundAddressElement;
 
{ TDPApplicationDesc }
 
(*
* TDPApplicationDesc
* Used to register a DirectPlay application
*)
PDPApplicationDesc = ^TDPApplicationDesc;
TDPApplicationDesc = record
TDPApplicationDesc = packed record
dwSize: DWORD;
dwFlags: DWORD;
case Integer of
0: (
lpszApplicationNameA: LPSTR; // ANSI
case integer of
0 : (lpszApplicationName: PCharAW;
guidApplication: TGUID;
lpszFilenameA: LPSTR;
lpszCommandLineA: LPSTR;
lpszPathA: LPSTR;
lpszCurrentDirectoryA: LPSTR;
lpszDescriptionA: LPSTR;
lpszDescriptionW: LPWSTR;
);
1: (
lpszApplicationName: LPWSTR; // Unicode
_union1b: TGUID;
lpszFilename: LPWSTR;
lpszCommandLine: LPWSTR;
lpszPath: LPWSTR;
lpszCurrentDirectory: LPWSTR;
_union1g: LPWSTR;
);
lpszFilename: PCharAW;
lpszCommandLine: PCharAW;
lpszPath: PCharAW;
lpszCurrentDirectory: PCharAW;
lpszDescriptionA: PAnsiChar;
lpszDescriptionW: PWideChar);
1 : (lpszApplicationNameA: PAnsiChar;
filler1: TGUID;
lpszFilenameA: PAnsiChar;
lpszCommandLineA: PAnsiChar;
lpszPathA: PAnsiChar;
lpszCurrentDirectoryA: PAnsiChar);
2 : (lpszApplicationNameW: PWideChar;
filler2: TGUID;
lpszFilenameW: PWideChar;
lpszCommandLineW: PWideChar;
lpszPathW: PWideChar;
lpszCurrentDirectoryW: PWideChar);
end;
 
DPAPPLICATIONDESC = TDPApplicationDesc;
LPDPAPPLICATIONDESC = PDPApplicationDesc;
 
{ TDPApplicationDesc2 }
 
(*
* TDPApplicationDesc2
* Used to register a DirectPlay application
*)
PDPApplicationDesc2 = ^TDPApplicationDesc2;
TDPApplicationDesc2 = record
TDPApplicationDesc2 = packed record
dwSize: DWORD;
dwFlags: DWORD;
case Integer of
0: (
lpszApplicationNameA: LPSTR; // ANSI
case integer of
0 : (lpszApplicationName: PCharAW;
guidApplication: TGUID;
lpszFilenameA: LPSTR;
lpszCommandLineA: LPSTR;
lpszPathA: LPSTR;
lpszCurrentDirectoryA: LPSTR;
lpszDescriptionA: LPSTR;
lpszDescriptionW: LPWSTR;
lpszAppLauncherNameA: LPSTR;
);
1: (
lpszApplicationName: LPWSTR; // Unicode
_union1b: TGUID;
lpszFilename: LPWSTR;
lpszCommandLine: LPWSTR;
lpszPath: LPWSTR;
lpszCurrentDirectory: LPWSTR;
_union1g: LPWSTR;
lpszAppLauncherName: LPWSTR;
);
lpszFilename: PCharAW;
lpszCommandLine: PCharAW;
lpszPath: PCharAW;
lpszCurrentDirectory: PCharAW;
lpszDescriptionA: PAnsiChar;
lpszDescriptionW: PWideChar;
lpszAppLauncherName: PCharAW);
1 : (lpszApplicationNameA: PAnsiChar;
filler1: TGUID;
lpszFilenameA: PAnsiChar;
lpszCommandLineA: PAnsiChar;
lpszPathA: PAnsiChar;
lpszCurrentDirectoryA: PAnsiChar;
filler3: PChar;
filler4: PChar;
lpszAppLauncherNameA: PAnsiChar);
2 : (lpszApplicationNameW: PWideChar;
filler2: TGUID;
lpszFilenameW: PWideChar;
lpszCommandLineW: PWideChar;
lpszPathW: PWideChar;
lpszCurrentDirectoryW: PWideChar;
filler5: PChar;
filler6: PChar;
lpszAppLauncherNameW: PWideChar);
end;
 
DPAPPLICATIONDESC2 = TDPApplicationDesc2;
LPDPAPPLICATIONDESC2 = PDPApplicationDesc2;
 
{ Enumeration Method Callback Prototypes }
(****************************************************************************
*
* Enumeration Method Callback Prototypes
*
****************************************************************************)
 
TDPEnumAddressCallback = function(const guidDataType: TGUID;
(*
* Callback for EnumAddress()
*)
TDPEnumAdressCallback = function(const guidDataType: TGUID;
dwDataSize: DWORD; lpData: Pointer; lpContext: Pointer): BOOL; stdcall;
LPDPENUMADDRESSCALLBACK = TDPEnumAddressCallback;
 
(*
* Callback for EnumAddressTypes()
*)
TDPLEnumAddressTypesCallback = function(const guidDataType: TGUID;
lpContext: Pointer; dwFlags: DWORD): BOOL; stdcall;
LPDPLENUMADDRESSTYPESCALLBACK = TDPLEnumAddressTypesCallback;
 
(*
* Callback for EnumLocalApplications()
*)
TDPLEnumLocalApplicationsCallback = function(const lpAppInfo: TDPLAppInfo;
lpContext: Pointer; dwFlags: DWORD): BOOL; stdcall;
LPDPLENUMLOCALAPPLICATIONSCALLBACK = TDPLEnumLocalApplicationsCallback;
 
{ IDirectPlayLobby (and IDirectPlayLobbyA) Interface }
(****************************************************************************
*
* IDirectPlayLobby (and IDirectPlayLobbyA) Interface
*
****************************************************************************)
 
type
IDirectPlayLobby = interface(IUnknown)
['{AF465C71-9588-11CF-A020-00AA006157AC}']
// IDirectPlayLobby methods
IDirectPlayLobbyAW = interface (IUnknown)
(*** IDirectPlayLobby methods ***)
function Connect(dwFlags: DWORD; out lplpDP: IDirectPlay2;
pUnk: IUnknown): HResult; stdcall;
function CreateAddress(const guidSP, guidDataType: TGUID; const lpData;
function CreateAddress(const guidSP, guidDataType: TGUID; var lpData;
dwDataSize: DWORD; var lpAddress; var lpdwAddressSize: DWORD): HResult; stdcall;
function EnumAddress(lpEnumAddressCallback: TDPEnumAddressCallback;
const lpAddress; dwAddressSize: DWORD; lpContext : Pointer): HResult; stdcall;
function EnumAddress(lpEnumAddressCallback: TDPEnumAdressCallback;
var lpAddress; dwAddressSize: DWORD; lpContext : Pointer) : HResult; stdcall;
function EnumAddressTypes(lpEnumAddressTypeCallback:
TDPLEnumAddressTypesCallback; const guidSP: TGUID; lpContext: Pointer;
dwFlags: DWORD): HResult; stdcall;
function EnumLocalApplications(lpEnumLocalAppCallback:
TDPLEnumLocalApplicationsCallback; lpContext: Pointer; dwFlags: DWORD): HResult; stdcall;
function GetConnectionSettings(dwAppID: DWORD; var lpData: TDPLConnection;
function EnumLocalApplications(lpEnumLocalAppCallback: TDPLEnumLocalApplicationsCallback;
lpContext: Pointer; dwFlags: DWORD) : HResult; stdcall;
function GetConnectionSettings(dwAppID: DWORD; lpData: PDPLConnection;
var lpdwDataSize: DWORD): HResult; stdcall;
function ReceiveLobbyMessage(dwFlags: DWORD; dwAppID: DWORD;
var lpdwMessageFlags: DWORD; var lpData; var lpdwDataSize: DWORD): HResult; stdcall;
var lpdwMessageFlags: DWORD; lpData: Pointer; var lpdwDataSize: DWORD) : HResult; stdcall;
function RunApplication(dwFlags: DWORD; var lpdwAppId: DWORD;
const lpConn: TDPLConnection; hReceiveEvent: THandle): HResult; stdcall;
function SendLobbyMessage(dwFlags: DWORD; dwAppID: DWORD; const lpData;
dwDataSize: DWORD): HResult; stdcall;
function SetConnectionSettings(dwFlags: DWORD; dwAppID: DWORD;
const lpConn: TDPLConnection): HResult; stdcall;
var lpConn: TDPLConnection) : HResult; stdcall;
function SetLobbyMessageEvent(dwFlags: DWORD; dwAppID: DWORD;
hReceiveEvent: THandle): HResult; stdcall;
end;
 
IDirectPlayLobbyA = interface(IDirectPlayLobby)
['{26C66A70-B367-11CF-A024-00AA006157AC}']
IDirectPlayLobbyW = interface (IDirectPlayLobbyAW)
['{AF465C71-9588-11CF-A020-00AA006157AC}']
end;
IDirectPlayLobbyA = interface (IDirectPlayLobbyAW)
['{26C66A70-B367-11cf-A024-00AA006157AC}']
end;
 
{ IDirectPlayLobby2 (and IDirectPlayLobby2A) Interface }
{$IFDEF UNICODE}
IDirectPlayLobby = IDirectPlayLobbyW;
{$ELSE}
IDirectPlayLobby = IDirectPlayLobbyA;
{$ENDIF}
 
IDirectPlayLobby2 = interface(IDirectPlayLobby)
['{0194C220-A303-11D0-9C4F-00A0C905425E}']
// IDirectPlayLobby2 methods
 
(****************************************************************************
*
* IDirectPlayLobby2 (and IDirectPlayLobby2A) Interface
*
****************************************************************************)
 
IDirectPlayLobby2AW = interface(IDirectPlayLobbyAW)
(*** IDirectPlayLobby2 methods ***)
function CreateCompoundAddress(const lpElements: TDPCompoundAddressElement;
dwElementCount: DWORD; var lpAddress; var lpdwAddressSize: DWORD): HResult; stdcall;
dwElementCount: DWORD; lpAddress: Pointer; var lpdwAddressSize: DWORD) : HResult; stdcall;
end;
 
IDirectPlayLobby2A = interface(IDirectPlayLobby2)
['{1BB4AF80-A303-11D0-9C4F-00A0C905425E}']
IDirectPlayLobby2W = interface (IDirectPlayLobby2AW)
['{0194C220-A303-11D0-9C4F-00A0C905425E}']
end;
IDirectPlayLobby2A = interface (IDirectPlayLobby2AW)
['{1BB4AF80-A303-11d0-9C4F-00A0C905425E}']
end;
 
{ IDirectPlayLobby3 (and IDirectPlayLobby3A) Interface }
{$IFDEF UNICODE}
IDirectPlayLobby2 = IDirectPlayLobby2W;
{$ELSE}
IDirectPlayLobby2 = IDirectPlayLobby2A;
{$ENDIF}
 
IDirectPlayLobby3 = interface(IDirectPlayLobby2)
['{2DB72490-652C-11d1-A7A8-0000F803ABFC}']
// IDirectPlayLobby3 Methods
function ConnectEx(dwFlags: DWORD; const riid: TGUID; var lplpDP: Pointer;
pUnk: IUnknown): HResult; stdcall;
function RegisterApplication(dwFlags: DWORD; const lpAppDesc: TDPApplicationDesc): HResult; stdcall;
function UnRegisterApplication(dwFlags: DWORD; const guidApplication: TGUID): HResult; stdcall;
(****************************************************************************
*
* IDirectPlayLobby3 (and IDirectPlayLobby3A) Interface
*
****************************************************************************)
 
IDirectPlayLobby3AW = interface(IDirectPlayLobby2AW)
(*** IDirectPlayLobby3 methods ***)
function ConnectEx(dwFlags: DWORD; const riid: TGUID;
out lplpDP; pUnk: IUnknown) : HResult; stdcall;
function RegisterApplication(dwFlags: DWORD;
var lpAppDesc: TDPApplicationDesc) : HResult; stdcall;
function UnregisterApplication(dwFlags: DWORD;
const guidApplication: TGUID) : HResult; stdcall;
function WaitForConnectionSettings(dwFlags: DWORD): HResult; stdcall;
end;
 
IDirectPlayLobby3A = interface(IDirectPlayLobby3)
IDirectPlayLobby3W = interface (IDirectPlayLobby3AW)
['{2DB72490-652C-11d1-A7A8-0000F803ABFC}']
end;
IDirectPlayLobby3A = interface (IDirectPlayLobby3AW)
['{2DB72491-652C-11d1-A7A8-0000F803ABFC}']
end;
 
{ DirectPlayLobby API Prototypes }
{$IFDEF UNICODE}
IDirectPlayLobby3 = IDirectPlayLobby3W;
{$ELSE}
IDirectPlayLobby3 = IDirectPlayLobby3A;
{$ENDIF}
 
function DirectPlayLobbyCreateW(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobby;
lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HResult; stdcall;
function DirectPlayLobbyCreateA(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HResult; stdcall;
function DirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HResult; stdcall;
IID_IDirectPlayLobbyW = IDirectPlayLobbyW;
IID_IDirectPlayLobbyA = IDirectPlayLobbyA;
IID_IDirectPlayLobby = IDirectPlayLobby;
 
{ DirectPlayLobby Flags }
IID_IDirectPlayLobby2W = IDirectPlayLobby2W;
IID_IDirectPlayLobby2A = IDirectPlayLobby2A;
IID_IDirectPlayLobby2 = IDirectPlayLobby2;
 
IID_IDirectPlayLobby3W = IDirectPlayLobby3W;
IID_IDirectPlayLobby3A = IDirectPlayLobby3A;
IID_IDirectPlayLobby3 = IDirectPlayLobby3;
 
(****************************************************************************
*
* DirectPlayLobby API Prototypes
*
****************************************************************************)
 
var
DirectPlayLobbyCreateW : function (lpguidSP: PGUID; out lplpDPL:
IDirectPlayLobbyW; lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD) : HResult; stdcall;
DirectPlayLobbyCreateA : function (lpguidSP: PGUID; out lplpDPL:
IDirectPlayLobbyA; lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD) : HResult; stdcall;
DirectPlayLobbyCreate : function (lpguidSP: PGUID; out lplpDPL:
IDirectPlayLobby; lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD) : HResult; stdcall;
 
const
(****************************************************************************
*
* DirectPlayLobby Flags
*
****************************************************************************)
 
(*
* This flag is used by IDirectPlayLobby.WaitForConnectionSettings to
* cancel a current wait that is in progress.
*)
DPLWAIT_CANCEL = $00000001;
 
(*
* This is a message flag used by ReceiveLobbyMessage. It can be
* returned in the dwMessageFlags parameter to indicate a message from
* the system.
*)
DPLMSG_SYSTEM = $00000001;
 
(*
* This is a message flag used by ReceiveLobbyMessage and SendLobbyMessage.
* It is used to indicate that the message is a standard lobby message.
* TDPLMsg_SetProperty, TDPLMsg_SetPropertyResponse, TDPLMsg_GetProperty,
* TDPLMsg_GetPropertyResponse
*)
DPLMSG_STANDARD = $00000002;
 
type
(****************************************************************************
*
* DirectPlayLobby messages and message data structures
*
* All system messages have a dwMessageFlags value of DPLMSG_SYSTEM returned
* from a call to ReceiveLobbyMessage.
*
* All standard messages have a dwMessageFlags value of DPLMSG_STANDARD returned
* from a call to ReceiveLobbyMessage.
*
****************************************************************************)
 
{ DirectPlayLobby messages and message data structures }
 
{ TDPLMsg_Generic }
 
type
(*
* TDPLMsg_Generic
* Generic message structure used to identify the message type.
*)
PDPLMsg_Generic = ^TDPLMsg_Generic;
TDPLMsg_Generic = record
TDPLMsg_Generic = packed record
dwType: DWORD; // Message type
end;
 
DPLMSG_GENERIC = TDPLMsg_Generic;
LPDPLMSG_GENERIC = PDPLMsg_Generic;
 
{ TDPLMsg_SystemMessage }
 
(*
* TDPLMsg_SystemMessage
* Generic message format for all system messages --
* DPLSYS_CONNECTIONSETTINGSREAD, DPLSYS_DPLYCONNECTSUCCEEDED,
* DPLSYS_DPLAYCONNECTFAILED, DPLSYS_APPTERMINATED, DPLSYS_NEWCONNECTIONSETTINGS
*)
PDPLMsg_SystemMessage = ^TDPLMsg_SystemMessage;
TDPLMsg_SystemMessage = record
TDPLMsg_SystemMessage = packed record
dwType: DWORD; // Message type
guidInstance: TGUID; // Instance GUID of the dplay session the message corresponds to
end;
 
DPLMSG_SYSTEMMESSAGE = TDPLMsg_SystemMessage;
LPDPLMSG_SYSTEMMESSAGE = PDPLMsg_SystemMessage;
 
{ TDPLMsg_SetProperty }
 
(*
* TDPLMsg_SetProperty
* Standard message sent by an application to a lobby to set a
* property
*)
PDPLMsg_SetProperty = ^TDPLMsg_SetProperty;
TDPLMsg_SetProperty = record
TDPLMsg_SetProperty = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID (DPL_NOCONFIRMATION if no confirmation desired)
guidPlayer: TGUID; // Player GUID
10986,17 → 16471,17
dwPropertyData: array[0..0] of DWORD; // Buffer containing data
end;
 
DPLMSG_SETPROPERTY = TDPLMsg_SetProperty;
LPDPLMSG_SETPROPERTY = PDPLMsg_SetProperty;
 
const
DPL_NOCONFIRMATION = 0;
 
{ TDPLMsg_SetPropertyResponse }
 
type
(*
* TDPLMsg_SetPropertyResponse
* Standard message returned by a lobby to confirm a
* TDPLMsg_SetProperty message.
*)
PDPLMsg_SetPropertyResponse = ^TDPLMsg_SetPropertyResponse;
TDPLMsg_SetPropertyResponse = record
TDPLMsg_SetPropertyResponse = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID
guidPlayer: TGUID; // Player GUID
11004,26 → 16489,27
hr: HResult; // Return Code
end;
 
DPLMSG_SETPROPERTYRESPONSE = TDPLMsg_SetPropertyResponse;
LPDPLMSG_SETPROPERTYRESPONSE = PDPLMsg_SetPropertyResponse;
 
{ TDPLMsg_GetProperty }
 
(*
* TDPLMsg_GetProperty
* Standard message sent by an application to a lobby to request
* the current value of a property
*)
PDPLMsg_GetProperty = ^TDPLMsg_GetProperty;
TDPLMsg_GetProperty = record
TDPLMsg_GetProperty = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID
guidPlayer: TGUID; // Player GUID
guidPropertyTag: TGUID; // Property GUID
end;
LPDPLMSG_GETPROPERTY = ^TDPLMsg_GetProperty;
 
DPLMSG_GETPROPERTY = TDPLMsg_GetProperty;
LPDPLMSG_GETPROPERTY = PDPLMsg_GetProperty;
 
{ TDPLMsg_GetPropertyResponse }
 
(*
* TDPLMsg_GetPropertyResponse
* Standard message returned by a lobby in response to a
* TDPLMsg_GetProperty message.
*)
PDPLMsg_GetPropertyResponse = ^TDPLMsg_GetPropertyResponse;
TDPLMsg_GetPropertyResponse = record
TDPLMsg_GetPropertyResponse = packed record
dwType: DWORD; // Message type
dwRequestID: DWORD; // Request ID
guidPlayer: TGUID; // Player GUID
11033,97 → 16519,297
dwPropertyData: array[0..0] of DWORD; // Buffer containing data
end;
 
DPLMSG_GETPROPERTYRESPONSE = TDPLMsg_GetPropertyResponse;
LPDPLMSG_GETPROPERTYRESPONSE = PDPLMsg_GetPropertyResponse;
 
{ TDPLMsg_NewSessionHost }
 
(*
* TDPLMsg_NewSessionHost
* Standard message returned by a lobby in response to a
* the session host migrating to a new client
*)
PDPLMsg_NewSessionHost = ^TDPLMsg_NewSessionHost;
TDPLMsg_NewSessionHost = record
TDPLMsg_NewSessionHost = packed record
dwType: DWORD; // Message type
guidInstance: TGUID; // GUID Instance of the session
guidInstance: TGUID; // Property GUID
end;
 
DPLMSG_NEWSESSIONHOST = TDPLMsg_NewSessionHost;
LPDPLMSG_NEWSESSIONHOST = PDPLMsg_NewSessionHost;
const
(******************************************
*
* DirectPlay Lobby message dwType values
*
*****************************************)
 
{ DirectPlay Lobby message dwType values }
(*
* The application has read the connection settings.
* It is now O.K. for the lobby client to release
* its IDirectPlayLobby interface.
*)
DPLSYS_CONNECTIONSETTINGSREAD = $00000001;
 
const
DPLSYS_CONNECTIONSETTINGSREAD = $00000001;
(*
* The application's call to DirectPlayConnect failed
*)
DPLSYS_DPLAYCONNECTFAILED = $00000002;
 
(*
* The application has created a DirectPlay session.
*)
DPLSYS_DPLAYCONNECTSUCCEEDED = $00000003;
 
(*
* The application has terminated.
*)
DPLSYS_APPTERMINATED = $00000004;
 
(*
* The message is a TDPLMsg_SetProperty message.
*)
DPLSYS_SETPROPERTY = $00000005;
 
(*
* The message is a TDPLMsg_SetPropertyResponse message.
*)
DPLSYS_SETPROPERTYRESPONSE = $00000006;
 
(*
* The message is a TDPLMsg_GetProperty message.
*)
DPLSYS_GETPROPERTY = $00000007;
 
(*
* The message is a TDPLMsg_GetPropertyResponse message.
*)
DPLSYS_GETPROPERTYRESPONSE = $00000008;
 
(*
* The message is a TDPLMsg_NewSessionHost message.
*)
DPLSYS_NEWSESSIONHOST = $00000009;
 
(*
* New connection settings are available.
*)
DPLSYS_NEWCONNECTIONSETTINGS = $0000000A;
 
{ DirectPlay defined property GUIDs and associated data structures }
(****************************************************************************
*
* DirectPlay defined property GUIDs and associated data structures
*
****************************************************************************)
 
DPLPROPERTY_MessagesSupported: TGUID = '{762CCDA1-D916-11d0-BA39-00C04FD7ED67}';
DPLPROPERTY_LobbyGuid: TGUID = '{F56920A0-D218-11d0-BA39-00C04FD7ED67}';
DPLPROPERTY_PlayerGuid: TGUID = '{B4319322-D20D-11d0-BA39-00C04FD7ED67}';
(*
* DPLPROPERTY_MessagesSupported
*
* Request whether the lobby supports standard. Lobby with respond with either
* TRUE or FALSE or may not respond at all.
*
* Property data is a single BOOL with TRUE or FALSE
*)
// {762CCDA1-D916-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_MessagesSupported: TGUID =
(D1:$762ccda1;D2:$d916;D3:$11d0;D4:($ba,$39,$00,$c0,$4f,$d7,$ed,$67));
 
{ TDPLData_PlayerGUID }
(*
* DPLPROPERTY_LobbyGuid
*
* Request the GUID that identifies the lobby software that the application
* is communicating with.
*
* Property data is a single GUID.
*)
// {F56920A0-D218-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_LobbyGuid: TGUID =
(D1:$F56920A0;D2:$D218;D3:$11d0;D4:($ba,$39,$00,$c0,$4f,$d7,$ed,$67));
 
(*
* DPLPROPERTY_PlayerGuid
*
* Request the GUID that identifies the player on this machine for sending
* property data back to the lobby.
*
* Property data is the DPLDATA_PLAYERDATA structure
*)
// {B4319322-D20D-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_PlayerGuid: TGUID =
(D1:$b4319322;D2:$d20d;D3:$11d0;D4:($ba,$39,$00,$c0,$4f,$d7,$ed,$67));
 
type
(*
* TDPLData_PlayerGUID
*
* Data structure to hold the GUID of the player and player creation flags
* from the lobby.
*)
PDPLData_PlayerGUID = ^TDPLData_PlayerGUID;
TDPLData_PlayerGUID = record
TDPLData_PlayerGUID = packed record
guidPlayer: TGUID;
dwPlayerFlags: DWORD;
end;
 
DPLDATA_PLAYERGUID = TDPLData_PlayerGUID;
LPDPLDATA_PLAYERGUID = PDPLData_PlayerGUID;
 
{ DPLPROPERTY_PlayerScore }
 
const
DPLPROPERTY_PlayerScore: TGUID = '{48784000-D219-11d0-BA39-00C04FD7ED67}';
(*
* DPLPROPERTY_PlayerScore
*
* Used to send an array of long integers to the lobby indicating the
* score of a player.
*
* Property data is the TDPLData_PlayerScore structure.
*)
// {48784000-D219-11d0-BA39-00C04FD7ED67}
DPLPROPERTY_PlayerScore: TGUID =
(D1:$48784000;D2:$d219;D3:$11d0;D4:($ba,$39,$00,$c0,$4f,$d7,$ed,$67));
 
{ TDPLData_PlayerScore }
 
type
(*
* TDPLData_PlayerScore
*
* Data structure to hold an array of long integers representing a player score.
* Application must allocate enough memory to hold all the scores.
*)
PDPLData_PlayerScore = ^TDPLData_PlayerScore;
TDPLData_PlayerScore = record
TDPLData_PlayerScore = packed record
dwScoreCount: DWORD;
Score: array[0..0] of Longint;
Score: array[0..0] of LongInt;
end;
 
DPLDATA_PLAYERSCORE = TDPLData_PlayerScore;
LPDPLDATA_PLAYERSCORE = PDPLData_PlayerScore;
(****************************************************************************
*
* DirectPlay Address ID's
*
****************************************************************************)
 
{ DirectPlay Address ID's }
(* DirectPlay Address
*
* A DirectPlay address consists of multiple chunks of data, each tagged
* with a GUID signifying the type of data in the chunk. The chunk also
* has a length so that unknown chunk types can be skipped.
*
* The EnumAddress() function is used to parse these address data chunks.
*)
 
type
(*
* TDPAddress
*
* Header for block of address data elements
*)
PDPAddress = ^TDPAddress;
TDPAddress = record
TDPAddress = packed record
guidDataType: TGUID;
dwDataSize: DWORD;
end;
 
DPADDRESS = TDPAddress;
LPDPADDRESS = PDPAddress;
 
const
DPAID_TotalSize: TGUID = '{1318F560-912C-11d0-9DAA-00A0C90A43CB}';
DPAID_ServiceProvider: TGUID = '{07D916C0-E0AF-11cf-9C4E-00A0C905425E}';
DPAID_LobbyProvider: TGUID = '{59B95640-9667-11d0-A77D-0000F803ABFC}';
DPAID_Phone: TGUID = '{78EC89A0-E0AF-11cf-9C4E-00A0C905425E}';
DPAID_PhoneW: TGUID = '{BA5A7A70-9DBF-11d0-9CC1-00A0C905425E}';
DPAID_Modem: TGUID = '{F6DCC200-A2FE-11d0-9C4F-00A0C905425E}';
DPAID_ModemW: TGUID = '{01FD92E0-A2FF-11d0-9C4F-00A0C905425E}';
DPAID_INet: TGUID = '{C4A54DA0-E0AF-11cf-9C4E-00A0C905425E}';
DPAID_INetW: TGUID = '{E63232A0-9DBF-11d0-9CC1-00A0C905425E}';
DPAID_INetPort: TGUID = '{E4524541-8EA5-11d1-8A96-006097B01411}';
DPAID_MaxMessageSize: TGUID = '{F5D09980-F0C4-11d1-8326-006097B01411}';
(*
* DPAID_TotalSize
*
* Chunk is a DWORD containing size of entire TDPAddress structure
*)
 
{ TDPComPortAddress }
// {1318F560-912C-11d0-9DAA-00A0C90A43CB}
DPAID_TotalSize: TGUID =
(D1:$1318f560;D2:$912c;D3:$11d0;D4:($9d,$aa,$00,$a0,$c9,$a,$43,$cb));
 
const
(*
* DPAID_ServiceProvider
*
* Chunk is a GUID describing the service provider that created the chunk.
* All addresses must contain this chunk.
*)
 
// {07D916C0-E0AF-11cf-9C4E-00A0C905425E}
DPAID_ServiceProvider: TGUID =
(D1:$7d916c0;D2:$e0af;D3:$11cf;D4:($9c,$4e,$00,$a0,$c9,$5,$42,$5e));
 
(*
* DPAID_LobbyProvider
*
* Chunk is a GUID describing the lobby provider that created the chunk.
* All addresses must contain this chunk.
*)
 
// {59B95640-9667-11d0-A77D-0000F803ABFC}
DPAID_LobbyProvider: TGUID =
(D1:$59b95640;D2:$9667;D3:$11d0;D4:($a7,$7d,$00,$00,$f8,$3,$ab,$fc));
 
(*
* DPAID_Phone and DPAID_PhoneW
*
* Chunk is a string containing a phone number (i.e. "1-800-555-1212")
* in ANSI or UNICODE format
*)
 
// {78EC89A0-E0AF-11cf-9C4E-00A0C905425E}
DPAID_Phone: TGUID =
(D1:$78ec89a0;D2:$e0af;D3:$11cf;D4:($9c,$4e,$00,$a0,$c9,$5,$42,$5e));
 
// {BA5A7A70-9DBF-11d0-9CC1-00A0C905425E}
DPAID_PhoneW: TGUID =
(D1:$ba5a7a70;D2:$9dbf;D3:$11d0;D4:($9c,$c1,$00,$a0,$c9,$5,$42,$5e));
 
(*
* DPAID_Modem and DPAID_ModemW
*
* Chunk is a string containing a modem name registered with TAPI
* in ANSI or UNICODE format
*)
 
// {F6DCC200-A2FE-11d0-9C4F-00A0C905425E}
DPAID_Modem: TGUID =
(D1:$f6dcc200;D2:$a2fe;D3:$11d0;D4:($9c,$4f,$00,$a0,$c9,$5,$42,$5e));
 
// {01FD92E0-A2FF-11d0-9C4F-00A0C905425E}
DPAID_ModemW: TGUID =
(D1:$1fd92e0;D2:$a2ff;D3:$11d0;D4:($9c,$4f,$00,$a0,$c9,$5,$42,$5e));
 
(*
* DPAID_Inet and DPAID_InetW
*
* Chunk is a string containing a TCP/IP host name or an IP address
* (i.e. "dplay.microsoft.com" or "137.55.100.173") in ANSI or UNICODE format
*)
 
// {C4A54DA0-E0AF-11cf-9C4E-00A0C905425E}
DPAID_INet: TGUID =
(D1:$c4a54da0;D2:$e0af;D3:$11cf;D4:($9c,$4e,$00,$a0,$c9,$5,$42,$5e));
 
// {E63232A0-9DBF-11d0-9CC1-00A0C905425E}
DPAID_INetW: TGUID =
(D1:$e63232a0;D2:$9dbf;D3:$11d0;D4:($9c,$c1,$00,$a0,$c9,$5,$42,$5e));
 
(*
* DPAID_InetPort
*
* Chunk is the port number used for creating the apps TCP and UDP sockets.
* WORD value (i.e. 47624)
*)
 
// {E4524541-8EA5-11d1-8A96-006097B01411}
DPAID_INetPort: TGUID =
(D1:$e4524541;D2:$8ea5;D3:$11d1;D4:($8a,$96,$00,$60,$97,$b0,$14,$11));
 
//@@BEGIN_MSINTERNAL
(*
* DPAID_MaxMessageSize
*
* Tells DPLAY what the maximum allowed message size is. Enables SPs to
* combat Denial of Service attacks
*)
 
// this terrible hack is needed so the SP can work with the Elmer build.
// it can be removed when the MSINTERNAL stuff is removed
{$DEFINE MAXMSGSIZEGUIDDEFINED}
 
// {F5D09980-F0C4-11d1-8326-006097B01411}
DPAID_MaxMessageSize: TGUID =
(D1:$f5d09980;D2:$f0c4;D3:$11d1;D4:($83,$26,$00,$60,$97,$b0,$14,$11));
//@@END_MSINTERNAL
 
(*
* TDPComPortAddress
*
* Used to specify com port settings. The constants that define baud rate,
* stop bits and parity are defined in WINBASE.H. The constants for flow
* control are given below.
*)
 
DPCPA_NOFLOW = 0; // no flow control
DPCPA_XONXOFFFLOW = 1; // software flow control
DPCPA_RTSFLOW = 2; // hardware flow control with RTS
11132,7 → 16818,7
 
type
PDPComPortAddress = ^TDPComPortAddress;
TDPComPortAddress = record
TDPComPortAddress = packed record
dwComPort: DWORD; // COM port to use (1-4)
dwBaudRate: DWORD; // baud rate (100-256k)
dwStopBits: DWORD; // no. stop bits (1-2)
11140,16 → 16826,28
dwFlowControl: DWORD; // flow control (none, xon/xoff, rts, dtr)
end;
 
DPCOMPORTADDRESS = TDPComPortAddress;
LPDPCOMPORTADDRESS = PDPComPortAddress;
 
const
DPAID_ComPort: TGUID = '{F2F0CE00-E0AF-11cf-9C4E-00A0C905425E}';
(*
* DPAID_ComPort
*
* Chunk contains a TDPComPortAddress structure defining the serial port.
*)
 
{ dplobby 1.0 obsolete definitions }
// {F2F0CE00-E0AF-11cf-9C4E-00A0C905425E}
DPAID_ComPort: TGUID =
(D1:$f2f0ce00;D2:$e0af;D3:$11cf;D4:($9c,$4e,$00,$a0,$c9,$5,$42,$5e));
 
(****************************************************************************
*
* dplobby 1.0 obsolete definitions
* Included for compatibility only.
*
****************************************************************************)
 
DPLAD_SYSTEM = DPLMSG_SYSTEM;
 
 
//DirectSetup file
(*==========================================================================
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
11157,10 → 16855,28
* File: dsetup.h
* Content: DirectXSetup, error codes and flags
*
* DirectX 7.0 Delphi adaptation by Erik Unger
*
* Modyfied: 05-Oct-99
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
***************************************************************************)
 
var
DSetupDLL : HModule;
 
type
PDLSVersion = ^TDLSVersion;
TDLSVersion = packed record
dwVersionMS: DWORD;
dwVersionLS: DWORD;
end;
 
 
const
FOURCC_VERS = Ord('v') + Ord('e')*$100 + Ord('r')*$10000 + Ord('s')*$1000000;
FOURCC_VERS : array[0..3] of Char = ('v','e','r','s');
 
// DSETUP Error Codes, must remain compatible with previous setup.
DSETUPERR_SUCCESS_RESTART = HResult(1);
11174,6 → 16890,7
DSETUPERR_CANTFINDINF = HResult(-7);
DSETUPERR_CANTFINDDIR = HResult(-8);
DSETUPERR_INTERNAL = HResult(-9);
DSETUPERR_NTWITHNO3D = HResult(-10); // REM: obsolete, you'll never see this
DSETUPERR_UNKNOWNOS = HResult(-11);
DSETUPERR_USERHITCANCEL = HResult(-12);
DSETUPERR_NOTPREINSTALLEDONNT = HResult(-13);
11186,11 → 16903,12
DSETUP_DIRECTX = DSETUP_DXCORE or DSETUP_DDRAWDRV or DSETUP_DSOUNDDRV;
DSETUP_TESTINSTALL = $00020000; (* just test install, don't do anything *)
DSETUP_USEROLDERFLAG = $02000000; (* enable return DSETUPERR_NEWERVERSION *)
// Bug #22730
DSETUP_NTINSTALL = $00080000; (* install on Win2K platform *)
 
// These OBSOLETE flags are here for compatibility with pre-DX5 apps only.
// They are present to allow DX3 apps to be recompiled with DX5 and still work.
// DO NOT USE THEM for DX5. They will go away in future DX releases.
 
DSETUP_DDRAW = $00000001; (* OBSOLETE. install DirectDraw *)
DSETUP_DSOUND = $00000002; (* OBSOLETE. install DirectSound *)
DSETUP_DPLAY = $00000004; (* OBSOLETE. install DirectPlay *)
11242,45 → 16960,21
DSETUP_CB_UPGRADE_DEVICE_DISPLAY = $1000;
DSETUP_CB_UPGRADE_DEVICE_MEDIA = $2000;
 
 
type
 
{ TDLSVersion }
 
PDLSVersion = ^TDLSVersion;
TDLSVersion = record
dwVersionMS: DWORD;
dwVersionLS: WORD;
end;
 
DLSVERSION = TDLSVersion;
LPDLSVERSION = PDLSVersion;
 
{ TDSetup_CB_UpgradeInfo }
 
PDSetup_CB_UpgradeInfo = ^TDSetup_CB_UpgradeInfo;
TDSetup_CB_UpgradeInfo = record
UpgradeFlags: DWORD;
end;
 
DSETUP_CB_UPGRADEINFO = TDSetup_CB_UpgradeInfo;
LPDSETUP_CB_UPGRADEINFO = PDSetup_CB_UpgradeInfo;
 
{ TDSetup_CB_FileCopyError }
 
PDSetup_CB_FileCopyError = ^TDSetup_CB_FileCopyError;
TDSetup_CB_FileCopyError = record
dwError: DWORD;
end;
 
DSETUP_CB_FILECOPYERROR = TDSetup_CB_FileCopyError;
LPDSETUP_CB_FILECOPYERROR = PDSetup_CB_FileCopyError;
 
//
// Data Structures
//
 
{ TDirectXRegisterAppA }
 
PDirectXRegisterAppA = ^TDirectXRegisterAppA;
TDirectXRegisterAppA = record
dwSize: DWORD;
11293,11 → 16987,6
lpszCurrentDirectory: PAnsiChar;
end;
 
DIRECTXREGISTERAPPA = TDirectXRegisterAppA;
LPDIRECTXREGISTERAPPA = PDirectXRegisterAppA;
 
{ TDirectXRegisterApp2A }
 
PDirectXRegisterApp2A = ^TDirectXRegisterApp2A;
TDirectXRegisterApp2A = record
dwSize: DWORD;
11311,11 → 17000,6
lpszLauncherName: PAnsiChar;
end;
 
DIRECTXREGISTERAPP2A = TDirectXRegisterApp2A;
LPDIRECTXREGISTERAPP2A = PDirectXRegisterApp2A;
 
{ TDirectXRegisterAppW }
 
PDirectXRegisterAppW = ^TDirectXRegisterAppW;
TDirectXRegisterAppW = record
dwSize: DWORD;
11328,11 → 17012,6
lpszCurrentDirectory: PWideChar;
end;
 
DIRECTXREGISTERAPPW = TDirectXRegisterAppW;
LPDIRECTXREGISTERAPPW = PDirectXRegisterAppW;
 
{ TDirectXRegisterApp2W }
 
PDirectXRegisterApp2W = ^TDirectXRegisterApp2W;
TDirectXRegisterApp2W = record
dwSize: DWORD;
11346,75 → 17025,102
lpszLauncherName: PWideChar;
end;
 
DIRECTXREGISTERAPP2W = TDirectXRegisterApp2W;
LPDIRECTXREGISTERAPP2W = PDirectXRegisterApp2W;
 
{ TDirectXRegisterApp }
 
PDirectXRegisterApp = PDirectXRegisterAppA;
PDirectXRegisterApp = ^TDirectXRegisterApp;
PDirectXRegisterApp2 = ^TDirectXRegisterApp2;
{$IFDEF UNICODE}
TDirectXRegisterApp = TDirectXRegisterAppW;
TDirectXRegisterApp2 = TDirectXRegisterApp2W;
{$ELSE}
TDirectXRegisterApp = TDirectXRegisterAppA;
 
PDirectXRegisterApp2 = PDirectXRegisterApp2A;
TDirectXRegisterApp2 = TDirectXRegisterApp2A;
{$ENDIF}
 
DIRECTXREGISTERAPP = TDirectXRegisterApp;
LPDIRECTXREGISTERAPP = PDirectXRegisterApp;
//
// API
//
var
DirectXSetupW : function (hWnd: HWND; lpszRootPath: PWideChar; dwFlags: DWORD) : Integer; stdcall;
DirectXSetupA : function (hWnd: HWND; lpszRootPath: PAnsiChar; dwFlags: DWORD) : Integer; stdcall;
DirectXSetup : function (hWnd: HWND; lpszRootPath: PCharAW; dwFlags: DWORD) : Integer; stdcall;
 
DIRECTXREGISTERAPP2 = TDirectXRegisterApp2;
LPDIRECTXREGISTERAPP2 = PDirectXRegisterApp2;
DirectXDeviceDriverSetupW : function (hWnd: HWND; lpszDriverClass: PWideChar;
lpszDriverPath: PWideChar; dwFlags: DWORD) : Integer; stdcall;
DirectXDeviceDriverSetupA : function (hWnd: HWND; lpszDriverClass: PAnsiChar;
lpszDriverPath: PAnsiChar; dwFlags: DWORD) : Integer; stdcall;
DirectXDeviceDriverSetup : function (hWnd: HWND; lpszDriverClass: PCharAW;
lpszDriverPath: PCharAW; dwFlags: DWORD) : Integer; stdcall;
 
{ API }
DirectXRegisterApplicationW : function
(hWnd: HWND; const lpDXRegApp: TDirectXRegisterAppW) : Integer; stdcall;
DirectXRegisterApplicationA : function
(hWnd: HWND; const lpDXRegApp: TDirectXRegisterAppA) : Integer; stdcall;
DirectXRegisterApplication : function
(hWnd: HWND; const lpDXRegApp: TDirectXRegisterApp) : Integer; stdcall;
 
function DirectXSetupA(hWnd: HWND; lpszRootPath: PAnsiChar; dwFlags: DWORD): Longint; stdcall;
function DirectXSetupW(hWnd: HWND; lpszRootPath: PWideChar; dwFlags: DWORD): Longint; stdcall;
function DirectXSetup(hWnd: HWND; lpszRootPath: PAnsiChar; dwFlags: DWORD): Longint; stdcall;
DirectXUnRegisterApplication : function
(hWnd: HWND; const lpGUID: TGUID) : Integer; stdcall;
 
function DirectXDeviceDriverSetupA(hWnd: HWND; lpszDriverClass: PAnsiChar;
lpszDriverPath: PAnsiChar; dwFlags: DWORD): Longint; stdcall;
function DirectXDeviceDriverSetupW(hWnd: HWND; lpszDriverClass: PWideChar;
lpszDriverPath: PWideChar; dwFlags: DWORD): Longint; stdcall;
function DirectXDeviceDriverSetup(hWnd: HWND; lpszDriverClass: PAnsiChar;
lpszDriverPath: PAnsiChar; dwFlags: DWORD): Longint; stdcall;
type
TDSetup_Callback = function (Reason: DWORD; MsgType: DWORD; // Same as flags to MessageBox
szMessage: PChar; szName: PChar; pInfo: Pointer) : DWORD; stdcall;
 
function DirectXRegisterApplicationA(hWnd: HWND; const lpDXRegApp: TDirectXRegisterAppA): Longint; stdcall;
function DirectXRegisterApplicationW(hWnd: HWND; const lpDXRegApp: TDirectXRegisterAppW): Longint; stdcall;
function DirectXRegisterApplication(hWnd: HWND; const lpDXRegApp: TDirectXRegisterAppA): Longint; stdcall;
function DirectXUnRegisterApplication(hWnd: HWND; const lpGUID: TGUID): Longint; stdcall;
var
DirectXSetupSetCallback : function (Callback: TDSetup_Callback) : Integer; stdcall;
 
type
TDSetup_Callback = function (Reason: DWORD; MsgType: DWORD;
szMessage: PAnsiChar; szName: PAnsiChar; pInfo: Pointer): DWORD; stdcall;
DSETUP_CALLBACK = TDSetup_Callback;
DirectXSetupGetVersion : function (out lpdwVersion, lpdwMinorVersion: DWORD) : Integer; stdcall;
 
function DirectXSetupSetCallback(Callback: TDSetup_Callback): Longint; stdcall;
function DirectXSetupGetVersion(var lpdwVersion, lpdwMinorVersion: DWORD): Longint; stdcall;
 
//DirectSound file
(*==========================================================================;
*
* Copyright (C) 1995,1996 Microsoft Corporation. All Rights Reserved.
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dsound.h
* Content: DirectSound include file
*
**************************************************************************)
* DirectX 7.0 Delphi adaptation by Erik Unger
*
* Modified: 10-Sep-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
***************************************************************************)
 
{ GUIDS used by DirectDraw objects }
{
Windows 98 and debug versions DInput and DSound
 
Under Windows 98, the "debug" setup of the DirectX SDK 6.x skips DInput.DLL
and DSound.DLL, i.e. makes you end up with the retail version of these two
files without any notice.
The debug versions of DInput.DLL and DSound.DLL can be found in the
\extras\Win98\Win98Dbg folder of the SDK CD; they need to be installed
"manually".
}
 
 
var
DSoundDLL : HMODULE;
function DSErrorString(Value: HResult) : string;
 
const
CLSID_DirectSound: TGUID = '{47D4D946-62E8-11cf-93BC-444553540000}';
CLSID_DirectSoundCapture: TGUID = '{B0210780-89CD-11d0-AF08-00A0C925CD16}';
_FACDS = $878;
function MAKE_DSHResult(code: DWORD) : HResult;
 
IID_IDirectSound: TGUID = '{279AFA83-4981-11CE-A521-0020AF0BE560}';
IID_IDirectSoundBuffer: TGUID = '{279AFA85-4981-11CE-A521-0020AF0BE560}';
IID_IDirectSound3DListener: TGUID = '{279AFA84-4981-11CE-A521-0020AF0BE560}';
IID_IDirectSound3DBuffer: TGUID = '{279AFA86-4981-11CE-A521-0020AF0BE560}';
IID_IDirectSoundCapture: TGUID = '{B0210781-89CD-11D0-AF08-00A0C925CD16}';
IID_IDirectSoundCaptureBuffer: TGUID = '{B0210782-89CD-11D0-AF08-00A0C925CD16}';
const
FLT_MIN = 1.175494351E-38;
FLT_MAX = 3.402823466E+38;
 
IID_IDirectSoundNotify: TGUID = '{B0210783-89CD-11D0-AF08-00A0C925CD16}';
const
// Direct Sound Component GUID {47D4D946-62E8-11cf-93BC-444553540000}
CLSID_DirectSound: TGUID = '{47D4D946-62E8-11cf-93BC-444553540000}';
 
{ DirectSound Structures }
// DirectSound Capture Component GUID {B0210780-89CD-11d0-AF08-00A0C925CD16}
CLSID_DirectSoundCapture: TGUID = '{47D4D946-62E8-11cf-93BC-444553540000}';
 
//
// Structures
//
type
IDirectSound = interface;
IDirectSoundBuffer = interface;
11423,11 → 17129,10
IDirectSoundCapture = interface;
IDirectSoundCaptureBuffer = interface;
IDirectSoundNotify = interface;
IKsPropertySet = interface;
 
{ TDSCaps }
 
PDSCaps = ^TDSCaps;
TDSCaps = record
TDSCaps = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwMinSecondarySampleRate: DWORD;
11453,14 → 17158,10
dwReserved1: DWORD;
dwReserved2: DWORD;
end;
PCDSCaps = ^TDSCaps;
 
DSCAPS = TDSCaps;
LPDSCAPS = PDSCaps;
 
{ TDSBCaps }
 
PDSBCaps = ^TDSBCaps;
TDSBCaps = record
TDSBCaps = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwBufferBytes: DWORD;
11467,45 → 17168,61
dwUnlockTransferRate: DWORD;
dwPlayCpuOverhead: DWORD;
end;
PCDSBCaps = ^TDSBCaps;
 
DSBCAPS = TDSBCaps;
LPDSBCAPS = DSBCAPS;
 
{ TDSBufferDesc }
 
PDSBufferDesc = ^TDSBufferDesc;
TDSBufferDesc = record
TDSBufferDesc_DX6 = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwBufferBytes: DWORD;
dwReserved: DWORD;
lpwfxFormat: PWaveFormatEx;
{$IFDEF SupportDirectX7}
guid3DAlgorithm: TGUID;
{$ENDIF}
end;
 
DSBUFFERDESC = TDSBufferDesc;
LPDSBUFFERDESC = PDSBufferDesc;
TDSBufferDesc1 = TDSBufferDesc_DX6;
PDSBufferDesc1 = ^TDSBufferDesc1;
PCDSBufferDesc1 = PDSBufferDesc1;
 
{ TDSBufferDesc1 }
 
PDSBufferDesc1 = ^TDSBufferDesc1;
TDSBufferDesc1 = record
TDSBufferDesc_DX7 = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwBufferBytes: DWORD;
dwReserved: DWORD;
lpwfxFormat: PWaveFormatEx;
guid3DAlgorithm: TGUID;
end;
 
DSBUFFERDESC1 = TDSBufferDesc1;
LPDSBUFFERDESC1 = PDSBufferDesc1;
{$IFDEF DIRECTX6}
TDSBufferDesc = TDSBufferDesc_DX6;
{$ELSE}
TDSBufferDesc = TDSBufferDesc_DX7;
{$ENDIF}
 
{ TDS3DBuffer }
PDSBufferDesc = ^TDSBufferDesc;
PCDSBufferDesc = PDSBufferDesc;
 
(***
// Snipped from D3DTypes.pas:
 
TD3DValue = Single;
 
PD3DVector = ^TD3DVector;
TD3DVector = packed record
case Integer of
0: (
x: TD3DValue;
y: TD3DValue;
z: TD3DValue;
);
1: (
dvX: TD3DValue;
dvY: TD3DValue;
dvZ: TD3DValue;
);
end;
*)
 
PDS3DBuffer = ^TDS3DBuffer;
TDS3DBuffer = record
TDS3DBuffer = packed record
dwSize: DWORD;
vPosition: TD3DVector;
vVelocity: TD3DVector;
11512,19 → 17229,15
dwInsideConeAngle: DWORD;
dwOutsideConeAngle: DWORD;
vConeOrientation: TD3DVector;
lConeOutsideVolume: Longint;
lConeOutsideVolume: LongInt;
flMinDistance: TD3DValue;
flMaxDistance: TD3DValue;
dwMode: DWORD;
end;
TCDS3DBuffer = ^TDS3DBuffer;
 
DS3DBUFFER = TDS3DBuffer;
LPDS3DBUFFER = PDS3DBuffer;
 
{ TDS3DListener }
 
PDS3DListener = ^TDS3DListener;
TDS3DListener = record
TDS3DListener = packed record
dwSize: DWORD;
vPosition: TD3DVector;
vVelocity: TD3DVector;
11534,27 → 17247,19
flRolloffFactor: TD3DValue;
flDopplerFactor: TD3DValue;
end;
PCDS3DListener = ^TDS3DListener;
 
DS3DLISTENER = TDS3DListener;
LPDS3DLISTENER = PDS3DListener;
 
{ TDSCCaps }
 
PDSCCaps = ^TDSCCaps;
TDSCCaps = record
TDSCCaps = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwFormats: DWORD;
dwChannels: DWORD;
end;
PCDSCCaps = ^TDSCCaps;
 
DSCCAPS = TDSCCaps;
LPDSCCAPS = PDSCCaps;
 
{ TDSCBufferDesc }
 
PDSCBufferDesc = ^TDSCBufferDesc;
TDSCBufferDesc = record
TDSCBufferDesc = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwBufferBytes: DWORD;
11561,41 → 17266,45
dwReserved: DWORD;
lpwfxFormat: PWaveFormatEx;
end;
PCDSCBufferDesc = ^TDSCBufferDesc;
 
DSCBUFFERDESC = TDSCBufferDesc;
LPDSCBUFFERDESC = PDSCBufferDesc;
 
{ TDSCBCaps }
 
PDSCBCaps = ^TDSCBCaps;
TDSCBCaps = record
TDSCBCaps = packed record
dwSize: DWORD;
dwFlags: DWORD;
dwBufferBytes: DWORD;
dwReserved: DWORD;
end;
PCDSCBCaps = ^TDSCBCaps;
 
DSCBCAPS = TDSCBCaps;
LPDSCBCAPS = PDSCBCaps;
 
{ TDSBPositionNotify }
 
PDSBPositionNotify = ^TDSBPositionNotify;
TDSBPositionNotify = record
TDSBPositionNotify = packed record
dwOffset: DWORD;
hEventNotify: THandle;
end;
PCDSBPositionNotify = ^TDSBPositionNotify;
 
DSBPOSITIONNOTIFY = TDSBPositionNotify;
LPDSBPOSITIONNOTIFY = PDSBPositionNotify;
//
// DirectSound API
//
TDSEnumCallbackW = function (lpGuid: PGUID; lpstrDescription: PWideChar;
lpstrModule: PWideChar; lpContext: Pointer) : BOOL; stdcall;
TDSEnumCallbackA = function (lpGuid: PGUID; lpstrDescription: PAnsiChar;
lpstrModule: PAnsiChar; lpContext: Pointer) : BOOL; stdcall;
{$IFDEF UNICODE}
TDSEnumCallback = TDSEnumCallbackW;
{$ELSE}
TDSEnumCallback = TDSEnumCallbackA;
{$ENDIF}
 
{ IDirectSound }
 
//
// IDirectSound
//
IDirectSound = interface(IUnknown)
['{279AFA83-4981-11CE-A521-0020AF0BE560}']
// IDirectSound methods
function CreateSoundBuffer(const lpDSBufferDesc: TDSBufferDesc;
out lplpDirectSoundBuffer: IDirectSoundBuffer;
out lpIDirectSoundBuffer: IDirectSoundBuffer;
pUnkOuter: IUnknown): HResult; stdcall;
function GetCaps(var lpDSCaps: TDSCaps): HResult; stdcall;
function DuplicateSoundBuffer(lpDsbOriginal: IDirectSoundBuffer;
11607,31 → 17316,32
function Initialize(lpGuid: PGUID): HResult; stdcall;
end;
 
{ IDirectSoundBuffer }
 
//
// IDirectSoundBuffer
//
IDirectSoundBuffer = interface(IUnknown)
['{279AFA85-4981-11CE-A521-0020AF0BE560}']
// IDirectSoundBuffer methods
function GetCaps(var lpDSBufferCaps: TDSBCaps): HResult; stdcall;
function GetCurrentPosition(var lpdwCurrentPlayCursor,
lpdwCurrentWriteCursor: DWORD): HResult; stdcall;
function GetFormat(var lpwfxFormat: TWaveFormatEx; dwSizeAllocated: DWORD;
var lpdwSizeWritten: DWORD): HResult; stdcall;
function GetVolume(var lplVolume: Longint): HResult; stdcall;
function GetPan(var lplPan: Longint): HResult; stdcall;
function GetCaps(var lpDSCaps: TDSBCaps) : HResult; stdcall;
function GetCurrentPosition
(lpdwCapturePosition, lpdwReadPosition : PDWORD) : HResult; stdcall;
function GetFormat(lpwfxFormat: PWaveFormatEx; dwSizeAllocated: DWORD;
lpdwSizeWritten: PWORD) : HResult; stdcall;
function GetVolume(var lplVolume: integer) : HResult; stdcall;
function GetPan(var lplPan: integer) : HResult; stdcall;
function GetFrequency(var lpdwFrequency: DWORD): HResult; stdcall;
function GetStatus(var lpdwStatus: DWORD): HResult; stdcall;
function Initialize(lpDirectSound: IDirectSound; const
lpDSBufferDesc: TDSBufferDesc): HResult; stdcall;
function Lock(dwWriteCursor: DWORD; dwWriteBytes: DWORD;
function Initialize(lpDirectSound: IDirectSound;
const lpcDSBufferDesc: TDSBufferDesc) : HResult; stdcall;
function Lock(dwWriteCursor, dwWriteBytes: DWORD;
var lplpvAudioPtr1: Pointer; var lpdwAudioBytes1: DWORD;
var lplpvAudioPtr2: Pointer; var lpdwAudioBytes2: DWORD;
dwFlags: DWORD): HResult; stdcall;
function Play(dwReserved1, dwReserved2: DWORD; dwFlags: DWORD): HResult; stdcall;
function SetCurrentPosition(dwNewPosition: DWORD): HResult; stdcall;
function SetFormat(const lpfxFormat: TWaveFormatEx): HResult; stdcall;
function SetVolume(lVolume: Longint): HResult; stdcall;
function SetPan(lPan: Longint): HResult; stdcall;
function Play(dwReserved1,dwReserved2,dwFlags: DWORD) : HResult; stdcall;
function SetCurrentPosition(dwPosition: DWORD) : HResult; stdcall;
function SetFormat(const lpcfxFormat: TWaveFormatEx) : HResult; stdcall;
function SetVolume(lVolume: integer) : HResult; stdcall;
function SetPan(lPan: integer) : HResult; stdcall;
function SetFrequency(dwFrequency: DWORD): HResult; stdcall;
function Stop: HResult; stdcall;
function Unlock(lpvAudioPtr1: Pointer; dwAudioBytes1: DWORD;
11639,49 → 17349,59
function Restore: HResult; stdcall;
end;
 
{ IDirectSound3DListener }
 
//
// IDirectSound3DListener
//
IDirectSound3DListener = interface(IUnknown)
['{279AFA84-4981-11CE-A521-0020AF0BE560}']
// IDirectSound3DListener methods
// IDirectSound3D methods
function GetAllParameters(var lpListener: TDS3DListener): HResult; stdcall;
function GetDistanceFactor(var lpflDistanceFactor: TD3DValue): HResult; stdcall;
function GetDopplerFactor(var lpflDopplerFactor: TD3DValue): HResult; stdcall;
function GetOrientation(var lpvOrientFront, lpvOrientTop: TD3DVector): HResult; stdcall;
function GetOrientation
(var lpvOrientFront, lpvOrientTop: TD3DVector) : HResult; stdcall;
function GetPosition(var lpvPosition: TD3DVector): HResult; stdcall;
function GetRolloffFactor(var lpflRolloffFactor: TD3DValue): HResult; stdcall;
function GetVelocity(var lpvVelocity: TD3DVector): HResult; stdcall;
function SetAllParameters(const lpListener: TDS3DListener; dwApply: DWORD): HResult; stdcall;
function SetDistanceFactor(flDistanceFactor: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetDopplerFactor(flDopplerFactor: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetAllParameters
(const lpcListener: TDS3DListener; dwApply: DWORD) : HResult; stdcall;
function SetDistanceFactor
(flDistanceFactor: TD3DValue; dwApply: DWORD) : HResult; stdcall;
function SetDopplerFactor
(flDopplerFactor: TD3DValue; dwApply: DWORD) : HResult; stdcall;
function SetOrientation(xFront, yFront, zFront, xTop, yTop, zTop: TD3DValue;
dwApply: DWORD): HResult; stdcall;
function SetPosition(x, y, z: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetRolloffFactor(flRolloffFactor: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetRolloffFactor
(flRolloffFactor: TD3DValue; dwApply: DWORD) : HResult; stdcall;
function SetVelocity(x, y, z: TD3DValue; dwApply: DWORD): HResult; stdcall;
function CommitDeferredSettings: HResult; stdcall;
end;
 
{ IDirectSound3DBuffer }
 
//
// IDirectSound3DBuffer
//
IDirectSound3DBuffer = interface(IUnknown)
['{279AFA86-4981-11CE-A521-0020AF0BE560}']
// IDirectSound3DBuffer methods
// IDirectSoundBuffer3D methods
function GetAllParameters(var lpDs3dBuffer: TDS3DBuffer): HResult; stdcall;
function GetConeAngles(var lpdwInsideConeAngle: DWORD;
var lpdwOutsideConeAngle: DWORD): HResult; stdcall;
function GetConeAngles
(var lpdwInsideConeAngle, lpdwOutsideConeAngle: DWORD) : HResult; stdcall;
function GetConeOrientation(var lpvOrientation: TD3DVector): HResult; stdcall;
function GetConeOutsideVolume(var lplConeOutsideVolume: Longint): HResult; stdcall;
function GetConeOutsideVolume(var lplConeOutsideVolume: integer) : HResult; stdcall;
function GetMaxDistance(var lpflMaxDistance: TD3DValue): HResult; stdcall;
function GetMinDistance(var lpflMinDistance: TD3DValue): HResult; stdcall;
function GetMode(var lpdwMod: DWORD): HResult; stdcall;
function GetMode(var lpdwMode: DWORD) : HResult; stdcall;
function GetPosition(var lpvPosition: TD3DVector): HResult; stdcall;
function GetVelocity(var lpvVelocity: TD3DVector): HResult; stdcall;
function SetAllParameters(const lpDs3dBuffer: TDS3DBuffer; dwApply: DWORD): HResult; stdcall;
function SetConeAngles(dwInsideConeAngle: DWORD; dwOutsideConeAngle: DWORD;
dwApply: DWORD): HResult; stdcall;
function SetAllParameters
(const lpcDs3dBuffer: TDS3DBuffer; dwApply: DWORD) : HResult; stdcall;
function SetConeAngles
(dwInsideConeAngle, dwOutsideConeAngle, dwApply: DWORD) : HResult; stdcall;
function SetConeOrientation(x, y, z: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetConeOutsideVolume(lConeOutsideVolume: Longint; dwApply: DWORD): HResult; stdcall;
function SetConeOutsideVolume
(lConeOutsideVolume: LongInt; dwApply: DWORD) : HResult; stdcall;
function SetMaxDistance(flMaxDistance: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetMinDistance(flMinDistance: TD3DValue; dwApply: DWORD): HResult; stdcall;
function SetMode(dwMode: DWORD; dwApply: DWORD): HResult; stdcall;
11689,32 → 17409,36
function SetVelocity(x, y, z: TD3DValue; dwApply: DWORD): HResult; stdcall;
end;
 
{ IDirectSoundCapture }
 
//
// IDirectSoundCapture
//
IDirectSoundCapture = interface(IUnknown)
['{B0210781-89CD-11D0-AF08-00A0C925CD16}']
['{b0210781-89cd-11d0-af08-00a0c925cd16}']
// IDirectSoundCapture methods
function CreateCaptureBuffer(const lpDSCBufferDesc: TDSCBufferDesc;
out lplpDirectSoundCaptureBuffer: IDirectSoundCaptureBuffer;
var lplpDirectSoundCaptureBuffer: IDirectSoundCaptureBuffer;
pUnkOuter: IUnknown): HResult; stdcall;
function GetCaps(var lpDSCCaps: TDSCCaps): HResult; stdcall;
function GetCaps(var lpdwCaps: TDSCCaps) : HResult; stdcall;
function Initialize(lpGuid: PGUID): HResult; stdcall;
end;
 
{ IDirectSoundCaptureBuffer }
 
//
// IDirectSoundCaptureBuffer
//
IDirectSoundCaptureBuffer = interface(IUnknown)
['{B0210782-89CD-11D0-AF08-00A0C925CD16}']
['{b0210782-89cd-11d0-af08-00a0c925cd16}']
// IDirectSoundCaptureBuffer methods
function GetCaps(var lpDSCBCaps: TDSCBCaps): HResult; stdcall;
function GetCurrentPosition(var lpdwCapturePosition,
lpdwReadPosition: DWORD): HResult; stdcall;
function GetFormat(var lpwfxFormat: TWaveFormatEx; dwSizeAllocated: DWORD;
var lpdwSizeWritten: DWORD): HResult; stdcall;
function GetCaps(var lpdwCaps: TDSCBCaps) : HResult; stdcall;
function GetCurrentPosition
(lpdwCapturePosition, lpdwReadPosition: PDWORD) : HResult; stdcall;
function GetFormat(lpwfxFormat: PWaveFormatEx; dwSizeAllocated: DWORD;
lpdwSizeWritten : PDWORD) : HResult; stdcall;
function GetStatus(var lpdwStatus: DWORD): HResult; stdcall;
function Initialize(lpDirectSoundCapture: IDirectSoundCapture;
const lpcDSBufferDesc: TDSCBufferDesc): HResult; stdcall;
function Lock(dwReadCursor: DWORD; dwReadBytes: DWORD;
function Lock(dwReadCursor, dwReadBytes: DWORD;
var lplpvAudioPtr1: Pointer; var lpdwAudioBytes1: DWORD;
var lplpvAudioPtr2: Pointer; var lpdwAudioBytes2: DWORD;
dwFlags: DWORD): HResult; stdcall;
11724,65 → 17448,148
lpvAudioPtr2: Pointer; dwAudioBytes2: DWORD): HResult; stdcall;
end;
 
{ IDirectSoundNotify }
 
//
// IDirectSoundNotify
//
IDirectSoundNotify = interface(IUnknown)
['{B0210783-89CD-11D0-AF08-00A0C925CD16}']
['{b0210783-89cd-11d0-af08-00a0c925cd16}']
// IDirectSoundNotify methods
function SetNotificationPositions(cPositionNotifies: DWORD;
const lpcPositionNotifies): HResult; stdcall;
const lpcPositionNotifies: TDSBPositionNotify) : HResult; stdcall;
end;
 
{ IKsPropertySet }
//
// IKsPropertySet
//
IKsPropertySet = interface (IUnknown)
['{31efac30-515c-11d0-a9aa-00aa0061be93}']
// IKsPropertySet methods
function Get(const rguidPropSet: TGUID; ulId: DWORD; var pInstanceData;
ulInstanceLength: DWORD; var pPropertyData; ulDataLength: DWORD;
var pulBytesReturned: DWORD) : HResult; stdcall;
// Warning: The following method is defined as Set() in DirectX
// which is a reserved word in Delphi!
function SetProperty(const rguidPropSet: TGUID; ulId: DWORD;
var pInstanceData; ulInstanceLength: DWORD;
var pPropertyData; pulDataLength: DWORD) : HResult; stdcall;
function QuerySupport(const rguidPropSet: TGUID; ulId: DWORD;
var pulTypeSupport: DWORD) : HResult; stdcall;
end;
 
 
const
KSPROPERTY_SUPPORT_GET = $00000001;
KSPROPERTY_SUPPORT_SET = $00000002;
 
IID_IKsPropertySet: TGUID = (D1:$31efac30;D2:$515c;D3:$11d0;D4:($a9,$aa,$00,$aa,$00,$61,$be,$93));
 
//
// GUID's for all the objects
//
type
IKsPropertySet = interface;
IID_IDirectSound = IDirectSound;
IID_IDirectSoundBuffer = IDirectSoundBuffer;
IID_IDirectSound3DListener = IDirectSound3DListener;
IID_IDirectSound3DBuffer = IDirectSound3DBuffer;
IID_IDirectSoundCapture = IDirectSoundCapture;
IID_IDirectSoundCaptureBuffer = IDirectSoundCaptureBuffer;
IID_IDirectSoundNotify = IDirectSoundNotify;
IID_IKsPropertySet = IKsPropertySet;
 
IKsPropertySet = interface(IUnknown)
['{31EFAC30-515C-11D0-A9AA-00AA0061BE93}']
// IKsPropertySet methods
function GetProperty(const PropertySetId: TGUID; PropertyId: DWORD;
var pPropertyParams; cbPropertyParams: DWORD;
var pPropertyData; cbPropertyData: DWORD;
var pcbReturnedData: ULONG): HResult; stdcall;
function SetProperty(const PropertySetId: TGUID; PropertyId: DWORD;
const pPropertyParams; cbPropertyParams: DWORD;
const pPropertyData; cbPropertyData: DWORD): HResult; stdcall;
function QuerySupport(const PropertySetId: TGUID; PropertyId: DWORD;
var pSupport: ULONG): HResult; stdcall;
end;
//
// Creation Routines
//
var
DirectSoundCreate : function ( lpGuid: PGUID; out ppDS: IDirectSound;
pUnkOuter: IUnknown) : HResult; stdcall;
 
{ Return Codes }
DirectSoundEnumerateW : function (lpDSEnumCallback: TDSEnumCallbackW;
lpContext: Pointer) : HResult; stdcall;
DirectSoundEnumerateA : function (lpDSEnumCallback: TDSEnumCallbackA;
lpContext: Pointer) : HResult; stdcall;
DirectSoundEnumerate : function (lpDSEnumCallback: TDSEnumCallback;
lpContext: Pointer) : HResult; stdcall;
 
DirectSoundCaptureCreate : function (lpGUID: PGUID;
out lplpDSC: IDirectSoundCapture;
pUnkOuter: IUnknown) : HResult; stdcall;
 
DirectSoundCaptureEnumerateW : function (lpDSEnumCallback: TDSEnumCallbackW;
lpContext: Pointer) : HResult; stdcall;
DirectSoundCaptureEnumerateA : function (lpDSEnumCallback: TDSEnumCallbackA;
lpContext: Pointer) : HResult; stdcall;
DirectSoundCaptureEnumerate : function(lpDSEnumCallback: TDSEnumCallback;
lpContext: Pointer) : HResult; stdcall;
 
 
//
// Return Codes
//
 
const
DS_OK = HResult(S_OK);
DS_NO_VIRTUALIZATION = HResult($878000A);
DSERR_ALLOCATED = HResult($88780000 + 10);
DSERR_CONTROLUNAVAIL = HResult($88780000 + 30);
DSERR_INVALIDPARAM = HResult(E_INVALIDARG);
DSERR_INVALIDCALL = HResult($88780000 + 50);
DSERR_GENERIC = HResult(E_FAIL);
DSERR_PRIOLEVELNEEDED = HResult($88780000 + 70);
DSERR_OUTOFMEMORY = HResult(E_OUTOFMEMORY);
DSERR_BADFORMAT = HResult($88780000 + 100);
DSERR_UNSUPPORTED = HResult(E_NOTIMPL);
DSERR_NODRIVER = HResult($88780000 + 120);
DSERR_ALREADYINITIALIZED = HResult($88780000 + 130);
DSERR_NOAGGREGATION = HResult(CLASS_E_NOAGGREGATION);
DSERR_BUFFERLOST = HResult($88780000 + 150);
DSERR_OTHERAPPHASPRIO = HResult($88780000 + 160);
DSERR_UNINITIALIZED = HResult($88780000 + 170);
DSERR_NOINTERFACE = HResult(E_NOINTERFACE);
DSERR_ACCESSDENIED = HResult(E_ACCESSDENIED);
MAKE_DSHRESULT_ = HResult($88780000);
 
{ Flags }
DS_OK = 0;
 
// The function completed successfully, but we had to substitute the 3D algorithm
DS_NO_VIRTUALIZATION = MAKE_DSHRESULT_ + 10;
 
// The call failed because resources (such as a priority level)
// were already being used by another caller.
DSERR_ALLOCATED = MAKE_DSHRESULT_ + 10;
 
// The control (vol,pan,etc.) requested by the caller is not available.
DSERR_CONTROLUNAVAIL = MAKE_DSHRESULT_ + 30;
 
// An invalid parameter was passed to the returning function
DSERR_INVALIDPARAM = E_INVALIDARG;
 
// This call is not valid for the current state of this object
DSERR_INVALIDCALL = MAKE_DSHRESULT_ + 50;
 
// An undetermined error occured inside the DirectSound subsystem
DSERR_GENERIC = E_FAIL;
 
// The caller does not have the priority level required for the function to
// succeed.
DSERR_PRIOLEVELNEEDED = MAKE_DSHRESULT_ + 70;
 
// Not enough free memory is available to complete the operation
DSERR_OUTOFMEMORY = E_OUTOFMEMORY;
 
// The specified WAVE format is not supported
DSERR_BADFORMAT = MAKE_DSHRESULT_ + 100;
 
// The function called is not supported at this time
DSERR_UNSUPPORTED = E_NOTIMPL;
 
// No sound driver is available for use
DSERR_NODRIVER = MAKE_DSHRESULT_ + 120;
 
// This object is already initialized
DSERR_ALREADYINITIALIZED = MAKE_DSHRESULT_ + 130;
 
// This object does not support aggregation
DSERR_NOAGGREGATION = CLASS_E_NOAGGREGATION;
 
// The buffer memory has been lost, and must be restored.
DSERR_BUFFERLOST = MAKE_DSHRESULT_ + 150;
 
// Another app has a higher priority level, preventing this call from
// succeeding.
DSERR_OTHERAPPHASPRIO = MAKE_DSHRESULT_ + 160;
 
// This object has not been initialized
DSERR_UNINITIALIZED = MAKE_DSHRESULT_ + 170;
 
// The requested COM interface is not available
DSERR_NOINTERFACE = E_NOINTERFACE;
 
// Access is denied
DSERR_ACCESSDENIED = E_ACCESSDENIED;
 
//
// Flags
//
 
DSCAPS_PRIMARYMONO = $00000001;
DSCAPS_PRIMARYSTEREO = $00000002;
DSCAPS_PRIMARY8BIT = $00000004;
11807,11 → 17614,16
DSSPEAKER_SURROUND = $00000005;
DSSPEAKER_5POINT1 = $00000006;
 
DSSPEAKER_GEOMETRY_MIN = $00000005;
DSSPEAKER_GEOMETRY_NARROW = $0000000A;
DSSPEAKER_GEOMETRY_WIDE = $00000014;
DSSPEAKER_GEOMETRY_MAX = $000000B4;
DSSPEAKER_GEOMETRY_MIN = $00000005; // 5 degrees
DSSPEAKER_GEOMETRY_NARROW = $0000000A; // 10 degrees
DSSPEAKER_GEOMETRY_WIDE = $00000014; // 20 degrees
DSSPEAKER_GEOMETRY_MAX = $000000B4; // 180 degrees
 
function DSSPEAKER_COMBINED(c, g: variant) : DWORD;
function DSSPEAKER_CONFIG(a: variant) : byte;
function DSSPEAKER_GEOMETRY(a: variant) : byte;
 
const
DSBCAPS_PRIMARYBUFFER = $00000001;
DSBCAPS_STATIC = $00000002;
DSBCAPS_LOCHARDWARE = $00000004;
11821,8 → 17633,6
DSBCAPS_CTRLPAN = $00000040;
DSBCAPS_CTRLVOLUME = $00000080;
DSBCAPS_CTRLPOSITIONNOTIFY = $00000100;
DSBCAPS_CTRLDEFAULT = $000000E0;
DSBCAPS_CTRLALL = $000001F0;
DSBCAPS_STICKYFOCUS = $00004000;
DSBCAPS_GLOBALFOCUS = $00008000;
DSBCAPS_GETCURRENTPOSITION2 = $00010000;
11833,8 → 17643,8
DSBPLAY_LOCHARDWARE = $00000002;
DSBPLAY_LOCSOFTWARE = $00000004;
DSBPLAY_TERMINATEBY_TIME = $00000008;
DSBPLAY_TERMINATEBY_DISTANCE = $00000010;
DSBPLAY_TERMINATEBY_PRIORITY = $00000020;
DSBPLAY_TERMINATEBY_DISTANCE = $000000010;
DSBPLAY_TERMINATEBY_PRIORITY = $000000020;
 
DSBSTATUS_PLAYING = $00000001;
DSBSTATUS_BUFFERLOST = $00000002;
11867,8 → 17677,8
DS3D_IMMEDIATE = $00000000;
DS3D_DEFERRED = $00000001;
DS3D_MINDISTANCEFACTOR = 0.0;
DS3D_MAXDISTANCEFACTOR = 10.0;
DS3D_MINDISTANCEFACTOR = FLT_MIN;
DS3D_MAXDISTANCEFACTOR = FLT_MAX;
DS3D_DEFAULTDISTANCEFACTOR = 1.0;
 
DS3D_MINROLLOFFFACTOR = 0.0;
11888,11 → 17698,16
 
DS3D_DEFAULTCONEOUTSIDEVOLUME = DSBVOLUME_MAX;
 
DSCCAPS_EMULDRIVER = DSCAPS_EMULDRIVER;
DSCCAPS_EMULDRIVER = $00000020;
DSCCAPS_CERTIFIED = DSCAPS_CERTIFIED;
 
DSCBCAPS_WAVEMAPPED = $80000000;
 
 
 
DSBCAPS_CTRLDEFAULT = $000000E0;
DSBCAPS_CTRLALL = $000001F0;
 
DSCBLOCK_ENTIREBUFFER = $00000001;
 
DSCBSTATUS_CAPTURING = $00000001;
11900,42 → 17715,50
 
DSCBSTART_LOOPING = $00000001;
 
DSBPN_OFFSETSTOP = $FFFFFFFF;
DSBPN_OFFSETSTOP = DWORD(-1);
 
//
// DirectSound3D Algorithms
//
 
// Default DirectSound3D algorithm {00000000-0000-0000-0000-000000000000}
DS3DALG_DEFAULT: TGUID = '{00000000-0000-0000-0000-000000000000}';
DS3DALG_NO_VIRTUALIZATION: TGUID = '{C241333F-1C1B-11D2-94F5-00C04FC28ACA}';
DS3DALG_HRTF_FULL: TGUID = '{C2413340-1C1B-11D2-94F5-00C04FC28ACA}';
DS3DALG_HRTF_LIGHT: TGUID = '{C2413342-1C1B-11D2-94F5-00C04FC28ACA}';
 
function DSSPEAKER_COMBINED(c, g: Byte): DWORD;
function DSSPEAKER_CONFIG(a: DWORD): Byte;
function DSSPEAKER_GEOMETRY(a: DWORD): Byte;
// No virtualization {C241333F-1C1B-11d2-94F5-00C04FC28ACA}
DS3DALG_NO_VIRTUALIZATION: TGUID = '';
 
{ DirectSound API }
// High-quality HRTF algorithm {C2413340-1C1B-11d2-94F5-00C04FC28ACA}
DS3DALG_HRTF_FULL: TGUID = '{C2413340-1C1B-11d2-94F5-00C04FC28ACA}';
 
type
TDSEnumCallbackW = function(lpGuid: PGUID; lpstrDescription: LPCWSTR;
lpstrModule: LPCWSTR; lpContext: Pointer): BOOL; stdcall;
LPDSENUMCALLBACKW = TDSEnumCallbackW;
// Lower-quality HRTF algorithm {C2413342-1C1B-11d2-94F5-00C04FC28ACA}
DS3DALG_HRTF_LIGHT: TGUID = '{C2413342-1C1B-11d2-94F5-00C04FC28ACA}';
 
TDSEnumCallbackA = function(lpGuid: PGUID; lpstrDescription: LPCSTR;
lpstrModule: LPCSTR; lpContext: Pointer): BOOL; stdcall;
LPDSENUMCALLBACKA = TDSEnumCallbackA;
//DirectMusic file
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* Files: dls1.h dls2.h dmdls.h dmerror.h dmksctrl.h
dmusicc.h dmusici.h dmusicf.h dmusbuff.h
* Content: DirectMusic, DirectSetup
*
* DirectX 7.0 Delphi adaptation by Erik Unger
*
* Modyfied: 10-Sep-2000
*
* Download: http://www.delphi-jedi.org/DelphiGraphics/
* E-Mail: DelphiDirectX@next-reality.com
*
***************************************************************************)
 
TDSEnumCallback = TDSEnumCallbackA;
LPDSENUMCALLBACK = TDSEnumCallback;
 
function DirectSoundCreate(lpGUID: PGUID; out lpDS: IDirectSound; pUnkOuter: IUnknown): HResult; stdcall;
function DirectSoundEnumerateA(lpDSEnumCallback: TDSEnumCallbackA; lpContext: Pointer): HResult; stdcall;
function DirectSoundEnumerateW(lpDSEnumCallback: TDSEnumCallbackW; lpContext: Pointer): HResult; stdcall;
function DirectSoundEnumerate(lpDSEnumCallback: TDSEnumCallbackA; lpContext: Pointer): HResult; stdcall;
function MAKE_HRESULT(sev,fac,code: DWORD) : HResult;
 
function DirectSoundCaptureCreate(lpGUID: PGUID; out lplpDSC: IDirectSoundCapture; pUnkOuter: IUnknown): HResult; stdcall;
function DirectSoundCaptureEnumerateA(lpDSEnumCallback: TDSEnumCallbackA; lpContext: Pointer): HResult; stdcall;
function DirectSoundCaptureEnumerateW(lpDSEnumCallback: TDSEnumCallbackW; lpContext: Pointer): HResult; stdcall;
function DirectSoundCaptureEnumerate(lpDSEnumCallback: TDSEnumCallbackA; lpContext: Pointer): HResult; stdcall;
type
mmioFOURCC = array [0..3] of Char;
 
//==========================================================================;
 
(*==========================================================================;
//
// dls1.h
//
11948,9 → 17771,9
//
// Written by Sonic Foundry 1996. Released for public use.
//
//=========================================================================
//=========================================================================*)
 
////////////////////////////////////////////////////////////////////////////
(*//////////////////////////////////////////////////////////////////////////
//
//
// Layout of an instrument collection:
11993,37 → 17816,37
// 'icmt' 'One of those crazy comments.'
// 'icop' 'Copyright (C) 1996 Sonic Foundry'
//
//////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////(*)
 
(*/////////////////////////////////////////////////////////////////////////
// FOURCC's used in the DLS file
////////////////////////////////////////////////////////////////////////(*)
 
///////////////////////////////////////////////////////////////////////////
// FOURCC's used in the DLS file
//////////////////////////////////////////////////////////////////////////
const
FOURCC_DLS = Ord('D') + Ord('L') shl 8 + Ord('S') shl 16 + Ord(' ') shl 24;
FOURCC_DLID = Ord('d') + Ord('l') shl 8 + Ord('i') shl 16 + Ord('d') shl 24;
FOURCC_COLH = Ord('c') + Ord('o') shl 8 + Ord('l') shl 16 + Ord('h') shl 24;
FOURCC_WVPL = Ord('w') + Ord('v') shl 8 + Ord('p') shl 16 + Ord('l') shl 24;
FOURCC_PTBL = Ord('p') + Ord('t') shl 8 + Ord('b') shl 16 + Ord('l') shl 24;
FOURCC_PATH = Ord('p') + Ord('a') shl 8 + Ord('t') shl 16 + Ord('h') shl 24;
FOURCC_wave = Ord('w') + Ord('a') shl 8 + Ord('v') shl 16 + Ord('e') shl 24;
FOURCC_LINS = Ord('l') + Ord('i') shl 8 + Ord('n') shl 16 + Ord('s') shl 24;
FOURCC_INS = Ord('i') + Ord('n') shl 8 + Ord('s') shl 16 + Ord(' ') shl 24;
FOURCC_INSH = Ord('i') + Ord('n') shl 8 + Ord('s') shl 16 + Ord('h') shl 24;
FOURCC_LRGN = Ord('l') + Ord('r') shl 8 + Ord('g') shl 16 + Ord('n') shl 24;
FOURCC_RGN = Ord('r') + Ord('g') shl 8 + Ord('n') shl 16 + Ord(' ') shl 24;
FOURCC_RGNH = Ord('r') + Ord('g') shl 8 + Ord('n') shl 16 + Ord('h') shl 24;
FOURCC_LART = Ord('l') + Ord('a') shl 8 + Ord('r') shl 16 + Ord('t') shl 24;
FOURCC_ART1 = Ord('a') + Ord('r') shl 8 + Ord('t') shl 16 + Ord('1') shl 24;
FOURCC_WLNK = Ord('w') + Ord('l') shl 8 + Ord('n') shl 16 + Ord('k') shl 24;
FOURCC_WSMP = Ord('w') + Ord('s') shl 8 + Ord('m') shl 16 + Ord('p') shl 24;
//FOURCC_VERS = Ord('v') + Ord('e') shl 8 + Ord('r') shl 16 + Ord('s') shl 24;
FOURCC_DLS : mmioFOURCC = ('D','L','S',' ');
FOURCC_DLID : mmioFOURCC = ('d','l','i','d');
FOURCC_COLH : mmioFOURCC = ('c','o','l','h');
FOURCC_WVPL : mmioFOURCC = ('w','v','p','l');
FOURCC_PTBL : mmioFOURCC = ('p','t','b','l');
FOURCC_PATH : mmioFOURCC = ('p','a','t','h');
FOURCC_wave : mmioFOURCC = ('w','a','v','e');
FOURCC_LINS : mmioFOURCC = ('l','i','n','s');
FOURCC_INS : mmioFOURCC = ('i','n','s',' ');
FOURCC_INSH : mmioFOURCC = ('i','n','s','h');
FOURCC_LRGN : mmioFOURCC = ('l','r','g','n');
FOURCC_RGN : mmioFOURCC = ('r','g','n',' ');
FOURCC_RGNH : mmioFOURCC = ('r','g','n','h');
FOURCC_LART : mmioFOURCC = ('l','a','r','t');
FOURCC_ART1 : mmioFOURCC = ('a','r','t','1');
FOURCC_WLNK : mmioFOURCC = ('w','l','n','k');
FOURCC_WSMP : mmioFOURCC = ('w','s','m','p');
//FOURCC_VERS : mmioFOURCC = ('v','e','r','s');
 
///////////////////////////////////////////////////////////////////////////
(*/////////////////////////////////////////////////////////////////////////
// Articulation connection graph definitions
//////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////(*)
 
// Generic Sources
(* Generic Sources *)
CONN_SRC_NONE = $0000;
CONN_SRC_LFO = $0001;
CONN_SRC_KEYONVELOCITY = $0002;
12032,133 → 17855,126
CONN_SRC_EG2 = $0005;
CONN_SRC_PITCHWHEEL = $0006;
 
// Midi Controllers 0-127
(* Midi Controllers 0-127 *)
CONN_SRC_CC1 = $0081;
CONN_SRC_CC7 = $0087;
CONN_SRC_CC10 = $008A;
CONN_SRC_CC11 = $008B;
CONN_SRC_CC10 = $008a;
CONN_SRC_CC11 = $008b;
 
// Generic Destinations
(* Generic Destinations *)
CONN_DST_NONE = $0000;
CONN_DST_ATTENUATION = $0001;
CONN_DST_PITCH = $0003;
CONN_DST_PAN = $0004;
 
// LFO Destinations
(* LFO Destinations *)
CONN_DST_LFO_FREQUENCY = $0104;
CONN_DST_LFO_STARTDELAY = $0105;
 
// EG1 Destinations
(* EG1 Destinations *)
CONN_DST_EG1_ATTACKTIME = $0206;
CONN_DST_EG1_DECAYTIME = $0207;
CONN_DST_EG1_RELEASETIME = $0209;
CONN_DST_EG1_SUSTAINLEVEL = $020A;
CONN_DST_EG1_SUSTAINLEVEL = $020a;
 
// EG2 Destinations
CONN_DST_EG2_ATTACKTIME = $030A;
CONN_DST_EG2_DECAYTIME = $030B;
CONN_DST_EG2_RELEASETIME = $030D;
CONN_DST_EG2_SUSTAINLEVEL = $030E;
(* EG2 Destinations *)
CONN_DST_EG2_ATTACKTIME = $030a;
CONN_DST_EG2_DECAYTIME = $030b;
CONN_DST_EG2_RELEASETIME = $030d;
CONN_DST_EG2_SUSTAINLEVEL = $030e;
 
CONN_TRN_NONE = $0000;
CONN_TRN_CONCAVE = $0001;
 
type
TDLSID = record
ulData1 : Cardinal;
PDLSId = ^TDLSId;
TDLSId = packed record
ulData1 : ULONG;
usData2 : Word;
usData3 : Word;
abData4 : array[0..7] of Byte;
abData4 : array [0..7] of BYTE;
end;
DLSID = TDLSID;
LPDLSID = ^DLSID;
 
{TDLSVERSION = record
dwVersionMS : DWORD;
dwVersionLS : DWORD;
end;
DLSVERSION = TDLSVERSION;
LPDLSVERSION = ^DLSVERSION;
}
TCONNECTION = record
// PDLSVersion = ^TDLSVersion;
// TDLSVersion = packed record
// dwVersionMS,
// dwVersionLS : DWORD;
// end;
 
PConnection = ^TConnection;
TConnection = packed record
usSource : Word;
usControl : Word;
usDestination : Word;
SuDestination : Word;
usTransform : Word;
lScale : Cardinal;
lScale : LongInt;
end;
CONNECTION = TCONNECTION;
LPCONNECTION = ^CONNECTION;
 
// Level 1 Articulation Data
(* Level 1 Articulation Data *)
 
TCONNECTIONLIST = record
cbSize : Cardinal; // size of the connection list structure
cConnections : Cardinal; // count of connections in the list
PConnectionList = ^TConnectionList;
TConnectionList = packed record
cbSize : ULONG; (* size of the connection list structure *)
cConnections : ULONG; (* count of connections in the list *)
end;
CONNECTIONLIST = TCONNECTIONLIST;
LPCONNECTIONLIST = ^CONNECTIONLIST;
 
///////////////////////////////////////////////////////////////////////////
(*/////////////////////////////////////////////////////////////////////////
// Generic type defines for regions and instruments
//////////////////////////////////////////////////////////////////////////
type
TRGNRANGE = record
////////////////////////////////////////////////////////////////////////(*)
 
PRGNRange = ^TRGNRange;
TRGNRange = packed record
usLow : Word;
usHigh : Word;
end;
RGNRANGE = TRGNRANGE;
LPRGNRANGE = ^RGNRANGE;
 
const
FTINSTRUMENTTDRUMS = $80000000;
F_INSTRUMENT_DRUMS = $80000000;
 
type
TMIDILOCALE = record
ulBank : Cardinal;
ulInstrument : Cardinal;
PMIDILocale = ^TMIDILocale;
TMIDILocale = packed record
ulBank : ULONG;
ulInstrument : ULONG;
end;
MIDILOCALE = TMIDILOCALE;
LPMIDILOCALE = ^MIDILOCALE;
 
///////////////////////////////////////////////////////////////////////////
(*/////////////////////////////////////////////////////////////////////////
// Header structures found in an DLS file for collection, instruments, and
// regions.
//////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////(*)
 
const
F_RGN_OPTION_SELFNONEXCLUSIVE = $0001;
 
type
TRGNHEADER = record
RangeKey : RGNRANGE; // Key range
RangeVelocity : RGNRANGE; // Velocity Range
fusOptions : Word; // Synthesis options for this range
usKeyGroup : Word; // Key grouping for non simultaneous play
end; // 0 = no group, 1 up is group
// for Level 1 only groups 1-15 are allowed
RGNHEADER = TRGNHEADER;
LPRGNHEADER = ^RGNHEADER;
PRGNHeader = ^TRGNHeader;
TRGNHeader = packed record
RangeKey : TRGNRange; (* Key range *)
RangeVelocity : TRGNRange; (* Velocity Range *)
fusOptions : Word ; (* Synthesis options for this range *)
usKeyGroup : Word ; (* Key grouping for non simultaneous play *)
(* 0 = no group, 1 up is group *)
(* for Level 1 only groups 1-15 are allowed *)
end;
 
TINSTHEADER = record
cRegions : Cardinal; // Count of regions in this instrument
Locale : MIDILOCALE; // Intended MIDI locale of this instrument
PInstHeader = ^TInstHeader;
TInstHeader = packed record
cRegions : ULONG; (* Count of regions in this instrument *)
Locale : TMIDILocale; (* Intended MIDI locale of this instrument *)
end;
INSTHEADER = TINSTHEADER;
LPINSTHEADER = ^INSTHEADER;
 
TDLSHEADER = record
cInstruments : Cardinal; // Count of instruments in the collection
PDLSHeader = ^TDLSHeader;
TDLSHeader = packed record
cInstruments : ULONG;
end;
DLSHEADER = TDLSHEADER;
LPDLSHEADER = ^DLSHEADER;
 
//////////////////////////////////////////////////////////////////////////////
(*////////////////////////////////////////////////////////////////////////////
// definitions for the Wave link structure
/////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////(*)
 
// **** For level 1 only WAVELINK_CHANNEL_MONO is valid ****
// ulChannel allows for up to 32 channels of audio with each bit position
// specifiying a channel of playback
(* **** For level 1 only WAVELINK_CHANNEL_MONO is valid **** *)
(* ulChannel allows for up to 32 channels of audio with each bit position *)
(* specifiying a channel of playback *)
 
const
WAVELINK_CHANNEL_LEFT = $0001;
12167,69 → 17983,65
F_WAVELINK_PHASE_MASTER = $0001;
 
type
TWAVELINK = record // any paths or links are stored right after struct
fusOptions : Word; // options flags for this wave
usPhaseGroup : Word; // Phase grouping for locking channels
ulChannel : Cardinal; // channel placement
ulTableIndex : Cardinal; // index into the wave pool table, 0 based
PWaveLink = ^TWaveLink;
TWaveLink = packed record (* any paths or links are stored right after struct *)
fusOptions : Word; (* options flags for this wave *)
usPhaseGroup : Word; (* Phase grouping for locking channels *)
ulChannel : ULONG; (* channel placement *)
ulTableIndex : ULONG; (* index into the wave pool table, 0 based *)
end;
WAVELINK = TWAVELINK;
LPWAVELINK = ^WAVELINK;
 
const
POOL_CUE_NULL = $FFFFFFFF;
POOL_CUE_NULL = $ffffffff;
 
type
TPOOLCUE = record
ulOffset : Cardinal; // Offset to the entry in the list
PPoolCUE = ^TPoolCUE;
TPoolCUE = packed record
ulOffset : ULONG;
end;
POOLCUE = TPOOLCUE;
LPPOOLCUE = ^POOLCUE;
 
TPOOLTABLE = record
cbSize : Cardinal; // size of the pool table structure
cCues : Cardinal; // count of cues in the list
PPoolTable = ^TPoolTable;
TPoolTable = packed record
cbSize : ULONG; (* size of the pool table structure *)
cCues : ULONG; (* count of cues in the list *)
end;
POOLTABLE = TPOOLTABLE;
LPPOOLTABLE = ^POOLTABLE;
 
//////////////////////////////////////////////////////////////////////////////
(*////////////////////////////////////////////////////////////////////////////
// Structures for the "wsmp" chunk
/////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////(*)
 
const
F_WSMP_NO_TRUNCATION = $0001;
F_WSMP_NO_COMPRESSION = $0002;
 
type
Trwsmp = record
cbSize : Cardinal;
usUnityNote : Word; // MIDI Unity Playback Note
sFineTune : Smallint; // Fine Tune in log tuning
lAttenuation : Longint; // Overall Attenuation to be applied to data
fulOptions : Cardinal; // Flag options
cSampleLoops : Cardinal; // Count of Sample loops, 0 loops is one shot
PWSMPL = ^TWSMPL;
TWSMPL = packed record
cbSize : ULONG;
usUnityNote : Word; (* MIDI Unity Playback Note *)
sFineTune : SmallInt; (* Fine Tune in log tuning *)
lAttenuation : Integer; (* Overall Attenuation to be applied to data *)
fulOptions : ULONG; (* Flag options *)
cSampleLoops : ULONG; (* Count of Sample loops, 0 loops is one shot *)
end;
WSMPL = Trwsmp;
LPWSMPL = ^WSMPL;
 
 
// This loop type is a normal forward playing loop which is continually
// played until the envelope reaches an off threshold in the release
// portion of the volume envelope
(* This loop type is a normal forward playing loop which is continually *)
(* played until the envelope reaches an off threshold in the release *)
(* portion of the volume envelope *)
 
const
WLOOP_TYPE_FORWARD = 0;
 
type
Trloop = record
cbSize : Cardinal;
ulType : Cardinal; // Loop Type
ulStart : Cardinal; // Start of loop in samples
ulLength : Cardinal; // Length of loop in samples
TWLoop = packed record
cbSize : ULONG;
ulType : ULONG; (* Loop Type *)
ulStart : ULONG; (* Start of loop in samples *)
ulLength : ULONG; (* Length of loop in samples *)
end;
WLOOP = Trloop;
LPWLOOP = ^WLOOP;
 
{/*
(*******************************************************************************
 
dls2.h
 
12240,940 → 18052,931
 
Written by Microsoft 1998. Released for public use.
 
}
*******************************************************************************)
 
(*
FOURCC's used in the DLS2 file, in addition to DLS1 chunks
*)
const
//
// FOURCC's used in the DLS2 file, in addition to DLS1 chunks
///
FOURCC_RGN2 : mmioFOURCC = ('r','g','n','2');
FOURCC_LAR2 : mmioFOURCC = ('l','a','r','2');
FOURCC_ART2 : mmioFOURCC = ('a','r','t','2');
FOURCC_CDL : mmioFOURCC = ('c','d','l',' ');
// FOURCC_DLID : mmioFOURCC = ('d','l','i','d');
 
FOURCC_RGN2 = Ord('r') + Ord('g') shl 8 + Ord('n') shl 16 + Ord('2') shl 24;
FOURCC_LAR2 = Ord('l') + Ord('a') shl 8 + Ord('r') shl 16 + Ord('2') shl 24;
FOURCC_ART2 = Ord('a') + Ord('r') shl 8 + Ord('t') shl 16 + Ord('2') shl 24;
FOURCC_CDL = Ord('c') + Ord('d') shl 8 + Ord('l') shl 16 + Ord(' ') shl 24;
//FOURCC_DLID = Ord('d') + Ord('l') shl 8 + Ord('i') shl 16 + Ord('d') shl 24;
(*
Articulation connection graph definitions. These are in addition to
the definitions in the DLS1 header.
*)
 
//
// Articulation connection graph definitions. These are in addition to
// the definitions in the DLS1 header.
///
const
(* Generic Sources (in addition to DLS1 sources. *)
CONN_SRC_POLYPRESSURE = $0007; (* Polyphonic Pressure *)
CONN_SRC_CHANNELPRESSURE = $0008; (* Channel Pressure *)
CONN_SRC_VIBRATO = $0009; (* Vibrato LFO *)
CONN_SRC_MONOPRESSURE = $000a; (* MIDI Mono pressure *)
 
// Generic Sources (in addition to DLS1 sources.
CONN_SRC_POLYPRESSURE = $0007; // Polyphonic Pressure
CONN_SRC_CHANNELPRESSURE = $0008; // Channel Pressure
CONN_SRC_VIBRATO = $0009; // Vibrato LFO
CONN_SRC_MONOPRESSURE = $000a; // MIDI Mono pressure
 
(* Midi Controllers *)
CONN_SRC_CC91 = $00db; (* Reverb Send *)
CONN_SRC_CC93 = $00dd; (* Chorus Send *)
 
// Midi Controllers
CONN_SRC_CC91 = $00db; // Reverb Send
CONN_SRC_CC93 = $00dd; // Chorus Send
 
(* Generic Destinations *)
CONN_DST_GAIN = $0001; (* Same as CONN_DST_ ATTENUATION *)
CONN_DST_KEYNUMBER = $0005; (* Key Number Generator *)
 
// Generic Destinations
CONN_DST_GAIN = $0001; // Same as CONN_DST_ ATTENUATION
CONN_DST_KEYNUMBER = $0005; // Key Number Generator
(* Audio Channel Output Destinations *)
CONN_DST_LEFT = $0010; (* Left Channel Send *)
CONN_DST_RIGHT = $0011; (* Right Channel Send *)
CONN_DST_CENTER = $0012; (* Center Channel Send *)
CONN_DST_LEFTREAR = $0013; (* Left Rear Channel Send *)
CONN_DST_RIGHTREAR = $0014; (* Right Rear Channel Send *)
CONN_DST_LFE_CHANNEL = $0015; (* LFE Channel Send *)
CONN_DST_CHORUS = $0080; (* Chorus Send *)
CONN_DST_REVERB = $0081; (* Reverb Send *)
 
// Audio Channel Output Destinations
CONN_DST_LEFT = $0010; // Left Channel Send
CONN_DST_RIGHT = $0011; // Right Channel Send
CONN_DST_CENTER = $0012; // Center Channel Send
CONN_DST_LEFTREAR = $0013; // Left Rear Channel Send
CONN_DST_RIGHTREAR = $0014; // Right Rear Channel Send
CONN_DST_LFE_CHANNEL = $0015; // LFE Channel Send
CONN_DST_CHORUS = $0080; // Chorus Send
CONN_DST_REVERB = $0081; // Reverb Send
(* Vibrato LFO Destinations *)
CONN_DST_VIB_FREQUENCY = $0114; (* Vibrato Frequency *)
CONN_DST_VIB_STARTDELAY = $0115; (* Vibrato Start Delay *)
 
// Vibrato LFO Destinations
CONN_DST_VIB_FREQUENCY = $0114; // Vibrato Frequency
CONN_DST_VIB_STARTDELAY = $0115; // Vibrato Start Delay
(* EG1 Destinations *)
CONN_DST_EG1_DELAYTIME = $020B; (* EG1 Delay Time *)
CONN_DST_EG1_HOLDTIME = $020C; (* EG1 Hold Time *)
 
// EG1 Destinations
CONN_DST_EG1_DELAYTIME = $020B; // EG1 Delay Time
CONN_DST_EG1_HOLDTIME = $020C; // EG1 Hold Time
 
(* EG2 Destinations *)
CONN_DST_EG2_DELAYTIME = $030F; (* EG2 Delay Time *)
CONN_DST_EG2_HOLDTIME = $0310; (* EG2 Hold Time *)
 
// EG2 Destinations
CONN_DST_EG2_DELAYTIME = $030F; // EG2 Delay Time
CONN_DST_EG2_HOLDTIME = $0310; // EG2 Hold Time
 
(* Filter Destinations *)
CONN_DST_FILTER_CUTOFF = $0500; (* Filter Cutoff Frequency *)
CONN_DST_FILTER_Q = $0501; (* Filter Resonance *)
 
// Filter Destinations
CONN_DST_FILTER_CUTOFF = $0500; // Filter Cutoff Frequency
CONN_DST_FILTER_Q = $0501; // Filter Resonance
 
(* Transforms *)
CONN_TRN_CONVEX = $0002; (* Convex Transform *)
CONN_TRN_SWITCH = $0003; (* Switch Transform *)
 
// Transforms
CONN_TRN_CONVEX = $0002; // Convex Transform
CONN_TRN_SWITCH = $0003; // Switch Transform
 
(* Conditional chunk operators *)
DLS_CDL_AND = $0001; (* X = X & Y *)
DLS_CDL_OR = $0002; (* X = X | Y *)
DLS_CDL_XOR = $0003; (* X = X ^ Y *)
DLS_CDL_ADD = $0004; (* X = X + Y *)
DLS_CDL_SUBTRACT = $0005; (* X = X - Y *)
DLS_CDL_MULTIPLY = $0006; (* X = X * Y *)
DLS_CDL_DIVIDE = $0007; (* X = X / Y *)
DLS_CDL_LOGICAL_AND = $0008; (* X = X && Y *)
DLS_CDL_LOGICAL_OR = $0009; (* X = X || Y *)
DLS_CDL_LT = $000A; (* X = (X < Y) *)
DLS_CDL_LE = $000B; (* X = (X <= Y) *)
DLS_CDL_GT = $000C; (* X = (X > Y) *)
DLS_CDL_GE = $000D; (* X = (X >= Y) *)
DLS_CDL_EQ = $000E; (* X = (X == Y) *)
DLS_CDL_NOT = $000F; (* X = !X *)
DLS_CDL_CONST = $0010; (* 32-bit constant *)
DLS_CDL_QUERY = $0011; (* 32-bit value returned from query *)
DLS_CDL_QUERYSUPPORTED = $0012; (* Test to see if DLSID Query is supported *)
 
// Conditional chunk operators
DLS_CDL_AND = $0001; // X = X & Y
DLS_CDL_OR = $0002; // X = X | Y
DLS_CDL_XOR = $0003; // X = X ^ Y
DLS_CDL_ADD = $0004; // X = X + Y
DLS_CDL_SUBTRACT = $0005; // X = X - Y
DLS_CDL_MULTIPLY = $0006; // X = X * Y
DLS_CDL_DIVIDE = $0007; // X = X / Y
DLS_CDL_LOGICAL_AND = $0008; // X = X && Y
DLS_CDL_LOGICAL_OR = $0009; // X = X || Y
DLS_CDL_LT = $000A; // X = (X < Y)
DLS_CDL_LE = $000B; // X = (X <= Y)
DLS_CDL_GT = $000C; // X = (X > Y)
DLS_CDL_GE = $000D; // X = (X >= Y)
DLS_CDL_EQ = $000E; // X = (X == Y)
DLS_CDL_NOT = $000F; // X = !X
DLS_CDL_CONST = $0010; // 32-bit constant
DLS_CDL_QUERY = $0011; // 32-bit value returned from query
DLS_CDL_QUERYSUPPORTED = $0012; // Test to see if DLSID Query is supported
(*
Loop and release
*)
 
//Loop and release
 
WLOOP_TYPE_RELEASE = 2;
 
//DLSID queries for <cdl-ck>
(*
DLSID queries for <cdl-ck>
*)
 
DLSID_GMInHardware : TGUID = '{178F2F24-C364-11D1-A760-0000F875AC12}';
DLSID_GSInHardware : TGUID = '{178F2F25-C364-11D1-A760-0000F875AC12}';
DLSID_XGInHardware : TGUID = '{178F2F26-C364-11D1-A760-0000F875AC12}';
DLSID_SupportsDLS1 : TGUID = '{178F2F27-C364-11D1-A760-0000F875AC12}';
DLSID_SupportsDLS2 : TGUID = '{F14599E5-4689-11D2-AFA6-00AA0024D8B6}';
DLSID_SampleMemorySize : TGUID = '{178F2F28-C364-11D1-A760-0000F875AC12}';
DLSID_ManufacturersID : TGUID = '{B03E1181-8095-11D2-A1EF-00600833DBD8}';
DLSID_ProductID : TGUID = '{B03E1182-8095-11D2-A1EF-00600833DBD8}';
DLSID_SamplePlaybackRate : TGUID = '{2A91F713-A4BF-11D2-BBDF-00600833DBD8}';
DLSID_GMInHardware : TGUID = '{178f2f24-c364-11d1-a760-0000f875ac12}';
DLSID_GSInHardware : TGUID = '{178f2f25-c364-11d1-a760-0000f875ac12}';
DLSID_XGInHardware : TGUID = '{178f2f26-c364-11d1-a760-0000f875ac12}';
DLSID_SupportsDLS1 : TGUID = '{178f2f27-c364-11d1-a760-0000f875ac12}';
DLSID_SupportsDLS2 : TGUID = '{f14599e5-4689-11d2-afa6-00aa0024d8b6}';
DLSID_SampleMemorySize : TGUID = '{178f2f28-c364-11d1-a760-0000f875ac12}';
DLSID_ManufacturersID : TGUID = '{b03e1181-8095-11d2-a1ef-00600833dbd8}';
DLSID_ProductID : TGUID = '{b03e1182-8095-11d2-a1ef-00600833dbd8}';
DLSID_SamplePlaybackRate : TGUID = '{2a91f713-a4bf-11d2-bbdf-00600833dbd8}';
 
//***********************************************************************
// *
// dmdls.h -- DLS download definitions for DirectMusic API's *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
//**********************************************************************
(************************************************************************
* *
* dmdls.h -- DLS download definitions for DirectMusic API's *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
************************************************************************)
 
type
PCENT = Longint; // Pitch cents
GCENT = Longint; // Gain cents
TCENT = Longint; // Time cents
PERCENT = Longint; // Per.. cent!
TPCent = LongInt; (* Pitch cents *)
TGCent = LongInt; (* Gain cents *)
TTCent = LongInt; (* Time cents *)
TPercent = LongInt; (* Per.. cent! *)
 
PReference_Time = ^TReference_Time;
TReference_Time = LONGLONG;
TReference_Time = LongLong;
 
Reference_Time = TReference_Time;
LPREFERENCE_TIME = PReference_Time;
TFourCC = DWORD; (* a four character code *)
 
function MAKEFOURCC(ch0, ch1, ch2, ch3: Char) : DWORD;
//function MAKEFOURCC (ch0, ch1, ch2, ch3: Char) : TFourCC;
 
type
FOURCC = DWORD; // a four character code
 
TDMUS_DOWNLOADINFO = record
dwDLType : DWORD; // Instrument or Wave
dwDLId : DWORD; // Unique identifier to tag this download.
dwNumOffsetTableEntries : DWORD; // Number of index in the offset address table.
cbSize : DWORD; // Total size of this memory chunk.
TDMus_DownloadInfor = packed record
dwDLType: DWORD; (* Instrument or Wave *)
dwDLId: DWORD; (* Unique identifier to tag this download. *)
dwNumOffsetTableEntries: DWORD; (* Number of index in the offset address table. *)
cbSize: DWORD; (* Total size of this memory chunk. *)
end;
DMUS_DOWNLOADINFO = TDMUS_DOWNLOADINFO;
 
const
DMUS_DOWNLOADINFO_INSTRUMENT = 1;
DMUS_DOWNLOADINFO_WAVE = 2;
DMUS_DOWNLOADINFO_INSTRUMENT2 = 3; (* New version for better DLS2 support. *)
 
DMUS_DEFAULT_SIZE_OFFSETTABLE = 1;
 
// Flags for DMUS_INSTRUMENT's ulFlags member
(* Flags for DMUS_INSTRUMENT's ulFlags member *)
 
DMUS_INSTRUMENT_GM_INSTRUMENT = 1; // (1 << 0) ????
DMUS_INSTRUMENT_GM_INSTRUMENT = 1 shl 0;
 
type
TDMUS_OFFSETTABLE = record
ulOffsetTable : array [0..DMUS_DEFAULT_SIZE_OFFSETTABLE] of Cardinal;
TDMus_OffsetTable = packed record
ulOffsetTable : array [0..DMUS_DEFAULT_SIZE_OFFSETTABLE-1] of ULONG;
end;
DMUS_OFFSETTABLE = TDMUS_OFFSETTABLE;
 
TDMUS_INSTRUMENT = record
ulPatch : Cardinal;
ulFirstRegionIdx : Cardinal;
ulGlobalArtIdx : Cardinal; // If zero the instrument does not have an articulation
ulFirstExtCkIdx : Cardinal; // If zero no 3rd party entenstion chunks associated with the instrument
ulCopyrightIdx : Cardinal; // If zero no Copyright information associated with the instrument
ulFlags : Cardinal;
TDMus_Instrument = packed record
ulPatch: ULONG;
ulFirstRegionIdx: ULONG;
ulGlobalArtIdx: ULONG; (* If zero the instrument does not have an articulation *)
ulFirstExtCkIdx: ULONG; (* If zero no 3rd party entenstion chunks associated with the instrument *)
ulCopyrightIdx: ULONG; (* If zero no Copyright information associated with the instrument *)
ulFlags: ULONG;
end;
DMUS_INSTRUMENT = TDMUS_INSTRUMENT;
 
TDMUS_REGION = record
RangeKey : RGNRANGE;
RangeVelocity : RGNRANGE;
TDMus_Region = packed record
RangeKey: TRGNRange;
RangeVelocity: TRGNRange;
fusOptions : Word;
usKeyGroup : Word;
ulRegionArtIdx : Cardinal; // If zero the region does not have an articulation
ulNextRegionIdx : Cardinal; // If zero no more regions
ulFirstExtCkIdx : Cardinal; // If zero no 3rd party entenstion chunks associated with the region
WaveLink : WAVELINK;
WSMP : WSMPL; // If WSMP.cSampleLoops > 1 then a WLOOP is included
WLOOP : array[0..0] of WLOOP;
ulRegionArtIdx: ULONG; (* If zero the region does not have an articulation *)
ulNextRegionIdx: ULONG; (* If zero no more regions *)
ulFirstExtCkIdx: ULONG; (* If zero no 3rd party entenstion chunks associated with the region *)
WaveLink: TWaveLink;
WSMP: TWSMPL; (* If WSMP.cSampleLoops > 1 then a WLOOP is included *)
WLOOP: array [0..0] of TWLoop;
end;
DMUS_REGION = TDMUS_REGION;
 
TDMUS_LFOPARAMS = record
pcFrequency : PCENT;
tcDelay : TCENT;
gcVolumeScale : GCENT;
pcPitchScale : PCENT;
gcMWToVolume : GCENT;
pcMWToPitch : PCENT;
TDMus_LFOParams = packed record
pcFrequency: TPCent;
tcDelay: TTCent;
gcVolumeScale: TGCent;
pcPitchScale: TPCent;
gcMWToVolume: TGCent;
pcMWToPitch: TPCent;
end;
DMUS_LFOPARAMS = TDMUS_LFOPARAMS;
 
TDMUS_VEGPARAMS = record
tcAttack : TCENT;
tcDecay : TCENT;
ptSustain : PERCENT;
tcRelease : TCENT;
tcVel2Attack : TCENT;
tcKey2Decay : TCENT;
TDMus_VEGParams = packed record
tcAttack: TTCent;
tcDecay: TTCent;
ptSustain: TPercent;
tcRelease: TTCent;
tcVel2Attack: TTCent;
tcKey2Decay: TTCent;
end;
DMUS_VEGPARAMS = TDMUS_VEGPARAMS;
 
TDMUS_PEGPARAMS = record
tcAttack : TCENT;
tcDecay : TCENT;
ptSustain : PERCENT;
tcRelease : TCENT;
tcVel2Attack : TCENT;
tcKey2Decay : TCENT;
pcRange : PCENT;
TDMus_PEGParams = packed record
tcAttack: TTCent;
tcDecay: TTCent;
ptSustain: TPercent;
tcRelease: TTCent;
tcVel2Attack: TTCent;
tcKey2Decay: TTCent;
pcRange: TPCent;
end;
DMUS_PEGPARAMS = TDMUS_PEGPARAMS;
 
TDMUS_MSCPARAMS = record
ptDefaultPan : PERCENT;
TDMus_MSCParams = packed record
ptDefaultPan: TPercent;
end;
DMUS_MSCPARAMS = TDMUS_MSCPARAMS;
 
TDMUS_ARTICPARAMS = record
LFO : DMUS_LFOPARAMS;
VolEG : DMUS_VEGPARAMS;
PitchEG : DMUS_PEGPARAMS;
Misc : DMUS_MSCPARAMS;
TDMus_ArticParams = packed record
LFO: TDMus_LFOParams;
VolEG: TDMus_VEGParams;
PitchEG: TDMus_PEGParams;
Misc: TDMus_MSCParams;
end;
DMUS_ARTICPARAMS = TDMUS_ARTICPARAMS;
 
TDMUS_ARTICULATION = record
ulArt1Idx : Cardinal; // If zero no DLS Level 1 articulation chunk
ulFirstExtCkIdx : Cardinal; // If zero no 3rd party entenstion chunks associated with the articulation
ulNextArtIdx : Cardinal; // Additional articulation chunks
TDMus_Articulation = packed record
ulArt1Idx: ULONG; (* If zero no DLS Level 1 articulation chunk *)
ulFirstExtCkIdx: ULONG; (* If zero no 3rd party entenstion chunks associated with the articulation *)
end;
DMUS_ARTICULATION = TDMUS_ARTICULATION;
 
TDMUS_ARTICULATION2 = record
ulArt1Idx : Cardinal; // If zero no DLS Level 1 articulation chunk
ulFirstExtCkIdx : Cardinal; // If zero no 3rd party entenstion chunks associated with the articulation
end;
DMUS_ARTICULATION2 = TDMUS_ARTICULATION2;
 
const
DMUS_MIN_DATA_SIZE = 4;
// The actual number is determined by cbSize of struct _DMUS_EXTENSIONCHUNK
 
(* The actual number is determined by cbSize of struct _DMUS_EXTENSIONCHUNK *)
 
type
TDMUS_EXTENSIONCHUNK = record
cbSize : Cardinal; // Size of extension chunk
ulNextExtCkIdx : Cardinal; // If zero no more 3rd party entenstion chunks
ExtCkID : FOURCC;
byExtCk : array[0..DMUS_MIN_DATA_SIZE - 1] of Byte; // The actual number that follows is determined by cbSize
DMus_ExtensionChunk = packed record
cbSize: ULONG; (* Size of extension chunk *)
ulNextExtCkIdx: ULONG; (* If zero no more 3rd party entenstion chunks *)
ExtCkID: TFourCC;
byExtCk: array [0..DMUS_MIN_DATA_SIZE-1] of BYTE; (* The actual number that follows is determined by cbSize *)
end;
DMUS_EXTENSIONCHUNK = TDMUS_EXTENSIONCHUNK;
 
// The actual number is determined by cbSize of struct TDMUS_COPYRIGHT
(* The actual number is determined by cbSize of struct _DMUS_COPYRIGHT *)
 
TDMUS_COPYRIGHT = record
cbSize : Cardinal; // Size of copyright information
byCopyright : array[0..DMUS_MIN_DATA_SIZE - 1] of Byte; // The actual number that follows is determined by cbSize
TDmus_Copyright = packed record
cbSize: ULONG; (* Size of copyright information *)
byCopyright: array [0..DMUS_MIN_DATA_SIZE-1] of BYTE; (* The actual number that follows is determined by cbSize *)
end;
DMUS_COPYRIGHT = TDMUS_COPYRIGHT;
 
TDMUS_WAVEDATA = record
cbSize : Cardinal;
byData : array[0..DMUS_MIN_DATA_SIZE - 1] of Byte;
TDMus_WaveData = packed record
cbSize: ULONG;
byData: array [0..DMUS_MIN_DATA_SIZE-1] of BYTE;
end;
DMUS_WAVEDATA = TDMUS_WAVEDATA;
 
TDMUS_WAVE = record
ulFirstExtCkIdx : Cardinal; // If zero no 3rd party entenstion chunks associated with the wave
ulCopyrightIdx : Cardinal; // If zero no Copyright information associated with the wave
ulWaveDataIdx : Cardinal; // Location of actual wave data.
WaveformatEx : TWAVEFORMATEX;
TDMus_Wave = packed record
ulFirstExtCkIdx: ULONG; (* If zero no 3rd party entenstion chunks associated with the wave *)
ulCopyrightIdx: ULONG; (* If zero no Copyright information associated with the wave *)
ulWaveDataIdx: ULONG; (* Location of actual wave data. *)
/// WaveformatEx: TWaveFormatEx;
end;
DMUS_WAVE = TDMUS_WAVE;
 
LPDMUS_NOTERANGE = ^TDMUS_NOTERANGE;
TDMUS_NOTERANGE = record
dwLowNote : DWORD; // Sets the low note for the range of MIDI note events to which the instrument responds.
dwHighNote : DWORD; // Sets the high note for the range of MIDI note events to which the instrument responds.
PDMus_NoteRange = ^TDMus_NoteRange;
TDMus_NoteRange = packed record
dwLowNote: DWORD; (* Sets the low note for the range of MIDI note events to which the instrument responds.*)
dwHighNote: DWORD; (* Sets the high note for the range of MIDI note events to which the instrument responds.*)
end;
DMUS_NOTERANGE = TDMUS_NOTERANGE;
 
(************************************************************************
* *
* dmerror.h -- Error code returned by DirectMusic API's *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
************************************************************************)
 
const
FACILITY_DIRECTMUSIC = $878; (* Shared with DirectSound *)
DMUS_ERRBASE = $1000; (* Make error codes human readable in hex *)
 
MAKE_DMHRESULTSUCCESS = (0 shl 31) or (FACILITY_DIRECTMUSIC shl 16) or DMUS_ERRBASE;
MAKE_DMHRESULTERROR = (1 shl 31) or (FACILITY_DIRECTMUSIC shl 16) or DMUS_ERRBASE;
 
 
//***********************************************************************
// *
// dmerror.h -- Error code returned by DirectMusic API's *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
//**********************************************************************
(* DMUS_S_PARTIALLOAD
*
* The object could only load partially. This can happen if some components are
* not registered properly, such as embedded tracks and tools.
*)
DMUS_S_PARTIALLOAD = MAKE_DMHRESULTSUCCESS + $091;
 
const
FACILITY_DIRECTMUSIC = $878; // Shared with DirectSound
DMUS_ERRBASE = $1000; // Make error codes human readable in hex
(* DMUS_S_PARTIALDOWNLOAD
*
* This code indicates that a band download was only successful in reaching
* some, but not all, of the referenced ports. Some samples may not play
* correctly.
*)
DMUS_S_PARTIALDOWNLOAD = MAKE_DMHRESULTSUCCESS + $092;
 
function MAKE_DMHRESULTSUCCESS(code: Cardinal) : HResult;
function MAKE_DMHRESULTERROR(code: Cardinal) : HResult;
(* DMUS_S_REQUEUE
*
* Return value from IDirectMusicTool::ProcessPMsg() which indicates to the
* performance that it should cue the PMsg again automatically.
*)
DMUS_S_REQUEUE = MAKE_DMHRESULTSUCCESS + $200;
 
// DMUS_S_PARTIALLOAD
//
// The object could only load partially. This can happen if some components are
// not registered properly, such as embedded tracks and tools.
///
const
DMUS_S_PARTIALLOAD = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $091;// MAKE_DMHRESULTSUCCESS($091);
(* DMUS_S_FREE
*
* Return value from IDirectMusicTool::ProcessPMsg() which indicates to the
* performance that it should free the PMsg automatically.
*)
DMUS_S_FREE = MAKE_DMHRESULTSUCCESS + $201;
 
// DMUS_S_REQUEUE
//
// Return value from IDirectMusicTool::ProcessPMsg() which indicates to the
// performance that it should cue the PMsg again automatically.
///
DMUS_S_REQUEUE = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $200;//MAKE_DMHRESULTSUCCESS(0x200)
(* DMUS_S_END
*
* Return value from IDirectMusicTrack::Play() which indicates to the
* segment that the track has no more data after mtEnd.
*)
DMUS_S_END = MAKE_DMHRESULTSUCCESS + $202;
 
// DMUS_S_FREE
//
// Return value from IDirectMusicTool::ProcessPMsg() which indicates to the
// performance that it should free the PMsg automatically.
///
DMUS_S_FREE = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $201;//MAKE_DMHRESULTSUCCESS(0x201)
(* DMUS_S_STRING_TRUNCATED
*
* Returned string has been truncated to fit the buffer size.
*)
DMUS_S_STRING_TRUNCATED = MAKE_DMHRESULTSUCCESS + $210;
 
// DMUS_S_END
//
// Return value from IDirectMusicTrack::Play() which indicates to the
// segment that the track has no more data after mtEnd.
///
DMUS_S_END = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $202;//MAKE_DMHRESULTSUCCESS(0x202)
(* DMUS_S_LAST_TOOL
*
* Returned from IDirectMusicGraph::StampPMsg(), this indicates that the PMsg
* is already stamped with the last tool in the graph. The returned PMsg's
* tool pointer is now NULL.
*)
DMUS_S_LAST_TOOL = MAKE_DMHRESULTSUCCESS + $211;
 
// DMUS_S_STRING_TRUNCATED
//
// Returned string has been truncated to fit the buffer size.
///
DMUS_S_STRING_TRUNCATED = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $210;//MAKE_DMHRESULTSUCCESS(0x210)
(* DMUS_S_OVER_CHORD
*
* Returned from IDirectMusicPerformance::MusicToMIDI(), this indicates
* that no note has been calculated because the music value has the note
* at a position higher than the top note of the chord. This applies only
* to DMUS_PLAYMODE_NORMALCHORD play mode. This success code indicates
* that the caller should not do anything with the note. It is not meant
* to be played against this chord.
*)
DMUS_S_OVER_CHORD = MAKE_DMHRESULTSUCCESS + $212;
 
// DMUS_S_LAST_TOOL
//
// Returned from IDirectMusicGraph::StampPMsg(), this indicates that the PMsg
// is already stamped with the last tool in the graph. The returned PMsg's
// tool pointer is now NULL.
///
DMUS_S_LAST_TOOL = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $211;//MAKE_DMHRESULTSUCCESS(0x211)
(* DMUS_S_UP_OCTAVE
*
* Returned from IDirectMusicPerformance::MIDIToMusic(), and
* IDirectMusicPerformance::MusicToMIDI(), this indicates
* that the note conversion generated a note value that is below 0,
* so it has been bumped up one or more octaves to be in the proper
* MIDI range of 0 through 127.
* Note that this is valid for MIDIToMusic() when using play modes
* DMUS_PLAYMODE_FIXEDTOCHORD and DMUS_PLAYMODE_FIXEDTOKEY, both of
* which store MIDI values in wMusicValue. With MusicToMIDI(), it is
* valid for all play modes.
* Ofcourse, DMUS_PLAYMODE_FIXED will never return this success code.
*)
DMUS_S_UP_OCTAVE = MAKE_DMHRESULTSUCCESS + $213;
 
// DMUS_S_OVER_CHORD
//
// Returned from IDirectMusicPerformance::MusicToMIDI(), this indicates
// that no note has been calculated because the music value has the note
// at a position higher than the top note of the chord. This applies only
// to DMUS_PLAYMODE_NORMALCHORD play mode. This success code indicates
// that the caller should not do anything with the note. It is not meant
// to be played against this chord.
///
DMUS_S_OVER_CHORD = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $212;//MAKE_DMHRESULTSUCCESS(0x212)
(* DMUS_S_DOWN_OCTAVE
*
* Returned from IDirectMusicPerformance::MIDIToMusic(), and
* IDirectMusicPerformance::MusicToMIDI(), this indicates
* that the note conversion generated a note value that is above 127,
* so it has been bumped down one or more octaves to be in the proper
* MIDI range of 0 through 127.
* Note that this is valid for MIDIToMusic() when using play modes
* DMUS_PLAYMODE_FIXEDTOCHORD and DMUS_PLAYMODE_FIXEDTOKEY, both of
* which store MIDI values in wMusicValue. With MusicToMIDI(), it is
* valid for all play modes.
* Ofcourse, DMUS_PLAYMODE_FIXED will never return this success code.
*)
DMUS_S_DOWN_OCTAVE = MAKE_DMHRESULTSUCCESS + $214;
 
// DMUS_S_UP_OCTAVE
//
// Returned from IDirectMusicPerformance::MIDIToMusic(), and
// IDirectMusicPerformance::MusicToMIDI(), this indicates
// that the note conversion generated a note value that is below 0,
// so it has been bumped up one or more octaves to be in the proper
// MIDI range of 0 through 127.
// Note that this is valid for MIDIToMusic() when using play modes
// DMUS_PLAYMODE_FIXEDTOCHORD and DMUS_PLAYMODE_FIXEDTOKEY, both of
// which store MIDI values in wMusicValue. With MusicToMIDI(), it is
// valid for all play modes.
// Ofcourse, DMUS_PLAYMODE_FIXED will never return this success code.
///
DMUS_S_UP_OCTAVE = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $213;//MAKE_DMHRESULTSUCCESS(0x213)
(* DMUS_S_NOBUFFERCONTROL
*
* Although the audio output from the port will be routed to the
* same device as the given DirectSound buffer, buffer controls
* such as pan and volume will not affect the output.
*
*)
DMUS_S_NOBUFFERCONTROL = MAKE_DMHRESULTSUCCESS + $215;
 
// DMUS_S_DOWN_OCTAVE
//
// Returned from IDirectMusicPerformance::MIDIToMusic(), and
// IDirectMusicPerformance::MusicToMIDI(), this indicates
// that the note conversion generated a note value that is above 127,
// so it has been bumped down one or more octaves to be in the proper
// MIDI range of 0 through 127.
// Note that this is valid for MIDIToMusic() when using play modes
// DMUS_PLAYMODE_FIXEDTOCHORD and DMUS_PLAYMODE_FIXEDTOKEY, both of
// which store MIDI values in wMusicValue. With MusicToMIDI(), it is
// valid for all play modes.
// Ofcourse, DMUS_PLAYMODE_FIXED will never return this success code.
///
DMUS_S_DOWN_OCTAVE = (0 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $214;//MAKE_DMHRESULTSUCCESS(0x214)
(* DMUS_E_DRIVER_FAILED
*
* An unexpected error was returned from a device driver, indicating
* possible failure of the driver or hardware.
*)
DMUS_E_DRIVER_FAILED = MAKE_DMHRESULTERROR + $0101;
 
// DMUS_E_DRIVER_FAILED
//
// An unexpected error was returned from a device driver, indicating
// possible failure of the driver or hardware.
///
DMUS_E_DRIVER_FAILED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0101;//MAKE_DMHRESULTERROR(0x0101)
(* DMUS_E_PORTS_OPEN
*
* The requested operation cannot be performed while there are
* instantiated ports in any process in the system.
*)
DMUS_E_PORTS_OPEN = MAKE_DMHRESULTERROR + $0102;
 
// DMUS_E_PORTS_OPEN
//
// The requested operation cannot be performed while there are
// instantiated ports in any process in the system.
///
DMUS_E_PORTS_OPEN = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0102;//MAKE_DMHRESULTERROR(0x0102)
(* DMUS_E_DEVICE_IN_USE
*
* The requested device is already in use (possibly by a non-DirectMusic
* client) and cannot be opened again.
*)
DMUS_E_DEVICE_IN_USE = MAKE_DMHRESULTERROR + $0103;
 
// DMUS_E_DEVICE_IN_USE
//
// The requested device is already in use (possibly by a non-DirectMusic
// client) and cannot be opened again.
///
DMUS_E_DEVICE_IN_USE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0103;//MAKE_DMHRESULTERROR(0x0103)
(* DMUS_E_INSUFFICIENTBUFFER
*
* Buffer is not large enough for requested operation.
*)
DMUS_E_INSUFFICIENTBUFFER = MAKE_DMHRESULTERROR + $0104;
 
// DMUS_E_INSUFFICIENTBUFFER
//
// Buffer is not large enough for requested operation.
///
DMUS_E_INSUFFICIENTBUFFER = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0104;//MAKE_DMHRESULTERROR(0x0104)
(* DMUS_E_BUFFERNOTSET
*
* No buffer was prepared for the download data.
*)
DMUS_E_BUFFERNOTSET = MAKE_DMHRESULTERROR + $0105;
 
// DMUS_E_BUFFERNOTSET
//
// No buffer was prepared for the download data.
///
DMUS_E_BUFFERNOTSET = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0105;//MAKE_DMHRESULTERROR(0x0105)
(* DMUS_E_BUFFERNOTAVAILABLE
*
* Download failed due to inability to access or create download buffer.
*)
DMUS_E_BUFFERNOTAVAILABLE = MAKE_DMHRESULTERROR + $0106;
 
// DMUS_E_BUFFERNOTAVAILABLE
//
// Download failed due to inability to access or create download buffer.
///
DMUS_E_BUFFERNOTAVAILABLE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0106;//MAKE_DMHRESULTERROR(0x0106)
(* DMUS_E_NOTADLSCOL
*
* Error parsing DLS collection. File is corrupt.
*)
DMUS_E_NOTADLSCOL = MAKE_DMHRESULTERROR + $0108;
 
// DMUS_E_NOTADLSCOL
//
// Error parsing DLS collection. File is corrupt.
///
DMUS_E_NOTADLSCOL = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0108;//MAKE_DMHRESULTERROR(0x0108)
(* DMUS_E_INVALIDOFFSET
*
* Wave chunks in DLS collection file are at incorrect offsets.
*)
DMUS_E_INVALIDOFFSET = MAKE_DMHRESULTERROR + $0109;
 
// DMUS_E_INVALIDOFFSET
//
// Wave chunks in DLS collection file are at incorrect offsets.
///
DMUS_E_INVALIDOFFSET = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0109;//MAKE_DMHRESULTERROR(0x0109)
(* DMUS_E_ALREADY_LOADED
*
* Second attempt to load a DLS collection that is currently open.
*)
DMUS_E_ALREADY_LOADED = MAKE_DMHRESULTERROR + $0111;
 
// DMUS_E_ALREADY_LOADED
//
// Second attempt to load a DLS collection that is currently open.
///
DMUS_E_ALREADY_LOADED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0111;//MAKE_DMHRESULTERROR(0x0111)
(* DMUS_E_INVALIDPOS
*
* Error reading wave data from DLS collection. Indicates bad file.
*)
DMUS_E_INVALIDPOS = MAKE_DMHRESULTERROR + $0113;
 
// DMUS_E_INVALIDPOS
//
// Error reading wave data from DLS collection. Indicates bad file.
///
DMUS_E_INVALIDPOS = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0113;//MAKE_DMHRESULTERROR(0x0113)
(* DMUS_E_INVALIDPATCH
*
* There is no instrument in the collection that matches patch number.
*)
DMUS_E_INVALIDPATCH = MAKE_DMHRESULTERROR + $0114;
 
// DMUS_E_INVALIDPATCH
//
// There is no instrument in the collection that matches patch number.
///
DMUS_E_INVALIDPATCH = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0114;//MAKE_DMHRESULTERROR(0x0114)
(* DMUS_E_CANNOTSEEK
*
* The IStream* doesn't support Seek().
*)
DMUS_E_CANNOTSEEK = MAKE_DMHRESULTERROR + $0115;
 
// DMUS_E_CANNOTSEEK
//
// The IStream* doesn't support Seek().
///
DMUS_E_CANNOTSEEK = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0115;//MAKE_DMHRESULTERROR(0x0115)
(* DMUS_E_CANNOTWRITE
*
* The IStream* doesn't support Write().
*)
DMUS_E_CANNOTWRITE = MAKE_DMHRESULTERROR + $0116;
 
// DMUS_E_CANNOTWRITE
//
// The IStream* doesn't support Write().
///
DMUS_E_CANNOTWRITE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0116;//MAKE_DMHRESULTERROR(0x0116)
(* DMUS_E_CHUNKNOTFOUND
*
* The RIFF parser doesn't contain a required chunk while parsing file.
*)
DMUS_E_CHUNKNOTFOUND = MAKE_DMHRESULTERROR + $0117;
 
// DMUS_E_CHUNKNOTFOUND
//
// The RIFF parser doesn't contain a required chunk while parsing file.
///
DMUS_E_CHUNKNOTFOUND = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0117;//MAKE_DMHRESULTERROR(0x0117)
(* DMUS_E_INVALID_DOWNLOADID
*
* Invalid download id was used in the process of creating a download buffer.
*)
DMUS_E_INVALID_DOWNLOADID = MAKE_DMHRESULTERROR + $0119;
 
// DMUS_E_INVALID_DOWNLOADID
//
// Invalid download id was used in the process of creating a download buffer.
///
DMUS_E_INVALID_DOWNLOADID = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0119;//MAKE_DMHRESULTERROR(0x0119)
(* DMUS_E_NOT_DOWNLOADED_TO_PORT
*
* Tried to unload an object that was not downloaded or previously unloaded.
*)
DMUS_E_NOT_DOWNLOADED_TO_PORT = MAKE_DMHRESULTERROR + $0120;
 
// DMUS_E_NOT_DOWNLOADED_TO_PORT
//
// Tried to unload an object that was not downloaded or previously unloaded.
///
DMUS_E_NOT_DOWNLOADED_TO_PORT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0120;//MAKE_DMHRESULTERROR(0x0120)
(* DMUS_E_ALREADY_DOWNLOADED
*
* Buffer was already downloaded to synth.
*)
DMUS_E_ALREADY_DOWNLOADED = MAKE_DMHRESULTERROR + $0121;
 
// DMUS_E_ALREADY_DOWNLOADED
//
// Buffer was already downloaded to synth.
///
DMUS_E_ALREADY_DOWNLOADED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0121;//MAKE_DMHRESULTERROR(0x0121)
(* DMUS_E_UNKNOWN_PROPERTY
*
* The specified property item was not recognized by the target object.
*)
DMUS_E_UNKNOWN_PROPERTY = MAKE_DMHRESULTERROR + $0122;
 
// DMUS_E_UNKNOWN_PROPERTY
//
// The specified property item was not recognized by the target object.
///
DMUS_E_UNKNOWN_PROPERTY = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0122;//MAKE_DMHRESULTERROR(0x0122)
(* DMUS_E_SET_UNSUPPORTED
*
* The specified property item may not be set on the target object.
*)
DMUS_E_SET_UNSUPPORTED = MAKE_DMHRESULTERROR + $0123;
 
// DMUS_E_SET_UNSUPPORTED
//
// The specified property item may not be set on the target object.
///
DMUS_E_SET_UNSUPPORTED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0123;//MAKE_DMHRESULTERROR(0x0123)
(* DMUS_E_GET_UNSUPPORTED
*
* The specified property item may not be retrieved from the target object.
*)
DMUS_E_GET_UNSUPPORTED = MAKE_DMHRESULTERROR + $0124;
 
// DMUS_E_GET_UNSUPPORTED
//
// The specified property item may not be retrieved from the target object.
///
DMUS_E_GET_UNSUPPORTED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0124;//MAKE_DMHRESULTERROR(0x0124)
(* DMUS_E_NOTMONO
*
* Wave chunk has more than one interleaved channel. DLS format requires MONO.
*)
DMUS_E_NOTMONO = MAKE_DMHRESULTERROR + $0125;
 
// DMUS_E_NOTMONO
//
// Wave chunk has more than one interleaved channel. DLS format requires MONO.
///
DMUS_E_NOTMONO = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0125;//MAKE_DMHRESULTERROR(0x0125)
(* DMUS_E_BADARTICULATION
*
* Invalid articulation chunk in DLS collection.
*)
DMUS_E_BADARTICULATION = MAKE_DMHRESULTERROR + $0126;
 
// DMUS_E_BADARTICULATION
//
// Invalid articulation chunk in DLS collection.
///
DMUS_E_BADARTICULATION = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0126;//MAKE_DMHRESULTERROR(0x0126)
(* DMUS_E_BADINSTRUMENT
*
* Invalid instrument chunk in DLS collection.
*)
DMUS_E_BADINSTRUMENT = MAKE_DMHRESULTERROR + $0127;
 
// DMUS_E_BADINSTRUMENT
//
// Invalid instrument chunk in DLS collection.
///
DMUS_E_BADINSTRUMENT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0127;//MAKE_DMHRESULTERROR(0x0127)
(* DMUS_E_BADWAVELINK
*
* Wavelink chunk in DLS collection points to invalid wave.
*)
DMUS_E_BADWAVELINK = MAKE_DMHRESULTERROR + $0128;
 
// DMUS_E_BADWAVELINK
//
// Wavelink chunk in DLS collection points to invalid wave.
///
DMUS_E_BADWAVELINK = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0128;//MAKE_DMHRESULTERROR(0x0128)
(* DMUS_E_NOARTICULATION
*
* Articulation missing from instrument in DLS collection.
*)
DMUS_E_NOARTICULATION = MAKE_DMHRESULTERROR + $0129;
 
// DMUS_E_NOARTICULATION
//
// Articulation missing from instrument in DLS collection.
///
DMUS_E_NOARTICULATION = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0129;//MAKE_DMHRESULTERROR(0x0129)
(* DMUS_E_NOTPCM
*
* Downoaded DLS wave is not in PCM format.
*)
DMUS_E_NOTPCM = MAKE_DMHRESULTERROR + $012A;
 
// DMUS_E_NOTPCM
//
// Downoaded DLS wave is not in PCM format.
///
DMUS_E_NOTPCM = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $012A;//MAKE_DMHRESULTERROR(0x012A)
(* DMUS_E_BADWAVE
*
* Bad wave chunk in DLS collection
*)
DMUS_E_BADWAVE = MAKE_DMHRESULTERROR + $012B;
 
// DMUS_E_BADWAVE
//
// Bad wave chunk in DLS collection
///
DMUS_E_BADWAVE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $012B;//MAKE_DMHRESULTERROR(0x012B)
(* DMUS_E_BADOFFSETTABLE
*
* Offset Table for download buffer has errors.
*)
DMUS_E_BADOFFSETTABLE = MAKE_DMHRESULTERROR + $012C;
 
// DMUS_E_BADOFFSETTABLE
//
// Offset Table for download buffer has errors.
///
DMUS_E_BADOFFSETTABLE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $012C;//MAKE_DMHRESULTERROR(0x012C)
(* DMUS_E_UNKNOWNDOWNLOAD
*
* Attempted to download unknown data type.
*)
DMUS_E_UNKNOWNDOWNLOAD = MAKE_DMHRESULTERROR + $012D;
 
// DMUS_E_UNKNOWNDOWNLOAD
//
// Attempted to download unknown data type.
///
DMUS_E_UNKNOWNDOWNLOAD = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $012D;//MAKE_DMHRESULTERROR(0x012D)
(* DMUS_E_NOSYNTHSINK
*
* The operation could not be completed because no sink was connected to
* the synthesizer.
*)
DMUS_E_NOSYNTHSINK = MAKE_DMHRESULTERROR + $012E;
 
// DMUS_E_NOSYNTHSINK
//
// The operation could not be completed because no sink was connected to
// the synthesizer.
///
DMUS_E_NOSYNTHSINK = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $012E;//MAKE_DMHRESULTERROR(0x012E)
(* DMUS_E_ALREADYOPEN
*
* An attempt was made to open the software synthesizer while it was already
* open.
* ASSERT?
*)
DMUS_E_ALREADYOPEN = MAKE_DMHRESULTERROR + $012F;
 
// DMUS_E_ALREADYOPEN
//
// An attempt was made to open the software synthesizer while it was already
// open.
// ASSERT?
///
DMUS_E_ALREADYOPEN = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $012F;//MAKE_DMHRESULTERROR(0x012F)
(* DMUS_E_ALREADYCLOSE
*
* An attempt was made to close the software synthesizer while it was already
* open.
* ASSERT?
*)
DMUS_E_ALREADYCLOSED = MAKE_DMHRESULTERROR + $0130;
 
// DMUS_E_ALREADYCLOSE
//
// An attempt was made to close the software synthesizer while it was already
// open.
// ASSERT?
///
DMUS_E_ALREADYCLOSED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0130;//MAKE_DMHRESULTERROR(0x0130)
(* DMUS_E_SYNTHNOTCONFIGURED
*
* The operation could not be completed because the software synth has not
* yet been fully configured.
* ASSERT?
*)
DMUS_E_SYNTHNOTCONFIGURED = MAKE_DMHRESULTERROR + $0131;
 
// DMUS_E_SYNTHNOTCONFIGURED
//
// The operation could not be completed because the software synth has not
// yet been fully configured.
// ASSERT?
///
DMUS_E_SYNTHNOTCONFIGURED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0131;//MAKE_DMHRESULTERROR(0x0131)
(* DMUS_E_SYNTHACTIVE
*
* The operation cannot be carried out while the synthesizer is active.
*)
DMUS_E_SYNTHACTIVE = MAKE_DMHRESULTERROR + $0132;
 
// DMUS_E_SYNTHACTIVE
//
// The operation cannot be carried out while the synthesizer is active.
///
DMUS_E_SYNTHACTIVE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0132;//MAKE_DMHRESULTERROR(0x0132)
(* DMUS_E_CANNOTREAD
*
* An error occurred while attempting to read from the IStream* object.
*)
DMUS_E_CANNOTREAD = MAKE_DMHRESULTERROR + $0133;
 
// DMUS_E_CANNOTREAD
//
// An error occurred while attempting to read from the IStream* object.
///
DMUS_E_CANNOTREAD = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0133;//MAKE_DMHRESULTERROR(0x0133)
(* DMUS_E_DMUSIC_RELEASED
*
* The operation cannot be performed because the final instance of the
* DirectMusic object was released. Ports cannot be used after final
* release of the DirectMusic object.
*)
DMUS_E_DMUSIC_RELEASED = MAKE_DMHRESULTERROR + $0134;
 
// DMUS_E_DMUSIC_RELEASED
//
// The operation cannot be performed because the final instance of the
// DirectMusic object was released. Ports cannot be used after final
// release of the DirectMusic object.
///
DMUS_E_DMUSIC_RELEASED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0134;//MAKE_DMHRESULTERROR(0x0134)
(* DMUS_E_BUFFER_EMPTY
*
* There was no data in the referenced buffer.
*)
DMUS_E_BUFFER_EMPTY = MAKE_DMHRESULTERROR + $0135;
 
// DMUS_E_BUFFER_EMPTY
//
// There was no data in the referenced buffer.
///
DMUS_E_BUFFER_EMPTY = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0135;//MAKE_DMHRESULTERROR(0x0135)
(* DMUS_E_BUFFER_FULL
*
* There is insufficient space to insert the given event into the buffer.
*)
DMUS_E_BUFFER_FULL = MAKE_DMHRESULTERROR + $0136;
 
// DMUS_E_BUFFER_FULL
//
// There is insufficient space to insert the given event into the buffer.
///
DMUS_E_BUFFER_FULL = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0136;//MAKE_DMHRESULTERROR(0x0136)
(* DMUS_E_PORT_NOT_CAPTURE
*
* The given operation could not be carried out because the port is a
* capture port.
*)
DMUS_E_PORT_NOT_CAPTURE = MAKE_DMHRESULTERROR + $0137;
 
// DMUS_E_PORT_NOT_CAPTURE
//
// The given operation could not be carried out because the port is a
// capture port.
///
DMUS_E_PORT_NOT_CAPTURE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0137;//MAKE_DMHRESULTERROR(0x0137)
(* DMUS_E_PORT_NOT_RENDER
*
* The given operation could not be carried out because the port is a
* render port.
*)
DMUS_E_PORT_NOT_RENDER = MAKE_DMHRESULTERROR + $0138;
 
// DMUS_E_PORT_NOT_RENDER
//
// The given operation could not be carried out because the port is a
// render port.
///
DMUS_E_PORT_NOT_RENDER = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0138;//MAKE_DMHRESULTERROR(0x0138)
(* DMUS_E_DSOUND_NOT_SET
*
* The port could not be created because no DirectSound has been specified.
* Specify a DirectSound interface via the IDirectMusic::SetDirectSound
* method; pass NULL to have DirectMusic manage usage of DirectSound.
*)
DMUS_E_DSOUND_NOT_SET = MAKE_DMHRESULTERROR + $0139;
 
// DMUS_E_DSOUND_NOT_SET
//
// The port could not be created because no DirectSound has been specified.
// Specify a DirectSound interface via the IDirectMusic::SetDirectSound
// method; pass NULL to have DirectMusic manage usage of DirectSound.
///
DMUS_E_DSOUND_NOT_SET = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0139;//MAKE_DMHRESULTERROR(0x0139)
(* DMUS_E_ALREADY_ACTIVATED
*
* The operation cannot be carried out while the port is active.
*)
DMUS_E_ALREADY_ACTIVATED = MAKE_DMHRESULTERROR + $013A;
 
// DMUS_E_ALREADY_ACTIVATED
//
// The operation cannot be carried out while the port is active.
///
DMUS_E_ALREADY_ACTIVATED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $013A;//MAKE_DMHRESULTERROR(0x013A)
(* DMUS_E_INVALIDBUFFER
*
* Invalid DirectSound buffer was handed to port.
*)
DMUS_E_INVALIDBUFFER = MAKE_DMHRESULTERROR + $013B;
 
// DMUS_E_INVALIDBUFFER
//
// Invalid DirectSound buffer was handed to port.
///
DMUS_E_INVALIDBUFFER = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $013B;//MAKE_DMHRESULTERROR(0x013B)
(* DMUS_E_WAVEFORMATNOTSUPPORTED
*
* Invalid buffer format was handed to the synth sink.
*)
DMUS_E_WAVEFORMATNOTSUPPORTED = MAKE_DMHRESULTERROR + $013C;
 
// DMUS_E_WAVEFORMATNOTSUPPORTED
//
// Invalid buffer format was handed to the synth sink.
///
DMUS_E_WAVEFORMATNOTSUPPORTED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $013C;//MAKE_DMHRESULTERROR(0x013C)
(* DMUS_E_SYNTHINACTIVE
*
* The operation cannot be carried out while the synthesizer is inactive.
*)
DMUS_E_SYNTHINACTIVE = MAKE_DMHRESULTERROR + $013D;
 
// DMUS_E_SYNTHINACTIVE
//
// The operation cannot be carried out while the synthesizer is inactive.
///
DMUS_E_SYNTHINACTIVE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $013D;//MAKE_DMHRESULTERROR(0x013D)
(* DMUS_E_DSOUND_ALREADY_SET
*
* IDirectMusic::SetDirectSound has already been called. It may not be
* changed while in use.
*)
DMUS_E_DSOUND_ALREADY_SET = MAKE_DMHRESULTERROR + $013E;
 
// DMUS_E_DSOUND_ALREADY_SET
//
// IDirectMusic::SetDirectSound has already been called. It may not be
// changed while in use.
///
DMUS_E_DSOUND_ALREADY_SET = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $013E;//MAKE_DMHRESULTERROR(0x013E)
(* DMUS_E_INVALID_EVENT
*
* The given event is invalid (either it is not a valid MIDI message
* or it makes use of running status). The event cannot be packed
* into the buffer.
*)
DMUS_E_INVALID_EVENT = MAKE_DMHRESULTERROR + $013F;
 
// DMUS_E_INVALID_EVENT
//
// The given event is invalid (either it is not a valid MIDI message
// or it makes use of running status). The event cannot be packed
// into the buffer.
///
DMUS_E_INVALID_EVENT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $013F;//MAKE_DMHRESULTERROR(0x013F)
(* DMUS_E_UNSUPPORTED_STREAM
*
* The IStream* object does not contain data supported by the loading object.
*)
DMUS_E_UNSUPPORTED_STREAM = MAKE_DMHRESULTERROR + $0150;
 
// DMUS_E_UNSUPPORTED_STREAM
//
// The IStream* object does not contain data supported by the loading object.
///
DMUS_E_UNSUPPORTED_STREAM = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0150;//MAKE_DMHRESULTERROR(0x0150)
(* DMUS_E_ALREADY_INITED
*
* The object has already been initialized.
*)
DMUS_E_ALREADY_INITED = MAKE_DMHRESULTERROR + $0151;
 
// DMUS_E_ALREADY_INITED
//
// The object has already been initialized.
///
DMUS_E_ALREADY_INITED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0151;//MAKE_DMHRESULTERROR(0x0151)
(* DMUS_E_INVALID_BAND
*
* The file does not contain a valid band.
*)
DMUS_E_INVALID_BAND = MAKE_DMHRESULTERROR + $0152;
 
// DMUS_E_INVALID_BAND
//
// The file does not contain a valid band.
///
DMUS_E_INVALID_BAND = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0152;//MAKE_DMHRESULTERROR(0x0152)
(* DMUS_E_TRACK_HDR_NOT_FIRST_CK
*
* The IStream* object's data does not have a track header as the first chunk,
* and therefore can not be read by the segment object.
*)
DMUS_E_TRACK_HDR_NOT_FIRST_CK = MAKE_DMHRESULTERROR + $0155;
 
// DMUS_E_TRACK_HDR_NOT_FIRST_CK
//
// The IStream* object's data does not have a track header as the first chunk,
// and therefore can not be read by the segment object.
///
DMUS_E_TRACK_HDR_NOT_FIRST_CK = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0155;//MAKE_DMHRESULTERROR(0x0155)
(* DMUS_E_TOOL_HDR_NOT_FIRST_CK
*
* The IStream* object's data does not have a tool header as the first chunk,
* and therefore can not be read by the graph object.
*)
DMUS_E_TOOL_HDR_NOT_FIRST_CK = MAKE_DMHRESULTERROR + $0156;
 
// DMUS_E_TOOL_HDR_NOT_FIRST_CK
//
// The IStream* object's data does not have a tool header as the first chunk,
// and therefore can not be read by the graph object.
///
DMUS_E_TOOL_HDR_NOT_FIRST_CK = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0156;//MAKE_DMHRESULTERROR(0x0156)
(* DMUS_E_INVALID_TRACK_HDR
*
* The IStream* object's data contains an invalid track header (ckid is 0 and
* fccType is NULL,) and therefore can not be read by the segment object.
*)
DMUS_E_INVALID_TRACK_HDR = MAKE_DMHRESULTERROR + $0157;
 
// DMUS_E_INVALID_TRACK_HDR
//
// The IStream* object's data contains an invalid track header (ckid is 0 and
// fccType is NULL,) and therefore can not be read by the segment object.
///
DMUS_E_INVALID_TRACK_HDR = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0157;//MAKE_DMHRESULTERROR(0x0157)
(* DMUS_E_INVALID_TOOL_HDR
*
* The IStream* object's data contains an invalid tool header (ckid is 0 and
* fccType is NULL,) and therefore can not be read by the graph object.
*)
DMUS_E_INVALID_TOOL_HDR = MAKE_DMHRESULTERROR + $0158;
 
// DMUS_E_INVALID_TOOL_HDR
//
// The IStream* object's data contains an invalid tool header (ckid is 0 and
// fccType is NULL,) and therefore can not be read by the graph object.
///
DMUS_E_INVALID_TOOL_HDR = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0158;//MAKE_DMHRESULTERROR(0x0158)
(* DMUS_E_ALL_TOOLS_FAILED
*
* The graph object was unable to load all tools from the IStream* object data.
* This may be due to errors in the stream, or the tools being incorrectly
* registered on the client.
*)
DMUS_E_ALL_TOOLS_FAILED = MAKE_DMHRESULTERROR + $0159;
 
// DMUS_E_ALL_TOOLS_FAILED
//
// The graph object was unable to load all tools from the IStream* object data.
// This may be due to errors in the stream, or the tools being incorrectly
// registered on the client.
///
DMUS_E_ALL_TOOLS_FAILED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0159;//MAKE_DMHRESULTERROR(0x0159)
(* DMUS_E_ALL_TRACKS_FAILED
*
* The segment object was unable to load all tracks from the IStream* object data.
* This may be due to errors in the stream, or the tracks being incorrectly
* registered on the client.
*)
DMUS_E_ALL_TRACKS_FAILED = MAKE_DMHRESULTERROR + $0160;
 
// DMUS_E_ALL_TRACKS_FAILED
//
// The segment object was unable to load all tracks from the IStream* object data.
// This may be due to errors in the stream, or the tracks being incorrectly
// registered on the client.
///
DMUS_E_ALL_TRACKS_FAILED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0160;//MAKE_DMHRESULTERROR(0x0160)
(* DMUS_E_NOT_FOUND
*
* The requested item was not contained by the object.
*)
DMUS_E_NOT_FOUND = MAKE_DMHRESULTERROR + $0161;
 
// DMUS_E_NOT_FOUND
//
// The requested item was not contained by the object.
///
DMUS_E_NOT_FOUND = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0161;//MAKE_DMHRESULTERROR(0x0161)
(* DMUS_E_NOT_INIT
*
* A required object is not initialized or failed to initialize.
*)
DMUS_E_NOT_INIT = MAKE_DMHRESULTERROR + $0162;
 
// DMUS_E_NOT_INIT
//
// A required object is not initialized or failed to initialize.
///
DMUS_E_NOT_INIT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0162;//MAKE_DMHRESULTERROR(0x0162)
(* DMUS_E_TYPE_DISABLED
*
* The requested parameter type is currently disabled. Parameter types may
* be enabled and disabled by certain calls to SetParam().
*)
DMUS_E_TYPE_DISABLED = MAKE_DMHRESULTERROR + $0163;
 
// DMUS_E_TYPE_DISABLED
//
// The requested parameter type is currently disabled. Parameter types may
// be enabled and disabled by certain calls to SetParam().
///
DMUS_E_TYPE_DISABLED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0163;//MAKE_DMHRESULTERROR(0x0163)
(* DMUS_E_TYPE_UNSUPPORTED
*
* The requested parameter type is not supported on the object.
*)
DMUS_E_TYPE_UNSUPPORTED = MAKE_DMHRESULTERROR + $0164;
 
// DMUS_E_TYPE_UNSUPPORTED
//
// The requested parameter type is not supported on the object.
///
DMUS_E_TYPE_UNSUPPORTED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0164;//MAKE_DMHRESULTERROR(0x0164)
(* DMUS_E_TIME_PAST
*
* The time is in the past, and the operation can not succeed.
*)
DMUS_E_TIME_PAST = MAKE_DMHRESULTERROR + $0165;
 
// DMUS_E_TIME_PAST
//
// The time is in the past, and the operation can not succeed.
///
DMUS_E_TIME_PAST = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0165;//MAKE_DMHRESULTERROR(0x0165)
(* DMUS_E_TRACK_NOT_FOUND
*
* The requested track is not contained by the segment.
*)
DMUS_E_TRACK_NOT_FOUND = MAKE_DMHRESULTERROR + $0166;
 
// DMUS_E_TRACK_NOT_FOUND
//
// The requested track is not contained by the segment.
///
DMUS_E_TRACK_NOT_FOUND = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0166;//MAKE_DMHRESULTERROR(0x0166)
(* DMUS_E_NO_MASTER_CLOCK
*
* There is no master clock in the performance. Be sure to call
* IDirectMusicPerformance::Init().
*)
DMUS_E_NO_MASTER_CLOCK = MAKE_DMHRESULTERROR + $0170;
 
// DMUS_E_NO_MASTER_CLOCK
//
// There is no master clock in the performance. Be sure to call
// IDirectMusicPerformance::Init().
///
DMUS_E_NO_MASTER_CLOCK = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0170;//MAKE_DMHRESULTERROR(0x0170)
(* DMUS_E_LOADER_NOCLASSID
*
* The class id field is required and missing in the DMUS_OBJECTDESC.
*)
DMUS_E_LOADER_NOCLASSID = MAKE_DMHRESULTERROR + $0180;
 
// DMUS_E_LOADER_NOCLASSID
//
// The class id field is required and missing in the DMUS_OBJECTDESC.
///
DMUS_E_LOADER_NOCLASSID = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0180;//MAKE_DMHRESULTERROR(0x0180)
(* DMUS_E_LOADER_BADPATH
*
* The requested file path is invalid.
*)
DMUS_E_LOADER_BADPATH = MAKE_DMHRESULTERROR + $0181;
 
// DMUS_E_LOADER_BADPATH
//
// The requested file path is invalid.
///
DMUS_E_LOADER_BADPATH = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0181;//MAKE_DMHRESULTERROR(0x0181)
(* DMUS_E_LOADER_FAILEDOPEN
*
* File open failed - either file doesn't exist or is locked.
*)
DMUS_E_LOADER_FAILEDOPEN = MAKE_DMHRESULTERROR + $0182;
 
// DMUS_E_LOADER_FAILEDOPEN
//
// File open failed - either file doesn't exist or is locked.
///
DMUS_E_LOADER_FAILEDOPEN = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0182;//MAKE_DMHRESULTERROR(0x0182)
(* DMUS_E_LOADER_FORMATNOTSUPPORTED
*
* Search data type is not supported.
*)
DMUS_E_LOADER_FORMATNOTSUPPORTED = MAKE_DMHRESULTERROR + $0183;
 
// DMUS_E_LOADER_FORMATNOTSUPPORTED
//
// Search data type is not supported.
///
DMUS_E_LOADER_FORMATNOTSUPPORTED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0183;//MAKE_DMHRESULTERROR(0x0183)
(* DMUS_E_LOADER_FAILEDCREATE
*
* Unable to find or create object.
*)
DMUS_E_LOADER_FAILEDCREATE = MAKE_DMHRESULTERROR + $0184;
 
// DMUS_E_LOADER_FAILEDCREATE
//
// Unable to find or create object.
///
DMUS_E_LOADER_FAILEDCREATE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0184;//MAKE_DMHRESULTERROR(0x0184)
(* DMUS_E_LOADER_OBJECTNOTFOUND
*
* Object was not found.
*)
DMUS_E_LOADER_OBJECTNOTFOUND = MAKE_DMHRESULTERROR + $0185;
 
// DMUS_E_LOADER_OBJECTNOTFOUND
//
// Object was not found.
///
DMUS_E_LOADER_OBJECTNOTFOUND = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0185;//MAKE_DMHRESULTERROR(0x0185)
(* DMUS_E_LOADER_NOFILENAME
*
* The file name is missing from the DMUS_OBJECTDESC.
*)
DMUS_E_LOADER_NOFILENAME = MAKE_DMHRESULTERROR + $0186;
 
// DMUS_E_LOADER_NOFILENAME
//
// The file name is missing from the DMUS_OBJECTDESC.
///
DMUS_E_LOADER_NOFILENAME = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0186;//MAKE_DMHRESULTERROR(0x0186)
(* DMUS_E_INVALIDFILE
*
* The file requested is not a valid file.
*)
DMUS_E_INVALIDFILE = MAKE_DMHRESULTERROR + $0200;
 
// DMUS_E_INVALIDFILE
//
// The file requested is not a valid file.
///
DMUS_E_INVALIDFILE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0200;//MAKE_DMHRESULTERROR(0x0200)
(* DMUS_E_ALREADY_EXISTS
*
* The tool is already contained in the graph. Create a new instance.
*)
DMUS_E_ALREADY_EXISTS = MAKE_DMHRESULTERROR + $0201;
 
// DMUS_E_ALREADY_EXISTS
//
// The tool is already contained in the graph. Create a new instance.
///
DMUS_E_ALREADY_EXISTS = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0201;//MAKE_DMHRESULTERROR(0x0201)
(* DMUS_E_OUT_OF_RANGE
*
* Value is out of range, for instance the requested length is longer than
* the segment.
*)
DMUS_E_OUT_OF_RANGE = MAKE_DMHRESULTERROR + $0202;
 
// DMUS_E_OUT_OF_RANGE
//
// Value is out of range, for instance the requested length is longer than
// the segment.
///
DMUS_E_OUT_OF_RANGE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0202;//MAKE_DMHRESULTERROR(0x0202)
(* DMUS_E_SEGMENT_INIT_FAILED
*
* Segment initialization failed, most likely due to a critical memory situation.
*)
DMUS_E_SEGMENT_INIT_FAILED = MAKE_DMHRESULTERROR + $0203;
 
// DMUS_E_SEGMENT_INIT_FAILED
//
// Segment initialization failed, most likely due to a critical memory situation.
///
DMUS_E_SEGMENT_INIT_FAILED = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0203;//MAKE_DMHRESULTERROR(0x0203)
(* DMUS_E_ALREADY_SENT
*
* The DMUS_PMSG has already been sent to the performance object via
* IDirectMusicPerformance::SendPMsg().
*)
DMUS_E_ALREADY_SENT = MAKE_DMHRESULTERROR + $0204;
 
// DMUS_E_ALREADY_SENT
//
// The DMUS_PMSG has already been sent to the performance object via
// IDirectMusicPerformance::SendPMsg().
///
DMUS_E_ALREADY_SENT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0204;//MAKE_DMHRESULTERROR(0x0204)
(* DMUS_E_CANNOT_FREE
*
* The DMUS_PMSG was either not allocated by the performance via
* IDirectMusicPerformance::AllocPMsg(), or it was already freed via
* IDirectMusicPerformance::FreePMsg().
*)
DMUS_E_CANNOT_FREE = MAKE_DMHRESULTERROR + $0205;
 
// DMUS_E_CANNOT_FREE
//
// The DMUS_PMSG was either not allocated by the performance via
// IDirectMusicPerformance::AllocPMsg(), or it was already freed via
// IDirectMusicPerformance::FreePMsg().
///
DMUS_E_CANNOT_FREE = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0205;//MAKE_DMHRESULTERROR(0x0205)
(* DMUS_E_CANNOT_OPEN_PORT
*
* The default system port could not be opened.
*)
DMUS_E_CANNOT_OPEN_PORT = MAKE_DMHRESULTERROR + $0206;
 
// DMUS_E_CANNOT_OPEN_PORT
//
// The default system port could not be opened.
///
DMUS_E_CANNOT_OPEN_PORT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0206;//MAKE_DMHRESULTERROR(0x0206)
(* DMUS_E_CONNOT_CONVERT
*
* A call to MIDIToMusic() or MusicToMIDI() resulted in an error because
* the requested conversion could not happen. This usually occurs when the
* provided DMUS_CHORD_KEY structure has an invalid chord or scale pattern.
*)
DMUS_E_CONNOT_CONVERT = MAKE_DMHRESULTERROR + $0207;
 
// DMUS_E_CONNOT_CONVERT
//
// A call to MIDIToMusic() or MusicToMIDI() resulted in an error because
// the requested conversion could not happen. This usually occurs when the
// provided DMUS_CHORD_KEY structure has an invalid chord or scale pattern.
///
DMUS_E_CONNOT_CONVERT = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0207;//MAKE_DMHRESULTERROR(0x0207)
(* DMUS_E_DESCEND_CHUNK_FAIL
*
* DMUS_E_DESCEND_CHUNK_FAIL is returned when the end of the file
* was reached before the desired chunk was found.
*)
DMUS_E_DESCEND_CHUNK_FAIL = MAKE_DMHRESULTERROR + $0210;
 
// DMUS_E_DESCEND_CHUNK_FAIL
//
// DMUS_E_DESCEND_CHUNK_FAIL is returned when the end of the file
// was reached before the desired chunk was found.
///
DMUS_E_DESCEND_CHUNK_FAIL = (1 shl 31) + (FACILITY_DIRECTMUSIC shl 16) + DMUS_ERRBASE + $0210;//MAKE_DMHRESULTERROR(0x0210)
 
(************************************************************************
* *
* dmksctrl.h -- Definition of IKsControl *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
* *
* This header file contains the definition of IKsControl, which *
* duplicates definitions from ks.h and ksproxy.h. Your code should *
* include ks.h and ksproxy.h directly if you have them (they are *
* provided in the Windows 98 DDK and will be in the Windows NT 5 *
* SDK). *
* *
************************************************************************)
 
//************************************************************************
// *
// dmksctrl.h -- Definition of IKsControl *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
// *
// This header file contains the definition of IKsControl, which *
// duplicates definitions from ks.h and ksproxy.h. Your code should *
// include ks.h and ksproxy.h directly if you have them (they are *
// provided in the Windows 98 DDK and will be in the Windows NT 5 *
// SDK). *
// *
//**********************************************************************
(*
* Warning: This will prevent the rest of ks.h from being pulled in if ks.h is
* included after dmksctrl.h. Make sure you do not include both headers in
* the same source file.
*)
 
//
// Warning: This will prevent the rest of ks.h from being pulled in if ks.h is
// included after dmksctrl.h. Make sure you do not include both headers in
// the same source file.
///
type
TData = record
_Set : TGUID;
Id : Cardinal;
Flags : Cardinal;
PKsIdentifier = ^TKsIdentifier;
TKsIdentifier = packed record
case integer of
1 : (
Set_: TGUID;
Id : ULONG;
Flags: ULONG
);
2 : (Alignment: LONGLONG);
end;
 
TKSIDENTIFIER = record
Data : TData;
Alignment : LONGLONG;
end;
PKsProperty = ^TKsProperty;
TKsProperty = TKsIdentifier;
 
KSIDENTIFIER = TKSIDENTIFIER;
PKSIDENTIFIER = ^KSIDENTIFIER;
PKsMethod = ^TKsMethod;
TKsMethod = TKsIdentifier;
 
TKSPROPERTY = KSIDENTIFIER;
KSPROPERTY = KSIDENTIFIER;
PKSPROPERTY = ^KSIDENTIFIER;
TKSMETHOD = KSIDENTIFIER;
KSMETHOD = KSIDENTIFIER;
PKSMETHOD = ^KSIDENTIFIER;
TKSEVENT = KSIDENTIFIER;
KSEVENT = KSIDENTIFIER;
PKSEVENT = ^KSIDENTIFIER;
PKsEvent = ^TKsEvent;
TKsEvent = TKsIdentifier;
 
const
KSMETHOD_TYPE_NONE = $00000000;
13203,64 → 19006,33
type
IKsControl = interface(IUnknown)
['{28F54685-06FD-11D2-B27A-00A0C9223196}']
//IKsControl
function KsProperty(const _Property: TKSPROPERTY; PropertyLength: Cardinal; var PropertyData;
DataLength: Cardinal; var BytesReturned: Cardinal) : HResult; stdcall;
function KsMethod(const Method: TKSMETHOD; MethodLength: Cardinal; var PropertyData;
DataLength: Cardinal; var BytesReturned: Cardinal) : HResult; stdcall;
function KsEvent(const Event: TKSEVENT; EventLength: Cardinal; var EventData;
DataLength: Cardinal; var BytesReturned: Cardinal) : HResult; stdcall;
function KsProperty (const pProperty: TKsProperty; PropertyLength: ULONG;
var PropertyData; DataLength: ULONG; out BytesReturned: ULONG) : HResult; stdcall;
function KsMethod(const Method: TKsMethod; MethodLength: ULONG;
var MethodData; DataLength: ULONG; out BytesReturned: ULONG) : HResult; stdcall;
function KsEvent (const Event: TKsEvent; EventLength: ULONG;
var EventData; DataLength: ULONG; out BytesReturned: ULONG) : HResult; stdcall;
end;
 
const
IID_IKsControl : TGUID = '{28F54685-06FD-11D2-B27A-00A0C9223196}';
type
IID_IKsControl = IKsControl;
STATIC_IID_IKsControl = IID_IKsControl;
 
// These formats are in ksmedia.h
KSDATAFORMAT_SUBTYPE_MIDI : TGUID = '{1D262760-E957-11CF-A5D6-28DB04C10000}';
KSDATAFORMAT_SUBTYPE_DIRECTMUSIC : TGUID = '{1A82F8BC-3F8B-11D2-B774-0060083316C1}';
 
//**************************************************************************
// *
// DMusBuff.h -- This module defines the buffer format for DirectMusic *
// Shared file between user mode and kernel mode components *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
//*************************************************************************
 
// Format of DirectMusic events in a buffer
//
// A buffer contains 1 or more events, each with the following header.
// Immediately following the header is the event data. The header+data
// size is rounded to the nearest quadword (8 bytes).
///
// Do not pad at end - that's where the data is
type
TDMUS_EVENTHEADER = record
cbEvent : DWORD; // Unrounded bytes in event
dwChannelGroup : DWORD; // Channel group of event
rtDelta : REFERENCE_TIME; // Delta from start time of entire buffer
dwFlags : DWORD; // Flags DMUS_EVENT_xxx
end;
DMUS_EVENTHEADER = TDMUS_EVENTHEADER;
LPDMUS_EVENTHEADER = ^TDMUS_EVENTHEADER;
 
const
DMUS_EVENT_STRUCTURED = $00000001; // Unstructured data (SysEx, etc.)
(* These formats are in ksmedia.h
*)
KSDATAFORMAT_SUBTYPE_MIDI : TGUID = '{1D262760-E957-11CF-A5D6-28DB04C10000}';
 
// The number of bytes to allocate for an event with 'cb' data bytes.
//
function QWORD_ALIGN(x: LONGLONG) : LONGLONG; //(((x) + 7) & ~7)
function DMUS_EVENT_SIZE(cb: LONGLONG) : LONGLONG; //QWORD_ALIGN(sizeof(DMUS_EVENTHEADER) + cb)
KSDATAFORMAT_SUBTYPE_DIRECTMUSIC : TGUID = '{1a82f8bc-3f8b-11d2-b774-0060083316c1}';
 
//***********************************************************************
// *
// dmusicc.h -- This module defines the DirectMusic core API's *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
//**********************************************************************
(************************************************************************
* *
* dmusicc.h -- This module defines the DirectMusic core API's *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
************************************************************************)
 
const
DMUS_MAX_DESCRIPTION = 128;
13267,44 → 19039,44
DMUS_MAX_DRIVER = 128;
 
type
TDMUS_BUFFERDESC = record
dwSize : DWORD;
PDMus_BufferDesc = ^TDMus_BufferDesc;
TDMus_BufferDesc = packed record
dwSize,
dwFlags : DWORD;
guidBufferFormat : TGUID;
cbBuffer : DWORD;
end;
DMUS_BUFFERDESC = TDMUS_BUFFERDESC;
LPDMUS_BUFFERDESC = ^TDMUS_BUFFERDESC;
 
// DMUS_EFFECT_ flags are used in the dwEffectFlags fields of both DMUS_PORTCAPS
// and DMUS_PORTPARAMS.
///
const
(* DMUS_EFFECT_ flags are used in the dwEffectFlags fields of both DMUS_PORTCAPS
* and DMUS_PORTPARAMS.
*)
DMUS_EFFECT_NONE = $00000000;
DMUS_EFFECT_REVERB = $00000001;
DMUS_EFFECT_CHORUS = $00000002;
 
// For DMUS_PORTCAPS dwClass
//
DMUS_PC_INPUTCLASS = (0);
DMUS_PC_OUTPUTCLASS = (1);
(* For DMUS_PORTCAPS dwClass
*)
DMUS_PC_INPUTCLASS = 0;
DMUS_PC_OUTPUTCLASS = 1;
 
// For DMUS_PORTCAPS dwFlags
//
DMUS_PC_DLS = ($00000001);
DMUS_PC_EXTERNAL = ($00000002);
DMUS_PC_SOFTWARESYNTH = ($00000004);
DMUS_PC_MEMORYSIZEFIXED = ($00000008);
DMUS_PC_GMINHARDWARE = ($00000010);
DMUS_PC_GSINHARDWARE = ($00000020);
DMUS_PC_XGINHARDWARE = ($00000040);
DMUS_PC_DIRECTSOUND = ($00000080);
DMUS_PC_SHAREABLE = ($00000100);
DMUS_PC_SYSTEMMEMORY = ($7FFFFFFF);
(* For DMUS_PORTCAPS dwFlags
*)
DMUS_PC_DLS = $00000001;
DMUS_PC_EXTERNAL = $00000002;
DMUS_PC_SOFTWARESYNTH = $00000004;
DMUS_PC_MEMORYSIZEFIXED = $00000008;
DMUS_PC_GMINHARDWARE = $00000010;
DMUS_PC_GSINHARDWARE = $00000020;
DMUS_PC_XGINHARDWARE = $00000040;
DMUS_PC_DIRECTSOUND = $00000080;
DMUS_PC_SHAREABLE = $00000100;
DMUS_PC_DLS2 = $00000200;
DMUS_PC_SYSTEMMEMORY = $7FFFFFFF;
 
type
 
TDMUS_PORTCAPS = record
PDMus_PortCaps = ^TDMus_PortCaps;
TDMus_PortCaps = packed record
dwSize : DWORD;
dwFlags : DWORD;
guidPort : TGUID;
13315,22 → 19087,20
dwMaxVoices : DWORD;
dwMaxAudioChannels : DWORD;
dwEffectFlags : DWORD;
wszDescription : array[0..DMUS_MAX_DESCRIPTION - 1] of WCHAR;
wszDescription: array [0..DMUS_MAX_DESCRIPTION-1] of WideChar;
end;
DMUS_PORTCAPS = TDMUS_PORTCAPS;
LPDMUS_PORTCAPS = ^TDMUS_PORTCAPS;
 
// Values for DMUS_PORTCAPS dwType. This field indicates the underlying
// driver type of the port.
///
const
DMUS_PORT_WINMM_DRIVER = (0);
DMUS_PORT_USER_MODE_SYNTH = (1);
DMUS_PORT_KERNEL_MODE = (2);
(* Values for DMUS_PORTCAPS dwType. This field indicates the underlying
* driver type of the port.
*)
DMUS_PORT_WINMM_DRIVER = 0;
DMUS_PORT_USER_MODE_SYNTH = 1;
DMUS_PORT_KERNEL_MODE = 2;
 
// These flags (set in dwValidParams) indicate which other members of the
// DMUS_PORTPARAMS are valid.
//
(* These flags (set in dwValidParams) indicate which other members of the *)
(* DMUS_PORTPARAMS are valid. *)
(* *)
DMUS_PORTPARAMS_VOICES = $00000001;
DMUS_PORTPARAMS_CHANNELGROUPS = $00000002;
DMUS_PORTPARAMS_AUDIOCHANNELS = $00000004;
13339,7 → 19109,8
DMUS_PORTPARAMS_SHARE = $00000040;
 
type
TDMUS_PORTPARAMS = record
PDMus_PortParams = ^TDMus_PortParams;
TDMus_PortParams = packed record
dwSize : DWORD;
dwValidParams : DWORD;
dwVoices : DWORD;
13349,476 → 19120,447
dwEffectFlags : DWORD;
fShare : BOOL;
end;
DMUS_PORTPARAMS = TDMUS_PORTPARAMS;
LPDMUS_PORTPARAMS = ^TDMUS_PORTPARAMS;
 
TDMUS_SYNTHSTATS = record
dwSize : DWORD; // Size in bytes of the structure
dwValidStats : DWORD; // Flags indicating which fields below are valid.
dwVoices : DWORD; // Average number of voices playing.
dwTotalCPU : DWORD; // Total CPU usage as percent * 100.
dwCPUPerVoice : DWORD; // CPU per voice as percent * 100.
dwLostNotes : DWORD; // Number of notes lost in 1 second.
dwFreeMemory : DWORD; // Free memory in bytes
lPeakVolume : Longint; // Decibel level * 100.
PDMus_SynthStats = ^TDMus_SynthStats;
TDMus_SynthStats = packed record
dwSize: DWORD; (* Size in bytes of the structure *)
dwValidStats: DWORD; (* Flags indicating which fields below are valid. *)
dwVoices: DWORD; (* Average number of voices playing. *)
dwTotalCPU: DWORD; (* Total CPU usage as percent * 100. *)
dwCPUPerVoice: DWORD; (* CPU per voice as percent * 100. *)
dwLostNotes: DWORD; (* Number of notes lost in 1 second. *)
dwFreeMemory: DWORD; (* Free memory in bytes *)
lPeakVolume: LongInt; (* Decibel level * 100. *)
end;
DMUS_SYNTHSTATS = TDMUS_SYNTHSTATS;
LPDMUS_SYNTHSTATS = ^TDMUS_SYNTHSTATS;
 
const
DMUS_SYNTHSTATS_VOICES = 1;
DMUS_SYNTHSTATS_TOTAL_CPU = 2;
DMUS_SYNTHSTATS_CPU_PER_VOICE = 4;
DMUS_SYNTHSTATS_LOST_NOTES = 8;
DMUS_SYNTHSTATS_PEAK_VOLUME = 16;
DMUS_SYNTHSTATS_FREE_MEMORY = 32;
DMUS_SYNTHSTATS_VOICES = 1 shl 0;
DMUS_SYNTHSTATS_TOTAL_CPU = 1 shl 1;
DMUS_SYNTHSTATS_CPU_PER_VOICE = 1 shl 2;
DMUS_SYNTHSTATS_LOST_NOTES = 1 shl 3;
DMUS_SYNTHSTATS_PEAK_VOLUME = 1 shl 4;
DMUS_SYNTHSTATS_FREE_MEMORY = 1 shl 5;
 
DMUS_SYNTHSTATS_SYSTEMMEMORY = DMUS_PC_SYSTEMMEMORY;
 
type
TDMUS_WAVES_REVERB_PARAMS = record
fInGain : Single; // Input gain in dB (to avoid output overflows)
fReverbMix : Single; // Reverb mix in dB. 0dB means 100% wet reverb (no direct signal)
//Negative values gives less wet signal.
//The coeficients are calculated so that the overall output level stays
//(approximately) constant regardless of the ammount of reverb mix.
fReverbTime : Single; // The reverb decay time, in milliseconds.
fHighFreqRTRatio : Single; // The ratio of the high frequencies to the global reverb time.
//Unless very 'splashy-bright' reverbs are wanted, this should be set to
//a value < 1.0.
//For example if dRevTime==1000ms and dHighFreqRTRatio=0.1 than the
//decay time for high frequencies will be 100ms.
TDMus_Waves_Reverb_Params = packed record
fInGain, (* Input gain in dB (to avoid output overflows) *)
fReverbMix, (* Reverb mix in dB. 0dB means 100% wet reverb (no direct signal)
Negative values gives less wet signal.
The coeficients are calculated so that the overall output level stays
(approximately) constant regardless of the ammount of reverb mix. *)
fReverbTime, (* The reverb decay time, in milliseconds. *)
fHighFreqRTRatio : Single; (* The ratio of the high frequencies to the global reverb time.
Unless very 'splashy-bright' reverbs are wanted, this should be set to
a value < 1.0.
For example if dRevTime==1000ms and dHighFreqRTRatio=0.1 than the
decay time for high frequencies will be 100ms.*)
 
end;
DMUS_WAVES_REVERB_PARAMS = TDMUS_WAVES_REVERB_PARAMS;
 
// Note: Default values for Reverb are:
// fInGain = 0.0dB (no change in level)
// fReverbMix = -10.0dB (a reasonable reverb mix)
// fReverbTime = 1000.0ms (one second global reverb time)
// fHighFreqRTRatio = 0.001 (the ratio of the high frequencies to the global reverb time)
///
 
DMUS_CLOCKTYPE = (DMUS_CLOCK_SYSTEM, DMUS_CLOCK_WAVE); //DMUS_CLOCK_SYSTEM = 0,
//DMUS_CLOCK_WAVE = 1
(* Note: Default values for Reverb are:
fInGain = 0.0dB (no change in level)
fReverbMix = -10.0dB (a reasonable reverb mix)
fReverbTime = 1000.0ms (one second global reverb time)
fHighFreqRTRatio = 0.001 (the ratio of the high frequencies to the global reverb time)
*)
 
TDMUS_CLOCKINFO = record
dwSize : DWORD;
ctType : DMUS_CLOCKTYPE;
guidClock : TGUID; // Identifies this time source
wszDescription : array[0..DMUS_MAX_DESCRIPTION - 1] of WCHAR;
TDMus_ClockType = (
DMUS_CLOCK_SYSTEM,
DMUS_CLOCK_WAVE
);
 
PDMus_ClockInfo = ^TDMus_ClockInfo;
TDMus_ClockInfo = packed record
dwSize : WORD;
ctType : TDMus_ClockType;
guidClock : TGUID; (* Identifies this time source *)
wszDescription : array [0..DMUS_MAX_DESCRIPTION-1] of WideChar;
end;
DMUS_CLOCKINFO = TDMUS_CLOCKINFO;
LPDMUS_CLOCKINFO = ^TDMUS_CLOCKINFO;
 
const
DMUS_EVENT_STRUCTURED = $00000001; (* Unstructured data (SysEx, etc.) *)
 
(* Standard values for voice priorities. Numerically higher priorities are higher in priority.
* These priorities are used to set the voice priority for all voices on a channel. They are
* used in the dwPriority parameter of IDirectMusicPort::GetPriority and returned in the
* lpwPriority parameter of pdwPriority.
*
* These priorities are shared with DirectSound.
*)
 
const
DAUD_CRITICAL_VOICE_PRIORITY = $F0000000;
DAUD_HIGH_VOICE_PRIORITY = $C0000000;
DAUD_STANDARD_VOICE_PRIORITY = $80000000;
DAUD_LOW_VOICE_PRIORITY = $40000000;
DAUD_PERSIST_VOICE_PRIORITY = $10000000;
 
(* These are the default priorities assigned if not overridden. By default priorities are
* equal across channel groups (e.g. channel 5 on channel group 1 has the same priority as
* channel 5 on channel group 2;.
*
* In accordance with DLS level 1, channel 10 has the highest priority, followed by 1 through 16
* except for 10.
*)
DAUD_CHAN1_VOICE_PRIORITY_OFFSET = $0000000E;
DAUD_CHAN2_VOICE_PRIORITY_OFFSET = $0000000D;
DAUD_CHAN3_VOICE_PRIORITY_OFFSET = $0000000C;
DAUD_CHAN4_VOICE_PRIORITY_OFFSET = $0000000B;
DAUD_CHAN5_VOICE_PRIORITY_OFFSET = $0000000A;
DAUD_CHAN6_VOICE_PRIORITY_OFFSET = $00000009;
DAUD_CHAN7_VOICE_PRIORITY_OFFSET = $00000008;
DAUD_CHAN8_VOICE_PRIORITY_OFFSET = $00000007;
DAUD_CHAN9_VOICE_PRIORITY_OFFSET = $00000006;
DAUD_CHAN10_VOICE_PRIORITY_OFFSET = $0000000F;
DAUD_CHAN11_VOICE_PRIORITY_OFFSET = $00000005;
DAUD_CHAN12_VOICE_PRIORITY_OFFSET = $00000004;
DAUD_CHAN13_VOICE_PRIORITY_OFFSET = $00000003;
DAUD_CHAN14_VOICE_PRIORITY_OFFSET = $00000002;
DAUD_CHAN15_VOICE_PRIORITY_OFFSET = $00000001;
DAUD_CHAN16_VOICE_PRIORITY_OFFSET = $00000000;
 
 
DAUD_CHAN1_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN1_VOICE_PRIORITY_OFFSET);
DAUD_CHAN2_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN2_VOICE_PRIORITY_OFFSET);
DAUD_CHAN3_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN3_VOICE_PRIORITY_OFFSET);
DAUD_CHAN4_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN4_VOICE_PRIORITY_OFFSET);
DAUD_CHAN5_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN5_VOICE_PRIORITY_OFFSET);
DAUD_CHAN6_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN6_VOICE_PRIORITY_OFFSET);
DAUD_CHAN7_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN7_VOICE_PRIORITY_OFFSET);
DAUD_CHAN8_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN8_VOICE_PRIORITY_OFFSET);
DAUD_CHAN9_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN9_VOICE_PRIORITY_OFFSET);
DAUD_CHAN10_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN10_VOICE_PRIORITY_OFFSET);
DAUD_CHAN11_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN11_VOICE_PRIORITY_OFFSET);
DAUD_CHAN12_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN12_VOICE_PRIORITY_OFFSET);
DAUD_CHAN13_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN13_VOICE_PRIORITY_OFFSET);
DAUD_CHAN14_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN14_VOICE_PRIORITY_OFFSET);
DAUD_CHAN15_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN15_VOICE_PRIORITY_OFFSET);
DAUD_CHAN16_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN16_VOICE_PRIORITY_OFFSET);
 
type
IDirectMusicBuffer = interface;
IDirectMusicPort = interface;
IDirectMusicThru = interface;
IReferenceClock = interface;
PIReferenceClock = IReferenceClock;
 
LPDIRECTMUSICBUFFER = IDirectMusicBuffer;
LPDIRECTMUSICPORT = IDirectMusicPort;
 
IDirectMusic = interface(IUnknown)
['{6536115A-7B2D-11D2-BA18-0000F875AC12}']
// IDirectMusic
function EnumPort(dwIndex: DWORD; var pPortCaps: TDMUS_PORTCAPS) : HResult; stdcall;
function CreateMusicBuffer(const pBufferDesc: TDMUS_BUFFERDESC; out ppBuffer: IDirectMusicBuffer;
['{6536115a-7b2d-11d2-ba18-0000f875ac12}']
function EnumPort (dwIndex: DWORD;
var pPortCaps: TDMus_PortCaps) : HResult; stdcall;
function CreateMusicBuffer (var pBufferDesc: TDMus_BufferDesc;
out ppBuffer: IDirectMusicBuffer;
pUnkOuter: IUnknown) : HResult; stdcall;
function CreatePort(const rclsidPort: TGUID; const pPortParams: TDMUS_PORTPARAMS;
out ppPort: IDirectMusicPort; pUnkOuter: IUnknown) : HResult; stdcall;
function EnumMasterClock(dwIndex: DWORD; var lpClockInfo: TDMUS_CLOCKINFO) : HResult; stdcall;
function GetMasterClock(pguidClock: PGUID; out ppReferenceClock: IReferenceClock) : HResult; stdcall;
function CreatePort (const rclsidPort: TGUID;
const pPortParams: TDMus_PortParams;
out ppPort: IDirectMusicPort;
pUnkOuter: IUnknown) : HResult; stdcall;
function EnumMasterClock (dwIndex: DWORD;
var lpClockInfo: TDMus_ClockInfo) : HResult; stdcall;
function GetMasterClock (pguidClock: PGUID;
ppReferenceClock : PIReferenceClock) : HResult; stdcall;
function SetMasterClock(const rguidClock: TGUID) : HResult; stdcall;
function Activate(fEnable: BOOL) : HResult; stdcall;
function GetDefaultPort(var pguidPort: TGUID) : HResult; stdcall;
function SetDirectSound(pDirectSound: IDirectSound; hWnd: HWND) : HResult; stdcall;
function GetDefaultPort (out pguidPort: TGUID) : HResult; stdcall;
function SetDirectSound (pDirectSound: IDirectSound;
hWnd: HWND) : HResult; stdcall;
 
end;
 
IDirectMusicBuffer = interface(IUnknown)
['{D2AC2878-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicBuffer
['{d2ac2878-b39b-11d1-8704-00600893b1bd}']
function Flush : HResult; stdcall;
function TotalTime(var prtTime: TREFERENCE_TIME) : HResult; stdcall;
function PackStructured(rt: TREFERENCE_TIME; dwChannelGroup: DWORD;
function TotalTime (out prtTime: TReference_Time) : HResult; stdcall;
function PackStructured (const rt: TReference_Time;
dwChannelGroup: DWORD;
dwChannelMessage: DWORD) : HResult; stdcall;
function PackUnstructured(rt: TREFERENCE_TIME; dwChannelGroup: DWORD;
cb: DWORD; const lpb) : HResult; stdcall;
function PackUnstructured (const rt: TReference_Time;
dwChannelGroup: DWORD;
cb: DWORD;
const lpb) : HResult; stdcall;
function ResetReadPtr : HResult; stdcall;
function GetNextEvent(var prt: TREFERENCE_TIME; var pdwChannelGroup: DWORD;
var pdwLength: DWORD; var ppData: Pointer) : HResult; stdcall;
function GetRawBufferPtr(var ppData: Pointer) : HResult; stdcall;
function GetStartTime(var prt: TREFERENCE_TIME) : HResult; stdcall;
function GetUsedBytes(var pcb: DWORD) : HResult; stdcall;
function GetMaxBytes(var pcb: DWORD) : HResult; stdcall;
function GetBufferFormat(var pGuidFormat: TGUID) : HResult; stdcall;
function SetStartTime(rt: TREFERENCE_TIME) : HResult; stdcall;
function GetNextEvent (out prt: TReference_Time;
out pdwChannelGroup: DWORD;
out pdwLength: DWORD;
out ppData: Pointer) : HResult; stdcall;
 
function GetRawBufferPtr (out ppData: Pointer) : HResult; stdcall;
function GetStartTime (out prt: TReference_Time) : HResult; stdcall;
function GetUsedBytes (out pcb: DWORD) : HResult; stdcall;
function GetMaxBytes (out pcb: DWORD) : HResult; stdcall;
function GetBufferFormat (out pGuidFormat: TGUID) : HResult; stdcall;
function SetStartTime (const rt: TReference_Time) : HResult; stdcall;
function SetUsedBytes(cb: DWORD) : HResult; stdcall;
end;
// Format of DirectMusic events in a buffer
//
// A buffer contains 1 or more events, each with the following header.
// Immediately following the header is the event data. The header+data
// size is rounded to the nearest quadword (8 bytes).
///
{TDMUS_EVENTHEADER = record
cbEvent : DWORD; // Unrounded bytes in event
dwChannelGroup : DWORD; // Channel group of event
rtDelta : REFERENCE_TIME; // Delta from start time of entire buffer
dwFlags : DWORD; // Flags DMUS_EVENT_xxx
 
(* Format of DirectMusic events in a buffer
*
* A buffer contains 1 or more events, each with the following header.
* Immediately following the header is the event data. The header+data
* size is rounded to the nearest quadword (8 bytes).
*)
 
TDMus_EventHeader = packed record
cbEvent: DWORD; (* Unrounded bytes in event *)
dwChannelGroup: DWORD; (* Channel group of event *)
rtDelta: TReference_Time; (* Delta from start time of entire buffer *)
dwFlags: DWORD; (* Flags DMUS_EVENT_xxx *)
end;
DMUS_EVENTHEADER = TDMUS_EVENTHEADER;
LPDMUS_EVENTHEADER = ^TDMUS_EVENTHEADER;}
 
IDirectMusicInstrument = interface(IUnknown)
['{D2AC287D-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicInstrument
function GetPatch(var pdwPatch: DWORD) : HResult; stdcall;
['{d2ac287d-b39b-11d1-8704-00600893b1bd}']
function GetPatch (out pdwPatch: DWORD ) : HResult; stdcall;
function SetPatch(dwPatch: DWORD) : HResult; stdcall;
end;
 
 
IDirectMusicDownloadedInstrument = interface(IUnknown)
['{D2AC287E-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicDownloadedInstrument
// None at this time
['{d2ac287e-b39b-11d1-8704-00600893b1bd}']
(* None at this time *)
end;
 
IDirectMusicCollection = interface(IUnknown)
['{D2AC287C-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicCollection
function GetInstrument(dwPatch: DWORD; out ppInstrument: IDirectMusicInstrument) : HResult; stdcall;
function EnumInstrument(dwIndex: DWORD; var pdwPatch: DWORD;
pwszName: LPWSTR; dwNameLen: DWORD) : HResult; stdcall;
['{d2ac287c-b39b-11d1-8704-00600893b1bd}']
function GetInstrument (dwPatch: DWORD;
out ppInstrument: IDirectMusicInstrument) : HResult; stdcall;
function EnumInstrument (dwIndex: DWORD;
out pdwPatch: DWORD;
pwszName: LPWSTR;
dwNameLen: DWORD) : HResult; stdcall;
end;
 
 
IDirectMusicDownload = interface(IUnknown)
['{D2AC287B-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicDownload
function GetBuffer(var ppvBuffer: Pointer; var pdwSize: DWORD) : HResult; stdcall;
['{d2ac287b-b39b-11d1-8704-00600893b1bd}']
function GetBuffer (out ppvBuffer: Pointer;
out pdwSize: DWORD) : HResult; stdcall;
end;
 
IDirectMusicPortDownload = interface(IUnknown)
['{D2AC287A-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicPortDownload
function GetBuffer(dwDLId: DWORD; out ppIDMDownload: IDirectMusicDownload) : HResult; stdcall;
function AllocateBuffer(dwSize: DWORD; out ppIDMDownload: IDirectMusicDownload) : HResult; stdcall;
function GetDLId(var pdwStartDLId; dwCount: DWORD) : HResult; stdcall;
function GetAppend(var pdwAppend: DWORD) : HResult; stdcall;
['{d2ac287a-b39b-11d1-8704-00600893b1bd}']
function GetBuffer (dwDLId: DWORD;
out ppIDMDownload: IDirectMusicDownload) : HResult; stdcall;
function AllocateBuffer (dwSize: DWORD;
out ppIDMDownload: IDirectMusicDownload) : HResult; stdcall;
function GetDLId (out pdwStartDLId: DWORD;
dwCount: DWORD) : HResult; stdcall;
function GetAppend (out pdwAppend: DWORD) : HResult; stdcall;
function Download(pIDMDownload: IDirectMusicDownload) : HResult; stdcall;
function Unload(pIDMDownload: IDirectMusicDownload) : HResult; stdcall;
end;
 
// These are the default priorities assigned if not overridden. By default priorities are
// equal across channel groups (e.g. channel 5 on channel group 1 has the same priority as
// channel 5 on channel group 2).
//
// In accordance with DLS level 1, channel 10 has the highest priority, followed by 1 through 16
// except for 10.
///
 
IDirectMusicPort = interface(IUnknown)
['{08F2D8C9-37C2-11D2-B9F9-0000F875AC12}']
// IDirectMusicPort
//
['{08f2d8c9-37c2-11d2-b9f9-0000f875ac12}']
function PlayBuffer(pBuffer: IDirectMusicBuffer) : HResult; stdcall;
function SetReadNotificationHandle(hEvent: THandle) : HResult; stdcall;
function SetReadNotificationHandle (hEvent: THANDLE) : HResult; stdcall;
function Read(pBuffer: IDirectMusicBuffer) : HResult; stdcall;
function DownloadInstrument(pInstrument: IDirectMusicInstrument;
out ppDownloadedInstrument: IDirectMusicDownloadedInstrument;
const pNoteRanges;
pNoteRanges: PDMus_NoteRange;
dwNumNoteRanges: DWORD) : HResult; stdcall;
function UnloadInstrument(pDownloadedInstrument: IDirectMusicDownloadedInstrument) : HResult; stdcall;
function GetLatencyClock(out ppClock: IReferenceClock) : HResult; stdcall;
function GetRunningStats(var pStats: TDMUS_SYNTHSTATS) : HResult stdcall;
function GetRunningStats (var pStats: TDMus_SynthStats) : HResult; stdcall;
function Compact : HResult; stdcall;
function GetCaps(var pPortCaps: TDMUS_PORTCAPS) : HResult; stdcall;
function GetCaps (var pPortCaps: TDMus_PortCaps) : HResult; stdcall;
function DeviceIoControl(dwIoControlCode: DWORD;
const lpInBuffer;
nInBufferSize: DWORD;
var lpOutBuffer;
out lpOutBuffer;
nOutBufferSize: DWORD;
var lpBytesReturned: DWORD;
out lpBytesReturned: DWORD;
var lpOverlapped: TOVERLAPPED) : HResult; stdcall;
function SetNumChannelGroups(dwChannelGroups: DWORD) : HResult; stdcall;
function GetNumChannelGroups(var pdwChannelGroups: DWORD) : HResult; stdcall;
function GetNumChannelGroups (out pdwChannelGroups: DWORD) : HResult; stdcall;
function Activate(fActive: BOOL) : HResult; stdcall;
function SetChannelPriority(dwChannelGroup: DWORD; dwChannel: DWORD; dwPriority: DWORD) : HResult; stdcall;
function GetChannelPriority(dwChannelGroup: DWORD; dwChannel: DWORD; var pdwPriority: DWORD) : HResult; stdcall;
function SetDirectSound(pDirectSound: IDirectSound; pDirectSoundBuffer: IDirectSoundBuffer) : HResult; stdcall;
function GetFormat(var pWaveFormatEx: TWAVEFORMATEX; var pdwWaveFormatExSize: DWORD; var pdwBufferSize: DWORD) : HResult; stdcall;
function SetChannelPriority (dwChannelGroup, dwChannel,
dwPriority: DWORD) : HResult; stdcall;
function GetChannelPriority (dwChannelGroup, dwChannel: DWORD;
out pdwPriority: DWORD) : HResult; stdcall;
function SetDirectSound (pDirectSound: IDirectSound;
pDirectSoundBuffer: IDirectSoundBuffer) : HResult; stdcall;
function GetFormat (pWaveFormatEx: PWaveFormatEx;
var pdwWaveFormatExSize: DWORD;
out pdwBufferSize: DWORD) : HResult; stdcall;
end;
 
IDirectMusicThru = interface(IUnknown)
['{CED153E7-3606-11D2-B9F9-0000F875AC12}']
// IDirectMusicThru
///
function ThruChannel(dwSourceChannelGroup: DWORD;
dwSourceChannel: DWORD;
dwDestinationChannelGroup: DWORD;
['{ced153e7-3606-11d2-b9f9-0000f875ac12}']
function ThruChannel (dwSourceChannelGroup,
dwSourceChannel,
dwDestinationChannelGroup,
dwDestinationChannel: DWORD;
pDestinationPort: IDirectMusicPort) : HResult; stdcall;
end;
 
 
IReferenceClock = interface(IUnknown)
['{56A86897-0AD4-11CE-B03A-0020AF0BA770}']
// IReferenceClock
//
['{56a86897-0ad4-11ce-b03a-0020af0ba770}']
(* get the time now *)
function GetTime (out pTime: TReference_Time) : HResult; stdcall;
 
// get the time now
function GetTime(var pTime: TREFERENCE_TIME) : HResult; stdcall;
(* ask for an async notification that a time has elapsed *)
function AdviseTime (const baseTime, (* base time *)
streamTime: TReference_Time; (* stream offset time *)
hEvent: THANDLE; (* advise via this event *)
var pdwAdviseCookie: DWORD) : HResult; stdcall; (* where your cookie goes *)
 
// ask for an async notification that a time has elapsed
function AdviseTime(baseTime: TREFERENCE_TIME; // base time
streamTime: TREFERENCE_TIME; // stream offset time
hEvent: THandle; // advise via this event
var pdwAdviseCookie: DWORD) : HResult; stdcall; // where your cookie goes
(* ask for an async periodic notification that a time has elapsed *)
function AdvisePeriodic (const startTime, (* starting at this time *)
periodTime: TReference_Time; (* time between notifications *)
hSemaphore: THANDLE; (* advise via a semaphore *)
var pdwAdviseCookie: DWORD) : HResult; stdcall; (* where your cookie goes *)
 
// ask for an async periodic notification that a time has elapsed
function AdvisePeriodic(startTime: REFERENCE_TIME; // starting at this time
periodTime: REFERENCE_TIME; // time between notifications
hSemaphore: THandle; // advise via a semaphore
var pdwAdviseCookie: DWORD) : HResult; stdcall; // where your cookie goes
 
// cancel a request for notification
(* cancel a request for notification *)
function Unadvise(dwAdviseCookie: DWORD) : HResult; stdcall;
end;
 
// Delphi‚̐«ŠiãAéŒ¾‚ðˆÚ“®‚³‚¹‚½‚à‚́BinterfaceAclassŒ^‚ÌforwardéŒ¾‚Í“¯‚¶typeƒ†ƒjƒbƒg“à‚ōĐ錾‚³‚ê‚È‚­‚Ä‚Í‚È‚ç‚È‚¢I
//const
// Format of DirectMusic events in a buffer
//
// A buffer contains 1 or more events, each with the following header.
// Immediately following the header is the event data. The header+data
// size is rounded to the nearest quadword (8 bytes).
///
type
IID_IDirectMusic = IDirectMusic;
IID_IDirectMusicBuffer = IDirectMusicBuffer;
IID_IDirectMusicPort = IDirectMusicPort;
IID_IDirectMusicThru = IDirectMusicThru;
IID_IDirectMusicPortDownload = IDirectMusicPortDownload;
IID_IDirectMusicDownload = IDirectMusicDownload;
IID_IDirectMusicCollection = IDirectMusicCollection;
IID_IDirectMusicInstrument = IDirectMusicInstrument;
IID_IDirectMusicDownloadedInstrument = IDirectMusicDownloadedInstrument;
IID_IReferenceClock = IReferenceClock;
 
//DMUS_EVENT_STRUCTURED = $00000001; // Unstructured data (SysEx, etc.)
 
// The number of bytes to allocate for an event with 'cb' data bytes.
///
//function QWORD_ALIGN(x: Cardinal) : Cardinal;
//function DMUS_EVENT_SIZE(cb: Cardinal) : Cardinal;
 
// Standard values for voice priorities. Numerically higher priorities are higher in priority.
// These priorities are used to set the voice priority for all voices on a channel. They are
// used in the dwPriority parameter of IDirectMusicPort::GetPriority and returned in the
// lpwPriority parameter of pdwPriority.
//
// These priorities are shared with DirectSound.
///
 
const
DAUD_CRITICAL_VOICE_PRIORITY = $F0000000;
DAUD_HIGH_VOICE_PRIORITY = $C0000000;
DAUD_STANDARD_VOICE_PRIORITY = $80000000;
DAUD_LOW_VOICE_PRIORITY = $40000000;
DAUD_PERSIST_VOICE_PRIORITY = $10000000;
CLSID_DirectMusic: TGUID = '{636b9f10-0c7d-11d1-95b2-0020afdc7421}';
 
// These are the default priorities assigned if not overridden. By default priorities are
// equal across channel groups (e.g. channel 5 on channel group 1 has the same priority as
// channel 5 on channel group 2).
//
// In accordance with DLS level 1, channel 10 has the highest priority, followed by 1 through 16
// except for 10.
///
 
DAUD_CHAN1_VOICE_PRIORITY_OFFSET = $0000000E;
DAUD_CHAN2_VOICE_PRIORITY_OFFSET = $0000000D;
DAUD_CHAN3_VOICE_PRIORITY_OFFSET = $0000000C;
DAUD_CHAN4_VOICE_PRIORITY_OFFSET = $0000000B;
DAUD_CHAN5_VOICE_PRIORITY_OFFSET = $0000000A;
DAUD_CHAN6_VOICE_PRIORITY_OFFSET = $00000009;
DAUD_CHAN7_VOICE_PRIORITY_OFFSET = $00000008;
DAUD_CHAN8_VOICE_PRIORITY_OFFSET = $00000007;
DAUD_CHAN9_VOICE_PRIORITY_OFFSET = $00000006;
DAUD_CHAN10_VOICE_PRIORITY_OFFSET = $0000000F;
DAUD_CHAN11_VOICE_PRIORITY_OFFSET = $00000005;
DAUD_CHAN12_VOICE_PRIORITY_OFFSET = $00000004;
DAUD_CHAN13_VOICE_PRIORITY_OFFSET = $00000003;
DAUD_CHAN14_VOICE_PRIORITY_OFFSET = $00000002;
DAUD_CHAN15_VOICE_PRIORITY_OFFSET = $00000001;
DAUD_CHAN16_VOICE_PRIORITY_OFFSET = $00000000;
DAUD_CHAN1_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN1_VOICE_PRIORITY_OFFSET);
DAUD_CHAN2_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN2_VOICE_PRIORITY_OFFSET);
DAUD_CHAN3_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN3_VOICE_PRIORITY_OFFSET);
DAUD_CHAN4_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN4_VOICE_PRIORITY_OFFSET);
DAUD_CHAN5_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN5_VOICE_PRIORITY_OFFSET);
DAUD_CHAN6_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN6_VOICE_PRIORITY_OFFSET);
DAUD_CHAN7_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN7_VOICE_PRIORITY_OFFSET);
DAUD_CHAN8_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN8_VOICE_PRIORITY_OFFSET);
DAUD_CHAN9_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN9_VOICE_PRIORITY_OFFSET);
DAUD_CHAN10_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN10_VOICE_PRIORITY_OFFSET);
DAUD_CHAN11_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN11_VOICE_PRIORITY_OFFSET);
DAUD_CHAN12_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN12_VOICE_PRIORITY_OFFSET);
DAUD_CHAN13_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN13_VOICE_PRIORITY_OFFSET);
DAUD_CHAN14_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN14_VOICE_PRIORITY_OFFSET);
DAUD_CHAN15_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN15_VOICE_PRIORITY_OFFSET);
DAUD_CHAN16_DEF_VOICE_PRIORITY = (DAUD_STANDARD_VOICE_PRIORITY or DAUD_CHAN16_VOICE_PRIORITY_OFFSET);
 
 
//GUID definition
IID_IReferenceClock : TGUID = '{56A86897-0AD4-11CE-B03A-0020AF0BA770}';
 
CLSID_DirectMusic : TGUID = '{636B9F10-0C7D-11D1-95B2-0020AFDC7421}';
CLSID_DirectMusicCollection : TGUID = '{480FF4B0-28B2-11D1-BEF7-00C04FBF8FEF}';
CLSID_DirectMusicCollection: TGUID = '{480ff4b0-28b2-11d1-bef7-00c04fbf8fef}';
CLSID_DirectMusicSynth : TGUID = '{58C2B4D0-46E7-11D1-89AC-00A0C9054129}';
 
IID_IDirectMusic : TGUID = '{6536115A-7B2D-11D2-BA18-0000F875AC12}';
IID_IDirectMusicBuffer : TGUID = '{D2AC2878-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicPort : TGUID = '{08F2D8C9-37C2-11D2-B9F9-0000F875AC12}';
IID_IDirectMusicThru : TGUID = '{CED153E7-3606-11D2-B9F9-0000F875AC12}';
IID_IDirectMusicPortDownload: TGUID = '{D2AC287A-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicDownload : TGUID = '{D2AC287B-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicCollection : TGUID = '{D2AC287C-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicInstrument : TGUID = '{D2AC287D-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicDownloadedInstrument: TGUID = '{D2AC287E-B39B-11D1-8704-00600893B1BD}';
(* Property Query GUID_DMUS_PROP_GM_Hardware - Local GM set, no need to download
* Property Query GUID_DMUS_PROP_GS_Hardware - Local GS set, no need to download
* Property Query GUID_DMUS_PROP_XG_Hardware - Local XG set, no need to download
* Property Query GUID_DMUS_PROP_DLS1 - Support DLS level 1
* Property Query GUID_DMUS_PROP_XG_Capable - Support minimum requirements of XG
* Property Query GUID_DMUS_PROP_GS_Capable - Support minimum requirements of GS
* Property Query GUID_DMUS_PROP_SynthSink_DSOUND - Synthsink talks to DSound
* Property Query GUID_DMUS_PROP_SynthSink_WAVE - Synthsink talks to Wave device
*
* Item 0: Supported
* Returns a DWORD which is non-zero if the feature is supported
*)
GUID_DMUS_PROP_GM_Hardware: TGUID = '{178f2f24-c364-11d1-a760-0000f875ac12}';
GUID_DMUS_PROP_GS_Hardware: TGUID = '{178f2f25-c364-11d1-a760-0000f875ac12}';
GUID_DMUS_PROP_XG_Hardware: TGUID = '{178f2f26-c364-11d1-a760-0000f875ac12}';
GUID_DMUS_PROP_XG_Capable: TGUID = '{6496aba1-61b0-11d2-afa6-00aa0024d8b6}';
GUID_DMUS_PROP_GS_Capable: TGUID = '{6496aba2-61b0-11d2-afa6-00aa0024d8b6}';
GUID_DMUS_PROP_DLS1: TGUID = '{178f2f27-c364-11d1-a760-0000f875ac12}';
GUID_DMUS_PROP_DLS2: TGUID = '{f14599e5-4689-11d2-afa6-00aa0024d8b6}';
GUID_DMUS_PROP_INSTRUMENT2: TGUID = '{865fd372-9f67-11d2-872a-00600893b1bd}';
GUID_DMUS_PROP_SynthSink_DSOUND: TGUID = '{0aa97844-c877-11d1-870c-00600893b1bd}';
GUID_DMUS_PROP_SynthSink_WAVE: TGUID = '{0aa97845-c877-11d1-870c-00600893b1bd}';
GUID_DMUS_PROP_SampleMemorySize: TGUID = '{178f2f28-c364-11d1-a760-0000f875ac12}';
GUID_DMUS_PROP_SamplePlaybackRate: TGUID = '{2a91f713-a4bf-11d2-bbdf-00600833dbd8}';
 
// Alternate interface ID for IID_IDirectMusic, available in DX7 release and after.
IID_IDirectMusic2 : TGUID = '{6FC2CAE1-BC78-11D2-AFA6-00AA0024D8B6}';
(* Property Get/Set GUID_DMUS_PROP_WriteLatency
*
* Item 0: Synth buffer write latency, in milliseconds
* Get/Set SynthSink latency, the average time after the play head that the next buffer gets written.
*)
GUID_DMUS_PROP_WriteLatency: TGUID = '{268a0fa0-60f2-11d2-afa6-00aa0024d8b6}';
 
// Property Query GUID_DMUS_PROP_GM_Hardware - Local GM set, no need to download
// Property Query GUID_DMUS_PROP_GS_Hardware - Local GS set, no need to download
// Property Query GUID_DMUS_PROP_XG_Hardware - Local XG set, no need to download
// Property Query GUID_DMUS_PROP_DLS1 - Support DLS level 1
// Property Query GUID_DMUS_PROP_XG_Capable - Support minimum requirements of XG
// Property Query GUID_DMUS_PROP_GS_Capable - Support minimum requirements of GS
// Property Query GUID_DMUS_PROP_SynthSink_DSOUND - Synthsink talks to DSound
// Property Query GUID_DMUS_PROP_SynthSink_WAVE - Synthsink talks to Wave device
//
// Item 0: Supported
// Returns a DWORD which is non-zero if the feature is supported
///
GUID_DMUS_PROP_GM_Hardware : TGUID = '{178F2F24-C364-11D1-A760-0000F875AC12}';
GUID_DMUS_PROP_GS_Hardware : TGUID = '{178F2F25-C364-11D1-A760-0000F875AC12}';
GUID_DMUS_PROP_XG_Hardware : TGUID = '{178F2F26-C364-11D1-A760-0000F875AC12}';
GUID_DMUS_PROP_XG_Capable : TGUID = '{6496ABA1-61B0-11D2-AFA6-00AA0024D8B6}';
GUID_DMUS_PROP_GS_Capable : TGUID = '{6496ABA2-61B0-11D2-AFA6-00AA0024D8B6}';
GUID_DMUS_PROP_DLS1 : TGUID = '{178F2F27-C364-11D1-A760-0000F875AC12}';
GUID_DMUS_PROP_SynthSink_DSOUND: TGUID = '{0AA97844-C877-11D1-870C-00600893B1BD}';
GUID_DMUS_PROP_SynthSink_WAVE : TGUID = '{0AA97845-C877-11D1-870C-00600893B1BD}';
(* Property Get/Set GUID_DMUS_PROP_WritePeriod
*
* Item 0: Synth buffer write period, in milliseconds
* Get/Set SynthSink buffer write period, time span between successive writes.
*)
GUID_DMUS_PROP_WritePeriod: TGUID = '{268a0fa1-60f2-11d2-afa6-00aa0024d8b6}';
 
// Property Get/Set GUID_DMUS_PROP_WriteLatency
//
// Item 0: Synth buffer write latency, in milliseconds
// Get/Set SynthSink latency, the average time after the play head that the next buffer gets written.
///
GUID_DMUS_PROP_WriteLatency : TGUID = '{268A0FA0-60F2-11D2-AFA6-00AA0024D8B6}';
(* Property Get GUID_DMUS_PROP_MemorySize
*
* Item 0: Memory size
* Returns a DWORD containing the total number of bytes of sample RAM
*)
GUID_DMUS_PROP_MemorySize: TGUID = '{178f2f28-c364-11d1-a760-0000f875ac12}';
 
// Property Get/Set GUID_DMUS_PROP_WritePeriod
//
// Item 0: Synth buffer write period, in milliseconds
// Get/Set SynthSink buffer write period, time span between successive writes.
///
GUID_DMUS_PROP_WritePeriod : TGUID = '{268A0FA1-60F2-11D2-AFA6-00AA0024D8B6}';
(* Property Set GUID_DMUS_PROP_WavesReverb
*
* Item 0: DMUS_WAVES_REVERB structure
* Sets reverb parameters
*)
GUID_DMUS_PROP_WavesReverb: TGUID = '{04cb5622-32e5-11d2-afa6-00aa0024d8b6}';
 
// Property Get GUID_DMUS_PROP_MemorySize
//
// Item 0: Memory size
// Returns a DWORD containing the total number of bytes of sample RAM
///
GUID_DMUS_PROP_MemorySize : TGUID = '{178F2F28-C364-11D1-A760-0000F875AC12}';
(* Property Set GUID_DMUS_PROP_Effects
*
* Item 0: DWORD with effects flags.
* Get/Set effects bits, same as dwEffectFlags in DMUS_PORTPARAMS and DMUS_PORTCAPS:
* DMUS_EFFECT_NONE
* DMUS_EFFECT_REVERB
* DMUS_EFFECT_CHORUS
*)
GUID_DMUS_PROP_Effects: TGUID = '{cda8d611-684a-11d2-871e-00600893b1bd}';
 
// Property Set GUID_DMUS_PROP_WavesReverb
//
// Item 0: DMUS_WAVES_REVERB structure
// Sets reverb parameters
///
GUID_DMUS_PROP_WavesReverb : TGUID = '{04CB5622-32E5-11D2-AFA6-00AA0024D8B6}';
(* Property Set GUID_DMUS_PROP_LegacyCaps
*
* Item 0: The MIDINCAPS or MIDIOUTCAPS which describes the port's underlying WinMM device. This property is only supported
* by ports which wrap WinMM devices.
*)
 
// Property Set GUID_DMUS_PROP_Effects
//
// Item 0: DWORD with effects flags.
// Get/Set effects bits, same as dwEffectFlags in DMUS_PORTPARAMS and DMUS_PORTCAPS:
// DMUS_EFFECT_NONE
// DMUS_EFFECT_REVERB
// DMUS_EFFECT_CHORUS
///
GUID_DMUS_PROP_Effects : TGUID = '{CDA8D611-684A-11D2-871E-00600893B1BD}';
GUID_DMUS_PROP_LegacyCaps: TGUID = '{cfa7cdc2-00a1-11d2-aad5-0000f875ac12}';
 
// Property Set GUID_DMUS_PROP_LegacyCaps
//
// Item 0: The MIDINCAPS or MIDIOUTCAPS which describes the port's underlying WinMM device. This property is only supported
// by ports which wrap WinMM devices.
///
(* Property Set GUID_DMUS_Volume
*
* Item 0: A long which contains an offset, in 1/100 dB, to be added to the final volume
*
*)
GUID_DMUS_PROP_Volume: TGUID = '{fedfae25-e46e-11d1-aace-0000f875ac12}';
 
GUID_DMUS_PROP_LegacyCaps : TGUID = '{CFA7CDC2-00A1-11D2-AAD5-0000F875AC12}';
(* Min and Max values for setting volume with GUID_DMUS_PROP_Volume *)
 
// Property Set GUID_DMUS_Volume
//
// Item 0: A long which contains an offset, in 1/100 dB, to be added to the final volume
//
///
GUID_DMUS_PROP_Volume : TGUID = '{FEDFAE25-E46E-11D1-AACE-0000F875AC12}';
DMUS_VOLUME_MAX = 2000; (* +20 dB *)
DMUS_VOLUME_MIN = -20000; (* -200 dB *)
 
(************************************************************************
* *
* dmusici.h -- This module contains the API for the *
* DirectMusic performance layer *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
************************************************************************)
 
 
 
 
//***********************************************************************
// *
// dmusici.h -- This module contains the API for the *
// DirectMusic performance layer *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
//**********************************************************************
type
TRANSITION_TYPE = Word;
MUSIC_TIME = Longint;
TTransition_Type = WORD;
PMusic_Time = ^TMusic_Time;
TMusic_Time = LongInt;
 
const
DMUS_PPQ = 768; // parts per quarter note
DMUS_PPQ = 768; (* parts per quarter note *)
 
const
DMUS_MAX_NAME = 64; // Maximum object name length.
DMUS_MAX_CATEGORY = 64; // Maximum object category name length.
DMUS_MAX_FILENAME = MAX_PATH;
type
TDMus_CommandT_Types = (
DMUS_COMMANDT_GROOVE,
DMUS_COMMANDT_FILL ,
DMUS_COMMANDT_INTRO ,
DMUS_COMMANDT_BREAK ,
DMUS_COMMANDT_END ,
DMUS_COMMANDT_ENDANDINTRO
);
 
TDMus_ShapeT_Types = (
DMUS_SHAPET_FALLING ,
DMUS_SHAPET_LEVEL ,
DMUS_SHAPET_LOOPABLE,
DMUS_SHAPET_LOUD ,
DMUS_SHAPET_QUIET ,
DMUS_SHAPET_PEAKING ,
DMUS_SHAPET_RANDOM ,
DMUS_SHAPET_RISING ,
DMUS_SHAPET_SONG
);
 
 
type
TDMus_ComposeF_Flags = DWORD;
const
DMUS_COMMANDT_GROOVE = 0;
DMUS_COMMANDT_FILL = 1;
DMUS_COMMANDT_INTRO = 2;
DMUS_COMMANDT_BREAK = 3;
DMUS_COMMANDT_END = 4;
DMUS_COMMANDT_ENDANDINTRO = 5;
{typedef enum enumDMUS_COMMANDT_TYPES
{
DMUS_COMMANDT_GROOVE = 0,
DMUS_COMMANDT_FILL = 1,
DMUS_COMMANDT_INTRO = 2,
DMUS_COMMANDT_BREAK = 3,
DMUS_COMMANDT_END = 4,
DMUS_COMMANDT_ENDANDINTRO = 5
DMUS_COMMANDT_TYPES;}
 
DMUS_SHAPET_FALLING = 0;
DMUS_SHAPET_LEVEL = 1;
DMUS_SHAPET_LOOPABLE = 2;
DMUS_SHAPET_LOUD = 3;
DMUS_SHAPET_QUIET = 4;
DMUS_SHAPET_PEAKING = 5;
DMUS_SHAPET_RANDOM = 6;
DMUS_SHAPET_RISING = 7;
DMUS_SHAPET_SONG = 8;
{typedef enum enumDMUS_SHAPET_TYPES
{
DMUS_SHAPET_FALLING = 0,
DMUS_SHAPET_LEVEL = 1,
DMUS_SHAPET_LOOPABLE = 2,
DMUS_SHAPET_LOUD = 3,
DMUS_SHAPET_QUIET = 4,
DMUS_SHAPET_PEAKING = 5,
DMUS_SHAPET_RANDOM = 6,
DMUS_SHAPET_RISING = 7,
DMUS_SHAPET_SONG = 8
DMUS_SHAPET_TYPES;}
 
DMUS_COMPOSEF_NONE = 0;
DMUS_COMPOSEF_ALIGN = $1;
DMUS_COMPOSEF_OVERLAP = $2;
13829,643 → 19571,198
DMUS_COMPOSEF_AFTERPREPARETIME = $40;
DMUS_COMPOSEF_MODULATE = $1000;
DMUS_COMPOSEF_LONG = $2000;
{typedef enum enumDMUS_COMPOSEF_FLAGS
{
DMUS_COMPOSEF_NONE = 0,
DMUS_COMPOSEF_ALIGN = 0x1,
DMUS_COMPOSEF_OVERLAP = 0x2,
DMUS_COMPOSEF_IMMEDIATE = 0x4,
DMUS_COMPOSEF_GRID = 0x8,
DMUS_COMPOSEF_BEAT = 0x10,
DMUS_COMPOSEF_MEASURE = 0x20,
DMUS_COMPOSEF_AFTERPREPARETIME = 0x40,
DMUS_COMPOSEF_MODULATE = 0x1000,
DMUS_COMPOSEF_LONG = 0x2000
DMUS_COMPOSEF_FLAGS;}
 
const
// DMUS_PMSGF_FLAGS fill the DMUS_PMSG's dwFlags member
DMUS_PMSGF_REFTIME = 1; // if rtTime is valid
DMUS_PMSGF_MUSICTIME = 2; // if mtTime is valid
DMUS_PMSGF_TOOL_IMMEDIATE = 4; // if PMSG should be processed immediately
DMUS_PMSGF_TOOL_QUEUE = 8; // if PMSG should be processed a little early, at Queue time
DMUS_PMSGF_TOOL_ATTIME = 16; // if PMSG should be processed at the time stamp
DMUS_PMSGF_TOOL_FLUSH = 32; // if PMSG is being flushed
// The values of DMUS_TIME_RESOLVE_FLAGS may also be used inside the
// DMUS_PMSG's dwFlags member.
 
type
TDMUS_PMSGF_FLAGS = Cardinal;
DMUS_PMSGF_FLAGS = TDMUS_PMSGF_FLAGS;
{typedef enum enumDMUS_PMSGF_FLAGS
{
DMUS_PMSGF_REFTIME = 1, /* if rtTime is valid
DMUS_PMSGF_MUSICTIME = 2, /* if mtTime is valid
DMUS_PMSGF_TOOL_IMMEDIATE = 4, /* if PMSG should be processed immediately
DMUS_PMSGF_TOOL_QUEUE = 8, /* if PMSG should be processed a little early, at Queue time
DMUS_PMSGF_TOOL_ATTIME = 16, /* if PMSG should be processed at the time stamp
DMUS_PMSGF_TOOL_FLUSH = 32 /* if PMSG is being flushed
/* The values of DMUS_TIME_RESOLVE_FLAGS may also be used inside the
/* DMUS_PMSG's dwFlags member.
DMUS_PMSGF_FLAGS;}
 
(* DMUS_PMsgF_FLAGS fill the TDMus_PMsg's dwFlags member *)
TDMus_PMsgF_Flags = DWORD;
const
// DMUS_PMSGT_TYPES fill the DMUS_PMSG's dwType member
DMUS_PMSGT_MIDI = 0; // MIDI short message
DMUS_PMSGT_NOTE = 1; // Interactive Music Note
DMUS_PMSGT_SYSEX = 2; // MIDI long message (system exclusive message)
DMUS_PMSGT_NOTIFICATION = 3; // Notification message
DMUS_PMSGT_TEMPO = 4; // Tempo message
DMUS_PMSGT_CURVE = 5; // Control change / pitch bend, etc. curve
DMUS_PMSGT_TIMESIG = 6; // Time signature
DMUS_PMSGT_PATCH = 7; // Patch changes
DMUS_PMSGT_TRANSPOSE = 8; // Transposition messages
DMUS_PMSGT_CHANNEL_PRIORITY = 9; // Channel priority
DMUS_PMSGT_STOP = 10; // Stop message
DMUS_PMSGT_DIRTY = 11; // Tells Tools that cache GetParam() info to refresh
DMUS_PMSGT_USER = 255; // User message
DMUS_PMsgF_REFTIME = 1; (* if rtTime is valid *)
DMUS_PMsgF_MUSICTIME = 2; (* if mtTime is valid *)
DMUS_PMsgF_TOOL_IMMEDIATE = 4; (* if PMSG should be processed immediately *)
DMUS_PMsgF_TOOL_QUEUE = 8; (* if PMSG should be processed a little early, at Queue time *)
DMUS_PMsgF_TOOL_ATTIME = 16; (* if PMSG should be processed at the time stamp *)
DMUS_PMsgF_TOOL_FLUSH = 32; (* if PMSG is being flushed *)
(* The values of DMUS_TIME_RESOLVE_FLAGS may also be used inside the *)
(* TDMus_PMsg's dwFlags member. *)
 
type
TDMUS_PMSGT_TYPES = Cardinal;
DMUS_PMSGT_TYPES = TDMUS_PMSGT_TYPES;
 
{typedef enum enumDMUS_PMSGT_TYPES
{
DMUS_PMSGT_MIDI = 0, /* MIDI short message
DMUS_PMSGT_NOTE = 1, /* Interactive Music Note
DMUS_PMSGT_SYSEX = 2, /* MIDI long message (system exclusive message)
DMUS_PMSGT_NOTIFICATION = 3, /* Notification message
DMUS_PMSGT_TEMPO = 4, /* Tempo message
DMUS_PMSGT_CURVE = 5, /* Control change / pitch bend, etc. curve
DMUS_PMSGT_TIMESIG = 6, /* Time signature
DMUS_PMSGT_PATCH = 7, /* Patch changes
DMUS_PMSGT_TRANSPOSE = 8, /* Transposition messages
DMUS_PMSGT_CHANNEL_PRIORITY = 9, /* Channel priority
DMUS_PMSGT_STOP = 10, /* Stop message
DMUS_PMSGT_DIRTY = 11, /* Tells Tools that cache GetParam() info to refresh
DMUS_PMSGT_USER = 255 /* User message
DMUS_PMSGT_TYPES;}
 
(* DMUS_PMsgT_TYPES fill the TDMus_PMsg's dwType member *)
TDMus_PMsgT_Types = (
DMUS_PMsgT_MIDI , (* MIDI short message *)
DMUS_PMsgT_NOTE , (* Interactive Music Note *)
DMUS_PMsgT_SYSEX , (* MIDI long message (system exclusive message) *)
DMUS_PMsgT_NOTIFICATION , (* Notification message *)
DMUS_PMsgT_TEMPO , (* Tempo message *)
DMUS_PMsgT_CURVE , (* Control change / pitch bend, etc. curve *)
DMUS_PMsgT_TIMESIG , (* Time signature *)
DMUS_PMsgT_PATCH , (* Patch changes *)
DMUS_PMsgT_TRANSPOSE , (* Transposition messages *)
DMUS_PMsgT_CHANNEL_PRIORITY, (* Channel priority *)
DMUS_PMsgT_STOP , (* Stop message *)
DMUS_PMsgT_DIRTY (* Tells Tools that cache GetParam() info to refresh *)
);
const
// DMUS_SEGF_FLAGS correspond to IDirectMusicPerformance::PlaySegment, and other API
DMUS_SEGF_REFTIME = 64; // time parameter is in reference time
DMUS_SEGF_SECONDARY = 128; // secondary segment
DMUS_SEGF_QUEUE = 256; // queue at the end of the primary segment queue (primary only)
DMUS_SEGF_CONTROL = 512; // play as a control track (secondary segments only)
DMUS_SEGF_AFTERPREPARETIME = 1 shl 10; // play after the prepare time (See IDirectMusicPerformance::GetPrepareTime)
DMUS_SEGF_GRID = 1 shl 11; // play on grid boundary
DMUS_SEGF_BEAT = 1 shl 12; // play on beat boundary
DMUS_SEGF_MEASURE = 1 shl 13; // play on measure boundary
DMUS_SEGF_DEFAULT = 1 shl 14; // use segment's default boundary
DMUS_SEGF_NOINVALIDATE = 1 shl 15; // play without invalidating the currently playing segment(s)
DMUS_PMsgT_USER = TDMus_PMsgT_Types(255); (* User message *)
 
type
TDMUS_SEGF_FLAGS = Cardinal;
DMUS_SEGF_FLAGS = TDMUS_SEGF_FLAGS;
 
{typedef enum enumDMUS_SEGF_FLAGS
{
DMUS_SEGF_REFTIME = 64, /* time parameter is in reference time
DMUS_SEGF_SECONDARY = 128, /* secondary segment
DMUS_SEGF_QUEUE = 256, /* queue at the end of the primary segment queue (primary only)
DMUS_SEGF_CONTROL = 512, /* play as a control track (secondary segments only)
DMUS_SEGF_AFTERPREPARETIME = 1<<10, /* play after the prepare time (See IDirectMusicPerformance::GetPrepareTime)
DMUS_SEGF_GRID = 1<<11, /* play on grid boundary
DMUS_SEGF_BEAT = 1<<12, /* play on beat boundary
DMUS_SEGF_MEASURE = 1<<13, /* play on measure boundary
DMUS_SEGF_DEFAULT = 1<<14, /* use segment's default boundary
DMUS_SEGF_NOINVALIDATE = 1<<15 /* play without invalidating the currently playing segment(s)
DMUS_SEGF_FLAGS;}
 
(* DMUS_SEGF_FLAGS correspond to IDirectMusicPerformance::PlaySegment, and other API *)
TDMus_SegF_Flags = DWORD;
const
// DMUS_TIME_RESOLVE_FLAGS correspond to IDirectMusicPerformance::GetResolvedTime, and can
// also be used interchangeably with the corresponding DMUS_SEGF_FLAGS, since their values
// are intentionally the same
DMUS_TIME_RESOLVE_AFTERPREPARETIME = 1 shl 10; // resolve to a time after the prepare time
DMUS_TIME_RESOLVE_GRID = 1 shl 11; // resolve to a time on a grid boundary
DMUS_TIME_RESOLVE_BEAT = 1 shl 12; // resolve to a time on a beat boundary
DMUS_TIME_RESOLVE_MEASURE = 1 shl 13; // resolve to a time on a measure boundary
DMUS_SEGF_REFTIME = 64; (* time parameter is in reference time *)
DMUS_SEGF_SECONDARY = 128; (* secondary segment *)
DMUS_SEGF_QUEUE = 256; (* queue at the end of the primary segment queue (primary only) *)
DMUS_SEGF_CONTROL = 512; (* play as a control track (secondary segments only) *)
DMUS_SEGF_AFTERPREPARETIME = 1 shl 10; (* play after the prepare time (See IDirectMusicPerformance::GetPrepareTime) *)
DMUS_SEGF_GRID = 1 shl 11; (* play on grid boundary *)
DMUS_SEGF_BEAT = 1 shl 12; (* play on beat boundary *)
DMUS_SEGF_MEASURE = 1 shl 13; (* play on measure boundary *)
DMUS_SEGF_DEFAULT = 1 shl 14; (* use segment's default boundary *)
DMUS_SEGF_NOINVALIDATE = 1 shl 15; (* play without invalidating the currently playing segment(s) *)
 
(* DMUS_TIME_RESOLVE_FLAGS correspond to IDirectMusicPerformance::GetResolvedTime, and can *)
(* also be used interchangeably with the corresponding DMUS_SEGF_FLAGS, since their values *)
(* are intentionally the same *)
type
TDMUS_TIME_RESOLVE_FLAGS = Cardinal;
DMUS_TIME_RESOLVE_FLAGS = TDMUS_TIME_RESOLVE_FLAGS;
 
{typedef enum enumDMUS_TIME_RESOLVE_FLAGS
{
DMUS_TIME_RESOLVE_AFTERPREPARETIME = 1<<10, /* resolve to a time after the prepare time
DMUS_TIME_RESOLVE_GRID = 1<<11, /* resolve to a time on a grid boundary
DMUS_TIME_RESOLVE_BEAT = 1<<12, /* resolve to a time on a beat boundary
DMUS_TIME_RESOLVE_MEASURE = 1<<13 /* resolve to a time on a measure boundary
DMUS_TIME_RESOLVE_FLAGS;}
 
TDMus_Time_Resolve_Flags = DWORD;
const
// The following flags are sent in the IDirectMusicTrack::Play() method
// inside the dwFlags parameter
DMUS_TRACKF_SEEK = 1; // set on a seek
DMUS_TRACKF_LOOP = 2; // set on a loop (repeat)
DMUS_TRACKF_START = 4; // set on first call to Play
DMUS_TRACKF_FLUSH = 8; // set when this call is in response to a flush on the perfomance
DMUS_TRACKF_DIRTY = 16; // set when the track should consider any cached values from a previous call to GetParam to be invalidated
DMUS_TIME_RESOLVE_AFTERPREPARETIME = 1 shl 10; (* resolve to a time after the prepare time *)
DMUS_TIME_RESOLVE_GRID = 1 shl 11; (* resolve to a time on a grid boundary *)
DMUS_TIME_RESOLVE_BEAT = 1 shl 12; (* resolve to a time on a beat boundary *)
DMUS_TIME_RESOLVE_MEASURE = 1 shl 13; (* resolve to a time on a measure boundary *)
 
(* The following flags are sent in the IDirectMusicTrack::Play() method *)
(* inside the dwFlags parameter *)
type
TDMUS_TRACKF_FLAGS = Cardinal;
DMUS_TRACKF_FLAGS = TDMUS_TRACKF_FLAGS;
TDMus_TrackF_Flags = DWORD;
const
DMUS_TRACKF_SEEK = 1; (* set on a seek *)
DMUS_TRACKF_LOOP = 2; (* set on a loop (repeat) *)
DMUS_TRACKF_START = 4; (* set on first call to Play *)
DMUS_TRACKF_FLUSH = 8; (* set when this call is in response to a flush on the perfomance *)
DMUS_TRACKF_DIRTY = 16; (* set when the track should consider any cached values from a previous call to GetParam to be invalidated *)
 
{typedef enum enumDMUS_TRACKF_FLAGS
{
DMUS_TRACKF_SEEK = 1, /* set on a seek
DMUS_TRACKF_LOOP = 2, /* set on a loop (repeat)
DMUS_TRACKF_START = 4, /* set on first call to Play
DMUS_TRACKF_FLUSH = 8, /* set when this call is in response to a flush on the perfomance
DMUS_TRACKF_DIRTY = 16, /* set when the track should consider any cached values from a previous call to GetParam to be invalidated
DMUS_TRACKF_FLAGS;}
 
const
DMUS_MAXSUBCHORD = 8;
 
type
TDMUS_SUBCHORD = record
dwChordPattern : DWORD; // Notes in the subchord
dwScalePattern : DWORD; // Notes in the scale
dwInversionPoints : DWORD; // Where inversions can occur
dwLevels : DWORD; // Which levels are supported by this subchord
bChordRoot : Byte; // Root of the subchord
bScaleRoot : Byte; // Root of the scale
end;
DMUS_SUBCHORD = TDMUS_SUBCHORD;
 
TDMUS_CHORD_KEY = record
wszName : array[0..15] of WideChar; // Name of the chord
wMeasure : Word; // Measure this falls on
bBeat : Byte; // Beat this falls on
bSubChordCount : Byte; // Number of chords in the list of subchords
SubChordList : array[0..DMUS_MAXSUBCHORD - 1] of TDMUS_SUBCHORD;// List of sub chords
dwScale : DWORD; // Scale underlying the entire chord
bKey : Byte; // Key underlying the entire chord
end;
DMUS_CHORD_KEY = TDMUS_CHORD_KEY;
 
const
//typedef enum enumDMUS_NOTEF_FLAGS
DMUS_NOTEF_NOTEON = 1; // Set if this is a MIDI Note On. Otherwise, it is MIDI Note Off
 
type
TDMUS_NOTEF_FLAGS = Cardinal;
DMUS_NOTEF_FLAGS = TDMUS_NOTEF_FLAGS;
 
// The DMUS_PLAYMODE_FLAGS are used to determine how to convert wMusicValue
// into the appropriate bMidiValue.
///
const
//typedef enum enumDMUS_PLAYMODE_FLAGS
DMUS_PLAYMODE_KEY_ROOT = 1; // Transpose on top of the key root.
DMUS_PLAYMODE_CHORD_ROOT = 2; // Transpose on top of the chord root.
DMUS_PLAYMODE_SCALE_INTERVALS = 4; // Use scale intervals from scale pattern.
DMUS_PLAYMODE_CHORD_INTERVALS = 8; // Use chord intervals from chord pattern.
DMUS_PLAYMODE_NONE = 16; // No mode. Indicates the parent part's mode should be used.
 
type
TDMUS_PLAYMODE_FLAGS = Cardinal;
DMUS_PLAYMODE_FLAGS = TDMUS_PLAYMODE_FLAGS;
 
// The following are playback modes that can be created by combining the DMUS_PLAYMODE_FLAGS
// in various ways:
///
 
// Fixed. wMusicValue holds final MIDI note value. This is used for drums, sound effects, and sequenced
// notes that should not be transposed by the chord or scale.
///
const
DMUS_PLAYMODE_FIXED = 0;
// In fixed to key, the musicvalue is again a fixed MIDI value, but it
// is transposed on top of the key root.
///
DMUS_PLAYMODE_FIXEDTOKEY = DMUS_PLAYMODE_KEY_ROOT;
// In fixed to chord, the musicvalue is also a fixed MIDI value, but it
// is transposed on top of the chord root.
///
DMUS_PLAYMODE_FIXEDTOCHORD = DMUS_PLAYMODE_CHORD_ROOT;
// In Pedalpoint, the key root is used and the notes only track the intervals in
// the scale. The chord root and intervals are completely ignored. This is useful
// for melodic lines that play relative to the key root.
///
DMUS_PLAYMODE_PEDALPOINT = (DMUS_PLAYMODE_KEY_ROOT or DMUS_PLAYMODE_SCALE_INTERVALS);
// In the Melodic mode, the chord root is used but the notes only track the intervals in
// the scale. The key root and chord intervals are completely ignored. This is useful
// for melodic lines that play relative to the chord root.
///
DMUS_PLAYMODE_MELODIC = (DMUS_PLAYMODE_CHORD_ROOT or DMUS_PLAYMODE_SCALE_INTERVALS);
// Normal chord mode is the prevalent playback mode.
// The notes track the intervals in the chord, which is based on the chord root.
// If there is a scale component to the MusicValue, the additional intervals
// are pulled from the scale and added.
// If the chord does not have an interval to match the chord component of
// the MusicValue, the note is silent.
///
DMUS_PLAYMODE_NORMALCHORD = (DMUS_PLAYMODE_CHORD_ROOT or DMUS_PLAYMODE_CHORD_INTERVALS);
// If it is desirable to play a note that is above the top of the chord, the
// always play mode (known as "purpleized" in a former life) finds a position
// for the note by using intervals from the scale. Essentially, this mode is
// a combination of the Normal and Melodic playback modes, where a failure
// in Normal causes a second try in Melodic mode.
///
DMUS_PLAYMODE_ALWAYSPLAY = (DMUS_PLAYMODE_MELODIC or DMUS_PLAYMODE_NORMALCHORD);
 
// Legacy names for modes...
DMUS_PLAYMODE_PURPLEIZED = DMUS_PLAYMODE_ALWAYSPLAY;
DMUS_PLAYMODE_SCALE_ROOT = DMUS_PLAYMODE_KEY_ROOT;
DMUS_PLAYMODE_FIXEDTOSCALE = DMUS_PLAYMODE_FIXEDTOKEY;
 
const
DMUS_TEMPO_MAX = 350;
DMUS_TEMPO_MIN = 10;
 
DMUS_MASTERTEMPO_MAX = 2.0;
DMUS_MASTERTEMPO_MIN = 0.25;
 
const
DMUS_CURVE_RESET = 1; // Set if the curve needs to be reset.
 
type
TDMUS_CURVE_FLAGS = Cardinal;
DMUS_CURVE_FLAGS = TDMUS_CURVE_FLAGS;
{
DMUS_CURVE_RESET = 1, /* Set if the curve needs to be reset.
DMUS_CURVE_FLAGS; }
 
 
const
//DMUS_CURVE_RESET = 1;
 
// Curve shapes
DMUS_CURVES_LINEAR = 0;
DMUS_CURVES_INSTANT = 1;
DMUS_CURVES_EXP = 2;
DMUS_CURVES_LOG = 3;
DMUS_CURVES_SINE = 4;
 
// curve types
DMUS_CURVET_PBCURVE = $03;
DMUS_CURVET_CCCURVE = $04;
DMUS_CURVET_MATCURVE = $05;
DMUS_CURVET_PATCURVE = $06;
 
// notification type values
// The following correspond to GUID_NOTIFICATION_SEGMENT
const
DMUS_NOTIFICATION_SEGSTART = 0;
DMUS_NOTIFICATION_SEGEND = 1;
DMUS_NOTIFICATION_SEGALMOSTEND = 2;
DMUS_NOTIFICATION_SEGLOOP = 3;
DMUS_NOTIFICATION_SEGABORT = 4;
// The following correspond to GUID_NOTIFICATION_PERFORMANCE
DMUS_NOTIFICATION_MUSICSTARTED = 0;
DMUS_NOTIFICATION_MUSICSTOPPED = 1;
// The following corresponds to GUID_NOTIFICATION_MEASUREANDBEAT
DMUS_NOTIFICATION_MEASUREBEAT = 0;
// The following corresponds to GUID_NOTIFICATION_CHORD
DMUS_NOTIFICATION_CHORD = 0;
// The following correspond to GUID_NOTIFICATION_COMMAND
DMUS_NOTIFICATION_GROOVE = 0;
DMUS_NOTIFICATION_EMBELLISHMENT= 1;
 
type
// Time Signature structure, used by IDirectMusicStyle
// Also used as a parameter for GetParam() and SetParam
TDMUS_TIMESIGNATURE = record
mtTime : MUSIC_TIME;
bBeatsPerMeasure : Byte; // beats per measure (top of time sig)
bBeat : Byte; // what note receives the beat (bottom of time sig.)
// we can assume that 0 means 256th note
wGridsPerBeat : Word; // grids per beat
end;
DMUS_TIMESIGNATURE = TDMUS_TIMESIGNATURE;
 
// Flags for dwValidData. When set, a flag indicates that the
// corresponding field in DMUSOBJECTDESC holds valid data.
const
DMUS_OBJ_OBJECT = 1 shl 0; // Object GUID is valid.
DMUS_OBJ_CLASS = 1 shl 1; // Class GUID is valid.
DMUS_OBJ_NAME = 1 shl 2; // Name is valid.
DMUS_OBJ_CATEGORY = 1 shl 3; // Category is valid.
DMUS_OBJ_FILENAME = 1 shl 4; // File path is valid.
DMUS_OBJ_FULLPATH = 1 shl 5; // Path is full path.
DMUS_OBJ_URL = 1 shl 6; // Path is URL.
DMUS_OBJ_VERSION = 1 shl 7; // Version is valid.
DMUS_OBJ_DATE = 1 shl 8; // Date is valid.
DMUS_OBJ_LOADED = 1 shl 9; // Object is currently loaded in memory.
DMUS_OBJ_MEMORY = 1 shl 10; // Object is pointed to by pbMemData.
 
const
DMUSB_LOADED = 1 shl 0; // Set when band has been loaded
DMUSB_DEFAULT = 1 shl 1; // Set when band is default band for a style
 
type
IDirectMusicTrack = interface;
IDirectMusicPerformance = interface;
IDirectMusicTool = interface;
IDirectMusicSegment = interface;
IDirectMusicSegmentState = interface;
IDirectMusicTool = interface;
IDirectMusicGraph = interface;
//IDirectMusicPort = interface;
//IDirectMusicBuffer = interface;
//IDirectMusicInstrument = interface;
//IDirectMusicDownloadedInstrument = interface;
IDirectMusicBand = interface;
IDirectMusicChordMap = interface;
IDirectMusicLoader = interface;
IDirectMusicObject = interface;
{#ifndef __cplusplus
typedef interface IDirectMusic IDirectMusic;
typedef interface IDirectMusicTrack IDirectMusicTrack;
typedef interface IDirectMusicPerformance IDirectMusicPerformance;
typedef interface IDirectMusicTool IDirectMusicTool;
typedef interface IDirectMusicSegment IDirectMusicSegment;
typedef interface IDirectMusicSegmentState IDirectMusicSegmentState;
typedef interface IDirectMusicGraph IDirectMusicGraph;
typedef interface IDirectMusicPort IDirectMusicPort;
typedef interface IDirectMusicBuffer IDirectMusicBuffer;
typedef interface IDirectMusicInstrument IDirectMusicInstrument;
typedef interface IDirectMusicDownloadedInstrument IDirectMusicDownloadedInstrument;
typedef interface IDirectMusicBand IDirectMusicBand;
typedef interface IDirectMusicChordMap IDirectMusicChordMap;
typedef interface IDirectMusicObject IDirectMusicObject;
typedef interface IDirectMusicLoader IDirectMusicLoader;
#endif}
 
LPDMUS_OBJECT = IDirectMusicObject;
LPDMUS_LOADER = IDirectMusicLoader;
LPDMUS_BAND = IDirectMusicBand;
 
TDMUS_PMSG_PART = record
PIDirectMusicSegmentState = ^IDirectMusicSegmentState;
 
TDMus_PMsg_Part = record
dwSize : DWORD;
rtTime : REFERENCE_TIME; // real time (in 100 nanosecond increments) \
mtTime : MUSIC_TIME; // music time \
dwFlags : DWORD; // various bits (see DMUS_PMSG_FLAGS enumeration) \
dwPChannel : DWORD; // Performance Channel. The Performance can \
// use this to determine the port/channel. \
dwVirtualTrackID : DWORD; // virtual track ID \
pTool : IDirectMusicTool; // tool interface pointer \
pGraph : IDirectMusicGraph; // tool graph interface pointer \
dwType : DWORD; // PMSG type (see DMUS_PMSGT_TYPES defines) \
dwVoiceID : DWORD; // unique voice id which allows synthesizers to \
// identify a specific event. For DirectX 6.0, \
// this field should always be 0. \
dwGroupID : DWORD; // Track group id \
punkUser : IUnknown; // user com pointer, auto released upon PMSG free
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
end;
// every DMUS_PMSG is based off of this structure. The Performance needs
// to access these members consistently in every PMSG that goes through it.
{typedef struct _DMUS_PMSG
{
/* begin DMUS_PMSG_PART
DMUS_PMSG_PART
/* end DMUS_PMSG_PART
 
DMUS_PMSG;}
TDMUS_PMSG = TDMUS_PMSG_PART;
DMUS_PMSG = TDMUS_PMSG;
(* every TDMus_PMsg is based off of this structure. The Performance needs
to access these members consistently in every PMSG that goes through it. *)
 
// DMUS_NOTE_PMSG
TDMUS_NOTE_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
(* begin DMUS_PMsg_PART *)
PDMus_PMsg = ^TDMus_PMsg;
TDMus_PMsg = TDMus_PMsg_Part;
(* end DMUS_PMsg_PART *)
 
mtDuration : MUSIC_TIME; // duration
wMusicValue : Word; // Description of note in chord and key.
wMeasure : Word; // Measure in which this note occurs
nOffset : Smallint; // Offset from grid at which this note occurs
bBeat : Byte; // Beat (in measure) at which this note occurs
bGrid : Byte; // Grid offset from beat at which this note occurs
bVelocity : Byte; // Note velocity
bFlags : Byte; // see DMUS_NOTE_FLAGS
bTimeRange : Byte; // Range to randomize time.
bDurRange : Byte; // Range to randomize duration.
bVelRange : Byte; // Range to randomize velocity.
bPlayModeFlags : Byte; // Play mode
bSubChordLevel : Byte; // Which subchord level this note uses.
bMidiValue : Byte; // The MIDI note value, converted from wMusicValue
cTranspose : Shortint; // Transposition to add to midi note value after converted from wMusicValue.
end;
DMUS_NOTE_PMSG = TDMUS_NOTE_PMSG;
(* DMUS_NOTIFICATION_PMsg *)
PDMus_Notification_PMsg = ^TDMus_Notification_PMsg;
TDMus_Notification_PMsg = record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
// DMUS_MIDI_PMSG
TDMUS_MIDI_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
bStatus : Byte;
bByte1 : Byte;
bByte2 : Byte;
bPad : array[0..0] of Byte;
end;
DMUS_MIDI_PMSG = TDMUS_MIDI_PMSG;
 
// DMUS_PATCH_PMSG
TDMUS_PATCH_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
byInstrument : Byte;
byMSB : Byte;
byLSB : Byte;
byPad : array[0..0] of Byte;
end;
DMUS_PATCH_PMSG = TDMUS_PATCH_PMSG;
 
// DMUS_TRANSPOSE_PMSG
TDMUS_TRANSPOSE_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
nTranspose : Smallint;
end;
DMUS_TRANSPOSE_PMSG = TDMUS_TRANSPOSE_PMSG;
 
// DMUS_CHANNEL_PRIORITY_PMSG
TDMUS_CHANNEL_PRIORITY_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
dwChannelPriority : DWORD;
end;
DMUS_CHANNEL_PRIORITY_PMSG = TDMUS_CHANNEL_PRIORITY_PMSG;
 
// DMUS_TEMPO_PMSG
TDMUS_TEMPO_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
dblTempo : Double; // the tempo
end;
DMUS_TEMPO_PMSG = TDMUS_TEMPO_PMSG;
 
// DMUS_SYSEX_PMSG
TDMUS_SYSEX_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
dwLen : DWORD; // length of the data
abData : array[0..0] of Byte; // array of data, length equal to dwLen
end;
DMUS_SYSEX_PMSG = TDMUS_SYSEX_PMSG;
 
// DMUS_CURVE_PMSG
TDMUS_CURVE_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
mtDuration : MUSIC_TIME; // how long this curve lasts
mtOriginalStart : MUSIC_TIME; // must be set to either zero when this PMSG is created or to the original mtTime of the curve
mtResetDuration : MUSIC_TIME; // how long after the curve is finished to reset to the
// reset value, nResetValue
nStartValue : Smallint; // curve's start value
nEndValue : Smallint; // curve's end value
nResetValue : Smallint; // curve's reset value, sent after mtResetDuration or
// upon a flush or invalidation
wMeasure : Word; // Measure in which this curve occurs
nOffset : Smallint; // Offset from grid at which this curve occurs
bBeat : Byte; // Beat (in measure) at which this curve occurs
bGrid : Byte; // Grid offset from beat at which this curve occurs
bType : Byte; // type of curve
bCurveShape : Byte; // shape of curve
bCCData : Byte; // CC# if this is a control change type
bFlags : Byte; // set to 1 if the nResetValue must be sent when the
// time is reached or an invalidate occurs because
// of a transition. If 0, the curve stays
// permanently stuck at the new value. All bits besides
// 1 are reserved.
 
end;
DMUS_CURVE_PMSG = TDMUS_CURVE_PMSG;
 
// DMUS_TIMESIG_PMSG
TDMUS_TIMESIG_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
// Time signatures define how many beats per measure, which note receives
// the beat, and the grid resolution.
bBeatsPerMeasure : Byte; // beats per measure (top of time sig)
bBeat : Byte; // what note receives the beat (bottom of time sig.)
// we can assume that 0 means 256th note
wGridsPerBeat : Word; // grids per beat
end;
DMUS_TIMESIG_PMSG = TDMUS_TIMESIG_PMSG;
 
// DMUS_NOTIFICATION_PMSG
PDMUS_NOTIFICATION_PMSG = ^TDMUS_NOTIFICATION_PMSG;
TDMUS_NOTIFICATION_PMSG = record
// begin DMUS_PMSG_PART
DMUS_PMSG_PART : TDMUS_PMSG_PART;
// end DMUS_PMSG_PART
 
guidNotificationType : TGUID;
dwNotificationOption : DWORD;
dwField1 : DWORD;
dwField2 : DWORD;
end;
DMUS_NOTIFICATION_PMSG = TDMUS_NOTIFICATION_PMSG;
 
TDMUS_VERSION = record
dwVersionMS : DWORD;
dwVersionLS : DWORD;
TDMus_SubChord = packed record
dwChordPattern: DWORD; (* Notes in the subchord *)
dwScalePattern: DWORD; (* Notes in the scale *)
dwInversionPoints: DWORD; (* Where inversions can occur *)
dwLevels: DWORD; (* Which levels are supported by this subchord *)
bChordRoot: BYTE; (* Root of the subchord *)
bScaleRoot: BYTE; (* Root of the scale *)
end;
DMUS_VERSION = TDMUS_VERSION;
LPDMUS_VERSION = ^TDMUS_VERSION;
 
// The DMUSOBJECTDESC structure is used to communicate everything you could
// possibly use to describe a DirectMusic object.
 
TDMUS_OBJECTDESC = record
dwSize : DWORD; // Size of this structure.
dwValidData : DWORD; // Flags indicating which fields below are valid.
guidObject : TGUID; // Unique ID for this object.
guidClass : TGUID; // GUID for the class of object.
ftDate : TFILETIME; // Last edited date of object.
vVersion : TDMUS_VERSION; // Version.
wszName : array[0..DMUS_MAX_NAME - 1] of WCHAR; // Name of object.
wszCategory : array[0..DMUS_MAX_CATEGORY - 1] of WCHAR; // Category for object (optional).
wszFileName : array[0..DMUS_MAX_FILENAME - 1] of WCHAR; // File path.
llMemLength : LONGLONG; // Size of Memory data.
pbMemData : Pointer; // Memory pointer for data.
TDMus_Chord_Key = packed record
wszName: array [0..15] of WideChar; (* Name of the chord *)
wMeasure: WORD; (* Measure this falls on *)
bBeat: BYTE; (* Beat this falls on *)
bSubChordCount: BYTE; (* Number of chords in the list of subchords *)
SubChordList: array [0..DMUS_MAXSUBCHORD-1] of TDMus_SubChord; (* List of sub chords *)
dwScale: DWORD; (* Scale underlying the entire chord *)
bKey: BYTE; (* Key underlying the entire chord *)
end;
DMUS_OBJECTDESC = TDMUS_OBJECTDESC;
LPDMUS_OBJECTDESC = ^TDMUS_OBJECTDESC;
 
IDirectMusicBand = interface(IUnknown)
['{D2AC28C0-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicBand
function CreateSegment(out ppSegment: IDirectMusicSegment) : HResult; stdcall;
function Download(pPerformance: IDirectMusicPerformance) : HResult; stdcall;
function Unload(pPerformance: IDirectMusicPerformance) : HResult; stdcall;
(* Time Signature structure, used by IDirectMusicStyle *)
(* Also used as a parameter for GetParam() and SetParam *)
TDMus_TimeSignature = packed record
mtTime: TMusic_Time;
bBeatsPerMeasure: BYTE; (* beats per measure (top of time sig) *)
bBeat: BYTE; (* what note receives the beat (bottom of time sig.) *)
(* we can assume that 0 means 256th note *)
wGridsPerBeat: WORD; (* grids per beat *)
end;
 
IDirectMusicObject = interface(IUnknown)
['{D2AC28B5-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicObject
function GetDescriptor(var pDesc: TDMUS_OBJECTDESC) : HResult; stdcall;
function SetDescriptor(const pDesc: TDMUS_OBJECTDESC) : HResult; stdcall;
function ParseDescriptor(pStream: IStream;
var pDesc: TDMUS_OBJECTDESC) : HResult; stdcall;
(*/////////////////////////////////////////////////////////////////////
// IDirectMusicSegmentState *)
IDirectMusicSegmentState = interface (IUnknown)
['{a3afdcc7-d3ee-11d1-bc8d-00a0c922e6eb}']
function GetRepeats (out pdwRepeats: DWORD) : HResult; stdcall;
function GetSegment (out ppSegment: IDirectMusicSegment) : HResult; stdcall;
function GetStartTime (out pmtStart: TMusic_Time) : HResult; stdcall;
function GetSeek (out pmtSeek: TMusic_Time) : HResult; stdcall;
function GetStartPoint (out pmtStart: TMusic_Time) : HResult; stdcall;
end;
 
IDirectMusicLoader = interface(IUnknown)
['{2FFAACA2-5DCA-11D2-AFA6-00AA0024D8B6}']
// IDirectMusicLoader
function GetObject(const pDesc: TDMUS_OBJECTDESC;
const riid: TGUID;
out ppv) : HResult; stdcall;
function SetObject(const pDesc: TDMUS_OBJECTDESC) : HResult; stdcall;
function SetSearchDirectory(const rguidClass: TGUID;
pwzPath: PWCHAR;
fClear: BOOL) : HResult; stdcall;
function ScanDirectory(const rguidClass: TGUID;
pwzFileExtension: PWCHAR;
var pwzScanFileName: PWCHAR) : HResult; stdcall;
function CacheObject(pObject: IDirectMusicObject) : HResult; stdcall;
function ReleaseObject(pObject: IDirectMusicObject) : HResult; stdcall;
function ClearCache(const rguidClass: TGUID) : HResult; stdcall;
function EnableCache(const rguidClass: TGUID;
fEnable: BOOL) : HResult; stdcall;
function EnumObject(const rguidClass: TGUID;
dwIndex: DWORD;
var pDesc: TDMUS_OBJECTDESC) : HResult; stdcall;
end;
 
// Stream object supports IDirectMusicGetLoader interface to access loader while file parsing.
IDirectMusicGetLoader = interface(IUnknown)
['{68A04844-D13D-11D1-AFA6-00AA0024D8B6}']
// IDirectMusicGetLoader
function GetLoader(out ppLoader: IDirectMusicLoader) : HResult; stdcall;
end;
 
{ IDirectMusicSegment }
 
(*////////////////////////////////////////////////////////////////////
// IDirectMusicSegment *)
IDirectMusicSegment = interface(IUnknown)
['{F96029A2-4282-11D2-8717-00600893B1BD}']
// IDirectMusicSegment
function GetLength(var pmtLength: MUSIC_TIME) : HResult; stdcall;
function SetLength(mtLength: MUSIC_TIME) : HResult; stdcall;
function GetRepeats(var pdwRepeats: DWORD) : HResult; stdcall;
['{f96029a2-4282-11d2-8717-00600893b1bd}']
function GetLength (out pmtLength: TMusic_Time) : HResult; stdcall;
function SetLength (mtLength: TMusic_Time) : HResult; stdcall;
function GetRepeats (out pdwRepeats: DWORD) : HResult; stdcall;
function SetRepeats(dwRepeats: DWORD) : HResult; stdcall;
function GetDefaultResolution(var pdwResolution: DWORD) : HResult; stdcall;
function GetDefaultResolution (out pdwResolution: DWORD) : HResult; stdcall;
function SetDefaultResolution(dwResolution: DWORD) : HResult; stdcall;
function GetTrack(const rguidType: TGUID;
dwGroupBits: DWORD;
dwIndex: DWORD;
dwGroupBits, dwIndex: DWORD;
out ppTrack: IDirectMusicTrack) : HResult; stdcall;
function GetTrackGroup(pTrack: IDirectMusicTrack;
var pdwGroupBits: DWORD) : HResult; stdcall;
out pdwGroupBits: DWORD) : HResult; stdcall;
function InsertTrack(pTrack: IDirectMusicTrack;
dwGroupBits: DWORD) : HResult; stdcall;
function RemoveTrack(pTrack: IDirectMusicTrack) : HResult; stdcall;
14477,115 → 19774,100
function AddNotificationType(const rguidNotificationType: TGUID) : HResult; stdcall;
function RemoveNotificationType(const rguidNotificationType: TGUID) : HResult; stdcall;
function GetParam(const rguidType: TGUID;
dwGroupBits: DWORD;
dwIndex: DWORD;
mtTime: MUSIC_TIME;
var pmtNext: MUSIC_TIME;
dwGroupBits, dwIndex: DWORD;
mtTime: TMusic_Time;
out pmtNext: TMusic_Time;
pParam: Pointer) : HResult; stdcall;
function SetParam(const rguidType: TGUID;
dwGroupBits: DWORD;
dwIndex: DWORD;
mtTime: MUSIC_TIME;
dwGroupBits, dwIndex: DWORD;
mtTime: TMusic_Time;
pParam: Pointer) : HResult; stdcall;
function Clone(mtStart: MUSIC_TIME;
mtEnd: MUSIC_TIME;
function Clone (mtStart: TMusic_Time;
mtEnd: TMusic_Time;
out ppSegment: IDirectMusicSegment) : HResult; stdcall;
function SetStartPoint(mtStart: MUSIC_TIME) : HResult; stdcall;
function GetStartPoint(var pmtStart: MUSIC_TIME) : HResult; stdcall;
function SetLoopPoints(mtStart: MUSIC_TIME;
mtEnd: MUSIC_TIME) : HResult; stdcall;
function GetLoopPoints(var pmtStart: MUSIC_TIME;
var pmtEnd: MUSIC_TIME) : HResult; stdcall;
function SetStartPoint (mtStart: TMusic_Time) : HResult; stdcall;
function GetStartPoint (out pmtStart: TMusic_Time) : HResult; stdcall;
function SetLoopPoints (mtStart: TMusic_Time;
mtEnd: TMusic_Time) : HResult; stdcall;
function GetLoopPoints (out pmtStart, pmtEnd: TMusic_Time) : HResult; stdcall;
function SetPChannelsUsed(dwNumPChannels: DWORD;
const paPChannels) : HResult; stdcall;
var paPChannels: DWORD) : HResult; stdcall;
end;
 
{ IDirectMusicSegmentState }
 
IDirectMusicSegmentState = interface(IUnknown)
['{A3AFDCC7-D3EE-11D1-BC8D-00A0C922E6EB}']
// IDirectMusicSegmentState
function GetRepeats(var pdwRepeats: DWORD) : HResult; stdcall;
function GetSegment(out ppSegment: IDirectMusicSegment) : HResult; stdcall;
function GetStartTime(var pmtStart: MUSIC_TIME) : HResult; stdcall;
function GetSeek(var pmtSeek: MUSIC_TIME) : HResult; stdcall;
function GetStartPoint(var pmtStart: MUSIC_TIME) : HResult; stdcall;
end;
 
{ IDirectMusicTrack }
 
(*////////////////////////////////////////////////////////////////////
// IDirectMusicTrack *)
IDirectMusicTrack = interface(IUnknown)
['{F96029A1-4282-11D2-8717-00600893B1BD}']
// IDirectMusicTrack
['{f96029a1-4282-11d2-8717-00600893b1bd}']
function Init(pSegment: IDirectMusicSegment) : HResult; stdcall;
function InitPlay(pSegmentState: IDirectMusicSegmentState;
pPerformance: IDirectMusicPerformance;
var ppStateData: Pointer;
dwVirtualTrackID: DWORD;
dwFlags: DWORD) : HResult; stdcall;
function EndPlay(const pStateData) : HResult; stdcall;
function Play(const pStateData;
mtStart: MUSIC_TIME;
mtEnd: MUSIC_TIME;
mtOffset: MUSIC_TIME;
out ppStateData: Pointer;
dwVirtualTrackID, dwFlags: DWORD) : HResult; stdcall;
function EndPlay (pStateData: Pointer) : HResult; stdcall;
function Play (pStateData: Pointer;
mtStart: TMusic_Time;
mtEnd: TMusic_Time;
mtOffset: TMusic_Time;
dwFlags: DWORD;
pPerf: IDirectMusicPerformance;
pSegSt: IDirectMusicSegmentState;
dwVirtualID: DWORD) : HResult; stdcall;
function GetParam(const rguidType: TGUID;
mtTime: MUSIC_TIME;
var pmtNext: MUSIC_TIME;
var pParam) : HResult; stdcall;
mtTime: TMusic_Time;
out pmtNext: TMusic_Time;
pParam: Pointer) : HResult; stdcall;
function SetParam(const rguidType: TGUID;
mtTime: MUSIC_TIME;
const pParam) : HResult; stdcall;
mtTime: TMusic_Time;
pParam: Pointer) : HResult; stdcall;
function IsParamSupported(const rguidType: TGUID) : HResult; stdcall;
function AddNotificationType(const rguidNotificationType: TGUID) : HResult; stdcall;
function RemoveNotificationType(const rguidNotificationType: TGUID) : HResult; stdcall;
function Clone(mtStart: MUSIC_TIME;
mtEnd: MUSIC_TIME;
function Clone (mtStart: TMusic_Time;
mtEnd: TMusic_Time;
out ppTrack: IDirectMusicTrack) : HResult; stdcall;
end;
 
{ IDirectMusicPerformance }
PIDirectMusic = ^IDirectMusic;
 
(*////////////////////////////////////////////////////////////////////
// IDirectMusicPerformance *)
IDirectMusicPerformance = interface(IUnknown)
['{07D43D03-6523-11D2-871D-00600893B1BD}']
// IDirectMusicPerformance
function Init(out ppDirectMusic: IDirectMusic;
['{07d43d03-6523-11d2-871d-00600893b1bd}']
function Init (ppDirectMusic: PIDirectMusic;
pDirectSound: IDirectSound;
hWnd: HWND) : HResult; stdcall;
function PlaySegment(pSegment: IDirectMusicSegment;
dwFlags: DWORD;
i64StartTime: LONGLONG;
out ppSegmentState: IDirectMusicSegmentState) : HResult; stdcall;
i64StartTime: LongLong;
ppSegmentState: PIDirectMusicSegmentState) : HResult; stdcall;
function Stop(pSegment: IDirectMusicSegment;
pSegmentState: IDirectMusicSegmentState;
mtTime: MUSIC_TIME;
mtTime: TMusic_Time;
dwFlags: DWORD) : HResult; stdcall;
function GetSegmentState(out ppSegmentState: IDirectMusicSegmentState;
mtTime: MUSIC_TIME) : HResult; stdcall;
mtTime: TMusic_Time) : HResult; stdcall;
function SetPrepareTime(dwMilliSeconds: DWORD) : HResult; stdcall;
function GetPrepareTime(var pdwMilliSeconds: DWORD) : HResult; stdcall;
function GetPrepareTime (out pdwMilliSeconds: DWORD) : HResult; stdcall;
function SetBumperLength(dwMilliSeconds: DWORD) : HResult; stdcall;
function GetBumperLength(var pdwMilliSeconds: DWORD) : HResult; stdcall;
function SendPMsg(const pPMSG: TDMUS_PMSG) : HResult; stdcall;
function MusicToReferenceTime(mtTime: MUSIC_TIME;
var prtTime: TREFERENCE_TIME) : HResult; stdcall;
function ReferenceToMusicTime(rtTime: TREFERENCE_TIME;
var pmtTime: MUSIC_TIME) : HResult; stdcall;
function GetBumperLength (out pdwMilliSeconds: DWORD) : HResult; stdcall;
function SendPMsg (out pPMSG: TDMus_PMsg) : HResult; stdcall;
function MusicToReferenceTime (mtTime: TMusic_Time;
out prtTime: TReference_Time) : HResult; stdcall;
function ReferenceToMusicTime (rtTime: TReference_Time;
out pmtTime: TMusic_Time) : HResult; stdcall;
function IsPlaying(pSegment: IDirectMusicSegment;
pSegState: IDirectMusicSegmentState) : HResult; stdcall;
function GetTime(var prtNow: TREFERENCE_TIME;
var pmtNow: MUSIC_TIME) : HResult; stdcall;
function AllocPMsg(cb: Cardinal;
var ppPMSG: TDMUS_PMSG) : HResult; stdcall;
function FreePMsg(const pPMSG: TDMUS_PMSG) : HResult; stdcall;
function GetTime (prtNow: PReference_Time;
pmtNow: PMusic_Time) : HResult; stdcall;
function AllocPMsg (cb: ULONG;
out ppPMSG: PDMus_PMsg) : HResult; stdcall;
function FreePMsg (pPMSG: PDMus_PMsg) : HResult; stdcall;
function GetGraph(out ppGraph: IDirectMusicGraph) : HResult; stdcall;
function SetGraph(pGraph: IDirectMusicGraph) : HResult; stdcall;
function SetNotificationHandle(hNotification: THandle;
rtMinimum: TREFERENCE_TIME) : HResult; stdcall;
function GetNotificationPMsg(var ppNotificationPMsg: PDMUS_NOTIFICATION_PMSG) : HResult; stdcall;
function SetNotificationHandle (hNotification: THANDLE;
rtMinimum: TReference_Time) : HResult; stdcall;
function GetNotificationPMsg (out ppNotificationPMsg: PDMus_Notification_PMsg) : HResult; stdcall;
function AddNotificationType(const rguidNotificationType: TGUID) : HResult; stdcall;
function RemoveNotificationType(const rguidNotificationType: TGUID) : HResult; stdcall;
function AddPort(pPort: IDirectMusicPort) : HResult; stdcall;
14595,151 → 19877,600
dwGroup: DWORD) : HResult; stdcall;
function AssignPChannel(dwPChannel: DWORD;
pPort: IDirectMusicPort;
dwGroup: DWORD;
dwMChannel: DWORD) : HResult; stdcall;
dwGroup, dwMChannel: DWORD) : HResult; stdcall;
function PChannelInfo(dwPChannel: DWORD;
out ppPort: IDirectMusicPort;
var pdwGroup: DWORD;
var pdwMChannel: DWORD) : HResult; stdcall;
out pdwGroup, pdwMChannel: DWORD ) : HResult; stdcall;
function DownloadInstrument(pInst: IDirectMusicInstrument;
dwPChannel: DWORD;
out ppDownInst: IDirectMusicDownloadedInstrument;
const pNoteRanges;
var pNoteRanges: TDMus_NoteRange;
dwNumNoteRanges: DWORD;
out ppPort: IDirectMusicPort;
var pdwGroup: DWORD;
var pdwMChannel: DWORD) : HResult; stdcall;
function Invalidate(mtTime: MUSIC_TIME;
out pdwGroup, pdwMChannel: DWORD) : HResult; stdcall;
function Invalidate (mtTime: TMusic_Time;
dwFlags: DWORD) : HResult; stdcall;
function GetParam(const rguidType: TGUID;
dwGroupBits: DWORD;
dwIndex: DWORD;
mtTime: MUSIC_TIME;
var pmtNext: MUSIC_TIME;
var pParam) : HResult; stdcall;
dwGroupBits, dwIndex: DWORD;
mtTime: TMusic_Time;
out pmtNext: TMusic_Time;
pParam: Pointer) : HResult; stdcall;
function SetParam(const rguidType: TGUID;
dwGroupBits: DWORD;
dwIndex: DWORD;
mtTime: MUSIC_TIME;
dwGroupBits, dwIndex: DWORD;
mtTime: TMusic_Time;
pParam: Pointer) : HResult; stdcall;
function GetGlobalParam(const rguidType: TGUID;
var pParam;
pParam: Pointer;
dwSize: DWORD) : HResult; stdcall;
function SetGlobalParam(const rguidType: TGUID;
const pParam;
pParam: Pointer;
dwSize: DWORD) : HResult; stdcall;
function GetLatencyTime(var prtTime: TREFERENCE_TIME) : HResult; stdcall;
function GetQueueTime(var prtTime: TREFERENCE_TIME) : HResult; stdcall;
function AdjustTime(rtAmount: TREFERENCE_TIME) : HResult; stdcall;
function GetLatencyTime (out prtTime: TReference_Time) : HResult; stdcall;
function GetQueueTime (out prtTime: TReference_Time) : HResult; stdcall;
function AdjustTime (rtAmount: TReference_Time) : HResult; stdcall;
function CloseDown : HResult; stdcall;
function GetResolvedTime(rtTime: TREFERENCE_TIME;
var prtResolved: TREFERENCE_TIME;
function GetResolvedTime (rtTime: TReference_Time;
out prtResolved: TReference_Time;
dwTimeResolveFlags: DWORD) : HResult; stdcall;
function MIDIToMusic(bMIDIValue: Byte;
const pChord: TDMUS_CHORD_KEY;
bPlayMode: Byte;
bChordLevel: Byte;
var pwMusicValue: Word) : HResult; stdcall;
function MusicToMIDI(wMusicValue: Word;
const pChord: TDMUS_CHORD_KEY;
bPlayMode: Byte;
bChordLevel: Byte;
var pbMIDIValue: Byte) : HResult; stdcall;
function TimeToRhythm(mtTime: MUSIC_TIME;
const pTimeSig: TDMUS_TIMESIGNATURE;
var pwMeasure: Word;
var pbBeat: Byte;
var pbGrid: Byte;
var pnOffset: Smallint) : HResult; stdcall;
function RhythmToTime(wMeasure: Word;
bBeat: Byte;
bGrid: Byte;
nOffset: Smallint;
const pTimeSig: TDMUS_TIMESIGNATURE;
var pmtTime: MUSIC_TIME) : HResult; stdcall;
function MIDIToMusic (bMIDIValue: BYTE;
const pChord: TDMus_Chord_Key;
bPlayMode, bChordLevel: Byte;
out pwMusicValue: WORD) : HResult; stdcall;
function MusicToMIDI (wMusicValue: WORD;
const pChord: TDMus_Chord_Key;
bPlayMode, bChordLevel: BYTE;
out pbMIDIValue: BYTE) : HResult; stdcall;
function TimeToRhythm (mtTime: TMusic_Time;
const pTimeSig: TDMus_TimeSignature;
out pwMeasure: WORD;
out pbBeat, pbGrid: BYTE;
out pnOffset: SmallInt) : HResult; stdcall;
function RhythmToTime (wMeasure: WORD;
bBeat, bGrid: BYTE;
nOffset: SmallInt;
const pTimeSig: TDMus_TimeSignature;
out pmtTime: TMusic_Time) : HResult; stdcall;
end;
 
{ IDirectMusicTool }
 
(*////////////////////////////////////////////////////////////////////
// IDirectMusicTool *)
IDirectMusicTool = interface(IUnknown)
['{D2AC28BA-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicTool
['{d2ac28ba-b39b-11d1-8704-00600893b1bd}']
function Init(pGraph: IDirectMusicGraph) : HResult; stdcall;
function GetMsgDeliveryType(var pdwDeliveryType: DWORD) : HResult; stdcall;
function GetMediaTypeArraySize(var pdwNumElements: DWORD) : HResult; stdcall;
function GetMediaTypes(var padwMediaTypes;
function GetMsgDeliveryType (out pdwDeliveryType: DWORD) : HResult; stdcall;
function GetMediaTypeArraySize (out pdwNumElements: DWORD) : HResult; stdcall;
function GetMediaTypes (out padwMediaTypes: PDWORD;
dwNumElements: DWORD) : HResult; stdcall;
function ProcessPMsg(pPerf: IDirectMusicPerformance;
const pPMSG: TDMUS_PMSG) : HResult; stdcall;
var pPMSG: TDMus_PMsg) : HResult; stdcall;
function Flush(pPerf: IDirectMusicPerformance;
const pPMSG: TDMUS_PMSG;
rtTime: TREFERENCE_TIME) : HResult; stdcall;
const pPMSG: TDMus_PMsg;
rtTime: TReference_Time) : HResult; stdcall;
end;
 
{ IDirectMusicGraph }
 
(*////////////////////////////////////////////////////////////////////
// IDirectMusicGraph *)
IDirectMusicGraph = interface(IUnknown)
['{2BEFC277-5497-11D2-BCCB-00A0C922E6EB}']
// IDirectMusicGraph
function StampPMsg(const pPMSG: TDMUS_PMSG) : HResult; stdcall;
['{2befc277-5497-11d2-bccb-00a0c922e6eb}']
function StampPMsg (var pPMSG: TDMus_PMsg ) : HResult; stdcall;
function InsertTool(pTool: IDirectMusicTool;
const pdwPChannels;
var pdwPChannels: DWORD;
cPChannels: DWORD;
lIndex: Longint) : HResult; stdcall;
lIndex: LongInt) : HResult; stdcall;
function GetTool(dwIndex: DWORD;
out ppTool: IDirectMusicTool) : HResult; stdcall;
function RemoveTool(pTool: IDirectMusicTool) : HResult; stdcall;
end;
 
{ IDirectMusicStyle }
 
(* DMUS_NOTE_PMsg *)
TDMus_Note_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
mtDuration: TMusic_Time; (* duration *)
wMusicValue: WORD; (* Description of note in chord and key. *)
wMeasure: WORD; (* Measure in which this note occurs *)
nOffset: SmallInt; (* Offset from grid at which this note occurs *)
bBeat: BYTE; (* Beat (in measure) at which this note occurs *)
bGrid: BYTE; (* Grid offset from beat at which this note occurs *)
bVelocity: BYTE; (* Note velocity *)
bFlags: BYTE; (* see DMUS_NOTE_FLAGS *)
bTimeRange: BYTE; (* Range to randomize time. *)
bDurRange: BYTE; (* Range to randomize duration. *)
bVelRange: BYTE; (* Range to randomize velocity. *)
bPlayModeFlags: BYTE; (* Play mode *)
bSubChordLevel: BYTE; (* Which subchord level this note uses. *)
bMidiValue: BYTE; (* The MIDI note value, converted from wMusicValue *)
cTranspose: char; (* Transposition to add to midi note value after converted from wMusicValue. *)
end;
 
TDMus_NoteF_Flags = DWORD;
const
DMUS_NOTEF_NOTEON = 1; (* Set if this is a MIDI Note On. Otherwise, it is MIDI Note Off *)
 
(* The DMUS_PLAYMODE_FLAGS are used to determine how to convert wMusicValue
into the appropriate bMidiValue.
*)
type
TDMus_PlayMode_Flags = DWORD;
const
DMUS_PLAYMODE_KEY_ROOT = 1; (* Transpose on top of the key root. *)
DMUS_PLAYMODE_CHORD_ROOT = 2; (* Transpose on top of the chord root. *)
DMUS_PLAYMODE_SCALE_INTERVALS = 4; (* Use scale intervals from scale pattern. *)
DMUS_PLAYMODE_CHORD_INTERVALS = 8; (* Use chord intervals from chord pattern. *)
DMUS_PLAYMODE_NONE = 16; (* No mode. Indicates the parent part's mode should be used. *)
 
(* The following are playback modes that can be created by combining the DMUS_PLAYMODE_FLAGS
in various ways:
*)
 
(* Fixed. wMusicValue holds final MIDI note value. This is used for drums, sound effects, and sequenced
notes that should not be transposed by the chord or scale.
*)
DMUS_PLAYMODE_FIXED = 0;
(* In fixed to key, the musicvalue is again a fixed MIDI value, but it
is transposed on top of the key root.
*)
DMUS_PLAYMODE_FIXEDTOKEY = DMUS_PLAYMODE_KEY_ROOT;
(* In fixed to chord, the musicvalue is also a fixed MIDI value, but it
is transposed on top of the chord root.
*)
DMUS_PLAYMODE_FIXEDTOCHORD = DMUS_PLAYMODE_CHORD_ROOT;
(* In Pedalpoint, the key root is used and the notes only track the intervals in
the scale. The chord root and intervals are completely ignored. This is useful
for melodic lines that play relative to the key root.
*)
DMUS_PLAYMODE_PEDALPOINT = (DMUS_PLAYMODE_KEY_ROOT or DMUS_PLAYMODE_SCALE_INTERVALS);
(* In the Melodic mode, the chord root is used but the notes only track the intervals in
the scale. The key root and chord intervals are completely ignored. This is useful
for melodic lines that play relative to the chord root.
*)
DMUS_PLAYMODE_MELODIC = (DMUS_PLAYMODE_CHORD_ROOT or DMUS_PLAYMODE_SCALE_INTERVALS);
(* Normal chord mode is the prevalent playback mode.
The notes track the intervals in the chord, which is based on the chord root.
If there is a scale component to the MusicValue, the additional intervals
are pulled from the scale and added.
If the chord does not have an interval to match the chord component of
the MusicValue, the note is silent.
*)
DMUS_PLAYMODE_NORMALCHORD = (DMUS_PLAYMODE_CHORD_ROOT or DMUS_PLAYMODE_CHORD_INTERVALS);
(* If it is desirable to play a note that is above the top of the chord, the
always play mode (known as "purpleized" in a former life) finds a position
for the note by using intervals from the scale. Essentially, this mode is
a combination of the Normal and Melodic playback modes, where a failure
in Normal causes a second try in Melodic mode.
*)
DMUS_PLAYMODE_ALWAYSPLAY = (DMUS_PLAYMODE_MELODIC or DMUS_PLAYMODE_NORMALCHORD);
 
(* Legacy names for modes... *)
DMUS_PLAYMODE_PURPLEIZED = DMUS_PLAYMODE_ALWAYSPLAY;
DMUS_PLAYMODE_SCALE_ROOT = DMUS_PLAYMODE_KEY_ROOT;
DMUS_PLAYMODE_FIXEDTOSCALE = DMUS_PLAYMODE_FIXEDTOKEY;
 
type
(* DMUS_MIDI_PMsg *)
TDMus_Midi_PMsg = record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
bStatus: BYTE;
bByte1: BYTE;
bByte2: BYTE;
bPad: array [0..0] of BYTE;
end;
 
(* DMUS_PATCH_PMsg *)
TDMus_Patch_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
byInstrument: BYTE;
byMSB: BYTE;
byLSB: BYTE;
byPad: array [0..0] of BYTE;
end;
 
(* DMUS_TRANSPOSE_PMsg *)
TDMus_Transpose_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
nTranspose: SmallInt;
end;
 
(* DMUS_CHANNEL_PRIORITY_PMsg *)
TDMus_Channel_Priority_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
dwChannelPriority: DWORD;
end;
 
(* DMUS_TEMPO_PMsg *)
TDMus_Tempo_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
dblTempo: double; (* the tempo *)
end;
 
const
DMUS_TEMPO_MAX = 1000;
DMUS_TEMPO_MIN = 1;
 
DMUS_MASTERTEMPO_MAX = 100.0;
DMUS_MASTERTEMPO_MIN = 0.01;
 
type
(* DMUS_SYSEX_PMsg *)
TDMus_SysEx_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
dwLen: DWORD; (* length of the data *)
abData: array [0..0] of BYTE; (* array of data, length equal to dwLen *)
end;
 
(* DMUS_CURVE_PMsg *)
TDMus_Curve_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
mtDuration: TMusic_Time; (* how long this curve lasts *)
mtOriginalStart: TMusic_Time; (* must be set to either zero when this PMSG is created or to the original mtTime of the curve *)
mtResetDuration: TMusic_Time; (* how long after the curve is finished to reset to the
reset value, nResetValue *)
nStartValue: SmallInt; (* curve's start value *)
nEndValue: SmallInt; (* curve's end value *)
nResetValue: SmallInt; (* curve's reset value, sent after mtResetDuration or
upon a flush or invalidation *)
wMeasure: WORD; (* Measure in which this curve occurs *)
nOffset: SmallInt; (* Offset from grid at which this curve occurs *)
bBeat: BYTE; (* Beat (in measure) at which this curve occurs *)
bGrid: BYTE; (* Grid offset from beat at which this curve occurs *)
bType: BYTE; (* type of curve *)
bCurveShape: BYTE; (* shape of curve *)
bCCData: BYTE; (* CC# if this is a control change type *)
bFlags: BYTE; (* set to 1 if the nResetValue must be sent when the
time is reached or an invalidate occurs because
of a transition. If 0, the curve stays
permanently stuck at the new value. All bits besides
1 are reserved. *)
end;
 
TDMus_Curve_Flags = DWORD;
const
DMUS_CURVE_RESET = 1; (* Set if the curve needs to be reset. *)
 
(* Curve shapes *)
type
TDMus_Curve_Shapes = (
DMUS_CURVES_LINEAR ,
DMUS_CURVES_INSTANT,
DMUS_CURVES_EXP ,
DMUS_CURVES_LOG ,
DMUS_CURVES_SINE
);
 
const
(* curve types *)
DMUS_CURVET_PBCURVE = $03;
DMUS_CURVET_CCCURVE = $04;
DMUS_CURVET_MATCURVE = $05;
DMUS_CURVET_PATCURVE = $06;
 
type
(* DMUS_TIMESIG_PMsg *)
TDMus_TimeSig_PMsg = packed record
(* begin DMUS_PMsg_PART *)
dwSize: DWORD;
rtTime: TReference_Time; (* real time (in 100 nanosecond increments) *)
mtTime: TMusic_Time; (* music time *)
dwFlags: DWORD; (* various bits (see DMUS_PMsg_FLAGS enumeration) *)
dwPChannel: DWORD; (* Performance Channel. The Performance can *)
(* use this to determine the port/channel. *)
dwVirtualTrackID:DWORD; (* virtual track ID *)
pTool: IDirectMusicTool; (* tool interface pointer *)
pGraph: IDirectMusicGraph; (* tool graph interface pointer *)
dwType: DWORD; (* PMSG type (see DMUS_PMsgT_TYPES defines) *)
dwVoiceID: DWORD; (* unique voice id which allows synthesizers to *)
(* identify a specific event. For DirectX 6.0, *)
(* this field should always be 0. *)
dwGroupID: DWORD; (* Track group id *)
punkUser: IUnknown; (* user com pointer, auto released upon PMSG free *)
(* end DMUS_PMsg_PART *)
 
(* Time signatures define how many beats per measure, which note receives *)
(* the beat, and the grid resolution. *)
bBeatsPerMeasure: BYTE; (* beats per measure (top of time sig) *)
bBeat: BYTE; (* what note receives the beat (bottom of time sig.) *)
(* we can assume that 0 means 256th note *)
wGridsPerBeat: WORD; (* grids per beat *)
end;
 
const
(* notification type values *)
(* The following correspond to GUID_NOTIFICATION_SEGMENT *)
DMUS_NOTIFICATION_SEGSTART = 0;
DMUS_NOTIFICATION_SEGEND = 1;
DMUS_NOTIFICATION_SEGALMOSTEND = 2;
DMUS_NOTIFICATION_SEGLOOP = 3;
DMUS_NOTIFICATION_SEGABORT = 4;
(* The following correspond to GUID_NOTIFICATION_PERFORMANCE *)
DMUS_NOTIFICATION_MUSICSTARTED = 0;
DMUS_NOTIFICATION_MUSICSTOPPED = 1;
(* The following corresponds to GUID_NOTIFICATION_MEASUREANDBEAT *)
DMUS_NOTIFICATION_MEASUREBEAT = 0;
(* The following corresponds to GUID_NOTIFICATION_CHORD *)
DMUS_NOTIFICATION_CHORD = 0;
(* The following correspond to GUID_NOTIFICATION_COMMAND *)
DMUS_NOTIFICATION_GROOVE = 0;
DMUS_NOTIFICATION_EMBELLISHMENT = 1;
 
const
DMUS_MAX_NAME = 64; (* Maximum object name length. *)
DMUS_MAX_CATEGORY = 64; (* Maximum object category name length. *)
DMUS_MAX_FILENAME = MAX_PATH;
 
type
PDMus_Version = ^TDMus_Version;
TDMus_Version = packed record
dwVersionMS: DWORD;
dwVersionLS: DWORD;
end;
 
(* The DMUSOBJECTDESC structure is used to communicate everything you could *)
(* possibly use to describe a DirectMusic object. *)
PDMus_ObjectDesc = ^TDMus_ObjectDesc;
TDMus_ObjectDesc = packed record
dwSize: DWORD; (* Size of this structure. *)
dwValidData: DWORD; (* Flags indicating which fields below are valid. *)
guidObject: TGUID; (* Unique ID for this object. *)
guidClass: TGUID; (* GUID for the class of object. *)
ftDate: TFileTime; (* Last edited date of object. *)
vVersion: TDMus_Version; (* Version. *)
wszName: array [0..DMUS_MAX_NAME-1] of WCHAR; (* Name of object. *)
wszCategory: array [0..DMUS_MAX_CATEGORY-1] of WCHAR; (* Category for object (optional). *)
wszFileName: array [0..DMUS_MAX_FILENAME-1] of WCHAR; (* File path. *)
llMemLength: LongLong; (* Size of Memory data. *)
pbMemData: Pointer; (* Memory pointer for data. *)
dwDummy: DWORD; ///?
end;
 
(* Flags for dwValidData. When set, a flag indicates that the *)
(* corresponding field in DMUSOBJECTDESC holds valid data. *)
const
DMUS_OBJ_OBJECT = (1 shl 0); (* Object GUID is valid. *)
DMUS_OBJ_CLASS = (1 shl 1); (* Class GUID is valid. *)
DMUS_OBJ_NAME = (1 shl 2); (* Name is valid. *)
DMUS_OBJ_CATEGORY = (1 shl 3); (* Category is valid. *)
DMUS_OBJ_FILENAME = (1 shl 4); (* File path is valid. *)
DMUS_OBJ_FULLPATH = (1 shl 5); (* Path is full path. *)
DMUS_OBJ_URL = (1 shl 6); (* Path is URL. *)
DMUS_OBJ_VERSION = (1 shl 7); (* Version is valid. *)
DMUS_OBJ_DATE = (1 shl 8); (* Date is valid. *)
DMUS_OBJ_LOADED = (1 shl 9); (* Object is currently loaded in memory. *)
DMUS_OBJ_MEMORY = (1 shl 10); (* Object is pointed to by pbMemData. *)
 
DMUSB_LOADED = (1 shl 0); (* Set when band has been loaded *)
DMUSB_DEFAULT = (1 shl 1); (* Set when band is default band for a style *)
 
type
IDirectMusicBand = interface;
IDirectMusicChordMap = interface;
IDirectMusicLoader = interface;
IDirectMusicObject = interface;
 
 
IDirectMusicBand = interface (IUnknown)
['{d2ac28c0-b39b-11d1-8704-00600893b1bd}']
function CreateSegment (out ppSegment: IDirectMusicSegment) : HResult; stdcall;
function Download (pPerformance: IDirectMusicPerformance) : HResult; stdcall;
function Unload (pPerformance: IDirectMusicPerformance) : HResult; stdcall;
end;
 
IDirectMusicObject = interface (IUnknown)
['{d2ac28b5-b39b-11d1-8704-00600893b1bd}']
function GetDescriptor (out pDesc: TDMus_ObjectDesc) : HResult; stdcall;
function SetDescriptor (const pDesc: TDMus_ObjectDesc) : HResult; stdcall;
function ParseDescriptor (var pStream;
out pDesc: TDMus_ObjectDesc) : HResult; stdcall;
end;
 
IDirectMusicLoader = interface (IUnknown)
['{2ffaaca2-5dca-11d2-afa6-00aa0024d8b6}']
function GetObject (const pDesc: TDMus_ObjectDesc;
const riid : TGUID;
out ppv) : HResult; stdcall;
function SetObject (const pDesc: TDMus_ObjectDesc) : HResult; stdcall;
function SetSearchDirectory (const rguidClass: TGUID;
pwzPath: PWideChar;
fClear: BOOL) : HResult; stdcall;
function ScanDirectory (const rguidClass: TGUID;
pwzFileExtension,
pwzScanFileName: PWideChar) : HResult; stdcall;
function CacheObject (pObject: IDirectMusicObject) : HResult; stdcall;
function ReleaseObject (pObject: IDirectMusicObject) : HResult; stdcall;
function ClearCache (const rguidClass: TGUID) : HResult; stdcall;
function EnableCache (const rguidClass: TGUID;
fEnable: BOOL) : HResult; stdcall;
function EnumObject (const rguidClass: TGUID;
dwIndex: DWORD;
const pDesc: TDMus_ObjectDesc) : HResult; stdcall;
end;
 
(* Stream object supports IDirectMusicGetLoader interface to access loader while file parsing. *)
 
IDirectMusicGetLoader = interface (IUnknown)
['{68a04844-d13d-11d1-afa6-00aa0024d8b6}']
function GetLoader (out ppLoader: IDirectMusicLoader) : HResult; stdcall;
end;
 
(*/////////////////////////////////////////////////////////////////////
// IDirectMusicStyle *)
IDirectMusicStyle = interface(IUnknown)
['{D2AC28BD-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicStyle
function GetBand(pwszName: PWCHAR;
['{d2ac28bd-b39b-11d1-8704-00600893b1bd}']
function GetBand (pwszName: PWideChar;
out ppBand: IDirectMusicBand) : HResult; stdcall;
function EnumBand(dwIndex: DWORD;
pwszName: PWCHAR) : HResult; stdcall;
pwszName: PWideChar) : HResult; stdcall;
function GetDefaultBand(out ppBand: IDirectMusicBand) : HResult; stdcall;
function EnumMotif(dwIndex: DWORD;
pwszName: PWCHAR) : HResult; stdcall;
function GetMotif(pwszName: PWCHAR;
pwszName: PWideChar) : HResult; stdcall;
function GetMotif (pwszName: PWideChar;
out ppSegment: IDirectMusicSegment) : HResult; stdcall;
function GetDefaultChordMap(out ppChordMap: IDirectMusicChordMap) : HResult; stdcall;
function EnumChordMap(dwIndex: DWORD;
pwszName: PWCHAR) : HResult; stdcall;
function GetChordMap(pwszName: PWCHAR;
pwszName: PWideChar) : HResult; stdcall;
function GetChordMap (pwszName: PWideChar;
out ppChordMap: IDirectMusicChordMap) : HResult; stdcall;
function GetTimeSignature(var pTimeSig: TDMUS_TIMESIGNATURE) : HResult; stdcall;
function GetEmbellishmentLength(dwType: DWORD;
dwLevel: DWORD;
var pdwMin: DWORD;
var pdwMax: DWORD) : HResult; stdcall;
function GetTempo(var pTempo: Double) : HResult; stdcall;
function GetTimeSignature (out pTimeSig: TDMus_TimeSignature) : HResult; stdcall;
function GetEmbellishmentLength (dwType, dwLevel: DWORD;
out pdwMin, pdwMax: DWORD) : HResult; stdcall;
function GetTempo (out pTempo: double) : HResult; stdcall;
end;
 
{ IDirectMusicChordMap }
 
(*/////////////////////////////////////////////////////////////////////
// IDirectMusicChordMap *)
IDirectMusicChordMap = interface(IUnknown)
['{D2AC28BE-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicChordMap
function GetScale(var pdwScale: DWORD) : HResult; stdcall;
['{d2ac28be-b39b-11d1-8704-00600893b1bd}']
function GetScale (out pdwScale: DWORD) : HResult; stdcall;
end;
 
{ IDirectMusicComposer }
 
(*/////////////////////////////////////////////////////////////////////
// IDirectMusicComposer *)
IDirectMusicComposer = interface(IUnknown)
['{D2AC28BF-B39B-11D1-8704-00600893B1BD}']
// IDirectMusicComposer
['{d2ac28bf-b39b-11d1-8704-00600893b1bd}']
function ComposeSegmentFromTemplate(pStyle: IDirectMusicStyle;
pTempSeg: IDirectMusicSegment;
wActivity: Word;
wActivity: WORD;
pChordMap: IDirectMusicChordMap;
out ppSectionSeg: IDirectMusicSegment) : HResult; stdcall;
function ComposeSegmentFromShape(pStyle: IDirectMusicStyle;
wNumMeasures: Word;
wShape: Word;
wActivity: Word;
wNumMeasures,
wShape,
wActivity: WORD;
fIntro: BOOL;
fEnd: BOOL;
pChordMap: IDirectMusicChordMap;
14746,24 → 20477,24
out ppSectionSeg: IDirectMusicSegment) : HResult; stdcall;
function ComposeTransition(pFromSeg: IDirectMusicSegment;
pToSeg: IDirectMusicSegment;
mtTime: MUSIC_TIME;
wCommand: Word;
mtTime: TMusic_Time;
wCommand: WORD;
dwFlags: DWORD;
pChordMap: IDirectMusicChordMap;
out ppSectionSeg: IDirectMusicSegment) : HResult; stdcall;
function AutoTransition(pPerformance: IDirectMusicPerformance;
pToSeg: IDirectMusicSegment;
wCommand: Word;
wCommand: WORD;
dwFlags: DWORD;
pChordMap: IDirectMusicChordMap;
out ppTransSeg: IDirectMusicSegment;
out ppToSegState: IDirectMusicSegmentState;
out ppTransSegState: IDirectMusicSegmentState) : HResult; stdcall;
function ComposeTemplateFromShape(wNumMeasures: Word;
wShape: Word;
function ComposeTemplateFromShape (wNumMeasures: WORD;
wShape: WORD;
fIntro: BOOL;
fEnd: BOOL;
wEndLength: Word;
wEndLength: WORD;
out ppTempSeg: IDirectMusicSegment) : HResult; stdcall;
function ChangeChordMap(pSectionSeg: IDirectMusicSegment;
fTrackScale: BOOL;
14771,592 → 20502,978
end;
 
const
// CLSID's
CLSID_DirectMusicPerformance : TGUID = '{D2AC2881-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicSegment : TGUID = '{D2AC2882-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicSegmentState : TGUID = '{D2AC2883-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicGraph : TGUID = '{D2AC2884-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicTempoTrack : TGUID = '{D2AC2885-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicSeqTrack : TGUID = '{D2AC2886-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicSysExTrack : TGUID = '{D2AC2887-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicTimeSigTrack : TGUID = '{D2AC2888-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicStyle : TGUID = '{D2AC288A-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicChordTrack : TGUID = '{D2AC288B-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicCommandTrack : TGUID = '{D2AC288C-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicStyleTrack : TGUID = '{D2AC288D-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicMotifTrack : TGUID = '{D2AC288E-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicChordMap : TGUID = '{D2AC288F-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicComposer : TGUID = '{D2AC2890-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicSignPostTrack: TGUID = '{F17E8672-C3B4-11D1-870B-00600893B1BD}';
CLSID_DirectMusicLoader : TGUID = '{D2AC2892-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicBandTrack : TGUID = '{D2AC2894-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicBand : TGUID = '{79BA9E00-B6EE-11D1-86BE-00C04FBF8FEF}';
CLSID_DirectMusicChordMapTrack: TGUID = '{D2AC2896-B39B-11D1-8704-00600893B1BD}';
CLSID_DirectMusicMuteTrack : TGUID = '{D2AC2898-B39B-11D1-8704-00600893B1BD}';
(* CLSID's *)
CLSID_DirectMusicPerformance : TGUID = '{d2ac2881-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicSegment : TGUID = '{d2ac2882-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicSegmentState : TGUID = '{d2ac2883-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicGraph : TGUID = '{d2ac2884-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicTempoTrack : TGUID = '{d2ac2885-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicSeqTrack : TGUID = '{d2ac2886-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicSysExTrack : TGUID = '{d2ac2887-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicTimeSigTrack : TGUID = '{d2ac2888-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicStyle : TGUID = '{d2ac288a-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicChordTrack : TGUID = '{d2ac288b-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicCommandTrack : TGUID = '{d2ac288c-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicStyleTrack : TGUID = '{d2ac288d-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicMotifTrack : TGUID = '{d2ac288e-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicChordMap : TGUID = '{d2ac288f-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicComposer : TGUID = '{d2ac2890-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicSignPostTrack : TGUID = '{f17e8672-c3b4-11d1-870b-00600893b1bd}';
CLSID_DirectMusicLoader : TGUID = '{d2ac2892-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicBandTrack : TGUID = '{d2ac2894-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicBand : TGUID = '{79ba9e00-b6ee-11d1-86be-00c04fbf8fef}';
CLSID_DirectMusicChordMapTrack : TGUID = '{d2ac2896-b39b-11d1-8704-00600893b1bd}';
CLSID_DirectMusicMuteTrack : TGUID = '{d2ac2898-b39b-11d1-8704-00600893b1bd}';
 
// Special GUID for all object types. This is used by the loader.
GUID_DirectMusicAllTypes : TGUID = '{D2AC2893-B39B-11D1-8704-00600893B1BD}';
(* Special GUID for all object types. This is used by the loader. *)
GUID_DirectMusicAllTypes : TGUID = '{d2ac2893-b39b-11d1-8704-00600893b1bd}';
 
// Notification guids
GUID_NOTIFICATION_SEGMENT : TGUID = '{D2AC2899-B39B-11D1-8704-00600893B1BD}';
GUID_NOTIFICATION_PERFORMANCE : TGUID = '{81F75BC5-4E5D-11D2-BCC7-00A0C922E6EB}';
GUID_NOTIFICATION_MEASUREANDBEAT: TGUID = '{D2AC289A-B39B-11D1-8704-00600893B1BD}';
GUID_NOTIFICATION_CHORD : TGUID = '{D2AC289B-B39B-11D1-8704-00600893B1BD}';
GUID_NOTIFICATION_COMMAND : TGUID = '{D2AC289C-B39B-11D1-8704-00600893B1BD}';
(* Notification guids *)
GUID_NOTIFICATION_SEGMENT : TGUID = '{d2ac2899-b39b-11d1-8704-00600893b1bd}';
GUID_NOTIFICATION_PERFORMANCE : TGUID = '{81f75bc5-4e5d-11d2-bcc7-00a0c922e6eb}';
GUID_NOTIFICATION_MEASUREANDBEAT : TGUID = '{d2ac289a-b39b-11d1-8704-00600893b1bd}';
GUID_NOTIFICATION_CHORD : TGUID = '{d2ac289b-b39b-11d1-8704-00600893b1bd}';
GUID_NOTIFICATION_COMMAND : TGUID = '{d2ac289c-b39b-11d1-8704-00600893b1bd}';
 
// Track param type guids
// Use to get/set a DMUS_COMMAND_PARAM param in the Command track
GUID_CommandParam : TGUID = '{D2AC289D-B39B-11D1-8704-00600893B1BD}';
(* Track param type guids *)
(* Use to get/set a DMUS_COMMAND_PARAM param in the Command track *)
GUID_CommandParam : TGUID = '{d2ac289d-b39b-11d1-8704-00600893b1bd}';
 
// Use to get/set a DMUS_CHORD_PARAM param in the Chord track
GUID_ChordParam : TGUID = '{D2AC289E-B39B-11D1-8704-00600893B1BD}';
(* Use to get a DMUS_COMMAND_PARAM_2 param in the Command track *)
GUID_CommandParam2 : TGUID = '{28f97ef7-9538-11d2-97a9-00c04fa36e58}';
 
// Use to get a DMUS_RHYTHM_PARAM param in the Chord track
GUID_RhythmParam : TGUID = '{D2AC289F-B39B-11D1-8704-00600893B1BD}';
(* Use to get/set a DMUS_CHORD_PARAM param in the Chord track *)
GUID_ChordParam : TGUID = '{d2ac289e-b39b-11d1-8704-00600893b1bd}';
 
// Use to get/set an IDirectMusicStyle param in the Style track
GUID_IDirectMusicStyle : TGUID = '{D2AC28A1-B39B-11D1-8704-00600893B1BD}';
(* Use to get a DMUS_RHYTHM_PARAM param in the Chord track *)
GUID_RhythmParam : TGUID = '{d2ac289f-b39b-11d1-8704-00600893b1bd}';
 
// Use to get a DMUS_TIMESIGNATURE param in the Style and TimeSig tracks
GUID_TimeSignature : TGUID = '{D2AC28A4-B39B-11D1-8704-00600893B1BD}';
(* Use to get/set an IDirectMusicStyle param in the Style track *)
GUID_IDirectMusicStyle : TGUID = '{d2ac28a1-b39b-11d1-8704-00600893b1bd}';
 
// Use to get/set a DMUS_TEMPO_PARAM param in the Tempo track
GUID_TempoParam : TGUID = '{D2AC28A5-B39B-11D1-8704-00600893B1BD}';
(* Use to get a DMUS_TIMESIGNATURE param in the Style and TimeSig tracks *)
GUID_TimeSignature : TGUID = '{d2ac28a4-b39b-11d1-8704-00600893b1bd}';
 
// Use to set an IDirectMusicBand param in the Band track
GUID_IDirectMusicBand : TGUID = '{D2AC28AC-B39B-11D1-8704-00600893B1BD}';
(* Use to get/set a DMUS_TEMPO_PARAM param in the Tempo track *)
GUID_TempoParam : TGUID = '{d2ac28a5-b39b-11d1-8704-00600893b1bd}';
 
// Use to get/set an IDirectMusicChordMap param in the ChordMap track
GUID_IDirectMusicChordMap : TGUID = '{D2AC28AD-B39B-11D1-8704-00600893B1BD}';
(* Use to set an IDirectMusicBand param in the Band track *)
GUID_IDirectMusicBand : TGUID = '{d2ac28ac-b39b-11d1-8704-00600893b1bd}';
 
// Use to get/set a DMUS_MUTE_PARAM param in the Mute track
GUID_MuteParam : TGUID = '{D2AC28AF-B39B-11D1-8704-00600893B1BD}';
(* Use to get/set an IDirectMusicChordMap param in the ChordMap track *)
GUID_IDirectMusicChordMap : TGUID = '{d2ac28ad-b39b-11d1-8704-00600893b1bd}';
 
// These guids are used in IDirectMusicSegment::SetParam to tell the band track to perform various actions.
///
/// Download bands for the IDirectMusicSegment
GUID_Download : TGUID = '{D2AC28A7-B39B-11D1-8704-00600893B1BD}';
(* Use to get/set a DMUS_MUTE_PARAM param in the Mute track *)
GUID_MuteParam : TGUID = '{d2ac28af-b39b-11d1-8704-00600893b1bd}';
 
// Unload bands for the IDirectMusicSegment
GUID_Unload : TGUID = '{D2AC28A8-B39B-11D1-8704-00600893B1BD}';
(* These guids are used in IDirectMusicSegment::SetParam to tell the band track to perform various actions.
*)
(* Download bands for the IDirectMusicSegment *)
GUID_Download : TGUID = '{d2ac28a7-b39b-11d1-8704-00600893b1bd}';
 
// Connect segment's bands to an IDirectMusicCollection
GUID_ConnectToDLSCollection : TGUID = '{1DB1AE6B-E92E-11D1-A8C5-00C04FA3726E}';
(* Unload bands for the IDirectMusicSegment *)
GUID_Unload : TGUID = '{d2ac28a8-b39b-11d1-8704-00600893b1bd}';
 
// Enable/disable autodownloading of bands
GUID_Enable_Auto_Download : TGUID = '{D2AC28A9-B39B-11D1-8704-00600893B1BD}';
GUID_Disable_Auto_Download : TGUID = '{D2AC28AA-B39B-11D1-8704-00600893B1BD}';
(* Connect segment's bands to an IDirectMusicCollection *)
GUID_ConnectToDLSCollection : TGUID = '{1db1ae6b-e92e-11d1-a8c5-00c04fa3726e}';
 
// Clear all bands
GUID_Clear_All_Bands : TGUID = '{D2AC28AB-B39B-11D1-8704-00600893B1BD}';
(* Enable/disable autodownloading of bands *)
GUID_Enable_Auto_Download : TGUID = '{d2ac28a9-b39b-11d1-8704-00600893b1bd}';
GUID_Disable_Auto_Download : TGUID = '{d2ac28aa-b39b-11d1-8704-00600893b1bd}';
 
// Set segment to manage all program changes, bank selects, etc. for simple playback of a standard MIDI file
GUID_StandardMIDIFile : TGUID = '{06621075-E92E-11D1-A8C5-00C04FA3726E}';
// For compatibility with beta releases...
GUID_IgnoreBankSelectForGM : TGUID = '{06621075-E92E-11D1-A8C5-00C04FA3726E}'; //same as GUID_StandardMIDIFile;
(* Clear all bands *)
GUID_Clear_All_Bands : TGUID = '{d2ac28ab-b39b-11d1-8704-00600893b1bd}';
 
// Disable/enable param guids. Use these in SetParam calls to disable or enable sending
// specific PMsg types.
///
GUID_DisableTimeSig : TGUID = '{45FC707B-1DB4-11D2-BCAC-00A0C922E6EB}';
GUID_EnableTimeSig : TGUID = '{45FC707C-1DB4-11D2-BCAC-00A0C922E6EB}';
GUID_DisableTempo : TGUID = '{45FC707D-1DB4-11D2-BCAC-00A0C922E6EB}';
GUID_EnableTempo : TGUID = '{45FC707E-1DB4-11D2-BCAC-00A0C922E6EB}';
(* Set segment to manage all program changes, bank selects, etc. for simple playback of a standard MIDI file *)
_GUID_StandardMIDIFile = '{06621075-e92e-11d1-a8c5-00c04fa3726e}';
GUID_StandardMIDIFile : TGUID = _GUID_StandardMIDIFile;
(* For compatibility with beta releases... *)
GUID_IgnoreBankSelectForGM : TGUID = _GUID_StandardMIDIFile;
 
// Global data guids
GUID_PerfMasterTempo : TGUID = '{D2AC28B0-B39B-11D1-8704-00600893B1BD}';
GUID_PerfMasterVolume : TGUID = '{D2AC28B1-B39B-11D1-8704-00600893B1BD}';
GUID_PerfMasterGrooveLevel : TGUID = '{D2AC28B2-B39B-11D1-8704-00600893B1BD}';
GUID_PerfAutoDownload : TGUID = '{FB09565B-3631-11D2-BCB8-00A0C922E6EB}';
(* Disable/enable param guids. Use these in SetParam calls to disable or enable sending
* specific PMsg types.
*)
GUID_DisableTimeSig : TGUID = '{45fc707b-1db4-11d2-bcac-00a0c922e6eb}';
GUID_EnableTimeSig : TGUID = '{45fc707c-1db4-11d2-bcac-00a0c922e6eb}';
GUID_DisableTempo : TGUID = '{45fc707d-1db4-11d2-bcac-00a0c922e6eb}';
GUID_EnableTempo : TGUID = '{45fc707e-1db4-11d2-bcac-00a0c922e6eb}';
 
// GUID for default GM/GS dls collection.
GUID_DefaultGMCollection : TGUID = '{F17E8673-C3B4-11D1-870B-00600893B1BD}';
(* Used in SetParam calls for pattern-based tracks. A nonzero value seeds the random number
generator for variation selection; a value of zero reverts to the default behavior of
getting the seed from the system clock.
*)
GUID_SeedVariations : TGUID = '{65b76fa5-ff37-11d2-814e-00c04fa36e58}';
 
// IID's
IID_IDirectMusicLoader : TGUID = '{2FFAACA2-5DCA-11D2-AFA6-00AA0024D8B6}';
IID_IDirectMusicGetLoader : TGUID = '{68A04844-D13D-11D1-AFA6-00AA0024D8B6}';
IID_IDirectMusicObject : TGUID = '{D2AC28B5-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicSegment : TGUID = '{F96029A2-4282-11D2-8717-00600893B1BD}';
IID_IDirectMusicSegmentState : TGUID = '{A3AFDCC7-D3EE-11D1-BC8D-00A0C922E6EB}';
IID_IDirectMusicTrack : TGUID = '{F96029A1-4282-11D2-8717-00600893B1BD}';
IID_IDirectMusicPerformance : TGUID = '{07D43D03-6523-11D2-871D-00600893B1BD}';
IID_IDirectMusicTool : TGUID = '{D2AC28BA-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicGraph : TGUID = '{2BEFC277-5497-11D2-BCCB-00A0C922E6EB}';
IID_IDirectMusicStyle : TGUID = '{D2AC28BD-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicChordMap : TGUID = '{D2AC28BE-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicComposer : TGUID = '{D2AC28BF-B39B-11D1-8704-00600893B1BD}';
IID_IDirectMusicBand : TGUID = '{D2AC28C0-B39B-11D1-8704-00600893B1BD}';
(* Global data guids *)
GUID_PerfMasterTempo : TGUID = '{d2ac28b0-b39b-11d1-8704-00600893b1bd}';
GUID_PerfMasterVolume : TGUID = '{d2ac28b1-b39b-11d1-8704-00600893b1bd}';
GUID_PerfMasterGrooveLevel : TGUID = '{d2ac28b2-b39b-11d1-8704-00600893b1bd}';
GUID_PerfAutoDownload : TGUID = '{fb09565b-3631-11d2-bcb8-00a0c922e6eb}';
 
// Alternate interface IDs, available in DX7 release and after.
IID_IDirectMusicPerformance2 : TGUID = '{6FC2CAE0-BC78-11D2-AFA6-00AA0024D8B6}';
IID_IDirectMusicSegment2 : TGUID = '{D38894D1-C052-11D2-872F-00600893B1BD}';
(* GUID for default GM/GS dls collection. *)
GUID_DefaultGMCollection : TGUID = '{f17e8673-c3b4-11d1-870b-00600893b1bd}';
 
type
(* IID's *)
IID_IDirectMusicLoader = IDirectMusicLoader;
IID_IDirectMusicGetLoader = IDirectMusicGetLoader;
IID_IDirectMusicObject = IDirectMusicObject;
IID_IDirectMusicSegment = IDirectMusicSegment;
IID_IDirectMusicSegmentState = IDirectMusicSegmentState;
IID_IDirectMusicTrack = IDirectMusicTrack;
IID_IDirectMusicPerformance = IDirectMusicPerformance;
IID_IDirectMusicTool = IDirectMusicTool;
IID_IDirectMusicGraph = IDirectMusicGraph;
IID_IDirectMusicStyle = IDirectMusicStyle;
IID_IDirectMusicChordMap = IDirectMusicChordMap;
IID_IDirectMusicComposer = IDirectMusicComposer;
IID_IDirectMusicBand = IDirectMusicBand;
 
//***********************************************************************
// *
// dmusicf.h -- This module defines the DirectMusic file formats *
// *
// Copyright (c) 1998, Microsoft Corp. All rights reserved. *
// *
//**********************************************************************
// Common chunks
const
DMUS_FOURCC_GUID_CHUNK = Ord('g') + Ord('u') shl 8 + Ord('i') shl 16 + Ord('d') shl 24;
DMUS_FOURCC_INFO_LIST = Ord('I') + Ord('N') shl 8 + Ord('F') shl 16 + Ord('O') shl 24;
DMUS_FOURCC_UNFO_LIST = Ord('U') + Ord('N') shl 8 + Ord('F') shl 16 + Ord('O') shl 24;
DMUS_FOURCC_UNAM_CHUNK = Ord('U') + Ord('N') shl 8 + Ord('A') shl 16 + Ord('M') shl 24;
DMUS_FOURCC_UART_CHUNK = Ord('U') + Ord('A') shl 8 + Ord('R') shl 16 + Ord('T') shl 24;
DMUS_FOURCC_UCOP_CHUNK = Ord('U') + Ord('C') shl 8 + Ord('O') shl 16 + Ord('P') shl 24;
DMUS_FOURCC_USBJ_CHUNK = Ord('U') + Ord('S') shl 8 + Ord('B') shl 16 + Ord('J') shl 24;
DMUS_FOURCC_UCMT_CHUNK = Ord('U') + Ord('C') shl 8 + Ord('M') shl 16 + Ord('T') shl 24;
DMUS_FOURCC_CATEGORY_CHUNK = Ord('c') + Ord('a') shl 8 + Ord('t') shl 16 + Ord('g') shl 24;
DMUS_FOURCC_VERSION_CHUNK = Ord('v') + Ord('e') shl 8 + Ord('r') shl 16 + Ord('s') shl 24;
(* Alternate interface IDs, available in DX7 release and after. *)
IID_IDirectMusicPerformance2 : TGUID = '{6fc2cae0-bc78-11d2-afa6-00aa0024d8b6}';
IID_IDirectMusicSegment2 : TGUID = '{d38894d1-c052-11d2-872f-00600893b1bd}';
 
// The following structures are used by the Tracks, and are the packed structures
// that are passed to the Tracks inside the IStream.
(************************************************************************
* *
* dmusicf.h -- This module defines the DirectMusic file formats *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
************************************************************************)
 
//type IDirectMusicCollection = interface;
 
const
(* Common chunks *)
 
DMUS_FOURCC_GUID_CHUNK : mmioFOURCC = ('g','u','i','d');
DMUS_FOURCC_INFO_LIST : mmioFOURCC = ('I','N','F','O');
DMUS_FOURCC_UNFO_LIST : mmioFOURCC = ('U','N','F','O');
DMUS_FOURCC_UNAM_CHUNK : mmioFOURCC = ('U','N','A','M');
DMUS_FOURCC_UART_CHUNK : mmioFOURCC = ('U','A','R','T');
DMUS_FOURCC_UCOP_CHUNK : mmioFOURCC = ('U','C','O','P');
DMUS_FOURCC_USBJ_CHUNK : mmioFOURCC = ('U','S','B','J');
DMUS_FOURCC_UCMT_CHUNK : mmioFOURCC = ('U','C','M','T');
DMUS_FOURCC_CATEGORY_CHUNK : mmioFOURCC = ('c','a','t','g');
DMUS_FOURCC_VERSION_CHUNK : mmioFOURCC = ('v','e','r','s');
 
(* The following structures are used by the Tracks, and are the packed structures *)
(* that are passed to the Tracks inside the IStream. *)
 
type
TDMUS_IO_SEQ_ITEM = record
mtTime : MUSIC_TIME;
mtDuration : MUSIC_TIME;
TDMus_IO_Seq_Item = packed record
mtTime: TMusic_Time;
mtDuration: TMusic_Time;
dwPChannel : DWORD;
nOffset : Smallint;
bStatus : Byte;
bByte1 : Byte;
bByte2 : Byte;
nOffset: SmallInt;
bStatus: BYTE;
bByte1: BYTE;
bByte2: BYTE;
end;
DMUS_IO_SEQ_ITEM = TDMUS_IO_SEQ_ITEM;
 
 
TDMUS_IO_CURVE_ITEM = record
mtStart : MUSIC_TIME;
mtDuration : MUSIC_TIME;
mtResetDuration : MUSIC_TIME;
TDMus_IO_Curve_Item = packed record
mtStart: TMusic_Time;
mtDuration: TMusic_Time;
mtResetDuration: TMusic_Time;
dwPChannel : DWORD;
nOffset : Smallint;
nStartValue : Smallint;
nEndValue : Smallint;
nResetValue : Smallint;
bType : Byte;
bCurveShape : Byte;
bCCData : Byte;
bFlags : Byte;
nOffset: SmallInt;
nStartValue: SmallInt;
nEndValue: SmallInt;
nResetValue: SmallInt;
bType: BYTE;
bCurveShape: BYTE;
bCCData: BYTE;
bFlags: BYTE;
end;
DMUS_IO_CURVE_ITEM = TDMUS_IO_CURVE_ITEM;
 
 
TDMUS_IO_TEMPO_ITEM = record
lTime : MUSIC_TIME;
dblTempo : Double;
TDMus_IO_Tempo_Item = packed record
lTime: TMusic_Time;
dblTempo: double;
end;
DMUS_IO_TEMPO_ITEM = TDMUS_IO_TEMPO_ITEM;
 
 
TDMUS_IO_SYSEX_ITEM = record
mtTime : MUSIC_TIME;
TDMus_IO_SysEx_Item = packed record
mtTime: TMusic_Time;
dwPChannel : DWORD;
dwSysExLength : DWORD;
end;
DMUS_IO_SYSEX_ITEM = TDMUS_IO_SYSEX_ITEM;
 
TDMus_IO_TimeSignature_Item = packed record
lTime: TMusic_Time;
bBeatsPerMeasure: BYTE; (* beats per measure (top of time sig) *)
bBeat: BYTE; (* what note receives the beat (bottom of time sig.) *)
(* we can assume that 0 means 256th note *)
wGridsPerBeat: WORD; (* grids per beat *)
end;
 
TDMUS_IO_TIMESIGNATURE_ITEM = record
lTime : MUSIC_TIME;
bBeatsPerMeasure : Byte; // beats per measure (top of time sig)
bBeat : Byte; // what note receives the beat (bottom of time sig.)
// we can assume that 0 means 256th note
wGridsPerBeat : Word; // grids per beat
(* PARAM structures, used by GetParam() and SetParam() *)
TDMus_Command_Param = packed record
bCommand: BYTE;
bGrooveLevel: BYTE;
bGrooveRange: BYTE;
end;
DMUS_IO_TIMESIGNATURE_ITEM = TDMUS_IO_TIMESIGNATURE_ITEM;
 
// PARAM structures, used by GetParam() and SetParam()
TDMUS_COMMAND_PARAM = record
bCommand : Byte;
bGrooveLevel : Byte;
bGrooveRange : Byte;
TDMus_Command_Param_2 = packed record
mtTime : TMusic_Time;
bCommand: BYTE;
bGrooveLevel: BYTE;
bGrooveRange: BYTE;
end;
DMUS_COMMAND_PARAM = TDMUS_COMMAND_PARAM;
 
//DMUS_CHORD_KEY = DMUS_CHORD_PARAM; // DMUS_CHORD_KEY defined in dmusici.h
TDMus_Chord_Param = TDMus_Chord_Key; (* DMUS_CHORD_KEY defined in dmusici.h *)
 
TDMUS_RHYTHM_PARAM = record
TimeSig : TDMUS_TIMESIGNATURE;
TDMus_Rhythm_Param = packed record
TimeSig: TDMus_TimeSignature;
dwRhythmPattern : DWORD;
end;
DMUS_RHYTHM_PARAM = TDMUS_RHYTHM_PARAM;
 
TDMUS_TEMPO_PARAM = record
mtTime : MUSIC_TIME;
dblTempo : Double;
TDMus_Tempo_Param = packed record
mtTime: TMusic_Time;
dblTempo: double;
end;
DMUS_TEMPO_PARAM = TDMUS_TEMPO_PARAM;
 
 
TDMUS_MUTE_PARAM = record
TDMus_Mute_Param = packed record
dwPChannel : DWORD;
dwPChannelMap : DWORD;
fMute : BOOL;
end;
DMUS_MUTE_PARAM = TDMUS_MUTE_PARAM;
 
const
// Style chunks
(* Style chunks *)
 
DMUS_FOURCC_STYLE_FORM = Ord('D') + Ord('M') shl 8 + Ord('S') shl 16 + Ord('T') shl 24;
DMUS_FOURCC_STYLE_CHUNK = Ord('s') + Ord('t') shl 8 + Ord('y') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_PART_LIST = Ord('p') + Ord('a') shl 8 + Ord('r') shl 16 + Ord('t') shl 24;
DMUS_FOURCC_PART_CHUNK = Ord('p') + Ord('r') shl 8 + Ord('t') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_NOTE_CHUNK = Ord('n') + Ord('o') shl 8 + Ord('t') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_CURVE_CHUNK = Ord('c') + Ord('r') shl 8 + Ord('v') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_PATTERN_LIST = Ord('p') + Ord('t') shl 8 + Ord('t') shl 16 + Ord('n') shl 24;
DMUS_FOURCC_PATTERN_CHUNK = Ord('p') + Ord('t') shl 8 + Ord('n') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_RHYTHM_CHUNK = Ord('r') + Ord('h') shl 8 + Ord('t') shl 16 + Ord('m') shl 24;
DMUS_FOURCC_PARTREF_LIST = Ord('p') + Ord('r') shl 8 + Ord('e') shl 16 + Ord('f') shl 24;
DMUS_FOURCC_PARTREF_CHUNK = Ord('p') + Ord('r') shl 8 + Ord('f') shl 16 + Ord('c') shl 24;
DMUS_FOURCC_STYLE_PERS_REF_LIST = Ord('p') + Ord('r') shl 8 + Ord('r') shl 16 + Ord('f') shl 24;
DMUS_FOURCC_MOTIFSETTINGS_CHUNK = Ord('m') + Ord('t') shl 8 + Ord('f') shl 16 + Ord('s') shl 24;
DMUS_FOURCC_STYLE_FORM : mmioFOURCC = ('D','M','S','T');
DMUS_FOURCC_STYLE_CHUNK : mmioFOURCC = ('s','t','y','h');
DMUS_FOURCC_PART_LIST : mmioFOURCC = ('p','a','r','t');
DMUS_FOURCC_PART_CHUNK : mmioFOURCC = ('p','r','t','h');
DMUS_FOURCC_NOTE_CHUNK : mmioFOURCC = ('n','o','t','e');
DMUS_FOURCC_CURVE_CHUNK : mmioFOURCC = ('c','r','v','e');
DMUS_FOURCC_PATTERN_LIST : mmioFOURCC = ('p','t','t','n');
DMUS_FOURCC_PATTERN_CHUNK : mmioFOURCC = ('p','t','n','h');
DMUS_FOURCC_RHYTHM_CHUNK : mmioFOURCC = ('r','h','t','m');
DMUS_FOURCC_PARTREF_LIST : mmioFOURCC = ('p','r','e','f');
DMUS_FOURCC_PARTREF_CHUNK : mmioFOURCC = ('p','r','f','c');
DMUS_FOURCC_STYLE_PERS_REF_LIST : mmioFOURCC = ('p', 'r', 'r', 'f');
DMUS_FOURCC_MOTIFSETTINGS_CHUNK : mmioFOURCC = ('m', 't', 'f', 's');
 
// Flags used by variations: these make up the DWORDs in dwVariationChoices.
(* Flags used by variations: these make up the DWORDs in dwVariationChoices. *)
 
// These flags determine the types of chords supported by a given variation in DirectMusic
// mode. The first seven flags (bits 1-7) are set if the variation supports major chords
// rooted in scale positions, so, e.g., if bits 1, 2, and 4 are set, the variation
// supports major chords rooted in the tonic, second, and fourth scale positions. The
// next seven flags serve the same purpose, but for minor chords, and the following seven
// flags serve the same purpose for chords that are not major or minor (e.g., SUS 4
// chords). Bits 22, 23, and 24 are set if the variation supports chords rooted in the
// scale, chords rooted sharp of scale tones, and chords rooted flat of scale tones,
// respectively. For example, to support a C# minor chord in the scale of C Major,
// bits 8 (for tonic minor) and 24 (for sharp) need to be set. Bits 25, 26, an 27 handle
// chords that are triads, 6th or 7th chords, and chords with extensions, respectively.
// bits 28 and 29 handle chords that are followed by tonic and dominant chords,
// respectively.
DMUS_VARIATIONF_MAJOR = $0000007F; // Seven positions in the scale - major chords.
DMUS_VARIATIONF_MINOR = $00003F80; // Seven positions in the scale - minor chords.
DMUS_VARIATIONF_OTHER = $001FC000; // Seven positions in the scale - other chords.
DMUS_VARIATIONF_ROOT_SCALE = $00200000; // Handles chord roots in the scale.
DMUS_VARIATIONF_ROOT_FLAT = $00400000; // Handles flat chord roots (based on scale notes).
DMUS_VARIATIONF_ROOT_SHARP = $00800000; // Handles sharp chord roots (based on scale notes).
DMUS_VARIATIONF_TYPE_TRIAD = $01000000; // Handles simple chords - triads.
DMUS_VARIATIONF_TYPE_6AND7 = $02000000; // Handles simple chords - 6 and 7.
DMUS_VARIATIONF_TYPE_COMPLEX= $04000000; // Handles complex chords.
DMUS_VARIATIONF_DEST_TO1 = $08000000; // Handles transitions to 1 chord.
DMUS_VARIATIONF_DEST_TO5 = $10000000; // Handles transitions to 5 chord.
(* These flags determine the types of chords supported by a given variation in DirectMusic *)
(* mode. The first seven flags (bits 1-7) are set if the variation supports major chords *)
(* rooted in scale positions, so, e.g., if bits 1, 2, and 4 are set, the variation *)
(* supports major chords rooted in the tonic, second, and fourth scale positions. The *)
(* next seven flags serve the same purpose, but for minor chords, and the following seven *)
(* flags serve the same purpose for chords that are not major or minor (e.g., SUS 4 *)
(* chords). Bits 22, 23, and 24 are set if the variation supports chords rooted in the *)
(* scale, chords rooted sharp of scale tones, and chords rooted flat of scale tones, *)
(* respectively. For example, to support a C# minor chord in the scale of C Major, *)
(* bits 8 (for tonic minor) and 24 (for sharp) need to be set. Bits 25, 26, an 27 handle *)
(* chords that are triads, 6th or 7th chords, and chords with extensions, respectively. *)
(* bits 28 and 29 handle chords that are followed by tonic and dominant chords, *)
(* respectively. *)
DMUS_VARIATIONF_MAJOR = $0000007F; (* Seven positions in the scale - major chords. *)
DMUS_VARIATIONF_MINOR = $00003F80; (* Seven positions in the scale - minor chords. *)
DMUS_VARIATIONF_OTHER = $001FC000; (* Seven positions in the scale - other chords. *)
DMUS_VARIATIONF_ROOT_SCALE = $00200000; (* Handles chord roots in the scale. *)
DMUS_VARIATIONF_ROOT_FLAT = $00400000; (* Handles flat chord roots (based on scale notes). *)
DMUS_VARIATIONF_ROOT_SHARP = $00800000; (* Handles sharp chord roots (based on scale notes). *)
DMUS_VARIATIONF_TYPE_TRIAD = $01000000; (* Handles simple chords - triads. *)
DMUS_VARIATIONF_TYPE_6AND7 = $02000000; (* Handles simple chords - 6 and 7. *)
DMUS_VARIATIONF_TYPE_COMPLEX = $04000000; (* Handles complex chords. *)
DMUS_VARIATIONF_DEST_TO1 = $08000000; (* Handles transitions to 1 chord. *)
DMUS_VARIATIONF_DEST_TO5 = $10000000; (* Handles transitions to 5 chord. *)
 
// The top three bits of the variation flags are the Mode bits. If all are 0, it's IMA.
// If the smallest is 1, it's Direct Music.
(* The top three bits of the variation flags are the Mode bits. If all are 0, it's IMA. *)
(* If the smallest is 1, it's Direct Music. *)
DMUS_VARIATIONF_MODES = $E0000000;
DMUS_VARIATIONF_IMA25_MODE = $00000000;
DMUS_VARIATIONF_DMUS_MODE = $20000000;
 
//#pragma pack(2)
 
type BYTE2 = Word;
 
type
TDMUS_IO_TIMESIG = record
// Time signatures define how many beats per measure, which note receives
// the beat, and the grid resolution.
bBeatsPerMeasure : Byte; // beats per measure (top of time sig)
bBeat : Byte; // what note receives the beat (bottom of time sig.)
// we can assume that 0 means 256th note
wGridsPerBeat : Word; // grids per beat
TDMus_IO_TimeSig = packed record
(* Time signatures define how many beats per measure, which note receives *)
(* the beat, and the grid resolution. *)
bBeatsPerMeasure: BYTE2; (* beats per measure (top of time sig) *)
bBeat: BYTE2; (* what note receives the beat (bottom of time sig.) *)
(* we can assume that 0 means 256th note *)
wGridsPerBeat: WORD; (* grids per beat *)
end;
DMUS_IO_TIMESIG = TDMUS_IO_TIMESIG;
 
TDMUS_IO_STYLE = record
timeSig : TDMUS_IO_TIMESIG; // Styles have a default Time Signature
dblTempo: Double;
TDMus_IO_Style = packed record
timeSig: TDMus_IO_TimeSig; (* Styles have a default Time Signature *)
dblTempo: double;
end;
DMUS_IO_STYLE = TDMUS_IO_STYLE;
 
TDMUS_IO_VERSION = record
dwVersionMS : DWORD; // Version # high-order 32 bits
dwVersionLS : DWORD; // Version # low-order 32 bits
TDMus_IO_Version = packed record
dwVersionMS: DWORD; (* Version # high-order 32 bits *)
dwVersionLS: DWORD; (* Version # low-order 32 bits *)
end;
DMUS_IO_VERSION = TDMUS_IO_VERSION;
 
TDMUS_IO_PATTERN = record
timeSig : TDMUS_IO_TIMESIG; // Patterns can override the Style's Time sig.
bGrooveBottom : Byte; // bottom of groove range
bGrooveTop : Byte; // top of groove range
wEmbellishment : Word; // Fill, Break, Intro, End, Normal, Motif
wNbrMeasures : Word; // length in measures
TDMus_IO_Pattern = packed record
timeSig: TDMus_IO_TimeSig; (* Patterns can override the Style's Time sig. *)
bGrooveBottom: BYTE2; (* bottom of groove range *)
bGrooveTop: BYTE2; (* top of groove range *)
wEmbellishment: WORD; (* Fill, Break, Intro, End, Normal, Motif *)
wNbrMeasures: WORD; (* length in measures *)
end;
DMUS_IO_PATTERN = TDMUS_IO_PATTERN;
 
TDMUS_IO_STYLEPART = record
timeSig : TDMUS_IO_TIMESIG; // can override pattern's
dwVariationChoices : array[0..31] of DWORD; // MOAW choice bitfield
guidPartID : TGUID; // identifies the part
wNbrMeasures : Word; // length of the Part
bPlayModeFlags : Byte; // see PLAYMODE flags
bInvertUpper : Byte; // inversion upper limit
bInvertLower : Byte; // inversion lower limit
TDMus_IO_StylePart = packed record
timeSig: TDMus_IO_TimeSig; (* can override pattern's *)
dwVariationChoices: array [0..31] of DWORD; (* MOAW choice bitfield *)
guidPartID: TGUID; (* identifies the part *)
wNbrMeasures: WORD; (* length of the Part *)
bPlayModeFlags: BYTE2; (* see PLAYMODE flags *)
bInvertUpper: BYTE2; (* inversion upper limit *)
bInvertLower: BYTE2; (* inversion lower limit *)
end;
DMUS_IO_STYLEPART = TDMUS_IO_STYLEPART;
 
TDMUS_IO_PARTREF = record
guidPartID : TGUID; // unique ID for matching up with parts
wLogicalPartID : Word; // corresponds to port/device/midi channel
bVariationLockID : Byte; // parts with the same ID lock variations.
// high bit is used to identify master Part
bSubChordLevel : Byte; // tells which sub chord level this part wants
bPriority : Byte; // 256 priority levels. Parts with lower priority
// aren't played first when a device runs out of
// notes
bRandomVariation : Byte; // when set, matching variations play in random order
// when clear, matching variations play sequentially
TDMus_IO_PartRef = packed record
guidPartID: TGUID; (* unique ID for matching up with parts *)
wLogicalPartID: WORD; (* corresponds to port/device/midi channel *)
bVariationLockID: BYTE2; (* parts with the same ID lock variations. *)
(* high bit is used to identify master Part *)
bSubChordLevel: BYTE2; (* tells which sub chord level this part wants *)
bPriority: BYTE2; (* 256 priority levels. Parts with lower priority *)
(* aren't played first when a device runs out of *)
(* notes *)
bRandomVariation: BYTE2; (* when set, matching variations play in random order *)
(* when clear, matching variations play sequentially *)
end;
DMUS_IO_PARTREF = TDMUS_IO_PARTREF;
 
TDMUS_IO_STYLENOTE = record
mtGridStart : MUSIC_TIME; // when this note occurs
dwVariation : DWORD; // variation bits
mtDuration : MUSIC_TIME; // how long this note lasts
nTimeOffset : Smallint; // offset from mtGridStart
wMusicValue : Word; // Position in scale.
bVelocity : Byte; // Note velocity.
bTimeRange : Byte; // Range to randomize start time.
bDurRange : Byte; // Range to randomize duration.
bVelRange : Byte; // Range to randomize velocity.
bInversionID : Byte; // Identifies inversion group to which this note belongs
bPlayModeFlags : Byte; // Can override part
TDMus_IO_StyleNote = packed record
mtGridStart: TMusic_Time ;(* when this note occurs *)
dwVariation: DWORD; (* variation bits *)
mtDuration: TMusic_Time; (* how long this note lasts *)
nTimeOffset: SmallInt; (* offset from mtGridStart *)
wMusicValue: WORD; (* Position in scale. *)
bVelocity: BYTE2; (* Note velocity. *)
bTimeRange: BYTE2; (* Range to randomize start time. *)
bDurRange: BYTE2; (* Range to randomize duration. *)
bVelRange: BYTE2; (* Range to randomize velocity. *)
bInversionID: BYTE2; (* Identifies inversion group to which this note belongs *)
bPlayModeFlags: BYTE2; (* Can override part *)
end;
DMUS_IO_STYLENOTE = TDMUS_IO_STYLENOTE;
 
TDMUS_IO_STYLECURVE = record
mtGridStart : MUSIC_TIME;// when this curve occurs
dwVariation : DWORD; // variation bits
mtDuration : MUSIC_TIME;// how long this curve lasts
mtResetDuration : MUSIC_TIME;// how long after the end of the curve to reset the curve
nTimeOffset : Smallint; // offset from mtGridStart
nStartValue : Smallint; // curve's start value
nEndValue : Smallint; // curve's end value
nResetValue : Smallint; // the value to which to reset the curve
bEventType : Byte; // type of curve
bCurveShape : Byte; // shape of curve
bCCData : Byte; // CC#
bFlags : Byte; // Bit 1=TRUE means to send nResetValue. Otherwise, don't.
// Other bits are reserved.
TDMus_IO_StyleCurve = packed record
mtGridStart: TMusic_Time; (* when this curve occurs *)
dwVariation: DWORD; (* variation bits *)
mtDuration: TMusic_Time; (* how long this curve lasts *)
mtResetDuration: TMusic_Time; (* how long after the end of the curve to reset the curve *)
nTimeOffset: SmallInt; (* offset from mtGridStart *)
nStartValue: SmallInt; (* curve's start value *)
nEndValue: SmallInt; (* curve's end value *)
nResetValue: SmallInt; (* the value to which to reset the curve *)
bEventType: BYTE2; (* type of curve *)
bCurveShape: BYTE2; (* shape of curve *)
bCCData: BYTE2; (* CC# *)
bFlags: BYTE2; (* Bit 1=TRUE means to send nResetValue. Otherwise, don't.
Other bits are reserved. *)
end;
DMUS_IO_STYLECURVE = TDMUS_IO_STYLECURVE;
 
TDMUS_IO_MOTIFSETTINGS = record
dwRepeats : DWORD; // Number of repeats. By default, 0.
mtPlayStart : MUSIC_TIME; // Start of playback. By default, 0.
mtLoopStart : MUSIC_TIME; // Start of looping portion. By default, 0.
mtLoopEnd : MUSIC_TIME; // End of loop. Must be greater than mtLoopStart. By default equal to length of motif.
dwResolution : DWORD; // Default resolution.
TDMus_IO_MotifSettings = packed record
dwRepeats: DWORD; (* Number of repeats. By default, 0. *)
mtPlayStart: TMusic_Time; (* Start of playback. By default, 0. *)
mtLoopStart: TMusic_Time; (* Start of looping portion. By default, 0. *)
mtLoopEnd: TMusic_Time; (* End of loop. Must be greater than mtLoopStart. By default equal to length of motif. *)
dwResolution: DWORD; (* Default resolution. *)
end;
DMUS_IO_MOTIFSETTINGS = TDMUS_IO_MOTIFSETTINGS;
 
//#pragma pack()
 
(*
RIFF
(
'DMST' // Style
<styh-ck> // Style header chunk
<guid-ck> // Every Style has a GUID
[<UNFO-list>] // Name, author, copyright info., comments
[<vers-ck>] // version chunk
<part-list>... // List of parts in the Style, used by patterns
<pttn-list>... // List of patterns in the Style
<DMBD-form>... // List of bands in the Style
[<motf-list>] // List of motifs in the Style
[<prrf-list>] // List of chord map references in the Style
)
 
// <styh-ck>
styh
(
<DMUS_IO_STYLE>
)
 
// <guid-ck>
guid
(
<GUID>
)
 
// <vers-ck>
vers
(
<DMUS_IO_VERSION>
)
 
// <part-list>
LIST
(
'part'
<prth-ck> // Part header chunk
[<UNFO-list>]
[<note-ck>] // List of notes in Part
[<crve-ck>] // List of curves in Part
)
 
// <orth-ck>
prth
(
<DMUS_IO_STYLEPART>
)
 
// <note-ck>
'note'
(
// sizeof DMUS_IO_STYLENOTE:DWORD
<DMUS_IO_STYLENOTE>...
)
 
// <crve-ck>
'crve'
(
// sizeof DMUS_IO_STYLECURVE:DWORD
<DMUS_IO_STYLECURVE>...
)
 
// <pttn-list>
LIST
(
'pttn'
<ptnh-ck> // Pattern header chunk
<rhtm-ck> // List of rhythms for chord matching
[<UNFO-list>]
[<mtfs-ck>] // Motif settings chunk
<pref-list>... // List of part reference id's
)
 
// <ptnh-ck>
ptnh
(
<DMUS_IO_PATTERN>
)
 
// <rhtm-ck>
'rhtm'
(
// DWORD's representing rhythms for chord matching based on number
// of measures in the pattern
)
 
// pref-list
LIST
(
'pref'
<prfc-ck> // part ref chunk
)
 
// <prfc-ck>
prfc
(
<DMUS_IO_PARTREF>
)
 
// <mtfs-ck>
mtfs
(
<DMUS_IO_MOTIFSETTINGS>
)
 
// <prrf-list>
LIST
(
'prrf'
// some number of <DMRF>
)
*)
 
(* Chord and command file formats *)
const
// Chord and command file formats
DMUS_FOURCC_CHORDTRACK_LIST : mmioFOURCC = ('c','o','r','d');
DMUS_FOURCC_CHORDTRACKHEADER_CHUNK : mmioFOURCC = ('c','r','d','h');
DMUS_FOURCC_CHORDTRACKBODY_CHUNK : mmioFOURCC = ('c','r','d','b');
 
DMUS_FOURCC_CHORDTRACK_LIST = Ord('c') + Ord('o') shl 8 + Ord('r') shl 16 + Ord('d') shl 24;
DMUS_FOURCC_CHORDTRACKHEADER_CHUNK = Ord('c') + Ord('r') shl 8 + Ord('d') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_CHORDTRACKBODY_CHUNK = Ord('c') + Ord('r') shl 8 + Ord('d') shl 16 + Ord('b') shl 24;
DMUS_FOURCC_COMMANDTRACK_CHUNK : mmioFOURCC = ('c','m','n','d');
 
DMUS_FOURCC_COMMANDTRACK_CHUNK = Ord('c') + Ord('m') shl 8 + Ord('n') shl 16 + Ord('d') shl 24;
 
type
TDMUS_IO_CHORD = record
wszName : array[0..15] of WCHAR; // Name of the chord
mtTime : MUSIC_TIME; // Time of this chord
wMeasure : Word; // Measure this falls on
bBeat : Byte; // Beat this falls on
TDMus_IO_Chord = packed record
wszName: array [0..15] of WCHAR; (* Name of the chord *)
mtTime: TMusic_Time; (* Time of this chord *)
wMeasure: WORD; (* Measure this falls on *)
bBeat: BYTE; (* Beat this falls on *)
end;
DMUS_IO_CHORD = TDMUS_IO_CHORD;
 
TDMUS_IO_SUBCHORD = record
dwChordPattern : DWORD; // Notes in the subchord
dwScalePattern : DWORD; // Notes in the scale
dwInversionPoints : DWORD; // Where inversions can occur
dwLevels : DWORD; // Which levels are supported by this subchord
bChordRoot : Byte; // Root of the subchord
bScaleRoot : Byte; // Root of the scale
TDMus_IO_SubChord = packed record
dwChordPattern: DWORD; (* Notes in the subchord *)
dwScalePattern: DWORD; (* Notes in the scale *)
dwInversionPoints: DWORD; (* Where inversions can occur *)
dwLevels: DWORD; (* Which levels are supported by this subchord *)
bChordRoot: BYTE; (* Root of the subchord *)
bScaleRoot: BYTE; (* Root of the scale *)
end;
DMUS_IO_SUBCHORD = TDMUS_IO_SUBCHORD;
 
TDMUS_IO_COMMAND = record
mtTime : MUSIC_TIME; // Time of this command
wMeasure : Word; // Measure this falls on
bBeat : Byte; // Beat this falls on
bCommand : Byte; // Command type (see #defines below)
bGrooveLevel : Byte; // Groove level (0 if command is not a groove)
bGrooveRange : Byte; // Groove range
TDMus_IO_Command = packed record
mtTime: TMusic_Time; (* Time of this command *)
wMeasure: WORD; (* Measure this falls on *)
bBeat: BYTE; (* Beat this falls on *)
bCommand: BYTE; (* Command type (see #defines below) *)
bGrooveLevel: BYTE; (* Groove level (0 if command is not a groove) *)
bGrooveRange: BYTE; (* Groove range *)
end;
DMUS_IO_COMMAND = TDMUS_IO_COMMAND;
 
(*
 
// File io for DirectMusic Tool and ToolGraph objects
///
// <cord-list>
LIST
(
'cord'
<crdh-ck>
<crdb-ck> // Chord body chunk
)
 
// <crdh-ck>
crdh
(
// Scale: dword (upper 8 bits for root, lower 24 for scale)
)
 
// <crdb-ck>
crdb
(
// sizeof DMUS_IO_CHORD:dword
<DMUS_IO_CHORD>
// # of DMUS_IO_SUBCHORDS:dword
// sizeof DMUS_IO_SUBCHORDS:dword
// a number of <DMUS_IO_SUBCHORD>
)
 
 
// <cmnd-list>
'cmnd'
(
//sizeof DMUS_IO_COMMAND: DWORD
<DMUS_IO_COMMAND>...
)
 
*)
 
(* File io for DirectMusic Tool and ToolGraph objects
*)
 
(* RIFF ids: *)
const
// RIFF ids:
DMUS_FOURCC_TOOLGRAPH_FORM : mmioFOURCC = ('D','M','T','G');
DMUS_FOURCC_TOOL_LIST : mmioFOURCC = ('t','o','l','l');
DMUS_FOURCC_TOOL_FORM : mmioFOURCC = ('D','M','T','L');
DMUS_FOURCC_TOOL_CHUNK : mmioFOURCC = ('t','o','l','h');
 
DMUS_FOURCC_TOOLGRAPH_FORM = Ord('D') + Ord('M') shl 8 + Ord('T') shl 16 + Ord('G') shl 24;
DMUS_FOURCC_TOOL_LIST = Ord('t') + Ord('o') shl 8 + Ord('l') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_TOOL_FORM = Ord('D') + Ord('M') shl 8 + Ord('T') shl 16 + Ord('L') shl 24;
DMUS_FOURCC_TOOL_CHUNK = Ord('t') + Ord('o') shl 8 + Ord('l') shl 16 + Ord('h') shl 24;
 
(* io structures: *)
type
// io structures:
 
TDMUS_IO_TOOL_HEADER = record
guidClassID : TGUID; // Class id of tool.
lIndex : Longint; // Position in graph.
cPChannels : DWORD; // Number of items in channels array.
ckid : FOURCC; // chunk ID of tool's data chunk if 0 fccType valid.
fccType : FOURCC; // list type if NULL ckid valid.
dwPChannels : array[0..0] of DWORD; // Array of PChannels, size determined by cPChannels.
TDMus_IO_Tool_Header = packed record
guidClassID: TGUID; (* Class id of tool. *)
lIndex: LongInt; (* Position in graph. *)
cPChannels: DWORD; (* Number of items in channels array. *)
ckid: TFourCC; (* chunk ID of tool's data chunk if 0 fccType valid. *)
fccType: TFourCC; (* list type if NULL ckid valid. *)
dwPChannels: array [0..0] of DWORD; (* Array of PChannels, size determined by cPChannels. *)
end;
DMUS_IO_TOOL_HEADER = TDMUS_IO_TOOL_HEADER;
 
(*
RIFF
(
'DMTG' // DirectMusic ToolGraph chunk
[<guid-ck>] // GUID for ToolGraph
[<vers-ck>] // Optional version info
[<UNFO-list>] // Name, author, copyright info., comments
<toll-list> // List of Tools
)
 
// File io for DirectMusic Band Track object
// <guid-ck>
'guid'
(
<GUID>
)
 
// <vers-ck>
vers
(
<DMUS_IO_VERSION>
)
 
// <toll-list>
LIST
(
'toll' // List of tools
<DMTL-form>... // Each tool is encapsulated in a RIFF chunk
)
 
// <DMTL-form> // Tools can be embedded in a graph or stored as separate files.
RIFF
(
'DMTL'
<tolh-ck>
[<guid-ck>] // Optional GUID for tool object instance (not to be confused with Class id in track header)
[<vers-ck>] // Optional version info
[<UNFO-list>] // Optional name, author, copyright info., comments
[<data>] // Tool data. Must be a RIFF readable chunk.
)
 
// <tolh-ck> // Tool header chunk
(
'tolh'
<DMUS_IO_TOOL_HEADER> // Tool header
)
*)
 
(* File io for DirectMusic Band Track object *)
 
 
(* RIFF ids: *)
const
// RIFF ids:
DMUS_FOURCC_BANDTRACK_FORM = Ord('D') + Ord('M') shl 8 + Ord('B') shl 16 + Ord('T') shl 24;
DMUS_FOURCC_BANDTRACK_CHUNK = Ord('b') + Ord('d') shl 8 + Ord('t') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_BANDS_LIST = Ord('l') + Ord('b') shl 8 + Ord('d') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_BAND_LIST = Ord('l') + Ord('b') shl 8 + Ord('n') shl 16 + Ord('d') shl 24;
DMUS_FOURCC_BANDITEM_CHUNK = Ord('b') + Ord('d') shl 8 + Ord('i') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_BANDTRACK_FORM : mmioFOURCC = ('D','M','B','T');
DMUS_FOURCC_BANDTRACK_CHUNK : mmioFOURCC = ('b','d','t','h');
DMUS_FOURCC_BANDS_LIST : mmioFOURCC = ('l','b','d','l');
DMUS_FOURCC_BAND_LIST : mmioFOURCC = ('l','b','n','d');
DMUS_FOURCC_BANDITEM_CHUNK : mmioFOURCC = ('b','d','i','h');
 
type
// io structures
TDMUS_IO_BAND_TRACK_HEADER = record
bAutoDownload : BOOL; // Determines if Auto-Download is enabled.
(* io structures *)
TDMus_IO_Band_Track_Header = packed record
bAutoDownload: BOOL; (* Determines if Auto-Download is enabled. *)
end;
DMUS_IO_BAND_TRACK_HEADER = TDMUS_IO_BAND_TRACK_HEADER;
 
TDMUS_IO_BAND_ITEM_HEADER = record
lBandTime : MUSIC_TIME; // Position in track list.
TDMus_IO_Band_Item_Header = packed record
lBandTime: TMusic_Time; (* Position in track list. *)
end;
DMUS_IO_BAND_ITEM_HEADER = TDMUS_IO_BAND_ITEM_HEADER;
 
(*
RIFF
(
'DMBT' // DirectMusic Band Track form-type
[<bdth-ck>] // Band track header
[<guid-ck>] // GUID for band track
[<vers-ck>] // Optional version info
[<UNFO-list>] // Name, author, copyright info., comments
<lbdl-list> // List of Band Lists
)
 
// File io for DirectMusic Band object
///
// <bnth-ck>
'bdth'
(
<DMUS_IO_BAND_TRACK_HEADER>
)
 
const
// RIFF ids:
// <guid-ck>
'guid'
(
<GUID>
)
 
DMUS_FOURCC_BAND_FORM = Ord('D') + Ord('M') shl 8 + Ord('B') shl 16 + Ord('D') shl 24;
DMUS_FOURCC_INSTRUMENTS_LIST = Ord('l') + Ord('b') shl 8 + Ord('i') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_INSTRUMENT_LIST = Ord('l') + Ord('b') shl 8 + Ord('i') shl 16 + Ord('n') shl 24;
DMUS_FOURCC_INSTRUMENT_CHUNK = Ord('b') + Ord('i') shl 8 + Ord('n') shl 16 + Ord('s') shl 24;
// <vers-ck>
vers
(
<DMUS_IO_VERSION>
)
 
// Flags for DMUS_IO_INSTRUMENT
///
DMUS_IO_INST_PATCH = (1 shl 0); // dwPatch is valid.
DMUS_IO_INST_BANKSELECT = (1 shl 1); // dwPatch contains a valid Bank Select MSB and LSB part
DMUS_IO_INST_ASSIGN_PATCH = (1 shl 3); // dwAssignPatch is valid
DMUS_IO_INST_NOTERANGES = (1 shl 4); // dwNoteRanges is valid
DMUS_IO_INST_PAN = (1 shl 5); // bPan is valid
DMUS_IO_INST_VOLUME = (1 shl 6); // bVolume is valid
DMUS_IO_INST_TRANSPOSE = (1 shl 7); // nTranspose is valid
DMUS_IO_INST_GM = (1 shl 8); // Instrument is from GM collection
DMUS_IO_INST_GS = (1 shl 9); // Instrument is from GS collection
DMUS_IO_INST_XG = (1 shl 10); // Instrument is from XG collection
DMUS_IO_INST_CHANNEL_PRIORITY = (1 shl 11); // dwChannelPriority is valid
DMUS_IO_INST_USE_DEFAULT_GM_SET = (1 shl 12); // Always use the default GM set for this patch,
// don't rely on the synth caps stating GM or GS in hardware.
// <lbdl-list>
LIST
(
'lbdl' // List of bands
<lbnd-list> // Each band is encapsulated in a list
)
 
// <lbnd-list>
LIST
(
'lbnd'
<bdih-ck>
<DMBD-form> // Band
)
 
// <bdih-ck> // band item header
(
<DMUS_IO_BAND_ITEM_HEADER> // Band item header
)
*)
 
 
(* File io for DirectMusic Band object
*)
 
(* RIFF ids: *)
const
DMUS_FOURCC_BAND_FORM : mmioFOURCC = ('D','M','B','D');
DMUS_FOURCC_INSTRUMENTS_LIST : mmioFOURCC = ('l','b','i','l');
DMUS_FOURCC_INSTRUMENT_LIST : mmioFOURCC = ('l','b','i','n');
DMUS_FOURCC_INSTRUMENT_CHUNK : mmioFOURCC = ('b','i','n','s');
 
(* Flags for DMUS_IO_INSTRUMENT
*)
DMUS_IO_INST_PATCH = (1 shl 0); (* dwPatch is valid. *)
DMUS_IO_INST_BANKSELECT = (1 shl 1); (* dwPatch contains a valid Bank Select MSB and LSB part *)
DMUS_IO_INST_ASSIGN_PATCH = (1 shl 3); (* dwAssignPatch is valid *)
DMUS_IO_INST_NOTERANGES = (1 shl 4); (* dwNoteRanges is valid *)
DMUS_IO_INST_PAN = (1 shl 5); (* bPan is valid *)
DMUS_IO_INST_VOLUME = (1 shl 6); (* bVolume is valid *)
DMUS_IO_INST_TRANSPOSE = (1 shl 7); (* nTranspose is valid *)
DMUS_IO_INST_GM = (1 shl 8); (* Instrument is from GM collection *)
DMUS_IO_INST_GS = (1 shl 9); (* Instrument is from GS collection *)
DMUS_IO_INST_XG = (1 shl 10); (* Instrument is from XG collection *)
DMUS_IO_INST_CHANNEL_PRIORITY = (1 shl 11); (* dwChannelPriority is valid *)
DMUS_IO_INST_USE_DEFAULT_GM_SET = (1 shl 12); (* Always use the default GM set for this patch, *)
(* don't rely on the synth caps stating GM or GS in hardware. *)
type
// io structures
TDMUS_IO_INSTRUMENT = record
dwPatch : DWORD; // MSB, LSB and Program change to define instrument
dwAssignPatch : DWORD; // MSB, LSB and Program change to assign to instrument when downloading
dwNoteRanges : array[0..3] of DWORD; // 128 bits; one for each MIDI note instrument needs to able to play
dwPChannel : DWORD; // PChannel instrument plays on
dwFlags : DWORD; // DMUS_IO_INST_ flags
bPan : Byte; // Pan for instrument
bVolume : Byte; // Volume for instrument
nTranspose : Smallint; // Number of semitones to transpose notes
dwChannelPriority : DWORD; // Channel priority
(* io structures *)
TDMus_IO_Instruments = packed record
dwPatch: DWORD; (* MSB, LSB and Program change to define instrument *)
dwAssignPatch: DWORD; (* MSB, LSB and Program change to assign to instrument when downloading *)
dwNoteRanges: array [0..3] of DWORD;(* 128 bits: one for each MIDI note instrument needs to able to play *)
dwPChannel: DWORD; (* PChannel instrument plays on *)
dwFlags: DWORD; (* DMUS_IO_INST_ flags *)
bPan: BYTE; (* Pan for instrument *)
bVolume: BYTE; (* Volume for instrument *)
nTranspose: SmallInt; (* Number of semitones to transpose notes *)
dwChannelPriority: DWORD; (* Channel priority *)
end;
DMUS_IO_INSTRUMENT = TDMUS_IO_INSTRUMENT;
 
(*
// <DMBD-form> bands can be embedded in other forms
RIFF
(
'DMBD' // DirectMusic Band chunk
[<guid-ck>] // GUID for band
[<vers-ck>] // Optional version info
[<UNFO-list>] // Name, author, copyright info., comments
<lbil-list> // List of Instruments
)
 
// File io for DirectMusic Segment object
// <guid-ck>
'guid'
(
<GUID>
)
 
// <vers-ck>
vers
(
<DMUS_IO_VERSION>
)
 
// <lbil-list>
LIST
(
'lbil' // List of instruments
<lbin-list> // Each instrument is encapsulated in a list
)
 
// <lbin-list>
LIST
(
'lbin'
<bins-ck>
[<DMRF-list>] // Optional reference to DLS Collection file.
)
 
// <bins-ck> // Instrument chunk
(
'bins'
<DMUS_IO_INSTRUMENT> // Instrument header
)
*)
 
(* File io for DirectMusic Segment object *)
 
(* RIFF ids: *)
const
// RIFF ids:
DMUS_FOURCC_SEGMENT_FORM : mmioFOURCC = ('D','M','S','G');
DMUS_FOURCC_SEGMENT_CHUNK : mmioFOURCC = ('s','e','g','h');
DMUS_FOURCC_TRACK_LIST : mmioFOURCC = ('t','r','k','l');
DMUS_FOURCC_TRACK_FORM : mmioFOURCC = ('D','M','T','K');
DMUS_FOURCC_TRACK_CHUNK : mmioFOURCC = ('t','r','k','h');
 
DMUS_FOURCC_SEGMENT_FORM = Ord('D') + Ord('M') shl 8 + Ord('S') shl 16 + Ord('G') shl 24;
DMUS_FOURCC_SEGMENT_CHUNK = Ord('s') + Ord('e') shl 8 + Ord('g') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_TRACK_LIST = Ord('t') + Ord('r') shl 8 + Ord('k') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_TRACK_FORM = Ord('D') + Ord('M') shl 8 + Ord('T') shl 16 + Ord('K') shl 24;
DMUS_FOURCC_TRACK_CHUNK = Ord('t') + Ord('r') shl 8 + Ord('k') shl 16 + Ord('h') shl 24;
 
(* io structures:*)
type
// io structures:
 
TDMUS_IO_SEGMENT_HEADER = record
dwRepeats : DWORD; // Number of repeats. By default, 0.
mtLength : MUSIC_TIME; // Length, in music time.
mtPlayStart : MUSIC_TIME; // Start of playback. By default, 0.
mtLoopStart : MUSIC_TIME; // Start of looping portion. By default, 0.
mtLoopEnd : MUSIC_TIME; // End of loop. Must be greater than dwPlayStart. By default equal to length.
dwResolution : DWORD; // Default resolution.
TDMus_IO_Segment_Header = packed record
dwRepeats: DWORD; (* Number of repeats. By default, 0. *)
mtLength: TMusic_Time; (* Length, in music time. *)
mtPlayStart: TMusic_Time; (* Start of playback. By default, 0. *)
mtLoopStart: TMusic_Time; (* Start of looping portion. By default, 0. *)
mtLoopEnd: TMusic_Time; (* End of loop. Must be greater than dwPlayStart. By default equal to length. *)
dwResolution: DWORD; (* Default resolution. *)
end;
DMUS_IO_SEGMENT_HEADER = TDMUS_IO_SEGMENT_HEADER;
 
TDMUS_IO_TRACK_HEADER = record
guidClassID : TGUID; // Class id of track.
dwPosition : DWORD; // Position in track list.
dwGroup : DWORD; // Group bits for track.
ckid : FOURCC; // chunk ID of track's data chunk if 0 fccType valid.
fccType : FOURCC; // list type if NULL ckid valid
TDMus_IO_Track_Header = packed record
guidClassID: TGUID; (* Class id of track. *)
dwPosition: DWORD; (* Position in track list. *)
dwGroup: DWORD; (* Group bits for track. *)
ckid: TFourCC; (* chunk ID of track's data chunk if 0 fccType valid. *)
fccType: TFourCC; (* list type if NULL ckid valid *)
end;
DMUS_IO_TRACK_HEADER = TDMUS_IO_TRACK_HEADER;
 
// File io for DirectMusic reference chunk.
// This is used to embed a reference to an object.
(*
RIFF
(
'DMSG' // DirectMusic Segment chunk
<segh-ck> // Segment header chunk
[<guid-ck>] // GUID for segment
[<vers-ck>] // Optional version info
[<UNFO-list>] // Name, author, copyright info., comments
<trkl-list> // List of Tracks
[<DMTG-form>] // Optional ToolGraph
)
 
// <segh-ck>
'segh'
(
<DMUS_IO_SEGMENT_HEADER>
)
// <guid-ck>
'guid'
(
<GUID>
)
 
// <vers-ck>
vers
(
<DMUS_IO_VERSION>
)
 
// <trkl-list>
LIST
(
'trkl' // List of tracks
<DMTK-form>... // Each track is encapsulated in a RIFF chunk
)
 
// <DMTK-form> // Tracks can be embedded in a segment or stored as separate files.
RIFF
(
'DMTK'
<trkh-ck>
[<guid-ck>] // Optional GUID for track object instance (not to be confused with Class id in track header)
[<vers-ck>] // Optional version info
[<UNFO-list>] // Optional name, author, copyright info., comments
[<data>] // Track data. Must be a RIFF readable chunk.
)
 
// <trkh-ck> // Track header chunk
(
'trkh'
<DMUS_IO_TRACK_HEADER> // Track header
)
*)
 
(* File io for DirectMusic reference chunk.
This is used to embed a reference to an object.
*)
 
(* RIFF ids: *)
const
// RIFF ids:
DMUS_FOURCC_REF_LIST : mmioFOURCC = ('D','M','R','F');
DMUS_FOURCC_REF_CHUNK : mmioFOURCC = ('r','e','f','h');
DMUS_FOURCC_DATE_CHUNK : mmioFOURCC = ('d','a','t','e');
DMUS_FOURCC_NAME_CHUNK : mmioFOURCC = ('n','a','m','e');
DMUS_FOURCC_FILE_CHUNK : mmioFOURCC = ('f','i','l','e');
 
DMUS_FOURCC_REF_LIST = Ord('D') + Ord('M') shl 8 + Ord('R') shl 16 + Ord('F') shl 24;
DMUS_FOURCC_REF_CHUNK = Ord('r') + Ord('e') shl 8 + Ord('f') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_DATE_CHUNK = Ord('d') + Ord('a') shl 8 + Ord('t') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_NAME_CHUNK = Ord('n') + Ord('a') shl 8 + Ord('m') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_FILE_CHUNK = Ord('f') + Ord('i') shl 8 + Ord('l') shl 16 + Ord('e') shl 24;
 
type
TDMUS_IO_REFERENCE = record
guidClassID : TGUID; // Class id is always required.
dwValidData : DWORD; // Flags.
TDMus_IO_Reference = packed record
guidClassID: TGUID; (* Class id is always required. *)
dwValidData: DWORD; (* Flags. *)
end;
DMUS_IO_REFERENCE = TDMUS_IO_REFERENCE;
 
(*
LIST
(
'DMRF' // DirectMusic Reference chunk
<refh-ck> // Reference header chunk
[<guid-ck>] // Optional object GUID.
[<date-ck>] // Optional file date.
[<name-ck>] // Optional name.
[<file-ck>] // Optional file name.
[<catg-ck>] // Optional category name.
[<vers-ck>] // Optional version info.
)
 
// Chord Maps
// <refh-ck>
'refh'
(
<DMUS_IO_REFERENCE>
)
 
// <guid-ck>
'guid'
(
<GUID>
)
 
// <date-ck>
date
(
<FILETIME>
)
 
// <name-ck>
name
(
// Name, stored as NULL terminated string of WCHARs
)
 
// <file-ck>
file
(
// File name, stored as NULL terminated string of WCHARs
)
 
// <catg-ck>
catg
(
// Category name, stored as NULL terminated string of WCHARs
)
 
// <vers-ck>
vers
(
<DMUS_IO_VERSION>
)
*)
 
(* Chord Maps *)
const
// runtime chunks
DMUS_FOURCC_CHORDMAP_FORM = Ord('D') + Ord('M') shl 8 + Ord('P') shl 16 + Ord('R') shl 24;
DMUS_FOURCC_IOCHORDMAP_CHUNK = Ord('p') + Ord('e') shl 8 + Ord('r') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_SUBCHORD_CHUNK = Ord('c') + Ord('h') shl 8 + Ord('d') shl 16 + Ord('t') shl 24;
DMUS_FOURCC_CHORDENTRY_CHUNK = Ord('c') + Ord('h') shl 8 + Ord('e') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_SUBCHORDID_CHUNK = Ord('s') + Ord('b') shl 8 + Ord('c') shl 16 + Ord('n') shl 24;
DMUS_FOURCC_IONEXTCHORD_CHUNK = Ord('n') + Ord('c') shl 8 + Ord('r') shl 16 + Ord('d') shl 24;
DMUS_FOURCC_NEXTCHORDSEQ_CHUNK = Ord('n') + Ord('c') shl 8 + Ord('s') shl 16 + Ord('q') shl 24;
DMUS_FOURCC_IOSIGNPOST_CHUNK = Ord('s') + Ord('p') shl 8 + Ord('s') shl 16 + Ord('h') shl 24;
DMUS_FOURCC_CHORDNAME_CHUNK = Ord('I') + Ord('N') shl 8 + Ord('A') shl 16 + Ord('M') shl 24;
(* runtime chunks *)
DMUS_FOURCC_CHORDMAP_FORM : mmioFOURCC = ('D','M','P','R');
DMUS_FOURCC_IOCHORDMAP_CHUNK : mmioFOURCC = ('p','e','r','h');
DMUS_FOURCC_SUBCHORD_CHUNK : mmioFOURCC = ('c','h','d','t');
DMUS_FOURCC_CHORDENTRY_CHUNK : mmioFOURCC = ('c','h','e','h');
DMUS_FOURCC_SUBCHORDID_CHUNK : mmioFOURCC = ('s','b','c','n');
DMUS_FOURCC_IONEXTCHORD_CHUNK : mmioFOURCC = ('n','c','r','d');
DMUS_FOURCC_NEXTCHORDSEQ_CHUNK : mmioFOURCC = ('n','c','s','q');
DMUS_FOURCC_IOSIGNPOST_CHUNK : mmioFOURCC = ('s','p','s','h');
DMUS_FOURCC_CHORDNAME_CHUNK : mmioFOURCC = ('I','N','A','M');
 
// runtime list chunks
DMUS_FOURCC_CHORDENTRY_LIST = Ord('c') + Ord('h') shl 8 + Ord('o') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_CHORDMAP_LIST = Ord('c') + Ord('m') shl 8 + Ord('a') shl 16 + Ord('p') shl 24;
DMUS_FOURCC_CHORD_LIST = Ord('c') + Ord('h') shl 8 + Ord('r') shl 16 + Ord('d') shl 24;
DMUS_FOURCC_CHORDPALETTE_LIST = Ord('c') + Ord('h') shl 8 + Ord('p') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_CADENCE_LIST = Ord('c') + Ord('a') shl 8 + Ord('d') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_SIGNPOSTITEM_LIST = Ord('s') + Ord('p') shl 8 + Ord('s') shl 16 + Ord('t') shl 24;
(* runtime list chunks *)
DMUS_FOURCC_CHORDENTRY_LIST : mmioFOURCC = ('c','h','o','e');
DMUS_FOURCC_CHORDMAP_LIST : mmioFOURCC = ('c','m','a','p');
DMUS_FOURCC_CHORD_LIST : mmioFOURCC = ('c','h','r','d');
DMUS_FOURCC_CHORDPALETTE_LIST : mmioFOURCC = ('c','h','p','l');
DMUS_FOURCC_CADENCE_LIST : mmioFOURCC = ('c','a','d','e');
DMUS_FOURCC_SIGNPOSTITEM_LIST : mmioFOURCC = ('s','p','s','t');
 
DMUS_FOURCC_SIGNPOST_LIST = Ord('s') + Ord('p') shl 8 + Ord('s') shl 16 + Ord('q') shl 24;
DMUS_FOURCC_SIGNPOST_LIST : mmioFOURCC = ('s','p','s','q');
 
// values for dwChord field of DMUS_IO_PERS_SIGNPOST
// DMUS_SIGNPOSTF_ flags are also used in templates (DMUS_IO_SIGNPOST)
(* values for dwChord field of DMUS_IO_PERS_SIGNPOST *)
(* DMUS_SIGNPOSTF_ flags are also used in templates (DMUS_IO_SIGNPOST) *)
DMUS_SIGNPOSTF_A = 1;
DMUS_SIGNPOSTF_B = 2;
DMUS_SIGNPOSTF_C = 4;
15374,271 → 21491,663
DMUS_SIGNPOSTF_ROOT = (DMUS_SIGNPOSTF_1 or DMUS_SIGNPOSTF_2 or DMUS_SIGNPOSTF_3 or DMUS_SIGNPOSTF_4 or DMUS_SIGNPOSTF_5 or DMUS_SIGNPOSTF_6 or DMUS_SIGNPOSTF_7);
DMUS_SIGNPOSTF_CADENCE = $8000;
 
// values for dwChord field of DMUS_IO_PERS_SIGNPOST
DMUS_SPOSTCADENCEF_1 = 2; // Use the first cadence chord.
DMUS_SPOSTCADENCEF_2 = 4; // Use the second cadence chord.
(* values for dwChord field of DMUS_IO_PERS_SIGNPOST *)
DMUS_SPOSTCADENCEF_1 = 2; (* Use the first cadence chord. *)
DMUS_SPOSTCADENCEF_2 = 4; (* Use the second cadence chord. *)
 
type
// run time data structs
TDMUS_IO_CHORDMAP = record
(* run time data structs *)
TDMus_IO_ChordMap = packed record
wszLoadName : array[0..19] of WCHAR;
dwScalePattern : DWORD;
dwFlags : DWORD;
end;
DMUS_IO_CHORDMAP = TDMUS_IO_CHORDMAP;
 
TDMUS_IO_CHORDMAP_SUBCHORD = record
TDMus_IO_ChordMap_SubChord = packed record
dwChordPattern : DWORD;
dwScalePattern : DWORD;
dwInvertPattern: DWORD;
bChordRoot : Byte;
bScaleRoot : Byte;
wCFlags : Word;
dwLevels : DWORD; // parts or which subchord levels this chord supports
bChordRoot: BYTE;
bScaleRoot: BYTE;
wCFlags: WORD;
dwLevels: DWORD; (* parts or which subchord levels this chord supports *)
end;
DMUS_IO_CHORDMAP_SUBCHORD = TDMUS_IO_CHORDMAP_SUBCHORD;
 
// Legacy name...
DMUS_IO_PERS_SUBCHORD = TDMUS_IO_CHORDMAP_SUBCHORD;
(* Legacy name... *)
TDMus_IO_Pers_SubChord = TDMus_IO_ChordMap_SubChord;
 
TDMUS_IO_CHORDENTRY = record
TDMus_IO_ChordEntry = packed record
dwFlags : DWORD;
wConnectionID : Word; // replaces runtime "pointer to this"
wConnectionID: WORD; (* replaces runtime "pointer to this" *)
end;
DMUS_IO_CHORDENTRY = TDMUS_IO_CHORDENTRY;
 
TDMUS_IO_NEXTCHORD = record
TDMus_IO_NextChord = packed record
dwFlags : DWORD;
nWeight : Word;
wMinBeats : Word;
wMaxBeats : Word;
wConnectionID : Word; // points to an ioChordEntry
nWeight: WORD;
wMinBeats: WORD;
wMaxBeats: WORD;
wConnectionID: WORD; (* points to an ioChordEntry *)
end;
DMUS_IO_NEXTCHORD = TDMUS_IO_NEXTCHORD;
 
TDMUS_IO_CHORDMAP_SIGNPOST = record
dwChords : DWORD; // 1bit per group
TDMus_IO_ChordMap_SignPost = packed record
dwChords: DWORD; (* 1bit per group *)
dwFlags : DWORD;
end;
DMUS_IO_CHORDMAP_SIGNPOST = TDMUS_IO_CHORDMAP_SIGNPOST;
 
// Legacy name...
DMUS_IO_PERS_SIGNPOST = TDMUS_IO_CHORDMAP_SIGNPOST;
(* Legacy name... *)
TDMus_IO_Pers_SignPost = TDMus_IO_ChordMap_SignPost;
 
(*
RIFF
(
'DMPR'
<perh-ck> // Chord map header chunk
[<guid-ck>] // guid chunk
[<vers-ck>] // version chunk (two DWORDS)
[<UNFO-list>] // Unfo chunk
<chdt-ck> // subchord database
<chpl-list> // chord palette
<cmap-list> // chord map
<spsq-list> // signpost list
)
 
<cmap-list> ::= LIST('cmap' <choe-list> )
 
<choe-list> ::= LIST('choe'
<cheh-ck> // chord entry data
<chrd-list> // chord definition
<ncsq-ck> // connecting(next) chords
)
 
<chrd-list> ::= LIST('chrd'
<INAM-ck> // name of chord in wide char format
<sbcn-ck> // list of subchords composing chord
)
 
<chpl-list> ::= LIST('chpl'
<chrd-list> ... // chord definition
)
 
<spsq-list> ::== LIST('spsq' <spst-list> ... )
 
<spst-list> ::= LIST('spst'
<spsh-ck>
<chrd-list>
[<cade-list>]
)
 
<cade-list> ::= LIST('cade' <chrd-list> ...)
 
<perh-ck> ::= perh(<DMUS_IO_CHORDMAP>)
 
<chdt-ck> ::= chdt(<cbChordSize::WORD>
<DMUS_IO_PERS_SUBCHORD> ... )
 
<cheh-ck> ::= cheh(<DMUS_IO_CHORDENTRY>)
 
<sbcn-ck> ::= sbcn(<cSubChordID:WORD> ...)
 
<ncsq-ck> ::= ncsq(<wNextChordSize:WORD>
<DMUS_IO_NEXTCHORD>...)
 
<spsh-ck> ::= spsh(<DMUS_IO_PERS_SIGNPOST>)
 
*)
 
(* Signpost tracks *)
const
// Signpost tracks
DMUS_FOURCC_SIGNPOST_TRACK_CHUNK = Ord('s') + Ord('g') shl 8 + Ord('n') shl 16 + Ord('p') shl 24;
DMUS_FOURCC_SIGNPOST_TRACK_CHUNK : mmioFOURCC = ( 's', 'g', 'n', 'p' );
 
type
TDMUS_IO_SIGNPOST = record
mtTime : MUSIC_TIME;
TDMus_IO_SignPost = packed record
mtTime: TMusic_Time;
dwChords : DWORD;
wMeasure : Word;
wMeasure: WORD;
end;
DMUS_IO_SIGNPOST = TDMUS_IO_SIGNPOST;
 
(*
 
// <sgnp-list>
'sgnp'
(
//sizeof DMUS_IO_SIGNPOST: DWORD
<DMUS_IO_SIGNPOST>...
)
 
*)
 
const
DMUS_FOURCC_MUTE_CHUNK = Ord('m') + Ord('u') shl 8 + Ord('t') shl 16 + Ord('e') shl 24;
DMUS_FOURCC_MUTE_CHUNK : mmioFOURCC = ('m','u','t','e');
 
type
TDMUS_IO_MUTE = record
mtTime : MUSIC_TIME;
TDMus_IO_Mute = packed record
mtTime: TMusic_Time;
dwPChannel : DWORD;
dwPChannelMap : DWORD;
end;
DMUS_IO_MUTE = TDMUS_IO_MUTE;
 
// Used for both style and chord map tracks
const
DMUS_FOURCC_TIME_STAMP_CHUNK = Ord('s') + Ord('t') shl 8 + Ord('m') shl 16 + Ord('p') shl 24;
(*
 
// Style tracks
DMUS_FOURCC_STYLE_TRACK_LIST = Ord('s') + Ord('t') shl 8 + Ord('t') shl 16 + Ord('r') shl 24;
DMUS_FOURCC_STYLE_REF_LIST = Ord('s') + Ord('t') shl 8 + Ord('r') shl 16 + Ord('f') shl 24;
// <mute-list>
'mute'
(
//sizeof DMUS_IO_MUTE:DWORD
<DMUS_IO_MUTE>...
)
 
// Chord map tracks
DMUS_FOURCC_PERS_TRACK_LIST = Ord('p') + Ord('f') shl 8 + Ord('t') shl 16 + Ord('r') shl 24;
DMUS_FOURCC_PERS_REF_LIST = Ord('p') + Ord('f') shl 8 + Ord('r') shl 16 + Ord('f') shl 24;
DMUS_FOURCC_TEMPO_TRACK = Ord('t') + Ord('e') shl 8 + Ord('t') shl 16 + Ord('r') shl 24;
DMUS_FOURCC_SEQ_TRACK = Ord('s') + Ord('e') shl 8 + Ord('q') shl 16 + Ord('t') shl 24;
DMUS_FOURCC_SEQ_LIST = Ord('e') + Ord('v') shl 8 + Ord('t') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_CURVE_LIST = Ord('c') + Ord('u') shl 8 + Ord('r') shl 16 + Ord('l') shl 24;
DMUS_FOURCC_SYSEX_TRACK = Ord('s') + Ord('y') shl 8 + Ord('e') shl 16 + Ord('x') shl 24;
DMUS_FOURCC_TIMESIGNATURE_TRACK = Ord('t') + Ord('i') shl 8 + Ord('m') shl 16 + Ord('s') shl 24;
 
implementation
*)
 
const
DDrawLib = 'DDraw.dll';
D3DRMLib = 'D3DRM.dll';
D3DXofLib = 'd3dxof.dll';
DInputLib = 'DInput.dll';
DPlayXLib = 'DPlayX.dll';
DSetupLib = 'DSetup.dll';
DSoundLib = 'DSound.dll';
(* Used for both style and chord map tracks *)
 
DMUS_FOURCC_TIME_STAMP_CHUNK : mmioFOURCC = ('s', 't', 'm', 'p');
 
{ DirectDraw }
(* Style tracks *)
 
DMUS_FOURCC_STYLE_TRACK_LIST : mmioFOURCC = ('s', 't', 't', 'r');
DMUS_FOURCC_STYLE_REF_LIST : mmioFOURCC = ('s', 't', 'r', 'f');
 
(*
 
// <sttr-list>
LIST('sttr'
(
// some number of <strf-list>
)
 
// <strf-list>
LIST('strf'
(
<stmp-ck>
<DMRF>
)
 
// <stmp-ck> defined in ..\dmcompos\dmcompp.h
 
*)
 
(* Chord map tracks *)
 
DMUS_FOURCC_PERS_TRACK_LIST : mmioFOURCC = ('p', 'f', 't', 'r');
DMUS_FOURCC_PERS_REF_LIST : mmioFOURCC = ('p', 'f', 'r', 'f');
 
(*
 
// <pftr-list>
LIST('pftr'
(
// some number of <pfrf-list>
)
 
// <pfrf-list>
LIST('pfrf'
(
<stmp-ck>
<DMRF>
)
 
// <stmp-ck>
'stmp'
(
// time:DWORD
)
 
 
 
*)
 
DMUS_FOURCC_TEMPO_TRACK : mmioFOURCC = ('t','e','t','r');
 
(*
// tempo list
'tetr'
(
// sizeof DMUS_IO_TEMPO_ITEM: DWORD
<DMUS_IO_TEMPO_ITEM>...
)
*)
 
DMUS_FOURCC_SEQ_TRACK : mmioFOURCC = ('s','e','q','t');
DMUS_FOURCC_SEQ_LIST : mmioFOURCC = ('e','v','t','l');
DMUS_FOURCC_CURVE_LIST : mmioFOURCC = ('c','u','r','l');
 
(*
// sequence track
'seqt'
(
// sequence list
'evtl'
(
// sizeof DMUS_IO_SEQ_ITEM: DWORD
<DMUS_IO_SEQ_ITEM>...
)
// curve list
'curl'
(
// sizeof DMUS_IO_CURVE_ITEM: DWORD
<DMUS_IO_CURVE_ITEM>...
)
)
*)
 
DMUS_FOURCC_SYSEX_TRACK : mmioFOURCC = ('s','y','e','x');
 
(*
// sysex track
'syex'
(
// list of:
// {
// <DMUS_IO_SYSEX_ITEM>
// sys-ex: data
// }...
)
*)
 
DMUS_FOURCC_TIMESIGNATURE_TRACK : mmioFOURCC = ('t','i','m','s');
 
(*
// time signature track
'tims'
(
// size of DMUS_IO_TIMESIGNATURE_ITEM : DWORD
<DMUS_IO_TIMESIGNATURE_ITEM>...
)
*)
 
(***************************************************************************
* *
* DMusBuff.h -- This module defines the buffer format for DirectMusic *
* Shared file between user mode and kernel mode components *
* *
* Copyright (c) 1998, Microsoft Corp. All rights reserved. *
* *
***************************************************************************)
 
(* The number of bytes to allocate for an event with 'cb' data bytes.
*)
function QWORD_ALIGN(x: DWORD) : DWORD;
 
function DMUS_EVENT_SIZE(cb: DWORD) : DWORD;
 
 
 
Implementation
 
//DirectDraw file
 
 
{
#define GET_WHQL_YEAR( dwWHQLLevel ) \
( (dwWHQLLevel) / 0x10000 )
#define GET_WHQL_MONTH( dwWHQLLevel ) \
( ( (dwWHQLLevel) / 0x100 ) & 0x00ff )
#define GET_WHQL_DAY( dwWHQLLevel ) \
( (dwWHQLLevel) & 0xff )
}
function GET_WHQL_YEAR(dwWHQLLevel: DWORD): DWORD;
begin
Result := dwWHQLLevel div $10000;
Result := (dwWHQLLevel) div $10000;
end;
 
function GET_WHQL_MONTH(dwWHQLLevel: DWORD): DWORD;
begin
Result := (dwWHQLLevel div $100) and $FF;
Result := ( (dwWHQLLevel) div $100 ) and $00ff;
end;
 
function GET_WHQL_DAY(dwWHQLLevel: DWORD): DWORD;
begin
Result := dwWHQLLevel and $FF;
Result := (dwWHQLLevel) and $ff;
end;
 
function DirectDrawEnumerateA; external DDrawLib;
function DirectDrawEnumerateW; external DDrawLib;
function DirectDrawEnumerate; external DDrawLib name 'DirectDrawEnumerateA';
 
function DirectDrawEnumerateExA; external DDrawLib;
function DirectDrawEnumerateExW; external DDrawLib;
function DirectDrawEnumerateEx; external DDrawLib name 'DirectDrawEnumerateExA';
function MAKEFOURCC(ch0, ch1, ch2, ch3: Char) : DWORD;
begin
Result := DWORD(byte(ch0) shl 0) or
DWORD(byte(ch1) shl 8) or
DWORD(byte(ch2) shl 16) or
DWORD(byte(ch3) shl 24);
end;
 
function DirectDrawCreate; external DDrawLib;
function DirectDrawCreateEx; external DDrawLib;
function DirectDrawCreateClipper; external DDrawLib;
function DDErrorString(Value: HResult) : string;
begin
case Value of
DD_OK: Result := 'The request completed successfully.';
DDERR_ALREADYINITIALIZED: Result := 'This object is already initialized.';
DDERR_BLTFASTCANTCLIP: Result := ' if a clipper object is attached to the source surface passed into a BltFast call.';
DDERR_CANNOTATTACHSURFACE: Result := 'This surface can not be attached to the requested surface.';
DDERR_CANNOTDETACHSURFACE: Result := 'This surface can not be detached from the requested surface.';
DDERR_CANTCREATEDC: Result := 'Windows can not create any more DCs.';
DDERR_CANTDUPLICATE: Result := 'Cannot duplicate primary & 3D surfaces, or surfaces that are implicitly created.';
DDERR_CLIPPERISUSINGHWND: Result := 'An attempt was made to set a cliplist for a clipper object that is already monitoring an hwnd.';
DDERR_COLORKEYNOTSET: Result := 'No src color key specified for this operation.';
DDERR_CURRENTLYNOTAVAIL: Result := 'Support is currently not available.';
DDERR_DIRECTDRAWALREADYCREATED: Result := 'A DirectDraw object representing this driver has already been created for this process.';
DDERR_EXCEPTION: Result := 'An exception was encountered while performing the requested operation.';
DDERR_EXCLUSIVEMODEALREADYSET: Result := 'An attempt was made to set the cooperative level when it was already set to exclusive.';
DDERR_GENERIC: Result := 'Generic failure.';
DDERR_HEIGHTALIGN: Result := 'Height of rectangle provided is not a multiple of reqd alignment.';
DDERR_HWNDALREADYSET: Result := 'The CooperativeLevel HWND has already been set. It can not be reset while the process has surfaces or palettes created.';
DDERR_HWNDSUBCLASSED: Result := 'HWND used by DirectDraw CooperativeLevel has been subclassed, this prevents DirectDraw from restoring state.';
DDERR_IMPLICITLYCREATED: Result := 'This surface can not be restored because it is an implicitly created surface.';
DDERR_INCOMPATIBLEPRIMARY: Result := 'Unable to match primary surface creation request with existing primary surface.';
DDERR_INVALIDCAPS: Result := 'One or more of the caps bits passed to the callback are incorrect.';
DDERR_INVALIDCLIPLIST: Result := 'DirectDraw does not support the provided cliplist.';
DDERR_INVALIDDIRECTDRAWGUID: Result := 'The GUID passed to DirectDrawCreate is not a valid DirectDraw driver identifier.';
DDERR_INVALIDMODE: Result := 'DirectDraw does not support the requested mode.';
DDERR_INVALIDOBJECT: Result := 'DirectDraw received a pointer that was an invalid DIRECTDRAW object.';
DDERR_INVALIDPARAMS: Result := 'One or more of the parameters passed to the function are incorrect.';
DDERR_INVALIDPIXELFORMAT: Result := 'The pixel format was invalid as specified.';
DDERR_INVALIDPOSITION: Result := 'Returned when the position of the overlay on the destination is no longer legal for that destination.';
DDERR_INVALIDRECT: Result := 'Rectangle provided was invalid.';
DDERR_LOCKEDSURFACES: Result := 'Operation could not be carried out because one or more surfaces are locked.';
DDERR_NO3D: Result := 'There is no 3D present.';
DDERR_NOALPHAHW: Result := 'Operation could not be carried out because there is no alpha accleration hardware present or available.';
DDERR_NOBLTHW: Result := 'No blitter hardware present.';
DDERR_NOCLIPLIST: Result := 'No cliplist available.';
DDERR_NOCLIPPERATTACHED: Result := 'No clipper object attached to surface object.';
DDERR_NOCOLORCONVHW: Result := 'Operation could not be carried out because there is no color conversion hardware present or available.';
DDERR_NOCOLORKEY: Result := 'Surface does not currently have a color key';
DDERR_NOCOLORKEYHW: Result := 'Operation could not be carried out because there is no hardware support of the destination color key.';
DDERR_NOCOOPERATIVELEVELSET: Result := 'Create function called without DirectDraw object method SetCooperativeLevel being called.';
DDERR_NODC: Result := 'No DC was ever created for this surface.';
DDERR_NODDROPSHW: Result := 'No DirectDraw ROP hardware.';
DDERR_NODIRECTDRAWHW: Result := 'A hardware-only DirectDraw object creation was attempted but the driver did not support any hardware.';
DDERR_NOEMULATION: Result := 'Software emulation not available.';
DDERR_NOEXCLUSIVEMODE: Result := 'Operation requires the application to have exclusive mode but the application does not have exclusive mode.';
DDERR_NOFLIPHW: Result := 'Flipping visible surfaces is not supported.';
DDERR_NOGDI: Result := 'There is no GDI present.';
DDERR_NOHWND: Result := 'Clipper notification requires an HWND or no HWND has previously been set as the CooperativeLevel HWND.';
DDERR_NOMIRRORHW: Result := 'Operation could not be carried out because there is no hardware present or available.';
DDERR_NOOVERLAYDEST: Result := 'Returned when GetOverlayPosition is called on an overlay that UpdateOverlay has never been called on to establish a destination.';
DDERR_NOOVERLAYHW: Result := 'Operation could not be carried out because there is no overlay hardware present or available.';
DDERR_NOPALETTEATTACHED: Result := 'No palette object attached to this surface.';
DDERR_NOPALETTEHW: Result := 'No hardware support for 16 or 256 color palettes.';
DDERR_NORASTEROPHW: Result := 'Operation could not be carried out because there is no appropriate raster op hardware present or available.';
DDERR_NOROTATIONHW: Result := 'Operation could not be carried out because there is no rotation hardware present or available.';
DDERR_NOSTRETCHHW: Result := 'Operation could not be carried out because there is no hardware support for stretching.';
DDERR_NOT4BITCOLOR: Result := 'DirectDrawSurface is not in 4 bit color palette and the requested operation requires 4 bit color palette.';
DDERR_NOT4BITCOLORINDEX: Result := 'DirectDrawSurface is not in 4 bit color index palette and the requested operation requires 4 bit color index palette.';
DDERR_NOT8BITCOLOR: Result := 'DirectDrawSurface is not in 8 bit color mode and the requested operation requires 8 bit color.';
DDERR_NOTAOVERLAYSURFACE: Result := 'Returned when an overlay member is called for a non-overlay surface.';
DDERR_NOTEXTUREHW: Result := 'Operation could not be carried out because there is no texture mapping hardware present or available.';
DDERR_NOTFLIPPABLE: Result := 'An attempt has been made to flip a surface that is not flippable.';
DDERR_NOTFOUND: Result := 'Requested item was not found.';
DDERR_NOTLOCKED: Result := 'Surface was not locked. An attempt to unlock a surface that was not locked at all, or by this process, has been attempted.';
DDERR_NOTPALETTIZED: Result := 'The surface being used is not a palette-based surface.';
DDERR_NOVSYNCHW: Result := 'Operation could not be carried out because there is no hardware support for vertical blank synchronized operations.';
DDERR_NOZBUFFERHW: Result := 'Operation could not be carried out because there is no hardware support for zbuffer blitting.';
DDERR_NOZOVERLAYHW: Result := 'Overlay surfaces could not be z layered based on their BltOrder because the hardware does not support z layering of overlays.';
DDERR_OUTOFCAPS: Result := 'The hardware needed for the requested operation has already been allocated.';
DDERR_OUTOFMEMORY: Result := 'DirectDraw does not have enough memory to perform the operation.';
DDERR_OUTOFVIDEOMEMORY: Result := 'DirectDraw does not have enough memory to perform the operation.';
DDERR_OVERLAYCANTCLIP: Result := 'The hardware does not support clipped overlays.';
DDERR_OVERLAYCOLORKEYONLYONEACTIVE: Result := 'Can only have ony color key active at one time for overlays.';
DDERR_OVERLAYNOTVISIBLE: Result := 'Returned when GetOverlayPosition is called on a hidden overlay.';
DDERR_PALETTEBUSY: Result := 'Access to this palette is being refused because the palette is already locked by another thread.';
DDERR_PRIMARYSURFACEALREADYEXISTS: Result := 'This process already has created a primary surface.';
DDERR_REGIONTOOSMALL: Result := 'Region passed to Clipper::GetClipList is too small.';
DDERR_SURFACEALREADYATTACHED: Result := 'This surface is already attached to the surface it is being attached to.';
DDERR_SURFACEALREADYDEPENDENT: Result := 'This surface is already a dependency of the surface it is being made a dependency of.';
DDERR_SURFACEBUSY: Result := 'Access to this surface is being refused because the surface is already locked by another thread.';
DDERR_SURFACEISOBSCURED: Result := 'Access to surface refused because the surface is obscured.';
DDERR_SURFACELOST: Result := 'Access to this surface is being refused because the surface memory is gone. The DirectDrawSurface object representing this surface should have Restore called on it.';
DDERR_SURFACENOTATTACHED: Result := 'The requested surface is not attached.';
DDERR_TOOBIGHEIGHT: Result := 'Height requested by DirectDraw is too large.';
DDERR_TOOBIGSIZE: Result := 'Size requested by DirectDraw is too large, but the individual height and width are OK.';
DDERR_TOOBIGWIDTH: Result := 'Width requested by DirectDraw is too large.';
DDERR_UNSUPPORTED: Result := 'Action not supported.';
DDERR_UNSUPPORTEDFORMAT: Result := 'FOURCC format requested is unsupported by DirectDraw.';
DDERR_UNSUPPORTEDMASK: Result := 'Bitmask in the pixel format requested is unsupported by DirectDraw.';
DDERR_VERTICALBLANKINPROGRESS: Result := 'Vertical blank is in progress.';
DDERR_WASSTILLDRAWING: Result := 'Informs DirectDraw that the previous Blt which is transfering information to or from this Surface is incomplete.';
DDERR_WRONGMODE: Result := 'This surface can not be restored because it was created in a different mode.';
DDERR_XALIGN: Result := 'Rectangle provided was not horizontally aligned on required boundary.';
// new:
DDERR_OVERLAPPINGRECTS: Result := 'Operation could not be carried out because the source and destination rectangles are on the same surface and overlap each other.';
DDERR_INVALIDSTREAM: Result := 'The specified stream contains invalid data';
DDERR_UNSUPPORTEDMODE: Result := 'The display is currently in an unsupported mode';
DDERR_NOMIPMAPHW: Result := 'Operation could not be carried out because there is no mip-map texture mapping hardware present or available.';
DDERR_INVALIDSURFACETYPE: Result := 'The requested action could not be performed because the surface was of the wrong type.';
DDERR_NOOPTIMIZEHW: Result := 'Device does not support optimized surfaces, therefore no video memory optimized surfaces';
DDERR_NOTLOADED: Result := 'Surface is an optimized surface, but has not yet been allocated any memory';
DDERR_NOFOCUSWINDOW: Result := 'Attempt was made to create or set a device window without first setting the focus window';
DDERR_DCALREADYCREATED: Result := 'A DC has already been returned for this surface. Only one DC can be retrieved per surface.';
DDERR_NONONLOCALVIDMEM: Result := 'An attempt was made to allocate non-local video memory from a device that does not support non-local video memory.';
DDERR_CANTPAGELOCK: Result := 'The attempt to page lock a surface failed.';
DDERR_CANTPAGEUNLOCK: Result := 'The attempt to page unlock a surface failed.';
DDERR_NOTPAGELOCKED: Result := 'An attempt was made to page unlock a surface with no outstanding page locks.';
DDERR_MOREDATA: Result := 'There is more data available than the specified buffer size could hold';
DDERR_EXPIRED: Result := 'The data has expired and is therefore no longer valid.';
DDERR_VIDEONOTACTIVE: Result := 'The video port is not active';
DDERR_DEVICEDOESNTOWNSURFACE: Result := 'Surfaces created by one direct draw device cannot be used directly by another direct draw device.';
DDERR_NOTINITIALIZED: Result := 'An attempt was made to invoke an interface member of a DirectDraw object created by CoCreateInstance() before it was initialized.';
else Result := 'Unrecognized Error';
end;
end;
 
{ Direct3D }
//Direct3D file
 
function D3DVALP(val: TD3DValue; prec: Integer): TD3DValue;
function DXFileErrorString(Value: HResult) : string;
begin
Result := val;
case Value of
DXFILE_OK: Result := 'Command completed successfully. Equivalent to DD_OK.';
DXFILEERR_BADVALUE: Result := 'Parameter is invalid.';
DXFILEERR_BADTYPE: Result := 'Object type is invalid.';
DXFILEERR_BADALLOC: Result := 'Memory allocation failed.';
DXFILEERR_NOTFOUND: Result := 'Object could not be found.';
DXFILEERR_FILENOTFOUND: Result := 'File could not be found.';
DXFILEERR_RESOURCENOTFOUND: Result := 'Resource could not be found.';
DXFILEERR_URLNOTFOUND: Result := 'URL could not be found.';
DXFILEERR_BADRESOURCE: Result := 'Resource is invalid.';
DXFILEERR_BADFILETYPE: Result := 'File is not a DirectX file.';
DXFILEERR_BADFILEVERSION: Result := 'File version is not valid.';
DXFILEERR_BADFILEFLOATSIZE: Result := 'Floating-point size is invalid.';
DXFILEERR_BADFILE: Result := 'File is invalid.';
DXFILEERR_PARSEERROR: Result := 'File could not be parsed.';
DXFILEERR_BADARRAYSIZE: Result := 'Array size is invalid.';
DXFILEERR_BADDATAREFERENCE: Result := 'Data reference is invalid.';
DXFILEERR_NOMOREOBJECTS: Result := 'All objects have been enumerated.';
DXFILEERR_NOMOREDATA: Result := 'No further data is available.';
else Result := 'Unrecognized Error';
end;
end;
 
function D3DVAL(val: TD3DValue): TD3DValue;
function D3DFVF_TEXCOORDSIZE3(CoordIndex: DWORD) : DWORD;
begin
Result := (D3DFVF_TEXTUREFORMAT3 shl (CoordIndex*2 + 16));
end;
 
function D3DFVF_TEXCOORDSIZE2(CoordIndex: DWORD) : DWORD;
begin
Result := (D3DFVF_TEXTUREFORMAT2);
end;
 
function D3DFVF_TEXCOORDSIZE4(CoordIndex: DWORD) : DWORD;
begin
Result := (D3DFVF_TEXTUREFORMAT4 shl (CoordIndex*2 + 16));
end;
 
function D3DFVF_TEXCOORDSIZE1(CoordIndex: DWORD) : DWORD;
begin
Result := (D3DFVF_TEXTUREFORMAT1 shl (CoordIndex*2 + 16));
end;
 
 
function D3DVal(val: variant) : float;
begin
Result := val;
end;
 
function D3DDivide(a, b: TD3DValue): TD3DValue;
function D3DDivide(a,b: double) : float;
begin
Result := a / b;
end;
 
function D3DMultiply(a, b: TD3DValue): TD3DValue;
function D3DMultiply(a,b: double) : float;
begin
Result := a * b;
end;
 
function CI_GETALPHA(ci: Integer): Byte;
// #define CI_GETALPHA(ci) ((ci) >> 24)
function CI_GETALPHA(ci: DWORD) : DWORD;
begin
Result := ci shr 24;
end;
 
function CI_GETINDEX(ci: Integer): Word;
// #define CI_GETINDEX(ci) (((ci) >> 8) & 0xffff)
function CI_GETINDEX(ci: DWORD) : DWORD;
begin
Result := ci shr 8;
Result := (ci shr 8) and $ffff;
end;
 
function CI_GETFRACTION(ci: Integer): Byte;
// #define CI_GETFRACTION(ci) ((ci) & 0xff)
function CI_GETFRACTION(ci: DWORD) : DWORD;
begin
Result := ci;
Result := ci and $ff;
end;
 
function CI_ROUNDINDEX(ci: Integer): Integer;
// #define CI_ROUNDINDEX(ci) CI_GETINDEX((ci) + 0x80)
function CI_ROUNDINDEX(ci: DWORD) : DWORD;
begin
Result := CI_GETINDEX(ci)+$80;
Result := CI_GETINDEX(ci + $80);
end;
 
function CI_MASKALPHA(ci: Integer): Integer;
// #define CI_MASKALPHA(ci) ((ci) & 0xffffff)
function CI_MASKALPHA(ci: DWORD) : DWORD;
begin
Result := ci and $FFFFFF;
Result := ci and $ffffff;
end;
 
function CI_MAKE(a: Byte; i: Word; f: Byte): Integer;
// #define CI_MAKE(a, i, f) (((a) << 24) | ((i) << 8) | (f))
function CI_MAKE(a,i,f: DWORD) : DWORD;
begin
Result := (a shl 24) or (i shl 8) or f;
end;
 
function RGBA_GETALPHA(rgb: TD3DColor): Byte;
// #define RGBA_GETALPHA(rgb) ((rgb) >> 24)
function RGBA_GETALPHA(rgb: TD3DColor) : DWORD;
begin
Result := rgb shr 24;
end;
 
function RGBA_GETRED(rgb: TD3DColor): Byte;
// #define RGBA_GETRED(rgb) (((rgb) >> 16) & 0xff)
function RGBA_GETRED(rgb: TD3DColor) : DWORD;
begin
Result := rgb shr 16;
Result := (rgb shr 16) and $ff;
end;
 
function RGBA_GETGREEN(rgb: TD3DColor): Byte;
// #define RGBA_GETGREEN(rgb) (((rgb) >> 8) & 0xff)
function RGBA_GETGREEN(rgb: TD3DColor) : DWORD;
begin
Result := rgb shr 8;
Result := (rgb shr 8) and $ff;
end;
 
function RGBA_GETBLUE(rgb: TD3DColor): Byte;
// #define RGBA_GETBLUE(rgb) ((rgb) & 0xff)
function RGBA_GETBLUE(rgb: TD3DColor) : DWORD;
begin
Result := rgb;
Result := rgb and $ff;
end;
 
function RGBA_MAKE(r, g, b, a: Byte): TD3DColor;
// #define RGBA_MAKE(r, g, b, a) ((TD3DColor) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)))
function RGBA_MAKE(r, g, b, a: DWORD) : TD3DColor;
begin
Result := (a shl 24) or (r shl 16) or (g shl 8) or b;
end;
 
function D3DRGB(r, g, b: TD3DValue): TD3DColor;
// #define D3DRGB(r, g, b) \
// (0xff000000L | (((long)((r) * 255)) << 16) | (((long)((g) * 255)) << 8) | (long)((b) * 255))
function D3DRGB(r, g, b: float) : TD3DColor;
begin
Result := $FF000000 or (Trunc(r*255) shl 16) or (Trunc(g*255) shl 8) or
(Trunc(b*255));
Result := $ff000000 or (round(r * 255) shl 16)
or (round(g * 255) shl 8)
or round(b * 255);
end;
 
function D3DRGBA(r, g, b, a: TD3DValue): TD3DColor;
// #define D3DRGBA(r, g, b, a) \
// ( (((long)((a) * 255)) << 24) | (((long)((r) * 255)) << 16) \
// | (((long)((g) * 255)) << 8) | (long)((b) * 255) \
// )
function D3DRGBA(r, g, b, a: float) : TD3DColor;
begin
Result := (Trunc(a*255) shl 24) or (Trunc(r*255) shl 16) or (Trunc(g*255) shl 8) or
(Trunc(b*255));
Result := (round(a * 255) shl 24) or (round(r * 255) shl 16)
or (round(g * 255) shl 8)
or round(b * 255);
end;
 
function RGB_GETRED(rgb: TD3DColor): Byte;
// #define RGB_GETRED(rgb) (((rgb) >> 16) & 0xff)
function RGB_GETRED(rgb: TD3DColor) : DWORD;
begin
Result := rgb shr 16;
Result := (rgb shr 16) and $ff;
end;
 
function RGB_GETGREEN(rgb: TD3DColor): Byte;
// #define RGB_GETGREEN(rgb) (((rgb) >> 8) & 0xff)
function RGB_GETGREEN(rgb: TD3DColor) : DWORD;
begin
Result := rgb shr 8;
Result := (rgb shr 8) and $ff;
end;
 
function RGB_GETBLUE(rgb: TD3DColor): Byte;
// #define RGB_GETBLUE(rgb) ((rgb) & 0xff)
function RGB_GETBLUE(rgb: TD3DColor) : DWORD;
begin
Result := rgb;
Result := rgb and $ff;
end;
 
function RGBA_SETALPHA(rgba: TD3DColor; x: Byte): TD3DColor;
// #define RGBA_SETALPHA(rgba, x) (((x) << 24) | ((rgba) & 0x00ffffff))
function RGBA_SETALPHA(rgba: TD3DColor; x: DWORD) : TD3DColor;
begin
Result := (x shl 24) or (rgba and $00FFFFFF);
Result := (x shl 24) or (rgba and $00ffffff);
end;
 
function RGB_MAKE(r, g, b: Byte): TD3DColor;
// #define RGB_MAKE(r, g, b) ((TD3DColor) (((r) << 16) | ((g) << 8) | (b)))
function RGB_MAKE(r, g, b: DWORD) : TD3DColor;
begin
Result := (r shl 16) or (g shl 8) or b;
end;
 
// #define RGBA_TORGB(rgba) ((TD3DColor) ((rgba) & 0xffffff))
function RGBA_TORGB(rgba: TD3DColor): TD3DColor;
begin
Result := rgba and $00FFFFFF;
Result := rgba and $00ffffff;
end;
 
// #define RGB_TORGBA(rgb) ((TD3DColor) ((rgb) | 0xff000000))
function RGB_TORGBA(rgb: TD3DColor): TD3DColor;
begin
Result := rgb or $FF000000;
Result := rgb or $ff000000;
end;
 
function VectorAdd(v1, v2: TD3DVector) : TD3DVector;
 
function D3DSTATE_OVERRIDE(StateType: DWORD) : DWORD;
begin
Result := StateType + D3DSTATE_OVERRIDE_BIAS;
end;
 
function D3DTRIFLAG_STARTFLAT(len: DWORD) : DWORD;
begin
if not (len in [1..29]) then len := 0;
result := len;
end;
 
// #define D3DRENDERSTATE_STIPPLEPATTERN(y) (D3DRENDERSTATE_STIPPLEPATTERN00 + (y))
function D3DRENDERSTATE_STIPPLEPATTERN(y: integer) : TD3DRenderStateType;
begin
Result := TD3DRenderStateType(Ord(D3DRENDERSTATE_STIPPLEPATTERN00) + y);
end;
 
 
 
 
// Addition and subtraction
function VectorAdd(const v1, v2: TD3DVector) : TD3DVector;
begin
result.x := v1.x+v2.x;
result.y := v1.y+v2.y;
result.z := v1.z+v2.z;
end;
 
function VectorSub(v1, v2: TD3DVector) : TD3DVector;
function VectorSub(const v1, v2: TD3DVector) : TD3DVector;
begin
result.x := v1.x-v2.x;
result.y := v1.y-v2.y;
15645,7 → 22154,8
result.z := v1.z-v2.z;
end;
 
function VectorMulS(v: TD3DVector; s: TD3DValue) : TD3DVector;
// Scalar multiplication and division
function VectorMulS(const v: TD3DVector; s: TD3DValue) : TD3DVector;
begin
result.x := v.x*s;
result.y := v.y*s;
15652,7 → 22162,7
result.z := v.z*s;
end;
 
function VectorDivS(v: TD3DVector; s: TD3DValue) : TD3DVector;
function VectorDivS(const v: TD3DVector; s: TD3DValue) : TD3DVector;
begin
result.x := v.x/s;
result.y := v.y/s;
15659,7 → 22169,8
result.z := v.z/s;
end;
 
function VectorMul(v1, v2: TD3DVector) : TD3DVector;
// Memberwise multiplication and division
function VectorMul(const v1, v2: TD3DVector) : TD3DVector;
begin
result.x := v1.x*v2.x;
result.y := v1.y*v2.y;
15666,7 → 22177,7
result.z := v1.z*v2.z;
end;
 
function VectorDiv(v1, v2: TD3DVector) : TD3DVector;
function VectorDiv(const v1, v2: TD3DVector) : TD3DVector;
begin
result.x := v1.x/v2.x;
result.y := v1.y/v2.y;
15673,6 → 22184,7
result.z := v1.z/v2.z;
end;
 
// Vector dominance
function VectorSmaller(v1, v2: TD3DVector) : boolean;
begin
result := (v1.x < v2.x) and (v1.y < v2.y) and (v1.z < v2.z);
15683,11 → 22195,13
result := (v1.x <= v2.x) and (v1.y <= v2.y) and (v1.z <= v2.z);
end;
 
// Bitwise equality
function VectorEquel(v1, v2: TD3DVector) : boolean;
begin
result := (v1.x = v2.x) and (v1.y = v2.y) and (v1.z = v2.z);
end;
 
// Length-related functions
function VectorSquareMagnitude(v: TD3DVector) : TD3DValue;
begin
result := (v.x*v.x) + (v.y*v.y) + (v.z*v.z);
15698,11 → 22212,13
result := sqrt( (v.x*v.x) + (v.y*v.y) + (v.z*v.z) );
end;
 
function VectorNormalize(v: TD3DVector) : TD3DVector;
// Returns vector with same direction and unit length
function VectorNormalize(const v: TD3DVector) : TD3DVector;
begin
result := VectorDivS(v,VectorMagnitude(v));
end;
 
// Return min/max component of the input vector
function VectorMin(v: TD3DVector) : TD3DValue;
var
ret : TD3DValue;
15723,7 → 22239,8
result := ret;
end;
 
function VectorMinimize(v1, v2: TD3DVector) : TD3DVector;
// Return memberwise min/max of input vectors
function VectorMinimize(const v1, v2: TD3DVector) : TD3DVector;
begin
if v1.x < v2.x then result.x := v1.x else result.x := v2.x;
if v1.y < v2.y then result.y := v1.y else result.y := v2.y;
15730,7 → 22247,7
if v1.z < v2.z then result.z := v1.z else result.z := v2.z;
end;
 
function VectorMaximize(v1, v2: TD3DVector) : TD3DVector;
function VectorMaximize(const v1, v2: TD3DVector) : TD3DVector;
begin
if v1.x > v2.x then result.x := v1.x else result.x := v2.x;
if v1.y > v2.y then result.y := v1.y else result.y := v2.y;
15737,12 → 22254,13
if v1.z > v2.z then result.z := v1.z else result.z := v2.z;
end;
 
// Dot and cross product
function VectorDotProduct(v1, v2: TD3DVector) : TD3DValue;
begin
result := (v1.x*v2.x) + (v1.y * v2.y) + (v1.z*v2.z);
end;
 
function VectorCrossProduct(v1, v2: TD3DVector) : TD3DVector;
function VectorCrossProduct(const v1, v2: TD3DVector) : TD3DVector;
begin
result.x := (v1.y*v2.z) - (v1.z*v2.y);
result.y := (v1.z*v2.x) - (v1.x*v2.z);
15749,245 → 22267,813
result.z := (v1.x*v2.y) - (v1.y*v2.x);
end;
 
function D3DSTATE_OVERRIDE(typ: DWORD): DWORD;
procedure DisableFPUExceptions;
var
FPUControlWord: WORD;
asm
FSTCW FPUControlWord;
OR FPUControlWord, $4 + $1; { Divide by zero + invalid operation }
FLDCW FPUControlWord;
end;
 
procedure EnableFPUExceptions;
var
FPUControlWord: WORD;
asm
FSTCW FPUControlWord;
AND FPUControlWord, $FFFF - $4 - $1; { Divide by zero + invalid operation }
FLDCW FPUControlWord;
end;
 
function D3DErrorString(Value: HResult) : string; //Full description not available yet
begin
Result := typ + D3DSTATE_OVERRIDE_BIAS;
case Value of
D3D_OK: Result := 'No error';
 
D3DERR_BADMAJORVERSION: Result := 'D3DERR_BADMAJORVERSION';
D3DERR_BADMINORVERSION: Result := 'D3DERR_BADMINORVERSION';
 
D3DERR_INVALID_DEVICE: Result := 'D3DERR_INITFAILED';
D3DERR_INITFAILED: Result := 'D3DERR_INITFAILED';
 
D3DERR_DEVICEAGGREGATED: Result := 'D3DERR_DEVICEAGGREGATED';
 
D3DERR_EXECUTE_CREATE_FAILED: Result := 'D3DERR_EXECUTE_CREATE_FAILED';
D3DERR_EXECUTE_DESTROY_FAILED: Result := 'D3DERR_EXECUTE_DESTROY_FAILED';
D3DERR_EXECUTE_LOCK_FAILED: Result := 'D3DERR_EXECUTE_LOCK_FAILED';
D3DERR_EXECUTE_UNLOCK_FAILED: Result := 'D3DERR_EXECUTE_UNLOCK_FAILED';
D3DERR_EXECUTE_LOCKED: Result := 'D3DERR_EXECUTE_LOCKED';
D3DERR_EXECUTE_NOT_LOCKED: Result := 'D3DERR_EXECUTE_NOT_LOCKED';
 
D3DERR_EXECUTE_FAILED: Result := 'D3DERR_EXECUTE_FAILED';
D3DERR_EXECUTE_CLIPPED_FAILED: Result := 'D3DERR_EXECUTE_CLIPPED_FAILED';
 
D3DERR_TEXTURE_NO_SUPPORT: Result := 'D3DERR_TEXTURE_NO_SUPPORT';
D3DERR_TEXTURE_CREATE_FAILED: Result := 'D3DERR_TEXTURE_CREATE_FAILED';
D3DERR_TEXTURE_DESTROY_FAILED: Result := 'D3DERR_TEXTURE_DESTROY_FAILED';
D3DERR_TEXTURE_LOCK_FAILED: Result := 'D3DERR_TEXTURE_LOCK_FAILED';
D3DERR_TEXTURE_UNLOCK_FAILED: Result := 'D3DERR_TEXTURE_UNLOCK_FAILED';
D3DERR_TEXTURE_LOAD_FAILED: Result := 'D3DERR_TEXTURE_LOAD_FAILED';
D3DERR_TEXTURE_SWAP_FAILED: Result := 'D3DERR_TEXTURE_SWAP_FAILED';
D3DERR_TEXTURE_LOCKED: Result := 'D3DERR_TEXTURELOCKED';
D3DERR_TEXTURE_NOT_LOCKED: Result := 'D3DERR_TEXTURE_NOT_LOCKED';
D3DERR_TEXTURE_GETSURF_FAILED: Result := 'D3DERR_TEXTURE_GETSURF_FAILED';
 
D3DERR_MATRIX_CREATE_FAILED: Result := 'D3DERR_MATRIX_CREATE_FAILED';
D3DERR_MATRIX_DESTROY_FAILED: Result := 'D3DERR_MATRIX_DESTROY_FAILED';
D3DERR_MATRIX_SETDATA_FAILED: Result := 'D3DERR_MATRIX_SETDATA_FAILED';
D3DERR_MATRIX_GETDATA_FAILED: Result := 'D3DERR_MATRIX_GETDATA_FAILED';
D3DERR_SETVIEWPORTDATA_FAILED: Result := 'D3DERR_SETVIEWPORTDATA_FAILED';
 
D3DERR_INVALIDCURRENTVIEWPORT: Result := 'D3DERR_INVALIDCURRENTVIEWPORT';
D3DERR_INVALIDPRIMITIVETYPE: Result := 'D3DERR_INVALIDPRIMITIVETYPE';
D3DERR_INVALIDVERTEXTYPE: Result := 'D3DERR_INVALIDVERTEXTYPE';
D3DERR_TEXTURE_BADSIZE: Result := 'D3DERR_TEXTURE_BADSIZE';
D3DERR_INVALIDRAMPTEXTURE: Result := 'D3DERR_INVALIDRAMPTEXTURE';
 
D3DERR_MATERIAL_CREATE_FAILED: Result := 'D3DERR_MATERIAL_CREATE_FAILED';
D3DERR_MATERIAL_DESTROY_FAILED: Result := 'D3DERR_MATERIAL_DESTROY_FAILED';
D3DERR_MATERIAL_SETDATA_FAILED: Result := 'D3DERR_MATERIAL_SETDATA_FAILED';
D3DERR_MATERIAL_GETDATA_FAILED: Result := 'D3DERR_MATERIAL_GETDATA_FAILED';
 
D3DERR_INVALIDPALETTE: Result := 'D3DERR_INVALIDPALETTE';
 
D3DERR_ZBUFF_NEEDS_SYSTEMMEMORY: Result := 'D3DERR_ZBUFF_NEEDS_SYSTEMMEMORY';
D3DERR_ZBUFF_NEEDS_VIDEOMEMORY: Result := 'D3DERR_ZBUFF_NEEDS_VIDEOMEMORY';
D3DERR_SURFACENOTINVIDMEM: Result := 'D3DERR_SURFACENOTINVIDMEM';
 
D3DERR_LIGHT_SET_FAILED: Result := 'D3DERR_LIGHT_SET_FAILED';
D3DERR_LIGHTHASVIEWPORT: Result := 'D3DERR_LIGHTHASVIEWPORT';
D3DERR_LIGHTNOTINTHISVIEWPORT: Result := 'D3DERR_LIGHTNOTINTHISVIEWPORT';
 
D3DERR_SCENE_IN_SCENE: Result := 'D3DERR_SCENE_IN_SCENE';
D3DERR_SCENE_NOT_IN_SCENE: Result := 'D3DERR_SCENE_NOT_IN_SCENE';
D3DERR_SCENE_BEGIN_FAILED: Result := 'D3DERR_SCENE_BEGIN_FAILED';
D3DERR_SCENE_END_FAILED: Result := 'D3DERR_SCENE_END_FAILED';
 
D3DERR_INBEGIN: Result := 'D3DERR_INBEGIN';
D3DERR_NOTINBEGIN: Result := 'D3DERR_NOTINBEGIN';
D3DERR_NOVIEWPORTS: Result := 'D3DERR_NOVIEWPORTS';
D3DERR_VIEWPORTDATANOTSET: Result := 'D3DERR_VIEWPORTDATANOTSET';
D3DERR_VIEWPORTHASNODEVICE: Result := 'D3DERR_VIEWPORTHASNODEVICE';
D3DERR_NOCURRENTVIEWPORT: Result := 'D3DERR_NOCURRENTVIEWPORT';
 
D3DERR_INVALIDVERTEXFORMAT: Result := 'D3DERR_INVALIDVERTEXFORMAT';
 
D3DERR_COLORKEYATTACHED: Result := 'D3DERR_COLORKEYATTACHED';
 
D3DERR_VERTEXBUFFEROPTIMIZED: Result := 'D3DERR_VERTEXBUFFEROPTIMIZED';
D3DERR_VBUF_CREATE_FAILED: Result := 'D3DERR_VBUF_CREATE_FAILED';
D3DERR_VERTEXBUFFERLOCKED: Result := 'D3DERR_VERTEXBUFFERLOCKED';
 
D3DERR_ZBUFFER_NOTPRESENT: Result := 'D3DERR_ZBUFFER_NOTPRESENT';
D3DERR_STENCILBUFFER_NOTPRESENT: Result := 'D3DERR_STENCILBUFFER_NOTPRESENT';
 
D3DERR_WRONGTEXTUREFORMAT: Result := 'D3DERR_WRONGTEXTUREFORMAT';
D3DERR_UNSUPPORTEDCOLOROPERATION: Result := 'D3DERR_UNSUPPORTEDCOLOROPERATION';
D3DERR_UNSUPPORTEDCOLORARG: Result := 'D3DERR_UNSUPPORTEDCOLORARG';
D3DERR_UNSUPPORTEDALPHAOPERATION: Result := 'D3DERR_UNSUPPORTEDALPHAOPERATION';
D3DERR_UNSUPPORTEDALPHAARG: Result := 'D3DERR_UNSUPPORTEDALPHAARG';
D3DERR_TOOMANYOPERATIONS: Result := 'D3DERR_TOOMANYOPERATIONS';
D3DERR_CONFLICTINGTEXTUREFILTER: Result := 'D3DERR_CONFLICTINGTEXTUREFILTER';
D3DERR_UNSUPPORTEDFACTORVALUE: Result := 'D3DERR_UNSUPPORTEDFACTORVALUE';
 
D3DERR_CONFLICTINGRENDERSTATE: Result := 'D3DERR_CONFLICTINGRENDERSTATE';
D3DERR_UNSUPPORTEDTEXTUREFILTER: Result := 'D3DERR_UNSUPPORTEDTEXTUREFILTER';
D3DERR_TOOMANYPRIMITIVES: Result := 'D3DERR_TOOMANYPRIMITIVES';
D3DERR_INVALIDMATRIX: Result := 'D3DERR_INVALIDMATRIX';
D3DERR_TOOMANYVERTICES: Result := 'D3DERR_TOOMANYVERTICES';
D3DERR_CONFLICTINGTEXTUREPALETTE: Result := 'D3DERR_CONFLICTINGTEXTUREPALETTE';
 
else Result := 'Unrecognized Error';
end;
end;
{$IFDEF D3DRM}
//Direct3DRM file
 
function D3DRENDERSTATE_STIPPLEPATTERN(y: DWORD): TD3DRenderStateType;
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3drmdef.h
* Content: Direct3DRM include file
*
***************************************************************************)
 
procedure D3DRMAnimationGetRotateKey
(var rmKey: TD3DRMAnimationKey; var rmQuat: TD3DRMQuaternion);
begin
Result := TD3DRenderStateType(Ord(D3DRENDERSTATE_STIPPLEPATTERN00)+y);
rmQuat := rmKey.dqRotateKey;
end;
 
function D3DTRIFLAG_STARTFLAT(len: DWORD) : DWORD;
procedure D3DRMAnimationGetScaleKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
begin
if not (len in [1..29]) then len := 0;
result := len;
dvVec := rmKey.dvScaleKey;
end;
 
function D3DFVF_TEXCOORDSIZE3(CoordIndex: DWORD): DWORD;
procedure D3DRMAnimationGetPositionKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
begin
Result := D3DFVF_TEXTUREFORMAT3 shl (CoordIndex*2 + 16);
dvVec := rmKey.dvPositionKey;
end;
 
function D3DFVF_TEXCOORDSIZE2(CoordIndex: DWORD): DWORD;
procedure D3DRMAnimatioSetRotateKey
(var rmKey: TD3DRMAnimationKey; var rmQuat: TD3DRMQuaternion);
begin
Result := D3DFVF_TEXTUREFORMAT2;
rmKey.dqRotateKey := rmQuat;
end;
 
function D3DFVF_TEXCOORDSIZE4(CoordIndex: DWORD): DWORD;
procedure D3DRMAnimationSetScaleKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
begin
Result := D3DFVF_TEXTUREFORMAT4 shl (CoordIndex*2 + 16);
rmKey.dvScaleKey := dvVec;
end;
 
function D3DFVF_TEXCOORDSIZE1(CoordIndex: DWORD): DWORD;
procedure D3DRMAnimationSetPositionKey
(var rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
begin
Result := D3DFVF_TEXTUREFORMAT1 shl (CoordIndex*2 + 16);
rmKey.dvPositionKey := dvVec;
end;
 
{ Direct3DRM }
(*==========================================================================;
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: d3drm.h
* Content: Direct3DRM include file
*
***************************************************************************)
 
procedure D3DRMAnimationGetRotateKey(const rmKey: TD3DRMAnimationKey; var rmQuat: TD3DRMQuaternion);
function D3DRMErrorString(Value: HResult) : string;
begin
rmQuat.s := rmKey.dvK[0];
rmQuat.v.x := rmKey.dvK[1];
rmQuat.v.y := rmKey.dvK[2];
rmQuat.v.z := rmKey.dvK[3];
case Value of
D3DRM_OK: Result := 'No error. Equivalent to DD_OK.';
D3DRMERR_BADALLOC: Result := 'Out of memory.';
D3DRMERR_BADDEVICE: Result := 'Device is not compatible with renderer.';
D3DRMERR_BADFILE: Result := 'Data file is corrupt.';
D3DRMERR_BADMAJORVERSION: Result := 'Bad DLL major version.';
D3DRMERR_BADMINORVERSION: Result := 'Bad DLL minor version.';
D3DRMERR_BADOBJECT: Result := 'Object expected in argument.';
D3DRMERR_BADPMDATA: Result := 'The data in the .x file is corrupted. The conversion to a progressive mesh succeeded but produced an invalid progressive mesh in the .x file.';
D3DRMERR_BADTYPE: Result := 'Bad argument type passed.';
D3DRMERR_BADVALUE: Result := 'Bad argument value passed.';
D3DRMERR_BOXNOTSET: Result := 'An attempt was made to access a bounding box (for example, with IDirect3DRMFrame3::GetBox) when no bounding box was set on the frame.';
D3DRMERR_CLIENTNOTREGISTERED: Result := 'Client has not been registered. Call IDirect3DRM3::RegisterClient.';
D3DRMERR_CONNECTIONLOST: Result := 'Data connection was lost during a load, clone, or duplicate.';
D3DRMERR_ELEMENTINUSE: Result := 'Element can´t be modified or deleted while in use. To empty a submesh, call Empty() against its parent.';
// D3DRMERR_ENTRYINUSE: Result := 'Vertex or normal entries are currently in use by a face and cannot be deleted.';
D3DRMERR_FACEUSED: Result := 'Face already used in a mesh.';
D3DRMERR_FILENOTFOUND: Result := 'File cannot be opened.';
// D3DRMERR_INCOMPATIBLEKEY: Result := 'Specified animation key is incompatible. The key cannot be modified.';
D3DRMERR_INVALIDLIBRARY: Result := 'Specified libary is invalid.';
// D3DRMERR_INVALIDOBJECT: Result := 'Method received a pointer to an object that is invalid.';
// D3DRMERR_INVALIDPARAMS: Result := 'One of the parameters passed to the method is invalid.';
D3DRMERR_LIBRARYNOTFOUND: Result := 'Specified libary not found.';
D3DRMERR_LOADABORTED: Result := 'Load aborted by user.';
D3DRMERR_NOSUCHKEY: Result := 'Specified animation key does not exist.';
D3DRMERR_NOTCREATEDFROMDDS: Result := 'Specified texture was not created from a DirectDraw Surface.';
D3DRMERR_NOTDONEYET: Result := 'Unimplemented.';
D3DRMERR_NOTENOUGHDATA: Result := 'Not enough data has been loaded to perform the requested operation.';
D3DRMERR_NOTFOUND: Result := 'Object not found in specified place.';
// D3DRMERR_OUTOFRANGE: Result := 'Specified value is out of range.';
D3DRMERR_PENDING: Result := 'Data required to supply the requested information has not finished loading.';
D3DRMERR_REQUESTTOOLARGE: Result := 'Attempt was made to set a level of detail in a progressive mesh greater than the maximum available.';
D3DRMERR_REQUESTTOOSMALL: Result := 'Attempt was made to set the minimum rendering detail of a progressive mesh smaller than the detail in the base mesh (the minimum for rendering).';
D3DRMERR_TEXTUREFORMATNOTFOUND: Result := 'Texture format could not be found that meets the specified criteria and that the underlying Immediate Mode device supports.';
D3DRMERR_UNABLETOEXECUTE: Result := 'Unable to carry out procedure.';
DDERR_INVALIDOBJECT: Result := 'Received pointer that was an invalid object.';
DDERR_INVALIDPARAMS: Result := 'One or more of the parameters passed to the method are incorrect.';
DDERR_NOTFOUND: Result := 'The requested item was not found.';
DDERR_NOTINITIALIZED: Result := 'An attempt was made to call an interface method of an object created by CoCreateInstance before the object was initialized.';
DDERR_OUTOFMEMORY: Result := 'DirectDraw does not have enough memory to perform the operation.';
else Result := 'Unrecognized Error';
end;
end;
{$ENDIF}
//DirectInput file
 
procedure D3DRMAnimationGetScaleKey(const rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
 
function DIMAKEUSAGEDWORD(UsagePage, Usage: WORD) : DWORD;
begin
dvVec.x := rmKey.dvK[0];
dvVec.y := rmKey.dvK[1];
dvVec.z := rmKey.dvK[2];
Result := Usage or (UsagePage shl 16);
end;
 
procedure D3DRMAnimationGetPositionKey(const rmKey: TD3DRMAnimationKey; var dvVec: TD3DVector);
 
function DIEFT_GETTYPE(n: variant) : byte;
begin
dvVec.x := rmKey.dvK[0];
dvVec.y := rmKey.dvK[1];
dvVec.z := rmKey.dvK[2];
Result := byte(n);
end;
 
procedure D3DRMAnimationSetRotateKey(var rmKey: TD3DRMAnimationKey; const rmQuat: TD3DRMQuaternion);
function GET_DIDEVICE_TYPE(dwDevType: variant) : byte;
begin
rmKey.dvK[0] := rmQuat.s;
rmKey.dvK[1] := rmQuat.v.x;
rmKey.dvK[2] := rmQuat.v.y;
rmKey.dvK[3] := rmQuat.v.z;
Result := byte(dwDevType);
end;
 
procedure D3DRMAnimationSetScaleKey(var rmKey: TD3DRMAnimationKey; const dvVec: TD3DVector);
function GET_DIDEVICE_SUBTYPE(dwDevType: variant) : byte;
begin
rmKey.dvK[0] := dvVec.x;
rmKey.dvK[1] := dvVec.y;
rmKey.dvK[2] := dvVec.z;
Result := hi(word(dwDevType));
end;
 
procedure D3DRMAnimationSetPositionKey(var rmKey: TD3DRMAnimationKey; const dvVec: TD3DVector);
function DIDFT_MAKEINSTANCE(n: variant) : DWORD;
begin
rmKey.dvK[0] := dvVec.x;
rmKey.dvK[1] := dvVec.y;
rmKey.dvK[2] := dvVec.z;
Result := word(n) shl 8;
end;
 
function Direct3DRMCreate; external D3DRMLib;
function DIDFT_GETTYPE(n: variant) : byte;
begin
Result := byte(n);
end;
 
function D3DRMCreateColorRGB; external D3DRMLib;
function D3DRMCreateColorRGBA; external D3DRMLib;
function D3DRMColorGetRed; external D3DRMLib;
function D3DRMColorGetGreen; external D3DRMLib;
function D3DRMColorGetBlue; external D3DRMLib;
function D3DRMColorGetAlpha; external D3DRMLib;
function D3DRMVectorAdd; external D3DRMLib;
function D3DRMVectorSubtract; external D3DRMLib;
function D3DRMVectorReflect; external D3DRMLib;
function D3DRMVectorCrossProduct; external D3DRMLib;
function D3DRMVectorDotProduct; external D3DRMLib;
function D3DRMVectorNormalize; external D3DRMLib;
function D3DRMVectorModulus; external D3DRMLib;
function D3DRMVectorRotate; external D3DRMLib;
function D3DRMVectorScale; external D3DRMLib;
function D3DRMVectorRandom; external D3DRMLib;
function D3DRMQuaternionFromRotation; external D3DRMLib;
function D3DRMQuaternionMultiply; external D3DRMLib;
function D3DRMQuaternionSlerp; external D3DRMLib;
procedure D3DRMMatrixFromQuaternion; external D3DRMLib;
function D3DRMQuaternionFromMatrix; external D3DRMLib;
function DIDFT_GETINSTANCE(n: variant) : DWORD;
begin
Result := word(n) shr 8;
end;
 
function DirectXFileCreate; external D3DXofLib;
function DIDFT_ENUMCOLLECTION(n: variant) : DWORD;
begin
Result := word(n) shl 8;
end;
 
{ DirectInput }
function DIJOFS_SLIDER(n: variant) : variant;
begin
Result := n * 4 + 24;
end;
 
function GET_DIDEVICE_TYPE(dwDevType: DWORD): DWORD;
function DIJOFS_POV(n: variant) : variant;
begin
Result := LOBYTE(dwDevType);
Result := n * 4 + 32;
end;
 
function GET_DIDEVICE_SUBTYPE(dwDevType: DWORD): DWORD;
function DIJOFS_BUTTON(n: variant) : variant;
begin
Result := HIBYTE(dwDevType);
Result := 48 + n;
end;
 
function DIEFT_GETTYPE(n: DWORD): DWORD;
function DIErrorString(Value: HResult) : string;
var
sValue: array[0..255] of char;
begin
Result := LOBYTE(n);
case Value of
DI_OK: Result := 'The operation completed successfully.';
S_FALSE: Result := '"The operation had no effect." or "The device buffer overflowed and some input was lost." or "The device exists but is not currently attached." or "The change in device properties had no effect."';
// DI_BUFFEROVERFLOW: Result := 'The device buffer overflowed and some input was lost. This value is equal to the S_FALSE standard COM return value.';
DI_DOWNLOADSKIPPED: Result := 'The parameters of the effect were successfully updated, but the effect could not be downloaded because the associated device was not acquired in exclusive mode.';
DI_EFFECTRESTARTED: Result := 'The effect was stopped, the parameters were updated, and the effect was restarted.';
// DI_NOEFFECT: Result := 'The operation had no effect. This value is equal to the S_FALSE standard COM return value.';
// DI_NOTATTACHED: Result := 'The device exists but is not currently attached. This value is equal to the S_FALSE standard COM return value.';
DI_POLLEDDEVICE: Result := 'The device is a polled device. As a result, device buffering will not collect any data and event notifications will not be signaled until the IDirectInputDevice2::Poll method is called.';
// DI_PROPNOEFFECT: Result := 'The change in device properties had no effect. This value is equal to the S_FALSE standard COM return value.';
DI_TRUNCATED: Result := 'The parameters of the effect were successfully updated, but some of them were beyond the capabilities of the device and were truncated to the nearest supported value.';
DI_TRUNCATEDANDRESTARTED: Result := 'Equal to DI_EFFECTRESTARTED | DI_TRUNCATED.';
DIERR_ACQUIRED: Result := 'The operation cannot be performed while the device is acquired.';
DIERR_ALREADYINITIALIZED: Result := 'This object is already initialized';
DIERR_BADDRIVERVER: Result := 'The object could not be created due to an incompatible driver version or mismatched or incomplete driver components.';
DIERR_BETADIRECTINPUTVERSION: Result := 'The application was written for an unsupported prerelease version of DirectInput.';
DIERR_DEVICEFULL: Result := 'The device is full.';
DIERR_DEVICENOTREG: Result := 'The device or device instance is not registered with DirectInput. This value is equal to the REGDB_E_CLASSNOTREG standard COM return value.';
DIERR_EFFECTPLAYING: Result := 'The parameters were updated in memory but were not downloaded to the device because the device does not support updating an effect while it is still playing.';
DIERR_HASEFFECTS: Result := 'The device cannot be reinitialized because there are still effects attached to it.';
DIERR_GENERIC: Result := 'An undetermined error occurred inside the DirectInput subsystem. This value is equal to the E_FAIL standard COM return value.';
// DIERR_HANDLEEXISTS: Result := 'The device already has an event notification associated with it. This value is equal to the E_ACCESSDENIED standard COM return value.';
DIERR_INCOMPLETEEFFECT: Result := 'The effect could not be downloaded because essential information is missing. For example, no axes have been associated with the effect, or no type-specific information has been supplied.';
DIERR_INPUTLOST: Result := 'Access to the input device has been lost. It must be reacquired.';
DIERR_INVALIDPARAM: Result := 'An invalid parameter was passed to the returning function, or the object was not in a state that permitted the function to be called. This value is equal to the E_INVALIDARG standard COM return value.';
DIERR_MOREDATA: Result := 'Not all the requested information fitted into the buffer.';
DIERR_NOAGGREGATION: Result := 'This object does not support aggregation.';
DIERR_NOINTERFACE: Result := 'The specified interface is not supported by the object. This value is equal to the E_NOINTERFACE standard COM return value.';
DIERR_NOTACQUIRED: Result := 'The operation cannot be performed unless the device is acquired.';
DIERR_NOTBUFFERED: Result := 'The device is not buffered. Set the DIPROP_BUFFERSIZE property to enable buffering.';
DIERR_NOTDOWNLOADED: Result := 'The effect is not downloaded.';
DIERR_NOTEXCLUSIVEACQUIRED: Result := 'The operation cannot be performed unless the device is acquired in DISCL_EXCLUSIVE mode.';
DIERR_NOTFOUND: Result := 'The requested object does not exist.';
DIERR_NOTINITIALIZED: Result := 'This object has not been initialized.';
// DIERR_OBJECTNOTFOUND: Result := 'The requested object does not exist.';
DIERR_OLDDIRECTINPUTVERSION: Result := 'The application requires a newer version of DirectInput.';
DIERR_OTHERAPPHASPRIO: Result := '"The device already has an event notification associated with it." or "The specified property cannot be changed." or "Another application has a higher priority level, preventing this call from succeeding. "';
DIERR_OUTOFMEMORY: Result := 'The DirectInput subsystem could not allocate sufficient memory to complete the call. This value is equal to the E_OUTOFMEMORY standard COM return value.';
// DIERR_READONLY: Result := 'The specified property cannot be changed. This value is equal to the E_ACCESSDENIED standard COM return value.';
DIERR_UNSUPPORTED: Result := 'The function called is not supported at this time. This value is equal to the E_NOTIMPL standard COM return value.';
E_PENDING: Result := 'Data is not yet available.';
HResult($800405CC): Result := 'No more memory for effects of this kind (not documented)';
else Result := 'Unrecognized Error: $' + sValue;
end;
end;
 
function DIDFT_MAKEINSTANCE(n: WORD): DWORD;
function joyConfigChanged(dwFlags: DWORD) : MMRESULT; external 'WinMM.dll';
 
procedure Init_c_dfDIKeyboard_Objects; // XRef: Initialization
var x: Cardinal;
begin
Result := n shl 8;
for x := 0 to 255 do
with _c_dfDIKeyboard_Objects[x] do
begin
pGuid := @GUID_Key; dwOfs := x; dwFlags := 0;
dwType := $80000000 or DIDFT_BUTTON or x shl 8;
end;
end;
 
function DIDFT_GETTYPE(n: DWORD): DWORD;
procedure Init_c_dfDIJoystick2_Objects; // XRef: Initialization
var x,y, OfVal: Cardinal;
begin
Result := LOBYTE(n);
Move(_c_dfDIJoystick_Objects,_c_dfDIJoystick2_Objects,SizeOf(_c_dfDIJoystick_Objects));
// all those empty "buttons"
for x := $2C to $8B do
Move(_c_dfDIJoystick_Objects[$2B],_c_dfDIJoystick2_Objects[x],SizeOf(TDIObjectDataFormat));
for x := 0 to 2 do
begin // 3 more blocks of X axis..Sliders
Move(_c_dfDIJoystick_Objects,_c_dfDIJoystick2_Objects[$8C+8*x],8*SizeOf(TDIObjectDataFormat));
for y := 0 to 7 do _c_dfDIJoystick2_Objects[$8C+8*x+y].dwFlags := (x+1) shl 8;
end;
OfVal := _c_dfDIJoystick2_Objects[$2B].dwOfs+1;
for x := $2C to $A3 do
begin
_c_dfDIJoystick2_Objects[x].dwOfs := OfVal;
if x < $8C then Inc(OfVal) else Inc(OfVal,4);
end;
end;
 
function DIDFT_GETINSTANCE(n: DWORD): WORD;
//DirectPlay file
 
(*==========================================================================;
*
* Copyright (C) 1994-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dplay.h
* Content: DirectPlay include file
*
***************************************************************************)
 
function DPErrorString(Value: HResult) : string;
begin
Result := n shr 8;
case Value of
CLASS_E_NOAGGREGATION: Result := 'A non-NULL value was passed for the pUnkOuter parameter in DirectPlayCreate, DirectPlayLobbyCreate, or IDirectPlayLobby2::Connect.';
DPERR_ACCESSDENIED: Result := 'The session is full or an incorrect password was supplied.';
DPERR_ACTIVEPLAYERS: Result := 'The requested operation cannot be performed because there are existing active players.';
DPERR_ALREADYINITIALIZED: Result := 'This object is already initialized.';
DPERR_APPNOTSTARTED: Result := 'The application has not been started yet.';
DPERR_AUTHENTICATIONFAILED: Result := 'The password or credentials supplied could not be authenticated.';
DPERR_BUFFERTOOLARGE: Result := 'The data buffer is too large to store.';
DPERR_BUSY: Result := 'A message cannot be sent because the transmission medium is busy.';
DPERR_BUFFERTOOSMALL: Result := 'The supplied buffer is not large enough to contain the requested data.';
DPERR_CANTADDPLAYER: Result := 'The player cannot be added to the session.';
DPERR_CANTCREATEGROUP: Result := 'A new group cannot be created.';
DPERR_CANTCREATEPLAYER: Result := 'A new player cannot be created.';
DPERR_CANTCREATEPROCESS: Result := 'Cannot start the application.';
DPERR_CANTCREATESESSION: Result := 'A new session cannot be created.';
DPERR_CANTLOADCAPI: Result := 'No credentials were supplied and the CryptoAPI package (CAPI) to use for cryptography services cannot be loaded.';
DPERR_CANTLOADSECURITYPACKAGE: Result := 'The software security package cannot be loaded.';
DPERR_CANTLOADSSPI: Result := 'No credentials were supplied and the software security package (SSPI) that will prompt for credentials cannot be loaded.';
DPERR_CAPSNOTAVAILABLEYET: Result := 'The capabilities of the DirectPlay object have not been determined yet. This error will occur if the DirectPlay object is implemented on a connectivity solution that requires polling to determine available bandwidth and latency.';
DPERR_CONNECTING: Result := 'The method is in the process of connecting to the network. The application should keep calling the method until it returns DP_OK, indicating successful completion, or it returns a different error.';
DPERR_ENCRYPTIONFAILED: Result := 'The requested information could not be digitally encrypted. Encryption is used for message privacy. This error is only relevant in a secure session.';
DPERR_EXCEPTION: Result := 'An exception occurred when processing the request.';
DPERR_GENERIC: Result := 'An undefined error condition occurred.';
// DPERR_INVALIDCREDENTIALS: Result := 'The credentials supplied (as to IDirectPlay3::SecureOpen) were not valid.';
DPERR_INVALIDFLAGS: Result := 'The flags passed to this method are invalid.';
DPERR_INVALIDGROUP: Result := 'The group ID is not recognized as a valid group ID for this game session.';
DPERR_INVALIDINTERFACE: Result := 'The interface parameter is invalid.';
DPERR_INVALIDOBJECT: Result := 'The DirectPlay object pointer is invalid.';
DPERR_INVALIDPARAMS: Result := 'One or more of the parameters passed to the method are invalid.';
DPERR_INVALIDPASSWORD: Result := 'An invalid password was supplied when attempting to join a session that requires a password.';
DPERR_INVALIDPLAYER: Result := 'The player ID is not recognized as a valid player ID for this game session.';
DPERR_LOGONDENIED: Result := 'The session could not be opened because credentials are required and either no credentials were supplied or the credentials were invalid.';
DPERR_NOCAPS: Result := 'The communication link that DirectPlay is attempting to use is not capable of this function.';
DPERR_NOCONNECTION: Result := 'No communication link was established.';
DPERR_NOINTERFACE: Result := 'The interface is not supported.';
DPERR_NOMESSAGES: Result := 'There are no messages in the receive queue.';
DPERR_NONAMESERVERFOUND: Result := 'No name server (host) could be found or created. A host must exist to create a player.';
DPERR_NONEWPLAYERS: Result := 'The session is not accepting any new players.';
DPERR_NOPLAYERS: Result := 'There are no active players in the session.';
DPERR_NOSESSIONS: Result := 'There are no existing sessions for this game.';
DPERR_NOTLOBBIED: Result := 'Returned by the IDirectPlayLobby2::Connect method if the application was not started by using the IDirectPlayLobby2::RunApplication method or if there is no DPLCONNECTION structure currently initialized for this DirectPlayLobby object.';
DPERR_NOTLOGGEDIN: Result := 'An action cannot be performed because a player or client application is not logged in. Returned by the IDirectPlay3::Send method when the client application tries to send a secure message without being logged in.';
DPERR_OUTOFMEMORY: Result := 'There is insufficient memory to perform the requested operation.';
DPERR_PLAYERLOST: Result := 'A player has lost the connection to the session.';
DPERR_SENDTOOBIG: Result := 'The message being sent by the IDirectPlay3::Send method is too large.';
DPERR_SESSIONLOST: Result := 'The connection to the session has been lost.';
DPERR_SIGNFAILED: Result := 'The requested information could not be digitally signed. Digital signatures are used to establish the authenticity of messages.';
DPERR_TIMEOUT: Result := 'The operation could not be completed in the specified time.';
DPERR_UNAVAILABLE: Result := 'The requested function is not available at this time.';
DPERR_UNINITIALIZED: Result := 'The requested object has not been initialized.';
DPERR_UNKNOWNAPPLICATION: Result := 'An unknown application was specified.';
DPERR_UNSUPPORTED: Result := 'The function is not available in this implementation. Returned from IDirectPlay3::GetGroupConnectionSettings and IDirectPlay3::SetGroupConnectionSettings if they are called from a session that is not a lobby session.';
DPERR_USERCANCEL: Result := 'Can be returned in two ways. 1) The user canceled the connection process during a call to the IDirectPlay3::Open method. 2) The user clicked Cancel in one of the DirectPlay service provider dialog boxes during a call to IDirectPlay3::EnumSessions.';
else Result := 'Unrecognized Error';
end;
end;
 
function DIDFT_ENUMCOLLECTION(n: WORD): DWORD;
//DirectSetup file
 
(*==========================================================================
*
* Copyright (C) 1995-1997 Microsoft Corporation. All Rights Reserved.
*
* File: dsetup.h
* Content: DirectXSetup, error codes and flags
***************************************************************************)
 
procedure LoadDSetup;
 
function RegGetStringValue(Hive: HKEY; const KeyName, ValueName: string): string;
var EnvKey : HKEY;
Buf : array[0..255] of char;
BufSize : DWord;
RegType : DWord;
rc : DWord;
begin
Result := n shl 8;
Result := '';
BufSize := Sizeof(Buf);
ZeroMemory(@Buf, BufSize);
RegType := REG_SZ;
try
if (RegOpenKeyEx(Hive, PChar(KeyName), 0, KEY_READ, EnvKey) = ERROR_SUCCESS) then
begin
try
if (ValueName = '') then rc := RegQueryValueEx(EnvKey, nil, nil, @RegType, @Buf, @BufSize)
else rc := RegQueryValueEx(EnvKey, PChar(ValueName), nil, @RegType, @Buf, @BufSize);
if rc = ERROR_SUCCESS then Result := string(Buf);
finally
RegCloseKey(EnvKey);
end;
end;
finally
RegCloseKey(Hive);
end;
end;
 
function DIMAKEUSAGEDWORD(UsagePage, Usage: Word): DWORD;
 
function ExistFile(const FileName: string): Boolean;
var hFile: THandle;
begin
Result := MAKELONG(Usage, UsagePage);
hFile := CreateFile(PChar(FileName), 0, 0, nil, OPEN_EXISTING, 0, 0);
Result := hFile <> INVALID_HANDLE_VALUE;
if hFile = INVALID_HANDLE_VALUE then CloseHandle(hFile);
end;
 
function DirectInputCreate; external DInputLib name 'DirectInputCreateA';
function DirectInputCreateEx; external DInputLib name 'DirectInputCreateEx';
function GetDSetupDLLPath : string;
begin
Result := RegGetStringValue(HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\Uninstall\DirectXDrivers',
'UninstallString');
if Result <> '' then
Result := Copy(Result,1,Length(Result)-Length('dxsetup.exe')) + 'DSetup.dll';
end;
 
{ DirectPlay }
begin
DSetupDLL := LoadLibrary(PChar(GetDSetupDLLPath));
 
function DirectPlayEnumerateA; external DPlayXLib;
function DirectPlayEnumerateW; external DPlayXLib;
function DirectPlayEnumerate; external DPlayXLib name 'DirectPlayEnumerateA';
DirectXSetupA := GetProcAddress(DSetupDLL,'DirectXSetupA');
DirectXSetupW := GetProcAddress(DSetupDLL,'DirectXSetupW');
{$IFDEF UNICODE}
DirectXSetup := DirectXSetupW;
{$ELSE}
DirectXSetup := DirectXSetupA;
{$ENDIF}
 
function DirectPlayCreate; external DPlayXLib;
DirectXDeviceDriverSetupA :=
GetProcAddress(DSetupDLL,'DirectXDeviceDriverSetupA');
DirectXDeviceDriverSetupW :=
GetProcAddress(DSetupDLL,'DirectXDeviceDriverSetupW');
{$IFDEF UNICODE}
DirectXDeviceDriverSetup := DirectXDeviceDriverSetupW;
{$ELSE}
DirectXDeviceDriverSetup := DirectXDeviceDriverSetupA;
{$ENDIF}
 
function DirectPlayLobbyCreateW; external DPlayXLib;
function DirectPlayLobbyCreateA; external DPlayXLib;
function DirectPlayLobbyCreate; external DPlayXLib name 'DirectPlayLobbyCreateA';
DirectXRegisterApplicationA :=
GetProcAddress(DSetupDLL,'DirectXRegisterApplicationA');
DirectXRegisterApplicationW :=
GetProcAddress(DSetupDLL,'DirectXRegisterApplicationW');
{$IFDEF UNICODE}
DirectXRegisterApplication := DirectXRegisterApplicationW;
{$ELSE}
DirectXRegisterApplication := DirectXRegisterApplicationA;
{$ENDIF}
 
{ DirectSetup }
DirectXUnRegisterApplication :=
GetProcAddress(DSetupDLL,'DirectXUnRegisterApplication');
 
function DirectXSetupA; external DSetupLib;
function DirectXSetupW; external DSetupLib;
function DirectXSetup; external DSetupLib name 'DirectXSetupA';
DirectXSetupSetCallback :=
GetProcAddress(DSetupDLL,'DirectXSetupSetCallback');
 
function DirectXDeviceDriverSetupA; external DSetupLib;
function DirectXDeviceDriverSetupW; external DSetupLib;
function DirectXDeviceDriverSetup; external DSetupLib name 'DirectXDeviceDriverSetupA';
DirectXSetupGetVersion := GetProcAddress(DSetupDLL,'DirectXSetupGetVersion');
 
function DirectXRegisterApplicationA; external DSetupLib;
function DirectXRegisterApplicationW; external DSetupLib;
function DirectXRegisterApplication; external DSetupLib name 'DirectXRegisterApplicationA';
end;
 
function DirectXUnRegisterApplication; external DSetupLib;
//DirectSound file
 
function DirectXSetupSetCallback; external DSetupLib;
function MAKE_DSHRESULT(code: DWORD) : HResult;
begin
Result := HResult(1 shl 31) or HResult(_FACDS shl 16)
or HResult(code);
end;
 
function DirectXSetupGetVersion; external DSetupLib;
function DSSPEAKER_COMBINED(c, g: variant) : DWORD;
begin
Result := byte(c) or (byte(g) shl 16)
end;
 
{ DirectSound }
function DSSPEAKER_CONFIG(a: variant) : byte;
begin
Result := byte(a);
end;
 
function DSSPEAKER_COMBINED(c, g: Byte): DWORD;
function DSSPEAKER_GEOMETRY(a: variant) : byte;
begin
Result := c or (g shl 16);
Result := byte(a shr 16 and $FF);
end;
 
function DSSPEAKER_CONFIG(a: DWORD): Byte;
 
function DSErrorString(Value: HResult) : string;
begin
Result := a;
case Value of
DS_OK: Result := 'The request completed successfully.';
DSERR_ALLOCATED: Result := 'The request failed because resources, such as a priority level, were already in use by another caller.';
DSERR_ALREADYINITIALIZED: Result := 'The object is already initialized.';
DSERR_BADFORMAT: Result := 'The specified wave format is not supported.';
DSERR_BUFFERLOST: Result := 'The buffer memory has been lost and must be restored.';
DSERR_CONTROLUNAVAIL: Result := 'The control (volume, pan, and so forth) requested by the caller is not available.';
DSERR_GENERIC: Result := 'An undetermined error occurred inside the DirectSound subsystem.';
DSERR_INVALIDCALL: Result := 'This function is not valid for the current state of this object.';
DSERR_INVALIDPARAM: Result := 'An invalid parameter was passed to the returning function.';
DSERR_NOAGGREGATION: Result := 'The object does not support aggregation.';
DSERR_NODRIVER: Result := 'No sound driver is available for use.';
DSERR_NOINTERFACE: Result := 'The requested COM interface is not available.';
DSERR_OTHERAPPHASPRIO: Result := 'Another application has a higher priority level, preventing this call from succeeding.';
DSERR_OUTOFMEMORY: Result := 'The DirectSound subsystem could not allocate sufficient memory to complete the caller´s request.';
DSERR_PRIOLEVELNEEDED: Result := 'The caller does not have the priority level required for the function to succeed.';
DSERR_UNINITIALIZED: Result := 'The IDirectSound::Initialize method has not been called or has not been called successfully before other methods were called.';
DSERR_UNSUPPORTED: Result := 'The function called is not supported at this time.';
else Result := 'Unrecognized Error';
end;
end;
 
function DSSPEAKER_GEOMETRY(a: DWORD): Byte;
//DirectMusic file
 
function MAKE_HRESULT(sev,fac,code: DWORD) : HResult;
begin
Result := a shr 16;
Result := (sev shl 31) or (fac shl 16) or code;
end;
 
function DirectSoundCreate; external DSoundLib;
function DirectSoundEnumerateA; external DSoundLib;
function DirectSoundEnumerateW; external DSoundLib;
function DirectSoundEnumerate; external DSoundLib name 'DirectSoundEnumerateA';
//function MAKEFOURCC (ch0, ch1, ch2, ch3: Char) : TFourCC;
//type
// tfcc = array [0..3] of Char;
//begin
// tfcc(Result)[0] := ch0;
// tfcc(Result)[1] := ch1;
// tfcc(Result)[2] := ch2;
// tfcc(Result)[3] := ch3;
//end;
 
function DirectSoundCaptureCreate; external DSoundLib;
function DirectSoundCaptureEnumerateA; external DSoundLib;
function DirectSoundCaptureEnumerateW; external DSoundLib;
function DirectSoundCaptureEnumerate; external DSoundLib name 'DirectSoundCaptureEnumerateA';
function QWORD_ALIGN(x: DWORD) : DWORD;
begin
Result := (x + 7) and (not 7); // (((x) + 7) & ~7)
end;
 
function MAKEFOURCC(ch0, ch1, ch2, ch3: Char) : DWORD;
function DMUS_EVENT_SIZE(cb: DWORD) : DWORD;
begin
Result := Ord(ch0) + (Ord(ch1) shl 8) + (Ord(ch2) shl 16) + (Ord(ch3) shl 24);
Result := QWORD_ALIGN(SizeOf(TDMus_EventHeader) + cb); // QWORD_ALIGN(sizeof(DMUS_EVENTHEADER) + cb)
end;
 
function MAKE_DMHRESULTSUCCESS(code: Cardinal) : HResult;
function IsNTandDelphiRunning : boolean;
var
OSVersion : TOSVersionInfo;
AppName : array[0..255] of char;
begin
Result := MakeResult(0, FACILITY_DIRECTMUSIC, (DMUS_ERRBASE + (code)));
OSVersion.dwOsVersionInfoSize := sizeof(OSVersion);
GetVersionEx(OSVersion);
// Not running in NT or program is not Delphi itself ?
AppName[0] := #0;
lstrcat(AppName, PChar(ParamStr(0))); // ParamStr(0) = Application.ExeName
{$IFDEF VER12UP}
CharUpperBuff(AppName, High(AppName) + 1);
{$ELSE}
CharUpperBuff(AppName, SizeOf(AppName));
{$ENDIF}
result := ( (OSVersion.dwPlatformID = VER_PLATFORM_WIN32_NT) and
(Pos('DELPHI32.EXE', AppName) = Length(AppName) - Length('DELPHI32.EXE') + 1) );
end;
 
function MAKE_DMHRESULTERROR(code: Cardinal) : HResult;
initialization
begin
Result := MakeResult(1, FACILITY_DIRECTMUSIC, (DMUS_ERRBASE + (code)));
{DirectDraw}
 
if not IsNTandDelphiRunning then
begin
DDrawDLL := LoadLibrary('DDraw.dll');
DirectDrawEnumerateA := GetProcAddress(DDrawDLL,'DirectDrawEnumerateA');
DirectDrawEnumerateW := GetProcAddress(DDrawDLL,'DirectDrawEnumerateW');
{$IFDEF UNICODE}
DirectDrawEnumerate := DirectDrawEnumerateW;
{$ELSE}
DirectDrawEnumerate := DirectDrawEnumerateA;
{$ENDIF}
 
DirectDrawEnumerateExA := GetProcAddress(DDrawDLL,'DirectDrawEnumerateExA');
DirectDrawEnumerateExW := GetProcAddress(DDrawDLL,'DirectDrawEnumerateExW');
{$IFDEF UNICODE}
DirectDrawEnumerateEx := DirectDrawEnumerateExW;
{$ELSE}
DirectDrawEnumerateEx := DirectDrawEnumerateExA;
{$ENDIF}
 
DirectDrawCreate := GetProcAddress(DDrawDLL,'DirectDrawCreate');
DirectDrawCreateEx := GetProcAddress(DDrawDLL,'DirectDrawCreateEx');
DirectDrawCreateClipper := GetProcAddress(DDrawDLL,'DirectDrawCreateClipper');
{$IFDEF WINNT}
NtDirectDrawCreate := GetProcAddress(DDrawDLL,'NtDirectDrawCreate');
{$ENDIF}
end;
{DirectDraw}
{Direct3D}
DisableFPUExceptions;
{$IFDEF D3DRM}
if not IsNTandDelphiRunning then
begin
DXFileDLL := LoadLibrary('D3DXOF.DLL');
DirectXFileCreate := GetProcAddress(DXFileDLL,'DirectXFileCreate');
end;
{Direct3D}
{Direct3DRM}
if not IsNTandDelphiRunning then
begin
D3DRMDLL := LoadLibrary('D3DRM.dll');
//d3drmdef:
D3DRMCreateColorRGB := GetProcAddress(D3DRMDLL,'D3DRMCreateColorRGB');
D3DRMCreateColorRGBA := GetProcAddress(D3DRMDLL,'D3DRMCreateColorRGBA');
D3DRMColorGetRed := GetProcAddress(D3DRMDLL,'D3DRMColorGetRed');
D3DRMColorGetGreen := GetProcAddress(D3DRMDLL,'D3DRMColorGetGreen');
D3DRMColorGetBlue := GetProcAddress(D3DRMDLL,'D3DRMColorGetBlue');
D3DRMColorGetAlpha := GetProcAddress(D3DRMDLL,'D3DRMColorGetAlpha');
D3DRMVectorAdd := GetProcAddress(D3DRMDLL,'D3DRMVectorAdd');
D3DRMVectorSubtract := GetProcAddress(D3DRMDLL,'D3DRMVectorSubtract');
D3DRMVectorReflect := GetProcAddress(D3DRMDLL,'D3DRMVectorReflect');
D3DRMVectorCrossProduct := GetProcAddress(D3DRMDLL,'D3DRMVectorCrossProduct');
D3DRMVectorDotProduct := GetProcAddress(D3DRMDLL,'D3DRMVectorDotProduct');
D3DRMVectorNormalize := GetProcAddress(D3DRMDLL,'D3DRMVectorNormalize');
D3DRMVectorModulus := GetProcAddress(D3DRMDLL,'D3DRMVectorModulus');
D3DRMVectorRotate := GetProcAddress(D3DRMDLL,'D3DRMVectorRotate');
D3DRMVectorScale := GetProcAddress(D3DRMDLL,'D3DRMVectorScale');
D3DRMVectorRandom := GetProcAddress(D3DRMDLL,'D3DRMVectorRandom');
D3DRMQuaternionFromRotation := GetProcAddress(D3DRMDLL,'D3DRMQuaternionFromRotation');
D3DRMQuaternionMultiply := GetProcAddress(D3DRMDLL,'D3DRMQuaternionMultiply');
D3DRMQuaternionSlerp := GetProcAddress(D3DRMDLL,'D3DRMQuaternionSlerp');
D3DRMMatrixFromQuaternion := GetProcAddress(D3DRMDLL,'D3DRMMatrixFromQuaternion');
D3DRMQuaternionFromMatrix := GetProcAddress(D3DRMDLL,'D3DRMQuaternionFromMatrix');
//d3drm:
Direct3DRMCreate := GetProcAddress(D3DRMDLL,'Direct3DRMCreate');
end;
{$ENDIF}
{Direct3DRM}
{DirectInput}
Init_c_dfDIKeyboard_Objects; // set kbd GUIDs & flags
Init_c_dfDIJoystick2_Objects; // construct Joystick2 from Joystick fmt
 
// The number of bytes to allocate for an event with 'cb' data bytes.
//
function QWORD_ALIGN(x: LONGLONG): LONGLONG;
if not IsNTandDelphiRunning then
begin
Result := x + 7;
PDWORD(@Result)^ := PDWORD(@Result)^ and (not 7);
DInputDLL := LoadLibrary('DInput.dll');
 
DirectInputCreateA := GetProcAddress(DInputDLL,'DirectInputCreateA');
DirectInputCreateW := GetProcAddress(DInputDLL,'DirectInputCreateW');
// no A/W version
DirectInputCreateEx := GetProcAddress(DInputDLL,'DirectInputCreateEx');
{$IFDEF UNICODE}
DirectInputCreate := DirectInputCreateW;
{$ELSE}
DirectInputCreate := DirectInputCreateA;
{$ENDIF}
end;
{DirectInput}
{DirectPlay}
if not IsNTandDelphiRunning then
begin
DPlayDLL := LoadLibrary('DPlayX.dll');
 
function DMUS_EVENT_SIZE(cb: LONGLONG): LONGLONG;
DirectPlayEnumerateA := GetProcAddress(DPlayDLL,'DirectPlayEnumerateA');
DirectPlayEnumerateW := GetProcAddress(DPlayDLL,'DirectPlayEnumerateW');
{$IFDEF UNICODE}
DirectPlayEnumerate := DirectPlayEnumerateW;
{$ELSE}
DirectPlayEnumerate := DirectPlayEnumerateA;
{$ENDIF}
 
DirectPlayCreate := GetProcAddress(DPlayDLL,'DirectPlayCreate');
 
// File: dplay.h
 
DirectPlayLobbyCreateW := GetProcAddress(DPlayDLL,'DirectPlayLobbyCreateW');
DirectPlayLobbyCreateA := GetProcAddress(DPlayDLL,'DirectPlayLobbyCreateA');
{$IFDEF UNICODE}
DirectPlayLobbyCreate := DirectPlayLobbyCreateW;
{$ELSE}
DirectPlayLobbyCreate := DirectPlayLobbyCreateA;
{$ENDIF}
 
end;
{DirectPlay}
{DirectSetup}
if not IsNTandDelphiRunning then
begin
Result := QWORD_ALIGN(SizeOf(DMUS_EVENTHEADER) + cb);
LoadDSetup;
end;
{DirectSetup}
{DirectSound}
if not IsNTandDelphiRunning then
begin
DSoundDLL := LoadLibrary('DSound.dll');
DirectSoundCreate := GetProcAddress(DSoundDLL,'DirectSoundCreate');
 
end.
DirectSoundEnumerateW := GetProcAddress(DSoundDLL,'DirectSoundEnumerateW');
DirectSoundEnumerateA := GetProcAddress(DSoundDLL,'DirectSoundEnumerateA');
{$IFDEF UNICODE}
DirectSoundEnumerate := DirectSoundEnumerateW;
{$ELSE}
DirectSoundEnumerate := DirectSoundEnumerateA;
{$ENDIF}
 
DirectSoundCaptureCreate :=
GetProcAddress(DSoundDLL,'DirectSoundCaptureCreate');
 
DirectSoundCaptureEnumerateW :=
GetProcAddress(DSoundDLL,'DirectSoundCaptureEnumerateW');
DirectSoundCaptureEnumerateA :=
GetProcAddress(DSoundDLL,'DirectSoundCaptureEnumerateA');
{$IFDEF UNICODE}
DirectSoundCaptureEnumerate := DirectSoundCaptureEnumerateW;
{$ELSE}
DirectSoundCaptureEnumerate := DirectSoundCaptureEnumerateA;
{$ENDIF}
end;
{DirectSound}
end;
 
finalization
begin
{DirectDraw}
if DDrawDLL <> 0 then FreeLibrary(DDrawDLL);
{DirectDraw}
{Direct3D}
FreeLibrary(DXFileDLL);
{Direct3D}
{Direct3DRM}
{$IFDEF D3DRM}
if D3DRMDLL <> 0 then FreeLibrary(D3DRMDLL);
{$ENDIF}
{Direct3DRM}
{DirectInput}
FreeLibrary(DInputDLL);
{DirectInput}
{DirectPlay}
if DPlayDLL <> 0 then FreeLibrary(DPlayDLL);
{DirectPlay}
{DirectSetup}
FreeLibrary(DSetupDLL);
{DirectSetup}
{DirectSound}
FreeLibrary(DSoundDLL);
{DirectSound}
end;
 
 
End.
/VCL_DELPHIX_D6/DxPathEdit.dfm
0,0 → 1,676
object DelphiXPathsEditForm: TDelphiXPathsEditForm
Left = 292
Top = 187
Width = 610
Height = 508
Caption = 'Paths Editor'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Panel2: TPanel
Left = 0
Top = 74
Width = 602
Height = 381
Align = alClient
BevelOuter = bvNone
BorderWidth = 5
Caption = 'Panel2'
TabOrder = 0
object ScrollBox1: TScrollBox
Left = 5
Top = 5
Width = 592
Height = 371
Align = alClient
TabOrder = 0
object Pane: TPanel
Left = 0
Top = 0
Width = 640
Height = 480
BevelOuter = bvNone
Color = clBlack
TabOrder = 0
OnResize = PaneResize
object Image1: TImage
Left = 0
Top = 0
Width = 640
Height = 480
Cursor = crCross
Align = alClient
end
object Shape1: TShape
Left = 16
Top = 16
Width = 16
Height = 16
Brush.Color = clYellow
Pen.Color = clRed
OnMouseDown = ShapeMouseDown
OnMouseMove = ShapeMouseMove
OnMouseUp = ShapeMouseUp
end
end
end
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 602
Height = 74
Align = alTop
BevelOuter = bvNone
BorderStyle = bsSingle
TabOrder = 1
object Label1: TLabel
Left = 4
Top = 28
Width = 97
Height = 13
Caption = 'Active editing trace:'
FocusControl = cbListOfTraces
end
object LAmount: TLabel
Left = 124
Top = 28
Width = 41
Height = 13
Caption = 'Amount:'
FocusControl = eAmount
end
object Label2: TLabel
Left = 172
Top = 28
Width = 54
Height = 13
Caption = 'Show (ms):'
FocusControl = eShowOn
end
object Label3: TLabel
Left = 464
Top = 48
Width = 11
Height = 13
Caption = 'R:'
end
object cbListOfTraces: TComboBox
Left = 4
Top = 44
Width = 113
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 1
OnChange = cbListOfTracesChange
end
object eAmount: TEdit
Left = 124
Top = 44
Width = 41
Height = 21
TabOrder = 2
Text = '32'
end
object btnNewTrace: TButton
Left = 312
Top = 40
Width = 65
Height = 25
Caption = 'New Trace'
TabOrder = 5
OnClick = btnNewTraceClick
end
object eShowOn: TEdit
Left = 172
Top = 44
Width = 41
Height = 21
TabOrder = 3
Text = '25'
end
object Panel12: TPanel
Left = 0
Top = 0
Width = 521
Height = 28
BevelOuter = bvLowered
TabOrder = 0
object btnSetTimming: TSpeedButton
Left = 2
Top = 2
Width = 24
Height = 24
Hint = 'Blit show time refresh.'
AllowAllUp = True
GroupIndex = 2
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
80000080000000808000800000008000800080800000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777777770000077777777700FBFBF007777770BFBFBFBFB077770BFBFBFBFBF
B07770FB0BFBFBFBF0770FBFB0BFBFBFBF070BFBFB0BFBFBFB070FBFBFB00000
0F070BFBFBFBFBFBFB070FBFBFBFBFBFBF0770FBFBFBFBFBF07770BFBFBFBFBF
B077770BFBF0FBFB077777700FBFBF0077777777700000777777}
ParentShowHint = False
ShowHint = True
OnClick = btnSetTimmingClick
end
object btnLine: TSpeedButton
Left = 32
Top = 2
Width = 24
Height = 24
Hint = 'Create line.'
AllowAllUp = True
GroupIndex = 3
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00888888888888
8888888888888888888888888888888888888888888888880888888888888880
8888888888888808888888888888808888888888888808888888888888808888
8888888888088888888888888088888888888888088888888888888088888888
8888880888888888888888888888888888888888888888888888}
ParentShowHint = False
ShowHint = True
OnClick = btnLineClick
end
object btnCircle: TSpeedButton
Left = 56
Top = 2
Width = 24
Height = 24
Hint = 'Create ellipse/circle.'
AllowAllUp = True
GroupIndex = 3
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00888888888888
8888888888888888888888888888888888888888888888888888888800000088
8888880088888800888880888888888808880888888888888088088888888888
8088088888888888808880888888888808888800888888008888888800000088
8888888888888888888888888888888888888888888888888888}
ParentShowHint = False
ShowHint = True
OnClick = btnLineClick
end
object btnSelectionArea: TSpeedButton
Left = 132
Top = 2
Width = 24
Height = 24
Hint = 'Selection.'
AllowAllUp = True
GroupIndex = 4
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007770777777777077700000007778777777777877700000007080
8080808080807000000077788888888888777000000077708888888880777000
0000777888888888887770000000777088888888807770000000777888888888
8877700000007770888888888077700000007778888888888877700000007770
8888888880777000000077788888888888777000000070808080808080807000
0000777877777777787770000000777077777777707770000000777777777777
777770000000}
ParentShowHint = False
ShowHint = True
OnClick = btnSelectionAreaClick
end
object btnSelectAll: TSpeedButton
Left = 180
Top = 2
Width = 24
Height = 24
Hint = 'Select single.'
Enabled = False
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007777000777777000700000007777000444444000700000007777
0007777770007000000077777477777777477000000000077477777777477000
0000000444777777774770000000000774777777774770000000747774777777
7747700000007477000777777000700000007477000444444000700000007477
0007747770007000000074777777747777777000000000077777000777777000
0000000444440007777770000000000777770007777770000000777777777777
777770000000}
ParentShowHint = False
ShowHint = True
end
object btnGrid: TSpeedButton
Left = 156
Top = 2
Width = 24
Height = 24
Hint = 'Show/hide grid...'
AllowAllUp = True
GroupIndex = 5
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777777877877877877777787787787787777880880880880887777877877877
8777777877877877877778808808808808877778778778778777777877877877
8777788088088088088777787787787787777778778778778777788088088088
0887777877877877877777787787787787777777777777777777}
ParentShowHint = False
ShowHint = True
OnClick = btnGridClick
end
object brnSelectAsOne: TSpeedButton
Left = 204
Top = 2
Width = 24
Height = 24
Hint = 'SSelect one.'
Enabled = False
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007000777777777700000000007000774444444400000000007000
7747777777000000000077777747777777747000000077777747777777747000
0000774444477777777470000000774777477777777470000000774777477777
7774700000007747774777777774700000007747774444444444700000007747
7777774777777000000077477777774777777000000070007777774777000000
0000700044444447770000000000700077777777770000000000777777777777
777770000000}
ParentShowHint = False
ShowHint = True
end
object btnBringToFront: TSpeedButton
Left = 252
Top = 2
Width = 24
Height = 24
Hint = 'Bring to front.'
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007777777777777777700000007777770000000007700000007777
7708888888077000000077777708888888077000000070000000000088077000
000070FBFBFBFBF088077000000070BFBFBFBFB088077000000070FBFBFBFBF0
88077000000070BFBFBFBFB000077000000070FBFBFBFBF077777000000070BF
BFBFBFB077777000000070FBFBFBFBF077777000000070BFBFBFBFB077777000
0000700000000000777770000000777777777777777770000000777777777777
777770000000}
ParentShowHint = False
ShowHint = True
OnClick = btnBringToFrontClick
end
object btnMoveDown: TSpeedButton
Left = 308
Top = 2
Width = 24
Height = 24
Hint = 'Move down.'
AllowAllUp = True
Flat = True
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777777777700077777707777770007777706077777000777706660777
7000777066666077700077066666660770007000066600007000777706660777
7000777706660777700077770666077770007777000007777000777777777777
7000}
ParentShowHint = False
ShowHint = True
OnClick = btnMoveDownClick
end
object btnSendToBack: TSpeedButton
Left = 228
Top = 2
Width = 24
Height = 24
Hint = 'Send to back.'
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007777777777777777700000007777770000000007700000007777
7708888888077000000077777708888888077000000070000008888888077000
000070FBFB08888888077000000070BFBF08888888077000000070FBFB088888
88077000000070BFBF00000000077000000070FBFBFBFBF077777000000070BF
BFBFBFB077777000000070FBFBFBFBF077777000000070BFBFBFBFB077777000
0000700000000000777770000000777777777777777770000000777777777777
777770000000}
ParentShowHint = False
ShowHint = True
OnClick = btnSendToBackClick
end
object btnMoveUp: TSpeedButton
Left = 284
Top = 2
Width = 24
Height = 24
Hint = 'Move up.'
AllowAllUp = True
Flat = True
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777777777700077770000077770007777066607777000777706660777
7000777706660777700070000666000070007706666666077000777066666077
7000777706660777700077777060777770007777770777777000777777777777
7000}
ParentShowHint = False
ShowHint = True
OnClick = btnMoveUpClick
end
object btnMoveLeft: TSpeedButton
Left = 332
Top = 2
Width = 24
Height = 24
Hint = 'Move left.'
AllowAllUp = True
Flat = True
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777077777700077777007777770007777060777777000777066000007
7000770666666607700070666666660770007706666666077000777066000007
7000777706077777700077777007777770007777770777777000777777777777
7000}
ParentShowHint = False
ShowHint = True
OnClick = btnMoveLeftClick
end
object btnMoveRight: TSpeedButton
Left = 356
Top = 2
Width = 24
Height = 24
Hint = 'Move right.'
AllowAllUp = True
Flat = True
Glyph.Data = {
DE000000424DDE0000000000000076000000280000000D0000000D0000000100
0400000000006800000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7000777777077777700077777700777770007777770607777000770000066077
7000770666666607700077066666666070007706666666077000770000066077
7000777777060777700077777700777770007777770777777000777777777777
7000}
ParentShowHint = False
ShowHint = True
OnClick = btnMoveRightClick
end
object btnCurve: TSpeedButton
Left = 104
Top = 2
Width = 24
Height = 24
Hint = 'Free style.'
AllowAllUp = True
GroupIndex = 3
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
8000008000000080800080000000800080008080000080808000C0C0C0000000
FF00C0C0C00000FFFF00FF000000C0C0C000FFFF0000FFFFFF00DADADADADADA
DADAADADADADAD0DADADDADADADAD0DADADAADADADAD000DADADDADADAD0D0D0
DADAADADADA0A0A0ADADDADADAD0DA00DADAADADADAD0DADADADDADADADAD0DA
DADAADAD00ADAD0DADADDAD0DA0ADA0ADADAADA0ADA0AD0DADADDADA0ADA00DA
DADAADADA0ADADADADADDADAD0DADADADADAADADA0ADADADADAD}
ParentShowHint = False
ShowHint = True
OnClick = btnLineClick
end
object btnProperties: TSpeedButton
Left = 488
Top = 2
Width = 24
Height = 24
Hint = 'Properties...'
GroupIndex = 11
Enabled = False
Flat = True
Glyph.Data = {
F6000000424DF600000000000000760000002800000010000000100000000100
0400000000008000000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777777777777777777777B387777777777777BB387777777777777BB3877777
77777777BB387777777777777BB387777777777777BB387788777777777BB388
008777777777BB300007777777777B0008877777777770008077777777770008
0B77777777700080B77777777777777777777777777777777777}
ParentShowHint = False
ShowHint = True
end
object btnRect: TSpeedButton
Left = 80
Top = 2
Width = 24
Height = 24
Hint = 'Create rectangle.'
AllowAllUp = True
GroupIndex = 3
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
7777700000007777777777777777700000007777777777777777700000007000
0000000000007000000070777777777777707000000070777777777777707000
0000707777777777777070000000707777777777777070000000707777777777
7770700000007077777777777770700000007077777777777770700000007077
7777777777707000000070777777777777707000000070777777777777707000
0000700000000000000070000000777777777777777770000000777777777777
777770000000}
ParentShowHint = False
ShowHint = True
OnClick = btnLineClick
end
object LDist: TLabel
Left = 384
Top = 7
Width = 26
Height = 13
Hint = 'Rotation distance 1..255'
Caption = 'Dist.:'
FocusControl = eDist
ParentShowHint = False
ShowHint = True
Transparent = True
end
object btnRotateLeft: TSpeedButton
Left = 440
Top = 2
Width = 24
Height = 24
Hint = 'Rotate left'
AllowAllUp = True
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
777770000000777777555555777770000000777775FBFBFB5777700000007777
5FBFBFBFB577700000007775FBFBFBFBFB5770000000775FBFBFBFBFBF577000
0000775BFBFBFBFBFBB570000000775FBFBF00BFBFF570000000775BFBFB00FF
BFB570000000775FBFB9B9BBFBF570000000775BFB9BF9FBFB57700000007775
B91FB9BFBF577000000077779B1999FBF57770000000777975BFB9BF57777000
0000709777555955777770000000700777770977777770000000777777770077
777770000000}
ParentShowHint = False
ShowHint = True
OnClick = btnRotateLeftClick
end
object btnRotateRight: TSpeedButton
Left = 464
Top = 2
Width = 24
Height = 24
Hint = 'Rotate right'
AllowAllUp = True
Flat = True
Glyph.Data = {
42010000424D4201000000000000760000002800000011000000110000000100
040000000000CC00000000000000000000001000000010000000000000000000
BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
77777000000077777555555777777000000077775BFBFBF57777700000007775
BFBFBFBF577770000000775BFBFBFBFBF57770000000775FBFBFBFBFBF577000
000075BBFBFBFBFBFB577000000075FFBFB00FBFBF577000000075BFBFF00BFB
FB577000000075FBFBB9B9BFBF5770000000775BFBF9FB9BFB5770000000775F
BFB9BF19B577700000007775FBF9991B97777000000077775FB9BFB579777000
0000777775595557779070000000777777790777770070000000777777700777
777770000000}
ParentShowHint = False
ShowHint = True
OnClick = btnRotateRightClick
end
object eDist: TEdit
Left = 412
Top = 3
Width = 25
Height = 21
TabOrder = 0
Text = '1'
end
end
object Panel3: TPanel
Left = 518
Top = 0
Width = 80
Height = 70
Align = alRight
BevelOuter = bvNone
TabOrder = 7
object OKButton: TButton
Left = 4
Top = 8
Width = 73
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 0
OnClick = OKButtonClick
end
object CancelButton: TButton
Left = 4
Top = 39
Width = 73
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object btnRefresh: TBitBtn
Left = 232
Top = 40
Width = 75
Height = 25
Caption = 'Refresh'
TabOrder = 4
OnClick = btnRefreshClick
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000010000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333
3333333333FFFFF3333333333999993333333333F77777FFF333333999999999
3333333777333777FF33339993707399933333773337F3777FF3399933000339
9933377333777F3377F3399333707333993337733337333337FF993333333333
399377F33333F333377F993333303333399377F33337FF333373993333707333
333377F333777F333333993333101333333377F333777F3FFFFF993333000399
999377FF33777F77777F3993330003399993373FF3777F37777F399933000333
99933773FF777F3F777F339993707399999333773F373F77777F333999999999
3393333777333777337333333999993333333333377777333333}
NumGlyphs = 2
end
object Button1: TBitBtn
Left = 384
Top = 40
Width = 74
Height = 25
Caption = 'Reset Sel.'
TabOrder = 6
OnClick = Button1Click
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000010000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00500005000555
555557777F777555F55500000000555055557777777755F75555005500055055
555577F5777F57555555005550055555555577FF577F5FF55555500550050055
5555577FF77577FF555555005050110555555577F757777FF555555505099910
555555FF75777777FF555005550999910555577F5F77777775F5500505509990
3055577F75F77777575F55005055090B030555775755777575755555555550B0
B03055555F555757575755550555550B0B335555755555757555555555555550
BBB35555F55555575F555550555555550BBB55575555555575F5555555555555
50BB555555555555575F555555555555550B5555555555555575}
NumGlyphs = 2
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 455
Width = 602
Height = 19
Panels = <
item
Width = 50
end
item
Width = 100
end
item
Width = 50
end>
SimplePanel = False
end
object PopupMenu1: TPopupMenu
Left = 216
Top = 64
object Activate1: TMenuItem
Caption = 'Activate'
end
end
end
/VCL_DELPHIX_D6/DxPathEdit.pas
0,0 → 1,1157
unit DXPathEdit;
//(c)2007 Jaro Benes
//All Rights Reserved
 
{
Complex application for users of unDelphiX as component editor:
 
Supported:
a) create path for default shape.
b) allow do change like move or rotate path layout.
c) create new trace by free-hand.
 
}
interface
{$INCLUDE DelphiXcfg.inc}
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, Buttons, Math, ComCtrls,
DXClass, DXDraws, DIB;
 
type
{ TEdit }
TEdit = class(StdCtrls.TEdit) {injected class}
private
function GetAsInteger: Integer;
procedure SetAsInteger(const Value: Integer);
published
public
property AsInteger: Integer read GetAsInteger write SetAsInteger;
end;
{ TShape }
TShape = class(ExtCtrls.TShape)
procedure CMMouseEnter(var Msg: TMessage); message CM_MouseEnter;
procedure CMMouseLeave(var Msg: TMessage); message CM_MouseLeave;
end;
{ TDelphiXTracesEditForm }
TDPoint = record
X, Y: Double;
StayOn: Double;
end;
TDPointArr = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TDPoint;
{$IFNDEF VER4UP}
PDPointArr = ^TDPointArr;
{$ENDIF}
TDelphiXPathsEditForm = class(TForm)
ScrollBox1: TScrollBox;
Pane: TPanel;
Shape1: TShape;
Panel2: TPanel;
Panel1: TPanel;
Label1: TLabel;
LAmount: TLabel;
cbListOfTraces: TComboBox;
eAmount: TEdit;
btnNewTrace: TButton;
PopupMenu1: TPopupMenu;
Activate1: TMenuItem;
Label2: TLabel;
eShowOn: TEdit;
Panel12: TPanel;
btnSetTimming: TSpeedButton;
btnLine: TSpeedButton;
btnCircle: TSpeedButton;
btnSelectionArea: TSpeedButton;
btnSelectAll: TSpeedButton;
btnGrid: TSpeedButton;
brnSelectAsOne: TSpeedButton;
btnBringToFront: TSpeedButton;
btnMoveDown: TSpeedButton;
btnSendToBack: TSpeedButton;
btnMoveUp: TSpeedButton;
btnMoveLeft: TSpeedButton;
btnMoveRight: TSpeedButton;
Panel3: TPanel;
OKButton: TButton;
CancelButton: TButton;
btnCurve: TSpeedButton;
btnProperties: TSpeedButton;
btnRect: TSpeedButton;
Image1: TImage;
btnRefresh: TBitBtn;
Label3: TLabel;
StatusBar1: TStatusBar;
Button1: TBitBtn;
eDist: TEdit;
LDist: TLabel;
btnRotateLeft: TSpeedButton;
btnRotateRight: TSpeedButton;
procedure btnRotateLeftClick(Sender: TObject);
procedure btnRotateRightClick(Sender: TObject);
procedure btnMoveRightClick(Sender: TObject);
procedure btnMoveLeftClick(Sender: TObject);
procedure btnMoveDownClick(Sender: TObject);
procedure btnMoveUpClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure btnLineClick(Sender: TObject);
procedure btnGridClick(Sender: TObject);
procedure btnSelectionAreaClick(Sender: TObject);
procedure btnRefreshClick(Sender: TObject);
procedure PaneResize(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure OKButtonClick(Sender: TObject);
procedure cbListOfTracesChange(Sender: TObject);
procedure rgShapeClick(Sender: TObject);
procedure btnNewTraceClick(Sender: TObject);
procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSendToBackClick(Sender: TObject);
procedure btnBringToFrontClick(Sender: TObject);
procedure btnSetTimmingClick(Sender: TObject);
private
{ Private declarations }
FCapture, FClicked: Boolean;
MouseDownSpot: TPoint;
LastShape: TShape;
FTracesList: TTraces;
tmpRect: TRect;
{$IFNDEF VER4UP}
tmpPointArrSize: Integer;
{$ENDIF}
tmpPointArr: {$IFNDEF VER4UP}PDPointArr{$ELSE}TDPointArr{$ENDIF};
X0, Y0, LX, LY: Integer;
IsDownNow: Boolean;
procedure btnCreateNewTrace(Sender: TObject);
procedure DoMakePoints;
procedure CreatePathFromActiveTrace(index: Integer);
function GetSizesOfTrace(out x, y, oWidth, oHeight: Integer): Boolean;
procedure RotatePathForAngle(Angle: Integer);
public
{ Public declarations }
property PrivateTraces: TTraces read FTracesList write FTracesList;
procedure ShowTracesOnPane_;
procedure RewriteTracesFromPane;
procedure ShowTracesOnPane;
procedure RefreshShowTracesOnPaneOnly;
end;
 
var
DelphiXPathsEditForm: TDelphiXPathsEditForm;
 
implementation
 
{$R *.dfm}
 
{ TEdit }
 
procedure TEdit.SetAsInteger(const Value: Integer);
begin
Self.Text := IntToStr(Value)
end;
 
function TEdit.GetAsInteger: Integer;
begin
try
Result := StrToInt(Self.Text);
except
Result := 0;
end;
end;
 
{ TShape }
 
procedure TShape.CMMouseLeave(var Msg: TMessage);
begin
Shape := stRectangle;
end;
 
procedure TShape.CMMouseEnter(var Msg: TMessage);
begin
Shape := stCircle;
end;
 
{ TDelphiXTracesEditForm }
 
procedure TDelphiXPathsEditForm.FormCreate(Sender: TObject);
begin
FTracesList := TTraces.Create(Self);
{$IFNDEF VER4UP}
tmpPointArrSize := 0;
tmpPointArr := nil;
{$ENDIF}
Image1.Picture.Bitmap.Width := Pane.Width;
Image1.Picture.Bitmap.Height := Pane.Height;
btnGrid.Click;
end;
 
procedure TDelphiXPathsEditForm.FormDestroy(Sender: TObject);
begin
{$IFNDEF VER4UP}
if tmpPointArrSize > 0 then
System.ReallocMem(tmpPointArr, 0);
{$ENDIF}
FTracesList.Free;
FTracesList := nil;
end;
 
procedure SetActiveColor(Active: Boolean; S: TShape);
begin
if Active then S.Pen.Color := clRed
else S.Pen.Color := $008080FF;
if Active then
if Active then S.Brush.Color := clYellow
else S.Brush.Color := $0095FFFF
else
if Active then S.Brush.Color := clGray
else S.Brush.Color := $00C4C4C4;
end;
 
procedure TDelphiXPathsEditForm.ShowTracesOnPane_;
var
I, J: Integer;
S: TShape;
B: Boolean;
begin
Screen.Cursor := crHourGlass;
{uvolni predchozi}
for I := ComponentCount - 1 downto 0 do
if Components[I] is TShape then with Components[I] as TShape do begin
if Parent = Pane then
Free;
end;
{projdi seznam}
for I := 0 to FTracesList.Count - 1 do begin
{slozky-udelej pomocne pole}
CreatePathFromActiveTrace(I);
B := cbListOfTraces.ItemIndex = I; {aktivni radek}
{vlastni stopy}
{$IFNDEF VER4UP}
for J := 0 to tmpPointArrSize - 1 do
{$ELSE}
for J := Low(tmpPointArr) to High(tmpPointArr) do
{$ENDIF}
begin
S := TShape.Create(Self);
//----------
S.Parent := Pane;
S.Width := 16;
S.Height := 16;
SetActiveColor(B, S);
//----------
S.Left := Round(tmpPointArr[J].X) - 8; {na stred}
S.Top := Round(tmpPointArr[J].Y) - 8; {na stred}
S.ShowHint := True;
S.Hint := FTracesList.Items[I].Name;
if Trim(S.Hint) = '' then S.Hint := Format('(unnamed[%d])', [I]);
S.ShowHint := True;
//Upravovat ale lze pouze jen tu cestu, ktera je aktivni v combobox
if cbListOfTraces.ItemIndex = I then begin
S.OnMouseDown := ShapeMouseDown;
S.OnMouseMove := ShapeMouseMove;
S.OnMouseUp := ShapeMouseUp;
end;
S.Tag := Integer(J);
 
end;
end;
btnGrid.Click;
Screen.Cursor := crDefault;
end;
 
procedure TDelphiXPathsEditForm.ShowTracesOnPane;
var
I, J, index: Integer;
S: TShape;
P: TPath;
begin
Screen.Cursor := crHourGlass;
{uvolni predchozi}
for I := ComponentCount - 1 downto 0 do
if Components[I] is TShape then with Components[I] as TShape do begin
if Parent = Pane then
Free;
end;
{projdi seznam}
for I := 0 to FTracesList.Count - 1 do begin
{slozky-udelej pomocne pole}
index := i;
if index = -1 then Exit;
{vlastni stopy}
with FTracesList.Items[index].Blit do
if GetPathCount > 0 then begin
for J := 0 to GetPathCount - 1 do
begin
S := TShape.Create(Self);
//----------
S.Parent := Pane;
S.Width := 16;
S.Height := 16;
SetActiveColor(cbListOfTraces.ItemIndex = I, S);
//----------
S.Left := Round(Path[J].X) - 8; {na stred}
S.Top := Round(Path[J].Y) - 8; {na stred}
S.ShowHint := True;
S.Hint := FTracesList.Items[I].Name;
if Trim(S.Hint) = '' then S.Hint := Format('(unnamed[%d])', [I]);
S.ShowHint := True;
//Upravovat ale lze pouze jen tu cestu, ktera je aktivni v combobox
if cbListOfTraces.ItemIndex = I then begin
S.OnMouseDown := ShapeMouseDown;
S.OnMouseMove := ShapeMouseMove;
S.OnMouseUp := ShapeMouseUp;
end;
S.Tag := Integer(J);
P := Path[J];
P.Tag := Integer(S);
Path[J] := P;
end;
end;
end;
btnGrid.Click;
Screen.Cursor := crDefault;
end;
 
procedure TDelphiXPathsEditForm.RefreshShowTracesOnPaneOnly;
var
I, J, index: Integer;
S: TShape;
// P: TPath;
begin
Screen.Cursor := crHourGlass;
{projdi seznam}
for I := 0 to FTracesList.Count - 1 do begin
{slozky-udelej pomocne pole}
index := i;
if index = -1 then Exit;
{vlastni stopy}
with FTracesList.Items[index].Blit do
if GetPathCount > 0 then begin
for J := 0 to GetPathCount - 1 do
begin
S := TShape(Path[J].Tag);
if Assigned(S) then begin
S.Left := Round(Path[J].X) - 8;
S.Top := Round(Path[J].Y) - 8;
SetActiveColor(cbListOfTraces.ItemIndex = I, S);
//----------
//Upravovat ale lze pouze jen tu cestu, ktera je aktivni v combobox
if cbListOfTraces.ItemIndex = I then begin
S.OnMouseDown := ShapeMouseDown;
S.OnMouseMove := ShapeMouseMove;
S.OnMouseUp := ShapeMouseUp;
end
else
begin
S.OnMouseDown := nil;
S.OnMouseMove := nil;
S.OnMouseUp := nil;
end;
end;
end;
end;
end;
btnGrid.Click;
Screen.Cursor := crDefault;
end;
 
procedure TDelphiXPathsEditForm.ShapeMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
M: TPoint;
begin
if FCapture and (ssLeft in Shift) then begin
TShape(Sender).Left := TShape(Sender).Left - (MouseDownSpot.x - x);
TShape(Sender).Top := TShape(Sender).Top - (MouseDownSpot.y - y);
end;
//pro zmenu velikosti
if FClicked and (ssRight in Shift) and Assigned(LastShape) then begin
M := Pane.ScreenToClient({$IFNDEF VER4UP}Point(X, Y){$ELSE}Mouse.CursorPos{$ENDIF});
LastShape.Width := M.X - LastShape.Left;
LastShape.Height := M.Y - LastShape.Top;
end;
end;
 
procedure TDelphiXPathsEditForm.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FCapture then
begin
ReleaseCapture;
FCapture := False;
TShape(Sender).Left := TShape(Sender).Left - (MouseDownSpot.x - x);
TShape(Sender).Top := TShape(Sender).Top - (MouseDownSpot.y - y);
end;
LastShape := nil;
FClicked := False;
RewriteTracesFromPane;
ShowTracesOnPane;
Cursor := crDefault;
end;
 
procedure TDelphiXPathsEditForm.ShapeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
FCapture := ssLeft in Shift;
MouseDownSpot.X := X;
MouseDownSpot.Y := Y;
FClicked := ssRight in Shift;
if FClicked and (Sender is TShape) then begin
P := TShape(Sender).ClientToScreen(Point(X, Y));
PopupMenu1.Popup(P.X, P.Y);
Exit;
end;
ShapeMouseMove(Sender, Shift, X, Y);
if (Sender is TShape) then
LastShape := TShape(Sender);
Cursor := {$IFNDEF VER4UP}crSIZE{$ELSE}crSizeAll{$ENDIF};
end;
 
procedure TDelphiXPathsEditForm.RewriteTracesFromPane;
var
I: Integer;
S: TShape;
//TT: TTracePoint;
T: TPath;
begin
for I := ComponentCount - 1 downto 0 do
if Components[I] is TShape then begin
S := Components[I] as TShape;
if S.Parent = Pane then
if S.Hint = cbListOfTraces.Text then //active item only
begin
T := PrivateTraces.Items[cbListOfTraces.ItemIndex].Blit.Path[S.Tag];
T.X := S.Left + 8;
T.Y := S.Top + 8;
{tady lze prepsat jine atributy treba Rychlost...}
PrivateTraces.Items[cbListOfTraces.ItemIndex].Blit.Path[S.Tag] := T;
end;
end;
end;
 
procedure TDelphiXPathsEditForm.btnBringToFrontClick(Sender: TObject);
var
T: TTrace;
begin
if cbListOfTraces.ItemIndex <> -1 then begin
T := FTracesList.Add;
T.Assign(FTracesList.Items[cbListOfTraces.ItemIndex]);
{$IFDEF VER5UP}
FTracesList.Delete(cbListOfTraces.ItemIndex);
{$ELSE}
FTracesList.Items[cbListOfTraces.ItemIndex].Free;
{$ENDIF}
cbListOfTraces.Items.Move(cbListOfTraces.ItemIndex, cbListOfTraces.Items.Count - 1);
cbListOfTraces.ItemIndex := cbListOfTraces.Items.Count - 1;
ShowTracesOnPane
end;
end;
 
procedure TDelphiXPathsEditForm.btnCreateNewTrace(Sender: TObject);
var
S: string;
T: TTrace;
begin
if InputQuery('Name of new Trace:', 'Trace name', S) then begin
if Trim(S) = '' then begin
ShowMessage('Name for new trace mustn''t be empty.');
Exit;
end;
if cbListOfTraces.Items.IndexOf(S) <> -1 then begin
ShowMessage('Name for new trace has to be unique.');
Exit;
end;
T := FTracesList.Add;
T.Name := S;
cbListOfTraces.Items.AddObject(S, Pointer(PrivateTraces.Count - 1));
cbListOfTraces.ItemIndex := cbListOfTraces.Items.IndexOf(S);
cbListOfTracesChange(cbListOfTraces);
end;
end;
 
procedure TDelphiXPathsEditForm.btnNewTraceClick(Sender: TObject);
begin
btnCreateNewTrace(Sender);
end;
 
procedure TDelphiXPathsEditForm.rgShapeClick(Sender: TObject);
begin
btnNewTrace.Enabled := btnLine.Down or btnCircle.Down or btnCurve.Down;
end;
 
procedure TDelphiXPathsEditForm.cbListOfTracesChange(Sender: TObject);
begin
RewriteTracesFromPane;
RefreshShowTracesOnPaneOnly
end;
 
procedure TDelphiXPathsEditForm.OKButtonClick(Sender: TObject);
begin
RewriteTracesFromPane;
Tag := 1;
end;
 
procedure TDelphiXPathsEditForm.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{zapnou se funkce pro sber}
begin
if ssleft in Shift then begin
X0 := X; LX := X;
Y0 := Y; LY := Y;
Image1.Picture.Bitmap.Canvas.Pen.Mode := pmNotXor;
Image1.Picture.Bitmap.Canvas.Pen.Color := clRed;
Image1.Picture.Bitmap.Canvas.Brush.Style := bsClear;
IsDownNow := True;
if btnCurve.Down then begin
{$IFNDEF VER4UP}
tmpPointArrSize := 1;
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
tmpPointArr[tmpPointArrSize - 1].X := X;
tmpPointArr[tmpPointArrSize - 1].Y := Y;
{$ELSE}
SetLength(tmpPointArr, 1);
tmpPointArr[High(tmpPointArr)].X := X;
tmpPointArr[High(tmpPointArr)].Y := Y;
{$ENDIF}
end;
end;
end;
 
procedure TDelphiXPathsEditForm.Image1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
{zabira ze plocha}
begin
if IsDownNow then with Image1.Picture.Bitmap.Canvas do begin
if btnSelectionArea.Down then begin
Rectangle(X0, Y0, LX, LY);
Rectangle(X0, Y0, X, Y);
end;
if btnLine.Down then begin
MoveTo(x0, y0);
LineTo(lx, ly);
MoveTo(x0, y0);
LineTo(x, y);
end;
if btnCircle.Down or btnRect.Down then begin
Rectangle(X0, Y0, LX, LY);
Rectangle(X0, Y0, X, Y);
end;
if btnCurve.Down then begin
if (X <> LX) or (Y <> LY) then begin
{$IFNDEF VER4UP}
Inc(tmpPointArrSize);
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
tmpPointArr[tmpPointArrSize - 1].X := X;
tmpPointArr[tmpPointArrSize - 1].Y := Y;
{$ELSE}
SetLength(tmpPointArr, Length(tmpPointArr) + 1);
tmpPointArr[High(tmpPointArr)].X := X;
tmpPointArr[High(tmpPointArr)].Y := Y;
{$ENDIF}
 
MoveTo(LX, LY);
LineTo(x, y);
end;
end;
LX := X;
LY := Y;
end;
StatusBar1.Panels[1].Text := Format('(x,y)=(%d,%d)', [X, Y]);
end;
 
{$IFNDEF VER4UP}
function Min(i1, i2: integer): integer;
begin
if i1 < i2 then Result := i1 else Result := i2;
end;
 
function Max(i1, i2: integer): integer;
begin
if i1 > i2 then Result := i1 else Result := i2;
end;
{$ENDIF}
 
procedure TDelphiXPathsEditForm.Image1MouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{koncovy bod}
var
i, v, a, b, c: Integer;
beta, sinbeta, cosbeta, angle, step, ii, vx, vy, alpha, sinalpha, cosalpha, p, vv, a1, b1: Double;
begin
if IsDownNow then with Image1.Picture.Bitmap.Canvas do begin
if btnCurve.Down then begin
DoMakePoints;
Label3.Caption := '';
Image1.OnMouseDown := nil;
Image1.OnMouseMove := nil;
Image1.OnMouseUp := nil;
btnCurve.Down := False;
end;
if btnSelectionArea.Down then begin
if ssShift in Shift then begin
Rectangle(X0, Y0, LX, LY); //smazat
Pen.Mode := pmCopy; //napevno
v := Max(Abs(X0 - x), Abs(X0 - y));
Rectangle(X0, y0, X0 + v, Y0 + v); //vykreslit
end
else begin
Pen.Mode := pmCopy; //napevno
Rectangle(x0, y0, x, y);
end;
tmpRect := Rect(x0, y0, x, y);
Label3.Caption := Format('R:((%d,%d),(%d,%d))', [x0, y0, x, y]);
Image1.OnMouseDown := nil;
Image1.OnMouseMove := nil;
Image1.OnMouseUp := nil;
btnSelectionArea.Down := False;
end;
if btnLine.Down then begin
MoveTo(x0, y0);
LineTo(x, y);
{$IFNDEF VER4UP}
tmpPointArrSize := 2;
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
{$ELSE}
SetLength(tmpPointArr, 2);
{$ENDIF}
C := 0;
tmpPointArr[C].X := X0;
tmpPointArr[C].Y := Y0;
Inc(C);
tmpPointArr[C].X := X;
tmpPointArr[C].Y := Y;
DoMakePoints;
Label3.Caption := '';
Image1.OnMouseDown := nil;
Image1.OnMouseMove := nil;
Image1.OnMouseUp := nil;
btnLine.Down := False;
end;
if btnCircle.Down then begin
Rectangle(X0, Y0, LX, LY); //smazat
{$IFNDEF VER4UP}
tmpPointArrSize := eAmount.AsInteger;
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
{$ELSE}
SetLength(tmpPointArr, eAmount.AsInteger);
{$ENDIF}
{neni pootocena}
angle := 0;
beta := -angle / 180 * PI;
 
sinbeta := Sin(beta);
cosbeta := Cos(beta);
step := 360 / eAmount.AsInteger;
ii := 0; v := {$IFNDEF VER4UP}0{$ELSE}Low(tmpPointArr){$ENDIF};
a := Abs(LX - X0) div 2; //mayor
b := Abs(LY - Y0) div 2; //minor
vx := X0 + a; //center x
vy := Y0 + b; //center y
while ii < 360 do begin
alpha := ii / 180 * PI;
sinalpha := Sin(alpha);
cosalpha := Cos(alpha);
tmpPointArr[v].X := vx + (a * cosalpha * cosbeta - b * sinalpha * sinbeta);
tmpPointArr[v].Y := vy + (a * cosalpha * sinbeta + b * sinalpha * cosbeta);
inc(v);
ii := ii + step;
end;
DoMakePoints;
Label3.Caption := '';
Image1.OnMouseDown := nil;
Image1.OnMouseMove := nil;
Image1.OnMouseUp := nil;
btnCircle.Down := False;
end;
if btnRect.Down then begin
Rectangle(X0, Y0, LX, LY); //smazat
{$IFNDEF VER4UP}
tmpPointArrSize := eAmount.AsInteger;
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
{$ELSE}
SetLength(tmpPointArr, eAmount.AsInteger);
{$ENDIF}
a1 := LX - X0;
b1 := LY - Y0;
//c := 2 * (LX - X0) + 2 * (LY - Y0); //delka
ii := (2 * a1 + 2 * b1) / eAmount.AsInteger; //delka useku
//first point is here
vv := 0;
tmpPointArr[0].X := X0; p := X0;
tmpPointArr[0].Y := Y0;
{rozhodit body po obdelniku}
for I := 1 to eAmount.AsInteger - 1 do begin
p := p + ii;
vv := vv + ii;
if vv < a1 then begin
tmpPointArr[I].X := p;
tmpPointArr[I].Y := Y0;
end
else
if vv < (a1 + b1) then begin
tmpPointArr[I].X := LX;
tmpPointArr[I].Y := Y0 + (vv - a1);
end
else
if vv < (2 * a1 + b1) then begin
tmpPointArr[I].X := LX - (vv - (a1 + b1));
tmpPointArr[I].Y := LY;
end
else
if vv < (2 * a1 + 2 * b1) then begin
tmpPointArr[I].X := X0;
tmpPointArr[I].Y := LY - (vv - (2 * a1 + b1));
end;
end;
DoMakePoints;
Label3.Caption := '';
Image1.OnMouseDown := nil;
Image1.OnMouseMove := nil;
Image1.OnMouseUp := nil;
btnRect.Down := False;
end;
end;
IsDownNow := False;
end;
 
procedure TDelphiXPathsEditForm.PaneResize(Sender: TObject);
begin
Image1.Picture.Bitmap.Width := Pane.Width;
Image1.Picture.Bitmap.Height := Pane.Height;
end;
 
procedure TDelphiXPathsEditForm.DoMakePoints;
function distance2d(x1, z1, x2, z2: single): single;
var
diffx, diffz: single;
begin
diffX := x1 - x2;
diffZ := z1 - z2;
result := system.Sqrt(diffX * diffX + diffZ * diffZ);
end;
var
T: TTrace;
Q: TPath;
I, D, C: Integer;
DX, DY, TX, TY: Single;
begin
if btnLine.Down then begin
C := 0;
if {$IFNDEF VER4UP}tmpPointArrSize{$ELSE}Length(tmpPointArr){$ENDIF} = 2 then begin
D := Round(distance2d(tmpPointArr[C].X, tmpPointArr[C].Y, tmpPointArr[C + 1].X, tmpPointArr[C + 1].Y));
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
T.Blit.SetPathLen(0); //smaz
{vytvoreni slozek}
{korekce, je-li bodu vic nez delka cary}
if eAmount.AsInteger > D then
eAmount.AsInteger := D;
{nastaveni velikosti cesty}
T.Blit.SetPathLen(eAmount.AsInteger);
{rozhozeni bodu na caru}
DX := (tmpPointArr[C + 1].X - tmpPointArr[C].X) / eAmount.AsInteger;
DY := (tmpPointArr[C + 1].Y - tmpPointArr[C].Y) / eAmount.AsInteger;
TX := tmpPointArr[C].X;
TY := tmpPointArr[C].Y;
for I := 1 to eAmount.AsInteger do begin
FillChar(Q, SizeOf(Q), 0);
Q.X := Round(TX + (I - 1) * DX);
Q.Y := Round(TY + (I - 1) * DY);
Q.StayOn := eShowOn.AsInteger;
T.Blit.Path[I - 1] := Q;
end;
T.Active := True;
ShowTracesOnPane;
end;
end;
end;
if btnCircle.Down or btnRect.Down or btnCurve.Down then begin
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
T.Blit.SetPathLen(0); //smaz
{vytvoreni slozek}
{$IFNDEF VER4UP}
T.Blit.SetPathLen(tmpPointArrSize);
for I := 0 to tmpPointArrSize - 1 do
{$ELSE}
T.Blit.SetPathLen(Length(tmpPointArr));
for I := Low(tmpPointArr) to High(tmpPointArr) do
{$ENDIF}
begin
FillChar(Q, SizeOf(Q), 0);
Q.X := Round(tmpPointArr[I].X);
Q.Y := Round(tmpPointArr[I].Y);
Q.StayOn := eShowOn.AsInteger;
T.Blit.Path[I] := Q;
end;
T.Active := True;
ShowTracesOnPane;
end;
end;
end;
 
procedure TDelphiXPathsEditForm.btnRefreshClick(Sender: TObject);
begin
DoMakePoints;
end;
 
procedure TDelphiXPathsEditForm.btnSelectionAreaClick(Sender: TObject);
begin
Image1.OnMouseDown := Image1MouseDown;
Image1.OnMouseMove := Image1MouseMove;
Image1.OnMouseUp := Image1MouseUp;
end;
 
procedure TDelphiXPathsEditForm.btnSendToBackClick(Sender: TObject);
var
T: TTrace;
I: Integer;
begin
if cbListOfTraces.ItemIndex <> -1 then begin
T := FTracesList.Items[cbListOfTraces.ItemIndex]; //saved
//from selected to first
for I := cbListOfTraces.ItemIndex-1 downto 0 do begin
FTracesList.Items[I] := FTracesList.Items[I + 1];
end;
FTracesList.Items[0] := T;
cbListOfTraces.Items.Move(cbListOfTraces.ItemIndex, 0);
cbListOfTraces.ItemIndex := 0; {it is first now}
ShowTracesOnPane
end;
end;
 
procedure TDelphiXPathsEditForm.btnSetTimmingClick(Sender: TObject);
var
T: TTrace;
I: Integer;
P: TPath;
begin
if MessageDlg(Format('Do you want change show time to %d ms for each point ?', [eShowOn.AsInteger]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
{move selected path to down}
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
P.StayOn := eShowOn.AsInteger;
T.Blit.Path[I] := P;
end;
end;
ShowTracesOnPane;
end;
end;
 
procedure TDelphiXPathsEditForm.btnGridClick(Sender: TObject);
const
ccGrid = 32;
ccShift = 16;
var I: Integer;
{$IFNDEF VER4UP}
// pp: Pointer;
{$ELSE}
pp: array of TPoint;
{$ENDIF}
begin
if btnGrid.Down then
with Image1.Picture.Bitmap.Canvas do begin
Brush.Color := clBlack;
FillRect(Bounds(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Width));
Pen.Color := clDkGray;
Pen.Style := psDot;
Pen.Mode := pmCopy;
Pen.Width := 1;
for I := 0 to Image1.Picture.Bitmap.Width div ccGrid do begin
MoveTo(I * ccGrid + ccShift, 0);
LineTo(I * ccGrid + ccShift, Image1.Picture.Bitmap.Height);
end;
for I := 0 to Image1.Picture.Bitmap.Width div ccGrid do begin
MoveTo(0, I * ccGrid + ccShift);
LineTo(Image1.Picture.Bitmap.Width, I * ccGrid + ccShift);
end;
Pen.Color := clLtGray;
Pen.Style := psSolid;
Pen.Width := 1;
for I := 0 to Image1.Picture.Bitmap.Width div 32 do begin
MoveTo(I * 32, 0);
LineTo(I * 32, Image1.Picture.Bitmap.Height);
end;
for I := 0 to Image1.Picture.Bitmap.Width div 32 do begin
MoveTo(0, I * 32);
LineTo(Image1.Picture.Bitmap.Width, I * 32);
end;
end
else
with Image1.Picture.Bitmap.Canvas do begin
Brush.Color := clBlack;
FillRect(Bounds(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Width));
end;
if (tmpRect.Right > 0) and (tmpRect.Bottom > 0) then
with Image1.Picture.Bitmap.Canvas do begin
Pen.Color := clGreen;
Pen.Width := 1;
Pen.Mode := pmCopy;
Brush.Style := bsClear;
{$IFDEF VER5UP}
Rectangle(tmpRect);
{$ELSE}
Rectangle(tmpRect.Left, tmpRect.Top, tmpRect.Right, tmpRect.Bottom);
{$ENDIF}
end;
with Image1.Picture.Bitmap.Canvas do begin
CreatePathFromActiveTrace(cbListOfTraces.ItemIndex);
{$IFNDEF VER4UP}
if tmpPointArrSize <= 0 then Exit;
MoveTo(Round(tmpPointArr[0].X), Round(tmpPointArr[0].Y));
for I := 1 to tmpPointArrSize - 1 do
LineTo(Round(tmpPointArr[I].X), Round(tmpPointArr[I].Y));
{$ELSE}
if Length(tmpPointArr) = 0 then Exit;
SetLength(pp, Length(tmpPointArr));
for I := Low(tmpPointArr) to High(tmpPointArr) do
pp[I] := Point(Round(tmpPointArr[I].X), Round(tmpPointArr[I].Y));
Pen.Color := clWhite;
Pen.Width := 1;
Pen.Mode := pmCopy;
Brush.Style := bsClear;
Polyline(pp);
{$ENDIF}
end;
end;
 
procedure TDelphiXPathsEditForm.btnLineClick(Sender: TObject);
begin
Image1.OnMouseDown := Image1MouseDown;
Image1.OnMouseMove := Image1MouseMove;
Image1.OnMouseUp := Image1MouseUp;
end;
 
procedure TDelphiXPathsEditForm.Button1Click(Sender: TObject);
begin
tmpRect := Rect(0, 0, 0, 0);
Label3.Caption := 'R:<none>';
end;
 
procedure TDelphiXPathsEditForm.CreatePathFromActiveTrace(index: Integer);
var
J: Integer;
begin
{$IFNDEF VER4UP}
tmpPointArrSize := 0;
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
{$ELSE}
SetLength(tmpPointArr, 0);
{$ENDIF}
if index = -1 then Exit;
{vlastni stopy}
with FTracesList.Items[index].Blit do
if GetPathCount > 0 then begin
{$IFNDEF VER4UP}
tmpPointArrSize := GetPathCount;
System.ReallocMem(tmpPointArr, tmpPointArrSize * SizeOf(TDPoint));
{$ELSE}
SetLength(tmpPointArr, GetPathCount);
{$ENDIF}
for J := 0 to GetPathCount - 1 do
begin
tmpPointArr[J].X := Path[J].X;
tmpPointArr[J].Y := Path[J].Y;
tmpPointArr[J].StayOn := Path[J].StayOn;
end;
end;
end;
 
procedure TDelphiXPathsEditForm.btnMoveUpClick(Sender: TObject);
var
T: TTrace;
I: Integer;
P: TPath;
begin
{move selected path to up}
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
P.Y := P.Y - eDist.AsInteger;
T.Blit.Path[I] := P;
end;
end;
ShowTracesOnPane;
end;
 
procedure TDelphiXPathsEditForm.btnMoveDownClick(Sender: TObject);
var
T: TTrace;
I: Integer;
P: TPath;
begin
{move selected path to down}
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
P.Y := P.Y + eDist.AsInteger;
T.Blit.Path[I] := P;
end;
end;
ShowTracesOnPane;
end;
 
procedure TDelphiXPathsEditForm.btnMoveLeftClick(Sender: TObject);
var
T: TTrace;
I: Integer;
P: TPath;
begin
{move selected path to left}
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
P.X := P.X - eDist.AsInteger;
T.Blit.Path[I] := P;
end;
end;
ShowTracesOnPane;
end;
 
procedure TDelphiXPathsEditForm.btnMoveRightClick(Sender: TObject);
var
T: TTrace;
I: Integer;
P: TPath;
begin
{move selected path to right}
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
P.X := P.X + eDist.AsInteger;
T.Blit.Path[I] := P;
end;
end;
ShowTracesOnPane;
end;
 
procedure Rotate(iRotAng: Single; x, y: Double; var Nx, Ny: Double);
procedure SinCosS(const Theta: Single; var Sin, Cos: Single); register;
// EAX contains address of Sin
// EDX contains address of Cos
// Theta is passed over the stack
asm
FLD Theta
FSINCOS
FSTP DWORD PTR [EDX] // cosine
FSTP DWORD PTR [EAX] // sine
end;
const PI256 = 2 * PI / 256;
var
SinVal, CosVal, RotAng: Single;
begin
RotAng := iRotAng * PI256;
SinCosS(RotAng, SinVal, CosVal);
Nx := x * CosVal - y * SinVal;
Ny := y * CosVal + x * SinVal;
end;
 
procedure RotateO(RotAng: Double; x, y, ox, oy: Double; var Nx, Ny: Double);
begin
Rotate(RotAng, x - ox, y - oy, Nx, Ny);
Nx := Nx + ox;
Ny := Ny + oy;
end;
 
function TDelphiXPathsEditForm.GetSizesOfTrace(out x, y, oWidth, oHeight: Integer): Boolean;
var
T: TTrace;
I: Integer;
P: TPath;
maxX, minX, maxY, minY: Single;
begin
Result := False;
oWidth := 0;
oHeight := 0;
maxX := 0;
minX := MaxInt;
maxY := 0;
minY := MaxInt;
if cbListOfTraces.ItemIndex <> -1 then begin
{ziskej aktivni stopu}
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
if P.X > maxX then maxX := P.X;
if P.Y > maxY then maxY := P.Y;
if P.X < minX then minX := P.X;
if P.Y < minY then minY := P.Y;
end;
x := Round(minX);
y := Round(minY);
oWidth := Abs(Round(maxX) - Round(minX));
oHeight := Abs(Round(maxY) - Round(minY));
Result := True;
end;
end;
 
procedure TDelphiXPathsEditForm.RotatePathForAngle(Angle: Integer);
var
T: TTrace;
I, x, y, width, height: Integer;
P: TPath;
nX, nY, dX, dY: Double;
begin
if GetSizesOfTrace(x, y, Width, Height) then
begin
dX := (x + width / 2);
dY := (y + height / 2);
T := PrivateTraces.Items[cbListOfTraces.ItemIndex];
for I := 0 to T.Blit.GetPathCount - 1 do
begin
P := T.Blit.Path[I];
RotateO(Angle, P.X, P.Y, dX, dY, nX, nY);
P.X := nX;
P.Y := nY;
T.Blit.Path[I] := P;
end;
end;
end;
 
procedure TDelphiXPathsEditForm.btnRotateLeftClick(Sender: TObject);
begin
RotatePathForAngle(-1 * eDist.AsInteger);
RefreshShowTracesOnPaneOnly
end;
 
procedure TDelphiXPathsEditForm.btnRotateRightClick(Sender: TObject);
begin
RotatePathForAngle(eDist.AsInteger);
RefreshShowTracesOnPaneOnly
end;
 
end.
/VCL_DELPHIX_D6/SXMedia/MpSndSys.pas
0,0 → 1,237
(*
* This unit is free software; you can redistribute it and modify it
* under the terms of the GNU Library General Public License as published
* by the Free Software Foundation; either version 2 of the license or
* (at your option) any later version.
*
* Author of CPP header file : Olivier Lapicque <olivierl@jps.net>
* Author of Delphi conversion : Dean Ellis <Dean_Ellis@sillex.freeserve.co.uk>
*
* NOTE : The Origonal C++ Class declarations anc constants have been left in place
*
*)
unit MpSndSys;
 
interface
 
uses Windows,Classes;
 
const
//#ifndef MPP_SND_SYS_H
//#define MPP_SND_SYS_H
 
//#ifndef MPPDLLEXPORT
//#define MPPDLLEXPORT
//#endif
 
//#define MPPAPI __stdcall
//#define MPPCDECL __cdecl
//#define MPPAPI_VERSION 0x0140
 
//#define MPPAPI_VERSION 0x0140
 
MPPAPI_VERSION = $0141;
 
// Version-specific functions
//#define MPPVERSION_HAS_NAVIGATION 0x0139
//#define MPPVERSION_HAS_SONGTIME 0x0141
 
MPPVERSION_HAS_NAVIGATION = $0139;
MPPVERSION_HAS_SONGTIME = $0141;
 
// Error codes
//typedef long MPPERR;
//
//enum {
// MPPERR_NOERROR=0,
// MPPERR_FAILED,
// MPPERR_INVALIDPARAM,
//};
 
//enum {
// MPPSONG_INVALID=0,
// MPPSONG_MOD,
// MPPSONG_S3M,
// MPPSONG_XM,
// MPPSONG_IT,
// MPPSONG_MDL,
// MPPSONG_UNKNOWN=100
//};
MPPERR_NOERROR = 0;
MPPERR_FAILED = 1;
MPPERR_INVALIDPARAM = 2;
 
MPPSONG_INVALID = 0;
MPPSONG_MOD = 1;
MPPSONG_S3M = 2;
MPPSONG_XM = 3;
MPPSONG_IT = 4;
MPPSONG_MDL = 5;
MPPSONG_UNKNOWN = 100;
 
// Mixer Options MPPMIX_XXXX
//#define MPPMIX_NORESAMPLING 0x01 // Faster, but crappy quality
//#define MPPMIX_BASSEXPANSION 0x02 // Bass Expansion
//#define MPPMIX_SURROUND 0x04 // Surround Encoding
//#define MPPMIX_REVERB 0x08 // Reverb
//#define MPPMIX_LOOP 0x10 // Loop the song (backward jumps will be enabled)
//// v1.40+ flags
//#define MPPMIX_HIGHQUALITY 0x20 // HQ mixing (better resampling, dithering enabled)
//#define MPPMIX_GAINCONTROL 0x40 // Automatic Gain Control
//#define MPPMIX_NOISEREDUCTION 0x80 // Noise reduction (-6dB 22kHz lowpass filter)
 
MPPMIX_NORESAMPLING = $01; // Faster, but crappy quality
MPPMIX_BASSEXPANSION = $02; // Bass Expansion
MPPMIX_SURROUND = $04; // Surround Encoding
MPPMIX_REVERB = $08; // Reverb
MPPMIX_LOOP = $10; // Loop the song (backward jumps will be enabled)
// v1.40+ flags
MPPMIX_HIGHQUALITY = $20; // HQ mixing (better resampling, dithering enabled)
MPPMIX_GAINCONTROL = $40; // Automatic Gain Control
MPPMIX_NOISEREDUCTION = $80; // Noise reduction (-6dB 22kHz lowpass filter)
 
type
//==========================
//class MPPDLLEXPORT IModMixer
//==========================
(* {
public:
// Reference count: the initial reference count is 1, so you shouldn't have to call AddRef()
virtual unsigned long MPPAPI AddRef() = 0;
virtual unsigned long MPPAPI Release() = 0;
 
// API Version: you should refuse to continue if the returned value is smaller than MPPAPI_VERSION
virtual unsigned long MPPAPI GetVersion() = 0;
 
// Basic I/O Functions
virtual MPPERR MPPAPI LoadSong(const void *pmemfile, long len) = 0;
// Songs are always loaded from memory. The pointer pmemfile can be destroyed
// after the call to LoadSong. You can use memory-mapped files or a pointer returned
// by LockResource(), or whatever file in memory.
virtual MPPERR MPPAPI FreeSong() = 0; // Free the memory used by the song
 
// Audio Rendering Functions: example: (44100, 2, 16) for 44.1kHz, stereo, 16-bit
virtual MPPERR MPPAPI SetWaveFormat(long samplespersec, long channels, long bitspersample) = 0;
// return # of SAMPLES that have been written to the buffer, 0 if end has been reached
// Note: protect calls to Render() and SetMixerOptions() by a critical section, if they
// are used in different threads.
virtual long MPPAPI Render(void *pbuffer, unsigned long bufsize) = 0;
 
// Player Configuration: set of MPPMIX_XXXX
virtual MPPERR MPPAPI SetMixerOptions(unsigned long dwOptions) = 0;
virtual unsigned long MPPAPI GetMixerOptions() = 0;
 
// Song Information
virtual long MPPAPI GetSongType() = 0; // Return MPPSONG_XXXX
virtual void MPPAPI GetSongName(char *pszbuf) = 0; // pszbuf must be at least 32-bytes
 
//////////////////////////////////////////////////////////////////////////////////////
// v1.39+: Navigation functions
// The order is the position in the pattern sequence list: this allows you to
// jump to a specific part of a song. It can be useful in a game with a song that
// uses pattern position jump effects (or pattern loops).
// These function will not be available if GetVersion() returns a value smaller than 0x139 (MPPVERSION_HAS_NAVIGATION)
virtual unsigned long MPPAPI GetNumOrders() = 0;
virtual unsigned long MPPAPI GetCurrentOrder() = 0;
virtual MPPERR MPPAPI SetCurrentOrder(unsigned long neworder) = 0;
 
};
*)
MppError = longint;
 
PModMixer = ^IModMixer;
IModMixer = class
public
function AddRef:longint; virtual; stdcall; abstract;
function Release:longint; virtual; stdcall; abstract;
function GetVersion:longint; virtual; stdcall; abstract;
function LoadSong(const MemFile:pointer;Length:longint):MppError;virtual; stdcall; abstract;
function FreeSong:MppError;virtual; stdcall; abstract;
function SetWaveFormat(SamplesPerSec,channels,bitsPerSample:longint):MppError;virtual; stdcall; abstract;
function Render(Buffer:pointer;BufferSize:longint):MppError;virtual; stdcall; abstract;
function SetMixerOptions(dwOptions:longint):MppError;virtual; stdcall; abstract;
function GetMixerOptions:longint;virtual; stdcall; abstract;
function GetSongType:longint;virtual; stdcall; abstract;
procedure GetSongName(Buffer:PChar);virtual; stdcall; abstract;
function GetNumOrders:longint;virtual; stdcall; abstract;
function SetCurrentOrder(newOrder:longint):MppError;virtual; stdcall; abstract;
function GetSongLength:longint; virtual; stdcall; abstract;
end;
 
var
MppSdkLibLoaded:Boolean;
ModMixer:IModMixer;
 
implementation
 
const MppSdkLibrary = 'mppsdk.dll';
 
var MppSdkLibHandle:THandle;
 
//#define MPP_GETMODAPIFUNCNAME "MPP_GetModAPI"
//typedef MPPERR (MPPCDECL * MPP_GETMODAPIFUNC)(IModMixer **);
GetModAPI : function(MODMixer:PModMixer):MppError;cdecl;
 
(*
*
* To get a pointer to the IModMixer interface, you can use the following functions:
*
* HMODULE hMPPSDK = (HMODULE)LoadLibrary("mppsdk.dll");
* MPP_GETMODAPIFUNC pFunc = (MPP_GETMODAPIFUNC)GetProcAddress(hMPPSDK, MPP_GETMODAPIFUNCNAME);
* IModMixer *pMPPAPI;
* pFunc(&pMPPAPI);
* ...
* You can then access the MPP SDK API through the IModMixer interface
*
* When you are done:
*
* pMPPAPI->Release();
* FreeLibrary(hMPPSDK);
*
*)
 
//#endif // MPP_SND_SYS_H
 
 
{----------------------------------------------------------------------------}
{InitLibrary - will try to load the Mppsdk.dll and get the ModMixer object}
{----------------------------------------------------------------------------}
function InitLibrary:Boolean;
begin
Result := False;
 
MppSdkLibHandle := LoadLibrary(MppSdkLibrary);
 
if MppSdkLibHandle = 0 then
begin
Exit;
end;
 
try
GetModAPI := GetProcAddress(MppSdkLibHandle,'MPP_GetModAPI');
GetModAPI(@ModMixer);
Result := True;
except
Result := False;
end;
end;
{----------------------------------------------------------------------------}
{UnLoadLibrary - Will unload the Mppsdk.dll if it was loaded}
{----------------------------------------------------------------------------}
procedure UnLoadLibrary;
begin
if MppSdkLibLoaded then
begin
FreeLibrary(MppSdkLibHandle);
end;
end;
 
{----------------------------------------------------------------------------}
{Automatic initialization and finalization - comment out if you want to
do this manually}
{----------------------------------------------------------------------------}
initialization
MppSdkLibLoaded:=InitLibrary;
finalization
UnloadLibrary;
end.
/VCL_DELPHIX_D6/SXMedia/SXAbout.dfm
0,0 → 1,728
object AboutBox: TAboutBox
Left = 260
Top = 194
BorderStyle = bsDialog
Caption = 'About SXMedia'
ClientHeight = 186
ClientWidth = 244
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsStayOnTop
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object InfoContainer: TPanel
Left = 0
Top = 0
Width = 245
Height = 153
BevelInner = bvLowered
BevelOuter = bvLowered
Color = clInactiveBorder
TabOrder = 0
object Version: TLabel
Left = 7
Top = 57
Width = 53
Height = 13
Caption = 'Version 1.0'
IsControl = True
end
object Copyright: TLabel
Left = 122
Top = 57
Width = 117
Height = 13
Caption = 'Copyright SXMedia 1999'
Transparent = True
IsControl = True
end
object Author: TLabel
Left = 76
Top = 74
Width = 87
Height = 13
Alignment = taCenter
Caption = 'Author : Dean Ellis'
end
object WebSite: TLabel
Left = 42
Top = 92
Width = 157
Height = 13
Caption = 'http://www.sillex.freeserve.co.uk'
IsControl = True
end
object Credits: TLabel
Left = 42
Top = 108
Width = 167
Height = 40
Alignment = taCenter
AutoSize = False
Caption =
'MOD Player Engine provided by'#13#10'Olivier Lapicque <olivierl@jps.ne' +
't>'#13#10'http://www/jps.net/olivierl/'
WordWrap = True
IsControl = True
end
object LogoContainer: TPanel
Left = 13
Top = 2
Width = 221
Height = 53
Color = clBlack
TabOrder = 0
object ProgramIcon: TImage
Left = 6
Top = 3
Width = 210
Height = 45
AutoSize = True
Center = True
IncrementalDisplay = True
Picture.Data = {
07544269746D61700A4A0000424D0A4A0000000000003600000028000000D200
00002D0000000100100000000000D44900000000000000000000000100000000
000000000000000080000080000000808000800000008000800080800000C0C0
C000C0DCC000F0CAA60018081000080000000800080008080800100008001008
0800100010001008100010101000180010001808100018081800250018002108
18001810100022091D0025102100181818002118180031042700311029003910
2D00211821002918210031182900262326003118310039183100352632004A14
3B006B0B520066255600493A4600653358006E3261006F4364008B176E00892E
71008E3375009C3184007E4171008E4279009C39840094468400A5007B00A510
7E00A5398400A5398C00A0467F00A0468400A04A8800AD007F00AD108400A542
8C00A54A9000C1009000B9229400D6009C00F5349500565256005A5A5A00635A
5E006363630075566D008452730088567B00A5636B00A55A7300AD637300A552
7B008C5A7B0094568400A1568800A0639400AD5A8400AD4A8C00AD528C00AD5A
8C00AD4A9400AD529400AD5A9400AD529C00AD5A9C00E75A7300E75A7B00EF52
7B00EF5A7B00EF4A8400EC4F89009E7A6100B5915C00B8C232007B7179008787
8700AF688A00B47B7E00CDAF4000C7CE2F00C0CA4500CE906000CB898000C0B6
5B00C4AB7600BDF70000C1F30400C6EF0800BDF70800C6F70800BDFF0000BDFF
0800C6FF0000C0E41000C1DE1800BDF31000CED62100C0E91800BDE22100C4E1
2D00D600A500D608A500DE00A500DE08A500E700A500DE00AD00EB00AD00EF00
B500F700B500F708B500F700BD00FF00B500FF08B500FF00BD00FF00C600E221
B100F721A500F714B900FF10B100FB10BD00FF08C600FC18C300EC29AF00EF2D
B500E241B700F92DC700FF39CE00E246BD00FF46D200A57B9C00AD639C00AD6B
9C00AD739C00B55A9C00B5639C00B56B9C00B563A500B56BA500B573A500BD7B
9C00BD5AA500BD6BA500BD73A500BD6BAD00D6739C00C66BAD00BD73AD00BD7B
AD00C67BAD00D65AB500D663B500CE6BB500CE73B500D66BB500D65ABD00DE52
BD00EF52C600FF5AD600FF67DA009C8C9C009C949C00AD8CA900AD94AD009C9C
9C00A59C9C00AD9CA500AD9CAD00B594AD00B59CAD00BD849C00C6849C00C68C
9C00C6949C00C68CA500C694A500C684AD00C68CAD00C67BB500C684B500CE7B
A500CE7BB500CE84BD00D68CC600E794CE00FF7BDE00FF84DE00FF84E700FF8C
E700FF94E700B4B0B200C8B7C100D3CCD000E6B9D600DED6DE00E7D6E700EFD6
E700FF9CE700FFA5EF00F7ADE700FFADEF00FFBDEF00F7CEEF00FFCEF700DEDE
DE00E7DEE700E7E7E700EFDEE700FFD6F700EFDEEF00EFE7EF00FBDEF300FFE7
FF00EFEFEF00F7EFF700FFEFFF00F7F7F700FFF7FF00FFFFFF00F0FBFF00A4A0
A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
FF00FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7B
BD779C739C733967F75EB656734E1042EF3DEF3DAE398B2DAE398B2D8B2D8B2D
E820E82084108410420800000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000002104
420884108614E8204A298B2DAE391042B656B656F75EB656F75E734E744EF75E
3967BD777B6F9C739C73BD77DE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BBD77BD779C73
9C735B6F9C73F75EB656B6561042AE398B2D4A294208E8204208841084100000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000042088614E8206A29
8B2DEF3D744E734EB656F75E39677B6F9C73BD77BD77DE7BFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BDE7B9C739C737B6F7B6F
F75EB656744E10428B2DE820E82042088614430C240C440C0000240C25100208
010002080208030845108614E820E820CC280D310D314E355035503550395039
7139503950397139503971395039713950395039713950397139503971397139
5039713950397139713971395039713950397139503971395039713950397139
5039503950395039503971395039503971395039503950397139503971395039
7139503950395039503971395039503950395039713950395039713950397139
5039713950397139503971397139713971397139503971395039713950397139
713950397139503971395039503971395039503971395039503950354E350D31
0D31CC28E820E82086144514240C020400000000000000000000000000000100
02044208430C210484108410E8204A298B2D1042F75EB656F75E39679C73BD77
DE7BDE7BFF7FDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BDE7BBD773967F75EB656
734EAE394A298410430C430C02080208030C0208030C481848188C285034EF34
11393445754DB751185A185A185A185A185A185A185A185A185A185A185A185A
185A185A185A185A185A185A185A185AF859185A185A185A185AF755185AF859
185AF755F859185AF755F859F755F859F755F859F855F755F859F755F855F755
F859F755F855F755F855F755F855F755F755F855F755F755F855F755F755F755
F755F755F755F855F755F755F855F755F855F755F855F755F855F755F855F755
F859F755F855F859F755F859F855F859F755F859F859F755185AF859185AF755
185A185AF755185A185A185A185AF859185A185A185A185A185A185A185A185A
185A185A185A185A185A185A185A185A185AF859F859B855764D1445B3405034
2C2448180510010400000000000000000000000000002104430CE8206A291042
734EF75E39677B6FBD77BD77DE7BDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BDE7BFF7F7B6FF75EF75EEF3D
6B2DE820430C240C0204030C040805102C245034153C7B54FB587A59B959F859
185A185A185A185A185A185A185A185A185A185A185A185A185A185A185A185A
185A185A185AF859185AF755185AF859F859F755185AF755F859F755F859F755
F855F755F855F755F855F755F755F755F855F755F755F755F755F755D755F755
F755D755F755D755F755D755F755D755D755F755D755D755F755D755D755F755
D755D755F755D755D755F755D755F755D755D755F755D755D755F755D755F755
D755F755D755F755F755D755F755F755F755F755F755F755F755F755F855F755
F855F755F859F755F859F855F859F755F859185AF859185AF755185A185A185A
F755185A185A185A185A185A185A185A185A185A185A185A185A185A185A185A
185A185A185AF8597A59FB587B54354014382C24481801040000000000000000
0000420800008614AE39734EB65639673967BD77BD77DE7BDE7BFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BFF7F7B6F3967F75E1042E820
4208430C240C020405104818143817441E58BD58FB58B959F859185A185A185A
185A185A185A185A185A185A185A185A185A185AF859185A185A185AF859185A
F755185AF859F755F859185AF755F859F755F855F755F859F755F755F755F855
F755F755D755F755D755F755D755F755D755D755D755D755D755D755D755D751
D755D755D755D755D755D751D755D755D755D751D755D755D755D651D755D755
D751D755D755D751D755D755D751D755D755D755D651D755D755D755D755D755
D755D755D755D755D755D751D755D755D755D755D755D755D755D755D755F755
D755F755D755F755D755F755F755F755F755F755F855F755F855F755F859F755
F859F855F859185AF859185AF755185A185A185AF859185A185A185A185A185A
185A185A185A185A185A185A185A185A185A185AD9597A59BD585E581A50153C
2C24261400000000020400000000210486148B2D1042F75E39677B6FBD77DE7B
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BDE7BBD779C733967734E4A290000
0000000002042C2414381B501F5C5E58FB587A59185A185A185A185A185A185A
185A185A185A185A185A185A185A185A185A185A185AF859185AF859F859F755
F859F755F859F755F755F855F755F755D755F755D755F755D755D755F755D755
D755D755D755D755D755D755D755D755D755D751D755D755D651D755B651D751
B651B755D755B651B755B751B651B755B651B755B651B755B651B751B651B755
B651B751B651B751B751B651B751B751B651B751B651B751B751B651D751B751
D651B751B751D751B751D651B751D755B651D751D755D751D755D751D755D755
D755D755D755D755D751D755D755D755D755D755D755D755F755D755F755D755
F755F755F755F755F855F755F855F755F859F855F859F755185AF8591856185A
185A185AF859185A185A185A185A185A185A185A185A185A185A185A185A185A
B9591B5D7B541E5C1E58153C2C2405100000000001000000420886148B2DB656
39677B6F9C73DE7BDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BBD77BD773967F75EEF3D84100000
000004082C241A4C1E5C1F5C3E5CFB58B959F859185A185A185A185A185A185A
185A185A185A185A185A185AF859185AF755185AF755F859F755F859F755F855
B83A372337233723372337233723372337233723372337233723372337233723
B755D755D755D651D755D751D755B651D751B751D751B651B751B751B751B651
B83A372337233723161737233723161737233723161737233723161737233723
37231617B83A9651B651B651B651B651B651B651B651B751B651B651B651B751
B651B651B651B651B651B651B651B651B751B651B751B651B751B651B751B751
B651B751B751D651B751D751B651D755D751D755D751D755D755D755D755D751
D755D755D755D755D755D755F755D755F755F755F755F755F755F855F755F859
F755F859F859F755185AF8591856185A185AF859185A185A185A185A185A185A
185A185A185A185A185AF8595B5D5E581E5C1F5C1B5414384818000000000104
430886148B2D734EB6563967BD77DE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BDE7B5B6F744EAE3922040104
02042C241A4C1F5C1F5C1E5CBD587A59185A185A185A185A185A185A185A185A
185A185AF859185A185A185AF755F8591856F859F755F859F755F855F755F755
F755F755D72AD703F703F703F703F703F703F703F703F803F703F703F703F703
F703D707D751B651B751B751B751B651B751B651B751B651B651B651B651B651
B651B6513817F703F703F703F703F703F703F703F703F803F703F703F703F703
F703F703D703F703D72A964D9651965196519651965196519651964D9651964D
96519651964D9651964D9651B65196519651B64D9651B6519651B6519651B651
B651B651B651B651B651B751B651B651B751B651B751B751B651B751B751D651
B751D755D751D755D755D751D755D755D755D755D755D751D755D755F755D755
F755F755F755F755F855F755F859F755F859F755F859185A185A185A185A185A
F859185A185A185A185A185A185A185A185A185AB959FB581E5C1F5C1E581D58
14380510040800000000E8204A291042F75E7B6FBD77DE7BFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BBD777C737B6FAE3984100104
4818153C1E5C1F5C1F5C5E58FB58D959185A185A185A185A185A185A185A185A
185AF859185AF755185AF859F755F859F755F859F755F755F855F755F755D755
F755D755D755D755384ED72AD72AD72A970BF703F703F703F703F703F703970F
D72A362EB83A362ED751B651B651B651B651B651B651B6519651B6519651964D
96519651964D9651F63D362EB83A362E1617F703F803F703F703F703F703F703
F703D703D7071617D72A362EF63D964D964D954D964D964D954D964D964D954D
9651964D964D954D9651964D9651964D964D9651964D9651964D9651964D9651
965196519651964D96519651964DB6519651B6519651B651B651B651B651B651
B651B751B651B751B651B751B751B651D751B751D755D651D755D755D755D755
D751D755D755D755D755F755D755F755F755F755F855F755F855F755F859F755
F859F755185A185A185AF859185A185A185A185A185A185A185A185AF8597A59
9D541F5C1F5C1E581A4C2C2402040000020842088614734EF75E7B6FBD77FF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7B7C733967734E43080000
2C241A4C1F5C1F583F547C39183E3852185A185A185A185A185A185A185A185A
F859185AF755185AF859F755F859F755F855F755F755F755F755D755D755F755
D755D755D755D751D755D755D751D755D751B755D651183E970FF703F703F703
F703D72A9651B6519651B651B65196519651B64D965196519651964D96519651
964D9651964D964D9651964D964D754D964D964D9541F703F703F703F703F703
F703F703D703D72A7549764D754D764D754D764D754D764D754D764D754D764D
754D764D754D764D754D964D754D764D954D764D764D954D764D964D764D954D
964D964D964D954D964D964D9651964D9651954D96519651964D96519651964D
96519651B64D9651B651B651B651B651B651B651B751B651B751B751B651B751
D751D651D755B755D751D755D755D755D751D755D755D755F755F755F755F755
F855F755F855F859F755F859F755185A185AF859185A185A185A185AF755185A
185A185A185A183E183E7E501F581E5C1D585034040801004308E8208B2D744E
39679C73DE7BDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FBD773967B656AE390000
2C241A4C1F5C1F5C7E50392E3723384E185A185A185A185A185A185A185AF859
185AF755185AF859F755F859F755F855F755F755F755D755F755D755D755D755
D755D755D751D755D755D751B755D651B751B751B651B751B651B751B6513723
D703F703F703F703D72A964D9651964D96519651964D9651964D964D954D764D
964D954D764D964D754D964D754D764D754D954D764D9541970BF703F703F703
F803F703F703D707F63D7549754D754D754D754D754D754D754D7549754D754D
754D754D754D754D7549754D754D7549754D754D7549754D754D754D754D754D
754D754D754D754D764D754D764D754D964D764D954D764D964D954D964D964D
964D9651954D96519651964D96519651964D9651B6519651B651B651B651B651
B651B751B651B751B751B651D751B751D755D651D755D755D751D755D755D755
D755F755D755F755F755F755F855F755F859F755F859F755185A185AF859185A
185A185A185A185A185A185A1856D72AB91E7C391F5C1F601E58503405100204
86144A29EF3DB6567B6FDE7BDE7BFF7FFF7FFF7FFF7FFF7FBD775B6F55564A29
051017441F5C1F5CDE48B91ED707B83AF859185A185A185A185A185AF859185A
F755185AF859F755F855F755F855F755F755F755D755F755D755D755D755D755
D755D751D755D751B755D651B751B651B751B651B751B651B651B651B6519651
B6519651D72AD703F703F703F703D72A964D964D954D764D964D954D764D964D
754D964D754D764D754D754D754D754D754D754D754D75499541D707D703F803
F703F703F703F703770B954175495549554D5549554955495549554955495549
554D75495549554955495549554D55495549554D55495549754D5549554D7549
554D7549554D754D7549754D754D754D754D754D7549754D754D754D754D764D
754D764D964D754D964D964D954D964D964D9651964D96519651964D96519651
964DB6519651B651B651B651B651B751B651B751B651B751D751D755D651B755
D751D755D755D755D755D751D755F755F755D755F755F855F755F859F755F859
F755185AF859185A185A185A185A185A185A185A38527817770B7C351F581F60
1B502C240510030CE820AE39B65639679C73DE7BFF7FFF7FFF7FBE7B5B6F5556
124150341F581F5C7E50B91EF80378171856185A185A185A185A185AF859F755
185AF859F755F859F755F859F755F755F755D755F755D755D755D755D755D755
D751D755D751B755D651B751B651B751B651B751B651B651B651B65196519651
B64D9651964D9651964DF63DD703F703F703F7031617964D754D964D754D764D
754D754D754D754D754D7549754D754D5549754D554975495549F63DD707D703
F703F703F703F703F703970F7545554955495549554955495549554955495549
5549554955493549554955495549554955495549554955495549554955495549
5549554955495549554955495549554955495549554D7549554D754D7549754D
7549754D754D754D754D754D754D764D754D764D954D764D964D954D964D964D
9651964D96519651964D96519651B6519651B651B651B651B751B651B751B651
B751B651D755D751B755D751D755D755D755D755D755F755D755F755F755F855
F755F755F859F755F859185AF755185A185AF755185A185A185A185AD72AD703
770B5D391E581F5C153C261404088614AE39744E39679C73BD77FF7FFF7FDE7B
D85E334135401E581E5C392ED703F703D72A185A185A185AF859185A185AF755
F859185AF755F859F755F755F755F755D755F755D755D755D755D755D755D751
D755D751B755D651B751B651B751B651B751B651B651B651B65196519651964D
9651964D9651964D9651954D764D954DF63D970FF703F703F703970F9541754D
754D7549754D7549754D554D5549554D5549554955495549554D5549F63DD703
F703F703F703F703F703D7031617754134453549344535493445354934453445
3445344534453445344534453445344534453445344534453445344535493445
3549344555493445554935495549554955495549554955495549554955495549
5549554D55497549554D754D7549554D754D754D7549754D754D764D754D764D
754D964D954D764D964D954D9651964D9651964D965196519651B651B651B651
B651B651B751B651B751B651D751D755B651D755D751D755D755D755D751D755
F755D755F755F855F755F855F755F859F755185AF859185AF859185A185A185A
185AB83AD707F703B91E7E501E581C5448180408E820AE39744EF75E7B6FFF7F
DE7B3967EF3417445E587E50590FF703F703D72A185A185A185A185A185AF859
F755185AF755F859F755F755F755F855F755D755F755D755D755D755D755D751
D755D751B755D651B751B651B751B651B751B651B651B6519651964D96519651
964D9651964D9651954D764D964D754D964D754D764D95413817F703F703F703
970B954175455549554D5549554955495549554955495549554955493445362E
D703F703F703F703F703F703F703161734453445344534453445344534453445
3445144534453445344534453445144534453445344534451445344534453445
3445344534453445344534453445344534453445344535493445354934455549
5549344555495549554955495549554955497549554D7549554D754D754D7549
754D754D764D754D764D754D964D754D964D954D9651964D9651964D9651964D
9651B651964DB651B651B751B651B751B651B751D651B755D751D755D651D755
D755D755D755D755F755D755F755F755F755F859F755F855F755185A185AF755
185A185A185A185A584ED703F703D7037C351F5C1E5C2C2426148614AE39B656
F75EFF7FDE7B4E351A501E583D41D703F703F703D72A185A185A185AF859185A
F755185AF755F859F755F755F755F855D755F755D755D755D755D755D751D755
D751B755D651B751B651D651B751B651B651B651B6519651964D96519651964D
9651964D9651754D964D964D764D954D764D764D754D764D754D754D75491617
F703F703F703D707F63D55495549554955493445554955493445354934453445
362ED703F703F703F703F703F703F703B91E3341144514453445144514453445
1445334114451445144514451445144514453341144514451445144534451445
1445144514451445144514453445144534451445344534453445344534453445
3445344534453549344535493549554935493445554935495549554955495549
55495549754D7549754D7549754D764D754D764D964D764D964D964D964D964D
9651964D9651965196519651B6519651B6519651B651B751B651B751D651B755
D751B755D751D755D751D755D755D755F755D755F855F755F755F859F755F859
F755185AF859185AF755185A185A584EF703F703F703392E1F581E5C2C242614
E8201042F75EFF7FB6561A4C1E5C3D41D703F703F7037817185A185AF755185A
185AF755F859F755F859F755F755F855F755D755F755D755D755D755D755D751
D755D751B755D651B751B6515341EF340D31EF340D31EF340D310D31EF340D31
0D31EF340D310D310D31EF34CD2C0D310D31CD2C0D31CD2C0D31CD2C0D313445
7549554D362EF703F703F703D703362E55495549344555493445344534453445
3445362EF703F703F703F803F703F703F703362E134114451139CD2C8C288C28
CD2C8C288C28B0341445144514451445D34014451445D1388C288C28CC288C28
8C288C2811391445144514451445144514451445144514451445334114453445
14453445CD2C8C2833413445EF34CD2CEF34CD2CEF34EF34EF34EF34CD2CEF34
EF34EF34EF34EF3455491241EF34EF34EF34EF34EF34EF34EF34EF34EF34EF34
EF34EF34EF347549965153415035EF3450355341B65150397549B651B651B751
B651B751B651D755D6515039503950395241D755F755D755F755F755F855D755
F859F755F855F755185AF859185A185AF755185AB83AF703F703F703B91E1F5C
1C542C24440C6A291042FF7F35491F5CDE48D703F703F703D703584E185AF859
185A185AF755185AF755F859F755F755F755F755D755F755D755D755D755D751
D755D751B755D651B751D751B651B751E8200000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000240C554955495549F63DD703F703F703D703362E34453445354534453445
34451445B91ED703F703F703F703F703F703D703362ED3401445144501040000
000000000000000000008C28D340D340D340D340D340D440D340000000000000
00000000000000008C28D440D3401445D34014451445D3401445144514451445
1445144513414818000000001139D34000000000000000002510461446144614
48188614461446144818E8203549CC2800000000000001044614861446144614
86140308000000000000E820764D86140000000000000D31964DCC2801045039
B651B751B651B751B651D751B7550000000000000000954DD751D755F755D755
F755F755D755F859F755F859F755185AF859F755185A185A18567817F703F703
F703392E1F5C1A4C0408420810427D771E581F5C590FF703F703F7033723185A
185A185AF859F755F859F755F859F755F855F755F855D755F755D755D755D755
D755D751D755B751D755B651B751B651B651B751E82000000000000000000000
00000104754993495549534175495341754953413341EF340000000000000000
0000000000000104554955495549344595419707F703F703F703161734453445
3445144534451617D703F703F703F703F703F703D703F32DD4401445D340D444
00000000000000000000000000004818D444D340D340B340D340B340B3400000
0000000000000000000000008C28D340D340D340D340D340D340D440D340D440
1445D3401445D138240C00000104CD2C14451241000000000000000034453445
344534453445344535495549344555495549CC2800000000000046147549554D
7549754D754D8C28000000000000E820764D4614000000000000CD2C9651B64D
EF340104CC28B651B651B651B751B651B75100000000000000009349D755D755
D755D755D755F855F755F855F859F755F859F755F859185A1856F859185A584E
F703F703F703F703DE481E582C2400006A291F6E1F5C7C35F803F703F703F703
584E1856185AF859F755185AF755F859F755F755F755F755D755F755D755D755
D755D751D755D751B651D755B651B751B651B751B651B751E820000000000000
00000000000022049651754D964D954D764D754D754D754D754D754D48180000
0000000000000000000001045549554934455549344575411617F703F703F703
16175341144533411617F703F703F703F703F703F703D70794311445D340D440
D340D34000000000000000000000000000004818D340B340B340B340B340B340
D13800000000000000000000000000008C28B340B340D340B340D340D340D340
D340D340D340D340CD2C01040000030CD13814451445D1380000000000000000
8C28CC288C288C28CC281341344534455549344555498C280000000000004614
5549754D5549754D7549E8200000000000004818964D86140000000000000D31
964D9651964D53414208240C440C440C86144614861400000000000000009349
D755D751D755F755D755F755D755F755F755F755F855F755185AF859F755185A
185A185A970FF703F703F70338171F5C1A5000008410DF641F5C3817D703F703
F703D707185A185AF755185AF859F755F859F755F855F755F855D755F755D755
D755D755D755D751D755D751B755D651B751B651B651B751B651B651CC28440C
430C240C430C240C240C4614954D964D754D764D764D754D764D754D55491139
4510000000000000000000000000020455495549344555493445344535451617
D703F703F703770B74351617F703F703F703F703F703F70397077435D340D340
D340D340D340D34000000000000000000000000000004818B340B340D138B340
B340B340B03400000000000000000000000000008C28B340B340B340B340B340
D340B340D340D340D3408C28000000004614D3401445D3401445113900000000
0000000025104510251045104510134134453549344555493445CC2800000000
000046145549754D5549754D554D8C28000000000000E820764D461400000000
0000CD2C964D9651964DB651954D861400000000CC28B651B751000000000000
00009349D755D751D755D755D755F755D755F855F755F859F755F859F755185A
F755185AF859185A3723F703F703F803D7037E501F5C040800005F5C1F5CD703
F703F703F7037817185AF859185A185AF755185AF755F859F755F755F755F755
D755D755D755D755D755D751D755B751D651B755B751B651B751B651B651B651
96519651964D9651964D9651964D954D964D754D964D754D5241CD2CE820240C
0000000000000000000002088614CC2811393445554934453549344534453549
34453445362EF703F703F703F703F703F703F703F803F703D703770B5439D340
D340D440D340D340D340B34000000000000000000000000000004818B340B340
B340B340D138B340503400000000000000000000000000008C28B340B340B340
D138B340B340B340D340D1382614000000008C28D340D3401445D3401445D138
000000000000000014451445344514453445144534453445344535493445CC28
000000000000451455495549554955497549E8200000000000004818954D4614
0000000000000D31954D9651964D96519651B651CC28000000008614954D0000
0000000000009349D755D751D755D755F755D755F755D755F855F755F859F755
F859F755185A185AF859185AD72AF703F703F703F7037C391F5C481800003E5C
1F5CF803F703F703F8037817F859185A185AF755F859F755185AF755F859F755
F859D755D755F755D755D755D755D751D755B651D755B751B651B751B651B651
B751B6519651B651964D96519651964D96517549EF34CC284510010400000000
0000000001004514CC28EF343341554955495549554955493445554934453549
344534453445344534459535D703F703F703F803F703F703F703F703770B133D
D340D340D340D340D340D340B340D34000000000000000000000000000004818
B340D138B3405034B3405034D13800000000000000000000000000008C28D138
B340B340B340B340B340B340B034020400000104B034D340D3401445D3401445
D340D3400000000000000000CC28CD2C8C28CD2CCD2CCD2CCD2CCD2CCD2CCD2C
3549CC28000000000000240CCC28CC28CC28CC28CC280000000000000000E820
764D4614000000000000CD2C964D9651964D9651B651964DB651503901040000
020800000000000000009349D755D751D755D755D751F755D755F855F755D755
F855F755F8591856F859F755185A185AB83AF703F703F703F7037C351F5C4818
02085F5C1F5C9707F703F703F703970F185A185A185AF755185AF859F755F755
F855F755F755D755F755D755D755D755D755D751D755B751D755B651B751D651
B751B651B651B751B6519651964D5241CC288614030C00000000000000000000
240CE820CD2C3341754D7549554D55495549554D554955495549344555493445
5549344534453445344534451445F32DB803F703F703F703F703F703F7031617
133DD444D3401445D340D444D340D340D340B340000000000000000000000000
00004818B340B340D138B340D138B3408C280000000000000000000000000000
8C28B340B340D138B340B340B3408C2800000000240CD138D444D340D340D340
1445D3401445D340CD2C8C288C28CC288C288C28CC288C28CC288C28CC28CC28
CD2CCD2C35491139CD2CCC28CD2CCC28CD2CCC28CD2CCD2CCD2CCD2CCD2CCD2C
0D313341954D33410D31CD2C0D3152419651964D9651964D9651B6519651B651
75490D310D310D31EF340D315035B755D651D755D755D755F755D755F755D755
F755F859F755F859F755F859F755185A185AF755D72AF703F803F703F7033D41
1F5C2614E8207F691F5C392EF803F703F703D7031856185AF859185AF755F859
F755F859F755F755F855D755F755D755D755D755D751D755D755D751B651D751
B651B755B651B751B6519651EF34440C0000000000000000000000008614CD2C
5039554D964D754D754D764D7549754912410D31EF34CD2CEF34CD2CEF34EF34
34455549344535493445344534453445362ED703F703F703F703F703F703F703
D70394311445D3401445D340D340D340D340D340D340D3400000000000000000
0000000000004818B340B340B340B340B3404818000000000000000000000000
000000008C28B340B340B340D340B3404818000000004818D340D340D340D440
D3401445D3401445D34014451445334114451445144534451445344534453445
35493445344555493445554934455549554955495549554D7549554D7549754D
754D7549764D954D764D954D764D9651754D964D9651964D96519651B64D9651
B751B651B651B751B651D755B651D751B755D751D755D755D751D755D755D755
F855F755F855F755F755F859F755185AF8591856F859185A3723F703F703F703
D7031F581E5C0204AE39BF761F5CDE48D703F803F703F703B83A185A185AF859
F755185AF755F859F755F859F755F755D755F755D755D755D755D755D751D755
B751D755B651D751B651B651B751B651E8200000000000000000000000000204
9651954D764D964D754D754D764D754D764D754D8C2800000000000000000000
000001045549554934453549554934453445362EF703F703F703F803F703F703
F703F703F703D703362ED34014451341D444D3401445D340D444D34000000000
000000000000000000004818D444D340B340D138261400000000000000000000
00000000000000008C28B340D340B340D138240C000000008C28D340D444D340
1445D3401445D444134114451445144514451445144534451445344534453445
34453445344535495549344555495549554955495549554D5549754D5549754D
7549754D754D764D754D764D954D764D954D964D9651964D9651964D9651B64D
9651B6519651B651B751B651B751B651D755B751D755D651D755D751D755F755
D755F755F755D755F755F755F859F755F859185AF755185AF8593852D707F703
F703F803392E1F58153CE820534EFF7FBE601F5C392EF803F703F7037817185A
F755185A185AF755F8591856F755F755F755F755F855D755F755D755D755D755
D751D755D755B651D751B755B651B751B651B651E82000000000000000000000
000000005241964D954D9651954D764D954D754D754D754DE820000000000000
0000000000000104554955495549554934453549362EF703F703F703F703F703
F703D803362ED707F703F703D703362E1341144513411445D3401445D3401445
00000000000000000000000000004818D340D340B0340208000001048C280000
0000000000000000000000008C28D340D440CD2C020400000208B034D3401445
D3401445D3401445144513411445144514451445144534451445344534453445
3445344534453549554934455549344555495549554955495549754D5549754D
5549754D754D754D764D754D964D754D964D754D9651964D9651964D9651964D
B6519651B751B651B651B751B651B751B651D751B755D651D755D751D755D755
D755D755F855F755D755F755F859F755F859F755185AF755185A185A185AB83A
F703F703F70397073F541F5C8C28F44DB656FF7FFF761F5C1F583817D703F703
F703B83A185A185AF859F755185AF755F859F755F859F755F755F755D755F755
D755D755D755D751D755D751D755B651D751B651B751B651CC28000000000000
00000000000000000000240C4510451045104510451045144510451001040000
000000000000000000000104554955495549554955491617D703F703F703F803
F703F703D703F32D35497541770BF703F703F703161713411445144514451445
134114450000000000000000000000000000240C4818461400000000240CD340
D3400000000000000000000000000000240C48184614000000004510D3401341
1445144513411445144514451445144514451445344534453445344534453445
34453445354955493445554934455549554955495549554D5549754D5549754D
5549754D754D7549764D754D964D754D964D754D964D9651954D9651964D9651
964DB6519651B651B651B651B751B651B751B651D755B651D755D751D755D755
D751D755F755D755F755D755F755F859F755F855F859F755185A185AF755185A
3852D707F703F703D703DE481E5C343C934939677C73FF7FFF7F1F6E1F5C3F54
3817D703F803D707584E185A185AF859185AF755F859185AF755F855F755F859
F755D755F855D755D755D755D751D755D755D751B651D755B751B6519349E820
4510451045144510451045144510451045104514451045104510451045104510
45104510451045104510451045104614754D7549554975491617F703F703F703
F703F703F703D707953555493445344555451617F703F703F703770B53413341
3445144514451445CD2C25102510440C2510240C2510240C2510440C25108C28
1341144513418C282510440C2510440C2510440C2510240C251045108C281445
1445144514451445144514453445144534453445344534453445344534453445
354934455549344555493445554955495549554955495549754D5549754D5549
754D7549754D754D764D754D964D754D964D754D964D9651964D9651964D9651
964DB6519651B651B651B751B651B751B651B751D651B755D751D755D751D755
D751D755D755F755D755F755F755F855F755F859F755F859185AF755185AF859
185A18563723F703F703D7033D411E581A4C7549D85E5B6FDE7BFF7FFF7FFF7F
9F691F5C1F58B91EF703F703970F3856185A185A185AF755185AF755F859F755
F859F755F755F755F755D755F755D755D755D755D755D751D755D751B651D755
B651B751B651B651B751B651B6519651B751964DB651964D9651964D9651964D
954D964D754D964D754D764D754D754D764D754D754D554975493817F703F703
F703F703F703F703D70795355549554934455549344555491617F703F703F703
9707953534453445344534453445144534451445344514451445344514451445
1445144514451445144514451445144514451445144514451445344514453445
1445344534453445144534453445344534453445344534453549344534453549
344555493445554955495549554955495549554D5549754D5549754D5549754D
7549754D764D754D764D754D964D754D964D754D964D9651954D9651964D9651
964DB6519651B651B751B651B751B651B651B751D651B755D751B755D651D755
D755D755D755F755D755F755F755F755F859F755F855185AF755185AF755185A
185A185A185AD72AF703F7039707DE481E5C1A500D31D85E9D77BE7BDE7BFF7F
FF7FFF7FFF7FFF6D1F5C1F5C7C35D703F703970F3852185A185A185A185A185A
F755185AF755F859F755F859F755F755F755D755F755D755D755D755D751D755
D755D751B755D651B751D755B651B751B651B651B651B65196519651B64D9651
964D9651964D964D9651954D764D954D764D754D964D754D954D9541970FD703
F703F803F703F703F703970B954155495549554955495549554955495549362E
F703F703F703D703362E34453445344534453445354934453445344534453445
3445344534453445344534453445344534453445344534453445344534453445
3445344534453445344534453549344534453549344555493445554934455549
554955495549554955495549554D5549554D75495549754D5549754D7549754D
754D754D754D764D954D764D954D764D954D9651964D9651964D9651964D9651
B64D9651B6519651B651B651B751B651B751B651D751B755D651D755D751D755
D751D755D755F755D755F755D755F755F855F755F859F755185AF859F755185A
F859185A185A185AD72AF703F703B91E3F541F5C1A4C0D315B6FBD77DF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7F9F763E5C1F5C7E50B91EF703970B584E185A185A
185AF755185A185AF755185AF755F859F755F859F755F755F755D755D755F755
D755D755D755D751D755D751D755B651B751D651B755B651B751B651B651B751
B6519651B6519651964D9651964D9651964D9651954D964D954D764D9541970B
F703F703F703F703F703F703970F95417549554D75495549554D554955495549
5549554D362ED703F703F703D703B91E34455549554955493445554934455549
3445354934455549344535493445354934453445354934455549344535493445
5549344535493445554934455549554934455549554955495549554955495549
55495549554955495549554D75495549754D5549754D7549754D764D754D754D
764D754D964D754D964D754D964D9651954D964D9651964D9651964D9651964D
B6519651B651B651B751B651B751B651B751D651B751D755B651D755D751D755
D755D755D755F755D755F755F755F755F859F755F859F755185AF755185AF755
185A185A185A185A18563723F80397077C391F5C1F601438AE39BD77FF7FDE7B
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F7E77DF641F5C1F5C3D413817D703
B83A185A185A185A185AF859185AF755185AF755F859F755F755F859F755F855
F755F755D755F755D755D755D755D755D751D755D751D755B651B751D651B755
B651B751B651B651B651B751B65196519651B64D9651964D9651964D9651F63D
D707F703F703F703F703F703D703970F9541754D764D754D754D754D754D7549
754D7549554D75495549F63DD707F703F703F703161775455549554955495549
5549554955495549554955495549554955495549554955495549554955495549
55495549554955495549554955495549554955495549554D554955495549754D
55495549754D5549754D7549754D754D7549754D764D754D754D764D754D754D
964D754D964D764D954D964D9651964D9651964D9651964D9651964DB6519651
B651B751B651B651B751B651B751B651B751D651B755D651D755D751D755D755
D755D755F755D755F755D755F755F855F755F859F755F859F755185AF755185A
F859185A185A185A185A584E970FB803392E1F581F5C1D588C28B656FF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F7F725F5C1F5C
1F5C3D41381738175852185A185A185A185AF859185AF8591856185AF859F755
F859F755F755F859F755F755F755D755D755F755D755D755D755D751D755D751
D755B651D751B651B751B651B751B651B651B751B651B6519651B7519651964D
F63DD703F703F703F803F703F703F70378177549964D954D764D954D764D754D
954D764D754D754D754D754D764D754D9541770BF703F703F703770B95417549
754D5549754D5549754D55495549754D55495549754D55495549754D5549554D
75495549554D75495549754D55497549554D7549754D7549554D7549754D7549
754D754D7549754D764D754D754D754D764D754D754D764D954D764D954D764D
954D964D9651954D9651964D9651964D9651964D9651964DB6519651B651B651
B651B751B651B651B751B651B751D651B755D651D755D751D755D751D755D755
D755D755F755D755F755F855F755F755F859F755F859F755185AF755185AF859
185A185A185A185AF859185AD72A970F392E1F581F5C1F5C1438EF3DBD77FF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
DF7F1F6E3E5C1F5C1F5CDE48392ED72A1856185A185A185A185A185AF859185A
F755185A185AF755F859F755F859F755F755F855F755F755D755F755D755D755
D755D755D755D751D755D751D755B751D651B755B651B751D651B751B651B651
B651B83AD703D703F703F703F703F703F7033817B64D9651964D9651964D9651
954D964D9651764D954D764D954D764D754D964D754D964D970FD703F703F703
D707F63D7549754D764D7549754D764D754D754D764D754D754D754D754D754D
754D7549754D754D754D764D754D754D754D754D754D764D754D754D754D764D
754D754D764D754D754D964D754D964D754D964D754D964D964D9651954D9651
964D9651964D9651964D9651964DB6519651B6519651B651B651B651B651B751
B651B751B651B751B651D751B755D651D755D751D755D751D755D755D755D755
F755D755F755F755F755F755F859F755F859F755185AF755185AF8591856F859
185A185A185A185A185A185AB83AB91E7C391F581F5C1E5C153C71397B6FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FBF7F3F725F5C1F5C1F5C3F543D41DA4D1856185A185A185A
185A185A185AF859185AF755185AF755185AF755185AF755F859F755F855F755
F755F755D755D755F755D755D755D755D755D751D755D751D755D651B755B651
B651B755D72AD703F703F703F703F703F803F7031617B651B651964DB6519651
964D9651964D9651964D9651964D9651964D9651964D9651954D964D964D970F
D703F703F703D703D72A754D9651754D964D754D964D754D764D954D764D754D
964D754D764D954D764D754D964D754D964D754D964D754D964D754D964D954D
764D954D964D9651964D954D9651964D9651964D964D9651964D9651964D9651
964D9651964DB6519651B651B6519651B651B651B651B651B751B651B751B651
B751B651D755B651D755D651D755D751D755D751D755D755D755D755D755F755
D755F755F755F755F855F755F859F755185AF755185AF755185AF859185A185A
185A185A185A185A185A185AF9517C399D541F581F5C1E58343C52417B6FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FBF761F651F5C1F5C1F5C3E5CFB58
F859185A185A185A185A185A185A185AF859185AF859185AF755185AF755F859
F755F859F755F859F755F755F855F755D755F755D755D755D755F755D755D755
D751F74DB83A970FD703F703F803F703F703F703F703F703D72AB651B751B651
9651B651B651B751B651B6519651B651B65196519651B64D96519651964D9651
964D3723D703F703F803F703F703970F362EB64D964D964D954D9651964D964D
9651964D9651964D964D9651964D9651964D964D9651964D964D9651964D9651
964D9651964D9651964D9651964D9651964D9651964D9651B6519651B6519651
B651B651B651B751B651B651B651B751B651B751B651B751B651B751D651B755
D651B751D755D751D755D751D755D751D755D755D755D755F755D755F755F755
F755F755F859F755F859F755F859F755185AF859F755185A185AF859185A185A
185A185A185A185A185AF8597A595E581E5C1F5C1F5C1A50B340334E9C73FF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F9F7F5F72DF64
1F5C1F5C1F5CBD587A59185A185A185A185A185A185A185A185A185AF859185A
F859185AF755185AF755185AF755185AF755F755F859F755F755F755F755F755
183ED707D703F703F703F703F703F703F703F703F803F703F703F703F703D703
D707D7077817B651B751B651B751B651B651B751B651B651B651B651B651970F
D707D707D703F703F703F703F703F703F703F703F703F703D703D707D72A964D
96519651B64D96519651B64D96519651B651964D9651B6519651964DB6519651
B6519651B64D9651B651B651B6519651B651B651B651B751B651B651B651B751
B651B651B751B651B651B751B651B751D651B751D755B651D751D755D751D755
D751D755D751D755D755D755D755D755F755D755F755F755F755F755F755F855
F755F859F755F859F755185AF755185AF859185AF755185A185A185A185A185A
185A185A185A185A185AB959FB583E5C1E5C1F5C1B50343C9349F75EFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7F9F7F5F721F653E5C1F5C3E5CBD589A59F859185A185A185A185A185A
185A185A185A185A185AF859185AF755185AF859F755185AF859F755185AF755
F859F755B83AF703F703F703F703F703F703F703F703F703F703F703F803F703
F703F703F703F703970FD751D755D751D751D651B755D751B651B751D755B651
B751D707F703F703F703F703F703F703F703F703F703F703F703F703F703F703
D72AB651B651B651B751B651B651B651B751B651B651B651B651B751B651B651
B751B651B651B751B651B751B651B751B651B651B751B651B751B651B751D651
B755B651D751D755B651D751D755D751D755D751D755D755D755D755D755D755
D755D755D755D755F755D755F755F755F755F755F859F755F859F755F859F755
F859F755185AF755185AF8591856185AF859185A185A185A185A185A185A185A
185A185A185A185AB9591B5D5E581E5C1F5C1A4C343C9349F75EDE7BFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FDF7FFF76FF6D1F651F5C3E5CBD585B5DF859
185AF859185A185A185A185A185A185A185A185A185A185AF859185AF755185A
F859F755185AF7551856174E3852384E174E3852174E384E174E384E174E174E
174E174E174E174E174E174E174ED755D755D755D755D755D755D751D755D755
D751D755D755F74D174E174EF74D174EF74D174EF74D174EF74DF74D174EF74D
F74DF74DF74DB651D751B751D651B755D651B751D751B651D755B751D751B651
D751B755D751B651D755D751D755B651D751D755D651D751D755D751D755D751
D755D755D751D755D755D751D755D755D755D755D755D755D755F755D755F755
D755F755F755F755F859F755F755F859F755F859F755F855F755185AF755185A
F859F755185A185AF859185AF859185A185A185A185AF755185A185A185A185A
185A185AF8597A5DFB583E5C1E5C1A4C343C3445534E3967FF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDF7F3F7B5F72
7F69BE605F5CFB585B5DB9591856185A185A185A185A185A185A185A185A185A
185A185A185A185AF859185AF859185AF755185AF755185AF755185AF755F859
F755185AF755F755F859F755F755F855F755F755F755D755F755F755F755D755
F755D755F755D755F755D755D755D755D755D755D755D755D755D755D755D755
D755D751D755D755D755D755D751D755D755D755D751D755D755D755D751D755
D755D755D755D751D755D755D755D751D755D755D755D755D755D755D755D755
D755D755D755F755D755D755F755D755F755F755F755F755F755F755F755F855
F755F755F755F859F755F855F755185AF755185AF755185AF755185AF859185A
F8591856F859185A185A185A185A185A185A185A185A185A185A185A185A185A
F8597A59FB585E581A50153CD444754975523967FF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FDF7F3F7BBE72FF6D7F695D61FB587A599A59F859185A185A
185A185A185A185A185A185A185A185A185A185A185A185A185AF859185AF859
185AF755185AF859F755185AF859F755185AF755F859F755185AF755F859F755
F859F755F755F859F755F755F755F855F755F755F855F755F755F755F755D755
F755D755F755D755F755D755F755D755F755D755F755D755F755D755F755D755
F755D755F755D755F755D755F755D755F755D755F75500000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000}
Stretch = True
IsControl = True
end
end
end
object OKButton: TButton
Left = 81
Top = 158
Width = 75
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 1
end
end
/VCL_DELPHIX_D6/SXMedia/SXAbout.pas
0,0 → 1,53
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
}
unit sxabout;
 
interface
 
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
 
type
TAboutBox = class(TForm)
InfoContainer: TPanel;
Version: TLabel;
Copyright: TLabel;
OKButton: TButton;
Author: TLabel;
WebSite: TLabel;
Credits: TLabel;
LogoContainer: TPanel;
ProgramIcon: TImage;
private
{ Private declarations }
public
{ Public declarations }
end;
 
implementation
 
{$R *.DFM}
 
end.
 
/VCL_DELPHIX_D6/SXMedia/SXEditor.pas
0,0 → 1,122
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
}
unit SXEditor;
 
{$INCLUDE DelphiXcfg.inc}
 
interface
 
uses Windows, Classes,
{$IfNDef VER6UP} DsgnIntf, {$Else} Designintf, DesignEditors, {$EndIf}
Dialogs, SXMovie, SXModPlayer, SXEngine, SXAbout;
 
const
 
SXMOVIE_FILTER = 'All Media Files|*.avi;*.mpg;*.mov|' +
'AVI (*.avi)|*.avi|MPG (*.mpg)|*.mpg|MOV (*.mov)|*.mov';
SXMODPLAYER_FILTER = 'All Media Files|*.mod;*.it;*.sm3|' +
'Impulse Tracker (*.it)|*.it|Scream Tracker (*.s3m)|*.s3m|Fast Tracker (*.xm)|*.xm';
 
type
 
TFilenameProperty = class(TPropertyEditor)
function GetAttributes : TPropertyAttributes; override;
function GetValue : string; override;
procedure SetValue(const Value : string); override;
procedure Edit; override;
end;
 
TSXComponentEditor = class(TComponentEditor)
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
end;
 
implementation
 
{--------------------------------------}
{ TFilename Property Editor }
{--------------------------------------}
procedure TFilenameProperty.Edit;
var
Dialog : TOpenDialog;
begin
Dialog := TOpenDialog.Create(nil);
with Dialog do
try
DefaultExt := 'All Media Files';
if GetComponent(0) is TSXMovie then
Filter := SXMOVIE_FILTER
else
if GetComponent(0) is TSXModPlayer then
Filter := SXMODPLAYER_FILTER
else
Exit;
if Dialog.Execute then
begin
SetStrValue(Dialog.FileName);
Designer.Modified;
end;
finally
Free;
end;
end;
 
function TFilenameProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;
 
function TFilenameProperty.GetValue : string;
begin
Result := GetStrValue;
end;
 
procedure TFilenameProperty.SetValue(const Value : string);
begin
SetStrValue(Value);
Designer.Modified;
end;
 
procedure TSXComponentEditor.ExecuteVerb(Index: Integer);
begin
with TAboutBox.Create(nil) do
begin
try
ShowModal;
finally
Free;
end;
end;
end;
function TSXComponentEditor.GetVerb(Index: Integer): string;
begin
Result := 'A&bout SXMedia';
end;
function TSXComponentEditor.GetVerbCount: Integer;
begin
Result := 1;
end;
 
end.
/VCL_DELPHIX_D6/SXMedia/SXEngine.pas
0,0 → 1,221
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
Testers : Dominique Louis
Ivan Blecic
}
unit SXEngine;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, MMSystem;
 
type
TFramesPerSecond = 1..100;
TFreeCyclesEvent = procedure (Sender: TObject; Count:Integer) of object;
 
TSXEngine = class(TComponent)
private
{ Private Data Members }
FFramesPerSecond:TFramesPerSecond;
FEnabled:Boolean;
FThreadPriority:TThreadPriority;
FFPS:Integer;
FActivate:TNotifyEvent;
FDeActivate:TNotifyEvent;
FRender:TNotifyEvent;
FFreeCycles:TFreeCyclesEvent;
protected
{ Property Accessors }
procedure SetTargetFPS(Value:TFramesPerSecond);
function GetTargetFPS:TFramesPerSecond;
procedure SetEnabled(Value:Boolean);
procedure SetThreadPriority(Value:TThreadPriority);
{ Notification methods }
procedure DoRender;
procedure DoActivate;
procedure DoDeActivate;
procedure DoFreeCycles(Count: Integer);
{ Class Helper methods }
public
{ Public methods }
constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
{Public Properties}
property FramesPerSecond : Integer read FFPS write FFPS;
published
{ Published properties }
property TargetFPS : TFramesPerSecond read GetTargetFPS write SetTargetFPS default 30;
property Enabled : Boolean read FEnabled write SetEnabled default False;
property ThreadPriority : TThreadPriority read FThreadPriority write SetThreadPriority;
{ Published Events}
property OnActivate : TNotifyEvent read FActivate write FActivate;
property OnDeActivate : TNotifyEvent read FDeActivate write FDeActivate;
property OnRender : TNotifyEvent read FRender write FRender;
property OnFreeCycles : TFreeCyclesEvent read FFreeCycles write FFreeCycles;
end;
 
implementation
{$J+}
const
FPS : Single = 33.3;
SECOND : Single = 1000.0;
 
type
TGameThread = class(TThread)
private
{ Private declarations }
FThreadCallback:TThreadMethod;
protected
procedure Execute; override;
property ThreadCallback: TThreadMethod read FThreadCallback write FThreadCallback;
public
constructor Create(CreateSupsended:Boolean;Callback:TThreadMethod);
end;
 
var Thread:TGameThread;
{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,
 
Synchronize(UpdateCaption);
 
and UpdateCaption could look like,
 
procedure TGameThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
 
{ TGameThread }
 
procedure TGameThread.Execute;
begin
{ Place thread code here }
while not Terminated do
begin
try
if Assigned(ThreadCallback) then Synchronize(ThreadCallback);
except
Terminate;
end;
end;
end;
constructor TGameThread.Create(CreateSupsended:Boolean;Callback:TThreadMethod);
begin
inherited Create(CreateSupsended);
ThreadCallback := Callback;
end;
 
{ TSXEngine }
constructor TSXEngine.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
if not (csDesigning in ComponentState) then
begin
if not Assigned(Thread) then
begin
Thread := TGameThread.Create(True,DoRender);
Thread.FreeOnTerminate := False;
Thread.Priority := ThreadPriority;
Thread.Suspended := not Enabled;
end;
DoActivate;
end;
Enabled := False;
TargetFPS := 30;
end;
destructor TSXEngine.Destroy;
begin
if not (csDesigning in ComponentState) then
begin
if Assigned(Thread) then
begin
Thread.Terminate;
Thread.Free;
end;
DoDeActivate;
end;
inherited Destroy;
end;
procedure TSXEngine.SetTargetFPS(Value:TFramesPerSecond);
begin
FFramesPerSecond := Value;
FPS := SECOND / Value;
end;
function TSXEngine.GetTargetFPS:TFramesPerSecond;
begin
Result := FFramesPerSecond;
end;
procedure TSXEngine.SetEnabled(Value:Boolean);
begin
FEnabled := Value;
if Thread <> nil then
Thread.Suspended := not Value;
end;
procedure TSXEngine.SetThreadPriority(Value:TThreadPriority);
begin
FThreadPriority := Value;
if Thread <> nil then
Thread.Priority := Value;
end;
procedure TSXEngine.DoRender;
const Start:DWord = 0;
OldStart:DWord = 0;
Count:Integer =0;
var FreeCycleCount:integer;
begin
try
Start := TimeGetTime;
FreeCycleCount := 0;
if Assigned(FRender) then FRender(Self);
if (Start - OldStart) < SECOND then
Inc(Count)
else
begin
FramesPerSecond := Count;
OldStart := Start;
Count := 0;
end;
repeat
DoFreeCycles(FreeCycleCount);
inc(FreeCycleCount);
until (TimeGetTime - Start) >= FPS;
except
Enabled := False;
Thread.Terminate;
end;
end;
procedure TSXEngine.DoActivate;
begin
if Assigned(FActivate) then FActivate(Self);
end;
procedure TSXEngine.DoDeActivate;
begin
if Assigned(FDeActivate) then FDeActivate(Self);
end;
procedure TSXEngine.DoFreeCycles(Count: Integer);
begin
if Assigned(FFreeCycles) then FFreeCycles(Self,Count);
end;
 
end.
/VCL_DELPHIX_D6/SXMedia/SXModPlayer.pas
0,0 → 1,542
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
Testers : Dominique Louis
Ivan Blecic
Naoki Haga
 
Version History
--------------------------------------------------------------------------------
25/01/2000 Modified Destroy and Stop methods to check IDSBuffer before
calling IBuffer.Stop. Stops the "Buffer not Created exception"
being thrown.
06/02/2000 Added OnStop and OnStart events
Added Finalize method. This does not have to be called but if you
manually finalize and initialize the DXSound Component you
need to call this method to clear the buffers and the Threads.
22/02/2000 Modified SetLoop code to correct functionality.
Modifed Stop method to make sure the OnStop event is only called
if it wsa playing and that the Value of Playing would be False
when the event is fired.
15/05/2000 Made use of the MppSdkLibLoaded variable to make sure the component
does nothing if the mppsdk.dll is not found.
Removed the raising of an exception in the constructor as it seemed to
be causing more problems than it was solving.
--------------------------------------------------------------------------------
}
unit SXModPlayer;
 
{$INCLUDE DelphiXcfg.inc}
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DXSounds, MMSystem, MpSndSys,
{$IFDEF StandardDX}
DirectDraw, DirectSound,
{$IFDEF DX7}
{$IFDEF D3DRM}
Direct3DRM,
{$ENDIF}
Direct3D;
{$ENDIF}
{$IFDEF DX9}
Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8;
{$ENDIF}
{$ELSE}
DirectX;
{$ENDIF}
 
type
 
TModOption = (NoResampling, BassExpansion, Surround, Reverb,
HighQuality, GainControl, NoiseReduction);
 
TModOptions = Set of TModOption;
 
TSXModPlayer = class(TComponent)
private
{ Private declarations }
FFilename: TFilename;
FDXSound : TDXSound;
FSoundBuffer : TDirectSoundBuffer;
FSoundNotify : IDirectSoundNotify;
FBufferDesc : TDSBufferDesc;
FWaveFormat : TWaveFormatEx;
FLoop : Boolean;
FPlaying : Boolean;
FOptions : TModOptions;
FEvents: TList;
FNotify: TList;
FOnStop: TNotifyEvent;
FOnStart: TNotifyEvent;
function GetPosition : Integer;
function GetSilenceData:Integer;
protected
{ Protected declarations }
procedure InitSoundEvents;
procedure ThreadCallback;
procedure SetFilename(const Value : TFilename);
procedure SetLoop(const Value : Boolean);
procedure SetOptions(const Value : TModOptions);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure DoStop;
procedure DoStart;
 
function CreateEventList : TList;
function CreateNotifyList : TList;
function CreateSoundBuffer : TDirectSoundBuffer;
function CreateSoundNotify : IDirectSoundNotify;
procedure ClearSoundNotify;
procedure CreateEventThread;
procedure ClearSoundBuffer;
 
procedure StartThread;
procedure StopThread;
 
property BufferDesc : TDSBufferDesc read FBufferDesc write FBufferDesc;
property WaveFormat : TWaveFormatEx read FWaveFormat write FWaveFormat;
property SoundBuffer : TDirectSoundBuffer read FSoundBuffer write FSoundBuffer;
property SoundNotify : IDirectSoundNotify read FSoundNotify write FSoundNotify;
property Events : TList read FEvents write FEvents;
property Notify : TList read FNotify write FNotify;
public
{ Public declarations }
constructor Create( AOwner : TComponent); override;
destructor Destroy; override;
procedure Initialize(Stream:TMemoryStream);
procedure Finalize;
procedure Play(Loop : Boolean);
procedure Stop;
procedure Reset;
 
property Position : Integer read GetPosition;
property Playing : Boolean read FPlaying;
published
{ Published declarations }
property Filename : TFilename read FFilename write SetFilename;
property DXSound : TDXSound read FDXSound write FDXSound;
property Looping : Boolean read FLoop write SetLoop default False;
property Options : TModOptions read FOptions write SetOptions;
property OnStart : TNotifyEvent read FOnStart write FOnStart;
property OnStop : TNotifyEvent read FOnStop write FOnStop;
end;
 
implementation
 
// If you are having problems compiling the package edit this file.
// Comment out this include Statement. You should only need to do this
// if you are NOT using the latest version of DelphiX (991024)
// Comment this Define out if you are using DelphiX992404 or earlier
{$DEFINE VERSION991024}
 
const
EVENTCOUNT:Integer = 2;
 
type
{Music Event Callback thread}
TSXEventThread = class(TThread)
private
FEventCallback:TThreadMethod;
public
procedure Execute; override;
property EventCallback : TThreadMethod read FEventCallback write FEventCallback;
 
end;
 
 
var
 
EventThread : TSXEventThread;
CurrentEvent : Integer;
 
{ TSXEventThread }
 
procedure TSXEventThread.Execute;
begin
if not Assigned(EventCallback) then Terminate;
while not Terminated do
begin
EventCallback;
end;
end;
 
{ TSXModPlayer }
 
constructor TSXModPlayer.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
if MppSdkLibLoaded then
ModMixer.SetMixerOptions(0);
Events := CreateEventList;
Notify := CreateNotifyList;
end;
destructor TSXModPlayer.Destroy;
begin
Finalize;
{}
Notify.Free;
Events.Free;
inherited Destroy;
end;
procedure TSXModPlayer.Initialize(Stream:TMemoryStream);
var Data:Pointer;
Size:Integer;
FreeStream:Boolean;
begin
try
if MppSdkLibLoaded then
begin
if SoundBuffer = nil then InitSoundEvents;
FreeStream := False;
if Stream = nil then
begin
Stream := TMemoryStream.Create;
Stream.LoadFromFile(Filename);
FreeStream := True;
end;
Data := Stream.Memory;
Size := Stream.Size;
ModMixer.FreeSong;
ModMixer.LoadSong(Data,Size);
if FreeStream then Stream.Free;
end;
except
end;
end;
procedure TSXModPlayer.Finalize;
begin
Stop;
if Assigned(EventThread) then
begin
EventThread.Terminate;
EventThread.Free;
EventThread := nil;
end;
ClearSoundNotify;
if Assigned(SoundBuffer) then
begin
try
if Playing and (SoundBuffer.IDSBuffer <> nil) then
SoundBuffer.IBuffer.Stop;
finally
SoundBuffer := nil;
end;
end;
end;
 
procedure TSXModPlayer.InitSoundEvents;
// DelphiX Version 991024 Edit Version.inc to change declarations
{$IFDEF VERSION991024}
var SizeWritten: Cardinal;
{$ELSE}
// DelphiX Version 992404 and earlier
var SizeWritten : Integer;
{$ENDIF}
begin
if MppSdkLibLoaded and Assigned(DXSound) then
begin
DXSound.Primary.IBuffer.GetFormat(@FWaveFormat,Sizeof(WaveFormat),@SizeWritten);
ModMixer.SetWaveFormat(WaveFormat.nSamplesPerSec,WaveFormat.nChannels,WaveFormat.wBitsPerSample);
SoundBuffer := CreateSoundBuffer;
SoundNotify := CreateSoundNotify;
if (SoundBuffer <> nil) and (SoundNotify <> nil) then
CreateEventThread;
end;
end;
procedure TSXModPlayer.ThreadCallback;
var Msg : TMsg;
 
procedure ReadData(Event:Integer);
var W1:pointer;
// DelphiX Version 991024 Edit Version.inc to change declarations
{$IFDEF VERSION991024}
S1, S2 : Cardinal;
{$ELSE}
// DelphiX Version 992404 and earlier
S1,S2:Integer;
{$ENDIF}
NumWrite:Longint;
Pos:Integer;
Written1:Integer;
begin
if Event = 0 then
Pos := TDSBPositionNotify(Notify[EVENTCOUNT -1]^).dwOffset
else
Pos := TDSBPositionNotify(Notify[Event-1]^).dwOffset;
NumWrite := TDSBPositionNotify(Notify[Event]^).dwOffset - Pos;
if (NumWrite < 0) then
inc(NumWrite,BufferDesc.dwBufferBytes);
if SoundBuffer.IBuffer.Lock(Pos,NumWrite,w1,{$IFDEF UNICODE}@{$ENDIF}s1,Pointer(nil^),{$IFDEF UNICODE}@{$ENDIF}s2,0) = 0 then
begin
Written1 := ModMixer.Render(W1,S1);
SoundBuffer.IBuffer.Unlock(w1,Written1, nil,0);
if (Written1 = 0) then
Stop;
end;
end;
 
begin
CurrentEvent := MsgWaitForMultipleObjects(EVENTCOUNT,Events.List{$IFNDEF UNICODE}^{$ENDIF}[0], False, INFINITE, QS_ALLINPUT);
dec(CurrentEvent,WAIT_OBJECT_0);
if CurrentEvent >= EVENTCOUNT then
begin
while (PeekMessage(Msg, 0, 0,0, PM_REMOVE)) do
begin
if Msg.Message = WM_QUIT then
Stop
else
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end
else
begin
ReadData(CurrentEvent);
end;
end;
function TSXModPlayer.CreateEventList : TList;
begin
Result := TList.Create;
Result.Capacity := EVENTCOUNT;
end;
function TSXModPlayer.CreateNotifyList : TList;
begin
Result := TList.Create;
Result.Capacity := EVENTCOUNT;
end;
function TSXModPlayer.CreateSoundBuffer : TDirectSoundBuffer;
{$IFDEF UNICODE}
const DSBCAPS_CTRLDEFAULT = DSBCAPS_CTRLPAN or DSBCAPS_CTRLVOLUME or DSBCAPS_CTRLFREQUENCY;
{$ENDIF}
begin
Result := TDirectSoundBuffer.Create(DXSound.DSound);
ZeroMemory(@BufferDesc,Sizeof(TDSBufferDesc));
FBufferDesc.dwSize := Sizeof(TDSBufferDesc);
FBufferDesc.dwFlags := DSBCAPS_CTRLDEFAULT or DSBCAPS_STATIC or
DSBCAPS_GETCURRENTPOSITION2 or DSBCAPS_CTRLPOSITIONNOTIFY;
FBufferDesc.dwBufferBytes := WaveFormat.nAvgBytesPerSec * 2;
FBufferDesc.lpwfxFormat := @WaveFormat;
Result.CreateBuffer(BufferDesc);
end;
function TSXModPlayer.CreateSoundNotify : IDirectSoundNotify;
type TNotifyArray = Array[0..99] of TDSBPositionNotify;
var PDSNotify : PDSBPositionNotify;
index : Integer; Offset: Integer;
PNotify: ^TNotifyArray;
begin
Result := nil;
if SoundBuffer.IBuffer.QueryInterface(IID_IDirectSoundNotify,Result) = 0 then
begin
{setup notifications here}
Offset := 0;
GetMem(PNotify,EVENTCOUNT * Sizeof(TDSBPositionNotify));
for Index := 1 to EVENTCOUNT do
begin
New(PDSNotify);
PDSNotify^.dwOffset := OffSet;
PDSNotify^.hEventNotify := CreateEvent(nil,False,False,nil);
Notify.Add(PDSNotify);
Events.Add(Pointer(PDSNotify^.hEventNotify));
PNotify[Index-1] := PDSNotify^;
inc(Offset,WaveFormat.nAvgBytesPerSec div EVENTCOUNT);
end;
 
if Result.SetNotificationPositions(EVENTCOUNT,{$IFDEF UNICODE}@{$ENDIF}PNotify[0]) <> 0 then
ShowMessage('Notification Falied');
FreeMem(PNotify,EVENTCOUNT * Sizeof(TDSBPositionNotify));
end;
end;
procedure TSXModPlayer.ClearSoundNotify;
var PDSNotify : PDSBPositionNotify;
Index : Integer;
begin
for Index := Notify.Count -1 downto 0 do
begin
PDSNotify := Notify[Index];
Notify.Delete(Index);
Events.Delete(Index);
CloseHandle(PDSNotify^.hEventNotify);
end;
SoundNotify := nil;
end;
procedure TSXModPlayer.CreateEventThread;
begin
if not Assigned(EventThread) then
begin
EventThread := TSXEventThread.Create(True);
EventThread.Priority := tpNormal;
EventThread.EventCallback := ThreadCallback;
end;
end;
 
procedure TSXModPlayer.ClearSoundBuffer;
var w1,w2:pointer;
// DelphiX Version 991024 Edit Version.inc to change declarations
{$IFDEF VERSION991024}
S1, S2 : Cardinal;
{$ELSE}
// DelphiX Version 992404 and earlier
S1,S2:Integer;
{$ENDIF}
Data:Word;
begin
Data := GetSilenceData;
if SoundBuffer.IBuffer.Lock(0,0,w1,{$IFDEF UNICODE}@{$ENDIF}s1,w2,{$IFDEF UNICODE}@{$ENDIF}s2,DSBLOCK_ENTIREBUFFER) = 0 then
begin
FillMemory(W1,S1,Data);
if W2 <> nil then
FillMemory(W2,S2,Data);
SoundBuffer.IBuffer.Unlock(W1,S1,W2,S2);
end;
end;
procedure TSXModPlayer.StartThread;
begin
if Assigned(EventThread) then EventThread.Resume;
end;
procedure TSXModPlayer.StopThread;
begin
if Assigned(EventThread) then EventThread.Suspend;
end;
{}
procedure TSXModPlayer.Play(Loop : Boolean);
begin
if MppSdkLibLoaded then
begin
if Assigned(SoundBuffer) and Assigned(EventThread) then
begin
SetLoop(Loop);
ClearSoundBuffer;
StartThread;
FPlaying := True;
DoStart;
SoundBuffer.IBuffer.Play(0,0,DSBPLAY_LOOPING);
end;
end;
end;
procedure TSXModPlayer.Stop;
begin
if MppSdkLibLoaded then
begin
if Assigned(SoundBuffer) and Assigned(EventThread) then
begin
try
if Playing and (SoundBuffer.IDSBuffer <> nil) then
begin
FPlaying := False;
SoundBuffer.IBuffer.Stop;
DoStop;
end;
finally
StopThread;
end;
end;
end;
end;
procedure TSXModPlayer.Reset;
begin
if MppSdkLibLoaded then
ModMixer.SetCurrentOrder(0);
end;
{Property Accessors}
function TSXModPlayer.GetPosition : Integer;
begin
Result := 0;
end;
procedure TSXModPlayer.SetFilename(const Value : TFilename);
begin
if FFilename <> Value then
begin
FFilename := Value;
end;
end;
procedure TSXModPlayer.SetLoop( const Value : Boolean);
var Flags : DWord;
begin
if FLoop <> Value then
begin
FLoop := Value;
if MppSdkLibLoaded then
begin
Flags := ModMixer.GetMixerOptions;
case Value of
True:Flags := Flags or MPPMIX_LOOP;
False:Flags := Flags and (not MPPMIX_LOOP);
end;
ModMixer.SetMixerOptions(Flags);
end;
end;
end;
procedure TSXModPlayer.SetOptions( const Value : TModOptions );
const OptionArray: array[Boolean,TModOption] of Integer = (
(0,0,0,0,0,0,0),
(MPPMIX_NORESAMPLING, MPPMIX_BASSEXPANSION, MPPMIX_SURROUND,
MPPMIX_REVERB, MPPMIX_HIGHQUALITY, MPPMIX_GAINCONTROL,
MPPMIX_NOISEREDUCTION)
);
var Flags : DWord;
begin
if FOptions <> Value then
begin
FOptions := Value;
if MppSdkLibLoaded then
begin
Flags := 0;
Flags := Flags or OptionArray[NoResampling in Value,NoResampling];
Flags := Flags or OptionArray[BassExpansion in Value,BassExpansion];
Flags := Flags or OptionArray[Surround in Value,Surround];
Flags := Flags or OptionArray[Reverb in Value,Reverb];
Flags := Flags or OptionArray[HighQuality in Value,HighQuality];
Flags := Flags or OptionArray[GainControl in Value,GainControl];
Flags := Flags or OptionArray[NoiseReduction in Value,NoiseReduction];
ModMixer.SetMixerOptions(Flags);
SetLoop(Looping);
end;
end;
end;
procedure TSXModPlayer.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification( AComponent, Operation);
 
if (Operation = opRemove) and (AComponent = DXSound) then
DXSound := nil;
end;
procedure TSXModPlayer.DoStop;
begin
if Assigned(FOnStop) then
FOnStop(Self);
end;
procedure TSXModPlayer.DoStart;
begin
if Assigned(FOnStart) then
FOnStart(Self);
end;
function TSXModPlayer.GetSilenceData:integer;
const SilenceData:array[1..2] of integer = ($80,$0);
begin
Result := SilenceData[WaveFormat.wBitsPerSample div 8];
end;
 
end.
/VCL_DELPHIX_D6/SXMedia/SXMovie.pas
0,0 → 1,460
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
Testers : Dominique Louis
Ivan Blecic
}
unit SXMovie;
 
{$INCLUDE DelphiXcfg.inc}
 
interface
 
uses
Windows, Classes, SysUtils, ActiveX, Math, Dialogs,
DXSounds, DXDraws,
{$IFDEF StandardDX}
DirectDraw, DirectSound, DirectShow9,
{$IFDEF DX7}
{$IFDEF D3DRM}
Direct3DRM,
{$ENDIF}
Direct3D;
{$ENDIF}
{$IFDEF DX9}
Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8;
{$ENDIF}
{$ELSE}
DShow, DirectX;
{$ENDIF}
 
type
TMovieOptions = (VideoAndSound, VideoOnly);
TDisplay = (FullScreen, WideScreen, OriginalSize);
 
TScreenRect = class(TPersistent)
private
FLeft: integer;
FRight: integer;
FTop: integer;
FBottom: integer;
procedure SetLeft(Value: integer);
procedure SetRight(Value: integer);
procedure SetTop(Value: integer);
procedure SetBottom(Value: integer);
protected
public
procedure Assign(Value: TScreenRect);
published
property Left: integer read FLeft write SetLeft;
property Right: integer read FRight write SetRight;
property Top: integer read FTop write SetTop;
property Bottom: integer read FBottom write SetBottom;
end;
 
 
TSXMovie = class;
 
TMovieThread = class(TThread)
private
{ Private declarations }
FSXMovie: TSXMovie;
protected
procedure Execute; override;
public
property SXMovie: TSXMovie read FSXMovie write FSXMovie;
end;
 
TSXMovie = class(TComponent)
private
FMovieThread: TMovieThread;
FDXDraw: TDXDraw;
FDXSound: TDXSound;
FMMStream: IMultiMediaStream;
FPrimaryVidStream: IMediaStream;
FDDStream: IDirectDrawMediaStream;
FSample: IDirectDrawStreamSample;
FSurface: IDirectDrawSurface;
FDXSurface: TDirectDrawSurface;
FRect: TRect;
FDestRect: TRect;
FScreenRect: TScreenRect;
FFilename: TFilename;
FPlaying: Boolean;
FDoFlip: Boolean;
{Event}
FOnMovieEnd: TNotifyEvent;
FOnBeforeRender: TNotifyEvent;
FOnAfterRender: TNotifyEvent;
procedure SetFilename(Value: TFilename);
procedure SetScreenRect(Value: TScreenRect);
procedure DoMovieEnd;
procedure DoBeforeRender;
procedure DoAfterRender;
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetMovieStateRun;
procedure SetMovieStateStop;
procedure CreateMediaStream; virtual;
procedure SetupMediaSample; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpDate; virtual;
// function SetDisplay(Value:TDisplay):Boolean;
procedure DisplayRect(Top, Left, Right, Bottom: integer);
procedure Play;
procedure Stop;
{}
published
property DXDraw: TDXDraw read FDXDraw write FDXDraw;
property DXSound: TDXSound read FDXSound write FDXSound;
property Filename: TFilename read FFilename write SetFilename;
property Playing: Boolean read FPlaying;
property DoFlip: Boolean read FDoFlip write FDoFlip;
property DestinationRectangle: TScreenRect read FScreenRect write SetScreenRect;
property OnMovieEnd: TNotifyEvent read FOnMovieEnd write FOnMovieEnd;
property OnBeforeRender: TNotifyEvent read FOnBeforeRender write FOnBeforeRender;
property OnAfterRender: TNotifyEvent read FOnAfterRender write FOnAfterRender;
end;
 
implementation
 
uses Graphics;
 
procedure TScreenRect.SetLeft(Value: integer);
begin
FLeft := Value;
end;
 
procedure TScreenRect.SetRight(Value: integer);
begin
FRight := Value;
end;
 
procedure TScreenRect.SetTop(Value: integer);
begin
FTop := Value;
end;
 
procedure TScreenRect.SetBottom(Value: integer);
begin
FBottom := Value;
end;
 
procedure TScreenRect.Assign(Value: TScreenRect);
begin
Left := Value.Left;
Right := Value.Right;
Top := Value.Top;
Bottom := Value.Bottom;
end;
 
{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,
 
Synchronize(UpdateCaption);
 
and UpdateCaption could look like,
 
procedure TMovieThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
 
{ TMovieThread }
 
procedure TMovieThread.Execute;
begin
{ Place thread code here }
if Assigned(SXMovie) then
SXMovie.SetMovieStateRun;
while (not Terminated) and Assigned(SXMovie) do
begin
Synchronize(SXMovie.UpDate)
end;
if Assigned(SXMovie) then
SXMovie.SetMovieStateStop;
end;
 
{SXMovie}
 
procedure TSXMovie.SetFilename(Value: TFilename);
begin
if Value <> '' then
FFilename := Value;
end;
 
procedure TSXMovie.SetScreenRect(Value: TScreenRect);
begin
FScreenRect.Assign(Value);
end;
 
procedure TSXMovie.DoMovieEnd;
begin
if Assigned(FOnMovieEnd) then FOnMovieEnd(Self);
end;
 
procedure TSXMovie.DoBeforeRender;
begin
if Assigned(FOnBeforeRender) then FOnBeforeRender(Self);
end;
 
procedure TSXMovie.DoAfterRender;
begin
if Assigned(FOnAfterRender) then FOnAfterRender(Self);
end;
 
procedure TSXMovie.Notification(AComponent: TComponent; Operation: TOperation);
begin
if Operation = opRemove then
begin
if AComponent is TDXDraw then FDXDraw := nil;
if AComponent is TDXSound then FDXSound := nil;
end;
inherited;
end;
 
procedure TSXMovie.SetMovieStateRun;
begin
try
if FMMStream.SetState(STREAMSTATE_RUN) <> S_OK then
Exception.Create('Set Movie State Run Exception');
except
end;
end;
 
procedure TSXMovie.SetMovieStateStop;
begin
try
FMMStream.SetState(STREAMSTATE_STOP);
finally
FPlaying := False;
end;
end;
 
procedure TSXMovie.CreateMediaStream;
var
wPath:{$IFDEF UNICODE}array of Char{$ELSE}array[0..MAX_PATH] of WChar{$ELSE}{$ENDIF};
AMStream:IAMMultiMediaStream;
Media:IMediaStream;
begin
Media := nil;
AMStream := nil;
try
CoCreateinstance(CLSID_AMMULTIMEDIASTREAM,nil,CLSCTX_INPROC_SERVER,IID_IAMMULTIMEDIASTREAM,AMStream);
{$IFDEF UNICODE}
SetLength(wPath, Length(Filename) + 1);
StrPCopy(@wPath, Filename);
{$ELSE}
MultiByteToWideChar(CP_ACP,0,PAnsiChar(Filename),-1,wPath,Sizeof(wPAth) div sizeof(wPath[0]));
{$ENDIF}
AMStream.Initialize(STREAMTYPE_READ,AMMSF_NOGRAPHTHREAD,nil);
if (DXSound <> nil) and (DXSound.DSound <> nil) and (DXSound.DSound.ISound <> nil) then
AMStream.AddMediaStream(DXSound.DSound.ISound,{$IFDEF UNICODE}@{$ENDIF}MSPID_PrimaryAudio,AMMSF_ADDDEFAULTRENDERER,IMediaStream(nil^));
AMStream.AddMediaStream(DXDraw.DDraw.IDraw,{$IFDEF UNICODE}@{$ENDIF}MSPID_PrimaryVideo,0,Media);
AMStream.OpenFile({$IFDEF UNICODE}@{$ENDIF}wPAth,0);
FMMStream := AMStream;
except
FMMStream := nil;
end;
end;
 
procedure TSXMovie.SetupMediaSample;
begin
try
FSample := nil;
FDDStream := nil;
FPrimaryVidStream := nil;
if FMMStream.GetMediaStream(MSPID_PrimaryVideo, FPrimaryVidStream) <> S_OK then Exit;
if FPrimaryVidStream.QueryInterface(IID_IDirectDrawMediaStream, FDDStream) <> S_OK then Exit;
if FDDStream.CreateSample(nil, PRect(nil)^, 0, FSample) <> S_OK then Exit;
FDXSurface := TDirectDrawSurface.Create(FDXDraw.DDraw);
if FSample.GetSurface(FSurface, FRect) <> S_OK then Exit;
FDXSurface.IDDSurface := FSurface;
except
 
end;
end;
 
procedure TSXMovie.UpDate;
function AspectRatio(SourceRect: TRect; var DestRect: TRect): Boolean;
var
SourceWidth, SourceHeight, DestWidth, DestHeight: Integer;
SourceRatio, DestRatio: Double;
begin
Result := False;
SourceWidth := SourceRect.Right - SourceRect.Left;
SourceHeight := SourceRect.Bottom - SourceRect.Top;
SourceRatio := SourceWidth/SourceHeight;
 
DestWidth := DestRect.Right - DestRect.Left;
DestHeight := DestRect.Bottom - DestRect.Top;
DestRatio := DestWidth/DestHeight;
if SourceRatio <> DestRatio then
begin
if DestWidth > DestHeight then
DestRect.Bottom := DestRect.Top + Round(DestWidth / SourceRatio)
else
DestRect.Right := DestRect.Left + Round(SourceRatio * DestHeight);
Result := True;
end;
end;
var
R: TRect;
Q: HResult;
begin
try
Q := FSample.Update(0, 0, nil, 0);
case Q of
HResult(MS_S_PENDING):;
HResult(MS_S_NOUPDATE):;
HResult(MS_S_ENDOFSTREAM):;
end;
if Q <> S_OK then
begin
FMovieThread.Terminate;
SetMovieStateStop;
FPlaying := False;
DoMovieEnd;
Exit;
end;
if (FSurface <> nil) and DXDraw.CanDraw then
begin
DoBeforeRender;
R := FDestRect;
if AspectRatio(FRect, R) then
FDestRect := R;
DXDraw.Surface.StretchDraw(FDestRect, FRect, FDXSurface, False);
with DXDraw.Surface.Canvas do
begin
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Size := 8;
Textout(5, 5, 'SilleX Media - Beta 1');
Release;
end;
DoAfterRender;
if DoFlip then
DXDraw.Flip;
end;
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
 
procedure TSXMovie.DisplayRect(Top, Left, Right, Bottom: integer);
begin
if not (csDesigning in ComponentState) then
begin
FScreenRect.Top := Top;
FSCreenRect.Left := Left;
FScreenRect.Right := Right;
FScreenRect.Bottom := Bottom;
end;
end;
 
procedure TSXMovie.Play;
begin
if not (csDesigning in ComponentState) then
begin
FDestRect.Left := FScreenRect.Left;
FDestRect.Right := FScreenRect.Right;
FDestRect.Top := FScreenRect.Top;
FDestRect.Bottom := FScreenRect.Bottom;
FPlaying := True;
CreateMediaStream;
SetupMediaSample;
if FSample <> nil then
begin
FMovieThread := TMovieThread.Create(True);
if Assigned(FMovieThread) then
begin
FMovieThread.FreeOnTerminate := False;
FMovieThread.SXMovie := Self;
FMovieThread.Resume;
end;
end;
end;
end;
 
procedure TSXMovie.Stop;
begin
if not (csDesigning in ComponentState) then
begin
FPlaying := False;
if Assigned(FMovieThread) then
begin
if not FMovieThread.Terminated then
begin
FMovieThread.Terminate;
DoMovieEnd;
end;
FMovieThread.Free;
FMovieThread := nil;
end;
if FDXSurface <> nil then
begin
FDXSurface.Free;
FSurface := nil;
end;
end;
end;
 
constructor TSXMovie.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FScreenRect := TScreenRect.Create;
CoInitialize(nil);
end;
 
destructor TSXMovie.Destroy;
begin
if not (csDesigning in ComponentState) then
begin
FPlaying := False;
if Assigned(FMovieThread) then
begin
if not FMovieThread.Terminated then
FMovieThread.Terminate;
FMovieThread.Free;
FMovieThread := nil;
end;
if Assigned(FSample) then
FSample := nil;
if Assigned(FDDStream) then
FDDStream := nil;
if Assigned(FPrimaryVidStream) then
FPrimaryVidStream := nil;
if Assigned(FMMStream) then
FMMStream := nil;
if Assigned(FSurface) then
FSurface := nil;
end;
FScreenRect.Free;
CoUnInitialize;
inherited;
end;
 
end.
 
/VCL_DELPHIX_D6/SXMedia/SXReg.dcr
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/SXMedia/SXReg.pas
0,0 → 1,53
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
Testers : Dominique Louis
Ivan Blecic
 
}
unit SXReg;
 
{$INCLUDE DelphiXcfg.inc}
 
interface
 
uses Windows, Classes, SysUtils, SXEditor, SXMovie, SXEngine, SXModPlayer,
{$IfNDef VER6UP} DsgnIntf {$Else} Designintf, DesignEditors {$EndIf};
 
procedure Register;
 
implementation
 
{$R SXReg.dcr}
 
 
procedure Register;
begin
RegisterPropertyEditor(TypeInfo(TFilename), nil, 'Filename', TFilenameProperty);
RegisterComponentEditor(TSXMovie,TSXComponentEditor);
RegisterComponentEditor(TSXEngine,TSXComponentEditor);
RegisterComponentEditor(TSXModPlayer,TSXComponentEditor);
RegisterComponents('SX Media',[TSXMovie, TSXEngine, TSXModPlayer]);
RegisterClass(TScreenRect);
end;
 
end.
/VCL_DELPHIX_D6/SXMedia/SxSample/MPPSDK.DLL
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/SXMedia/SxSample/SXMedia.dpr
0,0 → 1,14
program SXMedia;
 
uses
Forms,
main in 'main.pas' {FrmMain};
 
{$R *.RES}
 
begin
Application.Initialize;
Application.Title := 'SXMedia - Example Project';
Application.CreateForm(TFrmMain, FrmMain);
Application.Run;
end.
/VCL_DELPHIX_D6/SXMedia/SxSample/SXMedia.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/VCL_DELPHIX_D6/SXMedia/SxSample/main.dfm
0,0 → 1,765
object FrmMain: TFrmMain
Left = 97
Top = 154
BorderStyle = bsToolWindow
Caption = 'SX Media - Example Project'
ClientHeight = 329
ClientWidth = 536
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = True
OnKeyDown = DXDraw1KeyDown
PixelsPerInch = 96
TextHeight = 13
object DXDraw1: TDXDraw
Left = 0
Top = 0
Width = 536
Height = 329
AutoInitialize = True
AutoSize = True
Color = clBtnFace
Display.BitCount = 16
Display.FixedBitCount = True
Display.FixedRatio = True
Display.FixedSize = False
Options = [doAllowReboot, doWaitVBlank, doCenter, doDirectX7Mode, doHardware, doSelectDriver]
SurfaceHeight = 329
SurfaceWidth = 536
Align = alClient
TabOrder = 0
end
object MainMenu1: TMainMenu
Left = 398
Top = 9
object FileMnu: TMenuItem
Caption = '&File'
object Exit1: TMenuItem
Caption = 'E&xit'
OnClick = Exit1Click
end
end
object SXShowMnu: TMenuItem
Caption = 'SXShow'
object OpenFileItem: TMenuItem
Caption = '&Open File'
OnClick = OpenFileItemClick
end
object PlayItem: TMenuItem
Caption = '&Play'
OnClick = PlayItemClick
end
object StopItm: TMenuItem
Caption = '&Stop'
OnClick = PlayItemClick
end
end
object SXEngineMnu: TMenuItem
Caption = 'SXEngine'
object StartItem: TMenuItem
Caption = 'St&art'
OnClick = StartItemClick
end
object StopItem: TMenuItem
Caption = 'St&op'
OnClick = StopItemClick
end
end
object SXModPlayerMnu: TMenuItem
Caption = 'SXModPlayer'
object OpenFile1: TMenuItem
Caption = 'O&pen File'
OnClick = OpenFile1Click
end
object Start1: TMenuItem
Caption = '&Start'
OnClick = Start1Click
end
object Stop1: TMenuItem
Caption = '&Stop'
OnClick = Stop1Click
end
end
end
object OpenDlg: TOpenDialog
Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofNoLongNames]
Title = 'SXMedia Open'
Left = 364
Top = 8
end
object SXModPlayer: TSXModPlayer
DXSound = DXSound1
Options = [BassExpansion, Surround, Reverb, HighQuality, GainControl, NoiseReduction]
Left = 470
Top = 8
end
object SXEngine: TSXEngine
ThreadPriority = tpIdle
OnRender = SXEngineRender
Left = 438
Top = 10
end
object SXMovie: TSXMovie
DXDraw = DXDraw1
DXSound = DXSound1
DoFlip = True
DestinationRectangle.Left = 0
DestinationRectangle.Right = 200
DestinationRectangle.Top = 0
DestinationRectangle.Bottom = 200
Left = 470
Top = 48
end
object DXSound1: TDXSound
AutoInitialize = True
Options = [soExclusive]
Left = 330
Top = 12
end
object DXImageList1: TDXImageList
DXDraw = DXDraw1
Items = <
item
Name = 'logo_n.bmp'
PatternHeight = 0
PatternWidth = 0
Picture.Data = {
07544269746D61700A520000424D0A520000000000003608000028000000D200
00002D0000000100100003000000D44900000000000000000000000100000000
0000007C0000E00300001F000000000000000000800000800000008080008000
00008000800080800000C0C0C000C0DCC000F0CAA60018081000080000000800
0800080808001000080010080800100010001008100010101000180010001808
10001808180025001800210818001810100022091D0025102100181818002118
1800310427003110290039102D00211821002918210031182900262326003118
310039183100352632004A143B006B0B520066255600493A4600653358006E32
61006F4364008B176E00892E71008E3375009C3184007E4171008E4279009C39
840094468400A5007B00A5107E00A5398400A5398C00A0467F00A0468400A04A
8800AD007F00AD108400A5428C00A54A9000C1009000B9229400D6009C00F534
9500565256005A5A5A00635A5E006363630075566D008452730088567B00A563
6B00A55A7300AD637300A5527B008C5A7B0094568400A1568800A0639400AD5A
8400AD4A8C00AD528C00AD5A8C00AD4A9400AD529400AD5A9400AD529C00AD5A
9C00E75A7300E75A7B00EF527B00EF5A7B00EF4A8400EC4F89009E7A6100B591
5C00B8C232007B71790087878700AF688A00B47B7E00CDAF4000C7CE2F00C0CA
4500CE906000CB898000C0B65B00C4AB7600BDF70000C1F30400C6EF0800BDF7
0800C6F70800BDFF0000BDFF0800C6FF0000C0E41000C1DE1800BDF31000CED6
2100C0E91800BDE22100C4E12D00D600A500D608A500DE00A500DE08A500E700
A500DE00AD00EB00AD00EF00B500F700B500F708B500F700BD00FF00B500FF08
B500FF00BD00FF00C600E221B100F721A500F714B900FF10B100FB10BD00FF08
C600FC18C300EC29AF00EF2DB500E241B700F92DC700FF39CE00E246BD00FF46
D200A57B9C00AD639C00AD6B9C00AD739C00B55A9C00B5639C00B56B9C00B563
A500B56BA500B573A500BD7B9C00BD5AA500BD6BA500BD73A500BD6BAD00D673
9C00C66BAD00BD73AD00BD7BAD00C67BAD00D65AB500D663B500CE6BB500CE73
B500D66BB500D65ABD00DE52BD00EF52C600FF5AD600FF67DA009C8C9C009C94
9C00AD8CA900AD94AD009C9C9C00A59C9C00AD9CA500AD9CAD00B594AD00B59C
AD00BD849C00C6849C00C68C9C00C6949C00C68CA500C694A500C684AD00C68C
AD00C67BB500C684B500CE7BA500CE7BB500CE84BD00D68CC600E794CE00FF7B
DE00FF84DE00FF84E700FF8CE700FF94E700B4B0B200C8B7C100D3CCD000E6B9
D600DED6DE00E7D6E700EFD6E700FF9CE700FFA5EF00F7ADE700FFADEF00FFBD
EF00F7CEEF00FFCEF700DEDEDE00E7DEE700E7E7E700EFDEE700FFD6F700EFDE
EF00EFE7EF00FBDEF300FFE7FF00EFEFEF00F7EFF700FFEFFF00F7F7F700FFF7
FF00FFFFFF00F0FBFF00A4A0A000808080000000FF0000FF000000FFFF00FF00
0000FF00FF00FFFF0000FFFFFF00FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FDE7BBD779C739C733967F75EB656734E1042EF3DEF3D
AE398B2DAE398B2D8B2D8B2DE820E82084108410420800000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000002104420884108614E8204A298B2DAE391042B656B656
F75EB656F75E734E744EF75E3967BD777B6F9C739C73BD77DE7BFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FDE7BBD77BD779C739C735B6F9C73F75EB656B6561042AE398B2D4A29
4208E82042088410841000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000042088614E8206A298B2DEF3D744E734EB656F75E39677B6F9C73BD77
BD77DE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
DE7BDE7B9C739C737B6F7B6FF75EB656744E10428B2DE820E82042088614430C
240C440C0000240C25100208010002080208030845108614E820E820CC280D31
0D314E3550355035503950397139503950397139503971395039713950395039
7139503971395039713971395039713950397139713971395039713950397139
5039713950397139503971395039503950395039503971395039503971395039
5039503971395039713950397139503950395039503971395039503950395039
7139503950397139503971395039713950397139503971397139713971397139
5039713950397139503971397139503971395039713950395039713950395039
71395039503950354E350D310D31CC28E820E82086144514240C020400000000
00000000000000000000010002044208430C210484108410E8204A298B2D1042
F75EB656F75E39679C73BD77DE7BDE7BFF7FDE7BFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
DE7BDE7BBD773967F75EB656734EAE394A298410430C430C02080208030C0208
030C481848188C285034EF3411393445754DB751185A185A185A185A185A185A
185A185A185A185A185A185A185A185A185A185A185A185A185A185AF859185A
185A185A185AF755185AF859185AF755F859185AF755F859F755F859F755F859
F855F755F859F755F855F755F859F755F855F755F855F755F855F755F755F855
F755F755F855F755F755F755F755F755F755F855F755F755F855F755F855F755
F855F755F855F755F855F755F859F755F855F859F755F859F855F859F755F859
F859F755185AF859185AF755185A185AF755185A185A185A185AF859185A185A
185A185A185A185A185A185A185A185A185A185A185A185A185A185A185AF859
F859B855764D1445B34050342C24481805100104000000000000000000000000
00002104430CE8206A291042734EF75E39677B6FBD77BD77DE7BDE7BFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7B
DE7BFF7F7B6FF75EF75EEF3D6B2DE820430C240C0204030C040805102C245034
153C7B54FB587A59B959F859185A185A185A185A185A185A185A185A185A185A
185A185A185A185A185A185A185A185A185AF859185AF755185AF859F859F755
185AF755F859F755F859F755F855F755F855F755F855F755F755F755F855F755
F755F755F755F755D755F755F755D755F755D755F755D755F755D755D755F755
D755D755F755D755D755F755D755D755F755D755D755F755D755F755D755D755
F755D755D755F755D755F755D755F755D755F755F755D755F755F755F755F755
F755F755F755F755F855F755F855F755F859F755F859F855F859F755F859185A
F859185AF755185A185A185AF755185A185A185A185A185A185A185A185A185A
185A185A185A185A185A185A185A185A185AF8597A59FB587B54354014382C24
4818010400000000000000000000420800008614AE39734EB65639673967BD77
BD77DE7BDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7B
FF7F7B6F3967F75E1042E8204208430C240C020405104818143817441E58BD58
FB58B959F859185A185A185A185A185A185A185A185A185A185A185A185A185A
F859185A185A185AF859185AF755185AF859F755F859185AF755F859F755F855
F755F859F755F755F755F855F755F755D755F755D755F755D755F755D755D755
D755D755D755D755D755D751D755D755D755D755D755D751D755D755D755D751
D755D755D755D651D755D755D751D755D755D751D755D755D751D755D755D755
D651D755D755D755D755D755D755D755D755D755D755D751D755D755D755D755
D755D755D755D755D755F755D755F755D755F755D755F755F755F755F755F755
F855F755F855F755F859F755F859F855F859185AF859185AF755185A185A185A
F859185A185A185A185A185A185A185A185A185A185A185A185A185A185A185A
D9597A59BD585E581A50153C2C24261400000000020400000000210486148B2D
1042F75E39677B6FBD77DE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BDE7B
BD779C733967734E4A2900000000000002042C2414381B501F5C5E58FB587A59
185A185A185A185A185A185A185A185A185A185A185A185A185A185A185A185A
185AF859185AF859F859F755F859F755F859F755F755F855F755F755D755F755
D755F755D755D755F755D755D755D755D755D755D755D755D755D755D755D751
D755D755D651D755B651D751B651B755D755B651B755B751B651B755B651B755
B651B755B651B751B651B755B651B751B651B751B751B651B751B751B651B751
B651B751B751B651D751B751D651B751B751D751B751D651B751D755B651D751
D755D751D755D751D755D755D755D755D755D755D751D755D755D755D755D755
D755D755F755D755F755D755F755F755F755F755F855F755F855F755F859F855
F859F755185AF8591856185A185A185AF859185A185A185A185A185A185A185A
185A185A185A185A185A185AB9591B5D7B541E5C1E58153C2C24051000000000
01000000420886148B2DB65639677B6F9C73DE7BDE7BFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7BBD77
BD773967F75EEF3D84100000000004082C241A4C1E5C1F5C3E5CFB58B959F859
185A185A185A185A185A185A185A185A185A185A185A185AF859185AF755185A
F755F859F755F859F755F855B83A372337233723372337233723372337233723
372337233723372337233723B755D755D755D651D755D751D755B651D751B751
D751B651B751B751B751B651B83A372337233723161737233723161737233723
16173723372316173723372337231617B83A9651B651B651B651B651B651B651
B651B751B651B651B651B751B651B651B651B651B651B651B651B651B751B651
B751B651B751B651B751B751B651B751B751D651B751D751B651D755D751D755
D751D755D755D755D755D751D755D755D755D755D755D755F755D755F755F755
F755F755F755F855F755F859F755F859F859F755185AF8591856185A185AF859
185A185A185A185A185A185A185A185A185A185A185AF8595B5D5E581E5C1F5C
1B5414384818000000000104430886148B2D734EB6563967BD77DE7BFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7B
DE7B5B6F744EAE392204010402042C241A4C1F5C1F5C1E5CBD587A59185A185A
185A185A185A185A185A185A185A185AF859185A185A185AF755F8591856F859
F755F859F755F855F755F755F755F755D72AD703F703F703F703F703F703F703
F703F803F703F703F703F703F703D707D751B651B751B751B751B651B751B651
B751B651B651B651B651B651B651B6513817F703F703F703F703F703F703F703
F703F803F703F703F703F703F703F703D703F703D72A964D9651965196519651
965196519651964D9651964D96519651964D9651964D9651B65196519651B64D
9651B6519651B6519651B651B651B651B651B651B651B751B651B651B751B651
B751B751B651B751B751D651B751D755D751D755D755D751D755D755D755D755
D755D751D755D755F755D755F755F755F755F755F855F755F859F755F859F755
F859185A185A185A185A185AF859185A185A185A185A185A185A185A185A185A
B959FB581E5C1F5C1E581D5814380510040800000000E8204A291042F75E7B6F
BD77DE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDE7B
BD777C737B6FAE39841001044818153C1E5C1F5C1F5C5E58FB58D959185A185A
185A185A185A185A185A185A185AF859185AF755185AF859F755F859F755F859
F755F755F855F755F755D755F755D755D755D755384ED72AD72AD72A970BF703
F703F703F703F703F703970FD72A362EB83A362ED751B651B651B651B651B651
B651B6519651B6519651964D96519651964D9651F63D362EB83A362E1617F703
F803F703F703F703F703F703F703D703D7071617D72A362EF63D964D964D954D
964D964D954D964D964D954D9651964D964D954D9651964D9651964D964D9651
964D9651964D9651964D9651965196519651964D96519651964DB6519651B651
9651B651B651B651B651B651B651B751B651B751B651B751B751B651D751B751
D755D651D755D755D755D755D751D755D755D755D755F755D755F755F755F755
F855F755F855F755F859F755F859F755185A185A185AF859185A185A185A185A
185A185A185A185AF8597A599D541F5C1F5C1E581A4C2C240204000002084208
8614734EF75E7B6FBD77FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
DE7B7C733967734E430800002C241A4C1F5C1F583F547C39183E3852185A185A
185A185A185A185A185A185AF859185AF755185AF859F755F859F755F855F755
F755F755F755D755D755F755D755D755D755D751D755D755D751D755D751B755
D651183E970FF703F703F703F703D72A9651B6519651B651B65196519651B64D
965196519651964D96519651964D9651964D964D9651964D964D754D964D964D
9541F703F703F703F703F703F703F703D703D72A7549764D754D764D754D764D
754D764D754D764D754D764D754D764D754D764D754D964D754D764D954D764D
764D954D764D964D764D954D964D964D964D954D964D964D9651964D9651954D
96519651964D96519651964D96519651B64D9651B651B651B651B651B651B651
B751B651B751B751B651B751D751D651D755B755D751D755D755D755D751D755
D755D755F755F755F755F755F855F755F855F859F755F859F755185A185AF859
185A185A185A185AF755185A185A185A185A183E183E7E501F581E5C1D585034
040801004308E8208B2D744E39679C73DE7BDE7BFF7FFF7FFF7FFF7FFF7FFF7F
FF7FBD773967B656AE3900002C241A4C1F5C1F5C7E50392E3723384E185A185A
185A185A185A185A185AF859185AF755185AF859F755F859F755F855F755F755
F755D755F755D755D755D755D755D755D751D755D755D751B755D651B751B751
B651B751B651B751B6513723D703F703F703F703D72A964D9651964D96519651
964D9651964D964D954D764D964D954D764D964D754D964D754D764D754D954D
764D9541970BF703F703F703F803F703F703D707F63D7549754D754D754D754D
754D754D754D7549754D754D754D754D754D754D7549754D754D7549754D754D
7549754D754D754D754D754D754D754D754D754D764D754D764D754D964D764D
954D764D964D954D964D964D964D9651954D96519651964D96519651964D9651
B6519651B651B651B651B651B651B751B651B751B751B651D751B751D755D651
D755D755D751D755D755D755D755F755D755F755F755F755F855F755F859F755
F859F755185A185AF859185A185A185A185A185A185A185A1856D72AB91E7C39
1F5C1F601E5850340510020486144A29EF3DB6567B6FDE7BDE7BFF7FFF7FFF7F
FF7FFF7FBD775B6F55564A29051017441F5C1F5CDE48B91ED707B83AF859185A
185A185A185A185AF859185AF755185AF859F755F855F755F855F755F755F755
D755F755D755D755D755D755D755D751D755D751B755D651B751B651B751B651
B751B651B651B651B6519651B6519651D72AD703F703F703F703D72A964D964D
954D764D964D954D764D964D754D964D754D764D754D754D754D754D754D754D
754D75499541D707D703F803F703F703F703F703770B954175495549554D5549
554955495549554955495549554D75495549554955495549554D55495549554D
55495549754D5549554D7549554D7549554D754D7549754D754D754D754D754D
7549754D754D754D754D764D754D764D964D754D964D964D954D964D964D9651
964D96519651964D96519651964DB6519651B651B651B651B651B751B651B751
B651B751D751D755D651B755D751D755D755D755D755D751D755F755F755D755
F755F855F755F859F755F859F755185AF859185A185A185A185A185A185A185A
38527817770B7C351F581F601B502C240510030CE820AE39B65639679C73DE7B
FF7FFF7FFF7FBE7B5B6F5556124150341F581F5C7E50B91EF80378171856185A
185A185A185A185AF859F755185AF859F755F859F755F859F755F755F755D755
F755D755D755D755D755D755D751D755D751B755D651B751B651B751B651B751
B651B651B651B65196519651B64D9651964D9651964DF63DD703F703F703F703
1617964D754D964D754D764D754D754D754D754D754D7549754D754D5549754D
554975495549F63DD707D703F703F703F703F703F703970F7545554955495549
5549554955495549554955495549554955493549554955495549554955495549
5549554955495549554955495549554955495549554955495549554955495549
554D7549554D754D7549754D7549754D754D754D754D754D754D764D754D764D
954D764D964D954D964D964D9651964D96519651964D96519651B6519651B651
B651B651B751B651B751B651B751B651D755D751B755D751D755D755D755D755
D755F755D755F755F755F855F755F755F859F755F859185AF755185A185AF755
185A185A185A185AD72AD703770B5D391E581F5C153C261404088614AE39744E
39679C73BD77FF7FFF7FDE7BD85E334135401E581E5C392ED703F703D72A185A
185A185AF859185A185AF755F859185AF755F859F755F755F755F755D755F755
D755D755D755D755D755D751D755D751B755D651B751B651B751B651B751B651
B651B651B65196519651964D9651964D9651964D9651954D764D954DF63D970F
F703F703F703970F9541754D754D7549754D7549754D554D5549554D55495549
55495549554D5549F63DD703F703F703F703F703F703D7031617754134453549
3445354934453549344534453445344534453445344534453445344534453445
3445344534453445354934453549344555493445554935495549554955495549
5549554955495549554955495549554D55497549554D754D7549554D754D754D
7549754D754D764D754D764D754D964D954D764D964D954D9651964D9651964D
965196519651B651B651B651B651B651B751B651B751B651D751D755B651D755
D751D755D755D755D751D755F755D755F755F855F755F855F755F859F755185A
F859185AF859185A185A185A185AB83AD707F703B91E7E501E581C5448180408
E820AE39744EF75E7B6FFF7FDE7B3967EF3417445E587E50590FF703F703D72A
185A185A185A185A185AF859F755185AF755F859F755F755F755F855F755D755
F755D755D755D755D755D751D755D751B755D651B751B651B751B651B751B651
B651B6519651964D96519651964D9651964D9651954D764D964D754D964D754D
764D95413817F703F703F703970B954175455549554D55495549554955495549
55495549554955493445362ED703F703F703F703F703F703F703161734453445
3445344534453445344534453445144534453445344534453445144534453445
3445344514453445344534453445344534453445344534453445344534453445
3445354934453549344555495549344555495549554955495549554955497549
554D7549554D754D754D7549754D754D764D754D764D754D964D754D964D954D
9651964D9651964D9651964D9651B651964DB651B651B751B651B751B651B751
D651B755D751D755D651D755D755D755D755D755F755D755F755F755F755F859
F755F855F755185A185AF755185A185A185A185A584ED703F703D7037C351F5C
1E5C2C2426148614AE39B656F75EFF7FDE7B4E351A501E583D41D703F703F703
D72A185A185A185AF859185AF755185AF755F859F755F755F755F855D755F755
D755D755D755D755D751D755D751B755D651B751B651D651B751B651B651B651
B6519651964D96519651964D9651964D9651754D964D964D764D954D764D764D
754D764D754D754D75491617F703F703F703D707F63D55495549554955493445
554955493445354934453445362ED703F703F703F703F703F703F703B91E3341
1445144534451445144534451445334114451445144514451445144514453341
1445144514451445344514451445144514451445144514453445144534451445
3445344534453445344534453445344534453549344535493549554935493445
55493549554955495549554955495549754D7549754D7549754D764D754D764D
964D764D964D964D964D964D9651964D9651965196519651B6519651B6519651
B651B751B651B751D651B755D751B755D751D755D751D755D755D755F755D755
F855F755F755F859F755F859F755185AF859185AF755185A185A584EF703F703
F703392E1F581E5C2C242614E8201042F75EFF7FB6561A4C1E5C3D41D703F703
F7037817185A185AF755185A185AF755F859F755F859F755F755F855F755D755
F755D755D755D755D755D751D755D751B755D651B751B6515341EF340D31EF34
0D31EF340D310D31EF340D310D31EF340D310D310D31EF34CD2C0D310D31CD2C
0D31CD2C0D31CD2C0D3134457549554D362EF703F703F703D703362E55495549
3445554934453445344534453445362EF703F703F703F803F703F703F703362E
134114451139CD2C8C288C28CD2C8C288C28B0341445144514451445D3401445
1445D1388C288C28CC288C288C288C2811391445144514451445144514451445
14451445144533411445344514453445CD2C8C2833413445EF34CD2CEF34CD2C
EF34EF34EF34EF34CD2CEF34EF34EF34EF34EF3455491241EF34EF34EF34EF34
EF34EF34EF34EF34EF34EF34EF34EF34EF347549965153415035EF3450355341
B65150397549B651B651B751B651B751B651D755D6515039503950395241D755
F755D755F755F755F855D755F859F755F855F755185AF859185A185AF755185A
B83AF703F703F703B91E1F5C1C542C24440C6A291042FF7F35491F5CDE48D703
F703F703D703584E185AF859185A185AF755185AF755F859F755F755F755F755
D755F755D755D755D755D751D755D751B755D651B751D751B651B751E8200000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000240C554955495549F63DD703F703F703D703
362E3445344535453445344534451445B91ED703F703F703F703F703F703D703
362ED3401445144501040000000000000000000000008C28D340D340D340D340
D340D440D34000000000000000000000000000008C28D440D3401445D3401445
1445D34014451445144514451445144513414818000000001139D34000000000
00000000251046144614461448188614461446144818E8203549CC2800000000
00000104461486144614461486140308000000000000E820764D861400000000
00000D31964DCC2801045039B651B751B651B751B651D751B755000000000000
0000954DD751D755F755D755F755F755D755F859F755F859F755185AF859F755
185A185A18567817F703F703F703392E1F5C1A4C0408420810427D771E581F5C
590FF703F703F7033723185A185A185AF859F755F859F755F859F755F855F755
F855D755F755D755D755D755D755D751D755B751D755B651B751B651B651B751
E820000000000000000000000000010475499349554953417549534175495341
3341EF3400000000000000000000000000000104554955495549344595419707
F703F703F7031617344534453445144534451617D703F703F703F703F703F703
D703F32DD4401445D340D44400000000000000000000000000004818D444D340
D340B340D340B340B34000000000000000000000000000008C28D340D340D340
D340D340D340D440D340D4401445D3401445D138240C00000104CD2C14451241
000000000000000034453445344534453445344535495549344555495549CC28
00000000000046147549554D7549754D754D8C28000000000000E820764D4614
000000000000CD2C9651B64DEF340104CC28B651B651B651B751B651B7510000
0000000000009349D755D755D755D755D755F855F755F855F859F755F859F755
F859185A1856F859185A584EF703F703F703F703DE481E582C2400006A291F6E
1F5C7C35F803F703F703F703584E1856185AF859F755185AF755F859F755F755
F755F755D755F755D755D755D755D751D755D751B651D755B651B751B651B751
B651B751E82000000000000000000000000022049651754D964D954D764D754D
754D754D754D754D481800000000000000000000000001045549554934455549
344575411617F703F703F70316175341144533411617F703F703F703F703F703
F703D70794311445D340D440D340D34000000000000000000000000000004818
D340B340B340B340B340B340D13800000000000000000000000000008C28B340
B340D340B340D340D340D340D340D340D340D340CD2C01040000030CD1381445
1445D13800000000000000008C28CC288C288C28CC2813413445344555493445
55498C2800000000000046145549754D5549754D7549E8200000000000004818
964D86140000000000000D31964D9651964D53414208240C440C440C86144614
861400000000000000009349D755D751D755F755D755F755D755F755F755F755
F855F755185AF859F755185A185A185A970FF703F703F70338171F5C1A500000
8410DF641F5C3817D703F703F703D707185A185AF755185AF859F755F859F755
F855F755F855D755F755D755D755D755D755D751D755D751B755D651B751B651
B651B751B651B651CC28440C430C240C430C240C240C4614954D964D754D764D
764D754D764D754D554911394510000000000000000000000000020455495549
344555493445344535451617D703F703F703770B74351617F703F703F703F703
F703F70397077435D340D340D340D340D340D340000000000000000000000000
00004818B340B340D138B340B340B340B0340000000000000000000000000000
8C28B340B340B340B340B340D340B340D340D340D3408C28000000004614D340
1445D34014451139000000000000000025104510251045104510134134453549
344555493445CC2800000000000046145549754D5549754D554D8C2800000000
0000E820764D4614000000000000CD2C964D9651964DB651954D861400000000
CC28B651B75100000000000000009349D755D751D755D755D755F755D755F855
F755F859F755F859F755185AF755185AF859185A3723F703F703F803D7037E50
1F5C040800005F5C1F5CD703F703F703F7037817185AF859185A185AF755185A
F755F859F755F755F755F755D755D755D755D755D755D751D755B751D651B755
B751B651B751B651B651B65196519651964D9651964D9651964D954D964D754D
964D754D5241CD2CE820240C0000000000000000000002088614CC2811393445
55493445354934453445354934453445362EF703F703F703F703F703F703F703
F803F703D703770B5439D340D340D440D340D340D340B3400000000000000000
0000000000004818B340B340B340B340D138B340503400000000000000000000
000000008C28B340B340B340D138B340B340B340D340D1382614000000008C28
D340D3401445D3401445D1380000000000000000144514453445144534451445
34453445344535493445CC28000000000000451455495549554955497549E820
0000000000004818954D46140000000000000D31954D9651964D96519651B651
CC28000000008614954D00000000000000009349D755D751D755D755F755D755
F755D755F855F755F859F755F859F755185A185AF859185AD72AF703F703F703
F7037C391F5C481800003E5C1F5CF803F703F703F8037817F859185A185AF755
F859F755185AF755F859F755F859D755D755F755D755D755D755D751D755B651
D755B751B651B751B651B651B751B6519651B651964D96519651964D96517549
EF34CC2845100104000000000000000001004514CC28EF343341554955495549
554955493445554934453549344534453445344534459535D703F703F703F803
F703F703F703F703770B133DD340D340D340D340D340D340B340D34000000000
000000000000000000004818B340D138B3405034B3405034D138000000000000
00000000000000008C28D138B340B340B340B340B340B340B034020400000104
B034D340D3401445D3401445D340D3400000000000000000CC28CD2C8C28CD2C
CD2CCD2CCD2CCD2CCD2CCD2C3549CC28000000000000240CCC28CC28CC28CC28
CC280000000000000000E820764D4614000000000000CD2C964D9651964D9651
B651964DB651503901040000020800000000000000009349D755D751D755D755
D751F755D755F855F755D755F855F755F8591856F859F755185A185AB83AF703
F703F703F7037C351F5C481802085F5C1F5C9707F703F703F703970F185A185A
185AF755185AF859F755F755F855F755F755D755F755D755D755D755D755D751
D755B751D755B651B751D651B751B651B651B751B6519651964D5241CC288614
030C00000000000000000000240CE820CD2C3341754D7549554D55495549554D
5549554955493445554934455549344534453445344534451445F32DB803F703
F703F703F703F703F7031617133DD444D3401445D340D444D340D340D340B340
00000000000000000000000000004818B340B340D138B340D138B3408C280000
0000000000000000000000008C28B340B340D138B340B340B3408C2800000000
240CD138D444D340D340D3401445D3401445D340CD2C8C288C28CC288C288C28
CC288C28CC288C28CC28CC28CD2CCD2C35491139CD2CCC28CD2CCC28CD2CCC28
CD2CCD2CCD2CCD2CCD2CCD2C0D313341954D33410D31CD2C0D3152419651964D
9651964D9651B6519651B65175490D310D310D31EF340D315035B755D651D755
D755D755F755D755F755D755F755F859F755F859F755F859F755185A185AF755
D72AF703F803F703F7033D411F5C2614E8207F691F5C392EF803F703F703D703
1856185AF859185AF755F859F755F859F755F755F855D755F755D755D755D755
D751D755D755D751B651D751B651B755B651B751B6519651EF34440C00000000
00000000000000008614CD2C5039554D964D754D754D764D7549754912410D31
EF34CD2CEF34CD2CEF34EF3434455549344535493445344534453445362ED703
F703F703F703F703F703F703D70394311445D3401445D340D340D340D340D340
D340D34000000000000000000000000000004818B340B340B340B340B3404818
000000000000000000000000000000008C28B340B340B340D340B34048180000
00004818D340D340D340D440D3401445D3401445D34014451445334114451445
1445344514453445344534453549344534455549344555493445554955495549
5549554D7549554D7549754D754D7549764D954D764D954D764D9651754D964D
9651964D96519651B64D9651B751B651B651B751B651D755B651D751B755D751
D755D755D751D755D755D755F855F755F855F755F755F859F755185AF8591856
F859185A3723F703F703F703D7031F581E5C0204AE39BF761F5CDE48D703F803
F703F703B83A185A185AF859F755185AF755F859F755F859F755F755D755F755
D755D755D755D755D751D755B751D755B651D751B651B651B751B651E8200000
0000000000000000000002049651954D764D964D754D754D764D754D764D754D
8C2800000000000000000000000001045549554934453549554934453445362E
F703F703F703F803F703F703F703F703F703D703362ED34014451341D444D340
1445D340D444D34000000000000000000000000000004818D444D340B340D138
26140000000000000000000000000000000000008C28B340D340B340D138240C
000000008C28D340D444D3401445D3401445D444134114451445144514451445
1445344514453445344534453445344534453549554934455549554955495549
5549554D5549754D5549754D7549754D754D764D754D764D954D764D954D964D
9651964D9651964D9651B64D9651B6519651B651B751B651B751B651D755B751
D755D651D755D751D755F755D755F755F755D755F755F755F859F755F859185A
F755185AF8593852D707F703F703F803392E1F58153CE820534EFF7FBE601F5C
392EF803F703F7037817185AF755185A185AF755F8591856F755F755F755F755
F855D755F755D755D755D755D751D755D755B651D751B755B651B751B651B651
E82000000000000000000000000000005241964D954D9651954D764D954D754D
754D754DE8200000000000000000000000000104554955495549554934453549
362EF703F703F703F703F703F703D803362ED707F703F703D703362E13411445
13411445D3401445D340144500000000000000000000000000004818D340D340
B0340208000001048C2800000000000000000000000000008C28D340D440CD2C
020400000208B034D3401445D3401445D3401445144513411445144514451445
1445344514453445344534453445344534453549554934455549344555495549
554955495549754D5549754D5549754D754D754D764D754D964D754D964D754D
9651964D9651964D9651964DB6519651B751B651B651B751B651B751B651D751
B755D651D755D751D755D755D755D755F855F755D755F755F859F755F859F755
185AF755185A185A185AB83AF703F703F70397073F541F5C8C28F44DB656FF7F
FF761F5C1F583817D703F703F703B83A185A185AF859F755185AF755F859F755
F859F755F755F755D755F755D755D755D755D751D755D751D755B651D751B651
B751B651CC2800000000000000000000000000000000240C4510451045104510
4510451445104510010400000000000000000000000001045549554955495549
55491617D703F703F703F803F703F703D703F32D35497541770BF703F703F703
161713411445144514451445134114450000000000000000000000000000240C
4818461400000000240CD340D3400000000000000000000000000000240C4818
4614000000004510D34013411445144513411445144514451445144514451445
3445344534453445344534453445344535495549344555493445554955495549
5549554D5549754D5549754D5549754D754D7549764D754D964D754D964D754D
964D9651954D9651964D9651964DB6519651B651B651B651B751B651B751B651
D755B651D755D751D755D755D751D755F755D755F755D755F755F859F755F855
F859F755185A185AF755185A3852D707F703F703D703DE481E5C343C93493967
7C73FF7FFF7F1F6E1F5C3F543817D703F803D707584E185A185AF859185AF755
F859185AF755F855F755F859F755D755F855D755D755D755D751D755D755D751
B651D755B751B6519349E8204510451045144510451045144510451045104514
45104510451045104510451045104510451045104510451045104614754D7549
554975491617F703F703F703F703F703F703D707953555493445344555451617
F703F703F703770B534133413445144514451445CD2C25102510440C2510240C
2510240C2510440C25108C281341144513418C282510440C2510440C2510440C
2510240C251045108C2814451445144514451445144514453445144534453445
3445344534453445344534453549344555493445554934455549554955495549
55495549754D5549754D5549754D7549754D754D764D754D964D754D964D754D
964D9651964D9651964D9651964DB6519651B651B651B751B651B751B651B751
D651B755D751D755D751D755D751D755D755F755D755F755F755F855F755F859
F755F859185AF755185AF859185A18563723F703F703D7033D411E581A4C7549
D85E5B6FDE7BFF7FFF7FFF7F9F691F5C1F58B91EF703F703970F3856185A185A
185AF755185AF755F859F755F859F755F755F755F755D755F755D755D755D755
D755D751D755D751B651D755B651B751B651B651B751B651B6519651B751964D
B651964D9651964D9651964D954D964D754D964D754D764D754D754D764D754D
754D554975493817F703F703F703F703F703F703D70795355549554934455549
344555491617F703F703F7039707953534453445344534453445144534451445
3445144514453445144514451445144514451445144514451445144514451445
1445144514453445144534451445344534453445144534453445344534453445
344534453549344534453549344555493445554955495549554955495549554D
5549754D5549754D5549754D7549754D764D754D764D754D964D754D964D754D
964D9651954D9651964D9651964DB6519651B651B751B651B751B651B651B751
D651B755D751B755D651D755D755D755D755F755D755F755F755F755F859F755
F855185AF755185AF755185A185A185A185AD72AF703F7039707DE481E5C1A50
0D31D85E9D77BE7BDE7BFF7FFF7FFF7FFF7FFF6D1F5C1F5C7C35D703F703970F
3852185A185A185A185A185AF755185AF755F859F755F859F755F755F755D755
F755D755D755D755D751D755D755D751B755D651B751D755B651B751B651B651
B651B65196519651B64D9651964D9651964D964D9651954D764D954D764D754D
964D754D954D9541970FD703F703F803F703F703F703970B9541554955495549
55495549554955495549362EF703F703F703D703362E34453445344534453445
3549344534453445344534453445344534453445344534453445344534453445
3445344534453445344534453445344534453445344534453549344534453549
344555493445554934455549554955495549554955495549554D5549554D7549
5549754D5549754D7549754D754D754D754D764D954D764D954D764D954D9651
964D9651964D9651964D9651B64D9651B6519651B651B651B751B651B751B651
D751B755D651D755D751D755D751D755D755F755D755F755D755F755F855F755
F859F755185AF859F755185AF859185A185A185AD72AF703F703B91E3F541F5C
1A4C0D315B6FBD77DF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F9F763E5C1F5C7E50
B91EF703970B584E185A185A185AF755185A185AF755185AF755F859F755F859
F755F755F755D755D755F755D755D755D755D751D755D751D755B651B751D651
B755B651B751B651B651B751B6519651B6519651964D9651964D9651964D9651
954D964D954D764D9541970BF703F703F703F703F703F703970F95417549554D
75495549554D5549554955495549554D362ED703F703F703D703B91E34455549
5549554934455549344555493445354934455549344535493445354934453445
3549344555493445354934455549344535493445554934455549554934455549
55495549554955495549554955495549554955495549554D75495549754D5549
754D7549754D764D754D754D764D754D964D754D964D754D964D9651954D964D
9651964D9651964D9651964DB6519651B651B651B751B651B751B651B751D651
B751D755B651D755D751D755D755D755D755F755D755F755F755F755F859F755
F859F755185AF755185AF755185A185A185A185A18563723F80397077C391F5C
1F601438AE39BD77FF7FDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F7E77
DF641F5C1F5C3D413817D703B83A185A185A185A185AF859185AF755185AF755
F859F755F755F859F755F855F755F755D755F755D755D755D755D755D751D755
D751D755B651B751D651B755B651B751B651B651B651B751B65196519651B64D
9651964D9651964D9651F63DD707F703F703F703F703F703D703970F9541754D
764D754D754D754D754D7549754D7549554D75495549F63DD707F703F703F703
1617754555495549554955495549554955495549554955495549554955495549
5549554955495549554955495549554955495549554955495549554955495549
5549554D554955495549754D55495549754D5549754D7549754D754D7549754D
764D754D754D764D754D754D964D754D964D764D954D964D9651964D9651964D
9651964D9651964DB6519651B651B751B651B651B751B651B751B651B751D651
B755D651D755D751D755D755D755D755F755D755F755D755F755F855F755F859
F755F859F755185AF755185AF859185A185A185A185A584E970FB803392E1F58
1F5C1D588C28B656FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7F7F725F5C1F5C1F5C3D41381738175852185A185A185A185AF859
185AF8591856185AF859F755F859F755F755F859F755F755F755D755D755F755
D755D755D755D751D755D751D755B651D751B651B751B651B751B651B651B751
B651B6519651B7519651964DF63DD703F703F703F803F703F703F70378177549
964D954D764D954D764D754D954D764D754D754D754D754D764D754D9541770B
F703F703F703770B95417549754D5549754D5549754D55495549754D55495549
754D55495549754D5549554D75495549554D75495549754D55497549554D7549
754D7549554D7549754D7549754D754D7549754D764D754D754D754D764D754D
754D764D954D764D954D764D954D964D9651954D9651964D9651964D9651964D
9651964DB6519651B651B651B651B751B651B651B751B651B751D651B755D651
D755D751D755D751D755D755D755D755F755D755F755F855F755F755F859F755
F859F755185AF755185AF859185A185A185A185AF859185AD72A970F392E1F58
1F5C1F5C1438EF3DBD77FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FDF7F1F6E3E5C1F5C1F5CDE48392ED72A1856185A
185A185A185A185AF859185AF755185A185AF755F859F755F859F755F755F855
F755F755D755F755D755D755D755D755D755D751D755D751D755B751D651B755
B651B751D651B751B651B651B651B83AD703D703F703F703F703F703F7033817
B64D9651964D9651964D9651954D964D9651764D954D764D954D764D754D964D
754D964D970FD703F703F703D707F63D7549754D764D7549754D764D754D754D
764D754D754D754D754D754D754D7549754D754D754D764D754D754D754D754D
754D764D754D754D754D764D754D754D764D754D754D964D754D964D754D964D
754D964D964D9651954D9651964D9651964D9651964D9651964DB6519651B651
9651B651B651B651B651B751B651B751B651B751B651D751B755D651D755D751
D755D751D755D755D755D755F755D755F755F755F755F755F859F755F859F755
185AF755185AF8591856F859185A185A185A185A185A185AB83AB91E7C391F58
1F5C1E5C153C71397B6FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FBF7F3F725F5C1F5C1F5C3F54
3D41DA4D1856185A185A185A185A185A185AF859185AF755185AF755185AF755
185AF755F859F755F855F755F755F755D755D755F755D755D755D755D755D751
D755D751D755D651B755B651B651B755D72AD703F703F703F703F703F803F703
1617B651B651964DB6519651964D9651964D9651964D9651964D9651964D9651
964D9651954D964D964D970FD703F703F703D703D72A754D9651754D964D754D
964D754D764D954D764D754D964D754D764D954D764D754D964D754D964D754D
964D754D964D754D964D954D764D954D964D9651964D954D9651964D9651964D
964D9651964D9651964D9651964D9651964DB6519651B651B6519651B651B651
B651B651B751B651B751B651B751B651D755B651D755D651D755D751D755D751
D755D755D755D755D755F755D755F755F755F755F855F755F859F755185AF755
185AF755185AF859185A185A185A185A185A185A185A185AF9517C399D541F58
1F5C1E58343C52417B6FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FBF76
1F651F5C1F5C1F5C3E5CFB58F859185A185A185A185A185A185A185AF859185A
F859185AF755185AF755F859F755F859F755F859F755F755F855F755D755F755
D755D755D755F755D755D755D751F74DB83A970FD703F703F803F703F703F703
F703F703D72AB651B751B6519651B651B651B751B651B6519651B651B6519651
9651B64D96519651964D9651964D3723D703F703F803F703F703970F362EB64D
964D964D954D9651964D964D9651964D9651964D964D9651964D9651964D964D
9651964D964D9651964D9651964D9651964D9651964D9651964D9651964D9651
964D9651B6519651B6519651B651B651B651B751B651B651B651B751B651B751
B651B751B651B751D651B755D651B751D755D751D755D751D755D751D755D755
D755D755F755D755F755F755F755F755F859F755F859F755F859F755185AF859
F755185A185AF859185A185A185A185A185A185A185AF8597A595E581E5C1F5C
1F5C1A50B340334E9C73FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7F9F7F5F72DF641F5C1F5C1F5CBD587A59185A185A185A185A185A
185A185A185A185AF859185AF859185AF755185AF755185AF755185AF755F755
F859F755F755F755F755F755183ED707D703F703F703F703F703F703F703F703
F803F703F703F703F703D703D707D7077817B651B751B651B751B651B651B751
B651B651B651B651B651970FD707D707D703F703F703F703F703F703F703F703
F703F703D703D707D72A964D96519651B64D96519651B64D96519651B651964D
9651B6519651964DB6519651B6519651B64D9651B651B651B6519651B651B651
B651B751B651B651B651B751B651B651B751B651B651B751B651B751D651B751
D755B651D751D755D751D755D751D755D751D755D755D755D755D755F755D755
F755F755F755F755F755F855F755F859F755F859F755185AF755185AF859185A
F755185A185A185A185A185A185A185A185A185A185AB959FB583E5C1E5C1F5C
1B50343C9349F75EFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F9F7F5F721F653E5C1F5C3E5CBD589A59
F859185A185A185A185A185A185A185A185A185A185AF859185AF755185AF859
F755185AF859F755185AF755F859F755B83AF703F703F703F703F703F703F703
F703F703F703F703F803F703F703F703F703F703970FD751D755D751D751D651
B755D751B651B751D755B651B751D707F703F703F703F703F703F703F703F703
F703F703F703F703F703F703D72AB651B651B651B751B651B651B651B751B651
B651B651B651B751B651B651B751B651B651B751B651B751B651B751B651B651
B751B651B751B651B751D651B755B651D751D755B651D751D755D751D755D751
D755D755D755D755D755D755D755D755D755D755F755D755F755F755F755F755
F859F755F859F755F859F755F859F755185AF755185AF8591856185AF859185A
185A185A185A185A185A185A185A185A185A185AB9591B5D5E581E5C1F5C1A4C
343C9349F75EDE7BFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDF7FFF76FF6D
1F651F5C3E5CBD585B5DF859185AF859185A185A185A185A185A185A185A185A
185A185AF859185AF755185AF859F755185AF7551856174E3852384E174E3852
174E384E174E384E174E174E174E174E174E174E174E174E174ED755D755D755
D755D755D755D751D755D755D751D755D755F74D174E174EF74D174EF74D174E
F74D174EF74DF74D174EF74DF74DF74DF74DB651D751B751D651B755D651B751
D751B651D755B751D751B651D751B755D751B651D755D751D755B651D751D755
D651D751D755D751D755D751D755D755D751D755D755D751D755D755D755D755
D755D755D755F755D755F755D755F755F755F755F859F755F755F859F755F859
F755F855F755185AF755185AF859F755185A185AF859185AF859185A185A185A
185AF755185A185A185A185A185A185AF8597A5DFB583E5C1E5C1A4C343C3445
534E3967FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FDF7F3F7B5F727F69BE605F5CFB585B5DB9591856185A185A185A
185A185A185A185A185A185A185A185A185A185AF859185AF859185AF755185A
F755185AF755185AF755F859F755185AF755F755F859F755F755F855F755F755
F755D755F755F755F755D755F755D755F755D755F755D755D755D755D755D755
D755D755D755D755D755D755D755D751D755D755D755D755D751D755D755D755
D751D755D755D755D751D755D755D755D755D751D755D755D755D751D755D755
D755D755D755D755D755D755D755D755D755F755D755D755F755D755F755F755
F755F755F755F755F755F855F755F755F755F859F755F855F755185AF755185A
F755185AF755185AF859185AF8591856F859185A185A185A185A185A185A185A
185A185A185A185A185A185AF8597A59FB585E581A50153CD444754975523967
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7F
FF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FDF7F3F7BBE72FF6D7F695D61
FB587A599A59F859185A185A185A185A185A185A185A185A185A185A185A185A
185A185A185AF859185AF859185AF755185AF859F755185AF859F755185AF755
F859F755185AF755F859F755F859F755F755F859F755F755F755F855F755F755
F855F755F755F755F755D755F755D755F755D755F755D755F755D755F755D755
F755D755F755D755F755D755F755D755F755D755F755D755F755D755F755D755
F755000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000}
SystemMemory = False
Transparent = True
TransparentColor = clBlack
end>
Left = 424
Top = 42
end
end
/VCL_DELPHIX_D6/SXMedia/SxSample/main.pas
0,0 → 1,211
{
SXMedia Components - Beta 1
--------------------------------
Copyright 1999 Dean Ellis
http://www.sillex.freeserve.co.uk
 
This unit is part of the SXMedia Component Set. This code is
supplied as is with no guarantees and must be used at your own
risk.
 
No modifications to this code must be made without the express
permission of the author. Please report any problems to
support@sillex.freeserve.co.uk
 
You may use these components to create any freeware/shareware
applications that you wish. If the components are to be used in
a commercail product then credit for developement of these components
should be given.
 
Credits :
 
Developer : Dean Ellis
}
unit main;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SXMovie, SXModPlayer, SXEngine, Menus, DXSounds, DXDraws, MMSystem, DIB;
 
type
TFrmMain = class(TForm)
MainMenu1: TMainMenu;
FileMnu: TMenuItem;
SXShowMnu: TMenuItem;
SXEngineMnu: TMenuItem;
SXModPlayerMnu: TMenuItem;
Exit1: TMenuItem;
OpenFileItem: TMenuItem;
PlayItem: TMenuItem;
StopItm: TMenuItem;
StartItem: TMenuItem;
StopItem: TMenuItem;
OpenFile1: TMenuItem;
Start1: TMenuItem;
Stop1: TMenuItem;
OpenDlg: TOpenDialog;
SXModPlayer: TSXModPlayer;
SXEngine: TSXEngine;
SXMovie: TSXMovie;
DXSound1: TDXSound;
DXDraw1: TDXDraw;
DXImageList1: TDXImageList;
procedure Exit1Click(Sender: TObject);
procedure DXDraw1Finalize(Sender: TObject);
procedure OpenFileItemClick(Sender: TObject);
procedure OpenFile1Click(Sender: TObject);
procedure PlayItemClick(Sender: TObject);
procedure Start1Click(Sender: TObject);
procedure Stop1Click(Sender: TObject);
procedure DXSound1Initialize(Sender: TObject);
procedure SXEngineRender(Sender: TObject);
procedure StartItemClick(Sender: TObject);
procedure StopItemClick(Sender: TObject);
procedure DXDraw1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
 
var
FrmMain: TFrmMain;
 
implementation
 
{$R *.DFM}
procedure FreeObj(var Obj);
begin
if TObject(Obj) <> nil then
begin
TObject(Obj).Free;
TObject(Obj) := nil;
end;
end;
 
procedure ClearSurfaces;
begin
FrmMain.DXDraw1.Surface.Fill(clBlack);
FrmMain.DXDraw1.Primary.Fill(clBlack);
end;
 
procedure TFrmMain.Exit1Click(Sender: TObject);
begin
if SXMovie.Playing then SXMovie.Stop;
Close;
end;
 
procedure TFrmMain.DXDraw1Finalize(Sender: TObject);
begin
if SXEngine.Enabled then SXEngine.Enabled := False;
end;
 
procedure TFrmMain.OpenFileItemClick(Sender: TObject);
begin
OpenDlg.Filter := 'All Media Files|*.avi;*.mpg;*.mov|' +
'AVI (*.avi)|*.avi|MPG (*.mpg)|*.mpg|MOV (*.mov)|*.mov';
if OpenDlg.Execute then
begin
SXMovie.Filename := OpenDlg.FileName;
end;
end;
 
procedure TFrmMain.OpenFile1Click(Sender: TObject);
begin
OpenDlg.Filter := 'All Media Files|*.mod;*.it;*.s3m;*.xm|' +
'Mod (*.mod)|*.mod|Impulse Tracker (*.it)|*.it|Scream Tracker (*.s3m)|*.s3m|Fast Tracker (*.xm)|*.xm';
if OpenDlg.Execute then
begin
SXModPlayer.Filename := OpenDlg.FileName;
DXSound1Initialize(Sender);
SXModPlayer.Initialize(nil);
end;
end;
 
procedure TFrmMain.PlayItemClick(Sender: TObject);
begin
if not SXMovie.Playing then
begin
if DXDraw1.CanDraw then
ClearSurfaces;
SXMovie.DisplayRect(80,60, 400, 300);
SXMovie.Play
end
else
SXMovie.Stop;
end;
 
 
procedure TFrmMain.Start1Click(Sender: TObject);
begin
SXModPlayer.Play(True);
end;
 
procedure TFrmMain.Stop1Click(Sender: TObject);
begin
SXModPlayer.Stop;
end;
 
procedure TFrmMain.DXSound1Initialize(Sender: TObject);
var fmt:TWaveFormatEx;
begin
with Fmt do
begin
wFormatTag := WAVE_FORMAT_PCM;
nSamplesPerSec := 44100;
nChannels := 2;
wBitsPerSample := 16;
nBlockAlign := wBitsPerSample div 8 * nChannels;
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
end;
// must be in exclusive to set the format
DXSound1.Options := DXSound1.Options + [soExclusive];
DXSound1.Primary.SetFormat(Fmt);
end;
 
procedure TFrmMain.SXEngineRender(Sender: TObject);
var Angle: Integer;
begin
Angle := 0;
if DXDraw1.CanDraw then
begin
DXDraw1.Surface.Fill(clBlack);
with DXImageList1.Items[0] do
DrawWaveX(DXDraw1.Surface,160,50,Width,Height, 0, 5, 80, Angle*4);
with DXDraw1.Surface.Canvas do
begin
try
Brush.Style := bsClear;
Font.Color := clWhite;
Font.Size := 8;
Textout(5, 5, 'Frames Per Sec : ' + IntToStr(SXEngine.FramesPerSecond));
finally
Release;
end;
end;
DXDraw1.Flip;
Inc(Angle);
end;
end;
 
procedure TFrmMain.StartItemClick(Sender: TObject);
begin
if DXDraw1.CanDraw then ClearSurfaces;
SXEngine.Enabled := True;
end;
 
procedure TFrmMain.StopItemClick(Sender: TObject);
begin
SXEngine.Enabled := False;
end;
 
procedure TFrmMain.DXDraw1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then Close;
end;
 
end.
/VCL_DELPHIX_D6/turbopixels.pas
0,0 → 1,937
unit turbopixels;
 
// turboPixels 1.2
// for use with DelphiX DirectX Headers and Components
 
// (c) 2000 Michael Wilson -- no.2 games
// www.no2games.com & turbo.gamedev.net
// wilson@no2games.com
 
// 1.2 Features:
// DelphiX 7 support
// Powered by PixelCore release
// PixelCore ASM routines by Henri Hakl aka A-Lore
// Updated WinAmp font routine
 
// 1.1 Features:
// Incorporated ASM conversion by LifePower
// Incorporated ASM putpixels by JerK
// Added non-RGB versions of 8/16/24 PutPixels
// Faster clipping and no surface passing
// Auto 565 and 555 detection that works!!!
// Re-oganized demo for more speed and FPS counter
 
// 1.0 Inital release
 
// [ Credits and thanks... ]
// Based on FastPixels v0.2 for DelphiX -- but faster ;)
// 24-bit put loosely based on Erik Englund's Setpixel.pas
// Thanks to Tim Baumgarten for some bit shifting ideas
// Thanks to John Hebert for teaching me AlphaBlending
// Thanks to Hugo for introducing me to Wu
// ASM conversion routines by LifePower (faster...)
// ASM put routines by JerK (jdelauney@free.fr)
// PixelCore ASM routines by Henri Hakl aka A-Lore
// Font from a WinAmp skin
// Windows SDK help for confusing me about RGB values
 
// [ Legal ]
// THIS SOFTWARE AND THE ACCOMPANYING FILES
// ARE WITHOUT WARRANTIES AS TO PERFORMANCE
// OR MERCHANTABILITY OR ANY OTHER WARRANTIES
// WHETHER EXPRESSED OR IMPLIED.
// Because of the various hardware and software
// environments into which turboPixels may be put,
// NO WARRANTY OF FITNESS FOR A PARTICULAR
// PURPOSE IS OFFERED.
 
 
interface
{$INCLUDE DelphiXcfg.inc}
uses
Windows, Messages, SysUtils, Classes, Graphics,
DXDraws, DXClass,
{$IfDef StandardDX}
DirectDraw;
{$Else}
DirectX;
{$EndIf}
 
const
alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ"at 0123456789<>=()-''!_+\/{}^&%.=$#ÅÖÄ?*';
numbers = '0123456789-';
 
// *** locking functions ***
 
function turboLock(DxDrawSurface: TDirectDrawSurface): Boolean;
procedure turboUnlock;
 
// *** pixel manipulation ***
 
procedure turboSetPixel8(const X, Y: Integer; color: byte);
procedure turboSetPixel8A(const X, Y: Integer; color: Integer);
procedure turboSetPixel8PC(x, y, color: integer);
procedure turboSetPixel16RGB(const X, Y: Integer; R, G, B: byte);
procedure turboSetPixel24RGB(const X, Y: Integer; R, G, B: byte);
procedure turboSetPixel16(const X, Y: integer; color: cardinal);
procedure turboSetPixel16A(X, Y: Integer; color: cardinal);
procedure turboSetPixel16PC(x, y, color: integer);
procedure turboSetPixel32PC(x, y, color: integer);
procedure turboSetPixel24(const X, Y: integer; color: cardinal);
procedure turboSetPixel24A(X, Y: Integer; Color: cardinal);
procedure turboSetPixel24PC(x, y, color: integer);
function turboGetPixel8(const X, Y: Integer): byte;
function turboGetPixel8PC(x, y: integer): integer;
function turboGetPixel16(const x, y: Integer): cardinal;
function turboGetPixel16PC(x, y: integer): integer;
function r16(color: cardinal): byte;
function g16(color: cardinal): byte;
function b16(color: cardinal): byte;
function turboGetPixel24(const x, y: Integer): dword;
function turboGetPixel24PC(x, y: integer): integer;
function r24(color: cardinal): byte;
function g24(color: cardinal): byte;
function b24(color: cardinal): byte;
function turboGetPixel32PC(x, y: integer): integer;
procedure turboSetPixelAlpha16(const X, Y: Integer; color: cardinal; A: byte);
procedure turboSetPixelAlpha24(const X, Y: Integer; color: cardinal; A: byte);
procedure turboSetPixelAlpha16RGB(const X, Y: Integer; R, G, B, A: byte);
procedure turboSetPixelAlpha24RGB(const X, Y: Integer; R, G, B, A: byte);
function Conv15to24(Color: Word): Integer; register;
function Conv16to24(Color: Word): Integer; register;
function Conv24to15(Color: Integer): Word; register;
function Conv24to16(Color: Integer): Word; register;
 
// *** graphic primitives ***
 
procedure turboLine16(x1, y1, x2, y2: Integer; R, G, B: byte);
procedure turboLine24(x1, y1, x2, y2: Integer; R, G, B: byte);
procedure turboWuLine16(x1, y1, x2, y2: Integer; R, G, B: byte);
procedure turboWuLine24(x1, y1, x2, y2: Integer; R, G, B: byte);
procedure turboWrite(DxDrawSurface: TDirectDrawSurface; Imagelist: TDXImageList; font, text: string; x, y: integer);
procedure turboWriteD(DxDrawSurface: TDirectDrawSurface; Imagelist: TDXImageList; font, text: string; x, y: integer);
 
implementation
 
var
LockedSurface: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF};
LockedSurfaceDesc: TDDSurfaceDesc2;
LockedRect: TRect;
bitfix: cardinal; // for 555 or 565
xmax, ymax: integer; // clipping
 
function turboLock(DxDrawSurface: TDirectDrawSurface): Boolean;
begin
LockedSurface := DxDrawSurface.{$IFDEF D3D_deprecated}ISurface4{$ELSE}ISurface7{$ENDIF};
LockedSurfaceDesc.dwSize := SizeOf(TDDSurfaceDesc);
LockedRect := Rect(0, 0, LockedSurfaceDesc.dwWidth,
LockedSurfaceDesc.dwHeight);
if LockedSurface.Lock(@LockedRect, // do the lock
LockedSurfaceDesc,
DDLOCK_SURFACEMEMORYPTR + DDLOCK_WAIT,
0) <> DD_OK
then Result := False
else Result := True;
xmax := DxDrawSurface.Width - 1; // Max X clip
ymax := DxDrawSurface.Height - 1; // Max Y clip
if LockedSurfaceDesc.ddpfPixelFormat.dwGBitMask = 2016 // if there are 6 bits
then bitfix := 0 else bitfix := 1; // of GREEN were looking at 565
end;
 
procedure turboUnlock;
begin
LockedSurface.Unlock(@LockedRect);
LockedSurface := nil; // free locked surface
end;
 
procedure turboSetPixel8(const X, Y: Integer; color: byte);
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
pbyte(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x)^ := color; // offset for 1 byte pixel
end;
 
procedure turboSetPixel8A(const X, Y: Integer; color: Integer); assembler;
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push ebx // ASM put routines by JerK (jdelauney@free.fr)
push esi // Don't seem much faster
push edi
mov esi,LockedSurfaceDesc.lpSurface
mov eax,[LockedSurfaceDesc.lpitch]
mul [Y]
add esi,eax
mov ebx,[X]
add esi,ebx
mov ebx,[Color]
mov ds:[esi],ebx
pop edi
pop esi
pop ebx
end;
end;
 
procedure turboSetPixel16RGB(const X, Y: Integer; R, G, B: byte);
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
pword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 2)^ := // offset for *2* byte pixel
((R shr 3) shl (11 - bitfix)) or // r value shifted
((G shr (2 + bitfix)) shl 5) or // g value shifted
(B shr 3); // add blue
end;
 
procedure turboSetPixel24RGB(const X, Y: Integer; R, G, B: byte);
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
pdword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 3)^ :=
(r shl 16) or (g shl 8) or b; // Could use RGB(r,g,b)
end;
 
procedure turboSetPixel16(const X, Y: integer; color: cardinal);
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
if bitfix = 0 then
pword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 2)^ := // offset for *2* byte pixel
Conv24to16(color)
else
pword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 2)^ := // offset for *2* byte pixel
Conv24to15(color);
// ((R16(color) shr 3) shl (11 - bitfix)) or // r value shifted
// ((G16(color) shr (2 + bitfix)) shl 5) or // g value shifted
// (B16(color) shr 3); // add blue
end;
 
procedure turboSetPixel16A(X, Y: Integer; Color: cardinal); assembler;
var
convertedcolor: integer;
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
if bitfix = 0 then
convertedcolor := Conv24to16(color)
else
convertedcolor := Conv24to15(color);
asm
push ebx // ASM put routines by JerK (jdelauney@free.fr)
push esi
push edi
mov esi,LockedSurfaceDesc.lpSurface
mov eax,[LockedSurfaceDesc.lpitch]
mul [Y]
add esi,eax
mov ebx,[X]
shl ebx,1
add esi,ebx
mov ebx,[convertedcolor]
mov ds:[esi],ebx
pop edi
pop esi
pop ebx
end;
end;
 
procedure turboSetPixel24(const X, Y: Integer; color: cardinal);
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
pdword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 3)^ :=
color;
end;
 
procedure turboSetPixel24A(X, Y: Integer; Color: cardinal); assembler;
begin
asm
push ebx // ASM put routines by JerK (jdelauney@free.fr)
push esi
push edi
mov esi,LockedSurfaceDesc.lpSurface
mov eax,[LockedSurfaceDesc.lpitch]
mul [Y]
add esi,eax
mov ebx,[X]
imul ebx,3
add esi,ebx
mov ebx,[Color]
mov ds:[esi],ebx
pop edi
pop esi
pop ebx
end;
end;
 
function turboGetPixel8(const X, Y: Integer): byte;
begin
result := 0;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
result := pbyte(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x)^; // offset for 1 byte pixel
end;
 
function turboGetPixel16(const x, y: Integer): cardinal;
begin
result := 0;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
result := pword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 2)^;
end;
 
function r16(color: cardinal): byte;
begin;
result := (color shr (11 - bitfix)) shl 3;
end;
 
function g16(color: cardinal): byte;
begin;
if bitfix = 0 then
result := ((color and 2016) shr 5) shl 2
else
result := ((color and 992) shr 5) shl 3;
end;
 
function b16(color: cardinal): byte;
begin;
result := (color and 31) shl 3;
end;
 
function turboGetPixel24(const x, y: Integer): dword;
begin
result := 0;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
result := pdword(integer(LockedSurfaceDesc.lpsurface) + // surface pointer
y * LockedSurfaceDesc.lpitch + x * 3)^;
end;
 
function r24(color: cardinal): byte;
begin;
result := (color shr 16) and 255; // or GetRValue(color);
end;
 
function g24(color: cardinal): byte;
begin;
result := (color shr 8) and 255; // or GetGValue(color);
end;
 
function b24(color: cardinal): byte;
begin;
// Some video boards may return a blue value in the first byte
// i.e. result := color and 255;
result := (color shr 24) and 255; // or GetBValue(color);
end;
 
procedure turboSetPixelAlpha16RGB(const X, Y: Integer; R, G, B, A: byte);
var color: integer;
begin
// This function could use a lot of speed work, but it's faster than
// alpha blending Canvas.Pixels ;) but Hori's FillRectAdd is faster
// for large areas
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
color := turboGetPixel16(x, y); // get "color"
turboSetPixel16RGB(X, Y, // set new pixel
(A * (R - r16(color)) shr 8) + r16(color), // R alpha
(A * (G - g16(color)) shr 8) + g16(color), // G alpha
(A * (B - b16(color)) shr 8) + b16(color)); // B alpha
end;
 
procedure turboSetPixelAlpha24RGB(const X, Y: Integer; R, G, B, A: byte);
var color: dword;
begin
// This function could use a lot of speed work, but it's faster than
// alpha blending Canvas.Pixels ;) but Hori's FillRectAdd is faster
// for large areas
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
color := turboGetPixel24(x, y); // get "color"
turboSetPixel24RGB(X, Y, // set new pixel
(A * (R - r24(color)) shr 8) + r24(color), // R alpha
(A * (G - g24(color)) shr 8) + g24(color), // G alpha
(A * (B - b24(color)) shr 8) + b24(color)); // B alpha
end;
 
 
procedure turboSetPixelAlpha16(const X, Y: Integer; color: cardinal; A: byte);
var oldcolor: integer;
begin
// This function could use a lot of speed work, but it's faster than
// alpha blending Canvas.Pixels ;) but Hori's FillRectAdd is faster
// for large areas
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
oldcolor := turboGetPixel16(x, y); // get old color
turboSetPixel16RGB(X, Y, // set new pixel
(A * (r16(color) - r16(oldcolor)) shr 8) + r16(oldcolor), // R alpha
(A * (g16(color) - g16(oldcolor)) shr 8) + g16(oldcolor), // G alpha
(A * (b16(color) - b16(oldcolor)) shr 8) + b16(oldcolor)); // B alpha
end;
 
procedure turboSetPixelAlpha24(const X, Y: Integer; color: cardinal; A: byte);
var oldcolor: dword;
begin
// This function could use a lot of speed work, but it's faster than
// alpha blending Canvas.Pixels ;) but Hori's FillRectAdd is faster
// for large areas
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
oldcolor := turboGetPixel24(x, y); // get "color"
turboSetPixel24RGB(X, Y, // set new pixel
(A * (r24(color) - r24(oldcolor)) shr 8) + r24(oldcolor), // R alpha
(A * (g24(color) - g24(oldcolor)) shr 8) + g24(oldcolor), // G alpha
(A * (b24(color) - b24(oldcolor)) shr 8) + b24(oldcolor)); // B alpha
end;
 
// *** ASM pixel routines straight from PixelCore by Henri Hakl aka A-Lore ***
// *** Surface clipping added by Michael Wilson 09/07/2000
 
procedure turboSetPixel8PC(x, y, color: integer);
{ on entry: x = eax, y = edx, color = ecx }
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi // must maintain esi
mov esi,LockedSurfaceDesc.lpSurface // set to surface
add esi,eax // add x
mov eax,[LockedSurfaceDesc.lpitch] // eax = pitch
mul edx // eax = pitch * y
add esi,eax // esi = pixel offset
mov ds:[esi],cl // set pixel (lo byte of ecx)
pop esi // restore esi
ret // return
end;
end;
 
procedure turboSetPixel16PC(x, y, color: integer);
{ on entry: x = eax, y = edx, color = ecx }
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi
mov esi,LockedSurfaceDesc.lpSurface
shl eax,1
add esi,eax // description similar to PutPixel8
mov eax,[LockedSurfaceDesc.lpitch]
mul edx
add esi,eax
mov ds:[esi],cx
pop esi
ret
end;
end;
 
procedure turboSetPixel24PC(x, y, color: integer);
{ on entry: x = eax, y = edx, color = ecx }
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi
mov esi,LockedSurfaceDesc.lpSurface
imul eax,3
add esi,eax // description similar to PutPixel8
mov eax,[LockedSurfaceDesc.lpitch]
mul edx
add esi,eax
mov eax,ds:[esi] // the idea is to get the current pixel
and eax,$ff000000 // and the top 8 bits of next pixel (red component)
or ecx,eax // then bitwise OR that component to the current color
mov ds:[esi+1],ecx // to ensure the prior bitmap isn't incorrectly manipulated
pop esi // can't test if it works... so hope and pray
ret
end;
end;
 
procedure turboSetPixel32PC(x, y, color: integer);
{ on entry: x = eax, y = edx, color = ecx }
begin
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi
mov esi,LockedSurfaceDesc.lpSurface
shl eax,2
add esi,eax // description similar to PutPixel8
mov eax,[LockedSurfaceDesc.lpitch]
mul edx
add esi,eax
mov ds:[esi],ecx
pop esi
ret
end;
end;
 
function turboGetPixel8PC(x, y: integer): integer;
{ on entry: x = eax, y = edx }
begin
Result := -1;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi // myst maintain esi
mov esi,LockedSurfaceDesc.lpSurface // set to surface
add esi,eax // add x
mov eax,[LockedSurfaceDesc.lpitch] // eax = pitch
mul edx // eax = pitch * y
add esi,eax // esi = pixel offset
mov eax,ds:[esi] // eax = color
and eax,$ff // map into 8bit
pop esi // restore esi
ret // return
end;
end;
 
function turboGetPixel16PC(x, y: integer): integer;
{ on entry: x = eax, y = edx }
begin
Result := -1;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi
mov esi,LockedSurfaceDesc.lpSurface
shl eax,1
add esi,eax // description similar to GetPixel8
mov eax,[LockedSurfaceDesc.lpitch]
mul edx
add esi,eax
mov eax,ds:[esi]
and eax,$ffff // map into 16bit
pop esi
ret
end;
end;
 
function turboGetPixel24PC(x, y: integer): integer;
{ on entry: x = eax, y = edx }
begin
Result := -1;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi
mov esi,LockedSurfaceDesc.lpSurface
imul eax,3
add esi,ebx // description similar to GetPixel8
mov eax,[LockedSurfaceDesc.lpitch]
mul edx
add esi,eax
mov eax,ds:[esi]
and eax,$ffffff // map into 24bit
pop esi
ret
end;
end;
 
function turboGetPixel32PC(x, y: integer): integer;
{ on entry: x = eax, y = edx }
begin
Result := -1;
if (X < 0) or (X > xmax) or // Clip to DelphiX Surface
(Y < 0) or (Y > ymax) then Exit;
asm
push esi
mov esi,LockedSurfaceDesc.lpSurface
shl eax,2
add esi,eax // description similar to GetPixel8
mov eax,[LockedSurfaceDesc.lpitch]
mul edx
add esi,eax
mov eax,ds:[esi]
pop esi
ret
end;
end;
 
// *** end of Pixel Core routines
 
procedure turboLine16(x1, y1, x2, y2: Integer; R, G, B: byte);
var
i, deltax, deltay, numpixels,
d, dinc1, dinc2, x, xinc1, xinc2,
y, yinc1, yinc2: integer;
begin
deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
deltay := abs(y2 - y1);
if deltax >= deltay then // Initialize all vars based on which is the independent variable
begin
numpixels := deltax + 1; // x is independent variable
d := (2 * deltay) - deltax;
dinc1 := deltay shl 1;
dinc2 := (deltay - deltax) shl 1;
xinc1 := 1;
xinc2 := 1;
yinc1 := 0;
yinc2 := 1;
end
else
begin
numpixels := deltay + 1; // y is independent variable
d := (2 * deltax) - deltay;
dinc1 := deltax shl 1;
dinc2 := (deltax - deltay) shl 1;
xinc1 := 0;
xinc2 := 1;
yinc1 := 1;
yinc2 := 1;
end;
if x1 > x2 then // Make sure x and y move in the right directions
begin
xinc1 := -xinc1;
xinc2 := -xinc2;
end;
if y1 > y2 then
begin
yinc1 := -yinc1;
yinc2 := -yinc2;
end;
x := x1; // Start drawing at <x1, y1>
y := y1;
for i := 1 to numpixels do // Draw the pixels
begin
turboSetPixel16RGB(X, Y, R, G, B);
if d < 0 then
begin
d := d + dinc1;
x := x + xinc1;
y := y + yinc1;
end
else
begin
d := d + dinc2;
x := x + xinc2;
y := y + yinc2;
end;
end;
end;
 
procedure turboLine24(x1, y1, x2, y2: Integer; R, G, B: byte);
var
i, deltax, deltay, numpixels,
d, dinc1, dinc2, x, xinc1, xinc2,
y, yinc1, yinc2: integer;
begin
deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
deltay := abs(y2 - y1);
if deltax >= deltay then // Initialize all vars based on which is the independent variable
begin
numpixels := deltax + 1; // x is independent variable
d := (2 * deltay) - deltax;
dinc1 := deltay shl 1;
dinc2 := (deltay - deltax) shl 1;
xinc1 := 1;
xinc2 := 1;
yinc1 := 0;
yinc2 := 1;
end
else
begin
numpixels := deltay + 1; // y is independent variable
d := (2 * deltax) - deltay;
dinc1 := deltax shl 1;
dinc2 := (deltax - deltay) shl 1;
xinc1 := 0;
xinc2 := 1;
yinc1 := 1;
yinc2 := 1;
end;
if x1 > x2 then // Make sure x and y move in the right directions
begin
xinc1 := -xinc1;
xinc2 := -xinc2;
end;
if y1 > y2 then
begin
yinc1 := -yinc1;
yinc2 := -yinc2;
end;
x := x1; // Start drawing at <x1, y1>
y := y1;
for i := 1 to numpixels do // Draw the pixels
begin
turboSetPixel24RGB(X, Y, R, G, B);
if d < 0 then
begin
d := d + dinc1;
x := x + xinc1;
y := y + yinc1;
end
else
begin
d := d + dinc2;
x := x + xinc2;
y := y + yinc2;
end;
end;
end;
 
procedure turboWuLine16(x1, y1, x2, y2: Integer; R, G, B: byte);
var
deltax, deltay, loop, start, finish: integer;
dx, dy, dydx: single; // fractional parts
begin
deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
deltay := abs(y2 - y1);
if (deltax = 0) or (deltay = 0) then begin // straight lines
turboLine16(x1, y1, x2, y2, R, G, B);
exit;
end;
if deltax > deltay then // horizontal or verticle
begin
if y2 > y1 then // determine rise and run
dydx := -(deltay / deltax)
else
dydx := deltay / deltax;
if x2 < x1 then
begin
start := x2; // right to left
finish := x1;
dy := y2;
end
else
begin
start := x1; // left to right
finish := x2;
dy := y1;
dydx := -dydx; // inverse slope
end;
for loop := start to finish do begin
turboSetPixelAlpha16RGB(loop, trunc(dy), R, G, B,
trunc((1 - frac(dy)) * 255)); // plot main point
turboSetPixelAlpha16RGB(loop, trunc(dy) + 1, R, G, B,
trunc(frac(dy) * 255)); // plot fractional difference
dy := dy + dydx; // next point
end;
end
else
begin
if x2 > x1 then // determine rise and run
dydx := -(deltax / deltay)
else
dydx := deltax / deltay;
if y2 < y1 then
begin
start := y2; // right to left
finish := y1;
dx := x2;
end
else
begin
start := y1; // left to right
finish := y2;
dx := x1;
dydx := -dydx; // inverse slope
end;
for loop := start to finish do begin
turboSetPixelAlpha16RGB(trunc(dx), loop, R, G, B,
trunc((1 - frac(dx)) * 255)); // plot main point
turboSetPixelAlpha16RGB(trunc(dx) + 1, loop, R, G, B,
trunc(frac(dx) * 255)); // plot fractional difference
dx := dx + dydx; // next point
end;
end;
end;
 
procedure turboWuLine24(x1, y1, x2, y2: Integer; R, G, B: byte);
var
deltax, deltay, loop, start, finish: integer;
dx, dy, dydx: single; // fractional parts
begin
deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
deltay := abs(y2 - y1);
if (deltax = 0) or (deltay = 0) then begin // straight lines
turboLine24(x1, y1, x2, y2, R, G, B);
exit;
end;
if deltax > deltay then // horizontal or verticle
begin
if y2 > y1 then // determine rise and run
dydx := -(deltay / deltax)
else
dydx := deltay / deltax;
if x2 < x1 then
begin
start := x2; // right to left
finish := x1;
dy := y2;
end
else
begin
start := x1; // left to right
finish := x2;
dy := y1;
dydx := -dydx; // inverse slope
end;
for loop := start to finish do begin
turboSetPixelAlpha24RGB(loop, trunc(dy), R, G, B,
trunc((1 - frac(dy)) * 255)); // plot main point
turboSetPixelAlpha24RGB(loop, trunc(dy) + 1, R, G, B,
trunc(frac(dy) * 255)); // plot fractional difference
dy := dy + dydx; // next point
end;
end
else
begin
if x2 > x1 then // determine rise and run
dydx := -(deltax / deltay)
else
dydx := deltax / deltay;
if y2 < y1 then
begin
start := y2; // right to left
finish := y1;
dx := x2;
end
else
begin
start := y1; // left to right
finish := y2;
dx := x1;
dydx := -dydx; // inverse slope
end;
for loop := start to finish do begin
turboSetPixelAlpha24RGB(trunc(dx), loop, R, G, B,
trunc((1 - frac(dx)) * 255)); // plot main point
turboSetPixelAlpha24RGB(trunc(dx) + 1, loop, R, G, B,
trunc(frac(dx) * 255)); // plot fractional difference
dx := dx + dydx; // next point
end;
end;
end;
 
// *** ASM conversion routines by LifePower ***
 
function Conv15to24(Color: Word): Integer; register;
asm
xor edx,edx // not used in LIB
mov dx,ax // ASM code by LifePower
mov eax,edx
shl eax,27
shr eax,8
mov ecx,edx
shr ecx,5
shl ecx,27
shr ecx,16
or eax,ecx
mov ecx,edx
shr ecx,10
shl ecx,27
shr ecx,24
or eax,ecx
end;
 
function Conv16to24(Color: Word): Integer; register;
asm
xor edx,edx // not used in LIB
mov dx,ax // ASM code by LifePower
mov eax,edx
shl eax,27
shr eax,8
mov ecx,edx
shr ecx,5
shl ecx,26
shr ecx,16
or eax,ecx
mov ecx,edx
shr ecx,11
shl ecx,27
shr ecx,24
or eax,ecx
end;
 
function Conv24to15(Color: Integer): Word; register;
asm
mov ecx,eax // ASM code by LifePower
shl eax,24
shr eax,27
shl eax,10
mov edx,ecx
shl edx,16
shr edx,27
shl edx,5
or eax,edx
mov edx,ecx
shl edx,8
shr edx,27
or eax,edx
end;
 
function Conv24to16(Color: Integer): Word; register;
asm
mov ecx,eax // ASM code by LifePower
shl eax,24
shr eax,27
shl eax,11
mov edx,ecx
shl edx,16
shr edx,26
shl edx,5
or eax,edx
mov edx,ecx
shl edx,8
shr edx,27
or eax,edx
end;
 
procedure turboWrite(DxDrawSurface: TDirectDrawSurface; Imagelist: TDXImageList; font, text: string; x, y: integer);
var
loop, line, letter, offset, i: integer;
begin
i := Imagelist.items.IndexOf(font); // find font once
offset := Imagelist.items[i].patternwidth;
line := 1;
for loop := 1 to Length(text) do
begin { each letter }
if text[loop] = '|' then // fake a <P>
begin
inc(y, Imagelist.items[i].patternheight + 1);
line := 1;
end
else begin
letter := pos(uppercase(text[loop]), alphabet) - 1;
if letter < 0 then letter := 30;
Imagelist.items[i].draw(DxDrawSurface, x + (offset * line), y, letter);
inc(line);
end;
end; { loop }
end; { graphics write }
 
procedure turboWriteD(DxDrawSurface: TDirectDrawSurface; Imagelist: TDXImageList; font, text: string; x, y: integer);
var
loop, line, letter, offset, i: integer;
begin
i := Imagelist.items.IndexOf(font); // find font once
offset := Imagelist.items[i].patternwidth;
line := 1;
for loop := 1 to Length(text) do
begin { each letter }
if text[loop] = '|' then // fake a <P>
begin
inc(y, Imagelist.items[i].patternheight + 1);
line := 1;
end
else begin
letter := pos(uppercase(text[loop]), numbers) - 1;
if letter < 0 then letter := 30;
Imagelist.items[i].draw(DxDrawSurface, x + (offset * line), y, letter);
inc(line);
end;
end; { loop }
end; { graphics write digits }
 
end.
 

/VCL_DELPHIX_D6/.
Property changes:
Added: svn:ignore
+*.local
+*.dcu
+*.~*
+*.identcache
+*.tvsconfig
+__history
+*.exe