Subversion Repositories spacemission

Rev

Rev 1 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. (*******************************************************************************
  2.                        EXTEND UNIT DXDRAWS FROM DELPHIX PACK
  3.  
  4.  *  Copyright (c) 2004-2010 Jaro Benes
  5.  *  All Rights Reserved
  6.  *  Version 1.09
  7.  *  D2D Hardware module
  8.  *  web site: www.micrel.cz/Dx
  9.  *  e-mail: delphix_d2d@micrel.cz
  10.  
  11.  * Enhanced by User137
  12.  
  13.  * DISCLAIMER:
  14.    This software is provided "as is" and is without warranty of any kind.
  15.    The author of this software does not warrant, guarantee or make any
  16.    representations regarding the use or results of use of this software
  17.    in terms of reliability, accuracy or fitness for purpose. You assume
  18.    the entire risk of direct or indirect, consequential or inconsequential
  19.    results from the correct or incorrect usage of this software even if the
  20.    author has been informed of the possibilities of such damage. Neither
  21.    the author nor anybody connected to this software in any way can assume
  22.    any responsibility.
  23.  
  24.    Tested in Delphi 4, 5, 6, 7 and Delphi 2005/2006/2007/2009/2010
  25.  
  26.  * FEATURES:
  27.    a) Implement Hardware acceleration for critical function like DrawAlpha {Blend},
  28.       DrawSub and DrawAdd for both way DXIMAGELIST and DIRECTDRAWSURFACE with rotation too.
  29.    b) Automatic adjustement for texture size different 2^n.
  30.    c) Minimum current source code change, all accelerated code added into:
  31.       DXDraw.BeginScene;
  32.       //code here
  33.       DXDraw.EndScene;
  34.    d) DelphiX facade continues using still.
  35.  
  36.  * HOW TO USE
  37.    a) Design code like as DelphiX and drawing routine put into
  38.       DXDraw.BeginScene;
  39.       //code here
  40.       DXDraw.EndScene;
  41.    b) setup options in code or property for turn-on acceleration like:
  42.       DXDraw.Finalize; {done DXDraw}
  43.       If HardwareSwitch Then
  44.       {hardware}
  45.       Begin
  46.         if NOT (doDirectX7Mode in DXDraw.Options) then
  47.           DXDraw.Options := DXDraw.Options + [doDirectX7Mode];
  48.         if NOT (doHardware in DXDraw.Options) then
  49.           DXDraw.Options := DXDraw.Options + [doHardware];
  50.         if NOT (do3D in DXDraw.Options) then
  51.           DXDraw.Options := DXDraw.Options + [do3D];
  52.         if doSystemMemory in DXDraw.Options then
  53.           DXDraw.Options := DXDraw.Options - [doSystemMemory];
  54.       End
  55.       Else
  56.       {software}
  57.       Begin
  58.         if doDirectX7Mode in DXDraw.Options then
  59.           DXDraw.Options := DXDraw.Options - [doDirectX7Mode];
  60.         if do3D in DXDraw.Options then
  61.           DXDraw.Options := DXDraw.Options - [do3D];
  62.         if doHardware in DXDraw.Options then
  63.           DXDraw.Options := DXDraw.Options - [doHardware];
  64.         if NOT (doSystemMemory in DXDraw.Options) then
  65.           DXDraw.Options := DXDraw.Options + [doSystemMemory];
  66.       End;
  67.       {to fullscreen}
  68.       if doFullScreen in DXDraw.Options then
  69.       begin
  70.         RestoreWindow;
  71.         DXDraw.Cursor := crDefault;
  72.         BorderStyle := bsSingle;
  73.         DXDraw.Options := DXDraw.Options - [doFullScreen];
  74.         DXDraw.Options := DXDraw.Options + [doFlip];
  75.       end else
  76.       begin
  77.         StoreWindow;
  78.         DXDraw.Cursor := crNone;
  79.         BorderStyle := bsNone;
  80.         DXDraw.Options := DXDraw.Options + [doFullScreen];
  81.         DXDraw.Options := DXDraw.Options - [doFlip];
  82.       end;
  83.       DXDraw1.Initialize; {up DXDraw now}
  84.  
  85.  * NOTE Main form has to declare like:
  86.       TForm1 = class(TDXForm)
  87.  
  88.  * KNOWN BUGS OR RESTRICTION:
  89.    1/ Cannot be use DirectDrawSurface other from DXDraw.Surface in HW mode.
  90.    2/ New functions was not tested for two and more DXDraws on form. Sorry.
  91.  
  92.  ******************************************************************************)
  93. unit DXDraws;
  94.  
  95. interface
  96.  
  97. {$INCLUDE DelphiXcfg.inc}
  98.  
  99. uses
  100.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  101.   {$IFDEF VER14UP}
  102.   DXTypes,
  103.   {$ENDIF}
  104.   {$IFDEF VER17UP}System.Types, System.UITypes,{$ENDIF}
  105.   {$IFDEF DXTextureImage_UseZLIB}
  106.   ZLIB,
  107.   {$ENDIF}
  108.   DXClass, DIB,
  109.   {$IFDEF StandardDX}
  110.   DirectDraw, DirectSound,
  111.     {$IFDEF DX7}
  112.       {$IFDEF D3DRM}
  113.   Direct3DRM,
  114.       {$ENDIF}
  115.   Direct3D;
  116.     {$ENDIF}
  117.     {$IFDEF DX9}
  118.   Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8;
  119.     {$ENDIF}
  120.   {$ELSE}
  121.   DirectX;
  122.   {$ENDIF}
  123.  
  124. const
  125.   maxTexBlock = 2048; {maximum textures}
  126.   maxVideoBlockSize: Integer = 2048; {maximum size block of one texture}
  127.   SurfaceDivWidth: Integer = 2048;
  128.   SurfaceDivHeight: Integer = 2048;
  129.   {This conditional is for force set square texture when use it alphachannel from DIB32}
  130. {$DEFINE FORCE_SQUARE}
  131.   DXTextureImageGroupType_Normal = 0; // Normal group
  132.   DXTextureImageGroupType_Mipmap = 1; // Mipmap group
  133.  
  134.   Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ"at  0123456789<>=()-''!_+\/{}^&%.=$#ÅÖÄ?*';
  135.   PowerAlphabet = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ`1234567890-=~!@#$%^&*()_+[];'',./\{}:"<>?|©®™ ';
  136.   ccDefaultSpecular = $FFFFFFFF;
  137.  
  138.   ZeroRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
  139.  
  140. type
  141.  
  142.   {  TRenderType  }
  143.  
  144.   TRenderType = (rtDraw, rtBlend, rtAdd, rtSub);
  145.  
  146.   {  TRenderMirrorFlip  }
  147.  
  148.   TRenderMirrorFlip = (rmfMirror, rmfFlip);
  149.   TRenderMirrorFlipSet = set of TRenderMirrorFlip;
  150.  
  151.   {  EDirectDrawError  }
  152.  
  153.   EDirectDrawError = class(EDirectXError);
  154.   EDirectDrawPaletteError = class(EDirectDrawError);
  155.   EDirectDrawClipperError = class(EDirectDrawError);
  156.   EDirectDrawSurfaceError = class(EDirectDrawError);
  157.  
  158.   {  TDirectDraw  }
  159.  
  160.   TDirectDrawClipper = class;
  161.   TDirectDrawPalette = class;
  162.   TDirectDrawSurface = class;
  163.  
  164.   TDirectDraw = class(TDirectX)
  165.   private
  166.     {$IFDEF D3D_deprecated}
  167.     FIDDraw: IDirectDraw;
  168.     FIDDraw4: IDirectDraw4;
  169.     {$ENDIF}
  170.     FIDDraw7: IDirectDraw7;
  171.     FDriverCaps: TDDCaps;
  172.     FHELCaps: TDDCaps;
  173.     FClippers: TList;
  174.     FPalettes: TList;
  175.     FSurfaces: TList;
  176.     function GetClipper(Index: Integer): TDirectDrawClipper;
  177.     function GetClipperCount: Integer;
  178.     function GetDisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
  179.     {$IFDEF D3D_deprecated}
  180.     function GetIDDraw: IDirectDraw;
  181.     function GetIDDraw4: IDirectDraw4;
  182.     {$ENDIF}
  183.     function GetIDDraw7: IDirectDraw7;
  184.     {$IFDEF D3D_deprecated}
  185.     function GetIDraw: IDirectDraw;
  186.     function GetIDraw4: IDirectDraw4;
  187.     {$ENDIF}
  188.     function GetIDraw7: IDirectDraw7;
  189.     function GetPalette(Index: Integer): TDirectDrawPalette;
  190.     function GetPaletteCount: Integer;
  191.     function GetSurface(Index: Integer): TDirectDrawSurface;
  192.     function GetSurfaceCount: Integer;
  193.   public
  194.     constructor Create(GUID: PGUID);
  195.     constructor CreateEx(GUID: PGUID; DirectX7Mode: Boolean);
  196.     destructor Destroy; override;
  197.     class function Drivers: TDirectXDrivers;
  198.     {$IFDEF _DMO_}class function DriversEx: TDirectXDriversEx;{$ENDIF}
  199.     property ClipperCount: Integer read GetClipperCount;
  200.     property Clippers[Index: Integer]: TDirectDrawClipper read GetClipper;
  201.     property DisplayMode: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF} read GetDisplayMode;
  202.     property DriverCaps: TDDCaps read FDriverCaps;
  203.     property HELCaps: TDDCaps read FHELCaps;
  204.     {$IFDEF D3D_deprecated}
  205.     property IDDraw: IDirectDraw read GetIDDraw;
  206.     property IDDraw4: IDirectDraw4 read GetIDDraw4;
  207.     {$ENDIF}
  208.     property IDDraw7: IDirectDraw7 read GetIDDraw7;
  209.     {$IFDEF D3D_deprecated}
  210.     property IDraw: IDirectDraw read GetIDraw;
  211.     property IDraw4: IDirectDraw4 read GetIDraw4;
  212.     {$ENDIF}
  213.     property IDraw7: IDirectDraw7 read GetIDraw7;
  214.     property PaletteCount: Integer read GetPaletteCount;
  215.     property Palettes[Index: Integer]: TDirectDrawPalette read GetPalette;
  216.     property SurfaceCount: Integer read GetSurfaceCount;
  217.     property Surfaces[Index: Integer]: TDirectDrawSurface read GetSurface;
  218.   end;
  219.  
  220.   {  TDirectDrawClipper  }
  221.  
  222.   TDirectDrawClipper = class(TDirectX)
  223.   private
  224.     FDDraw: TDirectDraw;
  225.     FIDDClipper: IDirectDrawClipper;
  226.     function GetIDDClipper: IDirectDrawClipper;
  227.     function GetIClipper: IDirectDrawClipper;
  228.     procedure SetHandle(Value: THandle);
  229.     procedure SetIDDClipper(Value: IDirectDrawClipper);
  230.     property Handle: THandle write SetHandle;
  231.   public
  232.     constructor Create(ADirectDraw: TDirectDraw);
  233.     destructor Destroy; override;
  234.     procedure SetClipRects(const Rects: array of TRect);
  235.     property DDraw: TDirectDraw read FDDraw;
  236.     property IClipper: IDirectDrawClipper read GetIClipper;
  237.     property IDDClipper: IDirectDrawClipper read GetIDDClipper write SetIDDClipper;
  238.   end;
  239.  
  240.   {  TDirectDrawPalette  }
  241.  
  242.   TDirectDrawPalette = class(TDirectX)
  243.   private
  244.     FDDraw: TDirectDraw;
  245.     FIDDPalette: IDirectDrawPalette;
  246.     function GetEntry(Index: Integer): TPaletteEntry;
  247.     function GetIDDPalette: IDirectDrawPalette;
  248.     function GetIPalette: IDirectDrawPalette;
  249.     procedure SetEntry(Index: Integer; Value: TPaletteEntry);
  250.     procedure SetIDDPalette(Value: IDirectDrawPalette);
  251.   public
  252.     constructor Create(ADirectDraw: TDirectDraw);
  253.     destructor Destroy; override;
  254.     function CreatePalette(Caps: DWORD; const Entries): Boolean;
  255.     function GetEntries(StartIndex, NumEntries: Integer; var Entries): Boolean;
  256.     procedure LoadFromDIB(DIB: TDIB);
  257.     procedure LoadFromFile(const FileName: string);
  258.     procedure LoadFromStream(Stream: TStream);
  259.     function SetEntries(StartIndex, NumEntries: Integer; const Entries): Boolean;
  260.     property DDraw: TDirectDraw read FDDraw;
  261.     property Entries[Index: Integer]: TPaletteEntry read GetEntry write SetEntry;
  262.     property IDDPalette: IDirectDrawPalette read GetIDDPalette write SetIDDPalette;
  263.     property IPalette: IDirectDrawPalette read GetIPalette;
  264.   end;
  265.  
  266.   {  TDirectDrawSurfaceCanvas  }
  267.  
  268.   TDirectDrawSurfaceCanvas = class(TCanvas)
  269.   private
  270.     FDC: HDC;
  271.     FSurface: TDirectDrawSurface;
  272.   protected
  273.     procedure CreateHandle; override;
  274.   public
  275.     constructor Create(ASurface: TDirectDrawSurface);
  276.     destructor Destroy; override;
  277.     procedure Release;
  278.   end;
  279.  
  280.   {  TDirectDrawSurface  }
  281.  
  282.   TDirectDrawSurface = class(TDirectX)
  283.   private
  284.     FCanvas: TDirectDrawSurfaceCanvas;
  285.     FHasClipper: Boolean;
  286.     FDDraw: TDirectDraw;
  287.     {$IFDEF D3D_deprecated}
  288.     FIDDSurface: IDirectDrawSurface;
  289.     FIDDSurface4: IDirectDrawSurface4;
  290.     {$ENDIF}
  291.     FIDDSurface7: IDirectDrawSurface7;
  292.     FSystemMemory: Boolean;
  293.     FStretchDrawClipper: IDirectDrawClipper;
  294.     FSurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
  295.     FGammaControl: IDirectDrawGammaControl;
  296.     FLockSurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF};
  297.     FLockCount: Integer;
  298.     FIsLocked: Boolean;
  299.     FModified: Boolean;
  300.     FCaption: TCaption;
  301.     DIB_COLMATCH: TDIB;
  302.     function GetBitCount: Integer;
  303.     function GetCanvas: TDirectDrawSurfaceCanvas;
  304.     function GetClientRect: TRect;
  305.     function GetHeight: Integer;
  306.     {$IFDEF D3D_deprecated}
  307.     function GetIDDSurface: IDirectDrawSurface; {$IFDEF VER9UP}inline;{$ENDIF}
  308.     function GetIDDSurface4: IDirectDrawSurface4; {$IFDEF VER9UP}inline;{$ENDIF}
  309.     {$ENDIF}
  310.     function GetIDDSurface7: IDirectDrawSurface7; {$IFDEF VER9UP}inline;{$ENDIF}
  311.     {$IFDEF D3D_deprecated}
  312.     function GetISurface: IDirectDrawSurface;
  313.     function GetISurface4: IDirectDrawSurface4;
  314.     {$ENDIF}
  315.     function GetISurface7: IDirectDrawSurface7;
  316.     function GetPixel(X, Y: Integer): Longint;
  317.     function GetWidth: Integer;
  318.     procedure SetClipper(Value: TDirectDrawClipper);
  319.     procedure SetColorKey(Flags: DWORD; const Value: TDDColorKey);
  320.     {$IFDEF D3D_deprecated}
  321.     procedure SetIDDSurface(Value: IDirectDrawSurface);
  322.     procedure SetIDDSurface4(Value: IDirectDrawSurface4);
  323.     {$ENDIF}
  324.     procedure SetIDDSurface7(Value: IDirectDrawSurface7);
  325.     procedure SetPalette(Value: TDirectDrawPalette);
  326.     procedure SetPixel(X, Y: Integer; Value: Longint);
  327.     procedure SetTransparentColor(Col: Longint);
  328.     {support RGB routines}
  329.     procedure LoadRGB(Color: cardinal; var R, G, B: Byte);
  330.     function SaveRGB(const R, G, B: Byte): cardinal;
  331.     {asm routine for direct surface by pixel}
  332.     {no clipping}
  333.     function GetPixel16(x, y: Integer): Integer; register;
  334.     function GetPixel24(x, y: Integer): Integer; register;
  335.     function GetPixel32(x, y: Integer): Integer; register;
  336.     function GetPixel8(x, y: Integer): Integer; register;
  337.     procedure PutPixel16(x, y, color: Integer); register;
  338.     procedure PutPixel24(x, y, color: Integer); register;
  339.     procedure PutPixel32(x, y, color: Integer); register;
  340.     procedure PutPixel8(x, y, color: Integer); register;
  341.     {routines calls asm pixel routine}
  342.     function Peek(X, Y: Integer): LongInt; {$IFDEF VER9UP} inline; {$ENDIF}
  343.     procedure Poke(X, Y: Integer; const Value: LongInt); {$IFDEF VER9UP} inline; {$ENDIF}
  344.   public
  345.     constructor Create(ADirectDraw: TDirectDraw);
  346.     destructor Destroy; override;
  347.     procedure Assign(Source: TPersistent); override;
  348.     procedure AssignTo(Dest: TPersistent); override;
  349.     function Blt(const DestRect, SrcRect: TRect; Flags: DWORD;
  350.       const DF: TDDBltFX; Source: TDirectDrawSurface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  351.     function BltFast(X, Y: Integer; const SrcRect: TRect;
  352.       Flags: DWORD; Source: TDirectDrawSurface): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  353.     function ColorMatch(Col: TColor): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  354.   {$IFDEF VER4UP}
  355.     {$IFDEF D3D_deprecated}
  356.     function CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean; overload;
  357.     {$ENDIF}
  358.     function CreateSurface(SurfaceDesc: TDDSurfaceDesc2): Boolean; overload;
  359.   {$ELSE}
  360.     function CreateSurface(SurfaceDesc: TDDSurfaceDesc): Boolean;
  361.   {$ENDIF}
  362.  
  363.     procedure MirrorFlip(Value: TRenderMirrorFlipSet);
  364.  
  365.   {$IFDEF VER4UP}
  366.     procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface; Transparent: Boolean = True); overload;
  367.     procedure Draw(X, Y: Integer; Source: TDirectDrawSurface; Transparent: Boolean = True); overload;
  368.     procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  369.       Transparent: Boolean = True); overload;
  370.     procedure StretchDraw(const DestRect: TRect; Source: TDirectDrawSurface;
  371.       Transparent: Boolean = True); overload;
  372.   {$ELSE}
  373.     procedure Draw(X, Y: Integer; SrcRect: TRect; Source: TDirectDrawSurface;
  374.       Transparent: Boolean);
  375.     procedure StretchDraw(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  376.       Transparent: Boolean);
  377.   {$ENDIF}
  378.     procedure DrawAdd(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  379.       Transparent: Boolean; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  380.     procedure DrawAlpha(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  381.       Transparent: Boolean; Alpha: Integer);
  382.     procedure DrawSub(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  383.       Transparent: Boolean; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  384.  
  385.     procedure DrawAddCol(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  386.       Transparent: Boolean; Color, Alpha: Integer);
  387.     procedure DrawAlphaCol(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  388.       Transparent: Boolean; Color, Alpha: Integer);
  389.     procedure DrawSubCol(const DestRect, SrcRect: TRect; Source: TDirectDrawSurface;
  390.       Transparent: Boolean; Color, Alpha: Integer);
  391.  
  392.     {Rotate}
  393.     procedure DrawRotate(X, Y, Width, Height: Integer; const SrcRect: TRect;
  394.       Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single);
  395.     procedure DrawRotateAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
  396.       Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
  397.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  398.     procedure DrawRotateAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
  399.       Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
  400.       Alpha: Integer);
  401.     procedure DrawRotateSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
  402.       Source: TDirectDrawSurface; CenterX, CenterY: Double; Transparent: Boolean; Angle: single;
  403.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  404.  
  405.     procedure DrawRotateAddCol(X, Y, Width, Height: Integer;
  406.       const SrcRect: TRect; Source: TDirectDrawSurface; CenterX,
  407.       CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer;
  408.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  409.     procedure DrawRotateAlphaCol(X, Y, Width, Height: Integer;
  410.       const SrcRect: TRect; Source: TDirectDrawSurface; CenterX,
  411.       CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer;
  412.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  413.     procedure DrawRotateCol(X, Y, Width, Height: Integer; const SrcRect: TRect;
  414.       Source: TDirectDrawSurface; CenterX, CenterY: Double;
  415.       Transparent: Boolean; Angle: Single; Color: Integer);
  416.     procedure DrawRotateSubCol(X, Y, Width, Height: Integer;
  417.       const SrcRect: TRect; Source: TDirectDrawSurface; CenterX,
  418.       CenterY: Double; Transparent: Boolean; Angle: Single; Color: Integer;
  419.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  420.     {WaveX}
  421.     procedure DrawWaveX(X, Y, Width, Height: Integer; const SrcRect: TRect;
  422.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
  423.     procedure DrawWaveXAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
  424.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
  425.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  426.     procedure DrawWaveXAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
  427.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
  428.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  429.     procedure DrawWaveXSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
  430.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
  431.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  432.     {WaveY}
  433.     procedure DrawWaveY(X, Y, Width, Height: Integer; const SrcRect: TRect;
  434.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer);
  435.     procedure DrawWaveYAdd(X, Y, Width, Height: Integer; const SrcRect: TRect;
  436.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
  437.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  438.     procedure DrawWaveYAlpha(X, Y, Width, Height: Integer; const SrcRect: TRect;
  439.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
  440.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  441.     procedure DrawWaveYSub(X, Y, Width, Height: Integer; const SrcRect: TRect;
  442.       Source: TDirectDrawSurface; Transparent: Boolean; amp, Len, ph: Integer;
  443.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  444.     {Poke function}
  445.     procedure PokeLine(X1, Y1, X2, Y2: Integer; Color: cardinal); {$IFDEF VER9UP} inline; {$ENDIF}
  446.     procedure PokeLinePolar(x, y: Integer; angle, length: extended;
  447.       Color: cardinal); {$IFDEF VER9UP} inline; {$ENDIF}
  448.     procedure PokeBox(xs, ys, xd, yd: Integer; Color: cardinal);
  449.     procedure PokeBlendPixel(const X, Y: Integer; aColor: cardinal;
  450.       Alpha: byte);
  451.     procedure PokeWuLine(X1, Y1, X2, Y2, aColor: Integer);
  452.     procedure Noise(Oblast: TRect; Density: Byte);
  453.     procedure Blur;
  454.     procedure DoRotate(cent1, cent2, angle: Integer; coord1, coord2: Real;
  455.       color: word);
  456.     procedure PokeCircle(X, Y, Radius, Color: Integer);
  457.     procedure PokeEllipse(exc, eyc, ea, eb, angle, color: Integer);
  458.     procedure PokeFilledEllipse(exc, eyc, ea, eb, color: Integer);
  459.     procedure PokeVLine(x, y1, y2: Integer; Color: cardinal);
  460.     {Fill}
  461.     procedure Fill(DevColor: Longint);
  462.     procedure FillRect(const Rect: TRect; DevColor: Longint);
  463.     procedure FillRectAdd(const DestRect: TRect; Color: TColor; Alpha: Byte{$IFDEF VER4UP} = 128{$ENDIF});
  464.     procedure FillRectAlpha(const DestRect: TRect; Color: TColor; Alpha: Integer);
  465.     procedure FillRectSub(const DestRect: TRect; Color: TColor; Alpha: Byte{$IFDEF VER4UP} = 128{$ENDIF});
  466.     {Load}
  467.     procedure LoadFromDIB(DIB: TDIB);
  468.     procedure LoadFromDIBRect(DIB: TDIB; AWidth, AHeight: Integer; const SrcRect: TRect);
  469.     procedure LoadFromGraphic(Graphic: TGraphic);
  470.     procedure LoadFromGraphicRect(Graphic: TGraphic; AWidth, AHeight: Integer; const SrcRect: TRect);
  471.     procedure LoadFromFile(const FileName: string);
  472.     procedure LoadFromStream(Stream: TStream);
  473.     {$IFDEF VER4UP}
  474.     function Lock(const Rect: TRect; var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean; overload;
  475.     function Lock(var SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF}): Boolean; overload;
  476.     function Lock: Boolean; overload;
  477.     {$ELSE}
  478.     function LockSurface: Boolean;
  479.     function Lock(const Rect: TRect; var SurfaceDesc: TDDSurfaceDesc): Boolean;
  480.     {$ENDIF}
  481.     procedure UnLock;
  482.     function Restore: Boolean;
  483.     property IsLocked: Boolean read FIsLocked;
  484.     procedure SetSize(AWidth, AHeight: Integer);
  485.     property Modified: Boolean read FModified write FModified;
  486.     property BitCount: Integer read GetBitCount;
  487.     property Canvas: TDirectDrawSurfaceCanvas read GetCanvas;
  488.     property ClientRect: TRect read GetClientRect;
  489.     property Clipper: TDirectDrawClipper write SetClipper;
  490.     property ColorKey[Flags: DWORD]: TDDColorKey write SetColorKey;
  491.     property DDraw: TDirectDraw read FDDraw;
  492.     property GammaControl: IDirectDrawGammaControl read FGammaControl;
  493.     property Height: Integer read GetHeight;
  494.     {$IFDEF D3D_deprecated}
  495.     property IDDSurface: IDirectDrawSurface read GetIDDSurface write SetIDDSurface;
  496.     property IDDSurface4: IDirectDrawSurface4 read GetIDDSurface4 write SetIDDSurface4;
  497.     {$ENDIF}
  498.     property IDDSurface7: IDirectDrawSurface7 read GetIDDSurface7 write SetIDDSurface7;
  499.     {$IFDEF D3D_deprecated}
  500.     property ISurface: IDirectDrawSurface read GetISurface;
  501.     property ISurface4: IDirectDrawSurface4 read GetISurface4;
  502.     {$ENDIF}
  503.     property ISurface7: IDirectDrawSurface7 read GetISurface7;
  504.     property Palette: TDirectDrawPalette write SetPalette;
  505.     property Pixels[X, Y: Integer]: Longint read GetPixel write SetPixel;
  506.     property Pixel[X, Y: Integer]: LongInt read Peek write Poke;
  507.     property SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF} read FSurfaceDesc;
  508.     property SystemMemory: Boolean read FSystemMemory write FSystemMemory;
  509.     property TransparentColor: Longint write SetTransparentColor;
  510.     property Width: Integer read GetWidth;
  511.     property Caption: TCaption read FCaption write FCaption;
  512.   end;
  513.  
  514.   {  TDXDrawDisplay  }
  515.  
  516.   TCustomDXDraw = class;
  517.  
  518.   TDXDrawDisplayMode = class(TCollectionItem)
  519.   private
  520.     FSurfaceDesc: TDDSurfaceDesc;
  521.     function GetBitCount: Integer;
  522.     function GetHeight: Integer;
  523.     function GetWidth: Integer;
  524.   public
  525.     property BitCount: Integer read GetBitCount;
  526.     property Height: Integer read GetHeight;
  527.     property SurfaceDesc: TDDSurfaceDesc read FSurfaceDesc;
  528.     property Width: Integer read GetWidth;
  529.   end;
  530.  
  531.   TDXDrawDisplay = class(TPersistent)
  532.   private
  533.     FBitCount: Integer;
  534.     FDXDraw: TCustomDXDraw;
  535.     FHeight: Integer;
  536.     FModes: TCollection;
  537.     FWidth: Integer;
  538.     FFixedBitCount: Boolean;
  539.     FFixedRatio: Boolean;
  540.     FFixedSize: Boolean;
  541.     function GetCount: Integer;
  542.     function GetMode: TDXDrawDisplayMode;
  543.     function GetMode2(Index: Integer): TDXDrawDisplayMode;
  544.     procedure LoadDisplayModes;
  545.     procedure SetBitCount(Value: Integer);
  546.     procedure SetHeight(Value: Integer);
  547.     procedure SetWidth(Value: Integer);
  548.     function SetSize(AWidth, AHeight, ABitCount{$IFNDEF D3D_deprecated}, ARefreshRate, AFlags{$ENDIF}: Integer): Boolean;
  549.     function DynSetSize(AWidth, AHeight, ABitCount: Integer): Boolean;
  550.   public
  551.     constructor Create(ADXDraw: TCustomDXDraw);
  552.     destructor Destroy; override;
  553.     procedure Assign(Source: TPersistent); override;
  554.     function IndexOf(Width, Height, BitCount: Integer): Integer;
  555.     property Count: Integer read GetCount;
  556.     property Mode: TDXDrawDisplayMode read GetMode;
  557.     property Modes[Index: Integer]: TDXDrawDisplayMode read GetMode2; default;
  558.   published
  559.     property BitCount: Integer read FBitCount write SetBitCount default 16;
  560.     property FixedBitCount: Boolean read FFixedBitCount write FFixedBitCount;
  561.     property FixedRatio: Boolean read FFixedRatio write FFixedRatio;
  562.     property FixedSize: Boolean read FFixedSize write FFixedSize;
  563.     property Height: Integer read FHeight write SetHeight default 480;
  564.     property Width: Integer read FWidth write SetWidth default 640;
  565.   end;
  566.  
  567.   TDirectDrawDisplay = TDXDrawDisplay;
  568.   TDirectDrawDisplayMode = TDXDrawDisplayMode;
  569.  
  570.   {  EDXDrawError  }
  571.  
  572.   EDXDrawError = class(Exception);
  573.  
  574.   { TD2D HW acceleration}
  575.  
  576.   TD2D = class;
  577.  
  578.   {  TTracerCollection  }
  579.  
  580.   TTraces = class;
  581.  
  582.   {  TCustomDXDraw  }
  583.  
  584.   TD2DTextureFilter = (D2D_POINT, D2D_LINEAR, D2D_FLATCUBIC, D2D_GAUSSIANCUBIC, D2D_ANISOTROPIC);
  585.  
  586.  
  587.   TDXDrawOption = (doFullScreen, doNoWindowChange, doAllowReboot, doWaitVBlank,
  588.     doAllowPalette256, doSystemMemory, doStretch, doCenter, doFlip,
  589.     {$IFDEF D3D_deprecated}do3D, doDirectX7Mode,{$ENDIF} {$IFDEF D3DRM} doRetainedMode,{$ENDIF}
  590.     doHardware, doSelectDriver, doZBuffer);
  591.  
  592.   TDXDrawOptions = set of TDXDrawOption;
  593.  
  594.   TDXDrawNotifyType = (dxntDestroying, dxntInitializing, dxntInitialize, dxntInitializeSurface,
  595.     dxntFinalize, dxntFinalizeSurface, dxntRestore, dxntSetSurfaceSize);
  596.  
  597.   TDXDrawNotifyEvent = procedure(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType) of object;
  598.  
  599.   TD2DTextures = class;
  600.   TOnUpdateTextures = procedure(const Sender: TD2DTextures; var Changed: Boolean) of object;
  601.  
  602.   TPictureCollectionItem = class;
  603.  
  604.   {$IFNDEF D3D_deprecated}
  605.   TD3DDeviceType = (dtTnLHAL, dtHAL,dtMMX,dtRGB,dtRamp,dtRef);
  606.   TD3DDeviceTypeSet = Set of TD3DDeviceType;
  607.   {$ENDIF}
  608.  
  609.   TCustomDXDraw = class(TCustomControl)
  610.   private
  611.     FAutoInitialize: Boolean;
  612.     FAutoSize: Boolean;
  613.     FCalledDoInitialize: Boolean;
  614.     FCalledDoInitializeSurface: Boolean;
  615.     FForm: TCustomForm;
  616.     FNotifyEventList: TList;
  617.     FInitialized: Boolean;
  618.     FInitialized2: Boolean;
  619.     FInternalInitialized: Boolean;
  620.     FUpdating: Boolean;
  621.     FSubClass: TControlSubClass;
  622.     FNowOptions: TDXDrawOptions;
  623.     FOptions: TDXDrawOptions;
  624.     FOnFinalize: TNotifyEvent;
  625.     FOnFinalizeSurface: TNotifyEvent;
  626.     FOnInitialize: TNotifyEvent;
  627.     FOnInitializeSurface: TNotifyEvent;
  628.     FOnInitializing: TNotifyEvent;
  629.     FOnRestoreSurface: TNotifyEvent;
  630.     FOffNotifyRestore: Integer;
  631.     { DirectDraw }
  632.     FDXDrawDriver: TObject;
  633.     FDriver: PGUID;
  634.     FDriverGUID: TGUID;
  635.     FDDraw: TDirectDraw;
  636.     FDisplay: TDXDrawDisplay;
  637.     {$IFNDEF D3D_deprecated}
  638.     FDeviceTypeSet: TD3DDeviceTypeSet;{$ENDIF}
  639.     {$IFDEF _DMO_}FAdapters: TDirectXDriversEx;{$ENDIF}
  640.     FClipper: TDirectDrawClipper;
  641.     FPalette: TDirectDrawPalette;
  642.     FPrimary: TDirectDrawSurface;
  643.     FSurface: TDirectDrawSurface;
  644.     FSurfaceWidth: Integer;
  645.     FSurfaceHeight: Integer;
  646.     { Direct3D }
  647.     {$IFDEF D3D_deprecated}
  648.     FD3D: IDirect3D;
  649.     FD3D2: IDirect3D2;
  650.     FD3D3: IDirect3D3;
  651.     {$ENDIF}
  652.     FD3D7: IDirect3D7;
  653.     {$IFDEF D3D_deprecated}
  654.     FD3DDevice: IDirect3DDevice;
  655.     FD3DDevice2: IDirect3DDevice2;
  656.     FD3DDevice3: IDirect3DDevice3;
  657.     {$ENDIF}
  658.     FD3DDevice7: IDirect3DDevice7;
  659. {$IFDEF D3DRM}
  660.     FD3DRM: IDirect3DRM;
  661.     FD3DRM2: IDirect3DRM2;
  662.     FD3DRM3: IDirect3DRM3;
  663.     FD3DRMDevice: IDirect3DRMDevice;
  664.     FD3DRMDevice2: IDirect3DRMDevice2;
  665.     FD3DRMDevice3: IDirect3DRMDevice3;
  666.     FCamera: IDirect3DRMFrame;
  667.     FScene: IDirect3DRMFrame;
  668.     FViewport: IDirect3DRMViewport;
  669. {$ENDIF}
  670.     FZBuffer: TDirectDrawSurface;
  671.     FD2D: TD2D;
  672.     FOnUpdateTextures: TOnUpdateTextures;
  673.     FTraces: TTraces;
  674.     FOnRender: TNotifyEvent;
  675.     procedure FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);
  676.     function GetCanDraw: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  677.     function GetCanPaletteAnimation: Boolean;
  678.     function GetSurfaceHeight: Integer;
  679.     function GetSurfaceWidth: Integer;
  680.     procedure NotifyEventList(NotifyType: TDXDrawNotifyType);
  681.     procedure SetColorTable(const ColorTable: TRGBQuads);
  682.     procedure SetCooperativeLevel;
  683.     procedure SetDisplay(Value: TDXDrawDisplay);
  684.     procedure SetDriver(Value: PGUID);
  685.     procedure SetOptions(Value: TDXDrawOptions);
  686.     procedure SetSurfaceHeight(Value: Integer);
  687.     procedure SetSurfaceWidth(Value: Integer);
  688.     function TryRestore: Boolean;
  689.     procedure WMCreate(var Message: TMessage); message WM_CREATE;
  690.     function Fade2Color(colorfrom, colorto: Integer): LongInt;
  691.     function Grey2Fade(shadefrom, shadeto: Integer): Integer;
  692.     procedure SetTraces(const Value: TTraces);
  693.     function CheckD3: Boolean;
  694.     function CheckD3D(Dest: TDirectDrawSurface): Boolean;
  695.   protected
  696.     procedure DoFinalize; virtual;
  697.     procedure DoFinalizeSurface; virtual;
  698.     procedure DoInitialize; virtual;
  699.     procedure DoInitializeSurface; virtual;
  700.     procedure DoInitializing; virtual;
  701.     procedure DoRestoreSurface; virtual;
  702.     procedure Loaded; override;
  703.     procedure Paint; override;
  704.     function PaletteChanged(Foreground: Boolean): Boolean; override;
  705.     procedure SetParent(AParent: TWinControl); override;
  706.     procedure SetAutoSize(Value: Boolean); {$IFDEF D6UP} override; {$ENDIF}
  707.     property OnUpdateTextures: TOnUpdateTextures read FOnUpdateTextures write FOnUpdateTextures;
  708.     property OnRender: TNotifyEvent read FOnRender write FOnRender;
  709.   public
  710.     ColorTable: TRGBQuads;
  711.     DefColorTable: TRGBQuads;
  712.     //
  713.     function Fade2Black(colorfrom: Integer): Longint;
  714.     function Fade2White(colorfrom: Integer): Longint;
  715.     //
  716.     constructor Create(AOwner: TComponent); override;
  717.     destructor Destroy; override;
  718.     class function Drivers: TDirectXDrivers;
  719.     {$IFDEF _DMO_}class function DriversEx: TDirectXDriversEx;{$ENDIF}
  720.     procedure Finalize;
  721.     procedure Flip;
  722.     procedure Initialize;
  723.     procedure Render(LagCount: Integer{$IFDEF VER4UP} = 0{$ENDIF});
  724.     procedure Restore;
  725.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  726.     procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
  727.     procedure BeginScene;
  728.     procedure EndScene;
  729.     procedure TextureFilter(Grade: TD2DTextureFilter);
  730.     procedure AntialiasFilter(Grade: TD3DAntialiasMode);
  731.     procedure MirrorFlip(Value: TRenderMirrorFlipSet);
  732.     procedure SaveTextures(path: string);
  733.     procedure ClearStack;
  734.     procedure UpdateTextures;
  735.     {grab images}
  736.     procedure PasteImage(sdib: TDIB; x, y: Integer);
  737.     procedure GrabImage(iX, iY, iWidth, iHeight: Integer; ddib: TDIB);
  738.     {fades}
  739.     function Black2Screen(oldcolor: Integer): Longint;
  740.     function Fade2Screen(oldcolor, newcolour: Integer): LongInt;
  741.     function White2Screen(oldcolor: Integer): LongInt;
  742.     function FadeGrey2Screen(oldcolor, newcolour: LongInt): LongInt;
  743.     procedure UpdatePalette;
  744.     procedure RegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
  745.     procedure UnRegisterNotifyEvent(NotifyEvent: TDXDrawNotifyEvent);
  746.     property AutoInitialize: Boolean read FAutoInitialize write FAutoInitialize;
  747.     property AutoSize: Boolean read FAutoSize write SetAutoSize;
  748. {$IFDEF D3DRM}property Camera: IDirect3DRMFrame read FCamera; {$ENDIF}
  749.     property CanDraw: Boolean read GetCanDraw;
  750.     property CanPaletteAnimation: Boolean read GetCanPaletteAnimation;
  751.     property Clipper: TDirectDrawClipper read FClipper;
  752.     property Color;
  753.     {$IFDEF D3D_deprecated}
  754.     property D3D: IDirect3D read FD3D;
  755.     property D3D2: IDirect3D2 read FD3D2;
  756.     property D3D3: IDirect3D3 read FD3D3;
  757.     {$ENDIF}
  758.     property D3D7: IDirect3D7 read FD3D7;
  759.     {$IFDEF D3D_deprecated}
  760.     property D3DDevice: IDirect3DDevice read FD3DDevice;
  761.     property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
  762.     property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
  763.     {$ENDIF}
  764.     property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
  765.     {$IFNDEF D3D_deprecated}
  766.     property D3DDeviceTypeSet: TD3DDeviceTypeSet read FDeviceTypeSet;{$ENDIF}
  767. {$IFDEF D3DRM}
  768.     property D3DRM: IDirect3DRM read FD3DRM;
  769.     property D3DRM2: IDirect3DRM2 read FD3DRM2;
  770.     property D3DRM3: IDirect3DRM3 read FD3DRM3;
  771.     property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
  772.     property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
  773.     property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
  774. {$ENDIF}
  775.     property DDraw: TDirectDraw read FDDraw;
  776.     property Display: TDXDrawDisplay read FDisplay write SetDisplay;
  777.     {$IFDEF _DMO_}property Adapter: TDirectXDriversEx read FAdapters write FAdapters;{$ENDIF}
  778.     property Driver: PGUID read FDriver write SetDriver;
  779.     property Initialized: Boolean read FInitialized;
  780.     property NowOptions: TDXDrawOptions read FNowOptions;
  781.     property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
  782.     property OnFinalizeSurface: TNotifyEvent read FOnFinalizeSurface write FOnFinalizeSurface;
  783.     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
  784.     property OnInitializeSurface: TNotifyEvent read FOnInitializeSurface write FOnInitializeSurface;
  785.     property OnInitializing: TNotifyEvent read FOnInitializing write FOnInitializing;
  786.     property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
  787.     property Options: TDXDrawOptions read FOptions write SetOptions;
  788.     property Palette: TDirectDrawPalette read FPalette;
  789.     property Primary: TDirectDrawSurface read FPrimary;
  790. {$IFDEF D3DRM}property Scene: IDirect3DRMFrame read FScene; {$ENDIF}
  791.     property Surface: TDirectDrawSurface read FSurface;
  792.     property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
  793.     property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
  794. {$IFDEF D3DRM}property Viewport: IDirect3DRMViewport read FViewport; {$ENDIF}
  795.     property ZBuffer: TDirectDrawSurface read FZBuffer;
  796.     property D2D1: TD2D read FD2D; {public object is here}
  797.     property Traces: TTraces read FTraces write SetTraces;
  798.   end;
  799.  
  800.   {  TDXDraw  }
  801.  
  802.   TDXDraw = class(TCustomDXDraw)
  803.   published
  804.     {$IFDEF _DMO_}property Adapter;{$ENDIF}
  805.     property AutoInitialize;
  806.     property AutoSize;
  807.     property Color;
  808.     property Display;
  809.     property Options;
  810.     property SurfaceHeight;
  811.     property SurfaceWidth;
  812.     property OnFinalize;
  813.     property OnFinalizeSurface;
  814.     property OnInitialize;
  815.     property OnInitializeSurface;
  816.     property OnInitializing;
  817.     property OnRestoreSurface;
  818.     property OnUpdateTextures;
  819.     property OnRender;
  820.  
  821.     property Align;
  822. {$IFDEF VER4UP}property Anchors; {$ENDIF}
  823. {$IFDEF VER4UP}property Constraints; {$ENDIF}
  824.     property DragCursor;
  825.     property DragMode;
  826.     property Enabled;
  827.     property ParentShowHint;
  828.     property PopupMenu;
  829.     property ShowHint;
  830.     property TabOrder;
  831.     property TabStop;
  832.     property Traces;
  833.     property Visible;
  834.     property OnClick;
  835.     property OnDblClick;
  836.     property OnDragDrop;
  837.     property OnDragOver;
  838.     property OnEndDrag;
  839.     property OnEnter;
  840.     property OnExit;
  841.     property OnKeyDown;
  842.     property OnKeyPress;
  843.     property OnKeyUp;
  844.     property OnMouseDown;
  845.     property OnMouseMove;
  846.     property OnMouseUp;
  847. {$IFDEF VER9UP}
  848.     property OnMouseWheel;
  849.     property OnMouseWheelUp;
  850.     property OnMouseWheelDown;
  851. {$ENDIF}
  852. {$IFDEF VER4UP}property OnResize; {$ENDIF}
  853.     property OnStartDrag;
  854.   end;
  855.  
  856.   {  EDX3DError  }
  857.  
  858.   EDX3DError = class(Exception);
  859.  
  860.   {  DxTracer  }
  861.  
  862.   EDXTracerError = class(Exception);
  863.   EDXBlitError = class(Exception);
  864.  
  865.   TTracePointsType = (tptDot, tptLine, tptCircle, tptCurve);
  866.  
  867.   TBlitMoveEvent = procedure(Sender: TObject; LagCount: Integer; var MoveIt: Boolean) of object;
  868.   TWaveType = (wtWaveNone, wtWaveX, wtWaveY);
  869.   TBlitRec = packed record
  870.     FCollisioned: Boolean;
  871.     FMoved: Boolean;
  872.     FVisible: Boolean;
  873.     FX: Double;
  874.     FY: Double;
  875.     FZ: Integer;
  876.     FWidth: Integer;
  877.     FHeight: Integer;
  878.     //--
  879.     FAnimCount: Integer;
  880.     FAnimLooped: Boolean;
  881.     FAnimPos: Double;
  882.     FAnimSpeed: Double;
  883.     FAnimStart: Integer;
  884.     //FTile: Boolean;
  885.     FAngle: Single;
  886.     FAlpha: Integer;
  887.     FCenterX: Double;
  888.     FCenterY: Double;
  889.     FScale: Double;
  890.     FBlendMode: TRenderType;
  891.     FAmplitude: Integer;
  892.     FAmpLength: Integer;
  893.     FPhase: Integer;
  894.     FWaveType: TWaveType;
  895.     FSpeedX, FSpeedY: Single;
  896.     FGravityX, FGravityY: Single;
  897.     FEnergy: Single;
  898.     FBlurImage: Boolean;
  899.     FMirror: Boolean;
  900.     FFlip: Boolean;
  901.     FTextureFilter: TD2DTextureFilter;
  902.   end;
  903.   TBlurImageProp = packed record
  904.     eActive: Boolean;
  905.     eX, eY: Integer;
  906.     ePatternIndex: Integer; {when animated or 0 always}
  907.     eAngle: Single; //angle can be saved too
  908.     eBlendMode: TRenderType; //blend mode
  909.     eIntensity: Byte; {intensity of Blur/Add/Sub}
  910.   end;
  911.  
  912.   TPath = packed record
  913.     X, Y, Z: Single;
  914.     StayOn: Integer; {in milisecond}
  915.     Reserved: string[28]; {for future use}
  916.     Tag: Integer;
  917.   end;
  918.   TPathArr = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TPath;
  919. {$IFNDEF VER4UP}
  920.   PPathArr = ^TPathArr;
  921. {$ENDIF}
  922.   TBlit = class;
  923.  
  924.   TOnRender = procedure(Sender: TBlit) of object;
  925.  
  926.   TBlurImageArr = array[0..7] of TBlurImageProp;
  927.   TBlit = class(TPersistent)
  928.   private
  929.     FPathArr: {$IFNDEF VER4UP}PPathArr{$ELSE}TPathArr{$ENDIF};
  930. {$IFNDEF VER4UP}
  931.     FPathLen: Integer;
  932. {$ENDIF}
  933.     FParent: TBlit;
  934.     FBlitRec: TBlitRec;
  935.     FBlurImageArr: TBlurImageArr;
  936.     FActive: Boolean;
  937.     //--
  938.     FImage: TPictureCollectionItem;
  939.     FOnMove: TBlitMoveEvent;
  940.     FOnDraw: TNotifyEvent;
  941.     FOnCollision: TNotifyEvent;
  942.     FOnGetImage: TNotifyEvent;
  943.     FEngine: TCustomDXDraw;
  944.     FMovingRepeatly: Boolean;
  945.     FBustrofedon: Boolean;
  946.     FOnRender: TOnRender;
  947.     function GetWorldX: Double;
  948.     function GetWorldY: Double;
  949.     function GetDrawImageIndex: Integer;
  950.     function GetAlpha: Byte;
  951.     function GetAmpLength: Integer;
  952.     function GetAmplitude: Integer;
  953.     function GetAngle: Single;
  954.     function GetAnimCount: Integer;
  955.     function GetAnimLooped: Boolean;
  956.     function GetAnimPos: Double;
  957.     function GetAnimSpeed: Double;
  958.     function GetAnimStart: Integer;
  959.     function GetBlendMode: TRenderType;
  960.     function GetBlurImage: Boolean;
  961.     function GetCenterX: Double;
  962.     function GetCenterY: Double;
  963.     function GetCollisioned: Boolean;
  964.     function GetEnergy: Single;
  965.     function GetFlip: Boolean;
  966.     function GetGravityX: Single;
  967.     function GetGravityY: Single;
  968.     function GetHeight: Integer;
  969.     function GetMirror: Boolean;
  970.     function GetMoved: Boolean;
  971.     function GetPhase: Integer;
  972.     function GetScale: Double;
  973.     function GetSpeedX: Single;
  974.     function GetSpeedY: Single;
  975.     function GetVisible: Boolean;
  976.     function GetWaveType: TWaveType;
  977.     function GetWidth: Integer;
  978.     function GetX: Double;
  979.     function GetY: Double;
  980.     function GetZ: Integer;
  981.     procedure SetAlpha(const Value: Byte);
  982.     procedure SetAmpLength(const Value: Integer);
  983.     procedure SetAmplitude(const Value: Integer);
  984.     procedure SetAngle(const Value: Single);
  985.     procedure SetAnimCount(const Value: Integer);
  986.     procedure SetAnimLooped(const Value: Boolean);
  987.     procedure SetAnimPos(const Value: Double);
  988.     procedure SetAnimSpeed(const Value: Double);
  989.     procedure SetAnimStart(const Value: Integer);
  990.     procedure SetBlendMode(const Value: TRenderType);
  991.     procedure SetBlurImage(const Value: Boolean);
  992.     procedure SetCenterX(const Value: Double);
  993.     procedure SetCenterY(const Value: Double);
  994.     procedure SetCollisioned(const Value: Boolean);
  995.     procedure SetEnergy(const Value: Single);
  996.     procedure SetFlip(const Value: Boolean);
  997.     procedure SetGravityX(const Value: Single);
  998.     procedure SetGravityY(const Value: Single);
  999.     procedure SetHeight(const Value: Integer);
  1000.     procedure SetMirror(const Value: Boolean);
  1001.     procedure SetMoved(const Value: Boolean);
  1002.     procedure SetPhase(const Value: Integer);
  1003.     procedure SetScale(const Value: Double);
  1004.     procedure SetSpeedX(const Value: Single);
  1005.     procedure SetSpeedY(const Value: Single);
  1006.     procedure SetVisible(const Value: Boolean);
  1007.     procedure SetWaveType(const Value: TWaveType);
  1008.     procedure SetWidth(const Value: Integer);
  1009.     procedure SetX(const Value: Double);
  1010.     procedure SetY(const Value: Double);
  1011.     procedure SetZ(const Value: Integer);
  1012.     function StoreAngle: Boolean;
  1013.     function StoreAnimPos: Boolean;
  1014.     function StoreAnimSpeed: Boolean;
  1015.     function StoreCenterX: Boolean;
  1016.     function StoreCenterY: Boolean;
  1017.     function StoreEnergy: Boolean;
  1018.     function StoreGravityX: Boolean;
  1019.     function StoreGravityY: Boolean;
  1020.     function StoreScale: Boolean;
  1021.     function StoreSpeedX: Boolean;
  1022.     function StoreSpeedY: Boolean;
  1023.     function GetBoundsRect: TRect;
  1024.     function GetClientRect: TRect;
  1025.     function GetPath(index: Integer): TPath;
  1026.     procedure SetPath(index: Integer; const Value: TPath);
  1027.     procedure ReadPaths(Stream: TStream);
  1028.     procedure WritePaths(Stream: TStream);
  1029.     function GetMovingRepeatly: Boolean;
  1030.     procedure SetMovingRepeatly(const Value: Boolean);
  1031.     function GetBustrofedon: Boolean;
  1032.     procedure SetBustrofedon(const Value: Boolean);
  1033.     function GetTextureFilter: TD2DTextureFilter;
  1034.     procedure SetTextureFilter(const Value: TD2DTextureFilter);
  1035.   protected
  1036.     procedure DoDraw; virtual;
  1037.     procedure DoMove(LagCount: Integer);
  1038.     function DoCollision: TBlit; virtual;
  1039.     procedure DoGetImage; virtual;
  1040.     procedure DefineProperties(Filer: TFiler); override;
  1041.   public
  1042.     FCurrentPosition, FCurrentTime: Integer;
  1043.     FCurrentDirection: Boolean;
  1044.     constructor Create(AParent: TObject); virtual;
  1045.     destructor Destroy; override;
  1046.     procedure Assign(Source: TPersistent); override;
  1047.     property Engine: TCustomDXDraw read FEngine write FEngine;
  1048.     property Parent: TBlit read FParent;
  1049.     property WorldX: Double read GetWorldX;
  1050.     property WorldY: Double read GetWorldY;
  1051.     procedure ReAnimate(MoveCount: Integer); virtual;
  1052.     property Image: TPictureCollectionItem read FImage write FImage;
  1053.     property BoundsRect: TRect read GetBoundsRect;
  1054.     property ClientRect: TRect read GetClientRect;
  1055.     procedure SetPathLen(Len: Integer);
  1056.     function IsPathEmpty: Boolean;
  1057.     function GetPathCount: Integer;
  1058.     function GetBlitAt(X, Y: Integer): TBlit;
  1059.     property Path[index: Integer]: TPath read GetPath write SetPath; default;
  1060.   published
  1061.     property Active: Boolean read FActive write FActive default False;
  1062.     //--
  1063.     property Collisioned: Boolean read GetCollisioned write SetCollisioned default True;
  1064.     property Moved: Boolean read GetMoved write SetMoved default True;
  1065.     property Visible: Boolean read GetVisible write SetVisible default True;
  1066.     property X: Double read GetX write SetX;
  1067.     property Y: Double read GetY write SetY;
  1068.     property Z: Integer read GetZ write SetZ;
  1069.     property Width: Integer read GetWidth write SetWidth;
  1070.     property Height: Integer read GetHeight write SetHeight;
  1071.     property MovingRepeatly: Boolean read GetMovingRepeatly write SetMovingRepeatly default True;
  1072.     property Bustrofedon: Boolean read GetBustrofedon write SetBustrofedon default False;
  1073.     //--
  1074.     property AnimCount: Integer read GetAnimCount write SetAnimCount default 0;
  1075.     property AnimLooped: Boolean read GetAnimLooped write SetAnimLooped default False;
  1076.     property AnimPos: Double read GetAnimPos write SetAnimPos stored StoreAnimPos;
  1077.     property AnimSpeed: Double read GetAnimSpeed write SetAnimSpeed stored StoreAnimSpeed;
  1078.     property AnimStart: Integer read GetAnimStart write SetAnimStart default 0;
  1079.     property Angle: Single read GetAngle write SetAngle stored StoreAngle;
  1080.     property Alpha: Byte read GetAlpha write SetAlpha default $FF;
  1081.     property CenterX: Double read GetCenterX write SetCenterX stored StoreCenterX;
  1082.     property CenterY: Double read GetCenterY write SetCenterY stored StoreCenterY;
  1083.     property Scale: Double read GetScale write SetScale stored StoreScale;
  1084.     property BlendMode: TRenderType read GetBlendMode write SetBlendMode default rtDraw;
  1085.     property Amplitude: Integer read GetAmplitude write SetAmplitude default 0;
  1086.     property AmpLength: Integer read GetAmpLength write SetAmpLength default 0;
  1087.     property Phase: Integer read GetPhase write SetPhase default 0;
  1088.     property WaveType: TWaveType read GetWaveType write SetWaveType default wtWaveNone;
  1089.     property SpeedX: Single read GetSpeedX write SetSpeedX stored StoreSpeedX;
  1090.     property SpeedY: Single read GetSpeedY write SetSpeedY stored StoreSpeedY;
  1091.     property GravityX: Single read GetGravityX write SetGravityX stored StoreGravityX;
  1092.     property GravityY: Single read GetGravityY write SetGravityY stored StoreGravityY;
  1093.     property Energy: Single read GetEnergy write SetEnergy stored StoreEnergy;
  1094.     property BlurImage: Boolean read GetBlurImage write SetBlurImage default False;
  1095.     property Mirror: Boolean read GetMirror write SetMirror default False;
  1096.     property Flip: Boolean read GetFlip write SetFlip default False;
  1097.     property TextureFilter: TD2DTextureFilter read GetTextureFilter write SetTextureFilter default D2D_POINT;
  1098.  
  1099.     property OnGetImage: TNotifyEvent read FOnGetImage write FOnGetImage;
  1100.     property OnMove: TBlitMoveEvent read FOnMove write FOnMove;
  1101.     property OnDraw: TNotifyEvent read FOnDraw write FOnDraw;
  1102.     property OnCollision: TNotifyEvent read FOnCollision write FOnCollision;
  1103.     property OnRender: TOnRender read FOnRender write FOnRender;
  1104.   end;
  1105.  
  1106.   TTrace = class(THashCollectionItem)
  1107.   private
  1108.     FActualized: Boolean;
  1109.     FTag: Integer;
  1110.     FBlit: TBlit;
  1111.     function GetTraces: TTraces;
  1112.     function GetOnCollision: TNotifyEvent;
  1113.     function GetOnDraw: TNotifyEvent;
  1114.     function GetOnGetImage: TNotifyEvent;
  1115.     function GetOnMove: TBlitMoveEvent;
  1116.     procedure SetOnCollision(const Value: TNotifyEvent);
  1117.     procedure SetOnDraw(const Value: TNotifyEvent);
  1118.     procedure SetOnGetImage(const Value: TNotifyEvent);
  1119.     procedure SetOnMove(const Value: TBlitMoveEvent);
  1120.     function GetActive: Boolean;
  1121.     procedure SetActive(const Value: Boolean);
  1122.     function GetOnRender: TOnRender;
  1123.     procedure SetOnRender(const Value: TOnRender);
  1124.   protected
  1125.     function GetDisplayName: string; override;
  1126.     procedure SetDisplayName(const Value: string); override;
  1127.   public
  1128.     constructor Create(Collection: TCollection); override;
  1129.     destructor Destroy; override;
  1130.     procedure Render(const LagCount: Integer);
  1131.     function IsActualized: Boolean;
  1132.     procedure Assign(Source: TPersistent); override;
  1133.     property Traces: TTraces read GetTraces;
  1134.     function Clone(NewName: string; OffsetX: Integer{$IFDEF VER4UP} = 0{$ENDIF}; OffsetY: Integer{$IFDEF VER4UP} = 0{$ENDIF}; Angle: Single{$IFDEF VER4UP} = 0{$ENDIF}): TTrace;
  1135.   published
  1136.     property Active: Boolean read GetActive write SetActive;
  1137.     property Tag: Integer read FTag write FTag;
  1138.     property Blit: TBlit read FBlit write FBlit;
  1139.     {events}
  1140.     property OnGetImage: TNotifyEvent read GetOnGetImage write SetOnGetImage;
  1141.     property OnMove: TBlitMoveEvent read GetOnMove write SetOnMove;
  1142.     property OnDraw: TNotifyEvent read GetOnDraw write SetOnDraw;
  1143.     property OnCollision: TNotifyEvent read GetOnCollision write SetOnCollision;
  1144.     property OnRender: TOnRender read GetOnRender write SetOnRender;
  1145.   end;
  1146.  
  1147.   TTraces = class(THashCollection)
  1148.   private
  1149.     FOwner: TPersistent;
  1150.     function GetItem(Index: Integer): TTrace;
  1151.     procedure SetItem(Index: Integer; Value: TTrace);
  1152.   protected
  1153.     function GetOwner: TPersistent; override;
  1154.   public
  1155.     constructor Create(AOwner: TComponent);
  1156.     function Add: TTrace;
  1157.     function Find(const Name: string): TTrace;
  1158. {$IFDEF VER4UP}
  1159.     function Insert(Index: Integer): TTrace;
  1160. {$ENDIF}
  1161.     procedure Update(Item: TCollectionItem); override;
  1162.     property Items[Index: Integer]: TTrace read GetItem write SetItem;
  1163.     destructor Destroy; override;
  1164.   end;
  1165.  
  1166. {$IFDEF DX3D_deprecated}
  1167.  
  1168.   {  TCustomDX3D  }
  1169.  
  1170.   TDX3DOption = (toRetainedMode, toSystemMemory, toHardware, toSelectDriver, toZBuffer);
  1171.  
  1172.   TDX3DOptions = set of TDX3DOption;
  1173.  
  1174.   TCustomDX3D = class(TComponent)
  1175.   private
  1176.     FAutoSize: Boolean;
  1177. {$IFDEF D3DRM}FCamera: IDirect3DRMFrame; {$ENDIF}
  1178.     {$IFDEF D3D_deprecated}
  1179.     FD3D: IDirect3D;
  1180.     FD3D2: IDirect3D2;
  1181.     FD3D3: IDirect3D3;
  1182.     {$ENDIF}
  1183.     FD3D7: IDirect3D7;
  1184.     {$IFDEF D3D_deprecated}
  1185.     FD3DDevice: IDirect3DDevice;
  1186.     FD3DDevice2: IDirect3DDevice2;
  1187.     FD3DDevice3: IDirect3DDevice3;
  1188.     {$ENDIF}
  1189.     FD3DDevice7: IDirect3DDevice7;
  1190. {$IFDEF D3DRM}
  1191.     FD3DRM: IDirect3DRM;
  1192.     FD3DRM2: IDirect3DRM2;
  1193.     FD3DRM3: IDirect3DRM3;
  1194.     FD3DRMDevice: IDirect3DRMDevice;
  1195.     FD3DRMDevice2: IDirect3DRMDevice2;
  1196.     FD3DRMDevice3: IDirect3DRMDevice3;
  1197. {$ENDIF}
  1198.     FDXDraw: TCustomDXDraw;
  1199.     FInitFlag: Boolean;
  1200.     FInitialized: Boolean;
  1201.     FNowOptions: TDX3DOptions;
  1202.     FOnFinalize: TNotifyEvent;
  1203.     FOnInitialize: TNotifyEvent;
  1204.     FOptions: TDX3DOptions;
  1205. {$IFDEF D3DRM}FScene: IDirect3DRMFrame; {$ENDIF}
  1206.     FSurface: TDirectDrawSurface;
  1207.     FSurfaceHeight: Integer;
  1208.     FSurfaceWidth: Integer;
  1209. {$IFDEF D3DRM}FViewport: IDirect3DRMViewport; {$ENDIF}
  1210.     FZBuffer: TDirectDrawSurface;
  1211.     procedure Finalize;
  1212.     procedure Initialize;
  1213.     procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
  1214.     function GetCanDraw: Boolean;
  1215.     function GetSurfaceHeight: Integer;
  1216.     function GetSurfaceWidth: Integer;
  1217.     procedure SetAutoSize(Value: Boolean);
  1218.     procedure SetDXDraw(Value: TCustomDXDraw);
  1219.     procedure SetOptions(Value: TDX3DOptions); virtual; {TridenT}
  1220.     procedure SetSurfaceHeight(Value: Integer);
  1221.     procedure SetSurfaceWidth(Value: Integer);
  1222.   protected
  1223.     procedure DoFinalize; virtual;
  1224.     procedure DoInitialize; virtual;
  1225.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1226.   public
  1227.     constructor Create(AOwner: TComponent); override;
  1228.     destructor Destroy; override;
  1229.     procedure Render;
  1230.     procedure SetSize(ASurfaceWidth, ASurfaceHeight: Integer);
  1231.     property AutoSize: Boolean read FAutoSize write SetAutoSize;
  1232. {$IFDEF D3DRM}property Camera: IDirect3DRMFrame read FCamera; {$ENDIF}
  1233.     property CanDraw: Boolean read GetCanDraw;
  1234.     property D3D: IDirect3D read FD3D;
  1235.     property D3D2: IDirect3D2 read FD3D2;
  1236.     property D3D3: IDirect3D3 read FD3D3;
  1237.     property D3D7: IDirect3D7 read FD3D7;
  1238.     {$IFDEF D3D_deprecated}
  1239.     property D3DDevice: IDirect3DDevice read FD3DDevice;
  1240.     property D3DDevice2: IDirect3DDevice2 read FD3DDevice2;
  1241.     property D3DDevice3: IDirect3DDevice3 read FD3DDevice3;
  1242.     {$ENDIF}
  1243.     property D3DDevice7: IDirect3DDevice7 read FD3DDevice7;
  1244. {$IFDEF D3DRM}
  1245.     property D3DRM: IDirect3DRM read FD3DRM;
  1246.     property D3DRM2: IDirect3DRM2 read FD3DRM2;
  1247.     property D3DRM3: IDirect3DRM3 read FD3DRM3;
  1248.     property D3DRMDevice: IDirect3DRMDevice read FD3DRMDevice;
  1249.     property D3DRMDevice2: IDirect3DRMDevice2 read FD3DRMDevice2;
  1250.     property D3DRMDevice3: IDirect3DRMDevice3 read FD3DRMDevice3;
  1251. {$ENDIF}
  1252.     property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
  1253.     property Initialized: Boolean read FInitialized;
  1254.     property NowOptions: TDX3DOptions read FNowOptions;
  1255.     property OnFinalize: TNotifyEvent read FOnFinalize write FOnFinalize;
  1256.     property OnInitialize: TNotifyEvent read FOnInitialize write FOnInitialize;
  1257.     property Options: TDX3DOptions read FOptions write SetOptions;
  1258. {$IFDEF D3DRM}property Scene: IDirect3DRMFrame read FScene; {$ENDIF}
  1259.     property Surface: TDirectDrawSurface read FSurface;
  1260.     property SurfaceHeight: Integer read GetSurfaceHeight write SetSurfaceHeight default 480;
  1261.     property SurfaceWidth: Integer read GetSurfaceWidth write SetSurfaceWidth default 640;
  1262. {$IFDEF D3DRM}property Viewport: IDirect3DRMViewport read FViewport; {$ENDIF}
  1263.     property ZBuffer: TDirectDrawSurface read FZBuffer;
  1264.   end;
  1265.  
  1266.   {  TDX3D  }
  1267.  
  1268.   TDX3D = class(TCustomDX3D)
  1269.   published
  1270.     property AutoSize;
  1271.     property DXDraw;
  1272.     property Options;
  1273.     property SurfaceHeight;
  1274.     property SurfaceWidth;
  1275.     property OnFinalize;
  1276.     property OnInitialize;
  1277.   end;
  1278. {$ENDIF}
  1279.  
  1280.   {  EDirect3DTextureError  }
  1281.  
  1282.   EDirect3DTextureError = class(Exception);
  1283.  
  1284.   {  TDirect3DTexture  }
  1285.  
  1286.   TDirect3DTexture = class
  1287.   private
  1288.     FBitCount: DWORD;
  1289.     FDXDraw: TComponent;
  1290.     FEnumFormatFlag: Boolean;
  1291.     FFormat: TDDSurfaceDesc;
  1292.     FGraphic: TGraphic;
  1293.     FHandle: TD3DTextureHandle;
  1294.     FPaletteEntries: TPaletteEntries;
  1295.     FSurface: TDirectDrawSurface;
  1296.     FTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
  1297.     FTransparentColor: TColor;
  1298.     procedure Clear;
  1299.     procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
  1300.     function GetHandle: TD3DTextureHandle;
  1301.     function GetSurface: TDirectDrawSurface;
  1302.     function GetTexture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF};
  1303.     procedure SetTransparentColor(Value: TColor);
  1304.   public
  1305.     constructor Create(Graphic: TGraphic; DXDraw: TComponent);
  1306.     destructor Destroy; override;
  1307.     procedure Restore;
  1308.     property Handle: TD3DTextureHandle read GetHandle;
  1309.     property Surface: TDirectDrawSurface read GetSurface;
  1310.     property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
  1311.     property Texture: {$IFDEF D3D_deprecated}IDirect3DTexture{$ELSE}IDirect3DTexture2{$ENDIF} read GetTexture;
  1312.   end;
  1313.  
  1314.   { EDXTextureImageError }
  1315.  
  1316.   EDXTextureImageError = class(Exception);
  1317.  
  1318.   { channel structure }
  1319.  
  1320.   TDXTextureImageChannel = record
  1321.     Mask: DWORD;
  1322.     BitCount: Integer;
  1323.  
  1324.     {  Internal use  }
  1325.     _Mask2: DWORD;
  1326.     _rshift: Integer;
  1327.     _lshift: Integer;
  1328.     _BitCount2: Integer;
  1329.   end;
  1330.  
  1331.   TDXTextureImage_PaletteEntries = array[0..255] of TPaletteEntry;
  1332.  
  1333.   TDXTextureImageType = (
  1334.     DXTextureImageType_PaletteIndexedColor,
  1335.     DXTextureImageType_RGBColor
  1336.     );
  1337.  
  1338.   TDXTextureImageFileCompressType = (
  1339.     DXTextureImageFileCompressType_None,
  1340.     DXTextureImageFileCompressType_ZLIB
  1341.     );
  1342.  
  1343.   {forward}
  1344.  
  1345.   TDXTextureImage = class;
  1346.  
  1347.   { TDXTextureImageLoadFunc }
  1348.  
  1349.   TDXTextureImageLoadFunc = procedure(Stream: TStream; Image: TDXTextureImage);
  1350.  
  1351.   { TDXTextureImageProgressEvent }
  1352.  
  1353.   TDXTextureImageProgressEvent = procedure(Sender: TObject; Progress, ProgressCount: Integer) of object;
  1354.  
  1355.   { TDXTextureImage }
  1356.  
  1357.   TDXTextureImage = class
  1358.   private
  1359.     FOwner: TDXTextureImage;
  1360.     FFileCompressType: TDXTextureImageFileCompressType;
  1361.     FOnSaveProgress: TDXTextureImageProgressEvent;
  1362.     FSubImage: TList;
  1363.     FImageType: TDXTextureImageType;
  1364.     FWidth: Integer;
  1365.     FHeight: Integer;
  1366.     FPBits: Pointer;
  1367.     FBitCount: Integer;
  1368.     FPackedPixelOrder: Boolean;
  1369.     FWidthBytes: Integer;
  1370.     FNextLine: Integer;
  1371.     FSize: Integer;
  1372.     FTopPBits: Pointer;
  1373.     FTransparent: Boolean;
  1374.     FTransparentColor: DWORD;
  1375.     FImageGroupType: DWORD;
  1376.     FImageID: DWORD;
  1377.     FImageName: string;
  1378.     FAutoFreeImage: Boolean;
  1379.     procedure ClearImage;
  1380.     function GetPixel(x, y: Integer): DWORD;
  1381.     procedure SetPixel(x, y: Integer; c: DWORD);
  1382.     function GetScanLine(y: Integer): Pointer;
  1383.     function GetSubGroupImageCount(GroupTypeID: DWORD): Integer;
  1384.     function GetSubGroupImage(GroupTypeID: DWORD; Index: Integer): TDXTextureImage;
  1385.     function GetSubImageCount: Integer;
  1386.     function GetSubImage(Index: Integer): TDXTextureImage;
  1387.   protected
  1388.     procedure DoSaveProgress(Progress, ProgressCount: Integer); virtual;
  1389.   public
  1390.     idx_index: TDXTextureImageChannel;
  1391.     idx_alpha: TDXTextureImageChannel;
  1392.     idx_palette: TDXTextureImage_PaletteEntries;
  1393.     rgb_red: TDXTextureImageChannel;
  1394.     rgb_green: TDXTextureImageChannel;
  1395.     rgb_blue: TDXTextureImageChannel;
  1396.     rgb_alpha: TDXTextureImageChannel;
  1397.     constructor Create;
  1398.     constructor CreateSub(AOwner: TDXTextureImage);
  1399.     destructor Destroy; override;
  1400.     procedure Assign(Source: TDXTextureImage);
  1401.     procedure Clear;
  1402.     procedure SetImage(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes, NextLine: Integer;
  1403.       PBits, TopPBits: Pointer; Size: Integer; AutoFree: Boolean);
  1404.     procedure SetSize(ImageType: TDXTextureImageType; Width, Height, BitCount, WidthBytes: Integer);
  1405.     procedure LoadFromFile(const FileName: string);
  1406.     procedure LoadFromStream(Stream: TStream);
  1407.     procedure SaveToFile(const FileName: string);
  1408.     procedure SaveToStream(Stream: TStream);
  1409.     function EncodeColor(R, G, B, A: Byte): DWORD;
  1410.     function PaletteIndex(R, G, B: Byte): DWORD;
  1411.     class procedure RegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
  1412.     class procedure UnRegisterLoadFunc(LoadFunc: TDXTextureImageLoadFunc);
  1413.     property BitCount: Integer read FBitCount;
  1414.     property PackedPixelOrder: Boolean read FPackedPixelOrder write FPackedPixelOrder;
  1415.     property Height: Integer read FHeight;
  1416.     property ImageType: TDXTextureImageType read FImageType;
  1417.     property ImageGroupType: DWORD read FImageGroupType write FImageGroupType;
  1418.     property ImageID: DWORD read FImageID write FImageID;
  1419.     property ImageName: string read FImageName write FImageName;
  1420.     property NextLine: Integer read FNextLine;
  1421.     property PBits: Pointer read FPBits;
  1422.     property Pixels[x, y: Integer]: DWORD read GetPixel write SetPixel;
  1423.     property ScanLine[y: Integer]: Pointer read GetScanLine;
  1424.     property Size: Integer read FSize;
  1425.     property SubGroupImageCount[GroupTypeID: DWORD]: Integer read GetSubGroupImageCount;
  1426.     property SubGroupImages[GroupTypeID: DWORD; Index: Integer]: TDXTextureImage read GetSubGroupImage;
  1427.     property SubImageCount: Integer read GetSubImageCount;
  1428.     property SubImages[Index: Integer]: TDXTextureImage read GetSubImage;
  1429.     property TopPBits: Pointer read FTopPBits;
  1430.     property Transparent: Boolean read FTransparent write FTransparent;
  1431.     property TransparentColor: DWORD read FTransparentColor write FTransparentColor;
  1432.     property Width: Integer read FWidth;
  1433.     property WidthBytes: Integer read FWidthBytes;
  1434.     property FileCompressType: TDXTextureImageFileCompressType read FFileCompressType write FFileCompressType;
  1435.     property OnSaveProgress: TDXTextureImageProgressEvent read FOnSaveProgress write FOnSaveProgress;
  1436.   end;
  1437.  
  1438.   {  TDirect3DTexture2  }
  1439.  
  1440.   TDirect3DTexture2 = class
  1441.   private
  1442.     FDXDraw: TCustomDXDraw;
  1443.     FSrcImage: TObject;
  1444.     FImage: TDXTextureImage;
  1445.     FImage2: TDXTextureImage;
  1446.     FAutoFreeGraphic: Boolean;
  1447.     FSurface: TDirectDrawSurface;
  1448.     FTextureFormat: TDDSurfaceDesc2;
  1449.     FMipmap: Boolean;
  1450.     FTransparent: Boolean;
  1451.     FTransparentColor: TColorRef;
  1452.     FUseMipmap: Boolean;
  1453.     FUseColorKey: Boolean;
  1454.     FOnRestoreSurface: TNotifyEvent;
  1455.     FNeedLoadTexture: Boolean;
  1456.     FEnumTextureFormatFlag: Boolean;
  1457.     FD3DDevDesc: TD3DDeviceDesc;
  1458.     procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
  1459.     procedure SetDXDraw(ADXDraw: TCustomDXDraw);
  1460.     procedure LoadSubTexture(Dest: {$IFDEF D3D_deprecated}IDirectDrawSurface4{$ELSE}IDirectDrawSurface7{$ENDIF}; SrcImage: TDXTextureImage);
  1461.     procedure SetColorKey;
  1462.     procedure SetDIB(DIB: TDIB);
  1463.     function GetIsMipmap: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  1464.     function GetSurface: TDirectDrawSurface; {$IFDEF VER9UP}inline;{$ENDIF}
  1465.     function GetTransparent: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  1466.     procedure SetTransparent(Value: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
  1467.     procedure SetTransparentColor(Value: TColorRef); {$IFDEF VER9UP}inline;{$ENDIF}
  1468.     function GetHeight: Integer;
  1469.     function GetWidth: Integer;
  1470.   protected
  1471.     procedure DoRestoreSurface; virtual;
  1472.   public
  1473.     constructor Create(ADXDraw: TCustomDXDraw; Graphic: TObject; AutoFreeGraphic: Boolean{$IFDEF VER4UP} = False{$ENDIF});
  1474.     constructor CreateFromFile(ADXDraw: TCustomDXDraw; const FileName: string);
  1475.     constructor CreateVideoTexture(ADXDraw: TCustomDXDraw);
  1476.     destructor Destroy; override;
  1477.     procedure Finalize;
  1478.     procedure Load;
  1479.     procedure Initialize;
  1480.     property Height: Integer read GetHeight;
  1481.     property Width: Integer read GetWidth;
  1482.     property IsMipmap: Boolean read GetIsMipmap;
  1483.     property Surface: TDirectDrawSurface read GetSurface;
  1484.     property TextureFormat: TDDSurfaceDesc2 read FTextureFormat write FTextureFormat;
  1485.     property Transparent: Boolean read GetTransparent write SetTransparent;
  1486.     property TransparentColor: TColorRef read FTransparentColor write SetTransparentColor;
  1487.     property OnRestoreSurface: TNotifyEvent read FOnRestoreSurface write FOnRestoreSurface;
  1488.   end;
  1489.  
  1490.   {  EDXTBaseError  }
  1491.  
  1492.   EDXTBaseError = class(Exception);
  1493.  
  1494.   {  parameters for DXT generator  }
  1495.  
  1496.   TDXTImageChannel = (rgbNone, rgbRed, rgbGreen, rgbBlue, rgbAlpha, yuvY);
  1497.   TDXTImageChannels = set of TDXTImageChannel;
  1498.  
  1499.   TDXTImageChannelInfo = packed record
  1500.     Image: TDXTextureImage;
  1501.     BitCount: Integer;
  1502.   end;
  1503.  
  1504.   TDXTImageFormat = packed record
  1505.     ImageType: TDXTextureImageType;
  1506.     Width: Integer;
  1507.     Height: Integer;
  1508.     Bits: Pointer;
  1509.     BitCount: Integer;
  1510.     WidthBytes: Integer;
  1511.     {transparent}
  1512.     Transparent: Boolean;
  1513.     TransparentColor: TColorRef;
  1514.     {texture channels}
  1515.     idx_index: TDXTextureImageChannel;
  1516.     idx_alpha: TDXTextureImageChannel;
  1517.     idx_palette: TDXTextureImage_PaletteEntries;
  1518.     rgb_red: TDXTextureImageChannel;
  1519.     rgb_green: TDXTextureImageChannel;
  1520.     rgb_blue: TDXTextureImageChannel;
  1521.     rgb_alpha: TDXTextureImageChannel;
  1522.     {compress level}
  1523.     Compress: TDXTextureImageFileCompressType;
  1524.     MipmapCount: Integer;
  1525.     Name: string;
  1526.   end;
  1527.  
  1528.   {  TDXTBase  }
  1529.  
  1530.   {Note JB.}
  1531.   {Class for DXT generation files, primary use for load bitmap 32 with alphachannel}
  1532.   {recoded and class created by JB.}
  1533.   TDXTBase = class
  1534.   private
  1535.     FHasChannels: TDXTImageChannels;
  1536.     FHasChannelImages: array[TDXTImageChannel] of TDXTImageChannelInfo;
  1537.     FChannelChangeTable: array[TDXTImageChannel] of TDXTImageChannel;
  1538.     FHasImageList: TList;
  1539.     FParamsFormat: TDXTImageFormat;
  1540.     FStrImageFileName: string;
  1541.     FDIB: TDIB;
  1542.     function GetCompression: TDXTextureImageFileCompressType;
  1543.     function GetHeight: Integer;
  1544.     function GetMipmap: Integer;
  1545.     function GetTransparentColor: TColorRef;
  1546.     function GetWidth: Integer;
  1547.     procedure SetCompression(const Value: TDXTextureImageFileCompressType);
  1548.     procedure SetHeight(const Value: Integer);
  1549.     procedure SetMipmap(const Value: Integer);
  1550.     procedure SetTransparentColor(const Value: TColorRef);
  1551.     procedure SetWidth(const Value: Integer);
  1552.     procedure SetTransparentColorIndexed(const Value: TColorRef);
  1553.     function GetTexture: TDXTextureImage;
  1554.     procedure Resize(Image: TDXTextureImage; NewWidth, NewHeight: Integer;
  1555.       FilterTypeResample: TFilterTypeResample);
  1556.     procedure EvaluateChannels(const CheckChannelUsed: TDXTImageChannels;
  1557.       const CheckChannelChanged, CheckBitCountForChannel: string);
  1558.     function GetPicture: TDXTextureImage;
  1559.   protected
  1560.     procedure CalcOutputBitFormat;
  1561.     procedure BuildImage(Image: TDXTextureImage);
  1562.   public
  1563.     constructor Create;
  1564.     destructor Destroy; override;
  1565.     procedure SetChannelR(T: TDIB);
  1566.     procedure SetChannelG(T: TDIB);
  1567.     procedure SetChannelB(T: TDIB);
  1568.     procedure SetChannelA(T: TDIB);
  1569.     procedure LoadChannelAFromFile(const FileName: string);
  1570.     procedure SetChannelY(T: TDIB);
  1571.     procedure SetChannelRGB(T: TDIB);
  1572.     procedure LoadChannelRGBFromFile(const FileName: string);
  1573.     procedure SetChannelRGBA(T: TDIB);
  1574.     procedure LoadChannelRGBAFromFile(const FileName: string);
  1575.     procedure SaveToFile(iFilename: string {$IFDEF VER4UP} = ''{$ENDIF});
  1576.     function LoadFromFile(iFilename: string): Boolean;
  1577.     property TransparentColor: TColorRef read GetTransparentColor write SetTransparentColor;
  1578.     property TransparentColorIndexed: TColorRef read GetTransparentColor write SetTransparentColorIndexed;
  1579.     property Width: Integer read GetWidth write SetWidth;
  1580.     property Height: Integer read GetHeight write SetHeight;
  1581.     property Compression: TDXTextureImageFileCompressType read GetCompression write SetCompression;
  1582.     property Mipmap: Integer read GetMipmap write SetMipmap;
  1583.     property Texture: TDXTextureImage read GetTexture;
  1584.   end;
  1585.  
  1586. {$IFDEF D3DRM}
  1587.   {  EDirect3DRMUserVisualError  }
  1588.  
  1589.   EDirect3DRMUserVisualError = class(Exception);
  1590.  
  1591.   {  TDirect3DRMUserVisual  }
  1592.  
  1593.   TDirect3DRMUserVisual = class
  1594.   private
  1595.     FUserVisual: IDirect3DRMUserVisual;
  1596.   protected
  1597.     function DoRender(Reason: TD3DRMUserVisualReason;
  1598.       D3DRMDev: IDirect3DRMDevice; D3DRMView: IDirect3DRMViewport): HRESULT; virtual;
  1599.   public
  1600.     constructor Create(D3DRM: IDirect3DRM);
  1601.     destructor Destroy; override;
  1602.     property UserVisual: IDirect3DRMUserVisual read FUserVisual;
  1603.   end;
  1604. {$ENDIF}
  1605.  
  1606.   {  EPictureCollectionError  }
  1607.  
  1608.   EPictureCollectionError = class(Exception);
  1609.  
  1610.   {  TPictureCollectionItem  }
  1611.  
  1612.   TPictureCollection = class;
  1613.  
  1614.   TPictureCollectionItem = class(THashCollectionItem)
  1615.   private
  1616.     FPicture: TPicture;
  1617.     FInitialized: Boolean;
  1618.     FPatternHeight: Integer;
  1619.     FPatternWidth: Integer;
  1620.     FPatterns: TCollection;
  1621.     FSkipHeight: Integer;
  1622.     FSkipWidth: Integer;
  1623.     FSurfaceList: TList;
  1624.     FSystemMemory: Boolean;
  1625.     FTransparent: Boolean;
  1626.     FTransparentColor: TColor;
  1627.     procedure ClearSurface;
  1628.     procedure Finalize;
  1629.     procedure Initialize;
  1630.     function GetHeight: Integer;
  1631.     function GetPictureCollection: TPictureCollection;
  1632.     function GetPatternRect(Index: Integer): TRect;
  1633.     function GetPatternSurface(Index: Integer): TDirectDrawSurface;
  1634.     function GetPatternCount: Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  1635.     function GetWidth: Integer;
  1636.     procedure SetPicture(Value: TPicture);
  1637.     procedure SetTransparentColor(Value: TColor);
  1638.   public
  1639.     constructor Create(Collection: TCollection); override;
  1640.     destructor Destroy; override;
  1641.     procedure UpdateTag;
  1642.     procedure Assign(Source: TPersistent); override;
  1643.     procedure Draw(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1644.     //  Modifier par MKost d'Uk@Team tous droit réservé.
  1645.     //  22:02 04/11/2005
  1646.     //  Ajouté :
  1647.     // Dans TPictureCollectionItem
  1648.     // procedure DrawFlipH(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1649.     //      -Effectue un flip Horizontale de l'image
  1650.     // procedure DrawFlipHV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1651.     //      -Effectue un flip Oblique de l'image
  1652.     // procedure DrawFlipV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1653.     //      -Effectue un flip Verticale de l'image
  1654.     procedure DrawFlipH(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1655.     procedure DrawFlipHV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1656.     procedure DrawFlipV(Dest: TDirectDrawSurface; X, Y: Integer; PatternIndex: Integer);
  1657.     procedure StretchDraw(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer);
  1658.     procedure DrawAdd(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
  1659.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1660.     procedure DrawAddCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
  1661.       Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1662.     procedure DrawAlpha(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
  1663.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1664.     procedure DrawAlphaCol(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
  1665.       Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1666.     procedure DrawSub(Dest: TDirectDrawSurface; const DestRect: TRect; PatternIndex: Integer;
  1667.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1668.     procedure DrawSubCol(Dest: TDirectDrawSurface; const DestRect: TRect;
  1669.       PatternIndex, Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1670.     {Rotate}
  1671.     procedure DrawRotate(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1672.       CenterX, CenterY: Double; Angle: single);
  1673.     procedure DrawRotateAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1674.       CenterX, CenterY: Double; Angle: single;
  1675.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1676.     procedure DrawRotateAddCol(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1677.       CenterX, CenterY: Double; Angle: single;
  1678.       Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1679.     procedure DrawRotateAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1680.       CenterX, CenterY: Double; Angle: single;
  1681.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1682.     procedure DrawRotateAlphaCol(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1683.       CenterX, CenterY: Double; Angle: single;
  1684.       Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1685.     procedure DrawRotateSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1686.       CenterX, CenterY: Double; Angle: single;
  1687.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1688.     procedure DrawRotateSubCol(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1689.       CenterX, CenterY: Double; Angle: single;
  1690.       Color: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1691.     {WaveX}
  1692.     procedure DrawWaveX(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1693.       amp, Len, ph: Integer);
  1694.     procedure DrawWaveXAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1695.       amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1696.     procedure DrawWaveXAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
  1697.       amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1698.     procedure DrawWaveXSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1699.       amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1700.     {WaveY}
  1701.     procedure DrawWaveY(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1702.       amp, Len, ph: Integer);
  1703.     procedure DrawWaveYAdd(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1704.       amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1705.     procedure DrawWaveYAlpha(Dest: TDirectDrawSurface; X, Y, Width, Height, PatternIndex: Integer;
  1706.       amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1707.     procedure DrawWaveYSub(Dest: TDirectDrawSurface; X, Y, Width, Height: Integer; PatternIndex: Integer;
  1708.       amp, Len, ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1709.     {SpecialDraw}
  1710.     procedure DrawCol(Dest: TDirectDrawSurface; const DestRect, SourceRect: TRect;
  1711.       PatternIndex: Integer; Faded: Boolean; RenderType: TRenderType; Color,
  1712.       Specular: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1713.     procedure DrawRect(Dest: TDirectDrawSurface;
  1714.       const DestRect, SourceRect: TRect; PatternIndex: Integer;
  1715.       RenderType: TRenderType; Transparent: Boolean{$IFDEF VER4UP} = True{$ENDIF};
  1716.       Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF});
  1717.     procedure Restore;
  1718.     property Height: Integer read GetHeight;
  1719.     property Initialized: Boolean read FInitialized;
  1720.     property PictureCollection: TPictureCollection read GetPictureCollection;
  1721.     property PatternCount: Integer read GetPatternCount;
  1722.     property PatternRects[Index: Integer]: TRect read GetPatternRect;
  1723.     property PatternSurfaces[Index: Integer]: TDirectDrawSurface read GetPatternSurface;
  1724.     property Width: Integer read GetWidth;
  1725.   published
  1726.     property PatternHeight: Integer read FPatternHeight write FPatternHeight;
  1727.     property PatternWidth: Integer read FPatternWidth write FPatternWidth;
  1728.     property Picture: TPicture read FPicture write SetPicture;
  1729.     property SkipHeight: Integer read FSkipHeight write FSkipHeight default 0;
  1730.     property SkipWidth: Integer read FSkipWidth write FSkipWidth default 0;
  1731.     property SystemMemory: Boolean read FSystemMemory write FSystemMemory;
  1732.     property Transparent: Boolean read FTransparent write FTransparent;
  1733.     property TransparentColor: TColor read FTransparentColor write SetTransparentColor;
  1734.   end;
  1735.  
  1736.   {  TPictureCollection  }
  1737.  
  1738.   TPictureCollection = class(THashCollection)
  1739.   private
  1740.     FDXDraw: TCustomDXDraw;
  1741.     FOwner: TPersistent;
  1742.     function GetItem(Index: Integer): TPictureCollectionItem;
  1743.     procedure ReadColorTable(Stream: TStream);
  1744.     procedure WriteColorTable(Stream: TStream);
  1745.     function Initialized: Boolean;
  1746.   protected
  1747.     procedure DefineProperties(Filer: TFiler); override;
  1748.     function GetOwner: TPersistent; override;
  1749.   public
  1750.     ColorTable: TRGBQuads;
  1751.     constructor Create(AOwner: TPersistent);
  1752.     destructor Destroy; override;
  1753.     function Find(const Name: string): TPictureCollectionItem;
  1754.     procedure Finalize;
  1755.     procedure Initialize(DXDraw: TCustomDXDraw);
  1756.     procedure InitializeImages(DXDraw: TCustomDXDraw; Id : Integer);
  1757.     procedure LoadFromFile(const FileName: string);
  1758.     procedure LoadFromStream(Stream: TStream);
  1759.     procedure MakeColorTable;
  1760.     procedure Restore;
  1761.     procedure SaveToFile(const FileName: string);
  1762.     procedure SaveToStream(Stream: TStream);
  1763.     property DXDraw: TCustomDXDraw read FDXDraw;
  1764.     property Items[Index: Integer]: TPictureCollectionItem read GetItem; default;
  1765.   end;
  1766.  
  1767.   {  TCustomDXImageList  }
  1768.  
  1769.   TCustomDXImageList = class(TComponent)
  1770.   private
  1771.     FDXDraw: TCustomDXDraw;
  1772.     FItems: TPictureCollection;
  1773.     procedure DXDrawNotifyEvent(Sender: TCustomDXDraw; NotifyType: TDXDrawNotifyType);
  1774.     procedure SetDXDraw(Value: TCustomDXDraw);
  1775.     procedure SetItems(Value: TPictureCollection);
  1776.   protected
  1777.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1778.   public
  1779.     constructor Create(AOnwer: TComponent); override;
  1780.     destructor Destroy; override;
  1781.     property DXDraw: TCustomDXDraw read FDXDraw write SetDXDraw;
  1782.     property Items: TPictureCollection read FItems write SetItems;
  1783.   end;
  1784.  
  1785.   {  TDXImageList  }
  1786.  
  1787.   TDXImageList = class(TCustomDXImageList)
  1788.   published
  1789.     property DXDraw;
  1790.     property Items;
  1791.   end;
  1792.  
  1793.   {  EDirectDrawOverlayError  }
  1794.  
  1795.   EDirectDrawOverlayError = class(Exception);
  1796.  
  1797.   {  TDirectDrawOverlay  }
  1798.  
  1799.   TDirectDrawOverlay = class
  1800.   private
  1801.     FDDraw: TDirectDraw;
  1802.     FTargetSurface: TDirectDrawSurface;
  1803.     FDDraw2: TDirectDraw;
  1804.     FTargetSurface2: TDirectDrawSurface;
  1805.     FSurface: TDirectDrawSurface;
  1806.     FBackSurface: TDirectDrawSurface;
  1807.     FOverlayColorKey: TColor;
  1808.     FOverlayRect: TRect;
  1809.     FVisible: Boolean;
  1810.     procedure SetOverlayColorKey(Value: TColor);
  1811.     procedure SetOverlayRect(const Value: TRect);
  1812.     procedure SetVisible(Value: Boolean);
  1813.   public
  1814.     constructor Create(DDraw: TDirectDraw; TargetSurface: TDirectDrawSurface);
  1815.     constructor CreateWindowed(WindowHandle: HWND);
  1816.     destructor Destroy; override;
  1817.     procedure Finalize;
  1818.     procedure Initialize(const SurfaceDesc: {$IFDEF D3D_deprecated}TDDSurfaceDesc{$ELSE}TDDSurfaceDesc2{$ENDIF});
  1819.     procedure Flip;
  1820.     property OverlayColorKey: TColor read FOverlayColorKey write SetOverlayColorKey;
  1821.     property OverlayRect: TRect read FOverlayRect write SetOverlayRect;
  1822.     property Surface: TDirectDrawSurface read FSurface;
  1823.     property BackSurface: TDirectDrawSurface read FBackSurface;
  1824.     property Visible: Boolean read FVisible write SetVisible;
  1825.   end;
  1826.  
  1827. {
  1828.  Modified by Michael Wilson 2/05/2001
  1829.  - re-added redundant assignment to Offset
  1830.  Modified by Marcus Knight 19/12/2000
  1831.  - replaces all referaces to 'pos' with 'AnsiPos' <- faster
  1832.  - replaces all referaces to 'uppercase' with 'Ansiuppercase' <- faster
  1833.  - Now only uppercases outside the loop
  1834.  - Fixed the non-virtual contructor
  1835.  - renamed & moved Offset to private(fOffSet), and added the property OffSet
  1836.  - Commented out the redundant assignment to Offset<- not needed, as Offset is now a readonly property
  1837.  - Added the Notification method to catch when the image list is destroyed
  1838.  - removed DXclasses from used list
  1839. }
  1840.  
  1841.   TDXFont = class(TComponent)
  1842.   private
  1843.     FDXImageList: TDXImageList;
  1844.     FFont: string;
  1845.     FFontIndex: Integer;
  1846.     FOffset: Integer; // renamed from Offset -> fOffset
  1847.     procedure SetFont(const Value: string);
  1848.     procedure SetFontIndex(const Value: Integer);
  1849.   protected
  1850.     procedure Notification(AComponent: TComponent; Operation: TOperation); override; // added
  1851.   public
  1852.     constructor Create(AOwner: TComponent); override; // Modified
  1853.     destructor Destroy; override;
  1854.     procedure TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string);
  1855.     property Offset: Integer read FOffset write FOffset; // added
  1856.   published
  1857.     property Font: string read FFont write SetFont;
  1858.     property FontIndex: Integer read FFontIndex write SetFontIndex;
  1859.     property DXImageList: TDXImageList read FDXImageList write FDXImageList;
  1860.   end;
  1861.  
  1862. (*******************************************************************************
  1863.  * Unit Name: DXPowerFont.pas
  1864.  * Information: Writed By Ramin.S.Zaghi (Based On Wilson's DXFont Unit)
  1865.  * Last Changes: Dec 25 2000;
  1866.  * Unit Information:
  1867.  *     This unit includes a VCL-Component for DelphiX. This component draws the
  1868.  *     Character-Strings on a TDirectDrawSurface. This component helps the
  1869.  *     progarmmers to using custom fonts and printing texts easily such as
  1870.  *     TCanvas.TextOut function...
  1871.  * Includes:
  1872.  * 1. TDXPowerFontTextOutEffect ==> The kinds of drawing effects.
  1873.  *    - teNormal: Uses the Draw function. (Normal output)
  1874.  *    - teRotat: Uses the DrawRotate function. (Rotates each character)
  1875.  *    - teAlphaBlend: Uses DrawAlpha function. (Blends each character)
  1876.  *    - teWaveX: Uses DrawWaveX function. (Adds a Wave effect to the each character)
  1877.  *
  1878.  * 2. TDXPowerFontTextOutType ==> The kinds of each caracter.
  1879.  *    - ttUpperCase: Uppers all characters automaticaly.
  1880.  *    - ttLowerCase: Lowers all characters automaticaly.
  1881.  *    - ttNormal: Uses all characters with out any converting.
  1882.  *
  1883.  * 3. TDXPowerFontEffectsParameters ==> Includes the parameters for adding effects to the characters.
  1884.  *    - (CenterX, CenterY): The rotating center point.
  1885.  *    - (Width, Height): The new size of each character.
  1886.  *    - Angle: The angle of rotate.
  1887.  *    - AlphaValue: The value of Alpha-Chanel.
  1888.  *    - WAmplitude: The Amplitude of Wave function. (See The Help Of DelphiX)
  1889.  *    - WLenght: The Lenght Of Wave function. (See The Help Of DelphiX)
  1890.  *    - WPhase: The Phase Of Wave function. (See The Help Of DelphiX)
  1891.  *
  1892.  * 4. TDXPowerFontBeforeTextOutEvent ==> This is an event that occures before
  1893.  *    drawing texts on to TDirectDrawSurface object.
  1894.  *    - Sender: Retrieves the event caller object.
  1895.  *    - Text: Retrieves the text sended text for drawing.
  1896.  *      (NOTE: The changes will have effect)
  1897.  *    - DoTextOut: The False value means that the TextOut function must be stopped.
  1898.  *      (NOTE: The changes will have effect)
  1899.  *
  1900.  * 5. TDXPowerFontAfterTextOutEvent ==> This is an event that occures after
  1901.  *    drawing texts on to TDirectDrawSurface object.
  1902.  *    - Sender: Retrieves the event caller object.
  1903.  *    - Text: Retrieves the text sended text for drawing.
  1904.  *      (NOTE: The changes will not have any effects)
  1905.  *
  1906.  * 6. TDXPowerFont ==> I sthe main class of PowerFont VCL-Component.
  1907.  *    - property Font: string; The name of custom-font's image in the TDXImageList items.
  1908.  *    - property FontIndex: Integer; The index of custom-font's image in the TDXImageList items.
  1909.  *    - property DXImageList: TDXImageList; The TDXImageList that includes the image of custom-fonts.
  1910.  *    - property UseEnterChar: Boolean; When the value of this property is True, The component caculates Enter character.
  1911.  *    - property EnterCharacter: String;
  1912.  *==>   Note that TDXPowerFont calculates tow kinds of enter character:
  1913.  *==>   E1. The Enter character that draws the characters after it self in a new line and after last drawed character, ONLY.
  1914.  *==>   E2. The Enter character that draws the characters after it self in a new line such as #13#10 enter code in delphi.
  1915.  *==>   Imporatant::
  1916.  *==>       (E1) TDXPowerFont uses the first caracter of EnterCharacter string as the first enter caracter (Default value is '|').
  1917.  *==>       (E2) and uses the second character as the scond enter caracter (Default value is '<')
  1918.  *    - property BeforeTextOut: TDXPowerFontBeforeTextOutEvent; See TDXPowerFontBeforeTextOutEvent.
  1919.  *    - property AfterTextOut: TDXPowerFontAfterTextOutEvent; See TDXPowerFontAfterTextOutEvent.
  1920.  *    - property Alphabets: string; TDXPowerFont uses this character-string for retrieving the pattern number of each character.
  1921.  *    - property TextOutType: TDXPowerFontTextOutType; See TDXPowerFontTextOutType.
  1922.  *    - property TextOutEffect: TDXPowerFontTextOutEffect; See TDXPowerFontTextOutEffect.
  1923.  *    - property EffectsParameters: TDXPowerFontEffectsParameters; See TDXPowerFontEffectsParameters.
  1924.  *
  1925.  *    - function TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
  1926.  *      This function draws/prints the given text on the given TDirectDrawSurface.
  1927.  *      - DirectDrawSurface: The surface for drawing text (character-string).
  1928.  *      - (X , Y): The first point of outputed text. (Such as X,Y parameters in TCanvas.TextOut function)
  1929.  *      - Text: The text for printing.
  1930.  *      Return values: This function returns False when an error occured or...
  1931.  *    - function TextOutFast(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
  1932.  *      This function works such as TextOut function but,
  1933.  *      with out calculating any Parameters/Effects/Enter-Characters/etc...
  1934.  *      This function calculates the TextOutType, ONLY.
  1935.  *
  1936.  * Ramin.S.Zaghi (ramin_zaghi@yahoo.com)
  1937.  * (Based on wilson's code for TDXFont VCL-Component/Add-On)
  1938.  * (wilson@no2games.com)
  1939.  *
  1940.  * For more information visit:
  1941.  *  www.no2games.com
  1942.  *  turbo.gamedev.net
  1943.  ******************************************************************************)
  1944.  
  1945.  { DXPowerFont types }
  1946.  
  1947.   TDXPowerFontTextOutEffect = (teNormal, teRotat, teAlphaBlend, teWaveX);
  1948.   TDXPowerFontTextOutType = (ttUpperCase, ttLowerCase, ttNormal);
  1949.   TDXPowerFontBeforeTextOutEvent = procedure(Sender: TObject; var Text: string; var DoTextOut: Boolean) of object;
  1950.   TDXPowerFontAfterTextOutEvent = procedure(Sender: TObject; Text: string) of object;
  1951.  
  1952.  { TDXPowerFontEffectsParameters }
  1953.  
  1954.   TDXPowerFontEffectsParameters = class(TPersistent)
  1955.   private
  1956.     FCenterX: Integer;
  1957.     FCenterY: Integer;
  1958.     FHeight: Integer;
  1959.     FWidth: Integer;
  1960.     FAngle: Integer;
  1961.     FAlphaValue: Integer;
  1962.     FWPhase: Integer;
  1963.     FWAmplitude: Integer;
  1964.     FWLenght: Integer;
  1965.     procedure SetAngle(const Value: Integer);
  1966.     procedure SetCenterX(const Value: Integer);
  1967.     procedure SetCenterY(const Value: Integer);
  1968.     procedure SetHeight(const Value: Integer);
  1969.     procedure SetWidth(const Value: Integer);
  1970.     procedure SetAlphaValue(const Value: Integer);
  1971.     procedure SetWAmplitude(const Value: Integer);
  1972.     procedure SetWLenght(const Value: Integer);
  1973.     procedure SetWPhase(const Value: Integer);
  1974.   published
  1975.     property CenterX: Integer read FCenterX write SetCenterX;
  1976.     property CenterY: Integer read FCenterY write SetCenterY;
  1977.     property Width: Integer read FWidth write SetWidth;
  1978.     property Height: Integer read FHeight write SetHeight;
  1979.     property Angle: Integer read FAngle write SetAngle;
  1980.     property AlphaValue: Integer read FAlphaValue write SetAlphaValue;
  1981.     property WAmplitude: Integer read FWAmplitude write SetWAmplitude;
  1982.     property WLenght: Integer read FWLenght write SetWLenght;
  1983.     property WPhase: Integer read FWPhase write SetWPhase;
  1984.   end;
  1985.  
  1986.  { TDXPowerFont }
  1987.  
  1988.   TDXPowerFont = class(TComponent)
  1989.   private
  1990.     FDXImageList: TDXImageList;
  1991.     FFont: string;
  1992.     FFontIndex: Integer;
  1993.     FUseEnterChar: Boolean;
  1994.     FEnterCharacter: string;
  1995.     FAfterTextOut: TDXPowerFontAfterTextOutEvent;
  1996.     FBeforeTextOut: TDXPowerFontBeforeTextOutEvent;
  1997.     FAlphabets: string;
  1998.     FTextOutType: TDXPowerFontTextOutType;
  1999.     FTextOutEffect: TDXPowerFontTextOutEffect;
  2000.     FEffectsParameters: TDXPowerFontEffectsParameters;
  2001.     procedure SetFont(const Value: string);
  2002.     procedure SetFontIndex(const Value: Integer);
  2003.     procedure SetUseEnterChar(const Value: Boolean);
  2004.     procedure SetEnterCharacter(const Value: string);
  2005.     procedure SetAlphabets(const Value: string);
  2006.     procedure SetTextOutType(const Value: TDXPowerFontTextOutType);
  2007.     procedure SetTextOutEffect(const Value: TDXPowerFontTextOutEffect);
  2008.     procedure SetEffectsParameters(const Value: TDXPowerFontEffectsParameters);
  2009.   published
  2010.     property Font: string read FFont write SetFont;
  2011.     property FontIndex: Integer read FFontIndex write SetFontIndex;
  2012.     property DXImageList: TDXImageList read FDXImageList write FDXImageList;
  2013.     property UseEnterChar: Boolean read FUseEnterChar write SetUseEnterChar;
  2014.     property EnterCharacter: string read FEnterCharacter write SetEnterCharacter;
  2015.     property BeforeTextOut: TDXPowerFontBeforeTextOutEvent read FBeforeTextOut write FBeforeTextOut;
  2016.     property AfterTextOut: TDXPowerFontAfterTextOutEvent read FAfterTextOut write FAfterTextOut;
  2017.     property Alphabets: string read FAlphabets write SetAlphabets;
  2018.     property TextOutType: TDXPowerFontTextOutType read FTextOutType write SetTextOutType;
  2019.     property TextOutEffect: TDXPowerFontTextOutEffect read FTextOutEffect write SetTextOutEffect;
  2020.     property EffectsParameters: TDXPowerFontEffectsParameters read FEffectsParameters write SetEffectsParameters;
  2021.   public
  2022.     Offset: Integer;
  2023.     constructor Create(AOwner: TComponent); override;
  2024.     destructor Destroy; override;
  2025.     function TextOut(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
  2026.     function TextOutFast(DirectDrawSurface: TDirectDrawSurface; X, Y: Integer; const Text: string): Boolean;
  2027.   end;
  2028.  
  2029.  {D2D unit for pure HW support
  2030.  *  Copyright (c) 2004-2010 Jaro Benes
  2031.  *  All Rights Reserved
  2032.  *  Version 1.09
  2033.  *  D2D Hardware module - interface part
  2034.  *  web site: www.micrel.cz/Dx
  2035.  *  e-mail: delphix_d2d@micrel.cz
  2036.  }
  2037.  
  2038.   {supported texture vertex as substitute type from DirectX}
  2039.  
  2040.   {TD2D4Vertex - used with D2DTexturedOn}
  2041.  
  2042.   TD2D4Vertex = array[0..3] of TD3DTLVERTEX;
  2043.  
  2044.   {TD2DTextures - texture storage used with Direct3D}
  2045.   TTextureRec = packed record
  2046.     {$IFDEF VIDEOTEX}
  2047.     VDIB: TDIB;
  2048.     {$ENDIF}
  2049.     D2DTexture: TDirect3DTexture2;
  2050.     FloatX1, FloatY1, FloatX2, FloatY2: Double; //uschov vyrez
  2051.     Name: string{$IFNDEF VER4UP} [255]{$ENDIF}; //jmeno obrazku pro snadne dohledani
  2052.     Width, Height: Integer;
  2053.     AlphaChannel: Boolean; //.06c
  2054.   end;
  2055.   PTextureRec = ^TTextureRec;
  2056.   TTextureArr = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TTextureRec;
  2057. {$IFNDEF VER4UP}
  2058.   PTextureArr = ^TTextureArr;
  2059.   EMaxTexturesError = class(Exception);
  2060. {$ENDIF}
  2061.   TD2DTextures = class
  2062.   private
  2063.     FDDraw: TCustomDXDraw;
  2064. {$IFNDEF VER4UP}
  2065.     TexLen: Integer;
  2066.     Texture: PTextureArr;
  2067. {$ELSE}
  2068.     Texture: TTextureArr;
  2069. {$ENDIF}
  2070.     function GetD2DMaxTextures: Integer;
  2071.     procedure SetD2DMaxTextures(const Value: Integer);
  2072.     procedure D2DPruneTextures;
  2073.     procedure D2DPruneAllTextures;
  2074.     procedure SizeAdjust(var DIB: TDIB; var FloatX1, FloatY1, FloatX2,
  2075.       FloatY2: Double);
  2076.     function SetTransparentColor(dds: TDirectDrawSurface; PixelColor: Integer;
  2077.       Transparent: Boolean): Integer;
  2078.     {$IFDEF VIDEOTEX}
  2079.     function GetTexLayoutByName(name: string): TDIB;
  2080.     {$ENDIF}
  2081.     procedure SaveTextures(path: string);
  2082.   public
  2083.     constructor Create(DDraw: TCustomDXDraw);
  2084.     destructor Destroy; override;
  2085.     procedure D2DFreeTextures;
  2086.     function Find(byName: string): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  2087.     function GetTextureByName(const byName: string): TDirect3DTexture2;
  2088.     function GetTextureByIndex(const byIndex: Integer): TDirect3DTexture2;
  2089.     function GetTextureNameByIndex(const byIndex: Integer): string;
  2090.     function Count: Integer;
  2091.     {functions support loading image or DDS}
  2092. {$IFDEF VER4UP}
  2093.     function CanFindTexture(aImage: TPictureCollectionItem): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
  2094.     function CanFindTexture(const TexName: string): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
  2095.     function CanFindTexture(const Color: LongInt): Boolean; overload;{$IFDEF VER9UP}inline;{$ENDIF}
  2096.     function LoadTextures(aImage: TPictureCollectionItem): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
  2097.     function LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean; overload;
  2098.     function LoadTextures(dds: TDirectDrawSurface; Transparent: Boolean; TransparentColor: Integer; asTexName: string): Boolean; overload;
  2099.     function LoadTextures(Color: Integer): Boolean; overload;
  2100. {$ELSE}
  2101.     function CanFindTexture(aImage: TPictureCollectionItem): Boolean;
  2102.     function CanFindTexture2(const TexName: string): Boolean;
  2103.     function CanFindTexture3(const Color: LongInt): Boolean;
  2104.     function LoadTextures(aImage: TPictureCollectionItem): Boolean;
  2105.     function LoadTextures2(dds: TDirectDrawSurface; Transparent: Boolean; asTexName: string): Boolean;
  2106.     function LoadTextures3(dds: TDirectDrawSurface; Transparent: Boolean; TransparentColor: Integer; asTexName: string): Boolean;
  2107.     function LoadTextures4(Color: Integer): Boolean;
  2108. {$ENDIF}
  2109.     {$IFDEF VIDEOTEX}
  2110.     property TexLayoutByName[name: string]: TDIB read GetTexLayoutByName;
  2111.     {$ENDIF}
  2112.   //published
  2113.     property D2DMaxTextures: Integer read GetD2DMaxTextures write SetD2DMaxTextures;
  2114.   end;
  2115.  
  2116.   {Main component for HW support}
  2117.  
  2118.   TD2D = class
  2119.   private
  2120.     FDDraw: TCustomDXDraw;
  2121.     FCanUseD2D: Boolean;
  2122.     FBitCount: Integer;
  2123.     FMirrorFlipSet: TRenderMirrorFlipSet;
  2124.     FD2DTextureFilter: TD2DTextureFilter;
  2125.     FD2DAntialiasFilter: TD3DAntialiasMode;
  2126.     FVertex: TD2D4Vertex;
  2127.     FD2DTexture: TD2DTextures;
  2128.     FDIB: TDIB;
  2129.     FD3DDevDesc7: TD3DDeviceDesc7;
  2130.     FInitialized: Boolean;
  2131.     {ukazuje pocet textur}
  2132.     procedure D2DUpdateTextures; {$IFDEF VER9UP}inline;{$ENDIF}
  2133.  
  2134.     procedure SetCanUseD2D(const Value: Boolean);
  2135.     function GetCanUseD2D: Boolean;
  2136.     {create the component}
  2137.     constructor Create(DDraw: TCustomDXDraw);
  2138.     procedure SetD2DTextureFilter(const Value: TD2DTextureFilter);
  2139.     procedure SetD2DAntialiasFilter(const Value: TD3DAntialiasMode);
  2140.     procedure D2DEffectSolid; {$IFDEF VER9UP}inline;{$ENDIF}
  2141.     procedure D2DEffectAdd; {$IFDEF VER9UP}inline;{$ENDIF}
  2142.     procedure D2DEffectSub; {$IFDEF VER9UP}inline;{$ENDIF}
  2143.     procedure D2DEffectBlend; {$IFDEF VER9UP}inline;{$ENDIF}// used with alpha
  2144.  
  2145.     {verticies}
  2146.     procedure InitVertex; {$IFDEF VER9UP}inline;{$ENDIF}
  2147.     function D2DWhite: Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  2148.     function D2DVertColor(RenderType: TRenderType; Alpha: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF}
  2149.     procedure D2DColoredVertex(C: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
  2150.     function D2DAlphaVertex(Alpha: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  2151.     procedure D2DSpecularVertex(C: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
  2152.     {Fade used with Add and Sub}
  2153.     function D2DFade(Alpha: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  2154.     procedure D2DFadeColored(C, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
  2155.  
  2156.     function RenderQuad: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2157.  
  2158.     procedure D2DRect(R: TRect); {$IFDEF VER9UP}inline;{$ENDIF}
  2159.     procedure D2DTU(T: TTextureRec); {$IFDEF VER9UP}inline;{$ENDIF}
  2160.     {low lever version texturing for DDS}
  2161.     function D2DTexturedOnDDSTex(dds: TDirectDrawSurface; SubPatternRect: TRect;
  2162.       Transparent: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
  2163.     {texturing}
  2164.     function D2DTexturedOn(Image: TPictureCollectionItem; Pattern: Integer; SubPatternRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
  2165.     function D2DTexturedOnDDS(dds: TDirectDrawSurface; SubPatternRect: TRect; Transparent: Boolean; RenderType: TRenderType; Alpha: Byte): Boolean;
  2166.     function D2DTexturedOnRect(Rect: TRect; Color: Integer): Boolean;
  2167.     function D2DTexturedOnSubRect(Image: TPictureCollectionItem; Pattern: Integer; SubPatternRect, SubRect: TRect; RenderType: TRenderType; Alpha: Byte): Boolean;
  2168.  
  2169.     {low level for rotate mesh}
  2170.     procedure D2DRotate(X, Y, W, H: Integer; Px, Py: Double; Angle: single);
  2171.     {low lever routine for mesh mapping}
  2172.     function D2DMeshMapToWave(dds: TDirectDrawSurface; Transparent: Boolean;
  2173.       TransparentColor: Integer; X, Y, iWidth, iHeight, PatternIndex: Integer;
  2174.       PatternRect: TRect;
  2175.       Amp, Len, Ph, Alpha: Integer;
  2176.       Effect: TRenderType; DoY: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
  2177.     property D2DTextures: TD2DTextures read FD2DTexture;
  2178.   public
  2179.     //added to public
  2180.     procedure D2DColAlpha(C, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
  2181.     procedure D2DCol4Alpha(C1, C2, C3, C4, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
  2182.     procedure D2DFade4Colored(C1, C2, C3, C4, Alpha: Integer); {$IFDEF VER9UP}inline;{$ENDIF}
  2183.     function RenderTri: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2184.     procedure D2DMeshMapToRect(R: TRect);
  2185.     //
  2186.     {destruction textures and supported objects here}
  2187.     destructor Destroy; override;
  2188.     {use before starting rendering}
  2189.     procedure BeginScene;
  2190.     {use after all images have been rendered}
  2191.     procedure EndScene;
  2192.     {set directly of texture filter}
  2193.     property TextureFilter: TD2DTextureFilter write SetD2DTextureFilter;
  2194.     property AntialiasFilter: TD3DAntialiasMode write SetD2DAntialiasFilter;
  2195.     {indicate using of this object}
  2196.     property CanUseD2D: Boolean read GetCanUseD2D write SetCanUseD2D;
  2197.  
  2198.     {set property mirror-flip}
  2199.     property MirrorFlip: TRenderMirrorFlipSet read FMirrorFlipSet write FMirrorFlipSet;
  2200.  
  2201.     {initialize surface}
  2202.     function D2DInitializeSurface: Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2203.  
  2204.     {Render routines}
  2205.     function D2DRender(Image: TPictureCollectionItem; DestRect: TRect;
  2206.       Pattern: Integer; SourceRect: TRect; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean;{$IFDEF VER4UP} overload; {$ENDIF}{$IFDEF VER9UP}inline;{$ENDIF}
  2207.  
  2208.     function {$IFDEF VER4UP}D2DRender{$ELSE}D2DRender2{$ENDIF}(Image: TPictureCollectionItem; R: TRect;
  2209.       Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER4UP} overload; {$ENDIF}{$IFDEF VER9UP}inline;{$ENDIF}
  2210.  
  2211.     function D2DRenderDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect; Transparent: Boolean;
  2212.       Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2213.  
  2214.     function D2DRenderCol(Image: TPictureCollectionItem; R: TRect;
  2215.       Pattern, Color: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2216.     function D2DRenderColDDS(Source: TDirectDrawSurface; SourceRect, DestRect: TRect;
  2217.       Transparent: Boolean; Pattern, Color: Integer; RenderType:
  2218.       TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2219.  
  2220.     function D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
  2221.       Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean;
  2222. {$IFDEF VER4UP} overload; {$IFDEF VER9UP}inline;{$ENDIF}
  2223.     function D2DRenderDrawDDSXY(Source: TDirectDrawSurface; X, Y: Integer;
  2224.       SrcRect: TRect; Transparent: Boolean; Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF Ver4UP} = 255{$ENDIF}): Boolean; overload; {$IFDEF VER9UP}inline;{$ENDIF}
  2225. {$ENDIF}
  2226.     function D2DRenderDrawXY(Image: TPictureCollectionItem; X, Y: Integer;
  2227.       Pattern: Integer; RenderType: TRenderType; Alpha: Byte{$IFDEF VEr4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2228.  
  2229.     {Rotate}
  2230.     function D2DRenderRotate(Image: TPictureCollectionItem; RotX, RotY,
  2231.       PictWidth, PictHeight, PatternIndex: Integer; RenderType: TRenderType;
  2232.       CenterX, CenterY: Double; Angle: single; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2233.     function D2DRenderRotateDDS(Image: TDirectDrawSurface; SourceRect: TRect; RotX, RotY,
  2234.       PictWidth, PictHeight: Integer; RenderType: TRenderType;
  2235.       CenterX, CenterY: Double; Angle: single; Alpha: Byte;
  2236.       Transparent: Boolean): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2237.  
  2238.     function D2DRenderRotateModeCol(Image: TPictureCollectionItem; RenderType: TRenderType; RotX, RotY,
  2239.       PictWidth, PictHeight, PatternIndex: Integer; CenterX, CenterY: Double;
  2240.       Angle: single; Color: Integer; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2241.     function D2DRenderRotateModeColDDS(Image: TDirectDrawSurface;
  2242.       RotX, RotY, PictWidth, PictHeight: Integer; RenderType: TRenderType;
  2243.       CenterX, CenterY: Double; Angle: Single; Color: Integer; Alpha: Byte;
  2244.       Transparent: Boolean): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2245.  
  2246.     {WaveX}
  2247.     function D2DRenderWaveX(Image: TPictureCollectionItem; X, Y, Width, Height,
  2248.       PatternIndex: Integer; RenderType: TRenderType; Transparent: Boolean;
  2249.       Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2250.     function D2DRenderWaveXDDS(Source: TDirectDrawSurface; X, Y, Width,
  2251.       Height: Integer; RenderType: TRenderType; Transparent: Boolean;
  2252.       Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2253.  
  2254.     {WaveY}
  2255.     function D2DRenderWaveY(Image: TPictureCollectionItem; X, Y, Width, Height,
  2256.       PatternIndex: Integer; RenderType: TRenderType; Transparent: Boolean;
  2257.       Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2258.     function D2DRenderWaveYDDS(Source: TDirectDrawSurface; X, Y, Width,
  2259.       Height: Integer; RenderType: TRenderType; Transparent: Boolean;
  2260.       Amp, Len, Ph: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2261.  
  2262.     {Rect}
  2263.     function D2DRenderFillRect(Rect: TRect; RGBColor: LongInt;
  2264.       RenderType: TRenderType; Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2265.  
  2266.     {addmod}
  2267.     function D2DRenderColoredPartition(Image: TPictureCollectionItem; DestRect: TRect; PatternIndex,
  2268.       Color, Specular: Integer; Faded: Boolean;
  2269.       SourceRect: TRect;
  2270.       RenderType: TRenderType;
  2271.       Alpha: Byte{$IFDEF VER4UP} = 255{$ENDIF}): Boolean; {$IFDEF VER9UP}inline;{$ENDIF}
  2272.  
  2273.     procedure SaveTextures(path: string);
  2274.   end;
  2275.  
  2276. { Support functions for texturing }
  2277. function dxtMakeChannel(Mask: DWORD; indexed: Boolean): TDXTextureImageChannel;
  2278. function dxtEncodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
  2279. function dxtDecodeChannel(const Channel: TDXTextureImageChannel; c: DWORD): DWORD;
  2280.  
  2281. { Single support routine for convert DIB32 to DXT in one line }
  2282. procedure dib2dxt(DIBImage: TDIB; out DXTImage: TDXTextureImage{$IFDEF DXTextureImage_UseZLIB}; const Shrink: Boolean = True{$ENDIF});
  2283.  
  2284. { One line call drawing with attributes }
  2285. {$IFDEF VER4UP}
  2286. procedure DXDraw_Draw(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
  2287.   Rect: TRect; Pattern: Integer; TextureFilter: TD2DTextureFilter = D2D_POINT;
  2288.   MirrorFlip: TRenderMirrorFlipSet = [];
  2289.   BlendMode: TRenderType = rtDraw; Angle: Single = 0; Alpha: Byte = 255;
  2290.   CenterX: Double = 0.5; CenterY: Double = 0.5;
  2291.   Scale: Single = 1.0); {$IFDEF VER9UP}inline;{$ENDIF}
  2292. procedure DXDraw_Paint(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
  2293.   Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean = False;
  2294.   TextureFilter: TD2DTextureFilter = D2D_POINT;
  2295.   MirrorFlip: TRenderMirrorFlipSet = [];
  2296.   BlendMode: TRenderType = rtDraw;
  2297.   Angle: Single = 0;
  2298.   Alpha: Byte = 255;
  2299.   CenterX: Double = 0.5; CenterY: Double = 0.5); {$IFDEF VER9UP}inline;{$ENDIF}
  2300. procedure DXDraw_Render(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
  2301.   Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean = False;
  2302.   TextureFilter: TD2DTextureFilter = D2D_POINT;
  2303.   MirrorFlip: TRenderMirrorFlipSet = [];
  2304.   BlendMode: TRenderType = rtDraw;
  2305.   Angle: Single = 0;
  2306.   Alpha: Byte = 255;
  2307.   CenterX: Double = 0.5; CenterY: Double = 0.5;
  2308.   Scale: Single = 1.0;
  2309.   WaveType: TWaveType = wtWaveNone;
  2310.   Amplitude: Integer = 0; AmpLength: Integer = 0; Phase: Integer = 0); {$IFDEF VER9UP}inline;{$ENDIF}
  2311. {$ELSE}
  2312. procedure DXDraw_Draw(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
  2313.   Rect: TRect; Pattern: Integer; TextureFilter: TD2DTextureFilter;
  2314.   MirrorFlip: TRenderMirrorFlipSet;
  2315.   BlendMode: TRenderType; Angle: Single; Alpha: Byte;
  2316.   CenterX: Double; CenterY: Double;
  2317.   Scale: Single);
  2318. procedure DXDraw_Paint(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
  2319.   Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
  2320.   TextureFilter: TD2DTextureFilter;
  2321.   MirrorFlip: TRenderMirrorFlipSet;
  2322.   BlendMode: TRenderType;
  2323.   Angle: Single;
  2324.   Alpha: Byte;
  2325.   CenterX: Double; CenterY: Double);
  2326. procedure DXDraw_Render(DXDraw: TCustomDXDraw; Image: TPictureCollectionItem;
  2327.   Rect: TRect; Pattern: Integer; var BlurImageArr: TBlurImageArr; BlurImage: Boolean;
  2328.   TextureFilter: TD2DTextureFilter;
  2329.   MirrorFlip: TRenderMirrorFlipSet;
  2330.   BlendMode: TRenderType;
  2331.   Angle: Single;
  2332.   Alpha: Byte;
  2333.   CenterX: Double; CenterY: Double;
  2334.   Scale: Single;
  2335.   WaveType: TWaveType;
  2336.   Amplitude: Integer; AmpLength: Integer; Phase: Integer);
  2337. {$ENDIF}
  2338.  
  2339. implementation
  2340.  
  2341. uses DXConsts{$IFDEF DXR_deprecated}, DXRender{$ENDIF}, D3DUtils;
  2342.  
  2343. function DXDirectDrawEnumerate(lpCallback: {$IFDEF UNICODE}TDDEnumCallbackW{$ELSE}TDDEnumCallbackA{$ENDIF};
  2344.   lpContext: Pointer): HRESULT;
  2345. type
  2346.   TDirectDrawEnumerate = function(lpCallback: {$IFDEF UNICODE}TDDEnumCallbackW{$ELSE}TDDEnumCallbackA{$ENDIF};
  2347.     lpContext: Pointer): HRESULT; stdcall;
  2348. begin
  2349.   Result := TDirectDrawEnumerate(DXLoadLibrary('DDraw.dll', {$IFDEF UNICODE}'DirectDrawEnumerateW'{$ELSE}'DirectDrawEnumerateA'{$ENDIF}))
  2350.     (lpCallback, lpContext);
  2351. end;
  2352.  
  2353. var
  2354.   DirectDrawDrivers: TDirectXDrivers;
  2355.   {$IFDEF _DMO_}DirectDrawDriversEx: TDirectXDriversEx;{$ENDIF}
  2356.   D2D: TD2D = nil; {for internal use only, }
  2357.   RenderError: Boolean = false;
  2358.  
  2359. function EnumDirectDrawDrivers: TDirectXDrivers;
  2360.  
  2361.   function DDENUMCALLBACK(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
  2362.     lpstrModule: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer): BOOL; stdcall;
  2363.   begin
  2364.     Result := True;
  2365.     with TDirectXDriver.Create(TDirectXDrivers(lpContext)) do
  2366.     begin
  2367.       Guid := lpGuid;
  2368.       Description := lpstrDescription;
  2369.       DriverName := lpstrModule;
  2370.     end;
  2371.   end;
  2372.  
  2373. begin
  2374.   if DirectDrawDrivers = nil then
  2375.   begin
  2376.     DirectDrawDrivers := TDirectXDrivers.Create;
  2377.     try
  2378.       DXDirectDrawEnumerate(@DDENUMCALLBACK, DirectDrawDrivers);
  2379.     except
  2380.       DirectDrawDrivers.Free;
  2381.       raise;
  2382.     end;
  2383.   end;
  2384.  
  2385.   Result := DirectDrawDrivers;
  2386. end;
  2387.  
  2388. {$IFDEF _DMO_}
  2389. function EnumDirectDrawDriversEx: TDirectXDriversEx;
  2390.  
  2391.   function DDENUMCALLBACKEX(lpGuid: PGUID; lpstrDescription: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF};
  2392.     lpDriverName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPCSTR{$ENDIF}; lpContext: Pointer; iMonitor: HMonitor): BOOL; stdcall;
  2393.   var
  2394.     X: TDirectXDriverEx;
  2395.   begin
  2396.     Result := True;
  2397.     X := TDirectXDriverEx(DirectDrawDriversEx.Add);
  2398.     with X do
  2399.     begin
  2400.       Guid := lpGuid;
  2401.       Description := lpstrDescription;
  2402.       Monitor := iMonitor;
  2403.       DriverName := lpDriverName;
  2404.       //GetPhysicalMonitorsFromHMONITOR()
  2405.     end;
  2406.   end;
  2407.  
  2408. //var
  2409. //  DevMode: TDeviceMode;
  2410. begin
  2411.   if DirectDrawDriversEx = nil then DirectDrawDriversEx := TDirectXDriversEx.Create;
  2412.   if Assigned(DirectDrawDriversEx) then
  2413.   begin
  2414.     //FMonitors.Clear;
  2415.     try
  2416.       //FillChar(DevMode, SizeOf(TDeviceMode), 0);
  2417.       if DirectDrawEnumerateEx(@DDENUMCALLBACKEX, nil{DeviceContext}, DDENUM_ATTACHEDSECONDARYDEVICES or DDENUM_DETACHEDSECONDARYDEVICES or DDENUM_NONDISPLAYDEVICES) = DD_OK then;
  2418.     except
  2419.       DirectDrawDriversEx.Free; DirectDrawDriversEx := nil;
  2420.       raise;
  2421.     end;
  2422.   end;
  2423.   Result := DirectDrawDriversEx;
  2424. end;
  2425. {$ENDIF}
  2426.  
  2427. function ClipRect(var DestRect: TRect; const DestRect2: TRect): Boolean;
  2428. begin
  2429.   with DestRect do
  2430.   begin
  2431.     Left := Max(Left, DestRect2.Left);
  2432.     Right := Min(Right, DestRect2.Right);
  2433.     Top := Max(Top, DestRect2.Top);
  2434.     Bottom := Min(Bottom, DestRect2.Bottom);
  2435.  
  2436.     Result := (Left < Right) and (Top < Bottom);
  2437.   end;
  2438. end;
  2439.  
  2440. function ClipRect2(var DestRect, SrcRect: TRect; const DestRect2, SrcRect2: TRect): Boolean;
  2441. begin
  2442.   if DestRect.Left < DestRect2.Left then
  2443.   begin
  2444.     SrcRect.Left := SrcRect.Left + (DestRect2.Left - DestRect.Left);
  2445.     DestRect.Left := DestRect2.Left;
  2446.   end;
  2447.  
  2448.   if DestRect.Top < DestRect2.Top then
  2449.   begin
  2450.     SrcRect.Top := SrcRect.Top + (DestRect2.Top - DestRect.Top);
  2451.     DestRect.Top := DestRect2.Top;
  2452.   end;
  2453.  
  2454.   if SrcRect.Left < SrcRect2.Left then
  2455.   begin
  2456.     DestRect.Left := DestRect.Left + (SrcRect2.Left - SrcRect.Left);
  2457.     SrcRect.Left := SrcRect2.Left;
  2458.   end;
  2459.  
  2460.   if SrcRect.Top < SrcRect2.Top then
  2461.   begin
  2462.     DestRect.Top := DestRect.Top + (SrcRect2.Top - SrcRect.Top);
  2463.     SrcRect.Top := SrcRect2.Top;
  2464.   end;
  2465.  
  2466.   if DestRect.Right > DestRect2.Right then
  2467.   begin
  2468.     SrcRect.Right := SrcRect.Right - (DestRect.Right - DestRect2.Right);
  2469.     DestRect.Right := DestRect2.Right;
  2470.   end;
  2471.  
  2472.   if DestRect.Bottom > DestRect2.Bottom then
  2473.   begin
  2474.     SrcRect.Bottom := SrcRect.Bottom - (DestRect.Bottom - DestRect2.Bottom);
  2475.     DestRect.Bottom := DestRect2.Bottom;
  2476.   end;
  2477.  
  2478.   if SrcRect.Right > SrcRect2.Right then
  2479.   begin
  2480.     DestRect.Right := DestRect.Right - (SrcRect.Right - SrcRect2.Right);
  2481.     SrcRect.Right := SrcRect2.Right;
  2482.   end;
  2483.  
  2484.   if SrcRect.Bottom > SrcRect2.Bottom then
  2485.   begin
  2486.     DestRect.Bottom := DestRect.Bottom - (SrcRect.Bottom - SrcRect2.Bottom);
  2487.     SrcRect.Bottom := SrcRect2.Bottom;
  2488.   end;
  2489.  
  2490.   Result := (DestRect.Left < DestRect